--- a/MethodFinderWindow.st Fri Sep 27 17:05:04 2019 +0200
+++ b/MethodFinderWindow.st Sat Sep 28 16:32:50 2019 +0200
@@ -870,6 +870,46 @@
!MethodFinderWindow class methodsFor:'menu specs'!
+helpMenu
+ "This resource specification was automatically generated
+ by the MenuEditor of ST/X."
+
+ "Do not manually edit this!! If it is corrupted,
+ the MenuEditor may not be able to read the specification."
+
+
+ "
+ MenuEditor new openOnClass:MethodFinderWindow andSelector:#helpMenu
+ (Menu new fromLiteralArrayEncoding:(MethodFinderWindow helpMenu)) startUp
+ "
+
+ <resource: #menu>
+
+ ^
+ #(Menu
+ (MenuItem
+ activeHelpKey: helpTutorial
+ label: 'Documentation'
+ itemValue: openHTMLDocumentation
+ )
+ (MenuItem
+ label: '-'
+ )
+ (MenuItem
+ label: 'Show Me How it Works'
+ itemValue: showMeHowItWorks
+ )
+ (MenuItem
+ label: '-'
+ )
+ (MenuItem
+ activeHelpKey: aboutThisAppliaction
+ label: 'About MethodFinder...'
+ itemValue: openAboutThisApplication
+ )
+ )
+!
+
implementorListMenu
"This resource specification was automatically generated
by the MenuEditor of ST/X."
@@ -877,6 +917,7 @@
"Do not manually edit this!! If it is corrupted,
the MenuEditor may not be able to read the specification."
+
"
MenuEditor new openOnClass:MethodFinderWindow andSelector:#implementorListMenu
(Menu new fromLiteralArrayEncoding:(MethodFinderWindow implementorListMenu)) startUp
@@ -885,17 +926,12 @@
<resource: #menu>
^
- #(#Menu
- #(
- #(#MenuItem
- #label: 'Browse'
- #translateLabel: true
- #value: #openBrowserOnSelectedItem
- )
- )
- nil
- nil
- )
+ #(Menu
+ (MenuItem
+ label: 'Browse'
+ itemValue: openBrowserOnSelectedItem
+ )
+ )
!
menu
@@ -914,59 +950,25 @@
<resource: #menu>
^
- #(Menu
- (
- (MenuItem
- activeHelpKey: file
- label: '&File'
- submenu:
- (Menu
- (
- (MenuItem
- activeHelpKey: fileExit
- label: 'Exit'
- itemValue: closeRequest
- )
- )
- nil
- nil
- )
- )
- (MenuItem
- label: 'MENU_Help'
- startGroup: conditionalRight
- submenu:
- (Menu
- (
- (MenuItem
- activeHelpKey: helpTutorial
- label: 'Documentation'
- itemValue: openHTMLDocumentation
- )
- (MenuItem
- label: '-'
- )
- (MenuItem
- label: 'Show Me How it Works'
- itemValue: showMeHowItWorks
- )
- (MenuItem
- label: '-'
- )
- (MenuItem
- activeHelpKey: aboutThisAppliaction
- label: 'About MethodFinder...'
- itemValue: openAboutThisApplication
- )
- )
- nil
- nil
- )
- )
+ #(Menu
+ (MenuItem
+ activeHelpKey: file
+ label: '&File'
+ submenu:
+ (Menu
+ (MenuItem
+ activeHelpKey: fileExit
+ label: 'Exit'
+ itemValue: closeRequest
+ )
)
- nil
- nil
- )
+ )
+ (MenuItem
+ label: 'MENU_Help'
+ startGroup: conditionalRight
+ submenuChannel: helpMenu
+ )
+ )
!
resultListMenu
@@ -976,32 +978,25 @@
"Do not manually edit this!! If it is corrupted,
the MenuEditor may not be able to read the specification."
+
"
- MenuEditor new openOnClass:MethodFinderWindow andSelector:#implementorListMenu
- (Menu new fromLiteralArrayEncoding:(MethodFinderWindow implementorListMenu)) startUp
+ MenuEditor new openOnClass:MethodFinderWindow andSelector:#resultListMenu
+ (Menu new fromLiteralArrayEncoding:(MethodFinderWindow resultListMenu)) startUp
"
<resource: #menu>
^
- #(#Menu
- #(
- #(#MenuItem
- #label: 'Browse Senders'
- #translateLabel: true
- #value: #openBrowserOnSenderOfSelectedResultItem
- )
- #(#MenuItem
- #label: 'Browse Implementors'
- #translateLabel: true
- #value: #openBrowserOnSelectedResultItem
- )
- )
- nil
- nil
- )
-
- "Created: / 21-09-2012 / 11:05:15 / cg"
+ #(Menu
+ (MenuItem
+ label: 'Browse Senders'
+ itemValue: openBrowserOnSenderOfSelectedResultItem
+ )
+ (MenuItem
+ label: 'Browse Implementors'
+ itemValue: openBrowserOnSelectedResultItem
+ )
+ )
! !
!MethodFinderWindow class methodsFor:'startup'!
@@ -1136,20 +1131,22 @@
tempArguments := self argumentEditorsContents.
tempReceiver := self receiverEditorContents.
tempAnswer := self messageAnswerEditorContents.
- "self cleanInputRec:tempReceiver arg:tempArguments ans:tempAnswer."
- anArray := Array new:2.
+
+ "self cleanInputRec:tempReceiver arg:tempArguments ans:tempAnswer."
receiverWithArgument := self mergeReceiver:(tempReceiver value) withArgument:(tempArguments values).
- anArray
- at:1 put:receiverWithArgument;
- at:2 put:tempAnswer value.
- "an array now holds the following array #(#(receiver argument) answer) or #(#(receiver) answer).
- which should be suitable input for the method finder."
+ anArray := Array
+ with:receiverWithArgument
+ with:tempAnswer value.
+
+ "an array now holds the following array #(#(receiver argument) answer) or #(#(receiver) answer).
+ which should be suitable input for the method finder."
self withCursor:(Cursor execute) do:[
mf := MethodFinder new.
- resultArray := mf load:anArray; findMessage.
+ mf load:anArray.
+ resultArray := mf findMessage.
].
-
- ((resultArray at:1) includesSubString:'no single') ifTrue:[
+
+ (resultArray isString "(resultArray at:1) includesSubString:'no single'") ifTrue:[
false ifTrue:[
(self confirm:(c'%1\nTry a more exhaustive search (may take long)?' bindWith:(resultArray at:1)))
ifTrue:[
@@ -1202,7 +1199,7 @@
Given the original message,
try applying all unary messages first to the receiver,
then to each argument.
- This takes O(N^2) time - so be prepared"
+ This takes O(N²) time - so be prepared"
|tempReceiver tempAnswer tempArguments anArray resultArray receiverWithArgument mf|
@@ -1210,20 +1207,21 @@
tempReceiver := self receiverEditorContents.
tempAnswer := self messageAnswerEditorContents.
- anArray := Array new:2.
receiverWithArgument := self mergeReceiver:(tempReceiver value)
withArgument:(tempArguments values).
- anArray
- at:1 put:receiverWithArgument;
- at:2 put:tempAnswer value.
+ anArray := Array
+ with:receiverWithArgument;
+ with:tempAnswer value.
+
"an array now holds the following array #(#(receiver argument) answer) or #(#(receiver) answer).
which should be suitable input for the method finder."
self withCursor:Cursor execute do:[
mf := MethodFinder new.
- resultArray := mf load:anArray; findMessage.
+ mf load:anArray.
+ resultArray := mf findMessage.
].
- ((resultArray at:1) includesSubString:'no single') ifTrue:[
+ (resultArray isString "(resultArray at:1) includesSubString:'no single'") ifTrue:[
(self confirm:(c'%1\nTry a more exhaustive search (may take long)?' bindWith:(resultArray at:1)))
ifTrue:[
self search2Levels.
@@ -1265,6 +1263,66 @@
"Created: / 18-07-2019 / 21:22:47 / Claus Gittinger"
!
+searchPatternMatches:pattern
+ "Do a search based on the pattern match"
+
+ |list counts firsts seconds selectors resultList idx match|
+
+ self withCursor:Cursor execute do:[
+ pattern includesMatchCharacters ifFalse:[
+ list := SystemBrowser findImplementorsOf:pattern in:Smalltalk allClasses ignoreCase:true.
+ list isEmptyOrNil ifTrue:[
+ match := pattern,'*'.
+ list := SystemBrowser findImplementorsMatching:match in:Smalltalk allClasses ignoreCase:true.
+ ].
+ ] ifTrue:[
+ "/ match := '*',pattern,'*'.
+ match := pattern.
+ list := SystemBrowser findImplementorsMatching:match in:Smalltalk allClasses ignoreCase:true.
+ ].
+ ].
+
+ counts := IdentityDictionary new.
+ firsts := IdentityDictionary new.
+ seconds := IdentityDictionary new.
+ selectors := IdentitySet new.
+ list do:[:eachMethod |
+ |msel|
+
+ msel := eachMethod selector.
+ selectors add:msel.
+ (counts at:msel ifAbsentPut:[ 0 asValue ]) increment.
+ (firsts includesKey:msel) ifTrue:[
+ (seconds includesKey:msel) ifFalse:[
+ seconds at:msel ifAbsentPut:[ eachMethod mclass ].
+ ].
+ ] ifFalse:[
+ firsts at:msel ifAbsentPut:[ eachMethod mclass ].
+ ].
+ ].
+ resultSelectors := selectors asOrderedCollection sort.
+ resultList := resultSelectors
+ collect:[:sel |
+ |cnt s|
+
+ s := sel allBold , ' --> '.
+ cnt := (counts at:sel) value.
+ cnt == 1 ifTrue:[
+ s , (firsts at:sel) name
+ ] ifFalse:[
+ cnt == 2 ifTrue:[
+ s , (firsts at:sel) name , ' and ' , (seconds at:sel) name
+ ] ifFalse:[
+ s , cnt printString , ' implementor(s)'
+ ]
+ ].
+ ].
+
+ self enqueueDelayedAction:[ self updateListAfterPatternSearch: resultList ].
+
+ "Created: / 01-06-2012 / 13:16:54 / cg"
+!
+
searchPatternMatchesInBackground
"Do a search based on the pattern match as a background task"
@@ -1285,59 +1343,7 @@
searchProcess :=
[
- |list counts firsts seconds selectors resultList idx match|
-
- self withCursor:Cursor execute do:[
- pattern includesMatchCharacters ifFalse:[
- list := SystemBrowser findImplementorsOf:pattern in:Smalltalk allClasses ignoreCase:true.
- list isEmptyOrNil ifTrue:[
- match := pattern,'*'.
- list := SystemBrowser findImplementorsMatching:match in:Smalltalk allClasses ignoreCase:true.
- ].
- ] ifTrue:[
- "/ match := '*',pattern,'*'.
- match := pattern.
- list := SystemBrowser findImplementorsMatching:match in:Smalltalk allClasses ignoreCase:true.
- ].
- ].
-
- counts := IdentityDictionary new.
- firsts := IdentityDictionary new.
- seconds := IdentityDictionary new.
- selectors := IdentitySet new.
- list do:[:eachMethod |
- |msel|
-
- msel := eachMethod selector.
- selectors add:msel.
- (counts at:msel ifAbsentPut:[ 0 asValue ]) increment.
- (firsts includesKey:msel) ifTrue:[
- (seconds includesKey:msel) ifFalse:[
- seconds at:msel ifAbsentPut:[ eachMethod mclass ].
- ].
- ] ifFalse:[
- firsts at:msel ifAbsentPut:[ eachMethod mclass ].
- ].
- ].
- resultSelectors := selectors asOrderedCollection sort.
- resultList := resultSelectors
- collect:[:sel |
- |cnt s|
-
- s := sel allBold , ' --> '.
- cnt := (counts at:sel) value.
- cnt == 1 ifTrue:[
- s , (firsts at:sel) name
- ] ifFalse:[
- cnt == 2 ifTrue:[
- s , (firsts at:sel) name , ' and ' , (seconds at:sel) name
- ] ifFalse:[
- s , cnt printString , ' implementor(s)'
- ]
- ].
- ].
-
- self enqueueDelayedAction:[ self updateListAfterPatternSearch: resultList ].
+ self searchPatternMatches:pattern.
] fork.
"Created: / 01-06-2012 / 13:16:54 / cg"
@@ -1398,7 +1404,10 @@
searchPattern := self selectorPatternHolder value.
"/ is the search pattern in the list (i.e. a perfect match)?
"/ Then select it.
- idx := resultSelectors indexOf:searchPattern.
+ idx := resultList
+ findFirst:[:bd |
+ (bd nameOrDefault sameAs:searchPattern)
+ or:[ bd tags contains:[:tag | tag sameAs:searchPattern]]].
idx ~~ 0 ifTrue:[
self selectedImplementorsHolder setValue:idx; changed
].
@@ -1745,13 +1754,18 @@
|msg|
msg := super aboutThisApplicationText.
- msg := msg , '\\Original written by Ted Kaehler, Scott Wallace and Dan Ingalls.
+ msg := msg , self aboutThisApplicationText2.
+ ^msg withCRs.
+
+ "Modified: / 13.11.2001 / 12:56:44 / cg"
+!
+
+aboutThisApplicationText2
+ ^ '\\Original written by Ted Kaehler, Scott Wallace and Dan Ingalls.
Ported from Squeak to ST/X by James Hayes (2001 james@exept.de).
Improved by Claus Gittinger.
'.
- ^msg withCRs.
-
- "Modified: / 13.11.2001 / 12:56:44 / cg"
+
!
openHTMLDocumentation