'From Squeak3.2 of 11 July 2002 [latest update: #4956] on 28 September 2002 at 8:50:13 pm'!
"Change Set:		FileList-mods
Date:			21 September 2002
Author:			Stephan B. Wessels

Added a simple enhancement where the file name of the selected file
can be copied to the clipboard.  There is an existing menu operation
which supports copying the whole file name path to the clipboard and
this was left alone.

Also provided a way to copy a file from either a local
directory or a remote one to a local directory.  No provision has been made to
copy a local file to the remote at this time, however.

SUnit tests fo rthe FileList class are included.  It's not much, but it's a good start."!

TestCase subclass: #FileListTest
	instanceVariableNames: 'gui '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Tools-FileList'!
StandardFileMenu subclass: #StandardDirectoryMenu
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Tools-FileList'!

!FileDirectory methodsFor: 'file operations' stamp: 'sbw 9/23/2002 18:49'!
copyFileNamed: fileName toDirectory: aDirectory 
	"Copy the contents of the existing file into a directory."
	| file1 file2 |
	self = aDirectory
		ifTrue: [^ nil].
	file1 _ (self readOnlyFileNamed: fileName) binary.
	file2 _ (aDirectory newFileNamed: fileName) binary.
	self copyFile: file1 toFile: file2.
	file1 close.
	file2 close! !


!FileList methodsFor: 'file list menu' stamp: 'sbw 9/21/2002 14:20'!
copyJustFileName
	listIndex = 0
		ifTrue: [^ self].
	Clipboard clipboardText: fileName asText! !

!FileList methodsFor: 'file list menu' stamp: 'sbw 9/23/2002 18:57'!
copySelectedFileToDirectory: aDirectory 
	directory copyFileNamed: fileName toDirectory: aDirectory ! !

!FileList methodsFor: 'file list menu' stamp: 'sbw 9/23/2002 22:32'!
copySelectedFileToNewLocation
	| result |
	listIndex = 0
		ifTrue: [^ self].
	(result _ StandardDirectoryMenu choosePath)
		ifNotNil: [self copySelectedFileToDirectory: result directory]! !

!FileList methodsFor: 'file list menu' stamp: 'sbw 9/23/2002 22:42'!
itemsForAnyFile
	^ #(#('copy name to clipboard' 'copy just file name to clipboard' 'rename' 'delete' 'compress' 'add file to zip' 'copy file to new location') #() #(#copyName #copyJustFileName #renameFile #deleteFile #compressFile #addFileToZip #copySelectedFileToNewLocation) )! !

!FileList methodsFor: 'file list menu' stamp: 'sbw 9/23/2002 22:42'!
perform: selector orSendTo: otherTarget 
	"Selector was just chosen from a menu by a user. If can respond, then 
	perform it on myself. If not, send it to otherTarget, presumably the 
	editPane from which the menu was invoked."
	(#(#get #getHex #browseChanges #sortByDate #sortBySize #sortByName #fileInSelection #fileIntoNewChangeSet #browseChanges #copyName #copyJustFileName #openImageInWindow #importImage #playMidiFile #renameFile #deleteFile #addNewFile #putUpdate #copySelectedFileToNewLocation) includes: selector)
		ifTrue: [^ self perform: selector]
		ifFalse: [^ super perform: selector orSendTo: otherTarget]! !


!FileListTest methodsFor: 'Private' stamp: 'sbw 9/23/2002 16:55'!
createTempDirectoryIn: aDirectory 
	| time dname |
	time _ Time now.
	dname _ time hhmm24 , time seconds printString.
	(aDirectory directoryExists: dname)
		ifTrue: [aDirectory deleteDirectory: dname].
	aDirectory createDirectory: dname.
	^ dname! !

!FileListTest methodsFor: 'Private' stamp: 'sbw 9/23/2002 10:58'!
createTempFileIn: aDirectory
	| time fname fstream |
	time _ Time now.
	fname _ time hhmm24 , time seconds printString , '.tmp'.
	(aDirectory fileExists: fname)
		ifTrue: [aDirectory deleteFileNamed: fname].
	fstream _ aDirectory forceNewFileNamed: fname.
	fstream nextPutAll: self tempFileContents.
	fstream close.
	^ fname! !

!FileListTest methodsFor: 'Private' stamp: 'sbw 9/22/2002 20:58'!
fileListMorph
	^ ((gui allMorphs
		select: [:m | m isKindOf: PluggableListMorph])
		select: [:m | m getListSelector = #fileList]) first!
]style[(13 6 3 22 3 2 1 11 18 14 3 2 1 19 9 8)f1b,f1,f1cmagenta;,f1,f1cred;,f1,f1cblue;i,f1,f1cmagenta;,f1,f1cred;,f1,f1cblue;i,f1,f1c202202126,f1! !

!FileListTest methodsFor: 'Private' stamp: 'sbw 9/22/2002 20:18'!
tempFileContents
	^ 'test'! !

!FileListTest methodsFor: 'Running' stamp: 'sbw 9/23/2002 17:23'!
testFileLocalCopy
	| dir dname subDir fname entry index listMorph originalFileStream copiedFileStream originalContents copiedContents |
	Smalltalk isMorphic
		ifFalse: [^ nil].
	dir _ FileDirectory default.
	dname _ self createTempDirectoryIn: dir.
	subDir _ dir directoryNamed: dname.
	fname _ self createTempFileIn: dir.
	gui _ FileList openAsMorph.
	"Since we just opened up the FileList we can assume it's directory is correct."
	entry _ gui model fileList
				detect: [:each | each includesSubString: fname]
				ifNone: [].
	index _ gui model fileList indexOf: entry.
	listMorph _ self fileListMorph.
	listMorph selectionIndex: index.
	gui model fileListIndex: index.
	"Now that we faked the selection of our test file, ask our FileList to copy 
	the file to our new sub-directory."
	gui model copySelectedFileToDirectory: subDir.
	"See if it's there."
	self assert: (subDir fileExists: fname).
	"How about it's contents?"
	originalFileStream _ dir readOnlyFileNamed: fname.
	copiedFileStream _ subDir readOnlyFileNamed: fname.
	originalContents _ originalFileStream contentsOfEntireFile.
	copiedContents _ copiedFileStream contentsOfEntireFile.
	originalFileStream close.
	copiedFileStream close.
	self assert: originalContents = copiedContents.
	"Done with the files and directory."
	dir deleteFileNamed: fname.
	subDir deleteFileNamed: fname.
	dir deleteDirectory: dname.
	gui delete! !

!FileListTest methodsFor: 'Running' stamp: 'sbw 9/23/2002 15:08'!
testFileNameOperations
	| dir fname entry index listMorph string |
	Smalltalk isMorphic
		ifFalse: [^ nil].
	dir _ FileDirectory default.
	fname _ self createTempFileIn: dir.
	gui _ FileList openAsMorph.
	"Since we just opened up the FileList we can assume it's directory is the 
	same as ours."
	entry _ gui model fileList
				detect: [:each | each includesSubString: fname]
				ifNone: [].
	index _ gui model fileList indexOf: entry.
	listMorph _ self fileListMorph.
	listMorph selectionIndex: index.
	gui model fileListIndex: index.
	"Now that we faked the selection of our test file, ask our FileList to copy 
	the name."
	gui model copyName.
	string _ Clipboard clipboardText string.
	self assert: string
			= (dir fullNameFor: fname).
	gui model copyJustFileName.
	string _ Clipboard clipboardText string.
	self assert: string = fname.
	"Done with the file."
	dir deleteFileNamed: fname.
	gui delete! !


!ServerDirectory methodsFor: 'file directory' stamp: 'sbw 9/24/2002 17:32'!
copyFile: fileStream1 toFile: fileStream2 
	| buffer |
	buffer _ String new: 50000.
	[fileStream1 atEnd]
		whileFalse: [fileStream2
				nextPutAll: (fileStream1 nextInto: buffer)]! !

!ServerDirectory methodsFor: 'file directory' stamp: 'sbw 9/24/2002 17:33'!
copyFileNamed: fileName toDirectory: aDirectory 
	"Copy the contents of the existing file into a directory."
	| file1 file2 |
	self = aDirectory
		ifTrue: [^ nil].
	file1 _ (self readOnlyFileNamed: fileName) binary.
	file2 _ (aDirectory newFileNamed: fileName) binary.
	self copyFile: file1 toFile: file2.
	file1 close.
	file2 close! !


!StandardFileMenu methodsFor: 'private' stamp: 'sbw 9/23/2002 21:49'!
superStartUpWithCaption: aString at: location 
	^ super startUpWithCaption: aString at: location! !


!StandardDirectoryMenu methodsFor: 'as yet unclassified' stamp: 'sbw 9/23/2002 21:21'!
choosePathFrom: aDirectory 
	canTypeFileName _ false.
	^ self makeDirectoryMenuFor: aDirectory! !

!StandardDirectoryMenu methodsFor: 'as yet unclassified' stamp: 'sbw 9/23/2002 21:46'!
fileNamesString: aDirectory 
	"Answer a string concatenating the file name strings in aDirectory, each 
	string followed by a cr."
	^ String
		streamContents: [:s | s nextPutAll: 'SELECT: ' , aDirectory fullName;
				 cr]! !

!StandardDirectoryMenu methodsFor: 'as yet unclassified' stamp: 'sbw 9/23/2002 21:22'!
makeDirectoryMenuFor: aDirectory 
	^ self makeFileMenuFor: aDirectory! !

!StandardDirectoryMenu methodsFor: 'as yet unclassified' stamp: 'sbw 9/28/2002 20:48'!
menuLabelsString: aDirectory 
	"Answer the menu labels object corresponding to aDirectory"
	^ String
		streamContents: [:s | 
			s
				nextPutAll: (self pathPartsString: aDirectory).
			s
				nextPutAll: (self directoryNamesString: aDirectory).
			s
				nextPutAll: (self fileNamesString: aDirectory).
			s skip: -1]! !

!StandardDirectoryMenu methodsFor: 'as yet unclassified' stamp: 'sbw 9/23/2002 21:45'!
menuSelectionsArray: aDirectory 
	"Answer a menu selections object corresponding to aDirectory. The object  
	is an array corresponding to each item, each element itself constituting 
	a two-element array, the first element of which contains a selector to  
	operate on and the second element of which contains the parameters  
	for that selector."
	| dirSize |
	dirSize _ aDirectory pathParts size.
	^ Array
		streamContents: [:s | 
			s
				nextPut: (StandardFileMenuResult directory: FileDirectory root name: '').
			aDirectory pathParts
				doWithIndex: [:d :i | s
						nextPut: (StandardFileMenuResult
								directory: (self advance: dirSize - i containingDirectoriesFrom: aDirectory)
								name: '')].
			aDirectory directoryNames
				do: [:dn | s
						nextPut: (StandardFileMenuResult
								directory: (FileDirectory
										on: (aDirectory fullNameFor: dn))
								name: '')].
			s
				nextPut: (StandardFileMenuResult directory: aDirectory name: nil)]! !

!StandardDirectoryMenu methodsFor: 'as yet unclassified' stamp: 'sbw 9/23/2002 21:47'!
startUpWithCaption: aString at: location 
	| result |
	result _ super superStartUpWithCaption: aString at: location.
	result
		ifNil: [^ nil].
	result isDirectory
		ifTrue: [self makeDirectoryMenuFor: result directory.
			self computeForm.
			^ self startUpWithCaption: aString at: location].
	^ result! !


!StandardDirectoryMenu class methodsFor: 'as yet unclassified' stamp: 'sbw 9/23/2002 21:12'!
choosePath
	^ self choosePathFrom: FileDirectory default! !

!StandardDirectoryMenu class methodsFor: 'as yet unclassified' stamp: 'sbw 9/23/2002 21:12'!
choosePathFrom: aDirectory 
	^ (self choosePathMenu: aDirectory)
		startUpWithCaption: 'Select a Directory'! !

!StandardDirectoryMenu class methodsFor: 'as yet unclassified' stamp: 'sbw 9/23/2002 21:12'!
choosePathMenu: aDirectory 
	Smalltalk isMorphic
		ifFalse: [^ nil].
	^ self new choosePathFrom: aDirectory! !

FileListTest removeSelector: #createTempFile!