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!