fixed accepting a selector-namespace method
authorClaus Gittinger <cg@exept.de>
Fri, 27 Jul 2012 16:30:14 +0200
changeset 11695 e860f7929812
parent 11694 464f62536f09
child 11696 1718b69fe880
fixed accepting a selector-namespace method
Tools__NewSystemBrowser.st
--- a/Tools__NewSystemBrowser.st	Fri Jul 27 15:14:10 2012 +0200
+++ b/Tools__NewSystemBrowser.st	Fri Jul 27 16:30:14 2012 +0200
@@ -38871,11 +38871,12 @@
 projectMenuImport
     "import packages - but do not load classes"
 
-    self projectMenuImport:false
-
-!
-
-projectMenuImport:doLoadClasses
+    self projectMenuImport:false usingManager:nil
+
+    "Modified: / 27-07-2012 / 13:34:09 / cg"
+!
+
+projectMenuImport:doLoadClasses usingManager:managerOrNil
     |currentProject default pkg fromWhere module checkedOutPackageDir package numImported numSkipped msg classDefs
      filePerClassDefintion importFromFilesystem importDirectory importFromDirectoryAction
      sourceCodeManager|
@@ -38934,7 +38935,11 @@
         ].
     ].
 
-    sourceCodeManager := (AbstractSourceCodeManager managerForModule:module) ? AbstractSourceCodeManager defaultManager.
+    managerOrNil notNil ifTrue:[
+        sourceCodeManager := managerOrNil.
+    ] ifFalse:[
+        sourceCodeManager := (AbstractSourceCodeManager managerForModule:module) ? AbstractSourceCodeManager defaultManager.
+    ].
 
     UnimplementedFunctionalityError,SourceCodeManagerError handle:[:ex |
         |msg1 msg2|
@@ -39062,7 +39067,10 @@
                                 eachClassDefinition installAsAutoloadedClassIfPublicWithFilename:(filePerClassDefintion at:eachClassDefinition).
                                 (cls := eachClassDefinition changeClass) notNil ifTrue:[
                                     (oldPackage := cls package) ~= theProject ifTrue:[
-                                        (Dialog confirm:('Move the %1-class from the %2-package ?' bindWith:cls name with:oldPackage)) ifTrue:[
+                                        (Dialog confirm:('There is already a class named "%1" in the "%2"-pacakge.\\Move it to the "%3"-package?' 
+                                                    bindWith:cls name allBold 
+                                                    with:oldPackage allBold
+                                                    with:theProject allBold)) ifTrue:[
                                             cls package:theProject.
                                             cls instAndClassMethodsDo:[:m | m package = oldPackage ifTrue:[ m package:theProject]].
                                         ]
@@ -39130,13 +39138,39 @@
     ].
     LastImportedPackage := nil.
 
-    "Modified: / 19-04-2011 / 11:36:39 / cg"
+    "Created: / 27-07-2012 / 13:33:08 / cg"
 !
 
 projectMenuImportAndLoadClasses
     "import packages AND load classes"
 
-    self projectMenuImport:true
+    self projectMenuImport:true usingManager:nil
+
+    "Modified: / 27-07-2012 / 13:34:37 / cg"
+!
+
+projectMenuImportAndLoadClassesUsingManagerNamed:sourceCodeManagerClassName
+    "import packages AND load classes"
+
+    |mgr|
+
+    mgr := Smalltalk at:sourceCodeManagerClassName asSymbol.
+    self assert:(mgr notNil).
+    self projectMenuImport:true usingManager:mgr
+
+    "Created: / 27-07-2012 / 13:46:40 / cg"
+!
+
+projectMenuImportUsingManagerNamed:sourceCodeManagerClassName
+    "import packages - but do not load classes"
+
+    |mgr|
+
+    mgr := Smalltalk at:sourceCodeManagerClassName asSymbol.
+    self assert:(mgr notNil).
+    self projectMenuImport:false usingManager:mgr
+
+    "Created: / 27-07-2012 / 13:34:54 / cg"
 !
 
 projectMenuLoad
@@ -39368,11 +39402,26 @@
 !
 
 projectMenuRecompile
+    |selectedProjects allIncluded projectDefinitionClasses|
+
     self selectedProjectClasses do:[:eachClass |
         self recompileClass:eachClass
     ].
 
-    "Modified: / 30-09-2011 / 12:39:19 / cg"
+    "/ do not forget extensions
+    selectedProjects := self selectedProjects value.
+    allIncluded := selectedProjects includes:(BrowserList nameListEntryForALL).
+    allIncluded ifTrue:[ 
+        projectDefinitionClasses := 
+            ProjectDefinition withAllSubclasses reject:[:c | c isAbstract].
+    ] ifFalse:[
+        projectDefinitionClasses :=
+            selectedProjects collect:[:p | p asPackageId projectDefinitionClass].
+    ].
+    projectDefinitionClasses do:[:each |
+        each extensionMethods do:[:mthd | mthd mclass recompile:mthd selector].
+    ].
+
     "Created: / 31-05-2012 / 12:03:19 / cg"
 !
 
@@ -55850,7 +55899,7 @@
 
     |code cat returnValue newSelector existingMethod language |
 
-    code := codeArg.
+    code := codeArg asString.
     returnValue := false.
     language := languageOrNil 
                     ifNotNil: [languageOrNil]
@@ -55858,7 +55907,7 @@
                             ifTrue:[self selectedMethodsValue first programmingLanguage]
                             ifFalse:[cls programmingLanguage]].
 
-    "/ a quick parse for the selector ...
+    "/ a quick parse for the selector, to check if we overwrite an existing method...
     newSelector := self selectorOfMethodFromCode:code in:cls.
     existingMethod := cls compiledMethodAt:newSelector ifAbsent:[].
     cat := self protocolToAcceptMethod:newSelector class:cls.
@@ -55900,6 +55949,22 @@
                 "/ check if accepting a different selector than the selected one,
                 "/ and a method for the new selector exists.
                 (existingMethod notNil and:[oldSelector ~= newSelector]) ifTrue:[
+                    "/ seems to be the same selector; however, we must really compile to see if it is not going
+                    "/ to end up in another namespace. In that case, we give a different warning message.
+                    rslt := language compilerClass
+                                "/ cg: I am not sure, if this is correct; shouldn' we ask the old method
+                                "/ for its progLanguage/compilerClass if we accept an old method ???
+                                    compile:code
+                                    forClass:cls
+                                    inCategory:cat
+                                    notifying:nil
+                                    install:false.
+                    (rslt notNil and:[ rslt nameSpace notNil ]) ifTrue:[
+                        newSelector := (':',rslt nameSpace name,'::',newSelector) asSymbol.
+                        existingMethod := cls compiledMethodAt:newSelector.     
+                    ].
+                ].
+                (existingMethod notNil and:[oldSelector ~= newSelector]) ifTrue:[
                     answer := OptionBox
                                   request:('You are about to overwrite an existing method.\\Accept anyway ?' withCRs)
                                   label:(resources string:'Attention')
@@ -55978,8 +56043,6 @@
             [
                 |codeCritics|
 
-                code := code asString.
-
                 "/ cg: for now, only smalltalk critics is possible...
                 (self enforceCodeStyle and:[lang isSmalltalk]) ifTrue:[
                     codeCritics := CodeCritics checkCodeQuality:code.
@@ -56001,8 +56064,7 @@
                     "/ should be coupled with a metric
                     code asCollectionOfLines size > 3 ifTrue:[
                         (lang parserClass methodCommentFromSource:code) isEmptyOrNil ifTrue:[
-                            Dialog 
-                                warn:(resources stringWithCRs:'Bad style: please add a method comment.') 
+                            Dialog warn:(resources stringWithCRs:'Bad style: please add a method comment.') 
                         ].
                     ].
                 ].
@@ -56106,7 +56168,7 @@
     ^ returnValue.
 
     "Created: / 30-12-2009 / 20:01:41 / Jan Vrany <jan.vrany@fit.cvut.cz>"
-    "Modified: / 28-02-2012 / 16:14:33 / cg"
+    "Modified: / 27-07-2012 / 14:15:12 / cg"
 !
 
 askForInitialApplicationCodeFor:aClass
@@ -57650,11 +57712,11 @@
 !NewSystemBrowser class methodsFor:'documentation'!
 
 version
-    ^ '$Header: /cvs/stx/stx/libtool/Tools__NewSystemBrowser.st,v 1.1765 2012-07-27 10:29:32 cg Exp $'
+    ^ '$Header: /cvs/stx/stx/libtool/Tools__NewSystemBrowser.st,v 1.1766 2012-07-27 14:30:14 cg Exp $'
 !
 
 version_CVS
-    ^ '$Header: /cvs/stx/stx/libtool/Tools__NewSystemBrowser.st,v 1.1765 2012-07-27 10:29:32 cg Exp $'
+    ^ '$Header: /cvs/stx/stx/libtool/Tools__NewSystemBrowser.st,v 1.1766 2012-07-27 14:30:14 cg Exp $'
 !
 
 version_SVN