[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
|