"
 COPYRIGHT (c) 1999 by eXept Software AG
              All Rights Reserved

 This software is furnished under a license and may be used
 only in accordance with the terms of that license and with the
 inclusion of the above copyright notice.   This software may not
 be provided or otherwise made available to, or used by, any
 other person.  No title to or ownership of the software is
 hereby transferred.
"


"{ Package: 'stx:libwidg2' }"

HierarchicalList subclass:#HierarchicalFileList
	instanceVariableNames:'icons matchBlock showCursor'
	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:'documentation'!

copyright
"
 COPYRIGHT (c) 1999 by eXept Software AG
              All Rights Reserved

 This software is furnished under a license and may be used
 only in accordance with the terms of that license and with the
 inclusion of the above copyright notice.   This software may not
 be provided or otherwise made available to, or used by, any
 other person.  No title to or ownership of the software is
 hereby transferred.
"

! !

!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
    ^ FileBrowser 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|

"/    must explicitly enabled by user: ca
"/    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.

    root notNil ifTrue:[
        self recursionLock critical:[
            self stopMonitoringTask.
            root matchBlockChanged.
        ].
        self startMonitoringTask.
    ].

! !

!HierarchicalFileList methodsFor:'protocol'!

childrenFor:anItem
    "returns all visible children derived from the physical
     directory contents.
    "
    |contents list block|

    list := #().

    anItem isDirectory ifFalse:[
        ^ list
    ].

    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 suff mimeType icn|

    fn := anItem fileName.
    icons isNil ifTrue:[ icons := self class icons ].

    fn isDirectory ifTrue:[
        (fn isReadable and:[fn isExecutable]) ifTrue:[
            key := fn isSymbolicLink ifTrue:[#directoryLink]
                                    ifFalse:[#directory]
        ] ifFalse:[
            key := #directoryLocked
        ].
        ^ icons at:key ifAbsent:nil
    ].

    fn isReadable     ifFalse:[ ^ icons at:#fileLocked ifAbsent:nil ].
    fn isSymbolicLink  ifTrue:[ ^ icons at:#fileLink   ifAbsent:nil ].

    suff := fn suffix.

    (suff = 'bak' or:[suff = 'sav']) ifTrue:[
        suff := fn withoutSuffix suffix.
    ].

    suff size > 0 ifTrue:[
        ( #( 'o' 'so' 'a' ) includes:suff) ifTrue:[
             ^ icons at:#executableFile ifAbsent:nil
        ].        
        mimeType := MIMETypes mimeTypeForSuffix:suff.

        mimeType notNil ifTrue:[
            (icn := icons at:mimeType ifAbsent:nil) notNil ifTrue:[^ icn].

            (mimeType startsWith:'image/') ifTrue:[
                ^ icons at:#imageFile ifAbsent:nil
            ].
        ].
    ].

    fn isExecutableProgram ifTrue:[
        ^ icons at:#executableFile ifAbsent:nil
    ].
    ^ icons at:#file ifAbsent:nil
!

matchBlockFor:anItem
    "get the matchBlock - if non-nil, it controls which files are
     visible within the physical directory
    "
    ^ matchBlock        
!

validateIcon:anIcon for:anItem
    ^ anIcon
! !

!HierarchicalFileList methodsFor:'searching'!

detectItemFor:aPathOrFilename
    "make a filename visible
    "
    |file node p1 p2 sz|

    aPathOrFilename isNil ifTrue:[^ nil].

    file := aPathOrFilename asFilename.

    file exists ifFalse:[
        ^ nil
    ].
    (node := root) isNil ifTrue:[^ nil].

    p1 := node pathName.
    p2 := file pathName.

    (p2 startsWith:p1) ifFalse:[^ nil].
    sz := 1 + p1 size.

    (p1 last == Filename separator) ifFalse:[
        sz := sz + 1.
    ].

    p2 size > sz ifFalse:[^ nil].

    p2 :=  Filename components:(p2 copyFrom:sz).

    p2 do:[:bn|
        node := node detect:[:el| el baseName = bn] ifNone:nil.
        node isNil ifTrue:[^ nil ].
    ].
    ^ node
! !

!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|

    model := self model.
    model ifNil:[^ nil].

    icon isNil ifTrue:[
        icon := model iconFor:self
    ].
    ^ model validateIcon:icon for:self
!

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
    "


!

matchBlockChanged
    "called if the matchBlock changed
    "

! !

!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 notNil ifTrue:[
        ^ children
    ].

    (model := self model) isNil ifTrue:[
        "/ must reread later
        modificationTime := children := nil.
        ^ nil
    ].

    children := #().
    modificationTime := fileName modificationTime.
    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
        ]
    ].

!

matchBlockChanged
    "called if the matchBlock changed
    "
    modificationTime := nil.

    isExpanded ifFalse:[
        children := nil.
    ] ifTrue:[
        self monitoringCycle.

        children size ~~ 0 ifTrue:[
            children do:[:aChild| aChild matchBlockChanged ]
        ]
    ].
!

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.11 2002-04-24 11:35:01 penk Exp $'
! !