"
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 listUpdateProcess currentFileInFileName
lastFileDiffDirectory sortByWhat sortCaseless showingDetails
showingHiddenFiles showingBigImagePreview imagePreviewView
imageRenderProcess dosEOLMode doAutoUpdate doNotShowFontDialog'
classVariableNames:'DirectoryHistory DirectoryHistoryWhere HistorySize DefaultIcon
CommandHistory CommandHistorySize Icons DefaultCommandPerSuffix
DefaultCommandPerMIME VisitedFileHistory'
poolDictionaries:''
category:'Interface-Browsers'
!
!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'!
openOn:aDirectoryPath
"start a new FileBrowser in a pathname"
^ (self new currentDirectory:aDirectoryPath) open
"
FileBrowser openOn:'aDirectoryPath'
FileBrowser openOn:'/etc'
FileBrowser openOn:'..'
FileBrowser openOn:'.'
"
!
openOnFileNamed:aFilename
"start a new FileBrowser on a file"
|f browser|
f := aFilename asFilename.
f isDirectory ifTrue:[
^ self openOn:aFilename
].
browser := self new.
browser currentDirectory: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'!
hasVisitHistory
^ [DirectoryHistory size > 0]
"Created: / 14.8.1998 / 19:17:02 / cg"
"Modified: / 14.8.1998 / 19:17:17 / cg"
! !
!FileBrowser class methodsFor:'class initialization'!
icons
Icons isNil ifTrue:[
self initializeIcons
].
^ Icons
!
initializeDefaultCommands
DefaultCommandPerMIME := Dictionary new.
DefaultCommandPerMIME at:'application/x-tar-compressed' put:'gunzip < %1 | tar tvf -'.
DefaultCommandPerMIME at:'application/pdf' put:'acroread %1'.
"
self initializeDefaultCommands
"
"Modified: / 1.8.1998 / 17:39:27 / cg"
!
initializeIcons
|resources|
resources := self classResources.
Icons := Dictionary new.
#(
"/ internal-type to icon mappings.
(#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' )
"/ mime-type to icon mappings.
('text/plain' nil 'tiny_file_text.xpm' )
('text/html' nil 'tiny_file_text.xpm' )
('application/postscript' nil 'tiny_file_st.xpm' )
('application/x-smalltalk-source' nil 'tiny_file_st.xpm' )
('application/x-java-source' nil 'tiny_file_java.xpm' )
('image' nil 'tiny_file_pix.xpm' )
('audio' nil 'tiny_file_sound.xpm' )
) do:[:entry |
|key resource defaultName nm img|
key := entry at:1.
resource := entry at:2.
defaultName := entry at:3.
resource notNil ifTrue:[
nm := resources at:resource default:nil.
].
nm isNil ifTrue:[
nm := 'xpmBitmaps/document_images/' , defaultName
].
Icons at:key put:(Smalltalk imageFromFileNamed:nm forClass:self).
]
"
self initializeIcons
"
"Modified: / 1.8.1998 / 17:39:27 / cg"
! !
!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:'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"
!
addToHistory:path
|pos idx|
idx := DirectoryHistory indexOf:path.
idx == 0 ifTrue:[
DirectoryHistory size >= HistorySize ifTrue:[
DirectoryHistory removeLast.
DirectoryHistoryWhere removeLast
]
] ifFalse:[
"already been there before; move the entry to
the beginning, so it will fall out later."
DirectoryHistory removeIndex:idx.
pos := DirectoryHistoryWhere at:idx.
DirectoryHistoryWhere removeIndex:idx.
].
DirectoryHistory addFirst:path.
DirectoryHistoryWhere addFirst:pos.
"Created: / 8.11.1997 / 17:16:29 / 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:'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
#window:
#(#WindowSpec
#name: 'File Search'
#layout: #(#LayoutFrame 4 0 50 0 315 0 349 0)
#level: 0
#label: 'File Search'
#min: #(#Point 10 10)
#max: #(#Point 1280 1024)
#bounds: #(#Rectangle 4 50 316 350)
#usePreferredExtent: false
#returnIsOKInDialog: true
#escapeIsCancelInDialog: true
)
#component:
#(#SpecCollection
#collection:
#(
#(#LabelSpec
#name: 'Label1'
#layout: #(#LayoutFrame 0 0 10 0 0 1 32 0)
#label: 'Search for files named:'
#translateLabel: true
#adjust: #left
)
#(#InputFieldSpec
#name: 'EntryField1'
#layout: #(#LayoutFrame 10 0 36 0 305 0 58 0)
#tabable: true
#model: #namePatternHolder
)
#(#CheckBoxSpec
#name: 'CheckBox1'
#layout: #(#LayoutFrame 7 0 66 0 143 0 88 0)
#tabable: true
#model: #ignoreCaseInName
#label: 'Ignore case'
#translateLabel: true
)
#(#LabelSpec
#name: 'Label2'
#layout: #(#LayoutFrame 0 0.0 107 0 0 1.0 129 0)
#label: 'Containing the string:'
#translateLabel: true
#adjust: #left
)
#(#InputFieldSpec
#name: 'EntryField2'
#layout: #(#LayoutFrame 10 0 133 0 305 0 155 0)
#enableChannel: #notSearchForSameContents
#tabable: true
#model: #contentsPatternHolder
)
#(#CheckBoxSpec
#name: 'CheckBox2'
#layout: #(#LayoutFrame 6 0 163 0 142 0 185 0)
#enableChannel: #notSearchForSameContents
#tabable: true
#model: #ignoreCaseInContents
#label: 'Ignore case'
#translateLabel: true
)
#(#LabelSpec
#name: 'Label3'
#layout: #(#LayoutFrame 0 0.0 223 0 -30 1.0 245 0)
#label: 'Containing same contents as selected:'
#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)
#component:
#(#SpecCollection
#collection:
#(
#(#ActionButtonSpec
#name: 'Button1'
#label: 'Cancel'
#translateLabel: true
#tabable: true
#model: #cancel
#extent: #(#Point 151 25)
)
#(#ActionButtonSpec
#name: 'Button2'
#label: 'Search'
#translateLabel: true
#tabable: true
#model: #accept
#isDefault: true
#extent: #(#Point 152 25)
)
)
)
#horizontalLayout: #fitSpace
#verticalLayout: #centerMax
#horizontalSpace: 3
#verticalSpace: 3
)
)
)
)
! !
!FileBrowser class methodsFor:'menu specs'!
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
)
#(#MenuItem
#label: 'Back'
#translateLabel: true
#value: #changeToPreviousDirectory
)
#(#MenuItem
#label: 'Home'
#translateLabel: true
#value: #changeToHomeDirectory
)
#(#MenuItem
#label: 'Default'
#translateLabel: true
#value: #changeToDefaultDirectory
)
#(#MenuItem
#label: 'Goto...'
#translateLabel: true
#value: #changeCurrentDirectory
)
) nil
nil
)
"Created: / 4.8.1998 / 17:21:16 / cg"
"Modified: / 14.8.1998 / 19:19:06 / cg"
!
directoryMenuSpec
"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: #programMenu>
|m|
m := self baseDirectoryMenuSpec.
m := m decodeAsLiteralArray.
"/ add the history items ...
DirectoryHistory size > 0 ifTrue:[
m addItem:(MenuItem labeled:'-').
DirectoryHistory do:[:dirName |
m addItem:((MenuItem label:dirName value:#changeDirectoryTo:)
argument:dirName;
yourself).
].
].
m findGuiResourcesIn:self.
^ m
"Modified: / 17.8.1998 / 10:13:05 / cg"
!
menuPopUp
"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:#menuPopUp
(Menu new fromLiteralArrayEncoding:(FileBrowser menuPopUp)) startUp
"
<resource: #menu>
^
#(#Menu
#(
#(#MenuItem
#label: 'Spawn'
#translateLabel: true
#value: #fileSpawn
)
#(#MenuItem
#label: '-'
)
#(#MenuItem
#label: 'Get Contents'
#translateLabel: true
#value: #fileGet
#enabled: #hasSelection
)
#(#MenuItem
#label: 'Insert Contents'
#translateLabel: true
#value: #fileInsert
#enabled: #hasSelection
)
#(#MenuItem
#label: 'FileIn'
#translateLabel: true
#value: #fileFileIn
#enabled: #hasSelection
#shortcutKeyCharacter: #Accept
)
#(#MenuItem
#label: '-'
)
#(#MenuItem
#label: 'Tools'
#translateLabel: true
#submenuChannel: #toolsMenuSpec
)
#(#MenuItem
#label: '-'
)
#(#MenuItem
#label: 'Remove...'
#translateLabel: true
#value: #fileRemove
#enabled: #hasSelection
#shortcutKeyCharacter: #Cut
)
#(#MenuItem
#label: 'Rename...'
#translateLabel: true
#value: #fileRename
#enabled: #hasSelection
#shortcutKeyCharacter: #Replace
)
#(#MenuItem
#label: '-'
)
#(#MenuItem
#label: 'New Directory...'
#translateLabel: true
#value: #newDirectory
)
#(#MenuItem
#label: 'New File...'
#translateLabel: true
#value: #newFile
)
#(#MenuItem
#label: '-'
)
#(#MenuItem
#label: 'Update'
#translateLabel: true
#value: #updateCurrentDirectory
)
)
nil
nil
)
!
menuSpec
"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:#menuSpec
(Menu new fromLiteralArrayEncoding:(FileBrowser menuSpec)) startUp
"
<resource: #menu>
^
#(#Menu
#(
#(#MenuItem
#label: 'About'
#translateLabel: true
#labelImage: #(#ResourceRetriever #ToolApplicationModel #menuIcon)
#submenu:
#(#Menu
#(
#(#MenuItem
#label: 'About Smalltalk/X...'
#translateLabel: true
#value: #showAboutSTX
)
#(#MenuItem
#label: '-'
)
#(#MenuItem
#label: 'About FileBrowser...'
#translateLabel: true
#value: #openAboutThisApplication
)
)
nil
nil
)
)
#(#MenuItem
#label: 'File'
#translateLabel: true
#submenu:
#(#Menu
#(
#(#MenuItem
#label: 'Spawn'
#translateLabel: true
#value: #fileSpawn
)
#(#MenuItem
#label: '-'
)
#(#MenuItem
#label: 'Open'
#translateLabel: true
#value: #menuOpen
#enabled: #hasSelection
)
#(#MenuItem
#label: 'Open selected Filename'
#translateLabel: true
#isVisible: #hasFilenameSelectionInCodeView
#value: #openSelectedFilename
#enabled: #hasFilenameSelectionInCodeView
)
#(#MenuItem
#label: 'FileIn'
#translateLabel: true
#value: #fileFileIn
#enabled: #hasSelection
)
#(#MenuItem
#label: '-'
)
#(#MenuItem
#label: 'New'
#translateLabel: true
#submenu:
#(#Menu
#(
#(#MenuItem
#label: 'Directory...'
#translateLabel: true
#value: #newDirectory
)
#(#MenuItem
#label: 'File...'
#translateLabel: true
#value: #newFile
)
#(#MenuItem
#label: 'Hard Link...'
#translateLabel: true
#isVisible: #systemIsUnix
#value: #newHardLink
)
#(#MenuItem
#label: 'Symbolic Link...'
#translateLabel: true
#isVisible: #systemIsUnix
#value: #newSoftLink
)
)
nil
nil
)
)
#(#MenuItem
#label: 'Remove'
#translateLabel: true
#value: #fileRemove
#enabled: #hasSelection
)
#(#MenuItem
#label: 'Rename'
#translateLabel: true
#value: #fileRename
#enabled: #hasSelection
)
#(#MenuItem
#label: '-'
)
#(#MenuItem
#label: 'Properties...'
#translateLabel: true
#value: #fileGetLongInfo
#enabled: #hasSelection
)
#(#MenuItem
#label: 'Encoding...'
#translateLabel: true
#value: #fileEncoding
)
#(#MenuItem
#label: 'DOS EndOfLine Mode'
#translateLabel: true
#indication: #dosEOLMode
)
#(#MenuItem
#label: '-'
#isVisible: #javaSupportLoaded
)
#(#MenuItem
#label: 'Add to Java ClassPath'
#translateLabel: true
#isVisible: #javaSupportLoaded
#value: #fileAddToJavaClassPath
#enabled: #canAddToClassPath
)
#(#MenuItem
#label: 'Remove from Java ClassPath'
#translateLabel: true
#isVisible: #javaSupportLoaded
#value: #fileRemoveFromJavaClassPath
#enabled: #canRemoveFromClassPath
)
#(#MenuItem
#label: 'Add to Java SourcePath'
#translateLabel: true
#isVisible: #javaSupportLoaded
#value: #fileAddToJavaSourcePath
#enabled: #canAddToSourcePath
)
#(#MenuItem
#label: 'Remove from Java SourcePath'
#translateLabel: true
#isVisible: #javaSupportLoaded
#value: #fileRemoveFromJavaSourcePath
#enabled: #canRemoveFromSourcePath
)
#(#MenuItem
#label: '-'
)
#(#MenuItem
#label: 'Spawn'
#translateLabel: true
#value: #fileSpawn
)
#(#MenuItem
#label: '-'
)
#(#MenuItem
#label: 'Exit'
#translateLabel: true
#value: #menuExit
)
)
nil
nil
)
)
#(#MenuItem
#label: 'Directory'
#translateLabel: true
#submenuChannel: #directoryMenuSpec
)
#(#MenuItem
#label: 'Edit'
#translateLabel: true
#submenu:
#(#Menu
#(
#(#MenuItem
#label: 'Get Contents'
#translateLabel: true
#value: #fileGet
#enabled: #hasSelection
)
#(#MenuItem
#label: 'Insert Contents'
#translateLabel: true
#value: #fileInsert
#enabled: #hasSelection
)
#(#MenuItem
#label: '-'
)
#(#MenuItem
#label: 'Copy File List'
#translateLabel: true
#value: #copyFileList
)
#(#MenuItem
#label: 'Copy Selected Filename'
#translateLabel: true
#value: #copySelectedFileName
)
#(#MenuItem
#label: 'Copy Command History'
#translateLabel: true
#value: #copyCommandHistory
)
#(#MenuItem
#label: '-'
)
#(#MenuItem
#label: 'Visited Files'
#translateLabel: true
#submenuChannel: #visitedFileMenuSpec
)
)
nil
nil
)
)
#(#MenuItem
#label: 'View'
#translateLabel: true
#submenu:
#(#Menu
#(
#(#MenuItem
#label: 'Details'
#translateLabel: true
#indication: #showingDetails
)
#(#MenuItem
#label: 'Show Hidden Files'
#translateLabel: true
#indication: #showingHiddenFiles
)
#(#MenuItem
#label: 'Big Image Preview'
#translateLabel: true
#indication: #showingBigImagePreview
)
#(#MenuItem
#label: '-'
)
#(#MenuItem
#label: 'Sort by Name'
#translateLabel: true
#choice: #sortByWhat
#choiceValue: #name
)
#(#MenuItem
#label: 'Sort by Type'
#translateLabel: true
#choice: #sortByWhat
#choiceValue: #type
)
#(#MenuItem
#label: 'Sort by Time'
#translateLabel: true
#choice: #sortByWhat
#choiceValue: #time
)
#(#MenuItem
#label: 'Ignore Case'
#translateLabel: true
#indication: #sortCaseless
)
#(#MenuItem
#label: '-'
)
#(#MenuItem
#label: 'Update'
#translateLabel: true
#value: #updateCurrentDirectory
)
#(#MenuItem
#label: 'AutoUpdate'
#translateLabel: true
#indication: #autoUpdate
)
)
nil
nil
)
)
#(#MenuItem
#label: 'Tools'
#translateLabel: true
#submenuChannel: #toolsMenuSpec
)
#(#MenuItem
#label: 'CVS'
#translateLabel: true
#submenu:
#(#Menu
#(
#(#MenuItem
#label: 'Update selected files/directories'
#translateLabel: true
#value: #cvsUpdateSelection
#enabled: #hasSelection
)
#(#MenuItem
#label: 'Update directory local'
#translateLabel: true
#value: #cvsUpdateDirectoryLocal
)
#(#MenuItem
#label: 'Update directory recursive'
#translateLabel: true
#value: #cvsUpdateDirectoryRecursive
)
#(#MenuItem
#label: '-'
)
#(#MenuItem
#label: 'Commit...'
#translateLabel: true
#value: #cvsCommitSelection
)
#(#MenuItem
#label: 'Add...'
#translateLabel: true
#value: #cvsAddSelection
)
#(#MenuItem
#label: '-'
)
#(#MenuItem
#label: 'Remove file && CVS Container...'
#translateLabel: true
#value: #cvsRemoveFileAndContainer
#enabled: #canRemoveCVSContainer
)
)
nil
nil
)
)
#(#MenuItem
#label: 'Help'
#translateLabel: true
#startGroup: #right
#submenu:
#(#Menu
#(
#(#MenuItem
#label: 'FileBrowser Documentation'
#translateLabel: true
#value: #openHTMLDocument:
#argument: 'tools/fbrowser/TOP.html'
)
)
nil
nil
)
)
)
nil
nil
)
!
toolsMenuSpec
"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:#toolsMenuSpec
(Menu new fromLiteralArrayEncoding:(FileBrowser toolsMenuSpec)) startUp
"
<resource: #menu>
^
#(#Menu
#(
#(#MenuItem
#label: 'Unix Command...'
#translateLabel: true
#isVisible: #systemIsUnix
#value: #menuOSCommand
)
#(#MenuItem
#label: 'DOS Command...'
#translateLabel: true
#isVisible: #systemIsDOS
#value: #menuOSCommand
)
#(#MenuItem
#label: 'VMS Command...'
#translateLabel: true
#isVisible: #systemIsVMS
#value: #menuOSCommand
)
#(#MenuItem
#label: 'Shell Terminal'
#translateLabel: true
#isVisible: #canDoTerminal
#value: #openTerminal
#enabled: #canDoTerminal
)
#(#MenuItem
#label: '-'
)
#(#MenuItem
#label: 'Changes Browser'
#translateLabel: true
#value: #openChangesBrowser
#enabled: #hasSelection
)
#(#MenuItem
#label: 'Snapshot Image Browser'
#translateLabel: true
#value: #openSnapshotImageBrowser
#enabled: #hasSnapshotSelection
)
#(#MenuItem
#label: 'Create Smalltalk Project'
#translateLabel: true
#value: #createProjectAndOpenProjectBrowser
#enabled: #canCreateNewProject
)
#(#MenuItem
#label: 'Install autoloaded'
#translateLabel: true
#value: #readAbbrevFile
#enabled: #canReadAbbrevFile
)
#(#MenuItem
#label: 'Editor'
#translateLabel: true
#value: #openEditor
#enabled: #hasSelection
)
#(#MenuItem
#label: 'HTML Reader'
#translateLabel: true
#value: #openHTMLReader
#enabled: #hasSelection
)
#(#MenuItem
#label: 'ASN1 Browser'
#translateLabel: true
#isVisible: #hasASN1
#value: #openASN1Browser
#enabled: #hasASN1AndSelection
)
#(#MenuItem
#label: 'C Browser'
#translateLabel: true
#isVisible: #hasCBrowser
#value: #openCBrowser
#enabled: #hasCBrowser
)
#(#MenuItem
#label: 'Applet Viewer'
#translateLabel: true
#isVisible: #hasJava
#value: #openAppletViewer
#enabled: #hasJavaAndSelection
)
#(#MenuItem
#label: 'Image Inspector'
#translateLabel: true
#value: #openImageInspector
#enabled: #hasSelection
)
#(#MenuItem
#label: 'Image Preview'
#translateLabel: true
#value: #openImagePreview
#enabled: #hasSelection
)
#(#MenuItem
#label: 'Image Editor'
#translateLabel: true
#value: #openImageEditor
#enabled: #hasSelection
)
#(#MenuItem
#label: 'ZipFile Tool'
#translateLabel: true
#value: #openZipTool
#enabled: #hasZipFileSelected
)
#(#MenuItem
#label: 'File Differences...'
#translateLabel: true
#value: #openDiffView
)
#(#MenuItem
#label: 'Find Duplicate Files'
#translateLabel: true
#value: #fileFindDuplicates
)
#(#MenuItem
#label: 'Find All Duplicate Files (recursive)'
#translateLabel: true
#value: #fileFindAllDuplicates
)
#(#MenuItem
#label: 'Find a File...'
#translateLabel: true
#value: #fileFindFile
)
#(#MenuItem
#label: 'Hex Dump'
#translateLabel: true
#value: #fileHexDump
#enabled: #hasSelection
)
)
nil
nil
)
!
visitedFileMenuSpec
<resource: #programMenu>
|m|
VisitedFileHistory size == 0 ifTrue:[^ nil].
m := Menu new.
"/ add the history items ...
VisitedFileHistory do:[:pathName |
m addItem:((MenuItem label:pathName asFilename baseName value:#revisitFile:)
argument:pathName;
yourself).
].
^ m
! !
!FileBrowser class methodsFor:'queries'!
isVisualStartable
"return true, if this application can be started via #open.
(to allow start of a change browser via double-click in the browser)"
^ true
! !
!FileBrowser methodsFor:'aspects'!
autoUpdate
^ doAutoUpdate
"Created: / 6.5.1999 / 11:37:25 / cg"
"Modified: / 6.5.1999 / 11:39:38 / cg"
!
canAddToClassPath
^ [ |f|
(Java isNil or:[Java isLoaded not]) ifTrue:[
false
] ifFalse:[
f := self singleSelectedFileOrCurrentDirectory.
f notNil
and:[(Java classPath includes:f pathName) not
and:[f isDirectory
or:[(f hasSuffix:'jar')
or:[(f hasSuffix:'zip')]]]].
]
]
"Modified: / 1.2.1999 / 20:38:42 / cg"
!
canAddToSourcePath
^ [ |f|
(Java isNil or:[Java isLoaded not]) ifTrue:[
false
] ifFalse:[
f := self singleSelectedFileOrCurrentDirectory.
f notNil
and:[(Java sourcePath isNil
or:[(Java sourcePath includes:f pathName) not])
and:[f isDirectory
or:[(f hasSuffix:'jar')
or:[(f hasSuffix:'zip')]]]].
]
]
"Modified: / 1.2.1999 / 20:38:42 / cg"
!
canCreateNewProject
^ [
currentDirectory notNil
and:[((currentDirectory directoryContents
select:[:f| f endsWith:'.prj']) size == 0)
and:[((currentDirectory directoryContents
select:[:f| f endsWith:'.st']) size > 0)
]]]
!
canDoTerminal
^ OperatingSystem isUNIXlike
or:[OperatingSystem isMSWINDOWSlike]
"Created: / 4.8.1998 / 13:37:13 / cg"
"Modified: / 28.4.1999 / 11:54:17 / cg"
!
canReadAbbrevFile
^ [|sel f fn suff|
sel := fileListView selection.
sel size == 1 ifTrue:[
f := fileList at:sel first ifAbsent:nil.
f notNil ifTrue:[
f = 'abbrev.stc'.
] ifFalse:[
false
]
] ifFalse:[
false
]
]
"Modified: / 30.1.1999 / 19:05:59 / cg"
"Created: / 29.1.2000 / 13:00:57 / cg"
!
canRemoveCVSContainer
^ [ |cvsDir|
currentDirectory notNil
and:[fileListView selection size > 0
and:[(cvsDir := currentDirectory construct:'CVS') exists
and:[cvsDir isDirectory]]]]
!
canRemoveFromClassPath
^ [ |f|
(Java isNil or:[Java isLoaded not]) ifTrue:[
false
] ifFalse:[
f := self singleSelectedFileOrCurrentDirectory.
f notNil
and:[(Java classPath includes:f pathName)
and:[f isDirectory
or:[(f hasSuffix:'jar')
or:[(f hasSuffix:'zip')]]]]
]
]
"Modified: / 1.2.1999 / 20:39:25 / cg"
!
canRemoveFromSourcePath
^ [ |f|
(Java isNil or:[Java isLoaded not]) ifTrue:[
false
] ifFalse:[
f := self singleSelectedFileOrCurrentDirectory.
f notNil
and:[(Java sourcePath isNil
or:[(Java sourcePath includes:f pathName)])
and:[f isDirectory
or:[(f hasSuffix:'jar')
or:[(f hasSuffix:'zip')]]]]
]
]
"Modified: / 1.2.1999 / 20:39:25 / cg"
!
currentDirectoryIsNotTop
^ [currentDirectory notNil and:[currentDirectory isRootDirectory not]]
"Modified: / 4.8.1998 / 14:10:57 / cg"
"Created: / 14.8.1998 / 12:07:10 / cg"
!
dosEOLMode
^ dosEOLMode
"Created: / 6.5.1999 / 11:37:25 / cg"
"Modified: / 6.5.1999 / 11:39:38 / cg"
!
hasASN1
^ [ OSI::ASN1Parser notNil
and:[OSI::ASN1Parser isLoaded]]
!
hasASN1AndSelection
^ [ fileListView selection size > 0
and:[OSI::ASN1Parser notNil
and:[OSI::ASN1Parser isLoaded]]]
!
hasCBrowser
^ [ CC::Browser notNil ]
!
hasFilenameSelectionInCodeView
^ [ |val sel|
val := false.
sel := subView selection.
sel notNil ifTrue:[
sel := sel asString withoutSeparators.
sel asFilename exists ifTrue:[
val := sel asFilename isReadable
]
].
val
]
"Created: / 4.2.1999 / 17:34:57 / cg"
"Modified: / 4.2.1999 / 17:39:32 / cg"
!
hasJava
^ [ JavaClassReader notNil
and:[JavaClassReader isLoaded]]
"Modified: / 17.10.1998 / 16:57:14 / cg"
"Created: / 17.10.1998 / 22:58:25 / cg"
!
hasJavaAndSelection
^ [ fileListView selection size > 0
and:[JavaClassReader notNil
and:[JavaClassReader isLoaded]]]
"Modified: / 17.10.1998 / 16:57:14 / cg"
"Created: / 17.10.1998 / 22:58:03 / cg"
!
hasSelection
^ [fileListView selection size > 0]
"Created: / 4.8.1998 / 14:10:31 / cg"
"Modified: / 4.8.1998 / 14:10:57 / cg"
!
hasSnapshotSelection
^ [
(fileListView selection size == 1)
and:[ fileListView selectionValue first string withoutSeparators asFilename hasSuffix:'img' ]
]
"Created: / 4.8.1998 / 14:10:31 / cg"
"Modified: / 4.8.1998 / 14:10:57 / cg"
!
hasZipFileSelected
^ [|sel f fn suff|
sel := fileListView selection.
sel size == 1 ifTrue:[
f := fileList at:sel first ifAbsent:nil.
f notNil ifTrue:[
suff := f asFilename suffix asLowercase.
suff = 'zip' or:[suff = 'jar']
] ifFalse:[
false
]
] ifFalse:[
false
]
]
"Created: / 26.8.1998 / 16:15:26 / cg"
"Modified: / 30.1.1999 / 19:05:59 / cg"
!
javaSupportLoaded
^ [ JavaClassReader notNil
and:[JavaClassReader isLoaded]]
"Created: / 9.11.1998 / 05:33:17 / cg"
!
showingBigImagePreview
^ showingBigImagePreview
"Created: / 14.8.1998 / 14:15:44 / cg"
!
showingDetails
^ showingDetails
"Created: / 14.8.1998 / 14:15:15 / cg"
!
showingHiddenFiles
^ showingHiddenFiles
"Created: / 14.8.1998 / 14:15:44 / cg"
!
singleSelectedFile
|f sel|
sel := fileListView selection.
sel size ~~ 1 ifTrue:[
^ nil
].
f := fileList at:sel first ifAbsent:nil.
f notNil ifTrue:[
^ currentDirectory asFilename construct:f
].
^ nil
"Created: / 29.1.2000 / 13:09:09 / cg"
!
singleSelectedFileOrCurrentDirectory
|f sel|
sel := fileListView selection.
sel size > 1 ifTrue:[
^ nil
].
sel size == 0 ifTrue:[
^ currentDirectory asFilename
].
f := fileList at:sel first ifAbsent:nil.
f notNil ifTrue:[
^ currentDirectory asFilename construct:f
].
^ nil
!
sortByWhat
^ sortByWhat
"Created: / 14.8.1998 / 15:55:18 / cg"
"Modified: / 14.8.1998 / 15:56:08 / cg"
!
sortCaseless
^ sortCaseless
"Created: / 14.8.1998 / 14:21:21 / cg"
!
systemIsDOS
^ OperatingSystem isMSDOSlike
"Created: / 4.8.1998 / 13:37:28 / cg"
!
systemIsUnix
^ OperatingSystem isUNIXlike
"Created: / 4.8.1998 / 13:37:13 / cg"
!
systemIsVMS
^ OperatingSystem isVMSlike
"Created: / 4.8.1998 / 13:37:37 / cg"
! !
!FileBrowser methodsFor:'drag & drop'!
canDrop:aCollectionOfDropObjects
"I accept fileObjects only"
aCollectionOfDropObjects do:[:aDropObject |
aDropObject isFileObject ifFalse:[
aDropObject isTextObject ifFalse:[^ false].
]
].
^ true
"Modified: 11.4.1997 / 12:41:59 / cg"
!
drop:aCollectionOfDropObjects at:aPoint
"handle drops"
aCollectionOfDropObjects do:[:aDropObject |
self dropSingleObject:aDropObject at:aPoint
]
"Modified: 11.4.1997 / 12:43:36 / cg"
!
dropSingleObject:someObject at:aPoint
"handle drops; if its a directory, change to it.
If its a file, change to its directory and select the file.
If its text, paste it into the codeView."
|newDir newFile|
someObject isFileObject ifTrue:[
someObject isDirectory ifTrue:[
newDir := someObject theObject pathName.
] ifFalse:[
newDir := someObject theObject directoryName.
newFile := someObject theObject baseName.
].
newDir notNil ifTrue:[
newDir ~= currentDirectory pathName ifTrue:[
self changeDirectoryTo:newDir.
]
].
newFile notNil ifTrue:[
newFile ~= currentFileName ifTrue:[
fileListView selection:(fileList indexOf:newFile).
self doFileGet:false.
]
].
^ self
].
someObject isTextObject ifTrue:[
subView paste:someObject theObject.
^ self
].
"Modified: 6.4.1997 / 14:46:44 / cg"
! !
!FileBrowser methodsFor:'events'!
handlesKeyPress:key inView:view
"this method is reached via delegation: are we prepared to handle
a keyPress in some other view ?"
<resource: #keyboard (#GotoLine #InspectIt #CmdI #Cmdu
#DoIt #Delete #BackSpace #Accept #CmdF #CmdD
#CursorLeft #CursorRight
)>
view == fileListView ifTrue:[
(key == #Delete
or:[key == #BackSpace
or:[key == #Accept
or:[key == #CmdI
or:[key == #CmdF
or:[key == #CmdD
or:[key == #Cmdu
or:[key == #Cut
or:[key == #Cmdr
or:[key == #Replace
or:[key == #InspectIt
or:[key == #GotoLine
or:[key == #CursorLeft
or:[key == #CursorRight
or:[key == #DoIt]]]]]]]]]]]]]]) ifTrue:[^ true].
].
^ false
"Created: / 28.1.1997 / 14:03:20 / stefan"
"Modified: / 20.6.1997 / 16:35:01 / cg"
"Modified: / 16.1.1998 / 16:50:39 / stefan"
!
keyPress:key x:x y:y view:view
"this method is reached via delegation from the fileListView"
<resource: #keyboard (#GotoLine #InspectIt
#CmdI #Cmdu #DoIt #Delete #BackSpace #Accept
#Cmdr #Cut #CursorLeft #CursorRight)>
(key == #Delete
or:[key == #Cut
or:[key == #BackSpace]]) ifTrue:[
self fileRemove.
^ self
].
(key == #Accept) ifTrue:[
self fileFileIn.
^ self
].
(key == #GotoLine) ifTrue:[
self fileGet.
^ self
].
(key == #DoIt) ifTrue:[
self fileExecute.
^ self
].
(key == #InspectIt) ifTrue:[
self fileGetInfo.
^ self
].
(key == #CmdI) ifTrue:[
self fileGetLongInfo.
^ self
].
(key == #Cmdu) ifTrue:[
self updateCurrentDirectory.
^ self
].
(key == #CmdF) ifTrue:[
self newFile.
^ self
].
(key == #CmdD) ifTrue:[
self newDirectory.
^ self
].
((key == #Cmdr) or:[key == #Replace]) ifTrue:[
self fileRename.
^ self
].
(key == #CursorLeft) ifTrue:[
self changeToParentDirectory.
^ self
].
(key == #CursorRight) ifTrue:[
self changeToPreviousDirectory.
^ self
].
fileListView keyPress:key x:x y:y
"Created: / 28.1.1997 / 14:03:56 / stefan"
"Modified: / 20.6.1997 / 16:35:08 / cg"
"Modified: / 16.1.1998 / 16:51:38 / stefan"
!
mapped
super mapped.
"
whant to know about changed history
"
self updateCurrentDirectory
!
visibilityChange:how
|wasVisible|
wasVisible := shown.
super visibilityChange:how.
(wasVisible not and:[shown]) ifTrue:[
"
start checking again
"
Processor removeTimedBlock:checkBlock.
Processor addTimedBlock:checkBlock afterSeconds:checkDelta.
]
"Modified: / 18.2.1998 / 17:57:44 / cg"
! !
!FileBrowser methodsFor:'fileList user interaction'!
bigImagePreviewSettingChanged
"invoked, when big image preview flag changed"
|fh|
(showingBigImagePreview value == true
and:[showingDetails value == true]) ifTrue:[
fh := fileListView font height.
fileListView lineSpacing:(34 - fh max:0).
] ifFalse:[
fileListView clear.
self updateCurrentDirectory.
fileListView lineSpacing:2.
].
fileListView clear.
self updateCurrentDirectory
"Modified: / 4.8.1998 / 13:43:54 / cg"
"Created: / 14.8.1998 / 14:17:49 / cg"
!
changeDisplayMode
"toggle from long to short listing (and vice-versa)"
showingDetails value:(showingDetails value not).
"/ showLongList := showLongList not.
self showOrHideTabView.
self updateCurrentDirectory
"Modified: / 4.8.1998 / 13:43:54 / cg"
!
changeDotFileVisibility
"turn on/off visibility of files whose name starts with '.'"
showingHiddenFiles value:(showingHiddenFiles value not).
"/ showDotFiles := showDotFiles not.
self updateCurrentDirectory
"Modified: / 4.8.1998 / 13:45:46 / cg"
!
detailsSettingChanged
"invoked, when detail (i.e. long / short) listing flag changed"
self showOrHideTabView.
self bigImagePreviewSettingChanged
"Modified: / 4.8.1998 / 13:43:54 / cg"
"Created: / 14.8.1998 / 14:17:49 / cg"
!
fileDoubleClick:lineNr
"double click on a file - get its contents"
self fileSelect:lineNr.
self fileGet:true
!
fileEncoding
"open a dialog to allow change of the files character encoding.
Files are converted to internal encoding when read, and converted back
to this encoding when saved.
The default encoding is nil, which means that files are already in
the internal encoding (which is iso8859).
Notice: currently, not too many encodings are supported by the system."
|dialog list descr encodings encodingNames idx|
list := SelectionInList new.
descr := CharacterArray supportedExternalEncodings.
encodings := descr at:2.
encodingNames := descr at:1.
list list:encodingNames.
list selectionIndex:(encodings indexOf:fileEncoding ifAbsent:1).
dialog := Dialog new.
dialog addTextLabel:(resources string:'ENCODING_MSG') withCRs.
dialog addVerticalSpace.
dialog addListBoxOn:list withNumberOfLines:5.
dialog addAbortAndOkButtons.
dialog open.
dialog accepted ifTrue:[
idx := list selectionIndex.
fileEncoding := encodings at:idx.
subView externalEncoding:fileEncoding.
self validateFontEncodingFor:fileEncoding ask:true.
].
"Modified: 30.6.1997 / 14:41:12 / cg"
!
fileExecute
"if text was modified show a queryBox,
otherwise pop up execute box immediately"
|action sel fileName|
"
this replaces everything by the commands output ...
"
action := [:command |
self class addToCommandHistory:command for:fileName.
self doExecuteCommand:command replace:true
].
(self askIfModified:'contents has not been saved.\\Modifications will be lost when command is executed.'
yesButton:'execute') ifFalse:[^ self].
"/ "
"/ this inserts the commands output ...
"/ "
"/ action := [:command| self doExecuteCommand:command replace:false].
"/
sel := fileListView selection.
sel size == 1 ifTrue:[
fileName := fileList at:sel first
].
self askForCommandFor:fileName thenDo:action
"Modified: 14.11.1996 / 14:59:34 / cg"
!
fileFileIn
"fileIn the selected file(s)"
self fileFileInLazy:false
!
fileFileInLazy
"fileIn the selected file(s). Do a quick load (no compilation)"
self fileFileInLazy:true
!
fileFileInLazy:lazy
"fileIn the selected file(s)"
|aStream path wasLazy bos prevCurrentFileName|
self selectedFilesDo:[:fileName |
path := currentDirectory filenameFor:fileName.
path type == #regular ifTrue:[
prevCurrentFileName := currentFileInFileName.
currentFileInFileName := fileName.
(ObjectFileLoader notNil
and:[ObjectFileLoader hasValidBinaryExtension:fileName]) ifTrue:[
Object abortSignal catch:[
|p|
"/
"/ look if already loaded ... then unload first
"/
p := path pathName.
(ObjectFileLoader loadedObjectFiles includes:p) ifTrue:[
(Dialog confirm:(resources
string:'%1 is already loaded; load anyway ?'
with:p)) ifFalse:[
^ self
].
Transcript showCR:'unloading old ' , p , ' ...'.
ObjectFileLoader unloadObjectFile:p.
].
Transcript showCR:'loading ' , p , ' ...'.
ObjectFileLoader loadObjectFile:p.
Class addInfoRecord:('fileIn ' , fileName)
]
] ifFalse:[ (path hasSuffix:'cls') ifTrue:[
"/ loading a binary class file
aStream := path readStream.
aStream notNil ifTrue:[
bos := BinaryObjectStorage onOld:aStream.
Class nameSpaceQuerySignal
answer:Smalltalk
do:[
bos next.
].
bos close
]
] ifFalse:[
((path hasSuffix:'class')
or:[(path hasSuffix:'cla')]) ifTrue:[
"/ loading a java class file
JavaClassReader notNil ifTrue:[
JavaClassReader loadFile:(path pathName)
]
] ifFalse:[ (path hasSuffix:'sif') ifTrue:[
"/ loading a sif (smalltalk interchange format) file
SmalltalkInterchangeFileManager newForFileIn
fileName: path pathName;
fileIn.
] ifFalse:[
"/ loading a regular (chunk) or xml source file
aStream := path readStream.
aStream notNil ifTrue:[
[
Class withoutUpdatingChangesDo:[
wasLazy := Compiler compileLazy:lazy.
aStream fileIn.
].
Class addInfoRecord:('fileIn ' , fileName)
] valueNowOrOnUnwindDo:[
Compiler compileLazy:wasLazy.
aStream close
]
]
]]
]]
].
currentFileInFileName := prevCurrentFileName
]
"Modified: / 19.9.1997 / 23:42:22 / stefan"
"Modified: / 16.10.1999 / 12:16:31 / cg"
!
fileFindAllDuplicates
"scan directory and all subdirs for duplicate files"
|fileNames dir infoDir filesBySize
result info dirPrefix|
(self askIfModified:'contents has not been saved.\\Modifications will be lost when you proceed.'
yesButton:'proceed') ifFalse:[^ self].
self withWaitCursorDo:[
result := Dictionary new.
dir := currentDirectory asFilename.
self label:myName , '- gathering file names ...'.
fileNames := dir recursiveDirectoryContents.
fileNames := fileNames collect:[:fn | dir construct:fn].
fileNames := fileNames select:[:fn | fn isDirectory not].
self label:myName , '- gathering sizes ...'.
infoDir := Dictionary new.
fileNames do:[:fn |
infoDir at:fn put:(fn fileSize)
].
"/ for each, get the files size.
"/ in a first pass, look for files of the same size and
"/ compare them ...
self label:myName , '- preselect possible duplicates ...'.
filesBySize := Dictionary new.
infoDir keysAndValuesDo:[:fn :sz |
|entry|
entry := filesBySize at:sz ifAbsentPut:[Set new].
entry add:fn.
].
"/ any of same size ?
self label:myName , '- checking for duplicates ...'.
filesBySize do:[:entry |
|files|
entry size > 1 ifTrue:[
files := entry asArray.
1 to:files size-1 do:[:idx1 |
idx1+1 to:files size do:[:idx2 |
|fn1 fn2|
fn1 := files at:idx1.
fn2 := files at:idx2.
"/ self label:myName , '- checking ' , fn1 baseName , ' vs. ' , fn2 baseName , ' ...'.
(result at:fn2 ifAbsent:nil) ~= fn1 ifTrue:[
"/ compare the files
(fn1 sameContentsAs:fn2) ifTrue:[
"/ Transcript show:'Same: '; show:fn1 baseName; show:' and '; showCR:fn2 baseName.
result at:fn1 put:fn2.
]
]
]
]
]
].
self label:myName , '- sorting ...'.
dirPrefix := currentDirectory asFilename pathName.
result := result associations.
result := result collect:[:assoc |
|f1 f2|
f1 := assoc key name.
f2 := assoc value name.
(f1 startsWith:dirPrefix) ifTrue:[
f1 := f1 copyFrom:dirPrefix size + 2.
].
(f2 startsWith:dirPrefix) ifTrue:[
f2 := f2 copyFrom:dirPrefix size + 2.
].
f1 < f2 ifTrue:[
f2 -> f1
] ifFalse:[
f1 -> f2
]
].
result sort:[:f1 :f2 | f2 value < f1 value].
info := OrderedCollection new.
result do:[:assoc |
info add:(assoc key , ' same as ' , assoc value)
].
info isEmpty ifTrue:[
info := 'No duplicate files found.'
].
].
subView contents:info.
self label:myName.
"Created: / 28.11.1998 / 17:47:53 / cg"
"Modified: / 10.12.1998 / 17:13:14 / cg"
!
fileFindDuplicates
"scan directory for duplicate files"
|fileNames dir infoDir filesBySize
result info|
(self askIfModified:'contents has not been saved.\\Modifications will be lost when you proceed.'
yesButton:'proceed') ifFalse:[^ self].
self withWaitCursorDo:[
result := Dictionary new.
dir := currentDirectory asFilename.
fileNames := dir directoryContents.
fileNames := fileNames collect:[:fn | dir construct:fn].
fileNames := fileNames select:[:fn | fn isDirectory not].
infoDir := Dictionary new.
fileNames do:[:fn |
infoDir at:fn put:(fn info)
].
"/ for each, get the files size.
"/ in a first pass, look for files of the same size and
"/ compare them ...
filesBySize := Dictionary new.
infoDir keysAndValuesDo:[:fn :info |
|sz entry|
sz := info size.
entry := filesBySize at:sz ifAbsentPut:[Set new].
entry add:fn.
].
"/ any of same size ?
filesBySize do:[:entry |
|files|
entry size > 1 ifTrue:[
files := entry asArray.
1 to:files size-1 do:[:idx1 |
idx1+1 to:files size do:[:idx2 |
|fn1 fn2|
fn1 := files at:idx1.
fn2 := files at:idx2.
(result at:fn2 ifAbsent:nil) ~= fn1 ifTrue:[
"/ compare the files
(fn1 sameContentsAs:fn2) ifTrue:[
"/ Transcript show:'Same: '; show:fn1 baseName; show:' and '; showCR:fn2 baseName.
result at:fn1 put:fn2.
]
]
]
]
]
].
result := result associations.
result := result collect:[:assoc |
|f1 f2|
f1 := assoc key baseName.
f2 := assoc value baseName.
f1 < f2 ifTrue:[
f2 -> f1
] ifFalse:[
f1 -> f2
]
].
result sort:[:f1 :f2 | f2 value < f1 value].
info := OrderedCollection new.
result do:[:assoc |
info add:(assoc key , ' same as ' , assoc value)
].
info isEmpty ifTrue:[
info := 'No duplicate files found.'
].
].
subView contents:info
"Created: / 3.10.1998 / 17:59:00 / cg"
"Modified: / 3.10.1998 / 19:29:19 / cg"
!
fileFindFile
|sel bindings
namePatternHolder contentsPatternHolder
ignoreCaseInName ignoreCaseInContents
namePattern namePatterns contentsPattern
searchForSameContentsEnabled searchForSameContents|
(self askIfModified:'contents has not been saved.\\Modifications will be lost when you proceed.'
yesButton:'proceed') ifFalse:[^ self].
subView contents:nil; scrollToTop.
bindings := IdentityDictionary new.
bindings at:#namePatternHolder put:(namePatternHolder := '' asValue).
bindings at:#contentsPatternHolder put:(contentsPatternHolder := '' asValue).
bindings at:#ignoreCaseInName put:(ignoreCaseInName := false asValue).
bindings at:#ignoreCaseInContents put:(ignoreCaseInContents := false asValue).
searchForSameContentsEnabled := false.
sel := fileListView selectionValue.
sel size == 1 ifTrue:[
searchForSameContentsEnabled := true.
sel := sel first string withoutSeparators
].
bindings at:#searchForSameContentsEnabled put:(searchForSameContentsEnabled := searchForSameContentsEnabled asValue).
bindings at:#searchForSameContents put:(searchForSameContents := false asValue).
bindings at:#notSearchForSameContents put:(BlockValue forLogicalNot:searchForSameContents).
(SimpleDialog new
openFor:self
interfaceSpec:(self class fileSearchDialogSpec)
withBindings:bindings) ifTrue:[
namePattern := namePatternHolder value.
namePattern size == 0 ifTrue:[
namePatterns := nil
] ifFalse:[
ignoreCaseInName value ifTrue:[
namePattern := namePattern asLowercase
].
namePatterns := namePattern asCollectionOfSubstringsSeparatedBy:$;
].
contentsPattern := contentsPatternHolder value.
contentsPattern size == 0 ifTrue:[
contentsPattern := nil
] ifFalse:[
ignoreCaseInContents value ifTrue:[
contentsPattern := contentsPattern asLowercase
]
].
self withWaitCursorDo:[
|stopSignal access myProcess lowerFrameView|
myProcess := Processor activeProcess.
access := Semaphore forMutualExclusion name:'accessLock'.
stopSignal := Signal new.
"
The following is tricky:
the pauseToggle & killButton will
be handled by their own windowGroup process.
This means, that they respond to events even though
I myself am reading the commands output.
"
commandView beInvisible.
"
must take kill & pauseButtons out of my group
"
killButton windowGroup:nil.
"
bring them to front, and turn hidden-mode off
"
killButton label:(resources string:'stop').
killButton raise; beVisible.
"
kill will make me raise the stopSignal when pressed
"
killButton
action:[
access critical:[
myProcess interruptWith:[stopSignal raiseRequest].
]
].
"
start kill button under its own windowgroup
"
killButton openAutonomous.
killButton windowGroup process processGroupId:(Processor activeProcess id).
lowerFrameView := subView superView.
[
stopSignal catch:[
searchForSameContents value ifTrue:[
self
doFindFileNamed:namePatterns
ignoreCase:ignoreCaseInName value
containingString:nil
ignoreCaseInContents:ignoreCaseInContents value
sameContentsAsFile:(currentDirectory asFilename construct:sel)
sameContentsAs:nil
in:currentDirectory.
] ifFalse:[
(contentsPattern size > 0 or:[namePatterns size > 0]) ifTrue:[
self
doFindFileNamed:namePatterns
ignoreCase:ignoreCaseInName value
containingString:contentsPattern
ignoreCaseInContents:ignoreCaseInContents value
sameContentsAsFile:nil
sameContentsAs:nil
in:currentDirectory.
]
]
]
] valueNowOrOnUnwindDo:[
|wg|
self label:myName; iconLabel:myName.
"
hide the button, and make sure it will stay
hidden when we are realized again
"
killButton beInvisible.
commandView beVisible.
"
remove the killButton from its group
(otherwise, it will be destroyed when we shut down the group)
"
wg := killButton windowGroup.
killButton windowGroup:nil.
"
shut down the kill buttons windowgroup
"
wg notNil ifTrue:[
wg process terminate.
].
"
clear its action (actually not needed, but
releases reference to thisContext earlier)
"
killButton action:nil.
killButton label:(resources string:'kill').
"/
"/ allow interaction with the codeView
"/ (bring it back into my group)
"/
lowerFrameView windowGroup:(self windowGroup).
].
].
self label:myName.
currentFileName isNil ifTrue:[
subView modified:false.
].
].
"Created: / 15.10.1998 / 11:32:57 / cg"
"Modified: / 15.10.1998 / 12:41:09 / cg"
!
fileGet
"get contents of selected file into subView.
If text was modified show a queryBox,
otherwise get it immediately"
self fileGet:false
"Modified: 19.6.1996 / 09:38:45 / cg"
!
fileGet:viaDoubleClick
"get contents of selected file into subView.
If text was modified show a queryBox,
otherwise get it immediately"
|fileName msg label|
(subView modified not or:[subView contentsWasSaved]) ifTrue:[
self doFileGet:viaDoubleClick.
^ self
].
fileName := self getSelectedFileName.
fileName notNil ifTrue:[
(currentDirectory filenameFor:fileName) isDirectory ifTrue:[
msg := 'contents has not been saved.\\Modifications will be lost when directory is changed.'.
label := 'change'.
] ifFalse:[
msg := 'contents has not been saved.\\Modifications will be lost when new file is read.'.
label := 'get'.
].
(self ask:(resources at:msg) yesButton:label) ifTrue:[
subView modified:false.
self doFileGet:viaDoubleClick
]
]
"Created: 19.6.1996 / 09:38:35 / cg"
"Modified: 23.4.1997 / 13:04:11 / cg"
"Modified: 18.9.1997 / 16:27:34 / stefan"
!
fileGetInfo
"show short file (stat)-info"
self fileGetInfo:false
!
fileGetInfo:longInfo
"get info on selected file - show it in a box"
|string box updater|
string := self getFileInfoString:longInfo.
string notNil ifTrue:[
box := InfoBox title:string.
updater := [
[true] whileTrue:[
Delay waitForSeconds:2.
string := self getFileInfoString:longInfo.
box title:string
]
] fork.
box showAtPointer.
updater terminate.
box destroy
]
!
fileGetLongInfo
"show long stat (file)-info"
self fileGetInfo:true
!
fileHexDump
"show a hex dump (similar to od -x)
Only needed with non-Unix systems."
self withReadCursorDo:[
|fileName f stream data offs
addrDigits col line lineStream asciiLineStream lines|
fileName := self getSelectedFileName.
fileName notNil ifTrue:[
f := currentDirectory construct:fileName.
f isDirectory ifTrue:[
^ self warn:(resources string:'%1 is a directory.' with:fileName).
].
f exists ifFalse:[
self warn:(resources string:'oops, ''%1'' is gone or unreadable.' with:fileName).
^ self
].
f isReadable ifFalse:[
self warn:(resources string:'''%1'' is unreadable.' with:fileName).
^ self
].
f fileSize > (512*1024) ifTrue:[
(self confirm:'Warning: the file is big (', (f fileSize//1024) printString , 'Kb). Show anyway ?')
ifFalse:[
^ self
]
].
stream := f readStream binary.
data := stream contents.
stream close.
subView list:nil.
col := 1.
offs := 0.
lines := StringCollection new.
addrDigits := ((f fileSize + 1) log:16) truncated + 1.
lineStream := '' writeStream.
asciiLineStream := '' writeStream.
lineStream nextPutAll:(offs hexPrintString:addrDigits).
lineStream nextPutAll:': '.
data do:[:byte |
lineStream nextPutAll:(byte hexPrintString:2).
(byte between:32 and:127) ifTrue:[
asciiLineStream nextPut:(Character value:byte)
] ifFalse:[
asciiLineStream nextPut:$.
].
offs := offs + 1.
col := col + 1.
col > 16 ifTrue:[
lineStream nextPutAll:' '.
lineStream nextPutAll:asciiLineStream contents.
lines add:(lineStream contents).
(offs bitAnd:16rFF) == 0 ifTrue:[
lines add:nil
].
lineStream reset.
asciiLineStream reset.
lineStream nextPutAll:(offs hexPrintString:addrDigits).
lineStream nextPutAll:': '.
col := 1.
] ifFalse:[
lineStream space
]
].
line := lineStream contents paddedTo:(3*16 + addrDigits + 1).
lines add:(line , ' ' , asciiLineStream contents).
self show:lines.
]
]
"Modified: / 7.9.1998 / 15:37:47 / cg"
!
fileInsert
"insert contents of file at the cursor position"
|fileName|
fileName := self getSelectedFileName.
fileName notNil ifTrue:[
self showFile:fileName insert:true encoding:fileEncoding
]
"Modified: 23.4.1997 / 13:06:06 / cg"
!
fileListMenu
"return the menu to show in the fileList"
<resource: #programMenu>
|m|
m := self class menuPopUp.
m := m decodeAsLiteralArray.
m receiver:self.
m findGuiResourcesIn:self.
^ m.
"Modified: / 14.8.1998 / 14:09:12 / cg"
!
fileListMenu_old
"return the menu to show in the fileList"
<resource: #programMenu>
|items m sel ns subMenu subItems|
items := #(
('spawn' fileSpawn )
('-' nil )
('get contents' fileGet GotoLine)
('insert contents' fileInsert )
('show info' fileGetInfo InspectIt)
('show full info' fileGetLongInfo CmdI)
).
((ns := Project current defaultNameSpace) notNil
and:[ns ~~ Smalltalk]) ifTrue:[
items := items copyWith:(Array
with:(resources string:'fileIn (into ''%1'')' with:(Project current defaultNameSpace name))
with:#fileFileIn
with:#Accept)
] ifFalse:[
items := items copyWith:#( 'fileIn' #fileFileIn #Accept)
].
items := items , #(
('-' )
('update' updateCurrentDirectory Cmdu)
('-' )
('execute unix command ...' fileExecute DoIt)
('st/x tools' stxTools )
('-' )
('remove' fileRemove Delete)
('rename ...' fileRename )
('-' )
('display long list' changeDisplayMode )
('show all files' changeDotFileVisibility )
('encoding ...' fileEncoding )
('-' )
('create directory ...' newDirectory CmdD)
('create file ...' newFile CmdF)
).
m := PopUpMenu
itemList:items
resources:resources.
showingHiddenFiles value "showDotFiles" ifTrue:[
m labelAt:#changeDotFileVisibility put:(resources string:'hide hidden files')
].
showingDetails value "showLongList" ifTrue:[
m labelAt:#changeDisplayMode put:(resources string:'display short list')
].
items := #(
('Changes browser' openChangesBrowser )
('Editor' openEditor )
('HTML reader' openHTMLReader )
('Image inspect' openImageInspector )
('show file differences' openDiffView )
).
OperatingSystem isUNIXlike ifTrue:[
items := items , #( ('terminal' openTerminal )).
].
JavaInterpreter notNil ifTrue:[
items := items , #( ('Java Applet Viewer' openAppletViewer)).
].
m subMenuAt:#stxTools
put:(PopUpMenu
itemList:items
resources:resources).
((sel := fileListView selection) isNil
or:[sel isEmpty]) ifTrue:[
m disableAll:#(fileGet fileInsert
fileGetInfo fileGetLongInfo
fileFileIn fileFileInLazy
fileRemove fileRename).
(m subMenuAt:#stxTools)
disableAll:#(openChangesBrowser openEditor openHTMLReader openImageInspector)
] ifFalse:[
fileListView selection size > 1 ifTrue:[
m disableAll:#( fileGet fileInsert fileGetInfo fileGetLongInfo fileRename )
]
].
^m
"Modified: / 16.1.1998 / 16:42:59 / stefan"
"Modified: / 4.8.1998 / 13:45:56 / cg"
"Created: / 13.8.1998 / 20:51:38 / cg"
!
filePrint
"send a files contents to the printer (not in the menu)"
|fileName path inStream printStream line|
self withWaitCursorDo:[
fileName := self getSelectedFileName.
fileName notNil ifTrue:[
path := currentDirectory filenameFor:fileName.
(path type == #regular) ifTrue:[
inStream := path readStream.
inStream isNil ifFalse:[
printStream := PrinterStream new.
printStream notNil ifTrue:[
[inStream atEnd] whileFalse:[
line := inStream nextLine.
printStream nextPutLine:line.
].
printStream close
].
inStream close
]
]
].
0 "compiler hint"
]
"Modified: 23.4.1997 / 13:05:40 / cg"
"Modified: 18.9.1997 / 16:29:17 / stefan"
!
fileRemove
"remove the selected file(s).
Query if user really wants to remove the file.
- should be enhanced, to look for a ~/.trash directory
and move files there if it exists (without asking in this case)."
|sel q|
sel := fileListView selection.
sel size > 0 ifTrue:[
sel := sel collect:[:rawIndex | fileList at:rawIndex].
sel size > 1 ifTrue:[
q := resources string:'remove %1 selected files ?' with:(sel size)
] ifFalse:[
q := resources string:'remove ''%1'' ?' with:(sel first allBold)
].
(self sensor shiftDown
or:[self ask:q yesButton:'remove']) ifTrue:[
self withCursor:(Cursor wait) do:[
self doRemove:sel
]
]
]
"Modified: / 16.12.1998 / 17:30:31 / cg"
!
fileRename
"rename the selected file(s)"
|queryBox|
queryBox := FilenameEnterBox new.
queryBox okText:(resources at:'rename').
self selectedFilesDo:[:oldName |
queryBox title:(resources string:'rename ''%1'' to:' with:oldName).
queryBox initialText:oldName.
queryBox action:[:newName | self doRename:oldName to:newName].
queryBox showAtPointer
]
!
fileSelect:lineNr
"selected a file - do nothing here"
|fn|
imagePreviewView notNil ifTrue:[
self stopImageRenderProcess.
fn := self getSelectedFileName.
(Image isImageFileSuffix:(fn asFilename suffix)) ifTrue:[
imageRenderProcess := [
self loadImageAndPerform:[:img |
imagePreviewView beVisible.
imagePreviewView image:img
]
] forkAt:(Processor activePriority - 1).
] ifFalse:[
imagePreviewView beInvisible
].
]
"Modified: 23.4.1997 / 13:04:55 / cg"
!
fileSpawn
"start another FileBrowser on the selected directory or
on the same directory if none is selected."
|any path|
any := false.
self selectedFilesDo:[:fileName |
path := currentDirectory filenameFor:fileName.
path isDirectory ifTrue:[
self class openOn:(path pathName).
any := true
]
].
any ifFalse:[
self class openOn:currentDirectory pathName
]
"Modified: 18.9.1997 / 16:32:39 / stefan"
!
loadImageAndPerform:aSelectorOrBlock
|img path|
self selectedFilesDo:[:fileName |
path := currentDirectory filenameFor:fileName.
path isDirectory ifFalse:[
img := Image fromFile:(path pathName).
img notNil ifTrue:[
aSelectorOrBlock isSymbol ifTrue:[
img perform:aSelectorOrBlock
] ifFalse:[
aSelectorOrBlock value:img
]
] ifFalse:[
self warn:'unknown format: ' , fileName
]
]
].
"Modified: / 17.9.1995 / 17:41:24 / claus"
"Modified: / 18.9.1997 / 17:05:04 / stefan"
"Created: / 26.8.1998 / 16:20:18 / cg"
!
newDirectory
"ask for and create a new directory"
|queryBox|
queryBox := FilenameEnterBox
title:(resources at:'create new directory:') withCRs
okText:(resources at:'create')
action:[:newName | self doCreateDirectory:newName].
queryBox showAtPointer
"Modified: 23.4.1997 / 13:04:27 / cg"
!
newFile
"ask for and create a new file"
|sel queryBox|
queryBox := FilenameEnterBox
title:(resources at:'create new file:') withCRs
okText:(resources at:'create')
action:[:newName | newName isEmpty ifFalse:[
self doCreateFile:newName.
self selectFile:newName.
]
].
sel := subView selection.
sel notNil ifTrue:[
queryBox initialText:(sel asString)
].
queryBox showAtPointer
"Modified: / 23.4.1997 / 13:04:38 / cg"
"Modified: / 16.1.1998 / 16:54:00 / stefan"
!
newHardLink
"ask for and create a hard link (unix only)"
|sel box orgName1 name1 name2 f1 f2 f d err nm here l1 if1 if2|
sel := self getSelectedFileName.
orgName1 := ''.
(sel size > 0) ifTrue:[
(currentDirectory construct:sel) isDirectory ifFalse:[
orgName1 := sel
]
].
name1 := orgName1 asValue.
name2 := '' asValue.
box := DialogBox new.
(box addTextLabel:(resources string:'Create hard link from:')) adjust:#left.
if1 := box addFilenameInputFieldOn:name1 in:here tabable:true.
(box addTextLabel:(resources string:'to:')) adjust:#left.
if2 := box addFilenameInputFieldOn:name2 in:here tabable:true.
box addAbortAndOkButtons.
orgName1 size > 0 ifTrue:[
box focusOnField:if2.
].
box showAtPointer.
box accepted ifTrue:[
name1 := name1 value.
(name1 size == 0) ifTrue:[
err := 'no name entered'.
] ifFalse:[
f1 := name1 asFilename.
name2 := name2 value.
(name2 size == 0) ifTrue:[
err := 'no name entered'.
] ifFalse:[
f2 := name2 asFilename.
f2 exists ifTrue:[
err := '''%2'' already exists'.
] ifFalse:[
f1 exists ifFalse:[
err := '''%1'' does not exist'.
] ifTrue:[
f1 isDirectory ifTrue:[
err := '''%1'' is a directory'.
] ifFalse:[
ErrorSignal handle:[:ex |
err := ex errorString
] do:[
OperatingSystem createHardLinkFrom:name1 to:name2
]
]
]
]
]
].
err notNil ifTrue:[
self warn:(resources string:err with:(name1 ? '') allBold with:(name2 ? '') allBold).
^ self
].
].
"Modified: / 13.8.1998 / 21:47:01 / cg"
!
newSoftLink
"ask for and create a soft link (unix only)"
|sel box orgName1 name1 name2 f1 f2 f d err nm here l1 if1 if2|
sel := self getSelectedFileName.
here := currentDirectory pathName.
orgName1 := ''.
(sel size > 0) ifTrue:[
orgName1 := sel
].
name1 := orgName1 asValue.
name2 := '' asValue.
box := DialogBox new.
(box addTextLabel:'Create symbolic link to:') adjust:#left.
if1 := box addFilenameInputFieldOn:name1 in:here tabable:true.
(box addTextLabel:'as:') adjust:#left.
if2 := box addFilenameInputFieldOn:name2 in:here tabable:true.
box addAbortAndOkButtons.
orgName1 size > 0 ifTrue:[
box focusOnField:if2.
].
box showAtPointer.
box accepted ifTrue:[
name1 := name1 value.
(name1 size == 0) ifTrue:[
err := 'no name entered'.
] ifFalse:[
f1 := name1 asFilename.
name2 := name2 value.
(name2 size == 0) ifTrue:[
err := 'no name entered'.
] ifFalse:[
f2 := name2 asFilename.
f2 exists ifTrue:[
err := '''%2'' already exists'.
] ifFalse:[
f1 exists ifFalse:[
err := '''%1'' does not exist (link created anyway)'.
].
ErrorSignal handle:[:ex |
err := ex errorString
] do:[
OperatingSystem createSymbolicLinkFrom:name1 to:name2
]
]
]
].
err notNil ifTrue:[
self warn:(resources string:err with:(name1 ? '') allBold with:(name2 ? '') allBold).
^ self
].
].
"Modified: / 13.8.1998 / 21:26:59 / cg"
"Created: / 13.8.1998 / 21:47:14 / cg"
!
openASN1Browser
self openTool:OSI::ASN1Browser
"Modified: / 7.9.1998 / 21:31:58 / cg"
!
openAppletViewer
|numItems|
(numItems := fileListView selection size) > 2 ifTrue:[
(self
confirm:(resources string:'open for each of the %1 items ?'
with:numItems)) ifFalse:[^ self].
].
Java startupJavaSystem.
"/ Java markAllClassesUninitialized.
"/ Java initAllStaticFields.
"/ Java initAllClasses.
self selectedFilesDo:[:fileName |
|p path|
path := currentDirectory filenameFor:fileName.
path isDirectory ifFalse:[
p := Java
javaProcessForMainOf:(Java classForName:'sun.applet.AppletViewer')
argumentString:path pathName.
p resume.
]
].
"Modified: / 18.9.1997 / 17:00:59 / stefan"
"Modified: / 17.10.1998 / 17:00:43 / cg"
!
openCBrowser
CC::Browser openIn:currentDirectory.
!
openChangesBrowser
"open a change browser on the selected file(s)"
self openTool:(UserPreferences current changesBrowserClass)
"Modified: / 17.10.1998 / 14:39:15 / cg"
!
openDiffView
"open a diff-view"
|sel box orgName1 name1 name2 text1 text2 f d err nm here l1|
sel := self getSelectedFileName.
orgName1 := ''.
(sel size > 0
and:[lastFileDiffDirectory notNil
and:[lastFileDiffDirectory asFilename isDirectory]]) ifTrue:[
f := lastFileDiffDirectory asFilename construct:sel.
(f exists
and:[f isReadable]) ifTrue:[
orgName1 := f name
]
].
name1 := orgName1 asValue.
name2 := self getSelectedFileName asValue.
here := currentDirectory pathName.
box := DialogBox new.
(box addTextLabel:'show difference between:\\file1 (empty for views contents):' withCRs) adjust:#left.
box addFilenameInputFieldOn:name1 in:here tabable:true.
(box addTextLabel:'and file2:') adjust:#left.
box addFilenameInputFieldOn:name2 in:here tabable:true.
box addAbortAndOkButtons.
box showAtPointer.
box accepted ifTrue:[
name1 := name1 value.
(name1 isNil or:[name1 isEmpty]) ifTrue:[
"/ text1 := subView contents.
text1 := subView list asStringCollection withTabs.
text1 := text1 collect:[:l | l isNil ifTrue:[' '] ifFalse:[l]].
name1 := nil.
l1 := 'browser contents'
] ifFalse:[
name1 := currentDirectory filenameFor:name1.
name1 isReadable ifFalse:[
nm := name1.
name1 exists ifFalse:[
err := '%1 does not exist'.
] ifTrue:[
err := '%1 is not readable'
].
].
l1 := name1 pathName
].
name2 := currentDirectory filenameFor:name2 value.
err isNil ifTrue:[
name2 isReadable ifFalse:[
nm := name2.
name2 exists ifFalse:[
err := '%1 does not exist'.
] ifTrue:[
err := '%1 is not readable'
].
].
].
err notNil ifTrue:[
self warn:(resources string:err with:nm pathName).
^ self
].
self withWaitCursorDo:[
(name1 notNil and:[name1 name ~= orgName1]) ifTrue:[
lastFileDiffDirectory := name1 directoryName
].
name1 notNil ifTrue:[
text1 := name1 contents.
].
text2 := name2 contents.
text1 = text2 ifTrue:[
self information:'same contents'
] ifFalse:[
d := DiffTextView
openOn:text1 label:l1
and:text2 label:name2 pathName.
d label:'file differences'.
]
]
].
"Created: / 7.12.1995 / 20:33:58 / cg"
"Modified: / 18.9.1997 / 17:31:46 / stefan"
"Modified: / 5.5.1999 / 16:04:10 / cg"
!
openEditor
self openTool:EditTextView
!
openHTMLReader
self openTool:HTMLDocumentView ignoreDirectories:false
"Modified: / 7.9.1998 / 21:31:58 / cg"
!
openImageEditor
[self loadImageAndPerform:#edit] fork
"Modified: / 17.9.1995 / 17:41:24 / claus"
"Modified: / 18.9.1997 / 17:05:04 / stefan"
"Created: / 13.8.1998 / 22:07:09 / cg"
"Modified: / 7.9.1998 / 21:31:41 / cg"
!
openImageInspector
[self loadImageAndPerform:#inspect] fork
"Modified: / 17.9.1995 / 17:41:24 / claus"
"Modified: / 18.9.1997 / 17:05:04 / stefan"
"Modified: / 7.9.1998 / 21:31:30 / cg"
!
openImagePreview
[self loadImageAndPerform:[:img |
|i top viewer|
top := StandardSystemView new.
viewer := ImageView origin:0.0@0.0 corner:1.0@1.0 in:top.
i := img.
top extent:200@200.
top label:(img fileName asFilename directoryName asFilename baseName , '/' , img fileName asFilename baseName).
top openAndWait.
(i width > 200 or:[i height > 200]) ifTrue:[
i := i magnifiedPreservingRatioTo:200@200.
].
viewer image:i.
].
] fork
"Modified: / 4.12.1998 / 15:49:03 / cg"
!
openSelectedFilename
|sel|
sel := subView selection.
sel notNil ifTrue:[
sel := sel asString withoutSeparators.
sel asFilename exists ifTrue:[
self doOpenFile:sel viaDoubleClick:false
]
].
"Created: / 4.2.1999 / 17:40:42 / cg"
"Modified: / 4.2.1999 / 17:47:06 / cg"
!
openSnapshotImageBrowser
^ self openTool:SystemBrowser with:#openOnSnapShotImage: ignoreDirectories:true
!
openTerminal
VT100TerminalView openShellIn:currentDirectory
"Created: / 20.7.1998 / 18:18:15 / cg"
"Modified: / 20.7.1998 / 18:32:28 / cg"
!
openTool:aToolClass
"open a tool on the selected file(s)"
^ self openTool:aToolClass ignoreDirectories:true
"Modified: / 7.9.1998 / 19:32:10 / cg"
!
openTool:aToolClass ignoreDirectories:ignoreDirs
"open a tool on the selected file(s)"
^ self
openTool:aToolClass
with:#openOn:
ignoreDirectories:ignoreDirs
!
openTool:aToolClass with:aSelector ignoreDirectories:ignoreDirs
"open a tool on the selected file(s)"
|numItems path tool|
aToolClass isNil ifTrue:[
self warn:'Sorry, that tool seems to be not available'.
^ nil.
].
(numItems := fileListView selection size) > 2 ifTrue:[
(self
confirm:(resources string:'open for each of the %1 items ?'
with:numItems)) ifFalse:[^ self].
].
self selectedFilesDo:[:fileName |
path := currentDirectory filenameFor:fileName.
(ignoreDirs not
or:[path isDirectory not]) ifTrue:[
tool := aToolClass perform:aSelector with:(path pathName).
]
].
^ tool
"Modified: / 18.9.1997 / 17:06:18 / stefan"
"Created: / 7.9.1998 / 19:31:49 / cg"
"Modified: / 25.5.1999 / 16:30:35 / cg"
!
openZipTool
|zipTool|
(zipTool := self openTool:ZipTool) notNil ifTrue:[
zipTool initialExtractDirectory:currentDirectory
].
"Created: / 26.8.1998 / 16:20:55 / cg"
"Modified: / 25.5.1999 / 16:30:54 / cg"
!
readAbbrevFile
|sel|
sel := self singleSelectedFile.
sel notNil ifTrue:[
Smalltalk installAutoloadedClassesFrom:sel
].
"Created: / 4.2.1999 / 17:40:42 / cg"
"Modified: / 29.1.2000 / 13:10:01 / cg"
!
revisitFile:aFileName
|lineNr|
(self askIfModified:'contents has not been saved.\\Modifications will be lost when you proceed.'
yesButton:'proceed') ifFalse:[ ^self ].
self doChangeCurrentDirectoryTo:aFileName asFilename directory updateHistory:false.
lineNr := fileList indexOf:aFileName asFilename baseName.
fileListView selection:lineNr.
self fileGet:true.
!
showOrHideTabView
"depending on the showLongList setting, show or hde the tabSpec view"
showingDetails value "showLongList" ifTrue:[
tabRulerView isNil ifTrue:[
self createTabRulerIn:scrollView superView.
].
tabRulerView beVisible.
false "self is3D" ifTrue:[
scrollView topInset:(tabRulerView superView height).
tabRulerView superView leftInset:(fileListView originRelativeTo:scrollView) x.
] ifFalse:[
scrollView topInset:(tabRulerView height).
tabRulerView leftInset:(fileListView originRelativeTo:scrollView) x.
].
tabRulerView hiddenTabs:#(1).
tabRulerView fixedTabs:#(1).
] ifFalse:[
tabRulerView notNil ifTrue:[
tabRulerView beInvisible.
].
scrollView topInset:0
].
tabSpec := nil.
"Created: / 19.4.1997 / 09:50:02 / cg"
"Modified: / 4.8.1998 / 13:44:14 / cg"
! !
!FileBrowser methodsFor:'help '!
helpTextFor:aComponent
|s|
aComponent == subView ifTrue:[
s := 'HELP_SUBVIEW'
].
aComponent == fileListView ifTrue:[
s := 'HELP_FILELIST'
].
aComponent == filterField ifTrue:[
s := 'HELP_FILTER'
].
aComponent == labelView ifTrue:[
s := 'HELP_PATHFIELD'
].
aComponent == commandView ifTrue:[
s := 'HELP_COMMANDVIEW'
].
s notNil ifTrue:[
^ resources string:s
].
^ nil
! !
!FileBrowser methodsFor:'initialize / release'!
createTabRulerIn:topFrame
|v|
false "self is3D" ifTrue:[
v := View in:topFrame.
v level:-1.
tabRulerView := TabSpecRuler in:v.
tabRulerView level:1.
v origin:(0.0@0.0) corner:(1.0@10).
tabRulerView origin:(0.0@0.0) corner:(1.0@1.0).
] ifFalse:[
tabRulerView := TabSpecRuler in:topFrame.
tabRulerView origin:(0.0@0.0) corner:(1.0@10).
].
tabRulerView borderWidth:0.
tabRulerView synchronousOperation:true.
tabRulerView masterView:scrollView scrolledView
"Created: / 27.7.1998 / 20:23:10 / cg"
"Modified: / 27.7.1998 / 20:30:10 / cg"
!
currentDirectory:aDirectoryPath
"set the directory to be browsed"
|newDirectory|
newDirectory := aDirectoryPath asFilename.
newDirectory = currentDirectory ifTrue:[
^ self
].
currentDirectory := aDirectoryPath asFilename.
self changed:#path.
"
tell my subview (whatever that is) to start its file-dialog
(i.e. save-as etc.) in that directory
"
(subView respondsTo:#directoryForFileDialog:) ifTrue:[
subView directoryForFileDialog:currentDirectory
]
"Modified: 16.9.1997 / 14:56:17 / stefan"
"Modified: 21.9.1997 / 11:28:49 / cg"
!
destroy
"destroy view and boxes"
ObjectMemory removeDependent:self.
self stopUpdateProcess.
self stopImageRenderProcess.
checkBlock := nil.
super destroy
"Modified: 19.4.1997 / 13:51:48 / cg"
!
focusSequence
"return the sequence in which ALT-CursorRight steps focus"
|fs|
fs := Array
with:menuPanel
with:labelView
with:filterField
with:fileListView
with:subView.
commandView notNil ifTrue:[
fs := fs copyWith:commandView
].
^fs
!
initEvents
super initEvents.
self enableEvent:#visibilityChange.
!
initialize
|frame spacing halfSpacing v topFrame labelFrame filterModel
buttonPanel img mH lowerFrame|
super initialize.
fileEncoding := #iso8859. "/ native ST/X encoding
"if true, will replace leading spaces by tabs on
file write. If false, they will be written as spaces
"
compressTabs := resources at:'COMPRESS_TABS' default:true.
"
showing long or short by default
"
"/ showLongList := resources at:'LONG_LIST' default:false.
showingDetails := (resources at:'LONG_LIST' default:false) asValue.
showingDetails onChangeSend:#detailsSettingChanged to:self.
"
show hidden files or not ?
"
"/ showDotFiles := resources at:'SHOW_DOT_FILES' default:false.
showingHiddenFiles := (resources at:'SHOW_DOT_FILES' default:false) asValue.
showingHiddenFiles onChangeSend:#updateCurrentDirectory to:self.
"
showing small icons by default
"
showingBigImagePreview := (resources at:'BIG_IMAGE_PREVIEW' default:false) asValue.
showingBigImagePreview onChangeSend:#bigImagePreviewSettingChanged to:self.
sortByWhat := #name asValue.
sortByWhat onChangeSend:#sortChanged to:self.
sortCaseless := (Filename isCaseSensitive not) asValue.
sortCaseless onChangeSend:#updateCurrentDirectory to:self.
dosEOLMode := false asValue.
lockUpdate := false.
CommandHistory isNil ifTrue:[
CommandHistory := OrderedCollection new.
CommandHistorySize := 50
].
DirectoryHistory isNil ifTrue:[
DirectoryHistory := OrderedCollection new.
DirectoryHistoryWhere := OrderedCollection new.
].
VisitedFileHistory isNil ifTrue:[
VisitedFileHistory := OrderedCollection new.
].
HistorySize isNil ifTrue:[
HistorySize := 15
].
commandIndex := 0.
icons := Dictionary new.
Icons isNil ifTrue:[
self class initializeIcons
].
myName := (resources string:self class name).
self label:myName.
menuPanel := MenuPanel in:self.
menuPanel level:1.
menuPanel verticalLayout:false.
menuPanel receiver:self.
menuPanel menu:(self pullDownMenu).
mH := menuPanel preferredExtent y.
menuPanel origin:(0.0 @ 0.0) corner:(1.0 @ (mH)).
labelFrame := View
origin:(0.0 @ mH)
corner:(1.0 @ (font height * 1.8 + mH) rounded)
in:self.
(styleSheet name = #st80 or:[styleSheet name == #win95]) ifTrue:[
labelFrame level:1.
"/ labelFrame rightInset:-1.
].
spacing := ViewSpacing.
halfSpacing := spacing // 2.
"
checkBlock is executed by the Processor every checkDelta seconds.
We use #pushEvent: to perform the directory update
in our windowgroups process.
"
checkBlock := [self pushEvent:#checkIfDirectoryHasChanged].
checkDelta := resources at:'CHECK_DELTA' default:10.
doAutoUpdate := true asValue.
currentDirectory := Filename currentDirectory.
filterModel := '*' asValue.
filterField := EditField in:labelFrame.
filterField
origin:[((width // 4 * 3) + halfSpacing) @ (halfSpacing)]
corner:(1.0 @ (filterField heightIncludingBorder + halfSpacing) ).
filterField rightInset:(ViewSpacing - halfSpacing).
filterField model:filterModel.
labelFrame corner:(1.0 @ (mH + ViewSpacing + filterField height + halfSpacing)).
self initializeFilterPattern.
filterModel onChangeSend:#filterPatternChanged to:self.
"/ filterField leaveAction:[:key | fileListView scrollToTop. self updateCurrentDirectory].
"/ labelView := Label in:labelFrame.
"/ labelView origin:(halfSpacing @ halfSpacing)
"/ extent:[((width // 4 * 3) - spacing - borderWidth)
"/ @
"/ (filterField heightIncludingBorder)
"/ "(font height + font descent)"
"/ ].
"/ labelView adjust:#right.
"/ labelView borderWidth:0.
"/ labelView model:self; menu:#labelMenu; aspect:#path; labelMessage:#path.
"/ labelFrame model:self; menu:#labelMenu.
labelView := FilenameEditField in:labelFrame.
labelView
origin:(halfSpacing @ (halfSpacing))
extent:[((width // 4 * 3) - spacing - borderWidth)
@
(filterField heightIncludingBorder)
"(font height + font descent)"
].
labelView menu:#labelMenu;
aspect:#path; changeMessage:#pathChanged:.
labelView model:self.
labelView acceptOnExpand:true.
labelView backgroundColor:(labelFrame viewBackground).
labelFrame model:self; menu:#labelMenu.
labelView cursorType:#solidCaret; cursorTypeNoFocus:#none.
labelView level:0.
labelView borderWidth:0.
killButton := Button label:(resources string:'kill') in:self.
"/ killButton origin:(halfSpacing @ halfSpacing)
"/ extent:(killButton width @ filterField height).
killButton origin:(halfSpacing @ 1.0).
killButton topInset:(killButton height negated).
killButton beInvisible.
pauseToggle := Toggle label:(resources string:'pause') in:self.
"/ pauseToggle origin:((killButton corner x + 50) @ halfSpacing)
"/ extent:(pauseToggle width @ filterField height).
pauseToggle origin:((killButton corner x + ViewSpacing + 20) @ 1.0).
pauseToggle topInset:(pauseToggle height negated).
pauseToggle beInvisible.
self initializeCommandViewIn:self.
"/ frame := VariableVerticalPanel
"/ origin:[frame borderWidth negated
"/ @
"/ labelFrame height
"/ "/ (labelView height + labelView origin y + spacing)
"/ ]
"/ corner:(1.0 @ 1.0)
"/ in:self.
frame := VariableVerticalPanel origin:0.0@mH corner:1.0@1.0 in:self.
frame snapMode:#both.
frame topInset:labelFrame height.
commandView notNil ifTrue:[
frame bottomInset:(commandView height + spacing + spacing)
].
topFrame := View in:frame.
topFrame origin:(0.0 @ 0.0) corner:(1.0 @ 0.3).
false ifTrue:[
self createTabRulerIn:topFrame.
].
scrollView := ScrollableView in:topFrame.
scrollView
verticalScrollable:true;
verticalMini:false;
horizontalScrollable:true;
horizontalMini:true;
autoHideHorizontalScrollBar:true;
autoHideVerticalScrollBar:false;
origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
fileListView := SelectionInListView new.
scrollView scrolledView:fileListView.
fileListView action:[:lineNr | self fileSelect:lineNr].
fileListView doubleClickAction:[:lineNr | self fileDoubleClick:lineNr].
fileListView multipleSelectOk:true.
fileListView delegate:self.
fileListView menuHolder:self; menuPerformer:self; menuMessage:#fileListMenu.
fileListView allowDrag:true.
fileListView dragObjectConverter:[:obj |
|dir nm path idx|
nm := obj theObject asString.
idx := fileListView list indexOf:nm.
idx == 0 ifTrue:[
"/ cannot happen ...
nil
] ifFalse:[
nm := fileList at:idx.
dir := currentDirectory pathName asFilename.
path := dir constructString:nm.
DropObject newFile:path.
]
].
"/ sigh - must be delayed - origin is not yet fixe
"/ tabRulerView leftInset:(fileListView originRelativeTo:scrollView) x.
"/ self showOrHideTabView.
lowerFrame := View in:frame.
lowerFrame origin:(0.0 @ 0.3) corner:(1.0 @ 1.0).
v := self initializeSubViewIn:lowerFrame.
subView := v scrolledView.
(subView respondsTo:#directoryForFileDialog:) ifTrue:[
subView directoryForFileDialog:currentDirectory
].
"/ buttonPanel := HorizontalPanelView in:self.
"/ buttonPanel horizontalLayout:#leftSpace.
"/ buttonPanel verticalSpace:0.
"/ "/ buttonPanel verticalLayout:#top.
"/ buttonPanel borderWidth:0.
"/
"/ buttonPanel
"/ origin:(0.5 @ halfSpacing)
"/ extent:[((width // 4) - spacing - borderWidth)
"/ @
"/ (buttonPanel preferredExtent y max:(labelView height))
"/ ].
"/ "/ buttonPanel level:-1.
"/
"/ upButton := Button in:buttonPanel.
"/ img := Image fromFile:'bitmaps/xpmBitmaps/document_images/tiny_yellow_dir_up.xpm'.
"/ upButton label:(img ? 'up').
"/ upButton action:[self changeToParentDirectory].
ObjectMemory addDependent:self.
"Modified: / 6.9.1995 / 20:26:06 / claus"
"Modified: / 16.9.1997 / 14:52:46 / stefan"
"Modified: / 12.7.1999 / 12:59:47 / cg"
!
initializeCommandViewIn:frame
"set up the command view - can be redefined in subclasses as empty,
if no commandView is wanted"
commandView := EditField origin:0.0@1.0 corner:1.0@1.0 in:frame.
commandView allInset:ViewSpacing//2.
commandView topInset:(commandView preferredExtent y negated - ViewSpacing).
"/ commandView contents:'** no commands which require input here **'.
commandView entryCompletionBlock:[:contents |
|newString words lastWord expandedWord|
words := contents asCollectionOfWords.
words size == 0 ifTrue:[
commandView flash
] ifFalse:[
"/ actually: should expand the word before the cursor here ...
lastWord := words last.
expandedWord := Filename
filenameCompletionFor:lastWord
directory:currentDirectory
directoriesOnly:false
filesOnly:false
ifMultiple:[:dir | commandView flash.].
words at:(words size) put:expandedWord.
newString := words asStringCollection asStringWith:Character space.
commandView contents:newString.
commandView cursorToEndOfLine.
]
].
commandView leaveAction:[:key |
|cmd nCmd empty|
(key == #CursorDown
or:[key == #CursorUp]) ifTrue:[
nCmd := CommandHistory size.
nCmd == 0 ifTrue:[
empty := true
] ifFalse:[
key == #CursorUp ifTrue:[
commandIndex == nCmd ifTrue:[
commandView flash.
].
commandIndex := (commandIndex + 1) min:nCmd
] ifFalse:[
commandIndex == 1 ifTrue:[
commandView flash.
empty := true.
].
commandIndex := (commandIndex - 1) max:1.
].
].
empty == true ifTrue:[
commandView contents:nil
] ifFalse:[
commandView contents:(CommandHistory at:commandIndex).
]
].
key == #Return ifTrue:[
cmd := commandView contents string.
subView insertLine:(
Text string:('>> ' , cmd)
emphasis:(Array with:#bold with:#underline with:(#color->Color blue))
"/ ColoredListEntry string:('>> ' , cmd) color:Color blue
)
before:(subView cursorLine).
subView cursorDown:1.
"/ subView insertStringAtCursor:cmd.
"/ subView insertCharAtCursor:(Character cr).
(cmd notNil and:[cmd notEmpty]) ifTrue:[
self class addToCommandHistory:cmd for:nil.
self doExecuteCommand:cmd replace:false.
commandView contents:nil.
commandIndex := 0
]
]
].
"Modified: 7.9.1995 / 15:48:45 / claus"
"Modified: 30.8.1997 / 19:22:52 / cg"
"Modified: 18.9.1997 / 16:55:01 / stefan"
!
initializeFilterPattern
"set an initial matchpattern - can be redefined in subclasses"
filterField model value:'*'
!
initializeSubViewIn:frame
"set up the contents view - can be redefined in subclasses for
different view types (SoundFileBrowser/ImageBrowsers etc.)"
|textView|
textView := HVScrollableView
for:CodeView
miniScrollerH:true
miniScrollerV:false
in:frame.
textView origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
"/ imagePreviewView := HVScrollableView
"/ for:ImageView
"/ miniScrollerH:true
"/ miniScrollerV:false
"/ in:frame.
"/ imagePreviewView origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
"/
"/ imagePreviewView beInvisible.
textView doItAction:[:theCode |
PositionableStream currentFileInDirectoryQuerySignal
answer:(currentDirectory asFilename)
do:[
Compiler
evaluate:theCode
in:nil
receiver:nil
notifying:textView
logged:true
ifFail:nil
]
].
^ textView.
!
postRealize
super postRealize.
self showOrHideTabView.
"Created: 24.7.1997 / 18:13:46 / cg"
! !
!FileBrowser methodsFor:'menu actions'!
copyCommandHistory
"copy the command history to the clipBoard"
self setTextSelection:(CommandHistory asStringCollection asString).
"Modified: / 29.10.1998 / 12:17:14 / cg"
!
copyFileList
"copy fileList to the clipBoard"
self setTextSelection:(fileListView list
collect:[:l | |ll|
ll := l string withoutSeparators.
(ll endsWith:' ...') ifTrue:[
ll copyWithoutLast:4
] ifFalse:[
ll
]
])
asStringCollection asString.
"Modified: / 17.8.1998 / 10:13:10 / cg"
!
copySelectedFileName
"copy the selected filename to the clipBoard (for easy paste)"
|sel fileName|
sel := fileListView selection.
sel size == 1 ifTrue:[
fileName := fileList at:sel first.
self setTextSelection:fileName
].
!
createProjectAndOpenProjectBrowser
|nm f s|
nm := currentDirectory baseName.
f := (currentDirectory construct:nm) withSuffix:'prj'.
f exists ifTrue:[
self warn:'A file named ' , f baseName , ' alredy exists.'.
^ self.
].
s := f writeStream.
s nextPutAll:'
name ''' , nm , '''
type #classLibrary
package #''private:' , nm , '''
prerequisites nil
classes #( )
'.
s close.
ProjectBrowser openOnFile:f.
!
menuExit
self closeRequest
"Created: / 4.8.1998 / 13:41:38 / cg"
!
menuOSCommand
self fileExecute
"Created: / 4.8.1998 / 14:06:54 / cg"
!
menuOpen
"same as a double-click"
"Modified: / 4.8.1998 / 13:42:14 / cg"
!
menuShowFileBrowserDocumentation
"Created: / 4.8.1998 / 14:03:57 / cg"
!
openAboutThisApplication
"opens an about box for this application."
|rev box myClass clsRev image msg|
rev := ''.
myClass := self class.
(clsRev := myClass revision) notNil ifTrue: [rev := ' (rev: ', clsRev printString, ')'].
msg := '\' withCRs , myClass name asBoldText, rev.
AboutBox isNil ifTrue:[
"/ this handles bad installations of ST/X,
"/ where the AboutBox is missing.
"/ (May vanish in the future)
^ self information:msg
].
box := AboutBox title:msg.
image := self class defaultIcon.
image notNil ifTrue:[
box image:image
].
box label:'About This Application'.
box autoHideAfter:10 with:[].
box showAtPointer.
"Modified: / 14.8.1998 / 13:20:24 / cg"
!
openHTMLDocument:relativeDocPath
HTMLDocumentView openFullOnDocumentationFile:relativeDocPath
"Created: / 4.8.1998 / 14:06:10 / cg"
!
pullDownMenu
"return the top (pullDown) menu"
<resource: #programMenu>
|m|
m := self class menuSpec.
m := m decodeAsLiteralArray.
m receiver:self.
m findGuiResourcesIn:self.
^ m.
"Modified: / 14.8.1998 / 14:09:12 / cg"
"Created: / 14.8.1998 / 14:14:16 / cg"
!
showAboutSTX
ToolApplicationModel openAboutSTX
"Created: / 14.8.1998 / 13:18:41 / cg"
!
sortChanged
"/ Transcript show:'fBrowser:'; showCR:sortByWhat value.
self updateCurrentDirectory
"Created: / 14.8.1998 / 16:17:20 / cg"
"Modified: / 14.8.1998 / 16:44:00 / cg"
! !
!FileBrowser methodsFor:'menu actions - cvs'!
cvsAddSelection
"add files (or all in current directory)"
|sel log|
log := Dialog
requestText:(resources string:'enter initial log message')
lines:10
columns:70
initialAnswer:nil.
log notNil ifTrue:[
sel := fileListView selection.
sel size > 0 ifTrue:[
sel := sel collect:[:rawIndex | fileList at:rawIndex].
sel do:[:fn |
self
doExecuteCommand:('cvs add -m ''' , log , ''' ' , fn) replace:false
]
] ifFalse:[
self
doExecuteCommand:('cvs add -l -m ''' , log , ''' *') replace:false
].
]
"Modified: / 16.12.1998 / 17:30:31 / cg"
!
cvsCommitSelection
"commit files (or all in current directory)"
|sel log|
log := Dialog
requestText:(resources string:'enter log message')
lines:10
columns:70
initialAnswer:nil.
log notNil ifTrue:[
sel := fileListView selection.
sel size > 0 ifTrue:[
sel := sel collect:[:rawIndex | fileList at:rawIndex].
sel do:[:fn |
self
doExecuteCommand:('cvs commit -m ''' , log , ''' ' , fn) replace:false
]
] ifFalse:[
self
doExecuteCommand:('cvs commit -l -m ''' , log , '''') replace:false
].
]
"Modified: / 16.12.1998 / 17:30:31 / cg"
!
cvsRemoveFileAndContainer
"remove the selected file(s) and their CVS containers.
Query if user really wants to really remove them."
|sel q|
sel := fileListView selection.
sel size > 0 ifTrue:[
sel := sel collect:[:rawIndex | fileList at:rawIndex].
sel size > 1 ifTrue:[
q := resources string:'Remove %1 selected files and their CVS containers ?' with:(sel size)
] ifFalse:[
q := resources string:'Remove ''%1'' and its CVS container ?' with:(sel first allBold)
].
(self sensor shiftDown
or:[self ask:q yesButton:'remove']) ifTrue:[
self withCursor:(Cursor wait) do:[
self doRemoveAndRemoveFromCVS:sel
]
]
]
"Modified: / 16.12.1998 / 17:30:31 / cg"
!
cvsUpdateDirectoryLocal
"update this directory"
self
doExecuteCommand:'cvs upd -l' replace:false
"Modified: / 16.12.1998 / 17:30:31 / cg"
!
cvsUpdateDirectoryRecursive
"update this directory"
self
doExecuteCommand:'cvs upd -d' replace:false
"Modified: / 16.12.1998 / 17:30:31 / cg"
!
cvsUpdateSelection
"update selected files"
|sel|
sel := fileListView selection.
sel size > 0 ifTrue:[
sel := sel collect:[:rawIndex | fileList at:rawIndex].
sel do:[:fn |
self
doExecuteCommand:('cvs upd ' , fn) replace:false
]
].
!
doRemoveAndRemoveFromCVS:filesToRemove
"remove the selected file(s) and their CVS containers - no questions asked"
|msg idx needUpdate toRemove updateRunning yesToAll|
updateRunning := listUpdateProcess notNil.
self stopUpdateProcess.
toRemove := OrderedCollection new.
"/
"/ did the directory change in the meanwhile ?
"/
needUpdate := (currentDirectory modificationTime > timeOfLastCheck).
yesToAll := false.
lockUpdate := true.
[
filesToRemove do:[:fileName |
|f|
f := currentDirectory construct:fileName.
OperatingSystem accessDeniedErrorSignal handle:[:ex|
"was not able to remove it"
msg := (resources string:'cannot remove ''%1'' !!' with:fileName).
self showAlert:msg with:(OperatingSystem lastErrorString)
] do:[
|answer contents|
(f isSymbolicLink not) ifTrue:[
self
doExecuteCommand:('cvs remove -f ' , f baseName)
replace:false.
"
self show:nil
"
idx := fileList indexOf:fileName.
idx ~~ 0 ifTrue:[
toRemove add:idx.
]
]
].
].
] valueNowOrOnUnwindDo:[
lockUpdate := false.
fileListView setSelection:nil.
"/
"/ remove reverse - otherwise indices are wrong
"/
toRemove sort.
toRemove reverseDo:[:idx |
fileList removeIndex:idx.
fileListView removeIndex:idx.
].
updateRunning ifTrue:[
self updateCurrentDirectory
] ifFalse:[
"
install a new check after some time
"
needUpdate ifFalse:[timeOfLastCheck := AbsoluteTime now].
Processor removeTimedBlock:checkBlock.
Processor addTimedBlock:checkBlock afterSeconds:checkDelta.
]
].
self
doExecuteCommand:('cvs commit -m ''removed via FileBrowser''')
replace:false.
"Modified: / 21.10.1998 / 17:02:11 / cg"
! !
!FileBrowser methodsFor:'misc user interaction'!
closeRequest
"exit FileBrowser"
(self askIfModified:'contents has not been saved.\\Modifications will be lost when FileBrowser is closed.'
yesButton:'close')
ifTrue:[
"/ self windowGroup closeDownViews.
super closeRequest
]
"Created: / 3.8.1998 / 19:55:06 / cg"
"Modified: / 4.8.1998 / 18:21:03 / cg"
!
discardChangesDialog
"ask the user if changes should be discarded,
return true if changes should be discarded, false otherwise"
^ self askIfModified:'contents has not been saved.\\Modifications will be lost when directory is changed.'
yesButton:'change'
"Created: 2.10.1997 / 14:08:37 / stefan"
!
filterPatternChanged
fileListView scrollToTop.
fileListView deselect.
self updateCurrentDirectory
"Modified: / 3.10.1998 / 18:23:34 / cg"
!
update:what with:someArgument from:changedObject
realized ifFalse:[^ self].
(what == #aboutToExit) ifTrue:[
"system wants to shut down this
- if text was modified, pop up, and ask user and save if requested."
(subView modified and:[subView contentsWasSaved not]) ifTrue:[
self raiseDeiconified.
(self
ask:(resources at:'FileBrowser:\\contents has not been saved.\\Save before exiting ?')
yesButton:'save'
noButton:'don''t save')
ifTrue:[
subView acceptAction notNil ifTrue:[
subView accept
] ifFalse:[
subView save
]
]
].
^ self
].
changedObject == tabSpec ifTrue:[
fileListView invalidate
].
"Modified: 29.5.1996 / 16:13:43 / cg"
! !
!FileBrowser methodsFor:'pathField user interaction'!
addDirToJavaClassPath
"add the current path to javas classPath
(only available with ST/J System"
Java addToClassPath:currentDirectory pathName
"Modified: 14.12.1996 / 15:37:47 / cg"
"Created: 1.8.1997 / 21:25:22 / cg"
!
addDirToJavaSourcePath
"add the current path to javas sourcePath
(only available with ST/J System"
Java addToSourcePath:currentDirectory pathName
"Modified: 14.12.1996 / 15:37:47 / cg"
"Created: 2.8.1997 / 14:11:19 / cg"
!
changeCurrentDirectory
"if text was modified show a queryBox,
otherwise ask for & change to that directory"
self discardChangesDialog ifTrue:[
self queryForDirectoryToChange
]
"Modified: 21.9.1997 / 23:45:35 / cg"
"Modified: 2.10.1997 / 14:09:02 / stefan"
!
changeDirectoryTo:aDirectoryName
"sent from label menu to change back to a previous directory"
self discardChangesDialog ifTrue:[
self doChangeCurrentDirectoryTo:aDirectoryName updateHistory:true "/false.
].
"Modified: / 2.10.1997 / 14:09:24 / stefan"
"Modified: / 21.7.1998 / 16:38:03 / cg"
!
changeToDefaultDirectory
"if text was modified show a queryBox,
otherwise change immediately to the default directory"
self discardChangesDialog ifTrue:[
self doChangeToDefaultDirectory
]
"Modified: 21.9.1997 / 23:45:04 / cg"
"Modified: 2.10.1997 / 14:09:33 / stefan"
!
changeToHomeDirectory
"if text was modified show a queryBox,
otherwise change immediately to the home directory"
self discardChangesDialog ifTrue:[
self doChangeToHomeDirectory
]
"Modified: 21.9.1997 / 23:45:10 / cg"
"Modified: 2.10.1997 / 14:09:42 / stefan"
!
changeToParentDirectory
"if text was modified show a queryBox,
otherwise change immediately to the parent directory"
self discardChangesDialog ifTrue:[
self doChangeToParentDirectory
]
"Modified: 21.9.1997 / 23:45:15 / cg"
"Modified: 2.10.1997 / 14:09:55 / stefan"
!
copyPath
"copy current path into cut & paste buffer"
self setTextSelection:currentDirectory pathName
"Modified: 14.12.1996 / 15:37:47 / cg"
!
fileAddToJavaClassPath
"add the current path to javas classPath
(only available with ST/J System"
|f|
f := self getSelectedFileName.
f isNil ifTrue:[
^ self addDirToJavaClassPath
].
f := currentDirectory asFilename construct:f.
Java addToClassPath:(f pathName)
"Created: / 9.11.1998 / 05:41:34 / cg"
"Modified: / 9.11.1998 / 05:56:00 / cg"
!
fileAddToJavaSourcePath
"add the current path to javas sourcePath
(only available with ST/J System"
|f|
f := self getSelectedFileName.
f isNil ifTrue:[
^ self addDirToJavaSourcePath
].
f := currentDirectory asFilename construct:f.
Java addToSourcePath:(f pathName)
"Created: / 9.11.1998 / 05:41:34 / cg"
"Modified: / 9.11.1998 / 05:56:00 / cg"
!
fileRemoveFromJavaClassPath
"remove the current path from javas classPath
(only available with ST/J System"
|f|
f := self getSelectedFileName.
f isNil ifTrue:[
^ self removeDirFromJavaClassPath
].
f := currentDirectory asFilename construct:f.
Java removeFromClassPath:(f pathName)
"Created: / 9.11.1998 / 05:42:05 / cg"
"Modified: / 9.11.1998 / 05:56:14 / cg"
!
fileRemoveFromJavaSourcePath
"remove the current path from javas sourcePath
(only available with ST/J System"
|f|
f := self getSelectedFileName.
f isNil ifTrue:[
^ self removeDirFromJavaSourcePath
].
f := currentDirectory asFilename construct:f.
Java removeFromSourcePath:(f pathName)
"Created: / 9.11.1998 / 05:42:05 / cg"
"Modified: / 9.11.1998 / 05:56:14 / cg"
!
labelMenu
"return the popUpMenu for the path label"
<resource: #programMenu>
|m|
m := self class directoryMenuSpec.
m menuPerformer:self.
^ m
"Modified: / 14.8.1998 / 12:11:16 / cg"
!
labelMenu_old
"return the popUpMenu for the path label"
<resource: #programMenu>
|items menu currentIndex|
items := #(
('copy path' copyPath )
('-' )
('up' changeToParentDirectory )
('back' changeToPreviousDirectory )
('change to home-directory' changeToHomeDirectory )
('change to default-directory' changeToDefaultDirectory )
('change directory ...' changeCurrentDirectory )
).
(JavaClassReader notNil and:[JavaClassReader isLoaded]) ifTrue:[
items := items , #(
( '-')
( 'add to JavaClassPath' addDirToJavaClassPath)
( 'add to JavaSourcePath' addDirToJavaSourcePath)
( 'remove from JavaClassPath' removeDirFromJavaClassPath)
( 'remove from JavaSourcePath' removeDirFromJavaSourcePath)
).
].
DirectoryHistory size > 0 ifTrue:[
items := items copyWith:#('-').
items := items ,
(DirectoryHistory
collect:[:dirName |
Array
with:dirName
with:#changeDirectoryTo:
with:nil
with:dirName
]
).
currentIndex := items findFirst:[:i | (i at:1) = currentDirectory pathName].
currentIndex == 0 ifTrue:[currentIndex := nil].
].
menu := PopUpMenu
itemList:items
resources:resources.
previousDirectory isNil ifTrue:[
menu disable:#changeToPreviousDirectory.
].
currentIndex notNil ifTrue:[
menu disable:currentIndex
].
(JavaClassReader notNil and:[JavaClassReader isLoaded]) ifTrue:[
(Java classPath includes:currentDirectory pathName) ifTrue:[
menu disable:#addDirToJavaClassPath
] ifFalse:[
menu disable:#removeDirFromJavaClassPath
].
(Java sourcePath includes:currentDirectory pathName) ifTrue:[
menu disable:#addDirToJavaSourcePath
] ifFalse:[
menu disable:#removeDirFromJavaSourcePath
].
].
^menu.
"Modified: / 21.7.1998 / 16:43:25 / cg"
"Created: / 14.8.1998 / 12:10:02 / cg"
!
pathChanged:newPath
"change directory to newPath. If newPath is a filename, change
to its directory and get get the file."
|f name lcName idx|
self discardChangesDialog ifTrue:[
f := newPath asFilename.
(f isDirectory) ifTrue:[
self changeDirectoryTo:newPath
] ifFalse:[
self changeDirectoryTo:(f directoryName).
"/ self changed:#path.
name := f baseName.
idx := fileList indexOf:name.
idx = 0 ifTrue:[
lcName := name asLowercase.
f class isCaseSensitive ifFalse:[
idx := fileList findFirst:[:nm | nm asLowercase = lcName].
]
].
fileListView selection:idx.
self fileSelect:name.
self fileGet:true.
].
] ifFalse:[
self changed:#path.
].
"Created: / 21.9.1997 / 10:43:12 / cg"
"Modified: / 7.10.1997 / 14:10:39 / stefan"
"Modified: / 30.4.1999 / 11:19:29 / cg"
!
queryForDirectoryToChange
"query for new directory"
|queryBox dirName|
queryBox := FilenameEnterBox
title:(resources at:'change directory to:') withCRs
okText:(resources at:'change')
action:[:newName | dirName := newName].
"/ queryBox initialText:''.
queryBox showAtPointer.
queryBox destroy.
self doChangeCurrentDirectoryTo:dirName updateHistory:true.
"Modified: 28.4.1997 / 19:50:52 / cg"
"Modified: 28.4.1997 / 22:30:40 / dq"
!
removeDirFromJavaClassPath
"remove the current path from javas classPath
(only available with ST/J System"
Java removeFromClassPath:currentDirectory pathName
"Modified: 14.12.1996 / 15:37:47 / cg"
"Created: 1.8.1997 / 21:25:36 / cg"
!
removeDirFromJavaSourcePath
"remove the current path from javas sourcePath
(only available with ST/J System"
Java removeFromSourcePath:currentDirectory pathName
"Modified: 14.12.1996 / 15:37:47 / cg"
"Created: 2.8.1997 / 14:11:41 / cg"
! !
!FileBrowser methodsFor:'private'!
ask:question yesButton:yesButtonText
"common method to ask a yes/no question; return true or false"
^ self ask:question yesButton:yesButtonText noButton:'cancel'
!
ask:question yesButton:yesButtonText noButton:noButtonText
"common method to ask a yes/no question"
^ Dialog
confirm:question withCRs
yesLabel:(resources at:yesButtonText)
noLabel:(resources at:noButtonText)
"Modified: 21.2.1996 / 01:19:21 / cg"
!
askForCommandFor:fileName thenDo:aBlock
"setup and launch a querybox to ask for unix command.
Then evaluate aBlock passing the command-string as argument."
|box osName|
osName := OperatingSystem platformName.
box := FilenameEnterBox
title:(resources string:'execute %1 command:' with:osName)
okText:(resources string:'execute')
action:aBlock.
fileName notNil ifTrue:[
self initialCommandFor:fileName into:box.
].
box directory:currentDirectory.
box showAtPointer.
box destroy.
"Modified: / 7.9.1995 / 10:31:54 / claus"
"Modified: / 16.9.1997 / 15:35:10 / stefan"
"Modified: / 14.8.1998 / 14:12:52 / cg"
!
askIfModified:question yesButton:yesButtonText
"tell user, that code has been modified - let her confirm"
(subView modified not or:[subView contentsWasSaved]) ifTrue:[
^ true
].
(self ask:(resources string:question) yesButton:yesButtonText) ifTrue:[
"/ reset modified flag so question is asked only once
subView modified:false.
^ true
].
^ false
"Modified: 2.10.1997 / 14:23:47 / stefan"
!
getSelectedFileName
"returns the currently selected file; shows an error if
multiple files are selected"
|sel|
sel := fileListView selection.
(sel size > 1) ifTrue:[
self onlyOneSelection
] ifFalse:[
sel size > 0 ifTrue:[
^ fileList at:sel first ifAbsent:nil
]
].
^ nil
"Modified: / 3.10.1998 / 18:21:23 / cg"
!
onlyOneSelection
"show a warning, that only one file must be selected for
this operation"
self warn:'exactly one file must be selected !!'
!
selectFile:aFilename
(currentDirectory filenameFor:aFilename) exists ifTrue:[
fileListView selection:(fileList indexOf:aFilename).
self fileDoubleClick:fileListView selection.
].
!
selectedFilesDo:aBlock
"evaluate aBlock on all selected files;
show a wait cursor while doing this"
|sel action|
sel := fileListView selection.
sel notNil ifTrue:[
sel := sel collect:[:aSelectionIndex |
|nm|
nm := fileList at:aSelectionIndex ifAbsent:nil.
nm notNil ifTrue:[
nm := nm string.
(nm endsWith:' ...') ifTrue:[
nm := (nm copyWithoutLast:4) withoutSpaces
].
].
nm
].
action := [
sel do:[:nm |
nm notNil ifTrue:[
aBlock value:nm
]
]
].
Processor activeProcess == self windowGroup process ifTrue:[
self withWaitCursorDo:action
] ifFalse:[
action value
]
]
"Modified: / 16.12.1998 / 17:30:57 / cg"
!
show:something
"show something in subview and undef acceptAction"
subView contents:something.
subView acceptAction:nil.
subView modified:false.
currentFileName := nil
!
showAlert:aString with:anErrorString
"show an alertbox, displaying the last Unix-error"
|msg|
anErrorString isNil ifTrue:[
msg := aString
] ifFalse:[
msg := aString , '\\(' , anErrorString , ')'
].
self warn:msg withCRs
!
withoutHiddenFiles:aCollection
"remove hidden files (i.e. those that start with '.') from
the list in aCollection"
|newCollection|
newCollection := aCollection species new.
aCollection do:[:fname |
|ignore|
ignore := false.
((fname startsWith:'.') and:[fname ~= '..']) ifTrue:[
showingHiddenFiles value "showDotFiles" ifFalse:[
ignore := true
]
].
ignore ifFalse:[
newCollection add:fname
]
].
^ newCollection
"Modified: / 4.8.1998 / 13:46:27 / cg"
! !
!FileBrowser methodsFor:'private - actions & command execution'!
binaryFileAction:aFilename
"for some binary files, if double clicked, we can do some useful
action ..."
|cmd|
(aFilename asFilename hasSuffix:'pdf') ifTrue:[
DefaultCommandPerMIME isNil ifTrue:[
self class initializeDefaultCommands
].
cmd := DefaultCommandPerMIME at:'application/pdf' ifAbsent:nil.
cmd notNil ifTrue:[
(OperatingSystem executeCommand:(cmd bindWith:aFilename) inDirectory:currentDirectory pathName)
ifTrue:[^true].
].
].
(currentDirectory construct:aFilename) isExecutableProgram ifTrue:[
(OperatingSystem executeCommand:aFilename inDirectory:currentDirectory pathName)
ifTrue:[^true].
].
^ self imageAction:aFilename
"Modified: 19.6.1996 / 09:44:07 / cg"
"Modified: 18.9.1997 / 17:18:04 / stefan"
!
doExecuteCommand:commandArg replace:replace
"execute a unix command inserting the output of the command.
If replace is true, all text is replaced by the commands output;
otherwise, its inserted as selected text at the cursor position."
|command stream line lnr myProcess myPriority startLine startCol stopSignal
pauseSignal access stillReplacing pauseHolder lowerFrameView
buttonWindowGroup|
command := commandArg asString.
access := Semaphore forMutualExclusion name:'accessLock'.
stopSignal := Signal new.
pauseSignal := Signal new.
"
The following is tricky:
the pauseToggle & killButton will
be handled by their own windowGroup process.
This means, that they respond to events even though
I myself am reading the commands output.
"
commandView beInvisible.
"
must take kill & pauseButtons out of my group
"
killButton windowGroup:nil.
pauseToggle windowGroup:nil.
"
bring them to front, and turn hidden-mode off
"
killButton raise; beVisible.
pauseToggle raise; beVisible.
"
kill will make me raise the stopSignal when pressed
"
killButton
action:[
stream notNil ifTrue:[
access critical:[
myProcess interruptWith:[stopSignal raiseRequest].
]
]
].
"
pause makes me stop reading the commands output
"
pauseHolder := false asValue.
pauseToggle model:pauseHolder.
pauseToggle pressAction:[
stream notNil ifTrue:[
access critical:[
myProcess interruptWith:[pauseSignal raiseRequest].
]
]
].
"
start kill button under its own windowgroup
"
killButton openAutonomous.
buttonWindowGroup := killButton windowGroup.
buttonWindowGroup process name:'FileBrowser sub'.
buttonWindowGroup process processGroupId:(Processor activeProcess id).
"
and add the pauseToggle to its windowGroup
"
pauseToggle windowGroup:buttonWindowGroup.
lowerFrameView := subView superView.
"
go fork a pipe and read it
"
self label:(myName , ': executing ' , (command copyTo:(20 min:command size)) , ' ...').
[
self withWaitCursorDo:[
stopSignal catch:[
pauseSignal handle:[:ex|
|noPauseSema|
"/
"/ allow interaction with
"/ the codeView via the other windowGroup
"/
lowerFrameView windowGroup:buttonWindowGroup.
"/
"/ wait for pause to be turned off
"/
noPauseSema := Semaphore new.
pauseHolder onChangeSend:#signal to:noPauseSema.
noPauseSema wait.
"/
"/ no interaction with the codeView ...
"/
lowerFrameView windowGroup:(self windowGroup).
ex proceed.
] do:[
startLine := subView cursorLine.
startCol := subView cursorCol.
"
this can be a time consuming operation; therefore lower my priority
"
myProcess := Processor activeProcess.
"/ myPriority := myProcess priority.
"/ myProcess priority:(Processor userBackgroundPriority).
stream := PipeStream
readingFrom:command
errorDisposition:#inline
inDirectory:currentDirectory.
stream notNil ifTrue:[
[
|codeView lines noPauseSema enc|
enc := fileEncoding.
enc == #iso8859 ifTrue:[
enc := nil
].
stream buffered:true.
codeView := subView.
codeView unselect.
replace ifTrue:[
codeView list:nil.
lnr := 1.
].
stillReplacing := replace.
[stream readWait. stream atEnd] whileFalse:[
"
data available; read up to 100 lines
and insert as a single junk. This speeds up
display of long output (less line-scrolling).
"
lines := OrderedCollection new:100.
[
line := stream nextLine.
line notNil ifTrue:[
enc notNil ifTrue:[
line := line decodeFrom:enc
].
lines add:line
].
] doWhile:[
stream canReadWithoutBlocking
and:[stream atEnd not
and:[lines size < 100]]
].
"
need this critical section; otherwise,
we could get the signal while waiting for
an expose event ...
"
access critical:[
lines size > 0 ifTrue:[
stillReplacing ifTrue:[
lines do:[:line |
codeView at:lnr put:line withTabsExpanded.
codeView cursorToBottom; cursorDown:1.
lnr := lnr + 1.
lnr > codeView list size ifTrue:[
stillReplacing := false
]
].
] ifFalse:[
codeView insertLines:lines before:codeView cursorLine.
codeView cursorDown:lines size.
]
].
].
"
give others running at same prio a chance too
(especially other FileBrowsers doing the same)
"
Processor yield
].
] valueNowOrOnUnwindDo:[
stream shutDown "close". stream := nil.
].
"/
"/ the command could have changed the directory
"/
self updateCurrentDirectoryIfChanged
].
replace ifTrue:[
subView modified:false.
].
]
]
]
] valueNowOrOnUnwindDo:[
|wg|
self label:myName; iconLabel:myName.
"/ myProcess notNil ifTrue:[myProcess priority:myPriority].
"
hide the button, and make sure it will stay
hidden when we are realized again
"
killButton beInvisible.
pauseToggle beInvisible.
commandView beVisible.
"
remove the killButton from its group
(otherwise, it will be destroyed when we shut down the group)
"
wg := killButton windowGroup.
killButton windowGroup:nil.
pauseToggle windowGroup:nil.
"
shut down the kill buttons windowgroup
"
wg notNil ifTrue:[
wg process terminate.
].
"
clear its action (actually not needed, but
releases reference to thisContext earlier)
"
killButton action:nil.
pauseToggle pressAction:nil.
"/
"/ allow interaction with the codeView
"/ (bring it back into my group)
"/
lowerFrameView windowGroup:(self windowGroup).
].
currentFileName isNil ifTrue:[
subView modified:false.
].
subView size > 10000 ifTrue:[
self warn:'text quite large now - please cut off some lines'
]
"Modified: / 21.9.1995 / 11:18:46 / claus"
"Modified: / 6.3.1998 / 17:32:03 / stefan"
"Modified: / 15.10.1998 / 12:37:52 / cg"
!
imageAction:aFilename
"for some image files, if double clicked, we can do some useful
action ..."
|img errmsg|
(Image isImageFileSuffix:(aFilename asFilename suffix))
ifTrue:[
Image imageLoadErrorSignal handle:[:ex |
errmsg := ex errorString
] do:[
img := Image fromFile:(currentDirectory construct:aFilename).
].
img notNil ifTrue:[
ImageEditor openOnImage:img.
"/ img inspect.
^ true
].
errmsg notNil ifTrue:[
self warn:errmsg.
]
].
^ false
"Created: / 19.6.1996 / 09:43:50 / cg"
"Modified: / 18.9.1997 / 16:35:48 / stefan"
"Modified: / 18.5.1999 / 15:45:06 / cg"
!
initialCommandFor:fileName into:aBox
"set a useful initial command for execute box."
|mime cmd select path suffix|
path := currentDirectory filenameFor:fileName.
mime := MIMETypes mimeTypeForSuffix:fileName asFilename suffix.
"/ mime notNil ifTrue:[
"/ cmd := self initialCommandForMIME:mime file:path
"/ ].
"/ XXX should be changed to take stuff from a config file
"/ XXX or from resources.
(path type == #regular) ifTrue:[
path isExecutableProgram ifTrue:[
aBox initialText:(fileName , ' <arguments>').
^ self
].
select := true.
"some heuristics - my personal preferences ...
(actually this should come from a configfile)"
(fileName endsWith:'akefile') ifTrue:[
aBox initialText:'make target' selectFrom:6 to:11.
^ self
].
DefaultCommandPerMIME isNil ifTrue:[
self class initializeDefaultCommands
].
cmd := DefaultCommandPerMIME at:mime ifAbsent:nil.
cmd notNil ifTrue:[
select := false
].
cmd isNil ifTrue:[
suffix := path suffix.
(suffix = 'C') ifTrue:[
cmd := 'g++ -c %1'.
select := 6.
] ifFalse:[
suffix := suffix asLowercase.
(suffix = 'taz') ifTrue:[
aBox initialText:'zcat %1 | tar tvf -'.
select := false.
].
(suffix = 'tar') ifTrue:[
cmd := 'tar tvf %1'.
select := 7.
].
(suffix = 'zoo') ifTrue:[
cmd := 'zoo -list %1'.
select := 9.
].
(suffix = 'zip') ifTrue:[
cmd := 'unzip -l %1'.
select := 8.
].
(suffix = 'jar') ifTrue:[
cmd := 'unzip -l %1'.
select := 8.
].
(suffix = 'z') ifTrue:[
(fileName asLowercase endsWith:'tar.z') ifTrue:[
cmd := 'zcat %1 | tar tvf -'.
select := false.
] ifFalse:[
cmd := 'uncompress %1'
].
].
(suffix = 'gz') ifTrue:[
(fileName asLowercase endsWith:'tar.gz') ifTrue:[
cmd := ('gunzip < %1 | tar tvf -' ).
select := false.
] ifFalse:[
cmd := 'gunzip %1'.
].
].
(suffix = 'html') ifTrue:[
cmd := 'netscape %1'
].
(suffix = 'htm') ifTrue:[
cmd := 'netscape %1'
].
(suffix = 'uue') ifTrue:[
cmd := 'uudecode %1'
].
(suffix = 'c') ifTrue:[
cmd := 'cc -c %1'.
select := 5.
].
(suffix = 'cc') ifTrue:[
cmd := 'g++ -c %1'.
select := 6.
].
(suffix = 'xbm') ifTrue:[
cmd := 'bitmap %1'
].
(suffix = 'ps') ifTrue:[
cmd := 'ghostview %1'
].
((suffix = '1') or:[suffix = 'man']) ifTrue:[
cmd := 'nroff -man %1'.
select := 10.
].
].
].
cmd isNil ifTrue:[
DefaultCommandPerSuffix isNil ifTrue:[
cmd := '<cmd>'
] ifFalse:[
cmd := DefaultCommandPerSuffix
at:suffix
ifAbsent:'<cmd>'.
].
cmd := cmd , ' %1'.
].
cmd := cmd bindWith:fileName.
select == false ifTrue:[
aBox initialText:cmd
] ifFalse:[
select class == Interval ifTrue:[
aBox initialText:cmd selectFrom:select start to:select stop
] ifFalse:[
select isInteger ifFalse:[
select := (cmd indexOf:Character space ifAbsent:[cmd size + 1]) - 1.
].
aBox initialText:cmd selectFrom:1 to:select
].
]
]
"Modified: / 24.9.1997 / 16:34:52 / stefan"
"Modified: / 9.4.1998 / 17:15:57 / cg"
!
nonBinaryFileAction:aFilename
"for some nonBinary files, if double clicked, we can do some useful
action ..."
|fullPath|
fullPath := currentDirectory filenameFor:aFilename.
((fullPath hasSuffix:'htm')
or:[(fullPath hasSuffix:'HTM')
or:[(fullPath hasSuffix:'html')
or:[(fullPath hasSuffix:'HTML')]]]) ifTrue:[
HTMLDocumentView openOn:fullPath pathName.
^ true
].
((fullPath hasSuffix:'prj')
and:[ProjectBrowser notNil]) ifTrue:[
ProjectBrowser openOnFile:fullPath pathName.
^ true
].
OperatingSystem isUNIXlike ifTrue:[
(#('.man' '.1' '.2' '.3') findFirst:[:suff | fullPath hasSuffix:suff]) ~~ 0
ifTrue:[
HTMLDocumentView openFullOnText:(HTMLDocGenerator manPageForFile:fullPath pathName).
^ true
].
].
^ self imageAction:aFilename
"Created: 19.6.1996 / 09:36:38 / cg"
"Modified: 4.4.1997 / 10:49:00 / cg"
"Modified: 18.9.1997 / 16:58:40 / stefan"
! !
!FileBrowser methodsFor:'private - directory stuff'!
addToHistory:path
self class addToHistory:path
!
changeToPreviousDirectory
"if text was modified show a queryBox,
otherwise change immediately to previous directory."
previousDirectory isNil ifTrue:[^ self].
self discardChangesDialog ifTrue:[
self doChangeCurrentDirectoryTo:previousDirectory updateHistory:false
]
"Modified: 2.10.1997 / 14:13:40 / stefan"
!
checkIfDirectoryHasChanged
"every checkDelta secs, check if directoy has changed and update the list if so.
Also, we check if the file shown has been touched in the meanwhile (for example,
from another browser) and say 'outdated' in the label if so.
This avoids confusion if the same file is being edited by two browsers. (or other editors).
If the text shown in the codeView has been edited, 'modified' is shown.
"
|oldSelection nOld newState msg newLabel t|
shown ifTrue:[
currentDirectory notNil ifTrue:[
(lockUpdate or:[doAutoUpdate value not]) ifTrue:[
Processor removeTimedBlock:checkBlock.
Processor addTimedBlock:checkBlock afterSeconds:checkDelta.
^ self
].
subView modified ifTrue:[
newState := ' (modified)'
].
(currentDirectory isReadable) ifTrue:[
Processor removeTimedBlock:checkBlock.
t := currentDirectory modificationTime.
(t notNil and:[t > timeOfLastCheck]) ifTrue:[
nOld := fileListView numberOfSelections.
oldSelection := fileListView selectionValue.
self updateCurrentDirectory.
nOld ~~ 0 ifTrue:[
nOld > 1 ifTrue:[
oldSelection do:[:element |
fileListView addElementToSelection:element
]
] ifFalse:[
fileListView selectElementWithoutScroll:oldSelection
]
].
] ifFalse:[
Processor addTimedBlock:checkBlock afterSeconds:checkDelta
].
currentFileName notNil ifTrue:[
|f|
f := currentDirectory construct:currentFileName.
f exists ifFalse:[
newState := ' (removed)'.
] ifTrue:[
f modificationTime > timeOfFileRead ifTrue:[
newState := ' (outdated)'.
subView modified ifTrue:[
newState := ' (modified & outdated)'
]
].
].
].
] ifFalse:[
"
if the directory has been deleted, or is not readable ...
"
(currentDirectory exists) ifFalse:[
msg := 'FileBrowser:\\directory %1 is gone ?!!?'
] ifTrue:[
msg := 'FileBrowser:\\directory %1 is no longer readable ?!!?'
].
self warn:(resources string:msg with:currentDirectory pathName) withCRs.
fileListView contents:nil.
newLabel := myName , ': directory is gone !!'.
"/ Processor addTimedBlock:checkBlock afterSeconds:checkDelta
].
newState notNil ifTrue:[
newLabel := myName.
currentFileName notNil ifTrue:[
newLabel := newLabel , ': ' , currentFileName
].
newLabel := newLabel , newState.
].
newLabel notNil ifTrue:[
self label:newLabel.
]
]
]
"Modified: / 28.4.1997 / 22:31:02 / dq"
"Modified: / 16.9.1997 / 15:17:15 / stefan"
"Modified: / 18.2.1998 / 17:57:49 / cg"
!
doChangeCurrentDirectoryTo:fileName updateHistory:updateHistory
"verify argument is name of a readable & executable directory
and if so, go there"
|msg path idx f|
self label:myName; iconLabel:myName.
fileName notNil ifTrue:[
(f := fileName asFilename) isAbsolute ifFalse:[
f := currentDirectory filenameFor:fileName.
].
f := f asAbsoluteFilename.
(f isDirectory) ifTrue:[
(f isReadable) ifTrue:[
(f isExecutable) ifTrue:[
path := currentDirectory pathName.
previousDirectory := path.
"
remember where we are positioned in the fileList
(in case we want to return)
"
idx := DirectoryHistory indexOf:path.
idx ~~ 0 ifTrue:[
DirectoryHistoryWhere at:idx put:fileListView firstLineShown
].
updateHistory ifTrue:[
self addToHistory:path.
].
self setCurrentDirectory:(f pathName).
"/ fetch the new path.
path := currentDirectory pathName.
"
if we have already been there, look for the
position offset, and scroll the fileList
"
idx := DirectoryHistory indexOf:path.
idx ~~ 0 ifTrue:[
|pos|
pos := DirectoryHistoryWhere at:idx.
pos notNil ifTrue:[
fileListView scrollToLine:pos.
]
].
updateHistory ifTrue:[
self addToHistory:path.
].
^ self
].
msg := 'cannot change directory to ''%1'' !!'
] ifFalse:[
msg := 'cannot read directory ''%1'' !!'
]
] ifFalse:[
OperatingSystem isVMSlike ifTrue:[
"/ cannot tell if it exists or is simply invisible ...
msg := '''%1'' is not a directory or unreadable !!'
] ifFalse:[
msg := '''%1'' is not a directory !!'
]
].
Dialog warn:(resources string:msg withCRs with:fileName).
]
"Modified: / 18.9.1997 / 18:22:30 / stefan"
"Modified: / 27.4.1999 / 17:10:14 / cg"
!
doChangeToDefaultDirectory
"go to parent directory"
self doChangeCurrentDirectoryTo:(Filename currentDirectory pathName) updateHistory:true
"Created: 21.9.1997 / 23:45:59 / cg"
!
doChangeToHomeDirectory
"go to home directory"
self doChangeCurrentDirectoryTo:(OperatingSystem getHomeDirectory) updateHistory:true
!
doChangeToParentDirectory
"go to parent directory"
self doChangeCurrentDirectoryTo:'..' updateHistory:true
!
doCreateDirectory:newName
|f|
f := currentDirectory filenameFor:newName.
f exists ifTrue:[
self warn:'%1 already exists.' with:newName.
^ self
].
f makeDirectory ifTrue:[
self updateCurrentDirectory
] ifFalse:[
self showAlert:(resources string:'cannot create directory ''%1'' !!' with:newName)
with:(OperatingSystem lastErrorString)
]
"Modified: / 18.9.1997 / 17:21:25 / stefan"
"Modified: / 30.1.1999 / 16:24:12 / cg"
!
setCurrentDirectory:aPathName
"setup for another directory"
|newDirectory|
aPathName isEmpty ifTrue:[^ self].
newDirectory := currentDirectory filenameFor:aPathName.
newDirectory isDirectory ifTrue:[
self currentDirectory:newDirectory.
currentFileName notNil ifTrue:[
fileListView contents:nil.
currentFileName := nil.
] ifFalse:[
fileListView setSelection:nil.
fileListView scrollToTop.
].
self updateCurrentDirectory.
self showInfo.
]
"Modified: 21.9.1995 / 11:22:45 / claus"
"Modified: 25.5.1996 / 12:27:01 / cg"
"Modified: 18.9.1997 / 17:08:07 / stefan"
!
updateCurrentDirectoryIfChanged
|t|
OperatingSystem isMSDOSlike ifTrue:[
"/ workaround: DOS has no directory modifiation time ...
self updateCurrentDirectory.
^ self
].
((t := currentDirectory modificationTime) isNil
or:[t > timeOfLastCheck]) ifTrue:[
self updateCurrentDirectory
]
"Modified: / 16.9.1997 / 15:35:52 / stefan"
"Modified: / 16.12.1998 / 22:55:44 / cg"
! !
!FileBrowser methodsFor:'private - encoding'!
guessEncodingFrom:aBuffer
"look for a string
encoding #name
or:
encoding: name
within the given buffer
(which is usually the first few bytes of a textFile).
If thats not found, use heuristics (in CharacterArray) to guess."
|n "{Class: SmallInteger }"
binary idx s w enc|
binary := false.
n := aBuffer size.
(idx := aBuffer findString:'charset=') ~~ 0 ifTrue:[
s := ReadStream on:aBuffer.
s position:idx + 8.
s skipSeparators.
w := s upToSeparator.
w notNil ifTrue:[
(idx := w indexOf:$") ~~ 0 ifTrue:[
w := w copyTo:idx-1
].
^ w asSymbol
].
].
(idx := aBuffer findString:'encoding') ~~ 0 ifTrue:[
s := ReadStream on:aBuffer.
s position:idx + 8.
s skipSeparators.
s peek == $: ifTrue:[
s next.
s skipSeparators.
].
s peek == $# ifTrue:[
s next.
s skipSeparators.
].
w := s upToSeparator.
w notNil ifTrue:[
^ w asSymbol
].
].
1 to:n do:[:i |
(aBuffer at:i) isPrintable ifFalse:[binary := true].
].
binary ifTrue:[
"/ look for JIS7 / EUC encoding
enc := CharacterArray guessEncodingFrom:aBuffer.
enc notNil ifTrue:[
^ enc
].
"/ if the encoding has been set to any non iso setting,
"/ assume its what we defined ...
(('iso*' match:fileEncoding) or:['ascii*' match:fileEncoding]) ifTrue:[
^ #binary
].
^ fileEncoding ? #binary
].
^ #ascii
"Created: 26.2.1996 / 17:43:08 / cg"
"Modified: 1.7.1997 / 00:00:27 / cg"
!
preferredFontEncodingFor:fileEncoding
"given a file encoding, return corresponding preferred fontEncoding
match pattern"
|fe|
fe := MIMETypes fontForCharset:fileEncoding.
fe notNil ifTrue:[^ fe].
^ 'iso8859*'
"Created: 28.6.1997 / 20:47:35 / cg"
"Modified: 1.7.1997 / 00:04:56 / cg"
!
validateFontEncodingFor:newEncoding ask:ask
"if required, query user if he/she wants to change to another font,
which is able to display text encoded as specified by newEncoding"
|fontsEncoding msg filter f defaultFont pref|
fontsEncoding := subView font encoding.
pref := self preferredFontEncodingFor:newEncoding.
(pref match:fontsEncoding) ifTrue:[
^ self
].
"/ stupid ...
pref = 'ascii*' ifTrue:[
(fontsEncoding match:'iso8859*') ifTrue:[
^ self
]
].
filter := [:f | |coding|
(coding := f encoding) notNil
and:[pref match:coding]].
defaultFont := TextView defaultFont onDevice:device.
(pref match:(defaultFont encoding)) ifFalse:[
defaultFont := nil.
].
defaultFont isNil ifTrue:[
(pref = 'ascii*'
or:[pref = 'iso8859*']) ifTrue:[
defaultFont := FontDescription family:'courier' face:'medium' style:'roman' size:12
]
].
defaultFont isNil ifTrue:[
defaultFont := device
listOfAvailableFonts
detect:[:f | filter value:f]
ifNone:nil.
defaultFont isNil ifTrue:[
"/ flush list, and refetch font list
"/ (in case someone just changed the font path ...)
device flushListOfAvailableFonts.
defaultFont := device
listOfAvailableFonts
detect:[:f | filter value:f]
ifNone:nil.
].
defaultFont isNil ifTrue:[
self warn:'your display does not seem to provide any ' , newEncoding , '-encoded font.'.
^ self.
]
].
msg := 'switch to a %1 encoded font ?'.
(ask not or:[self confirm:(resources string:msg with:pref) withCRs])
ifTrue:[
self withWaitCursorDo:[
f := FontPanel
fontFromUserInitial:defaultFont
title:(resources string:'font selection')
filter:filter.
f notNil ifTrue:[
subView font:f
]
]
]
"Created: 26.10.1996 / 12:06:54 / cg"
"Modified: 30.6.1997 / 17:46:46 / cg"
! !
!FileBrowser methodsFor:'private - file stuff'!
doCreateFile:newName
"create an empty file"
|aStream f|
f := currentDirectory filenameFor:newName.
f exists ifTrue:[
(self
ask:(resources string:'%1 already exists\\truncate ?' with:newName)
yesButton:'truncate'
) ifFalse:[^ self].
].
FileStream openErrorSignal handle:[:ex|
^ self showAlert:(resources string:'cannot create file ''%1'' !!' with:newName)
with:(FileStream lastErrorString)
] do:[
aStream := f newReadWriteStream.
].
aStream notNil ifTrue:[
aStream close.
self updateCurrentDirectoryIfChanged
] ifFalse:[
self showAlert:(resources string:'cannot create file ''%1'' !!' with:newName)
with:(FileStream lastErrorString)
]
"Modified: 23.4.1997 / 13:19:12 / cg"
"Modified: 18.9.1997 / 17:21:45 / stefan"
!
doFileGet:viaDoubleClick
"get selected file - show contents in subView.
This is invoked either by the 'get file' menu item, or via double click.
When invoked via the menu (viaDoubleClick argument is false),
the automatic file action is not performed - instead, the file is always
shown in the codeView (if possible).
This distinction was done to allow xpm or xbm files (which have an automatic
action) to be edited."
|fileName|
fileName := self getSelectedFileName.
fileName notNil ifTrue:[
self doOpenFile:fileName viaDoubleClick:viaDoubleClick
]
"Created: / 19.6.1996 / 09:39:07 / cg"
"Modified: / 18.9.1997 / 17:35:31 / stefan"
"Modified: / 4.2.1999 / 17:43:51 / cg"
!
doFindFileNamed:namePatterns ignoreCase:ignCaseInName containingString:contentsString ignoreCaseInContents:ignCaseInString sameContentsAsFile:filenameToCompareContentsOrNil sameContentsAs:bytesToCompareContentsOrNil in:aDirectory
|dir subDirs nameMatches contentsMatches lines contentsToCompare|
bytesToCompareContentsOrNil notNil ifTrue:[
contentsToCompare := bytesToCompareContentsOrNil
].
subDirs := OrderedCollection new.
dir := aDirectory asFilename.
self label:myName , '- searching ' , dir name.
(dir directoryContents ? #()) sort do:[:fn |
|f|
f := dir construct:fn.
f isDirectory ifTrue:[
f isSymbolicLink ifFalse:[
subDirs add:f
]
] ifFalse:[
(nameMatches := namePatterns isNil) ifFalse:[
ignCaseInName ifTrue:[
nameMatches := namePatterns contains:[:aPattern | aPattern match:(fn asLowercase)]
] ifFalse:[
nameMatches := namePatterns contains:[:aPattern | aPattern match:fn]
]
].
nameMatches ifTrue:[
filenameToCompareContentsOrNil notNil ifTrue:[
"/ contents compare ...
contentsMatches := false.
f pathName ~= filenameToCompareContentsOrNil pathName ifTrue:[
f fileSize == filenameToCompareContentsOrNil fileSize ifTrue:[
contentsToCompare isNil ifTrue:[
filenameToCompareContentsOrNil fileSize < (512*1024) ifTrue:[
contentsToCompare := filenameToCompareContentsOrNil binaryContentsOfEntireFile
]
].
contentsToCompare isNil ifTrue:[
"/ too large - compare block-wise ...
contentsMatches := (filenameToCompareContentsOrNil sameContentsAs:f).
] ifFalse:[
contentsMatches := contentsToCompare = (f binaryContentsOfEntireFile).
]
].
] ifFalse:[
f isSymbolicLink ifTrue:[
subView insertLine:(f name , ' is a symbolic link to ' , f pathName) before:subView cursorLine.
subView cursorDown.
]
]
] ifFalse:[
"/ string search ...
(contentsMatches := contentsString isNil) ifFalse:[
(f exists and:[f isReadable]) ifFalse:[
subView insertLine:('*** ' , f pathName , ' skipped - unreadable or bad symbolic link ***') before:subView cursorLine.
subView cursorDown.
] ifTrue:[
f fileSize > (4024*1024) ifTrue:[
subView insertLine:('*** ' , f pathName , ' skipped - too large ***') before:subView cursorLine.
subView cursorDown.
] ifFalse:[
Stream lineTooLongErrorSignal handle:[:ex |
|cont|
"/ this typically happens, when a binary file is read linewise ...
cont := f readStream binary contentsOfEntireFile asString.
ignCaseInString ifTrue:[
contentsMatches := cont asLowercase includesString:contentsString
] ifFalse:[
contentsMatches := cont includesString:contentsString
].
] do:[
lines := f contents ? #().
ignCaseInString ifTrue:[
contentsMatches := (lines findFirst:[:l | l asLowercase includesString:contentsString]) ~~ 0
] ifFalse:[
contentsMatches := (lines findFirst:[:l | l includesString:contentsString]) ~~ 0
].
].
].
].
].
].
contentsMatches ifTrue:[
subView insertLine:f pathName before:subView cursorLine.
subView cursorDown.
]
]
]
].
subDirs do:[:dir |
self
doFindFileNamed:namePatterns
ignoreCase:ignCaseInName
containingString:contentsString
ignoreCaseInContents:ignCaseInString
sameContentsAsFile:filenameToCompareContentsOrNil
sameContentsAs:contentsToCompare
in:dir
].
"Created: / 15.10.1998 / 11:37:15 / cg"
"Modified: / 15.10.1998 / 12:50:48 / cg"
!
doOpenFile:fileName viaDoubleClick:viaDoubleClick
"get selected file - show contents in subView.
This is invoked either by the 'get file' menu item, or via double click.
When invoked via the menu (viaDoubleClick argument is false),
the automatic file action is not performed - instead, the file is always
shown in the codeView (if possible).
This distinction was done to allow xpm or xbm files (which have an automatic
action) to be edited."
|iconLbl winLbl f|
self withReadCursorDo:[
(f := fileName asFilename) isAbsolute ifFalse:[
f := currentDirectory construct:fileName.
].
f isDirectory ifTrue:[
self doChangeCurrentDirectoryTo:fileName updateHistory:true.
winLbl := myName.
iconLbl := myName
] ifFalse:[
f exists ifFalse:[
Dialog warn:(resources string:'oops, ''%1'' is gone or unreadable.' withCRs with:f pathName allBold).
^ self
].
timeOfFileRead := f modificationTime.
self showFile:fileName insert:false encoding:fileEncoding doubleClick:viaDoubleClick.
currentFileName := fileName.
self fileTypeSpecificActions.
subView acceptAction:[:theCode |
(f modificationTime <= timeOfFileRead
or:[
(self
ask:(resources at:'FileBrowser:\\file has changed somehow in the meanwhile.\(Hint: use the file-difference menu function to see what has changed)\\Do you really want to save ?')
yesButton:'save'
noButton:'don''t save')]) ifTrue:[
self withCursor:(Cursor write) do:[
self writeFile:fileName text:theCode encoding:fileEncoding.
timeOfFileRead := f modificationTime.
self label:myName , ': ' , currentFileName
]
]
].
winLbl := myName , ': ' , fileName.
f isWritable ifFalse:[
winLbl := winLbl , ' (readonly)'
].
iconLbl := fileName
].
self label:winLbl.
self iconLabel:iconLbl.
]
"Created: / 4.2.1999 / 17:43:26 / cg"
"Modified: / 3.5.1999 / 20:32:27 / ps"
"Modified: / 4.5.1999 / 20:39:10 / cg"
!
doRemove:filesToRemove
"remove the selected file(s) - no questions asked"
|msg needUpdate toRemove updateRunning yesToAll mTime|
updateRunning := listUpdateProcess notNil.
self stopUpdateProcess.
toRemove := OrderedCollection new.
"/
"/ did the directory change in the meanwhile ?
"/
mTime := currentDirectory modificationTime.
needUpdate := mTime notNil and:[mTime > timeOfLastCheck].
yesToAll := false.
lockUpdate := true.
[
filesToRemove keysAndValuesDo:[:idx :fileName |
|f|
f := currentDirectory construct:fileName.
OperatingSystem accessDeniedErrorSignal handle:[:ex|
"was not able to remove it"
msg := (resources string:'cannot remove ''%1'' !!' with:fileName).
self showAlert:msg with:(OperatingSystem lastErrorString)
] do:[
|answer contents i|
(f isSymbolicLink not and:[f isDirectory]) ifTrue:[
contents := f directoryContents.
contents isEmpty ifTrue:[
f remove
] ifFalse:[
yesToAll ifFalse:[
idx == filesToRemove size ifTrue:[
answer := Dialog
confirmWithCancel:(resources string:'directory ''%1'' is not empty\remove anyway ?' with:fileName allBold) withCRs
labels:(resources array:#('cancel' 'remove'))
values:#(false true)
default:2.
] ifFalse:[
answer := Dialog
confirmWithCancel:(resources string:'directory ''%1'' is not empty\remove anyway ?' with:fileName allBold) withCRs
labels:(resources array:#('cancel' 'remove all' 'remove'))
values:#(false #removeAll true)
default:3.
].
answer == false ifTrue:[
^ self
].
answer == #removeAll ifTrue:[
yesToAll := true
].
].
f recursiveRemove
].
] ifFalse:[
f removeFile.
].
"
self show:nil
"
i := fileList indexOf:fileName.
i ~~ 0 ifTrue:[
toRemove add:i.
]
].
].
] valueNowOrOnUnwindDo:[
lockUpdate := false.
fileListView setSelection:nil.
"/
"/ remove reverse - otherwise indices are wrong
"/
toRemove sort.
toRemove reverseDo:[:idx |
fileList removeIndex:idx.
fileListView removeIndex:idx.
].
updateRunning ifTrue:[
self updateCurrentDirectory
] ifFalse:[
"
install a new check after some time
"
needUpdate ifFalse:[timeOfLastCheck := AbsoluteTime now].
Processor removeTimedBlock:checkBlock.
Processor addTimedBlock:checkBlock afterSeconds:checkDelta.
]
]
"Modified: / 20.11.1997 / 17:39:14 / stefan"
"Modified: / 26.4.1999 / 23:03:12 / cg"
!
doRename:oldName to:newName
"rename a file (or directory)"
|old new|
(oldName notNil and:[newName notNil]) ifTrue:[
(oldName isBlank or:[newName isBlank]) ifFalse:[
old := currentDirectory filenameFor:oldName.
new := currentDirectory filenameFor:newName.
OperatingSystem errorSignal handle:[:ex|
self showAlert:(resources string:'cannot rename file ''%1'' to %2 !!'
with:oldName with:newName)
with:(OperatingSystem lastErrorString)
] do:[
new exists ifTrue:[
(self confirm:(resources string:'''%1'' already exists - rename (i.e. overwrite) anyway ?' with:new baseName allBold))
ifFalse:[
^ self
]
].
old renameTo:new.
].
self updateCurrentDirectoryIfChanged.
]
]
"Modified: / 24.9.1997 / 09:20:00 / stefan"
"Modified: / 3.10.1998 / 18:19:27 / cg"
! !
!FileBrowser methodsFor:'private - file type & info'!
fileCommentStrings
"return a useful comment definition; based upon the fileName for now"
|suff mime|
mime := MIMETypes mimeTypeForFilename:currentFileName.
mime isNil ifTrue:[
mime := (currentDirectory construct:currentFileName) mimeTypeOfContents.
].
(mime = 'application/x-make') ifTrue:[
"/ makefile
^ #('#' (nil nil)).
].
(mime = 'application/x-sh') ifTrue:[
"/ shell script
^ #('#' (nil nil)).
].
((mime = 'text/html')
or:[(mime = 'text/xml')
or:[(mime = 'application/xml')]]) ifTrue:[
^ #(nil ('<!!-- ' ' -->')).
].
(mime = 'application/x-batch-script') ifTrue:[
^ #('rem ' (nil nil)).
].
(mime = 'application/x-c-source') ifTrue:[
^ #(nil ('/*' '*/')).
].
(mime = 'application/x-cpp-source') ifTrue:[
^ #('//' ('/*' '*/')).
].
(mime = 'application/x-java-source') ifTrue:[
^ #('//' (nil nil)).
].
(mime = 'application/x-asn1-source') ifTrue:[
^ #('--' ('--' '--')).
].
suff := currentFileName asFilename suffix.
(suff = 'style') ifTrue:[
^ #(';' (nil nil)).
].
(suff = 'rs') ifTrue:[
^ #(';' (nil nil)).
].
"/ default: smalltalk comments
^ #('"/' ('"' '"')).
"Created: / 7.1.1997 / 20:30:00 / cg"
"Modified: / 4.5.1999 / 19:42:30 / ps"
"Modified: / 19.11.1999 / 15:25:24 / cg"
!
fileTypeSpecificActions
"any special fileTypeSpecific actions are done here,
when a new file is selected"
|commentStrings|
commentStrings := self fileCommentStrings.
commentStrings notNil ifTrue:[
subView perform:#commentStrings: with:commentStrings ifNotUnderstood:nil
].
"Modified: 7.1.1997 / 20:30:54 / cg"
!
getFileInfoString:longInfo
"get stat info on selected file - return a string which can be
shown in a box"
|fileName f fullPath text info fileOutput type modeBits modeString s ts|
fileName := self getSelectedFileName.
fileName isNil ifTrue:[^ nil].
f := currentDirectory construct:fileName.
info := f info.
info isNil ifTrue:[
self showAlert:(resources string:'cannot get info of ''%1'' !!' with:fileName)
with:(OperatingSystem lastErrorString).
^ nil
].
text := StringCollection new.
f isSymbolicLink ifTrue:[
text add:(resources string:'symbolic link to: %1' with:(f linkInfo path))
].
type := info type.
(longInfo and:[type == #regular]) ifTrue:[
fullPath := currentDirectory pathName asFilename constructString:fileName.
fileOutput := fullPath asFilename fileType.
].
s := (resources at:'type: ').
fileOutput isNil ifTrue:[
s := s , type asString
] ifFalse:[
s := s , 'regular (' , fileOutput , ')'
].
text add:s.
text add:(resources string:'size: %1' with:(info size) printString).
modeBits := info mode.
modeString := self getModeString:modeBits.
longInfo ifTrue:[
text add:(resources string:'access: %1 (%2)'
with:modeString
with:(modeBits printStringRadix:8))
] ifFalse:[
text add:(resources string:'access: %1' with:modeString)
].
text add:(resources string:'owner: %1'
with:(OperatingSystem getUserNameFromID:(info uid))).
longInfo ifTrue:[
text add:(resources string:'group: %1'
with:(OperatingSystem getGroupNameFromID:(info gid))).
ts := info accessed.
text add:(resources string:'last access: %1 %2'
with:(ts asTime printString)
with:(ts asDate printString)).
ts := info modified.
text add:(resources string:'last modification: %1 %2'
with:(ts asTime printString)
with:(ts asDate printString)).
].
^ text asString
"Modified: 8.9.1995 / 11:59:28 / claus"
"Modified: 1.11.1996 / 20:47:52 / cg"
"Modified: 18.9.1997 / 16:34:31 / stefan"
!
getInfoFile
"get filename of a description-file (.dir.info, README etc.);
This file is automatically shown when a directory is enterred.
You can add more names below if you like."
#(
'.dir.info'
'README'
'ReadMe'
'Readme'
'readme'
'read.me'
'Read.me'
'READ.ME'
'README.TXT'
'readme.txt'
'Readme.txt'
'Info.txt'
'info.txt'
'INFO.TXT'
) do:[:f |
|n|
n := currentDirectory construct:f.
(n isReadable and:[n isDirectory not]) ifTrue:[
^ f.
]
].
^ nil
"Modified: 3.8.1997 / 16:50:33 / cg"
"Modified: 16.9.1997 / 15:26:53 / stefan"
!
getModeString:modeBits
"convert file-mode bits into a more user-friendly string.
This is wrong here - should be moved into OperatingSystem."
^ self getModeString:modeBits
with:#( 'owner:' $r $w $x
' group:' $r $w $x
' others:' $r $w $x )
!
getModeString:modeBits with:texts
"convert file-mode bits into a more user-friendly string.
This is wrong here - should be moved into OperatingSystem."
|bits modeString|
bits := modeBits bitAnd:8r777.
modeString := ''.
#( nil 8r400 8r200 8r100 nil 8r040 8r020 8r010 nil 8r004 8r002 8r001 )
with: texts do:[:bitMask :access |
|ch|
bitMask isNil ifTrue:[
modeString := modeString , (resources string:access)
] ifFalse:[
(bits bitAnd:bitMask) == 0 ifTrue:[
ch := $-
] ifFalse:[
ch := access
].
modeString := modeString copyWith:ch
]
].
^ modeString
!
showInfo
"show directory info when dir has changed"
|info txt|
info := self getInfoFile.
info notNil ifTrue:[
txt := self readFile:info
].
self show:txt.
!
sizePrintString:size
"helper for update-directory to return a string with a files size.
This one gives the size in byte, Kb or Mb depending on size.
If you dont like this, just uncomment the first statement below."
|unitString n|
"
^ size printString.
"
unitString := ''.
size < (500 * 1024) ifTrue:[
size < 1024 ifTrue:[
n := size
] ifFalse:[
n := (size * 10 // 1024 / 10.0).
unitString := ' Kb'
]
] ifFalse:[
n := (size * 10 // 1024 // 1024 / 10.0).
unitString := ' Mb'
].
^ (n printStringLeftPaddedTo:5) , unitString.
! !
!FileBrowser methodsFor:'private - file-I/O'!
readFile:fileName
"read in the file, answer its contents as StringCollection"
^ self readFile:fileName lineDelimiter:Character cr encoding:nil
"Modified: 22.2.1996 / 14:57:08 / cg"
!
readFile:fileName lineDelimiter:aCharacter encoding:encoding
"read in the file, return its contents as StringCollection.
The files lines are delimited by aCharacter.
If encoding is nonNil, the file is assumed to be coded according to
that symbol, and #decodeString: should be able to convert it."
|f stream text msg sz|
(f := fileName asFilename) isAbsolute ifFalse:[
f := (currentDirectory construct:fileName)
].
stream := f readStream.
stream isNil ifTrue:[
msg := (resources string:'cannot read file ''%1'' !!' with:fileName).
self showAlert:msg with:(FileStream lastErrorString).
^ nil
].
"
for very big files, give ObjectMemory a hint, to preallocate more
"
(sz := stream fileSize) > 1000000 ifTrue:[
Processor activeProcess withPriority:Processor userBackgroundPriority do:[
ObjectMemory announceSpaceNeed:(sz + (sz // 5)) "/ add 20% for tab expansion
].
].
text := self readStream:stream lineDelimiter:aCharacter encoding:encoding.
stream close.
^ text
"Created: / 22.2.1996 / 14:56:48 / cg"
"Modified: / 18.9.1997 / 17:06:54 / stefan"
"Modified: / 4.2.1999 / 17:52:18 / cg"
!
readStream:aStream
"read in from aStream, answer its contents as StringCollection"
^ self readStream:aStream lineDelimiter:Character cr encoding:nil
"Modified: 22.2.1996 / 14:58:40 / cg"
!
readStream:aStream lineDelimiter:aCharacter encoding:encoding
"read from aStream, answer its contents as StringCollection.
The files lines are delimited by aCharacter.
If encoding is nonNil, the file is assumed to be coded according to
that symbol, and #decodeString: should be able to convert it."
|text line enc|
text := StringCollection new.
enc := encoding.
enc == #iso8859 ifTrue:[
enc := nil
].
aCharacter == Character cr ifTrue:[
FileStream lineTooLongErrorSignal handle:[:ex |
|s partialLine|
s := ex parameter at:1.
partialLine := ex parameter at:2.
ex proceedWith:(partialLine , s upTo:aCharacter)
] do:[
[aStream atEnd] whileFalse:[
line := aStream nextLine withTabsExpanded.
enc notNil ifTrue:[
line := line decodeFrom:enc
].
text add:line
].
].
] ifFalse:[
[aStream atEnd] whileFalse:[
line := (aStream upTo:aCharacter) withTabsExpanded.
enc notNil ifTrue:[
line := line decodeFrom:enc
].
text add:line
].
].
^ text
"Created: / 22.2.1996 / 14:58:25 / cg"
"Modified: / 5.2.1999 / 00:53:22 / cg"
!
showFile:fileName
"show contents of fileName in subView"
fileListView selection:(fileList indexOf:fileName).
self fileGet
"Modified: / 17.6.1998 / 11:26:13 / cg"
!
showFile:fileName insert:insert encoding:encoding
"show/insert contents of fileName in subView"
^ self
showFile:fileName insert:insert encoding:encoding doubleClick:false
"Modified: 19.6.1996 / 09:40:19 / cg"
!
showFile:fileName insert:insert encoding:encoding doubleClick:viaDoubleClick
"show/insert contents of fileName in subView"
|path buffer s n i ok convert text msg eol guess action enc
fontsEncoding pref failWarning f|
fileName asFilename isAbsolute ifFalse:[
path := currentDirectory filenameFor:fileName.
] ifTrue:[
path := fileName asFilename asAbsoluteFilename
].
(path type == #regular) ifFalse:[
"asked for a non-file - ignore it ..."
path exists ifFalse:[
msg := '''%1'' does not exist !!'.
] ifTrue:[
msg := '''%1'' is not a regular file !!'.
].
self warn:(resources string:msg with:fileName).
^ self
].
"/
"/ check if file is a text file
"/
s := path readStream.
s isNil ifTrue:[
self showAlert:(resources string:'cannot read file ''%1'' !!' with:fileName)
with:(FileStream lastErrorString).
^ nil
].
buffer := String new:4096.
n := s nextBytes:4096 into:buffer.
s close.
enc := encoding.
ok := true.
guess := self guessEncodingFrom:buffer.
guess == #binary ifTrue:[
ok := false.
viaDoubleClick ifTrue:[
(self binaryFileAction:fileName) ifTrue:[^ self].
].
(self confirm:(resources string:'''%1'' seems to be a binary file (or unsupported format) - show anyway ?' with:fileName))
ifFalse:[^ self]
] ifFalse:[
viaDoubleClick ifTrue:[
(self nonBinaryFileAction:fileName) ifTrue:[^ self].
].
fontsEncoding := subView font encoding.
pref := self preferredFontEncodingFor:guess.
ok := pref match:fontsEncoding.
ok ifFalse:[
pref = 'iso8859*' ifTrue:[
ok := 'ascii*' match:fontsEncoding
]
].
ok ifTrue:[
fileEncoding := guess.
enc := guess.
] ifFalse:[
doNotShowFontDialog == true ifTrue:[
action := #show
] ifFalse:[
action := Dialog choose:(resources string:'''%1'' seems to require a %2 font.' with:fileName with:pref)
labels:(resources array:#('cancel' 'show' 'dont ask again' 'change font'))
values:#(nil #show #showAlways #encoding)
default:#encoding.
].
action == #showAlways ifTrue:[
doNotShowFontDialog := true.
action := #show.
].
action isNil ifTrue:[^ self].
action == #encoding ifTrue:[
fileEncoding := guess asSymbol.
subView externalEncoding:fileEncoding.
self validateFontEncodingFor:fileEncoding ask:false.
] ifFalse:[
doNotShowFontDialog ~~ true ifTrue:[
self information:(resources string:'Individual characters may be invisible/wrong in this font.')
]
].
enc := fileEncoding.
].
].
convert := false.
"/ ok ifTrue:[
"/ "/
"/ "/ check if line delimiter is a cr
"/ "/
"/ i := buffer indexOf:Character cr.
"/ i == 0 ifTrue:[
"/ "/
"/ "/ no newline found - try cr
"/ "/
"/ i := buffer indexOf:(Character value:13).
"/ i ~~ 0 ifTrue:[
"/ convert := self confirm:(resources string:'''%1'' seems to have CR as line delimiter - convert to NL ?' with:fileName).
"/ ]
"/ ]
"/ ].
insert ifFalse:[
"/ release old text first
"/ - we might need the memory in case of huge files
"/ (helps if you have a 4Mb file in the view,
"/ and click on another biggy)
subView contents:nil.
].
convert ifTrue:[
eol := Character value:13
] ifFalse:[
eol := Character cr
].
failWarning := false.
CharacterArray decodingFailedSignal handle:[:ex |
|errStr|
failWarning ifFalse:[
errStr := resources string:ex errorString.
(self confirm:(resources
string:'An error occurred while decoding:\%1\\The file has either a different encoding or is corrupted.\\Continue ?'
with:errStr) withCRs)
ifFalse:[
^ self
].
failWarning := true.
].
ex proceed.
] do:[
text := self readFile:fileName lineDelimiter:eol encoding:enc.
].
insert ifFalse:[
(f := fileName asFilename) isAbsolute ifFalse:[
f := (currentDirectory construct:fileName)
].
self class addToVisitedFileHistory:f pathName.
self show:text
] ifTrue:[
subView insertSelectedStringAtCursor:text asString
].
"Created: / 19.6.1996 / 09:39:52 / cg"
"Modified: / 18.9.1997 / 17:10:20 / stefan"
"Modified: / 18.5.1999 / 15:51:18 / cg"
!
writeFile:fileName text:someText encoding:encoding
|stream errReason msg startNr nLines string|
errReason := ''.
FileStream streamErrorSignal handle:[:ex |
errReason := ex errorString.
ex return.
] do:[
stream := (currentDirectory filenameFor:fileName) writeStream.
].
stream isNil ifTrue:[
msg := (resources string:'cannot write file ''%1'' !!' with:fileName).
self showAlert:msg with:errReason.
^ self.
].
dosEOLMode value == true ifTrue:[
stream eolMode:#crlf.
"/ must do it lineWise ...
someText asStringCollection do:[:line |
line notNil ifTrue:[
stream nextPutAll:line
].
stream cr
]
] ifFalse:[
(someText isString) ifTrue:[
stream nextPutAll:someText.
] ifFalse:[
"/
"/ on some systems, writing linewise is very slow (via NFS)
"/ therefore we convert to a string and write it in chunks.
"/ To avoid creating huge strings, we do it in blocks of 1000 lines.
"/
startNr := 1.
nLines := someText size.
[startNr <= nLines] whileTrue:[
string := someText asStringWithCRsFrom:startNr
to:((startNr + 1000) min:nLines)
compressTabs:compressTabs.
encoding notNil ifTrue:[
string := string encodeInto:encoding
].
stream nextPutAll:string.
startNr := startNr + 1000 + 1.
].
].
].
stream close.
subView modified:false
"Created: / 22.2.1996 / 15:03:10 / cg"
"Modified: / 18.9.1997 / 17:12:44 / stefan"
"Modified: / 6.5.1999 / 11:45:50 / cg"
! !
!FileBrowser methodsFor:'private - presentation'!
defineTabulatorsForLongList
"define the tabs for the long list"
tabSpec := TabulatorSpecification new.
tabSpec unit:#inch.
"/ tabSpec positions:#(0 0.25 2.3 4.3 5.3 6.0 6.5).
tabSpec widths: #(0.25 2 2.0 1 0.5 0.5 1"any").
" icon name mode owner group size type"
tabSpec align: #(#left #left #left #right #right #decimal #left).
tabSpec addDependent:self.
tabRulerView tabulatorSpecification:tabSpec.
"Modified: 17.4.1997 / 02:56:07 / cg"
!
defineTabulatorsForShortList
"define the tabs for the short list"
tabSpec := TabulatorSpecification new.
tabSpec unit:#inch.
"/ tabSpec positions:#(0 0.25 ).
tabSpec widths: #(0.25 2 ).
" icon name"
tabSpec align: #(#left #left).
tabSpec addDependent:self.
tabRulerView notNil ifTrue:[
tabRulerView tabulatorSpecification:tabSpec.
].
"Created: / 17.4.1997 / 02:51:41 / cg"
"Modified: / 27.7.1998 / 20:23:34 / cg"
!
iconForFile:aFilenameString
"given a fileName, return an appropriate icon"
|f icn key key2 suff mimeType|
f := currentDirectory construct:aFilenameString.
f isDirectory ifTrue:[
f isSymbolicLink ifTrue:[
key := #directoryLink
] ifFalse:[
key := #directory.
(f isReadable not or:[f isExecutable not]) ifTrue:[
key := #directoryLocked
].
]
] ifFalse:[
f isSymbolicLink ifTrue:[
f isReadable not ifTrue:[
key := #fileLocked
] ifFalse:[
key := #fileLink
]
] ifFalse:[
key := key2 := #file.
f isExecutableProgram ifTrue:[
key := key2 := #executableFile
].
(f isReadable not) ifTrue:[
key := #fileLocked
] ifFalse:[
suff := f suffix.
(suff = 'bak' or:[suff = 'sav']) ifTrue:[
suff := f withoutSuffix suffix.
].
suff size > 0 ifTrue:[
mimeType := MIMETypes mimeTypeForSuffix:suff.
mimeType notNil ifTrue:[
(mimeType startsWith:'image/') ifTrue:[
key := #imageFile
] ifFalse:[
(mimeType startsWith:'text/') ifTrue:[
key := #textFile
]
]
].
].
].
].
].
"/ local (device) icons
icons notNil ifTrue:[
mimeType notNil ifTrue:[
icn := icons at:mimeType ifAbsent:nil.
] ifFalse:[
icn := icons at:key ifAbsent:nil.
].
icn notNil ifTrue:[^ icn].
].
"/ global icons
Icons notNil ifTrue:[
mimeType notNil ifTrue:[
icn := Icons at:mimeType ifAbsent:nil.
"/ sight - check for parent-MIME types ...
[icn isNil and:[mimeType includes:$/]] whileTrue:[
mimeType := mimeType copyTo:(mimeType lastIndexOf:$/) - 1.
icn := Icons at:mimeType ifAbsent:nil.
].
].
icn notNil ifTrue:[
key := mimeType
] ifFalse:[
icn := Icons at:key ifAbsent:nil.
].
].
icn isNil ifTrue:[
( (key := key2) isNil
or:[(icn := icons at:key ifAbsent:nil) notNil
or:[(icn := Icons at:key ifAbsent:nil) isNil]]
) ifTrue:[
^ icn
]
].
"/ remember device icon
icn := icn copy onDevice:device.
icn clearMaskedPixels.
icons at:key put:icn.
^ icn
"Modified: / 18.9.1997 / 16:35:28 / stefan"
"Modified: / 23.12.1999 / 22:28:00 / cg"
!
stopImageRenderProcess
imageRenderProcess notNil ifTrue:[
imageRenderProcess terminate.
imageRenderProcess := nil
].
"Created: 19.4.1997 / 13:51:34 / cg"
!
stopUpdateProcess
Processor removeTimedBlock:checkBlock.
listUpdateProcess notNil ifTrue:[
listUpdateProcess terminate.
listUpdateProcess := nil.
].
"Created: 19.4.1997 / 13:51:34 / cg"
!
updateCurrentDirectory
"update listView with directory contents"
"the code below may look somewhat complex -
it reads the directory first for the names,
then (in followup sweeps over the files) gets the
files type, info and icon in a forked subprocess.
This makes the Filebrowsers list update faster, since the fileInfo
(i.e. stat-calls) may take long - especially on NFS-mounted directories.
The file reading is done at lower priority, to let user continue
his work in other views. However, to be fair to other fileBrowser,
which may also read directories at low prio, give up the processor
after every entry. This shares the cpu among all fileBrowsers;
Therefore, browsers which read short directories will finish first.
ST/X users love this behavior ;-)
"
self withReadCursorDo:[
|files matchPattern list passDone f ignoreCase|
self stopUpdateProcess.
timeOfLastCheck := currentDirectory modificationTime.
files := currentDirectory asFilename fullDirectoryContents.
"/ (files includes:(Filename parentDirectoryName)) ifTrue:[
"/ upButton enable.
"/ ] ifFalse:[
"/ upButton disable.
"/ ].
"/ show files which are either directories
"/ or match the current pattern
matchPattern := filterField contents.
(matchPattern notNil and:[
matchPattern isEmpty not and:[
matchPattern ~= '*']]) ifTrue:[
ignoreCase := Filename isCaseSensitive not.
files := files select:[:aName |
((currentDirectory construct:aName) isDirectory)
or:[matchPattern compoundMatch:aName ignoreCase:ignoreCase]
].
].
files size == 0 ifTrue:[
self information:('directory ', currentDirectory pathName, ' vanished').
^ self
].
(sortByWhat value == #name) ifTrue:[
sortCaseless value == true ifTrue:[
files sort:[:a :b | a asLowercase < b asLowercase]
] ifFalse:[
files sort.
]
] ifFalse:[
(sortByWhat value == #time) ifTrue:[
files sort:[:a :b | |f1 f2 t1 t2|
f1 := (currentDirectory construct:a).
f2 := (currentDirectory construct:b).
t1 := f1 isSymbolicLink
ifFalse:[f1 modificationTime]
ifTrue:[f1 linkInfo modified].
t2 := f2 isSymbolicLink
ifFalse:[f2 modificationTime]
ifTrue:[f2 linkInfo modified].
t1 := t1 ? (AbsoluteTime now).
t2 := t2 ? (AbsoluteTime now).
t1 > t2
]
] ifFalse:[
(sortByWhat value == #type) ifTrue:[
files sort:[:a :b | |f1 f2 t1 t2 suff1 suff2|
f1 := (currentDirectory construct:a).
f2 := (currentDirectory construct:b).
t1 := f1 type ? #xbadLink.
t2 := f2 type ? #xbadLink.
t1 = t2 ifTrue:[
suff1 := f1 suffix.
suff2 := f2 suffix.
suff1 = suff2 ifTrue:[
sortCaseless value == true ifTrue:[
a asLowercase < b asLowercase
] ifFalse:[
a < b
]
] ifFalse:[
suff1 asLowercase < suff2 asLowercase
]
] ifFalse:[
t1 < t2
]
]
]
]
].
files := self withoutHiddenFiles:files.
fileList := files copy.
tabSpec isNil ifTrue:[
showingDetails value "showLongList" ifTrue:[
self defineTabulatorsForLongList
] ifFalse:[
self defineTabulatorsForShortList
].
].
"/
"/ first show all the names - this can be done fast ...
"/
list := files collect:[:fileName |
|entry|
entry := MultiColListEntry new.
entry tabulatorSpecification:tabSpec.
entry colAt:1 put:nil.
entry colAt:2 put:fileName.
].
fileListView setList:list expandTabs:false.
passDone := Array new:list size withAll:0.
"
this is a time consuming operation (especially, if reading an
NFS-mounted directory); therefore, start a low prio process,
which fills in the remaining fields in the fileList ...
"
listUpdateProcess := [
|prevUid prevGid fileNameString nameString groupString
modeString info line len
anyImages lineIndex aFileName
entry typ f p typeString done endIndex
state stopAtEnd nextState img prevFirstLine prevLastLine
numVisible dirSuffix prevWidth|
dirSuffix := Filename directorySuffix.
dirSuffix size > 0 ifTrue:[
dirSuffix := '.' , dirSuffix asLowercase.
].
"/
"/ then walk over the files, adding more info
"/ (since we have to stat each file, this may take a while longer)
"/ Visible items are always filled first.
"/
"/ the state machine
"/
nextState := IdentityDictionary new.
showingDetails value "showLongList" ifTrue:[
nextState add:(#visibleIcons -> #visibleAttributes).
nextState add:(#visibleAttributes -> #visibleTypes).
nextState add:(#visibleTypes -> #visibleImages).
nextState add:(#visibleImages -> #nextPageIcons).
nextState add:(#nextPageIcons -> #nextPageAttributes).
nextState add:(#nextPageAttributes -> #nextPageTypes).
nextState add:(#nextPageTypes -> #nextPageImages).
nextState add:(#nextPageImages -> #previousPageIcons).
nextState add:(#previousPageIcons -> #previousPageAttributes).
nextState add:(#previousPageAttributes -> #previousPageTypes).
nextState add:(#previousPageTypes -> #previousPageImages).
nextState add:(#previousPageImages -> #remainingIcons).
nextState add:(#remainingIcons -> #remainingAttributes).
nextState add:(#remainingAttributes -> #remainingTypes).
nextState add:(#remainingTypes -> #remainingImages).
nextState add:(#remainingImages -> nil).
] ifFalse:[
nextState add:(#visibleIcons -> #nextPageIcons).
nextState add:(#nextPageIcons -> #previousPageIcons).
nextState add:(#previousPageIcons -> #remainingIcons).
nextState add:(#remainingIcons -> nil).
].
anyImages := false.
lineIndex := prevFirstLine := fileListView firstLineShown.
endIndex := prevLastLine := fileListView lastLineShown.
endIndex := endIndex min:(files size).
state := #visibleIcons.
done := false.
[done] whileFalse:[
"/
"/ if multiple FileBrowsers are reading, let others
"/ make some progress too
"/
Processor yield.
"/
"/ could be destroyed in the meanwhile ...
"/
realized ifFalse:[
listUpdateProcess := nil.
Processor activeProcess terminate
].
((prevFirstLine ~~ fileListView firstLineShown)
or:[prevLastLine ~~ fileListView lastLineShown]) ifTrue:[
"/ start all over again
lineIndex := prevFirstLine := fileListView firstLineShown.
endIndex := prevLastLine := fileListView lastLineShown.
endIndex := endIndex min:(files size).
state := #visibleIcons.
].
showingDetails value ifTrue:[
prevWidth := fileListView widthOfContents.
].
(lineIndex between:1 and:(files size)) ifTrue:[
"/
"/ expand the next entry ...
"/
aFileName := files at:lineIndex.
entry := fileListView at:lineIndex.
f := currentDirectory construct:aFileName.
(state endsWith:'Icons') ifTrue:[
"/
"/ pass 1 - icons
"/
(passDone at:lineIndex) < 1 ifTrue:[
(f isDirectory
and:[(aFileName ~= '..') and:[aFileName ~= '.']]
) ifTrue:[
"/ the following suffix cutOff is not really required,
"/ but makes the list look better on VMS ...
fileNameString := aFileName.
dirSuffix notNil ifTrue:[
(aFileName asLowercase endsWith:dirSuffix) ifTrue:[
fileNameString := aFileName copyWithoutLast:(dirSuffix size).
]
].
fileNameString := fileNameString , ' ...'
] ifFalse:[
fileNameString := aFileName.
OperatingSystem isVMSlike ifTrue:[
(aFileName endsWith:'.') ifTrue:[
aFileName ~= '..' ifTrue:[
fileNameString := aFileName copyWithoutLast:1
]
]
]
].
showingDetails value "showLongList" ifTrue:[
len := fileNameString size.
(len > 20) ifTrue:[
fileNameString := (fileNameString contractTo:20)
].
].
entry colAt:1 put:(self iconForFile:aFileName).
entry colAt:2 put:fileNameString.
"/fileListView at:lineIndex put:entry.
fileListView withoutRedrawAt:lineIndex put:entry.
fileListView invalidateLine:lineIndex.
anyImages ifFalse:[
(Image isImageFileSuffix:(aFileName asFilename suffix))
ifTrue:[
anyImages := true
]
].
passDone at:lineIndex put:1
]
].
(state endsWith:'Attributes') ifTrue:[
"/
"/ pass 2 - everything except fileType (which takes very long)
"/
(passDone at:lineIndex) < 2 ifTrue:[
info := f info.
info isNil ifTrue:[
"not accessable - usually a symlink,
to a nonexisting/nonreadable file
"
f isSymbolicLink ifTrue:[
p := f linkInfo path.
typeString := 'broken symbolic link to ' , p
] ifFalse:[
typeString := 'unknown'
].
] ifFalse:[
typ := (info type).
modeString := self getModeString:(info at:#mode)
with:#( '' $r $w $x
' ' $r $w $x
' ' $r $w $x ).
entry colAt:3 put:modeString.
((info uid) ~~ prevUid) ifTrue:[
prevUid := (info uid).
nameString := OperatingSystem getUserNameFromID:prevUid.
nameString := nameString contractTo:10.
nameString := nameString , (String new:(10 - nameString size))
].
nameString isNil ifTrue:[nameString := '???'].
entry colAt:4 put:nameString withoutSpaces.
((info gid) ~~ prevGid) ifTrue:[
prevGid := (info gid).
groupString := OperatingSystem getGroupNameFromID:prevGid.
groupString := groupString contractTo:10.
groupString := groupString , (String new:(10 - groupString size))
].
groupString isNil ifTrue:[groupString := '???'].
entry colAt:5 put:groupString withoutSpaces.
(typ == #regular) ifTrue:[
entry colAt:6 put:(self sizePrintString:(info size)).
].
f isSymbolicLink ifTrue:[
p := f linkInfo path.
typeString := 'symbolic link to ' , p
] ifFalse:[
typeString := typ asString
].
].
entry colAt:7 put:typeString.
"/ fileListView at:lineIndex put:entry.
fileListView withoutRedrawAt:lineIndex put:entry.
fileListView invalidateLine:lineIndex.
passDone at:lineIndex put:2.
].
].
(state endsWith:'Types') ifTrue:[
"/
"/ pass 3: add fileType
"/
(passDone at:lineIndex) < 3 ifTrue:[
info := f info.
info notNil ifTrue:[
f isSymbolicLink ifFalse:[
(Image isImageFileSuffix:(f suffix)) ifFalse:[
typeString := f fileType.
entry colAt:7 put:typeString.
"/ fileListView at:lineIndex put:entry
fileListView withoutRedrawAt:lineIndex put:entry.
fileListView invalidateLine:lineIndex.
].
].
].
passDone at:lineIndex put:3
].
].
(state endsWith:'Images') ifTrue:[
"/
"/ pass 4: read images
"/
(passDone at:lineIndex) < 4 ifTrue:[
(Image isImageFileSuffix:(f suffix)) ifTrue:[
f isDirectory ifFalse:[
img := Image fromFile:(f pathName).
img notNil ifTrue:[
showingBigImagePreview value == true ifTrue:[
img := img magnifiedTo:32@32.
] ifFalse:[
img := img magnifiedTo:16@16.
].
img := img onDevice:self device.
entry colAt:7 put:img.
"/ fileListView at:lineIndex put:entry
fileListView withoutRedrawAt:lineIndex put:entry.
fileListView invalidateLine:lineIndex.
]
]
].
passDone at:lineIndex put:4
].
].
].
showingDetails value ifTrue:[
fileListView widthOfContents ~~ prevWidth ifTrue:[
fileListView contentsChanged.
]
].
"/
"/ advance to the next line
"/
lineIndex := lineIndex + 1.
lineIndex > endIndex ifTrue:[
"/ finished this round ...
"/ see what we are going for ...
numVisible := (fileListView lastLineShown - fileListView firstLineShown + 1).
state := nextState at:state ifAbsent:nil.
state isNil ifTrue:[
done := true
] ifFalse:[
(state startsWith:'visible') ifTrue:[
lineIndex := fileListView firstLineShown.
endIndex := fileListView lastLineShown.
endIndex := endIndex min:(files size).
] ifFalse:[
(state startsWith:'nextPage') ifTrue:[
lineIndex := fileListView lastLineShown + 1.
endIndex := lineIndex + numVisible.
endIndex := endIndex min:(files size).
lineIndex := lineIndex min:(files size).
] ifFalse:[
(state startsWith:'previousPage') ifTrue:[
endIndex := fileListView firstLineShown - 1.
lineIndex := endIndex - numVisible.
lineIndex := lineIndex max:1.
endIndex := endIndex min:(files size).
endIndex := endIndex max:1.
] ifFalse:[
"/ remaining
lineIndex := 1.
endIndex := files size.
]
]
]
]
]
].
listUpdateProcess := nil.
] forkAt:(Processor activePriority - 1).
"
install a new check after some time
"
Processor addTimedBlock:checkBlock afterSeconds:checkDelta
]
"Modified: / 21.9.1995 / 11:40:23 / claus"
"Modified: / 28.4.1997 / 22:30:30 / dq"
"Modified: / 18.9.1997 / 18:28:30 / stefan"
"Modified: / 16.12.1999 / 01:25:23 / cg"
! !
!FileBrowser methodsFor:'queries'!
fileName
"return my current fileName - during fileIn, the file
which is being loaded is returned.
This is provided for VW fileIn scripts, which walk the
context hierarchy and ask the fileBrowser for the name."
|f|
f := currentFileInFileName ? currentFileName.
f isNil ifTrue:[^ nil].
^ self path asFilename construct:f
"
(FileBrowser openOnFileNamed:'Makefile') fileName
"
"Modified: / 18.6.1998 / 15:27:35 / cg"
!
hasVisitHistory
^ self class hasVisitHistory
!
path
"return my currentDirectories pathName;
sent from the pathField to aquire the pathname when I changed directory"
"/ somewhat tricky: first ask it for the full pathName,
"/ then convert it to a directory name
"/ (which only makes a difference on VMS)
^ currentDirectory asFilename pathName "/ asFilename osNameForDirectory
"Modified: / 12.8.1998 / 14:45:48 / cg"
! !
!FileBrowser class methodsFor:'documentation'!
version
^ '$Header: /cvs/stx/stx/libtool/FileBrowser.st,v 1.393 2001-01-19 10:17:54 cg Exp $'
! !