1 ! Copyright (C) 2012 Alex Vondrak.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: calendar combinators compiler.units continuations
4 graphviz.dot images.viewer io.backend io.directories
5 io.encodings.latin1 io.encodings.utf8 io.files
6 io.files.temp io.files.unique io.launcher io.standard-paths
7 kernel locals make namespaces sequences summary system threads
8 unicode vocabs webbrowser 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-standard-login-path ] map-find drop ;
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 file-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 ] finally ;
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 ( ..a graph quot: ( ..a path -- ..b ) -- ..b )
120 "preview" ".dot" [| code-file |
121 "preview" preview-extension [| image-file |
122 graph code-file ?encoding write-dot
123 code-file image-file try-preview-command
125 ] cleanup-unique-file
126 ] cleanup-unique-file
127 ] with-temp-directory ; inline
131 : preview ( graph -- )
132 [ image. ] with-preview ;
134 : preview-window ( graph -- )
135 [ image-window ] with-preview ;
137 : preview-open ( graph -- )
138 [ open-item 1 seconds sleep ] with-preview ;
142 ! http://graphviz.org/content/output-formats
143 CONSTANT: standard-formats {
178 ! ! ! Canvas formats don't actually use path argument...
183 : define-graphviz-by-layout ( layout -- )
184 [ "graphviz.render" create-word ]
185 [ [ graphviz ] curry ] bi
186 ( graph path format -- )
189 : define-graphviz-by-format ( format -- )
191 dup standard-layouts member? [ "-file" append ] when
192 "graphviz.render" create-word
194 [ [ graphviz* ] curry ] bi
201 standard-layouts [ define-graphviz-by-layout ] each
202 standard-formats [ define-graphviz-by-format ] each
203 ] with-compilation-unit
205 os windows? [ "graphviz.render.windows" require ] when