[Cuis-dev] Changeset for StandardFileMenu

[Hilaire Fernandes]

Hi,

I refactored the class and add the following behaviors:

  * insert an excludePattern to exclude directories and files. Handy for
    invisible files/directories starting with a dot
  * sort the directories and files in the menu
  * refactored the code and improve understanding

Hilaire
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://lists.cuis.st/mailman/archives/cuis-dev/attachments/20230726/630b4bbe/attachment.htm>
-------------- next part --------------
'From Cuis 6.0 [latest update: #5940] on 25 July 2023 at 11:58:11 pm'!
!classDefinition: #StandardFileMenu category: 'Goodies-Tools-FileList'!
SelectionMenu subclass: #StandardFileMenu
	instanceVariableNames: 'canTypeFileName pattern excludePattern '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Goodies-Tools-FileList'!

!StandardFileMenu commentStamp: '<historical>' prior: 0!
I represent a SelectionMenu which operates like a modal dialog for selecting files, somewhat similar to the StandardFile dialogs in MacOS and Java Swing.

Try for example, the following:

	(StandardFileMenu oldFileFrom: DirectoryEntry smalltalkImageDirectory) inspect
	
	(StandardFileMenu new 
		oldFileFrom: DirectoryEntry smalltalkImageDirectory withPattern: '*.st' excludePattern: '.*';
		startUpWithCaption: 'Pick up a Smalltalk file') 	inspect
	
	((StandardFileMenu new 
		newFileFrom: DirectoryEntry smalltalkImageDirectory withPattern: '*.st') startUpWithCaption: 'dale') inspect!


!StandardFileMenu methodsFor: 'private' stamp: 'hlsf 7/25/2023 17:46:25'!
newFileFrom: aDirectory withPattern: aPattern excludePattern: anotherPattern

	canTypeFileName := true.
	self pattern: aPattern.
	self excludePattern: anotherPattern.
	^self makeFileMenuFor: aDirectory! !

!StandardFileMenu methodsFor: 'private' stamp: 'hlsf 7/25/2023 17:48:02'!
oldFileFrom: aDirectory withPattern: aPattern excludePattern: anotherPattern

	canTypeFileName := false.
	self pattern: aPattern.
	self excludePattern: anotherPattern.
	^self makeFileMenuFor: aDirectory! !

!StandardFileMenu methodsFor: 'pattern' stamp: 'hlsf 7/25/2023 18:02:11'!
excludePattern: patString
" See method pattern: "

	excludePattern := patString substrings! !

!StandardFileMenu methodsFor: 'pattern' stamp: 'hlsf 7/25/2023 17:59:48'!
excludePatternMatches: aString
	^excludePattern anySatisfy: [ :pat | pat match: aString ]! !

!StandardFileMenu methodsFor: 'pattern' stamp: 'hlsf 7/25/2023 23:52:31'!
matchingDirectories: parentDirectory
	^ (parentDirectory directories reject: [: aDirectory |
		self excludePatternMatches: aDirectory name]) sort: [:d1 :d2 | 
			d1 name asLowercase < d2 name asLowercase ]
	! !

!StandardFileMenu methodsFor: 'pattern' stamp: 'hlsf 7/25/2023 23:54:52'!
matchingFiles: parentDirectory
	^ (parentDirectory files select: [: aFile |
		(self excludePatternMatches: aFile name) not 
		and: [self patternMatches: aFile name]]) sort: [:f1 :f2 | 
			f1 name asLowercase < f2 name asLowercase ]
	! !


!StandardFileMenu methodsFor: 'private' stamp: 'hlsf 7/25/2023 17:46:51'!
newFileFrom: aDirectory withPattern: aPattern

	self newFileFrom: aDirectory withPattern: aPattern excludePattern: nil! !

!StandardFileMenu methodsFor: 'private' stamp: 'hlsf 7/25/2023 17:48:32'!
oldFileFrom: aDirectory withPattern: aPattern
	self oldFileFrom: aDirectory withPattern: aPattern excludePattern: nil! !

!StandardFileMenu methodsFor: 'menu building' stamp: 'hlsf 7/25/2023 23:33:54'!
directoryNamesString: aDirectory
"Answer a string concatenating the directory name strings in aDirectory, each string followed by a '[...]' indicator, and followed by a newLine."

	^ String streamContents: 		[:s | 
		(self matchingDirectories: aDirectory) do: 				[:subDirectory |	 
			s nextPutAll: subDirectory name withBlanksTrimmed , ' [...]'; newLine]]

! !

!StandardFileMenu methodsFor: 'menu building' stamp: 'hlsf 7/25/2023 23:45:13'!
fileNamesString: aDirectory
"Answer a string concatenating the file name strings in aDirectory, each string followed by a newLine."

	^String streamContents: 		[:s | 
		(self matchingFiles: aDirectory) do: 	[:file |
			s nextPutAll: file name withBlanksTrimmed; newLine]]! !

!StandardFileMenu methodsFor: 'menu building' stamp: 'hlsf 7/25/2023 23:48:19'!
makeFileMenuFor: aDirectory
"Initialize an instance of me to operate on aDirectory"

	| theMenu |
	pattern ifNil: [ self pattern: '*'].
	excludePattern ifNil: [self excludePattern: ''].
	self 
		labels: 	(self menuLabelsString: aDirectory)
		lines: 	(self menuLinesArray: aDirectory).
	theMenu := self selections: (self menuSelectionsArray: aDirectory).
	^theMenu! !

!StandardFileMenu methodsFor: 'menu building' stamp: 'hlsf 7/25/2023 23:47:12'!
menuLinesArray: aDirectory
"Answer a menu lines object corresponding to aDirectory"

	| typeCount nameCnt dirDepth|
	typeCount := canTypeFileName 
		ifTrue: [1] 
		ifFalse: [0].
	nameCnt := (self matchingDirectories: aDirectory) size.
	dirDepth := aDirectory pathComponents size.
	^Array streamContents: [:s |
		canTypeFileName ifTrue: [s nextPut: 1].
		s nextPut: dirDepth + typeCount + 1.
		s nextPut: dirDepth + nameCnt + typeCount + 1]! !

!StandardFileMenu methodsFor: 'menu building' stamp: 'hlsf 7/25/2023 23:43:56'!
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 pathComponents size.
	^Array streamContents: [:s |
		canTypeFileName ifTrue:
			[s nextPut: (StandardFileMenuResult
				directory: aDirectory
				name: nil)].
		s nextPut: (StandardFileMenuResult
			directory: (DirectoryEntry roots first)
			name: '').
		aDirectory pathComponents withIndexDo: 
			[:d :i | s nextPut: (StandardFileMenuResult
				directory: (self 
					advance: dirSize - i
					containingDirectoriesFrom: aDirectory)
				name: '')].
		(self matchingDirectories: aDirectory)		 do: 
			[:dir | 	s nextPut: (StandardFileMenuResult
					directory: dir
					name: '')].
		(self matchingFiles: aDirectory) do: 
			[:file | 	s nextPut: (StandardFileMenuResult
					directory: aDirectory
					name: file name)]]! !

!methodRemoval: StandardFileMenu #matchingDirectoryName: stamp: 'hlsf 7/25/2023 23:38:36'!
StandardFileMenu removeSelector: #matchingDirectoryName:!
!methodRemoval: StandardFileMenu #excludePpattern: stamp: 'hlsf 7/25/2023 17:24:59'!
StandardFileMenu removeSelector: #excludePpattern:!
!classDefinition: #StandardFileMenu category: 'Goodies-Tools-FileList'!
SelectionMenu subclass: #StandardFileMenu
	instanceVariableNames: 'canTypeFileName pattern excludePattern'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Goodies-Tools-FileList'!

!StandardFileMenu reorganize!
('private' advance:containingDirectoriesFrom: newFileFrom:withPattern: newFileFrom:withPattern:excludePattern: oldFileFrom: oldFileFrom:withPattern: oldFileFrom:withPattern:excludePattern:)
('basic control sequences' confirmExistingFiles: getTypedFileName: startUpWithCaption:at:allowKeyboard:)
('menu building' directoryNamesString: fileNamesString: makeFileMenuFor: menuLabelsString: menuLinesArray: menuSelectionsArray: pathPartsString:)
('pattern' excludePattern: excludePatternMatches: matchingDirectories: matchingFiles: pattern: patternMatches:)
!