Newsgroups: comp.lang.smalltalk
Path: utzoo!utgpu!cunews2!bnrgate!bqnes74!news
From: CWatts@BNR.CA (Carl Watts)
Subject: A Macintosh-Finder-like interface to the File System under Smalltalk-80 (part 1 of 2)
Message-ID: <1991May23.191531.9075@bqnes74.bnr.ca>
Sender: news@bqnes74.bnr.ca
Organization: Bell Northern Research
Date: Thu, 23 May 91 19:15:31 GMT

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