SystemOrganization addCategory: #GraphViz!
SystemOrganization addCategory: #'GraphViz-Generators'!
SystemOrganization addCategory: #'GraphViz-Connectors'!
SystemOrganization addCategory: #'GraphViz-Model'!
SystemOrganization addCategory: #'GraphViz-Tests'!
TestCase subclass: #GraphVizBaseTests
instanceVariableNames: 'graph tempDir'
classVariableNames: ''
poolDictionaries: ''
category: 'GraphViz-Tests'!
!GraphVizBaseTests class methodsFor: 'as yet unclassified' stamp: 'jrp 3/13/2005 23:35'!
isAbstract
^ self = GraphVizBaseTests! !
!GraphVizBaseTests methodsFor: 'fixture' stamp: 'jrp 3/19/2005 19:22'!
historyOfSmalltalk
"self new historyOfSmalltalk"
^ GraphViz new
beDirected;
name: 'HistoryOfSmalltalk';
add: #graph with: {#overlap -> #scale. #concentrate -> #true. #ranksep -> 0.25};
add: #edge with: {#arrowsize -> 0.5};
add: #node with: {#shape -> #plaintext. #fontsize -> 16};
add: #past -> '1970s' -> 1980 -> 1983 -> 1985 -> 1991 -> 1993 -> 1995 -> 1996 -> 1998 -> 1999 -> 2000;
add: #node with: {#shape -> #box. #fontsize -> 10. #style -> #filled. #fillcolor -> #ivory. #height -> 0.25};
rank: #past add: #(CDL Simula Lisp);
rank: '1970s' add: #('Smalltalk-71' 'Smalltalk-72, 74, 76, 78');
rank: 1980 add: 'Smalltalk-80';
rank: 1983 add: 'Objective-C';
rank: 1985 add: #Self;
rank: 1991 add: #Oak;
rank: 1993 add: #Ruby;
rank: 1995 add: 'Java 1';
rank: 1996 add: #Squeak;
rank: 1998 add: 'Java 2';
rank: 1999 add: #VisualWorks;
rank: 2000 add: 'C#';
add: #Simula -> 'Smalltalk-71';
add: #CDL -> 'Smalltalk-71';
add: #Lisp -> 'Smalltalk-71' -> 'Smalltalk-72, 74, 76, 78' -> 'Smalltalk-80' -> 'Objective-C' -> #Oak;
add: 'Smalltalk-80' -> #Self;
add: 'Smalltalk-80' -> #Oak -> 'Java 1' -> 'Java 2' -> 'C#';
add: 'Smalltalk-80' -> #Ruby;
add: 'Smalltalk-80' -> #Squeak;
add: 'Smalltalk-80' -> #VisualWorks;
yourself! !
!GraphVizBaseTests methodsFor: 'as yet unclassified' stamp: 'lr 9/4/2010 14:47'!
setUp
tempDir := FileDirectory default directoryNamed: 'graphVizTestTemp'.
tempDir assureExistence.
graph := GraphViz new.
graph generator outputPath: tempDir fullName! !
!GraphVizBaseTests methodsFor: 'as yet unclassified' stamp: 'jrp 3/13/2005 23:32'!
tearDown
50 milliSeconds asDelay wait.
tempDir recursiveDelete.
50 milliSeconds asDelay wait.! !
GraphVizBaseTests subclass: #GraphVizGraphModelTests
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'GraphViz-Tests'!
!GraphVizGraphModelTests methodsFor: 'as yet unclassified' stamp: 'jrp 3/27/2005 22:14'!
testAccessAllEdgesViaRootGraph
graph add: #A -> #B.
graph subgraphDo: [graph add: #B -> #C].
graph add: 123 -> 456.
self should: [(graph edgeNamed: #A->#B) notNil].
self should: [(graph edgeNamed: #B->#C) notNil].
self should: [(graph edgeNamed: '123'->'456') notNil]! !
!GraphVizGraphModelTests methodsFor: 'as yet unclassified' stamp: 'jrp 3/20/2005 16:37'!
testAccessAllNodesViaRootGraph
graph add: #A.
graph subgraphDo: [graph add: #B].
graph add: 123.
self should: [(graph nodeNamed: #A) notNil].
self should: [(graph nodeNamed: #B) notNil].
self should: [(graph nodeNamed: #C) isNil].
self should: [(graph nodeNamed: '123') notNil]! !
!GraphVizGraphModelTests methodsFor: 'as yet unclassified' stamp: 'jrp 3/29/2005 17:10'!
testInheritedStyle
graph add: #node with: #color -> #blue.
graph add: #A.
graph add: #B.
graph add: #C with: #color -> #yellow.
self should: [(graph nodeNamed: #A) color = #blue].
self should: [(graph nodeNamed: #B) color = #blue].
self should: [(graph nodeNamed: #C) color = #yellow].! !
!GraphVizGraphModelTests methodsFor: 'as yet unclassified' stamp: 'jrp 3/29/2005 19:31'!
testInheritedStyleCascadesThroughSubgraphs
graph add: #node with: {#color -> #blue.#shape -> #ellipse}.
graph subgraphDo:
[graph add: #node with: #shape -> #box.
graph add: #A].
graph add: #B.
self should: [(graph nodeNamed: #A) color = #blue].
self should: [(graph nodeNamed: #A) shape = #box].
self should: [(graph nodeNamed: #B) color = #blue].
self should: [(graph nodeNamed: #B) shape = #ellipse]! !
!GraphVizGraphModelTests methodsFor: 'as yet unclassified' stamp: 'jrp 3/29/2005 17:40'!
testInheritedStylesAreCumulative
graph add: #node with: #color -> #blue.
graph add: #A.
graph add: #node with: #shape -> #box.
graph add: #B -> #C.
self should: [(graph nodeNamed: #A) color = #blue].
self should: [(graph nodeNamed: #B) color = #blue].
self should: [(graph nodeNamed: #B) shape = #box].
self should: [(graph nodeNamed: #C) color = #blue].
self should: [(graph nodeNamed: #C) shape = #box]! !
!GraphVizGraphModelTests methodsFor: 'as yet unclassified' stamp: 'jrp 3/29/2005 18:35'!
testInheritedStylesAreDistinctForNodesAndEdges
graph add: #node with: #color -> #blue.
graph add: #edge with: #color -> #yellow.
graph add: #A.
graph add: #A->#B.
self should: [(graph nodeNamed: #A) color = #blue].
self should: [(graph edgeNamed: #A->#B) color = #yellow]! !
!GraphVizGraphModelTests methodsFor: 'as yet unclassified' stamp: 'lr 9/4/2010 14:47'!
testInheritedStylesMaintainedIfNodesPutIntoSubgraph
graph := GraphViz new
add: #node with: #fontsize -> 16;
add: #A;
add: #node with: #fontsize -> 10;
yourself.
graph subgraphDo: [graph add: #A].
self should: [(graph nodeNamed: #A) fontSize = 16]! !
!GraphVizGraphModelTests methodsFor: 'as yet unclassified' stamp: 'lr 9/4/2010 14:47'!
testLoopThroughAllEdges
| items |
graph add: #A -> #B.
graph subgraphDo: [graph add: #C -> #A].
items := OrderedCollection new.
graph allEdgesDo: [:each | items add: each].
self should: [items size = 2].! !
!GraphVizGraphModelTests methodsFor: 'as yet unclassified' stamp: 'lr 9/4/2010 14:47'!
testLoopThroughAllNodes
| items |
graph add: #A.
graph add: #B.
graph subgraphDo: [graph add: #C -> #A].
items := OrderedCollection new.
graph allNodesDo: [:each | items add: each].
self should: [items size = 3].! !
!GraphVizGraphModelTests methodsFor: 'as yet unclassified' stamp: 'jrp 3/11/2005 19:41'!
testModelContainsAttributes
graph addAttribute: #A -> #B.
self should: [graph attributes size = 1].
self should: [graph attributes first key = #A].
self should: [graph attributes first value = #B].! !
!GraphVizGraphModelTests methodsFor: 'as yet unclassified' stamp: 'jrp 3/20/2005 16:00'!
testModelContainsEdges
graph add: #A -> #B.
self should: [graph edges size = 1].
self should: [graph edges first id = (#A -> #B)].
self should: [graph nodes size = 2].
self should: [graph nodes first id = #A].
self should: [graph nodes second id = #B].! !
!GraphVizGraphModelTests methodsFor: 'as yet unclassified' stamp: 'jrp 3/13/2005 19:10'!
testModelContainsManyNodesWhenUsingEdgesWithNestedAssociations
graph add: #A -> #B -> #C.
self should: [graph nodes size = 3].! !
!GraphVizGraphModelTests methodsFor: 'as yet unclassified' stamp: 'jrp 3/20/2005 16:00'!
testModelContainsNodes
graph add: #A.
self should: [graph nodes size = 1].
self should: [graph nodes first id = #A].
graph add: #B.
self should: [graph nodes size = 2].
self should: [graph nodes second id = #B].
! !
!GraphVizGraphModelTests methodsFor: 'as yet unclassified' stamp: 'jrp 3/27/2005 18:56'!
testModelContainsSubgraphs
graph subgraph: #foo do: [graph add: #A].
self should: [graph nodes isEmpty].
self should: [graph subgraphs size = 1].
self should: [graph subgraphs first id = #foo].
self should: [graph subgraphs first nodes size = 1].
self should: [graph subgraphs first nodes first id = #A].! !
!GraphVizGraphModelTests methodsFor: 'as yet unclassified' stamp: 'lr 9/4/2010 14:47'!
testModelRecordsOnlyUniqueNodes
| newNode |
graph add: #A.
self should: [graph nodes size = 1].
self should: [graph nodes first id = #A].
newNode := graph add: #A.
self should: [graph nodes size = 1].
self should: [newNode = (graph nodeNamed: #A)]! !
!GraphVizGraphModelTests methodsFor: 'as yet unclassified' stamp: 'jrp 3/20/2005 17:09'!
testModelRecordsOnlyUniqueNodesEvenInSubgraphs
graph add: #A.
graph subgraphDo: [graph add: #A].
self should: [graph nodes size = 1].
self should: [graph subgraphs first nodes size = 1].
self should: [graph nodes first = graph subgraphs first nodes first]! !
!GraphVizGraphModelTests methodsFor: 'as yet unclassified' stamp: 'jrp 3/27/2005 18:56'!
testModelWithStyle
graph add: #node with: #color -> #blue.
self should: [graph nodes isEmpty].
self should: [graph styles size =1].! !
!GraphVizGraphModelTests methodsFor: 'as yet unclassified' stamp: 'jrp 3/29/2005 17:11'!
testObjectsHaveAttributes
graph add: #A with: #label -> 'A label'.
self should: [graph nodes first attributes size = 1].
self should: [(graph nodes first attributes at: #label) = 'A label'].
graph add: #B with: {#foo -> #bar. #doo -> #boo}.
self should: [graph nodes second attributes size = 2]! !
!GraphVizGraphModelTests methodsFor: 'as yet unclassified' stamp: 'jrp 3/29/2005 17:11'!
testSubgraphInSubgraphs
graph subgraph: #foo do:
[graph subgraph: #bar do: [graph add: #A]].
self should: [graph nodes isEmpty].
self should: [graph subgraphs size = 1].
self should: [graph subgraphs first id = #foo].
self should: [graph subgraphs first nodes isEmpty].
self should: [graph subgraphs first subgraphs size = 1].
self should: [graph subgraphs first subgraphs first id = #bar].
self should: [graph subgraphs first subgraphs first nodes size = 1].
self should: [graph subgraphs first subgraphs first nodes first id = #A].! !
!GraphVizGraphModelTests methodsFor: 'as yet unclassified' stamp: 'jrp 3/29/2005 17:10'!
testSubgraphsVsGraphs
self should: [graph isGraph].
self shouldnt: [graph isSubgraph].
graph subgraph: #foo do: [].
self should: [graph subgraphs first isGraph].
self should: [graph subgraphs first isSubgraph].
graph subgraphDo: [graph rank: #same].
self should: [graph attributes isEmpty].
self should: [graph subgraphs last attributes size = 1]
! !
GraphVizBaseTests subclass: #GraphVizGraphingTests
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'GraphViz-Tests'!
!GraphVizGraphingTests methodsFor: 'as yet unclassified' stamp: 'jrp 3/3/2005 23:50'!
testAnonymousSubGraph
graph subgraphDo:
[graph add: #A].
self should: [(graph dot lineNumber: 2) = ' {'].
self should: [(graph dot lineNumber: 3) = ' A;'].
self should: [(graph dot lineNumber: 4) = ' }'].
self should: [(graph dot lineNumber: 5) = '}'].! !
!GraphVizGraphingTests methodsFor: 'as yet unclassified' stamp: 'jrp 3/11/2005 18:14'!
testDirectedGraphWithOneEdge
graph beDirected.
graph add: #A -> #B.
self should: [graph dot includesSubString: ' A -> B;'].! !
!GraphVizGraphingTests methodsFor: 'as yet unclassified' stamp: 'jrp 3/5/2005 21:53'!
testGraphToMorph
graph add: #A.
self should: [graph asMorph height > 0]! !
!GraphVizGraphingTests methodsFor: 'as yet unclassified' stamp: 'jrp 5/2/2005 23:42'!
testGraphToXml
graph add: #A.
graph add: #B -> #C.
self
should: [Smalltalk includesKey: #XMLDOMParser]
description: 'Need YAXO package to run this test and use asXml feature of graphs'.
self should: [graph asXml topElement localName = #gxl]! !
!GraphVizGraphingTests methodsFor: 'as yet unclassified' stamp: 'jrp 2/27/2005 23:42'!
testGraphWithDoubleQuotedId
graph add: 'HI THERE'.
self should: [(graph dot lineNumber: 2) = ' "HI THERE";'] ! !
!GraphVizGraphingTests methodsFor: 'as yet unclassified' stamp: 'jrp 2/27/2005 21:19'!
testGraphWithEdgeAttribute
graph add: #edge with: #dir -> #both.
self should: [graph dot includesSubString: 'edge [dir=both];']! !
!GraphVizGraphingTests methodsFor: 'as yet unclassified' stamp: 'jrp 2/27/2005 21:19'!
testGraphWithGraphAttribute
graph add: #graph with: #start -> #rand.
self should: [graph dot includesSubString: 'graph [start=rand];']! !
!GraphVizGraphingTests methodsFor: 'as yet unclassified' stamp: 'jrp 2/26/2005 16:52'!
testGraphWithName
graph name: 'g'.
self should: [graph dot beginsWith: 'graph g {'].
self should: [graph dot last = $}]! !
!GraphVizGraphingTests methodsFor: 'as yet unclassified' stamp: 'jrp 2/27/2005 21:20'!
testGraphWithNodeAttribute
graph add: #node with: #shape -> #box.
self should: [graph dot includesSubString: 'node [shape=box];']! !
!GraphVizGraphingTests methodsFor: 'as yet unclassified' stamp: 'jrp 3/11/2005 18:12'!
testGraphWithOneEdge
graph add: #A -> #B.
self should: [graph dot includesSubString: ' A -- B;'].! !
!GraphVizGraphingTests methodsFor: 'as yet unclassified' stamp: 'jrp 2/27/2005 21:08'!
testGraphWithOneNode
graph add: #A.
self should: [(graph dot lineNumber: 2) = ' A;'] ! !
!GraphVizGraphingTests methodsFor: 'as yet unclassified' stamp: 'jrp 3/5/2005 14:08'!
testGraphWithSimpleAttribute
graph at: #label put: #title.
self should: [(graph dot lineNumber: 2) = ' label=title;']! !
!GraphVizGraphingTests methodsFor: 'as yet unclassified' stamp: 'jrp 2/27/2005 21:13'!
testGraphWithSpecificNodeAttribute
graph add: #A with: #shape -> #box.
self should: [(graph dot lineNumber: 2) = ' A [shape=box];'] ! !
!GraphVizGraphingTests methodsFor: 'as yet unclassified' stamp: 'jrp 3/29/2005 19:13'!
testGraphWithSpecificNodeAttributes
graph add: #A with: {#shape -> #box. #fontname -> #trebuc}.
self should: [(graph dot lineNumber: 2) includesSubString: 'shape=box'].
self should: [(graph dot lineNumber: 2) includesSubString: 'fontname=trebuc'] ! !
!GraphVizGraphingTests methodsFor: 'as yet unclassified' stamp: 'jrp 2/27/2005 12:12'!
testGraphWithTwoEdgesDifferentNode
graph add: #A -> #B.
graph add: #B -> #C.
self should: [graph dot includesSubString: 'A -- B'].
self should: [graph dot includesSubString: 'B -- C'].! !
!GraphVizGraphingTests methodsFor: 'as yet unclassified' stamp: 'jrp 2/27/2005 12:12'!
testGraphWithTwoEdgesFromSameNode
graph add: #A -> #B.
graph add: #A -> #C.
self should: [graph dot includesSubString: 'A -- B'].
self should: [graph dot includesSubString: 'A -- C'].! !
!GraphVizGraphingTests methodsFor: 'as yet unclassified' stamp: 'jrp 2/27/2005 21:08'!
testGraphWithTwoNodes
graph add: #A.
graph add: #B.
self should: [(graph dot lineNumber: 2) = ' A;'].
self should: [(graph dot lineNumber: 3) = ' B;'] ! !
!GraphVizGraphingTests methodsFor: 'as yet unclassified' stamp: 'jrp 2/27/2005 23:47'!
testSafeIds
self should: [(graph safeIdFor: #A) = #A].
self should: [(graph safeIdFor: 10) = '10'].
self should: [(graph safeIdFor: '"10"') = '"10"'].
self should: [(graph safeIdFor: '') = ''].
self should: [(graph safeIdFor: '10ABC') = '"10ABC"'].
self should: [(graph safeIdFor: 'ABC DEF') = '"ABC DEF"'].
self should: [(graph safeIdFor: 'ABC-DEF') = '"ABC-DEF"'].! !
!GraphVizGraphingTests methodsFor: 'as yet unclassified' stamp: 'jrp 2/26/2005 17:01'!
testSimplestDirectedGraph
graph beDirected.
self should: [graph dot beginsWith: 'digraph {'].
self should: [graph dot last = $}]! !
!GraphVizGraphingTests methodsFor: 'as yet unclassified' stamp: 'jrp 2/26/2005 16:51'!
testSimplestGraph
self should: [graph dot beginsWith: 'graph {'].
self should: [graph dot last = $}]! !
!GraphVizGraphingTests methodsFor: 'as yet unclassified' stamp: 'jrp 3/1/2005 07:38'!
testSubGraph
graph subgraph: #nested do:
[graph add: #A].
self should: [(graph dot lineNumber: 2) = ' subgraph nested {'].
self should: [(graph dot lineNumber: 3) = ' A;'].
self should: [(graph dot lineNumber: 4) = ' }'].
self should: [(graph dot lineNumber: 5) = '}'].! !
GraphVizBaseTests subclass: #GraphVizLayoutTests
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'GraphViz-Tests'!
!GraphVizLayoutTests methodsFor: 'as yet unclassified' stamp: 'lr 9/4/2010 14:47'!
testGetCoordinatesForEdges
| edge |
edge := graph add: #A -> #B.
graph doLayout.
self should: [edge vertices size = 4].
self should: [edge vertices first isPoint].
self should: [edge vertices first x > 0].
self should: [edge vertices first y > 0]! !
!GraphVizLayoutTests methodsFor: 'as yet unclassified' stamp: 'lr 9/4/2010 14:47'!
testGetCoordinatesForNodes
| node |
graph add: #A -> #B.
graph doLayout.
node := graph nodeNamed: #A.
self should: [node x > 0].
self should: [node y > 0].
self should: [node height > 0].
self should: [node width > 0]! !
!GraphVizLayoutTests methodsFor: 'as yet unclassified' stamp: 'lr 9/4/2010 14:47'!
testGetCoordinatesForNodesDefinedInSubgraph
| node |
graph subgraphDo: [node := graph add: #A].
graph doLayout.
self should: [node x > 0].
self should: [node y > 0].
self should: [node height > 0].
self should: [node width > 0]! !
GraphVizBaseTests subclass: #GraphVizOSProcessGeneratorTests
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'GraphViz-Tests'!
!GraphVizOSProcessGeneratorTests commentStamp: 'dtl 3/18/2005 22:46' prior: 0!
These tests should pass if and only if:
- This Squeak image is running on a Unix VM, including Unix, Linux, and Mac OS X systems.
- The Graphviz programs are installed on the underlying operating system, including the 'dot' and 'dot2gxl' programs.
- The Squeak OSProcess package is installed.
- The Squeak CommandShell package is installed.!
!GraphVizOSProcessGeneratorTests class methodsFor: 'as yet unclassified' stamp: 'dtl 3/20/2005 16:59'!
isAbstract
^ [GraphViz defaultGeneratorClass ~= OSProcessGraphVizGenerator]
on: Warning
do: [^ true]
! !
!GraphVizOSProcessGeneratorTests methodsFor: 'testing' stamp: 'lr 9/4/2010 14:47'!
testCreateXmlDocument
"Note: This test uses a #match: that should pass regardless of whether
XMLDOMParser is present in the image."
| gv xml |
gv := self historyOfSmalltalk.
xml := gv asXml.
self assert: ('***' match: (xml asString last: 20))
! !
!GraphVizOSProcessGeneratorTests methodsFor: 'testing' stamp: 'dtl 3/18/2005 22:23'!
testDot2GxlExecutableInstalled
"The dot2gxl external program is used to create an XML description of a graph.
Note: Some versions of the dot2gxl program do not correctly flush
output to a pipe or file. This test will fail in that case, with the XML
data appearing to have been truncated. If this happens, install a new
version of the GraphViz package on your system."
self assert: (ShellSyntax new findExecutablePathFor: 'dot2gxl' inDirectoryPath: nil) notNil! !
!GraphVizOSProcessGeneratorTests methodsFor: 'testing' stamp: 'dtl 3/18/2005 21:19'!
testDotExecutableInstalled
"The dot external program is used to translate dot language files into a
variety of output formats."
self assert: (ShellSyntax new findExecutablePathFor: 'dot' inDirectoryPath: nil) notNil! !
!GraphVizOSProcessGeneratorTests methodsFor: 'testing' stamp: 'lr 9/4/2010 14:47'!
testGenerateDotOutput
"Verify that that extern dot program produced expected output"
| plain |
plain := self historyOfSmalltalk asOutputType: #plain.
self assert: ((plain last: 20) copyWithoutAll: (String cr, String lf)) = '58 solid blackstop'
! !
!GraphVizOSProcessGeneratorTests methodsFor: 'testing' stamp: 'lr 9/4/2010 14:47'!
testMakeDotFile
| gv fileName fs |
gv := self historyOfSmalltalk.
fileName := gv generator outputFileNameFor: #plain.
FileDirectory default deleteFileNamed: fileName ifAbsent: [].
gv make: #plain.
fs := FileStream fileNamed: fileName.
[self assert: ((fs contents last: 20) copyWithoutAll: (String cr, String lf)) = '58 solid blackstop']
ensure:
[fs close.
FileDirectory default deleteFileNamed: fileName ifAbsent: []]
! !
!GraphVizOSProcessGeneratorTests methodsFor: 'testing' stamp: 'dtl 3/18/2005 21:11'!
testOSProcessInstalled
self assert: (Smalltalk hasClassNamed: #OSProcess).
self assert: (Smalltalk hasClassNamed: #CommandShell)! !
GraphVizBaseTests subclass: #GraphVizWin32GeneratorTests
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'GraphViz-Tests'!
!GraphVizWin32GeneratorTests class methodsFor: 'as yet unclassified' stamp: 'jrp 3/19/2005 19:20'!
isAbstract
^ SmalltalkImage current platformName = 'Win 32'! !
!GraphVizWin32GeneratorTests methodsFor: 'as yet unclassified' stamp: 'jrp 3/17/2005 20:35'!
testCleanupAfterYourself
self should: [tempDir entries isEmpty].
graph add: #A.
graph asMorph.
graph asXml.
self should: [tempDir entries isEmpty].! !
!GraphVizWin32GeneratorTests methodsFor: 'as yet unclassified' stamp: 'lr 9/4/2010 14:47'!
testWaitForNewFile
| generator testFile |
generator := Win32GraphVizGenerator new.
testFile := tempDir fullPathFor: 'testFile'.
self should:
[generator
do: nil
blockUntilFileUpdated: testFile
waitingNoMoreThan: 1 second] raise: Error.
self shouldnt:
[generator
do: [(tempDir forceNewFileNamed: 'testFile') nextPut: $.; close]
blockUntilFileUpdated: testFile
waitingNoMoreThan: 1 second] raise: Error! !
!GraphVizWin32GeneratorTests methodsFor: 'as yet unclassified' stamp: 'lr 9/4/2010 14:47'!
testWaitForNewerFile
| generator testFile |
generator := Win32GraphVizGenerator new.
testFile := tempDir fullPathFor: 'testFile'.
(tempDir forceNewFileNamed: 'testFile') close.
self should:
[generator
do: nil
blockUntilFileUpdated: testFile
waitingNoMoreThan: 1 second] raise: Error.
self shouldnt:
[generator
do: [(tempDir forceNewFileNamed: 'testFile') nextPut: $.; close]
blockUntilFileUpdated: testFile
waitingNoMoreThan: 1 second] raise: Error! !
!SystemOrganizer methodsFor: '*GraphViz' stamp: 'lr 9/4/2010 14:47'!
graphForCategoriesMatching: matchingString
| graph edges |
graph := GraphViz new.
graph beDirected.
graph
name: matchingString, ' class hierarchy';
add: #graph with: {#overlap -> #scale. #concentrate -> #true. #ranksep -> 0.25};
add: #node with: {#shape -> #box. #fontsize -> 10. #style -> #filled. #fillcolor -> #tomato. #height -> 0.25};
add: #edge with: {#arrowsize -> 0.5}.
edges := Set new.
(SystemOrganization categoriesMatching: (matchingString, '*')) do:
[:cat |
(SystemOrganization listAtCategoryNamed: cat) do:
[:klass | | browser hierarchy |
graph add: klass with: {#fillcolor -> #palegreen}.
browser := HierarchyBrowser new initHierarchyForClass: (Smalltalk at: klass).
hierarchy := (browser classList collect: [:each | each withBlanksTrimmed asSymbol]).
hierarchy := hierarchy first: (hierarchy indexOf: klass).
1 to: hierarchy size - 1 do: [:i | edges add: (hierarchy at: i) -> (hierarchy at: i + 1)]]].
edges do: [:each | graph add: each with: {#arrowtail -> #normal. #arrowhead -> #none}].
graph add: #graph with: {#label -> matchingString. #fontsize -> 20}.
^ graph
! !
Object subclass: #GraphVizCostume
instanceVariableNames: 'graph nodes edges'
classVariableNames: ''
poolDictionaries: ''
category: 'GraphViz-Connectors'!
!GraphVizCostume methodsFor: 'releasing' stamp: 'jrp 3/26/2005 10:42'!
deleteAll
self nodes values do: [:each | each delete].
self edges do: [:each | each delete].! !
!GraphVizCostume methodsFor: 'accessing' stamp: 'jrp 3/26/2005 10:41'!
edges
^ edges! !
!GraphVizCostume methodsFor: 'accessing' stamp: 'jrp 3/20/2005 13:12'!
graph
^ graph! !
!GraphVizCostume methodsFor: 'accessing' stamp: 'lr 9/4/2010 14:47'!
graph: aGraphViz
graph := aGraphViz! !
!GraphVizCostume methodsFor: 'initialization' stamp: 'lr 9/4/2010 14:47'!
initialize
nodes := Dictionary new.
edges := OrderedCollection new.! !
!GraphVizCostume methodsFor: 'accessing' stamp: 'jrp 3/26/2005 10:41'!
nodes
^ nodes! !
!GraphVizCostume methodsFor: 'displaying' stamp: 'lr 9/4/2010 14:47'!
openInWorld
| graphHeight pasteUp scrollPane window desiredExtent |
graph doLayout.
scrollPane := ScrollPane new.
pasteUp := PasteUpMorph new.
pasteUp extent: ((graph extent scaleBy: 1.2 @ 1.2) asIntegerPoint max: 300 @ 300).
pasteUp color: Color transparent.
pasteUp borderWidth: 0.
scrollPane scroller addMorph: pasteUp.
graphHeight := graph extent y.
graph allNodesDo:
[:each | | costume |
costume := each shape = #box ifTrue: [NCTextRectangleMorph new] ifFalse: [NCEllipseMorph new].
costume color: Color white.
self nodes at: each put: costume.
each style = #filled ifTrue: [costume color: (GraphViz colors at: each fillcolor)].
costume setAllFontsTo: (TextStyle default fontOfSize: each fontSize).
costume firstEmptyTextMorph
margins: 5 @ 0;
contents: each id asString.
costume center: each x @ (graphHeight - each y).
pasteUp addMorphBack: costume].
graph allEdgesDo:
[:each | | connector |
connector := NCAAConnectorMorph
fromMorph: (self nodes at: each fromNode)
toMorph: (self nodes at: each toNode).
connector beSmoothCurve.
"connector beOrthogonal: true."
graph isDirected ifTrue:
[(each arrowtail ~= #none and: [each arrowhead ~= #none])
ifTrue: [connector makeBothArrows]
ifFalse:
[each arrowhead ~= #none
ifTrue: [connector makeForwardArrow]
ifFalse: [connector makeBackArrow]]].
connector lineWidth: 1.
connector arrowScales: 0.75.
connector setVertices: (each vertices collect: [:vertex | vertex x @ (graphHeight - vertex y)]).
self edges add: connector].
window := (SystemWindow labelled: graph name) model: nil.
desiredExtent := pasteUp extent + ((window borderWidth * 2) @ (window borderWidth * 2 + window labelHeight)).
window extent: ((desiredExtent max: 300 @ 300) min: 800 @ 800).
window
addMorph: scrollPane
frame: (0 @ 0 extent: 1 @ 1).
window setWindowColor: Color lightOrange lighter lighter.
window openAsIs.! !
Object subclass: #GraphVizGenerator
instanceVariableNames: 'outputPath graph preferredProgram'
classVariableNames: ''
poolDictionaries: ''
category: 'GraphViz-Generators'!
GraphVizGenerator subclass: #FileBasedGraphVizGenerator
instanceVariableNames: 'durationToWaitForGenerating deleteIntermediateFiles'
classVariableNames: ''
poolDictionaries: ''
category: 'GraphViz-Generators'!
!FileBasedGraphVizGenerator methodsFor: 'accessing' stamp: 'lr 9/4/2010 14:47'!
beClean
deleteIntermediateFiles := true! !
!FileBasedGraphVizGenerator methodsFor: 'accessing' stamp: 'lr 9/4/2010 14:47'!
beMessy
deleteIntermediateFiles := false! !
!FileBasedGraphVizGenerator methodsFor: 'private' stamp: 'lr 9/4/2010 14:47'!
cleanUpIntermediateFilesAsAppropriate
| entries |
deleteIntermediateFiles ifFalse: [^ self].
self outputFileDirectory deleteFileNamed: self dotFileName.
entries := self outputFileDirectory matchingEntries: (self baseFileName, '.*').
entries do: [:each | self outputFileDirectory deleteFileNamed: each name]! !
!FileBasedGraphVizGenerator methodsFor: 'generating' stamp: 'jrp 3/27/2005 18:53'!
commandLineForFormat: outputFormat
self subclassResponsibility! !
!FileBasedGraphVizGenerator methodsFor: 'private' stamp: 'lr 9/4/2010 14:47'!
do: aBlock blockUntilFileUpdated: file waitingNoMoreThan: duration
| originalModTime returnValue stopwatch |
originalModTime := self modificationTimeOf: file.
returnValue := aBlock value.
stopwatch := Stopwatch new.
stopwatch activate.
[stopwatch duration < duration] whileTrue:
[(self modificationTimeOf: file) ifNotNilDo:
[:latestModTime | | testfile |
"if file is openable for writing then probably the external process is done"
testfile := FileStream fileNamed: file.
testfile ifNotNil:
[testfile close.
originalModTime
ifNil: [^ returnValue] "file did not exist before and now exists"
ifNotNil: [latestModTime > originalModTime ifTrue: [^ returnValue]]]].
150 milliSeconds asDelay wait].
self error: 'Timeout expired waiting for ', file, ' to be updated!!'! !
!FileBasedGraphVizGenerator methodsFor: 'accessing' stamp: 'jrp 3/25/2005 20:13'!
durationToWaitForGenerating
^ durationToWaitForGenerating ifNil: [30 seconds]! !
!FileBasedGraphVizGenerator methodsFor: 'accessing' stamp: 'lr 9/4/2010 14:47'!
durationToWaitForGenerating: aDuration
durationToWaitForGenerating := aDuration! !
!FileBasedGraphVizGenerator methodsFor: 'generating' stamp: 'jrp 3/25/2005 20:28'!
evaluateUsing: externalProgram forType: outputFormat
self
runOSProcess: externalProgram
with: (self commandLineForFormat: outputFormat)! !
!FileBasedGraphVizGenerator methodsFor: 'generating' stamp: 'lr 9/4/2010 14:47'!
generateType: outputTypeString
"Run dot and produce a string with the requested output type. See the
documentation for dot for a list of supported output types."
| fs converterClass |
self make: outputTypeString.
fs := FileStream readOnlyFileNamed: (self outputFileNameFor: outputTypeString).
[converterClass := Smalltalk
at: #Latin1TextConverter
ifAbsent: [nil].
converterClass ifNotNil: [fs converter: converterClass new].
^ fs contentsOfEntireFile] ensure:
[fs close.
self cleanUpIntermediateFilesAsAppropriate]! !
!FileBasedGraphVizGenerator methodsFor: 'initialization' stamp: 'jrp 3/25/2005 20:29'!
initialize
super initialize.
self beClean! !
!FileBasedGraphVizGenerator methodsFor: 'generating' stamp: 'jrp 3/27/2005 17:57'!
make: outputFormat
^ self
do: [self makeNoWait: outputFormat]
blockUntilFileUpdated: (self outputFileNameFor: outputFormat)
waitingNoMoreThan: self durationToWaitForGenerating! !
!FileBasedGraphVizGenerator methodsFor: 'generating' stamp: 'jrp 3/27/2005 17:57'!
makeNoWait: outputFormat
self writeDotFile.
self evaluateUsing: self preferredProgram forType: outputFormat.
^ self outputFileNameFor: outputFormat! !
!FileBasedGraphVizGenerator methodsFor: 'accessing' stamp: 'jrp 3/25/2005 20:14'!
modificationTimeOf: aString
^ (FileDirectory directoryEntryFor: aString) ifNotNilDo: [:entry | entry modificationTime]! !
!FileBasedGraphVizGenerator methodsFor: 'external' stamp: 'jrp 3/25/2005 20:30'!
runOSProcess: command with: arguments
self subclassResponsibility! !
FileBasedGraphVizGenerator subclass: #MacOSGraphVizGenerator
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'GraphViz-Generators'!
!MacOSGraphVizGenerator methodsFor: 'accessing' stamp: 'lr 9/4/2010 14:47'!
commandLineForFormat: outputFormat
| file |
file := self outputCommandLineFileNameFor: outputFormat.
^ String streamContents:
[:stream |
stream
nextPutAll: self outputPathForCommandLine;
nextPutAll: self dotFileName;
nextPutAll: ' -T';
nextPutAll: outputFormat;
nextPutAll: ' -o ';
nextPutAll: file]! !
!MacOSGraphVizGenerator methodsFor: 'generating' stamp: 'bvs 5/2/2005 21:11'!
createMorph
^ [(PNGReadWriter createAFormFrom: (self generateType: #png)) first asMorph]
ensure: [self cleanUpIntermediateFilesAsAppropriate]! !
!MacOSGraphVizGenerator methodsFor: 'as yet unclassified' stamp: 'bvs 5/2/2005 21:56'!
make: outputFormat
^ self
do: [self makeNoWait: outputFormat]
blockUntilFileUpdated: (self outputPath, ':', self baseFileName, '.', outputFormat)
waitingNoMoreThan: self durationToWaitForGenerating! !
!MacOSGraphVizGenerator methodsFor: 'as yet unclassified' stamp: 'bvs 5/2/2005 21:59'!
outputCommandLineFileNameFor: extension
^ self outputPathForCommandLine, self baseFileName, '.', extension.
! !
!MacOSGraphVizGenerator methodsFor: 'as yet unclassified' stamp: 'lr 9/4/2010 14:47'!
outputPathForCommandLine
| path |
path := self outputPath
copyReplaceAll: ':'
with: '/'.
path := path
copyReplaceAll: ' '
with: '\ '.
(path endsWith: '/') ifFalse: [path := path, '/'].
^ '/Volumes/', path
! !
!MacOSGraphVizGenerator methodsFor: 'private' stamp: 'lr 9/4/2010 14:47'!
runOSProcess: command with: arguments
| helperCommand |
helperCommand := '/Applications/GraphViz.app/Contents/MacOS/', command.
helperCommand := helperCommand, ' ', arguments.
self runWithSystemFramework: helperCommand.
! !
!MacOSGraphVizGenerator methodsFor: 'external calls' stamp: 'lr 9/13/2008 10:19'!
runWithSystemFramework: string
^ self externalCallFailed ! !
FileBasedGraphVizGenerator subclass: #Win32GraphVizGenerator
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'GraphViz-Generators'!
!Win32GraphVizGenerator methodsFor: 'accessing' stamp: 'lr 9/4/2010 14:47'!
commandLineForFormat: outputFormat
| file |
file := self outputFileNameFor: outputFormat.
^ String streamContents:
[:stream |
stream
nextPut: $";
nextPutAll: self dotFileName;
nextPutAll: '" -T';
nextPutAll: outputFormat;
nextPutAll: ' -o "';
nextPutAll: file;
nextPut: $"]! !
!Win32GraphVizGenerator methodsFor: 'creation' stamp: 'jrp 3/19/2005 15:03'!
createMorph
^ [(PNGReadWriter createAFormFrom: (self generateType: #png)) first asMorph]
ensure: [self cleanUpIntermediateFilesAsAppropriate]! !
!Win32GraphVizGenerator methodsFor: 'creation' stamp: 'lr 9/4/2010 14:47'!
createXMLDocument
| file parser xml |
file := self make: #dot.
file := self
do: [self launchDot2Gxl: file]
blockUntilFileUpdated: (self outputFileNameFor: #xml)
waitingNoMoreThan: self durationToWaitForGenerating.
parser := Smalltalk at: #XMLDOMParser ifAbsent: [nil].
xml := FileStream readOnlyFileNamed: file.
^ [parser
ifNil: [xml contents]
ifNotNil: [parser parseDocumentFrom: xml]] ensure: [xml close. self cleanUpIntermediateFilesAsAppropriate]! !
!Win32GraphVizGenerator methodsFor: 'external' stamp: 'jrp 5/2/2005 23:37'!
launchDot2Gxl: inputFile
| xmlFile |
xmlFile := self outputFileNameFor: #xml.
self
runOSProcess: 'dot2gxl'
with: ('-o "', xmlFile, '" "', inputFile, '"').
^ xmlFile! !
!Win32GraphVizGenerator methodsFor: 'creation' stamp: 'lr 9/4/2010 14:47'!
openInBrowser
| file |
file := self make: #svg.
file := self writeHtmlSvgFor: file.
Win32Shell new shellOpen: file! !
!Win32GraphVizGenerator methodsFor: 'external' stamp: 'jrp 5/2/2005 23:35'!
runOSProcess: command with: arguments
| shell |
shell := Win32Shell new.
shell
shellExecute: nil
lpOperation: 'open'
lpFile: command
lpParameters: arguments
lpDirectory: self outputPath
nShowCmd: 0! !
!GraphVizGenerator class methodsFor: 'as yet unclassified' stamp: 'lr 9/4/2010 14:47'!
newFor: aGraphViz
| generator |
generator := self new.
generator graph: aGraphViz.
^ generator! !
!GraphVizGenerator methodsFor: 'accessing' stamp: 'jrp 3/13/2005 22:22'!
baseFileName
^ self graph name! !
!GraphVizGenerator methodsFor: 'creation' stamp: 'jrp 3/13/2005 22:40'!
createMorph
"builds and returns a morph"
self subclassResponsibility! !
!GraphVizGenerator methodsFor: 'creation' stamp: 'jrp 3/13/2005 22:41'!
createXMLDocument
"builds and returns an XMLDocument"
self subclassResponsibility! !
!GraphVizGenerator methodsFor: 'accessing' stamp: 'jrp 3/5/2005 16:14'!
dotExtension
^ '.txt'! !
!GraphVizGenerator methodsFor: 'accessing' stamp: 'jrp 3/3/2005 22:16'!
dotFileName
^ self baseFileName, self dotExtension! !
!GraphVizGenerator methodsFor: 'generating' stamp: 'jrp 3/27/2005 18:58'!
evaluateUsing: externalProgram forType: outputFormat
self subclassResponsibility! !
!GraphVizGenerator methodsFor: 'generating' stamp: 'dtl 3/18/2005 22:34'!
generateType: outputTypeString
"Run dot and produce a string with the requested output type. See the
documentation for dot for a list of supported output types."
^ self subclassResponsibility! !
!GraphVizGenerator methodsFor: 'accessing' stamp: 'jrp 3/3/2005 22:11'!
graph
^ graph! !
!GraphVizGenerator methodsFor: 'accessing' stamp: 'lr 9/4/2010 14:47'!
graph: aGraphViz
graph := aGraphViz! !
!GraphVizGenerator methodsFor: 'accessing' stamp: 'jrp 3/13/2005 23:54'!
htmlSvgStringFor: svgFile
^ String streamContents:
[:stream |
stream
nextPutAll: '';
nextPutAll: self graph name;
nextPutAll: '']
! !
!GraphVizGenerator methodsFor: 'generating' stamp: 'jrp 3/13/2005 22:39'!
make: outputFormat
"makes the requested output format on disk and returns full filename to output file
e.g. write a SVG output file and returns full path to the output file"
self subclassResponsibility! !
!GraphVizGenerator methodsFor: 'accessing' stamp: 'lr 9/4/2010 14:47'!
outputFileDirectory
| fileDirectory |
fileDirectory := FileDirectory on: self outputPath.
fileDirectory assureExistence.
^ fileDirectory! !
!GraphVizGenerator methodsFor: 'accessing' stamp: 'jrp 3/27/2005 18:01'!
outputFileNameFor: extension
^ self outputFileDirectory fullPathFor: (self baseFileName, '.', extension)! !
!GraphVizGenerator methodsFor: 'accessing' stamp: 'jrp 3/27/2005 17:44'!
outputPath
^ outputPath ifNil: [(FileDirectory default directoryNamed: #dot) fullName]
! !
!GraphVizGenerator methodsFor: 'accessing' stamp: 'lr 9/4/2010 14:47'!
outputPath: aString
outputPath := aString! !
!GraphVizGenerator methodsFor: 'accessing' stamp: 'jrp 5/2/2005 23:34'!
preferredProgram
^ preferredProgram ifNil: [self graph isDirected ifTrue: ['dot'] ifFalse: ['neato']]
! !
!GraphVizGenerator methodsFor: 'accessing' stamp: 'lr 9/4/2010 14:47'!
preferredProgram: aSymbol
preferredProgram := aSymbol! !
!GraphVizGenerator methodsFor: 'generating' stamp: 'jrp 3/3/2005 22:12'!
writeDotFile
self writeDotFileNamed: self dotFileName! !
!GraphVizGenerator methodsFor: 'generating' stamp: 'lr 9/4/2010 14:47'!
writeDotFileNamed: aString
| fileName file |
fileName := aString.
(aString endsWith: self dotExtension) ifFalse: [fileName := fileName, self dotExtension].
file := self outputFileDirectory forceNewFileNamed: fileName.
[file nextPutAll: self graph dot] ensure: [file close]! !
!GraphVizGenerator methodsFor: 'generating' stamp: 'lr 9/4/2010 14:47'!
writeHtmlSvgFor: svgFile
| fileName html |
fileName := self outputFileNameFor: #html.
html := FileStream forceNewFileNamed: fileName.
[html nextPutAll: (self htmlSvgStringFor: svgFile)] ensure: [html close].
^ fileName! !
GraphVizGenerator subclass: #OSProcessGraphVizGenerator
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'GraphViz-Generators'!
!OSProcessGraphVizGenerator methodsFor: 'converting' stamp: 'dtl 3/15/2005 22:08'!
createMorph
"builds and returns a morph"
^ (PNGReadWriter createAFormFrom: (self generateType: #png)) first asMorph
! !
!OSProcessGraphVizGenerator methodsFor: 'converting' stamp: 'lr 9/4/2010 14:47'!
createXMLDocument
"builds and returns an XMLDocument"
"Warning: Some versions of the dot2gxl program do not correctly flush
output to a pipe or file. This method will fail in that case, with the XML
data appearing to have been truncated. If this happens, install a new
version of the GraphViz package on your system."
| dot2gxlProcess xml parser |
dot2gxlProcess := self externalCommand: 'dot2gxl'.
[xml := dot2gxlProcess
nextPutAll: (self generateType: #dot);
close;
output]
on: Error
do: [self notify: dot2gxlProcess errorPipelineContents.
^ xml ifNil: ['']].
dot2gxlProcess succeeded ifFalse:
[self notify: dot2gxlProcess errorPipelineContents].
parser := Smalltalk at: #XMLDOMParser ifAbsent: [].
^ parser
ifNil: [xml]
ifNotNil: [parser parseDocumentFrom: xml readStream]! !
!OSProcessGraphVizGenerator methodsFor: 'generating' stamp: 'dtl 3/25/2005 13:16'!
dotSourceWithLineFeedTerminators
"The external programs expect line terminators on Unix systems"
^ self graph dot copyReplaceAll: String cr with: String lf! !
!OSProcessGraphVizGenerator methodsFor: 'generating' stamp: 'dtl 3/25/2005 13:17'!
evaluateUsing: externalProgram forType: outputFormat
"Use OSProcess to run external program (i.e. dot, neato, fdp, twopi) and produce the requested output type.
See the documentation for dot for a list of supported output types. No external
files are produced. Answer the completed PipeableOSProcess."
^ (self externalCommand: externalProgram, ' -T', outputFormat)
nextPutAll: self dotSourceWithLineFeedTerminators;
close! !
!OSProcessGraphVizGenerator methodsFor: 'generating' stamp: 'dtl 3/19/2005 09:03'!
externalCommand: commandString
"Use OSProcess to evaluate an external command in a PipeableOSProcess.
Answer the PipeableOSProcess. The sender can obtain output streams and
exit status from the completed PipeableOSProcess as required."
^ (Smalltalk
at: #PipeableOSProcess
ifAbsent: [self notify: 'OSProcess and CommandShell packages not loaded in this image'])
command: commandString! !
!OSProcessGraphVizGenerator methodsFor: 'generating' stamp: 'lr 9/4/2010 14:47'!
generateType: outputTypeString
"Use OSProcess to run dot and produce the requested output type. See the
documentation for dot for a list of supported output types. No external
files are produced."
| dotProcess outputString |
dotProcess := self
evaluateUsing: self preferredProgram
forType: outputTypeString.
outputString := dotProcess output.
dotProcess succeeded
ifFalse: [self notify: dotProcess errorPipelineContents].
^ outputString
! !
!OSProcessGraphVizGenerator methodsFor: 'generating' stamp: 'lr 9/4/2010 14:47'!
make: outputFormat
"makes the requested output format on disk and returns full filename to output file
e.g. write a SVG output file and returns full path to the output file"
| fileName fs |
fileName := self outputFileNameFor: outputFormat.
fs := FileStream newFileNamed: fileName.
[fs nextPutAll: (self generateType: outputFormat)] ensure: [fs close].
^ fileName
! !
Object subclass: #GraphVizItem
instanceVariableNames: 'id'
classVariableNames: ''
poolDictionaries: ''
category: 'GraphViz-Model'!
GraphVizItem subclass: #GraphVizAttributableItem
instanceVariableNames: 'attributes inheritedStyle'
classVariableNames: ''
poolDictionaries: ''
category: 'GraphViz-Model'!
!GraphVizAttributableItem methodsFor: 'accessing' stamp: 'jrp 3/29/2005 20:08'!
attributeAt: symbol
^ self attributes at: symbol! !
!GraphVizAttributableItem methodsFor: 'accessing' stamp: 'jrp 3/29/2005 20:09'!
attributeAt: symbol ifAbsent: aBlock
^ self attributes at: symbol ifAbsent: aBlock! !
!GraphVizAttributableItem methodsFor: 'accessing' stamp: 'jrp 3/29/2005 18:42'!
attributeAt: key put: value
attributes at: key put: value! !
!GraphVizAttributableItem methodsFor: 'accessing' stamp: 'jrp 3/29/2005 19:40'!
attributes
^ (Dictionary newFrom: inheritedStyle attributes) addAll: attributes; yourself! !
!GraphVizAttributableItem methodsFor: 'error handling' stamp: 'lr 9/4/2010 14:47'!
doesNotUnderstand: aMessage
| argCount |
argCount := aMessage arguments size.
argCount = 0 ifTrue: [^ self attributeAt: aMessage selector].
argCount = 1 ifTrue: [^ self attributeAt: aMessage selector allButLast put: aMessage argument].
^ super doesNotUnderstand: aMessage! !
!GraphVizAttributableItem methodsFor: 'accessing' stamp: 'jrp 3/29/2005 17:19'!
fontSize
^ (self attributeAt: #fontsize ifAbsent: [14]) asNumber! !
!GraphVizAttributableItem methodsFor: 'accessing' stamp: 'lr 9/4/2010 14:47'!
inheritedStyle: aGraphVizStyle
inheritedStyle := aGraphVizStyle! !
!GraphVizAttributableItem methodsFor: 'initialization' stamp: 'lr 9/4/2010 14:47'!
initialize
attributes := Dictionary new! !
!GraphVizAttributableItem methodsFor: 'printing' stamp: 'jrp 3/13/2005 15:59'!
printOn: stream
super printOn: stream.
self writeAttributesOn: stream.! !
!GraphVizAttributableItem methodsFor: 'streaming' stamp: 'jrp 3/13/2005 14:44'!
writeAttributesOn: stream
self attributes ifEmpty: [^ self].
stream nextPutAll: ' ['.
self attributes associations
do: [:each | self writeAttribute: each key value: each value on: stream]
separatedBy: [stream nextPut: $,].
stream nextPutAll: ']'! !
GraphVizAttributableItem subclass: #GraphVizEdge
instanceVariableNames: 'fromNode toNode'
classVariableNames: ''
poolDictionaries: ''
category: 'GraphViz-Model'!
!GraphVizEdge methodsFor: 'accessing' stamp: 'jrp 4/3/2005 22:31'!
arrowhead
^ self attributes at: #arrowhead ifAbsent:
[self dir caseOf: {
[#forward] -> [#normal].
[#both] -> [#normal]}
otherwise: [#none]]! !
!GraphVizEdge methodsFor: 'accessing' stamp: 'jrp 4/3/2005 22:31'!
arrowtail
^ self attributes at: #arrowtail ifAbsent:
[self dir caseOf: {
[#back] -> [#normal].
[#both] -> [#normal]}
otherwise: [#none]]! !
!GraphVizEdge methodsFor: 'accessing' stamp: 'jrp 4/3/2005 22:15'!
dir
^ self attributes at: #dir ifAbsent: [fromNode graph isDirected ifTrue: [#forward] ifFalse: [#none]]! !
!GraphVizEdge methodsFor: 'accessing' stamp: 'jrp 3/20/2005 21:56'!
fromNode
^ fromNode! !
!GraphVizEdge methodsFor: 'accessing' stamp: 'lr 9/4/2010 14:47'!
fromNode: aGraphVizNode
fromNode := aGraphVizNode! !
!GraphVizEdge methodsFor: 'testing' stamp: 'jrp 3/6/2005 21:17'!
isEdge
^ true! !
!GraphVizEdge methodsFor: 'accessing' stamp: 'jrp 3/8/2005 07:01'!
nodeType
^ #edge! !
!GraphVizEdge methodsFor: 'accessing' stamp: 'jrp 3/20/2005 21:56'!
toNode
^ toNode! !
!GraphVizEdge methodsFor: 'accessing' stamp: 'lr 9/4/2010 14:47'!
toNode: aGraphVizNode
toNode := aGraphVizNode! !
!GraphVizEdge methodsFor: 'accessing' stamp: 'lr 9/4/2010 14:47'!
vertices
| pos |
pos := self pos ifNil: [^ #()].
^ (pos findTokens: ' ') collect:
[:each | | point |
point := each findTokens: ','.
point first asNumber @ point second asNumber]! !
!GraphVizEdge methodsFor: 'streaming' stamp: 'jrp 3/20/2005 21:58'!
writeContentsOn: stream withIndent: aNumber for: graph
stream nextPutAll: (self safeIdFor: self fromNode id).
graph isDirected
ifTrue: [stream nextPutAll: ' -> ']
ifFalse: [stream nextPutAll: ' -- '].
stream nextPutAll: (self safeIdFor: self toNode id).
self writeAttributesOn: stream.! !
GraphVizAttributableItem subclass: #GraphVizNode
instanceVariableNames: 'graph'
classVariableNames: ''
poolDictionaries: ''
category: 'GraphViz-Model'!
!GraphVizNode methodsFor: 'accessing' stamp: 'jrp 4/3/2005 22:14'!
graph
^ graph! !
!GraphVizNode methodsFor: 'accessing' stamp: 'lr 9/4/2010 14:47'!
graph: aGraphVizGraph
graph := aGraphVizGraph! !
!GraphVizNode methodsFor: 'testing' stamp: 'jrp 3/6/2005 21:18'!
isNode
^ true! !
!GraphVizNode methodsFor: 'accessing' stamp: 'jrp 3/8/2005 07:01'!
nodeType
^ #node! !
!GraphVizNode methodsFor: 'streaming' stamp: 'jrp 3/13/2005 14:42'!
writeContentsOn: stream withIndent: aNumber for: graph
stream nextPutAll: self safeId.
self writeAttributesOn: stream.! !
!GraphVizNode methodsFor: 'accessing' stamp: 'lr 9/4/2010 14:47'!
x
| pos |
pos := self attributes at: #pos ifAbsent: [^ nil].
^ (pos findTokens: ',') first asNumber! !
!GraphVizNode methodsFor: 'accessing' stamp: 'lr 9/4/2010 14:47'!
y
| pos |
pos := self attributes at: #pos ifAbsent: [^ nil].
^ (pos findTokens: ',') second asNumber! !
GraphVizNode subclass: #GraphVizStyle
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'GraphViz-Model'!
!GraphVizStyle class methodsFor: 'as yet unclassified' stamp: 'jrp 3/13/2005 15:47'!
styleNodes
^ #(graph node edge) ! !
!GraphVizStyle methodsFor: 'accessing' stamp: 'jrp 3/29/2005 18:55'!
attributes
^ attributes! !
!GraphVizStyle methodsFor: 'testing' stamp: 'jrp 3/13/2005 15:55'!
isNode
^ false! !
!GraphVizStyle methodsFor: 'testing' stamp: 'jrp 3/13/2005 15:33'!
isStyle
^ true! !
!GraphVizStyle methodsFor: 'accessing' stamp: 'jrp 3/13/2005 15:56'!
nodeType
^ #style! !
GraphVizItem subclass: #GraphVizAttribute
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'GraphViz-Model'!
!GraphVizAttribute methodsFor: 'testing' stamp: 'jrp 3/11/2005 19:44'!
isAttribute
^ true! !
!GraphVizAttribute methodsFor: 'accessing' stamp: 'jrp 3/11/2005 19:41'!
key
^ self id key! !
!GraphVizAttribute methodsFor: 'accessing' stamp: 'jrp 3/12/2005 19:15'!
nodeType
^ #attribute "should not be used by anyone, but this rounds out the need to implement this subclass responsibility"! !
!GraphVizAttribute methodsFor: 'accessing' stamp: 'jrp 3/11/2005 19:42'!
value
^ self id value! !
!GraphVizAttribute methodsFor: 'streaming' stamp: 'jrp 3/13/2005 14:20'!
writeContentsOn: stream withIndent: aNumber for: graph
self writeAttribute: self key value: self value on: stream! !
GraphVizItem subclass: #GraphVizGraph
instanceVariableNames: 'directed children currentGraphReceiver nodes layoutSize edges currentNodeStyle currentEdgeStyle'
classVariableNames: ''
poolDictionaries: ''
category: 'GraphViz-Model'!
GraphVizGraph subclass: #GraphViz
instanceVariableNames: 'generator generatorClass extent'
classVariableNames: ''
poolDictionaries: ''
category: 'GraphViz'!
GraphViz class
instanceVariableNames: 'colorsByName'!
GraphViz class
instanceVariableNames: 'colorsByName'!
!GraphViz class methodsFor: 'accessing' stamp: 'lr 9/4/2010 14:47'!
colors
| colorList |
^ colorsByName ifNil: [
colorList :=
'aliceblue;#f0f8ff
antiquewhite;#faebd7
antiquewhite1;#ffefdb
antiquewhite2;#eedfcc
antiquewhite3;#cdc0b0
antiquewhite4;#8b8378
aquamarine;#7fffd4
aquamarine1;#7fffd4
aquamarine2;#76eec6
aquamarine3;#66cdaa
aquamarine4;#458b74
azure;#f0ffff
azure1;#f0ffff
azure2;#e0eeee
azure3;#c1cdcd
azure4;#838b8b
beige;#f5f5dc
bisque;#ffe4c4
bisque1;#ffe4c4
bisque2;#eed5b7
bisque3;#cdb79e
bisque4;#8b7d6b
black;#000000
blanchedalmond;#ffebcd
blue;#0000ff
blue1;#0000ff
blue2;#0000ee
blue3;#0000cd
blue4;#00008b
blueviolet;#8a2be2
brown;#a52a2a
brown1;#ff4040
brown2;#ee3b3b
brown3;#cd3333
brown4;#8b2323
burlywood;#deb887
burlywood1;#ffd39b
burlywood2;#eec591
burlywood3;#cdaa7d
burlywood4;#8b7355
cadetblue;#5f9ea0
cadetblue1;#98f5ff
cadetblue2;#8ee5ee
cadetblue3;#7ac5cd
cadetblue4;#53868b
chartreuse;#7fff00
chartreuse1;#7fff00
chartreuse2;#76ee00
chartreuse3;#66cd00
chartreuse4;#458b00
chocolate;#d2691e
chocolate1;#ff7f24
chocolate2;#ee7621
chocolate3;#cd661d
chocolate4;#8b4513
coral;#ff7f50
coral1;#ff7256
coral2;#ee6a50
coral3;#cd5b45
coral4;#8b3e2f
cornflowerblue;#6495ed
cornsilk;#fff8dc
cornsilk1;#fff8dc
cornsilk2;#eee8cd
cornsilk3;#cdc8b1
cornsilk4;#8b8878
crimson;#dc143c
cyan;#00ffff
cyan1;#00ffff
cyan2;#00eeee
cyan3;#00cdcd
cyan4;#008b8b
darkgoldenrod;#b8860b
darkgoldenrod1;#ffb90f
darkgoldenrod2;#eead0e
darkgoldenrod3;#cd950c
darkgoldenrod4;#8b6508
darkgreen;#006400
darkkhaki;#bdb76b
darkolivegreen;#556b2f
darkolivegreen1;#caff70
darkolivegreen2;#bcee68
darkolivegreen3;#a2cd5a
darkolivegreen4;#6e8b3d
darkorange;#ff8c00
darkorange1;#ff7f00
darkorange2;#ee7600
darkorange3;#cd6600
darkorange4;#8b4500
darkorchid;#9932cc
darkorchid1;#bf3eff
darkorchid2;#b23aee
darkorchid3;#9a32cd
darkorchid4;#68228b
darksalmon;#e9967a
darkseagreen;#8fbc8f
darkseagreen1;#c1ffc1
darkseagreen2;#b4eeb4
darkseagreen3;#9bcd9b
darkseagreen4;#698b69
darkslateblue;#483d8b
darkslategray;#2f4f4f
darkslategray1;#97ffff
darkslategray2;#8deeee
darkslategray3;#79cdcd
darkslategray4;#528b8b
darkslategrey;#2f4f4f
darkturquoise;#00ced1
darkviolet;#9400d3
deeppink;#ff1493
deeppink1;#ff1493
deeppink2;#ee1289
deeppink3;#cd1076
deeppink4;#8b0a50
deepskyblue;#00bfff
deepskyblue1;#00bfff
deepskyblue2;#00b2ee
deepskyblue3;#009acd
deepskyblue4;#00688b
dimgray;#696969
dimgrey;#696969
dodgerblue;#1e90ff
dodgerblue1;#1e90ff
dodgerblue2;#1c86ee
dodgerblue3;#1874cd
dodgerblue4;#104e8b
firebrick;#b22222
firebrick1;#ff3030
firebrick2;#ee2c2c
firebrick3;#cd2626
firebrick4;#8b1a1a
floralwhite;#fffaf0
forestgreen;#228b22
gainsboro;#dcdcdc
ghostwhite;#f8f8ff
gold;#ffd700
gold1;#ffd700
gold2;#eec900
gold3;#cdad00
gold4;#8b7500
goldenrod;#daa520
goldenrod1;#ffc125
goldenrod2;#eeb422
goldenrod3;#cd9b1d
goldenrod4;#8b6914
gray;#c0c0c0
gray0;#000000
gray1;#030303
gray10;#1a1a1a
gray100;#ffffff
gray11;#1c1c1c
gray12;#1f1f1f
gray13;#212121
gray14;#242424
gray15;#262626
gray16;#292929
gray17;#2b2b2b
gray18;#2e2e2e
gray19;#303030
gray2;#050505
gray20;#333333
gray21;#363636
gray22;#383838
gray23;#3b3b3b
gray24;#3d3d3d
gray25;#404040
gray26;#424242
gray27;#454545
gray28;#474747
gray29;#4a4a4a
gray3;#080808
gray30;#4d4d4d
gray31;#4f4f4f
gray32;#525252
gray33;#545454
gray34;#575757
gray35;#595959
gray36;#5c5c5c
gray37;#5e5e5e
gray38;#616161
gray39;#636363
gray4;#0a0a0a
gray40;#666666
gray41;#696969
gray42;#6b6b6b
gray43;#6e6e6e
gray44;#707070
gray45;#737373
gray46;#757575
gray47;#787878
gray48;#7a7a7a
gray49;#7d7d7d
gray5;#0d0d0d
gray50;#7f7f7f
gray51;#828282
gray52;#858585
gray53;#878787
gray54;#8a8a8a
gray55;#8c8c8c
gray56;#8f8f8f
gray57;#919191
gray58;#949494
gray59;#969696
gray6;#0f0f0f
gray60;#999999
gray61;#9c9c9c
gray62;#9e9e9e
gray63;#a1a1a1
gray64;#a3a3a3
gray65;#a6a6a6
gray66;#a8a8a8
gray67;#ababab
gray68;#adadad
gray69;#b0b0b0
gray7;#121212
gray70;#b3b3b3
gray71;#b5b5b5
gray72;#b8b8b8
gray73;#bababa
gray74;#bdbdbd
gray75;#bfbfbf
gray76;#c2c2c2
gray77;#c4c4c4
gray78;#c7c7c7
gray79;#c9c9c9
gray8;#141414
gray80;#cccccc
gray81;#cfcfcf
gray82;#d1d1d1
gray83;#d4d4d4
gray84;#d6d6d6
gray85;#d9d9d9
gray86;#dbdbdb
gray87;#dedede
gray88;#e0e0e0
gray89;#e3e3e3
gray9;#171717
gray90;#e5e5e5
gray91;#e8e8e8
gray92;#ebebeb
gray93;#ededed
gray94;#f0f0f0
gray95;#f2f2f2
gray96;#f5f5f5
gray97;#f7f7f7
gray98;#fafafa
gray99;#fcfcfc
green;#00ff00
green1;#00ff00
green2;#00ee00
green3;#00cd00
green4;#008b00
greenyellow;#adff2f
grey;#c0c0c0
grey0;#000000
grey1;#030303
grey10;#1a1a1a
grey100;#ffffff
grey11;#1c1c1c
grey12;#1f1f1f
grey13;#212121
grey14;#242424
grey15;#262626
grey16;#292929
grey17;#2b2b2b
grey18;#2e2e2e
grey19;#303030
grey2;#050505
grey20;#333333
grey21;#363636
grey22;#383838
grey23;#3b3b3b
grey24;#3d3d3d
grey25;#404040
grey26;#424242
grey27;#454545
grey28;#474747
grey29;#4a4a4a
grey3;#080808
grey30;#4d4d4d
grey31;#4f4f4f
grey32;#525252
grey33;#545454
grey34;#575757
grey35;#595959
grey36;#5c5c5c
grey37;#5e5e5e
grey38;#616161
grey39;#636363
grey4;#0a0a0a
grey40;#666666
grey41;#696969
grey42;#6b6b6b
grey43;#6e6e6e
grey44;#707070
grey45;#737373
grey46;#757575
grey47;#787878
grey48;#7a7a7a
grey49;#7d7d7d
grey5;#0d0d0d
grey50;#7f7f7f
grey51;#828282
grey52;#858585
grey53;#878787
grey54;#8a8a8a
grey55;#8c8c8c
grey56;#8f8f8f
grey57;#919191
grey58;#949494
grey59;#969696
grey6;#0f0f0f
grey60;#999999
grey61;#9c9c9c
grey62;#9e9e9e
grey63;#a1a1a1
grey64;#a3a3a3
grey65;#a6a6a6
grey66;#a8a8a8
grey67;#ababab
grey68;#adadad
grey69;#b0b0b0
grey7;#121212
grey70;#b3b3b3
grey71;#b5b5b5
grey72;#b8b8b8
grey73;#bababa
grey74;#bdbdbd
grey75;#bfbfbf
grey76;#c2c2c2
grey77;#c4c4c4
grey78;#c7c7c7
grey79;#c9c9c9
grey8;#141414
grey80;#cccccc
grey81;#cfcfcf
grey82;#d1d1d1
grey83;#d4d4d4
grey84;#d6d6d6
grey85;#d9d9d9
grey86;#dbdbdb
grey87;#dedede
grey88;#e0e0e0
grey89;#e3e3e3
grey9;#171717
grey90;#e5e5e5
grey91;#e8e8e8
grey92;#ebebeb
grey93;#ededed
grey94;#f0f0f0
grey95;#f2f2f2
grey96;#f5f5f5
grey97;#f7f7f7
grey98;#fafafa
grey99;#fcfcfc
honeydew;#f0fff0
honeydew1;#f0fff0
honeydew2;#e0eee0
honeydew3;#c1cdc1
honeydew4;#838b83
hotpink;#ff69b4
hotpink1;#ff6eb4
hotpink2;#ee6aa7
hotpink3;#cd6090
hotpink4;#8b3a62
indianred;#cd5c5c
indianred1;#ff6a6a
indianred2;#ee6363
indianred3;#cd5555
indianred4;#8b3a3a
indigo;#4b0082
ivory;#fffff0
ivory1;#fffff0
ivory2;#eeeee0
ivory3;#cdcdc1
ivory4;#8b8b83
khaki;#f0e68c
khaki1;#fff68f
khaki2;#eee685
khaki3;#cdc673
khaki4;#8b864e
lavender;#e6e6fa
lavenderblush;#fff0f5
lavenderblush1;#fff0f5
lavenderblush2;#eee0e5
lavenderblush3;#cdc1c5
lavenderblush4;#8b8386
lawngreen;#7cfc00
lemonchiffon;#fffacd
lemonchiffon1;#fffacd
lemonchiffon2;#eee9bf
lemonchiffon3;#cdc9a5
lemonchiffon4;#8b8970
lightblue;#add8e6
lightblue1;#bfefff
lightblue2;#b2dfee
lightblue3;#9ac0cd
lightblue4;#68838b
lightcoral;#f08080
lightcyan;#e0ffff
lightcyan1;#e0ffff
lightcyan2;#d1eeee
lightcyan3;#b4cdcd
lightcyan4;#7a8b8b
lightgoldenrod;#eedd82
lightgoldenrod1;#ffec8b
lightgoldenrod2;#eedc82
lightgoldenrod3;#cdbe70
lightgoldenrod4;#8b814c
lightgoldenrodyellow;#fafad2
lightgray;#d3d3d3
lightgrey;#d3d3d3
lightpink;#ffb6c1
lightpink1;#ffaeb9
lightpink2;#eea2ad
lightpink3;#cd8c95
lightpink4;#8b5f65
lightsalmon;#ffa07a
lightsalmon1;#ffa07a
lightsalmon2;#ee9572
lightsalmon3;#cd8162
lightsalmon4;#8b5742
lightseagreen;#20b2aa
lightskyblue;#87cefa
lightskyblue1;#b0e2ff
lightskyblue2;#a4d3ee
lightskyblue3;#8db6cd
lightskyblue4;#607b8b
lightslateblue;#8470ff
lightslategray;#778899
lightslategrey;#778899
lightsteelblue;#b0c4de
lightsteelblue1;#cae1ff
lightsteelblue2;#bcd2ee
lightsteelblue3;#a2b5cd
lightsteelblue4;#6e7b8b
lightyellow;#ffffe0
lightyellow1;#ffffe0
lightyellow2;#eeeed1
lightyellow3;#cdcdb4
lightyellow4;#8b8b7a
limegreen;#32cd32
linen;#faf0e6
magenta;#ff00ff
magenta1;#ff00ff
magenta2;#ee00ee
magenta3;#cd00cd
magenta4;#8b008b
maroon;#b03060
maroon1;#ff34b3
maroon2;#ee30a7
maroon3;#cd2990
maroon4;#8b1c62
mediumaquamarine;#66cdaa
mediumblue;#0000cd
mediumorchid;#ba55d3
mediumorchid1;#e066ff
mediumorchid2;#d15fee
mediumorchid3;#b452cd
mediumorchid4;#7a378b
mediumpurple;#9370db
mediumpurple1;#ab82ff
mediumpurple2;#9f79ee
mediumpurple3;#8968cd
mediumpurple4;#5d478b
mediumseagreen;#3cb371
mediumslateblue;#7b68ee
mediumspringgreen;#00fa9a
mediumturquoise;#48d1cc
mediumvioletred;#c71585
midnightblue;#191970
mintcream;#f5fffa
mistyrose;#ffe4e1
mistyrose1;#ffe4e1
mistyrose2;#eed5d2
mistyrose3;#cdb7b5
mistyrose4;#8b7d7b
moccasin;#ffe4b5
navajowhite;#ffdead
navajowhite1;#ffdead
navajowhite2;#eecfa1
navajowhite3;#cdb38b
navajowhite4;#8b795e
navy;#000080
navyblue;#000080
oldlace;#fdf5e6
olivedrab;#6b8e23
olivedrab1;#c0ff3e
olivedrab2;#b3ee3a
olivedrab3;#9acd32
olivedrab4;#698b22
orange;#ffa500
orange1;#ffa500
orange2;#ee9a00
orange3;#cd8500
orange4;#8b5a00
orangered;#ff4500
orangered1;#ff4500
orangered2;#ee4000
orangered3;#cd3700
orangered4;#8b2500
orchid;#da70d6
orchid1;#ff83fa
orchid2;#ee7ae9
orchid3;#cd69c9
orchid4;#8b4789
palegoldenrod;#eee8aa
palegreen;#98fb98
palegreen1;#9aff9a
palegreen2;#90ee90
palegreen3;#7ccd7c
palegreen4;#548b54
paleturquoise;#afeeee
paleturquoise1;#bbffff
paleturquoise2;#aeeeee
paleturquoise3;#96cdcd
paleturquoise4;#668b8b
palevioletred;#db7093
palevioletred1;#ff82ab
palevioletred2;#ee799f
palevioletred3;#cd6889
palevioletred4;#8b475d
papayawhip;#ffefd5
peachpuff;#ffdab9
peachpuff1;#ffdab9
peachpuff2;#eecbad
peachpuff3;#cdaf95
peachpuff4;#8b7765
peru;#cd853f
pink;#ffc0cb
pink1;#ffb5c5
pink2;#eea9b8
pink3;#cd919e
pink4;#8b636c
plum;#dda0dd
plum1;#ffbbff
plum2;#eeaeee
plum3;#cd96cd
plum4;#8b668b
powderblue;#b0e0e6
purple;#a020f0
purple1;#9b30ff
purple2;#912cee
purple3;#7d26cd
purple4;#551a8b
red;#ff0000
red1;#ff0000
red2;#ee0000
red3;#cd0000
red4;#8b0000
rosybrown;#bc8f8f
rosybrown1;#ffc1c1
rosybrown2;#eeb4b4
rosybrown3;#cd9b9b
rosybrown4;#8b6969
royalblue;#4169e1
royalblue1;#4876ff
royalblue2;#436eee
royalblue3;#3a5fcd
royalblue4;#27408b
saddlebrown;#8b4513
salmon;#fa8072
salmon1;#ff8c69
salmon2;#ee8262
salmon3;#cd7054
salmon4;#8b4c39
sandybrown;#f4a460
seagreen;#2e8b57
seagreen1;#54ff9f
seagreen2;#4eee94
seagreen3;#43cd80
seagreen4;#2e8b57
seashell;#fff5ee
seashell1;#fff5ee
seashell2;#eee5de
seashell3;#cdc5bf
seashell4;#8b8682
sienna;#a0522d
sienna1;#ff8247
sienna2;#ee7942
sienna3;#cd6839
sienna4;#8b4726
skyblue;#87ceeb
skyblue1;#87ceff
skyblue2;#7ec0ee
skyblue3;#6ca6cd
skyblue4;#4a708b
slateblue;#6a5acd
slateblue1;#836fff
slateblue2;#7a67ee
slateblue3;#6959cd
slateblue4;#473c8b
slategray;#708090
slategray1;#c6e2ff
slategray2;#b9d3ee
slategray3;#9fb6cd
slategray4;#6c7b8b
slategrey;#708090
snow;#fffafa
snow1;#fffafa
snow2;#eee9e9
snow3;#cdc9c9
snow4;#8b8989
springgreen;#00ff7f
springgreen1;#00ff7f
springgreen2;#00ee76
springgreen3;#00cd66
springgreen4;#008b45
steelblue;#4682b4
steelblue1;#63b8ff
steelblue2;#5cacee
steelblue3;#4f94cd
steelblue4;#36648b
tan;#d2b48c
tan1;#ffa54f
tan2;#ee9a49
tan3;#cd853f
tan4;#8b5a2b
thistle;#d8bfd8
thistle1;#ffe1ff
thistle2;#eed2ee
thistle3;#cdb5cd
thistle4;#8b7b8b
tomato;#ff6347
tomato1;#ff6347
tomato2;#ee5c42
tomato3;#cd4f39
tomato4;#8b3626
transparent;#fffffe
turquoise;#40e0d0
turquoise1;#00f5ff
turquoise2;#00e5ee
turquoise3;#00c5cd
turquoise4;#00868b
violet;#ee82ee
violetred;#d02090
violetred1;#ff3e96
violetred2;#ee3a8c
violetred3;#cd3278
violetred4;#8b2252
wheat;#f5deb3
wheat1;#ffe7ba
wheat2;#eed8ae
wheat3;#cdba96
wheat4;#8b7e66
white;#ffffff
whitesmoke;#f5f5f5
yellow;#ffff00
yellow1;#ffff00
yellow2;#eeee00
yellow3;#cdcd00
yellow4;#8b8b00
yellowgreen;#9acd32'.
colorsByName := Dictionary new.
colorList linesDo:
[:each | | tokens |
tokens := each findTokens: ';'.
colorsByName at: tokens first asSymbol put: (Color fromString: tokens second)].
colorsByName]! !
!GraphViz class methodsFor: 'samples' stamp: 'lr 9/4/2010 14:47'!
connectorsDemo
"GraphViz connectorsDemo"
| graph costume |
self hasConnectorsInstalled ifFalse: [self notify: 'Install Connectors in order to run any GraphViz to Connectors demos'].
graph := self new.
graph
name: 'Connectors Demo';
add: #node with: #style -> #filled;
add: #Am with: #fillcolor -> #palegreen;
add: #Dah with: #fillcolor -> #burlywood;
add: #He with: #fillcolor -> #red1;
add: #Baz with: #fillcolor -> #yellow3;
add: #Car with: #fillcolor -> #ivory;
add: #Am->#Baz->#Car;
add: #Am->#Dah->#Baz;
subgraphDo: [graph add: 'Be Ga'->#Am];
add: #He->#Dah.
costume := graph displayCostume.
costume openInWorld! !
!GraphViz class methodsFor: 'samples' stamp: 'jrp 3/20/2005 22:33'!
createAllOutputFiles
"Generate all the output formats listed in GraphViz documentation (as of dot version 2.2).
Results are files named 'directedGraphSample.*' in the 'dot' folder."
"GraphViz createAllOutputFiles"
self new
beDirected;
name: #directedGraphSample;
add: #graph with: {#ratio -> '0.5'};
add: #node with: {#fontsize -> 10};
add: #Smalltalk -> #Squeak;
add: #Smalltalk -> 'C++';
add: 'C++' -> #Java;
add: #Java -> 'C#';
makeAll
! !
!GraphViz class methodsFor: 'samples' stamp: 'lr 9/4/2010 14:47'!
createAllOutputFormats
"Generate all the output formats listed in GraphViz documentation (as of dot version 2.2)."
"GraphViz createAllOutputFormats"
| d viz |
d := Dictionary new.
viz := self new
beDirected;
name: #directedGraphSample1;
add: #graph with: {#ratio -> '0.5'};
add: #node with: {#fontsize -> 10};
add: #Smalltalk -> #Squeak;
add: #Smalltalk -> 'C++';
add: 'C++' -> #Java;
add: #Java -> 'C#';
yourself.
self outputFormats do: [:t | d at: t put: (viz asOutputType: t)].
^ d! !
!GraphViz class methodsFor: 'accessing' stamp: 'lr 9/4/2010 14:47'!
defaultGeneratorClass
"GraphViz defaultGeneratorClass"
| platform className |
platform := (SmalltalkImage current platformName copyWithout: Character space) capitalized.
className := (platform , #GraphVizGenerator) asSymbol.
"Issue a warning for special case of Mac OS prior to the OS X operating system"
(platform = 'MacOS' and: [ SmalltalkImage current osVersion asNumber < 1000])
ifTrue: [self notify: 'GraphViz on Mac OS prior to OS X may not function correctly. ',
'You may proceed, but errors are possible. Please notify author ',
' if you are able to confirm GraphViz working on your Mac OS system.'].
"Use the specific concrete subclass for this platform if implemented"
(Smalltalk hasClassNamed: className) ifTrue: [^ Smalltalk at: className].
"Otherwise use OSProcess if possible"
(platform = 'Unix') ifTrue:
[(Smalltalk hasClassNamed: #PipeableOSProcess)
ifTrue: [^ OSProcessGraphVizGenerator]
ifFalse: [self notify:
'Class ' , className , ' not implemented for this platform. ',
'Load OSProcess and CommandShell to enable GraphViz on ',
'Unix, Linux, or Mac OS X with Unix VM.'].
^ nil].
self notify: SmalltalkImage current platformName, ' is is not yet supported for the GraphViz package for Squeak'.
^ nil! !
!GraphViz class methodsFor: 'samples' stamp: 'lr 9/4/2010 14:47'!
directedGraphSample
"GraphViz directedGraphSample"
| graph |
graph := self new.
graph beDirected.
graph
name: #directedGraphSample;
add: #node with: {#fontsize -> 28};
subgraph: #clusterfoo do:
[graph
at: #style put: #filled;
at: #fillcolor put: #lightgrey;
add: #A -> #B;
at: #label put: #Foo].
graph
add: #A -> #J;
add: #B -> #Z;
add: #graph with: {#label -> 'Cluster Graph'. #fontsize -> 50};
openInWindow! !
!GraphViz class methodsFor: 'accessing' stamp: 'jrp 3/28/2005 07:45'!
hasConnectorsInstalled
^ PackageInfo allPackages anySatisfy: [:each | each externalName = #Connectors]! !
!GraphViz class methodsFor: 'samples' stamp: 'jrp 4/3/2005 16:38'!
hierarchyForClassesInCategoriesMatching: symbol
"GraphViz hierarchyForClassesInCategoriesMatching: 'GraphViz'"
"GraphViz hierarchyForClassesInCategoriesMatching: 'System-Archives'"
"GraphViz hierarchyForClassesInCategoriesMatching: 'Collections-Weak'"
"GraphViz hierarchyForClassesInCategoriesMatching: #DynamicBindings"
(SystemOrganization graphForCategoriesMatching: symbol) openInWindow! !
!GraphViz class methodsFor: 'samples' stamp: 'lr 9/4/2010 14:47'!
historyOfSmalltalk
"GraphViz historyOfSmalltalk"
| graph |
graph := self new.
graph
beDirected;
name: 'HistoryOfSmalltalk';
add: #graph with: {#overlap -> #scale. #concentrate -> #true. #ranksep -> 0.25};
add: #edge with: {#arrowsize -> 0.5};
add: #node with: {#shape -> #plaintext. #fontsize -> 16};
add: #past -> '1970s' -> 1980 -> 1983 -> 1985 -> 1991 -> 1993 -> 1995 -> 1996 -> 1998 -> 1999 -> 2000;
add: #node with: {#shape -> #box. #fontsize -> 12. #style -> #filled. #fillcolor -> #ivory. #height -> 0.25};
rank: #past add: #(CDL Simula Lisp);
rank: '1970s' add: #('Smalltalk-71' 'Smalltalk-72, 74, 76, 78');
rank: 1980 add: 'Smalltalk-80';
rank: 1983 add: 'Objective-C';
rank: 1985 add: #Self;
rank: 1991 add: #Oak;
rank: 1993 add: #Ruby;
rank: 1995 add: 'Java 1';
rank: 1996 add: #Squeak;
rank: 1998 add: 'Java 2';
rank: 1999 add: #VisualWorks;
rank: 2000 add: 'C#';
add: #Simula -> 'Smalltalk-71';
add: #CDL -> 'Smalltalk-71';
add: #Lisp -> 'Smalltalk-71' -> 'Smalltalk-72, 74, 76, 78' -> 'Smalltalk-80' -> 'Objective-C' -> #Oak;
add: 'Smalltalk-80' -> #Self;
add: 'Smalltalk-80' -> #Oak -> 'Java 1' -> 'Java 2' -> 'C#';
add: 'Smalltalk-80' -> #Ruby;
add: 'Smalltalk-80' -> #Squeak;
add: 'Smalltalk-80' -> #VisualWorks;
openInWindow! !
!GraphViz class methodsFor: 'class initialization' stamp: 'lr 9/4/2010 14:47'!
initialize
colorsByName := nil! !
!GraphViz class methodsFor: 'samples' stamp: 'dtl 3/28/2005 01:46'!
makeLayoutCoordinates
"Answer plain text layout coordinates in a format that could be parsed in Squeak."
"GraphViz makeLayoutCoordinates explore"
^ self new
beDirected;
name: #directedGraphSample1;
add: #graph with: {#ratio -> '0.5'};
add: #node with: {#fontsize -> 10};
add: #Smalltalk -> #Squeak;
add: #Smalltalk -> 'C++';
add: 'C++' -> #Java;
add: #Java -> 'C#';
asLayoutCoordinates
! !
!GraphViz class methodsFor: 'output types' stamp: 'dtl 3/19/2005 13:29'!
outputFormats
"All the output formats listed in GraphViz documentation (as of dot version 2.2)."
^ #(
#canon
#cmap "Client-side imagemap"
#dot "DOT"
#fig "FIG"
#gd
#gd2 "GD/GD2 formats"
#gif "GIF"
#hpgl "HP-GL/2"
#imap "Server-side imagemap"
#ismap "Server-side imagemap (deprecated)"
#jpg
#jpeg "JPEG"
#mif "FrameMaker MIF format"
#mp "MetaPost"
#pcl "PCL"
#pic "PIC"
#plain
#'plain-ext' "Simple text format"
#png "Portable Network Graphics format"
#ps "PostScript"
#ps2 "PostScript for PDF"
#svg
#svgz "Scalable Vector Graphics"
#vrml "VRML"
#vtx "Visual Thought format"
#wbmp "Wireless BitMap format")! !
!GraphViz class methodsFor: 'accessing' stamp: 'jrp 3/26/2005 22:52'!
pointsPerInch
^ 72! !
!GraphViz class methodsFor: 'samples' stamp: 'lr 9/4/2010 14:47'!
referencesToClassesInCategoriesMatching: symbol
"GraphViz referencesToClassesInCategoriesMatching: 'GraphViz'"
"GraphViz referencesToClassesInCategoriesMatching: 'System-Archives'"
"GraphViz referencesToClassesInCategoriesMatching: 'Collections-Weak'"
"GraphViz referencesToClassesInCategoriesMatching: #DynamicBindings"
| graph edges |
graph := self new.
graph
name: symbol;
add: #graph with: {#overlap -> #orthoyx. #start -> #rand. #splines -> #true. #bgcolor -> #transparent. #concentrate -> #true};
add: #node with: {#shape -> #box. #fontsize -> 10. #style -> #filled. #fillcolor -> #tomato. #height -> 0.25};
add: #edge with: {#arrowtail -> #normal. #arrowsize -> 0.5. #minlen -> 2}.
edges := Set new.
(SystemOrganization categoriesMatching: (symbol, '*')) do:
[:cat |
(SystemOrganization listAtCategoryNamed: cat) do:
[:klass |
graph add: klass with: {#fillcolor -> #palegreen}.
(Smalltalk at: klass) allCallsOn do: [:each | edges add: klass -> each classSymbol]]].
edges do: [:each | graph add: each].
graph
add: #graph with: {#label -> symbol. #fontsize -> 20};
openInWindow! !
!GraphViz class methodsFor: 'samples' stamp: 'lr 9/4/2010 14:47'!
undirectedGraphSample
"GraphViz undirectedGraphSample"
| graph |
graph := self new.
graph
name: #undirectedGraphSample;
add: #graph with: #start -> #rand;
add: #node with: {#fontsize -> 28};
add: #A -> #X;
add: #node with: #shape -> #box;
add: #J with: {#style -> #filled. #fillcolor -> #red. #label -> 'J\nRed'};
add: #A -> #J;
add: #A -> #Z;
add: #graph with: {#label -> 'Test Graph'. #fontsize -> 50};
openInWindow! !
!GraphViz class methodsFor: 'samples' stamp: 'lr 9/4/2010 14:47'!
usersOf: aSymbol
"GraphViz usersOf: #WeakRegistry"
"GraphViz usersOf: #Bag"
| graph |
graph := self new.
graph
name: (#usersOf, aSymbol) capitalized;
add: #graph with: {#overlap -> #orthoyx. #start -> #rand. #splines -> #true};
add: #node with: {#fontsize -> 10. #height -> 0.25. #shape -> #octagon. #style -> #filled. #fillcolor -> #khaki};
add: aSymbol with: {#fillcolor -> #palegreen};
add: #edge with: {#len -> 0.75}.
(Smalltalk at: aSymbol) allCallsOn do:
[:each |
graph add: (each classSymbol, '>>', each methodSymbol) with: #label -> (each classSymbol, '>>\n', each methodSymbol).
graph
add: aSymbol -> (each classSymbol, '>>', each methodSymbol)
with: {#arrowtail -> #normal. #arrowsize -> 0.5}].
graph
add: #graph with: {#label -> ('Users of ', aSymbol). #fontsize -> 20};
openInWindow! !
!GraphViz methodsFor: 'converting' stamp: 'lr 9/4/2010 14:47'!
asLayoutCoordinates
"Create graph layout cooordinates in a format that could be easily parsed in Squeak."
| lines layout |
lines := OrderedCollection new.
layout := (self asOutputType: 'plain-ext') copyReplaceAll: String lf with: String cr.
layout linesDo: [:each | lines add: (self tokenizeLine: each)].
^ lines
! !
!GraphViz methodsFor: 'converting' stamp: 'jrp 3/13/2005 22:41'!
asMorph
^ self generator createMorph! !
!GraphViz methodsFor: 'generating' stamp: 'dtl 3/15/2005 22:07'!
asOutputType: outputFormat
^ self generator generateType: outputFormat! !
!GraphViz methodsFor: 'converting' stamp: 'jrp 3/13/2005 22:41'!
asXml
^ self generator createXMLDocument! !
!GraphViz methodsFor: 'accessing' stamp: 'jrp 3/20/2005 21:38'!
displayCostume
^ GraphVizCostume new graph: self! !
!GraphViz methodsFor: 'layout' stamp: 'lr 9/4/2010 14:47'!
doLayout
| layout graphHeight graphWidth |
layout := self asLayoutCoordinates.
graphWidth := (layout first third asNumber * self class pointsPerInch) asNumber rounded.
graphHeight := (layout first fourth asNumber * self class pointsPerInch) asNumber rounded.
extent := graphWidth @ graphHeight.
self layoutNodes: (layout select: [:each | each first = #node]).
self layoutEdges: (layout select: [:each | each first = #edge]).! !
!GraphViz methodsFor: 'accessing' stamp: 'jrp 3/13/2005 07:14'!
dot
^ String streamContents:
[:stream |
self writeOn: stream withIndent: 0 for: self]! !
!GraphViz methodsFor: 'accessing' stamp: 'jrp 3/29/2005 20:47'!
extent
"only has a value after calling doLayout"
^ extent! !
!GraphViz methodsFor: 'accessing' stamp: 'lr 9/4/2010 14:47'!
generator
^ generator ifNil: [generator := self generatorClass newFor: self]! !
!GraphViz methodsFor: 'accessing' stamp: 'lr 9/4/2010 14:47'!
generatorClass
^ generatorClass ifNil: [generatorClass := self class defaultGeneratorClass]! !
!GraphViz methodsFor: 'accessing' stamp: 'lr 9/4/2010 14:47'!
generatorClass: aClass
generatorClass := aClass! !
!GraphViz methodsFor: 'layout' stamp: 'lr 9/4/2010 14:47'!
layoutEdges: edgeList
"format => edge tail head n x1 y1 .. xn yn [label xl yl] style color"
edgeList do:
[:each | | edge positionOfStyle |
edge := self edgeNamed: each second -> each third.
edge ifNotNil:
[ | numberOfVertices pos |
numberOfVertices := each fourth asNumber.
positionOfStyle := 5 + (numberOfVertices * 2).
pos := String streamContents:
[:stream |
5 to: positionOfStyle - 1 by: 2 do:
[:i |
stream
nextPutAll: ((each at: i) asNumber * self class pointsPerInch) rounded asString;
nextPut: $,;
nextPutAll: ((each at: i + 1) asNumber * self class pointsPerInch) rounded asString;
nextPutAll: ' ']].
edge pos: pos allButLast.
edge style: (each at: positionOfStyle).
edge color: (each at: positionOfStyle + 1)]]! !
!GraphViz methodsFor: 'layout' stamp: 'lr 9/4/2010 14:47'!
layoutNodes: nodeList
"format => node name x y width height label style shape color fillcolor"
nodeList do:
[:each | | node |
node := self nodeNamed: each second.
node ifNotNil:
[ | x y |
x := (each third asNumber * self class pointsPerInch) rounded.
y := (each fourth asNumber * self class pointsPerInch) rounded.
node pos: x asString, ',', y asString.
node width: each fifth asNumber.
node height: each sixth asNumber.
node label: each seventh.
node style: each eighth.
node shape: each ninth.
node color: (each at: 10).
node fillcolor: (each at: 11)]]! !
!GraphViz methodsFor: 'generating' stamp: 'jrp 3/13/2005 21:57'!
make: outputFormat
^ self generator make: outputFormat! !
!GraphViz methodsFor: 'generating' stamp: 'dtl 3/19/2005 13:38'!
makeAll
"Generate output files in all known formats."
self class outputFormats do: [:format | self make: format]
! !
!GraphViz methodsFor: 'accessing' stamp: 'jrp 3/6/2005 23:28'!
name
^ (self id ifNil: [#UnamedGraph]) asString! !
!GraphViz methodsFor: 'accessing' stamp: 'jrp 3/6/2005 23:28'!
name: aString
self id: aString! !
!GraphViz methodsFor: 'converting' stamp: 'lr 9/4/2010 14:47'!
openInWindow
| morph window scrollPane |
morph := self asMorph.
scrollPane := ScrollPane new.
scrollPane scroller addMorph: morph.
window := (SystemWindow labelled: self name) model: nil.
window bounds: (morph position - (0 @ window labelHeight + window borderWidth) corner: morph bottomRight + window borderWidth).
window
addMorph: scrollPane
frame: (0 @ 0 extent: 1 @ 1).
window setWindowColor: Color lightOrange lighter lighter.
window openInWorld.
^ window ! !
!GraphViz methodsFor: 'converting' stamp: 'jrp 3/29/2005 22:01'!
openInteractive
self displayCostume openInWorld! !
!GraphViz methodsFor: 'layout' stamp: 'lr 9/4/2010 14:47'!
tokenizeLine: line
| tokens tokenSoFar insideQuote |
tokens := OrderedCollection new.
tokenSoFar := ''.
insideQuote := false.
line do:
[:char |
char = $" ifTrue: [insideQuote := insideQuote not].
tokenSoFar := (char = Character space and: [insideQuote not])
ifTrue: [tokenSoFar isEmpty ifFalse: [tokens add: tokenSoFar]. String new]
ifFalse: [tokenSoFar, char asString]].
tokenSoFar isEmpty ifFalse: [tokens add: tokenSoFar].
^ tokens collect: [:each | (each beginsWith: '"') ifTrue: [each allButFirst allButLast] ifFalse: [each]]! !
!GraphVizGraph methodsFor: 'graphing' stamp: 'jrp 3/20/2005 21:51'!
add: anObject
^ self add: anObject with: #()! !
!GraphVizGraph methodsFor: 'graphing' stamp: 'lr 9/4/2010 14:47'!
add: anObject with: associations
| newEdges newObject |
newObject := anObject isVariableBinding
ifTrue:
[newEdges := self flattenNestedAssocations: anObject.
newEdges collect: [:each | currentGraphReceiver addNewEdge: each with: associations]]
ifFalse:
[(GraphVizStyle styleNodes includes: anObject)
ifTrue: [currentGraphReceiver addNewStyle: anObject with: associations]
ifFalse:
[(anObject isCollection and: [anObject isString not])
ifTrue: [anObject collect: [:each | currentGraphReceiver addNewNode: each with: associations]]
ifFalse: [currentGraphReceiver addNewNode: anObject with: associations]]].
^ (newObject isCollection and: [newObject size = 1])
ifTrue: [newObject first]
ifFalse: [newObject]
! !
!GraphVizGraph methodsFor: 'adding' stamp: 'jrp 3/17/2005 22:01'!
addAttribute: association
^ self addNewChild: (GraphVizAttribute new id: association)! !
!GraphVizGraph methodsFor: 'private' stamp: 'jrp 3/18/2005 22:36'!
addNewChild: aGraphVizItem
^ children add: aGraphVizItem! !
!GraphVizGraph methodsFor: 'adding' stamp: 'jrp 3/6/2005 23:55'!
addNewEdge: anAssocation
^ self addNewEdge: anAssocation with: #()! !
!GraphVizGraph methodsFor: 'adding' stamp: 'lr 9/4/2010 14:47'!
addNewEdge: anAssociation with: associations
| edge atts |
atts := associations asOrderedCollection.
edge := GraphVizEdge new id: anAssociation.
atts do: [:each | edge attributeAt: each key put: each value].
"ensure edge nodes are already in node list"
edge fromNode: (self addNewNode: anAssociation key).
edge toNode: (self addNewNode: anAssociation value).
edges at: anAssociation key asString -> anAssociation value asString put: edge.
edge inheritedStyle: currentEdgeStyle.
^ self addNewChild: edge! !
!GraphVizGraph methodsFor: 'adding' stamp: 'jrp 3/6/2005 23:55'!
addNewNode: anObject
^ self addNewNode: anObject with: #()! !
!GraphVizGraph methodsFor: 'adding' stamp: 'lr 9/4/2010 14:47'!
addNewNode: anObject with: associations
| node |
node := self nodeNamed: anObject.
node ifNotNil: [^ node].
node := GraphVizNode new id: anObject; graph: self.
node inheritedStyle: currentNodeStyle.
^ self addNode: node with: associations! !
!GraphVizGraph methodsFor: 'adding' stamp: 'lr 9/4/2010 14:47'!
addNewStyle: anObject with: associations
| atts style |
(GraphVizStyle styleNodes includes: anObject) ifFalse: [^ self].
atts := associations asOrderedCollection.
style := GraphVizStyle new id: anObject.
anObject = #node ifTrue:
[currentNodeStyle attributes keysAndValuesDo: [:key :value | style attributeAt: key put: value].
currentNodeStyle := style].
anObject = #edge ifTrue:
[currentEdgeStyle attributes keysAndValuesDo: [:key :value | style attributeAt: key put: value].
currentEdgeStyle := style].
atts do: [:each | style attributes at: each key put: each value].
^ self addNewChild: style! !
!GraphVizGraph methodsFor: 'adding' stamp: 'lr 9/4/2010 14:47'!
addNewSubgraph: anObject
| subgraph |
subgraph := GraphVizSubgraph new
id: anObject;
parent: self;
directed: directed;
currentNodeStyle: currentNodeStyle;
currentEdgeStyle: currentEdgeStyle;
yourself.
^ self addNewChild: subgraph! !
!GraphVizGraph methodsFor: 'private' stamp: 'lr 9/4/2010 14:47'!
addNode: aGraphVizNode with: associations
| atts |
atts := associations asOrderedCollection.
atts do: [:each | aGraphVizNode attributeAt: each key put: each value].
nodes at: aGraphVizNode id asString put: aGraphVizNode.
^ self addNewChild: aGraphVizNode! !
!GraphVizGraph methodsFor: 'enumerating' stamp: 'jrp 3/25/2005 23:48'!
allEdgesDo: aBlock
self edges do: aBlock.
self subgraphs do: [:each | each allEdgesDo: aBlock]! !
!GraphVizGraph methodsFor: 'enumerating' stamp: 'jrp 3/20/2005 20:55'!
allNodesDo: aBlock
self allNodesDo: aBlock skippingOver: OrderedCollection new! !
!GraphVizGraph methodsFor: 'private' stamp: 'lr 9/4/2010 14:47'!
allNodesDo: aBlock skippingOver: nodeList
| effectiveNodes |
effectiveNodes := nodes reject: [:each | nodeList includes: each].
effectiveNodes valuesDo: aBlock.
nodeList addAll: effectiveNodes.
self subgraphs do: [:each | each allNodesDo: aBlock skippingOver: nodeList]! !
!GraphVizGraph methodsFor: 'graphing' stamp: 'jrp 3/13/2005 19:49'!
at: attribute put: value
currentGraphReceiver addAttribute: attribute -> value! !
!GraphVizGraph methodsFor: 'accessing' stamp: 'jrp 3/11/2005 19:43'!
attributes
^ children select: [:each | each isAttribute]! !
!GraphVizGraph methodsFor: 'accessing' stamp: 'lr 9/4/2010 14:47'!
beDirected
directed := true! !
!GraphVizGraph methodsFor: 'accessing' stamp: 'lr 9/4/2010 14:47'!
beUndirected
directed := false! !
!GraphVizGraph methodsFor: 'accessing' stamp: 'lr 9/4/2010 14:47'!
currentEdgeStyle: aGraphVizStyle
currentEdgeStyle := aGraphVizStyle! !
!GraphVizGraph methodsFor: 'accessing' stamp: 'lr 9/4/2010 14:47'!
currentNodeStyle: aGraphVizStyle
currentNodeStyle := aGraphVizStyle! !
!GraphVizGraph methodsFor: 'accessing' stamp: 'lr 9/4/2010 14:47'!
directed: aBoolean
directed := aBoolean! !
!GraphVizGraph methodsFor: 'testing' stamp: 'lr 9/4/2010 14:47'!
doesNotUnderstand: aMessage
| argCount |
argCount := aMessage arguments size.
argCount = 1 ifTrue: [^ self at: aMessage selector allButLast put: aMessage argument].
^ super doesNotUnderstand: aMessage! !
!GraphVizGraph methodsFor: 'accessing' stamp: 'lr 9/4/2010 14:47'!
edgeNamed: anAssociation
| edge |
edge := edges at: anAssociation ifAbsent: [nil].
edge ifNil:
[self subgraphs do:
[:each |
edge := each edgeNamed: anAssociation.
edge ifNotNil: [^ edge]]].
^ edge! !
!GraphVizGraph methodsFor: 'accessing' stamp: 'jrp 3/6/2005 23:43'!
edges
^ children select: [:each | each isEdge]! !
!GraphVizGraph methodsFor: 'private' stamp: 'lr 9/4/2010 14:47'!
flattenNestedAssocations: association
| flattened currentNode associations |
flattened := OrderedCollection new.
currentNode := association.
[currentNode isVariableBinding] whileTrue:
[flattened add: currentNode value.
currentNode := currentNode key].
flattened add: currentNode.
flattened := flattened reversed.
associations := OrderedCollection new.
1 to: flattened size - 1 do: [:i | associations add: (flattened at: i) -> (flattened at: i + 1)].
^ associations! !
!GraphVizGraph methodsFor: 'initialization' stamp: 'lr 9/4/2010 14:47'!
initialize
super initialize.
children := OrderedCollection new.
nodes := Dictionary new.
edges := Dictionary new.
directed := false.
currentGraphReceiver := self.
currentNodeStyle := GraphVizStyle new.
currentEdgeStyle := GraphVizStyle new.! !
!GraphVizGraph methodsFor: 'testing' stamp: 'jrp 3/12/2005 19:51'!
isDirected
^ directed! !
!GraphVizGraph methodsFor: 'testing' stamp: 'jrp 3/6/2005 23:30'!
isGraph
^ true! !
!GraphVizGraph methodsFor: 'testing' stamp: 'jrp 3/12/2005 19:52'!
isUndirected
^ self isDirected not! !
!GraphVizGraph methodsFor: 'accessing' stamp: 'lr 9/4/2010 14:47'!
nodeNamed: anObject
| node nodeId |
nodeId := anObject asString.
node := nodes at: nodeId ifAbsent: [nil].
node ifNil:
[self subgraphs do:
[:each |
node := each nodeNamed: nodeId.
node ifNotNil: [^ node]]].
^ node! !
!GraphVizGraph methodsFor: 'accessing' stamp: 'jrp 3/8/2005 07:01'!
nodeType
^ #graph! !
!GraphVizGraph methodsFor: 'accessing' stamp: 'jrp 3/20/2005 16:03'!
nodes
^ children select: [:each | each isNode]! !
!GraphVizGraph methodsFor: 'convenience' stamp: 'jrp 3/17/2005 21:00'!
rank: aString add: anObject
self subgraphDo:
[self rank: #same.
self add: aString.
self add: anObject]! !
!GraphVizGraph methodsFor: 'accessing' stamp: 'jrp 3/13/2005 15:30'!
styles
^ children select: [:each | each isStyle]! !
!GraphVizGraph methodsFor: 'graphing' stamp: 'lr 9/4/2010 14:47'!
subgraph: anObject do: aBlock
| subgraph |
subgraph := currentGraphReceiver addNewSubgraph: anObject.
currentGraphReceiver := subgraph.
[aBlock value] ensure: [currentGraphReceiver := self]! !
!GraphVizGraph methodsFor: 'graphing' stamp: 'jrp 3/6/2005 23:43'!
subgraphDo: aBlock
self subgraph: nil do: aBlock! !
!GraphVizGraph methodsFor: 'accessing' stamp: 'jrp 3/6/2005 23:43'!
subgraphs
^ children select: [:each | each isGraph]! !
!GraphVizGraph methodsFor: 'streaming' stamp: 'jrp 3/13/2005 14:26'!
writeContentsOn: stream withIndent: aNumber for: graph
children do: [:each | each writeOn: stream withIndent: aNumber + 1 for: self].
! !
!GraphVizGraph methodsFor: 'streaming' stamp: 'jrp 3/13/2005 14:26'!
writeHeaderOn: stream withIndent: aNumber
directed ifTrue: [stream nextPutAll: 'di'].
stream
nextPutAll: self nodeType;
nextPut: $ .
self id ifNotNilDo: [:name | stream nextPutAll: self safeId; nextPut: $ ].
stream nextPutAll: '{'.! !
!GraphVizGraph methodsFor: 'streaming' stamp: 'jrp 3/13/2005 14:27'!
writeTerminatorOn: stream withIndent: aNumber
stream cr.
self indent: aNumber on: stream.
stream nextPut: $}! !
GraphVizGraph subclass: #GraphVizSubgraph
instanceVariableNames: 'parent'
classVariableNames: ''
poolDictionaries: ''
category: 'GraphViz-Model'!
!GraphVizSubgraph methodsFor: 'adding' stamp: 'lr 9/4/2010 14:47'!
addNewNode: anObject with: associations
| node |
node := self rootGraph nodeNamed: anObject.
^ node
ifNil: [super addNewNode: anObject with: associations]
ifNotNil: [self addNode: node with: associations]! !
!GraphVizSubgraph methodsFor: 'testing' stamp: 'jrp 3/8/2005 06:44'!
isSubgraph
^ true! !
!GraphVizSubgraph methodsFor: 'accessing' stamp: 'jrp 3/8/2005 07:01'!
nodeType
^ #subgraph! !
!GraphVizSubgraph methodsFor: 'accessing' stamp: 'jrp 3/20/2005 16:49'!
parent
^ parent! !
!GraphVizSubgraph methodsFor: 'accessing' stamp: 'lr 9/4/2010 14:47'!
parent: aGraphVizGraph
parent := aGraphVizGraph! !
!GraphVizSubgraph methodsFor: 'accessing' stamp: 'jrp 3/20/2005 16:55'!
rootGraph
^ parent isSubgraph
ifTrue: [parent rootGraph]
ifFalse: [parent]! !
!GraphVizSubgraph methodsFor: 'streaming' stamp: 'jrp 3/13/2005 14:28'!
writeHeaderOn: stream withIndent: aNumber
stream cr.
self indent: aNumber on: stream.
self id ifNotNilDo:
[:name |
stream
nextPutAll: self nodeType;
nextPut: $ ].
self id ifNotNilDo: [:name | stream nextPutAll: self safeId; nextPut: $ ].
stream nextPutAll: '{'.
! !
!GraphVizItem methodsFor: 'accessing' stamp: 'jrp 3/6/2005 21:12'!
id
^ id! !
!GraphVizItem methodsFor: 'accessing' stamp: 'lr 9/4/2010 14:47'!
id: anObject
id := anObject! !
!GraphVizItem methodsFor: 'streaming' stamp: 'jrp 3/12/2005 19:43'!
indent: aNumber on: stream
aNumber timesRepeat: [stream tab]! !
!GraphVizItem methodsFor: 'testing' stamp: 'jrp 3/11/2005 19:44'!
isAttribute
^ false! !
!GraphVizItem methodsFor: 'testing' stamp: 'jrp 3/6/2005 21:16'!
isEdge
^ false! !
!GraphVizItem methodsFor: 'testing' stamp: 'jrp 3/8/2005 06:44'!
isGraph
^ false! !
!GraphVizItem methodsFor: 'testing' stamp: 'jrp 3/6/2005 21:17'!
isNode
^ false! !
!GraphVizItem methodsFor: 'testing' stamp: 'jrp 3/13/2005 15:34'!
isStyle
^ false! !
!GraphVizItem methodsFor: 'testing' stamp: 'jrp 3/6/2005 23:15'!
isSubgraph
^ false! !
!GraphVizItem methodsFor: 'accessing' stamp: 'jrp 3/8/2005 07:01'!
nodeType
self subclassResponsibility! !
!GraphVizItem methodsFor: 'printing' stamp: 'jrp 3/8/2005 07:00'!
printOn: aStream
aStream
nextPutAll: self nodeType;
nextPut: $ ;
nextPutAll: self id asString! !
!GraphVizItem methodsFor: 'accessing' stamp: 'jrp 3/11/2005 19:35'!
safeId
^ self safeIdFor: self id! !
!GraphVizItem methodsFor: 'accessing' stamp: 'lr 9/4/2010 14:47'!
safeIdFor: anObject
| hasWhiteSpace firstCharIsDigit |
anObject isNumber ifTrue: [^ anObject asString].
anObject isString ifTrue:
[(anObject first = $< and: [anObject last = $>]) ifTrue: [^ anObject].
(anObject first = $" and: [anObject last = $"]) ifTrue: [^ anObject].
hasWhiteSpace := anObject lastSpacePosition > 0.
hasWhiteSpace ifTrue: [^ '"', anObject, '"'].
firstCharIsDigit := anObject first isDigit.
firstCharIsDigit ifTrue: [^ '"', anObject, '"'].
anObject do: [:char | (char isAlphaNumeric or: [char = $_]) ifFalse: [^ '"', anObject, '"']]].
^ anObject asString! !
!GraphVizItem methodsFor: 'streaming' stamp: 'jrp 3/12/2005 20:01'!
writeAttribute: attribute value: value on: stream
stream
nextPutAll: (self safeIdFor: attribute);
nextPut: $=;
nextPutAll: (self safeIdFor: value)! !
!GraphVizItem methodsFor: 'streaming' stamp: 'jrp 3/13/2005 14:20'!
writeContentsOn: stream withIndent: aNumber for: graph
self subclassResponsibility! !
!GraphVizItem methodsFor: 'streaming' stamp: 'jrp 3/13/2005 14:22'!
writeHeaderOn: stream withIndent: aNumber
stream cr.
self indent: aNumber on: stream.! !
!GraphVizItem methodsFor: 'streaming' stamp: 'jrp 3/13/2005 14:31'!
writeOn: stream withIndent: aNumber for: graph
self writeHeaderOn: stream withIndent: aNumber.
self writeContentsOn: stream withIndent: aNumber for: graph.
self writeTerminatorOn: stream withIndent: aNumber! !
!GraphVizItem methodsFor: 'streaming' stamp: 'jrp 3/13/2005 14:28'!
writeTerminatorOn: stream withIndent: aNumber
stream nextPut: $;! !
GraphViz initialize!