: watch-optimizer ( quot -- )
[ "" ] dip watch-optimizer* ;
+
+: ssa. ( quot -- ) test-ssa [ cfgviz preview ] each ;
+: flat. ( quot -- ) test-flat [ cfgviz preview ] each ;
+: regs. ( quot -- ) test-regs [ cfgviz preview ] each ;
+++ /dev/null
-unix
\ No newline at end of file
+++ /dev/null
-! Copyright (C) 2011 Alex Vondrak.
-! See http://factorcode.org/license.txt for BSD license.
-USING: accessors classes classes.tuple combinators kernel
-sequences strings summary words
-graphviz
-graphviz.attributes
-graphviz.ffi
-;
-IN: graphviz.builder
-
-! Errors
-
-ERROR: non-graph-error obj ;
-
-M: non-graph-error summary
- drop "build-alien must be applied to the root graph" ;
-
-
-ERROR: improper-statement-error obj ;
-
-M: improper-statement-error summary
- drop "Not a proper Graphviz statement" ;
-
-! Use FFI to construct Agraph_t equivalent of a graph object
-
-<PRIVATE
-
-GENERIC: (build-alien) ( Agraph_t* obj -- )
-
-M: object (build-alien) improper-statement-error ;
-
-! Attributes
-
-: build-alien-attr ( alien attr value -- alien )
- dup
- [ [ "" agsafeset drop ] 3keep 2drop ]
- [ 2drop ]
- if ; inline
-
-: build-alien-attrs ( alien attrs -- )
- [ class-of "slots" word-prop ] [ tuple>array rest ] bi
- [ [ name>> ] dip build-alien-attr ] 2each drop ;
-
-M: graph-attributes (build-alien)
- build-alien-attrs ;
-M: node-attributes (build-alien)
- [ agprotonode ] dip build-alien-attrs ;
-M: edge-attributes (build-alien)
- [ agprotoedge ] dip build-alien-attrs ;
-
-! Subgraphs
-
-: build-alien-subgraph ( alien-graph subgraph -- alien-subgraph )
- [ id>> agsubg dup ] [ statements>> ] bi
- [ (build-alien) ] with each ;
-
-M: subgraph (build-alien) build-alien-subgraph drop ;
-
-! Nodes
-
-M: node (build-alien)
- [ id>> agnode ]
- [ attributes>> build-alien-attrs ] bi ;
-
-! Edges
-
-GENERIC: build-alien-endpoint ( Agraph_t* obj -- alien )
-
-M: string build-alien-endpoint agnode ;
-M: subgraph build-alien-endpoint build-alien-subgraph ;
-
-: build-alien-endpoints ( Agraph_t* edge -- Agraph_t* tail head )
- [ dup ] dip
- [ tail>> build-alien-endpoint ]
- [ head>> build-alien-endpoint ] 2bi ;
-
-
-: node->node? ( tail head -- ? )
- [ string? ] [ string? ] bi* and ; inline
-
-: node->subg? ( tail head -- ? )
- [ string? ] [ subgraph? ] bi* and ; inline
-
-: subg->node? ( tail head -- ? )
- [ subgraph? ] [ string? ] bi* and ; inline
-
-: subg->subg? ( tail head -- ? )
- [ subgraph? ] [ subgraph? ] bi* and ; inline
-
-
-: node->node ( Agraph_t* tail head attrs -- Agraph_t* )
- [ dup ] 3dip
- [ agedge ] dip build-alien-attrs ;
-
-: node->subg ( Agraph_t* tail head attrs -- Agraph_t* )
- [ node->node ] curry with each-node ;
-
-: subg->node ( Agraph_t* tail head attrs -- Agraph_t* )
- [ node->node ] 2curry each-node ;
-
-: subg->subg ( Agraph_t* tail head attrs -- Agraph_t* )
- [ node->subg ] 2curry each-node ;
-
-
-M: edge (build-alien)
- [ build-alien-endpoints ] 2keep nip
- [ attributes>> ] [ tail>> ] [ head>> ] tri
- {
- { [ 2dup node->node? ] [ 2drop node->node ] }
- { [ 2dup node->subg? ] [ 2drop node->subg ] }
- { [ 2dup subg->node? ] [ 2drop subg->node ] }
- { [ 2dup subg->subg? ] [ 2drop subg->subg ] }
- } cond drop ;
-
-PRIVATE>
-
-! Main word
-
-GENERIC: build-alien ( Agraph_t* graph -- )
-
-M: graph build-alien statements>> [ (build-alien) ] with each ;
-
-M: object build-alien non-graph-error ;
+++ /dev/null
-unix
\ No newline at end of file
--- /dev/null
+! Copyright (C) 2012 Alex Vondrak.
+! See http://factorcode.org/license.txt for BSD license.
+USING: graphviz help.markup help.syntax kernel strings ;
+IN: graphviz.dot
+
+HELP: write-dot
+{ $values
+ { "graph" graph } { "path" "a pathname string" } { "encoding" "a character encoding" }
+}
+{ $description "Converts " { $snippet "graph" } " into its equivalent DOT code, saving the file to " { $snippet "path" } " using the given character " { $snippet "encoding" } "." } ;
+
+ARTICLE: "graphviz.dot" "Translating Factor graphs into DOT"
+"The " { $vocab-link "graphviz.dot" } " vocabulary implements a word to translate Factor " { $link graph } " objects into equivalent DOT code (see " { $url "http://graphviz.org/content/dot-language" } ")."
+{ $subsections write-dot }
+"Because the data structure of Factor " { $link graph } " objects so closely maps to the DOT language, the translation is straightforward. This also means that rendering Factor " { $link graph } "s using the " { $vocab-link "graphviz.render" } " vocabulary should generally work exactly as though you had written the DOT code to start with."
+$nl
+"However, there is one limitation. Though Graphviz documentation claims that there's no semantic difference between quoted and unquoted identifiers, there are a few cases that make a difference. " { $link write-dot } " will always quote identifiers, since it's the safest option:"
+{ $list
+"Quoting prevents clashes with builtin DOT keywords."
+"Quoting lets identifiers use whitespace."
+}
+$nl
+"But there are a couple things to keep in mind:"
+{ $list
+{ "Quotes in " { $link string } "s will be escaped (and null-terminators " { $snippet "\"\\0\"" } " removed), but otherwise Factor strings are printed as usual. So " { $snippet "\"a\\nb\"" } " will print a newline in the DOT code, not a literal 'backslash n'. This is handy anyway, because certain Graphviz layout engines will parse escape codes in DOT that Factor doesn't know about. For instance, to use the Graphviz escape sequence " { $snippet "\"\\l\"" } ", you have to use the Factor string " { $snippet "\"\\\\l\"" } "." }
+{ "Node port syntax doesn't work when node names are quoted. Instead, use the edge's " { $snippet "headport" } " and " { $snippet "tailport" } " attributes (see " { $vocab-link "graphviz.attributes" } ")." }
+{ "HTML-like labels, which must use angle brackets (" { $snippet "<...>" } ") instead of quotes (" { $snippet "\"...\"" } "), are currently unsupported." }
+}
+;
+
+ABOUT: "graphviz.dot"
--- /dev/null
+! Copyright (C) 2012 Alex Vondrak.
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors classes classes.tuple combinators formatting
+graphviz graphviz.attributes io io.files kernel namespaces
+sequences splitting strings words ;
+IN: graphviz.dot
+
+<PRIVATE
+
+GENERIC: dot. ( obj -- )
+
+! Graphviz docs claim that there's no semantic difference
+! between quoted & unquoted IDs, but quoting them is the safest
+! option in case there's a keyword clash, spaces in the ID,
+! etc. This does mean that HTML labels aren't supported, but
+! they don't seem to work using the Graphviz API anyway.
+: escape ( str -- str' )
+ "\"" split "\\\"" join
+ "\0" split "" join ;
+
+M: string dot. escape "\"%s\" " printf ;
+
+: id. ( obj -- ) id>> dot. ;
+
+M: sequence dot.
+ "{" print [ dot. ";" print ] each "}" print ;
+
+: statements. ( sub/graph -- ) statements>> dot. ;
+
+SYMBOL: edgeop
+
+: with-edgeop ( graph quot -- )
+ [
+ dup directed?>> "-> " "-- " ? edgeop
+ ] dip with-variable ; inline
+
+: ?strict ( graph -- graph )
+ dup strict?>> [ "strict " write ] when ;
+
+: (di)graph ( graph -- graph )
+ dup directed?>> "digraph " "graph " ? write ;
+
+M: graph dot.
+ ?strict (di)graph dup id. [ statements. ] with-edgeop ;
+
+M: subgraph dot.
+ "subgraph " write [ id. ] [ statements. ] bi ;
+
+: attribute, ( attr value -- )
+ dup [ "%s=\"%s\"," printf ] [ 2drop ] if ;
+
+: attributes. ( attrs -- )
+ "[" write
+ [ class-of "slots" word-prop ] [ tuple>array rest ] bi
+ [ [ name>> ] dip attribute, ] 2each
+ "]" write ;
+
+M: graph-attributes dot. "graph" write attributes. ;
+M: node-attributes dot. "node" write attributes. ;
+M: edge-attributes dot. "edge" write attributes. ;
+
+M: node dot.
+ [ id. ] [ attributes>> attributes. ] bi ;
+
+M: edge dot.
+ {
+ [ tail>> dot. ]
+ [ drop edgeop get write ]
+ [ head>> dot. ]
+ [ attributes>> attributes. ]
+ } cleave ;
+
+PRIVATE>
+
+: write-dot ( graph path encoding -- )
+ [ dot. ] with-file-writer ;
+++ /dev/null
-! Copyright (C) 2011 Alex Vondrak.
-! See http://factorcode.org/license.txt for BSD license.
-USING: arrays help.markup help.syntax kernel math quotations strings ;
-IN: graphviz.ffi
-
-HELP: ffi-errors
-{ $values
- { "n" number }
-}
-{ $error-description "Thrown by " { $link gvFreeContext } " if the low-level Graphviz libraries (" { $emphasis "libgraph" } " and " { $emphasis "libgvc" } ") encountered one or more errors (specifically " { $slot "n" } " of them) while rendering. The C libraries themselves may print specific error messages to the standard error stream (see " { $url "http://graphviz.org/pdf/libguide.pdf" } "), but these messages will not be captured by " { $vocab-link "graphviz.ffi" } "." } ;
-
-{ supported-engines supported-formats } related-words
-
-HELP: supported-engines
-{ $values
- { "seq" array }
-}
-{ $description "An " { $link array } " of " { $link string } "s representing all valid " { $emphasis "layout engines" } ". For example, the " { $emphasis "dot" } " engine is typically included in a Graphviz installation, so " { $snippet "\"dot\"" } " will be an element of " { $link supported-engines } ". See " { $url "http://graphviz.org/Documentation.php" } " for more details." }
-{ $notes "This constant's definition is determined at parse-time by asking the system's Graphviz installation what engines are supported." }
-;
-
-HELP: supported-formats
-{ $values
- { "seq" array }
-}
-{ $description "An " { $link array } " of " { $link string } "s representing all valid " { $emphasis "layout formats" } ". For example, Graphviz can typically render using the Postscript format, in which case " { $snippet "\"ps\"" } " will be an element of " { $link supported-formats } ". See " { $url "http://graphviz.org/Documentation.php" } " for more details." }
-{ $notes "This constant's definition is determined at parse-time by asking the system's Graphviz installation what formats are supported."
-$nl
-"The Graphviz " { $emphasis "plugin" } " mechanism is not supported, so formats with colons like " { $snippet "\"png:cairo:gd\"" } " are not recognized."
-}
-;
-
-ARTICLE: "graphviz.ffi" "Graphviz C library interface"
-"The " { $vocab-link "graphviz.ffi" } " vocabulary defines words that interface with the low-level Graphviz libraries " { $emphasis "libgraph" } " and " { $emphasis "libgvc" } ", which should come installed with Graphviz."
-$nl
-"User code shouldn't call these words directly. Instead, use the " { $vocab-link "graphviz.render" } " vocabulary."
-$nl
-"User code may, however, encounter the following words exported from the " { $vocab-link "graphviz.ffi" } " vocabulary:"
-{ $subsections ffi-errors supported-engines supported-formats }
-
-{ $curious "Graphviz has documentation for " { $emphasis "libgraph" } " and " { $emphasis "libgvc" } " at " { $url "http://graphviz.org/pdf/libguide.pdf" } "." }
-;
-
-ABOUT: "graphviz.ffi"
+++ /dev/null
-! Copyright (C) 2011 Alex Vondrak.
-! See http://factorcode.org/license.txt for BSD license.
-USING: accessors alien alien.c-types alien.data
-alien.destructors alien.libraries alien.strings alien.syntax
-combinators debugger destructors fry graphviz io
-io.encodings.ascii kernel libc literals locals math memoize
-prettyprint sequences specialized-arrays splitting system ;
-SPECIALIZED-ARRAY: void*
-IN: graphviz.ffi
-
-<<
-"libgraph" {
- { [ os macosx? ] [ "libgraph.dylib" ] }
- { [ os unix? ] [ "libgraph.so" ] }
- { [ os windows? ] [ "graph.dll" ] }
-} cond cdecl add-library
-
-"libgvc"
-{
- { [ os macosx? ] [ "libgvc.dylib" ] }
- { [ os unix? ] [ "libgvc.so" ] }
- { [ os windows? ] [ "gvc.dll" ] }
-} cond cdecl add-library
->>
-
-LIBRARY: libgraph
-
-! Types
-
-C-TYPE: Agraph_t
-C-TYPE: Agnode_t
-C-TYPE: Agedge_t
-
-! Graphs & subgraphs
-
-FUNCTION: Agraph_t* agopen ( c-string name, int kind ) ;
-FUNCTION: Agraph_t* agsubg ( Agraph_t* g, c-string name ) ;
-FUNCTION: void agclose ( Agraph_t* g ) ;
-
-DESTRUCTOR: agclose
-
-: kind ( graph -- magic-constant )
- [ directed?>> ] [ strict?>> ] bi
- [ 3 2 ? ] [ 1 0 ? ] if ;
-
-! Nodes
-
-FUNCTION: Agnode_t* agnode ( Agraph_t* g, c-string name ) ;
-FUNCTION: Agnode_t* agfstnode ( Agraph_t* g ) ;
-FUNCTION: Agnode_t* agnxtnode ( Agraph_t* g, Agnode_t* n ) ;
-
-<PRIVATE
-
-: next-node ( g n -- g n' )
- [ dup ] dip agnxtnode ; inline
-
-: (each-node) ( Agraph_t* Agnode_t* quot -- )
- '[ [ nip @ ] 2keep next-node dup ] loop 2drop ; inline
-
-PRIVATE>
-
-: each-node ( Agraph_t* quot -- )
- [ dup agfstnode ] dip
- over [ (each-node) ] [ 3drop ] if ; inline
-
-! Edges
-
-FUNCTION: Agedge_t* agedge ( Agraph_t* g,
- Agnode_t* t,
- Agnode_t* h ) ;
-
-! Attributes
-
-FUNCTION: Agnode_t* agprotonode ( Agraph_t* g ) ;
-FUNCTION: Agedge_t* agprotoedge ( Agraph_t* g ) ;
-
-FUNCTION: c-string agget ( void* obj, c-string name ) ;
-
-FUNCTION: int agsafeset ( void* obj,
- c-string name,
- c-string value,
- c-string default ) ;
-
-
-LIBRARY: libgvc
-
-! Graphviz contexts
-
-C-TYPE: GVC_t
-
-FUNCTION: GVC_t* gvContext ( ) ;
-
-<PRIVATE
-
-FUNCTION-ALIAS: int-gvFreeContext
- int gvFreeContext ( GVC_t* gvc ) ;
-
-PRIVATE>
-
-ERROR: ffi-errors n ;
-M: ffi-errors error.
- "Graphviz FFI indicates that " write
- n>> pprint
- " error(s) occurred while rendering." print
- "(The messages were probably printed to STDERR.)" print ;
-
-: ?ffi-errors ( n -- )
- [ ffi-errors ] unless-zero ; inline
-
-: gvFreeContext ( gvc -- )
- int-gvFreeContext ?ffi-errors ;
-
-DESTRUCTOR: gvFreeContext
-
-! Layout
-
-FUNCTION: int gvLayout ( GVC_t* gvc,
- Agraph_t* g,
- c-string engine ) ;
-FUNCTION: int gvFreeLayout ( GVC_t* gvc, Agraph_t* g ) ;
-
-! Rendering
-
-FUNCTION: int gvRenderFilename ( GVC_t* gvc,
- Agraph_t* g,
- c-string format,
- c-string filename ) ;
-
-! Supported layout engines (dot, neato, etc.) and output
-! formats (png, jpg, etc.)
-<PRIVATE
-
-ENUM: api_t
-API_render
-API_layout
-API_textlayout
-API_device
-API_loadimage ;
-
-! This function doesn't exist on the Linux mason in Graphviz 2.28
-FUNCTION: char**
- gvPluginList
- ( GVC_t* gvc, c-string kind, int* size, c-string str ) ;
-
-:: Plugin-list ( kind-string -- seq )
- [
- gvContext &gvFreeContext
- kind-string
- 0 int <ref> dup :> size*
- f
- gvPluginList &(free) :> ret
- size* int deref :> size
- ret size void* <c-direct-array> [
- &(free) ascii alien>string
- ] { } map-as
- ] with-destructors ;
-
-! This function doesn't exist on the Windows mason in Graphviz 2.28
-FUNCTION: c-string
- gvplugin_list
- ( GVC_t* gvc, api_t api, c-string str ) ;
-
-: plugin-list ( API_t -- seq )
- '[
- gvContext &gvFreeContext _ "" gvplugin_list
- " " split harvest
- ] with-destructors ;
-
-PRIVATE>
-
-MEMO: supported-engines ( -- seq ) API_layout plugin-list ;
-MEMO: supported-formats ( -- seq ) API_device plugin-list ;
-
+++ /dev/null
-unix
\ No newline at end of file
$nl
-"In " { $emphasis "strict" } " " { $link graph } "s, there is at most one " { $link edge } " between any two " { $link node } "s, so duplicates are ignored while rendering. See " { $vocab-link "graphviz.render" } " for more information."
+"In " { $emphasis "strict" } " " { $link graph } "s, there is at most one " { $link edge } " between any two " { $link node } "s, so duplicates are ignored by Graphviz."
}
{ $examples
{ $example "USING: graphviz prettyprint ;" "<strict-digraph> graph? ." "t" }
$nl
-"In " { $emphasis "strict" } " " { $link graph } "s, there is at most one " { $link edge } " between any two " { $link node } "s, so duplicates are ignored while rendering. See " { $vocab-link "graphviz.render" } " for more information."
+"In " { $emphasis "strict" } " " { $link graph } "s, there is at most one " { $link edge } " between any two " { $link node } "s, so duplicates are ignored by Graphviz."
}
{ $examples
{ $example "USING: graphviz prettyprint ;" "<strict-graph> graph? ." "t" }
{ "edge from each node in " { $slot "tail" } "\nto each node in " { $slot "head" } }
}
}
-"For more details, see " { $vocab-link "graphviz.render" } "."
$nl
"In addition, an " { $link edge } " may store local attributes in its " { $slot "attributes" } " slot (" { $instance edge-attributes } " tuple)."
}
HELP: node
{ $class-description
-"Represents a single Graphviz node. Each " { $link node } " is uniquely determined by an " { $slot "id" } " (" { $instance string } ") and may have per-node attributes stored in its " { $slot "attributes" } " slot (" { $instance node-attributes } " tuple)." ! TODO see graphviz.attributes
+"Represents a single Graphviz node. Each " { $link node } " is uniquely determined by an " { $slot "id" } " (" { $instance string } ") and may have per-node attributes stored in its " { $slot "attributes" } " slot (" { $instance node-attributes } " tuple)."
} ;
HELP: subgraph
} ;
ARTICLE: { "graphviz" "data" } "Graphviz data structures"
-"To use the " { $vocab-link "graphviz" } " vocabulary, we construct Factor objects that can be converted to data understood by Graphviz (specifically, that " { $emphasis "libgraph" } " and " { $emphasis "libgvc" } " can understand; see " { $vocab-link "graphviz.ffi" } ")."
+"To use the " { $vocab-link "graphviz" } " vocabulary, we construct Factor objects that can be converted to data understood by Graphviz (see " { $vocab-link "graphviz.dot" } ")."
$nl
"The following classes are used to represent their equivalent Graphviz structures:"
{ $subsections node edge subgraph graph }
-USING: arrays formatting graphviz graphviz.ffi
-graphviz.notation graphviz.render graphviz.render.private
-io.directories io.files io.files.unique kernel locals math
-math.combinatorics math.parser sequences sets tools.test ;
-IN: graphviz.testing
-
-! Don't want to test canvas formats, since they'll open a
-! separate window (even if it's closed, that'll call exit() and
-! kill the Factor process).
-!
-! In fact, the exit() issue is why we probably don't even want
-! these formats supported in general, and why we have
-! graphviz.render:preview & preview-window. Should probably
-! gank them out of supported-formats in graphviz.ffi to begin
-! with.
-CONSTANT: canvas { "gtk" "x11" "xlib" }
-
-! Had some issues with the following formats. Graphviz 2.26.3
-! would die with "Error: deflation finish problem -2 cnt=0".
-! Could just be my installation, though.
-CONSTANT: zlib { "svgz" "vmlz" }
-
-! These are aliases for the neato flags -n/-n1/-n2, which
-! assume that all nodes have already been positioned, and thus
-! have "pos" attributes. Since this clearly isn't always the
-! case for our tests, we skip them to avoid useless rendering
-! errors.
-CONSTANT: neato-aliases { "nop" "nop1" "nop2" }
+USING: accessors arrays assocs combinators.short-circuit
+continuations formatting graphviz graphviz.attributes
+graphviz.dot graphviz.notation graphviz.render
+graphviz.render.private images.loader.private io.directories
+io.directories.hierarchy io.files io.files.unique io.launcher
+io.pathnames kernel locals make math math.combinatorics
+math.parser memoize namespaces sequences sequences.extras sets
+splitting system tools.test ;
+FROM: namespaces => set ;
+IN: graphviz.tests
+
+! XXX hack
+: force-error-message ( flag -- elts )
+ [
+ [ default-graphviz-program , , "?" , ] { } make
+ try-output-process
+ ! To balance the stack height, have to return a default
+ ! 'elts' value, though it shouldn't ever get pushed:
+ f
+ ] [
+ nip output>>
+ "Use one of: " split1 nip "\n" ?tail drop
+ " " split
+ ] recover ;
+
+! http://www.graphviz.org/Download_macos.php#comment-474
+: remove-sfdp-in-case-homebrew-is-dumb ( seq -- seq' )
+ os macosx? [ "sfdp" swap remove ] when ;
+
+SYMBOLS: supported-layouts supported-formats ;
+
+: init-supported-layouts/formats ( -- )
+ "-K" force-error-message standard-layouts intersect
+ remove-sfdp-in-case-homebrew-is-dumb
+ supported-layouts set-global
+
+ "-T" force-error-message standard-formats intersect
+ supported-formats set-global ;
+
+! Can't use cleanup-unique-working-directory without fixing
+! issue #890, so skip the cleanup on Windows.
+:: cleanup-unique-working-directory* ( quot -- )
+ unique-directory :> path
+ path [ path quot with-temporary-directory ] with-directory
+ os windows? [ path delete-tree ] unless ; inline
+
+! Can't predict file extension since we use Graphviz's actual
+! -O flag, so just look to see that there seems to be some sort
+! of output.
+: graphviz-output-appears-to-exist? ( base -- ? )
+ current-directory get directory-files
+ [ swap head? ] with count 1 = ;
+
+: next! ( seq -- elt ) [ first ] [ 1 rotate! ] bi ;
:: smoke-test ( graph -- pass? )
- temporary-file :> -O
- supported-formats canvas diff zlib diff [| -T |
- supported-engines neato-aliases diff [| -K |
- graph -O -T -K (graphviz)
- [ exists? ] [ delete-file ] bi
- ] all?
- ] all? ;
+ supported-formats get-global next! :> -T
+ supported-layouts get-global next! :> -K
+ [
+ graph "smoke-test" -T -K graphviz
+ "smoke-test" graphviz-output-appears-to-exist?
+ ] cleanup-unique-working-directory* ;
+
+: preview-smoke-test ( graph -- pass? )
+ f "pass?" [
+ [ exists? "pass?" set ] with-preview
+ "pass?" get
+ ] with-variable ;
: K_n ( n -- graph )
<graph>
over number>string "K " prepend =label
swap iota 2 [ first2 add-edge ] each-combination ;
-{ t } [ 5 K_n smoke-test ] unit-test
-{ t } [ 6 K_n smoke-test ] unit-test
-{ t } [ 7 K_n smoke-test ] unit-test
-
:: partite-set ( n color -- cluster )
color <cluster>
color =color
add-edge
n m "K %d,%d" sprintf =label ;
-{ t } [ 3 3 K_n,m smoke-test ] unit-test
-{ t } [ 3 4 K_n,m smoke-test ] unit-test
-{ t } [ 5 4 K_n,m smoke-test ] unit-test
-
: add-cycle ( graph n -- graph' )
[ iota add-path ] [ 1 - 0 add-edge ] bi ;
over number>string "C " prepend =label
swap add-cycle ;
-{ t } [ 5 C_n smoke-test ] unit-test
-{ t } [ 6 C_n smoke-test ] unit-test
-{ t } [ 7 C_n smoke-test ] unit-test
-
: W_n ( n -- graph )
<graph>
graph[ "t" =labelloc "twopi" =layout ];
over 1 - add-cycle
swap [ ] [ 1 - iota >array ] bi add-edge ;
-{ t } [ 6 W_n smoke-test ] unit-test
-{ t } [ 7 W_n smoke-test ] unit-test
-{ t } [ 8 W_n smoke-test ] unit-test
-
: cluster-example ( -- graph )
<digraph>
"dot" =layout
"end" add-node[ "Msquare" =shape ];
;
-{ t } [ cluster-example smoke-test ] unit-test
-
: colored-circle ( i -- node )
[ <node> ] keep
[ 16.0 / 0.5 + =width ]
[ 0 -- ] [ colored-circle add ] bi
] each ;
-{ t } [ colored-circles-example smoke-test ] unit-test
-
: dfa-example ( -- graph )
<digraph>
"LR" =rankdir
"LR_8" "LR_5" ->[ "S(a)" =label ];
;
-{ t } [ dfa-example smoke-test ] unit-test
-
: record-example ( -- graph )
<digraph>
graph[ "LR" =rankdir "8,8" =size ];
"node11" "node1" ->[ "f2" =tailport "f0" =headport ];
;
-{ t } [ record-example smoke-test ] unit-test
+:: with-global-value ( value variable quot -- )
+ variable get-global "orig" [
+ [ value variable set-global quot call ]
+ [ "orig" get variable set-global ] [ ] cleanup
+ ] with-variable ; inline
+
+: preview-format-test ( format -- pass? )
+ preview-format [
+ <graph> preview-smoke-test
+ ] with-global-value ;
+
+: valid-preview-formats ( -- formats )
+ types get keys "jpe" suffix
+ supported-formats get-global intersect ;
+
+: encoding-test ( encoding -- pass? )
+ graph-encoding [ <graph> smoke-test ] with-global-value ;
+
+default-graphviz-program [
+
+ init-supported-layouts/formats
+
+ { t } [ 5 K_n smoke-test ] unit-test
+ { t } [ 6 K_n smoke-test ] unit-test
+ { t } [ 7 K_n smoke-test ] unit-test
+ { t } [ 8 K_n preview-smoke-test ] unit-test
+
+ { t } [ 8 6 K_n,m smoke-test ] unit-test
+ { t } [ 7 5 K_n,m smoke-test ] unit-test
+ { t } [ 3 9 K_n,m smoke-test ] unit-test
+ { t } [ 3 4 K_n,m preview-smoke-test ] unit-test
+
+ { t } [ 5 C_n smoke-test ] unit-test
+ { t } [ 6 C_n smoke-test ] unit-test
+ { t } [ 7 C_n smoke-test ] unit-test
+ { t } [ 8 C_n preview-smoke-test ] unit-test
+
+ { t } [ 5 W_n smoke-test ] unit-test
+ { t } [ 6 W_n smoke-test ] unit-test
+ { t } [ 7 W_n smoke-test ] unit-test
+ { t } [ 8 W_n preview-smoke-test ] unit-test
+
+ { t } [ cluster-example smoke-test ] unit-test
+ { t } [ cluster-example preview-smoke-test ] unit-test
+
+ { t } [ colored-circles-example smoke-test ] unit-test
+ { t } [ colored-circles-example preview-smoke-test ] unit-test
+
+ { t } [ dfa-example smoke-test ] unit-test
+ { t } [ dfa-example preview-smoke-test ] unit-test
+
+ { t } [ record-example smoke-test ] unit-test
+ { t } [ record-example preview-smoke-test ] unit-test
+
+ { t } [
+ valid-preview-formats [ preview-format-test ] all?
+ ] unit-test
+
+ [
+ supported-formats get-global valid-preview-formats diff
+ [ preview-format-test ] attempt-all
+ ] [ unsupported-preview-format? ] must-fail-with
+
+ { t }
+ [
+ USE: io.encodings.8-bit.latin1
+ latin1 encoding-test
+ ] unit-test
+
+ { t }
+ [
+ USE: io.encodings.utf8
+ utf8 encoding-test
+ ] unit-test
+
+ [
+ USE: io.encodings.ascii
+ ascii encoding-test
+ ] [ unsupported-encoding? ] must-fail-with
-! TODO add the examples from graphviz's source code (the .gv
-! files in graphs/directed/ and graphs/undirected/)
+] when
$nl
"For example, since " { $link graph-attributes } " has a " { $slot "label" } " slot, the generic " { $link =label } " is defined, along with methods so that if " { $snippet "graphviz-obj" } " is a..."
{ $list
- { "..." { $link graph } " or " { $link subgraph } ", a new " { $link graph-attributes } " instance is created, has its " { $slot "label" } " slot is set to " { $snippet "val" } ", and is " { $link add } "ed to " { $snippet "graphviz-obj" } "." }
+ { "..." { $link graph } " or " { $link subgraph } ", a new " { $link graph-attributes } " instance is created, has its " { $slot "label" } " slot set to " { $snippet "val" } ", and is " { $link add } "ed to " { $snippet "graphviz-obj" } "." }
{ "..." { $link graph-attributes } " instance, its " { $slot "label" } " slot is set to " { $snippet "val" } "." }
}
$nl
+++ /dev/null
-unix
\ No newline at end of file
+++ /dev/null
-unix
\ No newline at end of file
+++ /dev/null
-unix
\ No newline at end of file
-! Copyright (C) 2011 Alex Vondrak.
+! Copyright (C) 2012 Alex Vondrak.
! See http://factorcode.org/license.txt for BSD license.
-USING: graphviz graphviz.attributes graphviz.builder
-graphviz.ffi help.markup help.syntax images.viewer kernel
+USING: graphviz help.markup help.syntax images.viewer
+io.encodings.8-bit.latin1 io.encodings.utf8 io.launcher kernel
strings ;
IN: graphviz.render
-HELP: default-format
-{ $var-description "Holds a " { $link string } " representing the implicit output format for certain words in the " { $vocab-link "graphviz.render" } " vocabulary." }
-{ $see-also graphviz graphviz* preview preview-window default-layout }
-;
+{ cannot-find-graphviz-installation default-graphviz-program ?default-graphviz-program } related-words
+{ unsupported-encoding graph-encoding } related-words
+{ unsupported-preview-format preview-format } related-words
+{ graphviz graphviz* } related-words
+{ preview preview-window } related-words
+{ circo dot fdp neato osage sfdp twopi } related-words
+{ bmp canon dot-file xdot cmap eps fig gd gd2 gif ico imap cmapx imap_np cmapx_np ismap jpg jpeg jpe pdf plain plain-ext png ps ps2 svg svgz tif tiff vml vmlz vrml wbmp webp } related-words
+
+HELP: cannot-find-graphviz-installation
+{ $error-description "Thrown by " { $link ?default-graphviz-program } " if a Graphviz installation cannot be found." } ;
+
+HELP: unsupported-encoding
+{ $values
+ { "graph-encoding" "a character encoding" }
+}
+{ $error-description "Thrown by " { $links graphviz graphviz* preview preview-window } ", and related words if " { $link graph-encoding } " has a value other than " { $link utf8 } " or " { $link latin1 } "." } ;
+
+HELP: unsupported-preview-format
+{ $values
+ { "preview-format" string }
+}
+{ $error-description "Thrown by " { $link preview } " or " { $link preview-window } " if " { $link preview-format } " has a value that's not supported by " { $vocab-link "images.loader" } "." } ;
+
+HELP: ?default-graphviz-program
+{ $values
+ { "path" "a pathname string" }
+}
+{ $description "Searches your computer for the path to a Graphviz executable." }
+{ $errors "Throws an error if a Graphviz installation cannot be found." } ;
+
+HELP: default-graphviz-program
+{ $values
+ { "path/f" { $maybe "a pathname string" } }
+}
+{ $description "Searches your computer for the path to a Graphviz executable. If one cannot be found, returns " { $link f } "."
+$nl
+"On a Unix machine, this involves looking for " { $snippet "circo" } ", " { $snippet "dot" } ", " { $snippet "fdp" } ", " { $snippet "neato" } ", " { $snippet "osage" } ", " { $snippet "sfdp" } ", or " { $snippet "twopi" } " somewhere in your " { $snippet "PATH" } "."
+$nl
+"On Windows, if you have Graphviz installed into a folder whose name begins with " { $snippet "Graphviz" } " in either " { $snippet "Program Files" } " or " { $snippet "Program Files(x86)" } ", that folder will be searched for an executable named " { $snippet "circo.exe" } ", " { $snippet "dot.exe" } ", " { $snippet "fdp.exe" } ", " { $snippet "neato.exe" } ", " { $snippet "osage.exe" } ", " { $snippet "sfdp.exe" } ", or " { $snippet "twopi.exe" } "."
+} ;
HELP: default-layout
-{ $var-description "Holds a " { $link string } " representing the implicit layout engine for certain words in the " { $vocab-link "graphviz.render" } " vocabulary." }
-{ $see-also graphviz graphviz* preview preview-window default-format }
-;
+{ $var-description "A " { $link string } " representing the layout engine implicitly used by " { $links graphviz* preview preview-window } ", and related words." }
+{ $notes "Must be an image format supported by " { $vocab-link "images.loader" } "." } ;
-{ graphviz graphviz* } related-words
+HELP: graph-encoding
+{ $var-description "The character encoding used when writing " { $instance graph } " to a DOT file." }
+{ $notes "To match Graphviz's valid values for a graph's " { $snippet "charset" } " attribute (see " { $url "http://graphviz.org/content/attrs#dcharset" } "), this global variable must either be " { $link utf8 } " or " { $link latin1 } ". If it does not match your graph's " { $snippet "charset" } ", your output may be incorrect." } ;
+
+HELP: preview-format
+{ $var-description "A " { $link string } " representing the output format implicitly used by " { $link preview } " and " { $link preview-window } "." } ;
HELP: graphviz
{ $values
- { "graph" graph }
- { "-O" string }
- { "-T" string }
- { "-K" { $maybe string } }
+ { "graph" graph } { "path" "a pathname string" } { "format" string } { "layout" string }
}
-{ $description "Renders " { $snippet "graph" } " to a specified output file."
+{ $description "Translates " { $snippet "graph" } " into DOT code and invokes Graphviz on the result."
$nl
-{ $snippet "-O" } " is similar to the command-line argument of the standard Graphviz commands (see " { $url "http://graphviz.org/content/command-line-invocation" } "). It specifies the base name of the " { $strong "o" } "utput file. Like Graphviz tools, the proper extension (if one is known) is automatically added to the file name based on " { $snippet "-T" } "."
+{ $snippet "path" } " is the location where you want to save your output, " { $emphasis "without" } " a file extension (Graphviz will automatically add one based on " { $snippet "format" } ")."
$nl
-{ $snippet "-T" } " specifies the output format " { $strong "t" } "ype (which must be a member of " { $link supported-formats } "). This is, again, akin to the command-line flag in standard Graphviz commands."
+{ $snippet "format" } " is the format of your output (e.g., " { $snippet "\"png\"" } ")."
$nl
-{ $snippet "-K" } " specifies the layout engine. If " { $snippet "-K" } " is " { $link f } ", then " { $snippet "graph" } " is checked for a " { $slot "layout" } " attribute (see " { $link graph-attributes } ") and that engine is used; if no such attribute is set, then " { $link default-layout } " is used. Regardless, the resulting engine must be a member of " { $link supported-engines } "."
-}
-{ $errors
-"If " { $snippet "graph" } " is not an instance of " { $link graph } ", a " { $link non-graph-error } " is thrown."
+{ $snippet "layout" } " is the layout engine to use (e.g., " { $snippet "\"dot\"" } ")."
$nl
-"An " { $link improper-statement-error } " is thrown if any element of " { $snippet "graph" } "'s " { $snippet "statements" } " slot is not an instance of:"
-{ $list
- { $link subgraph }
- { $link node }
- { $link edge }
- { $link graph-attributes }
- { $link node-attributes }
- { "or " { $link edge-attributes } }
+"Essentially, you can think of it as equivalent to running the Graphviz command \"" { $strong "dot" } " " { $snippet "path" } " " { $strong "-O" } " " { $strong "-T" } { $snippet "format" } " " { $strong "-K" } { $snippet "layout" } "\". See " { $url "http://graphviz.org/content/command-line-invocation" } "."
}
+{ $errors
+"If the Graphviz process encounters an error, its output will be captured and thrown as " { $instance output-process-error } " by Factor."
$nl
-"If " { $snippet "-K" } " (or the inferred layout engine) is not a member of " { $link supported-engines } ", an " { $link unsupported-engine } " error is thrown."
-$nl
-"If " { $snippet "-T" } " is not a member of " { $link supported-formats } ", an " { $link unsupported-format } " error is thrown."
+"Throws " { $instance unsupported-encoding } " error if " { $link graph-encoding } " isn't one of " { $link utf8 } " or " { $link latin1 } "."
}
-{ $examples "To render a " { $link graph } " " { $snippet "G" } " using " { $emphasis "circo" } " and save the output to a PNG file, we could write" { $code "G \"foo\" \"png\" \"circo\" graphviz" } "(assuming " { $emphasis "circo" } " and PNG are supported by your Graphviz installation). This will save the output to the file " { $snippet "foo.png" } "." }
-;
+{ $examples "To render a " { $link graph } " " { $snippet "G" } " using circo and save the output to a PNG file, you could write" { $code "G \"foo\" \"png\" \"circo\" graphviz" } "(assuming circo and PNG are supported by your Graphviz installation). This will save the output to the file " { $snippet "foo.png" } "." } ;
HELP: graphviz*
{ $values
- { "graph" graph }
- { "-O" string }
- { "-T" string }
-}
-{ $description "Renders " { $snippet "graph" } " to a specified output file (" { $snippet "-O" } ") with the specified format type (" { $snippet "-T" } ") using the " { $link default-layout } " (or " { $snippet "graph" } "'s " { $snippet "layout" } " attribute, if set). That is, the following two lines are equivalent:"
-{ $code "-O -T f graphviz" "-O -T graphviz*" }
+ { "graph" graph } { "path" "a pathname string" } { "format" string }
}
-{ $errors
-"If " { $snippet "graph" } " is not an instance of " { $link graph } ", a " { $link non-graph-error } " is thrown."
-$nl
-"An " { $link improper-statement-error } " is thrown if any element of " { $snippet "graph" } "'s " { $snippet "statements" } " slot is not an instance of:"
-{ $list
- { $link subgraph }
- { $link node }
- { $link edge }
- { $link graph-attributes }
- { $link node-attributes }
- { "or " { $link edge-attributes } }
-}
-$nl
-"If the inferred layout engine is not a member of " { $link supported-engines } ", an " { $link unsupported-engine } " error is thrown."
-$nl
-"If " { $snippet "-T" } " is not a member of " { $link supported-formats } ", an " { $link unsupported-format } " error is thrown."
+{ $description "Invokes the " { $link graphviz } " word using the value of " { $link default-layout } " as the layout engine. That is, the following two lines are equivalent:"
+{ $code "graph path format default-layout get-global graphviz" "graph path format graphviz*" }
}
-{ $examples "To render a " { $link graph } " " { $snippet "G" } " when we don't particularly care about the engine but want to save the output to a PNG file, we could write" { $code "G \"foo\" \"png\" graphviz*" } "(assuming the inferred layout and PNG are supported by your Graphviz installation). This will save the output to the file " { $snippet "foo.png" } "." }
-;
+{ $examples "To render a " { $link graph } " " { $snippet "G" } " when you don't particularly care about the layout engine but want to save the output to a PNG file, you could write" { $code "G \"foo\" \"png\" graphviz*" } "(assuming that " { $link default-layout } " and PNG are supported by your Graphviz installation). This will save the output to the file " { $snippet "foo.png" } "." } ;
HELP: preview
{ $values
{ "graph" graph }
}
-{ $description "Renders " { $snippet "graph" } " to a temporary file of the " { $link default-format } " (assumed to be an image format) using the " { $link default-layout } " (or, if specified, the engine set as the graph's " { $slot "layout" } " attribute). Then, using the " { $vocab-link "images.viewer" } " vocabulary, displays the image in the UI listener." }
+{ $description "Renders " { $snippet "graph" } " to a temporary file using " { $link preview-format } " and " { $link default-layout } ". Then, using " { $link image. } ", displays the image in the UI listener before deleting the temporary file." }
{ $errors
-"If " { $snippet "graph" } " is not an instance of " { $link graph } ", a " { $link non-graph-error } " is thrown."
-$nl
-"An " { $link improper-statement-error } " is thrown if any element of " { $snippet "graph" } "'s " { $snippet "statements" } " slot is not an instance of:"
-{ $list
- { $link subgraph }
- { $link node }
- { $link edge }
- { $link graph-attributes }
- { $link node-attributes }
- { "or " { $link edge-attributes } }
-}
+"Throws " { $instance unsupported-preview-format } " error if " { $link preview-format } " is not supported by " { $vocab-link "images.loader" } "."
$nl
-"If the inferred layout engine is not a member of " { $link supported-engines } ", an " { $link unsupported-engine } " error is thrown."
+"If the Graphviz process encounters an error, its output will be captured and thrown as " { $instance output-process-error } " by Factor."
$nl
-"If the inferred output format (i.e., " { $link default-format } ") is not a member of " { $link supported-formats } ", an " { $link unsupported-format } " error is thrown."
-}
-{ $see-also image. preview-window }
-;
+"Throws " { $instance unsupported-encoding } " error if " { $link graph-encoding } " isn't one of " { $link utf8 } " or " { $link latin1 } "."
+} ;
HELP: preview-window
{ $values
{ "graph" graph }
}
-{ $description "Renders " { $snippet "graph" } " to a temporary file of the " { $link default-format } " (assumed to be an image format) using the " { $link default-layout } " (or, if specified, the engine set as the graph's " { $slot "layout" } " attribute). Then, using the " { $vocab-link "images.viewer" } " vocabulary, opens a new window displaying the image." }
+{ $description "Renders " { $snippet "graph" } " to a temporary file using " { $link preview-format } " and " { $link default-layout } ". Then, using " { $link image-window } ", opens a new window displaying the image before deleting the temporary file." }
{ $errors
-"If " { $snippet "graph" } " is not an instance of " { $link graph } ", a " { $link non-graph-error } " is thrown."
+"Throws " { $instance unsupported-preview-format } " error if " { $link preview-format } " is not supported by " { $vocab-link "images.loader" } "."
$nl
-"An " { $link improper-statement-error } " is thrown if any element of " { $snippet "graph" } "'s " { $snippet "statements" } " slot is not an instance of:"
-{ $list
- { $link subgraph }
- { $link node }
- { $link edge }
- { $link graph-attributes }
- { $link node-attributes }
- { "or " { $link edge-attributes } }
-}
+"If the Graphviz process encounters an error, its output will be captured and thrown as " { $instance output-process-error } " by Factor."
$nl
-"If the inferred layout engine is not a member of " { $link supported-engines } ", an " { $link unsupported-engine } " error is thrown."
-$nl
-"If the inferred output format (i.e., " { $link default-format } ") is not a member of " { $link supported-formats } ", an " { $link unsupported-format } " error is thrown."
+"Throws " { $instance unsupported-encoding } " error if " { $link graph-encoding } " isn't one of " { $link utf8 } " or " { $link latin1 } "."
+} ;
+
+!
+
+HELP: circo
+{ $values
+ { "graph" graph } { "path" "a pathname string" } { "format" string }
}
-{ $see-also image-window preview }
-;
+{ $description "Invokes " { $link graphviz } " with " { $snippet "\"circo\"" } " supplied as the layout engine. That is, the following two lines are equivalent:" { $code "graph path format \"circo\" graphviz" "graph path format circo" } } ;
-HELP: unsupported-engine
+HELP: dot
{ $values
- { "engine" object }
+ { "graph" graph } { "path" "a pathname string" } { "format" string }
}
-{ $error-description "Thrown if a rendering word tries to use a layout engine that is not a member of " { $link supported-engines } "." }
-{ $see-also unsupported-format }
-;
+{ $description "Invokes " { $link graphviz } " with " { $snippet "\"dot\"" } " supplied as the layout engine. That is, the following two lines are equivalent:" { $code "graph path format \"dot\" graphviz" "graph path format dot" } } ;
-HELP: unsupported-format
+HELP: fdp
{ $values
- { "format" object }
+ { "graph" graph } { "path" "a pathname string" } { "format" string }
}
-{ $error-description "Thrown if a rendering word tries to use an output format that is not a member of " { $link supported-formats } "." }
-{ $see-also unsupported-engine }
-;
+{ $description "Invokes " { $link graphviz } " with " { $snippet "\"fdp\"" } " supplied as the layout engine. That is, the following two lines are equivalent:" { $code "graph path format \"fdp\" graphviz" "graph path format fdp" } } ;
-ARTICLE: { "graphviz.render" "algorithm" "node" } "Rendering nodes"
-"To render a " { $link node } ", a Graphviz equivalent is constructed in memory that is identified by the " { $link node } "'s " { $slot "id" } " slot. Then, any local attributes (as specified in the " { $slot "attributes" } " slot) are set."
-$nl
-"If two " { $link node } " instances have the same " { $slot "id" } ", they will correspond to the same object in the Graphviz representation. Thus, the effect of any local attributes are cumulative. For example,"
-{ $code
-"<graph>"
-" 1 add-node[ \"blue\" =color ];"
-" 1 add-node[ \"red\" =color ];"
-}
-"will render the same way as just"
-{ $code
-"<graph>"
-" 1 add-node[ \"red\" =color ];"
-}
-"because statements are rendered in the order they appear. Even " { $link node } " instances in a " { $link subgraph } " are treated this way, so"
-{ $code
-"<graph>"
-" 1 add-node"
-" <anon>"
-" 1 add-node"
-" add"
-}
-"will only create a single Graphviz node."
-;
+HELP: neato
+{ $values
+ { "graph" graph } { "path" "a pathname string" } { "format" string }
+}
+{ $description "Invokes " { $link graphviz } " with " { $snippet "\"neato\"" } " supplied as the layout engine. That is, the following two lines are equivalent:" { $code "graph path format \"neato\" graphviz" "graph path format neato" } } ;
-ARTICLE: { "graphviz.render" "algorithm" "subgraph" } "Rendering subgraphs"
-"To render a " { $link subgraph } ", a Graphviz equivalent is constructed in memory that is identified by the " { $link subgraph } "'s " { $slot "id" } " slot. This equivalent will inherit any attributes set in its parent graph (see " { $link { "graphviz.render" "algorithm" "attributes" } } ")."
-$nl
-"Each element of the " { $link subgraph } "'s " { $slot "statements" } " slot is recursively rendered in order. Thus, subgraph attributes are set by rendering a " { $link graph-attributes } " object contained in a " { $link subgraph } "'s " { $slot "statements" } "."
-$nl
-"If two " { $link subgraph } " instances have the same " { $slot "id" } ", they will correspond to the same object in the Graphviz representation. (Indeed, the " { $slot "id" } "s even share the same namespace as the root " { $link graph } "; see " { $url "http://graphviz.org/content/dot-language" } " for details.) Thus, the effect of rendering " { $emphasis "any" } " statement is cumulative. For example,"
-{ $code
-"<graph>"
-" { 1 2 3 } add-nodes"
-""
-" 0 <cluster>"
-" 4 add-node"
-" add"
-""
-" 0 <cluster>"
-" 5 add-node"
-" add"
-}
-"will render the same way as just"
-{ $code
-"<graph>"
-" { 1 2 3 } add-nodes"
-""
-" 0 <cluster>"
-" 4 add-node"
-" 5 add-node"
-" add"
+HELP: osage
+{ $values
+ { "graph" graph } { "path" "a pathname string" } { "format" string }
}
-;
+{ $description "Invokes " { $link graphviz } " with " { $snippet "\"osage\"" } " supplied as the layout engine. That is, the following two lines are equivalent:" { $code "graph path format \"osage\" graphviz" "graph path format osage" } } ;
-ARTICLE: { "graphviz.render" "algorithm" "attributes" } "Rendering attributes"
-"The way " { $link node-attributes } ", " { $link edge-attributes } ", and " { $link graph-attributes } " are rendered varies by context."
-$nl
-"If an instance of " { $link node-attributes } " or " { $link edge-attributes } " appears in the " { $slot "statements" } " of a " { $link graph } " or " { $link subgraph } ", it corresponds to global Graphviz attributes that will be set automatically for any " { $emphasis "future" } " " { $link node } " or " { $link edge } " instances (respectively), just like global attribute statements in the DOT language. Rendering " { $link graph-attributes } " behaves similarly, except that the Graphviz attributes of the containing graph/subgraph will also be altered, in addition to future " { $link subgraph } "s inheriting said attributes."
-$nl
-{ $link node-attributes } " and " { $link edge-attributes } " may also be rendered in the context of a single " { $link node } " or " { $link edge } ", as specified by these objects' " { $slot "attributes" } " slots. They correspond to Graphviz attributes set specifically for the corresponding node/edge, after the defaults are inherited from rendering global statements as in the above."
-$nl
-"For example, setting " { $emphasis "local" } " attributes like"
-{ $code
-"<graph>"
-" 1 add-node[ \"red\" =color ];"
-" 2 add-node[ \"red\" =color ];"
-" 3 add-node[ \"blue\" =color ];"
-" 4 add-node[ \"blue\" =color ];"
-}
-"will render the same way as setting " { $emphasis "global" } " attributes that get inherited, like"
-{ $code
-"<graph>"
-" node[ \"red\" =color ];"
-" 1 add-node"
-" 2 add-node"
-" node[ \"blue\" =color ];"
-" 3 add-node"
-" 4 add-node"
+HELP: sfdp
+{ $values
+ { "graph" graph } { "path" "a pathname string" } { "format" string }
}
-;
+{ $description "Invokes " { $link graphviz } " with " { $snippet "\"sfdp\"" } " supplied as the layout engine. That is, the following two lines are equivalent:" { $code "graph path format \"sfdp\" graphviz" "graph path format sfdp" } } ;
-ARTICLE: { "graphviz.render" "algorithm" "edge" } "Rendering edges"
-"Instances of " { $link edge } " are not quite in one-to-one correspondence with Graphviz edges. The latter exist solely between two nodes, whereas an " { $link edge } " instance may have a " { $link subgraph } " as an endpoint."
-$nl
-"To render an " { $link edge } ", first the " { $slot "tail" } " is recursively rendered:"
-{ $list
- { "If it is a " { $link string } ", then it's taken to identify a node (if one doesn't already exist in the Graphviz representation, it is created)." }
- { "If it is a " { $link subgraph } ", then it's rendered recursively as per " { $link { "graphviz.render" "algorithm" "subgraph" } } " (thus also creating the Graphviz subgraph if one doesn't already exist)." }
+HELP: twopi
+{ $values
+ { "graph" graph } { "path" "a pathname string" } { "format" string }
}
-$nl
-"The " { $slot "head" } " is then rendered in the same way."
-$nl
-"More than one corresponding Graphviz edge may be created at this point. In general, a Graphviz edge is created from each node in the tail (or just the one, if " { $slot "tail" } " was a " { $link string } ") to each node in the head (or just the one, if " { $slot "head" } " was a " { $link string } "). However, a Grapvhiz edge may or may not be solely identified by its endpoints. Either way, whatever Graphviz-equivalent edges wind up being rendered, their attributes will be set according to the " { $link edge } "'s " { $slot "attributes" } " slot."
-$nl
-"In particular, if the root graph is strict, then edges are uniquely identified, so attributes are cumulative (like in " { $link { "graphviz.render" "algorithm" "node" } } " and " { $link { "graphviz.render" "algorithm" "subgraph" } } "). For example,"
-{ $code
- "<strict-graph>"
- " 1 2 add-edge[ \"blue\" =color ];"
- " 1 2 add-edge[ \"red\" =color ];"
+{ $description "Invokes " { $link graphviz } " with " { $snippet "\"twopi\"" } " supplied as the layout engine. That is, the following two lines are equivalent:" { $code "graph path format \"twopi\" graphviz" "graph path format twopi" } } ;
+
+!
+
+HELP: bmp
+{ $values
+ { "graph" graph } { "path" "a pathname string" }
}
-"will render the same way as just"
-{ $code
- "<strict-graph>"
- " 1 2 add-edge[ \"red\" =color ];"
+{ $description "Invokes " { $link graphviz* } " with " { $snippet "\"bmp\"" } " supplied as the output format. That is, the following two lines are equivalent:" { $code "graph path \"bmp\" graphviz*" "graph path bmp" } } ;
+
+HELP: canon
+{ $values
+ { "graph" graph } { "path" "a pathname string" }
}
-$nl
-"But in a non-strict graph, a new Graphviz edge is created with its own local attributes which are not affected by past edges between the same endpoints. So,"
-{ $code
- "<graph>"
- " 1 2 add-edge[ \"blue\" =color ];"
- " 1 2 add-edge[ \"red\" =color ];"
+{ $description "Invokes " { $link graphviz* } " with " { $snippet "\"canon\"" } " supplied as the output format. That is, the following two lines are equivalent:" { $code "graph path \"canon\" graphviz*" "graph path canon" } } ;
+
+HELP: cmap
+{ $values
+ { "graph" graph } { "path" "a pathname string" }
}
-"will render " { $emphasis "two" } " separate edges with different colors (one red, one blue)."
-{ $notes
-"Because of the above semantics for edges between subgraphs, the " { $vocab-link "graphviz" } " vocabulary does not support edges betwteen clusters as single entities like certain Graphviz layout engines, specifically " { $emphasis "fdp" } "."
+{ $description "Invokes " { $link graphviz* } " with " { $snippet "\"cmap\"" } " supplied as the output format. That is, the following two lines are equivalent:" { $code "graph path \"cmap\" graphviz*" "graph path cmap" } } ;
+
+HELP: cmapx
+{ $values
+ { "graph" graph } { "path" "a pathname string" }
}
-;
+{ $description "Invokes " { $link graphviz* } " with " { $snippet "\"cmapx\"" } " supplied as the output format. That is, the following two lines are equivalent:" { $code "graph path \"cmapx\" graphviz*" "graph path cmapx" } } ;
-ARTICLE: { "graphviz.render" "algorithm" "error" } "Rendering unexpected objects"
-"If an object in the " { $slot "statements" } " of a " { $link graph } " or " { $link subgraph } " is not an instance of either"
-{ $list
- { $link subgraph }
- { $link node }
- { $link edge }
- { $link graph-attributes }
- { $link node-attributes }
- { "or " { $link edge-attributes } }
-}
-"then it will trigger an " { $link improper-statement-error } "."
-;
+HELP: cmapx_np
+{ $values
+ { "graph" graph } { "path" "a pathname string" }
+}
+{ $description "Invokes " { $link graphviz* } " with " { $snippet "\"cmapx_np\"" } " supplied as the output format. That is, the following two lines are equivalent:" { $code "graph path \"cmapx_np\" graphviz*" "graph path cmapx_np" } } ;
-ARTICLE: { "graphviz.render" "algorithm" } "Graphviz rendering algorithm"
-"The " { $vocab-link "graphviz.render" } " vocabulary provides words to " { $emphasis "render" } " graphs. That is, it generates Graphviz output from a " { $link graph } " by using the " { $vocab-link "graphviz.ffi" } " and " { $vocab-link "graphviz.builder" } " vocabularies. Intuitively, " { $link graph } "s follow the same rules as in the DOT language (see " { $url "http://graphviz.org/content/dot-language" } " for more information). To render a " { $link graph } ", each element of its " { $slot "statements" } " slot is added to the Graphviz representation in order. The following gives a general overview of how different objects are rendered, with a few points to keep in mind."
-{ $subsections
- { "graphviz.render" "algorithm" "node" }
- { "graphviz.render" "algorithm" "edge" }
- { "graphviz.render" "algorithm" "attributes" }
- { "graphviz.render" "algorithm" "subgraph" }
- { "graphviz.render" "algorithm" "error" }
+HELP: dot-file
+{ $values
+ { "graph" graph } { "path" "a pathname string" }
}
-{ $notes
-"Each call to a rendering word (like " { $links graphviz graphviz* preview preview-window } ", etc.) will go through the process of reconstructing the equivalent Graphviz representation in memory, even if the underlying " { $link graph } " hasn't changed."
+{ $description "Invokes " { $link graphviz* } " with " { $snippet "\"dot\"" } " supplied as the output format. That is, the following two lines are equivalent:" { $code "graph path \"dot\" graphviz*" "graph path dot-file" } } ;
+
+HELP: eps
+{ $values
+ { "graph" graph } { "path" "a pathname string" }
}
-;
+{ $description "Invokes " { $link graphviz* } " with " { $snippet "\"eps\"" } " supplied as the output format. That is, the following two lines are equivalent:" { $code "graph path \"eps\" graphviz*" "graph path eps" } } ;
-ARTICLE: { "graphviz.render" "engines" } "Rendering graphs by layout engine"
-"For each layout engine in " { $link supported-engines } ", the " { $vocab-link "graphviz.render" } " vocabulary defines a corresponding word that calls " { $link graphviz } " with that engine already supplied as an argument. For instance, instead of writing" { $code "graph -O -T \"dot\" graphviz" } "you can simply write" { $code "graph -O -T dot" } "as long as " { $snippet "\"dot\"" } " is a member of " { $link supported-engines } "."
-;
+HELP: fig
+{ $values
+ { "graph" graph } { "path" "a pathname string" }
+}
+{ $description "Invokes " { $link graphviz* } " with " { $snippet "\"fig\"" } " supplied as the output format. That is, the following two lines are equivalent:" { $code "graph path \"fig\" graphviz*" "graph path fig" } } ;
-ARTICLE: { "graphviz.render" "formats" } "Rendering graphs by output format"
-"For each output format in " { $link supported-formats } ", the " { $vocab-link "graphviz.render" } " vocabulary defines a corresponding word that calls " { $link graphviz* } " with that format already supplied as an argument. For instance, instead of writing" { $code "graph -O \"png\" graphviz*" } "you can simply write" { $code "graph -O png" } "as long as " { $snippet "\"png\"" } " is a member of " { $link supported-formats } "."
+HELP: gd
+{ $values
+ { "graph" graph } { "path" "a pathname string" }
+}
+{ $description "Invokes " { $link graphviz* } " with " { $snippet "\"gd\"" } " supplied as the output format. That is, the following two lines are equivalent:" { $code "graph path \"gd\" graphviz*" "graph path gd" } } ;
+
+HELP: gd2
+{ $values
+ { "graph" graph } { "path" "a pathname string" }
+}
+{ $description "Invokes " { $link graphviz* } " with " { $snippet "\"gd2\"" } " supplied as the output format. That is, the following two lines are equivalent:" { $code "graph path \"gd2\" graphviz*" "graph path gd2" } } ;
+
+HELP: gif
+{ $values
+ { "graph" graph } { "path" "a pathname string" }
+}
+{ $description "Invokes " { $link graphviz* } " with " { $snippet "\"gif\"" } " supplied as the output format. That is, the following two lines are equivalent:" { $code "graph path \"gif\" graphviz*" "graph path gif" } } ;
+
+HELP: ico
+{ $values
+ { "graph" graph } { "path" "a pathname string" }
+}
+{ $description "Invokes " { $link graphviz* } " with " { $snippet "\"ico\"" } " supplied as the output format. That is, the following two lines are equivalent:" { $code "graph path \"ico\" graphviz*" "graph path ico" } } ;
+
+HELP: imap
+{ $values
+ { "graph" graph } { "path" "a pathname string" }
+}
+{ $description "Invokes " { $link graphviz* } " with " { $snippet "\"imap\"" } " supplied as the output format. That is, the following two lines are equivalent:" { $code "graph path \"imap\" graphviz*" "graph path imap" } } ;
+
+HELP: imap_np
+{ $values
+ { "graph" graph } { "path" "a pathname string" }
+}
+{ $description "Invokes " { $link graphviz* } " with " { $snippet "\"imap_np\"" } " supplied as the output format. That is, the following two lines are equivalent:" { $code "graph path \"imap_np\" graphviz*" "graph path imap_np" } } ;
+
+HELP: ismap
+{ $values
+ { "graph" graph } { "path" "a pathname string" }
+}
+{ $description "Invokes " { $link graphviz* } " with " { $snippet "\"ismap\"" } " supplied as the output format. That is, the following two lines are equivalent:" { $code "graph path \"ismap\" graphviz*" "graph path ismap" } } ;
+
+HELP: jpe
+{ $values
+ { "graph" graph } { "path" "a pathname string" }
+}
+{ $description "Invokes " { $link graphviz* } " with " { $snippet "\"jpe\"" } " supplied as the output format. That is, the following two lines are equivalent:" { $code "graph path \"jpe\" graphviz*" "graph path jpe" } } ;
+
+HELP: jpeg
+{ $values
+ { "graph" graph } { "path" "a pathname string" }
+}
+{ $description "Invokes " { $link graphviz* } " with " { $snippet "\"jpeg\"" } " supplied as the output format. That is, the following two lines are equivalent:" { $code "graph path \"jpeg\" graphviz*" "graph path jpeg" } } ;
+
+HELP: jpg
+{ $values
+ { "graph" graph } { "path" "a pathname string" }
+}
+{ $description "Invokes " { $link graphviz* } " with " { $snippet "\"jpg\"" } " supplied as the output format. That is, the following two lines are equivalent:" { $code "graph path \"jpg\" graphviz*" "graph path jpg" } } ;
+
+HELP: pdf
+{ $values
+ { "graph" graph } { "path" "a pathname string" }
+}
+{ $description "Invokes " { $link graphviz* } " with " { $snippet "\"pdf\"" } " supplied as the output format. That is, the following two lines are equivalent:" { $code "graph path \"pdf\" graphviz*" "graph path pdf" } } ;
+
+HELP: plain
+{ $values
+ { "graph" graph } { "path" "a pathname string" }
+}
+{ $description "Invokes " { $link graphviz* } " with " { $snippet "\"plain\"" } " supplied as the output format. That is, the following two lines are equivalent:" { $code "graph path \"plain\" graphviz*" "graph path plain" } } ;
+
+HELP: plain-ext
+{ $values
+ { "graph" graph } { "path" "a pathname string" }
+}
+{ $description "Invokes " { $link graphviz* } " with " { $snippet "\"plain-ext\"" } " supplied as the output format. That is, the following two lines are equivalent:" { $code "graph path \"plain-ext\" graphviz*" "graph path plain-ext" } } ;
+
+HELP: png
+{ $values
+ { "graph" graph } { "path" "a pathname string" }
+}
+{ $description "Invokes " { $link graphviz* } " with " { $snippet "\"png\"" } " supplied as the output format. That is, the following two lines are equivalent:" { $code "graph path \"png\" graphviz*" "graph path png" } } ;
+
+HELP: ps
+{ $values
+ { "graph" graph } { "path" "a pathname string" }
+}
+{ $description "Invokes " { $link graphviz* } " with " { $snippet "\"ps\"" } " supplied as the output format. That is, the following two lines are equivalent:" { $code "graph path \"ps\" graphviz*" "graph path ps" } } ;
+
+HELP: ps2
+{ $values
+ { "graph" graph } { "path" "a pathname string" }
+}
+{ $description "Invokes " { $link graphviz* } " with " { $snippet "\"ps2\"" } " supplied as the output format. That is, the following two lines are equivalent:" { $code "graph path \"ps2\" graphviz*" "graph path ps2" } } ;
+
+HELP: svg
+{ $values
+ { "graph" graph } { "path" "a pathname string" }
+}
+{ $description "Invokes " { $link graphviz* } " with " { $snippet "\"svg\"" } " supplied as the output format. That is, the following two lines are equivalent:" { $code "graph path \"svg\" graphviz*" "graph path svg" } } ;
+
+HELP: svgz
+{ $values
+ { "graph" graph } { "path" "a pathname string" }
+}
+{ $description "Invokes " { $link graphviz* } " with " { $snippet "\"svgz\"" } " supplied as the output format. That is, the following two lines are equivalent:" { $code "graph path \"svgz\" graphviz*" "graph path svgz" } } ;
+
+HELP: tif
+{ $values
+ { "graph" graph } { "path" "a pathname string" }
+}
+{ $description "Invokes " { $link graphviz* } " with " { $snippet "\"tif\"" } " supplied as the output format. That is, the following two lines are equivalent:" { $code "graph path \"tif\" graphviz*" "graph path tif" } } ;
+
+HELP: tiff
+{ $values
+ { "graph" graph } { "path" "a pathname string" }
+}
+{ $description "Invokes " { $link graphviz* } " with " { $snippet "\"tiff\"" } " supplied as the output format. That is, the following two lines are equivalent:" { $code "graph path \"tiff\" graphviz*" "graph path tiff" } } ;
+
+HELP: vml
+{ $values
+ { "graph" graph } { "path" "a pathname string" }
+}
+{ $description "Invokes " { $link graphviz* } " with " { $snippet "\"vml\"" } " supplied as the output format. That is, the following two lines are equivalent:" { $code "graph path \"vml\" graphviz*" "graph path vml" } } ;
+
+HELP: vmlz
+{ $values
+ { "graph" graph } { "path" "a pathname string" }
+}
+{ $description "Invokes " { $link graphviz* } " with " { $snippet "\"vmlz\"" } " supplied as the output format. That is, the following two lines are equivalent:" { $code "graph path \"vmlz\" graphviz*" "graph path vmlz" } } ;
+
+HELP: vrml
+{ $values
+ { "graph" graph } { "path" "a pathname string" }
+}
+{ $description "Invokes " { $link graphviz* } " with " { $snippet "\"vrml\"" } " supplied as the output format. That is, the following two lines are equivalent:" { $code "graph path \"vrml\" graphviz*" "graph path vrml" } } ;
+
+HELP: wbmp
+{ $values
+ { "graph" graph } { "path" "a pathname string" }
+}
+{ $description "Invokes " { $link graphviz* } " with " { $snippet "\"wbmp\"" } " supplied as the output format. That is, the following two lines are equivalent:" { $code "graph path \"wbmp\" graphviz*" "graph path wbmp" } } ;
+
+HELP: webp
+{ $values
+ { "graph" graph } { "path" "a pathname string" }
+}
+{ $description "Invokes " { $link graphviz* } " with " { $snippet "\"webp\"" } " supplied as the output format. That is, the following two lines are equivalent:" { $code "graph path \"webp\" graphviz*" "graph path webp" } } ;
+
+HELP: xdot
+{ $values
+ { "graph" graph } { "path" "a pathname string" }
+}
+{ $description "Invokes " { $link graphviz* } " with " { $snippet "\"xdot\"" } " supplied as the output format. That is, the following two lines are equivalent:" { $code "graph path \"xdot\" graphviz*" "graph path xdot" } } ;
+
+ARTICLE: { "graphviz.render" "layouts" } "Rendering graphs by layout engine"
+"For each \"standard\" layout command listed in " { $url "http://graphviz.org/Documentation.php" } ", the " { $vocab-link "graphviz.render" } " vocabulary defines a corresponding word that calls " { $link graphviz } " with that layout engine already supplied as an argument. For instance, instead of writing" { $code "graph path format \"dot\" graphviz" } "you can simply write" { $code "graph path format dot" }
$nl
-"If any of the formats is also a member of " { $link supported-engines } ", the word is named with a " { $snippet "-file" } " suffix. For instance, the " { $vocab-link "graphviz.render" } " vocabulary may define a word for the " { $snippet "\"dot\"" } " layout engine, so that instead of" { $code "graph -O -T \"dot\" graphviz" } "you can write" { $code "graph -O -T dot" } "But to infer the layout engine and " { $emphasis "output" } " in the " { $snippet "\"dot\"" } " format, instead of" { $code "graph -O \"dot\" graphviz*" } "you can write" { $code "graph -O dot-file" } "as long as " { $snippet "\"dot\"" } " is a member of both " { $link supported-engines } " and " { $link supported-formats } "."
+"The following words are defined:"
+{ $subsections circo dot fdp neato osage sfdp twopi } ;
-{ $warning "Graphviz may support " { $emphasis "canvas" } " formats, such as " { $snippet "\"xlib\"" } " or " { $snippet "\"gtk\"" } ", that will open windows displaying the graph. However, the listener will not be aware of these windows: when they are closed, the listener will exit as well. You should probably use the " { $link preview-window } " word, instead." }
-;
+ARTICLE: { "graphviz.render" "formats" } "Rendering graphs by output format"
+"For each output format listed in " { $url "http://graphviz.org/content/output-formats" } ", the " { $vocab-link "graphviz.render" } " vocabulary defines a corresponding word that calls " { $link graphviz* } " with that format already supplied as an argument. For instance, instead of writing" { $code "graph path \"png\" graphviz*" } "you can simply write" { $code "graph path png" }
+$nl
+"In the case of the " { $snippet "dot" } " output format (which already has the " { $link dot } " shortcut defined for the layout engine), the shortcut function is named " { $link dot-file } "."
+$nl
+"The following words are defined:"
+{ $subsections bmp canon dot-file xdot cmap eps fig gd gd2 gif ico imap cmapx imap_np cmapx_np ismap jpg jpeg jpe pdf plain plain-ext png ps ps2 svg svgz tif tiff vml vmlz vrml wbmp webp } ;
ARTICLE: "graphviz.render" "Rendering Graphviz output"
-"The " { $vocab-link "graphviz.render" } " vocabulary provides words for converting " { $link graph } " objects into equivalent Graphviz output. The following provides a general overview of how this process works:"
-{ $subsections { "graphviz.render" "algorithm" } }
-
-"Graphviz provides a variety of different layout engines (which give algorithms for placing nodes and edges in a graph) and output formats (e.g., different image filetypes to show the graph structure)."
+"The " { $vocab-link "graphviz.render" } " vocabulary provides words for converting " { $link graph } " objects into equivalent Graphviz output. This is done by using the " { $vocab-link "graphviz.dot" } " vocabulary to convert the Factor objects into equivalent DOT code, then invoking Graphviz upon the result."
$nl
-"The most general words in this vocabulary will have you manually specify the desired engine and/or format, along with a file to which Graphviz should save its output:"
+"The most general words in this vocabulary will have you manually specify the desired layout engine and/or output format, along with a file to which Graphviz should save its output:"
{ $subsections
graphviz
graphviz*
preview-window
}
-"Specialized words are also defined to save on extraneous typing:"
+"A few global variables are used to control the above words:"
+{ $subsections
+ default-layout
+ graph-encoding
+ preview-format
+}
+
+"Shortcut words are also defined to save on extra typing:"
{ $subsections
- { "graphviz.render" "engines" }
+ { "graphviz.render" "layouts" }
{ "graphviz.render" "formats" }
}
;
-! Copyright (C) 2011 Alex Vondrak.
+! Copyright (C) 2012 Alex Vondrak.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors combinators compiler.units continuations
-destructors images.viewer io.backend io.files.unique kernel
-locals namespaces parser sequences summary unicode.case words
-graphviz.ffi graphviz.builder ;
+destructors graphviz.dot images.viewer io.backend
+io.directories io.encodings.8-bit.latin1 io.encodings.utf8
+io.files io.files.unique io.launcher io.standard-paths kernel
+locals make namespaces parser sequences summary system
+unicode.case vocabs words ;
IN: graphviz.render
+<PRIVATE
+
+! "Layout Commands" from http://graphviz.org/Documentation.php
+CONSTANT: standard-layouts {
+ "circo"
+ "dot"
+ "fdp"
+ "neato"
+ "osage"
+ "sfdp"
+ "twopi"
+}
+
+PRIVATE>
+
SYMBOL: default-layout
"dot" default-layout set-global
-SYMBOL: default-format
-"png" default-format set-global
+SYMBOL: preview-format
+"png" preview-format set-global
-ERROR: unsupported-format format ;
-ERROR: unsupported-engine engine ;
+ERROR: unsupported-preview-format preview-format ;
-M: unsupported-format summary
- drop "Unsupported layout format; check supported-formats" ;
+M: unsupported-preview-format summary
+ drop "Unsupported preview format" ;
-M: unsupported-engine summary
- drop "Unsupported layout engine; check supported-engines" ;
+SYMBOL: graph-encoding
+utf8 graph-encoding set-global
-<PRIVATE
+ERROR: unsupported-encoding graph-encoding ;
-: default-extension ( format -- extension )
- >lower {
- { "bmp" [ ".bmp" ] }
- { "canon" [ ".dot" ] }
- { "dot" [ ".dot" ] }
- { "xdot" [ ".dot" ] }
- { "eps" [ ".eps" ] }
- { "fig" [ ".fig" ] }
- { "gd" [ ".gd" ] }
- { "gd2" [ ".gd2" ] }
- { "gif" [ ".gif" ] }
- { "ico" [ ".ico" ] }
- { "imap" [ ".map" ] }
- { "cmapx" [ ".map" ] }
- { "imap_np" [ ".map" ] }
- { "cmapx_np" [ ".map" ] }
- { "ismap" [ ".map" ] }
- { "jpg" [ ".jpg" ] }
- { "jpeg" [ ".jpg" ] }
- { "jpe" [ ".jpg" ] }
- { "pdf" [ ".pdf" ] }
- { "plain" [ ".txt" ] }
- { "plain-ext" [ ".txt" ] }
- { "png" [ ".png" ] }
- { "ps" [ ".ps" ] }
- { "ps2" [ ".ps" ] }
- { "svg" [ ".svg" ] }
- { "svgz" [ ".svgz" ] }
- { "tif" [ ".tif" ] }
- { "tiff" [ ".tif" ] }
- { "vml" [ ".vml" ] }
- { "vmlz" [ ".vmlz" ] }
- { "vrml" [ ".vrml" ] }
- { "wbmp" [ ".wbmp" ] }
- [ drop "" ]
- } case ;
+M: unsupported-encoding summary
+ drop "Must use utf8 or latin1 (match the graph's charset attribute)" ;
-: check-format ( -T -- )
- dup supported-formats member?
- [ drop ] [ unsupported-format ] if ; inline
+HOOK: default-graphviz-program os ( -- path/f )
-: check-engine ( -K -- )
- dup supported-engines member?
- [ drop ] [ unsupported-engine ] if ; inline
+M: object default-graphviz-program ( -- path/f )
+ standard-layouts [ find-in-path ] find nip ;
-: compute-engine ( Agraph_t* -K -- engine )
- [ nip ]
- [
- "layout" agget
- [ default-layout get-global ] when-empty
- ] if* dup check-engine ;
+ERROR: cannot-find-graphviz-installation ;
+
+M: cannot-find-graphviz-installation summary
+ drop "Cannot find Graphviz installation" ;
+
+: ?default-graphviz-program ( -- path )
+ default-graphviz-program
+ [ cannot-find-graphviz-installation ] unless* ;
-:: (graphviz) ( graph -O -T -K -- -o )
- -T check-format
- -O -T default-extension append normalize-path :> -o
+<PRIVATE
+
+: try-graphviz-command ( path format layout -- )
[
- gvContext &gvFreeContext :> gvc
- graph id>> graph kind agopen &agclose :> g
- g graph build-alien
- g -K compute-engine :> engine
- gvc g engine gvLayout ?ffi-errors
- gvc g -T -o gvRenderFilename ?ffi-errors -o
- ] with-destructors ;
-
-: (preview) ( graph -- -o )
- "preview" unique-file
- default-format get-global
- f (graphviz) ; inline
+ ?default-graphviz-program ,
+ [ , "-O" , ]
+ [ "-T" , , ]
+ [ "-K" , , ] tri*
+ ] { } make try-output-process ;
+
+: ?encoding ( -- encoding )
+ graph-encoding get-global
+ dup [ utf8? ] [ latin1? ] bi or
+ [ unsupported-encoding ] unless ;
+
+: ?delete-file ( path -- )
+ dup exists? [ delete-file ] [ drop ] if ;
PRIVATE>
-: graphviz ( graph -O -T -K -- )
- (graphviz) drop ; inline
+:: graphviz ( graph path format layout -- )
+ path normalize-path :> dot-file
+ [
+ graph dot-file ?encoding write-dot
+ dot-file format layout try-graphviz-command
+ ]
+ [ dot-file ?delete-file ] [ ] cleanup ;
+
+: graphviz* ( graph path format -- )
+ default-layout get-global graphviz ;
+
+<PRIVATE
+
+: try-preview-command ( from-path to-path -- )
+ [
+ ?default-graphviz-program ,
+ [ , ]
+ [ "-o" , , ] bi*
+ "-T" , preview-format get-global ,
+ "-K" , default-layout get-global ,
+ ] { } make try-output-process ;
+
+! Not only must Graphviz support the image format, but so must
+! images.loader
+
+: preview-extension ( -- extension )
+ preview-format get-global >lower {
+ { "bmp" [ ".bmp" ] }
+ { "gif" [ ".gif" ] }
+ { "ico" [ ".ico" ] }
+ { "jpg" [ ".jpg" ] }
+ { "jpeg" [ ".jpg" ] }
+ { "jpe" [ ".jpg" ] }
+ { "png" [ ".png" ] }
+ { "tif" [ ".tif" ] }
+ { "tiff" [ ".tif" ] }
+ [ unsupported-preview-format ]
+ } case ;
+
+:: with-preview ( graph quot: ( path -- ) -- )
+ "preview" ".dot" [| code-file |
+ "preview" preview-extension [| image-file |
+ graph code-file ?encoding write-dot
+ code-file image-file try-preview-command
+ image-file quot call( path -- )
+ ] cleanup-unique-file
+ ] cleanup-unique-file ;
-: graphviz* ( graph -O -T -- )
- f graphviz ; inline
+PRIVATE>
: preview ( graph -- )
- (preview) image. ; inline
+ [ image. ] with-preview ;
: preview-window ( graph -- )
- (preview) image-window ; inline
+ [ image-window ] with-preview ;
<PRIVATE
-: define-graphviz-by-engine ( -K -- )
- [ "graphviz.render" create dup make-inline ]
+! http://graphviz.org/content/output-formats
+CONSTANT: standard-formats {
+ "bmp"
+ "canon"
+ "dot"
+ "xdot"
+ "cmap"
+ "eps"
+ "fig"
+ "gd"
+ "gd2"
+ "gif"
+ "ico"
+ "imap"
+ "cmapx"
+ "imap_np"
+ "cmapx_np"
+ "ismap"
+ "jpg"
+ "jpeg"
+ "jpe"
+ "pdf"
+ "plain"
+ "plain-ext"
+ "png"
+ "ps"
+ "ps2"
+ "svg"
+ "svgz"
+ "tif"
+ "tiff"
+ "vml"
+ "vmlz"
+ "vrml"
+ "wbmp"
+ "webp"
+ ! ! ! Canvas formats don't actually use path argument...
+ ! "gtk"
+ ! "xlib"
+}
+
+: define-graphviz-by-layout ( layout -- )
+ [ "graphviz.render" create ]
[ [ graphviz ] curry ] bi
- ( graph -O -T -- )
+ ( graph path format -- )
define-declared ;
-: define-graphviz-by-format ( -T -- )
+: define-graphviz-by-format ( format -- )
[
- dup supported-engines member? [ "-file" append ] when
- "graphviz.render" create dup make-inline
+ dup standard-layouts member? [ "-file" append ] when
+ "graphviz.render" create
]
[ [ graphviz* ] curry ] bi
- ( graph -O -- )
+ ( graph path -- )
define-declared ;
PRIVATE>
[
- supported-engines [ define-graphviz-by-engine ] each
- supported-formats [ define-graphviz-by-format ] each
+ standard-layouts [ define-graphviz-by-layout ] each
+ standard-formats [ define-graphviz-by-format ] each
] with-compilation-unit
+
+os windows? [ "graphviz.render.windows" require ] when
--- /dev/null
+! Copyright (C) 2012 Alex Vondrak.
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors combinators.short-circuit graphviz.render
+graphviz.render.private io.directories
+io.directories.search.windows io.files.info io.standard-paths
+kernel sequences system ;
+IN: graphviz.render.windows
+
+: graphviz-install-directories ( -- directories )
+ program-files-directories [
+ directory-entries [
+ {
+ [ directory? ]
+ [ name>> "Graphviz" head? ]
+ [ name>> ]
+ } 1&&
+ ] map sift
+ ] map concat ;
+
+M: windows default-graphviz-program ( -- path/f )
+ graphviz-install-directories
+ standard-layouts [ ".exe" append ] map
+ [ find-in-applications ] with find nip ;
projects / factor.git / commitdiff