diff options
| -rw-r--r-- | ccwl/graphviz.scm | 12 | ||||
| -rw-r--r-- | tests/graphviz.scm | 15 |
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") |