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