Lost in Squeak world....

Rick ricardosbc at netwave.com.br
Mon Feb 12 22:08:24 UTC 2001


>(Andrew C. Greenberg)

> >I  started my project copying the PluggableFileList class renaming it - this
> >window is the closest one to my aim - and then began modifying all
> >necessary to
> >fit my needs.
>
> You might find it far better to start off with a subclass, rather
> than just copying the code wholesale.

Sorry, I meant subclass. It is a FileList subclass. And I copyed it just for
begginning my project. At the end it will be completely different.

> When
> >the application window is opened, editionView is correctly
> >displaying that line,
> >but when I click to select a file name in fileListView pane, nothing happens
>
> Unsurprising behavior -- you might consider defining selectors for
> the selected: and changeSelected: keywords.

Sorry again. Browsing and experiencing with PluggableTest as suggested by Bijan
Parsia I found that #artist and #artist: selectors have nothing with the pane
updating, and can be erased without modifying the panes behavior.

>(Bijan Parsia)
>Added where in the method? (I'm grasping here ;)) Can we see this method?
At this point I have added it everywhere you can imagine, to see if any works...

> I'd have to muck with your code to figure out better
what was going on....

>(Ned Konz)
>We can't see your cde, but (....)

Ok, guys, here you have. I filed out my subclass as it is right now. But to see the
window in correct size ( if you are going to file in instead of just looking at it
) please make the following change in ModalSystemWindowView|doModalDialog  method
->
          self resizeTo: model fullScreenSize.

Thank you all for trying help me!  :-)

PS: This is a rebuilt of a project I did using Smalltalk Express. My original
project works perfectly, but as I said it have a little inconvenience: all file
names are displayed in DOS format and this causes some confusion to my end
users.... The application purpose is to generate special playlists for winamp, and
it is to be used in my radio station.
-------------- next part --------------
'From Squeak2.8 of 13 June 2000 [latest update: #2359] on 12 February 2001 at 4:50:21 pm'!
ModalSystemWindowView subclass: #ProgramadorView
	instanceVariableNames: 'acceptButtonView '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Tools-FileList'!

!ProgramadorView methodsFor: 'as yet unclassified' stamp: 'Ricardo Camargo 2/10/2001 09:18'!
label: aString

	super label: aString.
	self noLabel! !

!ProgramadorView methodsFor: 'as yet unclassified'!
update: aSymbol
 
	^super update: aSymbol! !
-------------- next part --------------
'From Squeak2.8 of 13 June 2000 [latest update: #2359] on 12 February 2001 at 5:51:40 pm'!
FileList subclass: #Programador
	instanceVariableNames: 'accepted fileFilterBlock canAcceptBlock validateBlock newFiles prompt resultBlock '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Tools-FileList'!

!Programador methodsFor: 'initialize-release' stamp: 'Ricardo Camargo 2/9/2001 18:06'!
defaultBackgroundColor

	^Color lightYellow! !

!Programador methodsFor: 'initialize-release'!
initialize

	Editada _ OrderedCollection new.
Editada add: 'Lista Nova'.
	directory _ FileDirectory default.
	newFiles _ OrderedCollection new.
	fileFilterBlock _ PluggableFileList allFilesAndFoldersFileFilter.
	canAcceptBlock _ PluggableFileList fileNameSelectedAcceptBlock.
	resultBlock _ PluggableFileList pathNameResultBlock.
	validateBlock _ PluggableFileList checkExistingFileValidateBlock.
! !

!Programador methodsFor: 'initialize-release'!
open
	"Open a view of an instance of me."
	"Programador new open"
	| topView tituloView closeView volListView editionView fileListView gravarButtonView limparButtonView mesclarButtonView optarButtonView selecionaTudoButtonView tipsView |
	
	self directory: directory.
	topView _ (ProgramadorView new)
		model: self.

	tituloView _ PluggableButtonView 
		on: self
		getState: nil
		action: nil.
	tituloView
		label: 'SPMRC - Super Programador Musical para R?dio Comunit?ria';
		backgroundColor: Color green;
		borderWidth: 1;
		window: (0 at 0 extent: 365 at 15).
	topView addSubView: tituloView.

	closeView _ PluggableButtonView 
		on: self
		getState: nil
		action: #fechar.
	closeView
		label: 'X';
		backgroundColor: Color red;
		borderWidth: 1;
		window: (0 at 0 extent: 15 at 15).
	topView addSubView: closeView toRightOf: tituloView.


	volListView _ PluggableListView on: self
		list: #volumeList
		selected: #volumeListIndex
		changeSelected: #volumeListIndex:
		menu: nil.
	volListView autoDeselect: false.
	volListView window: (0 at 0 extent: 180 at 145).
	topView addSubView: volListView below: tituloView.

	fileListView _ PluggableListView on: self
		list: #fileList
		selected: #fileListIndex
		changeSelected: #fileListIndx:
		menu: nil.
	fileListView window: (0 at 0 extent: 180 at 145).
	topView addSubView: fileListView below: volListView.

	editionView _ PluggableListView on: self
		list: #editar
		selected: nil
		changeSelected: nil
		menu: nil.
	editionView window: (0 at 0 extent: 200 at 137).
	topView addSubView: editionView toRightOf: volListView.

	selecionaTudoButtonView _ PluggableButtonView 
		on: self
		getState: nil
		action: #selecionaButtonPressed.
	selecionaTudoButtonView
		label: 'Selecionar Tudo';
		backgroundColor: Color green;
		borderWidth: 1;
		window: (0 at 0 extent: 180 at 15).

	gravarButtonView _ PluggableButtonView 
		on: self
		getState: nil
		action: nil.
	gravarButtonView
		label: 'Gravar';
		backgroundColor: Color red;
		borderWidth: 2;
		window: (0 at 0 extent: 50 at 15).

	limparButtonView _ PluggableButtonView
		on: self
		getState: nil
		action: nil.
	limparButtonView
		label: 'Limpar';
		window: (0 at 0 extent: 50 at 15);
		borderWidth: 1.

	mesclarButtonView _ PluggableButtonView 
		on: self
		getState: nil
		action: nil.
	mesclarButtonView
		label: 'Mesclar';
		borderWidth: 1;
		window: (0 at 0 extent: 50 at 15).

	optarButtonView _ PluggableButtonView
		on: self
		getState: nil
		action: #rightButtonPressed.
	optarButtonView
		label: 'Menu';
		borderWidth: 1;
		window: (0 at 0 extent: 50 at 15).

	topView
		addSubView: selecionaTudoButtonView below: fileListView;
		addSubView: gravarButtonView below: editionView;
		addSubView: limparButtonView toRightOf: gravarButtonView;
		addSubView: mesclarButtonView toRightOf: limparButtonView;
		addSubView: optarButtonView toRightOf: mesclarButtonView.

	tipsView _ PluggableTextView on: self 
			text: nil 
			accept: nil
			readSelection: nil 
			menu: nil.
	tipsView controller: ReadOnlyTextController new.
	tipsView window: (0 at 0 extent: 200 at 153).
	topView addSubView: tipsView below: gravarButtonView.

	self changed: #getSelectionSel.
	topView doModalDialog.
	
! !


!Programador methodsFor: 'accessing'!
fileListIndex

	self changed: #fileString.
	self changed: #editar.
	^super fileListIndex! !

!Programador methodsFor: 'accessing' stamp: 'Ricardo Camargo 2/9/2001 18:06'!
fileVolumeIndex

	self changed: #fileString.
	^super fileVolumeIndex! !


!Programador methodsFor: 'accepting/cancelling' stamp: 'Ricardo Camargo 2/12/2001 16:04'!
fechar


	self changed: #close.
! !


!Programador methodsFor: 'file string'!
fileString

	fileName ifNil: [^directory pathName].
	Editada add: (directory fullNameFor: fileName).
	self changed: #editar.
	^directory fullNameFor: fileName! !

!Programador methodsFor: 'file string' stamp: 'Ricardo Camargo 2/9/2001 18:06'!
fileString: aString

	"| textName index ending |
	textName _ aString asString.
	(FileDirectory default fileExists: textName) ifTrue:
		[self directory: (FileDirectory forFileName: textName).
		 index _ list indexOf: (FileDirectory localNameFor: textName).
		 index = 0 ifTrue: 
			[ending _ ') ', (FileDirectory localNameFor: textName).
		  	 index _ list findFirst: [:line | line endsWith: ending]].
		 self fileListIndex: index].
	(FileDirectory default directoryExists: textName) ifTrue:
		[self directory: (FileDirectory on: textName)]."
	self changed: #fileString.
	self changed: #contents.
	^true! !


!Programador methodsFor: 'as yet unclassified'!
atualizar
	^ Editada! !

!Programador methodsFor: 'as yet unclassified'!
editar

	^ Editada! !

!Programador methodsFor: 'as yet unclassified'!
fileListIndx: anInteger
	"Select the file name having the given index, and display its contents."

	| item name |
	self okToChange ifFalse: [^ self].
	listIndex := anInteger.
	listIndex = 0 
		ifTrue: [fileName := nil]
		ifFalse:
			[item := self fileNameFromFormattedItem: (list at: anInteger).
			(item endsWith: self folderString)
				ifTrue:
					["remove [...] folder string and open the folder"
					name := item copyFrom: 1 to: item size - self folderString size.
					listIndex := 0.
					brevityState := #FileList.
					self addPath: name.
					volListIndex = 1 ifTrue: [name _ name, directory slash].
							self directory: (directory directoryNamed: name)]
				ifFalse: [fileName := item].
			
				(fileName = nil) ifFalse: [Editada add: fileName asString].
				self changed: #editar]. 

	self changed: #fileListIndex.
	self changed: #getSelectionSel.
	self changed: #editar! !

!Programador methodsFor: 'as yet unclassified' stamp: 'Ricardo Camargo 2/9/2001 22:00'!
selecionaButtonPressed
	^nil! !

"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!

Programador class
	instanceVariableNames: ''!

!Programador class methodsFor: 'instance creation' stamp: 'Ricardo Camargo 2/9/2001 18:06'!
new

	^super new initialize! !

!Programador class methodsFor: 'instance creation' stamp: 'Ricardo Camargo 2/9/2001 18:06'!
open

	^self new open! !


More information about the Squeak-dev mailing list