1GtkConcreteWidget subclass: GtkCategoryWidget [
2    | categoryTree categories model class |
3
4    GtkCategoryWidget >> on: aClass [
5	<category: 'instance creation'>
6
7	^ (self new)
8	    initialize;
9	    classOrMeta: aClass;
10	    yourself
11    ]
12
13    initialize [
14	<category: 'initialization'>
15
16	self initializeCategories.
17	self mainWidget: self buildTreeView.
18	self registerNotifier
19    ]
20
21    initializeCategories [
22
23	categories := Set new.
24    ]
25
26    registerNotifier [
27        <category: 'initialize-release'>
28
29        (GtkLauncher uniqueInstance systemChangeNotifier)
30            notify: self ofSystemChangesOfItem: #method change: #Added using: #'addEvent:';
31            notify: self ofSystemChangesOfItem: #method change: #Removed using: #'removeEvent:'
32    ]
33
34    classOrMeta [
35	<category: 'accessing'>
36
37	^ class
38    ]
39
40    classOrMeta: aClass [
41	<category: 'accessing'>
42
43	class := aClass.
44	categories empty.
45	model
46	    item: (self buildCategory: categories);
47	    refresh
48    ]
49
50    buildCategory: aSet [
51        <category: 'model builder'>
52
53        aSet add: '*'.
54	self classOrMeta methodDictionary ifNil: [ ^ aSet ].
55        self classOrMeta methodDictionary do: [ :each | aSet add: each methodCategory ].
56        ^ aSet asSortedCollection
57    ]
58
59    emptyModel [
60	<category: 'accessing'>
61
62	self clear
63    ]
64
65    clear [
66        <category: 'accessing'>
67
68        model clear
69    ]
70
71    buildTreeView [
72        <category: 'user interface'>
73
74	categoryTree := GtkScrollTreeWidget createListWithModel: {{GtkColumnTextType title: 'Method categories'}}.
75	categoryTree treeView getSelection setMode: GTK.Gtk gtkSelectionBrowse.
76	categoryTree connectToWhenPopupMenu: (CategoryMenus on: self).
77        (model := GtkListModel on: categoryTree treeView getModel)
78                                        contentsBlock: [ :each | {each displayString} ].
79	^ categoryTree mainWidget
80    ]
81
82    unselectAll [
83	<category: 'selection'>
84
85	categoryTree treeView getSelection unselectAll
86    ]
87
88    whenSelectionChangedSend: aSelector to: anObject [
89	<category: 'events'>
90
91	categoryTree treeView getSelection
92	    connectSignal: 'changed' to: anObject selector: aSelector
93    ]
94
95    state [
96        <category: 'testing'>
97
98        ^ self hasSelectedCategory
99			ifFalse: [ ClassState with: self classOrMeta ]
100			ifTrue: [ CategoryState with: self classOrMeta->self selectedCategory ]
101    ]
102
103    hasSelectedCategory [
104	<category: 'testing'>
105
106	^ categoryTree treeView hasSelectedItem
107    ]
108
109    selectedCategory [
110	<category: 'accessing'>
111
112	self hasSelectedCategory ifFalse: [ self error: 'nothing is selected' ].
113	^ categoryTree treeView selection
114    ]
115
116    selectACategory: aString [
117        <category: 'item selection'>
118
119	categoryTree treeView select: aString
120    ]
121
122    findIterInACategory: aString [
123        <category: 'item selection'>
124
125        | result |
126        result := model findIterInACategory: aString.
127        categoryTree treeView scrollToCell: (model gtkModel getPath: result) column: nil useAlign: false rowAlign: 0.5 colAlign: 0.5.
128        ^ result
129    ]
130
131    viewedCategoryWidget [
132	<category: 'accessing'>
133
134	^ self
135    ]
136
137    viewedCategoryModel [
138	<category: 'accessing'>
139
140	^ model
141    ]
142
143    removeEmptyCategory [
144	<category: 'update'>
145
146	| set |
147	set := Set new.
148	self buildCategory: set.
149	(categories - set) do: [ :each |
150			model remove: each.
151			categories remove: each ifAbsent: [] ]
152    ]
153
154    addEvent: anEvent [
155        <category: 'event'>
156
157        (anEvent item methodClass == self classOrMeta and: [ (model hasItem: anEvent item methodCategory) not ]) ifFalse: [ ^ self ].
158        categories add: anEvent item methodCategory.
159	model append: anEvent item methodCategory.
160	self removeEmptyCategory
161    ]
162
163    removeEvent: anEvent [
164        <category: 'event'>
165
166        (anEvent item methodClass == self classOrMeta and: [ (model hasItem: anEvent item methodCategory) not ]) ifFalse: [ ^ self ].
167	self removeEmptyCategory
168    ]
169]
170
171