Browser subclass: #ScopedBrowser
	instanceVariableNames: 'includedCategories excludedClasses includedClasses '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'MakingSmalltalk-Article5'!
!ScopedBrowser commentStamp: 'JRS 3/18/2001 21:24' prior: 0!
I'm an extension that allows for scoping the protocols and/or classes viewable in a browser.  My intention is to be for educational purposes, to help simplify and direct students to specific classes to help them avoid being overwhelmed by the large class library available in Squeak.

See my class protocols for examples of my use.!


!ScopedBrowser methodsFor: 'class list' stamp: 'JRS 3/18/2001 17:15'!
classList
	"Override this method to:
		* look up the category index from the system category list, as the browser category index is expected to be different than the system category lists index.
		* reject/include any excluded/included classes
	Answer an array of the class names of the selected category. Answer an empty array if no selection exists."
	| categoryClasses |
	"Use temporary variable here, instead of block variable as I've heard Squeak has/had trouble with block variables."

	systemCategoryListIndex = 0
		ifTrue: [^Array new]
		ifFalse: [categoryClasses := (systemOrganizer listAtCategoryNumber: (systemOrganizer categories indexOf: self selectedSystemCategoryName asSymbol)). 
				"The implicit logic here, is that if there are both no included and no excluded classes - no class scope was specified - don't reject any classes."
				self includedClasses isNil
					ifTrue: [^categoryClasses reject: [:e | self excludedClasses includes: e]]
					ifFalse: [^categoryClasses select: [:e | self includedClasses includes: e]]].! !


!ScopedBrowser methodsFor: 'system category list' stamp: 'JRS 11/19/2000 09:16'!
systemCategoryList
	"Override this method to answer the scoped class categories modeled by the receiver."

	^self includedCategories select: [:e | systemOrganizer categories includes: e]! !


!ScopedBrowser methodsFor: 'accessing' stamp: 'JRS 11/14/2000 09:05'!
excludedClasses 

	^excludedClasses ! !

!ScopedBrowser methodsFor: 'accessing' stamp: 'JRS 11/14/2000 09:06'!
excludedClasses: aCollectionOfClasses 

	^excludedClasses := aCollectionOfClasses.! !

!ScopedBrowser methodsFor: 'accessing' stamp: 'JRS 11/14/2000 09:05'!
includedCategories

	^includedCategories! !

!ScopedBrowser methodsFor: 'accessing' stamp: 'JRS 11/14/2000 09:06'!
includedCategories: aCollectionOfCategories

	^includedCategories := aCollectionOfCategories! !

!ScopedBrowser methodsFor: 'accessing' stamp: 'JRS 12/12/2000 09:26'!
includedClasses 

	^includedClasses ! !

!ScopedBrowser methodsFor: 'accessing' stamp: 'JRS 12/12/2000 09:26'!
includedClasses: aCollectionOfClasses 

	^includedClasses := aCollectionOfClasses.! !

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

ScopedBrowser class
	instanceVariableNames: ''!

!ScopedBrowser class methodsFor: 'instance creation' stamp: 'JRS 3/18/2001 21:13'!
openBrowserWithCategories: aCollectionOfCategorySymbols 

	^self openBrowserWithCategories: aCollectionOfCategorySymbols 
		withoutClasses: OrderedCollection new
		withLabelSuffix: 'Unknown scope'! !

!ScopedBrowser class methodsFor: 'instance creation' stamp: 'JRS 3/18/2001 21:13'!
openBrowserWithCategories: aCollectionOfCategorySymbols withClasses: aCollectionOfClassSymbols

	^self openBrowserWithCategories: aCollectionOfCategorySymbols 
		withClasses: aCollectionOfClassSymbols
		withLabelSuffix: 'Unknown scope'! !

!ScopedBrowser class methodsFor: 'instance creation' stamp: 'JRS 3/18/2001 21:14'!
openBrowserWithCategories: aCollectionOfCategorySymbols withClasses: aCollectionOfClassSymbols withLabelSuffix: aLabelSuffix

	| aScopedBrowser |

	aScopedBrowser := self new.
	aScopedBrowser includedCategories: aCollectionOfCategorySymbols.
	aScopedBrowser includedClasses: aCollectionOfClassSymbols.
	self openBrowserView: (aScopedBrowser openEditString: nil)
			label: 'Scoped Browser: ', aLabelSuffix.
	^aScopedBrowser		! !

!ScopedBrowser class methodsFor: 'instance creation' stamp: 'JRS 3/18/2001 21:14'!
openBrowserWithCategories: aCollectionOfCategorySymbols withoutClasses: aCollectionOfClassSymbols

	^self openBrowserWithCategories: aCollectionOfCategorySymbols 
		withoutClasses: aCollectionOfClassSymbols
		withLabelSuffix: 'Unknown scope'! !

!ScopedBrowser class methodsFor: 'instance creation' stamp: 'JRS 3/18/2001 21:14'!
openBrowserWithCategories: aCollectionOfCategorySymbols withoutClasses: aCollectionOfClassSymbols withLabelSuffix: aLabelSuffix

	| aScopedBrowser |

	aScopedBrowser := self new.
	aScopedBrowser includedCategories: aCollectionOfCategorySymbols.
	aScopedBrowser excludedClasses: aCollectionOfClassSymbols.
	self openBrowserView: (aScopedBrowser openEditString: nil)
			label: 'Scoped Browser: ', aLabelSuffix.
	^aScopedBrowser		! !


!ScopedBrowser class methodsFor: 'instance creation - Making Smalltalk' stamp: 'JRS 3/18/2001 17:20'!
openBrowserForArticle3
	"Scopes the browser for Making Smalltalk 
	(www.magma.ca/~jagwar/makingSmalltalkForwardingPage.html, article 3"
	"self openBrowserForArticle3"

	self openBrowserWithCategories: (OrderedCollection new 
			add: 'Collections-Abstract' asSymbol; 
			add: 'Collections-Sequenceable' asSymbol;
			add: 'Collections-Unordered' asSymbol;
			yourself)
		withoutClasses: (OrderedCollection new
			add: #ArrayedCollection;
			add: #SharedQueue;
			add: #MappedCollection;
			add: #Interval;
			add: #IdentityDictionary;
			add: #IdentitySet;
			add: #PluggableDictionary;
			add: #PluggableSet;
			yourself)
		withLabelSuffix: 'Making Smalltalk - Article 3 scope'! !

!ScopedBrowser class methodsFor: 'instance creation - Making Smalltalk' stamp: 'JRS 3/18/2001 17:19'!
openBrowserForArticle4
	"Scopes the browser for Making Smalltalk 
	(www.magma.ca/~jagwar/makingSmalltalkForwardingPage.html, article 4"
	"self openBrowserForArticle4"

	self openBrowserWithCategories: (OrderedCollection new 
			add: 'Collections-Abstract' asSymbol; 
			add: 'Collections-Sequenceable' asSymbol;
			add: 'Collections-Unordered' asSymbol;
			add: 'Kernel-Objects' asSymbol;
			add: 'Kernel-ST80 Remnants';
			add: 'MakingSmalltalk-Article2' asSymbol;
			add: 'MakingSmalltalk-Article4' asSymbol;
			yourself)
		withClasses: (OrderedCollection new
			add: #Collection;
			add: #SequenceableCollection;

			add: #Heap;
			add: #LinkedList;
			add: #OrderedCollection;
			add: #SortedCollection;

			add: #Bag;
			add: #Dictionary;
			add: #Set;

			add: #Boolean;
			add: #False;
			add: #Object;
			add: #True;

			add: #Workspace;

			add: #Person;
			add: #ScopedBrowser;
			yourself)
		withLabelSuffix: 'Making Smalltalk - Article 4 scope'! !


!ScopedBrowser class methodsFor: 'manual unit testing' stamp: 'JRS 3/18/2001 21:20'!
openBrowserTest1
	"Note:  As of Squeak 3.0, SUnit has been included with the base image.  To run SUnit automatic tests, see ScopedBrowserTestCase class comment.  This manual test case has been left in for reference for now."
	"Test category scope creation method - browser should open with 1 protocol and 3 classes"
	"self openBrowserTest1"

	self openBrowserWithCategories: (OrderedCollection new 
			add: 'Collections-Abstract' asSymbol;
			yourself)! !

!ScopedBrowser class methodsFor: 'manual unit testing' stamp: 'JRS 3/18/2001 21:20'!
openBrowserTest2
	"Note:  As of Squeak 3.0, SUnit has been included with the base image.  To run SUnit automatic tests, see ScopedBrowserTestCase class comment.  This manual test case has been left in for reference for now."
	"Test exclude classes creation method - browser should open with 1 protocol and 2 classes"
	"self openBrowserTest2"

	self openBrowserWithCategories: (OrderedCollection new 
			add: 'Collections-Abstract' asSymbol;
			yourself)
		withoutClasses: (OrderedCollection new
			add: #Collection;
			yourself)! !

!ScopedBrowser class methodsFor: 'manual unit testing' stamp: 'JRS 3/18/2001 21:20'!
openBrowserTest3
	"Note:  As of Squeak 3.0, SUnit has been included with the base image.  To run SUnit automatic tests, see ScopedBrowserTestCase class comment.  This manual test case has been left in for reference for now."
	"Test exclude classes creation method - browser should open with 1 protocol and 2 classes"
	"self openBrowserTest3"

	self openBrowserWithCategories: (OrderedCollection new 
			add: 'Collections-Abstract' asSymbol;
			yourself)
		withoutClasses: (OrderedCollection new
			add: #Collection;
			yourself)
		withLabelSuffix: 'Testing Scope'! !

!ScopedBrowser class methodsFor: 'manual unit testing' stamp: 'JRS 3/18/2001 21:20'!
openBrowserTest4
	"Note:  As of Squeak 3.0, SUnit has been included with the base image.  To run SUnit automatic tests, see ScopedBrowserTestCase class comment.  This manual test case has been left in for reference for now."
	"Test instantiating with a non-existant category - browser should open with 1 protocol and 2 classes"
	"self openBrowserTest4"

	self openBrowserWithCategories: (OrderedCollection new 
			add: 'asdfasdfd-ereeff' asSymbol; 
			add: 'Collections-Abstract' asSymbol;
			yourself)
		withoutClasses: (OrderedCollection new
			add: #Collection;
			yourself)
		withLabelSuffix: 'Testing nonexistant category'! !

!ScopedBrowser class methodsFor: 'manual unit testing' stamp: 'JRS 3/18/2001 21:20'!
openBrowserTest5
	"Note:  As of Squeak 3.0, SUnit has been included with the base image.  To run SUnit automatic tests, see ScopedBrowserTestCase class comment.  This manual test case has been left in for reference for now."
	"Test instantiating with a non-existant class to exclude - browser should open with 1 protocol and 3 classes"
	"self openBrowserTest5"

	self openBrowserWithCategories: (OrderedCollection new 
			add: 'asdfasdfd-ereeff' asSymbol; 
			add: 'Collections-Abstract' asSymbol;
			yourself)
		withoutClasses: (OrderedCollection new
			add: #Aadfdfefff;
			yourself)
		withLabelSuffix: 'Testing nonexistant class to exclude'! !

!ScopedBrowser class methodsFor: 'manual unit testing' stamp: 'JRS 3/18/2001 21:21'!
openBrowserTest6
	"Note:  As of Squeak 3.0, SUnit has been included with the base image.  To run SUnit automatic tests, see ScopedBrowserTestCase class comment.  This manual test case has been left in for reference for now."
	"Test include classes creation method - browser should open with 1 protocol and 1 class"
	"self openBrowserTest6"

	self openBrowserWithCategories: (OrderedCollection new 
			add: 'Collections-Abstract' asSymbol;
			yourself)
		withClasses: (OrderedCollection new
			add: #Collection;
			yourself)! !

!ScopedBrowser class methodsFor: 'manual unit testing' stamp: 'JRS 3/18/2001 21:21'!
openBrowserTest7
	"Note:  As of Squeak 3.0, SUnit has been included with the base image.  To run SUnit automatic tests, see ScopedBrowserTestCase class comment.  This manual test case has been left in for reference for now."
	"Test include classes creation method - browser should open with 1 protocol and 1 class"
	"self openBrowserTest7"

	self openBrowserWithCategories: (OrderedCollection new 
			add: 'Collections-Abstract' asSymbol;
			yourself)
		withClasses: (OrderedCollection new
			add: #Collection;
			yourself)
		withLabelSuffix: 'Testing Scope'! !

!ScopedBrowser class methodsFor: 'manual unit testing' stamp: 'JRS 3/18/2001 21:21'!
openBrowserTest8
	"Note:  As of Squeak 3.0, SUnit has been included with the base image.  To run SUnit automatic tests, see ScopedBrowserTestCase class comment.  This manual test case has been left in for reference for now."
	"Test instantiating with a non-existant class to include - browser should open with 1 protocol and 0 classes"
	"self openBrowserTest8"

	self openBrowserWithCategories: (OrderedCollection new 
			add: 'asdfasdfd-ereeff' asSymbol; 
			add: 'Collections-Abstract' asSymbol;
			yourself)
		withClasses: (OrderedCollection new
			add: #Aadfdfefff;
			yourself)
		withLabelSuffix: 'Testing nonexistant class to include'! !


!ScopedBrowser class methodsFor: 'testing' stamp: 'JRS 3/18/2001 17:19'!
testedWithSqueakVersion
	"These extensions were last tested with this version of Squeak."

	^3.0! !

!ScopedBrowser class methodsFor: 'testing' stamp: 'JRS 3/18/2001 17:18'!
version

	^1.2! !


TestCase subclass: #ScopedBrowserTestCase
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'MakingSmalltalk-Article5'!
!ScopedBrowserTestCase commentStamp: 'JRS 3/18/2001 21:23' prior: 0!
TestCase class for the ScopedBrowser using SUnit included with Squeak 3.0.  

To run, do: 'TestModel openAsMorph', then click on the 'run' button.!


!ScopedBrowserTestCase methodsFor: 'testing' stamp: 'JRS 3/18/2001 21:16'!
testOpenBrowser1
	| testBrowser |
	"Test category scope creation method - browser should open with 1 protocol and 3 classes"

	testBrowser := ScopedBrowser openBrowserWithCategories: (OrderedCollection new 
			add: 'Collections-Abstract' asSymbol;
			yourself).
	self should: [testBrowser systemCategoryList size = 1].
	self should: [testBrowser selectCategoryForClass: ArrayedCollection.
				testBrowser classList size = 3].

	"FIXME - there must be a better way to close this morph, but this code works for now."
	testBrowser dependents first closeBoxHit.! !

!ScopedBrowserTestCase methodsFor: 'testing' stamp: 'JRS 3/18/2001 21:16'!
testOpenBrowser2
	| testBrowser |
	"Test exclude classes creation method - browser should open with 1 protocol and 2 classes"

	testBrowser := ScopedBrowser openBrowserWithCategories: (OrderedCollection new 
			add: 'Collections-Abstract' asSymbol;
			yourself)
		withoutClasses: (OrderedCollection new
			add: #Collection;
			yourself).
	self should: [testBrowser systemCategoryList size = 1].
	self should: [testBrowser selectCategoryForClass: ArrayedCollection.
				testBrowser classList size = 2].

	"FIXME - there must be a better way to close this morph, but this code works for now."
	testBrowser dependents first closeBoxHit.! !

!ScopedBrowserTestCase methodsFor: 'testing' stamp: 'JRS 3/18/2001 21:17'!
testOpenBrowser3
	| testBrowser |
	"Test exclude classes creation method - browser should open with 1 protocol and 2 classes"

	testBrowser := ScopedBrowser openBrowserWithCategories: (OrderedCollection new 
			add: 'Collections-Abstract' asSymbol;
			yourself)
		withoutClasses: (OrderedCollection new
			add: #Collection;
			yourself)
		withLabelSuffix: 'Testing Scope'.
	self should: [testBrowser systemCategoryList size = 1].
	self should: [testBrowser selectCategoryForClass: ArrayedCollection.
				testBrowser classList size = 2].

	"FIXME - there must be a better way to close this morph, but this code works for now."
	testBrowser dependents first closeBoxHit.! !

!ScopedBrowserTestCase methodsFor: 'testing' stamp: 'JRS 3/18/2001 21:17'!
testOpenBrowser4
	| testBrowser |
	"Test instantiating with a non-existant category - browser should open with 1 protocol and 2 classes"

	testBrowser := ScopedBrowser openBrowserWithCategories: (OrderedCollection new 
			add: 'asdfasdfd-ereeff' asSymbol; 
			add: 'Collections-Abstract' asSymbol;
			yourself)
		withoutClasses: (OrderedCollection new
			add: #Collection;
			yourself)
		withLabelSuffix: 'Testing nonexistant category'.
	self should: [testBrowser systemCategoryList size = 1].
	self should: [testBrowser selectCategoryForClass: ArrayedCollection.
				testBrowser classList size = 2].

	"FIXME - there must be a better way to close this morph, but this code works for now."
	testBrowser dependents first closeBoxHit.! !

!ScopedBrowserTestCase methodsFor: 'testing' stamp: 'JRS 3/18/2001 21:15'!
testOpenBrowser5
	| testBrowser |
	"Test instantiating with a non-existant class to exclude - browser should open with 1 protocol and 3 classes"

	testBrowser := ScopedBrowser openBrowserWithCategories: (OrderedCollection new 
			add: 'asdfasdfd-ereeff' asSymbol; 
			add: 'Collections-Abstract' asSymbol;
			yourself)
		withoutClasses: (OrderedCollection new
			add: #Aadfdfefff;
			yourself)
		withLabelSuffix: 'Testing nonexistant class to exclude'.
	self should: [testBrowser systemCategoryList size = 1].	
	self should: [testBrowser selectCategoryForClass: ArrayedCollection.
				testBrowser classList size = 3].

	"FIXME - there must be a better way to close this morph, but this code works for now."
	testBrowser dependents first closeBoxHit.! !

!ScopedBrowserTestCase methodsFor: 'testing' stamp: 'JRS 3/18/2001 21:17'!
testOpenBrowser6
	| testBrowser |
	"Test include classes creation method - browser should open with 1 protocol and 1 class"

	testBrowser := ScopedBrowser openBrowserWithCategories: (OrderedCollection new 
			add: 'Collections-Abstract' asSymbol;
			yourself)
		withClasses: (OrderedCollection new
			add: #Collection;
			yourself).
	self should: [testBrowser systemCategoryList size = 1].
	self should: [testBrowser selectCategoryForClass: ArrayedCollection.
				testBrowser classList size = 1].

	"FIXME - there must be a better way to close this morph, but this code works for now."
	testBrowser dependents first closeBoxHit.! !

!ScopedBrowserTestCase methodsFor: 'testing' stamp: 'JRS 3/18/2001 21:17'!
testOpenBrowser7
	| testBrowser |
	"Test include classes creation method - browser should open with 1 protocol and 1 class"

	testBrowser := ScopedBrowser openBrowserWithCategories: (OrderedCollection new 
			add: 'Collections-Abstract' asSymbol;
			yourself)
		withClasses: (OrderedCollection new
			add: #Collection;
			yourself)
		withLabelSuffix: 'Testing Scope'.
	self should: [testBrowser systemCategoryList size = 1].
	self should: [testBrowser selectCategoryForClass: ArrayedCollection.
				testBrowser classList size = 1].

	"FIXME - there must be a better way to close this morph, but this code works for now."
	testBrowser dependents first closeBoxHit.! !

!ScopedBrowserTestCase methodsFor: 'testing' stamp: 'JRS 3/18/2001 21:16'!
testOpenBrowser8
	| testBrowser |
	"Test instantiating with a non-existant class to include - browser should open with 1 protocol and 0 classes"

	testBrowser := ScopedBrowser openBrowserWithCategories: (OrderedCollection new 
			add: 'asdfasdfd-ereeff' asSymbol; 
			add: 'Collections-Abstract' asSymbol;
			yourself)
		withClasses: (OrderedCollection new
			add: #Aadfdfefff;
			yourself)
		withLabelSuffix: 'Testing nonexistant class to include'.
	self should: [testBrowser systemCategoryList size = 1].
	self should: [testBrowser selectCategoryForClass: ArrayedCollection.
				testBrowser classList size = 0].

	"FIXME - there must be a better way to close this morph, but this code works for now."
	testBrowser dependents first closeBoxHit.! !