├── .gitignore ├── COPYING ├── ChangeLog ├── README.md ├── attribute.lisp ├── attributes.lisp ├── cl-dot.asd ├── cl-dot.lisp ├── config-graphviz.lisp ├── deprecated.lisp ├── docs ├── .gitignore ├── Makefile ├── manual.texi ├── style.css ├── test-edges.png ├── test-lr.png ├── test-ports.png ├── test-undir.png └── test.png ├── examples ├── class-example.lisp ├── list-example-old.lisp ├── list-example.lisp ├── sb-c-example.lisp └── subgraph-example.lisp ├── package.lisp ├── raw-attributes.lisp └── tools-for-development └── scrape-attributes.lisp /.gitignore: -------------------------------------------------------------------------------- 1 | 2 | .DS_Store 3 | cl-dot.fasl 4 | /docs/version.texi 5 | -------------------------------------------------------------------------------- /COPYING: -------------------------------------------------------------------------------- 1 | Copyright (C) 2005 Juho Snellman 2 | Copyright (C) 2007,2008 Michael Weber 3 | 4 | Permission is hereby granted, free of charge, to any person obtaining 5 | a copy of this software and associated documentation files (the 6 | "Software"), to deal in the Software without restriction, including 7 | without limitation the rights to use, copy, modify, merge, publish, 8 | distribute, sublicense, and/or sell copies of the Software, and to 9 | permit persons to whom the Software is furnished to do so, subject to 10 | the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be 13 | included in all copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, 16 | EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF 17 | MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND 18 | NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE 19 | LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION 20 | OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION 21 | WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. 22 | -------------------------------------------------------------------------------- /ChangeLog: -------------------------------------------------------------------------------- 1 | 2013-01-15 Michael Weber 2 | 3 | * cl-dot/lisp: Supply :fontname and :fontsize arguments 4 | Patch by Jan Moringen 5 | * docs/manual.texi: Updated manual for GitHub move 6 | 7 | 2009-10-12 Michael Weber 8 | 9 | * cl-dot.lisp (construct-graph): Allow directed multi-graphs. 10 | Reported by Karol Skocik . 11 | 12 | 2008-11-15 Michael Weber 13 | 14 | * cl-dot.lisp (graph-object-edges): new generic function 15 | 16 | (construct-graph): Allow GRAPH-OBJECT functions to return 17 | sequences instead of lists 18 | 19 | * docs/version.texi: Generate version from Git 20 | 21 | 2008-11-11 Michael Weber 22 | 23 | * package.lisp: export *neato-path* 24 | 25 | 2008-11-09 Michael Weber 26 | 27 | * Released version 0.8.0 28 | 29 | * cl-dot.lisp (textify,print-key-value): allow labels to be 30 | aligned. Patch adapted from Nikodemus Siivola 31 | . 32 | 33 | * cl-dot.lisp (generate-graph): handle :node and :edge attributes 34 | specially. Patch adapted from Nikodemus Siivola 35 | . 36 | (print-key-value): new function, extracted from generate-graph. 37 | 38 | * docs/manual.texi: document accepted attributes 39 | 40 | * docs/manual.texi: new manual 41 | 42 | * COPYING: adjusted years 43 | 44 | 2008-10-27 Michael Weber 45 | 46 | * cl-dot.lisp (construct-graph): Save and reuse result of 47 | GRAPH-OBJECT- protocol functions 48 | 49 | Otherwise, ephemeral graph nodes get disconnected, which is 50 | somewhat unexpected. Report and patch by YuQian Zhou 51 | . 52 | 53 | 2008-06-16 Michael Weber 54 | 55 | * Released version 0.7.0 56 | 57 | * cl-dot.lisp: default methods for graph-object- protocol methods 58 | 59 | (dot-graph), doc/index.html: added support for undirected 60 | graphs (via neato); patch by Angel Bayloff , 61 | slightly edited. 62 | 63 | 2008-02-17 Michael Weber 64 | 65 | * Released version 0.6.0 66 | 67 | * cl-dot.lisp: introduced the GRAPH-OBJECT- protocol, 68 | moved OBJECT- protocol to deprecated.lisp 69 | 70 | (generate-graph-from-roots): new function 71 | (generate-graph): deprecated 72 | 73 | * deprecated.lisp: new file 74 | * docs/index.html: documented API changes 75 | * examples/: adapted examples to new API 76 | * cl-dot.asd: added list-example-old.lisp, deprecated.lisp 77 | * README: removed API documentation with pointer to docs directory 78 | 79 | 2007-11-29 Michael Weber 80 | 81 | * Released version 0.5.0 82 | 83 | * cl-dot.lisp (dot-graph): add support for CLISP. Patch by 84 | Martin Dengler . 85 | 86 | 2007-11-21 Michael Weber 87 | 88 | * cl-dot.lisp (dot-graph): add keyword parameter FORMAT 89 | 90 | 2007-03-02 Michael Weber 91 | 92 | * cl-dot.lisp (dot-graph): output .ps for LispWorks 93 | 94 | 2007-02-27 Michael Weber 95 | 96 | * cl-dot.lisp (dot-graph): removed extra binding 97 | 98 | 2007-02-26 Michael Weber 99 | 100 | * Released version 0.4.0 101 | 102 | * cl-dot.lisp (dot-graph): Allegro support (patch by 103 | Robert P. Goldman ), slightly edited. 104 | 105 | * Released version 0.3.0 106 | 107 | * cl-dot.lisp: *dot-path* for win32; 108 | execution support for LispWorks; escape node IDs with TEXTIFY. 109 | Original patch by Levente Mészáros, edited by michaelw@foldr.org 110 | 111 | * cl-dot.lisp (generate-dot): Use WITH-STANDARD-IO-SYNTAX for 112 | printing dot file. Patch by Todd Sabin . 113 | 114 | * Released version 0.2.0 115 | 116 | * taken over maintainership from Juho Snellman 117 | 118 | * cl-dot.lisp (generate-graph): changed to a generic function 119 | * cl-dot.lisp: various updates 120 | 121 | * docs/index.html: HTML documentation 122 | 123 | * cl-dot.asd: various changes 124 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | CL-DOT 2 | ====== 3 | CL-DOT is a small package for easily generating dot (a program in the 4 | GraphViz suite) output from arbitrary Lisp data. 5 | 6 | 7 | Building 8 | -------- 9 | Presuming ASDF is available: 10 | 11 | (asdf:load-system :cl-dot) 12 | 13 | Depending on the Lisp being used, `(require :cl-dot)` might do as 14 | well. 15 | 16 | 17 | Documentation 18 | ------------- 19 | See [docs](docs/) directory 20 | 21 | 22 | Licence 23 | ------- 24 | See file [COPYING](COPYING). 25 | 26 | 27 | Authors 28 | ------- 29 | Juho Snellman 30 | Michael Weber (current maintainer) 31 | -------------------------------------------------------------------------------- /attribute.lisp: -------------------------------------------------------------------------------- 1 | (cl:in-package #:cl-dot) 2 | 3 | (deftype context () 4 | "A context in which an attribute may occur." 5 | '(member :graph :subgraph :cluster :node :edge)) 6 | 7 | (defun context-list-p (thing) 8 | (and (listp thing) 9 | (every (lambda (element) (typep element 'context)) thing))) 10 | 11 | (deftype context-set () 12 | "A set of contexts in which an attribute may occur." 13 | '(satisfies context-list-p)) 14 | 15 | (defun foreign-name->lisp-name (name) 16 | "Return an idiomatic Lisp name derived from the GraphViz name NAME." 17 | (intern (string-upcase (substitute #\- #\_ name)) :keyword)) 18 | 19 | (defstruct (attribute 20 | (:constructor make-attribute (foreign-name allowed-in type 21 | &aux 22 | (name (foreign-name->lisp-name 23 | foreign-name)))) 24 | (:predicate nil) 25 | (:copier nil)) 26 | "Description of a GraphViz attribute." 27 | (name nil :type symbol :read-only t) 28 | (foreign-name nil :type string :read-only t) 29 | (allowed-in nil :type context-set :read-only t) 30 | (type nil :type (or symbol cons) :read-only t)) 31 | -------------------------------------------------------------------------------- /attributes.lisp: -------------------------------------------------------------------------------- 1 | ;; See http://www.graphviz.org/doc/info/attrs.html 2 | 3 | (in-package cl-dot) 4 | 5 | (defun find-attribute (name attributes) 6 | (or (find name attributes :key #'attribute-name) 7 | (error "Invalid attribute ~S" name))) 8 | 9 | (defparameter *graph-attributes* 10 | (remove :graph *attributes* :test-not #'member :key #'attribute-allowed-in)) 11 | 12 | (defparameter *node-attributes* 13 | (remove :node *attributes* :test-not #'member :key #'attribute-allowed-in)) 14 | 15 | (defparameter *edge-attributes* 16 | (remove :edge *attributes* :test-not #'member :key #'attribute-allowed-in)) 17 | 18 | (defparameter *cluster-attributes* 19 | (remove :cluster *attributes* :test-not #'member :key #'attribute-allowed-in)) 20 | -------------------------------------------------------------------------------- /cl-dot.asd: -------------------------------------------------------------------------------- 1 | ;; -*- Syntax: Ansi-Common-Lisp; Mode: lisp; -*- 2 | 3 | (asdf:defsystem :cl-dot 4 | :version "0.9.2" 5 | :description "Generate Dot Output from Arbitrary Lisp Data" 6 | :author "Juho Snellman " 7 | :maintainer "Robert P. Goldman " 8 | :depends-on (:uiop) 9 | :serial t 10 | :components 11 | ((:file "package") 12 | (:file "config-graphviz") 13 | (:file "attribute") 14 | (:file "raw-attributes") ; generated 15 | (:file "attributes") 16 | (:file "cl-dot") 17 | (:file "deprecated") 18 | (:static-file "README.md") 19 | (:static-file "COPYING") 20 | (:static-file "ChangeLog") 21 | (:module "examples" 22 | :components 23 | ((:static-file "class-example" :pathname "class-example.lisp") 24 | (:static-file "list-example" :pathname "list-example.lisp") 25 | (:static-file "list-example-old" :pathname "list-example-old.lisp") 26 | (:static-file "sb-c-example" :pathname "sb-c-example.lisp") 27 | (:static-file "subgraph-example" :pathname "subgraph-example.lisp"))))) 28 | -------------------------------------------------------------------------------- /cl-dot.lisp: -------------------------------------------------------------------------------- 1 | (in-package cl-dot) 2 | 3 | (declaim (type (or null string) 4 | *dot-path* *neato-path*)) 5 | 6 | (defvar *dot-path* 7 | nil 8 | "Path to the dot command") 9 | 10 | ;; the path to the neato executable (used for drawing undirected 11 | ;; graphs). 12 | (defvar *neato-path* 13 | nil 14 | "Path to the neato command") 15 | 16 | ;;; Classes 17 | 18 | (defvar *id*) 19 | 20 | (defclass id-mixin () 21 | ((id :initform (incf *id*) :initarg :id :accessor id-of))) 22 | 23 | (defclass attributes-mixin () 24 | ((attributes :initform nil :initarg :attributes :accessor attributes-of))) 25 | 26 | (defclass graph (attributes-mixin) 27 | ((nodes :initform nil :initarg :nodes :accessor nodes-of) 28 | (edges :initform nil :initarg :edges :accessor edges-of) 29 | ;; A hash table, mapping from clusters to lists of nodes. The hash 30 | ;; table also contains one entry whose key is NIL, and whose value is 31 | ;; the list of nodes that are not part of a cluster. 32 | (cluster-nodes 33 | :initform (make-hash-table) 34 | :initarg :cluster-nodes 35 | :accessor cluster-nodes-of))) 36 | 37 | (defclass node (id-mixin 38 | attributes-mixin) 39 | () 40 | (:documentation "A graph node with `dot` attributes (a plist, initarg 41 | :ATTRIBUTES) and an optional `dot` id (initarg :ID, autogenerated 42 | by default).")) 43 | 44 | (defclass port-mixin () 45 | ((source-port :initform nil :initarg :source-port :accessor source-port-of) 46 | (target-port :initform nil :initarg :target-port :accessor target-port-of))) 47 | 48 | (defclass attributed (attributes-mixin 49 | port-mixin) 50 | ((object :initarg :object :accessor object-of)) 51 | (:documentation "Wraps an object (initarg :OBJECT) with `dot` attribute 52 | information (a plist, initarg :ATTRIBUTES)")) 53 | 54 | (defmethod print-object ((object attributed) stream) 55 | (print-unreadable-object (object stream :type t :identity t) 56 | (format stream "~A" (object-of object)))) 57 | 58 | (defclass edge (attributes-mixin 59 | port-mixin) 60 | ((source :initform nil :initarg :source :accessor source-of) 61 | (target :initform nil :initarg :target :accessor target-of))) 62 | 63 | (defclass cluster (id-mixin 64 | attributes-mixin) 65 | () 66 | (:documentation "A cluster with `dot` attributes (a plist, initarg 67 | :ATTRIBUTES) and an optional `dot` id (initarg :ID, autogenerated 68 | by default).")) 69 | 70 | ;;; Protocol functions 71 | 72 | (defgeneric graph-object-node (graph object) 73 | (:documentation 74 | "Returns a NODE instance for this object, or NIL. 75 | 76 | In the latter case the object will not be included in the graph, but 77 | it can still have an indirect effect via other protocol 78 | functions (e.g. GRAPH-OBJECT-KNOWS-OF). This function will only be 79 | called once for each object during the generation of a graph.") 80 | (:method ((graph (eql 'default)) object) 81 | (declare (ignorable graph)) 82 | (object-node object))) 83 | 84 | (defgeneric graph-object-cluster (graph object) 85 | (:documentation 86 | "Returns a CLUSTER instance for this object, or NIL. 87 | 88 | The nodes nodes of objects for which this function returns the same cluster 89 | are grouped together as a subgraph. This function will only be called once 90 | for each object during the generation of a graph.") 91 | (:method (graph object) 92 | (declare (ignore graph object)) 93 | nil)) 94 | 95 | (defgeneric graph-object-edges (graph) 96 | (:documentation 97 | "Returns a sequence of edge specifications. 98 | 99 | An edge specification is a list (FROM TO [ATTRIBUTES]), where FROM and 100 | TO are objects of the graph and optional ATTRIBUTES is a plist of edge 101 | attributes.") 102 | (:method (graph) 103 | (declare (ignore graph)) 104 | '())) 105 | 106 | (defgeneric graph-object-points-to (graph object) 107 | (:documentation 108 | "Returns a sequence of objects to which the NODE of this object 109 | should be connected. 110 | 111 | The edges will be directed from this object to the others. To assign 112 | dot attributes to the generated edges, each object can optionally be 113 | wrapped in a instance of ATTRIBUTED.") 114 | (:method ((graph (eql 'default)) object) 115 | (declare (ignorable graph)) 116 | (object-points-to object)) 117 | (:method (graph (object t)) 118 | (declare (ignorable graph object)) 119 | '())) 120 | 121 | (defgeneric graph-object-pointed-to-by (graph object) 122 | (:documentation 123 | "Returns a sequence of objects to which the NODE of this object 124 | should be connected. 125 | 126 | The edges will be directed from the other objects to this one. To 127 | assign dot attributes to the generated edges, each object can 128 | optionally be wrapped in a instance of ATTRIBUTED.") 129 | (:method ((graph (eql 'default)) object) 130 | (declare (ignorable graph)) 131 | (object-pointed-to-by object)) 132 | (:method (graph (object t)) 133 | (declare (ignorable graph object)) 134 | '())) 135 | 136 | (defgeneric graph-object-knows-of (graph object) 137 | (:documentation 138 | "Returns a sequence of objects that this object knows should be 139 | part of the graph, but which it has no direct connections to.") 140 | (:method ((graph (eql 'default)) object) 141 | (declare (ignorable graph)) 142 | (object-knows-of object)) 143 | (:method (graph (object t)) 144 | (declare (ignorable graph object)) 145 | '())) 146 | 147 | ;;; Public interface 148 | 149 | (defgeneric generate-graph-from-roots (graph objects &optional attributes) 150 | (:documentation "Constructs a GRAPH with ATTRIBUTES starting 151 | from OBJECTS, using the GRAPH-OBJECT- protocol.") 152 | (:method (graph objects &optional attributes) 153 | (multiple-value-bind (nodes edges cluster-nodes) 154 | (construct-graph graph objects) 155 | (make-instance 'graph 156 | :attributes attributes 157 | :nodes nodes 158 | :edges edges 159 | :cluster-nodes cluster-nodes)))) 160 | 161 | (defun print-graph (graph &rest options 162 | &key (stream *standard-output*) (directed t)) 163 | "Prints a dot-format representation GRAPH to STREAM." 164 | (declare (ignore stream directed)) 165 | (apply #'generate-dot 166 | (cluster-nodes-of graph) 167 | (edges-of graph) 168 | (attributes-of graph) 169 | options)) 170 | 171 | (defun dot-graph (graph outfile &key (format :pdf) (directed t)) 172 | "Renders GRAPH to OUTFILE by running the program in \*DOT-PATH* or 173 | *NEATO-PATH* depending on the value of the DIRECTED keyword 174 | argument. The default is a directed graph. The default 175 | FORMAT is PDF." 176 | (let ((format (format nil "-T~(~a~)" format)) 177 | (outfile (merge-pathnames (parse-namestring outfile) 178 | (make-pathname :type (string-downcase format)))) 179 | (dot-path (if directed 180 | (setf *dot-path* 181 | (or *dot-path* (find-dot))) 182 | (setf *neato-path* 183 | (or *neato-path* (find-neato))))) 184 | (dot-string (with-output-to-string (stream) 185 | (print-graph graph 186 | :stream stream 187 | :directed directed)))) 188 | (unless dot-path 189 | (error "~a binary not found. Make sure it is installed and in your path." 190 | (if directed "'dot'" "'neato'"))) 191 | (uiop:run-program (list dot-path format "-o" (namestring outfile)) 192 | :input (make-string-input-stream dot-string) 193 | :output *standard-output*))) 194 | 195 | ;;; Internal 196 | (defun construct-graph (graph objects) 197 | (let ((handled-objects (make-hash-table)) 198 | (nodes '()) 199 | (edges '()) 200 | (cluster-nodes (make-hash-table)) 201 | (*id* 0)) 202 | (labels ((add-edge (source target attributes &optional source-port target-port) 203 | (let ((edge (make-instance 'edge 204 | :attributes attributes 205 | :source source 206 | :source-port source-port 207 | :target target 208 | :target-port target-port))) 209 | (push edge edges))) 210 | (get-node (object) 211 | (if (typep object 'attributed) 212 | (multiple-value-call #'values 213 | (get-node (object-of object)) 214 | (source-port-of object) 215 | (target-port-of object)) 216 | (gethash object handled-objects))) 217 | (get-attributes (object) 218 | (when (typep object 'attributed) 219 | (attributes-of object))) 220 | (handle-object (object) 221 | (when (typep object 'attributed) 222 | (return-from handle-object 223 | (handle-object (object-of object)))) 224 | ;; If object has been already been visited, skip 225 | (unless (nth-value 1 (get-node object)) 226 | (let ((node (graph-object-node graph object)) 227 | (cluster (graph-object-cluster graph object)) 228 | (knows-of (graph-object-knows-of graph object)) 229 | (points-to (graph-object-points-to graph object)) 230 | (pointed-to (graph-object-pointed-to-by graph object))) 231 | (setf (gethash object handled-objects) node) 232 | (map nil #'handle-object knows-of) 233 | (map nil #'handle-object points-to) 234 | (map nil #'handle-object pointed-to) 235 | (when node 236 | (push node (gethash cluster cluster-nodes '())) 237 | (push node nodes) 238 | (map nil 239 | (lambda (to) 240 | (multiple-value-bind (target found? source-port target-port) 241 | (get-node to) 242 | (when found? 243 | (add-edge node target (get-attributes to) 244 | source-port target-port)))) 245 | points-to) 246 | (map nil 247 | (lambda (from) 248 | (multiple-value-bind (source found? source-port target-port) 249 | (get-node from) 250 | (when found? 251 | (add-edge source node (get-attributes from) 252 | source-port target-port)))) 253 | pointed-to))))) 254 | (handle-edge (from to &optional attributes) 255 | (handle-object from) 256 | (handle-object to) 257 | (let ((source (get-node from)) 258 | (target (get-node to))) 259 | (add-edge source target attributes)))) 260 | (map nil #'handle-object objects) 261 | (map nil 262 | (lambda (edge-spec) 263 | (apply #'handle-edge edge-spec)) 264 | (graph-object-edges graph)) 265 | (values nodes edges cluster-nodes)))) 266 | 267 | (defun generate-dot (cluster-nodes edges attributes 268 | &key (stream *standard-output*) (directed t)) 269 | (with-standard-io-syntax () 270 | (let ((*standard-output* (or stream *standard-output*)) 271 | (*print-right-margin* 65535) 272 | (edge-op (if directed "->" "--")) 273 | (graph-type (if directed "digraph" "graph")) 274 | (node-defaults '()) 275 | (edge-defaults '())) 276 | (format stream "~a {~%" graph-type) 277 | (loop for (name value) on attributes by #'cddr do 278 | (case name 279 | (:node 280 | (setf node-defaults (append node-defaults value))) 281 | (:edge 282 | (setf edge-defaults (append edge-defaults value))) 283 | (t 284 | (print-key-value stream name value *graph-attributes*) 285 | (format stream ";~%")))) 286 | ;; Default attributes. 287 | (print-defaults stream "node" node-defaults *node-attributes*) 288 | (print-defaults stream "edge" edge-defaults *edge-attributes*) 289 | ;; Clusters of nodes. 290 | (maphash 291 | (lambda (cluster nodes) 292 | (if (null cluster) 293 | (dolist (node nodes) 294 | (format stream " ~a " (textify (id-of node))) 295 | (print-attributes stream (attributes-of node) *node-attributes*) 296 | (format stream ";~%")) 297 | (progn 298 | (format stream " subgraph cluster_~d {~%" (id-of cluster)) 299 | (loop for (name value) on (attributes-of cluster) by #'cddr do 300 | (format stream " ") 301 | (print-key-value stream name value *cluster-attributes*) 302 | (format stream ";~%")) 303 | (dolist (node nodes) 304 | (format stream " ~a " (textify (id-of node))) 305 | (print-attributes stream (attributes-of node) *node-attributes*) 306 | (format stream ";~%")) 307 | (format stream " }~%")))) 308 | cluster-nodes) 309 | ;; Edges. 310 | (dolist (edge edges) 311 | (format stream " ~a~@[:~a~] ~a ~a~@[:~a~]" 312 | (textify (id-of (source-of edge))) (source-port-of edge) 313 | edge-op 314 | (textify (id-of (target-of edge))) (target-port-of edge)) 315 | (print-attributes stream (attributes-of edge) *edge-attributes*) 316 | (format stream ";~%")) 317 | (format stream "}") 318 | (values)))) 319 | 320 | (defun print-defaults (stream kind attributes schema) 321 | (when attributes 322 | (format stream " ~A " kind) 323 | (print-attributes stream attributes schema) 324 | (format stream "~%"))) 325 | 326 | (defun print-attributes (stream attributes schema) 327 | (format stream "[") 328 | (loop for (name value) on attributes by #'cddr 329 | for prefix = "" then "," do 330 | (write-string prefix) 331 | (print-key-value stream name value schema)) 332 | (format stream "]")) 333 | 334 | (defun print-key-value (stream key value attributes) 335 | (let* ((attribute (find-attribute key attributes)) 336 | (foreign-name (attribute-foreign-name attribute)) 337 | (type (attribute-type attribute))) 338 | (flet ((text-value (value) 339 | (typecase value 340 | (cons 341 | (destructuring-bind (alignment value) value 342 | (textify value :alignment alignment))) 343 | (t 344 | (textify value))))) 345 | (format stream "~a=~a" foreign-name 346 | (etypecase type 347 | ((member integer) 348 | (unless (typep value 'integer) 349 | (error "Invalid value for ~S: ~S is not an integer" 350 | key value)) 351 | value) 352 | ((member boolean) 353 | (if value 354 | "true" 355 | "false")) 356 | ((member label-text) 357 | (typecase value 358 | ((cons (eql :html)) 359 | (htmlify value)) 360 | (t 361 | (text-value value)))) 362 | ((member text) 363 | (text-value value)) 364 | ((member float) 365 | (coerce value 'single-float)) 366 | (list 367 | (flet ((stringify (value) 368 | (unless (member value type :test 'equal) 369 | (error "Invalid value for ~S: ~S is not one of ~S" 370 | key value type)) 371 | (if (symbolp value) 372 | (string-downcase value) 373 | value))) 374 | (if (listp value) 375 | (format nil "\"~{~A~^,~}\"" (mapcar #'stringify value)) 376 | (stringify value))))))))) 377 | 378 | (defun htmlify (object) 379 | (check-type object (cons (eql :html) (cons null))) 380 | (with-output-to-string (stream) 381 | (labels 382 | ((escape-string (string &optional (stream stream)) 383 | (loop :for c :across string :do 384 | (case c 385 | (#\" 386 | (write-string """ stream)) 387 | (#\< 388 | (write-string "<" stream)) 389 | (#\> 390 | (write-string ">" stream)) 391 | (#\& 392 | (write-string "&" stream)) 393 | (#\Newline 394 | (write-string "
" stream)) 395 | (t 396 | (write-char c stream))))) 397 | (escape-attribute (attribute) 398 | (list 399 | (first attribute) 400 | (with-output-to-string (stream) 401 | (escape-string (second attribute) stream)))) 402 | (textify-node (node) 403 | (etypecase node 404 | (cons 405 | (destructuring-bind (name attributes &rest children) node 406 | (format stream "<~A~@[ ~{~{~A=\"~A\"~}~^ ~}~]>" 407 | name (mapcar #'escape-attribute attributes)) 408 | (mapc #'textify-node children) 409 | (format stream "" name))) 410 | (string 411 | (escape-string node))))) 412 | (write-char #\< stream) 413 | (mapc #'textify-node (nthcdr 2 object)) 414 | (write-char #\> stream)))) 415 | 416 | (defun textify (object &key alignment) 417 | (check-type alignment (member nil :center :left :right)) 418 | (let ((string (princ-to-string object)) 419 | (alignment (or alignment :center))) 420 | (with-output-to-string (stream) 421 | (write-char #\" stream) 422 | (loop for c across string do 423 | ;; Note: #\\ should not be escaped to allow \n, \l, \N, etc. 424 | ;; to work. 425 | (case c 426 | ((#\") 427 | (write-char #\\ stream) 428 | (write-char c stream)) 429 | (#\Newline 430 | (write-char #\\ stream) 431 | (ecase alignment 432 | (:center 433 | (write-char #\n stream)) 434 | (:left 435 | (write-char #\l stream)) 436 | (:right 437 | (write-char #\r stream)))) 438 | (t 439 | (write-char c stream)))) 440 | (write-char #\" stream)))) 441 | -------------------------------------------------------------------------------- /config-graphviz.lisp: -------------------------------------------------------------------------------- 1 | (in-package :cl-dot) 2 | 3 | (declaim (ftype (function () (values (or null string) &optional)) 4 | find-dot find-neato)) 5 | 6 | (defun find-dot () 7 | "Find the DOT program using either the environment variable CL_DOT_DOT, search in the user's 8 | path, or search of likely installation locations." 9 | (or 10 | (uiop:getenv "CL_DOT_DOT") 11 | (check-in-path "dot") 12 | (loop for file in #+(or win32 mswindows) (list "\"C:/Program Files/ATT/Graphviz/bin/dot.exe\"") 13 | #-(or win32 mswindows) (list "/usr/local/bin/dot" "/opt/local/bin/dot" "/usr/bin/dot") 14 | when (probe-file file) 15 | return (namestring file) 16 | finally (return nil)))) 17 | 18 | (defun find-neato () 19 | "Find the NEATO program using either the environment variable CL_DOT_NEATO, search in the user's 20 | path, or search of likely installation locations." 21 | (or 22 | (uiop:getenv "CL_DOT_NEATO") 23 | (check-in-path "neato") 24 | (loop for file in #+(or win32 mswindows) (list "\"C:/Program Files/ATT/Graphviz/bin/neato.exe\"") 25 | #-(or win32 mswindows) (list "/usr/local/bin/neato" "/opt/local/bin/neato" "/usr/bin/neato") 26 | when (probe-file file) 27 | return (namestring file) 28 | finally (return nil)))) 29 | 30 | 31 | (defun check-in-path (name) 32 | (multiple-value-bind (outstring errstring exit-code) 33 | (uiop:run-program (list #+(or win32 mswindows)"where" 34 | #-(or win32 mswindows)"which" 35 | name) 36 | :force-shell t 37 | :output '(:string :stripped t) 38 | :ignore-error-status t) 39 | (declare (ignore errstring)) 40 | (when (zerop exit-code) 41 | (namestring 42 | (uiop:parse-native-namestring outstring))))) 43 | -------------------------------------------------------------------------------- /deprecated.lisp: -------------------------------------------------------------------------------- 1 | ;;; -*- Mode:Lisp; Syntax:ANSI-Common-Lisp; Coding:utf-8 -*- 2 | 3 | (in-package cl-dot) 4 | 5 | ;;;; Deprecated Functionality 6 | 7 | (defgeneric object-node (object) 8 | (:documentation 9 | "Return a NODE instance for this object, or NIL. In the latter case 10 | the object will not be included in the graph, but it can still have an 11 | indirect effect via other protocol functions (e.g. OBJECT-KNOWS-OF). 12 | This function will only be called once for each object during the 13 | generation of a graph.")) 14 | 15 | (defgeneric object-points-to (object) 16 | (:documentation 17 | "Return a list of objects to which the NODE of this object should be 18 | connected. The edges will be directed from this object to the others. 19 | To assign dot attributes to the generated edges, each object can optionally 20 | be wrapped in a instance of ATTRIBUTED.") 21 | (:method ((object t)) 22 | nil)) 23 | 24 | (defgeneric object-pointed-to-by (object) 25 | (:documentation 26 | "Return a list of objects to which the NODE of this object should be 27 | connected. The edges will be directed from the other objects to this 28 | one. To assign dot attributes to the generated edges, each object can 29 | optionally be wrapped in a instance of ATTRIBUTED.") 30 | (:method ((object t)) 31 | nil)) 32 | 33 | (defgeneric object-knows-of (object) 34 | (:documentation 35 | "Return a list of objects that this object knows should be part of the 36 | graph, but which it has no direct connections to.") 37 | (:method ((object t)) 38 | nil)) 39 | 40 | (defgeneric generate-graph (object &optional attributes) 41 | (:documentation "Construct a GRAPH with ATTRIBUTES starting 42 | from OBJECT, using the GRAPH-OBJECT- protocol.") 43 | (:method ((object t) &optional attributes) 44 | (generate-graph-from-roots 'default (list object) attributes))) 45 | -------------------------------------------------------------------------------- /docs/.gitignore: -------------------------------------------------------------------------------- 1 | cl-dot.html 2 | cl-dot.info 3 | cl-dot.info.gz 4 | manual.aux 5 | manual.cp 6 | manual.cps 7 | manual.fn 8 | manual.fns 9 | manual.ky 10 | manual.log 11 | manual.pdf 12 | manual.pg 13 | manual.toc 14 | manual.tp 15 | manual.tps 16 | manual.vr 17 | manual.vrs 18 | -------------------------------------------------------------------------------- /docs/Makefile: -------------------------------------------------------------------------------- 1 | package = cl-dot 2 | prefix = $(DESTDIR)/usr/local 3 | datadir = $(prefix)/share/doc/$(package) 4 | infodir = $(prefix)/share/info 5 | 6 | MAKEINFO = makeinfo 7 | TEXINDEX = texindex 8 | PDFTEX = pdftex 9 | INSTALL = install 10 | 11 | SPLIT = --no-split 12 | MAKEINFO_FLAGS = --html --css-ref style.css --no-number-sections $(SPLIT) 13 | 14 | manual_SOURCES = manual.texi version.texi $(manual_EXTRA_SOURCES) 15 | manual_EXTRA_SOURCES = test.png test-lr.png test-undir.png test-edges.png 16 | dist_DATA = cl-dot.html manual.pdf style.css $(manual_EXTRA_SOURCES) 17 | 18 | 19 | all: cl-dot.html cl-dot.info.gz manual.pdf 20 | 21 | install: install-data install-info 22 | 23 | install-info: cl-dot.info.gz 24 | $(INSTALL) -d $(infodir) 25 | $(INSTALL) -m 0644 $^ $(infodir) 26 | 27 | install-data: $(dist_DATA) 28 | $(INSTALL) -d $(datadir) 29 | $(INSTALL) -m 0644 $^ $(datadir) 30 | 31 | clean: 32 | $(RM) cl-dot.html cl-dot.info cl-dot.info.gz 33 | $(RM) manual.pdf manual.{cp,fn,vr,tp} version.texi.tmp 34 | 35 | real-clean: clean 36 | $(RM) manual.{log,aux,cps,fns,ky,toc,tps,vrs,pg} version.texi 37 | 38 | cl-dot.html: $(manual_SOURCES) 39 | $(MAKEINFO) $(MAKEINFO_FLAGS) $< 40 | 41 | cl-dot.info: $(manual_SOURCES) 42 | $(MAKEINFO) $(SPLIT) $< 43 | 44 | manual.pdf: $(manual_SOURCES) 45 | 46 | version.texi: version.texi.tmp 47 | if cmp $< $@ 2>/dev/null; then $(RM) $<; else mv $< $@; fi 48 | 49 | version.texi.tmp: VERSION := $(shell git describe --tags --abbrev=6 HEAD || echo unknown) 50 | version.texi.tmp: 51 | echo "@set VERSION $(VERSION:cl-dot-%=%)" > $@ 52 | .PHONY: version.texi.tmp 53 | 54 | %.gz: % 55 | gzip --best < $< > $@ 56 | 57 | %.pdf: %.texi 58 | $(PDFTEX) $< 59 | $(TEXINDEX) $*.{fn,vr,tp} 60 | $(PDFTEX) $< 61 | 62 | .PHONY: all clean real-clean install install-data install-info 63 | -------------------------------------------------------------------------------- /docs/manual.texi: -------------------------------------------------------------------------------- 1 | \input texinfo @c -*-texinfo-*- 2 | @c %**start of header 3 | @setfilename cl-dot.info 4 | @settitle CL-DOT User Manual 5 | @ifhtml 6 | @exampleindent 0 7 | @end ifhtml 8 | @ifnothtml 9 | @exampleindent 2 10 | @end ifnothtml 11 | @c @syncodeindex tp fn 12 | @c %**end of header 13 | 14 | @c TODO 15 | @c * htmlize code 16 | @c * hyperspec links to CL vocabulary 17 | @c * consider separate summary page, a la CFFI 18 | 19 | @set EDITION 1.0 20 | @include version.texi 21 | 22 | @copying 23 | This manual is for CL-DOT, version@tie{}@value{VERSION}. 24 | 25 | Copyright @copyright{} 2005 Juho Snellman @* 26 | Copyright @copyright{} 2007,2008 Michael Weber 27 | 28 | @quotation 29 | Permission is hereby granted, free of charge, to any person obtaining 30 | a copy of this software and associated documentation files (the 31 | "Software"), to deal in the Software without restriction, including 32 | without limitation the rights to use, copy, modify, merge, publish, 33 | distribute, sublicense, and/or sell copies of the Software, and to 34 | permit persons to whom the Software is furnished to do so, subject to 35 | the following conditions: 36 | 37 | The above copyright notice and this permission notice shall be 38 | included in all copies or substantial portions of the Software. 39 | 40 | @sc{The software is provided ``as is'', without warranty of any kind, 41 | express or implied, including but not limited to the warranties of 42 | merchantability, fitness for a particular purpose and 43 | noninfringement. In no event shall the authors or copyright holders be 44 | liable for any claim, damages or other liability, whether in an action 45 | of contract, tort or otherwise, arising from, out of or in connection 46 | with the software or the use or other dealings in the software.} 47 | @end quotation 48 | @end copying 49 | 50 | @titlepage 51 | @title CL-DOT User Manual 52 | @author Michael Weber 53 | 54 | @c The following two commands 55 | @c start the copyright page. 56 | @page 57 | @vskip 0pt plus 1filll 58 | @insertcopying 59 | @end titlepage 60 | @c So the toc is printed at the start. 61 | @ifnothtml 62 | @contents 63 | @end ifnothtml 64 | 65 | @macro keyword{kw} 66 | @inlinefmtifelse{html, @code{\kw\}, @inlinefmtifelse{info, \kw\, @code{\kw\}}} 67 | @end macro 68 | 69 | @macro initarg{initarg} 70 | @keyword{:\initarg\} \initarg\@c 71 | @end macro 72 | 73 | @macro coderef{ref} 74 | @inlinefmtifelse{tex, @code{\ref\}, @inlinefmtifelse{info, \ref\, @code{@ref{\ref\}}}} 75 | @end macro 76 | 77 | @macro pcoderef{package,ref} 78 | @inlinefmtifelse{tex, @code{\package\:\ref\}, @inlinefmtifelse{info, \package\:\ref\, @code{@ref{\ref\,\package\:\ref\}}}} 79 | @end macro 80 | 81 | @macro cliki{project} 82 | @url{http://www.cliki.net/\project\,\project\}@c 83 | @end macro 84 | 85 | @ifnottex 86 | @node Top, Installation, , 87 | @top CL-DOT --- Generate Dot Output from Arbitrary Lisp Data 88 | @end ifnottex 89 | @iftex 90 | @top Introduction 91 | @end iftex 92 | 93 | CL-DOT is a small package for easily generating Dot (a program in the 94 | @url{http://www.graphviz.org/,GraphViz} suite) output from arbitrary 95 | Lisp data. It should work with any Common Lisp implementation supported 96 | by @url{https://www.common-lisp.net/project/asdf/,@acronym{UIOP}}. 97 | 98 | Original author is @url{http://jsnell.iki.fi/,Juho Snellman}, current 99 | maintainer is @url{http://www.foldr.org/~michaelw/,Michael Weber}. The 100 | code is covered by the MIT license, @pxref{Copying}. 101 | 102 | @ifnottex 103 | @ifhtml 104 | This manual is also available in @url{manual.pdf,@acronym{PDF} format}. 105 | 106 | @quotation 107 | @strong{Source Download shortcut:} 108 | @url{http://github.com/michaelw/cl-dot} 109 | @end quotation 110 | @end ifhtml 111 | @end ifnottex 112 | 113 | @ifhtml 114 | @contents 115 | @end ifhtml 116 | @html 117 | @c We need to keep the menu for HTML, otherwise makeinfo complains. 118 | @c Also, makeinfo is not very clever, hence the stray

below... 119 |

@c 120 |

Menu

121 | @end html 122 | @menu 123 | * Installation:: 124 | * Usage:: 125 | * Limitations:: 126 | * The CL-DOT Package:: 127 | * Support:: 128 | * Related Software:: 129 | * Copying:: 130 | * Indices:: 131 | 132 | @detailmenu 133 | Indices 134 | 135 | * Variable Index:: 136 | * Function Index:: 137 | * Class Index:: 138 | @c * Concept Index:: 139 | 140 | The CL-DOT Package 141 | 142 | * Variables:: 143 | * Generating Output:: 144 | * The GRAPH-OBJECT Protocol:: 145 | * Dot Attributes:: 146 | * Classes:: 147 | 148 | Dot Attributes 149 | 150 | * Graph Attributes:: 151 | * Node Attributes:: 152 | * Edge Attributes:: 153 | * Cluster Attributes:: 154 | 155 | @end detailmenu 156 | @end menu 157 | @html 158 |
@c 159 | @end html 160 | 161 | @c ----------------------------------------------------------------- 162 | @node Installation 163 | @chapter Installation 164 | 165 | CL-DOT together with this documentation can be downloaded from 166 | @quotation 167 | @url{http://www.foldr.org/~michaelw/projects/cl-dot/} 168 | @end quotation 169 | 170 | @noindent 171 | It can be installed via 172 | @url{http://quicklisp.org/,QuickLisp}: 173 | 174 | @lisp 175 | (ql:quickload "cl-dot") 176 | @end lisp 177 | 178 | @noindent 179 | The source code is available via @url{http://github.com/,GitHub}: 180 | @url{http://github.com/michaelw/cl-dot} 181 | 182 | @section External Dependencies 183 | 184 | The only @url{http://weitz.de/packages.html,systems} CL-DOT depends on 185 | is @url{https://www.common-lisp.net/project/asdf/,@acronym{UIOP}}. In 186 | addition, it requires the @url{http://www.graphviz.org/,GraphViz} suite 187 | to be installed for rendering, and 188 | @url{http://www.gnu.org/software/texinfo/,GNU Texinfo} for preparing 189 | this documentation. 190 | 191 | @c ----------------------------------------------------------------- 192 | @node Usage 193 | @chapter Usage 194 | 195 | With CL-DOT, graphs can be constructed by starting from some 196 | @emph{nodes} and recursively tracing edges until all reachable nodes and 197 | edges have been added. 198 | 199 | @menu 200 | * Node-Centric Graph Generation:: 201 | * Edge-Centric Graph Generation:: 202 | * Ports:: 203 | @end menu 204 | 205 | @node Node-Centric Graph Generation 206 | @section Node-Centric Graph Generation 207 | 208 | First, we define methods for the generic functions in the 209 | @code{GRAPH-OBJECT} protocol (@pxref{The GRAPH-OBJECT Protocol}) for all 210 | objects that can appear in our graph. @coderef{graph-object-node} must 211 | be defined for all objects, the others have a default implementation. 212 | For example: 213 | 214 | @smalllisp 215 | ;; @r{Conses} 216 | (defmethod @pcoderef{cl-dot,graph-object-node} ((graph (eql 'example)) (object cons)) 217 | (make-instance '@pcoderef{cl-dot,node} 218 | :attributes '(:label "cell \\N" 219 | :shape :box))) 220 | 221 | (defmethod @pcoderef{cl-dot,graph-object-points-to} ((graph (eql 'example)) (object cons)) 222 | (list (car object) 223 | (make-instance '@pcoderef{cl-dot,attributed} 224 | :object (cdr object) 225 | :attributes '(:weight 3)))) 226 | ;; @r{Symbols} 227 | (defmethod @pcoderef{cl-dot,graph-object-node} ((graph (eql 'example)) (object symbol)) 228 | (make-instance '@pcoderef{cl-dot,node} 229 | :attributes `(:label ,object 230 | :shape :hexagon 231 | :style :filled 232 | :color :black 233 | :fillcolor "#ccccff"))) 234 | @end smalllisp 235 | 236 | Note that in this example, the first argument to all @code{GRAPH-OBJECT} 237 | functions, @var{graph}, is only used to segregate the rendering of cons 238 | cells and symbols from those of other uses of CL-DOT. However, it could 239 | also be used to look up node information which is stored external to 240 | @var{object}. 241 | 242 | A call to @coderef{generate-graph-from-roots} generates an instance of 243 | @coderef{graph} for our data. From this graph instance, we can either 244 | generate dot-format output to some stream with @coderef{print-graph}, or 245 | call dot directly on the data with @coderef{dot-graph}. For example: 246 | 247 | @lisp 248 | (let* ((data '(a b c #1=(b z) c d #1#)) 249 | (dgraph (@pcoderef{cl-dot,generate-graph-from-roots} 'example (list data)))) 250 | (@pcoderef{cl-dot,dot-graph} dgraph "test.png" :format :png)) 251 | @end lisp 252 | 253 | @noindent 254 | We can also specify attributes for the whole graph: 255 | 256 | @lisp 257 | (let* ((data '(a b c #1=(b z) c d #1#)) 258 | (dgraph (@pcoderef{cl-dot,generate-graph-from-roots} 'example (list data) 259 | '(:rankdir "LR")))) 260 | (@pcoderef{cl-dot,dot-graph} dgraph "test-lr.png" :format :png)) 261 | @end lisp 262 | 263 | @float Figure,fig:example-lr 264 | @center @image{test-lr,5.5in,,Dot rendering of a graph} 265 | @caption{Graph of conses @code{(A B C #1=(B Z) C D #1#)}, generated by 266 | @code{@coderef{dot-graph}} with attributes @code{(:RANKDIR "LR")}} 267 | @end float 268 | 269 | @need 900 270 | In order to render an undirected graph we can call @coderef{dot-graph} 271 | in the following way: 272 | 273 | @lisp 274 | (@pcoderef{cl-dot,dot-graph} dgraph "test.png" 275 | :format :png 276 | :directed nil) 277 | @end lisp 278 | 279 | @anchor{exampleundir} 280 | @float Figure,fig:example-undir 281 | @center @image{test-undir,,4.75in,Dot rendering of an undirected graph} 282 | @caption{Graph of conses @code{(A B C #1=(B Z) C D #1#)}, generated by 283 | @code{@coderef{dot-graph}} with option @w{@code{@keyword{:directed} nil}}} 284 | @end float 285 | 286 | When the @var{directed} keyword argument is set to @code{NIL} (the 287 | default value is @code{T}) @coderef{dot-graph} outputs an undirected 288 | graph instead of a directed. To do that it needs the @command{neato} 289 | program from the Graphviz package, which is used to layout undirected 290 | graphs. The path to the @command{neato} program is stored in the 291 | @coderef{*neato-path*} special variable. 292 | 293 | @c Note that @command{neato} will not automatically fold duplicate edges. 294 | @c I.e., an edge from node @var{a} to node @var{b} and another from @var{b} 295 | @c to @var{a} will both end up being part of the graph. 296 | 297 | @c ----------------------------------------------------------------- 298 | @node Edge-Centric Graph Generation 299 | @section Edge-Centric Graph Generation 300 | 301 | If a graph is stored as an edge list, the use of 302 | @code{@coderef{graph-object-points-to}} is not a good match. Instead, 303 | we can use @code{@coderef{graph-object-edges}} to return @emph{edge 304 | specifications} (@pxref{graph-object-edges, Edge Specifications}) all 305 | edges which are part of the graph. For each object which appears as 306 | edge source or target, the appropriate functions of the 307 | @code{GRAPH-OBJECT} protocol are called. 308 | 309 | @lisp 310 | ;; @r{Define how nodes are drawn} 311 | (defmethod @pcoderef{cl-dot,graph-object-node} ((graph (eql 'edge-example)) object) 312 | (make-instance '@pcoderef{cl-dot,node} 313 | :attributes (list :label (format nil "Node ~A" object) 314 | :shape :box 315 | :style :filled 316 | :color :black 317 | :fillcolor "#ccccff"))) 318 | 319 | ;; @r{Edges and their attributes} 320 | (defmethod @pcoderef{cl-dot,graph-object-edges} ((graph (eql 'edge-example))) 321 | #((a b (:color :red :style :dashed)) 322 | (b c (:color :blue :style :dotted)) 323 | (c a (:color :yellow :style :bold)))) 324 | 325 | (let ((dgraph (@pcoderef{cl-dot,generate-graph-from-roots} 'edge-example '() 326 | '(:rankdir "LR")))) 327 | (@pcoderef{cl-dot,dot-graph} dgraph "test-edges.png" :format :png)) 328 | @end lisp 329 | 330 | @anchor{example-edges} 331 | @float Figure,fig:example-edges 332 | @center @image{test-edges,,0.5in,Dot rendering via edges} 333 | @caption{Graph generated via @code{@coderef{graph-object-edges}}} 334 | @end float 335 | 336 | @node Ports 337 | @section Ports 338 | 339 | GraphViz can connect the heads and tails of edges to specific parts of 340 | nodes called ``ports''. The ports available in a node have to be 341 | declared as port of the node's label. This can be done in two ways: 342 | @itemize @bullet 343 | @item For nodes with shape @code{:record}, the @code{:label} attribute string can contain port ``markers'' of the form @code{<@var{NAME}>} where @var{NAME} is the name of the provided port 344 | @item For nodes with @code{:html} labels, port markers can be added as attributes of certain HTML elements like @code{(:html () (:table () (:tr () (:td ((:port NAME)) CONTENT))))} 345 | @end itemize 346 | The heads and tails of edges can be attached to declared ports by making 347 | @coderef{attributed} instances and supplying @code{:source-port} and/or 348 | @code{:target-port} initargs. 349 | 350 | @smalllisp 351 | ;; @r{For HTML labels} 352 | (defmethod @pcoderef{cl-dot,graph-object-node} ((graph (eql 'ports)) (object cons)) 353 | (make-instance '@pcoderef{cl-dot,node} 354 | :attributes '(:label (:html () 355 | (:table ((:border "0")) 356 | (:tr () 357 | (:td ((:port "car")) "car") 358 | (:td ((:port "cdr")) "cdr")))) 359 | :shape :box))) 360 | 361 | ;; @r{For record nodes} 362 | #+alternative (defmethod @pcoderef{cl-dot,graph-object-node} ((graph (eql 'ports)) (object cons)) 363 | (make-instance '@pcoderef{cl-dot,node} 364 | :attributes '(:label "@{ | @}" 365 | :shape :record))) 366 | 367 | (defmethod @pcoderef{cl-dot,graph-object-points-to} ((graph (eql 'ports)) (object cons)) 368 | (list (make-instance '@pcoderef{cl-dot,attributed} 369 | :object (car object) 370 | :source-port "car:cc") 371 | (make-instance '@pcoderef{cl-dot,attributed} 372 | :object (cdr object) 373 | :source-port "cdr:cc" 374 | :attributes '(:weight 3)))) 375 | ;; @r{Symbols} 376 | (defmethod @pcoderef{cl-dot,graph-object-node} ((graph (eql 'ports)) (object symbol)) 377 | (make-instance '@pcoderef{cl-dot,node} 378 | :attributes `(:label ,object 379 | :shape :hexagon 380 | :style :filled 381 | :color :black 382 | :fillcolor "#ccccff"))) 383 | @end smalllisp 384 | 385 | @noindent 386 | The graph generation works as before: 387 | 388 | @lisp 389 | (let* ((data '(a b c #1=(b z) c d #1#)) 390 | (dgraph (@pcoderef{cl-dot,generate-graph-from-roots} ports (list data) 391 | '(:rankdir "LR")))) 392 | (@pcoderef{cl-dot,dot-graph} dgraph "test-ports.png" :format :png)) 393 | @end lisp 394 | 395 | @float Figure,fig:example-ports 396 | @center @image{test-ports,5.5in,,Dot rendering of a graph} 397 | @caption{Graph of conses @code{(A B C #1=(B Z) C D #1#)}, generated by 398 | @code{@coderef{dot-graph}} with ports} 399 | @end float 400 | 401 | @c ----------------------------------------------------------------- 402 | @node Limitations 403 | @chapter Limitations 404 | 405 | Not all of the functionality of the GraphViz suite is accessible from 406 | CL-DOT. Patches which add more features are highly welcome. 407 | 408 | @c ----------------------------------------------------------------- 409 | @node The CL-DOT Package 410 | @chapter The CL-DOT Package 411 | 412 | @menu 413 | * Variables:: 414 | * The GRAPH-OBJECT Protocol:: 415 | * Dot Attributes:: 416 | * Generating Output:: 417 | * Classes:: 418 | * Deprecated Functionality:: 419 | @end menu 420 | 421 | @c ----------------------------------------------------------------- 422 | @node Variables 423 | @section Variables 424 | 425 | @anchor{*dot-path*} 426 | @anchor{*neato-path*} 427 | @defvr {Special Variable} *dot-path* 428 | @defvrx {Special Variable} *neato-path* 429 | 430 | Path to the @command{dot} and @command{neato} commands, both from the 431 | @url{http://www.graphviz.org/,GraphViz} suite. 432 | @end defvr 433 | 434 | @c ----------------------------------------------------------------- 435 | @node The GRAPH-OBJECT Protocol 436 | @section The @code{GRAPH-OBJECT} Protocol 437 | 438 | The @code{GRAPH-OBJECT} protocol is used to translate Lisp data into a 439 | graph representation suitable for rendering with the Dot 440 | program. 441 | 442 | All protocol functions take as first parameter a @emph{context object} 443 | @var{graph}. This allows to render objects like cons cells differently 444 | for different graphs. 445 | 446 | Another use of the @var{graph} parameter is to look up node information 447 | needed for rendering. For example, if nodes are represented as integers 448 | and edges between nodes can be looked up in an external table, this 449 | table can be made accessible to the @code{GRAPH-OBJECT} functions via 450 | the @var{graph} parameter. 451 | 452 | @anchor{generate-graph-from-roots} 453 | @deffn {Generic Function} generate-graph-from-roots graph objects @ 454 | @keyword{&optional} attributes 455 | @deffnx {Method} generate-graph-from-roots @code{T} @code{T} @ 456 | @keyword{&optional} attributes 457 | 458 | Construct a @var{graph} with @var{attributes}, starting from 459 | @var{objects} (a sequence). Other functions of the @code{GRAPH-OBJECT} 460 | protocol are subsequently called on @var{objects} to discover other 461 | graph nodes and edges between them. 462 | @end deffn 463 | 464 | @anchor{graph-object-edges} 465 | @deffn {Generic Function} graph-object-edges graph 466 | @deffnx {Method} graph-object-edges @code{T} 467 | Returns a sequence of @emph{edge specifications}. 468 | 469 | An @dfn{edge specification} is a list @code{(@var{from} @var{to} 470 | [@var{attributes}])}, where @var{from} and @var{to} are objects of the 471 | graph and optional @var{attributes} is a @dfn{plist} of edge attributes, 472 | @pxref{Edge Attributes}. 473 | 474 | The default method returns an empty sequence. 475 | @end deffn 476 | 477 | @anchor{graph-object-knows-of} 478 | @deffn {Generic Function} graph-object-knows-of graph object 479 | @deffnx {Method} graph-object-knows-of @code{T} @code{T} 480 | Returns a sequence of objects that @var{object} knows should be part of 481 | the graph, but which it has no direct connections to. 482 | 483 | The default method returns an empty sequence. 484 | @end deffn 485 | 486 | @anchor{graph-object-node} 487 | @deffn {Generic Function} graph-object-node graph object 488 | Returns a @coderef{node} instance for @var{object}, or @code{NIL}. In 489 | the latter case the object will not be included in the constructed 490 | ouput, but it can still have an indirect effect via other protocol 491 | functions (e.g., @coderef{graph-object-knows-of}). This function will 492 | only be called once for each object during the generation of a graph. 493 | @end deffn 494 | 495 | @anchor{graph-object-cluster} 496 | @deffn {Generic Function} graph-object-cluster graph object 497 | Returns a @coderef{cluster} instance for @var{object}, or @code{NIL}. 498 | The nodes of objects for which this function returns the same cluster 499 | are grouped together as a subgraph. This function will only be called 500 | once for each object during the generation of a graph. 501 | @end deffn 502 | 503 | @anchor{graph-object-pointed-to-by} 504 | @deffn {Generic Function} graph-object-pointed-to-by graph object 505 | @deffnx {Method} graph-object-pointed-to-by @code{T} @code{T} 506 | Returns a sequence of objects to which the node of @var{object} should 507 | be connected. The edges will be directed from the other objects to this 508 | one. 509 | 510 | To assign Dot attributes to the generated edges, each object can 511 | optionally be wrapped in an instance of class @coderef{attributed}. 512 | 513 | The default method returns an empty sequence. 514 | @end deffn 515 | 516 | @anchor{graph-object-points-to} 517 | @deffn {Generic Function} graph-object-points-to graph object 518 | @deffnx {Method} graph-object-points-to @code{T} @code{T} 519 | Returns a sequence of objects to which the @coderef{node} of 520 | @var{object} should be connected. The edges will be directed from 521 | @var{object} to the others. 522 | 523 | To assign Dot attributes to the generated edges, each object can 524 | optionally be wrapped in an instance of class @coderef{attributed}. 525 | 526 | The default method returns an empty sequence. 527 | @end deffn 528 | 529 | @c ----------------------------------------------------------------- 530 | @node Dot Attributes 531 | @section Dot Attributes 532 | 533 | The rendering of Dot graphs, their nodes and edges can be influenced by 534 | @dfn{Dot attributes}. Attributes are represented as @dfn{keywords} of 535 | the same name. Multiple attributes can be given in form of a 536 | @dfn{plist}. 537 | 538 | CL-DOT supports most Dot attributes, a detailed list follows. 539 | Attributes which are not recognized result in an @dfn{error} when 540 | generating a graph. 541 | 542 | Most attributes have self-explanatory names, for more information we 543 | refer to the documentation of Dot. 544 | 545 | @menu 546 | * Graph Attributes:: 547 | * Node Attributes:: 548 | * Edge Attributes:: 549 | * Cluster Attributes:: 550 | @end menu 551 | 552 | @c ----------------------------------------------------------------- 553 | @node Graph Attributes 554 | @subsection Graph Attributes 555 | 556 | @dfn{Graph attributes} can be given to 557 | @coderef{generate-graph-from-roots} and apply to the whole graph. 558 | 559 | @table @code 560 | @item :bgcolor @var{text} 561 | @item :center @var{integer} 562 | @item :color @var{text} 563 | @item :edge @var{edge-attribute} 564 | The value of @var{edge-attribute} must be a single edge attribute, 565 | @pxref{Edge Attributes}. For example: 566 | 567 | @example 568 | (@coderef{generate-graph-from-roots} graph initial-states 569 | '(:edge (:arrowhead :odot))) 570 | @end example 571 | 572 | @item :layers @var{text} 573 | @item :margin @var{float} 574 | @item :mclimit @var{float} 575 | @item :node @var{node-attribute} 576 | The value of @var{node-attribute} must be a single node attribute, 577 | @pxref{Node Attributes}. For example: 578 | 579 | @example 580 | (@coderef{generate-graph-from-roots} graph initial-states 581 | '(:node (:shape :box) 582 | :node (:color :red))) 583 | @end example 584 | 585 | @item :nodesep @var{float} 586 | @item :nslimit @var{float} 587 | @item :ordering (:out) 588 | @item :page @var{text} 589 | @item :pagedir @var{text} 590 | @item :rank (:same :min :max) 591 | @item :rankdir ("LR" "RL" "BT") 592 | @item :ranksep @var{float} 593 | @item :ratio (:fill :compress :auto) 594 | @item :rotate @var{integer} 595 | @item :size @var{text} 596 | @end table 597 | 598 | @c ----------------------------------------------------------------- 599 | @node Node Attributes 600 | @subsection Node Attributes 601 | 602 | @table @code 603 | @item :color @var{text} 604 | @item :fillcolor @var{text} 605 | @item :fixed-size @var{boolean} 606 | @item :fontname @var{text} 607 | @item :fontsize @var{integer} 608 | @item :height @var{integer} 609 | @item :label @var{label} @anchor{node-attr-label} 610 | Provide a label for node. The string @var{label} may include 611 | escaped newlines @samp{\l}, @samp{\n}, or @samp{\r} for left, center, 612 | and right justified lines. The string @samp{\N} will be replaced by 613 | the node name. 614 | 615 | Note that verbatim backslashes inside of Lisp strings must be escaped 616 | themselves. E.g., the attribute @code{:label "Node \\N\\l"} produces a 617 | left-justified node label which includes the node identifier. 618 | 619 | By default, @code{#\Newline}-delimited lines contained in @var{label} 620 | are horizontally centered in Dot output. However, if the value of 621 | @var{label} is a list @code{(@var{alignment} @var{text})}, then 622 | @var{alignment} specifies how lines in string @var{text} are rendered. 623 | @var{alignment} can be one of @code{:left}, @code{:center}, 624 | @code{:right}. 625 | 626 | @item :layer @var{text} 627 | @item :shape @var{shape} 628 | 629 | @var{shape} can be one of the following keywords: 630 | 631 | @lisp 632 | :box :polygon :ellipse :oval 633 | :circle :point :egg :triangle 634 | :plaintext :plain :diamond :trapezium 635 | :parallelogram :house :pentagon :hexagon 636 | :septagon :octagon :doublecircle :doubleoctagon 637 | :tripleoctagon :invtriangle :invtrapezium :infhouse 638 | :Mdiamond :Msquare :Mcircle :rect 639 | :rectangle :square :star :none 640 | :underline :cylinder :note :tab 641 | :folder :box3d :component :promoter 642 | :cds :terminator :utr :primersite 643 | :restrictionsite :fivepoverhang :threepoverhang :noverhang 644 | :assembly :signature :insulator :ribosite 645 | :rnastab :proteasesite :proteinstab :rpromoter 646 | :rarrow :larrow :lpromoter :record 647 | @end lisp 648 | 649 | @item :style (:filled :solid :dashed :dotted :bold :invis) 650 | @item :width @var{integer} 651 | @end table 652 | 653 | @c ----------------------------------------------------------------- 654 | @node Edge Attributes 655 | @subsection Edge Attributes 656 | 657 | @table @code 658 | @need 600 659 | @item :arrowhead @var{arrow-spec} 660 | 661 | @var{arrow-spec} can be one of the following keywords: 662 | 663 | @lisp 664 | :none :normal :inv :dot :odot :invdot :invodot :tee :empty 665 | :invempty :open :halfopen :diamond :odiamond :box :obox :crow 666 | @end lisp 667 | 668 | @need 600 669 | @item :arrowtail @var{arrow-spec} 670 | 671 | @var{arrow-spec} can be one of the following keywords: 672 | 673 | @lisp 674 | :none :normal :inv :dot :odot :invdot :invodot :tee :empty 675 | :invempty :open :halfopen :diamond :odiamond :box :obox :crow 676 | @end lisp 677 | 678 | @item :color @var{text} 679 | @item :constraint @var{boolean} 680 | @item :decorate @var{boolean} 681 | @item :dir (:forward :back :both :none) 682 | @item :fontcolor @var{text} 683 | @item :fontname @var{text} 684 | @item :fontsize @var{integer} 685 | @item :headclip @var{boolean} 686 | @item :headlabel @var{text} 687 | @item :label @var{text} 688 | @xref{node-attr-label,Node Attributes}, for more information. 689 | 690 | @item :labeldistance @var{integer} 691 | @item :labelfontcolor @var{text} 692 | @item :labelfontname @var{text} 693 | @item :labelfontsize @var{integer} 694 | @item :layer @var{text} 695 | @item :minlen @var{integer} 696 | @item :port-label-distance @var{integer} 697 | @item :samehead @var{boolean} 698 | @item :sametail @var{boolean} 699 | @item :style (:solid :dashed :dotted :bold :invis) 700 | @item :tailclip @var{boolean} 701 | @item :taillabel @var{text} 702 | @item :weight @var{integer} 703 | @end table 704 | 705 | @c ----------------------------------------------------------------- 706 | @node Cluster Attributes 707 | @subsection Cluster Attributes 708 | 709 | @table @code 710 | @item :area @var{float} 711 | @item :bgcolor @var{text} 712 | @item :color @var{text} 713 | @item :colorscheme @var{text} 714 | @item :fillcolor @var{text} 715 | @item :fontcolor @var{text} 716 | @item :fontname @var{text} 717 | @item :fontsize @var{float} 718 | @item :label @var{text} 719 | @xref{node-attr-label,Node Attributes}, for more information. 720 | @item :shape @var{shape} 721 | 722 | @var{shape} can be one of the following keywords: 723 | 724 | @lisp 725 | :box :polygon :ellipse :oval 726 | :circle :point :egg :triangle 727 | :plaintext :plain :diamond :trapezium 728 | :parallelogram :house :pentagon :hexagon 729 | :septagon :octagon :doublecircle :doubleoctagon 730 | :tripleoctagon :invtriangle :invtrapezium :infhouse 731 | :Mdiamond :Msquare :Mcircle :rect 732 | :rectangle :square :star :none 733 | :underline :cylinder :note :tab 734 | :folder :box3d :component :promoter 735 | :cds :terminator :utr :primersite 736 | :restrictionsite :fivepoverhang :threepoverhang :noverhang 737 | :assembly :signature :insulator :ribosite 738 | :rnastab :proteasesite :proteinstab :rpromoter 739 | :rarrow :larrow :lpromoter :record 740 | @end lisp 741 | 742 | @item :style (:filled :solid :dashed :dotted :bold :invis) 743 | @end table 744 | 745 | @c ----------------------------------------------------------------- 746 | @node Generating Output 747 | @section Generating Output 748 | 749 | @anchor{dot-graph} 750 | @defun dot-graph graph outfile @keyword{&key} format directed 751 | Renders @var{graph} (an instance of @code{graph}, @pxref{graph,Classes}) to 752 | @var{outfile}, by running the program in either @coderef{*dot-path*} or 753 | @coderef{*neato-path*}. 754 | 755 | When @var{directed} is @code{T} (the default) it will use the program 756 | specified in @coderef{*dot-path*} to render a directed graph. Otherwise, 757 | (when @var{directed} is @code{NIL}) @coderef{dot-graph} will render an 758 | undirected graph using the program specified in @coderef{*neato-path*}. 759 | 760 | The default @var{format} is Postscript. 761 | @end defun 762 | 763 | @anchor{print-graph} 764 | @defun print-graph graph @keyword{&optional} stream 765 | Prints a dot-format representation of @var{graph} (an instance of 766 | @code{graph}, @pxref{graph, Classes}) to @var{stream}. 767 | @end defun 768 | 769 | @c ----------------------------------------------------------------- 770 | @node Classes 771 | @section Classes 772 | 773 | @anchor{graph} 774 | @deftp {Standard Class} graph 775 | A graph suitable for rendering with the Dot command. Instance 776 | of this class are most often generated with 777 | @code{generate-graph-from-roots} (@pxref{generate-graph-from-roots,The 778 | GRAPH-OBJECT Protocol}) or 779 | @code{generate-graph} (@pxref{generate-graph, The Object Protocol}). 780 | @end deftp 781 | 782 | @anchor{node} 783 | @deftp {Standard Class} node @initarg{attributes} @initarg{id} 784 | A graph node with dot attributes (a @dfn{plist}, initarg 785 | @var{attributes}, @pxref{Dot Attributes}) and an optional node 786 | identifier (initarg @var{id}, auto-generated by default). 787 | @end deftp 788 | 789 | @anchor{cluster} 790 | @deftp {Standard Class} cluster @initarg{attributes} @initarg{id} 791 | A graph cluster with dot attributes (a @dfn{plist}, initarg 792 | @var{attributes}, @pxref{Dot Attributes}) and an optional node 793 | identifier (initarg @var{id}, auto-generated by default). 794 | @end deftp 795 | 796 | @anchor{attributed} 797 | @deftp {Standard Class} attributed @initarg{object} @initarg{attributes} 798 | Wraps an object (initarg @var{object}) with edge attribute information 799 | (a @dfn{plist}, initarg @var{attributes}, @pxref{Dot Attributes}). 800 | @xref{Usage}, for an example of how to use @code{attributed}. 801 | @end deftp 802 | 803 | @c ----------------------------------------------------------------- 804 | @node Deprecated Functionality 805 | @section Deprecated Functionality 806 | 807 | The @code{OBJECT} protocol has been deprecated in favor of the more 808 | general @code{GRAPH-OBJECT} protocol (@pxref{The GRAPH-OBJECT 809 | Protocol}), which allows objects to be presented differently for 810 | different graphs. For backwards compatibility, the @code{OBJECT} 811 | protocol functions are called by their respective @code{GRAPH-OBJECT} 812 | equivalents when @coderef{generate-graph} is used. 813 | 814 | @subsection The @code{OBJECT} Protocol 815 | 816 | @anchor{generate-graph} 817 | @deffn {Generic Function} generate-graph object @keyword{&optional} attributes 818 | @deffnx {Method} generate-graph @code{T} @keyword{&optional} attributes 819 | Construct a @var{graph} with @var{attributes} starting from 820 | @var{object}, using the @code{OBJECT} protocol. 821 | 822 | The default method calls @coderef{generate-graph-from-roots} with a 823 | singleton list of @var{object}. 824 | @end deffn 825 | 826 | @anchor{object-knows-of} 827 | @deffn {Generic Function} object-knows-of object 828 | @deffnx {Method} object-knows-of @code{T} 829 | The default method returns the empty list. 830 | @end deffn 831 | 832 | @anchor{object-node} 833 | @deffn {Generic Function} object-node object 834 | Returns a @coderef{node} instance for @var{object}, or @code{NIL}. In 835 | the latter case the object will not be included in the constructed 836 | ouput, but it can still have an indirect effect via other protocol 837 | functions (e.g., @coderef{object-knows-of}). This function will only be 838 | called once for each object during the generation of a graph. 839 | @end deffn 840 | 841 | @anchor{object-pointed-to-by} 842 | @deffn {Generic Function} object-pointed-to-by object 843 | @deffnx {Method} object-pointed-to-by @code{T} 844 | The default method returns the empty list. 845 | @end deffn 846 | 847 | @anchor{object-points-to} 848 | @deffn {Generic Function} object-points-to object 849 | @deffnx {Method} object-points-to @code{T} 850 | The default method returns the empty list. 851 | @end deffn 852 | 853 | 854 | @c ----------------------------------------------------------------- 855 | @node Support 856 | @chapter Feedback and Support 857 | 858 | Please direct bug reports, patches, questions, and any other feedback to 859 | @email{michaelw@@foldr.org,Michael Weber}. 860 | A small check list helps to stream-line the process of submitting 861 | patches:@footnote{lifted from @url{http://weitz.de/patches.html}} 862 | @itemize @bullet 863 | @item When sending bug reports, please include a small test case. 864 | 865 | @item Please send patches in @dfn{unified} format. They can be created 866 | with @command{diff -u @dots{}}, for example. 867 | 868 | @item Do not use @key{TAB} characters for indentation. 869 | 870 | @item Every new function you add should have a reasonable documentation 871 | string. If you change an existing function, change its docstring as well 872 | if necessary. The same applies to global variables, classes, class 873 | slots, and everything else you can attach a docstring to. 874 | 875 | @item If your patch is exporting new functionality or changing 876 | exported functionality, please update the library's documentation as 877 | well. 878 | 879 | @item If you modify existing behavior, always try to be backwards 880 | compatible or to at least provide a simple transition path for users of 881 | previous releases. 882 | @end itemize 883 | 884 | @c ----------------------------------------------------------------- 885 | @node Related Software 886 | @chapter Related Software 887 | 888 | The following Lisp projects provide similar functionality: 889 | @table @cliki 890 | @item cl-graph 891 | This library has built-in support for the Dot output format. If we 892 | start out with CL-GRAPH data structures, this is probably the easiest 893 | way to render them with Dot. 894 | @item cl-graphviz 895 | This project provides a @cliki{CFFI} bindings to GraphViz. It provides 896 | richer access to (low-level) GraphViz functionality than CL-DOT. Also, 897 | it ties in with @cliki{cl-graph}. 898 | 899 | Quoting the main developer, 900 | Attila Lendvai:@footnote{Message-Id: @url{http://groups.google.com/group/comp.lang.lisp/msg/f6da031aa1a3faf7,<49d30481-63ee-475e-be17-07cc684f2a56@@w34g2000hsg.googlegroups.com>}} 901 | @quotation 902 | ``[@dots{}] if you only want to layout a few graphs from the repl then 903 | trivial-shell and the utils in cl-graph are your friends to exec the 904 | dot binary. cl-graphviz only helps if you want to have a web service 905 | or something and want to avoid exec'ing.'' 906 | @end quotation 907 | @item s-dot 908 | This library allows to translate graphs specified in @dfn{s-expressions} 909 | to the Dot format, and also render them by calling the @command{dot} 910 | command. 911 | @end table 912 | 913 | @c ----------------------------------------------------------------- 914 | @node Copying 915 | @chapter Copying 916 | @insertcopying 917 | 918 | @c ----------------------------------------------------------------- 919 | @node Indices 920 | @unnumbered Indices 921 | 922 | @menu 923 | * Variable Index:: 924 | * Function Index:: 925 | * Class Index:: 926 | @c * Concept Index:: 927 | @end menu 928 | 929 | @c ----------------------------------------------------------------- 930 | @node Variable Index 931 | @unnumberedsec Variable Index 932 | 933 | @printindex vr 934 | 935 | @c ----------------------------------------------------------------- 936 | @node Function Index 937 | @unnumberedsec Function Index 938 | @printindex fn 939 | 940 | @c ----------------------------------------------------------------- 941 | @node Class Index 942 | @unnumberedsec Class Index 943 | @printindex tp 944 | 945 | @c ----------------------------------------------------------------- 946 | @c @node Concept Index, , Class Index, Indices 947 | @c @unnumberedsec Concept Index 948 | 949 | @c @printindex cp 950 | 951 | @c ----------------------------------------------------------------- 952 | @bye 953 | 954 | Local Variables: 955 | mode: texinfo 956 | TeX-master: t 957 | End: 958 | -------------------------------------------------------------------------------- /docs/style.css: -------------------------------------------------------------------------------- 1 | /* Text, Layout */ 2 | body { 3 | padding: 1ex 3em; 4 | font-family: "Trebuchet MS", Verdana, Helvetica, sans-serif; 5 | font-size: 100%; 6 | min-width: 40em; 7 | line-height: 140%; 8 | } 9 | 10 | body li + li { 11 | margin-top: 1ex; 12 | } 13 | 14 | ul ul { 15 | margin-bottom: 1ex; 16 | } 17 | 18 | .contents li + li, 19 | ul.menu li, 20 | ul[compact] li { 21 | margin-top: 0; 22 | } 23 | 24 | dl dd + dt { 25 | margin-top: 2ex; 26 | } 27 | 28 | /* makeinfo generates stray
elements */ 29 | dl > dd > br { 30 | display: none; 31 | } 32 | 33 | @media print { 34 | body { 35 | margin: 0.5in 1in; 36 | } 37 | } 38 | 39 | h1.settitle { 40 | text-align: right; 41 | } 42 | h2 { 43 | color: #AE0A00; 44 | } 45 | 46 | /* Definitions */ 47 | div.defun { 48 | border-top: thin solid black; 49 | padding-top: 1ex; 50 | margin-bottom: 4em; 51 | } 52 | 53 | div.defun > b { /* name */ 54 | color: #AE0A00; 55 | font-family: Arial, sans-serif; 56 | } 57 | 58 | span.roman { 59 | font-family: "Trebuchet MS", Verdana, Helvetica, sans-serif; 60 | font-size: smaller; 61 | font-style: italic; 62 | color: #700; 63 | } 64 | 65 | var { 66 | color: #AE0A00; 67 | } 68 | 69 | .keyword { 70 | color: #aa0; 71 | } 72 | 73 | /* Code, Examples */ 74 | pre.example, 75 | pre.smallexample, 76 | pre.lisp, 77 | pre.smalllisp { 78 | margin: 4ex 3em; 79 | padding: 1.5ex 1em; 80 | background-color:#e8e8e8; 81 | } 82 | pre.smalllisp { 83 | font-size: 95%; 84 | } 85 | @media screen { 86 | pre.example, 87 | pre.smallexample, 88 | pre.lisp, 89 | pre.smalllisp { 90 | overflow: auto; 91 | } 92 | } 93 | 94 | /* Anchor hovering */ 95 | a { text-decoration: none; } 96 | a.noborder { border:0px } 97 | a.noborder:hover { border:0px } 98 | a.none { border:1px solid white; } 99 | a.none:hover { border:1px solid white; } 100 | a { border:1px solid white; } 101 | a:hover { border: 1px solid black; } 102 | a.noborder { border:0px } 103 | a.noborder:hover { border:0px } 104 | 105 | pre a, 106 | pre a:hover { 107 | border:none; 108 | } 109 | 110 | div.contents > h2 { 111 | margin-top: 3ex; 112 | } 113 | 114 | h2.unnumbered { 115 | margin-bottom: 4ex; 116 | } 117 | 118 | /* Nodes */ 119 | h1.settitle + div.node, 120 | h2.chapter + div.node, 121 | body > div.node:first-child { 122 | margin-top: 0; 123 | } 124 | 125 | div.node { 126 | padding: 0.25ex 0.5em; 127 | border: thin solid #faa; 128 | margin-top: 10ex; 129 | margin-bottom: 0.5ex; 130 | font-weight: bold; 131 | font-size: smaller; 132 | background: #fee; 133 | color: #777; 134 | text-align: right; 135 | font-family: "Trebuchet MS", Helvetica, Arial, sans-serif; 136 | clear: both; 137 | } 138 | 139 | /* Floats */ 140 | .float { 141 | margin: 7ex auto; 142 | padding: 1ex 1em 0 1em; 143 | } 144 | 145 | .float img { 146 | max-width: 100%; 147 | } 148 | 149 | /* Menus */ 150 | /* ul.menu, */ 151 | #master-menu { 152 | display: none; 153 | } 154 | 155 | @media print { 156 | .menu, 157 | div.node { 158 | display: none; 159 | } 160 | h2.chapter { 161 | margin-top: 4ex; 162 | } 163 | } 164 | 165 | .node p { 166 | margin: 0; 167 | padding: 0; 168 | } 169 | .node a { 170 | color: #a00; 171 | border-color: #fee; 172 | } 173 | .node a:hover { 174 | border-color: black; 175 | } 176 | .node a:visited { 177 | color: #500; 178 | } 179 | .node > hr { 180 | display: none; 181 | } 182 | -------------------------------------------------------------------------------- /docs/test-edges.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/michaelw/cl-dot/8a53123253e0f6a91e42842908fc28343c2079ec/docs/test-edges.png -------------------------------------------------------------------------------- /docs/test-lr.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/michaelw/cl-dot/8a53123253e0f6a91e42842908fc28343c2079ec/docs/test-lr.png -------------------------------------------------------------------------------- /docs/test-ports.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/michaelw/cl-dot/8a53123253e0f6a91e42842908fc28343c2079ec/docs/test-ports.png -------------------------------------------------------------------------------- /docs/test-undir.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/michaelw/cl-dot/8a53123253e0f6a91e42842908fc28343c2079ec/docs/test-undir.png -------------------------------------------------------------------------------- /docs/test.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/michaelw/cl-dot/8a53123253e0f6a91e42842908fc28343c2079ec/docs/test.png -------------------------------------------------------------------------------- /examples/class-example.lisp: -------------------------------------------------------------------------------- 1 | (defpackage class-hierarchy 2 | (:use :cl :cl-dot 3 | #+sbcl :sb-mop 4 | #-sbcl :closer-mop)) 5 | 6 | (in-package class-hierarchy) 7 | 8 | (defmethod graph-object-node ((graph (eql 'class-example)) (object class)) 9 | (make-instance 'node 10 | :attributes (list :label (class-name object) 11 | :shape :octagon 12 | :style :filled 13 | :fillcolor "#eeeeff"))) 14 | 15 | (defmethod graph-object-points-to ((graph (eql 'class-example)) (object class)) 16 | (class-direct-subclasses object)) 17 | -------------------------------------------------------------------------------- /examples/list-example-old.lisp: -------------------------------------------------------------------------------- 1 | (in-package cl-dot) 2 | 3 | ;; Conses 4 | (defmethod object-node ((object cons)) 5 | (make-instance 'node :attributes (list :label "cell \\N" 6 | :shape :box))) 7 | 8 | (defmethod object-points-to ((object cons)) 9 | (list (car object) 10 | (make-instance 'attributed 11 | :object (cdr object) 12 | :attributes (list :weight 3)))) 13 | 14 | ;; Symbols 15 | (defmethod object-node ((object symbol)) 16 | (make-instance 'node :attributes (list :label object 17 | :shape :hexagon 18 | :style :filled 19 | :color :black 20 | :fillcolor "#ccccff"))) 21 | -------------------------------------------------------------------------------- /examples/list-example.lisp: -------------------------------------------------------------------------------- 1 | (in-package cl-dot) 2 | 3 | ;; Conses 4 | (defmethod graph-object-node ((graph (eql 'list-example)) (object cons)) 5 | (make-instance 'node :attributes (list :label "cell \\N" 6 | :shape :box))) 7 | 8 | (defmethod graph-object-points-to ((graph (eql 'list-example)) (object cons)) 9 | (list (car object) 10 | (make-instance 'attributed 11 | :object (cdr object) 12 | :attributes (list :weight 3)))) 13 | 14 | ;; Symbols 15 | (defmethod graph-object-node ((graph (eql 'list-example)) (object symbol)) 16 | (make-instance 'node :attributes (list :label object 17 | :shape :hexagon 18 | :style :filled 19 | :color :black 20 | :fillcolor "#ccccff"))) 21 | -------------------------------------------------------------------------------- /examples/sb-c-example.lisp: -------------------------------------------------------------------------------- 1 | (in-package cl-dot) 2 | 3 | (defun list-no-nil (&rest args) 4 | (remove nil args)) 5 | 6 | ;; COMPONENT 7 | (defmethod graph-object-node ((graph (eql 'sb-c-example)) (object sb-c:component)) 8 | nil) 9 | 10 | (defmethod graph-object-knows-of ((graph (eql 'sb-c-example)) (c sb-c:component)) 11 | (list* (sb-c::component-head c) 12 | (sb-c::component-lambdas c))) 13 | 14 | 15 | ;; CBLOCK 16 | (defmethod graph-object-node ((graph (eql 'sb-c-example)) (c sb-c::cblock)) 17 | (make-instance 'node 18 | :attributes `(:label ,(format nil "Block ~A" (sb-c::block-number c))))) 19 | 20 | (defmethod graph-object-points-to ((graph (eql 'sb-c-example)) (c sb-c::cblock)) 21 | (sb-c::block-succ c)) 22 | 23 | (defmethod graph-object-knows-of ((graph (eql 'sb-c-example)) (c sb-c::cblock)) 24 | (sb-c::block-pred c)) 25 | 26 | ;; CLAMBDA 27 | (defmethod graph-object-node ((graph (eql 'sb-c-example)) (c sb-c::clambda)) 28 | (make-instance 'node 29 | :attributes `(:label ,(format nil "Lambda ~A" 30 | (sb-c::lambda-%source-name c))))) 31 | 32 | (defmethod graph-object-points-to ((graph (eql 'sb-c-example)) (c sb-c::clambda)) 33 | (sb-c::lambda-vars c)) 34 | 35 | ;; LAMBDA-VAR 36 | (defmethod graph-object-node ((graph (eql 'sb-c-example)) (c sb-c::lambda-var)) 37 | (make-instance 'node 38 | :attributes `(:label ,(format nil "Var ~A" 39 | (sb-c::lambda-var-%source-name c))))) 40 | 41 | (defmethod graph-object-knows-of ((graph (eql 'sb-c-example)) (c sb-c::lambda-var)) 42 | (sb-c::lambda-var-refs c)) 43 | 44 | ;; REF 45 | (defmethod graph-object-node ((graph (eql 'sb-c-example)) (c sb-c::ref)) 46 | (make-instance 'node 47 | :attributes (list :label "REF" 48 | :fillcolor "#ddffbb" 49 | :style :filled 50 | :shape :diamond))) 51 | 52 | (defmethod graph-object-points-to ((graph (eql 'sb-c-example)) (c sb-c::ref)) 53 | (list-no-nil (sb-c::ref-leaf c) 54 | (sb-c::ref-next c))) 55 | 56 | (defmethod graph-object-knows-of ((graph (eql 'sb-c-example)) (c sb-c::ref)) 57 | (list-no-nil (sb-c::ref-prev c) 58 | (sb-c::ref-lvar c))) 59 | 60 | ;; CTRAN 61 | (defmethod graph-object-node ((graph (eql 'sb-c-example)) (c sb-c::ctran)) 62 | (make-instance 'node 63 | :attributes `(:label ,(format nil "CTRAN ~A" 64 | (sb-c::ctran-kind c))))) 65 | 66 | (defmethod graph-object-points-to ((graph (eql 'sb-c-example)) (c sb-c::ctran)) 67 | (list-no-nil (sb-c::ctran-next c) 68 | (sb-c::ctran-use c))) 69 | 70 | ;; BIND 71 | (defmethod graph-object-node ((graph (eql 'sb-c-example)) (c sb-c::bind)) 72 | (make-instance 'node 73 | :attributes `(:label ,(format nil "BIND")))) 74 | 75 | (defmethod graph-object-points-to ((graph (eql 'sb-c-example)) (c sb-c::bind)) 76 | (list-no-nil (sb-c::bind-next c))) 77 | 78 | (defmethod graph-object-knows-of ((graph (eql 'sb-c-example)) (c sb-c::bind)) 79 | (list-no-nil (sb-c::bind-prev c))) 80 | 81 | ;; GLOBAL-VAR 82 | (defmethod graph-object-node ((graph (eql 'sb-c-example)) (c sb-c::global-var)) 83 | (make-instance 'node 84 | :attributes (list :label (format nil "GLOBAL-VAR\\n~A\\n~A" 85 | (sb-c::global-var-%source-name c) 86 | (sb-c::global-var-kind c)) 87 | :shape :box))) 88 | 89 | (defmethod graph-object-knows-of ((graph (eql 'sb-c-example)) (c sb-c::global-var)) 90 | (sb-c::global-var-refs c)) 91 | 92 | ;; CONSTANT 93 | (defmethod graph-object-node ((graph (eql 'sb-c-example)) (c sb-c::constant)) 94 | (make-instance 'node 95 | :attributes (list :label (format nil "CONSTANT ~A" 96 | (sb-c::constant-%source-name c) 97 | #+nil (sb-c::constant-value c)) 98 | :style :filled 99 | :fillcolor "#ffffee" 100 | :shape :box))) 101 | 102 | (defmethod graph-object-knows-of ((graph (eql 'sb-c-example)) (c sb-c::constant)) 103 | (sb-c::constant-refs c)) 104 | 105 | ;; ENTRY 106 | (defmethod graph-object-node ((graph (eql 'sb-c-example)) (c sb-c::entry)) 107 | (make-instance 'node 108 | :attributes `(:label ,(format nil "ENTRY")))) 109 | 110 | (defmethod graph-object-points-to ((graph (eql 'sb-c-example)) (c sb-c::entry)) 111 | ;; cleanup 112 | (list-no-nil (sb-c::entry-next c))) 113 | 114 | (defmethod graph-object-knows-of ((graph (eql 'sb-c-example)) (c sb-c::entry)) 115 | (list-no-nil (sb-c::entry-prev c))) 116 | 117 | ;; COMBINATION 118 | (defmethod graph-object-node ((graph (eql 'sb-c-example)) (c sb-c::combination)) 119 | (make-instance 'node 120 | :attributes (list :label (format nil "COMBINATION") 121 | :shape :octagon 122 | :style :filled 123 | :fillcolor "#eeeeff"))) 124 | 125 | (defmethod graph-object-points-to ((graph (eql 'sb-c-example)) (c sb-c::combination)) 126 | (list-no-nil (sb-c::combination-next c) 127 | (sb-c::combination-lvar c) 128 | (sb-c::combination-fun c))) 129 | 130 | (defmethod graph-object-knows-of ((graph (eql 'sb-c-example)) (c sb-c::combination)) 131 | (list* (sb-c::combination-prev c) 132 | (sb-c::combination-args c))) 133 | 134 | ;; LVAR 135 | (defmethod graph-object-node ((graph (eql 'sb-c-example)) (c sb-c::lvar)) 136 | (make-instance 'node 137 | :attributes (list :label (format nil "LVAR" 138 | #+nil (sb-c::lvar-derived-type c)) 139 | :style :filled 140 | :fillcolor "#ffeeff" 141 | :shape :octagon))) 142 | 143 | (defmethod graph-object-points-to ((graph (eql 'sb-c-example)) (c sb-c::lvar)) 144 | (list-no-nil (sb-c::lvar-dest c))) 145 | 146 | (defmethod graph-object-pointed-to-by ((graph (eql 'sb-c-example)) (c sb-c::lvar)) 147 | (let ((uses (sb-c::lvar-uses c))) 148 | (if (listp uses) 149 | uses 150 | (list-no-nil uses)))) 151 | 152 | ;; CIF 153 | (defmethod graph-object-node ((graph (eql 'sb-c-example)) (c sb-c::cif)) 154 | (make-instance 'node 155 | :attributes `(:label ,(format nil "CIF")))) 156 | 157 | (defmethod graph-object-points-to ((graph (eql 'sb-c-example)) (c sb-c::cif)) 158 | (list-no-nil (sb-c::if-next c) 159 | (sb-c::if-test c) 160 | (sb-c::if-consequent c) 161 | (sb-c::if-alternative c))) 162 | 163 | (defmethod graph-object-knows-of ((graph (eql 'sb-c-example)) (c sb-c::cif)) 164 | (list-no-nil (sb-c::if-prev c))) 165 | 166 | ;; CRETURN 167 | (defmethod graph-object-node ((graph (eql 'sb-c-example)) (c sb-c::creturn)) 168 | (make-instance 'node 169 | :attributes `(:label ,(format nil "CRETURN")))) 170 | 171 | (defmethod graph-object-points-to ((graph (eql 'sb-c-example)) (c sb-c::creturn)) 172 | (list-no-nil (sb-c::return-next c))) 173 | 174 | (defmethod graph-object-knows-of ((graph (eql 'sb-c-example)) (c sb-c::creturn)) 175 | (list-no-nil (sb-c::return-prev c) 176 | (sb-c::return-result c))) 177 | -------------------------------------------------------------------------------- /examples/subgraph-example.lisp: -------------------------------------------------------------------------------- 1 | (defpackage subgraph-example 2 | (:use :cl :cl-dot 3 | #+sbcl :sb-mop 4 | #-sbcl :closer-mop)) 5 | 6 | (in-package subgraph-example) 7 | 8 | ;; A hash table, mapping from classes to clusters. 9 | (defvar *class-cluster*) 10 | 11 | (defmethod generate-graph-from-roots 12 | ((graph (eql 'subgraph-example)) objects &optional attributes) 13 | (let ((*class-cluster* (make-hash-table))) 14 | ;; The :compound attribute is required to allow edges between clusters. 15 | (call-next-method graph objects (list* :compound t attributes)))) 16 | 17 | (defmethod graph-object-node ((graph (eql 'subgraph-example)) (object class)) 18 | (make-instance 'node 19 | :attributes (list :label (class-name object) 20 | :shape :octagon 21 | :style :filled 22 | :fillcolor "#eeeeff"))) 23 | 24 | (defmethod graph-object-cluster ((graph (eql 'subgraph-example)) (object class)) 25 | (or (gethash (class-of object) *class-cluster*) 26 | (setf (gethash (class-of object) *class-cluster*) 27 | (make-instance 'cluster 28 | :attributes (list :label (class-name (class-of object))))))) 29 | 30 | (defmethod graph-object-points-to ((graph (eql 'subgraph-example)) (object class)) 31 | (class-direct-subclasses object)) 32 | 33 | #+(or) ;; A quick demo: 34 | (dot-graph (generate-graph-from-roots 'subgraph-example (list (find-class 'function))) 35 | "subgraph-plot.pdf" :format :pdf) 36 | -------------------------------------------------------------------------------- /package.lisp: -------------------------------------------------------------------------------- 1 | ;; -*- Syntax: Ansi-Common-Lisp; Mode: lisp; -*- 2 | 3 | (defpackage cl-dot 4 | (:use :common-lisp) 5 | (:export 6 | ;; Variables 7 | #:*dot-path* 8 | #:*neato-path* 9 | 10 | ;; Classes 11 | #:attributed 12 | #:node 13 | #:cluster 14 | #:edge 15 | #:graph 16 | 17 | ;; Accessors 18 | #:id-of 19 | #:attributes-of 20 | #:nodes-of 21 | #:edges-of 22 | #:source-of 23 | #:target-of 24 | 25 | ;; Graph Protocol 26 | #:graph-object-knows-of 27 | #:graph-object-node 28 | #:graph-object-cluster 29 | #:graph-object-points-to 30 | #:graph-object-pointed-to-by 31 | #:graph-object-edges 32 | #:generate-graph-from-roots 33 | 34 | ;; Miscellaneous 35 | #:print-graph 36 | #:dot-graph 37 | 38 | ;; Deprecated 39 | #:object-knows-of 40 | #:object-node 41 | #:object-points-to 42 | #:object-pointed-to-by 43 | #:generate-graph)) 44 | 45 | 46 | 47 | 48 | 49 | -------------------------------------------------------------------------------- /raw-attributes.lisp: -------------------------------------------------------------------------------- 1 | ;;;; This file has been generated at 2017 2 26 1 55 33 from 2 | ;;;; http://www.graphviz.org/doc/info/attrs.html , 3 | ;;;; http://www.graphviz.org/doc/info/shapes.html and 4 | ;;;; http://www.graphviz.org/doc/info/arrows.html . Do not modify by 5 | ;;;; hand. 6 | 7 | (common-lisp:in-package #:cl-dot) 8 | 9 | (defparameter *node-shapes* 10 | '(:record :box :polygon :ellipse :oval :circle :point :egg :triangle 11 | :plaintext :plain :diamond :trapezium :parallelogram :house :pentagon 12 | :hexagon :septagon :octagon :doublecircle :doubleoctagon :tripleoctagon 13 | :invtriangle :invtrapezium :invhouse "Mdiamond" "Msquare" "Mcircle" :rect 14 | :rectangle :square :star :none :underline :cylinder :note :tab :folder 15 | :box3d :component :promoter :cds :terminator :utr :primersite 16 | :restrictionsite :fivepoverhang :threepoverhang :noverhang :assembly 17 | :signature :insulator :ribosite :rnastab :proteasesite :proteinstab 18 | :rpromoter :rarrow :larrow :lpromoter)) 19 | 20 | (defparameter *predefined-arrow-shapes* 21 | '(:box :lbox :rbox :obox :olbox :orbox :crow :lcrow :rcrow :diamond :ldiamond 22 | :rdiamond :odiamond :oldiamond :ordiamond :dot :odot :inv :linv :rinv :oinv 23 | :olinv :orinv :none :normal :lnormal :rnormal :onormal :olnormal :ornormal 24 | :tee :ltee :rtee :vee :lvee :rvee :curve :lcurve :rcurve :icurve :licurve 25 | :ricurve)) 26 | 27 | (defparameter *node-styles* 28 | '(:solid :dashed :dotted :bold :rounded :diagonals :filled :striped :wedged)) 29 | 30 | (defparameter *edge-styles* '(:solid :dashed :dotted :bold)) 31 | 32 | (defparameter *cluster-styles* 33 | '(:solid :dashed :dotted :bold :rounded :filled :striped)) 34 | 35 | (defparameter *attributes* 36 | (list (make-attribute "_background" '(:graph) 'text) 37 | (make-attribute "area" '(:node :cluster) 'float) 38 | (make-attribute "arrowhead" '(:edge) *predefined-arrow-shapes*) 39 | (make-attribute "arrowsize" '(:edge) 'float) 40 | (make-attribute "arrowtail" '(:edge) *predefined-arrow-shapes*) 41 | (make-attribute "bb" '(:graph) 'text) 42 | (make-attribute "bgcolor" '(:graph :cluster) 'text) 43 | (make-attribute "center" '(:graph) 'boolean) 44 | (make-attribute "charset" '(:graph) 'text) 45 | (make-attribute "clusterrank" '(:graph) '(:local :global :none)) 46 | (make-attribute "color" '(:edge :node :cluster) 'text) 47 | (make-attribute "colorscheme" '(:edge :node :cluster :graph) 'text) 48 | (make-attribute "comment" '(:edge :node :graph) 'text) 49 | (make-attribute "compound" '(:graph) 'boolean) 50 | (make-attribute "concentrate" '(:graph) 'boolean) 51 | (make-attribute "constraint" '(:edge) 'boolean) 52 | (make-attribute "Damping" '(:graph) 'float) 53 | (make-attribute "decorate" '(:edge) 'boolean) 54 | (make-attribute "defaultdist" '(:graph) 'float) 55 | (make-attribute "dim" '(:graph) 'integer) 56 | (make-attribute "dimen" '(:graph) 'integer) 57 | (make-attribute "dir" '(:edge) '(:forward :back :both :none)) 58 | (make-attribute "diredgeconstraints" '(:graph) 'text) 59 | (make-attribute "distortion" '(:node) 'float) 60 | (make-attribute "dpi" '(:graph) 'float) 61 | (make-attribute "edgehref" '(:edge) 'text) 62 | (make-attribute "edgetarget" '(:edge) 'text) 63 | (make-attribute "edgetooltip" '(:edge) 'text) 64 | (make-attribute "edgeURL" '(:edge) 'text) 65 | (make-attribute "epsilon" '(:graph) 'float) 66 | (make-attribute "esep" '(:graph) 'text) 67 | (make-attribute "fillcolor" '(:node :edge :cluster) 'text) 68 | (make-attribute "fixedsize" '(:node) 'text) 69 | (make-attribute "fontcolor" '(:edge :node :graph :cluster) 'text) 70 | (make-attribute "fontname" '(:edge :node :graph :cluster) 'text) 71 | (make-attribute "fontnames" '(:graph) 'text) 72 | (make-attribute "fontpath" '(:graph) 'text) 73 | (make-attribute "fontsize" '(:edge :node :graph :cluster) 'float) 74 | (make-attribute "forcelabels" '(:graph) 'boolean) 75 | (make-attribute "gradientangle" '(:node :cluster :graph) 'integer) 76 | (make-attribute "group" '(:node) 'text) 77 | (make-attribute "head_lp" '(:edge) 'text) 78 | (make-attribute "headclip" '(:edge) 'boolean) 79 | (make-attribute "headhref" '(:edge) 'text) 80 | (make-attribute "headlabel" '(:edge) 'label-text) 81 | (make-attribute "headport" '(:edge) 'text) 82 | (make-attribute "headtarget" '(:edge) 'text) 83 | (make-attribute "headtooltip" '(:edge) 'text) 84 | (make-attribute "headURL" '(:edge) 'text) 85 | (make-attribute "height" '(:node) 'float) 86 | (make-attribute "href" '(:graph :cluster :node :edge) 'text) 87 | (make-attribute "id" '(:graph :cluster :node :edge) 'text) 88 | (make-attribute "image" '(:node) 'text) 89 | (make-attribute "imagepath" '(:graph) 'text) 90 | (make-attribute "imagescale" '(:node) 'text) 91 | (make-attribute "inputscale" '(:graph) 'float) 92 | (make-attribute "K" '(:graph :cluster) 'float) 93 | (make-attribute "label" '(:edge :node :graph :cluster) 'label-text) 94 | (make-attribute "label_scheme" '(:graph) 'integer) 95 | (make-attribute "labelangle" '(:edge) 'float) 96 | (make-attribute "labeldistance" '(:edge) 'float) 97 | (make-attribute "labelfloat" '(:edge) 'boolean) 98 | (make-attribute "labelfontcolor" '(:edge) 'text) 99 | (make-attribute "labelfontname" '(:edge) 'text) 100 | (make-attribute "labelfontsize" '(:edge) 'float) 101 | (make-attribute "labelhref" '(:edge) 'text) 102 | (make-attribute "labeljust" '(:graph :cluster) 'text) 103 | (make-attribute "labelloc" '(:node :graph :cluster) 'text) 104 | (make-attribute "labeltarget" '(:edge) 'text) 105 | (make-attribute "labeltooltip" '(:edge) 'text) 106 | (make-attribute "labelURL" '(:edge) 'text) 107 | (make-attribute "landscape" '(:graph) 'boolean) 108 | (make-attribute "layer" '(:edge :node :cluster) 'text) 109 | (make-attribute "layerlistsep" '(:graph) 'text) 110 | (make-attribute "layers" '(:graph) 'text) 111 | (make-attribute "layerselect" '(:graph) 'text) 112 | (make-attribute "layersep" '(:graph) 'text) 113 | (make-attribute "layout" '(:graph) 'text) 114 | (make-attribute "len" '(:edge) 'float) 115 | (make-attribute "levels" '(:graph) 'integer) 116 | (make-attribute "levelsgap" '(:graph) 'float) 117 | (make-attribute "lhead" '(:edge) 'text) 118 | (make-attribute "lheight" '(:graph :cluster) 'float) 119 | (make-attribute "lp" '(:edge :graph :cluster) 'text) 120 | (make-attribute "ltail" '(:edge) 'text) 121 | (make-attribute "lwidth" '(:graph :cluster) 'float) 122 | (make-attribute "margin" '(:node :cluster :graph) 'text) 123 | (make-attribute "maxiter" '(:graph) 'integer) 124 | (make-attribute "mclimit" '(:graph) 'float) 125 | (make-attribute "mindist" '(:graph) 'float) 126 | (make-attribute "minlen" '(:edge) 'integer) 127 | (make-attribute "mode" '(:graph) 'text) 128 | (make-attribute "model" '(:graph) 'text) 129 | (make-attribute "mosek" '(:graph) 'boolean) 130 | (make-attribute "newrank" '(:graph) 'boolean) 131 | (make-attribute "nodesep" '(:graph) 'float) 132 | (make-attribute "nojustify" '(:graph :cluster :node :edge) 'boolean) 133 | (make-attribute "normalize" '(:graph) 'text) 134 | (make-attribute "notranslate" '(:graph) 'boolean) 135 | (make-attribute "nslimit" '(:graph) 'float) 136 | (make-attribute "ordering" '(:graph :node) 'text) 137 | (make-attribute "orientation" '(:node) 'float) 138 | (make-attribute "orientation" '(:graph) 'text) 139 | (make-attribute "outputorder" '(:graph) 140 | '(:breadthfirst :nodesfirst :edgesfirst)) 141 | (make-attribute "overlap" '(:graph) 'text) 142 | (make-attribute "overlap_scaling" '(:graph) 'float) 143 | (make-attribute "overlap_shrink" '(:graph) 'boolean) 144 | (make-attribute "pack" '(:graph) 'text) 145 | (make-attribute "packmode" '(:graph) 'text) 146 | (make-attribute "pad" '(:graph) 'text) 147 | (make-attribute "page" '(:graph) 'text) 148 | (make-attribute "pagedir" '(:graph) 149 | '("BL" "BR" "TL" "TR" "RB" "RT" "LB" "LT")) 150 | (make-attribute "pencolor" '(:cluster) 'text) 151 | (make-attribute "penwidth" '(:cluster :node :edge) 'float) 152 | (make-attribute "peripheries" '(:node :cluster) 'integer) 153 | (make-attribute "pin" '(:node) 'boolean) 154 | (make-attribute "pos" '(:edge :node) 'text) 155 | (make-attribute "quadtree" '(:graph) 'text) 156 | (make-attribute "quantum" '(:graph) 'float) 157 | (make-attribute "rank" '(:subgraph) '(:same :min :source :max :sink)) 158 | (make-attribute "rankdir" '(:graph) '("TB" "LR" "BT" "RL")) 159 | (make-attribute "ranksep" '(:graph) 'text) 160 | (make-attribute "ratio" '(:graph) 'text) 161 | (make-attribute "rects" '(:node) 'text) 162 | (make-attribute "regular" '(:node) 'boolean) 163 | (make-attribute "remincross" '(:graph) 'boolean) 164 | (make-attribute "repulsiveforce" '(:graph) 'float) 165 | (make-attribute "resolution" '(:graph) 'float) 166 | (make-attribute "root" '(:graph :node) 'text) 167 | (make-attribute "rotate" '(:graph) 'integer) 168 | (make-attribute "rotation" '(:graph) 'float) 169 | (make-attribute "samehead" '(:edge) 'text) 170 | (make-attribute "sametail" '(:edge) 'text) 171 | (make-attribute "samplepoints" '(:node) 'integer) 172 | (make-attribute "scale" '(:graph) 'text) 173 | (make-attribute "searchsize" '(:graph) 'integer) 174 | (make-attribute "sep" '(:graph) 'text) 175 | (make-attribute "shape" '(:node) *node-shapes*) 176 | (make-attribute "shapefile" '(:node) 'text) 177 | (make-attribute "showboxes" '(:edge :node :graph) 'integer) 178 | (make-attribute "sides" '(:node) 'integer) 179 | (make-attribute "size" '(:graph) 'text) 180 | (make-attribute "skew" '(:node) 'float) 181 | (make-attribute "smoothing" '(:graph) 182 | '(:none :avg_dist :graph_dist :power_dist :rng :spring 183 | :triangle)) 184 | (make-attribute "sortv" '(:graph :cluster :node) 'integer) 185 | (make-attribute "splines" '(:graph) 'text) 186 | (make-attribute "start" '(:graph) 'text) 187 | (make-attribute "style" '(:node) *node-styles*) 188 | (make-attribute "style" '(:edge) *edge-styles*) 189 | (make-attribute "style" '(:cluster) *cluster-styles*) 190 | (make-attribute "stylesheet" '(:graph) 'text) 191 | (make-attribute "tail_lp" '(:edge) 'text) 192 | (make-attribute "tailclip" '(:edge) 'boolean) 193 | (make-attribute "tailhref" '(:edge) 'text) 194 | (make-attribute "taillabel" '(:edge) 'label-text) 195 | (make-attribute "tailport" '(:edge) 'text) 196 | (make-attribute "tailtarget" '(:edge) 'text) 197 | (make-attribute "tailtooltip" '(:edge) 'text) 198 | (make-attribute "tailURL" '(:edge) 'text) 199 | (make-attribute "target" '(:edge :node :graph :cluster) 'text) 200 | (make-attribute "tooltip" '(:node :edge :cluster) 'text) 201 | (make-attribute "truecolor" '(:graph) 'boolean) 202 | (make-attribute "URL" '(:edge :node :graph :cluster) 'text) 203 | (make-attribute "vertices" '(:node) 'text) 204 | (make-attribute "viewport" '(:graph) 'text) 205 | (make-attribute "voro_margin" '(:graph) 'float) 206 | (make-attribute "weight" '(:edge) 'text) 207 | (make-attribute "width" '(:node) 'float) 208 | (make-attribute "xdotversion" '(:graph) 'text) 209 | (make-attribute "xlabel" '(:edge :node) 'label-text) 210 | (make-attribute "xlp" '(:node :edge) 'text) 211 | (make-attribute "z" '(:node) 'float))) 212 | -------------------------------------------------------------------------------- /tools-for-development/scrape-attributes.lisp: -------------------------------------------------------------------------------- 1 | ;;; Usage: 2 | ;;; 3 | ;;; (ql:quickload '(:alexandria :drakma :cxml :cxml-stp :xml.location :closure-html :cl-dot)) 4 | ;;; (load "scrape-attributes.lisp") 5 | ;;; (cl-dot.attribute-scraper:write-attributes-definition) 6 | 7 | (cl:defpackage #:cl-dot.attribute-scraper 8 | (:use 9 | #:cl 10 | #:alexandria) 11 | 12 | (:import-from #:cl-dot 13 | #:text 14 | #:label-text) 15 | 16 | (:export 17 | #:write-attributes-definition)) 18 | 19 | (cl:in-package #:cl-dot.attribute-scraper) 20 | 21 | ;;; Parameters 22 | 23 | (defvar *attribute-document-url* 24 | "http://www.graphviz.org/doc/info/attrs.html") 25 | 26 | (defvar *shapes-document-url* 27 | "http://www.graphviz.org/doc/info/shapes.html") 28 | 29 | (defvar *arrows-document-url* 30 | "http://www.graphviz.org/doc/info/arrows.html") 31 | 32 | (defvar *output-file* 33 | (asdf:system-relative-pathname :cl-dot "raw-attributes.lisp")) 34 | 35 | ;;; Obtaining and parsing the document 36 | 37 | (defvar *whitespace-characters* 38 | '(#\Space #\Tab #\Newline)) 39 | 40 | (defvar *xhtml-namespaces* 41 | '((nil . "http://www.w3.org/1999/xhtml"))) 42 | 43 | (defun parse-document (content) 44 | (closure-html:parse content (stp:make-builder))) 45 | 46 | (defun obtain-document (url) 47 | (parse-document (drakma:http-request url))) 48 | 49 | ;;; Scraping of attributes 50 | ;;; 51 | ;;; Find rows in the attributes table. For each row, extract the name, 52 | ;;; the graph elements it is allowed in and its type. 53 | 54 | (defun scrape-attribute-definitions (document) 55 | (xloc:with-locations-r/o 56 | (((:val attributes :type 'attribute-description) "//table[@align=\"CENTER\"]/tbody/tr[td]" 57 | :if-multiple-matches :all) 58 | :namespaces *xhtml-namespaces*) 59 | document 60 | attributes)) 61 | 62 | (defmethod xloc:xml-> ((value stp:node) 63 | (type (eql 'attribute-description)) 64 | &key inner-types) 65 | (declare (ignore inner-types)) 66 | (xloc:with-locations-r/o 67 | (((:val name) "td[1]/a/text()") 68 | ((:val allowed-in :type 'attribute-allowed-in) "td[2]/text()") 69 | ((:val type :type 'attribute-type) "td[3]") 70 | :namespaces *xhtml-namespaces*) 71 | value 72 | (list name allowed-in type))) 73 | 74 | (defmethod xloc:xml-> ((value string) 75 | (type (eql 'attribute-allowed-in)) 76 | &key inner-types) 77 | (declare (ignore inner-types)) 78 | (map 'list (lambda (character) 79 | (ecase character 80 | (#\G :graph) 81 | (#\S :subgraph) 82 | (#\C :cluster) 83 | (#\N :node) 84 | (#\E :edge))) 85 | value)) 86 | 87 | (defmethod xloc:xml-> ((value stp:node) 88 | (type (eql 'attribute-type)) 89 | &key inner-types) 90 | (declare (ignore inner-types)) 91 | (xloc:with-locations-r/o ((types ".//text()" :if-multiple-matches :all) 92 | :namespaces *xhtml-namespaces*) 93 | value 94 | (flet ((only-whitespace-p (string) 95 | (every (rcurry #'member *whitespace-characters*) string))) 96 | (let ((types (remove-duplicates 97 | (mapcar #'graphviz-type->lisp-type 98 | (remove-if #'only-whitespace-p types)))) 99 | (fallback ''text)) 100 | (cond 101 | ((= 1 (length types)) 102 | (first types)) 103 | (t 104 | (warn "~@" 106 | types fallback) 107 | fallback)))))) 108 | 109 | (defun graphviz-type->lisp-type (string) 110 | (eswitch (string :test #'string=) 111 | ("bool" ''boolean) 112 | ("int" ''integer) 113 | ("double" ''float) 114 | ("string" ''text) 115 | 116 | ("escString" ''text) 117 | 118 | ("arrowType" 'cl-dot::*predefined-arrow-shapes*) 119 | ("rect" ''text) 120 | 121 | ("color" ''text) 122 | ("colorList" ''text) 123 | 124 | ("clusterMode" ''(:local :global :none)) 125 | ("dirType" ''(:forward :back :both :none)) 126 | ("addDouble" ''text) 127 | ("addPoint" ''text) 128 | ("point" ''text) 129 | ("lblString" ''label-text) 130 | ("portPos" ''text) 131 | ("layerRange" ''text) 132 | ("layerList" ''text) 133 | ("outputMode" ''(:breadthfirst :nodesfirst :edgesfirst)) 134 | ("packMode" ''text) ; "node", "clust" , "graph" , "array(_flags)?(%d)?" 135 | ("pagedir" ''("BL" "BR" "TL" "TR" "RB" "RT" "LB" "LT")) 136 | ("splineType" ''text) 137 | ("quadType" ''(:normal :fast :none)) 138 | ("doubleList" ''text) 139 | ("shape" 'cl-dot::*node-shapes*) 140 | 141 | ("rankType" ''(:same :min :source :max :sink)) 142 | ("rankdir" ''("TB" "LR" "BT" "RL")) 143 | 144 | ("smoothType" ''(:none :avg_dist :graph_dist :power_dist :rng :spring :triangle)) 145 | ("startType" ''text) 146 | ("style" `(error "~@<~S should have been handled specially.~@:>" 147 | ,string)) 148 | ("pointList" ''text) 149 | ("viewPort" ''text))) 150 | 151 | ;;; Scraping of node, edge and cluster styles 152 | 153 | (defun scrape-style (document context) 154 | (let* ((caption (ecase context 155 | (:node "Basic style settings for nodes") 156 | (:edge "Basic style settings for edges") 157 | (:cluster "Basic style settings for clusters"))) 158 | (path (format nil "//table[caption/text()=~S]/tbody/tr/td/tt/text()" 159 | caption))) 160 | (xloc:with-locations-r/o 161 | ((styles path :if-multiple-matches :all) 162 | :namespaces *xhtml-namespaces*) 163 | document 164 | styles))) 165 | 166 | ;;; Scraping of polygonal node shapes 167 | 168 | (defun scrape-polygon-shapes (document) 169 | (xloc:with-locations-r/o 170 | ((shapes "//table[@align=\"CENTER\"]/tbody/tr/td/a/text()" 171 | :if-multiple-matches :all) 172 | :namespaces *xhtml-namespaces*) 173 | document 174 | shapes)) 175 | 176 | ;;; Scraping of arrow shapes 177 | 178 | (defun scrape-arrow-shapes (document) 179 | (xloc:with-locations-r/o 180 | ((shapes "//center[4]/table/tbody/tr/td[normalize-space(text())]/text()" 181 | :if-multiple-matches :all) 182 | :namespaces *xhtml-namespaces*) 183 | document 184 | (mapcar (curry #'string-trim *whitespace-characters*) shapes))) 185 | 186 | ;;; Emitter 187 | ;;; 188 | ;;; Write shape and style lists, write a form constructing an 189 | ;;; `attribute' instance for each scraped attribute. 190 | 191 | (defun maybe-keywordify (string) 192 | (if (notany #'upper-case-p string) 193 | (make-keyword (string-upcase string)) 194 | string)) 195 | 196 | (defun make-enum-definition (name values) 197 | `(defparameter ,name 198 | '(,@(mapcar #'maybe-keywordify values)))) 199 | 200 | (defun make-attributes-definition (attributes) 201 | `(defparameter cl-dot::*attributes* 202 | (list ,@(loop :for (name allowed-in type) :in attributes 203 | ;; Style attribute is context-dependent. Make one 204 | ;; `attribute' instance for each of the node, edge and 205 | ;; cluster contexts. 206 | :if (string= name "style") 207 | :collect `(cl-dot::make-attribute 208 | ,name '(:node) cl-dot::*node-styles*) 209 | :and :collect `(cl-dot::make-attribute 210 | ,name '(:edge) cl-dot::*edge-styles*) 211 | :and :collect `(cl-dot::make-attribute 212 | ,name '(:cluster) cl-dot::*cluster-styles*) 213 | ;; Everything else should be fine 214 | :else 215 | :collect `(cl-dot::make-attribute ,name ',allowed-in ,type))))) 216 | 217 | (defun write-attributes-definition () 218 | (let* ((polygon-shapes (scrape-polygon-shapes 219 | (obtain-document *shapes-document-url*))) 220 | (arrow-shapes (scrape-arrow-shapes 221 | (obtain-document *arrows-document-url*))) 222 | (attributes-document (obtain-document *attribute-document-url*)) 223 | (node-styles (scrape-style attributes-document :node)) 224 | (edge-styles (scrape-style attributes-document :edge)) 225 | (cluster-styles (scrape-style attributes-document :cluster)) 226 | (attributes (scrape-attribute-definitions 227 | attributes-document)) 228 | (attributes (sort attributes #'string-lessp :key #'first))) 229 | (with-output-to-file (stream *output-file* :if-exists :supersede) 230 | (with-standard-io-syntax 231 | (format stream ";;;;~{ ~<~%;;;; ~1,70:;~A~>~}~%" 232 | `("This" "file" "has" "been" "generated" "at" 233 | ,@(nthcdr 234 | 3 (reverse 235 | (multiple-value-list 236 | (decode-universal-time (get-universal-time))))) 237 | "from" ,*attribute-document-url* "," 238 | ,*shapes-document-url* "and" ,*arrows-document-url* "." 239 | "Do" "not" "modify" "by" "hand.")) 240 | (let ((*print-case* :downcase)) 241 | (let ((*package* (find-package '#:keyword))) 242 | (print '(in-package #:cl-dot) stream)) 243 | (terpri stream) 244 | 245 | 246 | (let ((*package* (find-package '#:cl-dot))) 247 | (flet ((emit (form) 248 | (pprint form stream) 249 | (terpri stream))) 250 | ;; Node shapes 251 | (emit (make-enum-definition 'cl-dot::*node-shapes* 252 | (list* "record" polygon-shapes))) 253 | ;; Arrow shapes 254 | (emit (make-enum-definition 'cl-dot::*predefined-arrow-shapes* 255 | arrow-shapes)) 256 | ;; Node styles 257 | (emit (make-enum-definition 'cl-dot::*node-styles* node-styles)) 258 | ;; Edge styles 259 | (emit (make-enum-definition 'cl-dot::*edge-styles* edge-styles)) 260 | ;; Cluster styles 261 | (emit (make-enum-definition 'cl-dot::*cluster-styles* cluster-styles)) 262 | ;; Attributes 263 | (emit (make-attributes-definition attributes))))))))) 264 | --------------------------------------------------------------------------------