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

(FILECREATED " 5-Aug-88 17:07:44" {QV}<NOTECARDS>1.3LNEXT>PMIPATCH102.;2
 4235   

      changes to%:  (VARS PMIPATCH102COMS)
                    (FNS RECURSIVE.COLLECTDESCENDENTS COLLECTDESCENDENTS NC.MakeBrowserCard)

      previous date%: " 5-Aug-88 13:36:56" {QV}<NOTECARDS>1.3LNEXT>PMIPATCH102.;1)


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

(PRETTYCOMPRINT PMIPATCH102COMS)

(RPAQQ PMIPATCH102COMS
 (

(* ;;; "New file")


                        (DECLARE%: DONTCOPY (PROPS (PMIPATCH102 MAKEFILE-ENVIRONMENT)
                                                   (PMIPATCH102 FILETYPE)))
                        [DECLARE%: FIRST (P (NC.LoadFileFromDirectories 'GRAPHERPATCH]
                        
          
          (* ;; "pmi 8/5/88: Fixes bug in PMIPATCH099. ")


                        
          
          (* ;; "Changed in GRAPHERPATCH")


                        (FNS RECURSIVE.COLLECTDESCENDENTS COLLECTDESCENDENTS)))



(* ;;; "New file")


(DECLARE%: DONTCOPY 

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

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



(* ;; "pmi 8/5/88: Fixes bug in PMIPATCH099. ")





(* ;; "Changed in GRAPHERPATCH")


(DEFINEQ

(RECURSIVE.COLLECTDESCENDENTS

  [LAMBDA (Node Graph)
                                       (* ; "Edited  5-Aug-88 16:06 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.")

          
          (* ;; "pmi 8/5/88: FIxes bug introduced by previous fix.")


    (LET (NodeId)
          
          (* ;; "Node's NODEID may be a list if it is a virtual node. ")


         (if
 (LISTP (SETQ NodeId (fetch
 (GRAPHNODE NODEID) of
 Node)))
             then
 (SETQ NodeId (CAR NodeId)))
         (NC.GraphNodeIDPutProp NodeId 'Visited T)
         (for
 ChildNode in
 (COLLECT.CHILD.NODES Node Graph) bind
 ChildNodeID
            when
 [PROGN (SETQ ChildNodeID (fetch
 (GRAPHNODE NODEID) of
 ChildNode))
          
          (* ;; "This node has not been visited, and it is not a virtual node.")


                        (NOT (NC.GraphNodeIDGetProp (if
 (LISTP ChildNodeID)
                                                        then
 (CAR ChildNodeID)
                                                      else
 ChildNodeID)
                                    'Visited] join
 (CONS ChildNode (RECURSIVE.COLLECTDESCENDENTS

                                                                    ChildNode Graph])

(COLLECTDESCENDENTS

  [LAMBDA (Node Graph)
                                       (* ; "Edited  5-Aug-88 15:40 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.")

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

          
          (* ;; "pmi 8/5/88: Now also cleans up Visited marker on Node.")


    (LET (NodeID Descendents)
         (RESETLST [RESETSAVE
                    NIL
                    '(PROGN (for
 VisitedNode in
 (CONS Node Descendents) bind
 VisitedNodeID
                               do
 (NC.GraphNodeIDPutProp (if
 (LISTP (SETQ VisitedNodeID
                                                                     (fetch
 (GRAPHNODE NODEID)
                                                                        of
 VisitedNode)))
                                                             then
 (CAR VisitedNodeID)
                                                           else
 VisitedNodeID)
                                         'Visited NIL]
                (SETQ Descendents (RECURSIVE.COLLECTDESCENDENTS
 Node Graph])
)
(PUTPROPS PMIPATCH102 COPYRIGHT ("Xerox Corporation" 1988))
(DECLARE%: DONTCOPY
  (FILEMAP (NIL (1395 4152 (RECURSIVE.COLLECTDESCENDENTS 1405 . 2846) (COLLECTDESCENDENTS 2848 . 4150)))
))
STOP