Tools__NewSystemBrowser.st
changeset 9523 4d77d289ca89
parent 9520 e372a4c70e3e
child 9524 74d5155db6b8
--- a/Tools__NewSystemBrowser.st	Sat Jul 17 14:51:06 2010 +0200
+++ b/Tools__NewSystemBrowser.st	Sat Jul 17 14:53:30 2010 +0200
@@ -43045,7 +43045,7 @@
                 ex proceedWith:answer
             ].
         ] do:[
-            |codeView package oldMethod oldSelector defPackage answer rslt|
+            |codeView package oldMethod oldSelector defPackage answer rslt lang|
 
             "/ used to be
             "/    oldSelector := self theSingleSelectedSelector.
@@ -43144,6 +43144,10 @@
                 ].
             ].
 
+            lang := oldMethod notNil
+                        ifTrue:[ oldMethod programmingLanguage ]
+                        ifFalse:[ cls programmingLanguage ].
+
             "/ notice: when compiling, the classes change message will already
             "/ be noticed by the methodList and lead to an update
             "/ to be enqueued.
@@ -43153,7 +43157,8 @@
 
                 code := code asString.
 
-                self enforceCodeStyle ifTrue:[
+                "/ cg: for now, only smalltalk critics is possible...
+                (self enforceCodeStyle and:[lang isSmalltalk]) ifTrue:[
                     codeCritics := CodeCritics checkCodeQuality:code.
                     codeCritics notNil ifTrue:[
                         codeCritics do:[:eachCritic |
@@ -43168,6 +43173,12 @@
                         ].
                     ].
                 ].
+                self enforceComment ifTrue:[
+                    (lang parserClass methodCommentFromSource:code) isEmptyOrNil ifTrue:[
+                        Dialog 
+                            warn:(resources stringWithCRs:'Bad style: please add a method comment.') 
+                    ].
+                ].
 
                 "/ do not react on the methodSelectionChanged notification
                 "/ (which is enforced by the methodList)
@@ -43184,6 +43195,7 @@
 answer:(self currentNamespace)
 do:[
                             (self canUseRefactoringSupport and:[(Smalltalk at:cls theNonMetaclass name)==cls]) ifTrue:[
+                                "/ cg: Q: is the AddMethodChange prepared for languages ?
                                 change := InteractiveAddMethodChange compile:code in:cls classified:cat.
                                 change controller:codeView.
                                 "/ change named:('Accept method ' , newSelector ? '???').
@@ -43191,6 +43203,8 @@
                                 RefactoryChangeManager performChange: change.
                                 rslt := cls compiledMethodAt:newSelector.
                             ] ifFalse:[
+                                "/ 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 ???
                                 rslt := cls compilerClass
                                     compile:code
                                     forClass:cls
@@ -43259,7 +43273,7 @@
     ].
     ^ returnValue.
 
-    "Modified: / 27-03-2007 / 21:51:20 / cg"
+    "Modified: / 17-07-2010 / 14:32:13 / cg"
 !
 
 askForInitialApplicationCodeFor:aClass
@@ -43683,6 +43697,12 @@
     ^ UserPreferences current enforceCodeStyle
 !
 
+enforceComment
+    ^ UserPreferences current enforceComment
+
+    "Created: / 17-07-2010 / 14:18:26 / cg"
+!
+
 openDiffViewForText:theCode againstSourceOfMethod:aMethod
     |originalSource changedSource v|
 
@@ -44492,11 +44512,11 @@
 !NewSystemBrowser class methodsFor:'documentation'!
 
 version
-    ^ '$Header: /cvs/stx/stx/libtool/Tools__NewSystemBrowser.st,v 1.1465 2010-07-11 15:44:16 cg Exp $'
+    ^ '$Header: /cvs/stx/stx/libtool/Tools__NewSystemBrowser.st,v 1.1466 2010-07-17 12:53:30 cg Exp $'
 !
 
 version_CVS
-    ^ '$Header: /cvs/stx/stx/libtool/Tools__NewSystemBrowser.st,v 1.1465 2010-07-11 15:44:16 cg Exp $'
+    ^ '$Header: /cvs/stx/stx/libtool/Tools__NewSystemBrowser.st,v 1.1466 2010-07-17 12:53:30 cg Exp $'
 ! !
 
 NewSystemBrowser initialize!