868 "Modified: / 19-07-2019 / 12:01:12 / Claus Gittinger" |
868 "Modified: / 19-07-2019 / 12:01:12 / Claus Gittinger" |
869 ! ! |
869 ! ! |
870 |
870 |
871 !MethodFinderWindow class methodsFor:'menu specs'! |
871 !MethodFinderWindow class methodsFor:'menu specs'! |
872 |
872 |
|
873 helpMenu |
|
874 "This resource specification was automatically generated |
|
875 by the MenuEditor of ST/X." |
|
876 |
|
877 "Do not manually edit this!! If it is corrupted, |
|
878 the MenuEditor may not be able to read the specification." |
|
879 |
|
880 |
|
881 " |
|
882 MenuEditor new openOnClass:MethodFinderWindow andSelector:#helpMenu |
|
883 (Menu new fromLiteralArrayEncoding:(MethodFinderWindow helpMenu)) startUp |
|
884 " |
|
885 |
|
886 <resource: #menu> |
|
887 |
|
888 ^ |
|
889 #(Menu |
|
890 (MenuItem |
|
891 activeHelpKey: helpTutorial |
|
892 label: 'Documentation' |
|
893 itemValue: openHTMLDocumentation |
|
894 ) |
|
895 (MenuItem |
|
896 label: '-' |
|
897 ) |
|
898 (MenuItem |
|
899 label: 'Show Me How it Works' |
|
900 itemValue: showMeHowItWorks |
|
901 ) |
|
902 (MenuItem |
|
903 label: '-' |
|
904 ) |
|
905 (MenuItem |
|
906 activeHelpKey: aboutThisAppliaction |
|
907 label: 'About MethodFinder...' |
|
908 itemValue: openAboutThisApplication |
|
909 ) |
|
910 ) |
|
911 ! |
|
912 |
873 implementorListMenu |
913 implementorListMenu |
874 "This resource specification was automatically generated |
914 "This resource specification was automatically generated |
875 by the MenuEditor of ST/X." |
915 by the MenuEditor of ST/X." |
876 |
916 |
877 "Do not manually edit this!! If it is corrupted, |
917 "Do not manually edit this!! If it is corrupted, |
878 the MenuEditor may not be able to read the specification." |
918 the MenuEditor may not be able to read the specification." |
|
919 |
879 |
920 |
880 " |
921 " |
881 MenuEditor new openOnClass:MethodFinderWindow andSelector:#implementorListMenu |
922 MenuEditor new openOnClass:MethodFinderWindow andSelector:#implementorListMenu |
882 (Menu new fromLiteralArrayEncoding:(MethodFinderWindow implementorListMenu)) startUp |
923 (Menu new fromLiteralArrayEncoding:(MethodFinderWindow implementorListMenu)) startUp |
883 " |
924 " |
884 |
925 |
885 <resource: #menu> |
926 <resource: #menu> |
886 |
927 |
887 ^ |
928 ^ |
888 #(#Menu |
929 #(Menu |
889 #( |
930 (MenuItem |
890 #(#MenuItem |
931 label: 'Browse' |
891 #label: 'Browse' |
932 itemValue: openBrowserOnSelectedItem |
892 #translateLabel: true |
933 ) |
893 #value: #openBrowserOnSelectedItem |
934 ) |
894 ) |
|
895 ) |
|
896 nil |
|
897 nil |
|
898 ) |
|
899 ! |
935 ! |
900 |
936 |
901 menu |
937 menu |
902 "This resource specification was automatically generated |
938 "This resource specification was automatically generated |
903 by the MenuEditor of ST/X." |
939 by the MenuEditor of ST/X." |
912 " |
948 " |
913 |
949 |
914 <resource: #menu> |
950 <resource: #menu> |
915 |
951 |
916 ^ |
952 ^ |
917 #(Menu |
953 #(Menu |
918 ( |
954 (MenuItem |
919 (MenuItem |
955 activeHelpKey: file |
920 activeHelpKey: file |
956 label: '&File' |
921 label: '&File' |
957 submenu: |
922 submenu: |
958 (Menu |
923 (Menu |
959 (MenuItem |
924 ( |
960 activeHelpKey: fileExit |
925 (MenuItem |
961 label: 'Exit' |
926 activeHelpKey: fileExit |
962 itemValue: closeRequest |
927 label: 'Exit' |
963 ) |
928 itemValue: closeRequest |
|
929 ) |
|
930 ) |
|
931 nil |
|
932 nil |
|
933 ) |
|
934 ) |
|
935 (MenuItem |
|
936 label: 'MENU_Help' |
|
937 startGroup: conditionalRight |
|
938 submenu: |
|
939 (Menu |
|
940 ( |
|
941 (MenuItem |
|
942 activeHelpKey: helpTutorial |
|
943 label: 'Documentation' |
|
944 itemValue: openHTMLDocumentation |
|
945 ) |
|
946 (MenuItem |
|
947 label: '-' |
|
948 ) |
|
949 (MenuItem |
|
950 label: 'Show Me How it Works' |
|
951 itemValue: showMeHowItWorks |
|
952 ) |
|
953 (MenuItem |
|
954 label: '-' |
|
955 ) |
|
956 (MenuItem |
|
957 activeHelpKey: aboutThisAppliaction |
|
958 label: 'About MethodFinder...' |
|
959 itemValue: openAboutThisApplication |
|
960 ) |
|
961 ) |
|
962 nil |
|
963 nil |
|
964 ) |
|
965 ) |
|
966 ) |
964 ) |
967 nil |
965 ) |
968 nil |
966 (MenuItem |
969 ) |
967 label: 'MENU_Help' |
|
968 startGroup: conditionalRight |
|
969 submenuChannel: helpMenu |
|
970 ) |
|
971 ) |
970 ! |
972 ! |
971 |
973 |
972 resultListMenu |
974 resultListMenu |
973 "This resource specification was automatically generated |
975 "This resource specification was automatically generated |
974 by the MenuEditor of ST/X." |
976 by the MenuEditor of ST/X." |
975 |
977 |
976 "Do not manually edit this!! If it is corrupted, |
978 "Do not manually edit this!! If it is corrupted, |
977 the MenuEditor may not be able to read the specification." |
979 the MenuEditor may not be able to read the specification." |
978 |
980 |
|
981 |
979 " |
982 " |
980 MenuEditor new openOnClass:MethodFinderWindow andSelector:#implementorListMenu |
983 MenuEditor new openOnClass:MethodFinderWindow andSelector:#resultListMenu |
981 (Menu new fromLiteralArrayEncoding:(MethodFinderWindow implementorListMenu)) startUp |
984 (Menu new fromLiteralArrayEncoding:(MethodFinderWindow resultListMenu)) startUp |
982 " |
985 " |
983 |
986 |
984 <resource: #menu> |
987 <resource: #menu> |
985 |
988 |
986 ^ |
989 ^ |
987 #(#Menu |
990 #(Menu |
988 #( |
991 (MenuItem |
989 #(#MenuItem |
992 label: 'Browse Senders' |
990 #label: 'Browse Senders' |
993 itemValue: openBrowserOnSenderOfSelectedResultItem |
991 #translateLabel: true |
994 ) |
992 #value: #openBrowserOnSenderOfSelectedResultItem |
995 (MenuItem |
993 ) |
996 label: 'Browse Implementors' |
994 #(#MenuItem |
997 itemValue: openBrowserOnSelectedResultItem |
995 #label: 'Browse Implementors' |
998 ) |
996 #translateLabel: true |
999 ) |
997 #value: #openBrowserOnSelectedResultItem |
|
998 ) |
|
999 ) |
|
1000 nil |
|
1001 nil |
|
1002 ) |
|
1003 |
|
1004 "Created: / 21-09-2012 / 11:05:15 / cg" |
|
1005 ! ! |
1000 ! ! |
1006 |
1001 |
1007 !MethodFinderWindow class methodsFor:'startup'! |
1002 !MethodFinderWindow class methodsFor:'startup'! |
1008 |
1003 |
1009 openOnSelectorPattern:selector |
1004 openOnSelectorPattern:selector |
1134 self classOfResultHolder value:nil. |
1129 self classOfResultHolder value:nil. |
1135 self codeHolder value:nil. |
1130 self codeHolder value:nil. |
1136 tempArguments := self argumentEditorsContents. |
1131 tempArguments := self argumentEditorsContents. |
1137 tempReceiver := self receiverEditorContents. |
1132 tempReceiver := self receiverEditorContents. |
1138 tempAnswer := self messageAnswerEditorContents. |
1133 tempAnswer := self messageAnswerEditorContents. |
1139 "self cleanInputRec:tempReceiver arg:tempArguments ans:tempAnswer." |
1134 |
1140 anArray := Array new:2. |
1135 "self cleanInputRec:tempReceiver arg:tempArguments ans:tempAnswer." |
1141 receiverWithArgument := self mergeReceiver:(tempReceiver value) withArgument:(tempArguments values). |
1136 receiverWithArgument := self mergeReceiver:(tempReceiver value) withArgument:(tempArguments values). |
1142 anArray |
1137 anArray := Array |
1143 at:1 put:receiverWithArgument; |
1138 with:receiverWithArgument |
1144 at:2 put:tempAnswer value. |
1139 with:tempAnswer value. |
1145 "an array now holds the following array #(#(receiver argument) answer) or #(#(receiver) answer). |
1140 |
1146 which should be suitable input for the method finder." |
1141 "an array now holds the following array #(#(receiver argument) answer) or #(#(receiver) answer). |
|
1142 which should be suitable input for the method finder." |
1147 self withCursor:(Cursor execute) do:[ |
1143 self withCursor:(Cursor execute) do:[ |
1148 mf := MethodFinder new. |
1144 mf := MethodFinder new. |
1149 resultArray := mf load:anArray; findMessage. |
1145 mf load:anArray. |
1150 ]. |
1146 resultArray := mf findMessage. |
1151 |
1147 ]. |
1152 ((resultArray at:1) includesSubString:'no single') ifTrue:[ |
1148 |
|
1149 (resultArray isString "(resultArray at:1) includesSubString:'no single'") ifTrue:[ |
1153 false ifTrue:[ |
1150 false ifTrue:[ |
1154 (self confirm:(c'%1\nTry a more exhaustive search (may take long)?' bindWith:(resultArray at:1))) |
1151 (self confirm:(c'%1\nTry a more exhaustive search (may take long)?' bindWith:(resultArray at:1))) |
1155 ifTrue:[ |
1152 ifTrue:[ |
1156 self search2Levels. |
1153 self search2Levels. |
1157 ]. |
1154 ]. |
1200 search2Levels |
1197 search2Levels |
1201 "Do an exhaustive search. |
1198 "Do an exhaustive search. |
1202 Given the original message, |
1199 Given the original message, |
1203 try applying all unary messages first to the receiver, |
1200 try applying all unary messages first to the receiver, |
1204 then to each argument. |
1201 then to each argument. |
1205 This takes O(N^2) time - so be prepared" |
1202 This takes O(N²) time - so be prepared" |
1206 |
1203 |
1207 |tempReceiver tempAnswer tempArguments anArray resultArray receiverWithArgument mf| |
1204 |tempReceiver tempAnswer tempArguments anArray resultArray receiverWithArgument mf| |
1208 |
1205 |
1209 tempArguments := self argumentEditorsContents. |
1206 tempArguments := self argumentEditorsContents. |
1210 tempReceiver := self receiverEditorContents. |
1207 tempReceiver := self receiverEditorContents. |
1211 tempAnswer := self messageAnswerEditorContents. |
1208 tempAnswer := self messageAnswerEditorContents. |
1212 |
1209 |
1213 anArray := Array new:2. |
|
1214 receiverWithArgument := self mergeReceiver:(tempReceiver value) |
1210 receiverWithArgument := self mergeReceiver:(tempReceiver value) |
1215 withArgument:(tempArguments values). |
1211 withArgument:(tempArguments values). |
1216 anArray |
1212 anArray := Array |
1217 at:1 put:receiverWithArgument; |
1213 with:receiverWithArgument; |
1218 at:2 put:tempAnswer value. |
1214 with:tempAnswer value. |
|
1215 |
1219 "an array now holds the following array #(#(receiver argument) answer) or #(#(receiver) answer). |
1216 "an array now holds the following array #(#(receiver argument) answer) or #(#(receiver) answer). |
1220 which should be suitable input for the method finder." |
1217 which should be suitable input for the method finder." |
1221 self withCursor:Cursor execute do:[ |
1218 self withCursor:Cursor execute do:[ |
1222 mf := MethodFinder new. |
1219 mf := MethodFinder new. |
1223 resultArray := mf load:anArray; findMessage. |
1220 mf load:anArray. |
|
1221 resultArray := mf findMessage. |
1224 ]. |
1222 ]. |
1225 |
1223 |
1226 ((resultArray at:1) includesSubString:'no single') ifTrue:[ |
1224 (resultArray isString "(resultArray at:1) includesSubString:'no single'") ifTrue:[ |
1227 (self confirm:(c'%1\nTry a more exhaustive search (may take long)?' bindWith:(resultArray at:1))) |
1225 (self confirm:(c'%1\nTry a more exhaustive search (may take long)?' bindWith:(resultArray at:1))) |
1228 ifTrue:[ |
1226 ifTrue:[ |
1229 self search2Levels. |
1227 self search2Levels. |
1230 ]. |
1228 ]. |
1231 ^ self |
1229 ^ self |
1263 receiver := tempReceiver |
1261 receiver := tempReceiver |
1264 |
1262 |
1265 "Created: / 18-07-2019 / 21:22:47 / Claus Gittinger" |
1263 "Created: / 18-07-2019 / 21:22:47 / Claus Gittinger" |
1266 ! |
1264 ! |
1267 |
1265 |
|
1266 searchPatternMatches:pattern |
|
1267 "Do a search based on the pattern match" |
|
1268 |
|
1269 |list counts firsts seconds selectors resultList idx match| |
|
1270 |
|
1271 self withCursor:Cursor execute do:[ |
|
1272 pattern includesMatchCharacters ifFalse:[ |
|
1273 list := SystemBrowser findImplementorsOf:pattern in:Smalltalk allClasses ignoreCase:true. |
|
1274 list isEmptyOrNil ifTrue:[ |
|
1275 match := pattern,'*'. |
|
1276 list := SystemBrowser findImplementorsMatching:match in:Smalltalk allClasses ignoreCase:true. |
|
1277 ]. |
|
1278 ] ifTrue:[ |
|
1279 "/ match := '*',pattern,'*'. |
|
1280 match := pattern. |
|
1281 list := SystemBrowser findImplementorsMatching:match in:Smalltalk allClasses ignoreCase:true. |
|
1282 ]. |
|
1283 ]. |
|
1284 |
|
1285 counts := IdentityDictionary new. |
|
1286 firsts := IdentityDictionary new. |
|
1287 seconds := IdentityDictionary new. |
|
1288 selectors := IdentitySet new. |
|
1289 list do:[:eachMethod | |
|
1290 |msel| |
|
1291 |
|
1292 msel := eachMethod selector. |
|
1293 selectors add:msel. |
|
1294 (counts at:msel ifAbsentPut:[ 0 asValue ]) increment. |
|
1295 (firsts includesKey:msel) ifTrue:[ |
|
1296 (seconds includesKey:msel) ifFalse:[ |
|
1297 seconds at:msel ifAbsentPut:[ eachMethod mclass ]. |
|
1298 ]. |
|
1299 ] ifFalse:[ |
|
1300 firsts at:msel ifAbsentPut:[ eachMethod mclass ]. |
|
1301 ]. |
|
1302 ]. |
|
1303 resultSelectors := selectors asOrderedCollection sort. |
|
1304 resultList := resultSelectors |
|
1305 collect:[:sel | |
|
1306 |cnt s| |
|
1307 |
|
1308 s := sel allBold , ' --> '. |
|
1309 cnt := (counts at:sel) value. |
|
1310 cnt == 1 ifTrue:[ |
|
1311 s , (firsts at:sel) name |
|
1312 ] ifFalse:[ |
|
1313 cnt == 2 ifTrue:[ |
|
1314 s , (firsts at:sel) name , ' and ' , (seconds at:sel) name |
|
1315 ] ifFalse:[ |
|
1316 s , cnt printString , ' implementor(s)' |
|
1317 ] |
|
1318 ]. |
|
1319 ]. |
|
1320 |
|
1321 self enqueueDelayedAction:[ self updateListAfterPatternSearch: resultList ]. |
|
1322 |
|
1323 "Created: / 01-06-2012 / 13:16:54 / cg" |
|
1324 ! |
|
1325 |
1268 searchPatternMatchesInBackground |
1326 searchPatternMatchesInBackground |
1269 "Do a search based on the pattern match as a background task" |
1327 "Do a search based on the pattern match as a background task" |
1270 |
1328 |
1271 | p pattern| |
1329 | p pattern| |
1272 |
1330 |
1283 ^ self |
1341 ^ self |
1284 ]. |
1342 ]. |
1285 |
1343 |
1286 searchProcess := |
1344 searchProcess := |
1287 [ |
1345 [ |
1288 |list counts firsts seconds selectors resultList idx match| |
1346 self searchPatternMatches:pattern. |
1289 |
|
1290 self withCursor:Cursor execute do:[ |
|
1291 pattern includesMatchCharacters ifFalse:[ |
|
1292 list := SystemBrowser findImplementorsOf:pattern in:Smalltalk allClasses ignoreCase:true. |
|
1293 list isEmptyOrNil ifTrue:[ |
|
1294 match := pattern,'*'. |
|
1295 list := SystemBrowser findImplementorsMatching:match in:Smalltalk allClasses ignoreCase:true. |
|
1296 ]. |
|
1297 ] ifTrue:[ |
|
1298 "/ match := '*',pattern,'*'. |
|
1299 match := pattern. |
|
1300 list := SystemBrowser findImplementorsMatching:match in:Smalltalk allClasses ignoreCase:true. |
|
1301 ]. |
|
1302 ]. |
|
1303 |
|
1304 counts := IdentityDictionary new. |
|
1305 firsts := IdentityDictionary new. |
|
1306 seconds := IdentityDictionary new. |
|
1307 selectors := IdentitySet new. |
|
1308 list do:[:eachMethod | |
|
1309 |msel| |
|
1310 |
|
1311 msel := eachMethod selector. |
|
1312 selectors add:msel. |
|
1313 (counts at:msel ifAbsentPut:[ 0 asValue ]) increment. |
|
1314 (firsts includesKey:msel) ifTrue:[ |
|
1315 (seconds includesKey:msel) ifFalse:[ |
|
1316 seconds at:msel ifAbsentPut:[ eachMethod mclass ]. |
|
1317 ]. |
|
1318 ] ifFalse:[ |
|
1319 firsts at:msel ifAbsentPut:[ eachMethod mclass ]. |
|
1320 ]. |
|
1321 ]. |
|
1322 resultSelectors := selectors asOrderedCollection sort. |
|
1323 resultList := resultSelectors |
|
1324 collect:[:sel | |
|
1325 |cnt s| |
|
1326 |
|
1327 s := sel allBold , ' --> '. |
|
1328 cnt := (counts at:sel) value. |
|
1329 cnt == 1 ifTrue:[ |
|
1330 s , (firsts at:sel) name |
|
1331 ] ifFalse:[ |
|
1332 cnt == 2 ifTrue:[ |
|
1333 s , (firsts at:sel) name , ' and ' , (seconds at:sel) name |
|
1334 ] ifFalse:[ |
|
1335 s , cnt printString , ' implementor(s)' |
|
1336 ] |
|
1337 ]. |
|
1338 ]. |
|
1339 |
|
1340 self enqueueDelayedAction:[ self updateListAfterPatternSearch: resultList ]. |
|
1341 ] fork. |
1347 ] fork. |
1342 |
1348 |
1343 "Created: / 01-06-2012 / 13:16:54 / cg" |
1349 "Created: / 01-06-2012 / 13:16:54 / cg" |
1344 ! |
1350 ! |
1345 |
1351 |
1396 self resultHolder value:resultList. |
1402 self resultHolder value:resultList. |
1397 |
1403 |
1398 searchPattern := self selectorPatternHolder value. |
1404 searchPattern := self selectorPatternHolder value. |
1399 "/ is the search pattern in the list (i.e. a perfect match)? |
1405 "/ is the search pattern in the list (i.e. a perfect match)? |
1400 "/ Then select it. |
1406 "/ Then select it. |
1401 idx := resultSelectors indexOf:searchPattern. |
1407 idx := resultList |
|
1408 findFirst:[:bd | |
|
1409 (bd nameOrDefault sameAs:searchPattern) |
|
1410 or:[ bd tags contains:[:tag | tag sameAs:searchPattern]]]. |
1402 idx ~~ 0 ifTrue:[ |
1411 idx ~~ 0 ifTrue:[ |
1403 self selectedImplementorsHolder setValue:idx; changed |
1412 self selectedImplementorsHolder setValue:idx; changed |
1404 ]. |
1413 ]. |
1405 ! ! |
1414 ! ! |
1406 |
1415 |
1743 |
1752 |
1744 aboutThisApplicationText |
1753 aboutThisApplicationText |
1745 |msg| |
1754 |msg| |
1746 |
1755 |
1747 msg := super aboutThisApplicationText. |
1756 msg := super aboutThisApplicationText. |
1748 msg := msg , '\\Original written by Ted Kaehler, Scott Wallace and Dan Ingalls. |
1757 msg := msg , self aboutThisApplicationText2. |
|
1758 ^msg withCRs. |
|
1759 |
|
1760 "Modified: / 13.11.2001 / 12:56:44 / cg" |
|
1761 ! |
|
1762 |
|
1763 aboutThisApplicationText2 |
|
1764 ^ '\\Original written by Ted Kaehler, Scott Wallace and Dan Ingalls. |
1749 Ported from Squeak to ST/X by James Hayes (2001 james@exept.de). |
1765 Ported from Squeak to ST/X by James Hayes (2001 james@exept.de). |
1750 Improved by Claus Gittinger. |
1766 Improved by Claus Gittinger. |
1751 '. |
1767 '. |
1752 ^msg withCRs. |
1768 |
1753 |
|
1754 "Modified: / 13.11.2001 / 12:56:44 / cg" |
|
1755 ! |
1769 ! |
1756 |
1770 |
1757 openHTMLDocumentation |
1771 openHTMLDocumentation |
1758 "about/help menu action" |
1772 "about/help menu action" |
1759 |
1773 |