1: ================================================================================
2:
3: Smalltalk.KSU defineClass: #ClassHierarchy
4: superclass: #{UI.ApplicationModel}
5: indexedType: #none
6: private: false
7: instanceVariableNames: 'hierarchyList rootClasses '
8: classInstanceVariableNames: ''
9: imports: ''
10: category: 'KSU-Template'
11:
12: ================================================================================
13:
14: KSU.ClassHierarchy method for 'menu messages'
15:
16: contractBranch
17:
18: self hierarchyList closeCurrent
19:
20: ------------------------------------------------------------
21:
22: KSU.ClassHierarchy method for 'defaults'
23:
24: defaultDisplayStringSelector
25:
26: ^#toolListDisplayString
27:
28: ------------------------------------------------------------
29:
30: KSU.ClassHierarchy method for 'defaults'
31:
32: defaultSortBlock
33:
34: | aSelector aBlock |
35: aSelector := self defaultDisplayStringSelector.
36: aBlock :=
37: [:classA :classB |
38: | nameA nameB |
39: (nameA := classA name) = (nameB := classB name)
40: ifTrue: [(classA perform: aSelector) < (classB perform: aSelector)]
41: ifFalse: [nameA < nameB]].
42: ^aBlock
43:
44: ------------------------------------------------------------
45:
46: KSU.ClassHierarchy method for 'menu messages'
47:
48: expandAll
49:
50: self hierarchyList deepOpenCurrent
51:
52: ------------------------------------------------------------
53:
54: KSU.ClassHierarchy method for 'menu messages'
55:
56: expandBranch
57:
58: self hierarchyList openCurrent
59:
60: ------------------------------------------------------------
61:
62: KSU.ClassHierarchy method for 'aspects'
63:
64: hierarchyList
65:
66: hierarchyList
67: ifNil:
68: [rootClasses := Class rootsOfTheWorld asSortedCollection: self defaultSortBlock.
69: hierarchyList := UI.IndentedTreeSelectionInList
70: listObjectHierarchy: #roots
71: childBlock: [:aClass | #roots == aClass ifTrue: [rootClasses] ifFalse: [self subClassesOf: aClass]]
72: childNameBlock: [:aClass | aClass perform: self defaultDisplayStringSelector].
73: hierarchyList selectionHolder compute:
74: [:aClass |
75: Transcript
76: cr;
77: show: (aClass
78: ifNil: [aClass printString]
79: ifNotNil: [aClass perform: self defaultDisplayStringSelector])]].
80: ^hierarchyList
81:
82: ------------------------------------------------------------
83:
84: KSU.ClassHierarchy method for 'initialize-release'
85:
86: initialize
87:
88: super initialize.
89: hierarchyList := nil.
90: rootClasses := nil.
91: ^self
92:
93: ------------------------------------------------------------
94:
95: KSU.ClassHierarchy method for 'menu messages'
96:
97: inspectClass
98:
99: | aClass |
100: (aClass := self hierarchyList selection) isNil
101: ifTrue: [Dialog warn: 'クラスが選択されていません。']
102: ifFalse: [aClass browse]
103:
104: ------------------------------------------------------------
105:
106: KSU.ClassHierarchy method for 'interface opening'
107:
108: postOpenWith: aBuilder
109:
110: | aWrapper |
111: super postOpenWith: aBuilder.
112: aWrapper := aBuilder componentAt: #hierarchyList.
113: aWrapper ifNil: [^nil].
114: aWrapper spec.
115: aWrapper widget
116:
117: ------------------------------------------------------------
118:
119: KSU.ClassHierarchy method for 'accessing'
120:
121: subClassesOf: aClass
122:
123: | aCollection |
124: aCollection := aClass subclasses select: [:aSubclass | aSubclass isMeta not].
125: ^(aCollection asSortedCollection: self defaultSortBlock) asArray
126:
127: ================================================================================
128:
129: KSU.ClassHierarchy class
130: instanceVariableNames: ''
131:
132: ================================================================================
133:
134: KSU.ClassHierarchy class method for 'examples'
135:
136: example1
137: "KSU.ClassHierarchy example1."
138:
139: | anApplication |
140: anApplication := KSU.ClassHierarchy new.
141: anApplication open.
142: ^anApplication
143:
144: ------------------------------------------------------------
145:
146: KSU.ClassHierarchy class method for 'resources'
147:
148: menuBar
149: "Tools.MenuEditor new openOnClass: self andSelector: #menuBar"
150:
151: <resource: #menu>
152: ^#(#{UI.Menu} #(
153: #(#{UI.MenuItem}
154: #rawLabel: 'ファイル'
155: #submenu: #(#{UI.Menu} #(
156: #(#{UI.MenuItem}
157: #rawLabel: '終了'
158: #value: #closeRequest ) ) #(1 ) nil ) ) ) #(1 ) nil ) decodeAsLiteralArray
159:
160: ------------------------------------------------------------
161:
162: KSU.ClassHierarchy class method for 'resources'
163:
164: menuForIndentedTreeSelectionInList
165: "Tools.MenuEditor new openOnClass: self andSelector: #menuForIndentedTreeSelectionInList"
166:
167: <resource: #menu>
168: ^#(#{UI.Menu} #(
169: #(#{UI.MenuItem}
170: #rawLabel: '拡張'
171: #value: #expandBranch )
172: #(#{UI.MenuItem}
173: #rawLabel: '全拡張'
174: #value: #expandAll )
175: #(#{UI.MenuItem}
176: #rawLabel: '縮小'
177: #value: #contractBranch )
178: #(#{UI.MenuItem}
179: #rawLabel: '検査'
180: #value: #inspectClass ) ) #(2 1 1 ) nil ) decodeAsLiteralArray
181:
182: ------------------------------------------------------------
183:
184: KSU.ClassHierarchy class method for 'interface specs'
185:
186: windowSpec
187: "Tools.UIPainter new openOnClass: self andSelector: #windowSpec"
188:
189: <resource: #canvas>
190: ^#(#{UI.FullSpec}
191: #window:
192: #(#{UI.WindowSpec}
193: #label: 'クラス階層'
194: #min: #(#{Core.Point} 200 300 )
195: #max: #(#{Core.Point} 0 0 )
196: #bounds: #(#{Graphics.Rectangle} 1080 420 1480 1020 )
197: #flags: 4
198: #menu: #menuBar )
199: #component:
200: #(#{UI.SpecCollection}
201: #collection: #(
202: #(#{UI.HierarchicalViewSpec}
203: #layout: #(#{Graphics.LayoutFrame} 1 0 1 0 -1 1 -1 1 )
204: #name: #hierarchyList
205: #flags: 15
206: #model: #hierarchyList
207: #menu: #menuForIndentedTreeSelectionInList
208: #useModifierKeys: true
209: #selectionType: #highlight ) ) ) )
210:
211: ================================================================================
This document was generated by KSU.TextDoclet on 2012/11/10 at 14:35:02.