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