"

 COPYRIGHT (c) 1991 by Claus Gittinger

              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:libtool' }"

StandardSystemView subclass:#FileBrowser

	instanceVariableNames:'menuPanel labelView filterField fileListView subView

		currentDirectory fileList checkBlock checkDelta timeOfLastCheck

		myName killButton pauseToggle compressTabs lockUpdate

		previousDirectory currentFileName timeOfFileRead tabSpec

		commandView commandIndex fileEncoding tabRulerView scrollView

		icons matchedIcons listUpdateProcess currentFileInFileName

		lastFileDiffDirectory sortByWhat sortCaseless showingDetails

		showingTimeAndDate showingHiddenFiles showingBigImagePreview

		imagePreviewView imageRenderProcess dosEOLMode doAutoUpdate

		doNotShowFontDialog lastEnforcedNameSpace'

	classVariableNames:'HistorySize DefaultIcon CommandHistory CommandHistorySize

		DefaultCommandPerSuffix VisitedFileHistory LastEnforcedNameSpace'

	poolDictionaries:''

	category:'Interface-Tools-File'

!

!FileBrowser class methodsFor:'documentation'!

copyright

"

 COPYRIGHT (c) 1991 by Claus Gittinger

              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.

"

!

documentation

"

    this used to be a very simple demo application,

    but migrated into a quite nice tool, includes all kinds of 

    warning and information boxes, background processes for directory-

    reading and internationalized strings. A good example for beginners,

    on how to do things .... (and maybe how not to do things ;-, since some

    stuff is historic and was implemented at times when better mechanisms

    were not available)

    See additional information in 'doc/misc/fbrowser.doc'.

    WARNING: files edited with FileBrowser will have leading spaces (multiple-8)

             being replaced by tabs. If tabs are to be preserved at other

             positions (for example, sendmail-config files) they will be

             corrupt after being written.

    [instance variables]:

        checkDelta      <Integer>       number of seconds of check interval

                                        (looks ever so often if shown directory

                                         has changed). You may make this number

                                        higher, if your network-times are

                                        incorrect and thus, the filebrowser

                                        checks too often.

        compressTabs    <Boolean>       if true, leading spaces will be

                                        replaced by tabs when saving text

    some of the defaults (long/short list etc.) can be set by the resource file;

    see FileBrowser>>initialize for more details..

    [author:]

        Claus Gittinger

    [start with:]

        FileBrowser open

"

! !

!FileBrowser class methodsFor:'instance creation'!

on:aDirectoryPath

    "return a new FileBrowser in a pathname"

    ^ (self new currentDirectory:aDirectoryPath)

    "

     (FileBrowser on:'/usr/local/bin') open

     (FileBrowser on:'/etc'          ) open

     (FileBrowser on:'..'            ) open

     (FileBrowser on:'.'             ) open

    "

!

openOn:aDirectoryPath

    "start a new FileBrowser in a pathname"

    ^ (self on:aDirectoryPath) open

    "

     FileBrowser openOn:'/etc'

     FileBrowser openOn:'..'

     FileBrowser openOn:'.'

    "

!

openOn:aDirectoryPath withExtent:extent

    "start a new FileBrowser in a pathname"

    ^ (self on:aDirectoryPath) openWithExtent:extent

    "

     FileBrowser openOn:'/etc'           withExtent:200@300

     FileBrowser openOn:'..'             withExtent:200@300

     FileBrowser openOn:'.'              withExtent:200@300

    "

!

openOnFileNamed:aFilename

    "start a new FileBrowser on a file"

    |f browser|

    f := aFilename asFilename.

    f isDirectory ifTrue:[

        ^ self openOn:aFilename

    ].

    browser := self on:f directoryName.

    browser updateCurrentDirectory.

    browser showFile:f baseName.

    ^ browser open.

    "

     FileBrowser openOnFileNamed:'Makefile'

     FileBrowser openOnFileNamed:'../Makefile'

     FileBrowser openOnFileNamed:'/tmp/foo'

    "

    "Modified: / 17.6.1998 / 11:25:29 / cg"

! !

!FileBrowser class methodsFor:'aspects'!

directoryBookmarks

    ^ AbstractFileBrowser directoryBookmarks.

!

directoryHistory

    ^ AbstractFileBrowser directoryHistory.

! !

!FileBrowser class methodsFor:'defaults'!

defaultIcon

    "return the file browsers default window icon"

    <resource: #style (#FILEBROWSER_ICON #FILEBROWSER_ICON_FILE)>

    |nm i res|

    (i := DefaultIcon) isNil ifTrue:[

        res := self classResources.

        i := res at:'FILEBROWSER_ICON' default:nil.

        i isNil ifTrue:[

            nm := res at:'FILEBROWSER_ICON_FILE' default:'FBrowser.xbm'.

            i := Smalltalk imageFromFileNamed:nm forClass:self.

            i isNil ifTrue:[

                i := StandardSystemView defaultIcon

            ]

        ].

        i notNil ifTrue:[

            DefaultIcon := i := i onDevice:Display

        ]

    ].

    ^ i

    "Modified: 19.3.1997 / 20:48:34 / ca"

    "Modified: 15.8.1997 / 15:27:19 / cg"

! !

!FileBrowser class methodsFor:'fileList user interaction'!

goodRenameDefaultForFile:oldName lastOld:lastOldName lastNew:lastNewName

    ^ DoWhatIMeanSupport goodRenameDefaultForFile:oldName lastOld:lastOldName lastNew:lastNewName

! !

!FileBrowser class methodsFor:'history'!

addToCommandHistory:aCommandString for:aFilename

    |cmd suffix|

    (aCommandString notNil and:[aCommandString notEmpty]) ifTrue:[

        CommandHistory notNil ifTrue:[

            CommandHistory addFirst:aCommandString.

            CommandHistory size > CommandHistorySize ifTrue:[

                CommandHistory removeLast

            ]

        ].

        aFilename notNil ifTrue:[

            cmd := aCommandString copyTo:(aCommandString indexOf:Character space ifAbsent:[aCommandString size + 1])-1.

            DefaultCommandPerSuffix isNil ifTrue:[

                DefaultCommandPerSuffix := Dictionary new.

            ].

            suffix := aFilename asFilename suffix.

            suffix notNil ifTrue:[

                DefaultCommandPerSuffix at:suffix put:cmd.

            ]

        ]

    ]

    "Created: 14.11.1996 / 14:58:13 / cg"

!

addToVisitedFileHistory:path

    |idx|

    idx := VisitedFileHistory indexOf:path.

    idx == 0 ifTrue:[

        VisitedFileHistory size >= HistorySize ifTrue:[

            VisitedFileHistory removeLast.

        ]

    ] ifFalse:[

        "already been there before; move the entry to

         the beginning, so it will fall out later."

        VisitedFileHistory removeIndex:idx.

    ].

    VisitedFileHistory addFirst:path.

! !

!FileBrowser class methodsFor:'icon-presentation'!

addOnIconsFor:aFilename to:aIcon

    "given a fileName, return an appropriate icon"

    | addIcns isDirectory isReadable|

    addIcns := OrderedCollection new.

    aFilename isSymbolicLink ifTrue:[

        addIcns add:(self iconForKeyMatching:#addOnLinked).

    ].

    isDirectory := aFilename isDirectory.

    isReadable := aFilename isReadable.

    ((isReadable not and:[isDirectory not]) or:[(isDirectory) and:[(isReadable not) or:[aFilename isExecutable not]]]) ifTrue:[

        addIcns add:(self iconForKeyMatching:#addOnLocked).

    ].

    addIcns notEmpty ifTrue:[

        addIcns addFirst:aIcon.

        ^ MultiImage images:addIcns.

    ].

    ^ aIcon

!

iconForFile:aFilename

    "given a fileName, return an appropriate icon"

    |icn|

    icn := self iconForKeyMatching:(self iconKeyForFile:aFilename).

    ^ self addOnIconsFor:aFilename to:icn.

!

iconForKeyMatching:mimeTypeOrKey

    ^ MIMETypeIconLibrary iconForKeyMatching:mimeTypeOrKey.

!

iconKeyForFile:aFilenameArg

    "given a fileName, return an appropriate icon"

    ^ MIMETypeIconLibrary iconKeyForFile:aFilenameArg

!

iconKeyForRemoteDirectory:aFilenameArg

    "given a fileName, return an appropriate icon"

    ^ MIMETypeIconLibrary iconKeyForRemoteDirectory:aFilenameArg

! !

!FileBrowser class methodsFor:'interface specs'!

fileSearchDialogSpec

    "This resource specification was automatically generated

     by the UIPainter of ST/X."

    "Do not manually edit this!! If it is corrupted,

     the UIPainter may not be able to read the specification."

    "

     UIPainter new openOnClass:FileBrowser andSelector:#fileSearchDialogSpec

    "

    <resource: #canvas>

    ^ 

     #(FullSpec

        name: fileSearchDialogSpec

        window: 

       (WindowSpec

          label: 'File Search'

          name: 'File Search'

          min: (Point 10 10)

          bounds: (Rectangle 14 46 326 346)

        )

        component: 

       (SpecCollection

          collection: (

           (LabelSpec

              label: 'Search for files named:'

              name: 'Label1'

              layout: (LayoutFrame 0 0 10 0 0 1 32 0)

              translateLabel: true

              adjust: left

            )

           (InputFieldSpec

              name: 'EntryField1'

              layout: (LayoutFrame 10 0 36 0 305 0 58 0)

              tabable: true

              model: namePatternHolder

              acceptOnPointerLeave: false

            )

           (CheckBoxSpec

              label: 'Ignore case'

              name: 'CheckBox1'

              layout: (LayoutFrame 7 0 66 0 143 0 88 0)

              tabable: true

              model: ignoreCaseInName

              translateLabel: true

            )

           (LabelSpec

              label: 'Containing the string:'

              name: 'Label2'

              layout: (LayoutFrame 0 0.0 107 0 0 1.0 129 0)

              translateLabel: true

              adjust: left

            )

           (InputFieldSpec

              name: 'EntryField2'

              layout: (LayoutFrame 10 0 133 0 305 0 155 0)

              enableChannel: notSearchForSameContents

              tabable: true

              model: contentsPatternHolder

              acceptOnPointerLeave: false

            )

           (CheckBoxSpec

              label: 'Ignore case'

              name: 'CheckBox2'

              layout: (LayoutFrame 6 0 163 0 142 0 185 0)

              enableChannel: notSearchForSameContents

              tabable: true

              model: ignoreCaseInContents

              translateLabel: true

            )

           (LabelSpec

              label: 'Containing same contents as selected:'

              name: 'Label3'

              layout: (LayoutFrame 0 0.0 223 0 -30 1.0 245 0)

              translateLabel: true

              adjust: left

            )

           (DividerSpec

              name: 'Separator1'

              layout: (LayoutFrame 0 0.0 97 0 0 1.0 101 0)

            )

           (CheckToggleSpec

              name: 'CheckToggle1'

              layout: (LayoutOrigin -25 1 225 0)

              tabable: true

              model: searchForSameContents

              enableChannel: searchForSameContentsEnabled

              isTriggerOnDown: true

              showLamp: false

              lampColor: (Color 100.0 100.0 0.0)

            )

           (HorizontalPanelViewSpec

              name: 'HorizontalPanel1'

              layout: (LayoutFrame 0 0.0 -30 1 0 1.0 0 1.0)

              horizontalLayout: fitSpace

              verticalLayout: centerMax

              horizontalSpace: 3

              verticalSpace: 3

              component: 

             (SpecCollection

                collection: (

                 (ActionButtonSpec

                    label: 'Cancel'

                    name: 'Button1'

                    translateLabel: true

                    tabable: true

                    model: cancel

                    extent: (Point 151 25)

                  )

                 (ActionButtonSpec

                    label: 'Search'

                    name: 'Button2'

                    translateLabel: true

                    tabable: true

                    model: accept

                    isDefault: true

                    extent: (Point 152 25)

                  )

                 )

              )

            )

           )

        )

      )

! !

!FileBrowser class methodsFor:'menu specs'!

baseBookmarksMenuSpec

    "This resource specification was automatically generated

     by the MenuEditor of ST/X."

    "Do not manually edit this!! If it is corrupted,

     the MenuEditor may not be able to read the specification."

    "

     MenuEditor new openOnClass:FileBrowser andSelector:#baseBookmarksMenuSpec

     (Menu new fromLiteralArrayEncoding:(FileBrowser baseBookmarksMenuSpec)) startUp

    "

    <resource: #menu>

    ^

       #(#Menu

           #(

             #(#MenuItem

                #label: 'Add Bookmark'

                #translateLabel: true

                #value: #addBookmark

            )

             #(#MenuItem

                #label: 'Remove Bookmark'

                #translateLabel: true

                #value: #removeBookmark

                #enabled: #hasBookmarksToRemove

            )

          ) nil

          nil

      )

    "Created: / 4.8.1998 / 17:21:16 / cg"

    "Modified: / 14.8.1998 / 19:19:06 / cg"

!

baseDirectoryMenuSpec

    "This resource specification was automatically generated

     by the MenuEditor of ST/X."

    "Do not manually edit this!! If it is corrupted,

     the MenuEditor may not be able to read the specification."

    "

     MenuEditor new openOnClass:FileBrowser andSelector:#directoryMenuSpec

     (Menu new fromLiteralArrayEncoding:(FileBrowser directoryMenuSpec)) startUp

    "

    <resource: #menu>

    ^

       #(#Menu

           #(

             #(#MenuItem

                #label: 'Copy Path'

                #translateLabel: true

                #value: #copyPath

            )

             #(#MenuItem

                #label: '-'

            )

             #(#MenuItem

                #label: 'Up'

                #translateLabel: true

                #value: #changeToParentDirectory

                #enabled: #currentDirectoryIsNotTop