diff -r 4c67d2bfe4f4 -r efaa34ed7534 MethodFinderWindow.st --- 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 + " + + + + ^ + #(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 @@ ^ - #(#Menu - #( - #(#MenuItem - #label: 'Browse' - #translateLabel: true - #value: #openBrowserOnSelectedItem - ) - ) - nil - nil - ) + #(Menu + (MenuItem + label: 'Browse' + itemValue: openBrowserOnSelectedItem + ) + ) ! menu @@ -914,59 +950,25 @@ ^ - #(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 " ^ - #(#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