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

Tedit2 move tedit files to separate tedit subdirectory attempt 2 (#836)

Browse Source 
* TEDIT files: deleted from library/, renamed to library>tedit.TEDIT-xxx

* PSEUDOHOSTS:  Error if file won't open

* LOADUP-*, MEDLEYDIR, UNICODE

Adjustment for TEDIT-xxx, plus moving UNICODE to the beginning of LOADUP-LISP, with UNICODEDIRECTORIES creating in MEDLEYDIR
This commit is contained in:
rmkaplan
2022-07-16 21:24:32 -07:00
committed by GitHub
parent 41bb28f01e
commit 7a220ddcba
55 changed files with 15306 additions and 16940 deletions
Download Patch File Download Diff File Expand all files Collapse all files

BIN
library/TEDITABBREV.LCOM
View File

Binary file not shown.

439
library/TEDITCHAT
View File

@@ -1,439 +0,0 @@
(DEFINE-FILE-INFO PACKAGE "LISP" READTABLE "XCL" BASE 10)
(IL:FILECREATED "28-Mar-94 16:05:24" IL:|{PELE:MV:ENVOS}<LISPCORE>LIBRARY>TEDITCHAT.;3| 31193
IL:|changes| IL:|to:| (IL:FNS IL:\\TEXTSTREAMBOUT)
IL:|previous| IL:|date:| "12-Jun-90 18:01:39" IL:|{PELE:MV:ENVOS}<LISPCORE>LIBRARY>TEDITCHAT.;2|
)
; Copyright (c) 1985, 1986, 1990, 1994 by Venue & Xerox Corporation. All rights reserved.
(IL:PRETTYCOMPRINT IL:TEDITCHATCOMS)
(IL:RPAQQ IL:TEDITCHATCOMS
((IL:COMS (IL:* IL:\; "character routines")
(IL:FNS IL:TEDITCHAT.CHARFN IL:\\TEXTSTREAMBOUT))
(IL:COMS (IL:FNS IL:TEDITSTREAM.INIT IL:TEDITCHAT.MENUFN))
(IL:COMS (IL:* IL:\; "TEDIT update routines")
(IL:FNS IL:TEDIT.DISPLAYTEXT))
(IL:GLOBALVARS IL:TEDITCHAT.MENU IL:CHAT.DRIVERTYPES IL:CHAT.DISPLAYTYPES)
(IL:VARS IL:TEDITCHAT.MENUITEMS (IL:TEDITCHAT.MENU))
(IL:ADDVARS (IL:CHAT.DRIVERTYPES (IL:TEDIT IL:TEDITCHAT.CHARFN IL:NILL)))
(IL:DECLARE\: IL:EVAL@COMPILE IL:DONTCOPY (IL:FILES (IL:SOURCE)
IL:CHATDECLS))))
(IL:* IL:\; "character routines")
(IL:DEFINEQ
(IL:TEDITCHAT.CHARFN
(IL:LAMBDA (IL:CH IL:CHAT.STATE) (IL:* IL:\; "Edited 12-Jun-90 18:00 by mitani")
(LET* ((IL:TEXTSTREAM (IL:|fetch| (IL:CHAT.STATE IL:TEXTSTREAM) IL:|of| IL:CHAT.STATE))
(IL:SEL (IL:|fetch| (IL:TEXTOBJ IL:SEL) IL:|of| (IL:TEXTOBJ IL:TEXTSTREAM))))
(IL:\\CARET.DOWN (IL:|fetch| (IL:TEXTOBJ IL:DS) IL:|of| (IL:TEXTOBJ IL:TEXTSTREAM))
)
(IL:SELCHARQ IL:CH
(IL:BS (IL:\\TEDIT.CHARDELETE IL:TEXTSTREAM "" IL:SEL)
(IL:MOVETO (IL:|fetch| IL:X0 IL:|of| IL:SEL)
(IL:|fetch| IL:Y0 IL:|of| IL:SEL)
(CAR (IL:|fetch| (IL:TEXTOBJ IL:\\WINDOW) IL:|of| (IL:TEXTOBJ
IL:TEXTSTREAM
)))))
(IL:LF NIL)
(IL:BOUT IL:TEXTSTREAM IL:CH)))))
(IL:\\TEXTSTREAMBOUT
(IL:LAMBDA (STREAM BYTE) (IL:* IL:\; "Edited 28-Mar-94 15:29 by jds")
(IL:* IL:|;;| "Do BOUT to a text stream, which is an insertion at the caret.")
(PROG ((IL:TEXTOBJ (IL:|fetch| (IL:TEXTSTREAM IL:TEXTOBJ) IL:|of| STREAM))
IL:CH# IL:WINDOW IL:TEXTLEN IL:PS IL:PC IL:PSTR IL:OFFST IL:SEL)
(IL:SETQ IL:TEXTLEN (IL:|fetch| (IL:TEXTOBJ IL:TEXTLEN) IL:|of| IL:TEXTOBJ))
(IL:SETQ IL:WINDOW (IL:|fetch| (IL:TEXTOBJ IL:\\WINDOW) IL:|of| IL:TEXTOBJ))
(IL:SETQ IL:SEL (IL:|fetch| (IL:TEXTOBJ IL:SEL) IL:|of| IL:TEXTOBJ))
(COND
((NOT (CAR (IL:|fetch| IL:L1 IL:|of| IL:SEL)))
(RETURN))) (IL:* IL:\;
 "Return if caret out of bounds, ie, user scrolls past end of text")
(IL:SETQ IL:CH# (IL:|fetch| IL:CH# IL:|of| IL:SEL))
(AND IL:WINDOW (IL:\\TEDIT.MARK.LINES.DIRTY IL:TEXTOBJ IL:CH# IL:CH#))
(COND
((IL:IEQP BYTE 13)
(IL:\\INSERTCR BYTE IL:CH# IL:TEXTOBJ))
(T (IL:\\INSERTCH BYTE IL:CH# IL:TEXTOBJ)))
(AND IL:WINDOW
(PROG ((IL:THISLINE (IL:|fetch| (IL:TEXTOBJ IL:THISLINE) IL:|of| IL:TEXTOBJ))
IL:EOLFLAG IL:CHORIG IL:CHWIDTH IL:OXLIM IL:OCHLIM IL:OCR\\END IL:PREVSPACE
IL:FIXEDLINE IL:NEXTLINE IL:LINES IL:NEWLINEFLG IL:DX IL:PREVLINE IL:SAVEWIDTH
IL:OFLOWFN IL:OLHEIGHT IL:DY IL:TABSEEN IL:IMAGECACHE IL:CURLINE IL:FONT
(IL:L1 (CAR (IL:|fetch| IL:L1 IL:|of| IL:SEL)))
(IL:LN (CAR (IL:|fetch| IL:LN IL:|of| IL:SEL)))
(IL:LOOKS (IL:\\TEDIT.APPLY.STYLES (IL:|fetch| (IL:TEXTOBJ IL:CARETLOOKS)
IL:|of| IL:TEXTOBJ)
(IL:|fetch| (IL:TEXTOBJ IL:\\INSERTPC) IL:|of|
IL:TEXTOBJ)
IL:TEXTOBJ)))
(IL:|add| (IL:|fetch| IL:CH# IL:|of| IL:SEL)
1) (IL:* IL:\;
 "These must be here, since SELs are valid even without a window.")
(IL:|replace| IL:CHLIM IL:|of| IL:SEL IL:|with| (IL:|fetch|
IL:CH# IL:|of|
IL:SEL))
(IL:|replace| IL:POINT IL:|of| IL:SEL IL:|with| 'IL:LEFT)
(IL:|replace| IL:DCH IL:|of| IL:SEL IL:|with| 0)
(IL:|replace| IL:SELKIND IL:|of| IL:SEL IL:|with| 'IL:CHAR)
(IL:SETQ IL:CURLINE IL:L1)
(IL:|add| (IL:|fetch| IL:CHARLIM IL:|of| IL:CURLINE)
1)
(IL:|add| (IL:|fetch| IL:CHARTOP IL:|of| IL:CURLINE)
1)
(IL:SETQ IL:FONT (IL:|fetch| IL:CLFONT IL:|of| IL:LOOKS))
(IL:DSPFONT IL:FONT (CAR IL:WINDOW))
(COND
((OR (IL:IGREATERP (IL:PLUS (IL:|fetch| IL:X0 IL:|of| IL:SEL)
(IL:CHARWIDTH BYTE IL:FONT))
(IL:IDIFFERENCE (IL:|fetch| (IL:TEXTOBJ IL:WRIGHT)
IL:|of| IL:TEXTOBJ)
8))
(IL:IEQP BYTE (IL:CHARCODE IL:CR)))
(IL:* IL:\;
 "gone off the edge of the line reformat and add new line")
(IL:TEDIT.UPDATE.SCREEN IL:TEXTOBJ)
(IL:\\FIXSEL IL:SEL IL:TEXTOBJ (CAR IL:WINDOW))
(IL:SETQ IL:L1 (CAR (IL:|fetch| IL:L1 IL:|of| IL:SEL)))
(IL:SETQ IL:LN (CAR (IL:|fetch| IL:LN IL:|of| IL:SEL)))
(COND
((OR (NULL (IL:SELECTQ (IL:|fetch| IL:POINT IL:|of| IL:SEL)
(IL:LEFT IL:L1)
(IL:RIGHT IL:LN)
NIL))
(IL:ILEQ (IL:SELECTQ (IL:|fetch| IL:POINT IL:|of| IL:SEL)
(IL:LEFT (IL:|fetch| IL:YBOT IL:|of| IL:L1))
(IL:RIGHT (IL:|fetch| IL:YBOT IL:|of| IL:LN))
0)
(IL:|fetch| (IL:REGION IL:BOTTOM)
IL:|of| (IL:DSPCLIPPINGREGION NIL (CAR IL:WINDOW)))))
(IL:* IL:\;
 "The caret is off-window in the selection window. Need to scroll it up so the caret is visible.")
(IL:|while| (IL:ILESSP (IL:|fetch| IL:Y0 IL:|of| IL:SEL)
(IL:|fetch| (IL:TEXTOBJ IL:WBOTTOM)
IL:|of| IL:TEXTOBJ))
IL:|do| (IL:* IL:\;
 "The caret just went off-screen. Move it up some.")
(IL:|replace| (IL:TEXTOBJ IL:EDITOPACTIVE) IL:|of|
IL:TEXTOBJ
IL:|with| NIL)
(IL:SCROLLW (CAR IL:WINDOW)
0
(IL:LLSH (COND
((IL:SELECTQ (IL:|fetch| IL:POINT
IL:|of| IL:SEL)
(IL:LEFT IL:L1)
(IL:RIGHT IL:LN)
NIL)
(IL:|fetch| IL:LHEIGHT
IL:|of| (IL:SELECTQ (IL:|fetch|
IL:POINT
IL:|of|
IL:SEL)
(IL:LEFT IL:L1)
(IL:RIGHT IL:LN)
(IL:SHOULDNT))))
(T 12))
1))))))
(T (IL:TEDIT.DISPLAYTEXT IL:TEXTOBJ BYTE (IL:CHARWIDTH BYTE IL:FONT)
IL:CURLINE
(IL:|fetch| IL:X0 IL:|of| IL:SEL)
(CAR IL:WINDOW)
IL:SEL) (IL:* IL:\;
 "Print out the character on the screen")
(IL:|add| (IL:|fetch| IL:X0 IL:|of| IL:SEL)
(IL:CHARWIDTH BYTE IL:FONT))
(IL:* IL:|;;| "And move the selection's notion of our X position to the right to account for that character's width.")
(IL:|replace| IL:XLIM IL:|of| IL:SEL IL:|with| (IL:|fetch|
IL:X0
IL:|of|
IL:SEL))))
(IL:* IL:|;;;| "Fix up the TEXTSTREAM so that the FILEPTR looks like it ought to after the BOUT, even though we've been updating the screen (which usually moves the fileptr....)")
(IL:SETQ IL:PS (IL:|ffetch| (IL:PIECE IL:PSTR) IL:|of|
(IL:SETQ IL:PC
(IL:|fetch| (IL:TEXTOBJ
IL:\\INSERTPC
)
IL:|of| IL:TEXTOBJ)))
) (IL:* IL:\;
 "This piece resides in a STRING. Because it's newly 'typed' material.")
(IL:|replace| (IL:TEXTSTREAM IL:PIECE) IL:|of| STREAM IL:|with|
IL:PC)
(IL:* IL:\;
 "Remember the current piece for others.")
(IL:* IL:\;
 "And which number piece this is.")
(IL:|freplace| (STREAM IL:CPPTR) IL:|of| STREAM
IL:|with| (IL:ADDBASE (IL:|ffetch| (IL:STRINGP IL:BASE) IL:|of|
IL:PS)
(IL:LRSH (IL:SETQ IL:OFFST (IL:|ffetch| (IL:STRINGP
IL:OFFST)
IL:|of| IL:PS))
1))) (IL:* IL:\;
 "Pointer to the actual characters in the string (allowing for substrings.)")
(IL:|freplace| (STREAM IL:CPAGE) IL:|of| STREAM IL:|with| 0)
(IL:|freplace| (STREAM IL:COFFSET) IL:|of| STREAM
IL:|with| (IL:IPLUS (IL:|freplace| (IL:TEXTSTREAM IL:PCSTARTCH)
IL:|of| STREAM IL:|with| (LOGAND 1
IL:OFFST))
(IL:|fetch| (IL:TEXTOBJ IL:\\INSERTLEN) IL:|of|
IL:TEXTOBJ))
)
(IL:|freplace| (IL:TEXTSTREAM IL:PCSTARTPG) IL:|of| STREAM IL:|with|
0)
(IL:* IL:\;
 "Page # within the 'file' where this piece starts")
(IL:|freplace| (STREAM IL:CBUFSIZE) IL:|of| STREAM
IL:|with| (IL:|fetch| (STREAM IL:COFFSET) IL:|of| STREAM))
(IL:|freplace| (STREAM IL:EPAGE) IL:|of| STREAM IL:|with| 1)
(IL:|freplace| (IL:TEXTSTREAM IL:CHARSLEFT) IL:|of| STREAM IL:|with|
0)
(IL:* IL:\;
 "We're, perforce, at the end of the piece.")
(IL:|freplace| (IL:TEXTSTREAM IL:REALFILE) IL:|of| STREAM IL:|with|
NIL)
(IL:* IL:\; "We're not on a file....")
)))))
)
(IL:DEFINEQ
(IL:TEDITSTREAM.INIT
(IL:LAMBDA (IL:WINDOW IL:MENUFN) (IL:* IL:\; "Edited 12-Jun-90 18:01 by mitani")
(IL:* IL:|;;| "Initialize and return TEDIT TEXTSTREAM")
(PROG* ((IL:TEXTSTREAM (IL:OPENTEXTSTREAM NIL IL:WINDOW NIL NIL))
(IL:TEXTOBJ (IL:TEXTOBJ IL:TEXTSTREAM))) (IL:* IL:\;
 "force shift select typein to be put in keyboard buffer")
(IL:TEXTPROP IL:TEXTSTREAM 'IL:COPYBYBKSYSBUF T)
(IL:|replace| (STREAM IL:STRMBOUTFN) IL:|of| IL:TEXTSTREAM IL:|with|
'IL:\\TEXTSTREAMBOUT)
(IL:|replace| SET IL:|of| (IL:|fetch| (IL:TEXTOBJ IL:SEL) IL:|of|
IL:TEXTOBJ)
IL:|with| T)
(IL:|replace| IL:L1 IL:|of| (IL:|fetch| (IL:TEXTOBJ IL:SEL) IL:|of|
IL:TEXTOBJ)
IL:|with| (LIST (IL:|fetch| IL:DESC IL:|of| (IL:|fetch| (IL:TEXTOBJ
IL:THISLINE)
IL:|of| IL:TEXTOBJ))))
(IL:* IL:\;
 "hookup middle button menu instead of TEDIT menu")
(IL:WINDOWPROP IL:WINDOW 'IL:TEDIT.TITLEMENUFN IL:MENUFN)
(RETURN IL:TEXTSTREAM))))
(IL:TEDITCHAT.MENUFN
(IL:LAMBDA (IL:WINDOW) (IL:* IL:|| "20-Oct-86 15:03")
(DECLARE (IL:GLOBALVARS IL:TEDITCHAT.MENU)
(IL:SPECVARS IL:WINDOW IL:STATE)) (IL:* IL:MIDDLEBUTTON)
(PROG ((IL:STATE (IL:WINDOWPROP IL:WINDOW 'IL:CHATSTATE))
IL:COMMAND)
(COND
((NOT IL:STATE) (IL:* IL:N\o IL:|Connection|
 IL:|here;| IL:|try| IL:|to|
 IL:|reestablish|)
(RETURN (COND
((IL:LASTMOUSESTATE IL:MIDDLE)
(IL:CHAT.RECONNECT IL:WINDOW))
(T (IL:TOTOPW IL:WINDOW))))))
(IL:|replace| (IL:CHAT.STATE IL:HELD) IL:|of| IL:STATE IL:|with| T)
(IL:\\CHECKCARET IL:WINDOW)
(IL:SELECTQ (IL:SETQ IL:COMMAND (IL:MENU (OR IL:TEDITCHAT.MENU (IL:SETQ IL:TEDITCHAT.MENU
(IL:|create| IL:MENU
IL:ITEMS IL:_
IL:TEDITCHAT.MENUITEMS
)))))
(IL:|Close| (IL:|replace| (IL:CHAT.STATE IL:RUNNING?) IL:|of| IL:STATE
IL:|with| 'IL:CLOSE) (IL:* IL:|Ask| IL:CHAT.TYPEIN IL:|to|
 IL:|shut| IL:|things| IL:|down.|)
)
(IL:|New| (IL:|replace| (IL:CHAT.STATE IL:RUNNING?) IL:|of| IL:STATE
IL:|with| 'IL:CLOSE)
(IL:WINDOWPROP IL:WINDOW 'IL:KEEPCHAT 'IL:NEW))
(IL:|Suspend| (IL:|replace| (IL:CHAT.STATE IL:RUNNING?) IL:|of| IL:STATE
IL:|with| 'IL:CLOSE)
(IL:WINDOWPROP IL:WINDOW 'IL:KEEPCHAT T))
(IL:|Freeze| (IL:* IL:|Leave| IL:|in| IL:HELD
 IL:|state|)
(RETURN))
(NIL)
(IL:APPLY* IL:COMMAND IL:STATE IL:WINDOW))
(IL:|replace| (IL:CHAT.STATE IL:HELD) IL:|of| IL:STATE IL:|with| NIL))))
)
(IL:* IL:\; "TEDIT update routines")
(IL:DEFINEQ
(IL:TEDIT.DISPLAYTEXT
(IL:LAMBDA (IL:TEXTOBJ IL:CH IL:CHWIDTH IL:LINE IL:XPOINT IL:DS IL:SEL)
(IL:* IL:\; "Edited 12-Jun-90 18:01 by mitani")
(IL:* IL:|This| IL:|function|
 IL:|does| IL:|the| IL:|actual|
 IL:|displaying| IL:|of|
 IL:|typed-in| IL:|text| IL:|on|
 IL:|the| IL:|edit| IL:|window.|)
(PROG ((IL:LOOKS (IL:\\TEDIT.APPLY.STYLES (IL:|fetch| (IL:TEXTOBJ IL:CARETLOOKS) IL:|of|
IL:TEXTOBJ)
(IL:|fetch| (IL:TEXTOBJ IL:\\INSERTPC) IL:|of| IL:TEXTOBJ)
IL:TEXTOBJ))
(IL:TERMSA (IL:|fetch| (IL:TEXTOBJ IL:TXTTERMSA) IL:|of| IL:TEXTOBJ))
IL:DY IL:FONT)
(IL:MOVETO IL:XPOINT (IL:IPLUS (IL:|fetch| IL:YBASE IL:|of| IL:LINE)
(OR (IL:|fetch| IL:CLOFFSET IL:|of| IL:LOOKS)
0))
IL:DS) (IL:* IL:|Set| IL:|the| IL:|display|
 IL:|stream| IL:|position|)
(COND
(IL:TERMSA (IL:* IL:|Special| IL:|terminal|
 IL:|table| IL:|for| IL:|controlling|
 IL:|character| IL:|display.|
 IL:|Use| IL:|it.|)
(IL:RESETLST
(IL:RESETSAVE IL:\\PRIMTERMSA IL:TERMSA)
(IL:|replace| (IL:TEXTSTREAM IL:REALFILE) IL:|of| (IL:|fetch|
(IL:TEXTOBJ
IL:STREAMHINT
)
IL:|of|
IL:TEXTOBJ)
IL:|with| IL:DS)
(COND
((IL:STRINGP IL:CH)
(IL:|for| IL:CHAR IL:|instring| IL:CH
IL:|do| (IL:SELCHARQ IL:CHAR
(IL:TAB (IL:* IL:|Put| IL:|down| IL:|white|)
(IL:BITBLT NIL 0 0 IL:DS IL:XPOINT
(IL:|fetch| IL:YBOT IL:|of|
IL:LINE)
36
(IL:|fetch| IL:LHEIGHT
IL:|of| IL:LINE)
'IL:TEXTURE
'IL:REPLACE IL:WHITESHADE)
(IL:RELMOVETO 36 0 IL:DS))
(IL:CR (IL:BITBLT NIL 0 0 IL:DS IL:XPOINT
(IL:|fetch| IL:YBOT IL:|of|
IL:LINE)
(IL:IMAX 6 (IL:CHARWIDTH IL:CHAR
IL:FONT))
(IL:|fetch| IL:LHEIGHT
IL:|of| IL:LINE)
'IL:TEXTURE
'IL:REPLACE IL:WHITESHADE))
(IL:\\DSPPRINTCHAR (IL:|fetch| (IL:TEXTOBJ
IL:STREAMHINT)
IL:|of| IL:TEXTOBJ)
IL:CHAR))))
(T (IL:SELCHARQ IL:CH
(IL:TAB (IL:* IL:|Put| IL:|down| IL:|white|)
(IL:BITBLT NIL 0 0 IL:DS IL:XPOINT (IL:|fetch|
IL:YBOT
IL:|of| IL:LINE
)
36
(IL:|fetch| IL:LHEIGHT IL:|of| IL:LINE)
'IL:TEXTURE
'IL:REPLACE IL:WHITESHADE)
(IL:RELMOVETO 36 0 IL:DS))
(IL:CR (IL:BITBLT NIL 0 0 IL:DS IL:XPOINT (IL:|fetch| IL:YBOT
IL:|of| IL:LINE)
(IL:IMAX 6 (IL:CHARWIDTH IL:CH IL:FONT))
(IL:|fetch| IL:LHEIGHT IL:|of| IL:LINE)
'IL:TEXTURE
'IL:REPLACE IL:WHITESHADE))
(IL:\\DSPPRINTCHAR (IL:|fetch| (IL:TEXTOBJ IL:STREAMHINT)
IL:|of| IL:TEXTOBJ)
IL:CH))))))
(T (IL:* IL:N\o IL:|special|
 IL:|handling;| IL:|just| IL:|use|
 IL:|native| IL:|character|
 IL:|codes|)
(COND
((IL:STRINGP IL:CH)
(IL:|for| IL:CHAR IL:|instring| IL:CH
IL:|do| (IL:SELCHARQ IL:CHAR
(IL:TAB (IL:* IL:|Put| IL:|down| IL:|white|)
(IL:BITBLT NIL 0 0 IL:DS (IL:DSPXPOSITION NIL IL:DS)
(IL:|fetch| IL:YBOT IL:|of| IL:LINE)
36
(IL:|fetch| IL:LHEIGHT IL:|of|
IL:LINE)
'IL:TEXTURE
'IL:REPLACE IL:WHITESHADE)
(IL:RELMOVETO 36 0 IL:DS))
(IL:CR (IL:BITBLT NIL 0 0 IL:DS (IL:DSPXPOSITION NIL IL:DS)
(IL:|fetch| IL:YBOT IL:|of| IL:LINE)
(IL:IMAX 6 (IL:CHARWIDTH IL:CHAR IL:FONT))
(IL:|fetch| IL:LHEIGHT IL:|of| IL:LINE
)
'IL:TEXTURE
'IL:REPLACE IL:WHITESHADE))
(IL:BLTCHAR IL:CHAR IL:DS))))
(T (IL:SELCHARQ IL:CH
(IL:TAB (IL:* IL:|Put| IL:|down| IL:|white|)
(IL:BITBLT NIL 0 0 IL:DS (IL:DSPXPOSITION NIL IL:DS)
(IL:|fetch| IL:YBOT IL:|of| IL:LINE)
36
(IL:|fetch| IL:LHEIGHT IL:|of| IL:LINE)
'IL:TEXTURE
'IL:REPLACE IL:WHITESHADE)
(IL:RELMOVETO 36 0 IL:DS))
(IL:CR (IL:* IL:|Blank| IL:|out| IL:|the|
 IL:|CR's| IL:|width.|)
(IL:BITBLT NIL 0 0 IL:DS (IL:DSPXPOSITION NIL IL:DS)
(IL:|fetch| IL:YBOT IL:|of| IL:LINE)
(IL:IMAX 6 (IL:CHARWIDTH IL:CH IL:FONT))
(IL:|fetch| IL:LHEIGHT IL:|of| IL:LINE)
'IL:TEXTURE
'IL:REPLACE IL:WHITESHADE))
(IL:BLTCHAR IL:CH IL:DS)))))))))
)
(IL:DECLARE\: IL:DOEVAL@COMPILE IL:DONTCOPY
(IL:GLOBALVARS IL:TEDITCHAT.MENU IL:CHAT.DRIVERTYPES IL:CHAT.DISPLAYTYPES)
)
(IL:RPAQQ IL:TEDITCHAT.MENUITEMS
((IL:|Close| 'IL:|Close| "Closes the connection and returns")
(IL:|Suspend| 'IL:|Suspend| "Closes the connection but leaves window up")
(IL:|New| 'IL:|New| "Closes this connection and prompts for a new host")
(IL:|Freeze| 'IL:|Freeze| "Holds typeout in this window until you bug it again")
("Dribble" (IL:FUNCTION IL:CHAT.TYPESCRIPT)
"Starts a typescript of window typeout")
("Input" (IL:FUNCTION IL:CHAT.TAKE.INPUT)
"Allows input from a file")
("Option" (IL:FUNCTION IL:DO.CHAT.OPTION)
"Do protocol specific option")))
(IL:RPAQQ IL:TEDITCHAT.MENU NIL)
(IL:ADDTOVAR IL:CHAT.DRIVERTYPES (IL:TEDIT IL:TEDITCHAT.CHARFN IL:NILL))
(IL:DECLARE\: IL:EVAL@COMPILE IL:DONTCOPY
(IL:FILESLOAD (IL:SOURCE)
IL:CHATDECLS)
)
(IL:PUTPROPS IL:TEDITCHAT IL:COPYRIGHT ("Venue & Xerox Corporation" 1985 1986 1990 1994))
(IL:DECLARE\: IL:DONTCOPY
(IL:FILEMAP (NIL (1308 15667 (IL:TEDITCHAT.CHARFN 1321 . 2481) (IL:\\TEXTSTREAMBOUT 2483 . 15665)) (
15668 20008 (IL:TEDITSTREAM.INIT 15681 . 17389) (IL:TEDITCHAT.MENUFN 17391 . 20006)) (20054 30055 (
IL:TEDIT.DISPLAYTEXT 20067 . 30053)))))
IL:STOP

BIN
library/TEDITCHAT.LCOM
View File

Binary file not shown.

3702
library/TEDITFILE
View File

File diff suppressed because it is too large Load Diff

3007
library/TEDITSCREEN
View File

File diff suppressed because it is too large Load Diff

2277
library/TEDITSELECTION
View File

File diff suppressed because it is too large Load Diff

BIN
library/TFBRAVO.LCOM
View File

Binary file not shown.

41
library/UNICODE
View File

@@ -1,12 +1,12 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "28-Jun-2022 00:02:58" 
{DSK}<Users>kaplan>Local>medley3.5>working-medley>library>UNICODE.;195 64708
(FILECREATED "13-Jul-2022 11:38:18" 
{DSK}<users>kaplan>local>medley3.5>working-medley>library>UNICODE.;196 64439
:CHANGES-TO (FNS NUTF8CODEBYTES)
:CHANGES-TO (VARS UNICODECOMS)
:PREVIOUS-DATE "30-Sep-2021 16:03:18"
{DSK}<Users>kaplan>Local>medley3.5>working-medley>library>UNICODE.;194)
:PREVIOUS-DATE "28-Jun-2022 00:02:58"
{DSK}<users>kaplan>local>medley3.5>working-medley>library>UNICODE.;195)
(PRETTYCOMPRINT UNICODECOMS)
@@ -25,7 +25,7 @@
(FNS XCCS-UTF8-AFTER-OPEN)
(DECLARE%: EVAL@COMPILE DONTCOPY (MACROS UNICODE.TRANSLATE))
(FNS XTOUCODE UTOXCODE))
[COMS
(COMS
(* ;; "Unicode mapping files")
(FNS READ-UNICODE-MAPPING-FILENAMES READ-UNICODE-MAPPING WRITE-UNICODE-MAPPING
@@ -40,9 +40,7 @@
(UNDEFINEDCODE (CL:PARSE-INTEGER "FFFF" :RADIX
16]
(VARS UNICODE-MAPPING-HEADER)
(INITVARS (UNICODEDIRECTORIES NIL))
(P (PUSHNEW UNICODEDIRECTORIES (PACK* (UNIX-GETENV "MEDLEYDIR")
'/unicode/xerox/]
(INITVARS (UNICODEDIRECTORIES NIL)))
(COMS
(* ;; "Set up translation tables for UTF8 and UTFBE external formats")
@@ -832,9 +830,6 @@
(RPAQ? UNICODEDIRECTORIES NIL)
(PUSHNEW UNICODEDIRECTORIES (PACK* (UNIX-GETENV "MEDLEYDIR")
'/unicode/xerox/))
(* ;; "Set up translation tables for UTF8 and UTFBE external formats")
@@ -1207,15 +1202,15 @@
)
)
(DECLARE%: DONTCOPY
(FILEMAP (NIL (4094 17774 (UTF8.OUTCHARFN 4104 . 6935) (UTF8.INCCODEFN 6937 . 12427) (UTF8.PEEKCCODEFN
12429 . 17203) (\UTF8.BACKCCODEFN 17205 . 17772)) (17775 21101 (UTF16BE.OUTCHARFN 17785 . 18609) (
UTF16BE.INCCODEFN 18611 . 19510) (UTF16BE.PEEKCCODEFN 19512 . 20583) (\UTF16.BACKCCODEFN 20585 . 21099
)) (21131 22939 (MAKE-UNICODE-FORMATS 21141 . 22937)) (23036 24342 (UNICODE.UNMAPPED 23046 . 24340)) (
24343 24879 (XCCS-UTF8-AFTER-OPEN 24353 . 24877)) (25712 26061 (XTOUCODE 25722 . 25890) (UTOXCODE
25892 . 26059)) (26101 42223 (READ-UNICODE-MAPPING-FILENAMES 26111 . 27212) (READ-UNICODE-MAPPING
27214 . 30512) (WRITE-UNICODE-MAPPING 30514 . 34731) (WRITE-UNICODE-INCLUDED 34733 . 39455) (
WRITE-UNICODE-MAPPING-HEADER 39457 . 40689) (WRITE-UNICODE-MAPPING-FILENAME 40691 . 42221)) (45556
54035 (MAKE-UNICODE-TRANSLATION-TABLES 45566 . 54033)) (54452 62478 (HEXSTRING 54462 . 55623) (
UTF8HEXSTRING 55625 . 57830) (NUTF8CODEBYTES 57832 . 58617) (NUTF8STRINGBYTES 58619 . 59100) (
XTOUSTRING 59102 . 62113) (XCCSSTRING 62115 . 62476)) (62479 63948 (SHOWCHARS 62489 . 63946)))))
(FILEMAP (NIL (3945 17625 (UTF8.OUTCHARFN 3955 . 6786) (UTF8.INCCODEFN 6788 . 12278) (UTF8.PEEKCCODEFN
12280 . 17054) (\UTF8.BACKCCODEFN 17056 . 17623)) (17626 20952 (UTF16BE.OUTCHARFN 17636 . 18460) (
UTF16BE.INCCODEFN 18462 . 19361) (UTF16BE.PEEKCCODEFN 19363 . 20434) (\UTF16.BACKCCODEFN 20436 . 20950
)) (20982 22790 (MAKE-UNICODE-FORMATS 20992 . 22788)) (22887 24193 (UNICODE.UNMAPPED 22897 . 24191)) (
24194 24730 (XCCS-UTF8-AFTER-OPEN 24204 . 24728)) (25563 25912 (XTOUCODE 25573 . 25741) (UTOXCODE
25743 . 25910)) (25952 42074 (READ-UNICODE-MAPPING-FILENAMES 25962 . 27063) (READ-UNICODE-MAPPING
27065 . 30363) (WRITE-UNICODE-MAPPING 30365 . 34582) (WRITE-UNICODE-INCLUDED 34584 . 39306) (
WRITE-UNICODE-MAPPING-HEADER 39308 . 40540) (WRITE-UNICODE-MAPPING-FILENAME 40542 . 42072)) (45287
53766 (MAKE-UNICODE-TRANSLATION-TABLES 45297 . 53764)) (54183 62209 (HEXSTRING 54193 . 55354) (
UTF8HEXSTRING 55356 . 57561) (NUTF8CODEBYTES 57563 . 58348) (NUTF8STRINGBYTES 58350 . 58831) (
XTOUSTRING 58833 . 61844) (XCCSSTRING 61846 . 62207)) (62210 63679 (SHOWCHARS 62220 . 63677)))))
STOP

BIN
library/UNICODE.LCOM
View File

Binary file not shown.

64
library/TEDIT → library/tedit/TEDIT
View File

@@ -1,12 +1,12 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "22-Jun-2022 20:05:24" 
{DSK}<Users>kaplan>Local>medley3.5>working-medley>library>TEDIT.;41 143462
(FILECREATED "14-Jul-2022 17:10:16" 
{DSK}<Users>kaplan>Local>medley3.5>working-medley>library>TEDIT>TEDIT.;47 143546
:CHANGES-TO (FNS TEDIT)
:CHANGES-TO (VARS TEDITCOMS)
:PREVIOUS-DATE " 6-Jun-2022 00:36:53"
{DSK}<Users>kaplan>Local>medley3.5>working-medley>library>TEDIT.;40)
:PREVIOUS-DATE "14-Jul-2022 16:30:30"
{DSK}<users>kaplan>local>medley3.5>working-medley>library>tedit>TEDIT.;45)
(* ; "
@@ -16,11 +16,11 @@ Copyright (c) 1983-1993, 1995, 1999, 2018, 2021 by Venue & Xerox Corporation.
(PRETTYCOMPRINT TEDITCOMS)
(RPAQQ TEDITCOMS
[(FILES TEDITDCL)
[(FILES TEDIT-DCL)
(DECLARE%: EVAL@COMPILE DONTCOPY (CONSTANTS (\SCRATCHLEN 64))
(FILES (LOADCOMP)
TEDITDCL))
(FILES PCTREE TEXTOFD TEDITCOMMAND TEDITSCREEN TEDITABBREV TEDITLOOKS)
TEDIT-DCL))
(FILES TEDIT-PCTREE TEDIT-TEXTOFD TEDIT-COMMAND TEDIT-SCREEN TEDIT-ABBREV TEDIT-LOOKS)
(VARS (TEDIT.TERMSA.FONTS NIL)
(TEDIT.TENTATIVE NIL)
(TEDIT.DEFAULT.PROPS NIL)
@@ -49,8 +49,8 @@ Copyright (c) 1983-1993, 1995, 1999, 2018, 2021 by Venue & Xerox Corporation.
(COMS (* ; "Object-oriented editing")
(FNS TEDIT.INSERT.OBJECT TEDIT.EDIT.OBJECT TEDIT.FIND.OBJECT TEDIT.FIND.OBJECT.SUBTREE
TEDIT.PUT.OBJECT TEDIT.GET.OBJECT TEDIT.OBJECT.CHANGED))
(FILES TEDITFIND TEDITHISTORY TEDITFILE TEDITWINDOW TEDITSELECTION IMAGEOBJ TFBRAVO TEDITHCPY
TEDITPAGE TEDITMENU TEDITFNKEYS)
(FILES TEDIT-FIND TEDIT-HISTORY TEDIT-FILE TEDIT-WINDOW TEDIT-SELECTION IMAGEOBJ
TEDIT-TFBRAVO TEDIT-HCPY TEDIT-PAGE TEDIT-MENU TEDIT-FNKEYS)
(COMS (* ; "TEDIT Support information")
(E (SETQ TEDITSYSTEMDATE (DATE)))
(VARS TEDITSYSTEMDATE (TEDITSUPPORT "TEditSupport.PA"))
@@ -63,7 +63,7 @@ Copyright (c) 1983-1993, 1995, 1999, 2018, 2021 by Venue & Xerox Corporation.
(ADDVARS (PRINTFILETYPES (TEDIT (TEST \TEDIT.FORMATTEDP1)
(EXTENSION (TEDIT])
(FILESLOAD TEDITDCL)
(FILESLOAD TEDIT-DCL)
(DECLARE%: EVAL@COMPILE DONTCOPY
(DECLARE%: EVAL@COMPILE
@@ -75,10 +75,10 @@ Copyright (c) 1983-1993, 1995, 1999, 2018, 2021 by Venue & Xerox Corporation.
(FILESLOAD (LOADCOMP)
TEDITDCL)
TEDIT-DCL)
)
(FILESLOAD PCTREE TEXTOFD TEDITCOMMAND TEDITSCREEN TEDITABBREV TEDITLOOKS)
(FILESLOAD TEDIT-PCTREE TEDIT-TEXTOFD TEDIT-COMMAND TEDIT-SCREEN TEDIT-ABBREV TEDIT-LOOKS)
(RPAQQ TEDIT.TERMSA.FONTS NIL)
@@ -2260,15 +2260,15 @@ Copyright (c) 1983-1993, 1995, 1999, 2018, 2021 by Venue & Xerox Corporation.
NIL T])
)
(FILESLOAD TEDITFIND TEDITHISTORY TEDITFILE TEDITWINDOW TEDITSELECTION IMAGEOBJ TFBRAVO TEDITHCPY
TEDITPAGE TEDITMENU TEDITFNKEYS)
(FILESLOAD TEDIT-FIND TEDIT-HISTORY TEDIT-FILE TEDIT-WINDOW TEDIT-SELECTION IMAGEOBJ TEDIT-TFBRAVO
TEDIT-HCPY TEDIT-PAGE TEDIT-MENU TEDIT-FNKEYS)
(* ; "TEDIT Support information")
(RPAQQ TEDITSYSTEMDATE "22-Jun-2022 20:05:24")
(RPAQQ TEDITSYSTEMDATE "14-Jul-2022 17:10:16")
(RPAQ TEDITSUPPORT "TEditSupport.PA")
(DEFINEQ
@@ -2294,20 +2294,20 @@ Copyright (c) 1983-1993, 1995, 1999, 2018, 2021 by Venue & Xerox Corporation.
(PUTPROPS TEDIT COPYRIGHT ("Venue & Xerox Corporation" 1983 1984 1985 1986 1987 1988 1989 1990 1991
1992 1993 1995 1999 2018 2021))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (4349 118632 (\TEDIT2 4359 . 7110) (COERCETEXTOBJ 7112 . 15888) (TEDIT 15890 . 21156) (
TEDITSTRING 21158 . 21717) (TEDIT-SEE 21719 . 24308) (TEDIT.CHARWIDTH 24310 . 26334) (TEDIT.COPY 26336
. 34772) (TEDIT.DELETE 34774 . 35464) (TEDIT.DO.BLUEPENDINGDELETE 35466 . 38533) (TEDIT.INSERT 38535
. 44065) (TEDIT.KILL 44067 . 45624) (TEDIT.MAPLINES 45626 . 47025) (TEDIT.MAPPIECES 47027 . 47983) (
TEDIT.MOVE 47985 . 57769) (TEDIT.QUIT 57771 . 59771) (TEDIT.STRINGWIDTH 59773 . 60444) (TEDIT.\INSERT
60446 . 62471) (TEXTOBJ 62473 . 63598) (TEXTSTREAM 63600 . 65215) (\TEDIT.INCLUDE 65217 . 69117) (
\TEDIT.INSERT.PIECES 69119 . 79034) (\TEDIT.MOVE.PIECEMAPFN 79036 . 81115) (\TEDIT.OBJECT.SHOWSEL
81117 . 84746) (\TEDIT.RESTARTFN 84748 . 86743) (\TEDIT.CHARDELETE 86745 . 90707) (
\TEDIT.COPY.PIECEMAPFN 90709 . 93934) (\TEDIT.DELETE 93936 . 101454) (\TEDIT.DIFFUSE.PARALOOKS 101456
. 104220) (\TEDIT.FOREIGN.COPY? 104222 . 107949) (\TEDIT.QUIT 107951 . 111097) (\TEDIT.WORDDELETE
111099 . 115932) (\TEDIT1 115934 . 118630)) (118746 118862 (\CREATE.TEDIT.RESTART.MENU 118756 . 118860
)) (118961 122650 (PLCHAIN 118971 . 119245) (PRINTLINE 119247 . 122011) (SEEFILE 122013 . 122648)) (
122691 142334 (TEDIT.INSERT.OBJECT 122701 . 131778) (TEDIT.EDIT.OBJECT 131780 . 134036) (
TEDIT.FIND.OBJECT 134038 . 134931) (TEDIT.FIND.OBJECT.SUBTREE 134933 . 135739) (TEDIT.PUT.OBJECT
135741 . 137400) (TEDIT.GET.OBJECT 137402 . 140601) (TEDIT.OBJECT.CHANGED 140603 . 142332)) (142612
142975 (MAKETEDITFORM 142622 . 142973)))))
(FILEMAP (NIL (4418 118701 (\TEDIT2 4428 . 7179) (COERCETEXTOBJ 7181 . 15957) (TEDIT 15959 . 21225) (
TEDITSTRING 21227 . 21786) (TEDIT-SEE 21788 . 24377) (TEDIT.CHARWIDTH 24379 . 26403) (TEDIT.COPY 26405
. 34841) (TEDIT.DELETE 34843 . 35533) (TEDIT.DO.BLUEPENDINGDELETE 35535 . 38602) (TEDIT.INSERT 38604
. 44134) (TEDIT.KILL 44136 . 45693) (TEDIT.MAPLINES 45695 . 47094) (TEDIT.MAPPIECES 47096 . 48052) (
TEDIT.MOVE 48054 . 57838) (TEDIT.QUIT 57840 . 59840) (TEDIT.STRINGWIDTH 59842 . 60513) (TEDIT.\INSERT
60515 . 62540) (TEXTOBJ 62542 . 63667) (TEXTSTREAM 63669 . 65284) (\TEDIT.INCLUDE 65286 . 69186) (
\TEDIT.INSERT.PIECES 69188 . 79103) (\TEDIT.MOVE.PIECEMAPFN 79105 . 81184) (\TEDIT.OBJECT.SHOWSEL
81186 . 84815) (\TEDIT.RESTARTFN 84817 . 86812) (\TEDIT.CHARDELETE 86814 . 90776) (
\TEDIT.COPY.PIECEMAPFN 90778 . 94003) (\TEDIT.DELETE 94005 . 101523) (\TEDIT.DIFFUSE.PARALOOKS 101525
. 104289) (\TEDIT.FOREIGN.COPY? 104291 . 108018) (\TEDIT.QUIT 108020 . 111166) (\TEDIT.WORDDELETE
111168 . 116001) (\TEDIT1 116003 . 118699)) (118815 118931 (\CREATE.TEDIT.RESTART.MENU 118825 . 118929
)) (119030 122719 (PLCHAIN 119040 . 119314) (PRINTLINE 119316 . 122080) (SEEFILE 122082 . 122717)) (
122760 142403 (TEDIT.INSERT.OBJECT 122770 . 131847) (TEDIT.EDIT.OBJECT 131849 . 134105) (
TEDIT.FIND.OBJECT 134107 . 135000) (TEDIT.FIND.OBJECT.SUBTREE 135002 . 135808) (TEDIT.PUT.OBJECT
135810 . 137469) (TEDIT.GET.OBJECT 137471 . 140670) (TEDIT.OBJECT.CHANGED 140672 . 142401)) (142696
143059 (MAKETEDITFORM 142706 . 143057)))))
STOP

80
library/TEDITABBREV → library/tedit/TEDIT-ABBREV
View File

@@ -1,25 +1,19 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED " 6-Aug-2020 14:52:14" 
{DSK}<Users>kaplan>Local>medley3.5>lispcore>library>TEDITABBREV.;4 10066
changes to%: (VARS TEDITABBREVCOMS)
(FNS \TEDIT.TRY.ABBREV)
(FILECREATED "14-Jul-2022 16:53:34" 
{DSK}<users>kaplan>local>medley3.5>working-medley>library>tedit>TEDIT-ABBREV.;1 9767
previous date%: "25-Aug-94 10:52:43"
{DSK}<Users>kaplan>Local>medley3.5>lispcore>library>TEDITABBREV.;1)
:PREVIOUS-DATE "14-Jul-2022 11:08:10"
{DSK}<users>kaplan>local>medley3.5>working-medley>library>newtedit>TEDIT-ABBREV.;3)
(* ; "
Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1990, 1991, 1992, 1993, 1994, 2020 by Venue & Xerox Corporation. All rights reserved.
")
(PRETTYCOMPRINT TEDIT-ABBREVCOMS)
(PRETTYCOMPRINT TEDITABBREVCOMS)
(RPAQQ TEDITABBREVCOMS
[(FILES TEDITDCL)
(RPAQQ TEDIT-ABBREVCOMS
[(FILES TEDIT-DCL)
(DECLARE%: EVAL@COMPILE DONTCOPY (CONSTANTS (\SCRATCHLEN 64))
(FILES (LOADCOMP)
TEDITDCL))
TEDIT-DCL))
(FNS \TEDIT.ABBREV.EXPAND \TEDIT.EXPAND.DATE \TEDIT.TRY.ABBREV)
(GLOBALVARS TEDIT.ABBREVS)
(INITVARS (TEDIT.ABBREVS '(("b" . "357,146")
@@ -69,7 +63,7 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1990, 1991, 1992, 1993, 1994,
("DATE" . \TEDIT.EXPAND.DATE)
(">>DATE<<" . \TEDIT.EXPAND.DATE])
(FILESLOAD TEDITDCL)
(FILESLOAD TEDIT-DCL)
(DECLARE%: EVAL@COMPILE DONTCOPY
(DECLARE%: EVAL@COMPILE
@@ -81,12 +75,12 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1990, 1991, 1992, 1993, 1994,
(FILESLOAD (LOADCOMP)
TEDITDCL)
TEDIT-DCL)
)
(DEFINEQ
(\TEDIT.ABBREV.EXPAND
[LAMBDA (STREAM) (* ; "Edited 30-May-91 19:27 by jds")
[LAMBDA (STREAM) (* ; "Edited 30-May-91 19:27 by jds")
(* ; "Expand an abbvreviation")
(PROG ((TEXTOBJ (fetch (TEXTSTREAM TEXTOBJ) of STREAM))
SEL CH# (CH NIL)
@@ -97,33 +91,33 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1990, 1991, 1992, 1993, 1994,
(RIGHT (SUB1 (fetch (SELECTION CHLIM) of SEL)))
0))
[COND
((ZEROP (fetch (SELECTION DCH) of SEL)) (* ;
 "Point Selection, so use the character to the left")
((ZEROP (fetch (SELECTION DCH) of SEL)) (* ;
 "Point Selection, so use the character to the left")
(COND
((ZEROP CH#) (* ;
 "If we're off the front of the document, don't bother trying.")
 "If we're off the front of the document, don't bother trying.")
(RETURN)))
(\SETUPGETCH CH# TEXTOBJ)
[SETQ CH (MKSTRING (CHARACTER (\BIN STREAM]
(TEDIT.SETSEL STREAM CH# 1 'RIGHT))
(T (* ;
 "We have a selection that isn't just a caret. Use it.")
 "We have a selection that isn't just a caret. Use it.")
(SETQ CH (TEDIT.SEL.AS.STRING STREAM]
(SETQ EXPANSION (\TEDIT.TRY.ABBREV CH STREAM)) (* ; "Find the abbreviation's expansion --first try it as-is, then try the upper-case version to be safe.")
(SETQ EXPANSION (\TEDIT.TRY.ABBREV CH STREAM)) (* ; "Find the abbreviation's expansion --first try it as-is, then try the upper-case version to be safe.")
(COND
(EXPANSION (* ;
 "It exists, so insert it where the abbrev used to be")
 "It exists, so insert it where the abbrev used to be")
(replace (TEXTOBJ \INSERTPCVALID) of TEXTOBJ with NIL)
(* ; "Force it to abandon caching")
(SETQ OLDLOOKS (TEDIT.GET.LOOKS TEXTOBJ))
(TEDIT.DELETE TEXTOBJ SEL) (* ;
 "First, delete the thing being expanded.")
 "First, delete the thing being expanded.")
(TEDIT.INSERT STREAM EXPANSION SEL OLDLOOKS])
(\TEDIT.EXPAND.DATE
[LAMBDA (STREAM CH) (* ; "Edited 23-Feb-88 10:41 by jds")
(* ;; "Provide the date as the expansion for an abbreviation")
[LAMBDA (STREAM CH) (* ; "Edited 23-Feb-88 10:41 by jds")
(* ;; "Provide the date as the expansion for an abbreviation")
(PROG* ((DATE (\UNPACKDATE))
(YEAR (pop DATE))
@@ -135,13 +129,13 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1990, 1991, 1992, 1993, 1994,
" " DAY ", " YEAR])
(\TEDIT.TRY.ABBREV
[LAMBDA (ABBREV STREAM) (* ; "Edited 6-Aug-2020 14:41 by rmk:")
(* jds "11-Jul-85 12:46")
[LAMBDA (ABBREV STREAM) (* ; "Edited 6-Aug-2020 14:41 by rmk:")
(* jds "11-Jul-85 12:46")
(* ;;
 "Try expanding ABBREV as an abbreviation. Return the expansion; NIL = no such abbreviation.")
(* ;;
 "Try expanding ABBREV as an abbreviation. Return the expansion; NIL = no such abbreviation.")
(* ;; "RMK: Established that a character-code looking string (%"357,201%" or %"02FE%") or a number is a character code that converts to a character.")
(* ;; "RMK: Established that a character-code looking string (%"357,201%" or %"02FE%") or a number is a character code that converts to a character.")
(PROG (SEL CH# (CH NIL)
EXPANSION)
@@ -149,16 +143,16 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1990, 1991, 1992, 1993, 1994,
(SASSOC (U-CASE ABBREV)
TEDIT.ABBREVS)))
(* Find the abbreviation's expansion --first try it as-is, then try the
 upper-case version to be safe.)
(* Find the abbreviation's expansion --first try it as-is, then try the
 upper-case version to be safe.)
(RETURN (COND
(EXPANSION (* There's an expansion.
 Turn it into an insertable string.)
(EXPANSION (* There's an expansion.
 Turn it into an insertable string.)
(COND
[(STRINGP (CDR EXPANSION))
(* ;; "Could be a character code")
(* ;; "Could be a character code")
(COND
((SETQ CH (CHARCODE.DECODE (CDR EXPANSION)
@@ -167,14 +161,14 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1990, 1991, 1992, 1993, 1994,
(T (CDR EXPANSION]
((SMALLP (CDR EXPANSION))
(* ;; "Treat a number as a character code.")
(* ;; "Treat a number as a character code.")
(CHARACTER (CDR EXPANSION)))
((AND (LITATOM (CDR EXPANSION))
(GETD (CDR EXPANSION))) (* It's a function to be called.)
(GETD (CDR EXPANSION))) (* It's a function to be called.)
(APPLY* (CDR EXPANSION)
STREAM CH))
(T (* Anything else is a form to EVAL.)
(T (* Anything else is a form to EVAL.)
(EVAL (CDR EXPANSION])
)
(DECLARE%: DOEVAL@COMPILE DONTCOPY
@@ -229,9 +223,7 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1990, 1991, 1992, 1993, 1994,
(" " . "357,41")
("DATE" . \TEDIT.EXPAND.DATE)
(">>DATE<<" . \TEDIT.EXPAND.DATE)))
(PUTPROPS TEDITABBREV COPYRIGHT ("Venue & Xerox Corporation" 1983 1984 1985 1986 1987 1988 1990 1991
1992 1993 1994 2020))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (3480 8598 (\TEDIT.ABBREV.EXPAND 3490 . 5811) (\TEDIT.EXPAND.DATE 5813 . 6458) (
\TEDIT.TRY.ABBREV 6460 . 8596)))))
(FILEMAP (NIL (3281 8423 (\TEDIT.ABBREV.EXPAND 3291 . 5638) (\TEDIT.EXPAND.DATE 5640 . 6273) (
\TEDIT.TRY.ABBREV 6275 . 8421)))))
STOP

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

Binary file not shown.

359
library/tedit/TEDIT-CHAT Normal file
View File

@@ -0,0 +1,359 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "14-Jul-2022 16:55:43" 
{DSK}<users>kaplan>local>medley3.5>working-medley>library>tedit>TEDIT-CHAT.;1 21593
:PREVIOUS-DATE "14-Jul-2022 10:40:06"
{DSK}<users>kaplan>local>medley3.5>working-medley>library>newtedit>TEDIT-CHAT.;1)
(PRETTYCOMPRINT TEDIT-CHATCOMS)
(RPAQQ TEDIT-CHATCOMS
((COMS (* ; "character routines")
(FNS TEDITCHAT.CHARFN \TEXTSTREAMBOUT))
(COMS (FNS TEDITSTREAM.INIT TEDITCHAT.MENUFN))
(COMS (* ; "TEDIT update routines")
(FNS TEDIT.DISPLAYTEXT))
(GLOBALVARS TEDITCHAT.MENU CHAT.DRIVERTYPES CHAT.DISPLAYTYPES)
(VARS TEDITCHAT.MENUITEMS (TEDITCHAT.MENU))
(ADDVARS (CHAT.DRIVERTYPES (TEDIT TEDITCHAT.CHARFN NILL)))
(DECLARE%: EVAL@COMPILE DONTCOPY (FILES (SOURCE)
CHATDECLS))))
(* ; "character routines")
(DEFINEQ
(TEDITCHAT.CHARFN
[LAMBDA (CH CHAT.STATE) (* ; "Edited 12-Jun-90 18:00 by mitani")
(LET* [(TEXTSTREAM (fetch (CHAT.STATE TEXTSTREAM) of CHAT.STATE))
(SEL (fetch (TEXTOBJ SEL) of (TEXTOBJ TEXTSTREAM]
(\CARET.DOWN (fetch (TEXTOBJ DS) of (TEXTOBJ TEXTSTREAM)))
(SELCHARQ CH
(BS (\TEDIT.CHARDELETE TEXTSTREAM "" SEL)
[MOVETO (fetch X0 of SEL)
(fetch Y0 of SEL)
(CAR (fetch (TEXTOBJ \WINDOW) of (TEXTOBJ TEXTSTREAM])
(LF NIL)
(BOUT TEXTSTREAM CH])
(\TEXTSTREAMBOUT
[LAMBDA (STREAM BYTE) (* ; "Edited 28-Mar-94 15:29 by jds")
(* ;; "Do BOUT to a text stream, which is an insertion at the caret.")
(PROG ((TEXTOBJ (fetch (TEXTSTREAM TEXTOBJ) of STREAM))
CH# WINDOW TEXTLEN PS PC PSTR OFFST SEL)
(SETQ TEXTLEN (fetch (TEXTOBJ TEXTLEN) of TEXTOBJ))
(SETQ WINDOW (fetch (TEXTOBJ \WINDOW) of TEXTOBJ))
(SETQ SEL (fetch (TEXTOBJ SEL) of TEXTOBJ))
(COND
((NOT (CAR (fetch L1 of SEL)))
(RETURN))) (* ;
 "Return if caret out of bounds, ie, user scrolls past end of text")
(SETQ CH# (fetch CH# of SEL))
(AND WINDOW (\TEDIT.MARK.LINES.DIRTY TEXTOBJ CH# CH#))
(COND
((IEQP BYTE 13)
(\INSERTCR BYTE CH# TEXTOBJ))
(T (\INSERTCH BYTE CH# TEXTOBJ)))
(AND WINDOW
(PROG ((THISLINE (fetch (TEXTOBJ THISLINE) of TEXTOBJ))
EOLFLAG CHORIG CHWIDTH OXLIM OCHLIM OCR\END PREVSPACE FIXEDLINE NEXTLINE LINES
NEWLINEFLG DX PREVLINE SAVEWIDTH OFLOWFN OLHEIGHT DY TABSEEN IMAGECACHE CURLINE
FONT (L1 (CAR (fetch L1 of SEL)))
(LN (CAR (fetch LN of SEL)))
(LOOKS (\TEDIT.APPLY.STYLES (fetch (TEXTOBJ CARETLOOKS) of TEXTOBJ)
(fetch (TEXTOBJ \INSERTPC) of TEXTOBJ)
TEXTOBJ)))
(add (fetch CH# of SEL)
1) (* ;
 "These must be here, since SELs are valid even without a window.")
(replace CHLIM of SEL with (fetch CH# of SEL))
(replace POINT of SEL with 'LEFT)
(replace DCH of SEL with 0)
(replace SELKIND of SEL with 'CHAR)
(SETQ CURLINE L1)
(add (fetch CHARLIM of CURLINE)
1)
(add (fetch CHARTOP of CURLINE)
1)
(SETQ FONT (fetch CLFONT of LOOKS))
(DSPFONT FONT (CAR WINDOW))
[COND
[(OR (IGREATERP (PLUS (fetch X0 of SEL)
(CHARWIDTH BYTE FONT))
(IDIFFERENCE (fetch (TEXTOBJ WRIGHT) of TEXTOBJ)
8))
(IEQP BYTE (CHARCODE CR))) (* ;
 "gone off the edge of the line reformat and add new line")
(TEDIT.UPDATE.SCREEN TEXTOBJ)
(\FIXSEL SEL TEXTOBJ (CAR WINDOW))
(SETQ L1 (CAR (fetch L1 of SEL)))
(SETQ LN (CAR (fetch LN of SEL)))
(COND
([OR (NULL (SELECTQ (fetch POINT of SEL)
(LEFT L1)
(RIGHT LN)
NIL))
(ILEQ (SELECTQ (fetch POINT of SEL)
(LEFT (fetch YBOT of L1))
(RIGHT (fetch YBOT of LN))
0)
(fetch (REGION BOTTOM) of (DSPCLIPPINGREGION NIL (CAR WINDOW]
(* ;
 "The caret is off-window in the selection window. Need to scroll it up so the caret is visible.")
(while (ILESSP (fetch Y0 of SEL)
(fetch (TEXTOBJ WBOTTOM) of TEXTOBJ))
do (* ;
 "The caret just went off-screen. Move it up some.")
(replace (TEXTOBJ EDITOPACTIVE) of TEXTOBJ with NIL)
(SCROLLW (CAR WINDOW)
0
(LLSH (COND
[(SELECTQ (fetch POINT of SEL)
(LEFT L1)
(RIGHT LN)
NIL)
(fetch LHEIGHT
of (SELECTQ (fetch POINT of SEL)
(LEFT L1)
(RIGHT LN)
(SHOULDNT]
(T 12))
1]
(T (TEDIT.DISPLAYTEXT TEXTOBJ BYTE (CHARWIDTH BYTE FONT)
CURLINE
(fetch X0 of SEL)
(CAR WINDOW)
SEL) (* ;
 "Print out the character on the screen")
(add (fetch X0 of SEL)
(CHARWIDTH BYTE FONT))
(* ;; "And move the selection's notion of our X position to the right to account for that character's width.")
(replace XLIM of SEL with (fetch X0 of SEL]
(* ;;; "Fix up the TEXTSTREAM so that the FILEPTR looks like it ought to after the BOUT, even though we've been updating the screen (which usually moves the fileptr....)")
[SETQ PS (ffetch (PIECE PSTR) of (SETQ PC (fetch (TEXTOBJ \INSERTPC)
of TEXTOBJ]
(* ;
 "This piece resides in a STRING. Because it's newly 'typed' material.")
(replace (TEXTSTREAM PIECE) of STREAM with PC)
(* ;
 "Remember the current piece for others.")
(* ; "And which number piece this is.")
(freplace (STREAM CPPTR) of STREAM with (ADDBASE (ffetch (STRINGP BASE)
of PS)
(LRSH (SETQ OFFST
(ffetch (STRINGP OFFST)
of PS))
1)))
(* ;
 "Pointer to the actual characters in the string (allowing for substrings.)")
(freplace (STREAM CPAGE) of STREAM with 0)
(freplace (STREAM COFFSET) of STREAM with (IPLUS (freplace (TEXTSTREAM PCSTARTCH
) of STREAM
with (LOGAND 1 OFFST))
(fetch (TEXTOBJ \INSERTLEN)
of TEXTOBJ)))
(freplace (TEXTSTREAM PCSTARTPG) of STREAM with 0)
(* ;
 "Page # within the 'file' where this piece starts")
(freplace (STREAM CBUFSIZE) of STREAM with (fetch (STREAM COFFSET) of STREAM))
(freplace (STREAM EPAGE) of STREAM with 1)
(freplace (TEXTSTREAM CHARSLEFT) of STREAM with 0)
(* ;
 "We're, perforce, at the end of the piece.")
(freplace (TEXTSTREAM REALFILE) of STREAM with NIL)
(* ; "We're not on a file....")
])
)
(DEFINEQ
(TEDITSTREAM.INIT
[LAMBDA (WINDOW MENUFN) (* ; "Edited 12-Jun-90 18:01 by mitani")
(* ;; "Initialize and return TEDIT TEXTSTREAM")
(PROG* ((TEXTSTREAM (OPENTEXTSTREAM NIL WINDOW NIL NIL))
(TEXTOBJ (TEXTOBJ TEXTSTREAM))) (* ;
 "force shift select typein to be put in keyboard buffer")
(TEXTPROP TEXTSTREAM 'COPYBYBKSYSBUF T)
(replace (STREAM STRMBOUTFN) of TEXTSTREAM with '\TEXTSTREAMBOUT)
(replace SET of (fetch (TEXTOBJ SEL) of TEXTOBJ) with T)
[replace L1 of (fetch (TEXTOBJ SEL) of TEXTOBJ) with (LIST (fetch DESC
of (fetch (TEXTOBJ THISLINE)
of TEXTOBJ]
(* ;
 "hookup middle button menu instead of TEDIT menu")
(WINDOWPROP WINDOW 'TEDIT.TITLEMENUFN MENUFN)
(RETURN TEXTSTREAM])
(TEDITCHAT.MENUFN
[LAMBDA (WINDOW) (* || "20-Oct-86 15:03")
(DECLARE (GLOBALVARS TEDITCHAT.MENU)
(SPECVARS WINDOW STATE)) (* MIDDLEBUTTON)
(PROG ((STATE (WINDOWPROP WINDOW 'CHATSTATE))
COMMAND)
[COND
((NOT STATE) (* No Connection here;
 try to reestablish)
(RETURN (COND
((LASTMOUSESTATE MIDDLE)
(CHAT.RECONNECT WINDOW))
(T (TOTOPW WINDOW]
(replace (CHAT.STATE HELD) of STATE with T)
(\CHECKCARET WINDOW)
(SELECTQ [SETQ COMMAND (MENU (OR TEDITCHAT.MENU (SETQ TEDITCHAT.MENU
(create MENU
ITEMS _ TEDITCHAT.MENUITEMS]
(Close (replace (CHAT.STATE RUNNING?) of STATE with 'CLOSE)
(* Ask CHAT.TYPEIN to shut things
 down.)
)
(New (replace (CHAT.STATE RUNNING?) of STATE with 'CLOSE)
(WINDOWPROP WINDOW 'KEEPCHAT 'NEW))
(Suspend (replace (CHAT.STATE RUNNING?) of STATE with 'CLOSE)
(WINDOWPROP WINDOW 'KEEPCHAT T))
(Freeze (* Leave in HELD state)
(RETURN))
(NIL)
(APPLY* COMMAND STATE WINDOW))
(replace (CHAT.STATE HELD) of STATE with NIL])
)
(* ; "TEDIT update routines")
(DEFINEQ
(TEDIT.DISPLAYTEXT
[LAMBDA (TEXTOBJ CH CHWIDTH LINE XPOINT DS SEL) (* ; "Edited 12-Jun-90 18:01 by mitani")
(* This function does the actual
 displaying of typed-in text on the
 edit window.)
(PROG ((LOOKS (\TEDIT.APPLY.STYLES (fetch (TEXTOBJ CARETLOOKS) of TEXTOBJ)
(fetch (TEXTOBJ \INSERTPC) of TEXTOBJ)
TEXTOBJ))
(TERMSA (fetch (TEXTOBJ TXTTERMSA) of TEXTOBJ))
DY FONT)
(MOVETO XPOINT (IPLUS (fetch YBASE of LINE)
(OR (fetch CLOFFSET of LOOKS)
0))
DS) (* Set the display stream position)
(COND
[TERMSA (* Special terminal table for
 controlling character display.
 Use it.)
(RESETLST
(RESETSAVE \PRIMTERMSA TERMSA)
(replace (TEXTSTREAM REALFILE) of (fetch (TEXTOBJ STREAMHINT) of TEXTOBJ)
with DS)
[COND
[(STRINGP CH)
(for CHAR instring CH
do (SELCHARQ CHAR
(TAB (* Put down white)
(BITBLT NIL 0 0 DS XPOINT (fetch YBOT of LINE)
36
(fetch LHEIGHT of LINE)
'TEXTURE
'REPLACE WHITESHADE)
(RELMOVETO 36 0 DS))
(CR (BITBLT NIL 0 0 DS XPOINT (fetch YBOT of LINE)
(IMAX 6 (CHARWIDTH CHAR FONT))
(fetch LHEIGHT of LINE)
'TEXTURE
'REPLACE WHITESHADE))
(\DSPPRINTCHAR (fetch (TEXTOBJ STREAMHINT) of TEXTOBJ)
CHAR]
(T (SELCHARQ CH
(TAB (* Put down white)
(BITBLT NIL 0 0 DS XPOINT (fetch YBOT of LINE)
36
(fetch LHEIGHT of LINE)
'TEXTURE
'REPLACE WHITESHADE)
(RELMOVETO 36 0 DS))
(CR (BITBLT NIL 0 0 DS XPOINT (fetch YBOT of LINE)
(IMAX 6 (CHARWIDTH CH FONT))
(fetch LHEIGHT of LINE)
'TEXTURE
'REPLACE WHITESHADE))
(\DSPPRINTCHAR (fetch (TEXTOBJ STREAMHINT) of TEXTOBJ)
CH])]
(T (* No special handling;
 just use native character codes)
(COND
[(STRINGP CH)
(for CHAR instring CH do (SELCHARQ CHAR
(TAB (* Put down white)
(BITBLT NIL 0 0 DS (DSPXPOSITION NIL DS)
(fetch YBOT of LINE)
36
(fetch LHEIGHT of LINE)
'TEXTURE
'REPLACE WHITESHADE)
(RELMOVETO 36 0 DS))
(CR (BITBLT NIL 0 0 DS (DSPXPOSITION NIL DS)
(fetch YBOT of LINE)
(IMAX 6 (CHARWIDTH CHAR FONT))
(fetch LHEIGHT of LINE)
'TEXTURE
'REPLACE WHITESHADE))
(BLTCHAR CHAR DS]
(T (SELCHARQ CH
(TAB (* Put down white)
(BITBLT NIL 0 0 DS (DSPXPOSITION NIL DS)
(fetch YBOT of LINE)
36
(fetch LHEIGHT of LINE)
'TEXTURE
'REPLACE WHITESHADE)
(RELMOVETO 36 0 DS))
(CR (* Blank out the CR's width.)
(BITBLT NIL 0 0 DS (DSPXPOSITION NIL DS)
(fetch YBOT of LINE)
(IMAX 6 (CHARWIDTH CH FONT))
(fetch LHEIGHT of LINE)
'TEXTURE
'REPLACE WHITESHADE))
(BLTCHAR CH DS])
)
(DECLARE%: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS TEDITCHAT.MENU CHAT.DRIVERTYPES CHAT.DISPLAYTYPES)
)
(RPAQQ TEDITCHAT.MENUITEMS
((Close 'Close "Closes the connection and returns")
(Suspend 'Suspend "Closes the connection but leaves window up")
(New 'New "Closes this connection and prompts for a new host")
(Freeze 'Freeze "Holds typeout in this window until you bug it again")
("Dribble" (FUNCTION CHAT.TYPESCRIPT)
"Starts a typescript of window typeout")
("Input" (FUNCTION CHAT.TAKE.INPUT)
"Allows input from a file")
("Option" (FUNCTION DO.CHAT.OPTION)
"Do protocol specific option")))
(RPAQQ TEDITCHAT.MENU NIL)
(ADDTOVAR CHAT.DRIVERTYPES (TEDIT TEDITCHAT.CHARFN NILL))
(DECLARE%: EVAL@COMPILE DONTCOPY
(FILESLOAD (SOURCE)
CHATDECLS)
)
(DECLARE%: DONTCOPY
(FILEMAP (NIL (1070 11167 (TEDITCHAT.CHARFN 1080 . 1769) (\TEXTSTREAMBOUT 1771 . 11165)) (11168 14251
(TEDITSTREAM.INIT 11178 . 12411) (TEDITCHAT.MENUFN 12413 . 14249)) (14290 20705 (TEDIT.DISPLAYTEXT
14300 . 20703)))))
STOP

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

Binary file not shown.

660
library/TEDITCOMMAND → library/tedit/TEDIT-COMMAND
View File

@@ -1,24 +1,19 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "20-Apr-2018 08:07:35" 
{DSK}<Users>kaplan>Local>medley3.5>lispcore>library>TEDITCOMMAND.;2 50383
changes to%: (FNS \TEDIT.READTABLE \TEDIT.COMMAND.LOOP TEDIT.GETFUNCTION TEDIT.SETFUNCTION)
(FILECREATED "14-Jul-2022 16:55:44" 
{DSK}<users>kaplan>local>medley3.5>working-medley>library>tedit>TEDIT-COMMAND.;1 48554
previous date%: "25-Aug-94 10:52:51"
{DSK}<Users>kaplan>Local>medley3.5>lispcore>library>TEDITCOMMAND.;1)
:PREVIOUS-DATE "14-Jul-2022 11:08:09"
{DSK}<users>kaplan>local>medley3.5>working-medley>library>newtedit>TEDIT-COMMAND.;2)
(* ; "
Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1990, 1991, 1992, 1994, 2018 by Venue & Xerox Corporation. All rights reserved.
")
(PRETTYCOMPRINT TEDIT-COMMANDCOMS)
(PRETTYCOMPRINT TEDITCOMMANDCOMS)
(RPAQQ TEDITCOMMANDCOMS
((FILES TEDITDCL)
(RPAQQ TEDIT-COMMANDCOMS
((FILES TEDIT-DCL)
(DECLARE%: EVAL@COMPILE DONTCOPY (CONSTANTS (\SCRATCHLEN 64))
(FILES (LOADCOMP)
TEDITDCL))
TEDIT-DCL))
(FNS \TEDIT.INSERT.TTY.BUFFER \TEDIT.INTERRUPT.SETUP \TEDIT.MARKACTIVE \TEDIT.MARKINACTIVE
\PNC \TEDIT.COMMAND.LOOP \TEDIT.COMMAND.RESET.SETUP)
[INITVARS (TEDIT.INTERRUPTS '((2 BREAK)
@@ -32,7 +27,7 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1990, 1991, 1992, 1994, 2018 b
(TEDIT.BLUEPENDINGDELETE NIL))
(GLOBALVARS TEDIT.COPY.PENDING TEDIT.COPYLOOKS.PENDING TEDIT.MOVE.PENDING TEDIT.DEL.PENDING
TEDIT.BLUEPENDINGDELETE TEDIT.INTERRUPTS)
(COMS (* ; "Read-table Utilities")
(COMS (* ; "Read-table Utilities")
(FNS \TEDIT.READTABLE \TEDIT.WORDBOUND.READTABLE TEDIT.GETSYNTAX TEDIT.SETSYNTAX
TEDIT.GETFUNCTION TEDIT.SETFUNCTION TEDIT.WORDGET TEDIT.WORDSET)
[DECLARE%: DONTEVAL@LOAD DOCOPY (VARS (TEDIT.READTABLE (\TEDIT.READTABLE))
@@ -41,7 +36,7 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1990, 1991, 1992, 1994, 2018 b
]
(GLOBALVARS TEDIT.READTABLE TEDIT.WORDBOUND.READTABLE))))
(FILESLOAD TEDITDCL)
(FILESLOAD TEDIT-DCL)
(DECLARE%: EVAL@COMPILE DONTCOPY
(DECLARE%: EVAL@COMPILE
@@ -53,58 +48,57 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1990, 1991, 1992, 1994, 2018 b
(FILESLOAD (LOADCOMP)
TEDITDCL)
TEDIT-DCL)
)
(DEFINEQ
(\TEDIT.INSERT.TTY.BUFFER
[LAMBDA (SCRATCH PASS TEXTOBJ SEL) (* ; "Edited 23-Feb-88 11:11 by jds")
(* ;; "OBSOLETE 2/9/86 ?? JDS")
(* ;; "(PROG ((TLEN (fetch (STRINGP OFFST) of SCRATCH))) (COND ((NOT (ZEROP TLEN)) (* If there are typed-ahead characters cached, insert them in the text object and clear the cache.) (replace (STRINGP OFFST) of SCRATCH with 0) (replace (STRINGP LENGTH) of SCRATCH with \SCRATCHLEN) (replace (STRINGP LENGTH) of PASS with TLEN) (TEDIT.\INSERT PASS SEL TEXTOBJ BLANKSEEN CRSEEN))))")
[LAMBDA (SCRATCH PASS TEXTOBJ SEL) (* ; "Edited 23-Feb-88 11:11 by jds")
(* ;; "OBSOLETE 2/9/86 ?? JDS")
(* ;; "(PROG ((TLEN (fetch (STRINGP OFFST) of SCRATCH))) (COND ((NOT (ZEROP TLEN)) (* If there are typed-ahead characters cached, insert them in the text object and clear the cache.) (replace (STRINGP OFFST) of SCRATCH with 0) (replace (STRINGP LENGTH) of SCRATCH with \SCRATCHLEN) (replace (STRINGP LENGTH) of PASS with TLEN) (TEDIT.\INSERT PASS SEL TEXTOBJ BLANKSEEN CRSEEN))))")
(HELP])
(\TEDIT.INTERRUPT.SETUP
(LAMBDA (PROC FORCEOFF) (* jds "12-Sep-84 15:36")
(* Disarm any inconvenient interrupts, and save re-arming info on the window.)
(PROG ((TEXTOBJ (AND (PROCESSPROP PROC 'WINDOW)
[LAMBDA (PROC FORCEOFF) (* jds "12-Sep-84 15:36")
(* Disarm any inconvenient interrupts,
 and save re-arming info on the window.)
[PROG [(TEXTOBJ (AND (PROCESSPROP PROC 'WINDOW)
(WINDOWPROP (PROCESSPROP PROC 'WINDOW)
'TEXTOBJ)
(TEXTOBJ (PROCESSPROP PROC 'WINDOW)))))
(TEXTOBJ (PROCESSPROP PROC 'WINDOW]
(UNINTERRUPTABLY
(COND
[COND
((AND FORCEOFF (PROCESSPROP PROC 'TEDIT.INTERRUPTS))
(* There are disarmed interrupts;
 re-arm them.)
(RESET.INTERRUPTS (PROCESSPROP PROC 'TEDIT.INTERRUPTS))
(PROCESSPROP PROC 'TEDIT.INTERRUPTS NIL))
((AND (NOT FORCEOFF)
(NOT (PROCESSPROP PROC 'TEDIT.INTERRUPTS)))
([AND (NOT FORCEOFF)
(NOT (PROCESSPROP PROC 'TEDIT.INTERRUPTS]
(* There aren't any interrupts
 disarmed; go do it.)
(PROCESSPROP PROC 'TEDIT.INTERRUPTS (RESET.INTERRUPTS
(OR (AND TEXTOBJ (TEXTPROP TEXTOBJ
'INTERRUPTS))
TEDIT.INTERRUPTS)
T))))))
PROC))
T])]
PROC])
(\TEDIT.MARKACTIVE
[LAMBDA (TEXTOBJ) (* ; "Edited 12-Jun-90 18:04 by mitani")
[LAMBDA (TEXTOBJ) (* ; "Edited 12-Jun-90 18:04 by mitani")
(replace (TEXTOBJ EDITOPACTIVE) of TEXTOBJ with T)
TEXTOBJ])
(\TEDIT.MARKINACTIVE
[LAMBDA (TEXTOBJ) (* ; "Edited 12-Jun-90 18:04 by mitani")
[LAMBDA (TEXTOBJ) (* ; "Edited 12-Jun-90 18:04 by mitani")
(replace (TEXTOBJ EDITOPACTIVE) of TEXTOBJ with NIL)
TEXTOBJ])
(\PNC
(LAMBDA (CH STR) (* jds " 7-JUN-82 14:03")
[LAMBDA (CH STR) (* jds " 7-JUN-82 14:03")
(PROG ((LEN (fetch (STRINGP LENGTH) of STR))
(OFFST (fetch (STRINGP OFFST) of STR)))
(COND
@@ -114,12 +108,12 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1990, 1991, 1992, 1994, 2018 b
(\PUTBASEBYTE (fetch (STRINGP BASE) of STR)
OFFST CH)
(replace (STRINGP OFFST) of STR with (ADD1 OFFST))
(replace (STRINGP LENGTH) of STR with (SUB1 LEN))))))))
(replace (STRINGP LENGTH) of STR with (SUB1 LEN)))])
(\TEDIT.COMMAND.LOOP
[LAMBDA (STREAM RTBL) (* ; "Edited 30-May-91 19:33 by jds")
[LAMBDA (STREAM RTBL) (* ; "Edited 30-May-91 19:33 by jds")
(* ;; "Main command loop for the TEDIT editor. Includes keyboard polling and command dispatch")
(* ;; "Main command loop for the TEDIT editor. Includes keyboard polling and command dispatch")
(PROG ((TEXTOBJ (COND
((type? STREAM STREAM)
@@ -130,15 +124,15 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1990, 1991, 1992, 1994, 2018 b
(SETQ SEL (fetch (TEXTOBJ SEL) of TEXTOBJ))
(SETQ WINDOW (fetch (TEXTOBJ \WINDOW) of TEXTOBJ))
(SETQ LINES (fetch (TEXTOBJ LINES) of TEXTOBJ))
(SETQ IPASSSTRING (SUBSTRING ISCRSTRING 1)) (* ; "Used inside \INSERT\TTY\BUFFER")
(SETQ IPASSSTRING (SUBSTRING ISCRSTRING 1)) (* ; "Used inside \INSERT\TTY\BUFFER")
(SETQ RTBL (OR RTBL (fetch (TEXTOBJ TXTRTBL) of TEXTOBJ)
TEDIT.READTABLE)) (* ;
 "Used to derive command characters from type-in")
TEDIT.READTABLE)) (* ;
 "Used to derive command characters from type-in")
(for WW inside WINDOW do (WINDOWPROP WW 'PROCESS (THIS.PROCESS)))
(* ; "And the window to this process")
(while (NOT (TTY.PROCESSP)) do (* ;
 "Wait until we really have the TTY before proceeding.")
(DISMISS 250))
(* ; "And the window to this process")
(while (NOT (TTY.PROCESSP)) do (* ;
 "Wait until we really have the TTY before proceeding.")
(DISMISS 250))
(RESETLST
(RESETSAVE (\TEDIT.COMMAND.RESET.SETUP (LIST TEXTOBJ WINDOW)
T))
@@ -160,79 +154,78 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1990, 1991, 1992, 1994, 2018 b
(while (NOT (fetch (TEXTOBJ EDITFINISHEDFLG) of TEXTOBJ))
do
(PROGN
(\WAITFORSYSBUFP 25) (* ; "Await type-in or mouse action")
(while (OR TEDIT.SELPENDING (fetch (TEXTOBJ EDITOPACTIVE)
of TEXTOBJ))
do (* ;
 "Don't do anything while he's selecting or one of the lock-out ops is active.")
[COND
((EQ TEDIT.SELPENDING TEXTOBJ)
(* ;
 "(OR (EQ TEDIT.SELPENDING TEXTOBJ) (fetch TCUP of (fetch CARET of TEXTOBJ)))")
(* ;
 "If this TEdit is the one being selected in, or the caret is explicitly visible, flash it")
(TEDIT.FLASHCARET (fetch (TEXTOBJ CARET) of TEXTOBJ]
(BLOCK))
(\WAITFORSYSBUFP 25) (* ; "Await type-in or mouse action")
(while (OR TEDIT.SELPENDING (fetch (TEXTOBJ EDITOPACTIVE) of TEXTOBJ))
do (* ;
 "Don't do anything while he's selecting or one of the lock-out ops is active.")
[COND
((EQ TEDIT.SELPENDING TEXTOBJ)
(* ;
 "(OR (EQ TEDIT.SELPENDING TEXTOBJ) (fetch TCUP of (fetch CARET of TEXTOBJ)))")
(* ;
 "If this TEdit is the one being selected in, or the caret is explicitly visible, flash it")
(TEDIT.FLASHCARET (fetch (TEXTOBJ CARET) of TEXTOBJ]
(BLOCK))
[COND
((fetch (TEXTOBJ EDITFINISHEDFLG) of TEXTOBJ))
(T (COND
((fetch (TEXTOBJ TXTNEEDSUPDATE) of TEXTOBJ)
(* ;
 "We got here somehow with the window not in sync with the text. Run an update.")
(* ;
 "We got here somehow with the window not in sync with the text. Run an update.")
(\SHOWSEL SEL NIL NIL)
(TEDIT.UPDATE.SCREEN TEXTOBJ NIL T)
(\FIXSEL SEL TEXTOBJ)
(\SHOWSEL SEL NIL T)))
(TEDIT.FLASHCARET (fetch (TEXTOBJ CARET) of TEXTOBJ))
(* ;
 "Flash the caret periodically (BUT not while we're here only to cleanup and quit.)")
(* ;
 "Flash the caret periodically (BUT not while we're here only to cleanup and quit.)")
(replace (TEXTOBJ EDITOPACTIVE) of TEXTOBJ with T)
(* ;
 "Before starting to work, note that we're doing something.")
(* ;
 "Before starting to work, note that we're doing something.")
(AND LOOPFN (ERSETQ (APPLY* LOOPFN STREAM)))
(* ;
 "If the guy wants control during the loop, give it to him.")
(* ; "Process any pending selections")
(* ;
 "If the guy wants control during the loop, give it to him.")
(* ; "Process any pending selections")
[COND
(TEDIT.COPY.PENDING (* ;
 "Have to copy the shifted SEL to caret.")
(TEDIT.COPY.PENDING (* ;
 "Have to copy the shifted SEL to caret.")
(SETQ TEDIT.COPY.PENDING NIL)
(\COPYSEL TEDIT.SHIFTEDSELECTION (fetch (TEXTOBJ
SHIFTEDSEL)
(\COPYSEL TEDIT.SHIFTEDSELECTION (fetch (TEXTOBJ
SHIFTEDSEL
)
of TEXTOBJ))
(ERSETQ (TEDIT.COPY (fetch (TEXTOBJ SHIFTEDSEL)
of TEXTOBJ)
(fetch (TEXTOBJ SEL) of TEXTOBJ)))
(replace (SELECTION SET) of
TEDIT.SHIFTEDSELECTION
(replace (SELECTION SET) of TEDIT.SHIFTEDSELECTION
with NIL)
(replace (SELECTION L1) of TEDIT.SHIFTEDSELECTION
with NIL)
(replace (SELECTION LN) of TEDIT.SHIFTEDSELECTION
with NIL)
(\COPYSEL TEDIT.SHIFTEDSELECTION (fetch (TEXTOBJ
SHIFTEDSEL)
of TEXTOBJ)))
(TEDIT.COPYLOOKS.PENDING(* ;
 "Have to copy the shifted SEL to caret.")
(SETQ TEDIT.COPYLOOKS.PENDING NIL)
(\COPYSEL TEDIT.COPYLOOKSSELECTION (fetch (TEXTOBJ
(\COPYSEL TEDIT.SHIFTEDSELECTION (fetch (TEXTOBJ
SHIFTEDSEL
)
of TEXTOBJ)))
(TEDIT.COPYLOOKS.PENDING(* ;
 "Have to copy the shifted SEL to caret.")
(SETQ TEDIT.COPYLOOKS.PENDING NIL)
(\COPYSEL TEDIT.COPYLOOKSSELECTION (fetch (TEXTOBJ SHIFTEDSEL)
of TEXTOBJ))
[ERSETQ (COND
((EQ 'PARA (fetch (SELECTION SELKIND)
of (fetch (TEXTOBJ SHIFTEDSEL)
of TEXTOBJ)))
(* ;
 "copy the paragraph looks, since the source selection type was paragraph")
(TEDIT.COPY.PARALOOKS TEXTOBJ (fetch
(TEXTOBJ SHIFTEDSEL)
of TEXTOBJ)))
(* ;
 "copy the paragraph looks, since the source selection type was paragraph")
(TEDIT.COPY.PARALOOKS TEXTOBJ (fetch (TEXTOBJ
SHIFTEDSEL)
of TEXTOBJ)
(fetch (TEXTOBJ SEL) of TEXTOBJ)))
(T (* ; "copy the character looks")
(TEDIT.COPY.LOOKS TEXTOBJ (fetch (TEXTOBJ
SHIFTEDSEL)
(T (* ; "copy the character looks")
(TEDIT.COPY.LOOKS TEXTOBJ (fetch (TEXTOBJ
SHIFTEDSEL
)
of TEXTOBJ)
(fetch (TEXTOBJ SEL) of TEXTOBJ]
(\SHOWSEL (fetch (TEXTOBJ SHIFTEDSEL) of TEXTOBJ)
@@ -243,19 +236,15 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1990, 1991, 1992, 1994, 2018 b
with NIL)
(replace (SELECTION LN) of TEDIT.COPYLOOKSSELECTION
with NIL)
(\COPYSEL TEDIT.COPYLOOKSSELECTION (fetch (TEXTOBJ
SHIFTEDSEL
)
(\COPYSEL TEDIT.COPYLOOKSSELECTION (fetch (TEXTOBJ SHIFTEDSEL)
of TEXTOBJ)))
(TEDIT.MOVE.PENDING (* ;
 "Have to move the ctrl-shift SEL to caret.")
(TEDIT.MOVE.PENDING (* ;
 "Have to move the ctrl-shift SEL to caret.")
(SETQ TEDIT.MOVE.PENDING NIL)
(\COPYSEL TEDIT.MOVESELECTION (fetch (TEXTOBJ MOVESEL
)
(\COPYSEL TEDIT.MOVESELECTION (fetch (TEXTOBJ MOVESEL)
of TEXTOBJ))
(TEDIT.DO.BLUEPENDINGDELETE SEL TEXTOBJ)
(ERSETQ (TEDIT.MOVE (fetch (TEXTOBJ MOVESEL)
of TEXTOBJ)
(ERSETQ (TEDIT.MOVE (fetch (TEXTOBJ MOVESEL) of TEXTOBJ)
(fetch (TEXTOBJ SEL) of TEXTOBJ)))
(replace (SELECTION SET) of TEDIT.MOVESELECTION
with NIL)
@@ -263,44 +252,38 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1990, 1991, 1992, 1994, 2018 b
with NIL)
(replace (SELECTION LN) of TEDIT.MOVESELECTION
with NIL)
(\COPYSEL TEDIT.MOVESELECTION (fetch (TEXTOBJ MOVESEL
)
(\COPYSEL TEDIT.MOVESELECTION (fetch (TEXTOBJ MOVESEL)
of TEXTOBJ)))
(TEDIT.DEL.PENDING (* ; "Delete the current selection.")
(TEDIT.DEL.PENDING (* ; "Delete the current selection.")
(SETQ TEDIT.DEL.PENDING NIL)
(* ;
 "Above all, reset the demand flag first")
(* ;
 "Above all, reset the demand flag first")
(ERSETQ (COND
((fetch (SELECTION SET) of
TEDIT.DELETESELECTION
)
(* ;
 "Only try the deletion if he really set the selection.")
(* ;
 "Only try the deletion if he really set the selection.")
(\SHOWSEL (fetch (TEXTOBJ DELETESEL)
of TEXTOBJ)
NIL NIL)
(* ;
 "Turn off the selection highlights")
(\SHOWSEL (fetch (TEXTOBJ SEL)
of TEXTOBJ)
(* ; "Turn off the selection highlights")
(\SHOWSEL (fetch (TEXTOBJ SEL) of TEXTOBJ)
NIL NIL)
(replace (SELECTION SET)
of (fetch (TEXTOBJ DELETESEL)
of TEXTOBJ) with NIL)
of (fetch (TEXTOBJ DELETESEL) of TEXTOBJ)
with NIL)
(\COPYSEL TEDIT.DELETESELECTION
(fetch (TEXTOBJ SEL) of
TEXTOBJ
))
(\TEDIT.SET.SEL.LOOKS (fetch (TEXTOBJ
SEL)
(fetch (TEXTOBJ SEL) of TEXTOBJ))
(\TEDIT.SET.SEL.LOOKS (fetch (TEXTOBJ SEL)
of TEXTOBJ)
'NORMAL)
(* ; "Grab the selection we're to use")
(* ; "Grab the selection we're to use")
(\TEDIT.DELETE (fetch (TEXTOBJ SEL)
of TEXTOBJ)
(fetch (SELECTION \TEXTOBJ)
of (fetch (TEXTOBJ SEL)
of TEXTOBJ))
of TEXTOBJ))
NIL)
(replace (SELECTION L1) of
TEDIT.DELETESELECTION
@@ -310,107 +293,101 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1990, 1991, 1992, 1994, 2018 b
with NIL]
(UNINTERRUPTABLY
(replace (STRINGP OFFST) of ISCRSTRING with 0)
(replace (STRINGP LENGTH) of ISCRSTRING with
\SCRATCHLEN
))
(replace (STRINGP LENGTH) of ISCRSTRING with \SCRATCHLEN))
(while (\SYSBUFP)
do (* ; "Handle user type-in")
(SETQ CH (\GETKEY))
(COND
(CHARFN (* ;
 "Give the OEM user control for each character typed.")
(SETQ TCH (APPLY* CHARFN STREAM CH))
(OR (EQ TCH T)
(SETQ CH TCH))
(* ;
 "And let him return one of NIL for 'ignore this char' , T for 'leave it be' or a new charcode.")
))
(SELECTC (AND CH (\SYNCODE TEDITSA CH))
(CHARDELETE.TTC
(* ;
 "Backspace handler: Remove the character just before SEL:CH#.")
(\TEDIT.CHARDELETE TEXTOBJ ISCRSTRING SEL)
(TEDIT.RESET.EXTEND.PENDING.DELETE SEL))
(WORDDELETE.TTC
(\TEDIT.WORDDELETE TEXTOBJ)
(TEDIT.RESET.EXTEND.PENDING.DELETE SEL))
(DELETE.TTC (* ;
 "DEL Key handler: Delete the selected characters")
(\TEDIT.DELETE SEL TEXTOBJ)
(TEDIT.RESET.EXTEND.PENDING.DELETE SEL))
(UNDO.TTC (* ;
 "He hit the CANCEL key, so go UNDO something")
(TEDIT.UNDO TEXTOBJ)
(TEDIT.RESET.EXTEND.PENDING.DELETE SEL))
(REDO.TTC (* ;
 "He hit the REDO key, so go REDO something")
(TEDIT.REDO TEXTOBJ)
(TEDIT.RESET.EXTEND.PENDING.DELETE SEL))
(FUNCTIONCALL.TTC
(* ;
 "This is a special character -- it calls a function")
(COND
([SETQ FN (CAR (FETCH MACROFN
OF (GETHASH CH
TEDITFNHASH]
(* ;
 "There IS a command function to be called.")
(APPLY* FN (fetch (TEXTOBJ STREAMHINT)
of TEXTOBJ)
TEXTOBJ SEL)
(* ; "do it")
(\SHOWSEL SEL NIL NIL)
(TEDIT.RESET.EXTEND.PENDING.DELETE SEL)
(* ;
 "After a user function, no more blue-pending-delete")
(\SHOWSEL SEL NIL T)
(* ;
 "And forget any pending deletion.")
)))
(NEXT.TTC (* ;
 "Move to the next blank to fill in. For now, blanks are delimited by >>...<<")
(TEDIT.NEXT TEXTOBJ))
(EXPAND.TTC (* ; "EXPAND AN ABBREVIATION")
(\TEDIT.ABBREV.EXPAND (fetch
(TEXTOBJ STREAMHINT
)
of TEXTOBJ)))
(SELECTC (AND TERMSA CH (fetch TERMCLASS
of (\SYNCODE TERMSA CH)
))
(CHARDELETE.TC
(* ;
 "Backspace handler: Remove the character just before SEL:CH#.")
(\TEDIT.CHARDELETE TEXTOBJ
ISCRSTRING SEL)
(TEDIT.RESET.EXTEND.PENDING.DELETE
SEL))
(WORDDELETE.TC
(* ; "Back-WORD handler")
(\TEDIT.WORDDELETE TEXTOBJ)
(TEDIT.RESET.EXTEND.PENDING.DELETE
SEL))
(LINEDELETE.TC
(* ;
 "DEL Key handler: Delete the selected characters")
(\TEDIT.DELETE SEL TEXTOBJ)
(TEDIT.RESET.EXTEND.PENDING.DELETE
SEL))
(COND
(CH (* ;
 "Any other key was hit: Just insert the character.")
(TEDIT.DO.BLUEPENDINGDELETE SEL TEXTOBJ)
(* ;
 "Handle blue pending delete, if there is one.")
(TEDIT.\INSERT CH SEL TEXTOBJ BLANKSEEN
CRSEEN]
do (* ; "Handle user type-in")
(SETQ CH (\GETKEY))
(COND
(CHARFN (* ;
 "Give the OEM user control for each character typed.")
(SETQ TCH (APPLY* CHARFN STREAM CH))
(OR (EQ TCH T)
(SETQ CH TCH))
(* ;
 "And let him return one of NIL for 'ignore this char' , T for 'leave it be' or a new charcode.")
))
(SELECTC (AND CH (\SYNCODE TEDITSA CH))
(CHARDELETE.TTC (* ;
 "Backspace handler: Remove the character just before SEL:CH#.")
(\TEDIT.CHARDELETE TEXTOBJ ISCRSTRING SEL)
(TEDIT.RESET.EXTEND.PENDING.DELETE SEL))
(WORDDELETE.TTC
(\TEDIT.WORDDELETE TEXTOBJ)
(TEDIT.RESET.EXTEND.PENDING.DELETE SEL))
(DELETE.TTC (* ;
 "DEL Key handler: Delete the selected characters")
(\TEDIT.DELETE SEL TEXTOBJ)
(TEDIT.RESET.EXTEND.PENDING.DELETE SEL))
(UNDO.TTC (* ;
 "He hit the CANCEL key, so go UNDO something")
(TEDIT.UNDO TEXTOBJ)
(TEDIT.RESET.EXTEND.PENDING.DELETE SEL))
(REDO.TTC (* ;
 "He hit the REDO key, so go REDO something")
(TEDIT.REDO TEXTOBJ)
(TEDIT.RESET.EXTEND.PENDING.DELETE SEL))
(FUNCTIONCALL.TTC
(* ;
 "This is a special character -- it calls a function")
(COND
([SETQ FN (CAR (FETCH MACROFN
OF (GETHASH CH TEDITFNHASH]
(* ;
 "There IS a command function to be called.")
(APPLY* FN (fetch (TEXTOBJ STREAMHINT)
of TEXTOBJ)
TEXTOBJ SEL)
(* ; "do it")
(\SHOWSEL SEL NIL NIL)
(TEDIT.RESET.EXTEND.PENDING.DELETE SEL)
(* ;
 "After a user function, no more blue-pending-delete")
(\SHOWSEL SEL NIL T)
(* ; "And forget any pending deletion.")
)))
(NEXT.TTC (* ;
 "Move to the next blank to fill in. For now, blanks are delimited by >>...<<")
(TEDIT.NEXT TEXTOBJ))
(EXPAND.TTC (* ; "EXPAND AN ABBREVIATION")
(\TEDIT.ABBREV.EXPAND (fetch (TEXTOBJ
STREAMHINT
)
of TEXTOBJ)))
(SELECTC (AND TERMSA CH (fetch TERMCLASS
of (\SYNCODE TERMSA CH)))
(CHARDELETE.TC
(* ;
 "Backspace handler: Remove the character just before SEL:CH#.")
(\TEDIT.CHARDELETE TEXTOBJ ISCRSTRING
SEL)
(TEDIT.RESET.EXTEND.PENDING.DELETE
SEL))
(WORDDELETE.TC
(* ; "Back-WORD handler")
(\TEDIT.WORDDELETE TEXTOBJ)
(TEDIT.RESET.EXTEND.PENDING.DELETE
SEL))
(LINEDELETE.TC
(* ;
 "DEL Key handler: Delete the selected characters")
(\TEDIT.DELETE SEL TEXTOBJ)
(TEDIT.RESET.EXTEND.PENDING.DELETE
SEL))
(COND
(CH (* ;
 "Any other key was hit: Just insert the character.")
(TEDIT.DO.BLUEPENDINGDELETE SEL TEXTOBJ)
(* ;
 "Handle blue pending delete, if there is one.")
(TEDIT.\INSERT CH SEL TEXTOBJ BLANKSEEN CRSEEN
]
(replace (TEXTOBJ EDITOPACTIVE) of TEXTOBJ with NIL]
(replace (TEXTOBJ EDITOPACTIVE) of TEXTOBJ with NIL))))])
(\TEDIT.COMMAND.RESET.SETUP
[LAMBDA (TEXT&WIND STARTING) (* ; "Edited 12-Jun-90 18:04 by mitani")
[LAMBDA (TEXT&WIND STARTING) (* ; "Edited 12-Jun-90 18:04 by mitani")
(* ;; "If STARTING is T, set up the reset-driven connections and values for editing; otherwise, break links and reset values for non-editing")
(* ;; "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))
(WINDOW (CADR TEXT&WIND))
@@ -420,30 +397,29 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1990, 1991, 1992, 1994, 2018 b
(OWINDOW (CADR (CDDDDR TEXT&WIND)))
TTYWINDOW)
[COND
(STARTING (* ;
 "We're going INTO the command loop. Set up all the stuff")
(STARTING (* ;
 "We're going INTO the command loop. Set up all the stuff")
(replace (TEXTOBJ EDITOPACTIVE) of TEXTOBJ with T)
(* ;
 "Mark us busy until we're set up, so that nobody tries any funny stuff.")
(* ;
 "Mark us busy until we're set up, so that nobody tries any funny stuff.")
(SETQ OWINDOW (PROCESSPROP (THIS.PROCESS)
'WINDOW
(CAR WINDOW))) (* ;
 "Attach the process to this window.")
(\TEDIT.INTERRUPT.SETUP (THIS.PROCESS))
(* ;
 "Disarm all interrupt chars, re-arm them when we leave the edit")
(CAR WINDOW))) (* ;
 "Attach the process to this window.")
(\TEDIT.INTERRUPT.SETUP (THIS.PROCESS)) (* ;
 "Disarm all interrupt chars, re-arm them when we leave the edit")
(SETQ OTTYEXITFN (PROCESSPROP (THIS.PROCESS)
'TTYEXITFN
'\TEDIT.PROCEXITFN))
(* ;
 "Set up functions for getting in and out of the edit process")
(* ;
 "Set up functions for getting in and out of the edit process")
(SETQ OTTYENTRYFN (PROCESSPROP (THIS.PROCESS)
'TTYENTRYFN
'\TEDIT.PROCENTRYFN))
[COND
((NEQ (TEXTPROP TEXTOBJ 'TTYWINDOW)
'DON'T) (* ;
 "He can suppress the ability to copy-select things into this window if he wants....")
'DON'T) (* ;
 "He can suppress the ability to copy-select things into this window if he wants....")
(SETQ TTYWINDOW (OR (TEXTPROP TEXTOBJ 'TTYWINDOW)
(CREATEW DEFAULTTTYREGION "TTY Window for TEdit" NIL T)))
(SETQ OTTYWINDOW (TTYDISPLAYSTREAM TTYWINDOW))
@@ -452,55 +428,55 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1990, 1991, 1992, 1994, 2018 b
(WINDOWPROP TTYWINDOW 'PROCESS NIL)
[WINDOWPROP TTYWINDOW 'CLOSEFN (FUNCTION (LAMBDA (WW)
(WINDOWPROP WW 'PROCESS NIL]
(* ;
 "So that there isn't a circularity in the PROCESS -> TTYWINDOW -> PROCESS")
(* ;
 "So that there isn't a circularity in the PROCESS -> TTYWINDOW -> PROCESS")
(WINDOWPROP TTYWINDOW 'COPYINSERTFN (FUNCTION \TEDIT.COPYINSERTFN))
(WINDOWPROP TTYWINDOW 'MAINWINDOW (CAR WINDOW]
(replace (TEXTOBJ TXTEDITING) of TEXTOBJ with T)
(* ;
 "Tell TEdit that this document is actively being edited.")
(* ;
 "Tell TEdit that this document is actively being edited.")
(replace (TEXTOBJ EDITOPACTIVE) of TEXTOBJ with NIL)
(* ;
 "Mark us un-busy so life can go on.")
(* ;
 "Mark us un-busy so life can go on.")
)
(T (* ;
 "Coming OUT OF the command loop -- reset everything")
(T (* ;
 "Coming OUT OF the command loop -- reset everything")
(PROCESSPROP (THIS.PROCESS)
'WINDOW
(CAR WINDOW)) (* ;
 "Detach the window from the edit process, to prevent circularity there")
(CAR WINDOW)) (* ;
 "Detach the window from the edit process, to prevent circularity there")
(WINDOWPROP (CAR WINDOW)
'PROCESS NIL)
(\TEDIT.INTERRUPT.SETUP (THIS.PROCESS)
T) (* ;
 "Re-arm the interrupts we turned off coming in.")
T) (* ;
 "Re-arm the interrupts we turned off coming in.")
(COND
((AND (TXTFILE TEXTOBJ)
(NOT (WINDOWPROP (CAR WINDOW)
'TEDIT-CLOSING-FILE T)))(* ;
 "Remember to close the file we were editing (Only if the window function isn't closing it.)")
'TEDIT-CLOSING-FILE T)))(* ;
 "Remember to close the file we were editing (Only if the window function isn't closing it.)")
(CLOSEF? (TXTFILE TEXTOBJ))
(WINDOWPROP (CAR WINDOW)
'TEDIT-CLOSING-FILE NIL) (* ;
 "And let anyone else who wants to try closing the file do so.")
'TEDIT-CLOSING-FILE NIL) (* ;
 "And let anyone else who wants to try closing the file do so.")
))
(PROCESSPROP (THIS.PROCESS)
'TTYEXITFN OTTYEXITFN)
(PROCESSPROP (THIS.PROCESS)
'TTYENTRYFN OTTYENTRYFN)
(replace (TEXTOBJ TXTHISTORY) of TEXTOBJ with NIL)
(* ;
 "To prevent circularities arising from the need to remember textobjs in the history list.")
(* ;
 "To prevent circularities arising from the need to remember textobjs in the history list.")
(replace (TEXTOBJ SELWINDOW) of TEXTOBJ with NIL)
(* ;
 "To prevent a circularity thru the window back to the textobj.")
(* ;
 "To prevent a circularity thru the window back to the textobj.")
(replace (TEXTOBJ TXTEDITING) of TEXTOBJ with NIL)
(* ;
 "Tell TEdit that this document is NO LONGER actively being edited.")
(* ;
 "Tell TEdit that this document is NO LONGER actively being edited.")
(COND
((NEQ (TEXTPROP TEXTOBJ 'TTYWINDOW)
'DON'T) (* ;
 "He can suppress the ability to copy-select things into this window if he wants....")
'DON'T) (* ;
 "He can suppress the ability to copy-select things into this window if he wants....")
(TTYDISPLAYSTREAM OTTYWINDOW)
(PROCESSPROP (THIS.PROCESS)
'TEDITTTYWINDOW NIL]
@@ -508,9 +484,9 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1990, 1991, 1992, 1994, 2018 b
)
(RPAQ? TEDIT.INTERRUPTS '((2 BREAK)
(5 ERROR)
(7 HELP)
(20 CONTROL-T)))
(5 ERROR)
(7 HELP)
(20 CONTROL-T)))
(RPAQQ TEDIT.COPY.PENDING NIL)
@@ -534,70 +510,69 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1990, 1991, 1992, 1994, 2018 b
(DEFINEQ
(\TEDIT.READTABLE
[LAMBDA NIL (* ; "Edited 20-Apr-2018 07:59 by rmk:")
(* jds "12-Sep-86 13:48")
[LAMBDA NIL (* ; "Edited 20-Apr-2018 07:59 by rmk:")
(* jds "12-Sep-86 13:48")
(* Create a TEdit read-table, to control which characters have what functions
 and call which commands.)
(* Create a TEdit read-table, to control which characters have what functions and
 call which commands.)
(PROG [(RTBL (create READTABLEP
READMACRODEFS _ (HASHARRAY 50]
(for CH in (CHARCODE (BS ^A ^W DEL %#A %#B %#C ESC)) as CL
in (LIST CHARDELETE.TTC CHARDELETE.TTC WORDDELETE.TTC DELETE.TTC UNDO.TTC NEXT.TTC
CMD.TTC REDO.TTC) do (* Set up the default syntax classes
 for command characters)
(\SETSYNCODE (fetch READSA of RTBL)
CH CL))
CMD.TTC REDO.TTC) do (* Set up the default syntax classes
 for command characters)
(\SETSYNCODE (fetch READSA of RTBL)
CH CL))
(for CH in (CHARCODE (^X)) as FN in '(\TEDIT.ABBREV.EXPAND)
do (* Set up the default
 function-calling characters
 (^X to expand abbrevs for now))
(TEDIT.SETFUNCTION CH FN RTBL))
do (* Set up the default function-calling
 characters (^X to expand abbrevs for
 now))
(TEDIT.SETFUNCTION CH FN RTBL))
(TEDIT.SETFUNCTION (CHARCODE ^O)
(FUNCTION GET.OBJ.FROM.USER)
RTBL) (* And for image object capture)
RTBL) (* And for image object capture)
(RETURN RTBL])
(\TEDIT.WORDBOUND.READTABLE
[LAMBDA NIL (* ; "Edited 22-May-92 15:10 by jds")
[LAMBDA NIL (* ; "Edited 22-May-92 15:10 by jds")
(* ;; "Create a readtable which will let TEdit find word boundaries. A word boundary is any point where the SYNCODE of the adjacent characters is different")
(PROG [(RTBL (create READTABLEP
READMACRODEFS _ (HARRAY 50]
(for CH from 0 to 255 do (\SETSYNCODE (fetch READSA of RTBL)
CH PUNCT.TTC))
CH PUNCT.TTC))
(* ;; "By default, every character except those noted below is a punctuation character")
(for CH from (CHARCODE A) to (CHARCODE Z)
do (\SETSYNCODE (fetch READSA of RTBL)
CH TEXT.TTC)) (* ; "Upper case alpha")
(for CH from (CHARCODE a) to (CHARCODE z)
do (\SETSYNCODE (fetch READSA of RTBL)
CH TEXT.TTC)) (* ; "Lower case alpha")
(for CH from (CHARCODE 0) to (CHARCODE 9)
do (\SETSYNCODE (fetch READSA of RTBL)
CH TEXT.TTC)) (* ; "And digits are text characters")
(for CH from (CHARCODE A) to (CHARCODE Z) do (\SETSYNCODE (fetch READSA of RTBL)
CH TEXT.TTC))
(* ; "Upper case alpha")
(for CH from (CHARCODE a) to (CHARCODE z) do (\SETSYNCODE (fetch READSA of RTBL)
CH TEXT.TTC))
(* ; "Lower case alpha")
(for CH from (CHARCODE 0) to (CHARCODE 9) do (\SETSYNCODE (fetch READSA of RTBL)
CH TEXT.TTC))
(* ; "And digits are text characters")
(* ;; "European chars and accents are text characters:")
(for CH from (CHARCODE "361,41") to (CHARCODE "361,376")
do (\SETSYNCODE (fetch READSA of RTBL)
CH TEXT.TTC))
CH TEXT.TTC))
(for CH from (CHARCODE "0,301") to (CHARCODE "0,317")
do (\SETSYNCODE (fetch READSA of RTBL)
CH TEXT.TTC))
CH TEXT.TTC))
(for CH from (CHARCODE "0,341") to (CHARCODE "0,376")
do (\SETSYNCODE (fetch READSA of RTBL)
CH TEXT.TTC))
(for CH in (CHARCODE (CR SPACE TAB ^L)) do (\SETSYNCODE (fetch READSA
of RTBL)
CH WHITESPACE.TTC))
CH TEXT.TTC))
(for CH in (CHARCODE (CR SPACE TAB ^L)) do (\SETSYNCODE (fetch READSA of RTBL)
CH WHITESPACE.TTC))
(* ; "And these are white space")
(for CH in (LIST MSPACE NSPACE THINSPACE FIGSPACE)
do (\SETSYNCODE (fetch READSA of RTBL)
CH TEXT.TTC))
CH TEXT.TTC))
(RETURN RTBL])
(TEDIT.GETSYNTAX
@@ -650,52 +625,50 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1990, 1991, 1992, 1994, 2018 b
(APPLY* 'CHARCODE CHAR))
(T CHAR)))
TABLE)
(\SETSYNCODE [fetch READSA of (COND
((type? TEXTOBJ TABLE)
(\SETSYNCODE [fetch READSA of (COND
((type? TEXTOBJ TABLE)
(* ;
 "If given a TEXTOBJ in place of a read table, coerce it to the read table for that edit session")
(OR (fetch (TEXTOBJ TXTRTBL) of TABLE)
TEDIT.READTABLE))
((type? STREAM TABLE)
(OR (fetch (TEXTOBJ TXTRTBL) of TABLE)
TEDIT.READTABLE))
((type? STREAM TABLE)
(* ;
 "If given a TEXTOBJ in place of a read table, coerce it to the read table for that edit session")
(OR (fetch (TEXTOBJ TXTRTBL) of (fetch (TEXTSTREAM
TEXTOBJ)
of TABLE))
TEDIT.READTABLE))
(T (OR TABLE TEDIT.READTABLE]
CHAR
(SELECTQ CLASS
(CHARDELETE CHARDELETE.TTC)
(WORDDELETE WORDDELETE.TTC)
((DELETE LINEDELETE)
DELETE.TTC)
(UNDO UNDO.TTC)
(REDO REDO.TTC)
(CMD CMD.TTC)
(FN FUNCTIONCALL.TTC)
(NEXT NEXT.TTC)
(EXPAND EXPAND.TTC)
NONE.TTC])
(OR (fetch (TEXTOBJ TXTRTBL) of (fetch (TEXTSTREAM TEXTOBJ)
of TABLE))
TEDIT.READTABLE))
(T (OR TABLE TEDIT.READTABLE]
CHAR
(SELECTQ CLASS
(CHARDELETE CHARDELETE.TTC)
(WORDDELETE WORDDELETE.TTC)
((DELETE LINEDELETE)
DELETE.TTC)
(UNDO UNDO.TTC)
(REDO REDO.TTC)
(CMD CMD.TTC)
(FN FUNCTIONCALL.TTC)
(NEXT NEXT.TTC)
(EXPAND EXPAND.TTC)
NONE.TTC)))])
(TEDIT.GETFUNCTION
[LAMBDA (CHARCODE TABLE) (* jds "19-Sep-85 17:06")
(* Gets the FN that is called when
 CH is hit inside TEDIT.)
[LAMBDA (CHARCODE TABLE) (* jds "19-Sep-85 17:06")
(* Gets the FN that is called when CH
 is hit inside TEDIT.)
[SETQ TABLE (COND
((type? TEXTOBJ TABLE)
(* If given a TEXTOBJ in place of a read table, coerce it to the read table for
 that edit session)
(* If given a TEXTOBJ in place of a read table, coerce it to the read table for
 that edit session)
(fetch (TEXTOBJ TXTRTBL) of TABLE))
((type? STREAM TABLE)
(* If given a TEXTOBJ in place of a read table, coerce it to the read table for
 that edit session)
(* If given a TEXTOBJ in place of a read table, coerce it to the read table for
 that edit session)
(fetch (TEXTOBJ TXTRTBL) of (fetch (TEXTSTREAM TEXTOBJ) of TABLE)
))
(fetch (TEXTOBJ TXTRTBL) of (fetch (TEXTSTREAM TEXTOBJ) of TABLE)))
(T (OR TABLE TEDIT.READTABLE]
(SETQ CHARCODE (COND
((LITATOM CHARCODE)
@@ -708,17 +681,17 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1990, 1991, 1992, 1994, 2018 b
(CAR (FETCH MACROFN OF (GETHASH CHARCODE (fetch READMACRODEFS of TABLE])
(TEDIT.SETFUNCTION
[LAMBDA (CHARCODE FN RTBL) (* ; "Edited 31-Mar-87 10:58 by jds")
(* ;
 "Set TEDITs (read) table so that FN is called whenever CHARCODE is typed.")
(* ;
 "If FN is NIL, make the character be normal again.")
[LAMBDA (CHARCODE FN RTBL) (* ; "Edited 31-Mar-87 10:58 by jds")
(* ;
 "Set TEDITs (read) table so that FN is called whenever CHARCODE is typed.")
(* ;
 "If FN is NIL, make the character be normal again.")
[SETQ RTBL (COND
((type? TEXTOBJ RTBL) (* ;
 "If given a TEXTOBJ in place of a read table, coerce it to the read table for that edit session")
((type? TEXTOBJ RTBL) (* ;
 "If given a TEXTOBJ in place of a read table, coerce it to the read table for that edit session")
(fetch (TEXTOBJ TXTRTBL) of RTBL))
((type? STREAM RTBL) (* ;
 "If given a TEXTOBJ in place of a read table, coerce it to the read table for that edit session")
((type? STREAM RTBL) (* ;
 "If given a TEXTOBJ in place of a read table, coerce it to the read table for that edit session")
(fetch (TEXTOBJ TXTRTBL) of (fetch (TEXTSTREAM TEXTOBJ) of RTBL)))
(T (OR RTBL TEDIT.READTABLE]
(\SETSYNCODE (fetch READSA of RTBL)
@@ -729,31 +702,30 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1990, 1991, 1992, 1994, 2018 b
(APPLY* 'CHARCODE CHARCODE))
(T CHARCODE)))
(COND
(FN (* ;
 "He gave us a function to call. Set up the syntax so it IS called.")
(FN (* ;
 "He gave us a function to call. Set up the syntax so it IS called.")
FUNCTIONCALL.TTC)
(T (* ;
 "He gave us a function of NIL, meaning 'turn it off' . Cause this character to become normal.")
NONE.TTC))) (* ;
 "Mark the character as invoking a function")
(T (* ;
 "He gave us a function of NIL, meaning 'turn it off' . Cause this character to become normal.")
NONE.TTC))) (* ;
 "Mark the character as invoking a function")
(OR (fetch READMACRODEFS of RTBL)
(replace READMACRODEFS of RTBL with (HARRAY 50)))
(* ;
 "Make sure there's a hash table to store the function in.")
(replace READMACRODEFS of RTBL with (HARRAY 50))) (* ;
 "Make sure there's a hash table to store the function in.")
(PUTHASH CHARCODE (CREATE READMACRODEF
MACROTYPE _ 'TEDIT
MACROFN _ (LIST FN))
(fetch READMACRODEFS of RTBL])
(TEDIT.WORDGET
(LAMBDA (CH TABLE) (* jds "27-MAY-83 13:24")
[LAMBDA (CH TABLE) (* jds "27-MAY-83 13:24")
(\SYNCODE (fetch READSA of (OR TABLE TEDIT.WORDBOUND.READTABLE))
(COND
((SMALLP CH))
(T (CHCON1 CH))))))
(T (CHCON1 CH])
(TEDIT.WORDSET
(LAMBDA (CHARCODE CLASS TABLE) (* jds " 1-JUN-83 12:23")
[LAMBDA (CHARCODE CLASS TABLE) (* jds " 1-JUN-83 12:23")
(* SETS TEDIT-STYLE SYNTAX BITS IN A
 TERMTABLE)
(\SETSYNCODE (fetch READSA of (OR TABLE TEDIT.WORDBOUND.READTABLE))
@@ -766,7 +738,7 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1990, 1991, 1992, 1994, 2018 b
(PUNCTUATION PUNCT.TTC)
(WHITESPACE WHITESPACE.TTC)
(TEXT TEXT.TTC)
TEXT.TTC))))))
TEXT.TTC])
)
(DECLARE%: DONTEVAL@LOAD DOCOPY
@@ -778,13 +750,11 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1990, 1991, 1992, 1994, 2018 b
(GLOBALVARS TEDIT.READTABLE TEDIT.WORDBOUND.READTABLE)
)
(PUTPROPS TEDITCOMMAND COPYRIGHT ("Venue & Xerox Corporation" 1983 1984 1985 1986 1987 1988 1990 1991
1992 1994 2018))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (2383 35906 (\TEDIT.INSERT.TTY.BUFFER 2393 . 3003) (\TEDIT.INTERRUPT.SETUP 3005 . 4578)
(\TEDIT.MARKACTIVE 4580 . 4788) (\TEDIT.MARKINACTIVE 4790 . 5002) (\PNC 5004 . 5644) (
\TEDIT.COMMAND.LOOP 5646 . 29326) (\TEDIT.COMMAND.RESET.SETUP 29328 . 35904)) (36480 49998 (
\TEDIT.READTABLE 36490 . 38095) (\TEDIT.WORDBOUND.READTABLE 38097 . 40622) (TEDIT.GETSYNTAX 40624 .
42820) (TEDIT.SETSYNTAX 42822 . 45163) (TEDIT.GETFUNCTION 45165 . 46547) (TEDIT.SETFUNCTION 46549 .
49018) (TEDIT.WORDGET 49020 . 49289) (TEDIT.WORDSET 49291 . 49996)))))
(FILEMAP (NIL (2178 34353 (\TEDIT.INSERT.TTY.BUFFER 2188 . 2770) (\TEDIT.INTERRUPT.SETUP 2772 . 4437)
(\TEDIT.MARKACTIVE 4439 . 4651) (\TEDIT.MARKINACTIVE 4653 . 4869) (\PNC 4871 . 5504) (
\TEDIT.COMMAND.LOOP 5506 . 27793) (\TEDIT.COMMAND.RESET.SETUP 27795 . 34351)) (34915 48289 (
\TEDIT.READTABLE 34925 . 36534) (\TEDIT.WORDBOUND.READTABLE 36536 . 39129) (TEDIT.GETSYNTAX 39131 .
41327) (TEDIT.SETSYNTAX 41329 . 43522) (TEDIT.GETFUNCTION 43524 . 44884) (TEDIT.SETFUNCTION 44886 .
47325) (TEDIT.WORDGET 47327 . 47588) (TEDIT.WORDSET 47590 . 48287)))))
STOP

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

Binary file not shown.

1057
library/TEDITDCL → library/tedit/TEDIT-DCL
View File

File diff suppressed because it is too large Load Diff

41
library/TEDITDCL.LCOM → library/tedit/TEDIT-DCL.LCOM
View File

@@ -1,12 +1,14 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "21-Sep-2021 12:53:57" ("compiled on "
{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>TEDITDCL.;2) "20-Sep-2021 11:14:12" brecompiled
exprs%: nothing in "FULL 20-Sep-2021 ..." dated "20-Sep-2021 11:14:18")
(FILECREATED "21-Sep-2021 12:53:57" {DSK}<Users>kaplan>Local>medley3.5>git-medley>library>TEDITDCL.;2
86549 changes to%: (VARS TEDITDCLCOMS) previous date%: "30-Apr-2021 17:26:17"
{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>TEDITDCL.;1)
(PRETTYCOMPRINT TEDITDCLCOMS)
(RPAQQ TEDITDCLCOMS ((* ;;;
(FILECREATED "14-Jul-2022 17:04:17" ("compiled on "
{DSK}<users>kaplan>local>medley3.5>working-medley>library>tedit>TEDIT-DCL.;3) "14-Jul-2022 13:19:07"
tcompl'd in "FULL 14-Jul-2022 ..." dated "14-Jul-2022 13:19:12")
(FILECREATED "14-Jul-2022 17:03:38"
{DSK}<users>kaplan>local>medley3.5>working-medley>library>tedit>TEDIT-DCL.;3 84851 :CHANGES-TO (VARS
TEDITFILES) :PREVIOUS-DATE "14-Jul-2022 16:29:57"
{DSK}<users>kaplan>local>medley3.5>working-medley>library>tedit>TEDIT-DCL.;2)
(PRETTYCOMPRINT TEDIT-DCLCOMS)
(RPAQQ TEDIT-DCLCOMS ((* ;;;
"This file is the collected record declarations and compile-time necessities for TEDIT.") (* ;;
"FROM TEDIT") (DECLARE%: EVAL@COMPILE DONTCOPY (CONSTANTS (\SCRATCHLEN 64))) (* ;;
"FROM TEDITSELECTION") (RECORDS SELECTION) (DECLARE%: EVAL@COMPILE DONTCOPY (CONSTANTS (COPYSELSHADE
@@ -83,9 +85,9 @@ SELECTION 8 POINTER) (SELECTION 10 POINTER) (SELECTION 12 POINTER) (SELECTION 14
FULLXPOINTER) (SELECTION 24 POINTER) (SELECTION 26 POINTER) (SELECTION 28 POINTER) (SELECTION 28 (
FLAGBITS . 0)) (SELECTION 30 POINTER) (SELECTION 30 (FLAGBITS . 0)) (SELECTION 32 POINTER))) (QUOTE 34
))
(RPAQQ TEDITFILES (PCTREE TEXTOFD TEDIT TEDITABBREV TEDITCOMMAND TEDITDCL TEDITFILE TEDITFIND
TEDITFNKEYS TEDITHCPY TEDITHISTORY TEDITLOOKS TEDITMENU TEDITPAGE TEDITSCREEN TEDITSELECTION
TEDITWINDOW))
(RPAQQ TEDITFILES (TEDIT-PCTREE TEDIT-TEXTOFD TEDIT TEDIT-ABBREV TEDIT-COMMAND TEDIT-DCL TEDIT-FILE
TEDIT-FIND TEDIT-FNKEYS TEDIT-HCPY TEDIT-HISTORY TEDIT-LOOKS TEDIT-MENU TEDIT-PAGE TEDIT-SCREEN
TEDIT-SELECTION TEDIT-WINDOW))
(DATATYPE THISLINE ((* ;;
"Cache for line-related character location info, for selection and line-display code to use.") (DESC
FULLXPOINTER) (* ; "Line descriptor for the line this describes now") LEN (* ;
@@ -160,9 +162,11 @@ NEXTPIECE (* ; "-> Next piece in this textobj.") (PREVPIECE FULLXPOINTER) (* ;
PPARALAST FLAG) (* ; "This piece contains a paragraph break") PPARALOOKS (* ;
"Paragraph looks for this piece") (PNEW FLAG) (* ;
"This text is new here; used by the tentative edit system, and anyone else interested.") (PFATP FLAG)
(* ; "T if the characters in this piece are FAT -- i.e., are 16 bits each.") (PTREENODE XPOINTER) (*
; "Points to the PCTB tree-node that contains this piece.")) PSTR _ NIL PFILE _ NIL PFPOS _ 0 PLEN _ 0
PPARALOOKS _ TEDIT.DEFAULT.FMTSPEC PTREENODE _ NIL)
(* ;
"T if the characters in this piece are FAT -- i.e., are 16 bits each. This is trumped for a piece on a file that has its own PEXTERNALFORMAT"
) (PTREENODE XPOINTER) (* ; "Points to the PCTB tree-node that contains this piece.") (PEXTERNALFORMAT
POINTER (* ; "The external format of a piece on a file"))) PSTR _ NIL PFILE _ NIL PFPOS _ 0 PLEN _ 0
PPARALOOKS _ TEDIT.DEFAULT.FMTSPEC PTREENODE _ NIL)
(DATATYPE TEXTOBJ ((* ;;
"This is where TEdit stores its state information, and internal data about the text being edited.")
PCTB (* ; "The piece table") TEXTLEN (* ; "# of chars in the text") \INSERTPC (* ;
@@ -263,10 +267,10 @@ fetch F4 of DATUM) (REPLACE F4 OF DATUM WITH NEWVALUE)) (* ;
"T if the current piece is 16 bit characters.")) (CREATE (create STREAM using \TEXTOFD IMAGEDATA _ (
create TEXTIMAGEDATA))))
(/DECLAREDATATYPE (QUOTE PIECE) (QUOTE (POINTER POINTER POINTER POINTER POINTER FULLXPOINTER POINTER
POINTER FLAG POINTER FLAG FLAG XPOINTER)) (QUOTE ((PIECE 0 POINTER) (PIECE 2 POINTER) (PIECE 4 POINTER
) (PIECE 6 POINTER) (PIECE 8 POINTER) (PIECE 10 FULLXPOINTER) (PIECE 12 POINTER) (PIECE 14 POINTER) (
PIECE 14 (FLAGBITS . 0)) (PIECE 16 POINTER) (PIECE 16 (FLAGBITS . 0)) (PIECE 16 (FLAGBITS . 16)) (
PIECE 18 XPOINTER))) (QUOTE 20))
POINTER FLAG POINTER FLAG FLAG XPOINTER POINTER)) (QUOTE ((PIECE 0 POINTER) (PIECE 2 POINTER) (PIECE 4
POINTER) (PIECE 6 POINTER) (PIECE 8 POINTER) (PIECE 10 FULLXPOINTER) (PIECE 12 POINTER) (PIECE 14
POINTER) (PIECE 14 (FLAGBITS . 0)) (PIECE 16 POINTER) (PIECE 16 (FLAGBITS . 0)) (PIECE 16 (FLAGBITS .
16)) (PIECE 18 XPOINTER) (PIECE 20 POINTER))) (QUOTE 22))
(/DECLAREDATATYPE (QUOTE TEXTOBJ) (QUOTE (POINTER POINTER POINTER POINTER POINTER POINTER POINTER
POINTER POINTER FLAG POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER
POINTER POINTER POINTER POINTER FLAG FULLXPOINTER POINTER POINTER POINTER POINTER POINTER FLAG POINTER
@@ -457,5 +461,4 @@ QUOTE 22))
(/DECLAREDATATYPE (QUOTE PCTNODE) (QUOTE (POINTER POINTER POINTER POINTER POINTER POINTER)) (QUOTE ((
PCTNODE 0 POINTER) (PCTNODE 2 POINTER) (PCTNODE 4 POINTER) (PCTNODE 6 POINTER) (PCTNODE 8 POINTER) (
PCTNODE 10 POINTER))) (QUOTE 12))
(PUTPROPS TEDITDCL COPYRIGHT ("Venue" 1986 1987 1988 1989 1990 1991 1993 1994 2021))
NIL

3505
library/tedit/TEDIT-FILE Normal file
View File

File diff suppressed because it is too large Load Diff

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

Binary file not shown.

457
library/TEDITFIND → library/tedit/TEDIT-FIND
View File

@@ -1,24 +1,19 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED " 6-May-2018 17:34:44" 
{DSK}<Users>kaplan>Local>medley3.5>lispcore>library>TEDITFIND.;2 40100
changes to%: (FNS TEDIT.FIND)
(FILECREATED "14-Jul-2022 16:55:46" 
{DSK}<users>kaplan>local>medley3.5>working-medley>library>tedit>TEDIT-FIND.;1 37798
previous date%: "25-Aug-94 10:53:52"
{DSK}<Users>kaplan>Local>medley3.5>lispcore>library>TEDITFIND.;1)
:PREVIOUS-DATE "14-Jul-2022 11:08:01"
{DSK}<users>kaplan>local>medley3.5>working-medley>library>newtedit>TEDIT-FIND.;2)
(* ; "
Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1994, 2018 by Venue & Xerox Corporation. All rights reserved.
")
(PRETTYCOMPRINT TEDIT-FINDCOMS)
(PRETTYCOMPRINT TEDITFINDCOMS)
(RPAQQ TEDITFINDCOMS
((FILES TEDITDCL)
(RPAQQ TEDIT-FINDCOMS
((FILES TEDIT-DCL)
(DECLARE%: EVAL@COMPILE DONTCOPY (CONSTANTS (\SCRATCHLEN 64))
(FILES (LOADCOMP)
TEDITDCL))
TEDIT-DCL))
[DECLARE%: DONTEVAL@LOAD DOCOPY (VARS (TEDIT.SEARCH.CODETABLE (\TEDIT.SEARCH.CODETABLE]
(COMS (* Read-table Utilities)
(FNS \TEDIT.SEARCH.CODETABLE)
@@ -27,7 +22,7 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1994, 2018 b
\TEDIT.PACK.TARGETLIST \TEDIT.PARSE.SEARCHSTRING \TEDIT.SUBST.FN1 \TEDIT.SUBST.FN2
TEDIT.SUBSTITUTE)))
(FILESLOAD TEDITDCL)
(FILESLOAD TEDIT-DCL)
(DECLARE%: EVAL@COMPILE DONTCOPY
(DECLARE%: EVAL@COMPILE
@@ -39,7 +34,7 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1994, 2018 b
(FILESLOAD (LOADCOMP)
TEDITDCL)
TEDIT-DCL)
)
(DECLARE%: DONTEVAL@LOAD DOCOPY
@@ -53,16 +48,14 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1994, 2018 b
(DEFINEQ
(\TEDIT.SEARCH.CODETABLE
(LAMBDA NIL (* jds "23-OCT-83 00:58")
(* Build the 16-bit-item "syntax class"
 table for searching)
[LAMBDA NIL (* jds "23-OCT-83 00:58")
(* Build the 16-bit-item "syntax class"
 table for searching)
(PROG ((CODETBL (ARRAY 256 'SMALLP 0 0)))
(for I from 0 to 255 do (SETA CODETBL I I))
(* Default is that a char maps to itself, and is punctuation.)
(for I from 0 to 255 do (SETA CODETBL I I)) (* Default is that a char maps to
 itself, and is punctuation.)
(for CH
in (CHARCODE (A B C D E F G H I J K L M N O P Q R S T U V W X Y Z a b c d e f g h i j k
in (CHARCODE (A B C D E F G H I J K L M N O P Q R S T U V W X Y Z a b c d e f g h i j k
l m n o p q r s t u v w x y z))
do (SETA CODETBL CH (IPLUS \AlphaNumericFlag \AlphaFlag CH)))
(for CH in (CHARCODE (0 1 2 3 4 5 6 7 8 9)) do (SETA CODETBL CH (IPLUS \AlphaNumericFlag CH
@@ -71,7 +64,7 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1994, 2018 b
in (LIST \OneCharPattern \AnyStringPattern \OneAlphaPattern \OneNonAlphaPattern
\AnyAlphaPattern \AnyNonAlphaPattern \LeftBracketPattern \RightBracketPattern)
do (SETA CODETBL CH CODE))
(RETURN CODETBL))))
(RETURN CODETBL])
)
(DECLARE%: DOEVAL@COMPILE DONTCOPY
@@ -80,7 +73,7 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1994, 2018 b
(DEFINEQ
(\TEDIT.BASICFIND
[LAMBDA (TEXTOBJ STRING CH# CHLIM) (* ; "Edited 30-May-91 20:56 by jds")
[LAMBDA (TEXTOBJ STRING CH# CHLIM) (* ; "Edited 30-May-91 20:56 by jds")
(* ;; "Search thru TEXTOBJ, starting where the caret is, for the string STRING, exact match only for now. (Optionally, start the search at character ch#.)")
@@ -93,22 +86,22 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1994, 2018 b
CH1 ANCHOR PCH# OANCHOR CH)
(replace (TEXTOBJ \INSERTPCVALID) of TEXTOBJ with NIL)
(* ;
 "2/12/85 JDS: I don't understand WHY this is here, but I'll assume it's right for now.")
 "2/12/85 JDS: I don't understand WHY this is here, but I'll assume it's right for now.")
(* ;
 "Prohibit future insertions in the current piece.")
 "Prohibit future insertions in the current piece.")
(COND
((OR CH# (fetch (SELECTION SET) of SEL))(* ;
 "There must be a well-defined starting point.")
((OR CH# (fetch (SELECTION SET) of SEL)) (* ;
 "There must be a well-defined starting point.")
(RETURN (PROG NIL
(SETQ CH1 (OR CH# (SELECTQ (fetch (SELECTION POINT) of SEL)
(LEFT (fetch (SELECTION CH#) of SEL))
(RIGHT (fetch (SELECTION CHLIM) of SEL))
NIL))) (* ;
 "Find the starting point for the search")
 "Find the starting point for the search")
(* ; "DO THE SEARCH")
(COND
((IGREATERP CH1 TEXTLIM) (* ;
 "Starting the search past the last possible starting point. Just punt.")
 "Starting the search past the last possible starting point. Just punt.")
(RETURN NIL)))
(SETQ ANCHOR (SUB1 CH1))
RETRY
@@ -116,31 +109,30 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1994, 2018 b
TEXTOBJ)
[for old ANCHOR from (ADD1 ANCHOR) to TEXTLIM
do (SETQ CH (\BIN TEXTSTREAM))
(COND
((EQ CH CH#1)
(RETURN]
(COND
((EQ CH CH#1)
(RETURN]
(COND
((IGREATERP ANCHOR TEXTLIM)
(RETURN NIL))) (* ;
 "No starting character found before end of string")
 "No starting character found before end of string")
(SETQ OANCHOR ANCHOR)
(SETQ FOUND T)
[for old CH1 from (ADD1 ANCHOR) to TEXTLIM as PCH#
from 2 to (NCHARS STRING)
do (SETQ CH (\BIN TEXTSTREAM))
(COND
((NEQ CH (NTHCHARCODE STRING PCH#))
(SETQ FOUND NIL)
(RETURN]
[for old CH1 from (ADD1 ANCHOR) to TEXTLIM as PCH# from 2
to (NCHARS STRING) do (SETQ CH (\BIN TEXTSTREAM))
(COND
((NEQ CH (NTHCHARCODE STRING PCH#))
(SETQ FOUND NIL)
(RETURN]
(COND
(FOUND (RETURN ANCHOR))
(T (GO RETRY])
(TEDIT.FIND
[LAMBDA (TEXTOBJ TARGETSTRING START# END# WILDCARDS?) (* ; "Edited 6-May-2018 17:34 by rmk:")
(* ; "Edited 30-May-91 20:56 by jds")
[LAMBDA (TEXTOBJ TARGETSTRING START# END# WILDCARDS?) (* ; "Edited 6-May-2018 17:34 by rmk:")
(* ; "Edited 30-May-91 20:56 by jds")
(* ;; "If WILDCARDS? is NIL then TEDIT.FIND is the old TEDIT.FIND. Else, it returns a list of (SEL.START# SEL.END#) which is the start and end char positions of the selection")
(* ;; "If WILDCARDS? is NIL then TEDIT.FIND is the old TEDIT.FIND. Else, it returns a list of (SEL.START# SEL.END#) which is the start and end char positions of the selection")
(LET*
[(TEXTOBJ (TEXTOBJ TEXTOBJ))
@@ -149,23 +141,20 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1994, 2018 b
(AND TARGETSTRING (NOT (STRINGP TARGETSTRING))
(SETQ TARGETSTRING (MKSTRING TARGETSTRING)))
(* ;; "RMK: FIND isn't undoable, FIND-AGAIN is armed on meta-g. No point in hiding a previous actual edit by adding the find event (given that the history is not a list, just a single event (TEDITHISTORY)")
(* ;; "RMK: FIND isn't undoable, FIND-AGAIN is armed on meta-g. No point in hiding a previous actual edit by adding the find event (given that the history is not a list, just a single event (TEDITHISTORY)")
(AND NIL (\TEDIT.HISTORYADD TEXTOBJ (create TEDITHISTORYEVENT
THACTION _ 'Find
THAUXINFO _ TARGETSTRING)))
(replace (TEXTOBJ \INSERTPCVALID) of TEXTOBJ with NIL)
(* ;
 "Any FIND invalidates the type-in cache.")
(replace (TEXTOBJ \INSERTPCVALID) of TEXTOBJ with NIL) (* ;
 "Any FIND invalidates the type-in cache.")
(COND
[WILDCARDS? (* ;
 "will return a list of start and end of selection or nil if not found")
[WILDCARDS? (* ;
 "will return a list of start and end of selection or nil if not found")
(PROG (TARGETLIST SEL RESULT RESULT1)
(RETURN (COND
((OR START# (AND (fetch (SELECTION SET) of (SETQ SEL
(fetch (TEXTOBJ
SEL)
of TEXTOBJ)))
((OR START# (AND (fetch (SELECTION SET) of (SETQ SEL (fetch (TEXTOBJ SEL)
of TEXTOBJ)))
(LEQ (SETQ START# (SELECTQ (fetch (SELECTION POINT)
of SEL)
(LEFT (fetch (SELECTION CH#)
@@ -173,25 +162,25 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1994, 2018 b
(RIGHT (fetch (SELECTION CHLIM)
of SEL))
NIL))
REAL-END#))) (* ; "START# better be >= to END#")
REAL-END#))) (* ; "START# better be >= to END#")
(COND
((AND (for X in [SETQ TARGETLIST
(\TEDIT.PARSE.SEARCHSTRING
(for X in (CHCON TARGETSTRING)
collect (MKSTRING (CHARACTER X]
collect X when (LITATOM X))
(\TEDIT.PARSE.SEARCHSTRING
(for X in (CHCON TARGETSTRING)
collect (MKSTRING (CHARACTER X] collect X
when (LITATOM X))
(SETQ RESULT1 (\TEDIT.SUBST.FN1 TEXTOBJ TARGETLIST START#
REAL-END#)))
(* ;
 "If there are atoms, they are tedit wildcard chars")
(* ;
 "If there are atoms, they are tedit wildcard chars")
(\TEDIT.FIND.WC TEXTOBJ TARGETLIST RESULT1 REAL-END#))
(T (* ; "no wildcards but bounded search")
(T (* ; "no wildcards but bounded search")
(COND
((SETQ RESULT (TEDIT.FIND TEXTOBJ (CAR TARGETLIST)
START# REAL-END# NIL))
(LIST RESULT (SUB1 (IPLUS RESULT (NCHARS (CAR TARGETLIST]
(T (* ;
 "will return just the number of the start char or nil if not found")
(T (* ;
 "will return just the number of the start char or nil if not found")
(LET ((RESULT (\TEDIT.BASICFIND TEXTOBJ TARGETSTRING START# REAL-END#)))
(COND
((NULL REAL-END#)
@@ -203,26 +192,24 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1994, 2018 b
(T RESULT])
(TEDIT.NEW.FIND
[LAMBDA (TEXTOBJ TARGETSTRING START# END# WILDCARDS?) (* ; "Edited 23-Feb-88 11:13 by jds")
(* ;; "If WILDCARDS? is NIL then TEDIT.NEW.FIND is the old TEDIT.FIND. Else, it returns a list of (SEL.START# SEL.END#) which is the start and end char positions of the selection")
(* ;; "(PROG ((TEXTSTREAM (fetch STREAMHINT of TEXTOBJ)) PATTERN FIRSTPAT PATTERNSTACK POSNSTACK FIRSTCHAR1 FIRSTCHAR2 FIRSTPATNORMAL PATTERNLEN FOUND PATTERNPOS TEXTPOS) (AND TARGETSTRING (NOT (STRINGP TARGETSTRING)) (SETQ TARGETSTRING (MKSTRING TARGETSTRING))) (SETQ PATTERN (\TEDIT.NEW.PARSE.SEARCHSTRING TARGETSTRING)) (OR PATTERN (RETURN)) (SETQ PATTERNLEN (FLENGTH PATTERN)) (\TEDIT.HISTORYADD TEXTOBJ (create TEDITHISTORYEVENT THACTION _ (QUOTE Find) THAUXINFO _ TARGETSTRING)) (COND ((ZEROP (LOGAND \SpecialPattern (SETQ FIRSTPAT (CAR PATTERN)))) (* The pattern starts with an easy first character) (SETQ FIRSTPATNORMAL T) (SETQ FIRSTCHAR1 (LOGAND \CHARMASK FIRSTPAT)) (COND ((ZEROP (LOGAND \AlphaFlag FIRSTPAT)) (* Not alphabetic) (SETQ FIRSTCHAR2 FIRSTCHAR1)) (T (* Is alphabetic) (SETQ FIRSTCHAR2 (LOGAND FIRSTCHAR1 223)))))) (bind (CH# _ START#) while (ILEQ CH# END#) first (\SETUPGETCH START# TEXTOBJ) do (COND (FIRSTPATNORMAL (* The pattern starts with an easy first character) (COND ((AND (NEQ (SETQ CH (\BIN TEXTSTREAM)) FIRSTCHAR1) (NEW CH FIRSTCHAR2)) (GO $$ITERATE))) (SETQ PATTERNPOS 1) (SETQ CH (\BIN TEXTSTREAM))) (T (SETQ PATTERNPOS 0))) (SETQ TEXTPOS (\TEXTMARK TEXTOBJ)) (COND ((IGEQ PATTERNPOS PATTERNLEN) (SETQ FOUND T) (RETURN)))))")
[LAMBDA (TEXTOBJ TARGETSTRING START# END# WILDCARDS?) (* ; "Edited 23-Feb-88 11:13 by jds")
(* ;; "If WILDCARDS? is NIL then TEDIT.NEW.FIND is the old TEDIT.FIND. Else, it returns a list of (SEL.START# SEL.END#) which is the start and end char positions of the selection")
(* ;; "(PROG ((TEXTSTREAM (fetch STREAMHINT of TEXTOBJ)) PATTERN FIRSTPAT PATTERNSTACK POSNSTACK FIRSTCHAR1 FIRSTCHAR2 FIRSTPATNORMAL PATTERNLEN FOUND PATTERNPOS TEXTPOS) (AND TARGETSTRING (NOT (STRINGP TARGETSTRING)) (SETQ TARGETSTRING (MKSTRING TARGETSTRING))) (SETQ PATTERN (\TEDIT.NEW.PARSE.SEARCHSTRING TARGETSTRING)) (OR PATTERN (RETURN)) (SETQ PATTERNLEN (FLENGTH PATTERN)) (\TEDIT.HISTORYADD TEXTOBJ (create TEDITHISTORYEVENT THACTION _ (QUOTE Find) THAUXINFO _ TARGETSTRING)) (COND ((ZEROP (LOGAND \SpecialPattern (SETQ FIRSTPAT (CAR PATTERN)))) (* The pattern starts with an easy first character) (SETQ FIRSTPATNORMAL T) (SETQ FIRSTCHAR1 (LOGAND \CHARMASK FIRSTPAT)) (COND ((ZEROP (LOGAND \AlphaFlag FIRSTPAT)) (* Not alphabetic) (SETQ FIRSTCHAR2 FIRSTCHAR1)) (T (* Is alphabetic) (SETQ FIRSTCHAR2 (LOGAND FIRSTCHAR1 223)))))) (bind (CH# _ START#) while (ILEQ CH# END#) first (\SETUPGETCH START# TEXTOBJ) do (COND (FIRSTPATNORMAL (* The pattern starts with an easy first character) (COND ((AND (NEQ (SETQ CH (\BIN TEXTSTREAM)) FIRSTCHAR1) (NEW CH FIRSTCHAR2)) (GO $$ITERATE))) (SETQ PATTERNPOS 1) (SETQ CH (\BIN TEXTSTREAM))) (T (SETQ PATTERNPOS 0))) (SETQ TEXTPOS (\TEXTMARK TEXTOBJ)) (COND ((IGEQ PATTERNPOS PATTERNLEN) (SETQ FOUND T) (RETURN)))))")
(HELP])
(TEDIT.NEXT
[LAMBDA (STREAM) (* ; "Edited 30-May-91 20:57 by jds")
[LAMBDA (STREAM) (* ; "Edited 30-May-91 20:57 by jds")
(PROG ((TEXTOBJ (TEXTOBJ STREAM))
TARGET SEL OPTION FIELDSEL)
(SETQ SEL (fetch (TEXTOBJ SEL) of TEXTOBJ))
(SETQ TARGET (TEDIT.FIND TEXTOBJ ">>*<<" NIL NIL T))
(* find the first >>delimited<<
 field)
(* find the first >>delimited<< field)
(SETQ FIELDSEL (MBUTTON.FIND.NEXT.FIELD TEXTOBJ (fetch (SELECTION CH#) of SEL)))
(* find the first menu-type
 insertion field, usually delimited
 with {})
(* find the first menu-type insertion
 field, usually delimited with {})
[SETQ OPTION (COND
[(AND TARGET FIELDSEL) (* take the first one)
(COND
@@ -239,11 +226,10 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1994, 2018 b
(\SHOWSEL SEL NIL NIL)
(replace (SELECTION CH#) of SEL with (CAR TARGET))
(* Set up SELECTION to be the found
 text)
 text)
(replace (SELECTION CHLIM) of SEL with (ADD1 (CADR TARGET)))
(replace (SELECTION DCH) of SEL with (IDIFFERENCE
(ADD1 (CADR TARGET))
(CAR TARGET)))
(replace (SELECTION DCH) of SEL with (IDIFFERENCE (ADD1 (CADR TARGET))
(CAR TARGET)))
(replace (SELECTION POINT) of SEL with 'RIGHT)
(\TEDIT.SET.SEL.LOOKS SEL 'PENDINGDEL) (* Always selected normally)
(replace (TEXTOBJ BLUEPENDINGDELETE) of TEXTOBJ with T)
@@ -253,18 +239,14 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1994, 2018 b
(\SHOWSEL SEL NIL T) (* And get it into the window)
)
(FIELD (* Replace the selection for this
 textobj with the scratch sel
 returned from
 MBUTTON.FIND.NEXT.FIELD)
 textobj with the scratch sel returned
 from MBUTTON.FIND.NEXT.FIELD)
(\SHOWSEL SEL NIL NIL)
(replace (SELECTION CH#) of SEL with (fetch (SELECTION CH#)
of FIELDSEL))
(replace (SELECTION CH#) of SEL with (fetch (SELECTION CH#) of FIELDSEL))
(* Set up SELECTION to be the found
 text)
(replace (SELECTION CHLIM) of SEL with (fetch (SELECTION CHLIM)
of FIELDSEL))
(replace (SELECTION DCH) of SEL with (fetch (SELECTION DCH)
of FIELDSEL))
 text)
(replace (SELECTION CHLIM) of SEL with (fetch (SELECTION CHLIM) of FIELDSEL))
(replace (SELECTION DCH) of SEL with (fetch (SELECTION DCH) of FIELDSEL))
(replace (SELECTION POINT) of SEL with 'LEFT)
(\TEDIT.SET.SEL.LOOKS SEL 'PENDINGDEL)
(replace (TEXTOBJ BLUEPENDINGDELETE) of TEXTOBJ with T)
@@ -279,16 +261,15 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1994, 2018 b
(SEL
(* There really IS a selection made here, so set up the charlooks for it
 properly.)
 properly.)
(replace (TEXTOBJ CARETLOOKS) of TEXTOBJ with (
\TEDIT.GET.INSERT.CHARLOOKS
TEXTOBJ SEL])
(replace (TEXTOBJ CARETLOOKS) of TEXTOBJ with (\TEDIT.GET.INSERT.CHARLOOKS TEXTOBJ
SEL])
(\TEDIT.FIND.WC
[LAMBDA (TEXTOBJ TARGETLIST START# END#) (* ; "Edited 9-Dec-88 09:56 by jds")
[LAMBDA (TEXTOBJ TARGETLIST START# END#) (* ; "Edited 9-Dec-88 09:56 by jds")
(* ;
 "\TEDIT.FIND.WC returns the end char # of the TARGETLIST which may contain wildcards")
 "\TEDIT.FIND.WC returns the end char # of the TARGETLIST which may contain wildcards")
(PROG (RESULT RESULT1)
(RETURN (COND
((SETQ RESULT (\TEDIT.FIND.WC1 TEXTOBJ TARGETLIST START# END#))
@@ -301,11 +282,11 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1994, 2018 b
(\TEDIT.FIND.WC TEXTOBJ TARGETLIST RESULT1 END#])
(\TEDIT.FIND.WC1
[LAMBDA (TEXTOBJ TARGETLIST TRIALEND# END#) (* ; "Edited 9-Dec-88 09:52 by jds")
[LAMBDA (TEXTOBJ TARGETLIST TRIALEND# END#) (* ; "Edited 9-Dec-88 09:52 by jds")
(* ;
 "TRIALEND# is where the next char string should go")
 "TRIALEND# is where the next char string should go")
(* ;
 "\TEDIT.FIND.WC1 should return the lastchar# of selection")
 "\TEDIT.FIND.WC1 should return the lastchar# of selection")
(PROG (RESULT RESULT1)
(RETURN (COND
((NULL TARGETLIST) (* ; "DONE!")
@@ -324,22 +305,20 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1994, 2018 b
'(%#)) (* ; "fixed width wildcard")
(COND
((OR (NULL (CDR TARGETLIST))
(EQUAL (CAR (TEDIT.FIND TEXTOBJ (CONCATLIST (
 \TEDIT.PACK.TARGETLIST
(CDR TARGETLIST)))
(EQUAL (CAR (TEDIT.FIND TEXTOBJ (CONCATLIST (\TEDIT.PACK.TARGETLIST
(CDR TARGETLIST)))
(ADD1 TRIALEND#)
END# T))
(ADD1 TRIALEND#))) (* ;
 "If the next start after a fixed char is the char after it, OK. else return nil")
 "If the next start after a fixed char is the char after it, OK. else return nil")
(\TEDIT.FIND.WC1 TEXTOBJ (CDR TARGETLIST)
(ADD1 TRIALEND#)
END#]
(T (* ; "variable width wildcard")
(COND
((CDR TARGETLIST)
(SETQ RESULT1 (TEDIT.FIND TEXTOBJ (CONCATLIST (
 \TEDIT.PACK.TARGETLIST
(CDR TARGETLIST)))
(SETQ RESULT1 (TEDIT.FIND TEXTOBJ (CONCATLIST (\TEDIT.PACK.TARGETLIST
(CDR TARGETLIST)))
TRIALEND# END# T))
(AND RESULT1 (CADR RESULT1)))
(T (* ; "last element of search")
@@ -347,7 +326,6 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1994, 2018 b
(\TEDIT.PACK.TARGETLIST
[LAMBDA (TARGETLIST) (* ; "Edited 24-Sep-87 09:54 by jds")
(COND
((NULL TARGETLIST)
NIL)
@@ -360,26 +338,25 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1994, 2018 b
(CONS (CAR TARGETLIST)
(\TEDIT.PACK.TARGETLIST (CDR TARGETLIST]
(T (* ; "wildcard")
(CONS (MKSTRING (CAR TARGETLIST))
(\TEDIT.PACK.TARGETLIST (CDR TARGETLIST])
(\TEDIT.PARSE.SEARCHSTRING
(LAMBDA (LST RESULT) (* jds "31-Jan-84 13:26")
(PROG ((TEDIT.WILDCARD.CHARACTERS '("#" "*")))
[LAMBDA (LST RESULT) (* jds "31-Jan-84 13:26")
(PROG [(TEDIT.WILDCARD.CHARACTERS '("#" "*"]
(RETURN (COND
((NULL LST)
[(NULL LST)
(COND
(RESULT (LIST RESULT))))
((MEMBER (CAR LST)
(RESULT (LIST RESULT]
[(MEMBER (CAR LST)
TEDIT.WILDCARD.CHARACTERS)
(COND
((NULL RESULT)
[(NULL RESULT)
(CONS (MKATOM (CAR LST))
(\TEDIT.PARSE.SEARCHSTRING (CDR LST))))
(\TEDIT.PARSE.SEARCHSTRING (CDR LST]
(T (APPEND (LIST RESULT (MKATOM (CAR LST)))
(\TEDIT.PARSE.SEARCHSTRING (CDR LST))))))
((AND (EQUAL (CAR LST)
(\TEDIT.PARSE.SEARCHSTRING (CDR LST]
[(AND (EQUAL (CAR LST)
"'")
(LISTP (CDR LST))
(MEMBER (CADR LST)
@@ -388,28 +365,27 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1994, 2018 b
(COND
((NULL RESULT)
(MKSTRING (CADR LST)))
(T (CONCAT RESULT (MKSTRING (CADR LST)))))))
(T (CONCAT RESULT (MKSTRING (CADR LST]
(T (\TEDIT.PARSE.SEARCHSTRING (CDR LST)
(COND
((NULL RESULT)
(CAR LST))
(T (CONCAT RESULT (CAR LST)))))))))))
(T (CONCAT RESULT (CAR LST])
(\TEDIT.SUBST.FN1
[LAMBDA (TEXTOBJ TARGETLIST START# END#) (* ; "Edited 3-Sep-87 11:38 by jds")
(* ;
 "returns the char location that would match the beginning element of a targetlist")
(PROG (RESULT)
(SETQ RESULT (\TEDIT.SUBST.FN2 TEXTOBJ TARGETLIST START# END#))
(RETURN (AND RESULT (IGEQ RESULT START#)
RESULT])
(\TEDIT.SUBST.FN2
[LAMBDA (TEXTOBJ TARGETLIST TRIALSTART# END#) (* ; "Edited 9-Dec-88 09:54 by jds")
[LAMBDA (TEXTOBJ TARGETLIST TRIALSTART# END#) (* ; "Edited 9-Dec-88 09:54 by jds")
(* ;;
 "will return the start char of a wildcarded selection. returns NIL if selection is beyond bounds")
 "will return the start char of a wildcarded selection. returns NIL if selection is beyond bounds")
(* ;; "TARGETLIST is (what)?")
@@ -428,7 +404,7 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1994, 2018 b
END#))
(SUB1 SUB-FIND-RESULT)))
(T (* ;
 "variable width wildcard, so forget them")
 "variable width wildcard, so forget them")
(\TEDIT.SUBST.FN2 TEXTOBJ (CDR TARGETLIST)
TRIALSTART# END#]
(T (* ; "it's a string")
@@ -436,7 +412,7 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1994, 2018 b
TRIALSTART# END# NIL])
(TEDIT.SUBSTITUTE
[LAMBDA (TEXTSTREAM PATTERN REPLACEMENT CONFIRM?) (* ; "Edited 30-Mar-94 16:04 by jds")
[LAMBDA (TEXTSTREAM PATTERN REPLACEMENT CONFIRM?) (* ; "Edited 30-Mar-94 16:04 by jds")
(* ;; "Replace all instances of PATTERN with REPLACEMENT. If CONFIRM? is non-NIL, ask before each replacement.")
@@ -451,7 +427,7 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1994, 2018 b
'TEDIT.LAST.SUBSTITUTE.STRING)
(CHARCODE (EOL LF ESC]
(* ;
 "If the search pattern is empty, bail out.")
 "If the search pattern is empty, bail out.")
(TEDIT.PROMPTPRINT TEXTOBJ "[Aborted]")
(RETURN)))
[SETQ REPLACESTRING (OR REPLACEMENT (TEDIT.GETINPUT TEXTOBJ "Replace string:"
@@ -462,142 +438,134 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1994, 2018 b
((STRINGP REPLACESTRING)
(SETQ REPLACE-LEN (NCHARS REPLACESTRING)))
((LISTP REPLACESTRING) (* ;
 "It's a list of pieces, meaning insert these pieces as the replacement.")
(SETQ REPLACE-LEN (for PC in REPLACESTRING sum (fetch (PIECE PLEN)
of PC]
 "It's a list of pieces, meaning insert these pieces as the replacement.")
(SETQ REPLACE-LEN (for PC in REPLACESTRING sum (fetch (PIECE PLEN) of PC]
(SETQ CRSEEN (AND REPLACESTRING (STRINGP REPLACESTRING)
(STRPOS (CHARACTER (CHARCODE CR))
REPLACESTRING)))
[COND
(PATTERN (* ;
 "If a pattern is specd in the call, use the caller's confirm flag.")
 "If a pattern is specd in the call, use the caller's confirm flag.")
(SETQ CONFIRMFLG CONFIRM?))
(T (* ; "Otherwise, ask for one.")
(SETQ CONFIRMFLG (MEMBER (TEDIT.GETINPUT TEXTOBJ "Ask before each replace?" "No"
(CHARCODE (EOL SPACE ESCAPE LF TAB)))
YESLIST]
(TEDIT.PROMPTPRINT TEXTOBJ "Substituting..." T)
(SETQ SEL (fetch (TEXTOBJ SEL) of TEXTOBJ))(* ;
 "STARTCHAR# and ENDCHAR# are the bound of the search")
(SETQ SEL (fetch (TEXTOBJ SEL) of TEXTOBJ)) (* ;
 "STARTCHAR# and ENDCHAR# are the bound of the search")
(\SHOWSEL SEL NIL NIL)
(TEDIT.RESET.EXTEND.PENDING.DELETE SEL) (* ;
 "Turn off any blue pending delete")
(TEDIT.RESET.EXTEND.PENDING.DELETE SEL) (* ; "Turn off any blue pending delete")
(SETQ BEGINCHAR# (SETQ STARTCHAR# (fetch (SELECTION CH#) of SEL)))
[SETQ ENDCHAR# (IPLUS STARTCHAR# (SUB1 (fetch (SELECTION DCH) of SEL]
(while (AND (SETQ RANGE (TEDIT.FIND TEXTOBJ SEARCHSTRING STARTCHAR# ENDCHAR# T))
(NOT ABORTFLG))
(NOT ABORTFLG))
do [PROG (PENDING.SEL CHOICE)
(COND
[CONFIRMFLG (SETQ PENDING.SEL (TEDIT.SETSEL TEXTSTREAM (CAR RANGE)
(IDIFFERENCE (CADR RANGE)
(SUB1 (CAR RANGE)))
'RIGHT T))
(\SHOWSEL PENDING.SEL NIL NIL)
(TEDIT.NORMALIZECARET TEXTOBJ PENDING.SEL)
(\SHOWSEL PENDING.SEL NIL T)
[SETQ CHOICE (TEDIT.GETINPUT TEXTOBJ "OK to replace? ['q' quits]"
"Yes" (CHARCODE (EOL SPACE ESCAPE LF TAB]
(COND
((MEMBER CHOICE '("Q" "q"))
(SETQ ABORTFLG T)
(GO L1))
((NOT (MEMBER CHOICE YESLIST))
(COND
[CONFIRMFLG (SETQ PENDING.SEL (TEDIT.SETSEL TEXTSTREAM (CAR RANGE)
(IDIFFERENCE (CADR RANGE)
(SUB1 (CAR RANGE)))
'RIGHT T))
(\SHOWSEL PENDING.SEL NIL NIL)
(TEDIT.NORMALIZECARET TEXTOBJ PENDING.SEL)
(\SHOWSEL PENDING.SEL NIL T)
[SETQ CHOICE (TEDIT.GETINPUT TEXTOBJ "OK to replace? ['q' quits]"
"Yes" (CHARCODE (EOL SPACE ESCAPE LF TAB]
(COND
((MEMBER CHOICE '("Q" "q"))
(SETQ ABORTFLG T)
(GO L1))
((NOT (MEMBER CHOICE YESLIST))
(* ; "turn off selection")
(TEDIT.SHOWSEL TEXTSTREAM NIL PENDING.SEL)
(GO L1))
(T (* ; "OK to replace")
(TEDIT.DELETE TEXTSTREAM PENDING.SEL)
(TEDIT.SHOWSEL TEXTSTREAM NIL PENDING.SEL)
(GO L1))
(T (* ; "OK to replace")
(TEDIT.DELETE TEXTSTREAM PENDING.SEL)
(* ; "make the replacement")
(* ;;;; "This is just wrong in this clause: (COND ((AND REPLACESTRING (NOT (EQUAL REPLACESTRING %"%"))) (* ; %"If the replacestring is nothing, why bother to add nothing%") (TEDIT.INSERT TEXTSTREAM REPLACESTRING (CAR RANGE)) (SETQ ENDCHAR# (IPLUS ENDCHAR# (IDIFFERENCE (NCHARS REPLACESTRING) (IDIFFERENCE (CADR RANGE) (SUB1 (CAR RANGE)))))) (add REPLACEDFLG 1)))")
[AND REPLACESTRING
(OR (IEQP REPLACE-LEN 0)
(COND
((LISTP REPLACESTRING)
[AND REPLACESTRING
(OR (IEQP REPLACE-LEN 0)
(COND
((LISTP REPLACESTRING)
(* ; "INSERT A RUN OF PIECES")
(\TEDIT.INSERT.PIECES
TEXTOBJ
(CAR RANGE)
(for PC in REPLACESTRING
collect (\TEDIT.COPY.PIECEMAPFN PC
TEXTOBJ TEXTOBJ TEXTOBJ
))
REPLACE-LEN NIL NIL T NIL T)
(add (fetch (TEXTOBJ TEXTLEN)
of TEXTOBJ)
REPLACE-LEN))
(T (TEDIT.INSERT TEXTSTREAM REPLACESTRING
(CAR RANGE]
[SETQ ENDCHAR# (IPLUS ENDCHAR#
(IDIFFERENCE
(OR (AND REPLACESTRING REPLACE-LEN)
0)
(IDIFFERENCE (CADR RANGE)
(\TEDIT.INSERT.PIECES TEXTOBJ (CAR RANGE)
(for PC in REPLACESTRING
collect (\TEDIT.COPY.PIECEMAPFN PC
TEXTOBJ TEXTOBJ TEXTOBJ))
REPLACE-LEN NIL NIL T NIL T)
(add (fetch (TEXTOBJ TEXTLEN) of TEXTOBJ)
REPLACE-LEN))
(T (TEDIT.INSERT TEXTSTREAM REPLACESTRING
(CAR RANGE]
[SETQ ENDCHAR# (IPLUS ENDCHAR#
(IDIFFERENCE (OR (AND REPLACESTRING
REPLACE-LEN)
0)
(IDIFFERENCE (CADR RANGE)
(SUB1 (CAR RANGE]
(add REPLACEDFLG 1]
(T (* ;
 "No confirmation required. Do the substitutions without showing intermediate work")
[replace (TEXTOBJ CARETLOOKS) of TEXTOBJ
with (fetch (PIECE PLOOKS) of (\CHTOPC (CAR RANGE)
(fetch (TEXTOBJ PCTB)
of TEXTOBJ]
(SETQ PC# (\DELETECH (CAR RANGE)
(ADD1 (CADR RANGE))
(ADD1 (IDIFFERENCE (CADR RANGE)
(CAR RANGE)))
TEXTOBJ))
(\FIXDLINES (fetch (TEXTOBJ LINES) of TEXTOBJ)
SEL
(CAR RANGE)
(ADD1 (CADR RANGE))
TEXTOBJ)
[SETQ ENDCHAR# (IDIFFERENCE ENDCHAR# (IDIFFERENCE (CADR RANGE)
(SUB1 (CAR RANGE]
(add REPLACEDFLG 1]
(T (* ;
 "No confirmation required. Do the substitutions without showing intermediate work")
[replace (TEXTOBJ CARETLOOKS) of TEXTOBJ
with (fetch (PIECE PLOOKS)
of (\CHTOPC (CAR RANGE)
(fetch (TEXTOBJ PCTB) of TEXTOBJ
]
(SETQ PC# (\DELETECH (CAR RANGE)
(ADD1 (CADR RANGE))
(ADD1 (IDIFFERENCE (CADR RANGE)
(CAR RANGE)))
TEXTOBJ))
(\FIXDLINES (fetch (TEXTOBJ LINES) of TEXTOBJ)
SEL
(CAR RANGE)
(ADD1 (CADR RANGE))
TEXTOBJ)
[SETQ ENDCHAR# (IDIFFERENCE ENDCHAR# (IDIFFERENCE (CADR RANGE)
(SUB1 (CAR RANGE]
(* ;
 "Take the length of what we're removing off the end-location, so we don't search too far.")
 "Take the length of what we're removing off the end-location, so we don't search too far.")
(COND
((AND REPLACESTRING (NOT (EQUAL REPLACESTRING "")))
(* ;
 "If the replacestring is nothing, why bother to add nothing")
(\FIXILINES TEXTOBJ SEL (CAR RANGE)
REPLACE-LEN
(fetch (TEXTOBJ TEXTLEN) of TEXTOBJ))
(COND
((AND REPLACESTRING (NOT (EQUAL REPLACESTRING "")))
[CRSEEN (for ACHAR instring REPLACESTRING as NCH#
from (CAR RANGE) by 1
do (SELCHARQ ACHAR
(CR (\INSERTCR ACHAR NCH# TEXTOBJ))
(\INSERTCH ACHAR NCH# TEXTOBJ]
((LISTP REPLACESTRING) (* ; "INSERT A RUN OF PIECES")
(\TEDIT.INSERT.PIECES TEXTOBJ (CAR RANGE)
(for PC in REPLACESTRING
collect (\TEDIT.COPY.PIECEMAPFN PC TEXTOBJ TEXTOBJ
TEXTOBJ))
REPLACE-LEN NIL NIL T NIL T)
(add (fetch (TEXTOBJ TEXTLEN) of TEXTOBJ)
REPLACE-LEN))
(T (\INSERTCH REPLACESTRING (CAR RANGE)
TEXTOBJ)))
(SETQ ENDCHAR# (IPLUS ENDCHAR# REPLACE-LEN))
(* ;
 "If the replacestring is nothing, why bother to add nothing")
(\FIXILINES TEXTOBJ SEL (CAR RANGE)
REPLACE-LEN
(fetch (TEXTOBJ TEXTLEN) of TEXTOBJ))
(COND
[CRSEEN (for ACHAR instring REPLACESTRING as
NCH#
from (CAR RANGE) by 1
do (SELCHARQ ACHAR
(CR (\INSERTCR ACHAR NCH# TEXTOBJ))
(\INSERTCH ACHAR NCH# TEXTOBJ]
((LISTP REPLACESTRING)(* ; "INSERT A RUN OF PIECES")
(\TEDIT.INSERT.PIECES TEXTOBJ (CAR RANGE)
(for PC in REPLACESTRING
collect (\TEDIT.COPY.PIECEMAPFN PC TEXTOBJ
TEXTOBJ TEXTOBJ))
REPLACE-LEN NIL NIL T NIL T)
(add (fetch (TEXTOBJ TEXTLEN) of TEXTOBJ)
REPLACE-LEN))
(T (\INSERTCH REPLACESTRING (CAR RANGE)
TEXTOBJ)))
(SETQ ENDCHAR# (IPLUS ENDCHAR# REPLACE-LEN))
(* ;
 "Now add the length of the replacement string into the ending position, so we go far enough.")
))
(add REPLACEDFLG 1)))
[SETQ STARTCHAR# (COND
(REPLACESTRING (IPLUS (CAR RANGE)
REPLACE-LEN))
(T (CAR RANGE]
(RETURN)
L1
 "Now add the length of the replacement string into the ending position, so we go far enough.")
))
(add REPLACEDFLG 1)))
[SETQ STARTCHAR# (COND
(REPLACESTRING (IPLUS (CAR RANGE)
REPLACE-LEN))
(T (CAR RANGE]
(RETURN)
L1
(* ;;
 "12/12/88 Should only look at REPLACESTRING when there has been a replacement.")
(* ;;
 "12/12/88 Should only look at REPLACESTRING when there has been a replacement.")
(SETQ STARTCHAR# (ADD1 (CAR RANGE] (* ;
 "start looking where you left off"))
(SETQ STARTCHAR# (ADD1 (CAR RANGE] (* ; "start looking where you left off")
)
(* ;; "Save the search & replacement strings to offer for next time:")
@@ -620,17 +588,14 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1994, 2018 b
(COND
((AND (NOT CONFIRMFLG)
(NOT (ZEROP REPLACEDFLG))) (* ;
 "There WERE replacements, and they were not confirmed.")
 "There WERE replacements, and they were not confirmed.")
(replace (SELECTION CHLIM) of SEL with (ADD1 ENDCHAR#))
(* ;
 "account for the changes in selection length due to replacements")
 "account for the changes in selection length due to replacements")
(replace (SELECTION CH#) of SEL with BEGINCHAR#)
(* ; "And remember where it started")
(replace (SELECTION DCH) of SEL with (IDIFFERENCE (fetch (SELECTION
CHLIM)
of SEL)
(fetch (SELECTION CH#)
of SEL)))
(replace (SELECTION DCH) of SEL with (IDIFFERENCE (fetch (SELECTION CHLIM) of SEL)
(fetch (SELECTION CH#) of SEL)))
(\TEDIT.MARK.LINES.DIRTY TEXTOBJ (fetch (SELECTION CH#) of SEL)
(fetch (SELECTION CHLIM) of SEL))
(TEDIT.UPDATE.SCREEN TEXTOBJ)
@@ -638,12 +603,10 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1994, 2018 b
(\SHOWSEL SEL NIL T)))
(RETURN REPLACEDFLG])
)
(PUTPROPS TEDITFIND COPYRIGHT ("Venue & Xerox Corporation" 1983 1984 1985 1986 1987 1988 1989 1990
1991 1994 2018))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (1472 2819 (\TEDIT.SEARCH.CODETABLE 1482 . 2817)) (2894 39960 (\TEDIT.BASICFIND 2904 .
6485) (TEDIT.FIND 6487 . 11084) (TEDIT.NEW.FIND 11086 . 12716) (TEDIT.NEXT 12718 . 17715) (
\TEDIT.FIND.WC 17717 . 18692) (\TEDIT.FIND.WC1 18694 . 21673) (\TEDIT.PACK.TARGETLIST 21675 . 22370) (
\TEDIT.PARSE.SEARCHSTRING 22372 . 23949) (\TEDIT.SUBST.FN1 23951 . 24438) (\TEDIT.SUBST.FN2 24440 .
25816) (TEDIT.SUBSTITUTE 25818 . 39958)))))
(FILEMAP (NIL (1329 2662 (\TEDIT.SEARCH.CODETABLE 1339 . 2660)) (2737 37775 (\TEDIT.BASICFIND 2747 .
6376) (TEDIT.FIND 6378 . 10740) (TEDIT.NEW.FIND 10742 . 12344) (TEDIT.NEXT 12346 . 16787) (
\TEDIT.FIND.WC 16789 . 17770) (\TEDIT.FIND.WC1 17772 . 20589) (\TEDIT.PACK.TARGETLIST 20591 . 21284) (
\TEDIT.PARSE.SEARCHSTRING 21286 . 22831) (\TEDIT.SUBST.FN1 22833 . 23319) (\TEDIT.SUBST.FN2 23321 .
24705) (TEDIT.SUBSTITUTE 24707 . 37773)))))
STOP

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

Binary file not shown.

304
library/TEDITFNKEYS → library/tedit/TEDIT-FNKEYS
View File

@@ -1,26 +1,21 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10 FORMAT XCCS)
(FILECREATED " 8-Aug-2021 21:28:17" 
{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>TEDITFNKEYS.;2 30663
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
changes to%: (VARS TEDITFNKEYSCOMS)
(FILECREATED "14-Jul-2022 16:55:47" 
{DSK}<users>kaplan>local>medley3.5>working-medley>library>tedit>TEDIT-FNKEYS.;1 29919
previous date%: " 6-May-2018 17:15:13"
{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>TEDITFNKEYS.;1)
:PREVIOUS-DATE "14-Jul-2022 11:08:01"
{DSK}<users>kaplan>local>medley3.5>working-medley>library>newtedit>TEDIT-FNKEYS.;2)
(* ; "
Copyright (c) 1985-1987, 1990-1991, 1994, 2018, 2021 by Venue & Xerox Corporation.
")
(PRETTYCOMPRINT TEDIT-FNKEYSCOMS)
(PRETTYCOMPRINT TEDITFNKEYSCOMS)
(RPAQQ TEDITFNKEYSCOMS
((FILES TEDITDCL)
(RPAQQ TEDIT-FNKEYSCOMS
((FILES TEDIT-DCL)
(DECLARE%: EVAL@COMPILE DONTCOPY (CONSTANTS (\SCRATCHLEN 64))
(FILES (LOADCOMP)
TEDITDCL))
TEDIT-DCL))
(COMS
(* ;; "Functions that actually implement the commands for the function keys:")
(* ;; "Functions that actually implement the commands for the function keys:")
(FNS \TEDIT.BOLD.SEL.OFF \TEDIT.BOLD.SEL.ON \TEDIT.CENTER.SEL \TEDIT.CENTER.SEL.REV
\TEDIT.DEFAULTS.CARET \TEDIT.DEFAULTSSEL \TEDIT.SETDEFAULT.FROM.SEL \TEDIT.FIND
@@ -30,14 +25,14 @@ Copyright (c) 1985-1987, 1990-1991, 1994, 2018, 2021 by Venue & Xerox Corporatio
\TEDIT.UNDERLINE.SEL.ON \TEDIT.STRIKEOUT.SEL.ON \TEDIT.STRIKEOUT.SEL.OFF
\TEDIT.SELECT.ALL))
(COMS
(* ;; "Auxiliary functions used in the above main functions:")
(* ;; "Auxiliary functions used in the above main functions:")
(FNS \TEDIT.BOLD.CARET.OFF \TEDIT.BOLD.CARET.ON \TEDIT.ITALIC.CARET.OFF
\TEDIT.ITALIC.CARET.ON \TEDIT.LARGER.CARET \TEDIT.SMALLER.CARET
\TEDIT.SUBSCRIPT.CARET \TEDIT.SUPERSCRIPT.CARET \TEDIT.UNDERLINE.CARET.OFF
\TEDIT.UNDERLINE.CARET.ON \TEDIT.STRIKEOUT.CARET.OFF \TEDIT.STRIKEOUT.CARET.ON))
(COMS (* ;
 "little selection utilities etc., for building hacks")
(COMS (* ;
 "little selection utilities etc., for building hacks")
(FNS \SEL.LIMIT \SEL.LINEDESC \TK.DESCRIBEFONT \PARAS.IN.SEL))
[VARS (TEDIT.FNKEY.VERBOSE T)
(\TEDIT.KEYS '(("Function,^D" UNDO)
@@ -88,12 +83,12 @@ Copyright (c) 1985-1987, 1990-1991, 1994, 2018, 2021 by Venue & Xerox Corporatio
(CADDR ENTRY)))
(TEDIT.SETSYNTAX (CAR ENTRY)
(CADR ENTRY]
(* ; "Original was %"(FOR ENTRY IN \TEDIT.KEYS DO (SELECTQ (CADR ENTRY) (FN (TEDIT.SETFUNCTION (CAR ENTRY) (CADDR ENTRY))) (TEDIT.SETSYNTAX (CAR ENTRY) (CADR ENTRY))))%".")
(* ;
 "Changed by yabu.fx, for SUNLOADUP without DWIM.")
(* ; "Original was %"(FOR ENTRY IN \TEDIT.KEYS DO (SELECTQ (CADR ENTRY) (FN (TEDIT.SETFUNCTION (CAR ENTRY) (CADDR ENTRY))) (TEDIT.SETSYNTAX (CAR ENTRY) (CADR ENTRY))))%".")
(* ;
 "Changed by yabu.fx, for SUNLOADUP without DWIM.")
))
(FILESLOAD TEDITDCL)
(FILESLOAD TEDIT-DCL)
(DECLARE%: EVAL@COMPILE DONTCOPY
(DECLARE%: EVAL@COMPILE
@@ -105,7 +100,7 @@ Copyright (c) 1985-1987, 1990-1991, 1994, 2018, 2021 by Venue & Xerox Corporatio
(FILESLOAD (LOADCOMP)
TEDITDCL)
TEDIT-DCL)
)
@@ -115,23 +110,25 @@ Copyright (c) 1985-1987, 1990-1991, 1994, 2018, 2021 by Venue & Xerox Corporatio
(DEFINEQ
(\TEDIT.BOLD.SEL.OFF
[LAMBDA (TEXTSTREAM TEXTOBJ SEL CHARCODE) (* ; "Edited 6-Nov-87 11:00 by jds")
(* ;; "Turn boldness off for the selected characters, and for future type-in.")
[LAMBDA (TEXTSTREAM TEXTOBJ SEL CHARCODE) (* ; "Edited 6-Nov-87 11:00 by jds")
(* ;; "Turn boldness off for the selected characters, and for future type-in.")
(\TEDIT.BOLD.CARET.OFF TEXTSTREAM TEXTOBJ SEL)
(TEDIT.LOOKS TEXTSTREAM '(WEIGHT MEDIUM) SEL])
(TEDIT.LOOKS TEXTSTREAM '(WEIGHT MEDIUM)
SEL])
(\TEDIT.BOLD.SEL.ON
[LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* ; "Edited 6-Nov-87 11:00 by jds")
(* ;; "Turn boldness on for selected characters and for future type-in.")
[LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* ; "Edited 6-Nov-87 11:00 by jds")
(* ;; "Turn boldness on for selected characters and for future type-in.")
(\TEDIT.BOLD.CARET.ON TEXTSTREAM TEXTOBJ SEL)
(TEDIT.LOOKS TEXTSTREAM '(WEIGHT BOLD) SEL])
(TEDIT.LOOKS TEXTSTREAM '(WEIGHT BOLD)
SEL])
(\TEDIT.CENTER.SEL
[LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* ; "Edited 30-May-91 21:05 by jds")
[LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* ; "Edited 30-May-91 21:05 by jds")
(* ;; "makes the current paragraph centered")
@@ -139,19 +136,19 @@ Copyright (c) 1985-1987, 1990-1991, 1994, 2018, 2021 by Venue & Xerox Corporatio
(SAVEDCH (fetch (SELECTION DCH) of SEL)))
(for PARA in (\PARAS.IN.SEL SEL TEXTOBJ)
do (SETQ LOOKS (TEDIT.GET.PARALOOKS TEXTSTREAM PARA))
(SETQ OLDQUAD (LISTGET LOOKS 'QUAD))
[SETQ NEWQUAD (CADR (MEMB OLDQUAD (CONSTANT '(LEFT JUSTIFIED CENTERED LEFT]
(LISTPUT LOOKS 'QUAD NEWQUAD)
(SETQ PARASEL (TEDIT.SETSEL TEXTSTREAM PARA 1))
(TEDIT.PARALOOKS TEXTSTREAM LOOKS PARASEL)
(push NEWQUADS NEWQUAD))
(SETQ OLDQUAD (LISTGET LOOKS 'QUAD))
[SETQ NEWQUAD (CADR (MEMB OLDQUAD (CONSTANT '(LEFT JUSTIFIED CENTERED LEFT]
(LISTPUT LOOKS 'QUAD NEWQUAD)
(SETQ PARASEL (TEDIT.SETSEL TEXTSTREAM PARA 1))
(TEDIT.PARALOOKS TEXTSTREAM LOOKS PARASEL)
(push NEWQUADS NEWQUAD))
(TEDIT.SETSEL TEXTSTREAM SAVECH# SAVEDCH)
(COND
(TEDIT.FNKEY.VERBOSE (TEDIT.PROMPTPRINT TEXTSTREAM (DREVERSE NEWQUADS)
T])
(\TEDIT.CENTER.SEL.REV
[LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* ; "Edited 30-May-91 21:05 by jds")
[LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* ; "Edited 30-May-91 21:05 by jds")
(* ;; "acts like center.sel but cycles in the opposite direction")
@@ -159,21 +156,21 @@ Copyright (c) 1985-1987, 1990-1991, 1994, 2018, 2021 by Venue & Xerox Corporatio
(SAVEDCH (fetch (SELECTION DCH) of SEL)))
(for PARA in (\PARAS.IN.SEL SEL TEXTOBJ)
do (SETQ LOOKS (TEDIT.GET.PARALOOKS TEXTSTREAM PARA))
(SETQ OLDQUAD (LISTGET LOOKS 'QUAD))
[SETQ NEWQUAD (CADR (MEMB OLDQUAD (CONSTANT '(LEFT CENTERED JUSTIFIED LEFT]
(LISTPUT LOOKS 'QUAD NEWQUAD)
(SETQ PARASEL (TEDIT.SETSEL TEXTSTREAM PARA 1))
(TEDIT.PARALOOKS TEXTSTREAM LOOKS PARASEL)
(push NEWQUADS NEWQUAD))
(SETQ OLDQUAD (LISTGET LOOKS 'QUAD))
[SETQ NEWQUAD (CADR (MEMB OLDQUAD (CONSTANT '(LEFT CENTERED JUSTIFIED LEFT]
(LISTPUT LOOKS 'QUAD NEWQUAD)
(SETQ PARASEL (TEDIT.SETSEL TEXTSTREAM PARA 1))
(TEDIT.PARALOOKS TEXTSTREAM LOOKS PARASEL)
(push NEWQUADS NEWQUAD))
(TEDIT.SETSEL TEXTSTREAM SAVECH# SAVEDCH)
(COND
(TEDIT.FNKEY.VERBOSE (TEDIT.PROMPTPRINT TEXTSTREAM (DREVERSE NEWQUADS)
T])
(\TEDIT.DEFAULTS.CARET
(LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* jds "21-Sep-85 11:24")
[LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* jds "21-Sep-85 11:24")
(PROGN (TEDIT.CARETLOOKS TEXTSTREAM (create CHARLOOKS using TEDIT.DEFAULT.CHARLOOKS))
(\TEDIT.SHOWCARETLOOKS TEXTSTREAM TEXTOBJ SEL))))
(\TEDIT.SHOWCARETLOOKS TEXTSTREAM TEXTOBJ SEL])
(\TEDIT.DEFAULTSSEL
[LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* ; "Edited 20-Oct-87 11:12 by jds")
@@ -182,21 +179,21 @@ Copyright (c) 1985-1987, 1990-1991, 1994, 2018, 2021 by Venue & Xerox Corporatio
SEL])
(\TEDIT.SETDEFAULT.FROM.SEL
(LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* jds " 8-Nov-85 15:22")
[LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* jds " 8-Nov-85 15:22")
(* Set the defaults from the current
 selection.)
(PROG ((LOOKS (TEDIT.GET.LOOKS TEXTSTREAM SEL)))
(SETQ TEDIT.DEFAULT.CHARLOOKS (\TEDIT.PARSE.CHARLOOKS.LIST LOOKS)))))
(SETQ TEDIT.DEFAULT.CHARLOOKS (\TEDIT.PARSE.CHARLOOKS.LIST LOOKS])
(\TEDIT.FIND
[LAMBDA (TEXTSTREAM TEXTOBJ SEL AGAIN) (* ; "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)
[LAMBDA (TEXTSTREAM TEXTOBJ SEL AGAIN) (* ; "Edited 6-May-2018 17:14 by rmk:")
(* ; "Edited 30-May-91 21:05 by jds")
(* just calls the normal tedit.find
 starting at the right of the current
 selection)
(PROG (TARGET (TEXTOBJ (TEXTOBJ TEXTSTREAM))
SEL CH W) (* Case sensitive search, with * and
 %# wildcards)
SEL CH W) (* Case sensitive search, with * and
 %# wildcards)
[SETQ W (CAR (MKLIST (fetch (TEXTOBJ \WINDOW) of TEXTOBJ]
(CL:WHEN AGAIN
(SETQ TARGET (WINDOWPROP W 'TEDIT.LAST.FIND.STRING)))
@@ -211,56 +208,54 @@ Copyright (c) 1985-1987, 1990-1991, 1994, 2018, 2021 by Venue & Xerox Corporatio
(SETQ CH (TEDIT.FIND TEXTOBJ (MKSTRING TARGET)
NIL NIL T))
(COND
(CH (* We found the target text.)
(CH (* We found the target text.)
(TEDIT.PROMPTPRINT TEXTOBJ "Done.")
(replace (SELECTION CH#) of SEL with (CAR CH))
(* Set up SELECTION to be the found
 text)
(* Set up SELECTION to be the found
 text)
(replace (SELECTION CHLIM) of SEL with (ADD1 (CADR CH)))
[replace (SELECTION DCH) of SEL with
(ADD1 (IDIFFERENCE (CADR CH)
(CAR CH]
[replace (SELECTION DCH) of SEL with (ADD1 (IDIFFERENCE (CADR CH)
(CAR CH]
(replace (SELECTION POINT) of SEL with 'RIGHT)
(replace (TEXTOBJ CARETLOOKS) of TEXTOBJ with (
\TEDIT.GET.INSERT.CHARLOOKS
TEXTOBJ SEL))
(replace (TEXTOBJ CARETLOOKS) of TEXTOBJ with (\TEDIT.GET.INSERT.CHARLOOKS
TEXTOBJ SEL))
(TEDIT.RESET.EXTEND.PENDING.DELETE SEL)
(* And never pending a deletion.)
(* And never pending a deletion.)
(\FIXSEL SEL TEXTOBJ)
(TEDIT.NORMALIZECARET TEXTOBJ)
(\SHOWSEL SEL NIL T)
(WINDOWPROP W 'TEDIT.LAST.FIND.STRING TARGET)
(* And get it into the window)
(* And get it into the window)
)
(T (TEDIT.PROMPTPRINT TEXTOBJ "(not found)")
(\SHOWSEL SEL NIL T]
(replace (TEXTOBJ \INSERTNEXTCH) of TEXTOBJ with -1])
(\TEDIT.FINDAGAIN
[LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* ; "Edited 6-May-2018 17:12 by rmk:")
[LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* ; "Edited 6-May-2018 17:12 by rmk:")
(\TEDIT.FIND TEXTSTREAM TEXTOBJ SEL T])
(\TEDIT.ITALIC.SEL.OFF
[LAMBDA (TEXTSTREAM TEXTOBJ SEL CHARCODE) (* ; "Edited 20-Oct-87 10:43 by jds")
(\TEDIT.ITALIC.CARET.OFF TEXTSTREAM TEXTOBJ SEL)
(TEDIT.LOOKS TEXTSTREAM '(SLOPE REGULAR) SEL])
(TEDIT.LOOKS TEXTSTREAM '(SLOPE REGULAR)
SEL])
(\TEDIT.ITALIC.SEL.ON
[LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* ; "Edited 20-Oct-87 10:43 by jds")
(TEDIT.LOOKS TEXTSTREAM '(SLOPE ITALIC) SEL])
(TEDIT.LOOKS TEXTSTREAM '(SLOPE ITALIC)
SEL])
(\TEDIT.LARGERSEL
(LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* jds "21-Sep-85 08:58")
[LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* jds "21-Sep-85 08:58")
(COND
((SHIFTDOWNP 'META)
(\TEDIT.LARGER.CARET TEXTSTREAM TEXTOBJ SEL))
(T (TEDIT.LOOKS TEXTSTREAM (LIST 'SIZEINCREMENT 2)
SEL)))))
SEL])
(\TEDIT.LCASE.SEL
[LAMBDA (STREAM TEXTOBJ SEL) (* ; "Edited 30-May-91 21:05 by jds")
[LAMBDA (STREAM TEXTOBJ SEL) (* ; "Edited 30-May-91 21:05 by jds")
(* ;; "LOWER-CASEs the selection")
@@ -272,21 +267,20 @@ Copyright (c) 1985-1987, 1990-1991, 1994, 2018, 2021 by Venue & Xerox Corporatio
(TEDIT.INSERT STREAM (L-CASE STR))
(TEDIT.SETSEL STREAM POS LEN POINT)
(TEDIT.NORMALIZECARET TEXTOBJ)
(replace (TEDITHISTORYEVENT THACTION) of (fetch (TEXTOBJ TXTHISTORY)
of TEXTOBJ) with 'LowerCase])
(replace (TEDITHISTORYEVENT THACTION) of (fetch (TEXTOBJ TXTHISTORY) of TEXTOBJ)
with 'LowerCase])
(\TEDIT.SHOWCARETLOOKS
[LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* ; "Edited 30-May-91 21:09 by jds")
[LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* ; "Edited 30-May-91 21:09 by jds")
(* * comment)
(PROG ((LOOKS (fetch (TEXTOBJ CARETLOOKS) of TEXTOBJ)))
(TEDIT.PROMPTPRINT TEXTSTREAM (CONCAT (\TK.DESCRIBEFONT (fetch (CHARLOOKS CLFONT)
of LOOKS))
of LOOKS))
(COND
((AND (fetch (CHARLOOKS CLOFFSET) of LOOKS)
(NEQ (fetch (CHARLOOKS CLOFFSET)
of LOOKS)
(NEQ (fetch (CHARLOOKS CLOFFSET) of LOOKS)
0))
(CONCAT " offset " (fetch (CHARLOOKS CLOFFSET)
of LOOKS)))
@@ -303,27 +297,25 @@ Copyright (c) 1985-1987, 1990-1991, 1994, 2018, 2021 by Venue & Xerox Corporatio
(RETURN])
(\TEDIT.SMALLERSEL
(LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* jds "21-Sep-85 08:58")
[LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* jds "21-Sep-85 08:58")
(COND
((SHIFTDOWNP 'META)
(\TEDIT.SMALLER.CARET TEXTSTREAM TEXTOBJ SEL))
(T (TEDIT.LOOKS TEXTSTREAM (LIST 'SIZEINCREMENT -2)
SEL)))))
SEL])
(\TEDIT.SUBSCRIPTSEL
[LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* ; "Edited 20-Oct-87 11:12 by jds")
(TEDIT.LOOKS TEXTSTREAM (LIST 'OFFSETINCREMENT -2)
SEL])
(\TEDIT.SUPERSCRIPTSEL
[LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* ; "Edited 20-Oct-87 11:13 by jds")
(TEDIT.LOOKS TEXTSTREAM (LIST 'OFFSETINCREMENT 2)
SEL])
(\TEDIT.UCASE.SEL
[LAMBDA (STREAM TEXTOBJ SEL) (* ; "Edited 30-May-91 21:05 by jds")
[LAMBDA (STREAM TEXTOBJ SEL) (* ; "Edited 30-May-91 21:05 by jds")
(* ; "uppercasifies the selection")
(PROG ((STR (TEDIT.SEL.AS.STRING STREAM SEL))
(POS (fetch (SELECTION CH#) of SEL))
@@ -333,31 +325,31 @@ Copyright (c) 1985-1987, 1990-1991, 1994, 2018, 2021 by Venue & Xerox Corporatio
(TEDIT.INSERT STREAM (U-CASE STR))
(TEDIT.SETSEL STREAM POS LEN POINT)
(TEDIT.NORMALIZECARET TEXTOBJ)
(replace (TEDITHISTORYEVENT THACTION) of (fetch (TEXTOBJ TXTHISTORY)
of TEXTOBJ) with 'UpperCase])
(replace (TEDITHISTORYEVENT THACTION) of (fetch (TEXTOBJ TXTHISTORY) of TEXTOBJ)
with 'UpperCase])
(\TEDIT.UNDERLINE.SEL.OFF
[LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* ; "Edited 20-Oct-87 11:26 by jds")
(TEDIT.LOOKS TEXTSTREAM '(UNDERLINE OFF) SEL])
(TEDIT.LOOKS TEXTSTREAM '(UNDERLINE OFF)
SEL])
(\TEDIT.UNDERLINE.SEL.ON
[LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* ; "Edited 20-Oct-87 11:27 by jds")
(TEDIT.LOOKS TEXTSTREAM '(UNDERLINE ON) SEL])
(TEDIT.LOOKS TEXTSTREAM '(UNDERLINE ON)
SEL])
(\TEDIT.STRIKEOUT.SEL.ON
[LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* ; "Edited 20-Oct-87 11:27 by jds")
(TEDIT.LOOKS TEXTSTREAM '(STRIKEOUT ON) SEL])
(TEDIT.LOOKS TEXTSTREAM '(STRIKEOUT ON)
SEL])
(\TEDIT.STRIKEOUT.SEL.OFF
[LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* ; "Edited 20-Oct-87 11:27 by jds")
(TEDIT.LOOKS TEXTSTREAM '(STRIKEOUT OFF) SEL])
(TEDIT.LOOKS TEXTSTREAM '(STRIKEOUT OFF)
SEL])
(\TEDIT.SELECT.ALL
[LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* ; "Edited 6-May-2018 12:41 by rmk:")
[LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* ; "Edited 6-May-2018 12:41 by rmk:")
(TEDIT.SETSEL TEXTSTREAM 0 (ADD1 (fetch TEXTLEN of TEXTOBJ))
'LEFT])
)
@@ -369,7 +361,7 @@ Copyright (c) 1985-1987, 1990-1991, 1994, 2018, 2021 by Venue & Xerox Corporatio
(DEFINEQ
(\TEDIT.BOLD.CARET.OFF
[LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* ; "Edited 12-Jun-90 18:32 by mitani")
[LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* ; "Edited 12-Jun-90 18:32 by mitani")
(PROG ((LOOKS (\TEDIT.PARSE.CHARLOOKS.LIST '(WEIGHT MEDIUM)
(fetch (TEXTOBJ CARETLOOKS) of TEXTOBJ)
TEXTOBJ)))
@@ -378,7 +370,7 @@ Copyright (c) 1985-1987, 1990-1991, 1994, 2018, 2021 by Venue & Xerox Corporatio
(\TEDIT.SHOWCARETLOOKS TEXTSTREAM TEXTOBJ SEL])
(\TEDIT.BOLD.CARET.ON
[LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* ; "Edited 12-Jun-90 18:32 by mitani")
[LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* ; "Edited 12-Jun-90 18:32 by mitani")
(PROG ((LOOKS (\TEDIT.PARSE.CHARLOOKS.LIST '(WEIGHT BOLD)
(fetch (TEXTOBJ CARETLOOKS) of TEXTOBJ)
TEXTOBJ)))
@@ -387,7 +379,7 @@ Copyright (c) 1985-1987, 1990-1991, 1994, 2018, 2021 by Venue & Xerox Corporatio
(\TEDIT.SHOWCARETLOOKS TEXTSTREAM TEXTOBJ SEL])
(\TEDIT.ITALIC.CARET.OFF
[LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* ; "Edited 12-Jun-90 18:32 by mitani")
[LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* ; "Edited 12-Jun-90 18:32 by mitani")
(PROG ((LOOKS (\TEDIT.PARSE.CHARLOOKS.LIST '(SLOPE REGULAR)
(fetch (TEXTOBJ CARETLOOKS) of TEXTOBJ)
TEXTOBJ)))
@@ -396,7 +388,7 @@ Copyright (c) 1985-1987, 1990-1991, 1994, 2018, 2021 by Venue & Xerox Corporatio
(\TEDIT.SHOWCARETLOOKS TEXTSTREAM TEXTOBJ SEL])
(\TEDIT.ITALIC.CARET.ON
[LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* ; "Edited 12-Jun-90 18:32 by mitani")
[LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* ; "Edited 12-Jun-90 18:32 by mitani")
(PROG ((LOOKS (\TEDIT.PARSE.CHARLOOKS.LIST '(SLOPE ITALIC)
(fetch (TEXTOBJ CARETLOOKS) of TEXTOBJ)
TEXTOBJ)))
@@ -405,7 +397,7 @@ Copyright (c) 1985-1987, 1990-1991, 1994, 2018, 2021 by Venue & Xerox Corporatio
(\TEDIT.SHOWCARETLOOKS TEXTSTREAM TEXTOBJ SEL])
(\TEDIT.LARGER.CARET
[LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* ; "Edited 12-Jun-90 18:32 by mitani")
[LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* ; "Edited 12-Jun-90 18:32 by mitani")
(PROG ((LOOKS (\TEDIT.PARSE.CHARLOOKS.LIST '(SIZEINCREMENT 2)
(fetch (TEXTOBJ CARETLOOKS) of TEXTOBJ)
TEXTOBJ)))
@@ -414,7 +406,7 @@ Copyright (c) 1985-1987, 1990-1991, 1994, 2018, 2021 by Venue & Xerox Corporatio
(\TEDIT.SHOWCARETLOOKS TEXTSTREAM TEXTOBJ SEL])
(\TEDIT.SMALLER.CARET
[LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* ; "Edited 12-Jun-90 18:32 by mitani")
[LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* ; "Edited 12-Jun-90 18:32 by mitani")
(PROG ((LOOKS (\TEDIT.PARSE.CHARLOOKS.LIST '(SIZEINCREMENT -2)
(fetch (TEXTOBJ CARETLOOKS) of TEXTOBJ)
TEXTOBJ)))
@@ -423,7 +415,7 @@ Copyright (c) 1985-1987, 1990-1991, 1994, 2018, 2021 by Venue & Xerox Corporatio
(\TEDIT.SHOWCARETLOOKS TEXTSTREAM TEXTOBJ SEL])
(\TEDIT.SUBSCRIPT.CARET
[LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* ; "Edited 12-Jun-90 18:32 by mitani")
[LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* ; "Edited 12-Jun-90 18:32 by mitani")
(PROG ((LOOKS (\TEDIT.PARSE.CHARLOOKS.LIST '(OFFSETINCREMENT -2)
(fetch (TEXTOBJ CARETLOOKS) of TEXTOBJ)
TEXTOBJ)))
@@ -432,7 +424,7 @@ Copyright (c) 1985-1987, 1990-1991, 1994, 2018, 2021 by Venue & Xerox Corporatio
(\TEDIT.SHOWCARETLOOKS TEXTSTREAM TEXTOBJ SEL])
(\TEDIT.SUPERSCRIPT.CARET
[LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* ; "Edited 12-Jun-90 18:32 by mitani")
[LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* ; "Edited 12-Jun-90 18:32 by mitani")
(PROG ((LOOKS (\TEDIT.PARSE.CHARLOOKS.LIST '(OFFSETINCREMENT 2)
(fetch (TEXTOBJ CARETLOOKS) of TEXTOBJ)
TEXTOBJ)))
@@ -441,7 +433,7 @@ Copyright (c) 1985-1987, 1990-1991, 1994, 2018, 2021 by Venue & Xerox Corporatio
(\TEDIT.SHOWCARETLOOKS TEXTSTREAM TEXTOBJ SEL])
(\TEDIT.UNDERLINE.CARET.OFF
[LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* ; "Edited 12-Jun-90 18:32 by mitani")
[LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* ; "Edited 12-Jun-90 18:32 by mitani")
(PROG ((LOOKS (\TEDIT.PARSE.CHARLOOKS.LIST '(UNDERLINE OFF)
(fetch (TEXTOBJ CARETLOOKS) of TEXTOBJ)
TEXTOBJ)))
@@ -450,7 +442,7 @@ Copyright (c) 1985-1987, 1990-1991, 1994, 2018, 2021 by Venue & Xerox Corporatio
(\TEDIT.SHOWCARETLOOKS TEXTSTREAM TEXTOBJ SEL])
(\TEDIT.UNDERLINE.CARET.ON
[LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* ; "Edited 12-Jun-90 18:32 by mitani")
[LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* ; "Edited 12-Jun-90 18:32 by mitani")
(PROG ((LOOKS (\TEDIT.PARSE.CHARLOOKS.LIST '(UNDERLINE ON)
(fetch (TEXTOBJ CARETLOOKS) of TEXTOBJ)
TEXTOBJ)))
@@ -459,7 +451,7 @@ Copyright (c) 1985-1987, 1990-1991, 1994, 2018, 2021 by Venue & Xerox Corporatio
(\TEDIT.SHOWCARETLOOKS TEXTSTREAM TEXTOBJ SEL])
(\TEDIT.STRIKEOUT.CARET.OFF
[LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* ; "Edited 12-Jun-90 18:32 by mitani")
[LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* ; "Edited 12-Jun-90 18:32 by mitani")
(PROG ((LOOKS (\TEDIT.PARSE.CHARLOOKS.LIST '(STRIKEOUT OFF)
(fetch (TEXTOBJ CARETLOOKS) of TEXTOBJ)
TEXTOBJ)))
@@ -468,7 +460,7 @@ Copyright (c) 1985-1987, 1990-1991, 1994, 2018, 2021 by Venue & Xerox Corporatio
(\TEDIT.SHOWCARETLOOKS TEXTSTREAM TEXTOBJ SEL])
(\TEDIT.STRIKEOUT.CARET.ON
[LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* ; "Edited 12-Jun-90 18:32 by mitani")
[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)))
@@ -484,10 +476,10 @@ Copyright (c) 1985-1987, 1990-1991, 1994, 2018, 2021 by Venue & Xerox Corporatio
(DEFINEQ
(\SEL.LIMIT
[LAMBDA (SEL) (* ; "Edited 30-May-91 21:06 by jds")
[LAMBDA (SEL) (* ; "Edited 30-May-91 21:06 by jds")
(* returns the character that delimits this selection.
 The first char if the point is left else the last)
 The first char if the point is left else the last)
(COND
((EQ (fetch (SELECTION POINT) of SEL)
@@ -496,10 +488,10 @@ Copyright (c) 1985-1987, 1990-1991, 1994, 2018, 2021 by Venue & Xerox Corporatio
(T (SUB1 (fetch (SELECTION CHLIM) of SEL])
(\SEL.LINEDESC
[LAMBDA (SEL) (* ; "Edited 30-May-91 21:06 by jds")
[LAMBDA (SEL) (* ; "Edited 30-May-91 21:06 by jds")
(* returns the first line descriptor
 if the point is left, otherwise the
 last)
 if the point is left, otherwise the
 last)
(COND
[(EQ (fetch (SELECTION POINT) of SEL)
'LEFT)
@@ -507,57 +499,54 @@ Copyright (c) 1985-1987, 1990-1991, 1994, 2018, 2021 by Venue & Xerox Corporatio
(T (CAR (MKLIST (fetch (SELECTION LN) of SEL])
(\TK.DESCRIBEFONT
(LAMBDA (FONT) (* gbn "15-Dec-84 17:54")
(* * returns a string which describes a font
 (in short. If it's not italic then no mention is made of slope, etc.))
[LAMBDA (FONT) (* gbn "15-Dec-84 17:54")
(* * returns a string which describes a font
 (in short. If it's not italic then no mention is made of slope, etc.))
(CONCAT (L-CASE (FONTPROP FONT 'FAMILY))
" "
(FONTPROP FONT 'SIZE)
(COND
((NEQ (FONTPROP FONT 'WEIGHT)
[(NEQ (FONTPROP FONT 'WEIGHT)
'MEDIUM)
(CONCAT " " (L-CASE (FONTPROP FONT 'WEIGHT))))
(CONCAT " " (L-CASE (FONTPROP FONT 'WEIGHT]
(T ""))
(COND
((NEQ (FONTPROP FONT 'SLOPE)
[(NEQ (FONTPROP FONT 'SLOPE)
'REGULAR)
(CONCAT " " (L-CASE (FONTPROP FONT 'SLOPE))))
(T "")))))
(CONCAT " " (L-CASE (FONTPROP FONT 'SLOPE]
(T ""])
(\PARAS.IN.SEL
[LAMBDA (SEL TEXTOBJ) (* ; "Edited 30-May-91 21:06 by jds")
[LAMBDA (SEL TEXTOBJ) (* ; "Edited 30-May-91 21:06 by jds")
(* returns a list which contains one character number for each paragraph
 included in the selection)
(* returns a list which contains one character number for each paragraph included
 in the selection)
(PROG ((PARAS)
PARAENDED PCS (POS (fetch (SELECTION CH#) of SEL)))
(COND
((ZEROP (fetch (SELECTION DCH) of SEL))
(* there are not really any pieces in this selection, however, effect the
 change to the para containing this selection by starting the selection one
 character earlier. This is not the right soln, but TEdit has no looks on the
 empty last para as yet.)
(* there are not really any pieces in this selection, however, effect the change
 to the para containing this selection by starting the selection one character
 earlier. This is not the right soln, but TEdit has no looks on the empty last
 para as yet.)
(replace (SELECTION CH#) of SEL with (IDIFFERENCE (fetch (SELECTION
CH#)
of SEL)
1))
(replace (SELECTION CH#) of SEL with (IDIFFERENCE (fetch (SELECTION CH#) of SEL)
1))
(replace (SELECTION DCH) of SEL with 1)
(\FIXSEL SEL TEXTOBJ)))
(SETQ PCS (TEDIT.SELECTED.PIECES TEXTOBJ SEL)) (* to include the first char)
(SETQ PARAENDED T)
(for PC in PCS do (COND
(PARAENDED (* the last piece ended a paragraph,
 so include this character in the
 list)
(SETQ PARAENDED NIL)
(push PARAS POS)))
(SETQ PARAENDED (fetch (PIECE PPARALAST) of PC))
(add POS (fetch (PIECE PLEN) of PC)))
(PARAENDED (* the last piece ended a paragraph,
 so include this character in the list)
(SETQ PARAENDED NIL)
(push PARAS POS)))
(SETQ PARAENDED (fetch (PIECE PPARALAST) of PC))
(add POS (fetch (PIECE PLEN) of PC)))
(RETURN (DREVERSE PARAS])
)
@@ -625,22 +614,21 @@ Copyright (c) 1985-1987, 1990-1991, 1994, 2018, 2021 by Venue & Xerox Corporatio
(* ; "Changed by yabu.fx, for SUNLOADUP without DWIM.")
(PUTPROPS TEDITFNKEYS COPYRIGHT ("Venue & Xerox Corporation" 1985 1986 1987 1990 1991 1994 2018 2021))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (5854 18888 (\TEDIT.BOLD.SEL.OFF 5864 . 6203) (\TEDIT.BOLD.SEL.ON 6205 . 6534) (
\TEDIT.CENTER.SEL 6536 . 7591) (\TEDIT.CENTER.SEL.REV 7593 . 8673) (\TEDIT.DEFAULTS.CARET 8675 . 8959)
(\TEDIT.DEFAULTSSEL 8961 . 9284) (\TEDIT.SETDEFAULT.FROM.SEL 9286 . 9725) (\TEDIT.FIND 9727 . 13090)
(\TEDIT.FINDAGAIN 13092 . 13266) (\TEDIT.ITALIC.SEL.OFF 13268 . 13510) (\TEDIT.ITALIC.SEL.ON 13512 .
13695) (\TEDIT.LARGERSEL 13697 . 13992) (\TEDIT.LCASE.SEL 13994 . 14745) (\TEDIT.SHOWCARETLOOKS 14747
. 16387) (\TEDIT.SMALLERSEL 16389 . 16687) (\TEDIT.SUBSCRIPTSEL 16689 . 16893) (\TEDIT.SUPERSCRIPTSEL
16895 . 17100) (\TEDIT.UCASE.SEL 17102 . 17909) (\TEDIT.UNDERLINE.SEL.OFF 17911 . 18099) (
\TEDIT.UNDERLINE.SEL.ON 18101 . 18287) (\TEDIT.STRIKEOUT.SEL.ON 18289 . 18475) (
\TEDIT.STRIKEOUT.SEL.OFF 18477 . 18665) (\TEDIT.SELECT.ALL 18667 . 18886)) (18960 24400 (
\TEDIT.BOLD.CARET.OFF 18970 . 19418) (\TEDIT.BOLD.CARET.ON 19420 . 19865) (\TEDIT.ITALIC.CARET.OFF
19867 . 20317) (\TEDIT.ITALIC.CARET.ON 20319 . 20767) (\TEDIT.LARGER.CARET 20769 . 21217) (
\TEDIT.SMALLER.CARET 21219 . 21669) (\TEDIT.SUBSCRIPT.CARET 21671 . 22125) (\TEDIT.SUPERSCRIPT.CARET
22127 . 22582) (\TEDIT.UNDERLINE.CARET.OFF 22584 . 23037) (\TEDIT.UNDERLINE.CARET.ON 23039 . 23490) (
\TEDIT.STRIKEOUT.CARET.OFF 23492 . 23945) (\TEDIT.STRIKEOUT.CARET.ON 23947 . 24398)) (24469 28217 (
\SEL.LIMIT 24479 . 24917) (\SEL.LINEDESC 24919 . 25515) (\TK.DESCRIBEFONT 25517 . 26232) (
\PARAS.IN.SEL 26234 . 28215)))))
(FILEMAP (NIL (5737 18485 (\TEDIT.BOLD.SEL.OFF 5747 . 6085) (\TEDIT.BOLD.SEL.ON 6087 . 6415) (
\TEDIT.CENTER.SEL 6417 . 7458) (\TEDIT.CENTER.SEL.REV 7460 . 8526) (\TEDIT.DEFAULTS.CARET 8528 . 8806)
(\TEDIT.DEFAULTSSEL 8808 . 9131) (\TEDIT.SETDEFAULT.FROM.SEL 9133 . 9565) (\TEDIT.FIND 9567 . 12789)
(\TEDIT.FINDAGAIN 12791 . 12969) (\TEDIT.ITALIC.SEL.OFF 12971 . 13223) (\TEDIT.ITALIC.SEL.ON 13225 .
13418) (\TEDIT.LARGERSEL 13420 . 13708) (\TEDIT.LCASE.SEL 13710 . 14416) (\TEDIT.SHOWCARETLOOKS 14418
. 15994) (\TEDIT.SMALLERSEL 15996 . 16287) (\TEDIT.SUBSCRIPTSEL 16289 . 16492) (\TEDIT.SUPERSCRIPTSEL
16494 . 16698) (\TEDIT.UCASE.SEL 16700 . 17462) (\TEDIT.UNDERLINE.SEL.OFF 17464 . 17662) (
\TEDIT.UNDERLINE.SEL.ON 17664 . 17860) (\TEDIT.STRIKEOUT.SEL.ON 17862 . 18058) (
\TEDIT.STRIKEOUT.SEL.OFF 18060 . 18258) (\TEDIT.SELECT.ALL 18260 . 18483)) (18557 24045 (
\TEDIT.BOLD.CARET.OFF 18567 . 19019) (\TEDIT.BOLD.CARET.ON 19021 . 19470) (\TEDIT.ITALIC.CARET.OFF
19472 . 19926) (\TEDIT.ITALIC.CARET.ON 19928 . 20380) (\TEDIT.LARGER.CARET 20382 . 20834) (
\TEDIT.SMALLER.CARET 20836 . 21290) (\TEDIT.SUBSCRIPT.CARET 21292 . 21750) (\TEDIT.SUPERSCRIPT.CARET
21752 . 22211) (\TEDIT.UNDERLINE.CARET.OFF 22213 . 22670) (\TEDIT.UNDERLINE.CARET.ON 22672 . 23127) (
\TEDIT.STRIKEOUT.CARET.OFF 23129 . 23586) (\TEDIT.STRIKEOUT.CARET.ON 23588 . 24043)) (24114 27576 (
\SEL.LIMIT 24124 . 24568) (\SEL.LINEDESC 24570 . 25174) (\TK.DESCRIBEFONT 25176 . 25866) (
\PARAS.IN.SEL 25868 . 27574)))))
STOP

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

Binary file not shown.

1273
library/TEDITHCPY → library/tedit/TEDIT-HCPY
View File

File diff suppressed because it is too large Load Diff

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

Binary file not shown.

359
library/TEDITHISTORY → library/tedit/TEDIT-HISTORY
View File

@@ -1,23 +1,19 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "29-Jan-99 17:34:39" {DSK}<tilde>sybalsky>lispcore3.0>library>TEDITHISTORY.;2 38471
changes to%: (FNS TEDIT.UNDO.INSERTION TEDIT.REDO.INSERTION TEDIT.UNDO.DELETION)
(FILECREATED "14-Jul-2022 16:55:48" 
{DSK}<users>kaplan>local>medley3.5>working-medley>library>tedit>TEDIT-HISTORY.;1 36011
previous date%: "25-Aug-94 10:54:22" {DSK}<tilde>sybalsky>lispcore3.0>library>TEDITHISTORY.;1
)
:PREVIOUS-DATE "14-Jul-2022 11:08:01"
{DSK}<users>kaplan>local>medley3.5>working-medley>library>newtedit>TEDIT-HISTORY.;2)
(* ; "
Copyright (c) 1983, 1984, 1985, 1986, 1987, 1990, 1991, 1993, 1994, 1999 by Venue & Xerox Corporation. All rights reserved.
")
(PRETTYCOMPRINT TEDIT-HISTORYCOMS)
(PRETTYCOMPRINT TEDITHISTORYCOMS)
(RPAQQ TEDITHISTORYCOMS
((FILES TEDITDCL)
(RPAQQ TEDIT-HISTORYCOMS
((FILES TEDIT-DCL)
(DECLARE%: EVAL@COMPILE DONTCOPY (CONSTANTS (\SCRATCHLEN 64))
(FILES (LOADCOMP)
TEDITDCL))
TEDIT-DCL))
(GLOBALVARS TEDIT.HISTORY.TYPELST TEDIT.HISTORYLST)
(INITVARS (TEDIT.HISTORY.TYPELST NIL)
(TEDIT.HISTORYLST NIL))
@@ -32,7 +28,7 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1990, 1991, 1993, 1994, 1999 by Venu
TEDIT.REDO.INSERTION TEDIT.UNDO.MOVE TEDIT.UNDO.REPLACE TEDIT.REDO.REPLACE
TEDIT.REDO.MOVE))))
(FILESLOAD TEDITDCL)
(FILESLOAD TEDIT-DCL)
(DECLARE%: EVAL@COMPILE DONTCOPY
(DECLARE%: EVAL@COMPILE
@@ -44,7 +40,7 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1990, 1991, 1993, 1994, 1999 by Venu
(FILESLOAD (LOADCOMP)
TEDITDCL)
TEDIT-DCL)
)
(DECLARE%: DOEVAL@COMPILE DONTCOPY
@@ -63,11 +59,10 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1990, 1991, 1993, 1994, 1999 by Venu
(\TEDIT.HISTORYADD
[LAMBDA (TEXTOBJ EVENT) (* ; "Edited 3-Sep-87 10:36 by jds")
(* ;; "Add a new event to the history list. For now, this just re-sets the whole list to be the one event...")
(* ;;
 "This function also takes care of cumulating cumulative events, like successive deletions.")
(* ;; "Add a new event to the history list. For now, this just re-sets the whole list to be the one event...")
(* ;; "This function also takes care of cumulating cumulative events, like successive deletions.")
(LET* ((OLDEVENT (fetch (TEXTOBJ TXTHISTORY) of TEXTOBJ))
(ETYPE (fetch (TEDITHISTORYEVENT THACTION) of EVENT))
@@ -77,7 +72,6 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1990, 1991, 1993, 1994, 1999 by Venu
((AND OLDEVENT (EQ OETYPE ETYPE)
(EQ ETYPE 'Delete)) (* ;
 "Repeated successive deletions. See if we can combine them.")
(LET* [(OSTART (fetch (TEDITHISTORYEVENT THCH#) of OLDEVENT))
(NSTART (fetch (TEDITHISTORYEVENT THCH#) of EVENT))
(OLDEND (+ OSTART (fetch (TEDITHISTORYEVENT THLEN) of OLDEVENT)))
@@ -85,20 +79,18 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1990, 1991, 1993, 1994, 1999 by Venu
(COND
((IEQP OLDEND NSTART) (* ;
 "The old deletion was just in front of the current one; cumulate them.")
(SETQ REALEVENT (\TEDIT.CUMULATE.EVENTS OLDEVENT EVENT T)))
((IEQP NEWEND OSTART) (* ;
 "The new deletion was just in front of the old one; cumulate them.")
(SETQ REALEVENT (\TEDIT.CUMULATE.EVENTS EVENT OLDEVENT T]
(replace (TEXTOBJ TXTHISTORY) of TEXTOBJ with REALEVENT])
(\TEDIT.CUMULATE.EVENTS
[LAMBDA (EVENT1 EVENT2 PIECES-TO-SAVE?) (* ; "Edited 3-Sep-87 10:42 by jds")
(* ;; "Accumulate history events that should really be combined into a single event.")
(* ;; "For now, this assumes they're events of the same type. Actually, this should be able to cumulate a delete/insert pair into a replacement, etc.")
(* ;; "Accumulate history events that should really be combined into a single event.")
(* ;; "For now, this assumes they're events of the same type. Actually, this should be able to cumulate a delete/insert pair into a replacement, etc.")
(LET* [(OLDLEN (fetch (TEDITHISTORYEVENT THLEN) of EVENT1))
(NEWPC1 (fetch (TEDITHISTORYEVENT THFIRSTPIECE) of EVENT2))
@@ -108,7 +100,7 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1990, 1991, 1993, 1994, 1999 by Venu
of EVENT2]
(bind (PC _ (fetch (TEDITHISTORYEVENT THFIRSTPIECE) of EVENT1))
(CHCOUNT _ 0) while (< (SETQ CHCOUNT (+ CHCOUNT (fetch (PIECE PLEN) of PC)))
OLDLEN) do (SETQ PC (fetch (PIECE NEXTPIECE) of PC))
OLDLEN) do (SETQ PC (fetch (PIECE NEXTPIECE) of PC))
finally (replace (PIECE NEXTPIECE) of PC with NEWPC1)
(replace (PIECE PREVPIECE) of NEWPC1 with PC)
(RETURN))
@@ -122,57 +114,57 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1990, 1991, 1993, 1994, 1999 by Venu
(DEFINEQ
(TEDIT.UNDO
[LAMBDA (TEXTOBJ) (* ; "Edited 12-Jun-90 18:41 by mitani")
[LAMBDA (TEXTOBJ) (* ; "Edited 12-Jun-90 18:41 by mitani")
(* ;; "Undo the last thing this guy did.")
(* ;; "Undo the last thing this guy did.")
(COND
((NOT (FETCH (TEXTOBJ TXTREADONLY) OF TEXTOBJ))
(* ;; "Only undo things if the document is allowed to change.")
(* ;; "Only undo things if the document is allowed to change.")
(PROG ((SEL (fetch (TEXTOBJ SEL) of TEXTOBJ))
EVENT CH# LEN FIRSTPIECE)
(COND
((SETQ EVENT (fetch (TEXTOBJ TXTHISTORY) of TEXTOBJ))
(* ;
 "There really is something to UNDO. Decide what, & fix it.")
(SETQ LEN (fetch THLEN of EVENT)) (* ;
 "Length of the text that was inserted/deleted/changed")
(SETQ CH# (fetch THCH# of EVENT)) (* ; "Starting CH# of the change")
(* ;
 "There really is something to UNDO. Decide what, & fix it.")
(SETQ LEN (fetch THLEN of EVENT)) (* ;
 "Length of the text that was inserted/deleted/changed")
(SETQ CH# (fetch THCH# of EVENT)) (* ; "Starting CH# of the change")
(SETQ FIRSTPIECE (fetch THFIRSTPIECE of EVENT))
(* ;
 "First piece affected by the change")
(* ;
 "First piece affected by the change")
(RESETLST
(RESETSAVE (CURSOR WAITINGCURSOR))
(\SHOWSEL SEL NIL NIL)
[SELECTQ (fetch THACTION of EVENT)
((Insert Copy Include) (* ; "It was an insertion")
((Insert Copy Include) (* ; "It was an insertion")
(TEDIT.UNDO.INSERTION TEXTOBJ EVENT LEN CH# FIRSTPIECE))
(Delete (* ; "It was a deletion")
(Delete (* ; "It was a deletion")
(TEDIT.UNDO.DELETION TEXTOBJ EVENT LEN CH# FIRSTPIECE))
(Looks (* ; "It was a character-looks change")
(Looks (* ; "It was a character-looks change")
(TEDIT.UNDO.LOOKS TEXTOBJ EVENT LEN CH# FIRSTPIECE))
(ParaLooks (* ; "It was a PARA looks change")
(ParaLooks (* ; "It was a PARA looks change")
(TEDIT.UNDO.PARALOOKS TEXTOBJ EVENT LEN CH# FIRSTPIECE))
(Move (TEDIT.UNDO.MOVE TEXTOBJ EVENT LEN CH# FIRSTPIECE)
(* ; "He moved some text")
(* ; "He moved some text")
)
((Replace LowerCase UpperCase)
(* ;; "He replaced one piece of text with another ; Lower-casing and upper-casing have the same undo event.")
(* ;; "He replaced one piece of text with another ; Lower-casing and upper-casing have the same undo event.")
(TEDIT.UNDO.REPLACE TEXTOBJ EVENT LEN CH# FIRSTPIECE))
(Get (* ; "He did a GET -- not undoable.")
(Get (* ; "He did a GET -- not undoable.")
(TEDIT.PROMPTPRINT TEXTOBJ "You can't UNDO a GET." T))
(Put (* ; "He did a PUT -- not undoable.")
(Put (* ; "He did a PUT -- not undoable.")
(TEDIT.PROMPTPRINT TEXTOBJ "You can't UNDO a Put." T))
(COND
((AND (SETQ UNDOFN (ASSOC (fetch THACTION of EVENT)
TEDIT.HISTORY.TYPELST))
(SETQ UNDOFN (CADDR UNDOFN)))
(* ;
 "TEDIT.HISTORY.TYPELST is an ALST of form (type redofn undofn)")
(* ;
 "TEDIT.HISTORY.TYPELST is an ALST of form (type redofn undofn)")
(APPLY* UNDOFN TEXTOBJ EVENT LEN CH# FIRSTPIECE))
(T (TEDIT.PROMPTPRINT TEXTOBJ (CONCAT "UNDO not implemented for "
(fetch THACTION of EVENT))
@@ -181,14 +173,14 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1990, 1991, 1993, 1994, 1999 by Venu
(T (TEDIT.PROMPTPRINT TEXTOBJ "Nothing to UNDO." T])
(TEDIT.UNDO.INSERTION
[LAMBDA (TEXTOBJ EVENT LEN CH# FIRSTPIECE) (* ; "Edited 21-Apr-93 01:33 by jds")
[LAMBDA (TEXTOBJ EVENT LEN CH# FIRSTPIECE) (* ; "Edited 21-Apr-93 01:33 by jds")
(* ;; "UNDO a prior Insert, Copy, or Include.")
(PROG (OBJ DELETEFN)
(replace (TEXTOBJ \INSERTPCVALID) of TEXTOBJ with NIL)
(* ;
 "Keep TEdit from reusing the current cache piece in the future -- it is probably invalid")
 "Keep TEdit from reusing the current cache piece in the future -- it is probably invalid")
(\DELETECH CH# (IPLUS CH# LEN)
LEN TEXTOBJ)
(\FIXDLINES (fetch (TEXTOBJ LINES) of TEXTOBJ)
@@ -196,20 +188,18 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1990, 1991, 1993, 1994, 1999 by Venu
CH#
(IPLUS CH# LEN)
TEXTOBJ) (* ;
 "Fix the line descriptors & selection")
 "Fix the line descriptors & selection")
(TEDIT.UPDATE.SCREEN TEXTOBJ) (* ;
 "Fix up the display for all this foofaraw")
(replace (SELECTION POINT) of (fetch (TEXTOBJ SEL) of TEXTOBJ)
with 'LEFT)
 "Fix up the display for all this foofaraw")
(replace (SELECTION POINT) of (fetch (TEXTOBJ SEL) of TEXTOBJ) with 'LEFT)
(\FIXSEL (fetch (TEXTOBJ SEL) of TEXTOBJ)
TEXTOBJ) (* ; "Really fix the selection")
(replace THACTION of EVENT with 'Delete)
(* ;
 "Make the UNDO be UNDOable, by changing the event to a deletion.")
(replace THACTION of EVENT with 'Delete) (* ;
 "Make the UNDO be UNDOable, by changing the event to a deletion.")
])
(TEDIT.UNDO.DELETION
[LAMBDA (TEXTOBJ EVENT LEN CH# FIRSTPIECE) (* ; "Edited 21-Apr-93 12:01 by jds")
[LAMBDA (TEXTOBJ EVENT LEN CH# FIRSTPIECE) (* ; "Edited 21-Apr-93 12:01 by jds")
(* ;; "UNDO a prior Deletion of text.")
@@ -221,11 +211,9 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1990, 1991, 1993, 1994, 1999 by Venu
(SETQ INSPC (\CHTOPC CH# PCTB T))
(replace (TEXTOBJ \INSERTPCVALID) of TEXTOBJ with NIL)
(* ;
 "Keep future people from stepping on the current cache piece, which is probably no longer valid.")
 "Keep future people from stepping on the current cache piece, which is probably no longer valid.")
(COND
((fetch (TEXTOBJ TXTREADONLY) of TEXTOBJ)
(* ;
 "Don't change read-only documents.")
((fetch (TEXTOBJ TXTREADONLY) of TEXTOBJ) (* ; "Don't change read-only documents.")
(RETURN)))
[COND
((IGREATERP CH# START-OF-PIECE)
@@ -235,60 +223,50 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1990, 1991, 1993, 1994, 1999 by Venu
(replace THFIRSTPIECE of EVENT with NEWPIECE)
(bind (TL _ 0) while (ILESSP TL LEN) do (\INSERTPIECE NEWPIECE INSPC TEXTOBJ)
(* ; "Insert the piece back in")
[COND
([AND (SETQ OBJECT
(fetch (PIECE POBJ)
of NEWPIECE))
(SETQ INSERTFN
(IMAGEOBJPROP OBJECT
'WHENINSERTEDFN]
[COND
([AND (SETQ OBJECT (fetch (PIECE POBJ)
of NEWPIECE))
(SETQ INSERTFN (IMAGEOBJPROP OBJECT
'WHENINSERTEDFN]
(* ;
 "If this is an imageobject, and it has an insertfn, call it.")
(APPLY* INSERTFN OBJECT (
\TEDIT.PRIMARYW
TEXTOBJ)
NIL
(TEXTSTREAM TEXTOBJ]
(SETQ TL (IPLUS TL (fetch
(PIECE PLEN)
of FIRSTPIECE)
))
 "If this is an imageobject, and it has an insertfn, call it.")
(APPLY* INSERTFN OBJECT (\TEDIT.PRIMARYW
TEXTOBJ)
NIL
(TEXTSTREAM TEXTOBJ]
(SETQ TL (IPLUS TL (fetch (PIECE PLEN) of
FIRSTPIECE
)))
(* ;
 "Keep track of how much we've re-inserted")
(SETQ FIRSTPIECE NPC)
 "Keep track of how much we've re-inserted")
(SETQ FIRSTPIECE NPC)
(* ; "Move to the next piece to insert")
(AND NPC (SETQ NPC (fetch (PIECE NEXTPIECE)
of NPC)))
(SETQ NEWPIECE (create PIECE using FIRSTPIECE)))
(* ;
 "Move to the next piece to insert")
(AND NPC (SETQ NPC (fetch
(PIECE NEXTPIECE)
of NPC)))
(SETQ NEWPIECE (create PIECE
using FIRSTPIECE))
) (* ;
 "Done here because \INSERTPIECE creams the NEXTPIECE field.")
(replace (TEXTOBJ TEXTLEN) of TEXTOBJ with (IPLUS (fetch (TEXTOBJ TEXTLEN)
of TEXTOBJ)
LEN))
 "Done here because \INSERTPIECE creams the NEXTPIECE field.")
(replace (TEXTOBJ TEXTLEN) of TEXTOBJ with (IPLUS (fetch (TEXTOBJ TEXTLEN) of TEXTOBJ)
LEN))
(* ;
 "Reset the text length and EOF ptr of the text stream.")
 "Reset the text length and EOF ptr of the text stream.")
(\FIXILINES TEXTOBJ SEL CH# LEN OTEXTLEN) (* ;
 "Fix the line descriptors & selection")
 "Fix the line descriptors & selection")
(TEDIT.UPDATE.SCREEN TEXTOBJ) (* ;
 "Fix up the display for all this foofaraw")
(replace (SELECTION CH#) of SEL with CH#)
(* ;
 "Make the selection point at the re-inserted text")
 "Fix up the display for all this foofaraw")
(replace (SELECTION CH#) of SEL with CH#) (* ;
 "Make the selection point at the re-inserted text")
(replace (SELECTION CHLIM) of SEL with (IPLUS CH# LEN))
(replace (SELECTION DCH) of SEL with LEN)
(replace (SELECTION POINT) of SEL with (fetch THPOINT of EVENT))
(\TEDIT.SET.SEL.LOOKS SEL 'NORMAL)
(\FIXSEL SEL TEXTOBJ) (* ; "Really fix the selection")
(replace THACTION of EVENT with 'Insert)
(* ;
 "Make the UNDO be UNDOable, by changing the event to a insertion.")
(replace THACTION of EVENT with 'Insert) (* ;
 "Make the UNDO be UNDOable, by changing the event to a insertion.")
])
(TEDIT.REDO
[LAMBDA (TEXTOBJ) (* ; "Edited 30-May-91 21:27 by jds")
[LAMBDA (TEXTOBJ) (* ; "Edited 30-May-91 21:27 by jds")
(* ;; "REDO the last thing this guy did.")
@@ -302,7 +280,7 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1990, 1991, 1993, 1994, 1999 by Venu
NIL)
((SETQ EVENT (fetch (TEXTOBJ TXTHISTORY) of TEXTOBJ))
(* ;
 "There really is something to REDO Decide what, & do it.")
 "There really is something to REDO Decide what, & do it.")
(RESETLST
(RESETSAVE (CURSOR WAITINGCURSOR))
(\SHOWSEL SEL NIL NIL)
@@ -316,7 +294,7 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1990, 1991, 1993, 1994, 1999 by Venu
(Delete (* ; "It was a deletion")
(\TEDIT.DELETE SEL TEXTOBJ))
(Replace (* ;
 "It was a replacement (a del/insert combo)")
 "It was a replacement (a del/insert combo)")
(TEDIT.REDO.REPLACE TEXTOBJ EVENT))
(LowerCase (* ; "He lower-cased something")
(\TEDIT.LCASE.SEL TEXTOBJ TEXTOBJ SEL))
@@ -324,14 +302,12 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1990, 1991, 1993, 1994, 1999 by Venu
(\TEDIT.LCASE.SEL TEXTOBJ TEXTOBJ SEL))
(Looks (* ; "It was a looks change")
(TEDIT.REDO.LOOKS TEXTOBJ EVENT (IMAX 1
(SELECTQ (fetch (SELECTION
POINT)
(SELECTQ (fetch (SELECTION POINT)
of SEL)
(LEFT (fetch (SELECTION
CH#)
(LEFT (fetch (SELECTION CH#)
of SEL))
(RIGHT (fetch (SELECTION
CHLIM)
CHLIM)
of SEL))
NIL))))
(ParaLooks (* ; "It was a Paragraph looks change")
@@ -351,12 +327,10 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1990, 1991, 1993, 1994, 1999 by Venu
(CH (TEDIT.PROMPTPRINT TEXTOBJ "done.")
(replace (SELECTION CH#) of SEL with CH)
[replace (SELECTION CHLIM) of SEL
with (IPLUS CH (NCHARS (fetch THAUXINFO
of EVENT]
with (IPLUS CH (NCHARS (fetch THAUXINFO of EVENT]
(replace (SELECTION DCH) of SEL
with (NCHARS (fetch THAUXINFO of EVENT)))
(replace (SELECTION POINT) of SEL with
'RIGHT)
(replace (SELECTION POINT) of SEL with 'RIGHT)
(\FIXSEL SEL TEXTOBJ)
(TEDIT.NORMALIZECARET TEXTOBJ)
(\SHOWSEL SEL NIL T))
@@ -383,99 +357,90 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1990, 1991, 1993, 1994, 1999 by Venu
(T (TEDIT.PROMPTPRINT TEXTOBJ "Nothing to REDO." T])
(TEDIT.REDO.INSERTION
[LAMBDA (TEXTOBJ EVENT CH#) (* ; "Edited 21-Apr-93 01:06 by jds")
[LAMBDA (TEXTOBJ EVENT CH#) (* ; "Edited 21-Apr-93 01:06 by jds")
(* ;
 "REDO a prior Insert/Copy/Include of text.")
 "REDO a prior Insert/Copy/Include of text.")
(PROG (INSPC INSPC# NPC (SEL (fetch (TEXTOBJ SEL) of TEXTOBJ))
(PCTB (fetch (TEXTOBJ PCTB) of TEXTOBJ))
(LEN (fetch THLEN of EVENT))
(FIRSTPIECE (create PIECE using (fetch THFIRSTPIECE of EVENT)
PNEW _ T))
PNEW _ T))
(OTEXTLEN (fetch (TEXTOBJ TEXTLEN) of TEXTOBJ))
OBJ COPYFN ORIGFIRSTPC)
(SETQ ORIGFIRSTPC FIRSTPIECE)
(replace THFIRSTPIECE of EVENT with FIRSTPIECE)
(* ;
 "So we can UNDO this, and remove the right set of pieces.")
(replace THFIRSTPIECE of EVENT with FIRSTPIECE) (* ;
 "So we can UNDO this, and remove the right set of pieces.")
(replace (TEXTOBJ \INSERTPCVALID) of TEXTOBJ with NIL)
(* ;
 "Force any further insertions to make new pieces.")
 "Force any further insertions to make new pieces.")
(SETQ NPC (fetch (PIECE NEXTPIECE) of FIRSTPIECE))
(SETQ INSPC (\CHTOPC CH# PCTB T))
[SETQ INSPC (COND
((IEQP CH# START-OF-PIECE) (* ;
 "We're inserting just before an existing piece")
 "We're inserting just before an existing piece")
INSPC)
(T (* ;
 "We must split this piece, and insert before the second part.")
 "We must split this piece, and insert before the second part.")
(\SPLITPIECE INSPC (- CH# START-OF-PIECE)
TEXTOBJ]
(bind (TL _ 0) while (ILESSP TL LEN)
do
(* ;; "Loop thru the pieces of the prior insertion, inserting copies of enough of them to cover the length of the insertion.")
(* ;; "Loop thru the pieces of the prior insertion, inserting copies of enough of them to cover the length of the insertion.")
[COND
((SETQ OBJ (fetch (PIECE POBJ) of FIRSTPIECE))
[COND
((SETQ OBJ (fetch (PIECE POBJ) of FIRSTPIECE))
(* ; "This piece describes an object")
[COND
[(SETQ COPYFN (IMAGEOBJPROP OBJ 'COPYFN))
(SETQ OBJ (APPLY* COPYFN OBJ (fetch (TEXTOBJ STREAMHINT) of
TEXTOBJ
)
(fetch (TEXTOBJ STREAMHINT) of TEXTOBJ)))
(COND
((EQ OBJ 'DON'T)
(TEDIT.PROMPTPRINT TEXTOBJ "COPY of this object not allowed." T)
(RETFROM 'TEDIT.COPY))
(T (replace (PIECE POBJ) of FIRSTPIECE with OBJ]
(OBJ (replace (PIECE POBJ) of FIRSTPIECE with (COPY OBJ]
(COND
((SETQ COPYFN (IMAGEOBJPROP OBJ 'WHENCOPIEDFN))
[COND
[(SETQ COPYFN (IMAGEOBJPROP OBJ 'COPYFN))
(SETQ OBJ (APPLY* COPYFN OBJ (fetch (TEXTOBJ STREAMHINT) of TEXTOBJ)
(fetch (TEXTOBJ STREAMHINT) of TEXTOBJ)))
(COND
((EQ OBJ 'DON'T)
(TEDIT.PROMPTPRINT TEXTOBJ "COPY of this object not allowed." T)
(RETFROM 'TEDIT.COPY))
(T (replace (PIECE POBJ) of FIRSTPIECE with OBJ]
(OBJ (replace (PIECE POBJ) of FIRSTPIECE with (COPY OBJ]
(COND
((SETQ COPYFN (IMAGEOBJPROP OBJ 'WHENCOPIEDFN))
(* ;
 "If there's an eventfn for copying, use it.")
(APPLY* COPYFN OBJ (WINDOWPROP (CAR (fetch (TEXTOBJ \WINDOW)
of TEXTOBJ))
'DSP)
(fetch (TEXTOBJ STREAMHINT) of TEXTOBJ)
(fetch (TEXTOBJ STREAMHINT) of TEXTOBJ]
(\INSERTPIECE FIRSTPIECE INSPC TEXTOBJ) (* ; "Insert the piece back in")
(SETQ TL (IPLUS TL (fetch (PIECE PLEN) of FIRSTPIECE)))
 "If there's an eventfn for copying, use it.")
(APPLY* COPYFN OBJ (WINDOWPROP (CAR (fetch (TEXTOBJ \WINDOW) of TEXTOBJ))
'DSP)
(fetch (TEXTOBJ STREAMHINT) of TEXTOBJ)
(fetch (TEXTOBJ STREAMHINT) of TEXTOBJ]
(\INSERTPIECE FIRSTPIECE INSPC TEXTOBJ) (* ; "Insert the piece back in")
(SETQ TL (IPLUS TL (fetch (PIECE PLEN) of FIRSTPIECE)))
(* ;
 "Keep track of how much we've re-inserted")
(SETQ FIRSTPIECE (create PIECE using NPC PNEW _ T))
 "Keep track of how much we've re-inserted")
(SETQ FIRSTPIECE (create PIECE using NPC PNEW _ T))
(* ; "Move to the next piece to insert")
(AND NPC (SETQ NPC (fetch (PIECE NEXTPIECE) of NPC)))
(* ;
 "Move to the next piece to insert")
(AND NPC (SETQ NPC (fetch (PIECE NEXTPIECE) of NPC)))
(* ;
 "Done here because \INSERTPIECE creams the NEXTPIECE field.")
)
 "Done here because \INSERTPIECE creams the NEXTPIECE field.")
)
(\TEDIT.DIFFUSE.PARALOOKS (fetch (PIECE PREVPIECE) of ORIGFIRSTPC)
INSPC) (* ;
 "propagate paragraph formatting into the new insertion")
(replace (TEXTOBJ TEXTLEN) of TEXTOBJ with (IPLUS (fetch (TEXTOBJ TEXTLEN)
of TEXTOBJ)
LEN))
 "propagate paragraph formatting into the new insertion")
(replace (TEXTOBJ TEXTLEN) of TEXTOBJ with (IPLUS (fetch (TEXTOBJ TEXTLEN) of TEXTOBJ)
LEN))
(* ;
 "Reset the text length and EOF ptr of the text stream.")
 "Reset the text length and EOF ptr of the text stream.")
(\FIXILINES TEXTOBJ SEL CH# LEN OTEXTLEN) (* ;
 "Fix the line descriptors & selection")
 "Fix the line descriptors & selection")
(TEDIT.UPDATE.SCREEN TEXTOBJ) (* ;
 "Fix up the display for all this foofaraw")
(replace (SELECTION CH#) of SEL with CH#)
(* ;
 "Make the selection point at the re-inserted text")
 "Fix up the display for all this foofaraw")
(replace (SELECTION CH#) of SEL with CH#) (* ;
 "Make the selection point at the re-inserted text")
(replace (SELECTION CHLIM) of SEL with (IPLUS CH# LEN))
(replace (SELECTION DCH) of SEL with LEN)
(\TEDIT.SET.SEL.LOOKS SEL 'NORMAL)
(\FIXSEL SEL TEXTOBJ) (* ; "Really fix the selection")
(replace THACTION of EVENT with 'Insert)
(* ;
 "Make the UNDO be UNDOable, by changing the event to a insertion.")
(replace THACTION of EVENT with 'Insert) (* ;
 "Make the UNDO be UNDOable, by changing the event to a insertion.")
])
(TEDIT.UNDO.MOVE
[LAMBDA (TEXTOBJ EVENT LEN CH# FIRSTPIECE) (* ; "Edited 30-May-91 21:27 by jds")
[LAMBDA (TEXTOBJ EVENT LEN CH# FIRSTPIECE) (* ; "Edited 30-May-91 21:27 by jds")
(* ; "UNDO a MOVE command")
(PROG ((TOOBJ (fetch THAUXINFO of EVENT))
(FROMOBJ (fetch THTEXTOBJ of EVENT))
@@ -484,29 +449,27 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1990, 1991, 1993, 1994, 1999 by Venu
TOSEL TOTEXTLEN)
(\SHOWSEL (fetch (TEXTOBJ SEL) of TOOBJ)
NIL NIL) (* ;
 "Turn off the selections in the old source and target documents")
 "Turn off the selections in the old source and target documents")
(\SHOWSEL (fetch (TEXTOBJ SEL) of FROMOBJ)
NIL NIL)
(\DELETECH CH# (IPLUS CH# LEN)
LEN FROMOBJ) (* ;
 "Delete the characters we moved, from the place we moved them to")
 "Delete the characters we moved, from the place we moved them to")
(\FIXDLINES (fetch (TEXTOBJ LINES) of FROMOBJ)
(fetch (TEXTOBJ SEL) of FROMOBJ)
CH#
(IPLUS CH# LEN)
FROMOBJ)
(replace (SELECTION CH#) of (fetch (TEXTOBJ SEL) of FROMOBJ)
with (replace (SELECTION CHLIM) of (fetch (TEXTOBJ SEL) of FROMOBJ)
with CH#)) (* ;
 "Make this document's selection be a point sel at the place the text used to be.")
(replace (SELECTION DCH) of (fetch (TEXTOBJ SEL) of FROMOBJ) with
0)
(replace (SELECTION POINT) of (fetch (TEXTOBJ SEL) of FROMOBJ)
with 'LEFT) (* ;
 "Mark lines for update, and fix the selection")
(SETQ TOTEXTLEN (fetch (TEXTOBJ TEXTLEN) of TOOBJ))
with (replace (SELECTION CHLIM) of (fetch (TEXTOBJ SEL) of FROMOBJ) with CH#))
(* ;
 "The pre-insertion len of the place the text is returning to, for the line udpater below")
 "Make this document's selection be a point sel at the place the text used to be.")
(replace (SELECTION DCH) of (fetch (TEXTOBJ SEL) of FROMOBJ) with 0)
(replace (SELECTION POINT) of (fetch (TEXTOBJ SEL) of FROMOBJ) with 'LEFT)
(* ;
 "Mark lines for update, and fix the selection")
(SETQ TOTEXTLEN (fetch (TEXTOBJ TEXTLEN) of TOOBJ))(* ;
 "The pre-insertion len of the place the text is returning to, for the line udpater below")
(\TEDIT.INSERT.PIECES TOOBJ SOURCECH# (fetch THFIRSTPIECE of EVENT)
LEN)
@@ -514,24 +477,24 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1990, 1991, 1993, 1994, 1999 by Venu
(\FIXILINES TOOBJ (fetch (TEXTOBJ SEL) of TOOBJ)
SOURCECH# LEN TOTEXTLEN) (* ;
 "Mark lines that need updating, and fix up the selection")
 "Mark lines that need updating, and fix up the selection")
(add (fetch (TEXTOBJ TEXTLEN) of TOOBJ)
LEN) (* ;
 "Update the text length of the erstwhile move source")
LEN) (* ;
 "Update the text length of the erstwhile move source")
(TEDIT.UPDATE.SCREEN FROMOBJ) (* ;
 "Update the erstwhile text location's image.")
 "Update the erstwhile text location's image.")
(COND
((NEQ FROMOBJ TOOBJ) (* ;
 "If they aren't the same document, we need to update the other document image as well.")
 "If they aren't the same document, we need to update the other document image as well.")
(TEDIT.UPDATE.SCREEN TOOBJ)))
(\FIXSEL (fetch (TEXTOBJ SEL) of TOOBJ)
TOOBJ) (* ;
 "Fix up the selections so their images will be OK")
 "Fix up the selections so their images will be OK")
(\FIXSEL (fetch (TEXTOBJ SEL) of FROMOBJ)
FROMOBJ)
(\COPYSEL (fetch (TEXTOBJ SEL) of FROMOBJ)
TEDIT.SELECTION) (* ;
 "It's handy to think of this as the last selection made, also.")
 "It's handy to think of this as the last selection made, also.")
(replace THACTION of EVENT with 'Move)
(replace THTEXTOBJ of EVENT with TOOBJ)
(replace THAUXINFO of EVENT with FROMOBJ)
@@ -543,7 +506,7 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1990, 1991, 1993, 1994, 1999 by Venu
NIL T])
(TEDIT.UNDO.REPLACE
[LAMBDA (TEXTOBJ EVENT LEN CH# FIRSTPIECE) (* ; "Edited 30-May-91 21:27 by jds")
[LAMBDA (TEXTOBJ EVENT LEN CH# FIRSTPIECE) (* ; "Edited 30-May-91 21:27 by jds")
(PROG ((OLDEVENT (fetch THOLDINFO of EVENT))
(CH# (fetch THCH# of EVENT))
(SEL (fetch (TEXTOBJ SEL) of TEXTOBJ)))
@@ -558,8 +521,7 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1990, 1991, 1993, 1994, 1999 by Venu
(replace THOLDINFO of EVENT with NIL)
(\TEDIT.HISTORYADD TEXTOBJ OLDEVENT)
(replace (SELECTION CH#) of SEL with CH#)
(replace (SELECTION CHLIM) of SEL with (IPLUS CH# (fetch THLEN of
OLDEVENT)))
(replace (SELECTION CHLIM) of SEL with (IPLUS CH# (fetch THLEN of OLDEVENT)))
(replace (SELECTION DCH) of SEL with (fetch THLEN of OLDEVENT))
(replace (SELECTION POINT) of SEL with (fetch THPOINT of EVENT))
(replace THPOINT of OLDEVENT with (fetch THPOINT of EVENT))
@@ -567,7 +529,7 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1990, 1991, 1993, 1994, 1999 by Venu
(\SHOWSEL SEL NIL T])
(TEDIT.REDO.REPLACE
[LAMBDA (TEXTOBJ EVENT) (* ; "Edited 30-May-91 21:28 by jds")
[LAMBDA (TEXTOBJ EVENT) (* ; "Edited 30-May-91 21:28 by jds")
(PROG ((OLDEVENT (fetch THOLDINFO of EVENT))
(CH# (fetch (SELECTION CH#) of (fetch (TEXTOBJ SEL) of TEXTOBJ)))
(SEL (fetch (TEXTOBJ SEL) of TEXTOBJ)))
@@ -584,15 +546,14 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1990, 1991, 1993, 1994, 1999 by Venu
TEXTOBJ)
(replace (SELECTION POINT) of SEL with 'LEFT)
(TEDIT.REDO.INSERTION TEXTOBJ EVENT CH#)
(replace THOLDINFO of EVENT with (SETQ OLDEVENT (fetch (TEXTOBJ TXTHISTORY)
of TEXTOBJ)))
(replace THOLDINFO of EVENT with (SETQ OLDEVENT (fetch (TEXTOBJ TXTHISTORY) of TEXTOBJ)))
(replace THACTION of OLDEVENT with 'Replace)
(replace THACTION of EVENT with 'Replace)
(replace THCH# of EVENT with CH#)
(\TEDIT.HISTORYADD TEXTOBJ EVENT])
(TEDIT.REDO.MOVE
[LAMBDA (TEXTOBJ EVENT LEN CH# FIRSTPIECE) (* ; "Edited 30-May-91 21:28 by jds")
[LAMBDA (TEXTOBJ EVENT LEN CH# FIRSTPIECE) (* ; "Edited 30-May-91 21:28 by jds")
(PROG ((FROMOBJ TEXTOBJ)
(SOURCECH# (fetch THOLDINFO of EVENT))
(OLDCH# (fetch THCH# of EVENT))
@@ -607,12 +568,10 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1990, 1991, 1993, 1994, 1999 by Venu
(\TEDIT.SET.SEL.LOOKS MOVESEL 'MOVE)
(TEDIT.MOVE MOVESEL SEL])
)
(PUTPROPS TEDITHISTORY COPYRIGHT ("Venue & Xerox Corporation" 1983 1984 1985 1986 1987 1990 1991 1993
1994 1999))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (1711 5083 (\TEDIT.HISTORYADD 1721 . 3606) (\TEDIT.CUMULATE.EVENTS 3608 . 5081)) (5136
38333 (TEDIT.UNDO 5146 . 9098) (TEDIT.UNDO.INSERTION 9100 . 10686) (TEDIT.UNDO.DELETION 10688 . 16623)
(TEDIT.REDO 16625 . 23562) (TEDIT.REDO.INSERTION 23564 . 30211) (TEDIT.UNDO.MOVE 30213 . 34646) (
TEDIT.UNDO.REPLACE 34648 . 36087) (TEDIT.REDO.REPLACE 36089 . 37514) (TEDIT.REDO.MOVE 37516 . 38331)))
(FILEMAP (NIL (1548 4840 (\TEDIT.HISTORYADD 1558 . 3393) (\TEDIT.CUMULATE.EVENTS 3395 . 4838)) (4893
35988 (TEDIT.UNDO 4903 . 8883) (TEDIT.UNDO.INSERTION 8885 . 10419) (TEDIT.UNDO.DELETION 10421 . 15423)
(TEDIT.REDO 15425 . 22036) (TEDIT.REDO.INSERTION 22038 . 28108) (TEDIT.UNDO.MOVE 28110 . 32451) (
TEDIT.UNDO.REPLACE 32453 . 33807) (TEDIT.REDO.REPLACE 33809 . 35165) (TEDIT.REDO.MOVE 35167 . 35986)))
))
STOP

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

Binary file not shown.

1912
library/TEDITLOOKS → library/tedit/TEDIT-LOOKS
View File

File diff suppressed because it is too large Load Diff

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

Binary file not shown.

2204
library/TEDITMENU → library/tedit/TEDIT-MENU
View File

File diff suppressed because it is too large Load Diff

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

Binary file not shown.

1197
library/TEDITPAGE → library/tedit/TEDIT-PAGE
View File

File diff suppressed because it is too large Load Diff

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

Binary file not shown.

269
library/PCTREE → library/tedit/TEDIT-PCTREE
View File

@@ -1,23 +1,19 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "22-Jun-2022 10:29:01" {DSK}<home>larry>medley>library>PCTREE.;2 28282
(FILECREATED "14-Jul-2022 17:00:01" 
{DSK}<users>kaplan>local>medley3.5>working-medley>library>tedit>TEDIT-PCTREE.;1 27141
:CHANGES-TO (FNS \INSERTTREE)
:PREVIOUS-DATE "19-Apr-2018 12:19:49" {DSK}<home>larry>medley>library>PCTREE.;1)
:PREVIOUS-DATE "14-Jul-2022 11:08:10"
{DSK}<users>kaplan>local>medley3.5>working-medley>library>newtedit>TEDIT-PCTREE.;2)
(* ; "
Copyright (c) 1990-1991, 1993-1995, 1999, 2018 by Venue & Xerox Corporation.
")
(PRETTYCOMPRINT TEDIT-PCTREECOMS)
(PRETTYCOMPRINT PCTREECOMS)
(RPAQQ PCTREECOMS
(RPAQQ TEDIT-PCTREECOMS
[
(* ;; "Balanced tree PIECE TABLE supporting functions")
(FILES TEDITDCL)
(FILES TEDIT-DCL)
(DECLARE%: EVAL@COMPILE DONTCOPY
(* ;; "\WORDSINBTREEMAIN = # of words in the child-pointers & offsets section of the node -- everything before SPARE5 (the overflow place).")
@@ -38,7 +34,7 @@ Copyright (c) 1990-1991, 1993-1995, 1999, 2018 by Venue & Xerox Corporation.
(\BTREETOPHALFOFFSET (UNFOLD (LRSH \BTREEMAXENTRIES 1)
4)))
(FILES (LOADCOMP)
TEDITDCL))
TEDIT-DCL))
(FNS UPDATEPCNODES FINDPCNODE \FIRSTNODE \DELETETREE \INSERTTREE \LASTNODE \MATCHPCS
\SPLITTREE \TEDIT.UPDATETREE \TEDIT.PIECE-CHNO \TEDIT.SET-TOTLEN)
(FNS DISPTREE TREEGRAPHNODE)
@@ -52,7 +48,7 @@ Copyright (c) 1990-1991, 1993-1995, 1999, 2018 by Venue & Xerox Corporation.
(* ;; "Balanced tree PIECE TABLE supporting functions")
(FILESLOAD TEDITDCL)
(FILESLOAD TEDIT-DCL)
(DECLARE%: EVAL@COMPILE DONTCOPY
(DECLARE%: EVAL@COMPILE
@@ -83,36 +79,35 @@ Copyright (c) 1990-1991, 1993-1995, 1999, 2018 by Venue & Xerox Corporation.
(FILESLOAD (LOADCOMP)
TEDITDCL)
TEDIT-DCL)
)
(DEFINEQ
(UPDATEPCNODES
[LAMBDA (PC DELTA) (* ; "Edited 21-Apr-93 16:09 by jds")
[LAMBDA (PC DELTA) (* ; "Edited 21-Apr-93 16:09 by jds")
(* ;; "ADD DELTA TO CHNUM IN NEXTALL NODES OF TOPNODE.")
(LET ((UPWARD (fetch (PIECE PTREENODE) of PC)))
(while UPWARD do (for I from 0 by 4 as ITEM from 1
to (fetch (BTREENODE COUNT) of UPWARD)
when (EQ PC (\GETBASEPTR UPWARD I))
do [\PUTBASEFIXP UPWARD (IPLUS I 2)
(IPLUS DELTA (\GETBASEFIXP UPWARD (IPLUS I 2]
(add (fetch (BTREENODE TOTLEN) of UPWARD)
DELTA)
(SETQ PC UPWARD)
(SETQ UPWARD (fetch (BTREENODE UPWARD) of PC))
(RETURN) finally (HELP "Piece not in its TREENODE"])
(while UPWARD do (for I from 0 by 4 as ITEM from 1 to (fetch (BTREENODE COUNT) of UPWARD)
when (EQ PC (\GETBASEPTR UPWARD I))
do [\PUTBASEFIXP UPWARD (IPLUS I 2)
(IPLUS DELTA (\GETBASEFIXP UPWARD (IPLUS I 2]
(add (fetch (BTREENODE TOTLEN) of UPWARD)
DELTA)
(SETQ PC UPWARD)
(SETQ UPWARD (fetch (BTREENODE UPWARD) of PC))
(RETURN) finally (HELP "Piece not in its TREENODE"])
(FINDPCNODE
[LAMBDA (PC PCTB) (* ; "Edited 13-Apr-93 15:00 by jds")
[LAMBDA (PC PCTB) (* ; "Edited 13-Apr-93 15:00 by jds")
(* ;; "Given a piece and the pctb it's in, return pcnode")
(fetch (PIECE PTREENODE) of PC])
(\FIRSTNODE
[LAMBDA (TREE) (* ; "Edited 14-Apr-93 02:06 by jds")
[LAMBDA (TREE) (* ; "Edited 14-Apr-93 02:06 by jds")
(LET ((COUNT (fetch (BTREENODE COUNT) of TREE))
CHILD)
(SETQ CHILD (\GETBASEPTR TREE 0))
@@ -122,8 +117,8 @@ Copyright (c) 1990-1991, 1993-1995, 1999, 2018 by Venue & Xerox Corporation.
(T TREE])
(\DELETETREE
[LAMBDA (OLD PCNODE) (* ;
 "Edited 21-Mar-95 15:29 by sybalsky:mv:envos")
[LAMBDA (OLD PCNODE) (* ;
 "Edited 21-Mar-95 15:29 by sybalsky:mv:envos")
(* ;; "Removes OLD from PCNODE. OLD is either a piece or tree node.")
@@ -138,9 +133,8 @@ Copyright (c) 1990-1991, 1993-1995, 1999, 2018 by Venue & Xerox Corporation.
(* ;; "Find OLD, .")
(for old ITEM# from 0 to (LLSH (SUB1 NODE-COUNT)
2) by 4
when (EQ OLD (\GETBASEPTR PCNODE ITEM#)) do (RETURN)
finally (HELP "Piece/node not in PCNODE"))
2) by 4 when (EQ OLD (\GETBASEPTR PCNODE ITEM#))
do (RETURN) finally (HELP "Piece/node not in PCNODE"))
(* ;; "Update the previous piece's length, if appropriate:")
@@ -148,10 +142,10 @@ Copyright (c) 1990-1991, 1993-1995, 1999, 2018 by Venue & Xerox Corporation.
(\RPLPTR BB 0 NIL)
[for I from 0 to (IDIFFERENCE \BTREELASTREALOFFSET ITEM#) by 4
do (\PUTBASEPTR BB I (\GETBASEPTR BB (IPLUS I 4)))
(\PUTBASEFIXP BB (IPLUS I 2)
(\GETBASEFIXP BB (IPLUS I 6]
(\PUTBASEFIXP BB (IPLUS I 2)
(\GETBASEFIXP BB (IPLUS I 6]
(\PUTBASEPTR PCNODE \BTREELASTREALOFFSET NIL) (* ;
 "Because it's been copied, clear the old value before the refcnt-er gets to it.")
 "Because it's been copied, clear the old value before the refcnt-er gets to it.")
(* ;; " If adding this piece EMPTIES the tree node, DELETE it.")
@@ -161,11 +155,11 @@ Copyright (c) 1990-1991, 1993-1995, 1999, 2018 by Venue & Xerox Corporation.
((IEQP NODE-COUNT 1)
(\DELETETREE PCNODE (fetch (BTREENODE UPWARD) of PCNODE)))
(T (* ;
 "No split, so update upper nodes with delta-length.")
 "No split, so update upper nodes with delta-length.")
[SETQ NEWLEN
(replace (BTREENODE TOTLEN) of PCNODE
with (for I from 2 to NODE-COUNT as ITEM# from 2
by 4 sum (\GETBASEFIXP PCNODE ITEM#]
with (for I from 2 to NODE-COUNT as ITEM# from 2 by 4
sum (\GETBASEFIXP PCNODE ITEM#]
(replace (BTREENODE COUNT) of PCNODE with (SUB1 NODE-COUNT))
(\TEDIT.UPDATETREE PCNODE (IDIFFERENCE NEWLEN OLDLEN]
@@ -257,36 +251,33 @@ Copyright (c) 1990-1991, 1993-1995, 1999, 2018 by Venue & Xerox Corporation.
1))])
(\LASTNODE
[LAMBDA (TREE) (* ; "Edited 14-Apr-93 16:29 by jds")
[LAMBDA (TREE) (* ; "Edited 14-Apr-93 16:29 by jds")
(LET ((COUNT (fetch (BTREENODE COUNT) of TREE))
CHILD)
(for ITEM# from (LLSH (IDIFFERENCE COUNT 1)
2) to 0 by -4 when (SETQ CHILD (\GETBASEPTR TREE
ITEM#))
2) to 0 by -4 when (SETQ CHILD (\GETBASEPTR TREE ITEM#))
do (RETURN (COND
((type? BTREENODE CHILD)
(\LASTNODE CHILD))
(T TREE])
((type? BTREENODE CHILD)
(\LASTNODE CHILD))
(T TREE])
(\MATCHPCS
[LAMBDA (PCNODE) (* ; "Edited 5-May-93 17:57 by jds")
[LAMBDA (PCNODE) (* ; "Edited 5-May-93 17:57 by jds")
(* ;; "Make sure that any pieces pointed to this node point back to this node.")
(bind PC for OFFSET from 0 to \WORDSINBTREEMAIN by 4 as I from 1
to (fetch (BTREENODE COUNT) of PCNODE) do (SETQ PC (\GETBASEPTR PCNODE OFFSET)
)
(COND
((type? PIECE PC)
(replace (PIECE PTREENODE)
of PC with PCNODE))
((type? BTREENODE PC)
(replace (BTREENODE UPWARD)
of PC with PCNODE])
(bind PC for OFFSET from 0 to \WORDSINBTREEMAIN by 4 as I from 1 to (fetch (BTREENODE COUNT)
of PCNODE)
do (SETQ PC (\GETBASEPTR PCNODE OFFSET))
(COND
((type? PIECE PC)
(replace (PIECE PTREENODE) of PC with PCNODE))
((type? BTREENODE PC)
(replace (BTREENODE UPWARD) of PC with PCNODE])
(\SPLITTREE
[LAMBDA (PCNODE) (* ;
 "Edited 21-Mar-95 15:26 by sybalsky:mv:envos")
[LAMBDA (PCNODE) (* ;
 "Edited 21-Mar-95 15:26 by sybalsky:mv:envos")
(* ;; "We're adding piece NEW in front of OLD. OLD is represented in the B-tree node PCNODE, which is full.")
@@ -299,58 +290,55 @@ Copyright (c) 1990-1991, 1993-1995, 1999, 2018 by Venue & Xerox Corporation.
(UPWARD
(* ;;
 "Easy case: This is not the root node, so split the node and propogate up.")
 "Easy case: This is not the root node, so split the node and propogate up.")
(SETQ NEW1 (create BTREENODE using PCNODE))
(* ;; "Clean out upper 3 child entries, leaving only the lower 2. Have to tell GC about actual child slots being set to NIL (hence \RPLPTRs):")
(for OFST from \BTREETOPHALFOFFSET to \WORDSINBTREEMAIN
by 4 do (\RPLPTR NEW1 OFST NIL)
(\PUTBASEFIXP NEW1 (IPLUS OFST 2)
0))
(for OFST from \BTREETOPHALFOFFSET to \WORDSINBTREEMAIN by 4
do (\RPLPTR NEW1 OFST NIL)
(\PUTBASEFIXP NEW1 (IPLUS OFST 2)
0))
(replace (BTREENODE COUNT) of NEW1 with (LRSH \BTREEMAXENTRIES 1))
(\TEDIT.SET-TOTLEN NEW1)
(\MATCHPCS NEW1)
(* ;;
 "Now clean up the old piece, to contain only the upper 3 original children:")
 "Now clean up the old piece, to contain only the upper 3 original children:")
(for OFST from 0 to (SUB1 \BTREETOPHALFOFFSET) by 4
do (* ;
 "For GC, have to tell it we've dropped pointers to first N/2 pieces")
(\RPLPTR PCNODE OFST NIL))
do (* ;
 "For GC, have to tell it we've dropped pointers to first N/2 pieces")
(\RPLPTR PCNODE OFST NIL))
(* ;; "Move upper N/2+1 down")
[for OFST from 0 to \BTREETOPHALFOFFSET by 4 as UPPEROFST
from \BTREETOPHALFOFFSET by 4
do (\PUTBASEPTR PCNODE OFST (\GETBASEPTR PCNODE UPPEROFST))
(\PUTBASEFIXP PCNODE (IPLUS 2 OFST)
(\GETBASEFIXP PCNODE (IPLUS 2 UPPEROFST]
[for OFST from 0 to \BTREETOPHALFOFFSET by 4 as UPPEROFST from
\BTREETOPHALFOFFSET
by 4 do (\PUTBASEPTR PCNODE OFST (\GETBASEPTR PCNODE UPPEROFST))
(\PUTBASEFIXP PCNODE (IPLUS 2 OFST)
(\GETBASEFIXP PCNODE (IPLUS 2 UPPEROFST]
(* ;; "And clean out upper 2 slots, without the GC seeing it:")
(for OFST from (IPLUS \BTREEWORDSPERENTRY \BTREETOPHALFOFFSET)
to \WORDSINBTREEMAIN by \BTREEWORDSPERENTRY
do (\PUTBASEPTR PCNODE OFST NIL)
(\PUTBASEFIXP PCNODE (IPLUS OFST 2)
0))
(replace (BTREENODE COUNT) of PCNODE with (ADD1 (LRSH
\BTREEMAXENTRIES
1)))
(for OFST from (IPLUS \BTREEWORDSPERENTRY \BTREETOPHALFOFFSET) to
\WORDSINBTREEMAIN
by \BTREEWORDSPERENTRY do (\PUTBASEPTR PCNODE OFST NIL)
(\PUTBASEFIXP PCNODE (IPLUS OFST 2)
0))
(replace (BTREENODE COUNT) of PCNODE with (ADD1 (LRSH \BTREEMAXENTRIES 1)))
(\TEDIT.SET-TOTLEN PCNODE)
(SETQ COUNT (fetch (BTREENODE COUNT) of UPWARD))
(\INSERTTREE NEW1 PCNODE UPWARD NIL (fetch (BTREENODE TOTLEN)
of PCNODE)))
(\INSERTTREE NEW1 PCNODE UPWARD NIL (fetch (BTREENODE TOTLEN) of PCNODE)))
(T
(* ;; "Hard case: This is the root node. We need to create 2 new nodes, put the split parts there, and re-use this node as the root.")
(SETQ NEW1 (create BTREENODE using PCNODE))
(for OFST from \BTREETOPHALFOFFSET to \WORDSINBTREEMAIN by 4
do (\RPLPTR NEW1 OFST NIL)
(\PUTBASEFIXP NEW1 (IPLUS OFST 2)
0))
(\PUTBASEFIXP NEW1 (IPLUS OFST 2)
0))
(replace (BTREENODE UPWARD) of NEW1 with PCNODE)
(replace (BTREENODE COUNT) of NEW1 with (LRSH \BTREEMAXENTRIES 1))
(\TEDIT.SET-TOTLEN NEW1)
@@ -360,22 +348,20 @@ Copyright (c) 1990-1991, 1993-1995, 1999, 2018 by Venue & Xerox Corporation.
(SETQ NEW2 (create BTREENODE using PCNODE))
(for OFST from 0 to (SUB1 \BTREETOPHALFOFFSET) by 4
do (* ;
 "For GC, have to tell it we've dropped pointers to first N/2 pieces")
(\RPLPTR NEW2 OFST NIL))
[for OFST from 0 to \BTREETOPHALFOFFSET by 4 as UPPEROFST
from \BTREETOPHALFOFFSET by 4
do (\PUTBASEPTR NEW2 OFST (\GETBASEPTR NEW2 UPPEROFST))
(\PUTBASEFIXP NEW2 (IPLUS 2 OFST)
(\GETBASEFIXP NEW2 (IPLUS 2 UPPEROFST]
(for OFST from (IPLUS \BTREEWORDSPERENTRY \BTREETOPHALFOFFSET)
to \WORDSINBTREEMAIN by \BTREEWORDSPERENTRY
do (\PUTBASEPTR NEW2 OFST NIL)
(\PUTBASEFIXP NEW2 (IPLUS OFST 2)
0))
do (* ;
 "For GC, have to tell it we've dropped pointers to first N/2 pieces")
(\RPLPTR NEW2 OFST NIL))
[for OFST from 0 to \BTREETOPHALFOFFSET by 4 as UPPEROFST from \BTREETOPHALFOFFSET
by 4 do (\PUTBASEPTR NEW2 OFST (\GETBASEPTR NEW2 UPPEROFST))
(\PUTBASEFIXP NEW2 (IPLUS 2 OFST)
(\GETBASEFIXP NEW2 (IPLUS 2 UPPEROFST]
(for OFST from (IPLUS \BTREEWORDSPERENTRY \BTREETOPHALFOFFSET) to
\WORDSINBTREEMAIN
by \BTREEWORDSPERENTRY do (\PUTBASEPTR NEW2 OFST NIL)
(\PUTBASEFIXP NEW2 (IPLUS OFST 2)
0))
(replace (BTREENODE UPWARD) of NEW2 with PCNODE)
(replace (BTREENODE COUNT) of NEW2 with (ADD1 (LRSH \BTREEMAXENTRIES 1
)))
(replace (BTREENODE COUNT) of NEW2 with (ADD1 (LRSH \BTREEMAXENTRIES 1)))
(\TEDIT.SET-TOTLEN NEW2)
(\MATCHPCS NEW2)
@@ -383,76 +369,70 @@ Copyright (c) 1990-1991, 1993-1995, 1999, 2018 by Venue & Xerox Corporation.
(for OFST from 0 to \WORDSINBTREEMAIN by \BTREEWORDSPERENTRY
do
(* ;; "Clean out the entries in the node, so we don't over-write them by mistake, thus losing refcount sync.")
(* ;; "Clean out the entries in the node, so we don't over-write them by mistake, thus losing refcount sync.")
(\RPLPTR PCNODE OFST NIL)
(\PUTBASEFIXP PCNODE (IPLUS 2 OFST)
0))
(\RPLPTR PCNODE OFST NIL)
(\PUTBASEFIXP PCNODE (IPLUS 2 OFST)
0))
(\RPLPTR PCNODE 0 NEW1) (* ; "Add first new node")
(\PUTBASEFIXP PCNODE 2 (ffetch (BTREENODE TOTLEN) of NEW1))
(\RPLPTR PCNODE 4 NEW2) (* ; "And the second....")
(\PUTBASEFIXP PCNODE 6 (ffetch (BTREENODE TOTLEN) of NEW2))
(freplace (BTREENODE COUNT) of PCNODE with 2)
(freplace (BTREENODE TOTLEN) of PCNODE with (IPLUS (ffetch
(BTREENODE TOTLEN)
of NEW1)
(ffetch
(BTREENODE TOTLEN)
of NEW2])])
(freplace (BTREENODE TOTLEN) of PCNODE with (IPLUS (ffetch (BTREENODE TOTLEN)
of NEW1)
(ffetch (BTREENODE TOTLEN)
of NEW2])])
(\TEDIT.UPDATETREE
[LAMBDA (PCNODE DELTA) (* ;
 "Edited 21-Mar-95 14:40 by sybalsky:mv:envos")
[LAMBDA (PCNODE DELTA) (* ;
 "Edited 21-Mar-95 14:40 by sybalsky:mv:envos")
(* ;; "The size of the text represented by PCNODE has grown by DELTA. Update all of PCNODE's parents to reflect the change in length.")
(LET ((UPWARD (fetch (BTREENODE UPWARD) of PCNODE)))
(while UPWARD do
(* ;; "Keep going up in the tree til we hit the top.")
(* ;; "Keep going up in the tree til we hit the top.")
(for old ITEM# from 0 by 4 as I from 1
to (ffetch (BTREENODE COUNT) of UPWARD)
when (EQ (\GETBASEPTR UPWARD ITEM#)
PCNODE)
do (\PUTBASEFIXP UPWARD (IPLUS ITEM# 2)
(IPLUS (\GETBASEFIXP UPWARD (IPLUS ITEM# 2))
DELTA))
(add (fetch (BTREENODE TOTLEN) of UPWARD)
DELTA)
(RETURN) FINALLY (HELP "PCNODE not in upward node."))
(SETQ PCNODE UPWARD)
(SETQ UPWARD (fetch (BTREENODE UPWARD) of PCNODE])
(for old ITEM# from 0 by 4 as I from 1 to (ffetch (BTREENODE COUNT)
of UPWARD)
when (EQ (\GETBASEPTR UPWARD ITEM#)
PCNODE) do (\PUTBASEFIXP UPWARD (IPLUS ITEM# 2)
(IPLUS (\GETBASEFIXP UPWARD (IPLUS ITEM# 2))
DELTA))
(add (fetch (BTREENODE TOTLEN) of UPWARD)
DELTA)
(RETURN) FINALLY (HELP "PCNODE not in upward node.")
)
(SETQ PCNODE UPWARD)
(SETQ UPWARD (fetch (BTREENODE UPWARD) of PCNODE])
(\TEDIT.PIECE-CHNO
[LAMBDA (PC)
(LET ((PCNODE (fetch (PIECE PTREENODE) of PC))
(CHARCOUNT 0))
(while PCNODE do [add CHARCOUNT (for OFST from 0 by 4
while (NEQ PC (\GETBASEPTR PCNODE OFST))
sum (\GETBASEFIXP PCNODE (IPLUS OFST 2]
(SETQ PC PCNODE)
(SETQ PCNODE (fetch (BTREENODE UPWARD) of PCNODE)))
(while PCNODE do [add CHARCOUNT (for OFST from 0 by 4 while (NEQ PC (\GETBASEPTR PCNODE OFST
))
sum (\GETBASEFIXP PCNODE (IPLUS OFST 2]
(SETQ PC PCNODE)
(SETQ PCNODE (fetch (BTREENODE UPWARD) of PCNODE)))
(ADD1 CHARCOUNT])
(\TEDIT.SET-TOTLEN
[LAMBDA (PCNODE) (* ; "Edited 9-May-93 15:40 by jds")
[LAMBDA (PCNODE) (* ; "Edited 9-May-93 15:40 by jds")
(* ;; "Fix the TOTLEN field of a node to match the sum of its childrens' lengths")
(replace (BTREENODE TOTLEN) of PCNODE with (for I from 1
to (fetch (BTREENODE COUNT)
of PCNODE) as ITEM#
from 2 by 4
sum (\GETBASEFIXP PCNODE ITEM#])
(replace (BTREENODE TOTLEN) of PCNODE with (for I from 1 to (fetch (BTREENODE COUNT) of PCNODE)
as ITEM# from 2 by 4 sum (\GETBASEFIXP PCNODE ITEM#
])
)
(DEFINEQ
(DISPTREE
[LAMBDA (TREE DEPTH) (* ; "Edited 13-Apr-90 15:00 by ON")
[LAMBDA (TREE DEPTH) (* ; "Edited 13-Apr-90 15:00 by ON")
(LET [(G (TREEGRAPHNODE TREE NIL (OR (NUMBERP DEPTH)
T]
T]
(SHOWGRAPH (LAYOUTGRAPH (CADR G)
(LIST (CAR G))
'(VERTICAL))
@@ -461,12 +441,12 @@ Copyright (c) 1990-1991, 1993-1995, 1999, 2018 by Venue & Xerox Corporation.
(INSPECT (fetch NODEID of X])
(TREEGRAPHNODE
[LAMBDA (TREE PARENT DEPTH) (* ; "Edited 12-Jun-90 10:33 by mitani")
[LAMBDA (TREE PARENT DEPTH) (* ; "Edited 12-Jun-90 10:33 by mitani")
(LET (THISNODE NEWDEPTH NODEID LONODES HINODES BFNODE BFNODEID RANKNODE RANKNODEID)
(COND
((ATOM TREE)
(LIST [fetch NODEID of (SETQ THISNODE (NODECREATE (CONS)
TREE NIL NIL (LIST PARENT]
TREE NIL NIL (LIST PARENT]
(LIST THISNODE)))
((OR (EQ DEPTH T)
(AND (NUMBERP DEPTH)
@@ -561,11 +541,10 @@ Copyright (c) 1990-1991, 1993-1995, 1999, 2018 by Venue & Xerox Corporation.
(ADDTOVAR LAMA )
)
(PUTPROPS PCTREE COPYRIGHT ("Venue & Xerox Corporation" 1990 1991 1993 1994 1995 1999 2018))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (2966 23396 (UPDATEPCNODES 2976 . 4063) (FINDPCNODE 4065 . 4297) (\FIRSTNODE 4299 . 4656
) (\DELETETREE 4658 . 7139) (\INSERTTREE 7141 . 11705) (\LASTNODE 11707 . 12350) (\MATCHPCS 12352 .
13476) (\SPLITTREE 13478 . 20654) (\TEDIT.UPDATETREE 20656 . 22133) (\TEDIT.PIECE-CHNO 22135 . 22714)
(\TEDIT.SET-TOTLEN 22716 . 23394)) (23397 25837 (DISPTREE 23407 . 23863) (TREEGRAPHNODE 23865 . 25835)
(FILEMAP (NIL (2938 22352 (UPDATEPCNODES 2948 . 3917) (FINDPCNODE 3919 . 4155) (\FIRSTNODE 4157 . 4518
) (\DELETETREE 4520 . 6985) (\INSERTTREE 6987 . 11551) (\LASTNODE 11553 . 12090) (\MATCHPCS 12092 .
12816) (\SPLITTREE 12818 . 19698) (\TEDIT.UPDATETREE 19700 . 21207) (\TEDIT.PIECE-CHNO 21209 . 21791)
(\TEDIT.SET-TOTLEN 21793 . 22350)) (22353 24789 (DISPTREE 22363 . 22819) (TREEGRAPHNODE 22821 . 24787)
))))
STOP

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

Binary file not shown.

2778
library/tedit/TEDIT-SCREEN Normal file
View File

File diff suppressed because it is too large Load Diff

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

Binary file not shown.

2132
library/tedit/TEDIT-SELECTION Normal file
View File

File diff suppressed because it is too large Load Diff

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

Binary file not shown.

1433
library/TEXTOFD → library/tedit/TEDIT-TEXTOFD
View File

File diff suppressed because it is too large Load Diff

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

Binary file not shown.

1015
library/TFBRAVO → library/tedit/TEDIT-TFBRAVO
View File

File diff suppressed because it is too large Load Diff

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

Binary file not shown.

1582
library/TEDITWINDOW → library/tedit/TEDIT-WINDOW
View File

File diff suppressed because it is too large Load Diff

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

Binary file not shown.

BIN
library/TEDIT.LCOM → library/tedit/TEDIT.LCOM
View File

Binary file not shown.

41
lispusers/PSEUDOHOSTS
View File

@@ -1,12 +1,12 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "25-Jun-2022 17:24:45" 
{DSK}<Users>kaplan>Local>medley3.5>working-medley>lispusers>PSEUDOHOSTS.;149 27524
(FILECREATED "14-Jul-2022 17:54:43" 
{DSK}<Users>kaplan>Local>medley3.5>working-medley>lispusers>PSEUDOHOSTS.;150 27644
:CHANGES-TO (VARS PSEUDOHOSTSCOMS)
:CHANGES-TO (FNS OPENFILE.PH)
:PREVIOUS-DATE "25-Jun-2022 17:07:38"
{DSK}<Users>kaplan>Local>medley3.5>working-medley>lispusers>PSEUDOHOSTS.;148)
:PREVIOUS-DATE "25-Jun-2022 17:24:45"
{DSK}<Users>kaplan>Local>medley3.5>working-medley>lispusers>PSEUDOHOSTS.;149)
(PRETTYCOMPRINT PSEUDOHOSTSCOMS)
@@ -314,6 +314,8 @@
(OPENFILE.PH
[LAMBDA (FILE ACCESS RECOG OTHERINFO FDEV OLDSTRING)
(* ;; "Edited 14-Jul-2022 17:53 by rmk")
(* ;; "Edited 25-Jun-2022 17:06 by rmk: If the stream was opened through the pseudohost, then it should only be registered on the pseudohost. We assume that it is safe to remove it from the target hosts list. The goal is that OPENP should only see it once, as being open on the pseudohost.")
(* ;; "Edited 25-Jan-2022 08:45 by rmk")
@@ -323,11 +325,12 @@
(LET ((TARGETDEV (FETCH (PHDEVICE TARGETDEV) OF FDEV))
(STREAM (PSEUDOHOST.TARGETVAL OPENFILE (FILE ACCESS RECOG OTHERINFO FDEV OLDSTRING)
FDEV)))
(CL:WHEN STREAM
(FDEVOP 'UNREGISTERFILE TARGETDEV TARGETDEV STREAM)
(CHANGE (FETCH (STREAM FULLFILENAME) OF STREAM)
(CONTRACT.PH DATUM FDEV))
(REPLACE (STREAM DEVICE) OF STREAM WITH FDEV))
(IF STREAM
THEN (FDEVOP 'UNREGISTERFILE TARGETDEV TARGETDEV STREAM)
(CHANGE (FETCH (STREAM FULLFILENAME) OF STREAM)
(CONTRACT.PH DATUM FDEV))
(REPLACE (STREAM DEVICE) OF STREAM WITH FDEV)
ELSE (ERROR "File not found: " FILE))
STREAM])
(GETFILENAME.PH
@@ -521,13 +524,13 @@
(LOAD 'EXPORTS.ALL))
)
(DECLARE%: DONTCOPY
(FILEMAP (NIL (1355 9387 (PSEUDOHOST 1365 . 6924) (PSEUDOHOSTP 6926 . 7439) (PSEUDOHOSTS 7441 . 7798)
(TARGETHOST 7800 . 8074) (TRUEFILENAME 8076 . 8763) (PSEUDOFILENAME 8765 . 9385)) (9415 16954 (
EXPAND.PH 9425 . 10678) (CONTRACT.PH 10680 . 13345) (SLASHIT 13347 . 14915) (UNSLASHIT 14917 . 16663)
(GETHOSTINFO.PH 16665 . 16952)) (16955 24859 (OPENFILE.PH 16965 . 17938) (GETFILENAME.PH 17940 . 18229
) (DIRECTORYNAMEP.PH 18231 . 18855) (CLOSEFILE.PH 18857 . 19324) (REOPENFILE.PH 19326 . 19891) (
DELETEFILE.PH 19893 . 20177) (OPENP.PH 20179 . 20474) (UNREGISTERFILE.PH 20476 . 21018) (
REGISTERFILE.PH 21020 . 21554) (GENERATEFILES.PH 21556 . 22596) (GETFILEINFO.PH 22598 . 22900) (
SETFILEINFO.PH 22902 . 23101) (NEXTFILEFN.PH 23103 . 23645) (FILEINFOFN.PH 23647 . 23918) (
RENAMEFILE.PH 23920 . 24857)))))
(FILEMAP (NIL (1350 9382 (PSEUDOHOST 1360 . 6919) (PSEUDOHOSTP 6921 . 7434) (PSEUDOHOSTS 7436 . 7793)
(TARGETHOST 7795 . 8069) (TRUEFILENAME 8071 . 8758) (PSEUDOFILENAME 8760 . 9380)) (9410 16949 (
EXPAND.PH 9420 . 10673) (CONTRACT.PH 10675 . 13340) (SLASHIT 13342 . 14910) (UNSLASHIT 14912 . 16658)
(GETHOSTINFO.PH 16660 . 16947)) (16950 24979 (OPENFILE.PH 16960 . 18058) (GETFILENAME.PH 18060 . 18349
) (DIRECTORYNAMEP.PH 18351 . 18975) (CLOSEFILE.PH 18977 . 19444) (REOPENFILE.PH 19446 . 20011) (
DELETEFILE.PH 20013 . 20297) (OPENP.PH 20299 . 20594) (UNREGISTERFILE.PH 20596 . 21138) (
REGISTERFILE.PH 21140 . 21674) (GENERATEFILES.PH 21676 . 22716) (GETFILEINFO.PH 22718 . 23020) (
SETFILEINFO.PH 23022 . 23221) (NEXTFILEFN.PH 23223 . 23765) (FILEINFOFN.PH 23767 . 24038) (
RENAMEFILE.PH 24040 . 24977)))))
STOP

BIN
lispusers/PSEUDOHOSTS.LCOM
View File

Binary file not shown.

16
sources/LOADUP-FULL
View File

@@ -1,10 +1,12 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED " 7-Mar-2022 21:08:31" {DSK}<home>larry>medley>sources>LOADUP-FULL.;2 4390
(FILECREATED "14-Jul-2022 12:33:11" 
{DSK}<Users>kaplan>Local>medley3.5>working-medley>sources>LOADUP-FULL.;6 4656
:CHANGES-TO (FNS LOADUP-FULL)
:PREVIOUS-DATE " 4-Mar-2022 19:17:17" {DSK}<home>larry>medley>sources>LOADUP-FULL.;1)
:PREVIOUS-DATE "12-Jul-2022 21:57:39"
{DSK}<Users>kaplan>Local>medley3.5>working-medley>sources>LOADUP-FULL.;5)
(PRETTYCOMPRINT LOADUP-FULLCOMS)
@@ -45,7 +47,9 @@
(PRINTOUT T "FULL fonts loaded" T])
(LOADUP-FULL
[LAMBDA NIL (* ; "Edited 7-Mar-2022 21:06 by larry")
[LAMBDA NIL (* ; "Edited 14-Jul-2022 12:32 by rmk")
(* ; "Edited 12-Jul-2022 21:57 by rmk")
(* ; "Edited 7-Mar-2022 21:06 by larry")
(* ; "Edited 2-Mar-2022 13:58 by larry")
(* ; "Edited 15-Jan-2022 15:48 ")
(* ; "Edited 29-Apr-2021 22:27 by rmk:")
@@ -72,8 +76,8 @@
(LOADFULLFONTS)
(LISTPUT IDLE.PROFILE 'TIMEOUT 0)
(SETQQ *DEFAULT-CLEANUP-COMPILER* BCOMPL)
(LOADUP '(CHAT PRESS INTERPRESS TEDIT HRULE TEDITCHAT READNUMBER EDITBITMAP FILEBROWSER THINFILES
GRAPHER SPY WHERE-IS COPYFILES MSANALYZE MSPARSE MASTERSCOPE UNIXPRINT UNICODE
(LOADUP '(CHAT PRESS INTERPRESS TEDIT HRULE TEDIT-CHAT READNUMBER EDITBITMAP FILEBROWSER
THINFILES GRAPHER SPY WHERE-IS COPYFILES MSANALYZE MSPARSE MASTERSCOPE UNIXPRINT
ISO8859IO HELPSYS DINFO CLIPBOARD MODERNIZE WHEELSCROLL PRETTYFILEINDEX WHO-LINE
UNIXCOMM UNIXCHAT))
(COND
@@ -91,5 +95,5 @@
(FIXMETA)
(DECLARE%: DONTCOPY
(FILEMAP (NIL (639 4352 (LOADFULLFONTS 649 . 2090) (LOADUP-FULL 2092 . 4102) (FIXMETA 4104 . 4350)))))
(FILEMAP (NIL (693 4618 (LOADFULLFONTS 703 . 2144) (LOADUP-FULL 2146 . 4368) (FIXMETA 4370 . 4616)))))
STOP

BIN
sources/LOADUP-FULL.LCOM
View File

Binary file not shown.

16
sources/LOADUP-LISP
View File

@@ -1,10 +1,12 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "XCL" BASE 10)
(FILECREATED " 4-Mar-2022 19:17:17" |{DSK}<home>larry>medley>sources>LOADUP-LISP.;2| 5132
(FILECREATED "13-Jul-2022 14:10:00" 
|{DSK}<Users>kaplan>Local>medley3.5>working-medley>sources>LOADUP-LISP.;5| 5331
:CHANGES-TO (FNS LOADUP-LISP)
:PREVIOUS-DATE " 2-Mar-2022 16:31:39" |{DSK}<home>larry>medley>sources>LOADUP-LISP.;1|)
:PREVIOUS-DATE "12-Jul-2022 21:57:32"
|{DSK}<Users>kaplan>Local>medley3.5>working-medley>sources>LOADUP-LISP.;4|)
(PRETTYCOMPRINT LOADUP-LISPCOMS)
@@ -17,11 +19,13 @@
(DEFINEQ
(LOADUP-LISP
(LAMBDA NIL (* \; "Edited 4-Mar-2022 19:13 by larry")
(LAMBDA NIL (* \; "Edited 13-Jul-2022 14:09 by rmk")
(* \; "Edited 4-Mar-2022 19:13 by larry")
(* \; "Edited 2-Mar-2022 16:31 by larry")
(* \; "Edited 28-Feb-2022 15:02 by larry")
(* \; "Edited 29-Apr-2021 22:30 by rmk:")
(SETQQ COMPILE.EXT LCOM) (* \; "should be set earlier")
(SETQQ COMPILE.EXT LCOM)
(MEDLEY-INIT-VARS) (* \; "should be set earlier")
(DRIBBLE (MEDLEYDIR "tmp" "lisp.dribble" T))
(FOR X IN BOOTLOADEDFILES DO (CL:UNLESS (MEMB X SYSFILES)
(PRINTOUT T X " bootloaded" T)
@@ -73,7 +77,7 @@
CMLENVIRONMENT CMLLOAD CMLFLOAT CMLTIME CMLRAND CMLMODULES))
(LOADUP '(PROFILE CMLEXEC EXEC-COMMANDS DEBUGGER IL-ERROR-STUFF DEBUGEDIT))
(LOADUP '(ADDARITH))
(LOADUP '(CMLPATHNAME HPRINT AARITH ADISPLAY HLDISPLAY MENU WINDOWOBJ WINDOWSCROLL WINDOW
(LOADUP '(UNICODE CMLPATHNAME HPRINT AARITH ADISPLAY HLDISPLAY MENU WINDOWOBJ WINDOWSCROLL WINDOW
WINDOWICON PAINTW ATTACHEDWINDOW XXGEOM XXFILL DEXEC INSPECT DESCRIBE
CMLARRAYINSPECTOR EDITINTERFACE TTYIN))
(LOADUP '(BREAK-AND-TRACE))
@@ -117,5 +121,5 @@
(GLOBALVARS LISPMAKESYSDATE MAKESYSFILENAME MEDLEY-INIT-VARS MEDLEYDIR SYSTEMINITVARS USERRECLST)
)
(DECLARE\: DONTCOPY
(FILEMAP (NIL (642 4910 (LOADUP-LISP 652 . 4908)))))
(FILEMAP (NIL (696 5109 (LOADUP-LISP 706 . 5107)))))
STOP

BIN
sources/LOADUP-LISP.LCOM
View File

Binary file not shown.

26
sources/MEDLEYDIR
View File

@@ -1,10 +1,12 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED " 7-Mar-2022 19:39:13" {DSK}<home>larry>medley>sources>MEDLEYDIR.;2 6274
(FILECREATED "13-Jul-2022 15:34:07" 
{DSK}<Users>kaplan>Local>medley3.5>working-medley>sources>MEDLEYDIR.;10 6722
:CHANGES-TO (VARS MEDLEY-INIT-VARS)
:CHANGES-TO (VARS MEDLEYDIRCOMS MEDLEY-INIT-VARS)
:PREVIOUS-DATE " 5-Mar-2022 12:43:54" {DSK}<home>larry>medley>sources>MEDLEYDIR.;1)
:PREVIOUS-DATE "13-Jul-2022 11:37:28"
{DSK}<Users>kaplan>Local>medley3.5>working-medley>sources>MEDLEYDIR.;8)
(PRETTYCOMPRINT MEDLEYDIRCOMS)
@@ -19,6 +21,10 @@
(BEFOREMAKESYSFORMS (SETQ MEDLEYDIR))
(AFTERSYSOUTFORMS (MEDLEY-INIT-VARS))
(AFTERMAKESYSFORMS (MEDLEY-INIT-VARS)))
(* ;;
 "NOTE: Do not use backquote in the variable definitions. These get evaluated early in the loadup.")
(VARS MEDLEY-INIT-VARS)
(DECLARE%: EVAL@COMPILE DOCOPY (ADDVARS (GLOBALVARS MEDLEYDIR MEDLEY-INIT-VARS])
@@ -106,6 +112,12 @@
(ADDTOVAR AFTERMAKESYSFORMS (MEDLEY-INIT-VARS))
(* ;;
"NOTE: Do not use backquote in the variable definitions. These get evaluated early in the loadup.")
(RPAQQ MEDLEY-INIT-VARS
([LISPUSERSDIRECTORIES (MEDLEYDIR '("library" "lispusers" "internal" "greetfiles" "doctools"]
[LISPSOURCEDIRECTORIES (MEDLEYDIR '("sources"]
@@ -115,8 +127,8 @@
(DIRECTORIES (APPEND LISPUSERSDIRECTORIES LISPSOURCEDIRECTORIES))
[LOGINHOST/DIR (DIRECTORYNAME (OR (UNIX-GETENV "LOGINDIR")
(UNIX-GETENV "HOME"]
[USERGREETFILES `((,LOGINHOST/DIR "INIT" COM)
(,LOGINHOST/DIR "INIT"]
[USERGREETFILES (LIST (CONS LOGINHOST/DIR '("INIT" COM))
(CONS LOGINHOST/DIR '("INIT"]
(DISPLAYFONTDIRECTORIES (MEDLEYDIR '("fonts/displayfonts" "fonts/altofonts" "fonts/adobe"
"fonts/big" "fonts/other")
NIL NIL T))
@@ -124,11 +136,13 @@
NIL NIL T))
(INTERPRESSFONTDIRECTORIES (MEDLEYDIR '("fonts/ipfonts")
NIL NIL T))
(UNICODEDIRECTORIES (MEDLEYDIR '("unicode/xerox")
NIL NIL T))
(XCL::*WHERE-IS-CASH-FILES*)))
(DECLARE%: EVAL@COMPILE DOCOPY
(ADDTOVAR GLOBALVARS MEDLEYDIR MEDLEY-INIT-VARS)
)
(DECLARE%: DONTCOPY
(FILEMAP (NIL (1383 4793 (MEDLEY-INIT-VARS 1393 . 3007) (MEDLEYDIR 3009 . 4791)))))
(FILEMAP (NIL (1588 4998 (MEDLEY-INIT-VARS 1598 . 3212) (MEDLEYDIR 3214 . 4996)))))
STOP

BIN
sources/MEDLEYDIR.LCOM
View File

Binary file not shown.