
17.2 Formatting Graphs in CLIM
&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)
(define-application-frame graph-it ()
((root-node :initform (find-class 'clim:design)
:initarg :root-node
:accessor root-node)
(app-stream :initform nil :accessor app-stream))
(:panes (display :application
:display-function 'draw-display
:display-after-commands :no-clear))
(:layouts
(:defaults
(horizontally () display))))
(defmethod draw-display ((frame graph-it) stream)
(format-graph-from-roots (root-node *application-frame*)
#'draw-node
#'clos:class-direct-subclasses
:stream stream
:arc-drawer
#'(lambda (stream from-object
to-object x1 y1
x2 y2
&rest
drawing-options)
(declare (dynamic-extent
drawing-options))
(declare (ignore from-object
to-object))
(apply #'draw-arrow* stream
x1 y1 x2 y2 drawing-options))
:merge-duplicates t)
(setf (app-stream frame) stream))
(define-presentation-type node ())
(defun draw-node (object stream)
(with-output-as-presentation (stream object 'node)
(surrounding-output-with-border
(stream :shape :rectangle)
(format stream "~A"
(class-name object)))))
(define-graph-it-command (exit :menu "Exit") ()
(frame-exit *application-frame*))
(defun graph-it (&optional (root-node (find-class 'basic-sheet))
(port (find-port)))
(if (atom root-node) (setf root-node (list root-node)))
(let ((graph-it (make-application-frame 'graph-it
:frame-manager
(find-frame-manager
:port port)
:width 800
:height 600
:root-node root-node)))
(run-frame-top-level graph-it)))

Generated with Harlequin WebMaker