summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--ccwl/graphviz.scm12
-rw-r--r--tests/graphviz.scm15
2 files changed, 26 insertions, 1 deletions
diff --git a/ccwl/graphviz.scm b/ccwl/graphviz.scm
index a505530..3aa3f2a 100644
--- a/ccwl/graphviz.scm
+++ b/ccwl/graphviz.scm
@@ -63,6 +63,12 @@ language."
"Construct <graph-node> object."
(make-graph-node name properties))
+(define-immutable-record-type <graph-port>
+ (graph-port node port)
+ graph-port?
+ (node graph-port-node)
+ (port graph-port-name))
+
(define-immutable-record-type <html-string>
(html-string str)
html-string?
@@ -120,10 +126,14 @@ language."
(define (serialize object)
"Serialize OBJECT according to graphviz dot syntax. OBJECT may a
-symbol, a string, or a <html-string> object."
+symbol, a string, a <graph-port> object, or a <html-string> object."
(cond
((symbol? object)
(serialize (symbol->string object)))
+ ((graph-port? object)
+ (string-append (serialize (graph-port-node object))
+ ":"
+ (serialize (graph-port-name object))))
;; Surround HTML strings in <>, and don't escape.
((html-string? object)
(format "<~a>" (html-string-underlying object)))
diff --git a/tests/graphviz.scm b/tests/graphviz.scm
index bb99edc..b61cc61 100644
--- a/tests/graphviz.scm
+++ b/tests/graphviz.scm
@@ -27,6 +27,9 @@
(define graph-node
(@@ (ccwl graphviz) graph-node))
+(define graph-port
+ (@@ (ccwl graphviz) graph-port))
+
(define html-string
(@@ (ccwl graphviz) html-string))
@@ -58,4 +61,16 @@
`((label . "foo\\lbar")))))
port))))
+(test-equal "serialize ports correctly"
+ "digraph foo {
+ foo:p1 -> bar:p2;
+}
+"
+ (call-with-output-string
+ (lambda (port)
+ (graph->dot
+ (graph 'foo
+ #:edges `((,(graph-port "foo" "p1") . ,(graph-port "bar" "p2"))))
+ port))))
+
(test-end "graphviz")