(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP")

(FILECREATED " 4-Aug-88 12:31:58" {QV}<NOTECARDS>1.3LNEXT>PMIPATCH099.;7
 8093   

      changes to%:  (VARS PMIPATCH099COMS)
                    (FNS COLLECTDESCENDENTS RECURSIVE.COLLECTDESCENDENTS NOT.TRACKCURSOR 
                         MOVEDESCENDENTS NC.RelayoutBrowserCard)

      previous date%: "27-Jul-88 16:47:58" {DSK}<LISPFILES>NOTECARDS>TEMP>PMIPATCH099.;2)


(* "
Copyright (c) 1988 by Xerox Corporation.  All rights reserved.
")

(PRETTYCOMPRINT PMIPATCH099COMS)

(RPAQQ PMIPATCH099COMS
 (

(* ;;; "New file")


                        (DECLARE%: DONTCOPY (PROPS (PMIPATCH099 MAKEFILE-ENVIRONMENT)
                                                   (PMIPATCH099 FILETYPE)))
                        [DECLARE%: FIRST (P (NC.LoadFileFromDirectories 'GRAPHERPATCH]
                        
          
          (* ;; 

  "pmi 8/4/88: Fixes infinite recursion when moving sub-tree in browser that contains circularities.")


                        
          
          (* ;; "New in GRAPHERPATCH")


                        (FNS COLLECTDESCENDENTS)
                        
          
          (* ;; "Changed in GRAPHERPATCH")


                        (FNS RECURSIVE.COLLECTDESCENDENTS NOT.TRACKCURSOR MOVEDESCENDENTS)))



(* ;;; "New file")


(DECLARE%: DONTCOPY 

(PUTPROPS PMIPATCH099 MAKEFILE-ENVIRONMENT
 (:PACKAGE "INTERLISP" :READTABLE "INTERLISP"))

(PUTPROPS PMIPATCH099 FILETYPE
 :BCOMPL)
)
(DECLARE%: FIRST 
(NC.LoadFileFromDirectories 'GRAPHERPATCH)
)



(* ;; 
"pmi 8/4/88: Fixes infinite recursion when moving sub-tree in browser that contains circularities.")





(* ;; "New in GRAPHERPATCH")


(DEFINEQ

(COLLECTDESCENDENTS

  [LAMBDA (Node Graph)
                                       (* ; "Edited  4-Aug-88 09:50 by pmi")

          
          (* ;; "pmi 8/3/88: Created to wrap RESETLST around call to RECURSIVE.COLLECTDESCENDENTS.  Prevents infinite looping on circular graph structures by marking where we have been.")


    (LET (Descendents)
          
          (* ;; "Clean up the Visited markers placed on the nodes traversed.")


         (RESETLST [RESETSAVE NIL '(PROGN (for
 DescendentNode in
 Descendents
                                             do
 (NC.GraphNodeIDPutProp (fetch
 (GRAPHNODE NODEID)
                                                                          of
 DescendentNode)
                                                       'Visited NIL]
                (SETQ Descendents (RECURSIVE.COLLECTDESCENDENTS
 Node Graph])
)



(* ;; "Changed in GRAPHERPATCH")


(DEFINEQ

(RECURSIVE.COLLECTDESCENDENTS

  [LAMBDA (Node Graph)
                                       (* ; "Edited  3-Aug-88 14:44 by pmi")

          
          (* ;; "Collect all descendents of Node in Graph.")

          
          (* ;; 

   "pmi 8/2/88: Changed to break infinite recursion on circular graphs.  Now marks nodes as visited.")


    (NC.GraphNodeIDPutProp (fetch
 (GRAPHNODE NODEID) of
 Node)
           'Visited T)
    (for
 ChildNode in
 (COLLECT.CHILD.NODES Node Graph) when
 (NOT (NC.GraphNodeIDGetProp
                                                                  (fetch
 (GRAPHNODE NODEID)
                                                                     of
 ChildNode)
                                                                  'Visited))
       join
 (CONS ChildNode (RECURSIVE.COLLECTDESCENDENTS
 ChildNode Graph])

(NOT.TRACKCURSOR

  [LAMBDA (Node DisplayStream Graph)
                         (* ; "Edited  3-Aug-88 14:50 by pmi")

          
          (* ;; "Gets an old, and a new region from the user, and uses these to calculate all the new positions for all the children of Node.")

          
          (* ;; 

   "rht 4/28/87: Changed from APPLY of UNIONREGIONS to for loop doing successive UNIONREGIONS calls.")

          
          (* ;; 

          "pmi 8/3/88: Changed to call COLLECTDESCENDENTS instead of RECURSIVE.COLLECTDESCENDENTS.")


    (if
 (NULL Node)
        then
 (PROMPTPRINT "No node selected.")
      else
 (PROG* ((Children (COLLECTDESCENDENTS
 Node Graph))
                   (OldRegion (for
 EachNode in
 (CONS Node Children) bind
 (TotalRegion ← (NODEREGION
                                                                                         Node))
                                 do
 (FLIPNODE EachNode DisplayStream)
                                    (SETQ TotalRegion (UNIONREGIONS TotalRegion (NODEREGION EachNode)
                                                             )) finally
 (RETURN TotalRegion)))
                   (NewRegionPosition (GETBOXPOSITION.FROMINITIALREGION (WFROMDS DisplayStream)
                                             OldRegion DisplayStream))
                   (deltaX (DIFFERENCE (fetch
 (POSITION XCOORD) of
 NewRegionPosition)
                                  (fetch
 (REGION LEFT) of
 OldRegion)))
                   (deltaY (DIFFERENCE (fetch
 (POSITION YCOORD) of
 NewRegionPosition)
                                  (fetch
 (REGION BOTTOM) of
 OldRegion)))
                   (OldPos (fetch
 (GRAPHNODE NODEPOSITION) of
 Node))
                   (NewPos (CREATE.NEW.NODEPOSITION Node deltaX deltaY)))
                  [if
 (NOT (EQUAL OldPos NewPos))
                      then
 (MOVENODE Node OldPos NewPos Graph DisplayStream)
                           (EXTENDEXTENT (WFROMDS DisplayStream)
                                  (NODEREGION Node))
                           (CALL.MOVENODEFN Node OldPos Graph (WFROMDS DisplayStream)
                                  NewPos)
                           (if
 Children
                               then
 (PROG [(MovedNodes (LIST (fetch
 (GRAPHNODE NODEID) of
 Node]
                                          (MOVEDESCENDENTS
 Graph Node DisplayStream deltaX deltaY]
                  (for
 EachNode in
 (CONS Node Children) do
 (FLIPNODE EachNode DisplayStream])

(MOVEDESCENDENTS

  [LAMBDA (Graph Node DisplayStream deltaX deltaY)
           (* ; "Edited  3-Aug-88 14:51 by pmi")

          
          (* ;; "Moves Node and all Children of Node by deltaX and deltaY.")

          
          (* ;; "first, finds all descendents of Node.  For each of these, create a new position based on the old and the deltas.  Then, if the child has not been moved yet, we add it to the list of moved nodes, move the node, and call the MOVENODEFN,")

          
          (* ;; 

          "pmi 8/3/88: Changed to call COLLECTDESCENDENTS instead of RECURSIVE.COLLECTDESCENDENTS.")


    (bind
 (MovedNodes ← (LIST Node))
          NewPos for
 Child in
 (COLLECTDESCENDENTS
 Node Graph) eachtime
 (SETQ NewPos
                                                                        (CREATE.NEW.NODEPOSITION
                                                                         Child deltaX deltaY))
       unless
 (MEMBER (fetch
 (GRAPHNODE NODEID) of
 Child)
                     MovedNodes) do
 (SETQ MovedNodes (CONS (fetch
 (GRAPHNODE NODEID) of
 Child)
                                                           MovedNodes))
                                    (MOVENODE Child (fetch
 NODEPOSITION of
 Child)
                                           NewPos Graph DisplayStream)
                                    (EXTENDEXTENT (WFROMDS DisplayStream)
                                           (NODEREGION Child)) 
          
          (* ;; "we must call EXTENDEXTENT to extend the graph extent in case we have moved a node outside the previous extent.")


                                    (CALL.MOVENODEFN Child NewPos Graph (WFROMDS DisplayStream)
                                           (fetch
 NODEPOSITION of
 Child])
)
(PUTPROPS PMIPATCH099 COPYRIGHT ("Xerox Corporation" 1988))
(DECLARE%: DONTCOPY
  (FILEMAP (NIL (1728 2629 (COLLECTDESCENDENTS 1738 . 2627)) (2671 8010 (RECURSIVE.COLLECTDESCENDENTS 
2681 . 3574) (NOT.TRACKCURSOR 3576 . 6175) (MOVEDESCENDENTS 6177 . 8008)))))
STOP