Merge jv
authorMerge Script
Tue, 14 Jun 2016 07:09:40 +0200
branchjv
changeset 16694 715f1da6f138
parent 16689 70b43a6c4755 (current diff)
parent 16693 cfc4360aea7d (diff)
child 16696 6b41ff123f46
Merge
SystemBrowser.st
Tools__NewSystemBrowser.st
Tools__SearchDialog.st
--- a/SystemBrowser.st	Fri Jun 10 07:10:24 2016 +0200
+++ b/SystemBrowser.st	Tue Jun 14 07:09:40 2016 +0200
@@ -1,3 +1,5 @@
+"{ Encoding: utf8 }"
+
 "
  COPYRIGHT (c) 1989 by Claus Gittinger
               All Rights Reserved
@@ -120,7 +122,7 @@
 
 openInClass:aClass selector:aSelector
     "launch a standard browser which immediately switches
-     to aClass » aSelector. Returns the browser"
+     to aClass » aSelector. Returns the browser"
 
     |brwsr classesName|
 
@@ -5110,9 +5112,29 @@
      containing a string in their source.
      This may be slow, since source-code has to be scanned."
 
+    ^ self findString:aString in:aCollectionOfClasses ignoreCase:ignoreCase match:doMatch fullWordsOnly:false
+
+    "
+     SystemBrowser 
+        findString:'should'   
+        in:(Array with:Object) 
+        ignoreCase:false
+    "
+!
+
+findString:aString in:aCollectionOfClasses ignoreCase:ignoreCase match:doMatch fullWordsOnly:fullWordsOnly
+    "return a collection of all methods in aCollectionOfClasses  
+     containing a string in their source.
+     This may be slow, since source-code has to be scanned."
+
     |searchBlock|
 
-    searchBlock := self searchBlockForString:aString ignoreCase:ignoreCase match:doMatch.
+    searchBlock := 
+        self 
+            searchBlockForString:aString 
+            ignoreCase:ignoreCase 
+            match:doMatch
+            fullWordsOnly:fullWordsOnly.
     ^ self findMethodsIn:aCollectionOfClasses where:searchBlock.
 
     "
@@ -5125,9 +5147,17 @@
      containing a string in their source.
      This may be slow, since source-code has to be scanned."
 
+    ^ self findString:aString inMethods:aCollectionOfMethods ignoreCase:ignoreCase match:doMatch fullWordsOnly:false
+!
+
+findString:aString inMethods:aCollectionOfMethods ignoreCase:ignoreCase match:doMatch fullWordsOnly:fullWordsOnly
+    "return a collection of all methods in aCollectionOfClasses  
+     containing a string in their source.
+     This may be slow, since source-code has to be scanned."
+
     |searchBlock|
 
-    searchBlock := self searchBlockForString:aString ignoreCase:ignoreCase match:doMatch.
+    searchBlock := self searchBlockForString:aString ignoreCase:ignoreCase match:doMatch fullWordsOnly:fullWordsOnly.
     ^ aCollectionOfMethods select:[:m | searchBlock value:m mclass value:m value:m selector].
 !
 
@@ -5135,9 +5165,22 @@
     "return a collection of all methods in aCollectionOfClasses  
      containing a string in any of their string-literals."
 
+    ^ self 
+        findStringLiteral:aString in:aCollectionOfClasses 
+        ignoreCase:ignoreCase match:doMatch fullWordsOnly:false
+
+    "
+     SystemBrowser findStringLiteral:'error' in:(Array with:Object) ignoreCase:true match:false
+    "
+!
+
+findStringLiteral:aString in:aCollectionOfClasses ignoreCase:ignoreCase match:doMatch fullWordsOnly:fullWordsOnly
+    "return a collection of all methods in aCollectionOfClasses  
+     containing a string in any of their string-literals."
+
     |searchBlock|
 
-    searchBlock := self searchBlockForStringLiteral:aString ignoreCase:ignoreCase match:doMatch.
+    searchBlock := self searchBlockForStringLiteral:aString ignoreCase:ignoreCase match:doMatch fullWordsOnly:fullWordsOnly.
     ^ self findMethodsIn:aCollectionOfClasses where:searchBlock.
 
     "
@@ -5149,9 +5192,18 @@
     "return a collection of all methods in aCollectionOfClasses  
      containing a string in any of their string-literals."
 
+    ^ self
+        findStringLiteral:aString inMethods:aCollectionOfMethods
+        ignoreCase:ignoreCase match:doMatch fullWordsOnly:false
+!
+
+findStringLiteral:aString inMethods:aCollectionOfMethods ignoreCase:ignoreCase match:doMatch fullWordsOnly:fullWordsOnly
+    "return a collection of all methods in aCollectionOfClasses  
+     containing a string in any of their string-literals."
+
     |searchBlock|
 
-    searchBlock := self searchBlockForStringLiteral:aString ignoreCase:ignoreCase match:doMatch.
+    searchBlock := self searchBlockForStringLiteral:aString ignoreCase:ignoreCase match:doMatch fullWordsOnly:fullWordsOnly.
     ^ aCollectionOfMethods select:[:m | searchBlock value:m mclass value:m value:m selector].
 !
 
@@ -5705,6 +5757,23 @@
 searchBlockForString:aString ignoreCase:ignoreCase match:doMatchArg
     "return a block to search for a string."
 
+    ^ self 
+        searchBlockForString:aString 
+        ignoreCase:ignoreCase 
+        match:doMatchArg 
+        fullWordsOnly:false
+
+    "
+     SystemBrowser 
+        findString:'should'   
+        in:(Array with:Object) 
+        ignoreCase:false
+    "
+!
+
+searchBlockForString:aString ignoreCase:ignoreCase match:doMatchArg fullWordsOnly:fullWordsOnly
+    "return a block to search for a string."
+
     |checkBlock lineCheckBlock pattern doMatch
      quickCheckString firstMatchIndex lastMatchIndex|
 
@@ -5734,45 +5803,59 @@
             pattern := pattern,'*'
         ].
         "/ when doing a match, be careful to not match acrosss lines
-        ignoreCase ifTrue:[
-            lineCheckBlock := [:line | pattern match:line caseSensitive:false]
-        ] ifFalse:[    
-            lineCheckBlock := [:line | pattern match:line caseSensitive:true]
-        ].
+        lineCheckBlock := [:line | pattern match:line caseSensitive:ignoreCase not].
         quickCheckString size > 1 ifTrue:[
-            ignoreCase ifTrue:[
-                checkBlock := [:src | 
-                                (src includesString:quickCheckString caseSensitive:false)
-                                and:[ (lineCheckBlock value:src)
-                                and:[ src asStringCollection contains:lineCheckBlock ]]].
-            ] ifFalse:[
-                checkBlock := [:src | 
-                                (src includesString:quickCheckString caseSensitive:true)
-                                and:[ (lineCheckBlock value:src)
-                                and:[ src asStringCollection contains:lineCheckBlock ]]].
-            ]    
+            checkBlock := [:src | 
+                            (src includesString:quickCheckString caseSensitive:ignoreCase not)
+                            and:[ (lineCheckBlock value:src)
+                            and:[ src asStringCollection contains:lineCheckBlock ]]].
         ] ifFalse:[    
             checkBlock := [:src | 
                             (lineCheckBlock value:src)
                             and:[ src asStringCollection contains:lineCheckBlock ]].
         ].
     ] ifFalse:[
-        ignoreCase ifTrue:[
-            checkBlock := [:src | src includesString:aString caseSensitive:false]
-        ] ifFalse:[
-            checkBlock := [:src | src includesString:aString caseSensitive:true]
-        ].    
+        checkBlock := [:src | src includesString:aString caseSensitive:ignoreCase not]
     ].
+    
     ^ [:cls :mthd :sel | 
-        |src|
-
+        |src found idx1 reallyFound ch1 ch2|
+
+        found := false.
         src := mthd source.
         src isNil ifTrue:[
             ('Browser [info]: no source for ' , mthd printString) infoPrintCR.
-            false
         ] ifFalse:[
-            checkBlock value:src
-        ]
+            found := checkBlock value:src.
+            (fullWordsOnly and:[found]) ifTrue:[
+                self halt.
+                doMatch ifTrue:[
+                    
+                ] ifFalse:[
+                    reallyFound := false.
+                    idx1 := 0.
+                    [ 
+                        reallyFound not
+                        and:[
+                            idx1 := src indexOfSubCollection:aString startingAt:idx1+1 ifAbsent:0 caseSensitive:ignoreCase not.
+                            idx1 ~~ 0]
+                    ] whileTrue:[
+                        "/ see if it is a free-standing word
+                        reallyFound := true.
+                        idx1 > 1 ifTrue:[
+                            ch1 := src at:idx1-1.
+                            (ch1 isLetter or:[ch1 == $_]) ifTrue:[ reallyFound := false].
+                        ].
+                        (idx1+aString size-1) < src size ifTrue:[
+                            ch2 := src at:idx1+aString size.
+                            (ch2 isLetter or:[ch2 == $_]) ifTrue:[ reallyFound := false].
+                        ].
+                    ].
+                    found := reallyFound
+                ].                
+            ].                
+        ].
+        found
       ]
 
     "
@@ -5783,6 +5866,21 @@
 searchBlockForStringLiteral:aString ignoreCase:ignoreCase match:doMatchArg
     "return a block to search for a string-literal."
 
+    ^ self
+        searchBlockForStringLiteral:aString ignoreCase:ignoreCase match:doMatchArg
+        fullWordsOnly:false
+
+    "
+     SystemBrowser findStringLiteral:'error' in:(Array with:Object) ignoreCase:true match:true
+     SystemBrowser findStringLiteral:'error' in:(Array with:Object) ignoreCase:true match:false
+     SystemBrowser findStringLiteral:'error' in:(Array with:Object) ignoreCase:false match:true
+     SystemBrowser findStringLiteral:'error' in:(Array with:Object) ignoreCase:false match:false
+    "
+!
+
+searchBlockForStringLiteral:aString ignoreCase:ignoreCase match:doMatchArg fullWordsOnly:fullWordsOnly
+    "return a block to search for a string-literal."
+
     |pattern doMatch checkLiteral checkSource 
      quickCheckString firstMatchIndex lastMatchIndex|
 
@@ -6992,8 +7090,8 @@
         ('*>>*' match:sel) ifTrue:[
             sep := $>
         ] ifFalse:[
-            ('*»*' match:sel) ifTrue:[
-                sep := $»
+            ('*»*' match:sel) ifTrue:[
+                sep := $»
             ] ifFalse:[
                 ('* *' match:sel) ifTrue:[
                     sep := Character space
@@ -7032,7 +7130,7 @@
 
     aString isEmptyOrNil ifTrue:[^ nil].
 
-    (idx := aString indexOf:$») ~~ 0 ifTrue:[
+    (idx := aString indexOf:$») ~~ 0 ifTrue:[
         s := (aString copyFrom:idx+1) withoutSeparators.
         s isEmpty ifTrue:[^ nil]. 
     ] ifFalse:[    
@@ -7082,7 +7180,7 @@
      self extractSelectorFrom:'self at:something put:someValue'
      self extractSelectorFrom:'(self at:something put:someValue)' 
      self extractSelectorFrom:'[self at:something put:someValue] value' 
-     self extractSelectorFrom:'Array » at:put:' 
+     self extractSelectorFrom:'Array » at:put:' 
      self extractSelectorFrom:'Array>>at:put:' 
      self extractSelectorFrom:'Array>>#at:put:' 
      self extractSelectorFrom:'Array>>#''at:put:''' 
@@ -7255,7 +7353,7 @@
     ].
     selector notNil ifTrue:[ 
         aGCOrStream
-            nextPutAll:' » ';
+            nextPutAll:' » ';
             emphasis:#bold;
             nextPutAll:selector;
             emphasis:nil.
--- a/Tools__NewSystemBrowser.st	Fri Jun 10 07:10:24 2016 +0200
+++ b/Tools__NewSystemBrowser.st	Tue Jun 14 07:09:40 2016 +0200
@@ -24163,7 +24163,7 @@
                         searchPattern = codeView searchPattern ifTrue:[
                             codeView
                                 cursorHome;
-                                cursorRight; "/ to avoid finding the selector
+                                "/ cursorRight; "/ to avoid finding the selector
                                 searchFwd:searchPattern
                                     ignoreCase:(navigationState autoSearchIgnoreCase)
                                     match:(navigationState autoSearchIsMatch)
@@ -26480,8 +26480,8 @@
     self
         askForMethodAndSpawnSearchTitle:'String to Search for in Sources:'
         browserLabel:'Methods containing "%1"'
-        searchWith:#( #'findString:in:ignoreCase:match:' #'findString:inMethods:ignoreCase:match:' 
-                      #'findStringLiteral:in:ignoreCase:match:' #'findStringLiteral:inMethods:ignoreCase:match:' )
+        searchWith:#( #'findString:in:ignoreCase:match:fullWordsOnly:' #'findString:inMethods:ignoreCase:match:' 
+                      #'findStringLiteral:in:ignoreCase:match:fullWordsOnly:' #'findStringLiteral:inMethods:ignoreCase:match:fullWordsOnly:' )
         searchWhat:#string
         searchArea:whereDefault
         withCaseIgnore:true
@@ -56154,7 +56154,7 @@
         initialText:aString;
         showMetaFilter:true.
 
-    "/ hack...
+    "/ very ugly hack...
     searchWhat == #string ifTrue:[
         selectorOrBlockOrSelectorPair size == 4 ifTrue:[
             "/ the first two are for a string search,
@@ -56165,6 +56165,7 @@
 
             dialog withSearchStringInLiterals:true.
         ].    
+        "/ dialog withSearchFreeStandingWordsOnly:true.
     ].
     
     dialog    
@@ -56182,7 +56183,7 @@
     
     [:restart|
         dialog askThenDo:[
-            |classes string ignoreCase openHow match methods isMethod searchAction
+            |classes string ignoreCase openHow match fullWordsOnly methods isMethod searchAction
              keepResultList|
 
             "/ some searches are very slow, and we do not want to research automatically
@@ -56194,6 +56195,7 @@
             ignoreCase := dialog searchIgnoringCase.
             openHow := dialog openHow.
             match := dialog searchWithMatch.
+            fullWordsOnly := dialog searchFreeStandingWordsOnly.
             methods := dialog methodsToSearch.
             isMethod := dialog matchMethods.
 
@@ -56237,7 +56239,8 @@
                                    entities . 
                                    ((selector notNil and:[selector endsWith:'isMethod:']) 
                                                 ifTrue:[isMethod] ifFalse:[ignoreCase]) .
-                                   match 
+                                   match.
+                                   fullWordsOnly
                                  } copyTo:numArgs.
                 ].
 
--- a/Tools__SearchDialog.st	Fri Jun 10 07:10:24 2016 +0200
+++ b/Tools__SearchDialog.st	Tue Jun 14 07:09:40 2016 +0200
@@ -1,3 +1,5 @@
+"{ Encoding: utf8 }"
+
 "
  COPYRIGHT (c) 2000 by eXept Software AG
 	      All Rights Reserved
@@ -23,7 +25,8 @@
 		searchInstanceProtocolHolder selectorOrCode selectionList
 		listHolder matchProcess inputField showMetaFilter
 		metaclassesOnlyHolder classesOnlyHolder initialText
-		withSearchStringInLiterals searchStringInLiteralsHolder'
+		withSearchStringInLiterals searchStringInLiteralsHolder
+		searchFreeStandingWordsOnlyHolder withSearchFreeStandingWordsOnly'
 	classVariableNames:'LastCodeSearched LastCodeSearchWasMethod LastGlobalSearched
 		LastStringSearched LastSearchWasMatch LastSearchWasCaseSensitive
 		LastStringSearchArea LastCodeSearchArea AREA_LISTOFMETHODS
@@ -149,6 +152,9 @@
 #searchStringInLiterals
 'Search string in literal constants; not in source code'
 
+#searchFreeStandingWordsOnly
+'Search for free-standing words only (i.e. not substrings)'
+
 #match
 'Perform a pattern match search, as opposed to an exact string search.\Pattern is a simple GLOB pattern (as in filenames)'
 
@@ -187,6 +193,12 @@
     showMetaFilter := aBoolean.
 !
 
+withSearchFreeStandingWordsOnly:aBoolean
+    "enable another checkbox, to allow searching for full words only"
+     
+    withSearchFreeStandingWordsOnly := aBoolean.
+!
+
 withSearchStringInLiterals:aBoolean
     "enable another checkbox, to allow searching for a string
      in the literals only"
@@ -244,6 +256,14 @@
     ^ whereRadioGroup value.
 !
 
+searchFreeStandingWordsOnly
+    "the value of the corresponding check toggle;
+     if on, only free standing words match - i.e. the searched word
+     may not be part of a longer word"
+     
+    ^ searchFreeStandingWordsOnlyHolder value ? false.
+!
+
 searchIgnoringCase
     ^ self searchIsCaseSensitive not
 !
@@ -579,6 +599,10 @@
         currentPanel := self.
         self addCheckBoxForSearchInLiteralsOnly
     ].
+    (withSearchFreeStandingWordsOnly ? false) ifTrue:[    
+        currentPanel := self.
+        self addCheckBoxForSearchFreeStandingWordsOnly
+    ].
     
     self addHorizontalLine.
 
@@ -957,6 +981,20 @@
     ^ b.
 !
 
+addCheckBoxForSearchFreeStandingWordsOnly
+    |p b|
+
+    p := View new.
+    
+    b := CheckBox label:(resources string:'Search Free Standing Words Only') in:p.
+    b model:(searchFreeStandingWordsOnlyHolder := false asValue).
+    p helpKey:#searchFreeStandingWordsOnly.
+    self makeTabable:b.
+
+    currentPanel add:p.
+    ^ nil.
+!
+
 addCheckBoxForSearchInLiteralsOnly
     |p b|