S-Graphviz is an S-Expression syntax for the input language of the ‘Dot’ graph drawing tool from the AT&T GraphViz suite. With S-Graphviz, you can render ‘Dot’ graphs from within Common Lisp. The idea of this package is from S-DOT.
Let’s create an individual package for this module.
(defpackage :s-graphviz
(:nicknames :graphviz)
(:use :common-lisp :iter)
(:export :render-graph :format-graph))
(in-package :s-graphviz)We will use a lisp style to present the DOT language.
graph : [ strict ] (graph | digraph) [ ID ] '{' stmt_list '}'
stmt_list : [ stmt [ ';' ] stmt_list ]
stmt : node_stmt
| edge_stmt
| attr_stmt
| ID '=' ID
| subgraph
attr_stmt : (graph | node | edge) attr_list
attr_list : '[' [ a_list ] ']' [ attr_list ]
a_list : ID '=' ID [ (';' | ',') ] [ a_list ]
edge_stmt : (node_id | subgraph) edgeRHS [ attr_list ]
edgeRHS : edgeop (node_id | subgraph) [ edgeRHS ]
node_stmt : node_id [ attr_list ]
node_id : ID [ port ]
port : ':' ID [ ':' compass_pt ]
| ':' compass_pt
subgraph : [ subgraph [ ID ] ] '{' stmt_list '}'
compass_pt : (n | ne | e | se | s | sw | w | nw | c | _)
The encoded DOT expressions will print to this stream.
(defvar *dot-stream*)How many white spaces will be written before printing current DOT expression.
(defvar *indent-spaces* 0)(defvar *indent-tab-size* 2)Renders a s-graphviz graph into a graphic file.
file-name should be a path name.
If the file-name is /foo/bar.png, the DOT file /foo/bar.dot is created
and then rendered.
Format should be one out of http://www.graphviz.org/doc/info/output.html,
for example svg, ps, gif, png, or jpg.
(defun render-graph (file-name s-expression &key
(format (pathname-type file-name))
(dot-exe "dot")
(dot-options "")
(dot-output-format-switch "-T"))
(let ((dot-file-name (make-pathname :directory (pathname-directory file-name)
:name (pathname-name file-name) :type "dot")))
(with-open-file (stream dot-file-name :direction :output :if-exists :supersede
:if-does-not-exist :create)
(format stream "// This file is generated automatically by S-GRAPHVIZ.~%~%")
(format-graph s-expression :stream stream))
(uiop:run-program (format nil "~a -o ~a ~a~a ~a ~a"
dot-exe file-name dot-output-format-switch
format dot-options dot-file-name)
:ignore-error-status t)))We will provide a helpful routine to render an S-GRAPHVIZ S-expression and open it in Emacs.
(defmacro render-and-open-s-graphviz (file-name &rest left-args)
(let ((real-file-name (gensym "file-name")))
`(let ((,real-file-name (namestring ,file-name)))
(render-graph ,real-file-name ,@left-args)
#+slynk
(slynk:eval-in-emacs `(find-file ,,real-file-name) t)
#+swank
(swank:eval-in-emacs `(find-file ,,real-file-name) t))))- The top expression must begin with the graph type:
:graphor:digraph, or(:strict :graph)or(:strict :digraph)
(defvar *valid-graph-predicates* '(:graph :digraph (:strict :graph) (:strict :digraph)))- the second item in top expression will be the graph
IDif not null. - the left items in top expression are the
stmt_listfor this graph.
(defun format-graph (s-expression &key stream)
(let ((graph-type (car s-expression))
(id (second s-expression))
(stmt-list (cddr s-expression))
(*indent-spaces* 0)
(*dot-stream* (or stream
(make-string-output-stream))))
;; check graph type.
(unless (find graph-type *valid-graph-predicates* :test #'equal)
(error "The dot graph must be a 'graph' or a 'digraph'!"))
;; write out graph type.
(if (atom graph-type)
(format *dot-stream* "~(~a~) " graph-type)
(format *dot-stream* "~{~(~a ~)~}" graph-type))
;; write out optional graph ID
(when id
(format-id id))
(format-stmt-list stmt-list)
(when (null stream)
(get-output-stream-string *dot-stream*))))a graph is established by a stmt_list.
We can also apply some global configuration in a stmt_list to limit their affection scope, for example:
(render-and-open-s-graphviz
(merge-pathnames
#p"images/statements.png"
(asdf:component-pathname (asdf:find-system :s-graphviz)))
'(:digraph nil
(= :rankdir "LR")
(:-> nil a b c)
(:-> nil d e f)
(:-> nil b d)
(:{}
(= :rank :same)
(b)
(d)))
)(defun format-stmt-list (stmt-list)
(format *dot-stream* "{~%")
(incf *indent-spaces* *indent-tab-size*)
;; write out statements
(iter (for stmt in stmt-list)
(iter (repeat *indent-spaces*)
(write-char #\Space *dot-stream*))
(format-stmt stmt)
(format *dot-stream* ";~%"))
(decf *indent-spaces* *indent-tab-size*)
(iter (repeat *indent-spaces*)
(write-char #\Space *dot-stream*))
(format *dot-stream* "}")
)There are many kinds of statements, let’s recognize them one by one.
(defun format-stmt (stmt)
(case (car stmt)
((:-> :--) (format-edge-stmt stmt))
((:graph :node :edge) (format-attr-stmt stmt))
((:= =) (format-attribute stmt))
(({ :{ :{}) (format-stmt-list (cdr stmt)))
(:subgraph (format-subgraph-stmt stmt))
(otherwise (format-node-stmt stmt))))If a statement starts without a known keyword, then it’s a node statement, for example
(render-and-open-s-graphviz
(merge-pathnames
#p"images/node1.png"
(asdf:component-pathname (asdf:find-system :s-graphviz)))
'(:digraph nil
(node1 (:label "nice node") (:shape :box) (:fontname "Arial") (:fontcolor "#AA0000"))))
(defun format-node-stmt (stmt)
(let ((id-port (first stmt))
(attr-list (cdr stmt)))
(format-node-id id-port)
(format-attr-list attr-list)))node_id : ID [ port ]
In an S-expression, it can be a single id or a list contains both id and port.
(defun format-node-id (id-port)
(if (atom id-port)
(format-id id-port)
(let ((id (first id-port))
(port (second id-port)))
(format-id id)
(when port
(format-port port)))))edge_stmt : (node_id | subgraph) edgeRHS [ attr_list ]
edgeRHS : edgeop (node_id | subgraph) [ edgeRHS ]
In an S-expression, it’s a list that starts with an edgeop and an attr_list and
the rest are a list of node id, for example
(render-and-open-s-graphviz
(merge-pathnames
#p"images/edge1.png"
(asdf:component-pathname (asdf:find-system :s-graphviz)))
'(:digraph nil
(:-> ((arrowhead :diamond)
(color "#FF0000")
(headlabel "head\\nlabel")
(label "red edge")
(labelfontname "Arial")
(fontname "courier")
(arrowsize 2))
node1
node2
node3)))
(defun format-edge-stmt (stmt)
(let ((edge-op (first stmt))
(attr-list (second stmt))
(list-of-node-id (cddr stmt)))
(iter (initially (format-node-id (first list-of-node-id)))
(for left-nodes on (cdr list-of-node-id))
(format *dot-stream* " ~a " edge-op)
(format-node-id (car left-nodes)))
(format-attr-list attr-list)))attr_stmt : (graph | node | edge) attr_list
In an S-GRAPHVIZ S-expression, it starts with keyword :graph, :node, :edge , and the rest items
in the list is the ~attr_list~(ref:attr-list),for example:
(render-and-open-s-graphviz
(merge-pathnames
#p"images/node2.png"
(asdf:component-pathname (asdf:find-system :s-graphviz)))
'(:digraph nil
(:node
(:fillcolor "#AAFFAA")
(:shape :circle)
(:color "#0000AA")
(:style :filled)
(:fontsize 16))
(node1 (:id "a")(:label :test))))
(defun format-attr-stmt (stmt)
(format-id (car stmt))
(format-attr-list (cdr stmt)))a single attribute can be applied to global environment in a statement, in an S-GRAPHVIZ S-expression, it looks like this:
(render-and-open-s-graphviz
(merge-pathnames
#p"images/attr.png"
(asdf:component-pathname (asdf:find-system :s-graphviz)))
'(:digraph nil
(= :compound t)
(node1 (:id :test)(:label :test))))
(defun format-attribute (stmt)
(let ((key (second stmt))
(value (third stmt)))
(format-id key)
(write-string " = " *dot-stream*)
(format-id value)))It a subgraph’s name starts with “cluster”, then it has a special meaning. in an S-GRAPHVIZ S-expression, it looks like this:
(render-and-open-s-graphviz
(merge-pathnames
#p"images/cluster1.png"
(asdf:component-pathname (asdf:find-system :s-graphviz)))
'(:digraph nil
(:subgraph cluster_1
(node1 (:id :test)(:label :test))
(node2 (:id :test2)(:label :test2))
(:-> nil node1 node2))))
(defun format-subgraph-stmt (stmt)
(let ((id (second stmt))
(stmt-list (cddr stmt)))
(write-string "subgraph " *dot-stream*)
(when id
(format-id id))
(format-stmt-list stmt-list)))(defun format-id (id)
(typecase id
(string
;; To a string, we have to format it in `~a' to avoid escape special characters twice.
(write-char #\" *dot-stream*)
(format *dot-stream* "~a" id)
(write-char #\" *dot-stream*))
(t (cond ((eq id t)
(format *dot-stream* "true"))
((eq id nil)
(format *dot-stream* "false"))
(t
(format *dot-stream* "~(~a~)" id))))))Its BNF syntax is:
port : ':' ID [ ':' compass_pt ]
| ':' compass_pt
compass_pt : (n | ne | e | se | s | sw | w | nw | c | _)
In an S-GRAPHVIZ S-expression, it looks like this:
(render-and-open-s-graphviz
(merge-pathnames
#p"images/port.png"
(asdf:component-pathname (asdf:find-system :s-graphviz)))
'(:digraph nil
(:-> nil (node1 :e) (node2 :s))))
(defun format-port (port)
(write-string " : " *dot-stream*)
(cond ((atom port)
(format-id port))
(t
(let ((id (first port))
(compass-pt (second port)))
(format-id id)
(write-string " : " *dot-stream*)
(format-id compass-pt)))))label:attr-list
attr_list : '[' [ a_list ] ']' [ attr_list ]
a_list : ID '=' ID [ (';' | ',') ] [ a_list ]
In an S-expression, it is an association list like this:
((:label "a label") (:shape :box))(defun format-attr-list (attr-list)
(when attr-list
(iter (initially (format *dot-stream* " ["))
(for (key value) in attr-list)
(unless (first-iteration-p)
(write-string ", " *dot-stream*))
(format-id key)
(write-string " = " *dot-stream*)
(format-id value)
(finally (format *dot-stream* "]")))))Now it’s time to validate some functions. The FiveAM library is used to test.
(eval-when (:compile-toplevel :load-toplevel :execute)
(unless (find-package :fiveam)
#+quicklisp (ql:quickload :fiveam)
#-quicklisp (asdf:load-system :fiveam)))
(5am:def-suite s-graphviz-suite :description "The test suite of S-GRAPHVIZ.")
(5am:in-suite s-graphviz-suite)label:test-of-node-statement
(5am:test node-stmt
(5am:is (equal "digraph {
node1 [label = \"nice node\", shape = box, fontname = \"Arial\", fontcolor = \"#AA0000\"];
}"
(format-graph '(:digraph nil
(node1
(:label "nice node")
(:shape :box)
(:fontname "Arial")
(:fontcolor "#AA0000"))))))
)