Finish cleanup

library/new/PCTREE

@@ -0,0 +1,572 @@
+(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

library/new/TEDITHISTORY

@@ -0,0 +1,622 @@
+(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