anchor.diff:  ;;;     Title: Graph Formatting
   ;;;   Created: 2002-08-13
   ;;;   License: LGPL (See file COPYING for details).
  +;;;       $Id: graph-formatting.lisp,v 1.3 2002/08/14 10:31:06 gilbert Exp $
   ;;; ---------------------------------------------------------------------------
   
   ;;;  (c) copyright 2002 by Gilbert Baumann
  
positive.code: ;;   restricted to the set of hash test functions? --GB 2002-08-13
  
  ;; - What is the purpose of (SETFGRAPH-NODE-CHILDREN) and
  ;;   (SETFGRAPH-NODE-PARENTS)?
  
  ;;;; Declarations
  
  
negative.code: ;;;; Entry
  
  (defun format-graph-from-roots (root-objects object-printer inferior-producer
                                  &rest graph-options
                                  &key stream orientation cutoff-depth
                                       merge-duplicates duplicate-key duplicate-test
                                       generation-separation
                                       within-generation-separation
                                       center-nodes arc-drawer arc-drawing-options
                                       graph-type (move-cursor t)
                                  &allow-other-keys)
    ;; Mungle some arguments
    (check-type cutoff-depth (or null integer))
    (setf stream (or stream *standard-output*)
          graph-type (or graph-type (if merge-duplicates :digraph :tree))
          duplicate-key (or duplicate-key #'identity)
          duplicate-test (or duplicate-test #'eql) )
    
    ;; clean the options
    (remf :stream graph-options)
    (remf :duplicate-key graph-options)
    (remf :duplicate-test graph-options)
    (remf :arc-drawer graph-options)
    (remf :arc-drawing-options graph-options)
    (remf :graph-type graph-options)
    (remf :move-cursor graph-options)
    
    (multiple-value-bind (cursor-old-x cursor-old-y)
        (stream-cursor-position stream)
      (let ((graph-output-record
             (labels ((cont (stream graph-output-record)
                        (with-output-recording-options (stream :draw nil :record t)
                          (generate-graph-nodes graph-output-record stream root-objects
                                                object-printer inferior-producer
                                                :duplicate-key duplicate-key
                                                :duplicate-test duplicate-test)
                          (layout-graph-nodes graph-output-record stream arc-drawer arc-drawing-options)
                          (layout-graph-edges graph-output-record stream arc-drawer arc-drawing-options)) ))
               (apply #'invoke-with-new-output-record stream
                      #'cont
                      (find-graph-type graph-type)
                      :hash-table (make-hash-table :test duplicate-test)
                      graph-options))))
        (setf (output-record-position graph-output-record)
              (values cursor-old-x cursor-old-y))
        (with-output-recording-options (stream :draw t :record nil)
          (replay-output-record graph-output-record stream))
        (when move-cursor
          (setf (stream-cursor-position stream)
                (values (bounding-rectangle-max-x graph-output-record)
  