Merge pull request #252 from Interlisp/dup-new-TEDIT
move older "new" TEDIT
This commit is contained in:
Nick Briggs
GitHub
@@ -1,572 +0,0 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
(FILECREATED "22-Mar-95 18:19:18" {DSK}<lispcore>library>new>PCTREE.;1 28446
|
||||
|
||||
changes to%: (FNS \INSERTTREE \DELETETREE \SPLITTREE \TEDIT.UPDATETREE)
|
||||
|
||||
previous date%: " 7-Oct-94 17:44:31" {DSK}<lispcore>library>PCTREE.;5)
|
||||
|
||||
|
||||
(* ; "
|
||||
Copyright (c) 1990, 1991, 1993, 1994, 1995 by Venue & Xerox Corporation. All rights reserved.
|
||||
")
|
||||
|
||||
(PRETTYCOMPRINT PCTREECOMS)
|
||||
|
||||
(RPAQQ PCTREECOMS
|
||||
[
|
||||
(* ;; "Balanced tree PIECE TABLE supporting functions")
|
||||
|
||||
(FILES TEDITDCL)
|
||||
(DECLARE%: EVAL@COMPILE DONTCOPY
|
||||
|
||||
(* ;; "\WORDSINBTREEMAIN = # of words in the child-pointers & offsets section of the node -- everything before SPARE5 (the overflow place).")
|
||||
|
||||
|
||||
(* ;;
|
||||
"\BTREEMAXCOUNT = number of children in a full node = maximum value for a node's COUNT field.")
|
||||
|
||||
|
||||
(* ;; "\BTREELASTREALOFFSET = offset of last real space for a child entry in the node ( = \WORDSINBTREEMAIN - 4)")
|
||||
|
||||
(CONSTANTS (\BTREEMAXENTRIES 8)
|
||||
(\BTREEMAXCOUNT 8)
|
||||
(\BTREEWORDSPERENTRY 4)
|
||||
(\WORDSINBTREEMAIN (UNFOLD \BTREEMAXENTRIES 4))
|
||||
(\BTREELASTREALOFFSET (UNFOLD (SUB1 \BTREEMAXENTRIES)
|
||||
4))
|
||||
(\BTREETOPHALFOFFSET (UNFOLD (LRSH \BTREEMAXENTRIES 1)
|
||||
4)))
|
||||
(FILES (LOADCOMP)
|
||||
TEDITDECLS))
|
||||
(FNS UPDATEPCNODES FINDPCNODE \FIRSTNODE \DELETETREE \INSERTTREE \LASTNODE \MATCHPCS
|
||||
\SPLITTREE \TEDIT.UPDATETREE \TEDIT.PIECE-CHNO \TEDIT.SET-TOTLEN)
|
||||
(FNS DISPTREE TREEGRAPHNODE)
|
||||
(RECORDS BTREENODE)
|
||||
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA)
|
||||
(NLAML)
|
||||
(LAMA])
|
||||
|
||||
|
||||
|
||||
(* ;; "Balanced tree PIECE TABLE supporting functions")
|
||||
|
||||
|
||||
(FILESLOAD TEDITDCL)
|
||||
(DECLARE%: EVAL@COMPILE DONTCOPY
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(RPAQQ \BTREEMAXENTRIES 8)
|
||||
|
||||
(RPAQQ \BTREEMAXCOUNT 8)
|
||||
|
||||
(RPAQQ \BTREEWORDSPERENTRY 4)
|
||||
|
||||
(RPAQ \WORDSINBTREEMAIN (UNFOLD \BTREEMAXENTRIES 4))
|
||||
|
||||
(RPAQ \BTREELASTREALOFFSET (UNFOLD (SUB1 \BTREEMAXENTRIES)
|
||||
4))
|
||||
|
||||
(RPAQ \BTREETOPHALFOFFSET (UNFOLD (LRSH \BTREEMAXENTRIES 1)
|
||||
4))
|
||||
|
||||
|
||||
(CONSTANTS (\BTREEMAXENTRIES 8)
|
||||
(\BTREEMAXCOUNT 8)
|
||||
(\BTREEWORDSPERENTRY 4)
|
||||
(\WORDSINBTREEMAIN (UNFOLD \BTREEMAXENTRIES 4))
|
||||
(\BTREELASTREALOFFSET (UNFOLD (SUB1 \BTREEMAXENTRIES)
|
||||
4))
|
||||
(\BTREETOPHALFOFFSET (UNFOLD (LRSH \BTREEMAXENTRIES 1)
|
||||
4)))
|
||||
)
|
||||
|
||||
|
||||
(FILESLOAD (LOADCOMP)
|
||||
TEDITDECLS)
|
||||
)
|
||||
(DEFINEQ
|
||||
|
||||
(UPDATEPCNODES
|
||||
[LAMBDA (PC DELTA) (* ; "Edited 21-Apr-93 16:09 by jds")
|
||||
|
||||
(* ;; "ADD DELTA TO CHNUM IN NEXTALL NODES OF TOPNODE.")
|
||||
|
||||
(LET ((UPWARD (fetch (PIECE PTREENODE) of PC)))
|
||||
(while UPWARD do (for I from 0 by 4 as ITEM from 1
|
||||
to (fetch (BTREENODE COUNT) of UPWARD)
|
||||
when (EQ PC (\GETBASEPTR UPWARD I))
|
||||
do [\PUTBASEFIXP UPWARD (IPLUS I 2)
|
||||
(IPLUS DELTA (\GETBASEFIXP UPWARD (IPLUS I 2]
|
||||
(add (fetch (BTREENODE TOTLEN) of UPWARD)
|
||||
DELTA)
|
||||
(SETQ PC UPWARD)
|
||||
(SETQ UPWARD (fetch (BTREENODE UPWARD) of PC))
|
||||
(RETURN) finally (HELP "Piece not in its TREENODE"])
|
||||
|
||||
(FINDPCNODE
|
||||
[LAMBDA (PC PCTB) (* ; "Edited 13-Apr-93 15:00 by jds")
|
||||
|
||||
(* ;; "Given a piece and the pctb it's in, return pcnode")
|
||||
|
||||
(fetch (PIECE PTREENODE) of PC])
|
||||
|
||||
(\FIRSTNODE
|
||||
[LAMBDA (TREE) (* ; "Edited 14-Apr-93 02:06 by jds")
|
||||
(LET ((COUNT (fetch (BTREENODE COUNT) of TREE))
|
||||
CHILD)
|
||||
(SETQ CHILD (\GETBASEPTR TREE 0))
|
||||
(COND
|
||||
((type? BTREENODE CHILD)
|
||||
(\FIRSTNODE CHILD))
|
||||
(T TREE])
|
||||
|
||||
(\DELETETREE
|
||||
[LAMBDA (OLD PCNODE) (* ;
|
||||
"Edited 21-Mar-95 15:29 by sybalsky:mv:envos")
|
||||
|
||||
(* ;; "Removes OLD from PCNODE. OLD is either a piece or tree node.")
|
||||
|
||||
(UNINTERRUPTABLY
|
||||
(LET* ((OLDLEN (ffetch (BTREENODE TOTLEN) of PCNODE))
|
||||
NEWLEN INCHNO AFTERFLG NODE-COUNT ITEM# BB)
|
||||
|
||||
(* ;; "NEW CODE")
|
||||
|
||||
(SETQ NODE-COUNT (fetch (BTREENODE COUNT) of PCNODE))
|
||||
|
||||
(* ;; "Find OLD, .")
|
||||
|
||||
(for old ITEM# from 0 to (LLSH (SUB1 NODE-COUNT)
|
||||
2) by 4
|
||||
when (EQ OLD (\GETBASEPTR PCNODE ITEM#)) do (RETURN)
|
||||
finally (HELP "Piece/node not in PCNODE"))
|
||||
|
||||
(* ;; "Update the previous piece's length, if appropriate:")
|
||||
|
||||
(SETQ BB (\ADDBASE PCNODE ITEM#))
|
||||
(\RPLPTR BB 0 NIL)
|
||||
[for I from 0 to (IDIFFERENCE \BTREELASTREALOFFSET ITEM#) by 4
|
||||
do (\PUTBASEPTR BB I (\GETBASEPTR BB (IPLUS I 4)))
|
||||
(\PUTBASEFIXP BB (IPLUS I 2)
|
||||
(\GETBASEFIXP BB (IPLUS I 6]
|
||||
(\PUTBASEPTR PCNODE \BTREELASTREALOFFSET NIL) (* ;
|
||||
"Because it's been copied, clear the old value before the refcnt-er gets to it.")
|
||||
|
||||
(* ;; " If adding this piece EMPTIES the tree node, DELETE it.")
|
||||
|
||||
(* ;; "FIXMI -- This should coalesce adjacent nodes that are too empty!")
|
||||
|
||||
[COND
|
||||
((IEQP NODE-COUNT 1)
|
||||
(\DELETETREE PCNODE (fetch (BTREENODE UPWARD) of PCNODE)))
|
||||
(T (* ;
|
||||
"No split, so update upper nodes with delta-length.")
|
||||
[SETQ NEWLEN
|
||||
(replace (BTREENODE TOTLEN) of PCNODE
|
||||
with (for I from 2 to NODE-COUNT as ITEM# from 2
|
||||
by 4 sum (\GETBASEFIXP PCNODE ITEM#]
|
||||
(replace (BTREENODE COUNT) of PCNODE with (SUB1 NODE-COUNT))
|
||||
(\TEDIT.UPDATETREE PCNODE (IDIFFERENCE NEWLEN OLDLEN]
|
||||
|
||||
(* ;; "END NEW CODE")
|
||||
|
||||
1))])
|
||||
|
||||
(\INSERTTREE
|
||||
[LAMBDA (NEW OLD PCNODE NEW-PREVLEN NEW-OLDLEN PREV)
|
||||
(* ;
|
||||
"Edited 22-Mar-95 15:37 by sybalsky:mv:envos")
|
||||
|
||||
(* ;; "inserts NEW in front of OLD in PCNODE. NEW/OLD are either pieces or tree nodes.")
|
||||
|
||||
(* ;; "If NEWE-PREVLEN is non-NIL, it's a DELTA for updating parents of THE PIECE BEFORE OLD. This is used by \SPLITPIECE to pass down the new shortened length for the original piece.")
|
||||
|
||||
(UNINTERRUPTABLY
|
||||
(LET* ((OLDLEN (ffetch (BTREENODE TOTLEN) of PCNODE))
|
||||
NEWLEN INCHNO AFTERFLG NODE-COUNT ITEM# BB)
|
||||
|
||||
(* ;; "NEW CODE")
|
||||
|
||||
(SETQ NODE-COUNT (fetch (BTREENODE COUNT) of PCNODE))
|
||||
|
||||
(* ;; "Find OLD, and insert the NEW piece (and length) in front of it.")
|
||||
|
||||
[for old ITEM# from 0 to (LLSH (SUB1 NODE-COUNT)
|
||||
2) by 4
|
||||
when (EQ OLD (\GETBASEPTR PCNODE ITEM#)) do (RETURN)
|
||||
finally (COND
|
||||
(OLD (HELP "Old piece not in this PCNODE."))
|
||||
(T (* ; "INSERTING FIRST PIECE")
|
||||
(SETQ ITEM# 0]
|
||||
(OR NEW (HELP "Inserting empty item"))
|
||||
|
||||
(* ;; "Update the previous piece's length, if appropriate:")
|
||||
|
||||
[AND NEW-PREVLEN (COND
|
||||
((ZEROP ITEM#)
|
||||
|
||||
(* ;;
|
||||
"The hard way -- the previous piece is in a prior btree node, so we have to go there to update it.")
|
||||
|
||||
(LET* ((NODE (fetch (PIECE PTREENODE) of PREV)))
|
||||
(UPDATEPCNODES PREV NEW-PREVLEN)))
|
||||
(T
|
||||
(* ;; "Easy way -- it's in this node. Update it in place.")
|
||||
|
||||
(\PUTBASEFIXP PCNODE (IDIFFERENCE ITEM# 2)
|
||||
(IPLUS NEW-PREVLEN (\GETBASEFIXP PCNODE (IDIFFERENCE
|
||||
ITEM# 2]
|
||||
(COND
|
||||
(NEW-OLDLEN (\PUTBASEFIXP PCNODE (IPLUS ITEM# 2)
|
||||
NEW-OLDLEN)))
|
||||
(SETQ BB (\ADDBASE PCNODE ITEM#))
|
||||
(\RPLPTR PCNODE \WORDSINBTREEMAIN NIL) (* ;
|
||||
"Clean out the slot that's about to be copied over.")
|
||||
(\BLT (\ADDBASE BB 4)
|
||||
BB
|
||||
(IDIFFERENCE \WORDSINBTREEMAIN ITEM#))
|
||||
(\PUTBASEPTR PCNODE ITEM# NIL) (* ;
|
||||
"Because it's been copied, clear the old value before the refcnt-er gets to it.")
|
||||
(\RPLPTR PCNODE ITEM# NEW)
|
||||
(COND
|
||||
((type? PIECE NEW)
|
||||
(\PUTBASEFIXP PCNODE (IPLUS ITEM# 2)
|
||||
(fetch (PIECE PLEN) of NEW))
|
||||
(replace (PIECE PTREENODE) of NEW with PCNODE))
|
||||
((type? BTREENODE NEW) (* ; "Inserting a NODE")
|
||||
(\PUTBASEFIXP PCNODE (IPLUS ITEM# 2)
|
||||
(fetch (BTREENODE TOTLEN) of NEW))
|
||||
(replace (BTREENODE UPWARD) of NEW with PCNODE))
|
||||
(T (\ILLEGAL.ARG NEW)))
|
||||
[SETQ NEWLEN (replace (BTREENODE TOTLEN) of PCNODE
|
||||
with (for I from 0 to NODE-COUNT as ITEM#
|
||||
from 2 by 4 sum (\GETBASEFIXP PCNODE ITEM#]
|
||||
|
||||
(* ;; " If adding this piece overflows the tree node, split it.")
|
||||
|
||||
[COND
|
||||
((IEQP NODE-COUNT \BTREEMAXCOUNT) (* ;
|
||||
"Tree node is full, so have to split.")
|
||||
(\SPLITTREE PCNODE OLD NEW))
|
||||
(T (* ;
|
||||
"No split, so update upper nodes with delta-length.")
|
||||
(replace (BTREENODE COUNT) of PCNODE with (ADD1 NODE-COUNT))
|
||||
(\TEDIT.UPDATETREE PCNODE (IDIFFERENCE NEWLEN OLDLEN]
|
||||
|
||||
(* ;; "END NEW CODE")
|
||||
|
||||
1))])
|
||||
|
||||
(\LASTNODE
|
||||
[LAMBDA (TREE) (* ; "Edited 14-Apr-93 16:29 by jds")
|
||||
(LET ((COUNT (fetch (BTREENODE COUNT) of TREE))
|
||||
CHILD)
|
||||
(for ITEM# from (LLSH (IDIFFERENCE COUNT 1)
|
||||
2) to 0 by -4 when (SETQ CHILD (\GETBASEPTR TREE
|
||||
ITEM#))
|
||||
do (RETURN (COND
|
||||
((type? BTREENODE CHILD)
|
||||
(\LASTNODE CHILD))
|
||||
(T TREE])
|
||||
|
||||
(\MATCHPCS
|
||||
[LAMBDA (PCNODE) (* ; "Edited 5-May-93 17:57 by jds")
|
||||
|
||||
(* ;; "Make sure that any pieces pointed to this node point back to this node.")
|
||||
|
||||
(bind PC for OFFSET from 0 to \WORDSINBTREEMAIN by 4 as I from 1
|
||||
to (fetch (BTREENODE COUNT) of PCNODE) do (SETQ PC (\GETBASEPTR PCNODE OFFSET)
|
||||
)
|
||||
(COND
|
||||
((type? PIECE PC)
|
||||
(replace (PIECE PTREENODE)
|
||||
of PC with PCNODE))
|
||||
((type? BTREENODE PC)
|
||||
(replace (BTREENODE UPWARD)
|
||||
of PC with PCNODE])
|
||||
|
||||
(\SPLITTREE
|
||||
[LAMBDA (PCNODE) (* ;
|
||||
"Edited 21-Mar-95 15:26 by sybalsky:mv:envos")
|
||||
|
||||
(* ;; "We're adding piece NEW in front of OLD. OLD is represented in the B-tree node PCNODE, which is full.")
|
||||
|
||||
(* ;; "Split PCNODE in two and propogate any changes upward.")
|
||||
|
||||
(UNINTERRUPTABLY
|
||||
[LET ((UPWARD (fetch (BTREENODE UPWARD) of PCNODE))
|
||||
COUNT ITEM# NEW1 NEW2)
|
||||
(COND
|
||||
(UPWARD
|
||||
|
||||
(* ;;
|
||||
"Easy case: This is not the root node, so split the node and propogate up.")
|
||||
|
||||
(SETQ NEW1 (create BTREENODE using PCNODE))
|
||||
|
||||
(* ;; "Clean out upper 3 child entries, leaving only the lower 2. Have to tell GC about actual child slots being set to NIL (hence \RPLPTRs):")
|
||||
|
||||
(for OFST from \BTREETOPHALFOFFSET to \WORDSINBTREEMAIN
|
||||
by 4 do (\RPLPTR NEW1 OFST NIL)
|
||||
(\PUTBASEFIXP NEW1 (IPLUS OFST 2)
|
||||
0))
|
||||
(replace (BTREENODE COUNT) of NEW1 with (LRSH \BTREEMAXENTRIES 1))
|
||||
(\TEDIT.SET-TOTLEN NEW1)
|
||||
(\MATCHPCS NEW1)
|
||||
|
||||
(* ;;
|
||||
"Now clean up the old piece, to contain only the upper 3 original children:")
|
||||
|
||||
(for OFST from 0 to (SUB1 \BTREETOPHALFOFFSET) by 4
|
||||
do (* ;
|
||||
"For GC, have to tell it we've dropped pointers to first N/2 pieces")
|
||||
(\RPLPTR PCNODE OFST NIL))
|
||||
|
||||
(* ;; "Move upper N/2+1 down")
|
||||
|
||||
[for OFST from 0 to \BTREETOPHALFOFFSET by 4 as UPPEROFST
|
||||
from \BTREETOPHALFOFFSET by 4
|
||||
do (\PUTBASEPTR PCNODE OFST (\GETBASEPTR PCNODE UPPEROFST))
|
||||
(\PUTBASEFIXP PCNODE (IPLUS 2 OFST)
|
||||
(\GETBASEFIXP PCNODE (IPLUS 2 UPPEROFST]
|
||||
|
||||
(* ;; "And clean out upper 2 slots, without the GC seeing it:")
|
||||
|
||||
(for OFST from (IPLUS \BTREEWORDSPERENTRY \BTREETOPHALFOFFSET)
|
||||
to \WORDSINBTREEMAIN by \BTREEWORDSPERENTRY
|
||||
do (\PUTBASEPTR PCNODE OFST NIL)
|
||||
(\PUTBASEFIXP PCNODE (IPLUS OFST 2)
|
||||
0))
|
||||
(replace (BTREENODE COUNT) of PCNODE with (ADD1 (LRSH
|
||||
\BTREEMAXENTRIES
|
||||
1)))
|
||||
(\TEDIT.SET-TOTLEN PCNODE)
|
||||
(SETQ COUNT (fetch (BTREENODE COUNT) of UPWARD))
|
||||
(\INSERTTREE NEW1 PCNODE UPWARD NIL (fetch (BTREENODE TOTLEN)
|
||||
of PCNODE)))
|
||||
(T
|
||||
(* ;; "Hard case: This is the root node. We need to create 2 new nodes, put the split parts there, and re-use this node as the root.")
|
||||
|
||||
(SETQ NEW1 (create BTREENODE using PCNODE))
|
||||
(for OFST from \BTREETOPHALFOFFSET to \WORDSINBTREEMAIN by 4
|
||||
do (\RPLPTR NEW1 OFST NIL)
|
||||
(\PUTBASEFIXP NEW1 (IPLUS OFST 2)
|
||||
0))
|
||||
(replace (BTREENODE UPWARD) of NEW1 with PCNODE)
|
||||
(replace (BTREENODE COUNT) of NEW1 with (LRSH \BTREEMAXENTRIES 1))
|
||||
(\TEDIT.SET-TOTLEN NEW1)
|
||||
(\MATCHPCS NEW1)
|
||||
|
||||
(* ;; "--")
|
||||
|
||||
(SETQ NEW2 (create BTREENODE using PCNODE))
|
||||
(for OFST from 0 to (SUB1 \BTREETOPHALFOFFSET) by 4
|
||||
do (* ;
|
||||
"For GC, have to tell it we've dropped pointers to first N/2 pieces")
|
||||
(\RPLPTR NEW2 OFST NIL))
|
||||
[for OFST from 0 to \BTREETOPHALFOFFSET by 4 as UPPEROFST
|
||||
from \BTREETOPHALFOFFSET by 4
|
||||
do (\PUTBASEPTR NEW2 OFST (\GETBASEPTR NEW2 UPPEROFST))
|
||||
(\PUTBASEFIXP NEW2 (IPLUS 2 OFST)
|
||||
(\GETBASEFIXP NEW2 (IPLUS 2 UPPEROFST]
|
||||
(for OFST from (IPLUS \BTREEWORDSPERENTRY \BTREETOPHALFOFFSET)
|
||||
to \WORDSINBTREEMAIN by \BTREEWORDSPERENTRY
|
||||
do (\PUTBASEPTR NEW2 OFST NIL)
|
||||
(\PUTBASEFIXP NEW2 (IPLUS OFST 2)
|
||||
0))
|
||||
(replace (BTREENODE UPWARD) of NEW2 with PCNODE)
|
||||
(replace (BTREENODE COUNT) of NEW2 with (ADD1 (LRSH \BTREEMAXENTRIES 1
|
||||
)))
|
||||
(\TEDIT.SET-TOTLEN NEW2)
|
||||
(\MATCHPCS NEW2)
|
||||
|
||||
(* ;; "Now clean out the top-level node, and fill it in with its new children.")
|
||||
|
||||
(for OFST from 0 to \WORDSINBTREEMAIN by \BTREEWORDSPERENTRY
|
||||
do
|
||||
|
||||
(* ;; "Clean out the entries in the node, so we don't over-write them by mistake, thus losing refcount sync.")
|
||||
|
||||
(\RPLPTR PCNODE OFST NIL)
|
||||
(\PUTBASEFIXP PCNODE (IPLUS 2 OFST)
|
||||
0))
|
||||
(\RPLPTR PCNODE 0 NEW1) (* ; "Add first new node")
|
||||
(\PUTBASEFIXP PCNODE 2 (ffetch (BTREENODE TOTLEN) of NEW1))
|
||||
(\RPLPTR PCNODE 4 NEW2) (* ; "And the second....")
|
||||
(\PUTBASEFIXP PCNODE 6 (ffetch (BTREENODE TOTLEN) of NEW2))
|
||||
(freplace (BTREENODE COUNT) of PCNODE with 2)
|
||||
(freplace (BTREENODE TOTLEN) of PCNODE with (IPLUS (ffetch
|
||||
(BTREENODE TOTLEN)
|
||||
of NEW1)
|
||||
(ffetch
|
||||
(BTREENODE TOTLEN)
|
||||
of NEW2])])
|
||||
|
||||
(\TEDIT.UPDATETREE
|
||||
[LAMBDA (PCNODE DELTA) (* ;
|
||||
"Edited 21-Mar-95 14:40 by sybalsky:mv:envos")
|
||||
|
||||
(* ;; "The size of the text represented by PCNODE has grown by DELTA. Update all of PCNODE's parents to reflect the change in length.")
|
||||
|
||||
(LET ((UPWARD (fetch (BTREENODE UPWARD) of PCNODE)))
|
||||
(while UPWARD do
|
||||
|
||||
(* ;; "Keep going up in the tree til we hit the top.")
|
||||
|
||||
(for old ITEM# from 0 by 4 as I from 1
|
||||
to (ffetch (BTREENODE COUNT) of UPWARD)
|
||||
when (EQ (\GETBASEPTR UPWARD ITEM#)
|
||||
PCNODE)
|
||||
do (\PUTBASEFIXP UPWARD (IPLUS ITEM# 2)
|
||||
(IPLUS (\GETBASEFIXP UPWARD (IPLUS ITEM# 2))
|
||||
DELTA))
|
||||
(add (fetch (BTREENODE TOTLEN) of UPWARD)
|
||||
DELTA)
|
||||
(RETURN) FINALLY (HELP "PCNODE not in upward node."))
|
||||
(SETQ PCNODE UPWARD)
|
||||
(SETQ UPWARD (fetch (BTREENODE UPWARD) of PCNODE])
|
||||
|
||||
(\TEDIT.PIECE-CHNO
|
||||
[LAMBDA (PC)
|
||||
(LET ((PCNODE (fetch (PIECE PTREENODE) of PC))
|
||||
(CHARCOUNT 0))
|
||||
(while PCNODE do [add CHARCOUNT (for OFST from 0 by 4
|
||||
while (NEQ PC (\GETBASEPTR PCNODE OFST))
|
||||
sum (\GETBASEFIXP PCNODE (IPLUS OFST 2]
|
||||
(SETQ PC PCNODE)
|
||||
(SETQ PCNODE (fetch (BTREENODE UPWARD) of PCNODE)))
|
||||
(ADD1 CHARCOUNT])
|
||||
|
||||
(\TEDIT.SET-TOTLEN
|
||||
[LAMBDA (PCNODE) (* ; "Edited 9-May-93 15:40 by jds")
|
||||
|
||||
(* ;; "Fix the TOTLEN field of a node to match the sum of its childrens' lengths")
|
||||
|
||||
(replace (BTREENODE TOTLEN) of PCNODE with (for I from 1
|
||||
to (fetch (BTREENODE COUNT)
|
||||
of PCNODE) as ITEM#
|
||||
from 2 by 4
|
||||
sum (\GETBASEFIXP PCNODE ITEM#])
|
||||
)
|
||||
(DEFINEQ
|
||||
|
||||
(DISPTREE
|
||||
[LAMBDA (TREE DEPTH) (* ; "Edited 13-Apr-90 15:00 by ON")
|
||||
(LET [(G (TREEGRAPHNODE TREE NIL (OR (NUMBERP DEPTH)
|
||||
T]
|
||||
(SHOWGRAPH (LAYOUTGRAPH (CADR G)
|
||||
(LIST (CAR G))
|
||||
'(VERTICAL))
|
||||
NIL
|
||||
#'(LAMBDA (X)
|
||||
(INSPECT (fetch NODEID of X])
|
||||
|
||||
(TREEGRAPHNODE
|
||||
[LAMBDA (TREE PARENT DEPTH) (* ; "Edited 12-Jun-90 10:33 by mitani")
|
||||
(LET (THISNODE NEWDEPTH NODEID LONODES HINODES BFNODE BFNODEID RANKNODE RANKNODEID)
|
||||
(COND
|
||||
((ATOM TREE)
|
||||
(LIST [fetch NODEID of (SETQ THISNODE (NODECREATE (CONS)
|
||||
TREE NIL NIL (LIST PARENT]
|
||||
(LIST THISNODE)))
|
||||
((OR (EQ DEPTH T)
|
||||
(AND (NUMBERP DEPTH)
|
||||
(>= DEPTH 0)))
|
||||
(SETQ NEWDEPTH (COND
|
||||
((NUMBERP DEPTH)
|
||||
(SUB1 DEPTH))
|
||||
(T DEPTH)))
|
||||
(SETQ NODEID (fetch (PCTNODE PCE) of TREE))
|
||||
(SETQ LONODES (TREEGRAPHNODE (fetch (PCTNODE LO) of TREE)
|
||||
NODEID NEWDEPTH))
|
||||
(SETQ HINODES (TREEGRAPHNODE (fetch (PCTNODE HI) of TREE)
|
||||
NODEID NEWDEPTH))
|
||||
(SETQ BFNODE (NODECREATE (SETQ BFNODEID (CONS))
|
||||
(fetch (PCTNODE BF) of TREE)
|
||||
NIL NIL (LIST NODEID)))
|
||||
(SETQ RANKNODE (NODECREATE (SETQ RANKNODEID (CONS))
|
||||
(fetch (PCTNODE RANK) of TREE)
|
||||
NIL NIL (LIST NODEID)))
|
||||
[SETQ THISNODE (NODECREATE NODEID (fetch (PCTNODE CHNUM) of TREE)
|
||||
NIL
|
||||
(LIST (CAR LONODES)
|
||||
BFNODEID RANKNODEID (CAR HINODES))
|
||||
(AND PARENT (LIST PARENT]
|
||||
(LIST (fetch NODEID of THISNODE)
|
||||
(APPEND (LIST THISNODE BFNODE RANKNODE)
|
||||
(CADR LONODES)
|
||||
(CADR HINODES])
|
||||
)
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(DATATYPE BTREENODE (
|
||||
(* ;; "An order-4 BTREE node for representing the piece table for TEdit.")
|
||||
|
||||
DOWN1
|
||||
(DLEN1 FIXP)
|
||||
DOWN2
|
||||
(DLEN2 FIXP)
|
||||
DOWN3
|
||||
(DLEN3 FIXP)
|
||||
DOWN4
|
||||
(DLEN4 FIXP)
|
||||
DOWN5
|
||||
(DLEN5 FIXP)
|
||||
DOWN6
|
||||
(DLEN6 FIXP)
|
||||
DOWN7
|
||||
(DLEN7 FIXP)
|
||||
DOWN8
|
||||
(DLEN8 FIXP)
|
||||
SPARE5 (* ;
|
||||
"Used only to hold the extra piece when we're overflowing")
|
||||
(SPARELEN FIXP) (* ; "So the code is easy and fast.")
|
||||
(COUNT BITS 4) (* ; "# of children of this node")
|
||||
(UPWARD XPOINTER) (* ; "Parent of this node, if any.")
|
||||
(TOTLEN FIXP) (* ;
|
||||
"Total length of this tree and subtrees")
|
||||
))
|
||||
)
|
||||
|
||||
(/DECLAREDATATYPE 'BTREENODE
|
||||
'(POINTER FIXP POINTER FIXP POINTER FIXP POINTER FIXP POINTER FIXP POINTER FIXP POINTER FIXP
|
||||
POINTER FIXP POINTER FIXP (BITS 4)
|
||||
XPOINTER FIXP)
|
||||
'((BTREENODE 0 POINTER)
|
||||
(BTREENODE 2 FIXP)
|
||||
(BTREENODE 4 POINTER)
|
||||
(BTREENODE 6 FIXP)
|
||||
(BTREENODE 8 POINTER)
|
||||
(BTREENODE 10 FIXP)
|
||||
(BTREENODE 12 POINTER)
|
||||
(BTREENODE 14 FIXP)
|
||||
(BTREENODE 16 POINTER)
|
||||
(BTREENODE 18 FIXP)
|
||||
(BTREENODE 20 POINTER)
|
||||
(BTREENODE 22 FIXP)
|
||||
(BTREENODE 24 POINTER)
|
||||
(BTREENODE 26 FIXP)
|
||||
(BTREENODE 28 POINTER)
|
||||
(BTREENODE 30 FIXP)
|
||||
(BTREENODE 32 POINTER)
|
||||
(BTREENODE 34 FIXP)
|
||||
(BTREENODE 32 (BITS . 3))
|
||||
(BTREENODE 36 XPOINTER)
|
||||
(BTREENODE 38 FIXP))
|
||||
'40)
|
||||
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
|
||||
|
||||
(ADDTOVAR NLAMA )
|
||||
|
||||
(ADDTOVAR NLAML )
|
||||
|
||||
(ADDTOVAR LAMA )
|
||||
)
|
||||
(PUTPROPS PCTREE COPYRIGHT ("Venue & Xerox Corporation" 1990 1991 1993 1994 1995))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (3019 23506 (UPDATEPCNODES 3029 . 4116) (FINDPCNODE 4118 . 4350) (\FIRSTNODE 4352 . 4709
|
||||
) (\DELETETREE 4711 . 7192) (\INSERTTREE 7194 . 11815) (\LASTNODE 11817 . 12460) (\MATCHPCS 12462 .
|
||||
13586) (\SPLITTREE 13588 . 20764) (\TEDIT.UPDATETREE 20766 . 22243) (\TEDIT.PIECE-CHNO 22245 . 22824)
|
||||
(\TEDIT.SET-TOTLEN 22826 . 23504)) (23507 25947 (DISPTREE 23517 . 23973) (TREEGRAPHNODE 23975 . 25945)
|
||||
))))
|
||||
STOP
|
||||
2226
library/new/TEDIT
2226
library/new/TEDIT
File diff suppressed because it is too large
Load Diff
Binary file not shown.
Binary file not shown.
Binary file not shown.
1654
library/new/TEDITDCL
1654
library/new/TEDITDCL
File diff suppressed because it is too large
Load Diff
File diff suppressed because one or more lines are too long
File diff suppressed because it is too large
Load Diff
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
@@ -1,622 +0,0 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
(FILECREATED " 4-May-95 10:38:22" {DSK}<lispcore>library>new>TEDITHISTORY.;3 38709
|
||||
|
||||
changes to%: (FNS TEDIT.REDO.INSERTION \TEDIT.CUMULATE.EVENTS TEDIT.UNDO TEDIT.UNDO.REPLACE)
|
||||
|
||||
previous date%: "22-Mar-95 18:20:17" {DSK}<lispcore>library>new>TEDITHISTORY.;1)
|
||||
|
||||
|
||||
(* ; "
|
||||
Copyright (c) 1983, 1984, 1985, 1986, 1987, 1990, 1991, 1993, 1995 by Venue & Xerox Corporation. All rights reserved.
|
||||
")
|
||||
|
||||
(PRETTYCOMPRINT TEDITHISTORYCOMS)
|
||||
|
||||
(RPAQQ TEDITHISTORYCOMS
|
||||
((FILES TEDITDECLS)
|
||||
(DECLARE%: EVAL@COMPILE DONTCOPY (CONSTANTS (\SCRATCHLEN 64))
|
||||
(FILES (LOADCOMP)
|
||||
TEDITDECLS))
|
||||
(GLOBALVARS TEDIT.HISTORY.TYPELST TEDIT.HISTORYLST)
|
||||
(INITVARS (TEDIT.HISTORY.TYPELST NIL)
|
||||
(TEDIT.HISTORYLST NIL))
|
||||
(COMS
|
||||
(* ;; "History-list maintenance functions")
|
||||
|
||||
(FNS \TEDIT.HISTORYADD \TEDIT.CUMULATE.EVENTS))
|
||||
(COMS
|
||||
(* ;; "Specialized UNDO & REDO functions.")
|
||||
|
||||
(FNS TEDIT.UNDO TEDIT.UNDO.INSERTION TEDIT.UNDO.DELETION TEDIT.REDO
|
||||
TEDIT.REDO.INSERTION TEDIT.UNDO.MOVE TEDIT.UNDO.REPLACE TEDIT.REDO.REPLACE
|
||||
TEDIT.REDO.MOVE))))
|
||||
|
||||
(FILESLOAD TEDITDECLS)
|
||||
(DECLARE%: EVAL@COMPILE DONTCOPY
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(RPAQQ \SCRATCHLEN 64)
|
||||
|
||||
|
||||
(CONSTANTS (\SCRATCHLEN 64))
|
||||
)
|
||||
|
||||
|
||||
(FILESLOAD (LOADCOMP)
|
||||
TEDITDECLS)
|
||||
)
|
||||
(DECLARE%: DOEVAL@COMPILE DONTCOPY
|
||||
|
||||
(GLOBALVARS TEDIT.HISTORY.TYPELST TEDIT.HISTORYLST)
|
||||
)
|
||||
|
||||
(RPAQ? TEDIT.HISTORY.TYPELST NIL)
|
||||
|
||||
(RPAQ? TEDIT.HISTORYLST NIL)
|
||||
|
||||
|
||||
|
||||
(* ;; "History-list maintenance functions")
|
||||
|
||||
(DEFINEQ
|
||||
|
||||
(\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.")
|
||||
|
||||
(LET* ((OLDEVENT (fetch (TEXTOBJ TXTHISTORY) of TEXTOBJ))
|
||||
(ETYPE (fetch (TEDITHISTORYEVENT THACTION) of EVENT))
|
||||
(OETYPE (fetch (TEDITHISTORYEVENT THACTION) of OLDEVENT))
|
||||
(REALEVENT EVENT))
|
||||
[COND
|
||||
((AND OLDEVENT (EQ OETYPE ETYPE)
|
||||
(EQ ETYPE 'Delete)) (* ;
|
||||
"Repeated successive deletions. See if we can combine them.")
|
||||
|
||||
(LET* [(OSTART (fetch (TEDITHISTORYEVENT THCH#) of OLDEVENT))
|
||||
(NSTART (fetch (TEDITHISTORYEVENT THCH#) of EVENT))
|
||||
(OLDEND (+ OSTART (fetch (TEDITHISTORYEVENT THLEN) of OLDEVENT)))
|
||||
(NEWEND (+ NSTART (fetch (TEDITHISTORYEVENT THLEN) of EVENT]
|
||||
(COND
|
||||
((IEQP OLDEND NSTART) (* ;
|
||||
"The old deletion was just in front of the current one; cumulate them.")
|
||||
|
||||
(SETQ REALEVENT (\TEDIT.CUMULATE.EVENTS OLDEVENT EVENT T)))
|
||||
((IEQP NEWEND OSTART) (* ;
|
||||
"The new deletion was just in front of the old one; cumulate them.")
|
||||
|
||||
(SETQ REALEVENT (\TEDIT.CUMULATE.EVENTS EVENT OLDEVENT T]
|
||||
(replace (TEXTOBJ TXTHISTORY) of TEXTOBJ with REALEVENT])
|
||||
|
||||
(\TEDIT.CUMULATE.EVENTS
|
||||
[LAMBDA (EVENT1 EVENT2 PIECES-TO-SAVE?) (* ;
|
||||
"Edited 3-Apr-95 12:23 by sybalsky:mv:envos")
|
||||
|
||||
(* ;; "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 (CAR (fetch (TEDITHISTORYEVENT THFIRSTPIECE) of EVENT2)))
|
||||
(REALEVENT (create TEDITHISTORYEVENT using EVENT1 THLEN _
|
||||
(+ OLDLEN (fetch (TEDITHISTORYEVENT
|
||||
THLEN) of EVENT2]
|
||||
(bind (PC _ (CAR (fetch (TEDITHISTORYEVENT THFIRSTPIECE) of EVENT1)))
|
||||
(CHCOUNT _ 0) while (< (SETQ CHCOUNT (+ CHCOUNT (fetch (PIECE PLEN)
|
||||
of PC)))
|
||||
OLDLEN) do (SETQ PC (fetch (PIECE NEXTPIECE)
|
||||
of PC))
|
||||
finally (replace (PIECE NEXTPIECE) of PC with NEWPC1)
|
||||
(replace (PIECE PREVPIECE) of NEWPC1 with PC)
|
||||
(RETURN))
|
||||
REALEVENT])
|
||||
)
|
||||
|
||||
|
||||
|
||||
(* ;; "Specialized UNDO & REDO functions.")
|
||||
|
||||
(DEFINEQ
|
||||
|
||||
(TEDIT.UNDO
|
||||
[LAMBDA (TEXTOBJ) (* ;
|
||||
"Edited 22-Mar-95 16:48 by sybalsky:mv:envos")
|
||||
|
||||
(* ;; "Undo the last thing this guy did.")
|
||||
|
||||
(COND
|
||||
((NOT (fetch (TEXTOBJ TXTREADONLY) of TEXTOBJ))
|
||||
|
||||
(* ;; "Only undo things if the document is allowed to change.")
|
||||
|
||||
(PROG ((SEL (fetch (TEXTOBJ SEL) of TEXTOBJ))
|
||||
EVENT CH# LEN FIRSTPIECE)
|
||||
(COND
|
||||
((SETQ EVENT (fetch (TEXTOBJ TXTHISTORY) of TEXTOBJ))
|
||||
(* ;
|
||||
"There really is something to UNDO. Decide what, & fix it.")
|
||||
(SETQ LEN (fetch THLEN of EVENT)) (* ;
|
||||
"Length of the text that was inserted/deleted/changed")
|
||||
(SETQ CH# (fetch THCH# of EVENT)) (* ; "Starting CH# of the change")
|
||||
(SETQ FIRSTPIECE (CAR (fetch THFIRSTPIECE of EVENT)))
|
||||
(* ;
|
||||
"First piece affected by the change")
|
||||
(RESETLST
|
||||
(RESETSAVE (CURSOR WAITINGCURSOR))
|
||||
(\SHOWSEL SEL NIL NIL)
|
||||
[SELECTQ (fetch THACTION of EVENT)
|
||||
((Insert Copy Include) (* ; "It was an insertion")
|
||||
(TEDIT.UNDO.INSERTION TEXTOBJ EVENT LEN CH# FIRSTPIECE))
|
||||
(Delete (* ; "It was a deletion")
|
||||
(TEDIT.UNDO.DELETION TEXTOBJ EVENT LEN CH# FIRSTPIECE))
|
||||
(Looks (* ; "It was a character-looks change")
|
||||
(TEDIT.UNDO.LOOKS TEXTOBJ EVENT LEN CH# FIRSTPIECE))
|
||||
(ParaLooks (* ; "It was a PARA looks change")
|
||||
(TEDIT.UNDO.PARALOOKS TEXTOBJ EVENT LEN CH# FIRSTPIECE))
|
||||
(Move (TEDIT.UNDO.MOVE TEXTOBJ EVENT LEN CH# FIRSTPIECE)
|
||||
(* ; "He moved some text")
|
||||
)
|
||||
((Replace LowerCase UpperCase)
|
||||
|
||||
(* ;; "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.")
|
||||
(TEDIT.PROMPTPRINT TEXTOBJ "You can't UNDO a GET." T))
|
||||
(Put (* ; "He did a PUT -- not undoable.")
|
||||
(TEDIT.PROMPTPRINT TEXTOBJ "You can't UNDO a Put." T))
|
||||
(COND
|
||||
((AND (SETQ UNDOFN (ASSOC (fetch THACTION of EVENT)
|
||||
TEDIT.HISTORY.TYPELST))
|
||||
(SETQ UNDOFN (CADDR UNDOFN)))
|
||||
(* ;
|
||||
"TEDIT.HISTORY.TYPELST is an ALST of form (type redofn undofn)")
|
||||
(APPLY* UNDOFN TEXTOBJ EVENT LEN CH# FIRSTPIECE))
|
||||
(T (TEDIT.PROMPTPRINT TEXTOBJ (CONCAT "UNDO not implemented for "
|
||||
(fetch THACTION of EVENT))
|
||||
T]
|
||||
(\SHOWSEL SEL NIL T)))
|
||||
(T (TEDIT.PROMPTPRINT TEXTOBJ "Nothing to UNDO." T])
|
||||
|
||||
(TEDIT.UNDO.INSERTION
|
||||
[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")
|
||||
(\DELETECH CH# (IPLUS CH# LEN)
|
||||
LEN TEXTOBJ)
|
||||
(\FIXDLINES (fetch (TEXTOBJ LINES) of TEXTOBJ)
|
||||
(fetch (TEXTOBJ SEL) of TEXTOBJ)
|
||||
CH#
|
||||
(IPLUS CH# LEN)
|
||||
TEXTOBJ) (* ;
|
||||
"Fix the line descriptors & selection")
|
||||
(TEDIT.UPDATE.SCREEN TEXTOBJ) (* ;
|
||||
"Fix up the display for all this foofaraw")
|
||||
(replace (SELECTION POINT) of (fetch (TEXTOBJ SEL) of TEXTOBJ)
|
||||
with 'LEFT)
|
||||
(\FIXSEL (fetch (TEXTOBJ SEL) of TEXTOBJ)
|
||||
TEXTOBJ) (* ; "Really fix the selection")
|
||||
(replace THACTION of EVENT with 'Delete)
|
||||
(* ;
|
||||
"Make the UNDO be UNDOable, by changing the event to a deletion.")
|
||||
])
|
||||
|
||||
(TEDIT.UNDO.DELETION
|
||||
[LAMBDA (TEXTOBJ EVENT LEN CH# FIRSTPIECE) (* ; "Edited 21-Apr-93 12:01 by jds")
|
||||
|
||||
(* ;; "UNDO a prior Deletion of text.")
|
||||
|
||||
(PROG ((NPC (fetch (PIECE NEXTPIECE) of FIRSTPIECE))
|
||||
(PCTB (fetch (TEXTOBJ PCTB) of TEXTOBJ))
|
||||
(SEL (fetch (TEXTOBJ SEL) of TEXTOBJ))
|
||||
(OTEXTLEN (fetch (TEXTOBJ TEXTLEN) of TEXTOBJ))
|
||||
NEWPIECE INSPC OBJECT INSERTFN START-OF-PIECE)
|
||||
(SETQ INSPC (\CHTOPC CH# PCTB T))
|
||||
(replace (TEXTOBJ \INSERTPCVALID) of TEXTOBJ with NIL)
|
||||
(* ;
|
||||
"Keep future people from stepping on the current cache piece, which is probably no longer valid.")
|
||||
(COND
|
||||
((fetch (TEXTOBJ TXTREADONLY) of TEXTOBJ)
|
||||
(* ;
|
||||
"Don't change read-only documents.")
|
||||
(RETURN)))
|
||||
[COND
|
||||
((IGREATERP CH# START-OF-PIECE)
|
||||
(SETQ INSPC (\SPLITPIECE INSPC (- CH# START-OF-PIECE)
|
||||
TEXTOBJ INSPC#]
|
||||
(SETQ NEWPIECE (create PIECE using FIRSTPIECE))
|
||||
(replace THFIRSTPIECE of EVENT with NEWPIECE)
|
||||
(bind (TL _ 0) while (ILESSP TL LEN) do (\INSERTPIECE NEWPIECE INSPC TEXTOBJ)
|
||||
(* ; "Insert the piece back in")
|
||||
[COND
|
||||
([AND (SETQ OBJECT
|
||||
(fetch (PIECE POBJ)
|
||||
of NEWPIECE))
|
||||
(SETQ INSERTFN
|
||||
(IMAGEOBJPROP OBJECT
|
||||
'WHENINSERTEDFN]
|
||||
(* ;
|
||||
"If this is an imageobject, and it has an insertfn, call it.")
|
||||
(APPLY* INSERTFN OBJECT (
|
||||
\TEDIT.PRIMARYW
|
||||
TEXTOBJ)
|
||||
NIL
|
||||
(TEXTSTREAM TEXTOBJ]
|
||||
(SETQ TL (IPLUS TL (fetch
|
||||
(PIECE PLEN)
|
||||
of FIRSTPIECE)
|
||||
))
|
||||
(* ;
|
||||
"Keep track of how much we've re-inserted")
|
||||
(SETQ FIRSTPIECE NPC)
|
||||
(* ;
|
||||
"Move to the next piece to insert")
|
||||
(AND NPC (SETQ NPC (fetch
|
||||
(PIECE NEXTPIECE)
|
||||
of NPC)))
|
||||
(SETQ NEWPIECE (create PIECE
|
||||
using FIRSTPIECE))
|
||||
) (* ;
|
||||
"Done here because \INSERTPIECE creams the NEXTPIECE field.")
|
||||
(replace (TEXTOBJ TEXTLEN) of TEXTOBJ with (IPLUS (fetch (TEXTOBJ TEXTLEN)
|
||||
of TEXTOBJ)
|
||||
LEN))
|
||||
(* ;
|
||||
"Reset the text length and EOF ptr of the text stream.")
|
||||
(\FIXILINES TEXTOBJ SEL CH# LEN OTEXTLEN) (* ;
|
||||
"Fix the line descriptors & selection")
|
||||
(TEDIT.UPDATE.SCREEN TEXTOBJ) (* ;
|
||||
"Fix up the display for all this foofaraw")
|
||||
(replace (SELECTION CH#) of SEL with CH#)
|
||||
(* ;
|
||||
"Make the selection point at the re-inserted text")
|
||||
(replace (SELECTION CHLIM) of SEL with (IPLUS CH# LEN))
|
||||
(replace (SELECTION DCH) of SEL with LEN)
|
||||
(replace (SELECTION POINT) of SEL with (fetch THPOINT of EVENT))
|
||||
(\TEDIT.SET.SEL.LOOKS SEL 'NORMAL)
|
||||
(\FIXSEL SEL TEXTOBJ) (* ; "Really fix the selection")
|
||||
(replace THACTION of EVENT with 'Insert)
|
||||
(* ;
|
||||
"Make the UNDO be UNDOable, by changing the event to a insertion.")
|
||||
])
|
||||
|
||||
(TEDIT.REDO
|
||||
[LAMBDA (TEXTOBJ) (* ; "Edited 30-May-91 21:27 by jds")
|
||||
|
||||
(* ;; "REDO the last thing this guy did.")
|
||||
|
||||
(PROG ((SEL (fetch (TEXTOBJ SEL) of TEXTOBJ))
|
||||
EVENT CH)
|
||||
(COND
|
||||
((FETCH (TEXTOBJ TXTREADONLY) OF TEXTOBJ)
|
||||
|
||||
(* ;; "The document is read-only; don't make any changes.")
|
||||
|
||||
NIL)
|
||||
((SETQ EVENT (fetch (TEXTOBJ TXTHISTORY) of TEXTOBJ))
|
||||
(* ;
|
||||
"There really is something to REDO Decide what, & do it.")
|
||||
(RESETLST
|
||||
(RESETSAVE (CURSOR WAITINGCURSOR))
|
||||
(\SHOWSEL SEL NIL NIL)
|
||||
(SELECTQ (fetch THACTION of EVENT)
|
||||
((Insert Copy Include) (* ; "It was an insertion")
|
||||
(TEDIT.REDO.INSERTION TEXTOBJ EVENT
|
||||
(IMAX 1 (SELECTQ (fetch (SELECTION POINT) of SEL)
|
||||
(LEFT (fetch (SELECTION CH#) of SEL))
|
||||
(RIGHT (fetch (SELECTION CHLIM) of SEL))
|
||||
NIL))))
|
||||
(Delete (* ; "It was a deletion")
|
||||
(\TEDIT.DELETE SEL TEXTOBJ))
|
||||
(Replace (* ;
|
||||
"It was a replacement (a del/insert combo)")
|
||||
(TEDIT.REDO.REPLACE TEXTOBJ EVENT))
|
||||
(LowerCase (* ; "He lower-cased something")
|
||||
(\TEDIT.LCASE.SEL TEXTOBJ TEXTOBJ SEL))
|
||||
(UpperCase (* ; "He upper-cased something")
|
||||
(\TEDIT.LCASE.SEL TEXTOBJ TEXTOBJ SEL))
|
||||
(Looks (* ; "It was a looks change")
|
||||
(TEDIT.REDO.LOOKS TEXTOBJ EVENT (IMAX 1
|
||||
(SELECTQ (fetch (SELECTION
|
||||
POINT)
|
||||
of SEL)
|
||||
(LEFT (fetch (SELECTION
|
||||
CH#)
|
||||
of SEL))
|
||||
(RIGHT (fetch (SELECTION
|
||||
CHLIM)
|
||||
of SEL))
|
||||
NIL))))
|
||||
(ParaLooks (* ; "It was a Paragraph looks change")
|
||||
(TEDIT.REDO.PARALOOKS TEXTOBJ EVENT
|
||||
(IMAX 1 (SELECTQ (fetch (SELECTION POINT) of SEL)
|
||||
(LEFT (fetch (SELECTION CH#) of SEL))
|
||||
(RIGHT (fetch (SELECTION CHLIM) of SEL))
|
||||
NIL))))
|
||||
(Find (* ; "EXACT-MATCH SEARCH COMMAND")
|
||||
(RESETLST
|
||||
(RESETSAVE (CURSOR WAITINGCURSOR))
|
||||
(TEDIT.PROMPTPRINT TEXTOBJ "Searching..." T)
|
||||
(SETQ SEL (fetch (TEXTOBJ SEL) of TEXTOBJ))
|
||||
(\SHOWSEL SEL NIL NIL)
|
||||
(SETQ CH (TEDIT.FIND TEXTOBJ (fetch THAUXINFO of EVENT)))
|
||||
(COND
|
||||
(CH (TEDIT.PROMPTPRINT TEXTOBJ "done.")
|
||||
(replace (SELECTION CH#) of SEL with CH)
|
||||
[replace (SELECTION CHLIM) of SEL
|
||||
with (IPLUS CH (NCHARS (fetch THAUXINFO
|
||||
of EVENT]
|
||||
(replace (SELECTION DCH) of SEL
|
||||
with (NCHARS (fetch THAUXINFO of EVENT)))
|
||||
(replace (SELECTION POINT) of SEL with
|
||||
'RIGHT)
|
||||
(\FIXSEL SEL TEXTOBJ)
|
||||
(TEDIT.NORMALIZECARET TEXTOBJ)
|
||||
(\SHOWSEL SEL NIL T))
|
||||
(T (TEDIT.PROMPTPRINT TEXTOBJ "[Not found]"))))
|
||||
(replace (TEXTOBJ \INSERTPCVALID) of TEXTOBJ with NIL)
|
||||
(* ; "Drop the cached piece. WHY??")
|
||||
)
|
||||
((Move ReplaceMove) (* ; "He moved some text")
|
||||
(TEDIT.REDO.MOVE TEXTOBJ EVENT (fetch THLEN of EVENT)
|
||||
(IMAX 1 (SELECTQ (fetch (SELECTION POINT) of SEL)
|
||||
(LEFT (fetch (SELECTION CH#) of SEL))
|
||||
(RIGHT (fetch (SELECTION CHLIM) of SEL))
|
||||
NIL))
|
||||
(fetch THFIRSTPIECE of EVENT)))
|
||||
(Get (* ; "He did a GET -- not undoable.")
|
||||
(TEDIT.PROMPTPRINT TEXTOBJ "You can't REDO a GET." T))
|
||||
(Put (* ; "He did a PUT -- not undoable.")
|
||||
(TEDIT.PROMPTPRINT TEXTOBJ "You can't REDO a PUT." T))
|
||||
(TEDIT.PROMPTPRINT TEXTOBJ (CONCAT "REDO of the action " (fetch THACTION
|
||||
of EVENT)
|
||||
" isn't implemented.")
|
||||
T))
|
||||
(\SHOWSEL SEL NIL T)))
|
||||
(T (TEDIT.PROMPTPRINT TEXTOBJ "Nothing to REDO." T])
|
||||
|
||||
(TEDIT.REDO.INSERTION
|
||||
[LAMBDA (TEXTOBJ EVENT CH#) (* ;
|
||||
"Edited 3-Apr-95 15:55 by sybalsky:mv:envos")
|
||||
(* ;
|
||||
"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 (CAR (fetch THFIRSTPIECE of EVENT))
|
||||
PNEW _ T))
|
||||
(OTEXTLEN (fetch (TEXTOBJ TEXTLEN) of TEXTOBJ))
|
||||
OBJ COPYFN ORIGFIRSTPC)
|
||||
(SETQ ORIGFIRSTPC FIRSTPIECE)
|
||||
(replace THFIRSTPIECE of EVENT with (LIST FIRSTPIECE))
|
||||
(* ;
|
||||
"So we can UNDO this, and remove the right set of pieces.")
|
||||
(replace (TEXTOBJ \INSERTPCVALID) of TEXTOBJ with NIL)
|
||||
(* ;
|
||||
"Force any further insertions to make new pieces.")
|
||||
(SETQ NPC (fetch (PIECE NEXTPIECE) of FIRSTPIECE))
|
||||
(SETQ INSPC (\CHTOPC CH# PCTB T))
|
||||
[SETQ INSPC (COND
|
||||
((IEQP CH# START-OF-PIECE) (* ;
|
||||
"We're inserting just before an existing piece")
|
||||
INSPC)
|
||||
(T (* ;
|
||||
"We must split this piece, and insert before the second part.")
|
||||
(\SPLITPIECE INSPC (- CH# START-OF-PIECE)
|
||||
TEXTOBJ]
|
||||
(bind (TL _ 0) while (ILESSP TL LEN)
|
||||
do
|
||||
|
||||
(* ;; "Loop thru the pieces of the prior insertion, inserting copies of enough of them to cover the length of the insertion.")
|
||||
|
||||
[COND
|
||||
((SETQ OBJ (fetch (PIECE POBJ) of FIRSTPIECE))
|
||||
(* ; "This piece describes an object")
|
||||
[COND
|
||||
[(SETQ COPYFN (IMAGEOBJPROP OBJ 'COPYFN))
|
||||
(SETQ OBJ (APPLY* COPYFN OBJ (fetch (TEXTOBJ STREAMHINT) of
|
||||
TEXTOBJ
|
||||
)
|
||||
(fetch (TEXTOBJ STREAMHINT) of TEXTOBJ)))
|
||||
(COND
|
||||
((EQ OBJ 'DON'T)
|
||||
(TEDIT.PROMPTPRINT TEXTOBJ "COPY of this object not allowed." T)
|
||||
(RETFROM 'TEDIT.COPY))
|
||||
(T (replace (PIECE POBJ) of FIRSTPIECE with OBJ]
|
||||
(OBJ (replace (PIECE POBJ) of FIRSTPIECE with (COPY OBJ]
|
||||
(COND
|
||||
((SETQ COPYFN (IMAGEOBJPROP OBJ 'WHENCOPIEDFN))
|
||||
(* ;
|
||||
"If there's an eventfn for copying, use it.")
|
||||
(APPLY* COPYFN OBJ (WINDOWPROP (CAR (fetch (TEXTOBJ \WINDOW)
|
||||
of TEXTOBJ))
|
||||
'DSP)
|
||||
(fetch (TEXTOBJ STREAMHINT) of TEXTOBJ)
|
||||
(fetch (TEXTOBJ STREAMHINT) of TEXTOBJ]
|
||||
(\INSERTPIECE FIRSTPIECE INSPC TEXTOBJ) (* ; "Insert the piece back in")
|
||||
(SETQ TL (IPLUS TL (fetch (PIECE PLEN) of FIRSTPIECE)))
|
||||
(* ;
|
||||
"Keep track of how much we've re-inserted")
|
||||
(SETQ FIRSTPIECE (create PIECE using NPC PNEW _ T))
|
||||
(* ;
|
||||
"Move to the next piece to insert")
|
||||
(AND NPC (SETQ NPC (fetch (PIECE NEXTPIECE) of NPC)))
|
||||
(* ;
|
||||
"Done here because \INSERTPIECE creams the NEXTPIECE field.")
|
||||
)
|
||||
(\TEDIT.DIFFUSE.PARALOOKS (fetch (PIECE PREVPIECE) of ORIGFIRSTPC)
|
||||
INSPC) (* ;
|
||||
"propagate paragraph formatting into the new insertion")
|
||||
(replace (TEXTOBJ TEXTLEN) of TEXTOBJ with (IPLUS (fetch (TEXTOBJ TEXTLEN)
|
||||
of TEXTOBJ)
|
||||
LEN))
|
||||
(* ;
|
||||
"Reset the text length and EOF ptr of the text stream.")
|
||||
(\FIXILINES TEXTOBJ SEL CH# LEN OTEXTLEN) (* ;
|
||||
"Fix the line descriptors & selection")
|
||||
(TEDIT.UPDATE.SCREEN TEXTOBJ) (* ;
|
||||
"Fix up the display for all this foofaraw")
|
||||
(replace (SELECTION CH#) of SEL with CH#)
|
||||
(* ;
|
||||
"Make the selection point at the re-inserted text")
|
||||
(replace (SELECTION CHLIM) of SEL with (IPLUS CH# LEN))
|
||||
(replace (SELECTION DCH) of SEL with LEN)
|
||||
(\TEDIT.SET.SEL.LOOKS SEL 'NORMAL)
|
||||
(\FIXSEL SEL TEXTOBJ) (* ; "Really fix the selection")
|
||||
(replace THACTION of EVENT with 'Insert)
|
||||
(* ;
|
||||
"Make the UNDO be UNDOable, by changing the event to a insertion.")
|
||||
])
|
||||
|
||||
(TEDIT.UNDO.MOVE
|
||||
[LAMBDA (TEXTOBJ EVENT LEN CH# FIRSTPIECE) (* ; "Edited 30-May-91 21:27 by jds")
|
||||
(* ; "UNDO a MOVE command")
|
||||
(PROG ((TOOBJ (fetch THAUXINFO of EVENT))
|
||||
(FROMOBJ (fetch THTEXTOBJ of EVENT))
|
||||
(SOURCECH# (fetch THOLDINFO of EVENT))
|
||||
(CH# (fetch THCH# of EVENT))
|
||||
TOSEL TOTEXTLEN)
|
||||
(\SHOWSEL (fetch (TEXTOBJ SEL) of TOOBJ)
|
||||
NIL NIL) (* ;
|
||||
"Turn off the selections in the old source and target documents")
|
||||
(\SHOWSEL (fetch (TEXTOBJ SEL) of FROMOBJ)
|
||||
NIL NIL)
|
||||
(\DELETECH CH# (IPLUS CH# LEN)
|
||||
LEN FROMOBJ) (* ;
|
||||
"Delete the characters we moved, from the place we moved them to")
|
||||
(\FIXDLINES (fetch (TEXTOBJ LINES) of FROMOBJ)
|
||||
(fetch (TEXTOBJ SEL) of FROMOBJ)
|
||||
CH#
|
||||
(IPLUS CH# LEN)
|
||||
FROMOBJ)
|
||||
(replace (SELECTION CH#) of (fetch (TEXTOBJ SEL) of FROMOBJ)
|
||||
with (replace (SELECTION CHLIM) of (fetch (TEXTOBJ SEL) of FROMOBJ)
|
||||
with CH#)) (* ;
|
||||
"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)
|
||||
|
||||
(* ;; "Put the pieces we moved back where they came from (no need to copy them, since we did that on the original move.)")
|
||||
|
||||
(\FIXILINES TOOBJ (fetch (TEXTOBJ SEL) of TOOBJ)
|
||||
SOURCECH# LEN TOTEXTLEN) (* ;
|
||||
"Mark lines that need updating, and fix up the selection")
|
||||
(add (fetch (TEXTOBJ TEXTLEN) of TOOBJ)
|
||||
LEN) (* ;
|
||||
"Update the text length of the erstwhile move source")
|
||||
(TEDIT.UPDATE.SCREEN FROMOBJ) (* ;
|
||||
"Update the erstwhile text location's image.")
|
||||
(COND
|
||||
((NEQ FROMOBJ TOOBJ) (* ;
|
||||
"If they aren't the same document, we need to update the other document image as well.")
|
||||
(TEDIT.UPDATE.SCREEN TOOBJ)))
|
||||
(\FIXSEL (fetch (TEXTOBJ SEL) of TOOBJ)
|
||||
TOOBJ) (* ;
|
||||
"Fix up the selections so their images will be OK")
|
||||
(\FIXSEL (fetch (TEXTOBJ SEL) of FROMOBJ)
|
||||
FROMOBJ)
|
||||
(\COPYSEL (fetch (TEXTOBJ SEL) of FROMOBJ)
|
||||
TEDIT.SELECTION) (* ;
|
||||
"It's handy to think of this as the last selection made, also.")
|
||||
(replace THACTION of EVENT with 'Move)
|
||||
(replace THTEXTOBJ of EVENT with TOOBJ)
|
||||
(replace THAUXINFO of EVENT with FROMOBJ)
|
||||
(replace THOLDINFO of EVENT with CH#)
|
||||
(replace THCH# of EVENT with SOURCECH#)
|
||||
(\SHOWSEL (fetch (TEXTOBJ SEL) of TOOBJ)
|
||||
NIL T)
|
||||
(\SHOWSEL (fetch (TEXTOBJ SEL) of FROMOBJ)
|
||||
NIL T])
|
||||
|
||||
(TEDIT.UNDO.REPLACE
|
||||
[LAMBDA (TEXTOBJ EVENT LEN CH# FIRSTPIECE) (* ;
|
||||
"Edited 22-Mar-95 16:47 by sybalsky:mv:envos")
|
||||
(PROG ((OLDEVENT (fetch THOLDINFO of EVENT))
|
||||
(CH# (fetch THCH# of EVENT))
|
||||
(SEL (fetch (TEXTOBJ SEL) of TEXTOBJ)))
|
||||
(\SHOWSEL SEL NIL NIL)
|
||||
(TEDIT.UNDO.INSERTION TEXTOBJ EVENT LEN CH# FIRSTPIECE)
|
||||
(\SHOWSEL SEL NIL NIL)
|
||||
(TEDIT.UNDO.DELETION TEXTOBJ OLDEVENT (fetch THLEN of OLDEVENT)
|
||||
CH#
|
||||
(CAR (fetch THFIRSTPIECE of OLDEVENT)))
|
||||
(replace THOLDINFO of OLDEVENT with EVENT)
|
||||
(replace THACTION of OLDEVENT with 'Replace)
|
||||
(replace THOLDINFO of EVENT with NIL)
|
||||
(\TEDIT.HISTORYADD TEXTOBJ OLDEVENT)
|
||||
(replace (SELECTION CH#) of SEL with CH#)
|
||||
(replace (SELECTION CHLIM) of SEL with (IPLUS CH# (fetch THLEN of
|
||||
OLDEVENT)))
|
||||
(replace (SELECTION DCH) of SEL with (fetch THLEN of OLDEVENT))
|
||||
(replace (SELECTION POINT) of SEL with (fetch THPOINT of EVENT))
|
||||
(replace THPOINT of OLDEVENT with (fetch THPOINT of EVENT))
|
||||
(\FIXSEL SEL TEXTOBJ)
|
||||
(\SHOWSEL SEL NIL T])
|
||||
|
||||
(TEDIT.REDO.REPLACE
|
||||
[LAMBDA (TEXTOBJ EVENT) (* ; "Edited 30-May-91 21:28 by jds")
|
||||
(PROG ((OLDEVENT (fetch THOLDINFO of EVENT))
|
||||
(CH# (fetch (SELECTION CH#) of (fetch (TEXTOBJ SEL) of TEXTOBJ)))
|
||||
(SEL (fetch (TEXTOBJ SEL) of TEXTOBJ)))
|
||||
(\SHOWSEL SEL NIL NIL)
|
||||
(\DELETECH (fetch (SELECTION CH#) of SEL)
|
||||
(fetch (SELECTION CHLIM) of SEL)
|
||||
(IDIFFERENCE (fetch (SELECTION CHLIM) of SEL)
|
||||
(fetch (SELECTION CH#) of SEL))
|
||||
TEXTOBJ)
|
||||
(\FIXDLINES (fetch (TEXTOBJ LINES) of TEXTOBJ)
|
||||
SEL
|
||||
(fetch (SELECTION CH#) of SEL)
|
||||
(fetch (SELECTION CHLIM) of SEL)
|
||||
TEXTOBJ)
|
||||
(replace (SELECTION POINT) of SEL with 'LEFT)
|
||||
(TEDIT.REDO.INSERTION TEXTOBJ EVENT CH#)
|
||||
(replace THOLDINFO of EVENT with (SETQ OLDEVENT (fetch (TEXTOBJ TXTHISTORY)
|
||||
of TEXTOBJ)))
|
||||
(replace THACTION of OLDEVENT with 'Replace)
|
||||
(replace THACTION of EVENT with 'Replace)
|
||||
(replace THCH# of EVENT with CH#)
|
||||
(\TEDIT.HISTORYADD TEXTOBJ EVENT])
|
||||
|
||||
(TEDIT.REDO.MOVE
|
||||
[LAMBDA (TEXTOBJ EVENT LEN CH# FIRSTPIECE) (* ; "Edited 30-May-91 21:28 by jds")
|
||||
(PROG ((FROMOBJ TEXTOBJ)
|
||||
(SOURCECH# (fetch THOLDINFO of EVENT))
|
||||
(OLDCH# (fetch THCH# of EVENT))
|
||||
(SEL (fetch (TEXTOBJ SEL) of TEXTOBJ))
|
||||
(MOVESEL (fetch (TEXTOBJ MOVESEL) of TEXTOBJ))
|
||||
OLDCHLIM)
|
||||
(replace (SELECTION CH#) of MOVESEL with OLDCH#)
|
||||
(replace (SELECTION CHLIM) of MOVESEL with (IPLUS OLDCH# LEN))
|
||||
(replace (SELECTION DCH) of MOVESEL with LEN)
|
||||
(replace (SELECTION SET) of MOVESEL with T)
|
||||
(\FIXSEL MOVESEL TEXTOBJ)
|
||||
(\TEDIT.SET.SEL.LOOKS MOVESEL 'MOVE)
|
||||
(TEDIT.MOVE MOVESEL SEL])
|
||||
)
|
||||
(PUTPROPS TEDITHISTORY COPYRIGHT ("Venue & Xerox Corporation" 1983 1984 1985 1986 1987 1990 1991 1993
|
||||
1995))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (1696 5135 (\TEDIT.HISTORYADD 1706 . 3591) (\TEDIT.CUMULATE.EVENTS 3593 . 5133)) (5188
|
||||
38576 (TEDIT.UNDO 5198 . 9210) (TEDIT.UNDO.INSERTION 9212 . 10798) (TEDIT.UNDO.DELETION 10800 . 16735)
|
||||
(TEDIT.REDO 16737 . 23674) (TEDIT.REDO.INSERTION 23676 . 30392) (TEDIT.UNDO.MOVE 30394 . 34827) (
|
||||
TEDIT.UNDO.REPLACE 34829 . 36330) (TEDIT.REDO.REPLACE 36332 . 37757) (TEDIT.REDO.MOVE 37759 . 38574)))
|
||||
))
|
||||
STOP
|
||||
Binary file not shown.
Binary file not shown.
File diff suppressed because it is too large
Load Diff
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
2637
library/new/TEXTOFD
2637
library/new/TEXTOFD
File diff suppressed because it is too large
Load Diff
Binary file not shown.
Reference in New Issue
Block a user