aboutsummaryrefslogtreecommitdiff
path: root/dump.scm
diff options
context:
space:
mode:
authorArun Isaac2021-12-13 18:35:20 +0530
committerArun Isaac2021-12-14 14:05:16 +0530
commit86d0968236ba3d44b327343d1597c77583a39355 (patch)
treef321fed4f443605eea905056fb25d3c54f260816 /dump.scm
parent85ed67f43136a03c38df587e2c8cddb55df68203 (diff)
downloadgn-transform-databases-86d0968236ba3d44b327343d1597c77583a39355.tar.gz
Take advantage of bug fixes in bleeding edge (ccwl graphviz).
* dump.scm (graph->dot): Delete function. (sxml->graphviz-html): Return a <html-string> object. (dump-schema): Use graph->dot from (ccwl graphviz).
Diffstat (limited to 'dump.scm')
-rwxr-xr-xdump.scm20
1 files changed, 3 insertions, 17 deletions
diff --git a/dump.scm b/dump.scm
index 4e3bb63..f0391ee 100755
--- a/dump.scm
+++ b/dump.scm
@@ -568,19 +568,6 @@ case-insensitive."
color-scheme
(1+ (min (floor-log1024 bytes) 3)))))
-;; This wrapper function is necessary to work around bugs in (ccwl
-;; graphviz) whereby backslashes in node labels are escaped as \\, and
-;; HTML strings are escaped incorrectly.
-(define (graph->dot graph)
- (put-string (current-output-port)
- (replace-substrings
- (call-with-output-string
- (cut (@@ (ccwl graphviz) graph->dot) graph <>))
- '(("\\\\" . "\\")
- ("\"<<" . "<<")
- (">>\"" . ">>")
- ("\\\"" . "\"")))))
-
(define (trigrams str)
"Return all trigrams in STR."
(if (< (string-length str) 3)
@@ -621,9 +608,8 @@ metric."
(cut sxml->xml tree <>)))
(define (sxml->graphviz-html tree)
- "Serialize sxml TREE to a graphviz HTML string. Return the
-serialized string."
- (string-append "<" (sxml->xml-string tree) ">"))
+ "Convert sxml TREE to a graphviz <html-string>, and return it."
+ ((@@ (ccwl graphviz) html-string) (sxml->xml-string tree)))
(define (dumped-table? table)
"Return non-#f if TABLE has been dumped. Else, return #f."
@@ -700,7 +686,7 @@ relations in TABLES."
(define (dump-schema db)
(let ((tables (tables db)))
- (graph->dot
+ ((@@ (ccwl graphviz) graph->dot)
((@@ (ccwl graphviz) graph) 'schema
#:nodes (map table->graphviz-node tables)
#:edges (tables->graphviz-edges tables)))))