|
1 HierarchicalList subclass:#HierarchicalFileList |
|
2 instanceVariableNames:'icons matchBlock' |
|
3 classVariableNames:'' |
|
4 poolDictionaries:'' |
|
5 category:'AAA-Model' |
|
6 ! |
|
7 |
|
8 HierarchicalItem subclass:#File |
|
9 instanceVariableNames:'fileName baseName icon' |
|
10 classVariableNames:'' |
|
11 poolDictionaries:'' |
|
12 privateIn:HierarchicalFileList |
|
13 ! |
|
14 |
|
15 HierarchicalFileList::File subclass:#Directory |
|
16 instanceVariableNames:'modificationTime' |
|
17 classVariableNames:'' |
|
18 poolDictionaries:'' |
|
19 privateIn:HierarchicalFileList::File |
|
20 ! |
|
21 |
|
22 |
|
23 !HierarchicalFileList class methodsFor:'examples'! |
|
24 |
|
25 test |
|
26 |top sel list item| |
|
27 |
|
28 list := HierarchicalFileList new. |
|
29 list directory:(Filename homeDirectory). |
|
30 list showRoot:false. |
|
31 list matchBlock:[:fn :isDir| |suf rslt| |
|
32 (rslt := isDir) ifFalse:[ |
|
33 suf := fn suffix. |
|
34 |
|
35 suf size ~~ 0 ifTrue:[ |
|
36 rslt := ( suf = 'c' |
|
37 or:[suf = 'h' |
|
38 or:[suf = 'hi']] |
|
39 ) |
|
40 ] |
|
41 ]. |
|
42 rslt |
|
43 ]. |
|
44 |
|
45 top := StandardSystemView new; extent:300@300. |
|
46 sel := ScrollableView for:HierarchicalListView miniScroller:true |
|
47 origin:0.0@0.0 corner:1.0@1.0 in:top. |
|
48 |
|
49 sel list:list. |
|
50 list root expand. |
|
51 |
|
52 sel doubleClickAction:[:i| (list at:i) toggleExpand ]. |
|
53 sel indicatorAction:[:i| (list at:i) toggleExpand ]. |
|
54 |
|
55 top open. |
|
56 |
|
57 |
|
58 ! ! |
|
59 |
|
60 !HierarchicalFileList class methodsFor:'resources'! |
|
61 |
|
62 icons |
|
63 "returns set of icons |
|
64 " |
|
65 |icons resources fileKey resource baseName pathName| |
|
66 |
|
67 resources := FileBrowser classResources. |
|
68 icons := Dictionary new. |
|
69 |
|
70 #( |
|
71 (#directory 'ICON_DIRECTORY' 'tiny_yellow_dir.xpm' ) |
|
72 (#directoryLocked 'ICON_DIRECTORY_LOCKED' 'tiny_yellow_dir_locked.xpm') |
|
73 (#directoryLink 'ICON_DIRECTORY_LINK' 'tiny_yellow_dir_link.xpm' ) |
|
74 (#file 'ICON_FILE' 'tiny_file_plain.xpm' ) |
|
75 (#fileLink 'ICON_FILE_LINK' 'tiny_file_link.xpm' ) |
|
76 (#fileLocked 'ICON_FILE_LOCKED' 'tiny_file_lock.xpm' ) |
|
77 (#imageFile 'ICON_IMAGE_FILE' 'tiny_file_pix.xpm' ) |
|
78 (#textFile 'ICON_TEXT_FILE' 'tiny_file_text.xpm' ) |
|
79 (#executableFile 'ICON_EXECUTABLEFILE' 'tiny_file_exec.xpm' ) |
|
80 |
|
81 ) do:[:entry| |
|
82 fileKey := entry at:1. |
|
83 resource := entry at:2. |
|
84 baseName := entry at:3. |
|
85 |
|
86 (pathName := resources at:(entry at:2) default:nil) isNil ifTrue:[ |
|
87 pathName := 'bitmaps/xpmBitmaps/document_images/' , baseName |
|
88 ]. |
|
89 icons at:fileKey put:(Image fromFile:pathName). |
|
90 ]. |
|
91 ^ icons |
|
92 |
|
93 |
|
94 |
|
95 |
|
96 ! ! |
|
97 |
|
98 !HierarchicalFileList methodsFor:'accessing'! |
|
99 |
|
100 directory |
|
101 "returns the root directory or nil |
|
102 " |
|
103 ^ root notNil ifTrue:[root fileName] ifFalse:[nil] |
|
104 |
|
105 ! |
|
106 |
|
107 directory:aDirectory |
|
108 "set the root directory or nil |
|
109 " |
|
110 |directory| |
|
111 |
|
112 monitoringTaskDelay := 1. |
|
113 |
|
114 (aDirectory notNil and:[(directory := aDirectory asFilename) exists]) ifTrue:[ |
|
115 directory isDirectory ifFalse:[ |
|
116 directory := directory directory |
|
117 ] |
|
118 ] ifFalse:[ |
|
119 directory := nil |
|
120 ]. |
|
121 |
|
122 directory = self directory ifFalse:[ |
|
123 directory notNil ifTrue:[ |
|
124 directory := File fileName:directory isDirectory:true |
|
125 ]. |
|
126 self root:directory |
|
127 ]. |
|
128 ! ! |
|
129 |
|
130 !HierarchicalFileList methodsFor:'actions'! |
|
131 |
|
132 matchBlock |
|
133 "set the matchBlock - if non-nil, it controls which files are visible. |
|
134 " |
|
135 ^ matchBlock |
|
136 |
|
137 ! |
|
138 |
|
139 matchBlock:aBlock |
|
140 "set the matchBlock - if non-nil, it controls which files are visible. |
|
141 " |
|
142 matchBlock := aBlock. |
|
143 |
|
144 ! ! |
|
145 |
|
146 !HierarchicalFileList methodsFor:'protocol'! |
|
147 |
|
148 childrenFor:anItem |
|
149 "returns all visible children derived from the physical |
|
150 directory contents. |
|
151 " |
|
152 |contents list block| |
|
153 |
|
154 list := #(). |
|
155 |
|
156 anItem isDirectory ifFalse:[ |
|
157 ^ list |
|
158 ]. |
|
159 |
|
160 Cursor read showWhile:[ |
|
161 contents := DirectoryContents directoryNamed:(anItem fileName). |
|
162 |
|
163 contents notNil ifTrue:[ |
|
164 list := OrderedCollection new. |
|
165 block := self matchBlockFor:anItem. |
|
166 |
|
167 block isNil ifTrue:[ |
|
168 contents contentsDo:[:fn :isDir| |
|
169 list add:(File fileName:fn isDirectory:isDir) |
|
170 ] |
|
171 ] ifFalse:[ |
|
172 contents contentsDo:[:fn :isDir| |
|
173 (block value:fn value:isDir) ifTrue:[ |
|
174 list add:(File fileName:fn isDirectory:isDir) |
|
175 ] |
|
176 ] |
|
177 ] |
|
178 ] |
|
179 ]. |
|
180 ^ list |
|
181 |
|
182 |
|
183 |
|
184 |
|
185 ! |
|
186 |
|
187 hasChildrenFor:anItem |
|
188 "returns true if the physical directory contains at least |
|
189 one visible item otherwise false. |
|
190 " |
|
191 |block| |
|
192 |
|
193 anItem isDirectory ifFalse:[ |
|
194 ^ false |
|
195 ]. |
|
196 |
|
197 (block := self matchBlockFor:anItem) isNil ifTrue:[ |
|
198 block := [:aFilename :isDirectory| true ] |
|
199 ]. |
|
200 ^ DirectoryContents directoryNamed:(anItem fileName) detect:block |
|
201 ! |
|
202 |
|
203 iconFor:anItem |
|
204 "returns the icon for an item |
|
205 " |
|
206 |fn key| |
|
207 |
|
208 fn := anItem fileName. |
|
209 |
|
210 fn isDirectory ifTrue:[ |
|
211 (fn isReadable and:[fn isExecutable]) ifTrue:[ |
|
212 key := fn isSymbolicLink ifTrue:[#directoryLink] |
|
213 ifFalse:[#directory] |
|
214 ] ifFalse:[ |
|
215 key := #directoryLocked |
|
216 ] |
|
217 ] ifFalse:[ |
|
218 fn isReadable ifTrue:[ |
|
219 fn isSymbolicLink ifTrue:[ |
|
220 key := #fileLink |
|
221 ] ifFalse:[ |
|
222 (Image isImageFileSuffix:(fn suffix)) ifTrue:[ |
|
223 key := #imageFile |
|
224 ] ifFalse:[ |
|
225 key := #file |
|
226 ] |
|
227 ] |
|
228 ] ifFalse:[ |
|
229 key := #fileLocked |
|
230 ] |
|
231 ]. |
|
232 icons isNil ifTrue:[ |
|
233 icons := self class icons |
|
234 ]. |
|
235 |
|
236 ^ icons at:key ifAbsent:nil |
|
237 ! |
|
238 |
|
239 matchBlockFor:anItem |
|
240 "get the matchBlock - if non-nil, it controls which files are |
|
241 visible within the physical directory |
|
242 " |
|
243 ^ matchBlock |
|
244 ! ! |
|
245 |
|
246 !HierarchicalFileList::File class methodsFor:'instance creation'! |
|
247 |
|
248 fileName:aFileName isDirectory:isDirectory |
|
249 "instance creation |
|
250 " |
|
251 |item| |
|
252 |
|
253 item := isDirectory ifTrue:[Directory new] ifFalse:[HierarchicalFileList::File new]. |
|
254 item fileName:aFileName. |
|
255 ^ item |
|
256 |
|
257 ! ! |
|
258 |
|
259 !HierarchicalFileList::File methodsFor:'accessing'! |
|
260 |
|
261 baseName |
|
262 "returns the baseName |
|
263 " |
|
264 ^ baseName |
|
265 |
|
266 |
|
267 ! |
|
268 |
|
269 children |
|
270 "always returns an empty list |
|
271 " |
|
272 ^ #() |
|
273 ! |
|
274 |
|
275 fileName |
|
276 "returns the fileName |
|
277 " |
|
278 ^ fileName |
|
279 |
|
280 |
|
281 ! |
|
282 |
|
283 fileName:fname |
|
284 "instance creation |
|
285 " |
|
286 fileName := fname. |
|
287 baseName := fname baseName. |
|
288 ! |
|
289 |
|
290 icon |
|
291 "returns the icon key |
|
292 " |
|
293 |model| |
|
294 |
|
295 icon isNil ifTrue:[ |
|
296 (model := self model) notNil ifTrue:[ |
|
297 icon := model iconFor:self |
|
298 ] |
|
299 ]. |
|
300 ^ icon |
|
301 |
|
302 |
|
303 ! |
|
304 |
|
305 label |
|
306 "returns the printable name, the baseName |
|
307 " |
|
308 ^ baseName |
|
309 |
|
310 |
|
311 ! |
|
312 |
|
313 pathName |
|
314 "returns the pathName |
|
315 " |
|
316 ^ fileName pathName |
|
317 ! ! |
|
318 |
|
319 !HierarchicalFileList::File methodsFor:'accessing hierarchy'! |
|
320 |
|
321 recursiveExpand |
|
322 "redefined to expand |
|
323 " |
|
324 self expand |
|
325 |
|
326 |
|
327 ! ! |
|
328 |
|
329 !HierarchicalFileList::File methodsFor:'invalidate'! |
|
330 |
|
331 invalidate |
|
332 "invalidate the contents |
|
333 " |
|
334 self invalidateRepairNow:false |
|
335 |
|
336 ! |
|
337 |
|
338 invalidateRepairNow |
|
339 "invalidate the contents; repair now |
|
340 " |
|
341 self invalidateRepairNow:true |
|
342 |
|
343 ! |
|
344 |
|
345 invalidateRepairNow:doRepair |
|
346 "invalidate the contents; dependent on the boolean |
|
347 do repair immediately |
|
348 " |
|
349 |
|
350 |
|
351 ! ! |
|
352 |
|
353 !HierarchicalFileList::File methodsFor:'queries'! |
|
354 |
|
355 hasChildren |
|
356 "always returns false |
|
357 " |
|
358 ^ false |
|
359 ! |
|
360 |
|
361 isDirectory |
|
362 "always returns false |
|
363 " |
|
364 ^ false |
|
365 |
|
366 ! |
|
367 |
|
368 string |
|
369 "returns the string from the label or nil |
|
370 " |
|
371 ^ baseName |
|
372 ! ! |
|
373 |
|
374 !HierarchicalFileList::File::Directory methodsFor:'accessing'! |
|
375 |
|
376 children |
|
377 "returns the list of children |
|
378 " |
|
379 |model list| |
|
380 |
|
381 children isNil ifTrue:[ |
|
382 children := #(). "/ disable reread |
|
383 modificationTime := fileName modificationTime. |
|
384 |
|
385 (model := self model) notNil ifTrue:[ |
|
386 list := model childrenFor:self. |
|
387 |
|
388 list size ~~ 0 ifTrue:[ |
|
389 list do:[:aChild| aChild parent:self]. |
|
390 children := list. |
|
391 ] |
|
392 ]. |
|
393 ]. |
|
394 ^ children |
|
395 ! |
|
396 |
|
397 icon |
|
398 "returns the icon |
|
399 " |
|
400 (isExpanded and:[children size ~~ 0]) ifTrue:[ |
|
401 ^ nil |
|
402 ]. |
|
403 ^ super icon |
|
404 ! ! |
|
405 |
|
406 !HierarchicalFileList::File::Directory methodsFor:'queries'! |
|
407 |
|
408 hasChildren |
|
409 "returns true if children exists |
|
410 " |
|
411 ^ children isNil or:[children notEmpty] |
|
412 ! |
|
413 |
|
414 isDirectory |
|
415 "always returns true |
|
416 " |
|
417 ^ true |
|
418 |
|
419 |
|
420 ! ! |
|
421 |
|
422 !HierarchicalFileList::File::Directory methodsFor:'validation'! |
|
423 |
|
424 invalidateRepairNow:doRepair |
|
425 "invalidate contents |
|
426 " |
|
427 modificationTime := nil. |
|
428 |
|
429 doRepair ifTrue:[ |
|
430 self monitoringCycle |
|
431 ] ifFalse:[ |
|
432 (isExpanded or:[children size == 0]) ifFalse:[ |
|
433 children := nil |
|
434 ] |
|
435 ]. |
|
436 |
|
437 ! |
|
438 |
|
439 monitoringCycle |
|
440 "run monitoring cycle |
|
441 " |
|
442 |list size name modifyTime isNotEmpty wasNotEmpty model| |
|
443 |
|
444 modifyTime := fileName modificationTime. |
|
445 |
|
446 (modificationTime notNil and:[modifyTime <= modificationTime]) ifTrue:[ |
|
447 ^ self |
|
448 ]. |
|
449 model := self model. |
|
450 modificationTime := modifyTime. |
|
451 |
|
452 isExpanded ifFalse:[ |
|
453 |
|
454 "/ CHECK WHETHER CHILDREN EXIST( INDICATOR ) |
|
455 "/ ========================================= |
|
456 |
|
457 isNotEmpty := model hasChildrenFor:self. |
|
458 |
|
459 "/ check whether has changed durring evaluation |
|
460 (isExpanded or:[modificationTime ~= modifyTime]) ifFalse:[ |
|
461 wasNotEmpty := children isNil. |
|
462 children := isNotEmpty ifTrue:[nil] ifFalse:[#()]. |
|
463 |
|
464 wasNotEmpty ~~ isNotEmpty ifTrue:[ |
|
465 self changed |
|
466 ] |
|
467 ]. |
|
468 ^ self |
|
469 |
|
470 ]. |
|
471 |
|
472 "/ START MERGING( CONTENTS IS VISIBLE ) |
|
473 "/ ==================================== |
|
474 |
|
475 list := model childrenFor:self. |
|
476 |
|
477 list size == 0 ifTrue:[ "/ contents becomes empty |
|
478 ^ self removeAll "/ clear contents |
|
479 ]. |
|
480 (size := children size) == 0 ifTrue:[ "/ old contents was empty |
|
481 ^ self addAll:list. "/ take over new contents |
|
482 ]. |
|
483 |
|
484 size to:1 by:-1 do:[:anIndex| "/ remove invisible items |
|
485 name := (children at:anIndex) baseName. |
|
486 |
|
487 (list findFirst:[:i|i baseName = name]) == 0 ifTrue:[ |
|
488 self removeIndex:anIndex |
|
489 ] |
|
490 ]. |
|
491 |
|
492 list keysAndValuesDo:[:anIndex :anItem| "/ add new visible items |
|
493 name := anItem baseName. |
|
494 |
|
495 (children findFirst:[:i|i baseName = name]) == 0 ifTrue:[ |
|
496 self add:anItem beforeIndex:anIndex |
|
497 ] |
|
498 ]. |
|
499 ! ! |
|
500 |
|
501 !HierarchicalFileList class methodsFor:'documentation'! |
|
502 |
|
503 version |
|
504 ^ '$Header: /cvs/stx/stx/libwidg2/HierarchicalFileList.st,v 1.1 1999-05-23 12:56:11 cg Exp $' |
|
505 ! ! |