class: Tools::NewSystemBrowser
authorClaus Gittinger <cg@exept.de>
Sun, 14 Apr 2013 16:53:50 +0200
changeset 12662 f1c3b68e5234
parent 12661 4739a38172dc
child 12663 b03e10855ce2
class: Tools::NewSystemBrowser added:9 methods comment/format in: #methodsPreviousVersionCode changed:5 methods search and compare functions for shadowed (=overwritten in a loaded package) methods. Useful to find and fix package conflicts.
Tools__NewSystemBrowser.st
--- a/Tools__NewSystemBrowser.st	Sun Apr 14 14:40:00 2013 +0200
+++ b/Tools__NewSystemBrowser.st	Sun Apr 14 16:53:50 2013 +0200
@@ -5871,8 +5871,12 @@
                 )
                (MenuItem
                   label: 'With Extensions'
-                  itemValue: browseMenuClassesWithExtensions
-                  isVisible: false
+                  itemValue: browseMenuClassExtensionsBuffer
+                  showBusyCursorWhilePerforming: true
+                )
+               (MenuItem
+                  label: 'With Shadowed Methods (Package Conflicts)'
+                  itemValue: browseMenuClassesWithShadowedMethods
                   showBusyCursorWhilePerforming: true
                 )
                (MenuItem
@@ -6045,15 +6049,15 @@
                   showBusyCursorWhilePerforming: true
                 )
                (MenuItem
-                  label: 'Overwritten Methods'
-                  itemValue: browseMenuOverwrittenMethods:
-                  argument: newBrowser
-                  showBusyCursorWhilePerforming: true
-                )
-               (MenuItem
                   label: 'Unassigned Extensions'
                   itemValue: browseMenuUnassignedMethods:
-                  argument: newBrowser
+                  argument: newBuffer
+                  showBusyCursorWhilePerforming: true
+                )
+               (MenuItem
+                  label: 'Overwritten Methods (Package Conflicts)'
+                  itemValue: browseMenuOverwrittenMethods:
+                  argument: newBuffer
                   showBusyCursorWhilePerforming: true
                 )
                (MenuItem
@@ -10950,6 +10954,11 @@
                   itemValue: selectorMenuCompareWithPreviousVersion
                 )
                (MenuItem
+                  enabled: methodIsShadowedHolder
+                  label: 'With Shadowed Method'
+                  itemValue: selectorMenuCompareWithShadowedMethod
+                )
+               (MenuItem
                   enabled: hasSingleMethodSelectedAndCodeModifiedHolder
                   label: 'With Methods Actual Source'
                   itemValue: selectorMenuCompareWithMethod
@@ -22009,6 +22018,14 @@
     ^ [ self methodHasPreviousVersion ]
 !
 
+methodIsShadowed
+    ^ self methodsShadowedMethod notNil
+!
+
+methodIsShadowedHolder
+    ^ [ self methodIsShadowed ]
+!
+
 methodIsSubclassResponsibility
     self selectedMethodsDo:[:eachMethod |
         (eachMethod sends:#subclassResponsibility) ifTrue:[^ true].
@@ -23503,19 +23520,9 @@
     |searchBlock|
 
     searchBlock := [
-                        |classes|
-
-                        classes := IdentitySet new.
-
-                        Smalltalk allClassesDo:[:eachClass |
-                            |cls|
-
-                            eachClass wasAutoloaded ifTrue:[
-                                classes add:eachClass.
-                            ].
-                        ].
-                        classes asOrderedCollection
-                  ].
+                        (Smalltalk allClassesForWhich:[:someClass | someClass wasAutoloaded])
+                            asOrderedCollection
+                   ].
 
     self
         spawnClassBrowserForSearch:searchBlock
@@ -23547,20 +23554,20 @@
 
             newBrowser := self
                         spawnClassExtensionBrowserForSearch:[
-                            |classes include|
-
-                            classes := IdentitySet new.
-                            aCollectionOfClasses do:[:aClass |
-                                aCollectionOfPackagesOrNil isNil ifTrue:[
-                                    include := aClass hasExtensions.
-                                ] ifFalse:[
-                                    include := aCollectionOfPackagesOrNil contains:[:eachPackage | aClass hasExtensionsFrom:eachPackage]
-                                ].
-                                include ifTrue:[
-                                    classes add:aClass
-                                ]
-                            ].
-                            classes asOrderedCollection sort:[:a :b | a name < b name]
+                            |classes|
+
+                            classes := (aCollectionOfClasses 
+                                        select:[:aClass |
+                                            |include|
+
+                                            aCollectionOfPackagesOrNil isNil ifTrue:[
+                                                include := aClass hasExtensions.
+                                            ] ifFalse:[
+                                                include := aCollectionOfPackagesOrNil contains:[:eachPackage | aClass hasExtensionsFrom:eachPackage]
+                                            ].
+                                            include
+                                        ]) asOrderedCollection.
+                            classes sort:[:a :b | a name < b name]
                         ]
                         label:labelOrNil
                         in:openHow.
@@ -23930,6 +23937,42 @@
     self searchMenuFindClass:#newBuffer single:false.
 !
 
+browseMenuClassesWithShadowedMethods
+    "open a new browser on all package conflicts (methods shadowing existing one's from
+     another package)"
+
+    self browseMenuClassesWithShadowedMethodsOpenAs:#newBuffer
+!
+
+browseMenuClassesWithShadowedMethodsOpenAs:openHow
+    "open a browser / add a new buffer on all methods which shadow an
+     existing method from another package"
+
+    self withSearchCursorDo:[
+        |newBrowser|
+
+        newBrowser := self
+                    spawnClassExtensionBrowserForSearch:[
+                        |classes|
+
+                        classes := Smalltalk allClassesForWhich:[:someClass |
+                            |include|
+
+                            include := false.
+                            someClass hasExtensions ifTrue:[
+                                someClass instAndClassMethodsDo:[:m | m isShadowingExtension ifTrue:[include := true]].
+                            ].
+                            include 
+                        ].
+                        classes asOrderedCollection sort:[:a :b | a name < b name]
+                    ]
+                    label:'Classes with Overwritten Methods (Package Conflicts)'
+                    in:openHow.
+
+        "/ newBrowser navigationState selectedProjects value:nil.
+    ]
+!
+
 browseMenuClassesWithStringInCommentOrDocumentation
     "open a dialog asking for a string; search for classes having
      such a string fragment in their comment/documentation."
@@ -24878,7 +24921,7 @@
             and:[ (def savedOverwrittenMethodForClass:cls selector:mthd selector) notNil ]]]
         ]
         in:openHow
-        label:'Overwritten Methods'
+        label:'Overwritten Methods (Package Conflicts)'
 !
 
 browseMenuRecentChanges
@@ -42697,7 +42740,7 @@
 !
 
 methodsPreviousVersionCode
-    "return the methods previous versions code"
+    "return the method's previous version's code"
 
     |m|
 
@@ -42718,6 +42761,25 @@
     ^ m previousVersions.
 !
 
+methodsShadowedMethod
+    "return the method's shadowed method, or nil.
+     The shadowed method is the original method from its original package,
+     which was overloaded by another package"
+
+    |m mClass mProjectDefinition|
+
+    m := self theSingleSelectedMethod.
+    m isNil ifTrue:[^ nil].
+
+    mClass := m mclass theNonMetaclass.
+    (mClass notNil
+      and:[ m package ~= mClass package
+      and:[ (mProjectDefinition := mClass projectDefinitionClass) notNil]]) ifTrue:[
+        ^ mProjectDefinition savedOverwrittenMethodForClass:m mclass selector:m selector
+    ].
+    ^ nil
+!
+
 moveMethods:methods toClass:newClass
     "move some methods to some other class - typically a sister class"
 
@@ -43759,6 +43821,30 @@
     ^ self
 !
 
+selectorMenuCompareWithShadowedMethod
+    "compare the codeView's contents against the method's shadowed version
+     (that is the original, overloaded method from the method's original package)"
+
+    |m originalMethod v|
+
+    m := self theSingleSelectedMethod.
+    originalMethod := self methodsShadowedMethod.
+    originalMethod isNil ifTrue:[
+        self information:'Oops - no shadowed (original method) found'.
+        ^ self
+    ].
+    self withWaitCursorDo:[
+        v := DiffCodeView
+                openOn:originalMethod source
+                label:(resources string:'shadowed (original) in %1' with:originalMethod package allBold)
+                and:m source
+                label:(resources string:'current in %1' with:m package allBold).
+        v label:(resources string:'comparing method').
+        v waitUntilVisible.
+    ].
+    ^ self
+!
+
 selectorMenuCompareWithSmallTeamVersionOnHost:hostName
     "compare the codeViews contents against a SmallTeam version"
 
@@ -58296,11 +58382,11 @@
 !NewSystemBrowser class methodsFor:'documentation'!
 
 version
-    ^ '$Header: /cvs/stx/stx/libtool/Tools__NewSystemBrowser.st,v 1.1863 2013-04-04 06:30:54 cg Exp $'
+    ^ '$Header: /cvs/stx/stx/libtool/Tools__NewSystemBrowser.st,v 1.1864 2013-04-14 14:53:50 cg Exp $'
 !
 
 version_CVS
-    ^ '$Header: /cvs/stx/stx/libtool/Tools__NewSystemBrowser.st,v 1.1863 2013-04-04 06:30:54 cg Exp $'
+    ^ '$Header: /cvs/stx/stx/libtool/Tools__NewSystemBrowser.st,v 1.1864 2013-04-14 14:53:50 cg Exp $'
 !
 
 version_SVN