Sure, but this is not under refactorings in the menu. It is just that NautilusUI routes such requests to the NautilusRefactorings class.
Maybe there is another place to store that. Or a need to refactor NautilusRefactorings into NautilusCommands (a true refactoring!) As I don't have a view on the design of that beast, I am at a loss here. Phil 2013/2/22 stephane ducasse <[email protected]>: > we should not put it under refactorings. > > > On Feb 21, 2013, at 10:54 AM, [email protected] wrote: > >> I added this one to NautilusRefactorings >> >> basicRenameMethodFor: aMethod >> >> | class selector category oldMethodName newMethodName oldSelector >> newSelector newMethod source parser | >> >> class := aMethod methodClass. >> oldSelector := aMethod selector. >> oldMethodName := oldSelector asString. >> category := aMethod category. >> >> (newMethodName := UITheme builder textEntry: 'New method name:' >> asString title: 'Rename ',oldMethodName asString, ' to...') ifNil: [ >> ^ nil ]. >> >> newSelector := newMethodName asSymbol. >> oldSelector = newSelector ifTrue: [^self]. >> source := class sourceCodeAt: oldSelector. >> >> "Replace selector in method source" >> (parser := class parserClass new) parseSelector: source. >> source := (newSelector asString), (source allButFirst: parser >> endOfLastToken). >> >> "Compile modified source" >> class compile: source classified: category. >> >> "Remove old selector" >> class removeSelector: oldSelector >> >> >> And changed the rename menu into the NautilusUI with >> refactoringMethodMenu: aBuilder >> <nautilusGlobalMethodMenu> >> | target | >> target := aBuilder model. >> target selectedMethod ifNil:[ ^ target ]. >> >> (aBuilder item: #'Refactoring') >> order: -100. >> >> (aBuilder item: #'Rename method (basic)') >> action: [ | scroll | >> scroll := target methodWidget vScrollValue. >> target refactor basicRenameMethodFor: target >> selectedMethod. >> target methodWidget vScrollValue: scroll ]; >> order: -95. >> >> (aBuilder item: #'Rename method (all)') >> keyText: 'r, m' if: Nautilus useOldStyleKeys not; >> keyText: 'r' if: Nautilus useOldStyleKeys; >> action: [ | scroll | >> scroll := target methodWidget vScrollValue. >> target refactor renameMethodFor: target >> selectedMethod. >> target methodWidget vScrollValue: scroll ]; >> order: -90; >> withSeparatorAfter >> >> .... >> >> I think you can get this in Slice #7560 >> >> So, I've got what I needed. Maybe someone knowing better can make this clean. >> >> Maybe there is a way to do this with the standard refactorings system, >> but it was beyond me to start understanding how to do that properly. >> (Altough it looks like pretty cool!) >> >> Phil >> >> >> 2013/2/21 Goubier Thierry <[email protected]>: >>> Le 20/02/2013 21:33, Benjamin a écrit : >>>> >>>> On Feb 20, 2013, at 8:43 PM, stephane ducasse <[email protected] >>>> <mailto:[email protected]>> wrote: >>>> >>>>> >>>>> On Feb 20, 2013, at 1:07 PM, Benjamin >>>>> <[email protected] >>>>> <mailto:[email protected]>> wrote: >>>>> >>>>>> There is actually no simple way to simply rename a method. >>>>>> We should maybe add one which keep track of the versions :) >>>>> >>>>> >>>>> sure there is: >>>>> click on the method >>>>> in the text pane change the selector of the method and compile. >>>> >>>> >>>> I am kind of aware of that :) >>>> >>>> But for a new comer, it's not obvious at all. >>>> And usually they first look in the menu and click on the first entry >>>> "matching" the need >>>> >>>> Ben >>> >>> >>> What about restricting the rename to the current package or class? With, >>> say, a box to tick to go system wide? >>> >>> (And a nice GUI, moose-like, showing on a color map how much of the system >>> the rename will impact :)) >>> >>> Thierry >>> -- >>> Thierry Goubier >>> CEA list >>> Laboratoire des Fondations des Systèmes Temps Réel Embarqués >>> 91191 Gif sur Yvette Cedex >>> France >>> Phone/Fax: +33 (0) 1 69 08 32 92 / 83 95 >>> >> > >
