[ENH] PackageBrowser for 2.6

Stephen Travis Pope stp at create.ucsb.edu
Thu Dec 2 20:42:47 UTC 1999


--------------C4980A6B35F0531092238CAF
Content-Type: text/plain; charset=us-ascii
Content-Transfer-Encoding: 7bit



Hi,

I've made a stand-alone (i,.e., one that doesn't require the STP12 goodies) file-in for the PackageBrowser (AKA six-paned browser). It's attached. Bug reports are solicited...

-- 
stp

Stephen Travis Pope  --  http://www.create.ucsb.edu/~stp
stp at expertcity.com   --  stp9 at cornell.edu
--------------C4980A6B35F0531092238CAF
Content-Type: text/plain; charset=us-ascii;
 name="PackageBrowser.2Dece1216pm.cs"
Content-Transfer-Encoding: 7bit
Content-Disposition: inline;
 filename="PackageBrowser.2Dece1216pm.cs"


'From Squeak2.6 of 11 October 1999 [latest update: #1559] on 2 December 1999 at 12:16:01 pm'!
Browser subclass: #PackageBrowser
	instanceVariableNames: 'package packageListIndex packageList '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Interface-Browser'!
PackageBrowser class
	instanceVariableNames: ''!

!Browser class methodsFor: 'instance creation' stamp: 'stp 12/2/1999 12:03'!
openBrowser
	"Create and schedule a BrowserView with label 'System Browser'. The 
	view consists of five subviews, starting with the list view of system 
	categories of SystemOrganization. The initial text view part is empty."

	PackageBrowser openBrowser
"
	Browser openBrowserView: (Browser new openEditString: nil)
			label: 'System Browser'
"
! !


!PackageBrowser commentStamp: '<historical>' prior: 0!
A package browser represents a hierarchical query path through an organization of class and method information.   It parses class categories into a two-level hierarchy on the first '-' character, giving "packages" (e.g.,  Magnitude, Collections, Graphics, etc.), and "categories" (e.g., Magnitude-General and Magnitude-Number).

Instance Variables:
	package  <Symbol> the "category header," e.g., #Magnitudes or #Collections
	packageListIndex <Integer> The index in the package list
	packageList  <OrderedCollection of String> the list of package names
!

!PackageBrowser methodsFor: 'initialize-release' stamp: 'stp 04/07/1999 04:21'!
defaultBackgroundColor
	"PackageBrowser openBrowser"

"	^yellow"
	^ Color r: 1.0 g: 1.0 b: 0.3! !

!PackageBrowser methodsFor: 'initialize-release' stamp: 'stp 04/07/1999 04:31'!
openAsMorphEditing: editString
	"Create a pluggable version of all the views for a Browser, including views and controllers."
	"PackageBrowser openBrowser"

	| listHeight buttonHeight window switches codePane aListMorph |
	listHeight := 0.33.
	buttonHeight := 0.04.
	window _ (SystemWindow labelled: 'later') model: self.

	window addMorph: (PluggableListMorph on: self list: #packageList
			selected: #packageListIndex changeSelected: #packageListIndex:
			menu: #packageMenu: keystroke: #packageListKey:from:)
		frame: (0 at 0 extent: 0.15 at listHeight).

	window addMorph: (PluggableListMorph on: self list: #systemCategoryList
			selected: #systemCategoryListIndex changeSelected: #systemCategoryListIndex:
			menu: #systemCategoryMenu: keystroke: #systemCatListKey:from:)
		frame: (0.15 at 0 extent: 0.2 at listHeight).

	window addMorph: (PluggableListMorph on: self list: #classList
			selected: #classListIndex changeSelected: #classListIndex:
			menu: #classListMenu: keystroke: #classListKey:from:)
		frame: (0.35 at 0 extent: 0.25@(listHeight - buttonHeight)).

	switches _ self buildMorphicSwitches.
	window addMorph: switches frame: (0.35@(listHeight - buttonHeight) 
				extent: 0.25 at buttonHeight).
	switches borderWidth: 0.

	window addMorph: (PluggableListMorph on: self list: #messageCategoryList
			selected: #messageCategoryListIndex changeSelected: #messageCategoryListIndex:
			menu: #messageCategoryMenu:)
		frame: (0.6 at 0 extent: 0.15 at listHeight).
	aListMorph _ PluggableListMorph on: self list: #messageList
			selected: #messageListIndex changeSelected: #messageListIndex:
			menu: #messageListMenu:shifted:
			keystroke: #messageListKey:from:.
	aListMorph menuTitleSelector: #messageListSelectorTitle.
	window addMorph: aListMorph
		frame: (0.75 at 0 extent: 0.25 at listHeight).

	codePane _ PluggableTextMorph on: self text: #contents accept: #contents:notifying:
			readSelection: #contentsSelection menu: #codePaneMenu:shifted:.
	editString ifNotNil: [codePane editString: editString.
					codePane hasUnacceptedEdits: true].
	window addMorph: codePane
		frame: (0 at listHeight corner: 1 at 1).

	^ window! !

!PackageBrowser methodsFor: 'initialize-release' stamp: 'stp 04/07/1999 04:33'!
openEditString: aString
	"Create a pluggable version of all the views for a Browser, including views and controllers."
	"PackageBrowser openBrowser"

	| packageListView systemCategoryListView classListView messageCategoryListView
	  messageListView browserCodeView topView switchView |

	World ifNotNil: [^ self openAsMorphEditing: aString].

	topView := (StandardSystemView new) model: self.
	topView borderWidth: 1.
		"label and minSize taken care of by caller"

	packageListView := PluggableListView on: self
		list: #packageList
		selected: #packageListIndex
		changeSelected: #packageListIndex:
		menu: #packageMenu:.
	packageListView window: (0 @ 0 extent: 20 @ 70).
	topView addSubView: packageListView.

	systemCategoryListView := PluggableListView on: self
		list: #systemCategoryList
		selected: #systemCategoryListIndex
		changeSelected: #systemCategoryListIndex:
		menu: #systemCategoryMenu:.
	systemCategoryListView window: (20 @ 0 extent: 30 @ 70).
	topView addSubView: systemCategoryListView.

	classListView := PluggableListView on: self
		list: #classList
		selected: #classListIndex
		changeSelected: #classListIndex:
		menu: #classListMenu:.
	classListView window: (0 @ 0 extent: 50 @ 62).
	topView addSubView: classListView toRightOf: systemCategoryListView.

	switchView := self buildInstanceClassSwitchView.
	switchView borderWidth: 1.
	topView addSubView: switchView below: classListView.

	messageCategoryListView := PluggableListView on: self
		list: #messageCategoryList
		selected: #messageCategoryListIndex
		changeSelected: #messageCategoryListIndex:
		menu: #messageCategoryMenu:.
	messageCategoryListView window: (0 @ 0 extent: 50 @ 70).
	topView addSubView: messageCategoryListView toRightOf: classListView.

	messageListView := PluggableListView on: self
		list: #messageList
		selected: #messageListIndex
		changeSelected: #messageListIndex:
		menu: #messageListMenu:shifted:
		keystroke: #messageListKey:from:.
	messageListView window: (0 @ 0 extent: 50 @ 70).
	topView addSubView: messageListView toRightOf: messageCategoryListView.

	browserCodeView := PluggableTextView on: self 
			text: #contents accept: #contents:notifying:
			readSelection: #contentsSelection menu: #codePaneMenu:shifted:.
	browserCodeView window: (0 at 0 extent: 200 at 110).
	topView addSubView: browserCodeView below: packageListView.
	aString ifNotNil: [browserCodeView editString: aString.
			browserCodeView hasUnacceptedEdits: true].
	^ topView
! !

!PackageBrowser methodsFor: 'initialize-release' stamp: 'stp 10/06/1998 22:02'!
systemOrganizer: aSystemOrganizer 
	"Initialize the receiver as a perspective on the system organizer, 
	aSystemOrganizer. Typically there is only one--the system variable 
	SystemOrganization."

	super systemOrganizer: aSystemOrganizer .
	packageListIndex := 0! !

!PackageBrowser methodsFor: 'package list' stamp: 'stp 10/06/1998 22:03'!
findClass
	"Search for a class by name.  Modified so that if only 1 class matches the user-supplied string,
	 or if the user-supplied string exactly matches a class name, then the pop-up menu is bypassed"

	| pattern foundClass classNames index reply |
	self okToChange ifFalse: [^ self classNotFound].
	pattern := (reply := FillInTheBlank request: 'Class Name?') asLowercase.
	pattern isEmpty ifTrue: [^ self classNotFound].
	(Smalltalk hasClassNamed: reply)
		ifTrue:
			[foundClass := Smalltalk at: reply asSymbol]
		ifFalse:
 			[classNames := Smalltalk classNames asArray select: 
				[:n | (n asLowercase indexOfSubCollection: pattern startingAt: 1) > 0].
			classNames isEmpty ifTrue: [^ self classNotFound].
			index := classNames size == 1
				ifTrue:	[1]
				ifFalse:	[(PopUpMenu labelArray: classNames lines: #()) startUp].
			index = 0 ifTrue: [^ self classNotFound].
			foundClass := Smalltalk at: (classNames at: index)].
 	self selectCategory: foundClass category.
	self classListIndex: (self classList indexOf: foundClass name). 
! !

!PackageBrowser methodsFor: 'package list' stamp: 'stp 10/06/1998 07:55'!
package
	"Answer the receiver's 'package'."

	^packageListIndex = 0
		ifFalse: [self packageList at: packageListIndex]
		ifTrue: [nil]! !

!PackageBrowser methodsFor: 'package list' stamp: 'stp 10/05/1998 20:36'!
packageList
	"Answer a list of the packages in the current system organization."

	| str cats stream |
	str := Set new: 100.
	stream := WriteStream on: (Array new: 100).
	systemOrganizer categories do:
		[ :categ | 
		cats := categ asString copyUpTo: $-.
		(str includes: cats) ifFalse: 
			[str add: cats.
			stream nextPut: cats]].
	^stream contents! !

!PackageBrowser methodsFor: 'package list' stamp: 'stp 10/05/1998 19:48'!
packageListIndex
	"Answer the index of the current package selection."

	^packageListIndex! !

!PackageBrowser methodsFor: 'package list' stamp: 'stp 12/01/1998 02:46'!
packageListIndex: anInteger 
	"Set anInteger to be the index of the current package selection."

	packageListIndex := anInteger.
	anInteger = 0
		ifFalse: [package := self packageList at: packageListIndex].
	messageCategoryListIndex := 0.
	systemCategoryListIndex := 0.
	messageListIndex := 0.
	classListIndex := 0.
	self setClassOrganizer.
	self changed: #packageSelectionChanged.
	self changed: #packageListIndex.	"update my selection"
	self changed: #systemCategoryList.	"update the category list"
	self systemCategoryListIndex: 0.	"update category list selection"
! !

!PackageBrowser methodsFor: 'package list' stamp: 'stp 10/06/1998 19:59'!
packageMenu: aMenu
	"Answer a Menu of operations on class packages to be 
	displayed when the operate menu button is pressed."

	^aMenu
			labels: 'find class...\recent classes...\reorganize\update' withCRs
			lines: #(2)
			selections: #(#findClass #recent #editSystemCategories #updatePackages)! !

!PackageBrowser methodsFor: 'package list' stamp: 'stp 10/06/1998 19:51'!
recent
	"Let the user select from a list of recently visited classes.  11/96 stp.
	 12/96 di:  use class name, not classes themselves.
	 : dont fall into debugger in empty case"

	| className class recentList |
	recentList _ RecentClasses select: [:n | Smalltalk includesKey: n].
	recentList size == 0 ifTrue: [^ self beep].
	className := (SelectionMenu selections: recentList) startUp.
	className == nil ifTrue: [^ self].
	class := Smalltalk at: className.
	self selectCategory: class category.
	self classListIndex: (self classList indexOf: class name)! !

!PackageBrowser methodsFor: 'package list' stamp: 'stp 10/06/1998 07:47'!
updatePackages
	"Update the contents of the package list."

	editSelection := #none.
	self changed: #packageList.
	self changed: #package.
	self packageListIndex: 0 ! !

!PackageBrowser methodsFor: 'system category list' stamp: 'stp 10/06/1998 07:52'!
selectedSystemCategoryName
	"Answer the name of the selected system category or nil."

	systemCategoryListIndex = 0
		ifTrue: [^nil].
	packageListIndex = 0
		ifTrue: [^self systemCategoryList at: systemCategoryListIndex].
	^package, (self systemCategoryList at: systemCategoryListIndex)! !

!PackageBrowser methodsFor: 'system category list' stamp: 'stp 10/06/1998 07:52'!
systemCategoryList
	"Answer the sequenceable collection containing the class categories that 
	the receiver accesses."

	| num str stream pname |
	packageListIndex = 0 ifTrue: [^systemOrganizer categories].
	pname := self package, '-'.
	num := pname size.
	stream := WriteStream on: (Array new: 100).
	systemOrganizer categories do: 
		[ :cat | 
		cat size >= num
			ifTrue: [(cat copyFrom: 1 to: num) = pname
				ifTrue: [str := cat copyFrom: (cat indexOf: $- ifAbsent: [1]) to: cat size.
					stream nextPut: str]]].
	^stream contents! !

!PackageBrowser methodsFor: 'class list' stamp: 'stp 10/05/1998 21:01'!
classList
	"Answer an array of the class names of the selected category. Answer an 
	empty array if no selection exists."

	systemCategoryListIndex = 0
		ifTrue: [^Array new]
		ifFalse: [^systemOrganizer listAtCategoryNumber:
			(systemOrganizer categories indexOf: self selectedSystemCategoryName asSymbol)]! !

!PackageBrowser methodsFor: 'class list' stamp: 'stp 10/06/1998 19:51'!
selectCategory: cat

	self packageListIndex: (self packageList indexOf: (cat copyUpTo: $-)).	
	self systemCategoryListIndex: (self systemCategoryList indexOf: 
			(cat copyFrom: (cat indexOf: $- ifAbsent: [1]) to: cat size)).! !


!PackageBrowser class methodsFor: 'instance creation' stamp: 'stp 10/06/1998 22:02'!
openBrowser
	"PackageBrowser openBrowser"

	self openBrowserView: (self new openEditString: nil)
			label: 'Squeak Package Browser'! !

(StringHolder new textContents:
	('
	For a demonstration of the PackageBrowser, evaluate the following expression

		"PackageBrowser openBrowser"

	NB: The file-in has also overwritten the Browser''s open message to spawn a PackageBrowser; to change this back, see the method openBrowser in class Browser'))
	openLabel: 'PackageBrowser ReadMe'!!


--------------C4980A6B35F0531092238CAF--





More information about the Squeak-dev mailing list