CWatts@BNR.CA (Carl Watts) (05/24/91)
Here's one of the most successful programming tools I've written for Smalltalk-80. My pet name for it is "Finder ST", in homage to Macintosh's Finder. The need for it came about when we switched from developing on Macintosh's to Sparcstations. The Sparcstations were real fast execution platforms for Smalltalk but they lacked the graceful direct-manipulation interface to the file system that the Macintosh had. I was traumatized for life with my attempts to use a CShell interface to the file system, so I decided to write a Macintosh Finder-like interface to the file system in Smalltalk. Its gone through three generations and about six months of fine tuning, but I'm finally happy with it. It manages to remain true to the look-and-feel of Smalltalk while remaining true to the direct manipulation user-interface style of Macintosh. In good Smalltalk tradition, its platform independent. Never again to I have to type names of files that already exist. Never again and I forced to give files short names just so I can type then easily when I need to use the file. In the Macintosh tradition, I just point and click. Anyway, I guess you can tell I'm proud of it. The first part of the fileIn to follow contains some nice extensions and improvements to Filename, UnixFilename, and SelectionInListView. These are usefull even in the absence of Finder ST. The Filename extensions allow directories to be treated like files for moving, copying, and deleting. The UnixFilename extensions implement methods to manipulate privileges on UnixFilenames. Here's that part, part 2 contains Finder ST itself. 'From Objectworks for Smalltalk-80(tm), Version 2.5 of 29 July 1989 on 4 December 1990 at 2:32:39 pm'! !Filename methodsFor: 'file utilities'! copyDirectoryTo: destName "Copy the directory whose name is the receiver to another directory called destname." "By Carl Watts" | destFileName | destFileName _ destName asFilename. (self asString ~= destFileName asString) ifTrue: [ (destFileName exists) ifTrue: [destFileName delete]. destFileName makeDirectory. self directoryContents do: [:file | (self construct: file) copyTo: (destFileName construct: file)]]! copyFileTo: destName "Copy the file whose name is the receiver to a file named destName." "By Carl Watts. This method was origionally called copyTo: but since copyTo: was changed to handle directories as well as files, this method has changed names." | buffer bufferSize sourceFile destFile amountRead | sourceFile _ IOAccessor openFileReadOnly: self. destFile _ IOAccessor openFileWriteOnly: destName asFilename. [bufferSize _ sourceFile bufferSize. buffer _ ByteArray new: bufferSize. "Copy until we have a read that is less than buffer size" [(amountRead _ sourceFile readInto: buffer) = bufferSize] whileTrue: [destFile writeAll: buffer]. "Copy any thing left over" amountRead > 0 ifTrue: [destFile writeFrom: buffer startingAt: 1 forSure: amountRead] ] valueNowOrOnUnwindDo: [sourceFile close. destFile close]! copyTo: destName "Copy the file/directory whose name is the receiver to a file/directory named destName. " "Rewritten By Carl Watts to handle directories as well as files." (self asString ~= destName asString) ifTrue: [ (self isDirectory) ifTrue: [self copyDirectoryTo: destName] ifFalse: [self copyFileTo: destName]]! delete "Delete the reference to the named file/directory (which is slightly different than saying 'deleting the file', but means the same thing in most cases)." "Modified by Carl Watts to delete directories as well." (self isDirectory) ifTrue: [self deleteDirectoryContents]. self deleteErrInto: (self errorReporter new)! deleteDirectoryContents "Delete the contents of the directory that is the receiver." "By Carl Watts." (self directoryContents) do: [:file | (self construct: file) delete]! ! !Filename methodsFor: 'utilities'! fileIn "FileIn the contents of the file represented by the receiver. If the receiver is a directory, then the contents of all files in the directory will be filedIn (using an inorder traversal) (ordered alphabetically)." "Modified By Carl Watts so that it would fileIn directories as well as files." (self isDirectory) ifTrue: [ self directoryContents asSortedCollection do: [:name | (self construct: name) fileIn]] ifFalse: [ Transcript cr; cr; show: 'Filing in from:'; crtab; show: self asString; cr. ^self readStream fileIn]! ! UnixFilename organization changeFromString: '(''testing'' hasPrivilege: isReadable) (''parsing'' extension) (''utilities'' printFile sendMailFile submit) (''private'' filesMatchingAccessList:into: named: primGetProtectionErrInto: primSetProtection:errInto:) (''file utilities'' directoryContents moveTo:) (''protection/privileges'' addPrivilege: directoryAddPrivilege: directoryRemovePrivilege: getProtection removePrivilege: setProtection:) '! !UnixFilename methodsFor: 'testing'! hasPrivilege: anInteger "Answer whether the receiver has all the privileges indicated by anInteger. See the class protocol (protect/privilege) for some constants for privileges." ^self getProtection allMask: anInteger! ! !UnixFilename methodsFor: 'utilities'! sendMailFile "Send a file as mail. Platform specific. Show the response on the transcript." | answer | answer _ UnixProcess cshOne: '/usr/lib/sendmail -t -oi <', self asString. Transcript show: answer! ! !UnixFilename methodsFor: 'file utilities'! moveTo: destName "Copy the file whose name is the receiver to a file named destName." "Since renameTo: will handle a move better and faster if its on the same file system (not to mention it preserves symbolic links and stuff like that), I'll try that first. If that fails, I'll do the copy file by file copy. By Carl Watts. " | result | result _ UnixErrorHolder inaccessableSignal handle: [:exception | exception returnWith: false] do: [self renameTo: destName. true]. result ifFalse: [super moveTo: destName]! ! !UnixFilename methodsFor: 'protection/privileges'! directoryAddPrivilege: anInteger "Add the privileges indicated by anInteger to the protection/privilege status of the receiver PLUS all of the receiver's contents. See the class protocol (protect/privilege) for some constants for privileges. A directory receiving read or write access will also receive execute access." | filename p | p _ self getProtection maskSet: anInteger. p _ (p bitOr: ((p bitAnd: self class allReadPrivilege) bitShift: -2)) bitOr: ((p bitAnd: self class allWritePrivilege) bitShift: -1). self setProtection: p. self directoryContents do: [:each | filename _ self construct: each. filename isDirectory ifTrue: [filename directoryAddPrivilege: anInteger] ifFalse: [filename addPrivilege: anInteger]]! directoryRemovePrivilege: anInteger "Remove the privileges indicated by anInteger to the protection/privilege status of the receiver PLUS all of the receiver's contents. See the class protocol (protect/privilege) for some constants for privileges. A directory losing both read and write access will lose execute access." | filename p | self directoryContents do: [:each | filename _ self construct: each. filename isDirectory ifTrue: [filename directoryRemovePrivilege: anInteger] ifFalse: [filename removePrivilege: anInteger]]. p _ (self getProtection maskClear: anInteger) bitAnd: self class allReadWritePrivilege. p _ (p bitOr: ((p bitAnd: self class allReadPrivilege) bitShift: -2)) bitOr: ((p bitAnd: self class allWritePrivilege) bitShift: -1). self setProtection: p! ! !UnixFilename class methodsFor: 'protection constants'! allReadDirectoryPrivilege "Answer the setProtection: privilege to allow all read and execute privileges for a directory. This number can be masked with other privilege numbers to add or remove the privilege" ^8r555! allReadPrivilege "Answer the setProtection: privilege to allow all read privileges. This number can be masked with other privilege numbers to add or remove the privilege" ^8r444! allReadWriteDirectoryPrivilege "Answer the setProtection: privilege to allow all read/write and execute privileges for a directory. This number can be masked with other privilege numbers to add or remove the privilege" ^8r777! allReadWritePrivilege "Answer the setProtection: privilege to allow all read/write privileges. This number can be masked with other privilege numbers to add or remove the privilege" ^8r666! allWritePrivilege "Answer the setProtection: privilege to allow all write privileges. This number can be masked with other privilege numbers to add or remove the privilege" ^8r222! groupReadDirectoryPrivilege "Answer the setProtection: privilege to allow the group read and execute privileges for a directory. This number can be masked with other privilege numbers to add or remove the privilege" ^8r050! groupReadPrivilege "Answer the setProtection: privilege to allow the group read privileges. This number can be masked with other privilege numbers to add or remove the privilege" ^8r040! groupReadWriteDirectoryPrivilege "Answer the setProtection: privilege to allow the group read/write and execute privileges for a directory. This number can be masked with other privilege numbers to add or remove the privilege" ^8r070! groupReadWritePrivilege "Answer the setProtection: privilege to allow the group read/write privileges. This number can be masked with other privilege numbers to add or remove the privilege" ^8r060! groupWritePrivilege "Answer the setProtection: privilege to allow the group write privilege. This number can be masked with other privilege numbers to add or remove the privilege" ^8r020! otherReadDirectoryPrivilege "Answer the setProtection: privilege to allow other read and execute privileges for a directory. This number can be masked with other privilege numbers to add or remove the privilege" ^8r005! otherReadPrivilege "Answer the setProtection: privilege to allow other read privileges. This number can be masked with other privilege numbers to add or remove the privilege" ^8r004! otherReadWriteDirectoryPrivilege "Answer the setProtection: privilege to allow others read/write and execute privileges for a directory. This number can be masked with other privilege numbers to add or remove the privilege" ^8r007! otherReadWritePrivilege "Answer the setProtection: privilege to allow others read/write privileges. This number can be masked with other privilege numbers to add or remove the privilege" ^8r006! otherWritePrivilege "Answer the setProtection: privilege to allow others write privilege. This number can be masked with other privilege numbers to add or remove the privilege" ^8r002! userReadDirectoryPrivilege "Answer the setProtection: privilege to allow the user read and execute privileges for a directory. This number can be masked with other privilege numbers to add or remove the privilege" ^8r500! userReadPrivilege "Answer the setProtection: privilege to allow the user read privileges. This number can be masked with other privilege numbers to add or remove the privilege" ^8r400! userReadWriteDirectoryPrivilege "Answer the setProtection: privilege to allow the user read/write and execute privileges for a directory. This number can be masked with other privilege numbers to add or remove the privilege" ^8r700! userReadWritePrivilege "Answer the setProtection: privilege to allow the user read/write privileges. This number can be masked with other privilege numbers to add or remove the privilege" ^8r600! userWritePrivilege "Answer the setProtection: privilege to allow the user write privilege. This number can be masked with other privilege numbers to add or remove the privilege" ^8r200! ! SelectionInListView comment: 'SelectionInListView is a "pluggable" ListView. The notion of pluggable views is an experiment in user interface design. The idea is to provide a view which can be plugged onto any object, rather than having to define a new subclass specific to every kind of object which needs to be viewed. The chief mechanism is a set of selectors, which can be thought of as an adaptor to convert the generic listView operations (such as changeSelection) into model-specific operations (such as fileName:). An added feature of this listView is that it tries to preserve its selection through changes in the choice list. This effect, and also the choice of an initial selection are transmitted to the model just as a user-requested selection would be. See the protocol ''adaptor'' for use of the pluggable selectors. See the creation messages in my class for an explication of the various parameters. Browse senders of the creation messages in the class for examples in the system. Instance Variables: itemList <Array of: Strings> printItems <Boolean | Symbol> message to send to get printable text for each item in list (true means printString). oneItem <Boolean> partMsg <Symbol> message to send to find out about the changed aspect of the instance initialSelectionMsg <Symbol> message to send to find out which item in the list is the initially selected one changeMsg <Symbol> message to send to find out what changed listMsg <Symbol> message to send to obtain the printable list menuMsg <Symbol> message to send to find out the menu '! !SelectionInListView methodsFor: 'list access'! list: anArray "Set the receiver's list to be anArray." "Modified by Carl Watts so the the printItems parameter can be a message to send to the model to convert each item in anArray into the appropriate text for the list item." | item theList| itemList _ anArray. anArray == nil ifTrue: [isEmpty _ true. selection _ 0. ^self changeModelSelection: 0]. isEmpty _ false. printItems isSymbol ifTrue: [theList _ anArray collect: [:each | (model perform: printItems with: each)]] ifFalse: [printItems ifTrue: [theList _ anArray collect: [:each | each printString copyUpTo: Character cr]] ifFalse: [theList _ anArray]]. list _ TextList onList: (topDelimiter == nil ifTrue: [theList] ifFalse: [(Array with: topDelimiter) , theList , (Array with: bottomDelimiter)]). item _ self initialSelection. selection _ item == nil ifTrue: [0] ifFalse: [itemList findFirst: [:x | x = item]]. self positionList. self changeModelSelection: selection! !
CWatts@BNR.CA (Carl Watts) (05/24/91)
Ok, here is Finder ST itself. It is implemented by the class FileDirectoryList. This fileIn modifies the ScreenController menu item 'file list' to open a FileDirectoryList instead. Documentation for all the abilities of Finder ST is in the class comment. Finder ST is for Smalltalk-80 2.5 right now. Collapsed Finder ST windows are little labeled icons of File Folders. I've changed the couple of methods that need to be changed to have it work under Smalltalk-80 4.0 but I won't release that version until I'm satisfied with the way collapsed windows look under 4.0. You will notice that Finder ST implements a lot of functionality. Its menus are far more context sensitive than typical Smalltalk-80 applications. The menus attempt to only present actions that are valid for whatever you have selected. So if you are looking for a particular function and it doesn't appear in the menu, its probably because that operation does not make sense in the context of what you have selected. For example the "trash" menuitem (Yes, Finder ST even has the same kind of non-destructive "Trash" as the Macintosh Finder) will not appear if the selected file/directory cannot be "trashed". (And yes, you can even recover things you "trashed" if the trash hasn't been emptied). Also Finder ST can move and copy files/folders using a background process (eg. the menu item "and move it here sometime"). This allows you to keep working while large folders/directories are being moved/copied. This feature forks a task at userBackgroundPriority. In Smalltalk 2.5, MVC usually consumes 100% of the Processor so these tasks can take a long time to run. There are several things people have written to change MVC so it does consume 100% of the Processor. If you have one of these in your image then moving/copying directories will occur much faster. I've written my own modifications to MVC in Smalltalk 2.5 so that they don't consume 100% of the CPU. I'll publish mine here tomorrow and you can use that one if you would like. Anyway, here is Finder ST... It does a lot of stuff so spend some time getting to know how to use it, it is quite powerful. It you have the extensions to class form that I published last week, then you can just select a file containing a picture and select "open" from the menu and Finder ST will open a Form editor on it. 'From Objectworks for Smalltalk-80(tm), Version 2.5 of 29 July 1989 on 15 April 1991 at 10:43:34 am'! Model subclass: #FileDirectoryList instanceVariableNames: 'directory file ' classVariableNames: 'CollapsedIcon SeparatorStringText TakenFile TakenFileDirectoryList Trash ' poolDictionaries: '' category: 'Tools-File Model'! FileDirectoryList comment: 'Instance of the receiver browse a specific folder/directory and allow Macintosh Finder like operations on the contents. The ''file list'' background menu should be modified to call ''FileDirectoryList open''. This class was written by Carl Watts (cwatts@BNR.CA). ''file list'' (from ScreenController menu) - open a fileDirectoryList on the currentDirectory. If the shift key is down, you can rapidly navigate to any particular directory. ''open'' (on a selected folder) - opens a new view on the selected folder. ''open...'' (on a selected folder with the shift key down) - allows you to rapidly select one of the folders transitively contained within the selected folder and opens a new view on it. Keep the shift key held down until you navigate to the directory you want. ''open'' (on a selected file) - If the file ends with .st then a ChangeListView is opened on it. This allows many operations on Smalltalk source fileIns. If the file ends in .im and the file is a kindOf: UnixFilename, the image is launched. If the file contains a recornizable kind of image then it will be opened as a Form. Otherwise a file editor is opened on the file. ''open as string'' (on a selected file with the shift key down) - Opens a file editor on the file. ''take it'' (on a selected file or folder) - selects it for moving or copying to another folder (see ''and move it here'', ''and copy it here'', ''and move it in here'', ''and copy it in here'') ''find...'' (on a selected folder) - allows searching a folder hierearchy for a file or folder matching an input string. The match string can contain any wildcard characters understood by String>match: ''file in'' (on a selected folder or a file with a .st extension) - fileIn the file or all files with the selected folder. ''open...'' (with nothing selected) - allows you to rapidly open one of the folders that transitively contains the current folder and opens a fileDirectoryList on it. If you hold down the shift key when you select the folder then you will be able to rapidly navigate to any folder within this folder (see ''open...'' on a selected folder). ''update'' (with nothing selected) - update the contents list for this folder. ''make folder...'' (with nothing selected) - make a new folder in this folder. ''make file...'' (with nothing selected) - make a new empty file in this folder. ''and move it here'' (with nothing selected) - moves the previously ''taken'' file or folder into this folder. ''and move it here sometime'' (with nothing selected and shift key down) - same as above only a process is forked at userBackgroundPriority to do the move. ''and copy it here'' (with nothing selected) - copies the previously ''taken'' file or folder into this folder. ''and copy it here sometime'' (with nothing selected and shift key down) - same as above only a process is forked at userBackgroundPriority to do the copy. ''recover trash'' (with nothing selected) - appears when there are files in the trash area that can be recovered. A menu appears with the contents of the trash area. Selecting a file brings it out of the trash area and puts in in the directory. ''empty trash'' (with nothing selected) - appears when there are files in the trash area. Selecting this item will cause them to be permanently deleted. ''and move it in here'' (on a selected folder) - moves the previously ''taken'' file or folder into this folder. ''and move it in here sometime'' (with nothing selected and shift key down) - same as above only a process is forked at userBackgroundPriority to do the move. ''and copy it in here'' (on a selected folder) - copies the previously ''taken'' file or folder into this folder. ''and copy it in here sometime'' (with nothing selected and shift key down) - same as above only a process is forked at userBackgroundPriority to do the copy. ''get privileges'' (on a file or directory that is a kindOf: UnixFilename) - opens a view on the privileges of the selections. Buttons allow you to set various protection settings. Changes take effect immediately. Holding down the leftShiftKey while clicking a privilege button for a directory will make the corresponding privilege change to all the contents of the directory. Attempts to change privileges when you do not own the file will result in a notifier. ''rename...'' (on a file or directory) - allows renaming the file or directory. ''trash'' (on a file or directory) - trashes the file. A trashed file is not immediately deleted. For an indefinite period of time, trashed files can be recovered by selecting ''recover trash'' (with nothing selected). ''file out...'' (on a file with a .st extension) - If the file prefix is the name of a class (ie. ''Integer.st''), attempt to fileout the class definition into the file. If the file prefix is the name of a class followed by a space and some more text (ie. ''Integer fixes.st'') then attempt to file out the changes for the specified class. If neither of the above then attempt to fileout all the changes in the current project. '! !FileDirectoryList methodsFor: 'accessing'! fileDirectory "Answer the fileDirectory that the receiver is looking at." ^directory! fileDirectory: aFilename "Set the receiver to be examining a new directory." directory _ aFilename. self newFileList: nil! ! !FileDirectoryList methodsFor: 'file list'! file "Answer the file that is currently selected in the list." ^file! file: aFile "A new file has been selected in the file list." file _ aFile! fileItem: aFilename "Answer the text to appear in the list for the specified Filename." (self fileIsDirectory: aFilename) ifTrue: [^aFilename tail asText, SeparatorStringText] ifFalse: [^aFilename tail]! fileList "Answer the list of files for the current directory. Unless the left shift key is down, don't show names starting with a period." | names | directory exists ifFalse: [^OrderedCollection new: 0]. names _ directory directoryContents. (Sensor leftShiftDown) ifFalse: [ names _ names reject: [:name | name first == $.]]. names _ names asSortedCollection. ^names collect: [:name | directory construct: name]! fileMenu "Answer the menu of actions to the currently selected files in the list." (directory exists) ifFalse: [^ActionMenu labels: 'make this folder' selectors: #(makeThisFolder)]. (file isNil) ifTrue: [^self fileMenuForNoSelection]. (file exists) ifFalse: [^ActionMenu labels: 'update' selectors: #(updateFileList)]. (self fileIsDirectory) ifTrue: [^self fileMenuForDirectory] ifFalse: [^self fileMenuForFile]! fileMenuForDirectory "Answer the menu of actions to the currently selected file (a Directory)." | labelList selectors | labelList _ OrderedCollection new. selectors _ OrderedCollection new. (file isReadable) ifTrue: [ self extendedMenus ifTrue: [ labelList add: #('open...' 'take it' 'find...' 'file in sometime'). selectors addAll: #(openSomeInnerFolder takeIt findFilename fileInSometime)] ifFalse: [ labelList add: #('open' 'take it' 'find...' 'file in'). selectors addAll: #(openDirectory takeIt findFilename fileIn)]]. file isWritable & self takenFileAvailable ifTrue: [ self extendedMenus ifTrue: [ labelList add: #('and move it in here sometime' 'and copy it in here sometime'). selectors addAll: #(andMoveItInHereSometime andCopyItInHereSometime)] ifFalse: [ labelList add: #('and move it in here' 'and copy it in here'). selectors addAll: #(andMoveItInHere andCopyItInHere)]]. (self fileIsUnixFilename) ifTrue: [ labelList add: #('get privileges'). selectors add: #getPrivileges]. (file isWritable) & (directory isWritable) ifTrue: [ labelList add: (OrderedCollection with: 'rename...'). selectors add: #renameFile. self extendedMenus ifTrue: [ labelList last add: 'delete'. selectors add: #deleteFile] ifFalse: [ labelList last add: 'trash'. selectors add: #trashFile]]. ^ActionMenu labelList: labelList selectors: selectors! fileMenuForFile "Answer the menu of actions to the currently selected file." | labelList selectors isST isMail | labelList _ OrderedCollection new. selectors _ OrderedCollection new. isST _ '*.st' match: file tail. isMail _ '*.mail' match: file tail. (file isReadable) ifTrue: [ self extendedMenus ifTrue: [labelList add: #('open as string' 'take it') asOrderedCollection. selectors addAll: #(openFileSomehow takeIt)] ifFalse: [labelList add: #('open' 'take it') asOrderedCollection. selectors addAll: #(openFile takeIt)]. isST ifTrue: [labelList last add: 'file in'. selectors add: #fileIn. (file respondsTo: #submit) ifTrue: [labelList last add: 'submit'. selectors add: #submit]]. (isMail and: [file respondsTo: #sendMailFile]) ifTrue: [ labelList last add: 'send mail'. selectors add: #sendMail]]. (self fileIsUnixFilename) ifTrue: [ labelList add: #('get privileges'). selectors add: #getPrivileges]. (file isWritable) ifTrue: [ isST ifTrue: [labelList add: #('file out...'). selectors add: #fileOut]. (directory isWritable) ifTrue: [ labelList add: (OrderedCollection with: 'rename...'). selectors add: #renameFile. self extendedMenus ifTrue: [ labelList last add: 'delete'. selectors add: #deleteFile] ifFalse: [ labelList last add: 'trash'. selectors add: #trashFile]]]. ^ActionMenu labelList: labelList selectors: selectors! fileMenuForNoSelection "Answer the menu of actions when no file is selected." | labelList selectors | labelList _ OrderedCollection new. selectors _ OrderedCollection new. labelList add: #('parents...' 'update' 'find...'). selectors addAll: #(openSomeContainingFolder updateFileList findInDirectory). (self isUnixFilename: directory) ifTrue: [ labelList add: #('get privileges'). selectors add: #getDirectoryPrivileges]. directory isWritable ifTrue: [ self takenFileAvailable ifTrue: [ self extendedMenus ifTrue: [ labelList add: #('and move it here sometime' 'and copy it here sometime'). selectors addAll: #(andMoveItHereSometime andCopyItHereSometime)] ifFalse: [ labelList add: #('and move it here' 'and copy it here'). selectors addAll: #(andMoveItHere andCopyItHere)]]. labelList add: #('make folder...' 'make file...'). selectors add: #makeNewFolder; add: #makeNewFile]. (Trash isEmpty) ifFalse: [ labelList add: #('recover trash' 'empty trash'). selectors addAll: #(recoverTrash emptyTrash)]. ^ActionMenu labelList: labelList selectors: selectors! newFileList: initialSelection "Set the currently selected message selector to be initialSelection." file _ initialSelection. self changed: #file! ! !FileDirectoryList methodsFor: 'file functions'! andCopyItHere "Copy the taken file to the current directory." self bringWith: #copyTo: into: directory sometime: false! andCopyItHereSometime "Copy the taken file to the current directory. Fork it at userBackgroundPriority" self bringWith: #copyTo: into: directory sometime: true! andCopyItInHere "Copy the taken file into the current selected directory." self bringWith: #copyTo: into: file sometime: false! andCopyItInHereSometime "Copy the taken file into the current selected directory. Do it as a Process at userBackgroundPriority." self bringWith: #copyTo: into: file sometime: true! andMoveItHere "Move the taken file to the current directory." self bringWith: #moveTo: into: directory sometime: false! andMoveItHereSometime "Move the taken file to the current directory sometime." self bringWith: #moveTo: into: directory sometime: true! andMoveItInHere "Move the taken file into the current directory." self bringWith: #moveTo: into: file sometime: false! andMoveItInHereSometime "Move the taken file into the current directory sometime." self bringWith: #moveTo: into: file sometime: true! deleteFile "Delete the selected file." file delete. self newFileList: nil! editFile "Edit the selected file." | k | k _ file fileSize // 1024. (k < 100 or: [self confirm: 'This file is ', k printString, 'k in size. Continue?']) ifTrue: [file edit]! emptySomeTrash "Empty some of the trash." | toEmpty | Trash isEmpty ifTrue: [^self]. toEmpty _ Trash removeFirst. toEmpty exists ifFalse: [^self]. toEmpty isWritable ifFalse: [^self]. toEmpty directoryContents do: [:tail | ('.trashed*' match: tail) ifTrue: [ | fileName | fileName _ toEmpty construct: tail. (fileName exists and: [fileName isWritable]) ifTrue: [fileName delete]]]! emptyTrash "Empty the trash (finally delete any trashed files)" [Trash isEmpty] whileFalse: [self emptySomeTrash]! fileIn "File in the file." file fileIn! fileInSometime "Fork a process at userBackgroundPriority to fileIn the file." | theFile | theFile _ file. [theFile fileIn] forkAt: Processor userBackgroundPriority! fileNamesInDirectory: aFilename matching: matchString "Answer the OrderedCollection of filenames matching matchString in the recursive directories of aFilename." | result childFilename | result _ OrderedCollection new. (aFilename directoryContents) do: [:name | childFilename _ aFilename construct: name. childFilename exists ifTrue: [ "ignore something weird" (matchString match: name) ifTrue: [result add: childFilename]. (childFilename isDirectory & childFilename isReadable) ifTrue: [result addAll: (self fileNamesInDirectory: childFilename matching: matchString)]]]. ^result! fileOut "File out to the selected file. If the file is named with the name of a class, file out that class." | aClass choice | aClass _ self classOfFileout. aClass isNil ifTrue: [ (self confirm: 'File out all changes?') ifTrue: [file fileOutChanges]. ^self]. choice _ (PopUpMenu labels: ('class ', aClass name, '\', 'changes for class ', aClass name, '\all changes') withCRs) startUp. choice = 1 ifTrue: [self fileOutClass: aClass]. choice = 2 ifTrue: [file fileOutChangesFor: aClass]. choice = 3 ifTrue: [file fileOutChanges]! fileOutClass: aClass "File out to the selected file. If the file is named with the name of a class, file out that class." | fileStream | fileStream _ file writeStream. [aClass fileOutOn: fileStream] valueNowOrOnUnwindDo: [fileStream close]! findFilename "Find a certain file in the selected directory." self findInDirectory: file! findInDirectory "Find a certain file in the current directory." self findInDirectory: directory! findInDirectory: aDirectory "Prompt for a match string and search all files and directories under the specified directory for matching filenames. If more than one is found, provide a PopUpMenu with the options." | matchString options choice | matchString _ FillInTheBlank request: 'Find files matching:'. matchString isEmpty ifTrue: [^self]. options _ self fileNamesInDirectory: aDirectory matching: matchString. (options isEmpty) ifTrue: [ Transcript show: 'Nobody'. ^self]. (options size = 1) ifTrue: [choice _ options first] ifFalse: [ options _ options asSortedCollection: [:a :b | a asString <= b asString]. choice _ (PopUpMenu labelList: (Array with: (options collect: [:o | self fileItem: o]))) startUp. (choice = 0) ifTrue: [^self]. choice _ options at: choice]. self class openShowing: choice! makeFolder: aFilename "Make the folder called aFilename." (aFilename directory exists) ifFalse: [self makeFolder: aFilename directory]. (aFilename exists) ifFalse: [ aFilename makeDirectory. (aFilename respondsTo: #getProtection) ifTrue: [ aFilename setProtection: (aFilename getProtection bitOr: aFilename directory getProtection)]]! makeNewFile "Prompt for the name of a new file and make it in the current directory." | aString newFile | self changeRequest ifFalse: [^self]. aString _ FillInTheBlank request: 'Enter new file name'. aString isEmpty ifTrue: [^self]. newFile _ directory construct: aString. (newFile exists) ifFalse: [ (newFile writeStream) close. (newFile respondsTo: #getProtection) ifTrue: [ newFile setProtection: ((newFile getProtection bitOr: newFile directory getProtection) maskClear: self allExecuteMask)]. self newFileList: newFile]! makeNewFolder "Prompt for the name of a new folder and make it in the current directory." | aString newFolder | self changeRequest ifFalse: [^self]. aString _ FillInTheBlank request: 'Enter new folder name'. aString isEmpty ifTrue: [^self]. newFolder _ directory construct: aString. (newFolder exists) ifFalse: [ self makeFolder: newFolder. self newFileList: newFolder]! makeThisFolder "Make the folder that I am supposed to be showing (someone deleted it)." self makeFolder: directory. self newFileList: file! openDirectory "Open the selected file (which is a directory)." self class openOn: file! openFile "Open the selected file." (('*.im' match: file tail) and: [self fileIsUnixFilename]) ifTrue: [^self launchImageInUnix]. ('*.st' match: file tail) ifTrue: [^self scanFileIn]. ('*form' match: file tail) | ('*.im1' match: file tail) | ('*.rf' match: file tail) | ('*.icon' match: file tail) ifTrue: [^self openFormFile]. self openFileSomehow! openFileSomehow "Open the selected file somehow (don't attempt anything bright, just open it)." self editFile! openFormFile "Open the selected file as a form." | form choice | form _ Form readFrom: file asString. form isNil ifTrue: [^self]. (form respondsTo: #open) ifTrue: [^form open]. choice _ (PopUpMenu labels: 'edit\bitEdit\backgroundForm' withCRs) startUp. choice = 0 ifTrue: [^nil]. choice = 1 ifTrue: [^form edit]. choice = 2 ifTrue: [^form bitEdit]. choice = 3 ifTrue: [ (form extent >= Display extent) ifTrue: [ScheduledControllers backgroundForm: form] ifFalse: [ScheduledControllers background: form]]! openSomeContainingFolder "Open some folder somewhere inside the currently selected folder." self openSomeFolderContaining: directory! openSomeFolderContaining: aFolder "Open some directory which contains (transitively) aFolder." | contents choice names | contents _ self containersOf: aFolder. names _ contents collect: [:filename | self fileItem: filename]. choice _ (PopUpMenu labelList: (Array with: names)) startUp. (choice = 0) ifTrue: [^self]. self extendedMenus ifTrue: [self class openSomeFolderIn: (contents at: choice)] ifFalse: [self class openOn: (contents at: choice)]! openSomeInnerFolder "Open some folder somewhere inside the currently selected folder." self class openSomeFolderIn: file! parentFolder "Open the parent folder." self class openOn: directory directory! recoverTrash "Attempt to recover something that has been previously trashed." | viableNames choice toRecover recoveredFile viableFiles fileName | Trash _ Trash select: [:each | each exists and: [each isWritable]]. viableFiles _ OrderedCollection new. Trash do: [:each | each directoryContents do: [:tail | ('.trashed *' match: tail) ifTrue: [ fileName _ each construct: tail. fileName isWritable ifTrue: [viableFiles add: fileName]]]]. (viableFiles isEmpty) ifTrue: [^self]. viableNames _ viableFiles collect: [:each | each tail copyFrom: ('.trashed ' size + 1) to: each tail size]. choice _ (PopUpMenu labelList: (Array with: viableNames)) startUp. (choice = 0) ifTrue: [^self]. toRecover _ viableFiles at: choice. recoveredFile _ directory construct: (viableNames at: choice). toRecover moveTo: recoveredFile. self newFileList: recoveredFile! renameFile "Rename the selected file." | newName newFilename | self changeRequest ifFalse: [^self]. newName _ FillInTheBlank request: 'Enter new name' initialAnswer: file tail. newName isEmpty ifTrue: [^self]. newFilename _ directory construct: newName. self emptyTrash. newFilename exists not ifTrue: [ file renameTo: newFilename]. self newFileList: newFilename! scanFileIn "Open the current file by opening a ChangeListView on the file" ChangeListView openOn: (ChangeList new scanFile: file readStream)! sendMail "The file understands the message 'sendMailFile'. Do it, whatever it does." file sendMailFile! submit "Submit the file (whatever that means to the file)." file submit! takeIt "Take the currently selected file in preparation for moving or copying it elsewhere. Also put the name of it in the ParagraphEditor clipboard." TakenFile _ file. TakenFileDirectoryList _ self. ParagraphEditor new copySelection: file asString asText! trashFile "Trash the selected file (which is not the same as delete in that it is recoverable)." | trashFile | ('.trashed*' match: file tail) ifTrue: [^self deleteFile]. trashFile _ directory construct: '.trashed ', file tail. (trashFile exists) ifTrue: [trashFile delete]. file renameTo: trashFile asString. (Trash includes: directory) ifFalse: [Trash add: directory]. (Trash size > 9) ifTrue: [self emptySomeTrash]. self newFileList: nil! updateFileList "Update the list of files." self changeRequest ifFalse: [^self]. self newFileList: file! ! !FileDirectoryList methodsFor: 'testing'! classOfFileout "Answer the class with the file (a .st file) appears to be a fileout of. If none answer nil." | prefix | prefix _ (file tail copyUpTo: $.) copyUpTo: Character space. (prefix isEmpty or: [prefix first isUppercase not]) ifTrue: [^nil]. ^Smalltalk detect: [:entry | (entry isKindOf: Class) and: [prefix = entry name]] ifNone: [nil]! extendedMenus "Answer whether menus should show the extended functionality or not." ^Sensor leftShiftDown! fileIsDirectory "Answer whether the currently selected file is a directory." ^self fileIsDirectory: file! fileIsDirectory: aFilename "Answer whether aFilename is a directory." "If its one of those wierd Unix files I get an error, so I have to catch it." ^self errorSignal handle: [:exception | exception returnWith: false] do: [aFilename isDirectory]! takenFileAvailable "Answer if there is a taken file available for moving or copying." ^TakenFile notNil and: [TakenFile exists]! ! !FileDirectoryList methodsFor: 'file functions (unix)'! fileIsUnixFilename "Answer if the currently selected file is a kind of UnixFilename" ^self isUnixFilename: file! getDirectoryPrivileges "Get the privileges for the current directory and allow changing them." self class openPrivilegesOn: (self copy fileDirectory: directory directory; file: directory)! getPrivileges "Get the privileges for the selected Unix file or directory and allow changing them." self class openPrivilegesOn: self copy! isUnixFilename: aFilename "Answer if aFilename is a kind of UnixFilename" ^aFilename isKindOf: UnixFilename! launchImageInUnix "Launch the file (an Image) under Unix." UnixProcess cshBullet: 'st80 ', (String with: $"), file asString, (String with: $"), ' &'! ! !FileDirectoryList methodsFor: 'privilege buttons (unix)'! toggleGroupRead: ignored "Toggle the privileges the group has reading the selected file." (self groupRead) ifTrue: [self perform: #resetGroupRead: from: file] ifFalse: [ self perform: #setGroupRead: from: file. self makeGroupAccessable: directory]. self changed: #groupRead. self changed: #groupWrite. self changed: #otherRead. self changed: #otherWrite! toggleGroupWrite: ignored "Toggle the privileges the group has writing the selected file." (self groupWrite) ifTrue: [self perform: #resetGroupWrite: from: file] ifFalse: [ self perform: #setGroupWrite: from: file. self makeGroupAccessable: directory]. self changed: #groupWrite. self changed: #groupRead. self changed: #otherWrite. self changed: #otherRead! toggleLocked: ignore "The user has clicked on the locked button. Toggle the locked state of the file." (self isLocked) ifTrue: [self perform: #unlock: from: file] ifFalse: [self perform: #lock: from: file]. self changed: #isLocked. self changed: #groupWrite. self changed: #otherWrite! toggleOtherRead: ignored "Toggle the privileges others have reading the selected file." (self otherRead) ifTrue: [self perform: #resetOtherRead: from: file] ifFalse: [ self perform: #setOtherRead: from: file. self makeOtherAccessable: directory]. self changed: #otherRead. self changed: #otherWrite. self changed: #groupRead. self changed: #groupWrite! toggleOtherWrite: ignored "Toggle the privileges others have writing the selected file." (self otherWrite) ifTrue: [self perform: #resetOtherWrite: from: file] ifFalse: [ self perform: #setOtherWrite: from: file. self makeOtherAccessable: directory]. self changed: #otherWrite. self changed: #otherRead. self changed: #groupWrite. self changed: #groupRead! ! !FileDirectoryList methodsFor: 'privilege functions (unix)'! lock: aFilename "Lock aFilename. This means take away all write access." self privileges: (aFilename getProtection maskClear: self allWriteMask) on: aFilename! makeGroupAccessable: aFilename "Make sure that the directory denoted by aFilename is accessable to groups." (aFilename getProtection allMask: self groupExecuteMask) ifFalse: [ self setGroupRead: aFilename. self makeGroupAccessable: aFilename directory]! makeOtherAccessable: aFilename "Make sure that the directory denoted by aFilename is accessable to others." (aFilename getProtection allMask: self otherExecuteMask) ifFalse: [ self setOtherRead: aFilename. self makeOtherAccessable: aFilename directory]! perform: aMessage from: aFilename "Perform aMessage on aFilename. If the user is holding down the left shift key and aFilename is a directory then perform aMessage on the contents of the directory as well." Cursor execute showWhile: [ self perform: aMessage from: aFilename recursing: Sensor leftShiftDown]! perform: aMessage from: aFilename recursing: aBoolean "Perform aMessage on aFilename. If aBoolean and aFilename is a directory then perform aMessage on the contents of the directory as well." self perform: aMessage with: aFilename. (aBoolean and: [aFilename isDirectory]) ifTrue: [ aFilename directoryContents do: [:name | self perform: aMessage from: (aFilename construct: name) recursing: aBoolean]]! privileges: anInteger on: aFilename "Set the privileges for the given file as specified by anInteger. If aFilename is a directory then give execute privileges to anyone who has read or write privileges." | newPrivileges | newPrivileges _ anInteger. (aFilename isDirectory) ifTrue: [ | executeMask | executeMask _ ((anInteger bitAnd: self allReadMask) bitShift: -2) bitOr: ((anInteger bitAnd: self allWriteMask) bitShift: -1). newPrivileges _ (anInteger maskClear: self allExecuteMask) maskSet: executeMask]. OSErrorHolder noPermissionsSignal handle: [:exception | exception return] do: [aFilename setProtection: newPrivileges]! resetGroupRead: aFilename "Reset the ability for group read to aFilename. If this in not a directory then also reset the ability for group write to the file as well. If the group can't read then others can't either." | newPrivileges | newPrivileges _ aFilename getProtection maskClear: self groupReadMask. newPrivileges _ newPrivileges maskClear: self otherReadMask. "from self resetOtherRead: aFilename" (aFilename isDirectory) ifFalse: [ newPrivileges _ newPrivileges maskClear: self groupWriteMask. newPrivileges _ newPrivileges maskClear: self otherWriteMask]. "from self resetOtherRead: aFilename" self privileges: newPrivileges on: aFilename! resetGroupWrite: aFilename "Reset the ability for group to write to aFilename. If the group can't write then others can't either." | newPrivileges | newPrivileges _ aFilename getProtection maskClear: self groupWriteMask. newPrivileges _ newPrivileges maskClear: self otherWriteMask. "from resetOtherWrite" self privileges: newPrivileges on: aFilename! resetOtherRead: aFilename "Reset the ability for others to read aFilename. If this in not a directory then also reset the ability to write to the file as well." | newPrivileges | newPrivileges _ aFilename getProtection maskClear: self otherReadMask. (aFilename isDirectory) ifFalse: [newPrivileges _ newPrivileges maskClear: self otherWriteMask]. self privileges: newPrivileges on: aFilename! resetOtherWrite: aFilename "Reset the ability for others to write to aFilename." | newPrivileges | newPrivileges _ aFilename getProtection maskClear: self otherWriteMask. self privileges: newPrivileges on: aFilename! resolvePrivilegesOf: aFile "Resolve the privileges of aFile in the directory it sits in." "Give aFile at least the read privileges of the directory in which it resides. If its locked, keep it locked otherwise give it exactly the write privileges of the directory." | directoryPrivileges directoryRead directoryWrite filePrivileges newFilePrivileges | (aFile isKindOf: UnixFilename) ifFalse: [^self]. directoryPrivileges _ aFile directory getProtection. directoryRead _ directoryPrivileges bitAnd: self allReadMask. directoryWrite _ directoryPrivileges bitAnd: self allWriteMask. filePrivileges _ aFile getProtection. newFilePrivileges _ (filePrivileges bitOr: directoryRead) maskClear: self allWriteMask. (filePrivileges noMask: self userWriteMask) ifFalse: [newFilePrivileges _ newFilePrivileges bitOr: directoryWrite]. self privileges: newFilePrivileges on: aFile. aFile isDirectory ifTrue: [ aFile directoryContents do: [:tail | self resolvePrivilegesOf: (aFile construct: tail)]]! setGroupRead: aFilename "Set the ability for group read to aFilename." self privileges: (aFilename getProtection maskSet: self groupReadMask) on: aFilename! setGroupWrite: aFilename "Set the ability for group to write to aFilename (if it isn't locked). If the group gets write access, it also get read access." | newPrivileges | (self isLocked: aFilename) ifFalse: [ newPrivileges _ aFilename getProtection maskSet: self groupWriteMask. (aFilename isDirectory) ifFalse: [ newPrivileges _ newPrivileges maskSet: self groupReadMask]. self privileges: newPrivileges on: aFilename]! setOtherRead: aFilename "Set the ability for others to read aFilename. Give the same privilege to groups as well." | newPrivileges | newPrivileges _ aFilename getProtection maskSet: self otherReadMask. newPrivileges _ newPrivileges maskSet: self groupReadMask. "from setGroupRead:" self privileges: newPrivileges on: aFilename.! setOtherWrite: aFilename "Set the ability for others to write to aFilename (if its not locked). This implies read access as well. And anything that others can do, the group should be able to do." | newPrivileges | (self isLocked: aFilename) ifFalse: [ newPrivileges _ aFilename getProtection maskSet: self otherWriteMask. newPrivileges _ newPrivileges maskSet: self groupWriteMask. "from setGroupWrite:" (aFilename isDirectory) ifFalse: [ newPrivileges _ newPrivileges maskSet: self otherReadMask. newPrivileges _ newPrivileges maskSet: self groupReadMask]. "from setGroupWrite:" self privileges: newPrivileges on: aFilename]! unlock: aFilename "Unlock aFilename. This means give the user write access." self privileges: (aFilename getProtection maskSet: self userWriteMask) on: aFilename! ! !FileDirectoryList methodsFor: 'privilege testing (unix)'! groupRead "Answer if the group has read privileges on the selected file." (file isDirectory) ifTrue: [^self privileges allMask: self groupReadMask + self groupExecuteMask] ifFalse: [^self privileges allMask: self groupReadMask]! groupWrite "Answer if the group has write privileges on the selected file." (file isDirectory) ifFalse: [^self privileges allMask: self groupWriteMask] ifTrue: [^self privileges allMask: self groupWriteMask + self groupExecuteMask]! isLocked "Answer if the file is locked (noone has write privileges)." ^self isLocked: file! isLocked: aFilename "Answer if aFilename is locked (noone has write privileges)." ^(aFilename getProtection) noMask: self allWriteMask! otherRead "Answer if other users have read privileges on the selected file." (file isDirectory) ifTrue: [^self privileges allMask: self otherReadMask + self otherExecuteMask] ifFalse: [^self privileges allMask: self otherReadMask]! otherWrite "Answer if other users have write privileges on the selected file." (file isDirectory) ifFalse: [ ^self privileges allMask: self otherWriteMask] ifTrue: [ ^self privileges allMask: self otherWriteMask + self otherExecuteMask]! privileges ^file getProtection! ! !FileDirectoryList methodsFor: 'utilities'! containersOf: aFilename "Answer an ordered collection of the folders which contain (transitively) aFilename." | parents dir | parents _ OrderedCollection new. dir _ aFilename. [dir _ dir directory. parents addFirst: dir. dir = dir directory] whileFalse. ^parents! ! !FileDirectoryList methodsFor: 'constants (unix)'! allExecuteMask "Answer the bit mask for all execute privileges." ^8r111! allReadMask "Answer the bit mask for all read privileges." ^8r444! allWriteMask "Answer the bit mask for all write privileges." ^8r222! groupExecuteMask "Answer the bit mask for group execute privileges." ^8r010! groupReadMask "Answer the bit mask for group read privileges." ^8r040! groupWriteMask "Answer the bit mask for group write privileges." ^8r020! otherExecuteMask "Answer the bit mask for other execute privileges." ^8r001! otherReadMask "Answer the bit mask for other users read privileges." ^8r004! otherWriteMask "Answer the bit mask for other users write privileges." ^8r002! userReadMask "Answer the bit mask for user read privileges." ^8r400! userWriteMask "Answer the bit mask for user write privileges." ^8r200! ! !FileDirectoryList methodsFor: 'private'! bringWith: transferMessage into: aFilename sometime: sometime "Transfer the taken file into aFilename using transferMessage. If sometime then fork the process at userBackgroundPriority." | takenFile takenFileDirectoryList newFilename transferBlock | takenFile _ TakenFile. takenFileDirectoryList _ TakenFileDirectoryList. newFilename _ aFilename construct: takenFile tail. (newFilename exists not or: [self confirm: 'Replace item with the same name?']) ifFalse: [^nil]. TakenFile _ nil. TakenFileDirectoryList _ nil. self emptyTrash. transferBlock _ [ takenFile perform: transferMessage with: newFilename. self resolvePrivilegesOf: newFilename. takenFile exists ifFalse: [takenFileDirectoryList newFileList: nil]. aFilename = directory ifTrue: [self newFileList: newFilename]]. sometime ifTrue: [transferBlock forkAt: Processor userBackgroundPriority] ifFalse: [transferBlock value]! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! FileDirectoryList class instanceVariableNames: ''! FileDirectoryList class comment: 'Instances of the reciever represent models for a FileDirectory on the workstation. The allow various "Finder" like operations on FileDirectories.'! !FileDirectoryList class methodsFor: 'instance creation'! newOn: aDirectory "Answer a new instance of the receiver on the specified directory." SeparatorStringText _ (String with: Filename separator) asText allBold. ^self new fileDirectory: aDirectory! ! !FileDirectoryList class methodsFor: 'scheduling'! open "Open a new instance of the receiver ." (Sensor leftShiftDown) ifTrue: [self openVolumes] ifFalse: [self openCurrentDirectory]! openCurrentDirectory "Open a new instance of the receiver on the current directory." self openOn: Filename defaultDirectory! openOn: aFilename "Open a new instance of the receiver on the directory specified by aFilename." self openViewOn: (self newOn: aFilename)! openShowing: aFilename "Open a new instance of the receiver on the directory that contains aFilename with aFilename already selected." self openViewOn: ((self newOn: aFilename directory) file: aFilename)! openSomeFolderIn: aFolder "Open some directory somewhere inside aFolder." | contents choice names | contents _ aFolder directoryContents asSortedCollection collect: [:tail | aFolder construct: tail]. contents _ contents select: [:filename | filename isReadable and: [filename isDirectory]]. (contents isEmpty) ifTrue: [^self openOn: aFolder]. names _ contents collect: [:filename | filename tail]. choice _ (PopUpMenu labelList: (Array with: names)) startUp. (choice = 0) ifTrue: [^self openOn: aFolder]. self extendedMenus ifTrue: [self openSomeFolderIn: (contents at: choice)] ifFalse: [self openOn: (contents at: choice)]! openViewOn: aFileDirectoryList "Open a view on aFileDirectoryList." | topView listView | topView _ StandardSystemView new. topView label: (self labelFor: aFileDirectoryList fileDirectory); icon: CollapsedIcon; iconText: (self iconTextFor: aFileDirectoryList fileDirectory); minimumSize: 120@120; maximumSize: (400@Display height); borderWidth: 1. listView _ SelectionInListView on: aFileDirectoryList printItems: #fileItem: oneItem: false aspect: #file change: #file: list: #fileList menu: #fileMenu initialSelection: #file. topView addSubView: listView in: (0@0 corner: (1@1)) borderWidth: 1. topView controller open! openVolumes "Open a new instance of the receiver on one of the volumes." | volumes choice | volumes _ (Filename volumes) asArray. (volumes size > 1) ifFalse: [choice _ volumes first] ifTrue: [ choice _ (PopUpMenu labelList: (Array with: volumes)) startUp. (choice = 0) ifTrue: [^self] ifFalse: [choice _ volumes at: choice]]. self extendedMenus ifTrue: [self openSomeFolderIn: (Filename named: choice)] ifFalse: [self openOn: (Filename named: choice)]! ! !FileDirectoryList class methodsFor: 'examples'! example "The best example is the real thing, so open a real FileDirectory List." FileDirectoryList open! ! !FileDirectoryList class methodsFor: 'scheduling (unix)'! openPrivilegesOn: aFileDirectoryList "Open a privileges window on the specified file directory list. This should only be used on UnixFilenames." | topView | topView _ StandardSystemView new. topView label: (self labelFor: aFileDirectoryList file), ' privileges'; minimumSize: 200@100; maximumSize: 200@100; borderWidth: 1. topView addSubView: (BooleanView on: aFileDirectoryList aspect: #isLocked label: 'lock' change: #toggleLocked: value: true) in: (0@0 corner: (1/3)@1) borderWidth: 1. topView addSubView: (BooleanView on: aFileDirectoryList aspect: #groupRead label: 'group\read' withCRs change: #toggleGroupRead: value: true) in: ((1/3)@0 corner: (2/3)@(1/2)) borderWidth: 1. topView addSubView: (BooleanView on: aFileDirectoryList aspect: #groupWrite label: 'group\write' withCRs change: #toggleGroupWrite: value: true) in: ((1/3)@(1/2) corner: (2/3)@1) borderWidth: 1. topView addSubView: (BooleanView on: aFileDirectoryList aspect: #otherRead label: 'all\read' withCRs change: #toggleOtherRead: value: true) in: ((2/3)@0 corner: 1@(1/2)) borderWidth: 1. topView addSubView: (BooleanView on: aFileDirectoryList aspect: #otherWrite label: 'all\write' withCRs change: #toggleOtherWrite: value: true) in: ((2/3)@(1/2) corner: 1@1) borderWidth: 1. topView controller open! ! !FileDirectoryList class methodsFor: 'labeling'! iconTextFor: aFilename "Answer a text which represents aFilename and is suitable for titling a collapsed icon." | label filename | filename _ aFilename. label _ WriteStream with: filename tail. 2 timesRepeat: [ label nextPut: Character cr; nextPut: filename separator; nextPutAll: filename directory tail. filename directory = filename ifTrue: [^label contents]. filename _ filename directory]. ^label contents! labelFor: aFilename "Answer a string which represents aFilename and is suitable for titling a window." | components label | components _ aFilename class components: aFilename asString. label _ components removeLast. components reverseDo: [:c | (label size > 32) ifTrue: [^'...', label]. label _ (c asFilename construct: label) asString]. ^label! ! !FileDirectoryList class methodsFor: 'initialization'! initialize "Initialize the class." Trash isNil ifTrue: [Trash _ OrderedCollection new: 10]. CollapsedIcon _ Icon form: (OpaqueForm figure: ((Form extent: 62@50 fromArray: #( 31 65024 0 0 63 65280 0 0 96 384 0 0 192 192 0 0 384 96 0 0 768 48 0 0 1536 24 0 0 3072 12 0 0 16383 65535 65535 65520 32767 65535 65535 65528 49152 0 0 12 49152 0 0 12 49152 0 0 12 49152 0 0 12 49152 0 0 12 49152 0 0 12 49152 0 0 12 49152 0 0 12 49152 0 0 12 49152 0 0 12 49152 0 0 12 49152 0 0 12 49152 0 0 12 49152 0 0 12 49152 0 0 12 49152 0 0 12 49152 0 0 12 49152 0 0 12 49152 0 0 12 49152 0 0 12 49152 0 0 12 49152 0 0 12 49152 0 0 12 49152 0 0 12 49152 0 0 12 49152 0 0 12 49152 0 0 12 49152 0 0 12 49152 0 0 12 49152 0 0 12 49152 0 0 12 49152 0 0 12 49152 0 0 12 49152 0 0 12 49152 0 0 12 49152 0 0 12 49152 0 0 12 49152 0 0 12 65535 65535 65535 65532 65535 65535 65535 65532) offset: 0@0)) shape: ((Form extent: 62@50 fromArray: #( 31 65024 0 0 63 65280 0 0 127 65408 0 0 255 65472 0 0 511 65504 0 0 1023 65520 0 0 2047 65528 0 0 4095 65532 0 0 16383 65535 65535 65520 32767 65535 65535 65528 65535 65535 65535 65532 65535 65535 65535 65532 65535 65535 65535 65532 65535 65535 65535 65532 65535 65535 65535 65532 65535 65535 65535 65532 65535 65535 65535 65532 65535 65535 65535 65532 65535 65535 65535 65532 65535 65535 65535 65532 65535 65535 65535 65532 65535 65535 65535 65532 65535 65535 65535 65532 65535 65535 65535 65532 65535 65535 65535 65532 65535 65535 65535 65532 65535 65535 65535 65532 65535 65535 65535 65532 65535 65535 65535 65532 65535 65535 65535 65532 65535 65535 65535 65532 65535 65535 65535 65532 65535 65535 65535 65532 65535 65535 65535 65532 65535 65535 65535 65532 65535 65535 65535 65532 65535 65535 65535 65532 65535 65535 65535 65532 65535 65535 65535 65532 65535 65535 65535 65532 65535 65535 65535 65532 65535 65535 65535 65532 65535 65535 65535 65532 65535 65535 65535 65532 65535 65535 65535 65532 offset: 0@0))) textRect: (Rectangle origin: 4@12 corner: 57@45)! ! !FileDirectoryList class methodsFor: 'testing'! extendedMenus "Answer whether menus should show the extended functionality or not." ^Sensor leftShiftDown! ! FileDirectoryList initialize! !ScreenController methodsFor: 'menu messages'! openFileList "Create and schedule a FileList view for specifying files to access." "Modified by Carl Watts to use my new FileDirectoryLists" FileDirectoryList open! !