CLIM mail archive

[Prev][Next][Index][Thread]

format-graph-from-roots



I am using a Symbolics 3620 with Genera 8.1 and CLIM 1.1 (28.5).

If I use CLIM:FORMAT-GRAPH-FROM-ROOTS and specify :MERGE-DUPLICATES T,
some parts of the graph have the children in the same generation column
as their parent.  This makes the resulting graph difficult to follow
(especially when there are several hundred nodes).  Is there some way to
get those children into the proper generation column?  (Note: this
behavior is also exhibited in the :VERTICAL orientation.)

To see what I mean:
  1. Compile and load the following code
  2. Type (show-test) in a CLIM Listener
  3. Look at ITEM-4 and ITEM-8 in the two resulting graphs.

------------------------------ Start of File ------------------------------
;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Package: FCL-USER; Base: 10 -*-

(in-package :FCL-USER)

(defvar *ITEMS* nil)
(defvar *ROOTS* nil)

(defclass ITEM ()
    ((name     :accessor item-name     :initarg :name)
     (children :accessor item-children :initform nil)))

(defmethod PRINT-OBJECT ((item Item) stream)
  (with-slots (name children) item
    (if *print-escape*
	(print-unreadable-object (item stream :type t :identity t)
	  (format stream "~D~@[ with ~D children~]" name
		  (and children (length children))))
	(format stream "ITEM-~D" name))))

(defun FIND-ITEM (name) (find name *items* :key #'item-name))

(defun SET-CHILDREN (parent &rest children)
  (let ((item (find-item parent))
	(kids (loop for child in children collect (find-item child))))
    (setf (item-children item) kids)
    item))

(defun INIT-ITEMS ()
  (setf *items*
	(loop for i from 1 to 20
	      collect (make-instance 'item :name i)))
  (setf *roots*
	(loop for i in '(1 19 20)
	      collect (find-item i)))
  (set-children 1 2)
  (set-children 2 4 3 7)
  (set-children 3 4 5 6 7)
  (set-children 4 8)
  (set-children 5 9 10)
  (set-children 6 11 12 13 14 15 16 17)
  *roots*)

(defun FORMAT-ROOTS (&optional depth merge? &key (stream *standard-output*))
  (clim:format-graph-from-roots
    *roots* #'princ #'item-children
    :graph-type :digraph
    ;;:orientation :vertical
    :stream stream
    :merge-duplicates merge?
    :cutoff-depth depth))

(defun SHOW-TEST (&optional (stream *standard-output*))
  (init-items)
  (format stream "~%FORMAT-GRAPH-FROM-ROOTS :cutoff-depth nil :merge-duplicates t~%")
  (format-roots nil t :stream stream)
  (format stream "~2%FORMAT-GRAPH-FROM-ROOTS :cutoff-depth 4 :merge-duplicates t~%")
  (format-roots 4 t :stream stream)
  (values))



Main Index | Thread Index