idc@minster.UUCP (12/05/86)
Following the lead set by Tim Rentsch, here is the first in a series
of goodies developed at Manchester University for version 2
Smalltalk-80 systems. Some of them are new, others are based on
goodies that have appeared elsewhere. All have been tested on PARC
Smalltalk (PS).
This first goodie is an improvement on, and extension to, a goodie
that appeared in Smalltalk-80 Newsletter. It adds a menu option to
the category and class subviews of the standard system browser. The
menu option prompts the user to enter the name of a class (in the
category subview) or selector (in the class subview), and tries to set
the browser to that class or selector. Spelling correction is invoked
if necessary.
After filing in the following code the user should evaluate the
expression "Browser flushMenus" to update the menus.
Mario Wolczko (please send any replies directly to me at the address below)
------------------------------------------------------------------------
Dept. of Computer Science ARPA: miw%uk.ac.man.cs.ux@cs.ucl.ac.uk
The University USENET: mcvax!ukc!man.cs.ux!miw
Manchester M13 9PL JANET: miw@uk.ac.man.cs.ux
U.K. 061-273 7121 x 5699
------------------------------------------------------------------------
'From Smalltalk-80, version 2, of April 1, 1983 on 28 July 1986 at 12:16:54 pm'!
!Browser methodsFor: 'category functions'!
findClass
"Ask for the name of a class with the intention of setting the
category and class to match it. If not found as a class in the
system dictionary, attempt a correction.
This really could go anywhere, but is placed in category functions for
no particular reason"
| aString testClassName testClass sym reply bestScore score |
aString _ FillInTheBlank request: 'Find which class?' initialAnswer: 'ClassName'.
aString isEmpty ifTrue: [^self]. "the user changed his/her mind"
testClassName _ aString asSymbol.
((Smalltalk includesKey: testClassName) "not a known symbol"
and: [((testClass _ Smalltalk at: testClassName) isKindOf: Behavior)]) "not a class"
ifFalse: [ "try to find a class with a name close to the one the user entered,
and see if he/she wants to correct to it."
bestScore _ 0.
"enumerate all the names of classes, and choose the best match "
Smalltalk keysDo: [:classname |
(((Smalltalk at: classname) isKindOf: Behavior)
and: [(score _ classname spellAgainst: aString) > bestScore])
ifTrue: "found a class that matches better"
[bestScore _ score.
testClassName _ classname]].
testClassName isNil
ifTrue: [^self] "give up---nothing close"
ifFalse:
[reply _ (ActionMenu
labels:
('correct to ' , (testClassName contractTo: 25) , '?\abort') withCRs
selectors: #(correct abort ))
startUp: #anyButton withHeading: ' ' , (aString contractTo: 25) , ' is not a class'.
reply == 2 ifTrue: [^self]. "abort chosen"
testClass _ Smalltalk at: testClassName]].
self changeRequest ifFalse: [^self].
self newCategoryList: testClass category.
self newClassList: testClassName! !
!Browser methodsFor: 'category list'!
categoryMenu
"Browser flushMenus"
category == nil ifTrue:
[^ ActionMenu labels: 'add category\update\edit all\find class' withCRs
lines: #(1 3)
selectors: #(addCategory updateCategories editCategories findClass)].
CategoryMenu == nil ifTrue:
[CategoryMenu _ ActionMenu
labels: 'file out\print out\spawn\add category\rename\remove\update\edit all\find class' withCRs
lines: #(3 6 8)
selectors: #(fileOutCategory printOutCategory spawnCategory addCategory renameCategory removeCategory updateCategories editCategories findClass)].
^ CategoryMenu! !
!Browser methodsFor: 'class list'!
classMenu
"Browser flushMenus"
className == nil ifTrue: [^nil].
ClassMenu == nil ifTrue:
[ClassMenu _ ActionMenu
labels: 'file out\LaTeX out\spawn\spawn hierarchy
hierarchy\definition\comment\protocols\find selector
inst var refs\class var refs\class refs
rename\remove' withCRs
lines: #(4 9 12)
selectors: #(fileOutClass printOutClass spawnClass spawnHierarchy
showHierarchy editClass editComment editProtocols findSelector
browseFieldReferences browseClassVariables browseClassReferences
renameClass removeClass)].
^ ClassMenu! !
!Browser methodsFor: 'class functions'!
findSelector
"Ask for the name of a selector with the intention of setting the protocol and selector to match it. If not found as a selector in the method dictionary, attempt a correction."
| aString testSelector class sym reply bestScore score |
aString _ FillInTheBlank request: 'Find which selector?' initialAnswer: 'selector'.
aString isEmpty ifTrue: [^self]. "the user changed his/her mind"
testSelector _ aString asSymbol.
class _ self selectedClass.
(class includesSelector: testSelector) "not part of the protocol"
ifFalse: [ "try to find a selector with a name close to the one the user entered,
and see if he/she wants to correct to it."
bestScore _ 0.
"enumerate all the names of classes, and choose the best match "
class selectors do: [:aSelector |
(score _ aSelector spellAgainst: aString) > bestScore
ifTrue: "found a selector that matches better"
[bestScore _ score.
testSelector _ aSelector]].
testSelector isNil
ifTrue: [^self] "give up---nothing close"
ifFalse:
[reply _ (ActionMenu
labels:
('correct to ' , (testSelector contractTo: 25) , '?\abort') withCRs
selectors: #(correct abort ))
startUp: #anyButton withHeading: ' ' , (aString contractTo: 25) , ' is not in this class'.
reply == 2 ifTrue: [^self]. "abort chosen"]].
self changeRequest ifFalse: [^self].
self newProtocolList: (class whichCategoryIncludesSelector: testSelector).
self newSelectorList: testSelector! !
----------------------------------------------------------------