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.