Tools__NewSystemBrowser.st
branchjv
changeset 16459 85d703589d34
parent 16445 6bc184e74f9c
parent 16452 bedabf0a4ae5
child 16570 dc5e958a20dc
--- a/Tools__NewSystemBrowser.st	Thu May 05 06:48:38 2016 +0200
+++ b/Tools__NewSystemBrowser.st	Fri May 06 06:55:08 2016 +0200
@@ -6001,7 +6001,7 @@
 
     <resource: #menu>
 
-    ^
+    ^ 
      #(Menu
         (
          (MenuItem
@@ -6031,7 +6031,7 @@
           )
          (MenuItem
             label: 'Classes'
-            submenu:
+            submenu: 
            (Menu
               (
                (MenuItem
@@ -6174,6 +6174,17 @@
                   label: '-'
                 )
                (MenuItem
+                  label: 'Pick a View, Browse its Application Class'
+                  itemValue: pickViewAndBrowseApplicationClass
+                )
+               (MenuItem
+                  label: 'Pick a View, Browse Widget''s Class'
+                  itemValue: pickViewAndBrowseViewClass
+                )
+               (MenuItem
+                  label: '-'
+                )
+               (MenuItem
                   label: 'Special'
                   submenuChannel: specialBrowseMenu
                 )
@@ -6228,7 +6239,7 @@
           )
          (MenuItem
             label: 'Methods'
-            submenu:
+            submenu: 
            (Menu
               (
                (MenuItem
@@ -26305,7 +26316,8 @@
     self
         askForMethodAndSpawnSearchTitle:'String to Search for in Sources:'
         browserLabel:'Methods containing "%1"'
-        searchWith:#( #'findString:in:ignoreCase:match:' #'findString:inMethods:ignoreCase:match:' )
+        searchWith:#( #'findString:in:ignoreCase:match:' #'findString:inMethods:ignoreCase:match:' 
+                      #'findStringLiteral:in:ignoreCase:match:' #'findStringLiteral:inMethods:ignoreCase:match:' )
         searchWhat:#string
         searchArea:whereDefault
         withCaseIgnore:true
@@ -27200,6 +27212,34 @@
     ^ classes asOrderedCollection
 !
 
+pickViewAndBrowseApplicationClass
+    "let user click on a view, then browse its appliction class"
+
+    |view app|
+
+    view := Screen current viewFromUser.
+    view isNil ifTrue:[^ self].
+    (app := view application) isNil ifTrue:[
+        (app := view topView application) isNil ifTrue:[
+            Dialog information:'Neither widget nor its topview have an application'.
+            ^ self
+        ].
+    ].
+    self createBuffer.
+    self switchToClass:app class selector:nil updateHistory:false.
+!
+
+pickViewAndBrowseWidgetClass
+    "let user click on a view, then browse its class"
+
+    |view|
+
+    view := Screen current viewFromUser.
+    view isNil ifTrue:[^ self].
+    self createBuffer.
+    self switchToClass:view class selector:nil updateHistory:false.
+!
+
 spawnClassDocumentationBrowserIn:where
     "browse documentation;
         where is: #newBrowser - open a new browser
@@ -37660,7 +37700,7 @@
 !
 
 codeMenuFormat
-    "format (prettyPrint) the selected method(s)"
+    "format (prettyPrint) the selected method(s) and accept"
 
     |modifiedBefore|
 
@@ -38749,7 +38789,8 @@
 !
 
 formatCode
-    "format (prettyPrint) the selected method's code"
+    "format (prettyPrint) the selected method's code.
+     Does not accept, so caller can decide"
 
     |tree newText mthd codeView|
 
@@ -38775,7 +38816,8 @@
     codeView
         undoableDo:[ codeView replaceContentsWith:newText ]
         info:'Format'.
-    codeView modified:true.
+    "/ codeView modified:true.
+    navigationState modified:true.
     navigationState realModifiedState:true.
     ^ newText.
 !
@@ -49214,7 +49256,7 @@
     |label|
 
     self withSearchCursorDo:[
-        |cachedList newBrowser theSingleSelector searchBlock|
+        |cachedList newBrowser theSingleSelector searchBlock answer|
 
         aSelectorCollection size == 1 ifTrue:[
             theSingleSelector := aSelectorCollection first.
@@ -49223,36 +49265,40 @@
             label := resources string:labelPrefix.
         ].
 
-        searchBlock := [
-                            |l|
-
-                            cachedList notNil ifTrue:[
-                                l := cachedList.
-                                cachedList := nil
-                            ] ifFalse:[
-                                l := IdentitySet new.
-                                aSelectorCollection do:[:aSelector |
-                                    l addAll:(self class
-                                                    findSendersOf:aSelector
-                                                    in:setOfClasses
-                                                    ignoreCase:false
-                                                    match:false
-                                                )
-                                ].
-                                l := l asOrderedCollection
-                            ].
-                            l
-                       ].
+        searchBlock := 
+            [
+                |l|
+
+                cachedList notNil ifTrue:[
+                    l := cachedList.
+                    cachedList := nil
+                ] ifFalse:[
+                    l := IdentitySet new.
+                    aSelectorCollection do:[:aSelector |
+                        l addAll:(self class
+                                        findSendersOf:aSelector in:setOfClasses
+                                        ignoreCase:false match:false
+                                    )
+                    ].
+                    l := l asOrderedCollection
+                ].
+                l
+           ].
 
         theSingleSelector notNil ifTrue:[
             cachedList := searchBlock value.
             cachedList size == 0 ifTrue:[
-                (Dialog
-                    confirm:(label , (resources string:' - none found'))
-                    yesLabel:(resources string:'Show Implementors') noLabel:'OK'
-                    initialAnswer:false
-                ) ifTrue:[
-                    self spawnMethodImplementorsBrowserFor:aSelectorCollection in:openHow
+                answer := Dialog
+                    confirmWithCancel:(label , (resources string:' - none found'))
+                    labels:(resources array: #('Cancel' 'Search String' 'Show Implementors'))
+                    values:#(nil #string #implementors)
+                    default:nil.
+                (answer == #string) ifTrue:[
+                    self spawnMethodStringSearchBrowserFor:aSelectorCollection in:openHow
+                ] ifFalse:[
+                    (answer == #implementors) ifTrue:[
+                        self spawnMethodImplementorsBrowserFor:aSelectorCollection in:openHow
+                    ].
                 ].
                 ^ self
             ].
@@ -49278,6 +49324,73 @@
     "Created: / 05-09-2006 / 10:43:21 / cg"
 !
 
+spawnMethodStringSearchBrowserFor:aStringCollection in:openHow
+    "open a new browser or add a buffer showing the selected methods only"
+
+    ^ self
+        spawnMethodStringSearchBrowserFor:aStringCollection
+        match:false
+        in:openHow
+        classes:environment allClasses
+        label:'string search'
+!
+
+spawnMethodStringSearchBrowserFor:aStringCollection match:doMatch in:openHow classes:classes label:labelPrefix
+    "open a new browser or add a buffer showing the selected methods only"
+
+    self withSearchCursorDo:[
+        |newBrowser label impls searchBlock cachedList theSingleString|
+
+        aStringCollection size == 1 ifTrue:[
+            theSingleString := aStringCollection first.
+            label := resources string:(labelPrefix,' with %1') with:(theSingleString allBold)
+        ] ifFalse:[
+            label := resources string:labelPrefix.
+        ].
+
+        searchBlock := 
+            [
+                |list|
+
+                (list := cachedList) notNil ifTrue:[
+                    cachedList := nil
+                ] ifFalse:[
+                    list := IdentitySet new.
+                    aStringCollection do:[:eachString |
+                        list addAll:(self class
+                                        findString:eachString 
+                                        in:classes
+                                        ignoreCase:false 
+                                        match:doMatch
+                                    )
+                    ].
+                    list := list asOrderedCollection
+                ].
+                list
+            ].
+
+        cachedList := searchBlock value.
+        (cachedList size == 1 and:[cachedList first == self theSingleSelectedMethod]) ifTrue:[
+            (Dialog
+                confirm:label,' - ',(resources stringWithCRs:'only the selected method found.\\Browse anyway?')
+                initialAnswer:false
+            ) ifFalse:[
+                ^ self
+            ]
+        ].
+
+        newBrowser := self
+                        spawnMethodBrowserForSearch:searchBlock
+                        sortBy:nil
+                        in:openHow
+                        label:label.
+        
+        newBrowser autoSearchPattern:(aStringCollection asStringWith:'|') ignoreCase:false.
+        newBrowser sortBy value:#classes.
+        newBrowser
+    ]
+!
+
 spawnProjectExtensionsBrowserFor:aMethodCollection in:openHow
     "open a new browser or add a buffer showing the selected methods senders only"
 
@@ -55649,7 +55762,7 @@
 !
 
 askForMethodAndSpawnSearchTitle:title browserLabel:labelHolderOrBlock 
-    searchWith:aSelectorOrBlock searchWhat:searchWhat searchArea:whereDefault
+    searchWith:searchWithSpec searchWhat:searchWhat searchArea:whereDefault
     withCaseIgnore:withCaseIgnore withTextEntry:withTextEntry 
     withMatch:withMatch withMethodList:withMethodList 
     setSearchPattern:setSearchPatternAction
@@ -55675,11 +55788,28 @@
      searchWhat is a symbol such as #selector, #code etc.
     "
 
-    |dialog|
-
+    |dialog selectorOrBlockOrSelectorPair literalStringSearchSelectors|
+
+    selectorOrBlockOrSelectorPair := searchWithSpec.
+    
     dialog := SearchDialog new
         initialText:aString;
-        showMetaFilter:true;
+        showMetaFilter:true.
+
+    "/ hack...
+    searchWhat == #string ifTrue:[
+        selectorOrBlockOrSelectorPair size == 4 ifTrue:[
+            "/ the first two are for a string search,
+            "/ the last two for a string-in-literal search.
+            "/ need to clean that ugly interface up...
+            literalStringSearchSelectors := selectorOrBlockOrSelectorPair copyFrom:3.
+            selectorOrBlockOrSelectorPair := selectorOrBlockOrSelectorPair copyTo:2.
+
+            dialog withSearchStringInLiterals:true.
+        ].    
+    ].
+    
+    dialog    
         setupToAskForMethodSearchTitle:title
         forBrowser:self
         searchWhat:searchWhat
@@ -55691,7 +55821,7 @@
         allowBuffer:true
         allowBrowser:true
         withTextEntry:withTextEntry.
-
+    
     [:restart|
         dialog askThenDo:[
             |classes string ignoreCase openHow match methods isMethod searchAction
@@ -55711,38 +55841,46 @@
 
             self withSearchCursorDo:[
                 |initialList list newBrowser numFound label
-                 selector entities arguments numArgs answer
-                 alternativeSelector question altArguments t|
-
-                aSelectorOrBlock isArray ifTrue:[
+                 selectorList selector entities arguments numArgs answer
+                 alternativeSelector question altArguments t extraStringMsg|
+
+                (literalStringSearchSelectors notNil and:[dialog searchStringInLiterals]) ifTrue:[ 
+                    selectorList := literalStringSearchSelectors.
+                    extraStringMsg := ' (in String literals)'. 
+                ] ifFalse:[ 
+                    selectorList := selectorOrBlockOrSelectorPair.
+                    extraStringMsg := ''. 
+                ].
+
+                selectorList isArray ifTrue:[
                     classes notNil ifTrue:[
-                        selector := aSelectorOrBlock first.
+                        selector := selectorList first.
                         entities := classes.
                     ] ifFalse:[
-                        selector := aSelectorOrBlock second.
+                        selector := selectorList second.
                         entities := methods.
                     ].
                     numArgs := selector numArgs.
                 ] ifFalse:[
                     entities := classes.
-                    aSelectorOrBlock isSymbol ifTrue:[
-                        selector := aSelectorOrBlock.
+                    selectorList isSymbol ifTrue:[
+                        selector := selectorList.
                     ] ifFalse:[
                         selector := nil
                     ].
-                    numArgs := aSelectorOrBlock numArgs.
+                    numArgs := selectorList numArgs.
                 ].
                 (selector notNil
                 and:[ (selector numArgs == 1)
                 and:[ (selector endsWith:'In:') or:[ selector endsWith:'inMethods:' ]]]) ifTrue:[
                     arguments := Array with:entities
                 ] ifFalse:[
-                    arguments := (Array
-                                        with:string
-                                        with:entities
-                                        with:((selector notNil and:[selector endsWith:'isMethod:']) ifTrue:[isMethod] ifFalse:[ignoreCase])
-                                        with:match
-                                  ) copyTo:numArgs.
+                    arguments := { string . 
+                                   entities . 
+                                   ((selector notNil and:[selector endsWith:'isMethod:']) 
+                                                ifTrue:[isMethod] ifFalse:[ignoreCase]) .
+                                   match 
+                                 } copyTo:numArgs.
                 ].
 
                 searchAction :=
@@ -55760,17 +55898,17 @@
                             selector notNil ifTrue:[
                                 result := self class perform:selector withArguments:arguments.
                             ] ifFalse:[
-                                result := aSelectorOrBlock valueWithArguments:arguments
+                                result := selectorList valueWithArguments:arguments
                             ].
                             "/ sorry for this special case: when searching in a package,
                             "/ also search extensionMethods
                             dialog searchAreaSelected == #currentPackage ifTrue:[
-                                aSelectorOrBlock isArray ifTrue:[
+                                selectorList isArray ifTrue:[
                                     "/ findSendersOf:inMethods:ignoreCase:match:
                                     extensionMethods := environment allExtensionsForPackage:(dialog currentPackage).
                                     arguments2 := arguments copy.
                                     arguments2 at:2 put:extensionMethods.
-                                    moreResults := self class perform:(aSelectorOrBlock at:2) withArguments:arguments2.
+                                    moreResults := self class perform:(selectorList at:2) withArguments:arguments2.
                                     result := result , moreResults.
                                 ]
                             ].
@@ -55803,7 +55941,11 @@
 
                 numFound := initialList size.
                 numFound == 0 ifTrue:[
-                    question := resources stringWithCRs:label with:((string ? '') allBold colorizeAllWith:Color red darkened).
+                    question := resources 
+                                    stringWithCRs:label,extraStringMsg 
+                                    with:((string ? '') 
+                                            allBold 
+                                                colorizeAllWith:Color red darkened).
                     question := question , (resources string:' - none found.').
 
                     ((selector == #findImplementors:in:ignoreCase:match:)
@@ -58161,7 +58303,7 @@
 !
 
 getMethodInfoForMethod:aMethod
-    "get something about aMethod
+    "get some info about aMethod
      to be shown in the info line at the bottom"
 
     |msg msg2 method wrapper|