1 ! Copyright (C) 2012 Alex Vondrak.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: accessors combinators compiler.units continuations
4 destructors graphviz.dot images.viewer io.backend
5 io.directories io.encodings.8-bit.latin1 io.encodings.utf8
6 io.files io.files.unique io.launcher io.standard-paths kernel
7 locals make namespaces parser sequences summary system
8 unicode.case vocabs words ;
13 ! "Layout Commands" from http://graphviz.org/Documentation.php
14 CONSTANT: standard-layouts {
26 SYMBOL: default-layout
27 "dot" default-layout set-global
29 SYMBOL: preview-format
30 "png" preview-format set-global
32 ERROR: unsupported-preview-format preview-format ;
34 M: unsupported-preview-format summary
35 drop "Unsupported preview format" ;
37 SYMBOL: graph-encoding
38 utf8 graph-encoding set-global
40 ERROR: unsupported-encoding graph-encoding ;
42 M: unsupported-encoding summary
43 drop "Must use utf8 or latin1 (match the graph's charset attribute)" ;
45 HOOK: default-graphviz-program os ( -- path/f )
47 M: object default-graphviz-program ( -- path/f )
48 standard-layouts [ find-in-path ] find nip ;
50 ERROR: cannot-find-graphviz-installation ;
52 M: cannot-find-graphviz-installation summary
53 drop "Cannot find Graphviz installation" ;
55 : ?default-graphviz-program ( -- path )
56 default-graphviz-program
57 [ cannot-find-graphviz-installation ] unless* ;
61 : try-graphviz-command ( path format layout -- )
63 ?default-graphviz-program ,
67 ] { } make try-output-process ;
69 : ?encoding ( -- encoding )
70 graph-encoding get-global
71 dup [ utf8? ] [ latin1? ] bi or
72 [ unsupported-encoding ] unless ;
74 : ?delete-file ( path -- )
75 dup exists? [ delete-file ] [ drop ] if ;
79 :: graphviz ( graph path format layout -- )
80 path normalize-path :> dot-file
82 graph dot-file ?encoding write-dot
83 dot-file format layout try-graphviz-command
85 [ dot-file ?delete-file ] [ ] cleanup ;
87 : graphviz* ( graph path format -- )
88 default-layout get-global graphviz ;
92 : try-preview-command ( from-path to-path -- )
94 ?default-graphviz-program ,
97 "-T" , preview-format get-global ,
98 "-K" , default-layout get-global ,
99 ] { } make try-output-process ;
101 ! Not only must Graphviz support the image format, but so must
104 : preview-extension ( -- extension )
105 preview-format get-global >lower {
110 { "jpeg" [ ".jpg" ] }
114 { "tiff" [ ".tif" ] }
115 [ unsupported-preview-format ]
118 :: with-preview ( graph quot: ( path -- ) -- )
119 "preview" ".dot" [| code-file |
120 "preview" preview-extension [| image-file |
121 graph code-file ?encoding write-dot
122 code-file image-file try-preview-command
123 image-file quot call( path -- )
124 ] cleanup-unique-file
125 ] cleanup-unique-file ;
129 : preview ( graph -- )
130 [ image. ] with-preview ;
132 : preview-window ( graph -- )
133 [ image-window ] with-preview ;
137 ! http://graphviz.org/content/output-formats
138 CONSTANT: standard-formats {
173 ! ! ! Canvas formats don't actually use path argument...
178 : define-graphviz-by-layout ( layout -- )
179 [ "graphviz.render" create-word ]
180 [ [ graphviz ] curry ] bi
181 ( graph path format -- )
184 : define-graphviz-by-format ( format -- )
186 dup standard-layouts member? [ "-file" append ] when
187 "graphviz.render" create-word
189 [ [ graphviz* ] curry ] bi
196 standard-layouts [ define-graphviz-by-layout ] each
197 standard-formats [ define-graphviz-by-format ] each
198 ] with-compilation-unit
200 os windows? [ "graphviz.render.windows" require ] when