[comp.lang.smalltalk] A Goodies for the ScreenController

bnfb@geocub.greco-prog.fr (Freeman Benson) (03/21/90)

Here is a goodie that changes the ScreenController menu item
"file editor" to provide a menu of choices rather than requiring
you to type in a name.  It works in ParcPlace 2.3 on the Macintosh.
It may work on others as well, but I haven't tested it.

Enjoy,
Bjorn N. Freeman-Benson

'From Smalltalk-80, Version 2.3 of 13 June 1988 on 21 March 1990 at 2:44:42 pm'!


PopUpMenu subclass: #LeftPopUpMenu
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Interface-Menus'!


!LeftPopUpMenu methodsFor: 'private'!

labels: aString font: aFont lines: anArray
	| style labelPara |
	labelString _ aString.
	font _ aFont.
	style _ TextStyle fontArray: (Array with: font).
	style alignment: 0.  "left"
	style gridForFont: 1 withLead: 0.
	labelPara _ Paragraph withText: aString asText style: style.
	lineArray _ anArray.
	form _ labelPara asForm.
	frame _ Quadrangle new.
	frame region: (labelPara compositionRectangle expandBy: 2).
	frame borderWidth: (1@1 corner: 3@3).
	lineArray == nil
	  ifFalse:
		[lineArray do:
			[:line |
			form fill: (0 @ (line * font height) extent: (frame width @ 1)) 
				mask: Form black]].
	marker _ frame inside topLeft extent: frame inside width @ labelPara lineGrid.
	selection _ 0! !

'From Smalltalk-80, Version 2.3 of 13 June 1988 on 21 March 1990 at 4:18:08 pm'!



!ScreenController methodsFor: 'menu messages'!

openFileEditor
	"Prompt for a file name and open an editor on it."

	| aString |
	Sensor leftShiftDown
		ifTrue: [aString _ FillInTheBlank request: 'Please type a file name: ' initialAnswer: 'fileName.st']
		ifFalse: 
			[aString _ FileDirectory default selectFileNameViaMenu.
			aString isNil ifTrue: [aString _ '']].
	aString = '' ifFalse: [(FileStream fileNamed: aString) edit]! !


!FileDirectory methodsFor: 'user interface'!

selectFileNameViaMenu
	| currentDir ws fileList actionList volList parentDirName idx idxOffset theSelectedFile |
	currentDir _ self.
	
	[ws _ String new writeStream.
	actionList _ OrderedCollection new.
	parentDirName _ currentDir fullName copyFrom: 1 to: currentDir fullName size - currentDir name size.
	parentDirName isEmpty
		ifTrue: 
			[fileList _ SystemCall default getVolumeNames.
			volList _ OrderedCollection new.
			fileList do: [:each | each , FileDirectory separatorString ~= currentDir fullName
					ifTrue: 
						[actionList addLast: true.
						volList addLast: each.
						ws nextPutAll: each; nextPutAll: FileDirectory separatorString; cr]].
			fileList do: [:each | each , FileDirectory separatorString = currentDir fullName
					ifTrue: 
						[actionList addLast: true.
						volList addLast: each.
						ws nextPutAll: each; nextPutAll: FileDirectory separatorString; cr]].
			volList _ volList asArray]
		ifFalse: 
			[actionList addLast: true.
			ws nextPutAll: currentDir fullName; cr].
	idxOffset _ actionList size.
	fileList _ currentDir contents.
	fileList do: 
		[:each | 
		ws tab; nextPutAll: each; cr.
		actionList addLast: false].
	fileList _ (fileList collect: [:each | currentDir fullName , each]) asArray.
	actionList _ actionList asArray.
	ws skip: -1.
	idx _ (LeftPopUpMenu labels: ws contents) startUp.
	idx = 0 ifTrue: [^nil].
	(actionList at: idx)
		ifTrue: [parentDirName isEmpty
				ifTrue: [currentDir _ FileDirectory named: (volList at: idx)]
				ifFalse: [currentDir _ FileDirectory named: parentDirName]]
		ifFalse: 
			[theSelectedFile _ fileList at: idx - idxOffset.
			(FileDirectory isDirectory: theSelectedFile)
				ifTrue: [currentDir _ FileDirectory named: theSelectedFile]
				ifFalse: [^theSelectedFile]].
	true] whileTrue! !