HierarchicalList subclass:#HierarchicalFileList

	instanceVariableNames:'icons matchBlock'

	classVariableNames:''

	poolDictionaries:''

	category:'Views-Support'

!

HierarchicalItem subclass:#File

	instanceVariableNames:'fileName baseName icon'

	classVariableNames:''

	poolDictionaries:''

	privateIn:HierarchicalFileList

!

HierarchicalFileList::File subclass:#Directory

	instanceVariableNames:'modificationTime'

	classVariableNames:''

	poolDictionaries:''

	privateIn:HierarchicalFileList::File

!

!HierarchicalFileList class methodsFor:'examples'!

test

    |top sel list item|

    list := HierarchicalFileList new.

    list directory:(Filename homeDirectory).

    list showRoot:false.

    list matchBlock:[:fn :isDir| |suf rslt|

                         (rslt := isDir) ifFalse:[

                             suf := fn suffix.

                             suf size ~~ 0 ifTrue:[

                                 rslt := (    suf = 'c'

                                          or:[suf = 'h'

                                          or:[suf = 'hi']]

                                         )

                             ]

                         ].

                         rslt

                     ].

    top := StandardSystemView new; extent:300@300.

    sel := ScrollableView for:HierarchicalListView miniScroller:true

                       origin:0.0@0.0 corner:1.0@1.0 in:top.

    sel list:list.

    list root expand.

    sel doubleClickAction:[:i| (list at:i) toggleExpand ].

    sel   indicatorAction:[:i| (list at:i) toggleExpand ].

    top open.

! !

!HierarchicalFileList class methodsFor:'resources'!

icons

    "returns set of icons

    "

    |icons resources fileKey resource baseName pathName|

    resources := FileBrowser classResources.

    icons     := Dictionary new.

    #(

        (#directory       'ICON_DIRECTORY'        'tiny_yellow_dir.xpm'       )

        (#directoryLocked 'ICON_DIRECTORY_LOCKED' 'tiny_yellow_dir_locked.xpm')

        (#directoryLink   'ICON_DIRECTORY_LINK'   'tiny_yellow_dir_link.xpm'  )

        (#file            'ICON_FILE'             'tiny_file_plain.xpm'       )

        (#fileLink        'ICON_FILE_LINK'        'tiny_file_link.xpm'        )

        (#fileLocked      'ICON_FILE_LOCKED'      'tiny_file_lock.xpm'        )

        (#imageFile       'ICON_IMAGE_FILE'       'tiny_file_pix.xpm'         )

        (#textFile        'ICON_TEXT_FILE'        'tiny_file_text.xpm'        )

        (#executableFile  'ICON_EXECUTABLEFILE'   'tiny_file_exec.xpm'        )

     ) do:[:entry|

        fileKey  := entry at:1.

        resource := entry at:2.

        baseName := entry at:3.

        (pathName := resources at:(entry at:2) default:nil) isNil ifTrue:[

            pathName := 'bitmaps/xpmBitmaps/document_images/' , baseName

        ].

        icons at:fileKey put:(Image fromFile:pathName).

    ].

    ^ icons

! !

!HierarchicalFileList methodsFor:'accessing'!

directory

    "returns the root directory or nil

    "

    ^ root notNil ifTrue:[root fileName] ifFalse:[nil]

!

directory:aDirectory

    "set the root directory or nil

    "

    |directory|

    monitoringTaskDelay := 1.

    (aDirectory notNil and:[(directory := aDirectory asFilename) exists]) ifTrue:[

        directory isDirectory ifFalse:[

            directory := directory directory

        ]

    ] ifFalse:[

        directory := nil

    ].

    directory = self directory ifFalse:[

        directory notNil ifTrue:[

            directory := File fileName:directory isDirectory:true

        ].

        self root:directory

    ].

! !

!HierarchicalFileList methodsFor:'actions'!

matchBlock

    "set the matchBlock - if non-nil, it controls which files are visible.

    "

    ^ matchBlock

!

matchBlock:aBlock

    "set the matchBlock - if non-nil, it controls which files are visible.

    "

    matchBlock := aBlock.

! !

!HierarchicalFileList methodsFor:'protocol'!

childrenFor:anItem

    "returns all visible children derived from the physical

     directory contents.

    "

    |contents list block|

    list := #().

    anItem isDirectory ifFalse:[

        ^ list

    ].

    Cursor read showWhile:[

        contents := DirectoryContents directoryNamed:(anItem fileName).

        contents notNil ifTrue:[

            list  := OrderedCollection new.

            block := self matchBlockFor:anItem.

            block isNil ifTrue:[

                contents contentsDo:[:fn :isDir|

                    list add:(File fileName:fn isDirectory:isDir)

                ]

            ] ifFalse:[

                contents contentsDo:[:fn :isDir|

                    (block value:fn value:isDir) ifTrue:[

                        list add:(File fileName:fn isDirectory:isDir)

                    ]

                ]

            ]

        ]

    ].

    ^ list

!

hasChildrenFor:anItem

    "returns true if the physical directory contains at least

     one visible item otherwise false.

    "

    |block|

    anItem isDirectory ifFalse:[

        ^ false

    ].

    (block := self matchBlockFor:anItem) isNil ifTrue:[

        block := [:aFilename :isDirectory| true ]

    ].

    ^ DirectoryContents directoryNamed:(anItem fileName) detect:block

!

iconFor:anItem

    "returns the icon for an item

    "

    |fn key|

    fn := anItem fileName.

    fn isDirectory ifTrue:[

        (fn isReadable and:[fn isExecutable]) ifTrue:[

            key := fn isSymbolicLink ifTrue:[#directoryLink]

                                    ifFalse:[#directory]

        ] ifFalse:[

            key := #directoryLocked

        ]

    ] ifFalse:[

        fn isReadable ifTrue:[

            fn isSymbolicLink ifTrue:[

                key := #fileLink

            ] ifFalse:[

                (Image isImageFileSuffix:(fn suffix)) ifTrue:[

                    key := #imageFile

                ] ifFalse:[

                    key := #file

                ]

            ]

        ] ifFalse:[

            key := #fileLocked

        ]

    ].

    icons isNil ifTrue:[

        icons := self class icons

    ].

  ^ icons at:key ifAbsent:nil

!

matchBlockFor:anItem

    "get the matchBlock - if non-nil, it controls which files are

     visible within the physical directory

    "

    ^ matchBlock        

! !

!HierarchicalFileList::File class methodsFor:'instance creation'!

fileName:aFileName isDirectory:isDirectory

    "instance creation

    "

    |item|

    item := isDirectory ifTrue:[Directory new] ifFalse:[HierarchicalFileList::File new].

    item fileName:aFileName.

  ^ item

! !

!HierarchicalFileList::File methodsFor:'accessing'!

baseName

    "returns the baseName

    "

    ^ baseName

!

children

    "always returns an empty list

    "

    ^ #()

!

fileName

    "returns the fileName

    "

    ^ fileName

!

fileName:fname

    "instance creation

    "

    fileName := fname.

    baseName := fname baseName.

!

icon

    "returns the icon key

    "

    |model|

    icon isNil ifTrue:[

        (model := self model) notNil ifTrue:[

            icon := model iconFor:self

        ]

    ].

    ^ icon

!

label

    "returns the printable name, the baseName

    "

    ^ baseName

!

pathName

    "returns the pathName

    "

    ^ fileName pathName

! !

!HierarchicalFileList::File methodsFor:'accessing hierarchy'!

recursiveExpand

    "redefined to expand

    "

    self expand

! !

!HierarchicalFileList::File methodsFor:'invalidate'!

invalidate

    "invalidate the contents

    "

    self invalidateRepairNow:false

!

invalidateRepairNow

    "invalidate the contents; repair now

    "

    self invalidateRepairNow:true

!

invalidateRepairNow:doRepair

    "invalidate the contents; dependent on the boolean

     do repair immediately

    "

! !

!HierarchicalFileList::File methodsFor:'queries'!

hasChildren

    "always returns false

    "

    ^ false

!

isDirectory

    "always returns false

    "

    ^ false

! !

!HierarchicalFileList::File::Directory methodsFor:'accessing'!

children

    "returns the list of children

    "

    |model list|

    children isNil ifTrue:[

        children := #().     "/ disable reread

        modificationTime := fileName modificationTime.

        (model := self model) notNil ifTrue:[

            list := model childrenFor:self.

            list size ~~ 0 ifTrue:[

                list do:[:aChild| aChild parent:self].

                children := list.

            ]

        ].

    ].

    ^ children

!

icon

    "returns the icon

    "

    (isExpanded and:[children size ~~ 0]) ifTrue:[

        ^ nil

    ].

    ^ super icon

! !

!HierarchicalFileList::File::Directory methodsFor:'queries'!

hasChildren

    "returns true if children exists

    "

    ^ children isNil or:[children notEmpty]

!

isDirectory

    "always returns true

    "

    ^ true

! !

!HierarchicalFileList::File::Directory methodsFor:'validation'!

invalidateRepairNow:doRepair

    "invalidate contents

    "

    modificationTime := nil.

    doRepair ifTrue:[

        self monitoringCycle

    ] ifFalse:[

        (isExpanded or:[children size == 0]) ifFalse:[

            children := nil

        ]

    ].

!

monitoringCycle

    "run monitoring cycle

    "

    |list size name modifyTime isNotEmpty wasNotEmpty model|

    modifyTime := fileName modificationTime.

    (modificationTime notNil and:[modifyTime <= modificationTime]) ifTrue:[

        ^ self

    ].

    model := self model.

    modificationTime := modifyTime.

    isExpanded ifFalse:[

     "/ CHECK WHETHER CHILDREN EXIST( INDICATOR )

     "/ =========================================

        isNotEmpty := model hasChildrenFor:self.

     "/ check whether has changed durring evaluation

        (isExpanded or:[modificationTime ~= modifyTime]) ifFalse:[

            wasNotEmpty := children isNil.

            children    := isNotEmpty ifTrue:[nil] ifFalse:[#()].

            wasNotEmpty ~~ isNotEmpty ifTrue:[

                self changed

            ]

        ].

        ^ self

    ].

 "/ START MERGING( CONTENTS IS VISIBLE )

 "/ ====================================

    list := model childrenFor:self.

    list size == 0 ifTrue:[                         "/ contents becomes empty

        ^ self removeAll                            "/ clear contents

    ].

    (size := children size) == 0 ifTrue:[           "/ old contents was empty 

        ^ self addAll:list.                         "/ take over new contents

    ].

    size to:1 by:-1 do:[:anIndex|                   "/ remove invisible items

        name := (children at:anIndex) baseName.

        (list findFirst:[:i|i baseName = name]) == 0 ifTrue:[

            self removeIndex:anIndex

        ]

    ].

    list keysAndValuesDo:[:anIndex :anItem|         "/ add new visible items

        name := anItem baseName.

        (children findFirst:[:i|i baseName = name]) == 0 ifTrue:[

            self add:anItem beforeIndex:anIndex

        ]

    ].

! !

!HierarchicalFileList class methodsFor:'documentation'!

version