1: ================================================================================
2:
3: Smalltalk.KSU defineClass: #DirectoryTree
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.DirectoryTree method for 'defaults'
15:
16: defaultDirectory
17:
18: | aDirectory |
19: aDirectory :=
20: [aDirectory := Filename volumes first asFilename construct: 'Users'.
21: (aDirectory exists and: [aDirectory isDirectory])
22: ifFalse: [self error: '期待していたディレクトリがありません。'].
23: aDirectory yourself]
24: on: self errorSignal
25: do: [:anException | Filename defaultDirectory].
26: ^aDirectory
27:
28: ------------------------------------------------------------
29:
30: KSU.DirectoryTree method for 'defaults'
31:
32: defaultDisplayStringSelector
33:
34: ^#tail
35:
36: ------------------------------------------------------------
37:
38: KSU.DirectoryTree method for 'defaults'
39:
40: defaultSortBlock
41:
42: | aSelector aBlock |
43: aSelector := self defaultDisplayStringSelector.
44: aBlock := [:directoryA :directoryB | (directoryA perform: aSelector) < (directoryB perform: aSelector)].
45: ^aBlock
46:
47: ------------------------------------------------------------
48:
49: KSU.DirectoryTree method for 'initialize-release'
50:
51: initialize
52:
53: super initialize.
54: selectionInTree := nil.
55: ^self
56:
57: ------------------------------------------------------------
58:
59: KSU.DirectoryTree method for 'menu messages'
60:
61: inspectDirectory
62:
63: | aDirectory |
64: (aDirectory := self selectionInTree selection) isNil
65: ifTrue: [Dialog warn: 'ディレクトリが選択されていません。']
66: ifFalse:
67: [
68: [| aFileBrowser |
69: (aFileBrowser := #{Tools.FileTools.FileBrowser} value new)
70: open;
71: selectDirectory: aDirectory.
72: aFileBrowser isZoomed ifFalse: [aFileBrowser toggleZoom]]
73: on: Object errorSignal
74: do: [:anException | Dialog warn: 'ディレクトリ「' , (aDirectory asString contractTo: 32) , '」はアクセスできません。']]
75:
76: ------------------------------------------------------------
77:
78: KSU.DirectoryTree method for 'interface opening'
79:
80: postOpenWith: aBuilder
81:
82: | aWrapper |
83: super postOpenWith: aBuilder.
84: aWrapper := aBuilder componentAt: #selectionInTree.
85: aWrapper ifNil: [^nil].
86: aWrapper spec useIcons: #folder.
87: (aWrapper widget)
88: useLines: true;
89: useChildImages: true;
90: rootExpander: true;
91: displayStringSelector: self defaultDisplayStringSelector
92:
93: ------------------------------------------------------------
94:
95: KSU.DirectoryTree method for 'aspects'
96:
97: selectionInTree
98:
99: selectionInTree
100: ifNil:
101: [selectionInTree := UI.SelectionInTree new.
102: selectionInTree list
103: root: self defaultDirectory
104: displayIt: true
105: childrenBlock: [:aDirectory | self subDirectoriesOf: aDirectory].
106: selectionInTree selectionHolder compute:
107: [:aDirectory |
108: Transcript
109: cr;
110: show: aDirectory printString]].
111: ^selectionInTree
112:
113: ------------------------------------------------------------
114:
115: KSU.DirectoryTree method for 'accessing'
116:
117: subDirectoriesOf: aDirectory
118:
119: | aCollection |
120: aCollection := OrderedCollection new.
121: aDirectory directoryContents do:
122: [:each |
123: each first = $.
124: ifFalse:
125: [
126: [| aFilename |
127: aFilename := aDirectory constructSafe: each.
128: aFilename isDirectory ifTrue: [aCollection add: aFilename]]
129: on: self errorSignal
130: do: [:anException | anException return]]].
131: aCollection := aCollection asSortedCollection: self defaultSortBlock.
132: ^aCollection asArray
133:
134: ================================================================================
135:
136: KSU.DirectoryTree class
137: instanceVariableNames: ''
138:
139: ================================================================================
140:
141: KSU.DirectoryTree class method for 'examples'
142:
143: example1
144: "KSU.DirectoryTree example1."
145:
146: | anApplication |
147: anApplication := KSU.DirectoryTree new.
148: anApplication open.
149: ^anApplication
150:
151: ------------------------------------------------------------
152:
153: KSU.DirectoryTree class method for 'resources'
154:
155: menuBar
156: "Tools.MenuEditor new openOnClass: self andSelector: #menuBar"
157:
158: <resource: #menu>
159: ^#(#{UI.Menu} #(
160: #(#{UI.MenuItem}
161: #rawLabel: 'ファイル'
162: #submenu: #(#{UI.Menu} #(
163: #(#{UI.MenuItem}
164: #rawLabel: '終了'
165: #value: #closeRequest ) ) #(1 ) nil ) ) ) #(1 ) nil ) decodeAsLiteralArray
166:
167: ------------------------------------------------------------
168:
169: KSU.DirectoryTree class method for 'resources'
170:
171: menuForSelectionInTree
172: "Tools.MenuEditor new openOnClass: self andSelector: #menuForSelectionInTree"
173:
174: <resource: #menu>
175: ^#(#{UI.Menu} #(
176: #(#{UI.MenuItem}
177: #rawLabel: '拡張'
178: #value: #expand )
179: #(#{UI.MenuItem}
180: #rawLabel: '縮小'
181: #value: #contractFully )
182: #(#{UI.MenuItem}
183: #rawLabel: '検査'
184: #value: #inspectDirectory ) ) #(1 1 1 ) nil ) decodeAsLiteralArray
185:
186: ------------------------------------------------------------
187:
188: KSU.DirectoryTree class method for 'interface specs'
189:
190: windowSpec
191: "Tools.UIPainter new openOnClass: self andSelector: #windowSpec"
192:
193: <resource: #canvas>
194: ^#(#{UI.FullSpec}
195: #window:
196: #(#{UI.WindowSpec}
197: #label: 'ディレクトリツリー'
198: #min: #(#{Core.Point} 200 300 )
199: #max: #(#{Core.Point} 0 0 )
200: #bounds: #(#{Graphics.Rectangle} 1080 420 1480 1020 )
201: #flags: 4
202: #menu: #menuBar )
203: #component:
204: #(#{UI.SpecCollection}
205: #collection: #(
206: #(#{UI.TreeViewSpec}
207: #layout: #(#{Graphics.LayoutFrame} 2 0 2 0 -2 1 -2 1 )
208: #name: #selectionInTree
209: #flags: 15
210: #model: #selectionInTree
211: #menu: #menuForSelectionInTree
212: #useModifierKeys: true
213: #selectionType: #highlight
214: #displayStringSelector: #tail
215: #useIcons: #folder
216: #rootExpander: true ) ) ) )
217:
218: ================================================================================
This document was generated by KSU.TextDoclet on 2012/11/10 at 14:13:04.