HierarchicalList subclass:#HierarchicalFileList
	instanceVariableNames:'icons matchBlock'
	classVariableNames:''
	poolDictionaries:''
	category:'AAA-Model'
!

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

!

string
    "returns the string from the label or nil
    "
    ^ baseName
! !

!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
    ^ '$Header: /cvs/stx/stx/libwidg2/HierarchicalFileList.st,v 1.1 1999-05-23 12:56:11 cg Exp $'
! !