"
COPYRIGHT (c) 2000 by eXept Software AG
All Rights Reserved
This software is furnished under a license and may be used
only in accordance with the terms of that license and with the
inclusion of the above copyright notice. This software may not
be provided or otherwise made available to, or used by, any
other person. No title to or ownership of the software is
hereby transferred.
"
"{ Package: 'stx:libtool' }"
"{ NameSpace: Tools }"
SystemBrowser subclass:#NewSystemBrowser
instanceVariableNames:'navigationState bufferNameList selectedBuffer buffers
bufferUsageOrder browserCanvas immediateUpdate showClassPackages
lastMethodCategory lastMethodMoveClass browserCanvasType
syntaxColoringProcessRunning syntaxColoringProcess
methodInfoProcess'
classVariableNames:'LastNewProtocols LastProtocolRenames LastCategoryRenames
LastCategoryRenameOld LastCategoryRenameNew LastProjectMoves
LastNameSpaceMove LastMethodMoveOrCopyTargetClass
LastSearchPatterns LastClassFilterBlockString
LastMethodFilterBlockString LastBreakPointConditionString
LastIndividualChecks LastAcceptPackage LastVariableRenames
LastVisitorClassName LastTemporaryVariableName BookMarks
FindHistory CheckForInstancesWhenRemovingClasses
SynchronousUpdate DoubleClickIsOpenBrowser
ShowMethodTemplateWhenProtocolIsSelected
DefaultShowMethodTemplate DefaultShowMethodInheritance
DefaultEmphasizeUnloadedClasses DefaultImmediateSyntaxColoring
DefaultImmediateExplaining DefaultSyntaxColoring
DefaultToolBarVisible DefaultCodeInfoVisible
DefaultShortNameInTabs DefaultHideUnloadedClasses
DefaultMarkApplications DefaultAutoFormat
DefaultShowMethodComplexity DefaultShowMethodTypeIcon
DefaultShowSpecialResourceEditors SharedMethodCategoryCache
LastMethodProcessingBlockString LastLoadedPackages
DefaultShortAllClassesInNameSpaceOrganisation LastTag
DefaultShowPseudoProtocols DefaultShowMultitabMode LastRenamedOld
LastRenamedNew'
poolDictionaries:''
category:'Interface-Browsers-New'
!
!NewSystemBrowser class methodsFor:'documentation'!
aboutThisApplicationText
^ super aboutThisApplicationText ,
'\\Written by Claus Gittinger, eXept Software AG\Thanks to John Brant & Dan Roberts for their Refactory Code.' withCRs
!
copyright
"
COPYRIGHT (c) 2000 by eXept Software AG
All Rights Reserved
This software is furnished under a license and may be used
only in accordance with the terms of that license and with the
inclusion of the above copyright notice. This software may not
be provided or otherwise made available to, or used by, any
other person. No title to or ownership of the software is
hereby transferred.
"
!
documentation
"
A new, much improved, system browser,
providing:
multiple buffers
multi-select in most selectionLists
view-selection (by namespace, by project, by category ...)
embedded repository diff
more search operations
code checker (not yet complete)
some refactoryBrowser functionality
completely built using GUI painter and reusable components.
[author:]
cg@exept.de
[see also:]
SystemBrowser BrowserView
VersionDiffBrowser
"
!
examples
"
NewSystemBrowser open
"
! !
!NewSystemBrowser class methodsFor:'initialization'!
initialize
Icon initialize.
Color initialize.
"/ self installInLauncher. - now done in phase 2
ObjectMemory addDependent:self.
!
installInLauncher
"add myself to the launcher menu and toolBar"
|menuItem icon action currentLauncher|
NewLauncher isNil ifTrue:[^ self].
action := (MessageSend receiver:(Smalltalk at:self name) selector:#open).
icon := [NewLauncher startNewSystemBrowserIcon]. "/ self defaultIcon magnifiedTo:28@28.
menuItem := MenuItem new
value: action;
isButton: false;
translateLabel: true;
label:'New System Browser' icon:icon;
nameKey: #newSystemBrowser;
activeHelpKey: #newSystemBrowser;
submenuChannel: #menuClassHistoryNew;
showBusyCursorWhilePerforming:true.
NewLauncher
addMenuItem:menuItem
from:self
in:'menu.classes'
position:#(before systemBrowser)
space:true.
menuItem := MenuItem new
value: action;
isButton: true;
translateLabel: true;
icon:icon;
nameKey: #newSystemBrowser;
activeHelpKey: #newSystemBrowser;
submenuChannel: #menuClassHistoryNew;
showBusyCursorWhilePerforming:true.
NewLauncher
addMenuItem:menuItem
from:self
in:'toolbar'
position:#(before systemBrowser)
space:false.
currentLauncher := NewLauncher current.
currentLauncher notNil ifTrue:[
currentLauncher systemBrowserItemVisible value:false.
]
"
self installInLauncher
self removeFromLauncher
"
!
loadRefactoryBrowser
"/ try to load the refactoryBrowser package ...
Smalltalk loadPackage:'stx:goodies/refactoryBrowser' asAutoloaded:true.
"/ could be autoloaded
RefactoryChangeManager notNil ifTrue:[
RefactoryChangeManager autoload.
]
!
postAutoload
"add myself to the launcher menu."
self installInLauncher.
"/ try to load the refactoryBrowser package ...
self loadRefactoryBrowser.
"
self postAutoload
Transcript application removeUserTool:#newSystemBrowser
"
"Modified: / 23.8.2001 / 12:32:34 / cg"
!
removeFromLauncher
"remove myself from the launcher menu"
|currentLauncher|
NewLauncher isNil ifTrue:[^ self].
NewLauncher removeUserTool:#newSystemBrowser.
currentLauncher := NewLauncher current.
currentLauncher notNil ifTrue:[
currentLauncher systemBrowserItemVisible value:true
]
"
self removeFromLauncher
"
!
unload
"class is about to be unloaded - remove myself from the launcher menu"
self removeFromLauncher.
super unload.
!
update:something with:aParameter from:changedObject
something == #initialized ifTrue:[
changedObject == ObjectMemory ifTrue:[
self installInLauncher.
ObjectMemory removeDependent:self.
]
].
! !
!NewSystemBrowser class methodsFor:'accessing-history'!
addToBookMarks:aClass selector:aSelectorOrNil
|newEntry|
(newEntry := self historyEntryForClass:aClass selector:aSelectorOrNil) isNil ifTrue:[^ self].
((BookMarks ? #()) contains:[:entry | entry className = newEntry className
and:[entry meta = newEntry meta
and:[aSelectorOrNil isNil or:[entry selector = newEntry selector]]]])
ifFalse:[
BookMarks isNil ifTrue:[
BookMarks := OrderedCollection new
].
BookMarks remove:newEntry ifAbsent:nil.
BookMarks addFirst:newEntry
]
!
lastSearchPatterns
^ LastSearchPatterns
! !
!NewSystemBrowser class methodsFor:'defaults'!
synchronousUpdate
^ SynchronousUpdate ? false
! !
!NewSystemBrowser class methodsFor:'help specs'!
flyByHelpSpec
<resource: #help>
|spec manager|
spec := super flyByHelpSpec addPairsFrom:#(
#columnLabel
'The text-cursor''s column number'
#lineLabel
'The text-cursor''s line number. Double-Click to change'
#modeLabel
'The editing mode (Insert vs. Overwrite). Right-Click to change'
#packageInfoLabel
'Package and revision info (for class or method)'
#addBreakPoint
'Add Breakpoint on Method'
#createBuffer
'Add Buffer'
#removeBreakPoint
'Remove Breakpoint'
#recentlyChangedMethods
'Recently Changed Methods'
#recentlyChangedClasses
'Recently Changed Classes'
#recentChanges
'Recently Changed Methods'
#recentVisits
'Recently Visited'
#recentlyVisitedMethods
'Recently Visited Methods'
#recentlyVisitedMethods
'Visited Methods'
#executeSelectedClassMethod
'Execute the Selected Class Method. Show Execution Time and Answer on the Transcript'
#launchSelectedApplication
'Launch the Selected Application'
#runTestCases
'Run Selected TestCase(s)'
#runTestCasesWithDebug
'Run Selected TestCase(s) with Debugger enabled'
#showCategories
'Show Class Categories'
#showClassHierarchy
'Show Class Inheritance'
#showInheritedMethods
'Show Inherited Methods (except Object''s)'
#doNotShowInheritedMethods
'Do not Show Inherited Methods'
#searchClass
'Search Class'
#searchClass
'Search Class'
#gotoClassEntryField
'Goto Class'
#formatCode
'Format Code (PrettyPrint)'
#hideToolBar
'Hide Toolbar. Show again via the "View"-Menu'
#redoOperation
'Redo undone Operation'
#undoOperation
'Undo Operation'
).
(RefactoryChangeManager notNil and:[ RefactoryChangeManager isLoaded ]) ifTrue:[
manager := RefactoryChangeManager instance.
manager hasUndoableOperations
ifTrue:[
spec at:#undoOperation put:(self resources string:'Undo (%1)' with:manager undoChange name).
].
manager hasRedoableOperations
ifTrue:[
spec at:#redoOperation put:(self resources string:'Redo (%1)' with:manager redoChange name).
].
].
^ spec.
"Modified: / 25-08-2010 / 10:22:28 / cg"
! !
!NewSystemBrowser class methodsFor:'image specs'!
defaultIcon
<resource: #programImage>
^ ToolbarIconLibrary systemBrowserIcon
"/ ^ ToolbarIconLibrary systemBrowser24x24Icon2
!
defaultIcon1
"This resource specification was automatically generated
by the ImageEditor of ST/X."
"Do not manually edit this!! If it is corrupted,
the ImageEditor may not be able to read the specification."
"
self defaultIcon1 inspect
ImageEditor openOnClass:self andSelector:#defaultIcon1
Icon flushCachedIcons
"
<resource: #image>
^Icon
constantNamed:#'Tools::NewSystemBrowser class defaultIcon1'
ifAbsentPut:[(Depth4Image new) width: 28; height: 28; photometric:(#palette); bitsPerSample:(#(4)); samplesPerPixel:(1); bits:(ByteArray fromPackedString:'
@@@@@@@@@@@@@@@@@@@FY&Y&Y&X0@@@@@FY @@YDQDQDQB@@@@@FXFX@A$QDQDQDH@@@@FY Y&@CH"H"H"H @@@@X@@@X@@@@@@@@@@@@@A&XFY @@@@H@@@
@@@@@@Y Y @@@@@ @@@@@@@@@FY @@@@@B@@@@@@@@@@@@@@@@@@H@@@@@@@@@@@@@@@@@@@@@@@A&Y&Y&Y#@@@@@F@"H"HFDQDQDQH@@@@@@@@@@@L"H"H"
H @@@@@ @@@@@@@@@@@@@@@@@B@@@@@@@@@@@@@@@@@@H@@@@@@@@@@@@@@@@@@@@@@@A&Y&Y&Y#@@@@@F@"H"HFUUUUUUH@@@@@@@@@@@L"H"H"H @@@@@@
@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@H@@@@B@B@ @B@@@@@ @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
@@@@@@@@@@@@@@@@@@@@@@@@H@@@@ @@@@H@@ @@@@Hb') ; colorMapFromArray:#[0 0 0 0 255 0 127 127 127 170 170 170 255 0 0 255 255 0 255 255 255]; mask:((Depth1Image new) width: 28; height: 28; photometric:(#blackIs0); bitsPerSample:(#(1)); samplesPerPixel:(1); bits:(ByteArray fromPackedString:'
??0C O?<A<C??@? ??0_<O?<G?C??A?0@ @O8@H@A<@B@@N@@ O?8@\C?>@G??? A0O?8@HC?>@B@@@@@ O?8@\C?>@G??? A0O?8@@C?>@@@@@@9O]7\IRT
QDBD%DQ@!!OH''HHRQEABT$QPP99]7\@@a') ; yourself); yourself]
!
doNotShowInheritedMethodsIcon
"This resource specification was automatically generated
by the ImageEditor of ST/X."
"Do not manually edit this!! If it is corrupted,
the ImageEditor may not be able to read the specification."
"
self doNotShowInheritedMethodsIcon inspect
ImageEditor openOnClass:self andSelector:#doNotShowInheritedMethodsIcon
Icon flushCachedIcons
"
<resource: #image>
^Icon
constantNamed:#'Tools::NewSystemBrowser class doNotShowInheritedMethodsIcon'
ifAbsentPut:[(Depth2Image new) width: 16; height: 16; photometric:(#palette); bitsPerSample:(#(2 )); samplesPerPixel:(1); bits:(ByteArray fromPackedString:'UUUUUUUUUUU@@@@EUDP@AT@@@@AT@@@EP@Q@AUUUUTU@@@@APUQDDTP@@@E@@@@EUUU@AUUUUPUT@@@UU@@EUP@a') ; colorMapFromArray:#[0 0 0 255 255 255 255 255 127 127 127 127]; mask:((Depth1Image new) width: 16; height: 16; photometric:(#blackIs0); bitsPerSample:(#(1 )); samplesPerPixel:(1); bits:(ByteArray fromPackedString:'
@@@@@@@@G0@@@@@@A<@@@@@@@_@@@@@@@G0@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@a') ; yourself); yourself]
!
hideToolBarIcon
<resource: #programImage>
^ ToolbarIconLibrary hideToolBarIcon
"Created: / 10-12-2001 / 20:45:12 / cg"
"Modified: / 18-02-2007 / 14:52:45 / cg"
!
showCategoriesIcon
"This resource specification was automatically generated
by the ImageEditor of ST/X."
"Do not manually edit this!! If it is corrupted,
the ImageEditor may not be able to read the specification."
"
self showCategoriesIcon inspect
ImageEditor openOnClass:self andSelector:#showCategoriesIcon
Icon flushCachedIcons
"
<resource: #image>
^Icon
constantNamed:#'Tools::NewSystemBrowser class showCategoriesIcon'
ifAbsentPut:[(Depth1Image new) width: 16; height: 16; photometric:(#palette); bitsPerSample:(#(1 )); samplesPerPixel:(1); bits:(ByteArray fromPackedString:'?????8@C??.@@N@C @O?>8@A''?6 @X@C??/?<>@G8C<b') ; colorMapFromArray:#[0 0 0 255 255 255]; mask:((Depth1Image new) width: 16; height: 16; photometric:(#blackIs0); bitsPerSample:(#(1 )); samplesPerPixel:(1); bits:(ByteArray fromPackedString:'
@@@@@A?8@@@@@A?8@@@@@A?8@@@@@A?8@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@a') ; yourself); yourself]
!
showClassHierarchyIcon
"This resource specification was automatically generated
by the ImageEditor of ST/X."
"Do not manually edit this!! If it is corrupted,
the ImageEditor may not be able to read the specification."
"
self showClassHierarchyIcon inspect
ImageEditor openOnClass:self andSelector:#showClassHierarchyIcon
Icon flushCachedIcons
"
<resource: #image>
^Icon
constantNamed:#'Tools::NewSystemBrowser class showClassHierarchyIcon'
ifAbsentPut:[(Depth1Image new) width: 16; height: 16; photometric:(#palette); bitsPerSample:(#(1 )); samplesPerPixel:(1); bits:(ByteArray fromPackedString:'?????8@C O.@@N@C @O?>8@A&@6 @X@C? O?<>@G8C<b') ; colorMapFromArray:#[0 0 0 255 255 255]; mask:((Depth1Image new) width: 16; height: 16; photometric:(#blackIs0); bitsPerSample:(#(1 )); samplesPerPixel:(1); bits:(ByteArray fromPackedString:'
@@@@@@@@O0@@@@@@C<@@@@@@@?@@@@@@@O0@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@a') ; yourself); yourself]
!
showInheritedMethodsIcon
"This resource specification was automatically generated
by the ImageEditor of ST/X."
"Do not manually edit this!! If it is corrupted,
the ImageEditor may not be able to read the specification."
"
self showInheritedMethodsIcon inspect
ImageEditor openOnClass:self andSelector:#showInheritedMethodsIcon
Icon flushCachedIcons
"
<resource: #image>
^Icon
constantNamed:#'Tools::NewSystemBrowser class showInheritedMethodsIcon'
ifAbsentPut:[(Depth2Image new) width: 16; height: 16; photometric:(#palette); bitsPerSample:(#(2 )); samplesPerPixel:(1); bits:(ByteArray fromPackedString:'UUUQUUUUTWU@@@CMT@A@HT@@@2MT@@B(P@@@@EUUUTU@@@@APU@@@TP@@@E@@@@EUUP@AUUUUPUT@@@UU@@EUP@a') ; colorMapFromArray:#[0 0 0 255 255 255 255 255 127 127 127 127]; mask:((Depth1Image new) width: 16; height: 16; photometric:(#blackIs0); bitsPerSample:(#(1 )); samplesPerPixel:(1); bits:(ByteArray fromPackedString:'
@@@@A@@NO08@G0@_C9<@@@@@@>@@@@@@@O @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@a') ; yourself); yourself]
! !
!NewSystemBrowser class methodsFor:'interface specs'!
chainBrowserSpec
"This resource specification was automatically generated
by the UIPainter of ST/X."
"Do not manually edit this!! If it is corrupted,
the UIPainter may not be able to read the specification."
"
UIPainter new openOnClass:NewSystemBrowser andSelector:#chainBrowserSpec
NewSystemBrowser new openInterface:#chainBrowserSpec
"
<resource: #canvas>
^
#(#FullSpec
#name: #chainBrowserSpec
#window:
#(#WindowSpec
#label: 'MethodBrowser'
#name: 'MethodBrowser'
#min: #(#Point 0 0)
#bounds: #(#Rectangle 185 379 647 679)
)
#component:
#(#SpecCollection
#collection: #(
#(#VariableVerticalPanelSpec
#name: 'VariableVerticalPanel1'
#layout: #(#LayoutFrame 0 0.0 0 0.0 0 1.0 0 1.0)
#showHandle: false
#snapMode: #both
#handlePosition: #left
#component:
#(#SpecCollection
#collection: #(
#(#VariableHorizontalPanelSpec
#name: 'VariableHorizontalPanel1'
#showHandle: false
#barWidth: 2
#component:
#(#SpecCollection
#collection: #(
#(#SubCanvasSpec
#name: 'MethodList1'
#majorKey: #'MethodList'
#subAspectHolders:
#(#Array
#(#SubChannelInfoSpec
#subAspect: #showCoverageInformation
#aspect: #showCoverageInformation
)
#(#SubChannelInfoSpec
#subAspect: #doubleClickChannel
#callBack: #methodDoubleClicked1
)
#(#SubChannelInfoSpec
#subAspect: #immediateUpdate
#aspect: #immediateUpdate
)
#(#SubChannelInfoSpec
#subAspect: #inGeneratorHolder
#aspect: #selectorListGenerator1
)
#(#SubChannelInfoSpec
#subAspect: #menuHolder
#aspect: #selectorPopUpMenu
)
#(#SubChannelInfoSpec
#subAspect: #packageFilter
#aspect: #packageFilter
)
#(#SubChannelInfoSpec
#subAspect: #selectedMethods
#aspect: #selectedMethods1
#callBack: #methodsSelectionChanged1
)
#(#SubChannelInfoSpec
#subAspect: #selectionChangeCondition
#aspect: #selectionChangeConditionHolder
)
#(#SubChannelInfoSpec
#subAspect: #sortBy
#aspect: #sortBy
)
#(#SubChannelInfoSpec
#subAspect: #showMethodInheritance
#aspect: #showMethodInheritance
)
#(#SubChannelInfoSpec
#subAspect: #showMethodComplexity
#aspect: #showMethodComplexity
)
#(#SubChannelInfoSpec
#subAspect: #showMethodTypeIcon
#aspect: #showMethodTypeIcon
)
)
#createNewApplication: true
#createNewBuilder: true
)
#(#SubCanvasSpec
#name: 'MethodList2'
#majorKey: #'MethodList'
#subAspectHolders:
#(#Array
#(#SubChannelInfoSpec
#subAspect: #showCoverageInformation
#aspect: #showCoverageInformation
)
#(#SubChannelInfoSpec
#subAspect: #doubleClickChannel
#callBack: #methodDoubleClicked2
)
#(#SubChannelInfoSpec
#subAspect: #immediateUpdate
#aspect: #immediateUpdate
)
#(#SubChannelInfoSpec
#subAspect: #inGeneratorHolder
#aspect: #selectorListGenerator2
)
#(#SubChannelInfoSpec
#subAspect: #menuHolder
#aspect: #selectorPopUpMenu
)
#(#SubChannelInfoSpec
#subAspect: #packageFilter
#aspect: #packageFilter
)
#(#SubChannelInfoSpec
#subAspect: #selectedMethods
#aspect: #selectedMethods2
#callBack: #methodsSelectionChanged2
)
#(#SubChannelInfoSpec
#subAspect: #selectionChangeCondition
#aspect: #selectionChangeConditionHolder
)
#(#SubChannelInfoSpec
#subAspect: #sortBy
#aspect: #sortBy
)
#(#SubChannelInfoSpec
#subAspect: #showMethodInheritance
#aspect: #showMethodInheritance
)
#(#SubChannelInfoSpec
#subAspect: #showMethodComplexity
#aspect: #showMethodComplexity
)
#(#SubChannelInfoSpec
#subAspect: #showMethodTypeIcon
#aspect: #showMethodTypeIcon
)
)
#createNewApplication: true
#createNewBuilder: true
)
#(#SubCanvasSpec
#name: 'MethodList3'
#majorKey: #'MethodList'
#subAspectHolders:
#(#Array
#(#SubChannelInfoSpec
#subAspect: #showCoverageInformation
#aspect: #showCoverageInformation
)
#(#SubChannelInfoSpec
#subAspect: #doubleClickChannel
#callBack: #methodDoubleClicked3
)
#(#SubChannelInfoSpec
#subAspect: #immediateUpdate
#aspect: #immediateUpdate
)
#(#SubChannelInfoSpec
#subAspect: #inGeneratorHolder
#aspect: #selectorListGenerator3
)
#(#SubChannelInfoSpec
#subAspect: #menuHolder
#aspect: #selectorPopUpMenu
)
#(#SubChannelInfoSpec
#subAspect: #packageFilter
#aspect: #packageFilter
)
#(#SubChannelInfoSpec
#subAspect: #selectedMethods
#aspect: #selectedMethods3
#callBack: #methodsSelectionChanged3
)
#(#SubChannelInfoSpec
#subAspect: #selectionChangeCondition
#aspect: #selectionChangeConditionHolder
)
#(#SubChannelInfoSpec
#subAspect: #sortBy
#aspect: #sortBy
)
#(#SubChannelInfoSpec
#subAspect: #showMethodInheritance
#aspect: #showMethodInheritance
)
#(#SubChannelInfoSpec
#subAspect: #showMethodComplexity
#aspect: #showMethodComplexity
)
#(#SubChannelInfoSpec
#subAspect: #showMethodTypeIcon
#aspect: #showMethodTypeIcon
)
)
#createNewApplication: true
#createNewBuilder: true
)
#(#SubCanvasSpec
#name: 'MethodList4'
#majorKey: #'MethodList'
#subAspectHolders:
#(#Array
#(#SubChannelInfoSpec
#subAspect: #showCoverageInformation
#aspect: #showCoverageInformation
)
#(#SubChannelInfoSpec
#subAspect: #doubleClickChannel
#callBack: #methodDoubleClicked4
)
#(#SubChannelInfoSpec
#subAspect: #immediateUpdate
#aspect: #immediateUpdate
)
#(#SubChannelInfoSpec
#subAspect: #inGeneratorHolder
#aspect: #selectorListGenerator4
)
#(#SubChannelInfoSpec
#subAspect: #menuHolder
#aspect: #selectorPopUpMenu
)
#(#SubChannelInfoSpec
#subAspect: #packageFilter
#aspect: #packageFilter
)
#(#SubChannelInfoSpec
#subAspect: #selectedMethods
#aspect: #selectedMethods4
#callBack: #methodsSelectionChanged4
)
#(#SubChannelInfoSpec
#subAspect: #selectionChangeCondition
#aspect: #selectionChangeConditionHolder
)
#(#SubChannelInfoSpec
#subAspect: #sortBy
#aspect: #sortBy
)
#(#SubChannelInfoSpec
#subAspect: #showMethodInheritance
#aspect: #showMethodInheritance
)
#(#SubChannelInfoSpec
#subAspect: #showMethodComplexity
#aspect: #showMethodComplexity
)
#(#SubChannelInfoSpec
#subAspect: #showMethodTypeIcon
#aspect: #showMethodTypeIcon
)
)
#createNewApplication: true
#createNewBuilder: true
)
)
)
#handles: #(#Any 0.25 0.5 0.75 1.0)
)
#(#SubCanvasSpec
#name: 'CodePane'
#autoHideScrollBars: false
#majorKey: #'NewSystemBrowser'
#minorKey: #codePaneSpec
)
"/ #(#CodeViewSpec
"/ #name: 'CodeView'
"/ #model: #codeHolder
"/ #hasHorizontalScrollBar: true
"/ #hasVerticalScrollBar: true
"/ #miniScrollerHorizontal: true
"/ #postBuildCallback: #postBuildCodeView:
"/ #modifiedChannel: #codeModifiedHolder
"/ )
)
)
#handles: #(#Any 0.5 1.0)
)
)
)
)
"Modified: / 27-04-2010 / 16:29:54 / cg"
!
classDocumentationBrowserSpec
"This resource specification was automatically generated
by the UIPainter of ST/X."
"Do not manually edit this!! If it is corrupted,
the UIPainter may not be able to read the specification."
"
UIPainter new openOnClass:NewSystemBrowser andSelector:#classDocumentationBrowserSpec
NewSystemBrowser new openInterface:#classDocumentationBrowserSpec
"
<resource: #canvas>
^
#(#FullSpec
#name: #classDocumentationBrowserSpec
#window:
#(#WindowSpec
#label: 'Full Class Browser'
#name: 'Full Class Browser'
#min: #(#Point 0 0)
#bounds: #(#Rectangle 12 22 474 322)
)
#component:
#(#SpecCollection
#collection: #(
#(#VariableVerticalPanelSpec
#name: 'VariableVerticalPanel1'
#layout: #(#LayoutFrame 0 0.0 0 0.0 0 1.0 0 1.0)
#showHandle: false
#snapMode: #both
#handlePosition: #left
#component:
#(#SpecCollection
#collection: #(
#(#SubCanvasSpec
#name: 'Navigator'
#majorKey: #'NavigatorCanvas'
#minorKey: #categoryAndSingleClassOnlySpec
)
#(#HTMLViewSpec
#name: 'HTMLBrowser1'
#htmlText: #classDocumentationHolder
#hasHorizontalScrollBar: true
#hasVerticalScrollBar: true
)
)
)
#handles: #(#Any 0.5 1.0)
)
)
)
)
!
codePaneSpec
"This resource specification was automatically generated
by the UIPainter of ST/X."
"Do not manually edit this!! If it is corrupted,
the UIPainter may not be able to read the specification."
"
UIPainter new openOnClass:Tools::NewSystemBrowser andSelector:#codePaneSpec
Tools::NewSystemBrowser new openInterface:#codePaneSpec
"
<resource: #canvas>
^
#(FullSpec
name: codePaneSpec
window:
(WindowSpec
label: 'SystemBrowser'
name: 'SystemBrowser'
min: (Point 0 0)
bounds: (Rectangle 0 0 459 319)
icon: defaultIcon
)
component:
(SpecCollection
collection: (
(NoteBookViewSpec
name: 'EditorNoteBook'
layout: (LayoutFrame 0 0 0 0 0 1 -50 1)
level: 0
model: selectedEditorNoteBookTabIndexHolder
menu: editorNoteBookListHolder
"/ direction: right
"/ direction: left
direction: top
"/ direction: bottom
useIndex: true
canvas: editorNoteBookCanvasHolder
keepCanvasAlive: true
postBuildCallback: postBuildEditorNoteBook:
)
(SubCanvasSpec
name: 'StringSearchToolCanvas'
layout: (LayoutFrame 0 0 -49 1 0 1 -25 1)
visibilityChannel: stringSearchToolVisibleHolder
hasHorizontalScrollBar: false
hasVerticalScrollBar: false
majorKey: StringSearchToolForTextView
createNewApplication: true
postBuildCallback: postBuildStringSearchTool:
)
(ViewSpec
name: 'InfoBox'
layout: (LayoutFrame 0 0 -24 1 0 1 0 1)
visibilityChannel: codeInfoVisible
component:
(SpecCollection
collection: (
(VariableHorizontalPanelSpec
name: 'InfoBoxPanel'
layout: (LayoutFrame 0 0.0 0 0.0 -60 1.0 0 1.0)
showHandle: false
component:
(SpecCollection
collection: (
(LabelSpec
label: 'Info'
name: 'InfoLabel'
level: -1
translateLabel: true
labelChannel: infoLabelHolder
adjust: left
)
(LabelSpec
label: 'Package'
name: 'PackageLabel'
activeHelpKey: packageInfoLabel
level: -1
translateLabel: true
labelChannel: packageLabelHolder
adjust: left
)
)
)
handles: (Any 0.66 1.0)
)
(LabelSpec
name: 'ModeLabel'
layout: (LayoutFrame -60 1 0 0.0 -50 1 0 1.0)
activeHelpKey: modeLabel
level: -1
translateLabel: true
labelChannel: modeLabelHolder
postBuildCallback: postBuildEditModeInfoLabel:
)
(LabelSpec
name: 'CursorLineLabel'
layout: (LayoutFrame -50 1 0 0.0 -20 1 0 1.0)
activeHelpKey: lineLabel
level: -1
translateLabel: true
labelChannel: cursorLineLabelHolder
adjust: right
)
(LabelSpec
name: 'CursorColLabel'
layout: (LayoutFrame -20 1 0 0.0 0 1.0 0 1.0)
activeHelpKey: columnLabel
level: -1
translateLabel: true
labelChannel: cursorColLabelHolder
adjust: right
)
)
)
)
)
)
)
!
fullBrowserSpec
"This resource specification was automatically generated
by the UIPainter of ST/X."
"Do not manually edit this!! If it is corrupted,
the UIPainter may not be able to read the specification."
"
UIPainter new openOnClass:NewSystemBrowser andSelector:#fullBrowserSpec
NewSystemBrowser new openInterface:#fullBrowserSpec
"
<resource: #canvas>
^
#(#FullSpec
#name: #fullBrowserSpec
#window:
#(#WindowSpec
#label: 'SystemBrowser'
#name: 'SystemBrowser'
#min: #(#Point 0 0)
#bounds: #(#Rectangle 7 0 469 300)
#icon: #defaultIcon
)
#component:
#(#SpecCollection
#collection: #(
#(#VariableVerticalPanelSpec
#name: 'VariableVerticalPanel1'
#layout: #(#LayoutFrame 0 0.0 0 0.0 0 1.0 0 1.0)
#barWidth: 2
#showHandle: false
#snapMode: #both
#handlePosition: #left
#component:
#(#SpecCollection
#collection: #(
#(#SubCanvasSpec
#name: 'Navigator'
#autoHideScrollBars: false
#majorKey: #'NavigatorCanvas'
#minorKey: #windowSpec
)
#(#SubCanvasSpec
#name: 'CodePane'
#autoHideScrollBars: false
#majorKey: #'NewSystemBrowser'
#minorKey: #codePaneSpec
)
)
)
#handles: #(#Any 0.5 1.0)
)
)
)
)
!
fullClassSourceBrowserSpec
"This resource specification was automatically generated
by the UIPainter of ST/X."
"Do not manually edit this!! If it is corrupted,
the UIPainter may not be able to read the specification."
"
UIPainter new openOnClass:NewSystemBrowser andSelector:#fullClassBrowserSpec
NewSystemBrowser new openInterface:#fullClassBrowserSpec
"
<resource: #canvas>
^
#(#FullSpec
#name: #fullClassSourceBrowserSpec
#window:
#(#WindowSpec
#label: 'Full Class Browser'
#name: 'NewBrowser'
#min: #(#Point 0 0)
#bounds: #(#Rectangle 13 23 475 323)
)
#component:
#(#SpecCollection
#collection: #(
#(#VariableVerticalPanelSpec
#name: 'VariableVerticalPanel1'
#layout: #(#LayoutFrame 0 0.0 0 0.0 0 1.0 0 1.0)
#barWidth: 2
#showHandle: false
#handlePosition: #left
#snapMode: #both
#component:
#(#SpecCollection
#collection: #(
#(#SubCanvasSpec
#name: 'Navigator'
#majorKey: #'NavigatorCanvas'
#minorKey: #categoryAndSingleClassOnlySpec
)
#(#SubCanvasSpec
#name: 'CodePane'
#autoHideScrollBars: false
#majorKey: #'NewSystemBrowser'
#minorKey: #codePaneSpec
)
"/ #(#CodeViewSpec
"/ #name: 'CodeView'
"/ #model: #codeHolder
"/ #hasHorizontalScrollBar: true
"/ #hasVerticalScrollBar: true
"/ #miniScrollerHorizontal: true
"/ #postBuildCallback: #postBuildCodeView:
"/ #modifiedChannel: #codeModifiedHolder
"/ )
)
)
#handles: #(#Any 0.3 1.0)
)
)
)
)
"Modified: / 24.2.2000 / 23:35:03 / cg"
!
methodListBrowserSpec
"This resource specification was automatically generated
by the UIPainter of ST/X."
"Do not manually edit this!! If it is corrupted,
the UIPainter may not be able to read the specification."
"
UIPainter new openOnClass:NewSystemBrowser andSelector:#methodListBrowserSpec
NewSystemBrowser new openInterface:#methodListBrowserSpec
"
<resource: #canvas>
^
#(#FullSpec
#name: #methodListBrowserSpec
#window:
#(#WindowSpec
#label: 'MethodListBrowser'
#name: 'NewBrowser'
#min: #(#Point 0 0)
#bounds: #(#Rectangle 13 23 475 323)
)
#component:
#(#SpecCollection
#collection: #(
#(#VariableVerticalPanelSpec
#name: 'VariableVerticalPanel1'
#layout: #(#LayoutFrame 0 0.0 0 0.0 0 1.0 0 1.0)
#snapMode: #both
#handlePosition: #left
#showHandle: false
#component:
#(#SpecCollection
#collection: #(
#(#SubCanvasSpec
#name: 'MethodList'
#majorKey: #'MethodList'
#subAspectHolders:
#(#Array
#(#SubChannelInfoSpec
#subAspect: #showCoverageInformation
#aspect: #showCoverageInformation
)
#(#SubChannelInfoSpec
#subAspect: #doubleClickChannel
#callBack: #methodDoubleClicked
)
#(#SubChannelInfoSpec
#subAspect: #immediateUpdate
#aspect: #immediateUpdate
)
#(#SubChannelInfoSpec
#subAspect: #inGeneratorHolder
#aspect: #selectorListGenerator
)
#(#SubChannelInfoSpec
#subAspect: #menuHolder
#aspect: #methodListPopUpMenu
)
#(#SubChannelInfoSpec
#subAspect: #packageFilter
#aspect: #packageFilter
)
#(#SubChannelInfoSpec
#subAspect: #sortBy
#aspect: #sortBy
)
#(#SubChannelInfoSpec
#subAspect: #showMethodInheritance
#aspect: #showMethodInheritance
)
#(#SubChannelInfoSpec
#subAspect: #showMethodComplexity
#aspect: #showMethodComplexity
)
#(#SubChannelInfoSpec
#subAspect: #showMethodTypeIcon
#aspect: #showMethodTypeIcon
)
#(#SubChannelInfoSpec
#subAspect: #selectedMethods
#aspect: #selectedMethods
#callBack: #methodsSelectionChanged
)
#(#SubChannelInfoSpec
#subAspect: #selectionChangeCondition
#aspect: #selectionChangeConditionHolder
)
)
#createNewApplication: true
#createNewBuilder: true
)
#(#SubCanvasSpec
#name: 'CodePane'
#autoHideScrollBars: false
#majorKey: #'NewSystemBrowser'
#minorKey: #codePaneSpec
)
"/ #(#CodeViewSpec
"/ #name: 'CodeView'
"/ #model: #codeHolder
"/ #hasHorizontalScrollBar: true
"/ #hasVerticalScrollBar: true
"/ #miniScrollerHorizontal: true
"/ )
)
)
#handles: #(#Any 0.3 1.0)
)
)
)
)
"Modified: / 27-04-2010 / 16:30:00 / cg"
!
multipleCategoryBrowserSpec
"This resource specification was automatically generated
by the UIPainter of ST/X."
"Do not manually edit this!! If it is corrupted,
the UIPainter may not be able to read the specification."
"
UIPainter new openOnClass:NewSystemBrowser andSelector:#multipleCategoryBrowserSpec
NewSystemBrowser new openInterface:#multipleCategoryBrowserSpec
"
<resource: #canvas>
^
#(#FullSpec
#name: #multipleCategoryBrowserSpec
#window:
#(#WindowSpec
#label: 'CategoryBrowser'
#name: 'NewBrowser'
#min: #(#Point 0 0)
#bounds: #(#Rectangle 12 22 474 322)
)
#component:
#(#SpecCollection
#collection: #(
#(#VariableVerticalPanelSpec
#name: 'VariableVerticalPanel1'
#layout: #(#LayoutFrame 0 0.0 0 0.0 0 1.0 0 1.0)
#showHandle: false
#snapMode: #both
#handlePosition: #left
#component:
#(#SpecCollection
#collection: #(
#(#SubCanvasSpec
#name: 'Navigator'
#autoHideScrollBars: false
#majorKey: #'NavigatorCanvas'
#minorKey: #'multipleCategoryBrowserSpec'
)
#(#SubCanvasSpec
#name: 'CodePane'
#autoHideScrollBars: false
#majorKey: #'NewSystemBrowser'
#minorKey: #codePaneSpec
)
"/ #(#CodeViewSpec
"/ #name: 'CodeView'
"/ #model: #codeHolder
"/ #hasHorizontalScrollBar: true
"/ #hasVerticalScrollBar: true
"/ #miniScrollerHorizontal: true
"/ #postBuildCallback: #postBuildCodeView:
"/ #modifiedChannel: #codeModifiedHolder
"/ )
)
)
#handles: #(#Any 0.3 1.0)
)
)
)
)
!
multipleClassBrowserSpec
"This resource specification was automatically generated
by the UIPainter of ST/X."
"Do not manually edit this!! If it is corrupted,
the UIPainter may not be able to read the specification."
"
UIPainter new openOnClass:NewSystemBrowser andSelector:#multipleClassBrowserSpec
NewSystemBrowser new openInterface:#multipleClassBrowserSpec
"
<resource: #canvas>
^
#(#FullSpec
#name: #multipleClassBrowserSpec
#window:
#(#WindowSpec
#label: 'ClassBrowser'
#name: 'NewBrowser'
#min: #(#Point 0 0)
#bounds: #(#Rectangle 13 23 475 323)
)
#component:
#(#SpecCollection
#collection: #(
#(#VariableVerticalPanelSpec
#name: 'VariableVerticalPanel1'
#layout: #(#LayoutFrame 0 0.0 0 0.0 0 1.0 0 1.0)
#showHandle: false
#snapMode: #both
#handlePosition: #left
#component:
#(#SpecCollection
#collection: #(
#(#SubCanvasSpec
#name: 'Navigator'
#autoHideScrollBars: false
#majorKey: #'NavigatorCanvas'
#minorKey: #'multipleClassBrowserSpec'
)
#(#SubCanvasSpec
#name: 'CodePane'
#autoHideScrollBars: false
#majorKey: #'NewSystemBrowser'
#minorKey: #codePaneSpec
)
"/ #(#CodeViewSpec
"/ #name: 'CodeView'
"/ #model: #codeHolder
"/ #hasHorizontalScrollBar: true
"/ #hasVerticalScrollBar: true
"/ #miniScrollerHorizontal: true
"/ #postBuildCallback: #postBuildCodeView:
"/ #modifiedChannel: #codeModifiedHolder
"/ )
)
)
#handles: #(#Any 0.5 1.0)
)
)
)
)
"Modified: / 25.2.2000 / 02:08:21 / cg"
!
multipleClassExtensionBrowserSpec
"This resource specification was automatically generated
by the UIPainter of ST/X."
"Do not manually edit this!! If it is corrupted,
the UIPainter may not be able to read the specification."
"
UIPainter new openOnClass:NewSystemBrowser andSelector:#multipleClassBrowserSpec
NewSystemBrowser new openInterface:#multipleClassBrowserSpec
"
<resource: #canvas>
^
#(#FullSpec
#name: #multipleClassExtensionBrowserSpec
#window:
#(#WindowSpec
#label: 'ClassExtensionBrowser'
#name: 'NewBrowser'
#min: #(#Point 0 0)
#bounds: #(#Rectangle 13 23 475 323)
)
#component:
#(#SpecCollection
#collection: #(
#(#VariableVerticalPanelSpec
#name: 'VariableVerticalPanel1'
#layout: #(#LayoutFrame 0 0.0 0 0.0 0 1.0 0 1.0)
#showHandle: false
#snapMode: #both
#handlePosition: #left
#component:
#(#SpecCollection
#collection: #(
#(#SubCanvasSpec
#name: 'Navigator'
#autoHideScrollBars: false
#majorKey: #'NavigatorCanvas'
#minorKey: #'multipleClassExtensionBrowserSpec'
)
#(#SubCanvasSpec
#name: 'CodePane'
#autoHideScrollBars: false
#majorKey: #'NewSystemBrowser'
#minorKey: #codePaneSpec
)
"/ #(#CodeViewSpec
"/ #name: 'CodeView'
"/ #model: #codeHolder
"/ #hasHorizontalScrollBar: true
"/ #hasVerticalScrollBar: true
"/ #miniScrollerHorizontal: true
"/ #postBuildCallback: #postBuildCodeView:
"/ #modifiedChannel: #codeModifiedHolder
"/ )
)
)
#handles: #(#Any 0.3 1.0)
)
)
)
)
"Modified: / 25.2.2000 / 02:08:21 / cg"
!
multipleClassRepositoryDiffBrowserSpec
"This resource specification was automatically generated
by the UIPainter of ST/X."
"Do not manually edit this!! If it is corrupted,
the UIPainter may not be able to read the specification."
"
UIPainter new openOnClass:NewSystemBrowser andSelector:#multipleClassRepositoryDiffBrowserSpec
NewSystemBrowser new openInterface:#multipleClassRepositoryDiffBrowserSpec
"
<resource: #canvas>
^
#(#FullSpec
#name: #multipleClassRepositoryDiffBrowserSpec
#window:
#(#WindowSpec
#label: 'ClassBrowser'
#name: 'ClassBrowser'
#min: #(#Point 0 0)
#bounds: #(#Rectangle 661 213 1123 513)
)
#component:
#(#SpecCollection
#collection: #(
#(#VariableVerticalPanelSpec
#name: 'VariableVerticalPanel1'
#layout: #(#LayoutFrame 0 0.0 0 0.0 0 1.0 0 1.0)
#showHandle: false
#snapMode: #both
#handlePosition: #left
#component:
#(#SpecCollection
#collection: #(
#(#SubCanvasSpec
#name: 'Navigator'
#autoHideScrollBars: false
#majorKey: #'NavigatorCanvas'
#minorKey: #multipleClassDiffBrowserSpec
)
#(#SubCanvasSpec
#name: 'DiffView'
#hasHorizontalScrollBar: false
#hasVerticalScrollBar: false
#majorKey: #VersionDiffBrowser
#minorKey: #windowSpec
#createNewApplication: true
#createNewBuilder: true
#postBuildCallback: #versionDiffViewerCreated:
)
)
)
#handles: #(#Any 0.3 1.0)
)
)
)
)
!
multipleClassWithInfoAndMethodWithInfoBrowserSpec
"This resource specification was automatically generated
by the UIPainter of ST/X."
"Do not manually edit this!! If it is corrupted,
the UIPainter may not be able to read the specification."
"
UIPainter new openOnClass:NewSystemBrowser andSelector:#multipleMethodWithInfoBrowserSpec
NewSystemBrowser new openInterface:#multipleMethodWithInfoBrowserSpec
"
<resource: #canvas>
^
#(#FullSpec
#name: #multipleClassWithInfoAndMethodWithInfoBrowserSpec
#window:
#(#WindowSpec
#label: 'MethodBrowser'
#name: 'MethodBrowser'
#min: #(#Point 0 0)
#bounds: #(#Rectangle 18 51 480 351)
)
#component:
#(#SpecCollection
#collection: #(
#(#VariableVerticalPanelSpec
#name: 'VariableVerticalPanel1'
#layout: #(#LayoutFrame 0 0.0 0 0.0 0 1.0 0 1.0)
#showHandle: false
#snapMode: #both
#handlePosition: #left
#component:
#(#SpecCollection
#collection: #(
#(#SubCanvasSpec
#attributes:
#(#vpext
#(#Point 1.0 0.243333)
)
#name: 'ClassList'
#majorKey: #'ClassList'
#subAspectHolders:
#(#Array
#(#SubChannelInfoSpec
#subAspect: #showCoverageInformation
#aspect: #showCoverageInformation
)
#(#SubChannelInfoSpec
#subAspect: #doubleClickChannel
#callBack: #classDoubleClicked
)
#(#SubChannelInfoSpec
#subAspect: #immediateUpdate
#aspect: #immediateUpdate
)
#(#SubChannelInfoSpec
#subAspect: #meta
#aspect: #meta
)
#(#SubChannelInfoSpec
#subAspect: #inGeneratorHolder
#aspect: #classListGenerator
)
#(#SubChannelInfoSpec
#subAspect: #menuHolder
#aspect: #classMenu
)
#(#SubChannelInfoSpec
#subAspect: #selectedClasses
#aspect: #selectedClasses
#callBack: #classSelectionChanged
)
#(#SubChannelInfoSpec
#subAspect: #selectionChangeCondition
#aspect: #selectionChangeConditionHolder
)
)
#createNewApplication: true
#createNewBuilder: true
)
#(#SubCanvasSpec
#attributes:
#(#vpext
#(#Point 1.0 0.243333)
)
#name: 'MethodList'
#majorKey: #'MethodList'
#subAspectHolders:
#(#Array
#(#SubChannelInfoSpec
#subAspect: #showCoverageInformation
#aspect: #showCoverageInformation
)
#(#SubChannelInfoSpec
#subAspect: #doubleClickChannel
#callBack: #methodDoubleClicked
)
#(#SubChannelInfoSpec
#subAspect: #immediateUpdate
#aspect: #immediateUpdate
)
#(#SubChannelInfoSpec
#subAspect: #inGeneratorHolder
#aspect: #selectorListGenerator
)
#(#SubChannelInfoSpec
#subAspect: #menuHolder
#aspect: #methodListPopUpMenu
)
#(#SubChannelInfoSpec
#subAspect: #packageFilter
#aspect: #packageFilter
)
#(#SubChannelInfoSpec
#subAspect: #selectedMethods
#aspect: #selectedMethods
#callBack: #methodsSelectionChanged
)
#(#SubChannelInfoSpec
#subAspect: #selectionChangeCondition
#aspect: #selectionChangeConditionHolder
)
)
#createNewApplication: true
#createNewBuilder: true
)
#(#TextEditorSpec
#attributes:
#(#vpext
#(#Point 1.0 0.53)
)
#name: 'MethodInfoView'
#model: #methodInfo
#hasHorizontalScrollBar: true
#hasVerticalScrollBar: true
#autoHideScrollBars: true
#isReadOnly: true
)
#(#SubCanvasSpec
#name: 'CodePane'
#autoHideScrollBars: false
#majorKey: #'NewSystemBrowser'
#minorKey: #codePaneSpec
)
"/ #(#CodeViewSpec
"/ #name: 'CodeView'
"/ #model: #codeHolder
"/ #hasHorizontalScrollBar: true
"/ #hasVerticalScrollBar: true
"/ #miniScrollerHorizontal: true
"/ #postBuildCallback: #postBuildCodeView:
"/ #modifiedChannel: #codeModifiedHolder
"/ )
)
)
#handles: #(#Any 0.1 0.25 0.5 1.0)
)
)
)
)
"Modified: / 27-04-2010 / 16:30:07 / cg"
!
multipleClassWithInfoBrowserSpec
"This resource specification was automatically generated
by the UIPainter of ST/X."
"Do not manually edit this!! If it is corrupted,
the UIPainter may not be able to read the specification."
"
UIPainter new openOnClass:NewSystemBrowser andSelector:#multipleMethodWithInfoBrowserSpec
NewSystemBrowser new openInterface:#multipleMethodWithInfoBrowserSpec
"
<resource: #canvas>
^
#(#FullSpec
#name: #multipleClassWithInfoSpec
#window:
#(#WindowSpec
#label: 'MethodBrowser'
#name: 'MethodBrowser'
#min: #(#Point 0 0)
#bounds: #(#Rectangle 18 51 480 351)
)
#component:
#(#SpecCollection
#collection: #(
#(#VariableVerticalPanelSpec
#name: 'VariableVerticalPanel1'
#layout: #(#LayoutFrame 0 0.0 0 0.0 0 1.0 0 1.0)
#showHandle: false
#snapMode: #both
#handlePosition: #left
#component:
#(#SpecCollection
#collection: #(
#(#SubCanvasSpec
#attributes:
#(#vpext
#(#Point 1.0 0.243333)
)
#name: 'ClassList'
#majorKey: #'ClassList'
#subAspectHolders:
#(#Array
#(#SubChannelInfoSpec
#subAspect: #doubleClickChannel
#callBack: #classDoubleClicked
)
#(#SubChannelInfoSpec
#subAspect: #immediateUpdate
#aspect: #immediateUpdate
)
#(#SubChannelInfoSpec
#subAspect: #meta
#aspect: #meta
)
#(#SubChannelInfoSpec
#subAspect: #inGeneratorHolder
#aspect: #classListGenerator
)
#(#SubChannelInfoSpec
#subAspect: #menuHolder
#aspect: #classMenu
)
#(#SubChannelInfoSpec
#subAspect: #selectedClasses
#aspect: #selectedClasses
#callBack: #classSelectionChanged
)
#(#SubChannelInfoSpec
#subAspect: #selectionChangeCondition
#aspect: #selectionChangeConditionHolder
)
)
#createNewApplication: true
#createNewBuilder: true
)
#(#TextEditorSpec
#attributes:
#(#vpext
#(#Point 1.0 0.53)
)
#name: 'MethodInfoView'
#model: #methodInfo
#hasHorizontalScrollBar: true
#hasVerticalScrollBar: true
#autoHideScrollBars: true
#isReadOnly: true
)
#(#SubCanvasSpec
#name: 'CodePane'
#autoHideScrollBars: false
#majorKey: #'NewSystemBrowser'
#minorKey: #codePaneSpec
)
"/ #(#CodeViewSpec
"/ #name: 'CodeView'
"/ #model: #codeHolder
"/ #hasHorizontalScrollBar: true
"/ #hasVerticalScrollBar: true
"/ #miniScrollerHorizontal: true
"/ #postBuildCallback: #postBuildCodeView:
"/ #modifiedChannel: #codeModifiedHolder
"/ )
)
)
#handles: #(#Any 0.25 0.5 1.0)
)
)
)
)
!
multipleFullProtocolBrowserSpec
"This resource specification was automatically generated
by the UIPainter of ST/X."
"Do not manually edit this!! If it is corrupted,
the UIPainter may not be able to read the specification."
"
UIPainter new openOnClass:NewSystemBrowser andSelector:#multipleProtocolBrowserSpec
NewSystemBrowser new openInterface:#multipleProtocolBrowserSpec
"
<resource: #canvas>
^
#(#FullSpec
#name: #multipleFullProtocolBrowserSpec
#window:
#(#WindowSpec
#label: 'ProtocolBrowser'
#name: 'NewBrowser'
#min: #(#Point 0 0)
#bounds: #(#Rectangle 12 22 474 322)
)
#component:
#(#SpecCollection
#collection: #(
#(#VariableVerticalPanelSpec
#name: 'VariableVerticalPanel1'
#layout: #(#LayoutFrame 0 0.0 0 0.0 0 1.0 0 1.0)
#showHandle: false
#snapMode: #both
#handlePosition: #left
#component:
#(#SpecCollection
#collection: #(
#(#SubCanvasSpec
#name: 'Navigator'
#autoHideScrollBars: false
#majorKey: #'NavigatorCanvas'
#minorKey: #'multipleFullProtocolBrowserSpec'
)
#(#SubCanvasSpec
#name: 'CodePane'
#autoHideScrollBars: false
#majorKey: #'NewSystemBrowser'
#minorKey: #codePaneSpec
)
"/ #(#CodeViewSpec
"/ #name: 'CodeView'
"/ #model: #codeHolder
"/ #hasHorizontalScrollBar: true
"/ #hasVerticalScrollBar: true
"/ #miniScrollerHorizontal: true
"/ #postBuildCallback: #postBuildCodeView:
"/ #modifiedChannel: #codeModifiedHolder
"/ )
)
)
#handles: #(#Any 0.3 1.0)
)
)
)
)
"Modified: / 1.3.2000 / 20:45:30 / cg"
!
multipleMethodBrowserSpec
"This resource specification was automatically generated
by the UIPainter of ST/X."
"Do not manually edit this!! If it is corrupted,
the UIPainter may not be able to read the specification."
"
UIPainter new openOnClass:NewSystemBrowser andSelector:#multipleMethodBrowserSpec
NewSystemBrowser new openInterface:#multipleMethodBrowserSpec
"
<resource: #canvas>
^
#(#FullSpec
#name: #multipleMethodBrowserSpec
#window:
#(#WindowSpec
#label: 'MethodBrowser'
#name: 'NewBrowser'
#min: #(#Point 0 0)
#bounds: #(#Rectangle 13 23 475 323)
)
#component:
#(#SpecCollection
#collection: #(
#(#VariableVerticalPanelSpec
#name: 'VariableVerticalPanel1'
#layout: #(#LayoutFrame 0 0.0 0 0.0 0 1.0 0 1.0)
#showHandle: false
#snapMode: #both
#handlePosition: #left
#component:
#(#SpecCollection
#collection: #(
#(#SubCanvasSpec
#name: 'MethodList'
#majorKey: #'MethodList'
#subAspectHolders:
#(#Array
#(#SubChannelInfoSpec
#subAspect: #showCoverageInformation
#aspect: #showCoverageInformation
)
#(#SubChannelInfoSpec
#subAspect: #doubleClickChannel
#callBack: #methodDoubleClicked
)
#(#SubChannelInfoSpec
#subAspect: #immediateUpdate
#aspect: #immediateUpdate
)
#(#SubChannelInfoSpec
#subAspect: #inGeneratorHolder
#aspect: #selectorListGenerator
)
#(#SubChannelInfoSpec
#subAspect: #showMethodInheritance
#aspect: #showMethodInheritance
)
#(#SubChannelInfoSpec
#subAspect: #showMethodComplexity
#aspect: #showMethodComplexity
)
#(#SubChannelInfoSpec
#subAspect: #showMethodTypeIcon
#aspect: #showMethodTypeIcon
)
#(#SubChannelInfoSpec
#subAspect: #menuHolder
#aspect: #selectorPopUpMenu
)
#(#SubChannelInfoSpec
#subAspect: #packageFilter
#aspect: #packageFilter
)
#(#SubChannelInfoSpec
#subAspect: #variableFilter
#aspect: #variableFilter
)
#(#SubChannelInfoSpec
#subAspect: #selectedMethods
#aspect: #selectedMethods
#callBack: #methodsSelectionChanged
)
#(#SubChannelInfoSpec
#subAspect: #sortBy
#aspect: #sortBy
)
#(#SubChannelInfoSpec
#subAspect: #selectionChangeCondition
#aspect: #selectionChangeConditionHolder
)
)
#createNewApplication: true
#createNewBuilder: true
)
#(#SubCanvasSpec
#name: 'CodePane'
#autoHideScrollBars: false
#majorKey: #'NewSystemBrowser'
#minorKey: #codePaneSpec
)
"/ #(#CodeViewSpec
"/ #name: 'CodeView'
"/ #model: #codeHolder
"/ #hasHorizontalScrollBar: true
"/ #hasVerticalScrollBar: true
"/ #miniScrollerHorizontal: true
"/ #postBuildCallback: #postBuildCodeView:
"/ #modifiedChannel: #codeModifiedHolder
"/ )
)
)
#handles: #(#Any 0.3 1.0)
)
)
)
)
"Modified: / 27-04-2010 / 16:30:12 / cg"
!
multipleMethodWithInfoBrowserSpec
"This resource specification was automatically generated
by the UIPainter of ST/X."
"Do not manually edit this!! If it is corrupted,
the UIPainter may not be able to read the specification."
"
UIPainter new openOnClass:NewSystemBrowser andSelector:#multipleMethodWithInfoBrowserSpec
NewSystemBrowser new openInterface:#multipleMethodWithInfoBrowserSpec
"
<resource: #canvas>
^
#(#FullSpec
#name: #multipleMethodWithInfoBrowserSpec
#window:
#(#WindowSpec
#label: 'MethodBrowser'
#name: 'MethodBrowser'
#min: #(#Point 0 0)
#bounds: #(#Rectangle 18 51 480 351)
)
#component:
#(#SpecCollection
#collection: #(
#(#VariableVerticalPanelSpec
#name: 'VariableVerticalPanel1'
#layout: #(#LayoutFrame 0 0.0 0 0.0 0 1.0 0 1.0)
#showHandle: false
#snapMode: #both
#handlePosition: #left
#component:
#(#SpecCollection
#collection: #(
#(#SubCanvasSpec
#attributes:
#(#vpext
#(#Point 1.0 0.243333)
)
#name: 'MethodList'
#majorKey: #'MethodList'
#subAspectHolders:
#(#Array
#(#SubChannelInfoSpec
#subAspect: #showCoverageInformation
#aspect: #showCoverageInformation
)
#(#SubChannelInfoSpec
#subAspect: #doubleClickChannel
#callBack: #methodDoubleClicked
)
#(#SubChannelInfoSpec
#subAspect: #immediateUpdate
#aspect: #immediateUpdate
)
#(#SubChannelInfoSpec
#subAspect: #inGeneratorHolder
#aspect: #selectorListGenerator
)
#(#SubChannelInfoSpec
#subAspect: #menuHolder
#aspect: #methodListPopUpMenu
)
#(#SubChannelInfoSpec
#subAspect: #showMethodInheritance
#aspect: #showMethodInheritance
)
#(#SubChannelInfoSpec
#subAspect: #showMethodComplexity
#aspect: #showMethodComplexity
)
#(#SubChannelInfoSpec
#subAspect: #showMethodTypeIcon
#aspect: #showMethodTypeIcon
)
#(#SubChannelInfoSpec
#subAspect: #packageFilter
#aspect: #packageFilter
)
#(#SubChannelInfoSpec
#subAspect: #selectedMethods
#aspect: #selectedMethods
#callBack: #methodsSelectionChanged
)
#(#SubChannelInfoSpec
#subAspect: #selectionChangeCondition
#aspect: #selectionChangeConditionHolder
)
)
#createNewApplication: true
#createNewBuilder: true
)
#(#TextEditorSpec
#attributes:
#(#vpext
#(#Point 1.0 0.53)
)
#name: 'MethodInfoView'
#model: #methodInfo
#hasHorizontalScrollBar: true
#hasVerticalScrollBar: true
#autoHideScrollBars: true
#isReadOnly: true
)
#(#SubCanvasSpec
#name: 'CodePane'
#autoHideScrollBars: false
#majorKey: #'NewSystemBrowser'
#minorKey: #codePaneSpec
)
"/ #(#CodeViewSpec
"/ #name: 'CodeView'
"/ #model: #codeHolder
"/ #hasHorizontalScrollBar: true
"/ #hasVerticalScrollBar: true
"/ #miniScrollerHorizontal: true
"/ #postBuildCallback: #postBuildCodeView:
"/ #modifiedChannel: #codeModifiedHolder
"/ )
)
)
#handles: #(#Any 0.25 0.5 1.0)
)
)
)
)
"Modified: / 27-04-2010 / 16:30:16 / cg"
!
multipleNameSpaceBrowserSpec
"This resource specification was automatically generated
by the UIPainter of ST/X."
"Do not manually edit this!! If it is corrupted,
the UIPainter may not be able to read the specification."
"
UIPainter new openOnClass:NewSystemBrowser andSelector:#multipleNameSpaceBrowserSpec
NewSystemBrowser new openInterface:#multipleNameSpaceBrowserSpec
"
<resource: #canvas>
^
#(#FullSpec
#name: #multipleNameSpaceBrowserSpec
#window:
#(#WindowSpec
#label: 'NameSpaceBrowser'
#name: 'NewBrowser'
#min: #(#Point 0 0)
#bounds: #(#Rectangle 12 22 474 322)
)
#component:
#(#SpecCollection
#collection: #(
#(#VariableVerticalPanelSpec
#name: 'VariableVerticalPanel1'
#layout: #(#LayoutFrame 0 0.0 0 0.0 0 1.0 0 1.0)
#showHandle: false
#snapMode: #both
#handlePosition: #left
#component:
#(#SpecCollection
#collection: #(
#(#SubCanvasSpec
#name: 'Navigator'
#autoHideScrollBars: false
#majorKey: #'NavigatorCanvas'
#minorKey: #'multipleNameSpaceBrowserSpec'
)
#(#SubCanvasSpec
#name: 'CodePane'
#autoHideScrollBars: false
#majorKey: #'NewSystemBrowser'
#minorKey: #codePaneSpec
)
"/ #(#CodeViewSpec
"/ #name: 'CodeView'
"/ #model: #codeHolder
"/ #hasHorizontalScrollBar: true
"/ #hasVerticalScrollBar: true
"/ #miniScrollerHorizontal: true
"/ #postBuildCallback: #postBuildCodeView:
"/ #modifiedChannel: #codeModifiedHolder
"/ )
)
)
#handles: #(#Any 0.3 1.0)
)
)
)
)
"Modified: / 18.8.2000 / 15:01:15 / cg"
!
multipleNameSpaceFullBrowserSpec
"This resource specification was automatically generated
by the UIPainter of ST/X."
"Do not manually edit this!! If it is corrupted,
the UIPainter may not be able to read the specification."
"
UIPainter new openOnClass:NewSystemBrowser andSelector:#multipleNameSpaceBrowserSpec
NewSystemBrowser new openInterface:#multipleNameSpaceBrowserSpec
"
<resource: #canvas>
^
#(#FullSpec
#name: #multipleNameSpaceBrowserSpec
#window:
#(#WindowSpec
#label: 'NameSpaceBrowser'
#name: 'NewBrowser'
#min: #(#Point 0 0)
#bounds: #(#Rectangle 12 22 474 322)
)
#component:
#(#SpecCollection
#collection: #(
#(#VariableVerticalPanelSpec
#name: 'VariableVerticalPanel1'
#layout: #(#LayoutFrame 0 0.0 0 0.0 0 1.0 0 1.0)
#showHandle: false
#snapMode: #both
#handlePosition: #left
#component:
#(#SpecCollection
#collection: #(
#(#SubCanvasSpec
#name: 'Navigator'
#autoHideScrollBars: false
#majorKey: #'NavigatorCanvas'
#minorKey: #'multipleNameSpaceFullBrowserSpec'
)
#(#SubCanvasSpec
#name: 'CodePane'
#autoHideScrollBars: false
#majorKey: #'NewSystemBrowser'
#minorKey: #codePaneSpec
)
"/ #(#CodeViewSpec
"/ #name: 'CodeView'
"/ #model: #codeHolder
"/ #hasHorizontalScrollBar: true
"/ #hasVerticalScrollBar: true
"/ #miniScrollerHorizontal: true
"/ #postBuildCallback: #postBuildCodeView:
"/ #modifiedChannel: #codeModifiedHolder
"/ )
)
)
#handles: #(#Any 0.3 1.0)
)
)
)
)
"Modified: / 18.8.2000 / 13:53:10 / cg"
"Created: / 18.8.2000 / 15:01:00 / cg"
!
multipleProjectBrowserSpec
"This resource specification was automatically generated
by the UIPainter of ST/X."
"Do not manually edit this!! If it is corrupted,
the UIPainter may not be able to read the specification."
"
UIPainter new openOnClass:NewSystemBrowser andSelector:#multipleProjectBrowserSpec
NewSystemBrowser new openInterface:#multipleProjectBrowserSpec
"
<resource: #canvas>
^
#(#FullSpec
#name: #multipleProjectBrowserSpec
#window:
#(#WindowSpec
#label: 'ProjectBrowser'
#name: 'NewBrowser'
#min: #(#Point 0 0)
#bounds: #(#Rectangle 12 22 474 322)
)
#component:
#(#SpecCollection
#collection: #(
#(#VariableVerticalPanelSpec
#name: 'VariableVerticalPanel1'
#layout: #(#LayoutFrame 0 0.0 0 0.0 0 1.0 0 1.0)
#showHandle: false
#snapMode: #both
#handlePosition: #left
#component:
#(#SpecCollection
#collection: #(
#(#SubCanvasSpec
#name: 'Navigator'
#autoHideScrollBars: false
#majorKey: #'NavigatorCanvas'
#minorKey: #'multipleProjectBrowserSpec'
)
#(#SubCanvasSpec
#name: 'CodePane'
#autoHideScrollBars: false
#majorKey: #'NewSystemBrowser'
#minorKey: #codePaneSpec
)
"/ #(#CodeViewSpec
"/ #name: 'CodeView'
"/ #model: #codeHolder
"/ #hasHorizontalScrollBar: true
"/ #hasVerticalScrollBar: true
"/ #miniScrollerHorizontal: true
"/ #postBuildCallback: #postBuildCodeView:
"/ #modifiedChannel: #codeModifiedHolder
"/ )
)
)
#handles: #(#Any 0.3 1.0)
)
)
)
)
!
multipleProjectFullBrowserSpec
"This resource specification was automatically generated
by the UIPainter of ST/X."
"Do not manually edit this!! If it is corrupted,
the UIPainter may not be able to read the specification."
"
UIPainter new openOnClass:NewSystemBrowser andSelector:#multipleProjectBrowserSpec
NewSystemBrowser new openInterface:#multipleProjectBrowserSpec
"
<resource: #canvas>
^
#(#FullSpec
#name: #multipleProjectFullBrowserSpec
#window:
#(#WindowSpec
#label: 'ProjectBrowser'
#name: 'NewBrowser'
#min: #(#Point 0 0)
#bounds: #(#Rectangle 12 22 474 322)
)
#component:
#(#SpecCollection
#collection: #(
#(#VariableVerticalPanelSpec
#name: 'VariableVerticalPanel1'
#layout: #(#LayoutFrame 0 0.0 0 0.0 0 1.0 0 1.0)
#showHandle: false
#snapMode: #both
#handlePosition: #left
#component:
#(#SpecCollection
#collection: #(
#(#SubCanvasSpec
#name: 'Navigator'
#autoHideScrollBars: false
#majorKey: #'NavigatorCanvas'
#minorKey: #'multipleProjectFullBrowserSpec'
)
#(#SubCanvasSpec
#name: 'CodePane'
#autoHideScrollBars: false
#majorKey: #'NewSystemBrowser'
#minorKey: #codePaneSpec
)
"/ #(#CodeViewSpec
"/ #name: 'CodeView'
"/ #model: #codeHolder
"/ #hasHorizontalScrollBar: true
"/ #hasVerticalScrollBar: true
"/ #miniScrollerHorizontal: true
"/ #postBuildCallback: #postBuildCodeView:
"/ #modifiedChannel: #codeModifiedHolder
"/ )
)
)
#handles: #(#Any 0.3 1.0)
)
)
)
)
"Created: / 18.8.2000 / 18:42:38 / cg"
!
multipleProtocolBrowserSpec
"This resource specification was automatically generated
by the UIPainter of ST/X."
"Do not manually edit this!! If it is corrupted,
the UIPainter may not be able to read the specification."
"
UIPainter new openOnClass:NewSystemBrowser andSelector:#multipleProtocolBrowserSpec
NewSystemBrowser new openInterface:#multipleProtocolBrowserSpec
"
<resource: #canvas>
^
#(#FullSpec
#name: #multipleProtocolBrowserSpec
#window:
#(#WindowSpec
#label: 'ProtocolBrowser'
#name: 'NewBrowser'
#min: #(#Point 0 0)
#bounds: #(#Rectangle 12 22 474 322)
)
#component:
#(#SpecCollection
#collection: #(
#(#VariableVerticalPanelSpec
#name: 'VariableVerticalPanel1'
#layout: #(#LayoutFrame 0 0.0 0 0.0 0 1.0 0 1.0)
#showHandle: false
#snapMode: #both
#handlePosition: #left
#component:
#(#SpecCollection
#collection: #(
#(#SubCanvasSpec
#name: 'Navigator'
#autoHideScrollBars: false
#majorKey: #'NavigatorCanvas'
#minorKey: #'multipleProtocolBrowserSpec'
)
#(#SubCanvasSpec
#name: 'CodePane'
#autoHideScrollBars: false
#majorKey: #'NewSystemBrowser'
#minorKey: #codePaneSpec
)
"/ #(#CodeViewSpec
"/ #name: 'CodeView'
"/ #model: #codeHolder
"/ #hasHorizontalScrollBar: true
"/ #hasVerticalScrollBar: true
"/ #miniScrollerHorizontal: true
"/ #postBuildCallback: #postBuildCodeView:
"/ #modifiedChannel: #codeModifiedHolder
"/ )
)
)
#handles: #(#Any 0.3 1.0)
)
)
)
)
"Modified: / 1.3.2000 / 20:45:30 / cg"
!
noteBookWindowSpec
"This resource specification was automatically generated
by the UIPainter of ST/X."
"Do not manually edit this!! If it is corrupted,
the UIPainter may not be able to read the specification."
"
UIPainter new openOnClass:Tools::NewSystemBrowser andSelector:#noteBookWindowSpec
Tools::NewSystemBrowser new openInterface:#noteBookWindowSpec
"
<resource: #canvas>
^
#(FullSpec
name: noteBookWindowSpec
window:
(WindowSpec
label: 'NewSystemBrowser'
name: 'NewSystemBrowser'
min: (Point 0 0)
bounds: (Rectangle 0 0 800 700)
menu: mainMenu
icon: defaultIcon
)
component:
(SpecCollection
collection: (
(NoteBookViewSpec
name: 'NoteBook'
layout: (LayoutFrame 0 0.0 0 0.0 0 1.0 0 1.0)
level: 0
model: selectedBuffer
menu: bufferNameList
useIndex: true
valueChangeSelector: bufferSelectionChanged
accessTabMenuAction: tabMenu:
hasScrollButtons: true
destroyTabAction: destroyTab:
canvas: browserCanvas
canvasInset: 0
keepCanvasAlive: true
tabLevel: 1
)
(ViewSpec
name: 'ToolBar'
layout: (LayoutFrame 0 0 0 0 0 1 40 0)
visibilityChannel: toolBarVisibleHolder
component:
(SpecCollection
collection: (
(ActionButtonSpec
label: 'hideToolBarIcon'
name: 'HideToolBarButton'
layout: (LayoutFrame 0 0 0 0 13 0 0 1)
activeHelpKey: hideToolBar
hasCharacterOrientedLabel: false
translateLabel: true
model: hideToolbar
postBuildCallback: hideToolBarButtonCreated:
)
(MenuPanelSpec
name: 'ToolBarMenu'
layout: (LayoutFrame 13 0.0 0 0.0 -250 1.0 0 1.0)
visibilityChannel: toolBarVisibleHolder
menu: toolBarMenu
textDefault: true
)
(HorizontalPanelViewSpec
name: 'HorizontalPanel1'
layout: (LayoutFrame -250 1 0 0 0 1 0 1)
level: 1
horizontalLayout: fitSpace
verticalLayout: center
horizontalSpace: 2
verticalSpace: 2
component:
(SpecCollection
collection: (
(ComboBoxSpec
name: 'SearchedClassNameComboBox'
activeHelpKey: gotoClassEntryField
model: searchedClassNameOrSelectorHolder
acceptOnLeave: false
acceptOnReturn: true
acceptOnPointerLeave: false
acceptIfUnchanged: true
comboList: visitedClassesHistory
extent: (Point 244 24)
postBuildCallback: searchFieldCreated:
)
)
)
postBuildCallback: searchFieldPanelCreated:
)
)
)
)
)
)
)
!
selectorBrowserSpec
"This resource specification was automatically generated
by the UIPainter of ST/X."
"Do not manually edit this!! If it is corrupted,
the UIPainter may not be able to read the specification."
"
UIPainter new openOnClass:NewSystemBrowser andSelector:#selectorBrowserSpec
NewSystemBrowser new openInterface:#selectorBrowserSpec
"
<resource: #canvas>
^
#(#FullSpec
#name: #selectorBrowserSpec
#window:
#(#WindowSpec
#label: 'SelectorBrowser'
#name: 'NewBrowser'
#min: #(#Point 0 0)
#bounds: #(#Rectangle 18 51 480 351)
)
#component:
#(#SpecCollection
#collection: #(
#(#VariableVerticalPanelSpec
#name: 'VariableVerticalPanel1'
#layout: #(#LayoutFrame 0 0.0 0 0.0 0 1.0 0 1.0)
#showHandle: false
#snapMode: #both
#handlePosition: #left
#component:
#(#SpecCollection
#collection: #(
#(#SubCanvasSpec
#name: 'Navigator'
#autoHideScrollBars: false
#majorKey: #'NavigatorCanvas'
#minorKey: #'selectorBrowserSpec'
)
#(#SubCanvasSpec
#name: 'CodePane'
#autoHideScrollBars: false
#majorKey: #'NewSystemBrowser'
#minorKey: #codePaneSpec
)
"/ #(#CodeViewSpec
"/ #name: 'CodeView'
"/ #model: #codeHolder
"/ #hasHorizontalScrollBar: true
"/ #hasVerticalScrollBar: true
"/ #miniScrollerHorizontal: true
"/ #modifiedChannel: #codeModifiedHolder
"/ #postBuildCallback: #postBuildCodeView:
"/ #modifiedChannel: #codeModifiedHolder
"/ )
)
)
#handles: #(#Any 0.3 1.0)
)
)
)
)
!
senderChainBrowserSpec
"This resource specification was automatically generated
by the UIPainter of ST/X."
"Do not manually edit this!! If it is corrupted,
the UIPainter may not be able to read the specification."
"
UIPainter new openOnClass:NewSystemBrowser andSelector:#senderChainBrowserSpec
NewSystemBrowser new openInterface:#senderChainBrowserSpec
"
<resource: #canvas>
^
#(#FullSpec
#name: #senderChainBrowserSpec
#window:
#(#WindowSpec
#label: 'MethodBrowser'
#name: 'MethodBrowser'
#min: #(#Point 0 0)
#bounds: #(#Rectangle 185 379 647 679)
)
#component:
#(#SpecCollection
#collection: #(
#(#VariableVerticalPanelSpec
#name: 'VariableVerticalPanel1'
#layout: #(#LayoutFrame 0 0.0 0 0.0 0 1.0 0 1.0)
#showHandle: false
#snapMode: #both
#handlePosition: #left
#component:
#(#SpecCollection
#collection: #(
#(#VariableHorizontalPanelSpec
#name: 'VariableHorizontalPanel1'
#showHandle: false
#barWidth: 2
#component:
#(#SpecCollection
#collection: #(
#(#SubCanvasSpec
#name: 'MethodList1'
#majorKey: #'MethodList'
#subAspectHolders:
#(#Array
#(#SubChannelInfoSpec
#subAspect: #showCoverageInformation
#aspect: #showCoverageInformation
)
#(#SubChannelInfoSpec
#subAspect: #doubleClickChannel
#callBack: #methodDoubleClicked1
)
#(#SubChannelInfoSpec
#subAspect: #immediateUpdate
#aspect: #immediateUpdate
)
#(#SubChannelInfoSpec
#subAspect: #inGeneratorHolder
#aspect: #selectorListGenerator1
)
#(#SubChannelInfoSpec
#subAspect: #menuHolder
#aspect: #selectorPopUpMenu
)
#(#SubChannelInfoSpec
#subAspect: #showMethodInheritance
#aspect: #showMethodInheritance
)
#(#SubChannelInfoSpec
#subAspect: #showMethodComplexity
#aspect: #showMethodComplexity
)
#(#SubChannelInfoSpec
#subAspect: #showMethodTypeIcon
#aspect: #showMethodTypeIcon
)
#(#SubChannelInfoSpec
#subAspect: #packageFilter
#aspect: #packageFilter
)
#(#SubChannelInfoSpec
#subAspect: #selectedMethods
#aspect: #selectedMethods1
#callBack: #methodsSelectionChanged1
)
#(#SubChannelInfoSpec
#subAspect: #selectionChangeCondition
#aspect: #selectionChangeConditionHolder
)
)
#createNewApplication: true
#createNewBuilder: true
)
#(#SubCanvasSpec
#name: 'MethodList2'
#majorKey: #'MethodList'
#subAspectHolders:
#(#Array
#(#SubChannelInfoSpec
#subAspect: #showCoverageInformation
#aspect: #showCoverageInformation
)
#(#SubChannelInfoSpec
#subAspect: #doubleClickChannel
#callBack: #methodDoubleClicked2
)
#(#SubChannelInfoSpec
#subAspect: #immediateUpdate
#aspect: #immediateUpdate
)
#(#SubChannelInfoSpec
#subAspect: #showMethodInheritance
#aspect: #showMethodInheritance
)
#(#SubChannelInfoSpec
#subAspect: #showMethodComplexity
#aspect: #showMethodComplexity
)
#(#SubChannelInfoSpec
#subAspect: #showMethodTypeIcon
#aspect: #showMethodTypeIcon
)
#(#SubChannelInfoSpec
#subAspect: #inGeneratorHolder
#aspect: #selectorListGenerator2
)
#(#SubChannelInfoSpec
#subAspect: #menuHolder
#aspect: #selectorPopUpMenu
)
#(#SubChannelInfoSpec
#subAspect: #packageFilter
#aspect: #packageFilter
)
#(#SubChannelInfoSpec
#subAspect: #selectedMethods
#aspect: #selectedMethods2
#callBack: #methodsSelectionChanged2
)
#(#SubChannelInfoSpec
#subAspect: #selectionChangeCondition
#aspect: #selectionChangeConditionHolder
)
)
#createNewApplication: true
#createNewBuilder: true
)
#(#SubCanvasSpec
#name: 'MethodList3'
#majorKey: #'MethodList'
#subAspectHolders:
#(#Array
#(#SubChannelInfoSpec
#subAspect: #showCoverageInformation
#aspect: #showCoverageInformation
)
#(#SubChannelInfoSpec
#subAspect: #doubleClickChannel
#callBack: #methodDoubleClicked3
)
#(#SubChannelInfoSpec
#subAspect: #immediateUpdate
#aspect: #immediateUpdate
)
#(#SubChannelInfoSpec
#subAspect: #showMethodInheritance
#aspect: #showMethodInheritance
)
#(#SubChannelInfoSpec
#subAspect: #showMethodComplexity
#aspect: #showMethodComplexity
)
#(#SubChannelInfoSpec
#subAspect: #showMethodTypeIcon
#aspect: #showMethodTypeIcon
)
#(#SubChannelInfoSpec
#subAspect: #inGeneratorHolder
#aspect: #selectorListGenerator3
)
#(#SubChannelInfoSpec
#subAspect: #menuHolder
#aspect: #selectorPopUpMenu
)
#(#SubChannelInfoSpec
#subAspect: #packageFilter
#aspect: #packageFilter
)
#(#SubChannelInfoSpec
#subAspect: #selectedMethods
#aspect: #selectedMethods3
#callBack: #methodsSelectionChanged3
)
#(#SubChannelInfoSpec
#subAspect: #selectionChangeCondition
#aspect: #selectionChangeConditionHolder
)
)
#createNewApplication: true
#createNewBuilder: true
)
#(#SubCanvasSpec
#name: 'MethodList4'
#majorKey: #'MethodList'
#subAspectHolders:
#(#Array
#(#SubChannelInfoSpec
#subAspect: #showCoverageInformation
#aspect: #showCoverageInformation
)
#(#SubChannelInfoSpec
#subAspect: #doubleClickChannel
#callBack: #methodDoubleClicked4
)
#(#SubChannelInfoSpec
#subAspect: #immediateUpdate
#aspect: #immediateUpdate
)
#(#SubChannelInfoSpec
#subAspect: #showMethodInheritance
#aspect: #showMethodInheritance
)
#(#SubChannelInfoSpec
#subAspect: #showMethodComplexity
#aspect: #showMethodComplexity
)
#(#SubChannelInfoSpec
#subAspect: #showMethodTypeIcon
#aspect: #showMethodTypeIcon
)
#(#SubChannelInfoSpec
#subAspect: #inGeneratorHolder
#aspect: #selectorListGenerator4
)
#(#SubChannelInfoSpec
#subAspect: #menuHolder
#aspect: #selectorPopUpMenu
)
#(#SubChannelInfoSpec
#subAspect: #packageFilter
#aspect: #packageFilter
)
#(#SubChannelInfoSpec
#subAspect: #selectedMethods
#aspect: #selectedMethods4
#callBack: #methodsSelectionChanged4
)
#(#SubChannelInfoSpec
#subAspect: #selectionChangeCondition
#aspect: #selectionChangeConditionHolder
)
)
#createNewApplication: true
#createNewBuilder: true
)
)
)
#handles: #(#Any 0.25 0.5 0.75 1.0)
)
#(#SubCanvasSpec
#name: 'CodePane'
#autoHideScrollBars: false
#majorKey: #'NewSystemBrowser'
#minorKey: #codePaneSpec
)
"/ #(#CodeViewSpec
"/ #name: 'CodeView'
"/ #model: #codeHolder
"/ #hasHorizontalScrollBar: true
"/ #hasVerticalScrollBar: true
"/ #miniScrollerHorizontal: true
"/ #postBuildCallback: #postBuildCodeView:
"/ #modifiedChannel: #codeModifiedHolder
"/ )
)
)
#handles: #(#Any 0.5 1.0)
)
)
)
)
"Modified: / 27-04-2010 / 16:30:26 / cg"
!
singleCategoryBrowserSpec
"This resource specification was automatically generated
by the UIPainter of ST/X."
"Do not manually edit this!! If it is corrupted,
the UIPainter may not be able to read the specification."
"
UIPainter new openOnClass:NewSystemBrowser andSelector:#singleCategoryBrowserSpec
NewSystemBrowser new openInterface:#singleCategoryBrowserSpec
"
<resource: #canvas>
^
#(#FullSpec
#name: #singleCategoryBrowserSpec
#window:
#(#WindowSpec
#label: 'CategoryBrowser'
#name: 'SingleCategoryBrowser'
#min: #(#Point 0 0)
#bounds: #(#Rectangle 12 22 474 322)
)
#component:
#(#SpecCollection
#collection: #(
#(#VariableVerticalPanelSpec
#name: 'VariableVerticalPanel1'
#layout: #(#LayoutFrame 0 0.0 0 0.0 0 1.0 0 1.0)
#showHandle: false
#snapMode: #both
#handlePosition: #left
#component:
#(#SpecCollection
#collection: #(
#(#SubCanvasSpec
#name: 'Navigator'
#autoHideScrollBars: false
#majorKey: #'NavigatorCanvas'
#minorKey: #'singleCategoryBrowserSpec'
)
#(#SubCanvasSpec
#name: 'CodePane'
#autoHideScrollBars: false
#majorKey: #'NewSystemBrowser'
#minorKey: #codePaneSpec
)
"/ #(#CodeViewSpec
"/ #name: 'CodeView'
"/ #model: #codeHolder
"/ #hasHorizontalScrollBar: true
"/ #hasVerticalScrollBar: true
"/ #miniScrollerHorizontal: true
"/ #postBuildCallback: #postBuildCodeView:
"/ #modifiedChannel: #codeModifiedHolder
"/ )
)
)
#handles: #(#Any 0.3 1.0)
)
)
)
)
!
singleClassBrowserSpec
"This resource specification was automatically generated
by the UIPainter of ST/X."
"Do not manually edit this!! If it is corrupted,
the UIPainter may not be able to read the specification."
"
UIPainter new openOnClass:NewSystemBrowser andSelector:#singleClassBrowserSpec
NewSystemBrowser new openInterface:#singleClassBrowserSpec
"
<resource: #canvas>
^
#(#FullSpec
#name: #singleClassBrowserSpec
#window:
#(#WindowSpec
#label: 'ClassBrowser'
#name: 'NewBrowser'
#min: #(#Point 0 0)
#bounds: #(#Rectangle 12 22 474 322)
)
#component:
#(#SpecCollection
#collection: #(
#(#VariableVerticalPanelSpec
#name: 'VariableVerticalPanel1'
#layout: #(#LayoutFrame 0 0.0 0 0.0 0 1.0 0 1.0)
#showHandle: false
#snapMode: #both
#handlePosition: #left
#component:
#(#SpecCollection
#collection: #(
#(#SubCanvasSpec
#name: 'Navigator'
#autoHideScrollBars: false
#majorKey: #'NavigatorCanvas'
#minorKey: #'singleClassBrowserSpec'
)
#(#SubCanvasSpec
#name: 'CodePane'
#autoHideScrollBars: false
#majorKey: #'NewSystemBrowser'
#minorKey: #codePaneSpec
)
"/ #(#CodeViewSpec
"/ #name: 'CodeView'
"/ #model: #codeHolder
"/ #hasHorizontalScrollBar: true
"/ #hasVerticalScrollBar: true
"/ #miniScrollerHorizontal: true
"/ #postBuildCallback: #postBuildCodeView:
"/ #modifiedChannel: #codeModifiedHolder
"/ )
)
)
#handles: #(#Any 0.4 1.0)
)
)
)
)
!
singleFullProtocolBrowserSpec
"This resource specification was automatically generated
by the UIPainter of ST/X."
"Do not manually edit this!! If it is corrupted,
the UIPainter may not be able to read the specification."
"
UIPainter new openOnClass:NewSystemBrowser andSelector:#singleProtocolBrowserSpec
NewSystemBrowser new openInterface:#singleProtocolBrowserSpec
"
<resource: #canvas>
^
#(#FullSpec
#name: #singleFullProtocolBrowserSpec
#window:
#(#WindowSpec
#label: 'ProtocolBrowser'
#name: 'NewBrowser'
#min: #(#Point 0 0)
#bounds: #(#Rectangle 13 23 475 323)
)
#component:
#(#SpecCollection
#collection: #(
#(#VariableVerticalPanelSpec
#name: 'VariableVerticalPanel1'
#layout: #(#LayoutFrame 0 0.0 0 0.0 0 1.0 0 1.0)
#showHandle: false
#snapMode: #both
#handlePosition: #left
#component:
#(#SpecCollection
#collection: #(
#(#SubCanvasSpec
#name: 'Navigator'
#autoHideScrollBars: false
#majorKey: #'NavigatorCanvas'
#minorKey: #'singleFullProtocolBrowserSpec'
)
#(#SubCanvasSpec
#name: 'CodePane'
#autoHideScrollBars: false
#majorKey: #'NewSystemBrowser'
#minorKey: #codePaneSpec
)
"/ #(#CodeViewSpec
"/ #name: 'CodeView'
"/ #model: #codeHolder
"/ #hasHorizontalScrollBar: true
"/ #hasVerticalScrollBar: true
"/ #miniScrollerHorizontal: true
"/ #postBuildCallback: #postBuildCodeView:
"/ #modifiedChannel: #codeModifiedHolder
"/ )
)
)
#handles: #(#Any 0.3 1.0)
)
)
)
)
"Modified: / 1.3.2000 / 11:59:28 / cg"
!
singleMethodBrowserSpec
"This resource specification was automatically generated
by the UIPainter of ST/X."
"Do not manually edit this!! If it is corrupted,
the UIPainter may not be able to read the specification."
"
UIPainter new openOnClass:NewSystemBrowser andSelector:#singleMethodBrowserSpec
NewSystemBrowser new openInterface:#singleMethodBrowserSpec
"
<resource: #canvas>
^
#(#FullSpec
#name: #methodBrowserSpec
#window:
#(#WindowSpec
#label: 'MethodBrowser'
#name: 'NewBrowser'
#min: #(#Point 0 0)
#bounds: #(#Rectangle 13 23 475 323)
)
#component:
#(#SpecCollection
#collection: #(
#(#SubCanvasSpec
#name: 'PseudoMethodList'
#layout: #(#LayoutFrame 0 0.0 0 0 0 1.0 25 0)
#majorKey: #'MethodList'
#minorKey: #singleMethodWindowSpec
#subAspectHolders:
#(#Array
#(#SubChannelInfoSpec
#subAspect: #immediateUpdate
#aspect: #immediateUpdate
)
#(#SubChannelInfoSpec
#subAspect: #inGeneratorHolder
#aspect: #selectorListGenerator
)
#(#SubChannelInfoSpec
#subAspect: #packageFilter
#aspect: #packageFilter
)
#(#SubChannelInfoSpec
#subAspect: #selectedMethods
#aspect: #selectedProtocolMethods
)
#(#SubChannelInfoSpec
#subAspect: #menuHolder
#aspect: #selectorPopUpMenu
)
)
#createNewApplication: true
#createNewBuilder: true
)
#(#SubCanvasSpec
#layout: #(#LayoutFrame 0 0.0 25 0.0 0 1.0 0 1.0)
#name: 'CodePane'
#autoHideScrollBars: false
#majorKey: #'NewSystemBrowser'
#minorKey: #codePaneSpec
)
"/ #(#CodeViewSpec
"/ #name: 'CodeView'
"/ #layout: #(#LayoutFrame 0 0.0 25 0.0 0 1.0 0 1.0)
"/ #model: #codeHolder
"/ #hasHorizontalScrollBar: true
"/ #hasVerticalScrollBar: true
"/ #miniScrollerHorizontal: true
"/ #postBuildCallback: #postBuildCodeView:
"/ #modifiedChannel: #codeModifiedHolder
"/ )
)
)
)
"Modified: / 1.3.2000 / 20:47:18 / cg"
!
singleMethodWithInfoBrowserSpec
"This resource specification was automatically generated
by the UIPainter of ST/X."
"Do not manually edit this!! If it is corrupted,
the UIPainter may not be able to read the specification."
"
UIPainter new openOnClass:NewSystemBrowser andSelector:#singleMethodWithInfoBrowserSpec
NewSystemBrowser new openInterface:#singleMethodWithInfoBrowserSpec
"
<resource: #canvas>
^
#(#FullSpec
#name: #singleMethodWithInfoBrowserSpec
#window:
#(#WindowSpec
#label: 'MethodBrowser'
#name: 'MethodBrowser'
#min: #(#Point 0 0)
#bounds: #(#Rectangle 18 51 480 351)
)
#component:
#(#SpecCollection
#collection: #(
#(#SubCanvasSpec
#name: 'PseudoMethodList'
#layout: #(#LayoutFrame 0 0.0 0 0 0 1.0 25 0)
#majorKey: #'MethodList'
#minorKey: #singleMethodWindowSpec
#subAspectHolders:
#(#Array
#(#SubChannelInfoSpec
#subAspect: #immediateUpdate
#aspect: #immediateUpdate
)
#(#SubChannelInfoSpec
#subAspect: #inGeneratorHolder
#aspect: #selectorListGenerator
)
#(#SubChannelInfoSpec
#subAspect: #packageFilter
#aspect: #packageFilter
)
#(#SubChannelInfoSpec
#subAspect: #selectedMethods
#aspect: #selectedProtocolMethods
)
#(#SubChannelInfoSpec
#subAspect: #menuHolder
#aspect: #methodListPopUpMenu
)
)
#createNewApplication: true
#createNewBuilder: true
)
#(#VariableVerticalPanelSpec
#name: 'VariableVerticalPanel1'
#layout: #(#LayoutFrame 0 0.0 25 0 0 1.0 0 1.0)
#showHandle: false
#snapMode: #both
#handlePosition: #left
#component:
#(#SpecCollection
#collection: #(
#(#TextEditorSpec
#name: 'MethodInfoView'
#model: #methodInfo
#hasHorizontalScrollBar: true
#hasVerticalScrollBar: true
#autoHideScrollBars: true
#isReadOnly: true
)
#(#SubCanvasSpec
#name: 'CodePane'
#autoHideScrollBars: false
#majorKey: #'NewSystemBrowser'
#minorKey: #codePaneSpec
)
"/ #(#CodeViewSpec
"/ #name: 'CodeView'
"/ #model: #codeHolder
"/ #hasHorizontalScrollBar: true
"/ #hasVerticalScrollBar: true
"/ #miniScrollerHorizontal: true
"/ #postBuildCallback: #postBuildCodeView:
"/ #modifiedChannel: #codeModifiedHolder
"/ )
)
)
#handles: #(#Any 0.5 1.0)
)
)
)
)
!
singleNameSpaceBrowserSpec
"This resource specification was automatically generated
by the UIPainter of ST/X."
"Do not manually edit this!! If it is corrupted,
the UIPainter may not be able to read the specification."
"
UIPainter new openOnClass:NewSystemBrowser andSelector:#singleNameSpaceBrowserSpec
NewSystemBrowser new openInterface:#singleNameSpaceBrowserSpec
"
<resource: #canvas>
^
#(#FullSpec
#name: #singleNameSpaceBrowserSpec
#window:
#(#WindowSpec
#label: 'NameSpaceBrowser'
#name: 'NameSpaceBrowser'
#min: #(#Point 0 0)
#bounds: #(#Rectangle 518 71 1205 712)
)
#component:
#(#SpecCollection
#collection: #(
#(#VariableVerticalPanelSpec
#name: 'VariableVerticalPanel1'
#layout: #(#LayoutFrame 0 0.0 0 0.0 0 1.0 0 1.0)
#showHandle: false
#snapMode: #both
#handlePosition: #left
#component:
#(#SpecCollection
#collection: #(
#(#SubCanvasSpec
#name: 'Navigator'
#autoHideScrollBars: false
#majorKey: #'NavigatorCanvas'
#minorKey: #singleNameSpaceBrowserSpec
)
#(#SubCanvasSpec
#name: 'CodePane'
#autoHideScrollBars: false
#majorKey: #'NewSystemBrowser'
#minorKey: #codePaneSpec
)
"/ #(#CodeViewSpec
"/ #name: 'CodeView'
"/ #model: #codeHolder
"/ #hasHorizontalScrollBar: true
"/ #hasVerticalScrollBar: true
"/ #miniScrollerHorizontal: true
"/ #postBuildCallback: #postBuildCodeView:
"/ #modifiedChannel: #codeModifiedHolder
"/ )
)
)
#handles: #(#Any 0.3 1.0)
)
)
)
)
"Modified: / 18.8.2000 / 15:01:10 / cg"
!
singleNameSpaceFullBrowserSpec
"This resource specification was automatically generated
by the UIPainter of ST/X."
"Do not manually edit this!! If it is corrupted,
the UIPainter may not be able to read the specification."
"
UIPainter new openOnClass:NewSystemBrowser andSelector:#singleNameSpaceBrowserSpec
NewSystemBrowser new openInterface:#singleNameSpaceBrowserSpec
"
<resource: #canvas>
^
#(#FullSpec
#name: #singleNameSpaceBrowserSpec
#window:
#(#WindowSpec
#label: 'NameSpaceBrowser'
#name: 'NameSpaceBrowser'
#min: #(#Point 0 0)
#bounds: #(#Rectangle 518 71 1205 712)
)
#component:
#(#SpecCollection
#collection: #(
#(#VariableVerticalPanelSpec
#name: 'VariableVerticalPanel1'
#layout: #(#LayoutFrame 0 0.0 0 0.0 0 1.0 0 1.0)
#showHandle: false
#snapMode: #both
#handlePosition: #left
#component:
#(#SpecCollection
#collection: #(
#(#SubCanvasSpec
#name: 'Navigator'
#autoHideScrollBars: false
#majorKey: #'NavigatorCanvas'
#minorKey: #singleNameSpaceFullBrowserSpec
)
#(#SubCanvasSpec
#name: 'CodePane'
#autoHideScrollBars: false
#majorKey: #'NewSystemBrowser'
#minorKey: #codePaneSpec
)
"/ #(#CodeViewSpec
"/ #name: 'CodeView'
"/ #model: #codeHolder
"/ #hasHorizontalScrollBar: true
"/ #hasVerticalScrollBar: true
"/ #miniScrollerHorizontal: true
"/ #postBuildCallback: #postBuildCodeView:
"/ #modifiedChannel: #codeModifiedHolder
"/ )
)
)
#handles: #(#Any 0.3 1.0)
)
)
)
)
"Modified: / 18.8.2000 / 14:03:27 / cg"
"Created: / 18.8.2000 / 15:01:07 / cg"
!
singleProjectBrowserSpec
"This resource specification was automatically generated
by the UIPainter of ST/X."
"Do not manually edit this!! If it is corrupted,
the UIPainter may not be able to read the specification."
"
UIPainter new openOnClass:NewSystemBrowser andSelector:#singleProjectBrowserSpec
NewSystemBrowser new openInterface:#singleProjectBrowserSpec
"
<resource: #canvas>
^
#(#FullSpec
#name: #singleProjectBrowserSpec
#window:
#(#WindowSpec
#label: 'ProjectBrowser'
#name: 'NewBrowser'
#min: #(#Point 0 0)
#bounds: #(#Rectangle 13 23 475 323)
)
#component:
#(#SpecCollection
#collection: #(
#(#VariableVerticalPanelSpec
#name: 'VariableVerticalPanel1'
#layout: #(#LayoutFrame 0 0.0 0 0.0 0 1.0 0 1.0)
#showHandle: false
#snapMode: #both
#handlePosition: #left
#component:
#(#SpecCollection
#collection: #(
#(#SubCanvasSpec
#name: 'Navigator'
#autoHideScrollBars: false
#majorKey: #'NavigatorCanvas'
#minorKey: #'singleProjectBrowserSpec'
)
#(#SubCanvasSpec
#name: 'CodePane'
#autoHideScrollBars: false
#majorKey: #'NewSystemBrowser'
#minorKey: #codePaneSpec
)
"/ #(#CodeViewSpec
"/ #name: 'CodeView'
"/ #model: #codeHolder
"/ #hasHorizontalScrollBar: true
"/ #hasVerticalScrollBar: true
"/ #miniScrollerHorizontal: true
"/ #postBuildCallback: #postBuildCodeView:
"/ #modifiedChannel: #codeModifiedHolder
"/ )
)
)
#handles: #(#Any 0.3 1.0)
)
)
)
)
"Created: / 25.2.2000 / 02:33:53 / cg"
"Modified: / 25.2.2000 / 03:11:11 / cg"
!
singleProjectFullBrowserSpec
"This resource specification was automatically generated
by the UIPainter of ST/X."
"Do not manually edit this!! If it is corrupted,
the UIPainter may not be able to read the specification."
"
UIPainter new openOnClass:NewSystemBrowser andSelector:#singleProjectBrowserSpec
NewSystemBrowser new openInterface:#singleProjectBrowserSpec
"
<resource: #canvas>
^
#(#FullSpec
#name: #singleProjectFullBrowserSpec
#window:
#(#WindowSpec
#label: 'ProjectBrowser'
#name: 'NewBrowser'
#min: #(#Point 0 0)
#bounds: #(#Rectangle 13 23 475 323)
)
#component:
#(#SpecCollection
#collection: #(
#(#VariableVerticalPanelSpec
#name: 'VariableVerticalPanel1'
#layout: #(#LayoutFrame 0 0.0 0 0.0 0 1.0 0 1.0)
#showHandle: false
#snapMode: #both
#handlePosition: #left
#component:
#(#SpecCollection
#collection: #(
#(#SubCanvasSpec
#name: 'Navigator'
#autoHideScrollBars: false
#majorKey: #'NavigatorCanvas'
#minorKey: #'singleProjectFullBrowserSpec'
)
#(#SubCanvasSpec
#name: 'CodePane'
#autoHideScrollBars: false
#majorKey: #'NewSystemBrowser'
#minorKey: #codePaneSpec
)
"/ #(#CodeViewSpec
"/ #name: 'CodeView'
"/ #model: #codeHolder
"/ #hasHorizontalScrollBar: true
"/ #hasVerticalScrollBar: true
"/ #miniScrollerHorizontal: true
"/ #postBuildCallback: #postBuildCodeView:
"/ #modifiedChannel: #codeModifiedHolder
"/ )
)
)
#handles: #(#Any 0.3 1.0)
)
)
)
)
"Modified: / 25.2.2000 / 03:11:11 / cg"
"Created: / 18.8.2000 / 18:42:51 / cg"
!
singleProtocolBrowserSpec
"This resource specification was automatically generated
by the UIPainter of ST/X."
"Do not manually edit this!! If it is corrupted,
the UIPainter may not be able to read the specification."
"
UIPainter new openOnClass:NewSystemBrowser andSelector:#singleProtocolBrowserSpec
NewSystemBrowser new openInterface:#singleProtocolBrowserSpec
"
<resource: #canvas>
^
#(#FullSpec
#name: #singleProtocolBrowserSpec
#window:
#(#WindowSpec
#label: 'ProtocolBrowser'
#name: 'NewBrowser'
#min: #(#Point 0 0)
#bounds: #(#Rectangle 13 23 475 323)
)
#component:
#(#SpecCollection
#collection: #(
#(#VariableVerticalPanelSpec
#name: 'VariableVerticalPanel1'
#layout: #(#LayoutFrame 0 0.0 0 0.0 0 1.0 0 1.0)
#showHandle: false
#snapMode: #both
#handlePosition: #left
#component:
#(#SpecCollection
#collection: #(
#(#SubCanvasSpec
#name: 'Navigator'
#autoHideScrollBars: false
#majorKey: #'NavigatorCanvas'
#minorKey: #'singleProtocolBrowserSpec'
)
#(#SubCanvasSpec
#name: 'CodePane'
#autoHideScrollBars: false
#majorKey: #'NewSystemBrowser'
#minorKey: #codePaneSpec
)
"/ #(#CodeViewSpec
"/ #name: 'CodeView'
"/ #model: #codeHolder
"/ #hasHorizontalScrollBar: true
"/ #hasVerticalScrollBar: true
"/ #miniScrollerHorizontal: true
"/ #postBuildCallback: #postBuildCodeView:
"/ #modifiedChannel: #codeModifiedHolder
"/ )
)
)
#handles: #(#Any 0.3 1.0)
)
)
)
)
"Modified: / 1.3.2000 / 11:59:28 / cg"
!
windowSpec
"/ ^ self browserWindowSpec
^ self noteBookWindowSpec
"Modified: / 5.2.2000 / 12:23:55 / cg"
! !
!NewSystemBrowser class methodsFor:'interface specs-dialogs'!
repositoryConsistencyDialogSpec
"This resource specification was automatically generated
by the UIPainter of ST/X."
"Do not manually edit this!! If it is corrupted,
the UIPainter may not be able to read the specification."
"
UIPainter new openOnClass:NewSystemBrowser andSelector:#repositoryConsistencyDialogSpec
NewSystemBrowser new openInterface:#repositoryConsistencyDialogSpec
"
<resource: #canvas>
^
#(#FullSpec
#name: #repositoryConsistencyDialogSpec
#window:
#(#WindowSpec
#label: 'Repository Consistency Check'
#name: 'Repository Consistency Check'
#min: #(#Point 10 10)
#max: #(#Point 1280 1024)
#bounds: #(#Rectangle 16 46 316 492)
)
#component:
#(#SpecCollection
#collection: #(
#(#LabelSpec
#label: 'Repository Consistency Check Report:'
#name: 'Label1'
#layout: #(#LayoutFrame 0 0 0 0 0 1 33 0)
#translateLabel: true
)
#(#VerticalPanelViewSpec
#name: 'VerticalPanel1'
#layout: #(#LayoutFrame 0 0.0 34 0.0 0 1.0 -31 1.0)
#horizontalLayout: #fit
#verticalLayout: #fit
#horizontalSpace: 3
#verticalSpace: 3
#component:
#(#SpecCollection
#collection: #(
#(#ViewSpec
#name: 'Box1'
#visibilityChannel: #classesWithoutContainerBoxVisible
#component:
#(#SpecCollection
#collection: #(
#(#DividerSpec
#name: 'Separator1'
#layout: #(#LayoutFrame 0 0.0 0 0 0 1.0 4 0)
)
#(#LabelSpec
#label: 'Classes without Repository Container:'
#name: 'Label2'
#layout: #(#LayoutFrame 0 0.0 5 0 0 1.0 27 0)
#translateLabel: true
#adjust: #left
#menu: #classesWithMissingContainerPopupMenu
#performer: #dialogMenuPerformer
)
#(#SequenceViewSpec
#name: 'List1'
#layout: #(#LayoutFrame 0 0.0 28 0 0 1.0 0 1)
#model: #selectedClassesWithMissingContainer
#menu: #classesWithMissingContainerPopupMenu
#performer: #dialogMenuPerformer
#hasHorizontalScrollBar: true
#hasVerticalScrollBar: true
#isMultiSelect: true
#useIndex: true
#sequenceList: #listOfClassesWithMissingContainer
)
)
)
#extent: #(#Point 300 74)
)
#(#ViewSpec
#name: 'Box2'
#visibilityChannel: #classesWithInvalidInfoBoxVisible
#component:
#(#SpecCollection
#collection: #(
#(#DividerSpec
#name: 'Separator2'
#layout: #(#LayoutFrame 0 0.0 0 0 0 1.0 4 0)
)
#(#LabelSpec
#label: 'Classes with Invalid Repository Info:'
#name: 'Label3'
#layout: #(#LayoutFrame 0 0.0 5 0 0 1.0 27 0)
#translateLabel: true
#adjust: #left
#menu: #classesWithInvalidInfoPopupMenu
#performer: #dialogMenuPerformer
)
#(#SequenceViewSpec
#name: 'List2'
#layout: #(#LayoutFrame 0 0.0 28 0 0 1.0 0 1)
#model: #selectedClassesWithRepositoryMismatches
#menu: #classesWithInvalidInfoPopupMenu
#performer: #dialogMenuPerformer
#hasHorizontalScrollBar: true
#hasVerticalScrollBar: true
#isMultiSelect: true
#useIndex: true
#sequenceList: #listOfClassesWithRepositoryMismatches
)
)
)
#extent: #(#Point 300 74)
)
#(#ViewSpec
#name: 'Box3'
#visibilityChannel: #obsoleteContainersBoxVisible
#component:
#(#SpecCollection
#collection: #(
#(#DividerSpec
#name: 'Separator3'
#layout: #(#LayoutFrame 0 0.0 0 0 0 1.0 4 0)
)
#(#LabelSpec
#label: 'Containers without class: (need checkOut ?)'
#name: 'Label4'
#layout: #(#LayoutFrame 0 0.0 5 0 0 1.0 27 0)
#translateLabel: true
#adjust: #left
#menu: #obsoleteContainersPopupMenu
#performer: #dialogMenuPerformer
)
#(#SequenceViewSpec
#name: 'List3'
#layout: #(#LayoutFrame 0 0.0 28 0 0 1.0 0 1)
#model: #selectedObsoleteContainers
#menu: #obsoleteContainersPopupMenu
#performer: #dialogMenuPerformer
#hasHorizontalScrollBar: true
#hasVerticalScrollBar: true
#isMultiSelect: true
#useIndex: true
#sequenceList: #listOfObsoleteContainers
)
)
)
#extent: #(#Point 300 73)
)
#(#ViewSpec
#name: 'Box4'
#visibilityChannel: #classesWhichHaveBeenModifiedBoxVisible
#component:
#(#SpecCollection
#collection: #(
#(#DividerSpec
#name: 'Separator4'
#layout: #(#LayoutFrame 0 0.0 0 0 0 1.0 4 0)
)
#(#LabelSpec
#label: 'Modified Classes (need checkIn ?):'
#name: 'Label5'
#layout: #(#LayoutFrame 0 0.0 5 0 0 1.0 27 0)
#translateLabel: true
#adjust: #left
#menu: #classesWhichHaveBeenModifiedPopupMenu
#performer: #dialogMenuPerformer
)
#(#SequenceViewSpec
#name: 'List4'
#layout: #(#LayoutFrame 0 0.0 28 0 0 1.0 0 1)
#model: #selectedClassesWhichHaveBeenModified
#menu: #classesWhichHaveBeenModifiedPopupMenu
#performer: #dialogMenuPerformer
#hasHorizontalScrollBar: true
#hasVerticalScrollBar: true
#isMultiSelect: true
#useIndex: true
#sequenceList: #listOfClassesWhichHaveBeenModified
)
)
)
#extent: #(#Point 300 74)
)
#(#ViewSpec
#name: 'Box5'
#visibilityChannel: #classesWithNewerVersionInRepositoryBoxVisible
#component:
#(#SpecCollection
#collection: #(
#(#DividerSpec
#name: 'Separator5'
#layout: #(#LayoutFrame 0 0.0 0 0 0 1.0 4 0)
)
#(#LabelSpec
#label: 'New Version in Repository (need checkOut ?):'
#name: 'Label6'
#layout: #(#LayoutFrame 0 0.0 5 0 0 1.0 27 0)
#translateLabel: true
#adjust: #left
#menu: #classesWithNewerVersionInRepositoryPopupMenu
#performer: #dialogMenuPerformer
)
#(#SequenceViewSpec
#name: 'List5'
#layout: #(#LayoutFrame 0 0.0 28 0 0 1.0 0 1)
#model: #selectedClassesWithNewerVersionInRepository
#menu: #classesWithNewerVersionInRepositoryPopupMenu
#performer: #dialogMenuPerformer
#hasHorizontalScrollBar: true
#hasVerticalScrollBar: true
#isMultiSelect: true
#useIndex: true
#sequenceList: #listOfClassesWithNewerVersionInRepository
)
)
)
#extent: #(#Point 300 74)
)
)
)
)
#(#HorizontalPanelViewSpec
#name: 'HorizontalPanel1'
#layout: #(#LayoutFrame 0 0 -30 1 0 1 0 1)
#horizontalLayout: #center
#verticalLayout: #center
#horizontalSpace: 3
#verticalSpace: 3
#component:
#(#SpecCollection
#collection: #(
#(#ActionButtonSpec
#label: 'Close'
#name: 'Button1'
#translateLabel: true
#model: #closeRequest
#extent: #(#Point 125 22)
)
)
)
)
)
)
)
! !
!NewSystemBrowser class methodsFor:'menu specs'!
browseMenu
"This resource specification was automatically generated
by the MenuEditor of ST/X."
"Do not manually edit this!! If it is corrupted,
the MenuEditor may not be able to read the specification."
"
MenuEditor new openOnClass:Tools::NewSystemBrowser andSelector:#browseMenu
(Menu new fromLiteralArrayEncoding:(Tools::NewSystemBrowser browseMenu)) startUp
"
<resource: #menu>
^
#(Menu
(
(MenuItem
label: 'Clone'
itemValue: browseMenuClone
translateLabel: true
isVisible: shiftNotPressedHolder
shortcutKey: Ctrln
)
(MenuItem
label: 'Old SystemBrowser on Class'
itemValue: browseMenuClone
translateLabel: true
isVisible: shiftPressedHolder
)
(MenuItem
label: '-'
isVisible: false
)
(MenuItem
label: 'Class...'
itemValue: browseMenuOpenInClass
translateLabel: true
)
(MenuItem
label: 'Classes'
translateLabel: true
submenu:
(Menu
(
(MenuItem
label: 'With Name Matching...'
itemValue: browseMenuClassesWithNameMatching
translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
label: '-'
)
(MenuItem
label: 'In Current ChangeSet'
itemValue: browseMenuClassesInCurrentChangeSet
translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
label: 'In All ChangeSets'
itemValue: browseMenuClassesInAllChangeSets
translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
label: 'Which were Autoloaded'
itemValue: browseMenuAutoloadedClasses
translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
label: 'With Extensions'
itemValue: browseMenuClassesWithExtensions
translateLabel: true
showBusyCursorWhilePerforming: true
isVisible: false
)
(MenuItem
label: '-'
)
(MenuItem
label: 'All Subclasses of...'
itemValue: browseMenuAllSubclassesOf
translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
label: 'All Applications'
itemValue: browseMenuApplicationClasses
translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
label: 'All Web Services'
itemValue: browseMenuHTTPServiceClasses
translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
label: 'All TestCases'
itemValue: browseMenuTestCaseClasses
translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
label: '-'
)
(MenuItem
label: 'Without Documentation'
itemValue: browseMenuClassesWithoutDocumentation
translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
label: 'Without Copyright'
itemValue: browseMenuClassesWithoutCopyright
translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
label: 'Without Examples'
itemValue: browseMenuClassesWithoutExamples
translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
label: 'Without CVS Repository Container'
itemValue: browseMenuClassesWithoutCVSRepositoryContainer
translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
label: 'Without SVN Repository Container'
itemValue: browseMenuClassesWithoutSVNRepositoryContainer
translateLabel: true
isVisible: hasSubversionSupport
showBusyCursorWhilePerforming: true
)
(MenuItem
label: '-'
)
(MenuItem
label: 'Defining Variable...'
itemValue: browseMenuClassesDefiningVariable
translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
label: 'With String in Comment/Documentation...'
itemValue: browseMenuClassesWithStringInCommentOrDocumentation
translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
label: 'With External Function Calls (FFI)'
itemValue: browseMenuClassesWithExternalFunctionCalls
translateLabel: true
showBusyCursorWhilePerforming: true
isVisible: false
)
(MenuItem
label: 'With Primitive Code'
itemValue: browseMenuClassesWithPrimitiveCode
translateLabel: true
showBusyCursorWhilePerforming: true
isVisible: false
)
(MenuItem
label: '-'
)
(MenuItem
label: 'For which...'
itemValue: browseMenuClassesWithUserFilter
translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
label: '-'
)
(MenuItem
label: 'Special'
translateLabel: true
submenuChannel: specialBrowseMenu
)
)
nil
nil
)
)
(MenuItem
label: '-'
)
(MenuItem
label: 'Implementors of...'
itemValue: browseMenuImplementorsOf
translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
label: 'Senders of...'
itemValue: browseSendersOf
translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
label: '-'
)
(MenuItem
label: 'References to Class or Global...'
itemValue: browseMenuReferencesToGlobal
translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
label: 'References to Symbol...'
itemValue: browseMenuReferencesToSymbol
translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
label: '-'
)
(MenuItem
label: 'Recently Changed Methods'
itemValue: browseMenuRecentChanges
translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
label: 'Class Extensions'
itemValue: browseMenuClassExtensionsBuffer
translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
label: 'Methods'
translateLabel: true
submenu:
(Menu
(
(MenuItem
label: 'Changed Methods'
itemValue: browseMenuMethodsInCurrentChangeSet
translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
label: 'Overwritten Methods'
itemValue: browseMenuOverwrittenMethods:
translateLabel: true
isVisible: false
argument: newBrowser
showBusyCursorWhilePerforming: true
)
(MenuItem
label: 'Unassigned Extensions'
itemValue: browseMenuUnassignedMethods:
translateLabel: true
argument: newBrowser
showBusyCursorWhilePerforming: true
)
(MenuItem
label: 'With Break- or Tracepoint'
itemValue: browseMenuMethodsWithWrap
translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
label: '-'
)
(MenuItem
label: 'With String...'
itemValue: browseMenuMethodsWithString
translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
label: 'With String in Help Spec...'
itemValue: browseMenuMethodsWithStringInHelpSpec
translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
label: 'With String in Menu Spec...'
itemValue: browseMenuMethodsWithStringInMenuSpec
translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
label: 'With String-Literal Matching...'
itemValue: browseMenuMethodsWithStringLiteral
translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
label: '-'
)
(MenuItem
label: 'With Window Spec...'
itemValue: browseMenuMethodsWithWindowSpec
translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
label: 'With Menu Spec...'
itemValue: browseMenuMethodsWithMenuSpec
translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
label: 'With Image Spec...'
itemValue: browseMenuMethodsWithImageSpec
translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
label: 'With Table Spec...'
itemValue: browseMenuMethodsWithTableSpec
translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
label: 'With Help Spec...'
itemValue: browseMenuMethodsWithHelpSpec
translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
label: 'With any Resource...'
itemValue: browseMenuMethodsWithResource
translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
label: '-'
)
(MenuItem
label: 'Without Comment...'
itemValue: browseMenuMethodsWithoutComment
translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
label: 'With Ugly Coding Style...'
itemValue: browseMenuMethodsWithUglyCodingStyle
translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
label: 'With Possible Leftover Debug Code...'
itemValue: browseMenuMethodsWithLeftoverDebugCode
translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
label: 'Deprecated'
itemValue: browseMenuDeprecatedMethods
translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
label: '-'
)
(MenuItem
label: 'With Exception Handlers'
itemValue: browseMenuMethodsWithExceptionHandlers
translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
label: 'With Exception Raisers'
itemValue: browseMenuMethodsWithExceptionRaisers
translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
label: 'With Primitive Code'
itemValue: browseMenuMethodsWithPrimitiveCode
translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
label: 'With External Function Calls (FFI)'
itemValue: browseMenuMethodsWithExternalFunctionCalls
translateLabel: true
showBusyCursorWhilePerforming: true
isVisible: false
)
(MenuItem
label: '-'
)
(MenuItem
label: 'For which...'
itemValue: browseMenuMethodsWithUserFilter
translateLabel: true
showBusyCursorWhilePerforming: true
)
)
nil
nil
)
)
)
nil
nil
)
"Modified: / 11-05-2010 / 18:21:14 / cg"
!
bufferBaseMenu
"This resource specification was automatically generated
by the MenuEditor of ST/X."
"Do not manually edit this!! If it is corrupted,
the MenuEditor may not be able to read the specification."
"
MenuEditor new openOnClass:Tools::NewSystemBrowser andSelector:#bufferBaseMenu
(Menu new fromLiteralArrayEncoding:(Tools::NewSystemBrowser bufferBaseMenu)) startUp
"
<resource: #menu>
^
#(Menu
(
(MenuItem
label: 'Add Page'
itemValue: bufferMenuCreateBuffer
nameKey: CreateBuffer
translateLabel: true
shortcutKey: Ctrlt
)
(MenuItem
label: 'Remove Page'
itemValue: bufferMenuRemoveCurrentBuffer
nameKey: RemoveBuffer
translateLabel: true
)
)
nil
nil
)
"Modified: / 03-08-2004 / 14:28:02 / stefan"
!
categoryMenu
"This resource specification was automatically generated
by the MenuEditor of ST/X."
"Do not manually edit this!! If it is corrupted,
the MenuEditor may not be able to read the specification."
"
MenuEditor new openOnClass:Tools::NewSystemBrowser andSelector:#categoryMenu
(Menu new fromLiteralArrayEncoding:(Tools::NewSystemBrowser categoryMenu)) startUp
"
<resource: #menu>
^
#(Menu
(
(MenuItem
label: 'FileOutAndRepositorySlice'
translateLabel: true
submenuChannel: categoryMenuFileOutAndRepositorySlice
isMenuSlice: true
)
(MenuItem
label: '-'
)
(MenuItem
label: 'DocumentationSlice'
translateLabel: true
submenuChannel: categoryMenuDocumentationSlice
isMenuSlice: true
)
(MenuItem
label: '-'
)
(MenuItem
label: 'SpawnSlice'
translateLabel: true
submenuChannel: categoryMenuSpawnSlice
isMenuSlice: true
)
(MenuItem
label: '-'
)
(MenuItem
label: 'Menu Slice'
nameKey: NewAndRenameSlice
translateLabel: true
submenuChannel: categoryMenuNewAndRenameSlice
isMenuSlice: true
)
(MenuItem
label: '-'
)
(MenuItem
label: 'Special'
translateLabel: true
submenuChannel: categorySpecialMenu
)
(MenuItem
label: '-'
)
(MenuItem
label: 'Update'
itemValue: categoryMenuUpdate
translateLabel: true
)
)
nil
nil
)
!
categoryMenuDocumentationSlice
"This resource specification was automatically generated
by the MenuEditor of ST/X."
"Do not manually edit this!! If it is corrupted,
the MenuEditor may not be able to read the specification."
"
MenuEditor new openOnClass:Tools::NewSystemBrowser andSelector:#categoryMenuDocumentationSlice
(Menu new fromLiteralArrayEncoding:(Tools::NewSystemBrowser categoryMenuDocumentationSlice)) startUp
"
<resource: #menu>
^
#(Menu
(
(MenuItem
enabled: hasCategorySelectedHolder
label: 'Documentation'
translateLabel: true
submenu:
(Menu
(
(MenuItem
enabled: hasCategorySelectedHolder
label: 'PrintOut'
itemValue: categoryMenuPrintOut
translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasCategorySelectedHolder
label: 'PrintOut Protocol'
itemValue: categoryMenuPrintOutProtocol
translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasCategorySelectedHolder
label: 'Save HTML Documentation In...'
itemValue: categoryMenuSaveDocumentationIn
translateLabel: true
showBusyCursorWhilePerforming: true
)
)
nil
nil
)
)
)
nil
nil
)
!
categoryMenuFileOutAndRepositorySlice
"This resource specification was automatically generated
by the MenuEditor of ST/X."
"Do not manually edit this!! If it is corrupted,
the MenuEditor may not be able to read the specification."
"
MenuEditor new openOnClass:Tools::NewSystemBrowser andSelector:#categoryMenuFileOutAndRepositorySlice
(Menu new fromLiteralArrayEncoding:(Tools::NewSystemBrowser categoryMenuFileOutAndRepositorySlice)) startUp
"
<resource: #menu>
^
#(Menu
(
(MenuItem
enabled: hasCategorySelectedHolder
label: 'FileOut'
translateLabel: true
submenu:
(Menu
(
(MenuItem
enabled: hasCategorySelectedHolder
label: 'as...'
itemValue: categoryMenuFileOutAs
translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasCategorySelectedAndCanFileOutXMLHolder
label: 'XML as...'
itemValue: categoryMenuFileOutXMLAs
translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasCategorySelectedAndCanFileOutSIFHolder
label: 'SIF as...'
itemValue: categoryMenuFileOutSIFAs
translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasCategorySelectedHolder
label: 'Each in...'
itemValue: categoryMenuFileOutEachIn
translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasCategorySelectedAndCanFileOutXMLHolder
label: 'Each XML in...'
itemValue: categoryMenuFileOutEachXMLIn
translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasCategorySelectedAndCanFileOutSIFHolder
label: 'Each SIF in...'
itemValue: categoryMenuFileOutEachSIFIn
translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasCategorySelectedHolder
label: 'Each Binary in...'
itemValue: categoryMenuFileOutEachBinaryIn
translateLabel: true
showBusyCursorWhilePerforming: true
)
)
nil
nil
)
)
(MenuItem
enabled: hasSourceCodeManagerHolder
label: 'CVS'
translateLabel: true
submenu:
(Menu
(
(MenuItem
enabled: hasCategorySelectedAndSourceCodeManagerHolder
label: 'CheckIn all...'
itemValue: categoryMenuCheckInEach
translateLabel: true
labelImage: (ResourceRetriever ToolbarIconLibrary repositoryCheckIn 'CheckIn all...')
showBusyCursorWhilePerforming: true
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasCategorySelectedAndSourceCodeManagerHolder
label: 'CheckOut Newest All'
itemValue: categoryMenuCheckOutNewest
translateLabel: true
labelImage: (ResourceRetriever ToolbarIconLibrary repositoryCheckOut 'CheckOut Newest All')
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasCategorySelectedAndSourceCodeManagerHolder
label: 'CheckOut Previous Versions All...'
itemValue: categoryMenuCheckOut
translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasSourceCodeManagerHolder
label: 'Repository History...'
itemValue: categoryMenuRepositoryHistory
translateLabel: true
showBusyCursorWhilePerforming: true
labelImage: (ResourceRetriever ToolbarIconLibrary repositoryLog 'Repository History...')
)
)
nil
nil
)
labelImage: (ResourceRetriever ToolbarIconLibrary repositoryCVSIcon 'CVS')
)
)
nil
nil
)
!
categoryMenuNewAndRenameSlice
"This resource specification was automatically generated
by the MenuEditor of ST/X."
"Do not manually edit this!! If it is corrupted,
the MenuEditor may not be able to read the specification."
"
MenuEditor new openOnClass:Tools::NewSystemBrowser andSelector:#categoryMenuNewAndRenameSlice
(Menu new fromLiteralArrayEncoding:(Tools::NewSystemBrowser categoryMenuNewAndRenameSlice)) startUp
"
<resource: #menu>
^
#(Menu
(
(MenuItem
label: 'New...'
itemValue: categoryMenuNewCategory
translateLabel: true
)
(MenuItem
enabled: hasCategorySelectedHolder
label: 'Rename...'
itemValue: categoryMenuRename
translateLabel: true
shortcutKey: #Rename
ignoreShortcutKeys: true
)
(MenuItem
enabled: hasCategorySelectedHolder
label: 'Remove...'
itemValue: categoryMenuRemove
translateLabel: true
)
)
nil
nil
)
!
categoryMenuSpawnSlice
"This resource specification was automatically generated
by the MenuEditor of ST/X."
"Do not manually edit this!! If it is corrupted,
the MenuEditor may not be able to read the specification."
"
MenuEditor new openOnClass:Tools::NewSystemBrowser andSelector:#categoryMenuSpawnSlice
(Menu new fromLiteralArrayEncoding:(Tools::NewSystemBrowser categoryMenuSpawnSlice)) startUp
"
<resource: #menu>
^
#(Menu
(
(MenuItem
enabled: hasCategorySelectedHolder
label: 'Spawn'
translateLabel: true
submenu:
(Menu
(
(MenuItem
enabled: hasCategorySelectedHolder
label: 'Buffer'
itemValue: categoryMenuSpawnBuffer
translateLabel: true
)
(MenuItem
label: 'Buffer with Categories Matching...'
itemValue: categoryMenuSpawnMatchingCategoriesBuffer
translateLabel: true
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasCategorySelectedHolder
label: 'Browser'
itemValue: categoryMenuSpawnBrowser
translateLabel: true
)
(MenuItem
label: 'Browser on Categories Matching...'
itemValue: categoryMenuSpawnMatchingCategoriesBrowser
translateLabel: true
)
)
nil
nil
)
)
)
nil
nil
)
!
categoryMenuWithFind
"This resource specification was automatically generated
by the MenuEditor of ST/X."
"Do not manually edit this!! If it is corrupted,
the MenuEditor may not be able to read the specification."
"
MenuEditor new openOnClass:Tools::NewSystemBrowser andSelector:#categoryMenuWithFind
(Menu new fromLiteralArrayEncoding:(Tools::NewSystemBrowser categoryMenuWithFind)) startUp
"
<resource: #menu>
^
#(Menu
(
(MenuItem
label: 'FileOutAndRepositorySlice'
translateLabel: true
submenuChannel: categoryMenuFileOutAndRepositorySlice
isMenuSlice: true
)
(MenuItem
label: '-'
)
(MenuItem
label: 'DocumentationSlice'
translateLabel: true
submenuChannel: categoryMenuDocumentationSlice
isMenuSlice: true
)
(MenuItem
label: '-'
)
(MenuItem
label: 'SpawnSlice'
translateLabel: true
submenuChannel: categoryMenuSpawnSlice
isMenuSlice: true
)
(MenuItem
label: 'Find'
translateLabel: true
submenuChannel: searchMenu
)
(MenuItem
label: '-'
)
(MenuItem
label: 'NewAndRenameSlice'
translateLabel: true
submenuChannel: categoryMenuNewAndRenameSlice
isMenuSlice: true
)
(MenuItem
label: '-'
)
(MenuItem
label: 'Special'
translateLabel: true
submenuChannel: categorySpecialMenu
)
(MenuItem
label: '-'
)
(MenuItem
label: 'Update'
itemValue: categoryMenuUpdate
translateLabel: true
)
)
nil
nil
)
!
categorySpecialMenu
"This resource specification was automatically generated
by the MenuEditor of ST/X."
"Do not manually edit this!! If it is corrupted,
the MenuEditor may not be able to read the specification."
"
MenuEditor new openOnClass:Tools::NewSystemBrowser andSelector:#categorySpecialMenu
(Menu new fromLiteralArrayEncoding:(Tools::NewSystemBrowser categorySpecialMenu)) startUp
"
<resource: #menu>
^
#(Menu
(
(MenuItem
enabled: hasAnyCategoryWithAnyUnLoadedClassSelectedHolder
label: 'Load'
itemValue: categoryMenuLoad
translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasAnyCategoryWithAnyAutoLoadedClassSelectedHolder
label: 'Unload'
itemValue: categoryMenuUnload
translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasCategorySelectedHolder
label: 'Remove all from ChangeSet'
itemValue: categoryMenuCleanUpChangeSet
translateLabel: true
)
)
nil
nil
)
"Modified: / 31-01-2011 / 11:11:18 / cg"
!
checkMenu
"This resource specification was automatically generated
by the MenuEditor of ST/X."
"Do not manually edit this!! If it is corrupted,
the MenuEditor may not be able to read the specification."
"
MenuEditor new openOnClass:Tools::NewSystemBrowser andSelector:#checkMenu
(Menu new fromLiteralArrayEncoding:(Tools::NewSystemBrowser checkMenu)) startUp
"
<resource: #menu>
^
#(Menu
(
(MenuItem
label: 'Lint'
translateLabel: true
submenuChannel: lintMenu
keepLinkedMenu: true
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasClassSelectedAndInstrumentingCompilerExistsHolder
label: 'Recompile all Methods with Instrumentation'
itemValue: classMenuRecompileInstrumented
translateLabel: true
showBusyCursorWhilePerforming: true
)
)
nil
nil
)
!
classClassVariablesMenu
"This resource specification was automatically generated
by the MenuEditor of ST/X."
"Do not manually edit this!! If it is corrupted,
the MenuEditor may not be able to read the specification."
"
MenuEditor new openOnClass:NewSystemBrowser andSelector:#classClassVariablesMenu
(Menu new fromLiteralArrayEncoding:(NewSystemBrowser classClassVariablesMenu)) startUp
"
<resource: #menu>
^
#(#Menu
#(
#(#MenuItem
#label: 'References...'
#translateLabel: true
#value: #variablesMenuBrowseAllClassVarRefs
#enabled: #hasClassSelectedHolder
#showBusyCursorWhilePerforming: true
)
#(#MenuItem
#label: 'Readers...'
#translateLabel: true
#value: #variablesMenuBrowseAllClassVarReads
#enabled: #hasClassSelectedHolder
#showBusyCursorWhilePerforming: true
)
#(#MenuItem
#label: 'Writers...'
#translateLabel: true
#value: #variablesMenuBrowseAllClassVarMods
#enabled: #hasClassSelectedHolder
#showBusyCursorWhilePerforming: true
)
#(#MenuItem
#label: '-'
)
#(#MenuItem
#label: 'Add...'
#translateLabel: true
#value: #variablesMenuAddClassVariable
#enabled: #hasSingleClassSelectedAndCanUseRefactoringSupportHolder
#showBusyCursorWhilePerforming: true
)
#(#MenuItem
#label: 'Rename...'
#translateLabel: true
#value: #variablesMenuRenameClassVariable
#enabled: #hasSingleClassAndClassVariableSelectedAndCanUseRefactoringSupportHolder
#showBusyCursorWhilePerforming: true
)
#(#MenuItem
#label: 'Remove'
#translateLabel: true
#value: #variablesMenuRemoveClassVariable
#enabled: #hasSingleClassAndClassVariableSelectedAndCanUseRefactoringSupportHolder
#showBusyCursorWhilePerforming: true
)
#(#MenuItem
#label: '-'
)
#(#MenuItem
#label: 'Pull Up'
#translateLabel: true
#value: #codeMenuPullUpClassVariable
#enabled: #hasClassVariableSelectedInCodeViewOrVariableListAndCanUseRefactoringSupportHolder
#showBusyCursorWhilePerforming: true
)
#(#MenuItem
#label: 'Push Down'
#translateLabel: true
#value: #codeMenuPushDownClassVariable
#enabled: #hasClassVariableSelectedInCodeViewOrVariableListAndCanUseRefactoringSupportHolder
#showBusyCursorWhilePerforming: true
)
#(#MenuItem
#label: '-'
)
#(#MenuItem
#label: 'Make Abstract (Access only via Getters/Setters)'
#translateLabel: true
#value: #codeMenuMakeAbstractVariable
#enabled: #hasClassVariableSelectedInCodeViewOrVariableListAndCanUseRefactoringSupportHolder
#showBusyCursorWhilePerforming: true
)
#(#MenuItem
#label: 'Make Concrete (Protect from Access via Getters/Setters)'
#translateLabel: true
#value: #codeMenuProtectInstanceVariable
#enabled: #hasClassVariableSelectedInCodeViewOrVariableListAndCanUseRefactoringSupportHolder
#showBusyCursorWhilePerforming: true
)
"/ #(#MenuItem
"/ #label: 'Type info...'
"/ #translateLabel: true
"/ #value: #variablesMenuClassVariableTypeInfo
"/ #enabled: #hasSingleVariableSelectedHolder
"/ #showBusyCursorWhilePerforming: true
"/ )
)
nil
nil
)
!
classDebugMenu
"This resource specification was automatically generated
by the MenuEditor of ST/X."
"Do not manually edit this!! If it is corrupted,
the MenuEditor may not be able to read the specification."
"
MenuEditor new openOnClass:Tools::NewSystemBrowser andSelector:#classDebugMenu
(Menu new fromLiteralArrayEncoding:(Tools::NewSystemBrowser classDebugMenu)) startUp
"
<resource: #menu>
^
#(Menu
(
(MenuItem
enabled: hasClassSelectedHolder
label: 'Inspect Class'
itemValue: classMenuInspectClass
translateLabel: true
isVisible: hasNotMultipleClassesSelectedHolder
)
(MenuItem
enabled: hasClassSelectedHolder
label: 'Inspect Classes'
itemValue: classMenuInspectClass
translateLabel: true
isVisible: hasMultipleClassesSelectedHolder
)
(MenuItem
enabled: hasClassSelectedHolder
label: 'Inspect Subclasses'
itemValue: classMenuInspectSubclasses
translateLabel: true
isVisible: hasNotMultipleClassesSelectedHolder
)
(MenuItem
enabled: hasClassSelectedHolder
label: 'Inspect Instances'
itemValue: classMenuInspectInstances
translateLabel: true
)
(MenuItem
enabled: hasClassSelectedHolder
label: 'Inspect Derived Instances'
itemValue: classMenuInspectDerivedInstances
translateLabel: true
)
(MenuItem
enabled: hasClassSelectedHolder
label: 'Inspect References to Instances'
itemValue: classMenuInspectReferencesToInstances
translateLabel: true
)
(MenuItem
label: '-'
)
(MenuItem
label: 'Lint'
translateLabel: true
submenuChannel: lintMenu
keepLinkedMenu: true
)
(MenuItem
enabled: hasClassSelectedHolder
label: 'Recompile all Methods'
itemValue: classMenuRecompile
translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasClassSelectedAndInstrumentingCompilerExistsHolder
label: 'Recompile all Methods with Instrumentation'
itemValue: classMenuRecompileInstrumented
translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasClassSelectedAndInstrumentingCompilerExistsAndOOMPackageLoadedHolder
label: 'Call Graph'
itemValue: debugMenuOpenCallGraphForClasses
translateLabel: true
showBusyCursorWhilePerforming: true
)
)
nil
nil
)
"Modified: / 27-04-2010 / 14:06:28 / cg"
!
classGenerateMenu
"This resource specification was automatically generated
by the MenuEditor of ST/X."
"Do not manually edit this!! If it is corrupted,
the MenuEditor may not be able to read the specification."
"
MenuEditor new openOnClass:Tools::NewSystemBrowser andSelector:#classGenerateMenu
(Menu new fromLiteralArrayEncoding:(Tools::NewSystemBrowser classGenerateMenu)) startUp
"
<resource: #menu>
^
#(Menu
(
(MenuItem
label: 'AccessMethodsSlice'
translateLabel: true
submenuChannel: classGenerateMenuAccessMethodsSlice
isMenuSlice: true
)
(MenuItem
label: 'CommonInstMethodsSlice'
translateLabel: true
submenuChannel: classGenerateMenuCommonInstMethodsSlice
isMenuSlice: true
)
(MenuItem
enabled: hasLoadedClassSelectedHolder
label: 'Documentation Stubs'
itemValue: classMenuGenerateDocumentationStubs
translateLabel: true
)
(MenuItem
enabled: hasSingleLoadedClassWithCommentSelectedHolder
label: 'Documentation Method from Comment'
itemValue: classMenuGenerateDocumentationMethodFromComment
translateLabel: true
)
(MenuItem
enabled: hasLoadedClassSelectedHolder
label: 'Copyright Method'
itemValue: classMenuGenerateCopyrightMethod
translateLabel: true
)
(MenuItem
label: '-'
isVisible: hasClassSelectedHolder
)
(MenuItem
label: 'Project Definitions'
itemValue: classMenuGenerateProjectDefinitions
translateLabel: true
isVisible: hasProjectDefinitionSelectedHolder
)
(MenuItem
label: 'Update Project Contents Definitions'
itemValue: classMenuUpdateProjectContentsDefinitions
translateLabel: true
isVisible: hasProjectDefinitionSelectedHolder
)
(MenuItem
label: 'Regenerate Project Contents Definitions'
itemValue: classMenuRegenerateProjectContentsDefinitions
translateLabel: true
isVisible: hasProjectDefinitionSelectedHolder
)
(MenuItem
enabled: hasSingleLoadedClassSelectedHolder
label: 'Initialized Instance Creation'
itemValue: classMenuGenerateInitializedInstanceCreationMethods
translateLabel: true
isVisible: hasNonProjectDefinitionSelectedHolder
)
(MenuItem
enabled: hasSingleLoadedClassSelectedHolder
label: 'Parametrized Instance Creation'
itemValue: classMenuGenerateParametrizedInstanceCreationMethods
translateLabel: true
isVisible: hasNonProjectDefinitionSelectedHolder
)
(MenuItem
enabled: hasSingleLoadedClassSelectedHolder
label: 'Redefined Instance Creation'
itemValue: classMenuGenerateRedefinedInstanceCreationMethods
translateLabel: true
isVisible: hasNonProjectDefinitionSelectedHolder
)
(MenuItem
enabled: hasApplicationOrHTTPServiceClassSelectedHolder
label: 'Application Code'
itemValue: classMenuGenerateApplicationCode
translateLabel: true
isVisible: hasNonProjectDefinitionSelectedHolder
)
(MenuItem
enabled: hasEnumTypeClassSelectedHolder
label: 'EnumType Code'
itemValue: classMenuGenerateEnumTypeCode
translateLabel: true
isVisible: hasNonProjectDefinitionSelectedHolder
)
(MenuItem
enabled: hasSharedPoolClassSelectedHolder
label: 'SharedPool Initialization Code'
itemValue: classMenuGeneratePoolInitializationCode
translateLabel: true
isVisible: hasNonProjectDefinitionSelectedHolder
)
(MenuItem
enabled: hasLoadedClassSelectedHolder
label: 'Class Initialization Code'
itemValue: classMenuGenerateClassInitializationCode
translateLabel: true
isVisible: hasNonProjectDefinitionSelectedHolder
)
(MenuItem
enabled: hasLoadedClassSelectedHolder
label: 'Required Protocol'
itemValue: classMenuGenerateRequiredProtocol
translateLabel: true
isVisible: hasNonProjectDefinitionSelectedHolder
)
)
nil
nil
)
!
classGenerateMenuAccessMethodsSlice
"This resource specification was automatically generated
by the MenuEditor of ST/X."
"Do not manually edit this!! If it is corrupted,
the MenuEditor may not be able to read the specification."
"
MenuEditor new openOnClass:Tools::NewSystemBrowser andSelector:#classGenerateMenu
(Menu new fromLiteralArrayEncoding:(Tools::NewSystemBrowser classGenerateMenu)) startUp
"
<resource: #menu>
^
#(Menu
(
(MenuItem
enabled: hasSingleLoadedClassSelectedHolder
label: 'Access Methods'
itemValue: classMenuGenerateAccessMethods
translateLabel: true
)
(MenuItem
enabled: hasSingleLoadedClassSelectedHolder
label: 'Getter Method(s)'
itemValue: classMenuGenerateGetterMethods
translateLabel: true
)
(MenuItem
enabled: hasSingleLoadedClassSelectedHolder
label: 'Setter Method(s)'
itemValue: classMenuGenerateSetterMethods
translateLabel: true
)
(MenuItem
enabled: hasSingleLoadedClassSelectedAndMultipleVariablesSelectedHolder
label: 'Multi-Setter Method'
itemValue: classMenuGenerateMultiSetterMethod
translateLabel: true
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasSingleLoadedClassSelectedHolder
label: 'Access Methods with Lazy Initialization in Getter'
itemValue: classMenuGenerateAccessMethodsWithLazyInitialization
translateLabel: true
isVisible: hasNonMetaSelectedHolder
)
(MenuItem
enabled: hasSingleLoadedClassSelectedHolder
label: 'Access Methods with Change Notification'
itemValue: classMenuGenerateAccessMethodsWithChange
translateLabel: true
isVisible: hasNonMetaSelectedHolder
)
(MenuItem
enabled: hasSingleLoadedClassSelectedHolder
label: 'Access Methods for ValueHolder'
itemValue: classMenuGenerateAccessMethodsForValueHolder
translateLabel: true
isVisible: hasNonMetaSelectedHolder
)
(MenuItem
enabled: hasSingleLoadedClassSelectedHolder
label: 'Access Methods for ValueHolder with Change Notification'
itemValue: classMenuGenerateAccessMethodsForValueHolderWithChange
translateLabel: true
isVisible: hasNonMetaSelectedHolder
)
(MenuItem
label: '-'
isVisible: hasNonMetaSelectedHolder
)
)
nil
nil
)
"Created: / 10-08-2006 / 16:11:12 / cg"
!
classGenerateMenuCommonInstMethodsSlice
"This resource specification was automatically generated
by the MenuEditor of ST/X."
"Do not manually edit this!! If it is corrupted,
the MenuEditor may not be able to read the specification."
"
MenuEditor new openOnClass:Tools::NewSystemBrowser andSelector:#classGenerateMenu
(Menu new fromLiteralArrayEncoding:(Tools::NewSystemBrowser classGenerateMenu)) startUp
"
<resource: #menu>
^
#(Menu
(
(MenuItem
enabled: hasClassSelectedHolder
label: 'Initialize Method'
itemValue: classMenuGenerateInitializationMethod
translateLabel: true
isVisible: hasNonMetaSelectedHolder
sendToOriginator: true
)
(MenuItem
enabled: hasClassSelectedHolder
label: 'PrintOn Method'
itemValue: classMenuGenerateStandardPrintOnMethod
translateLabel: true
isVisible: hasNonMetaSelectedHolder
sendToOriginator: true
)
(MenuItem
enabled: hasClassSelectedHolder
label: 'Update Method Template'
itemValue: classMenuGenerateUpdateMethod
translateLabel: true
isVisible: hasNonMetaSelectedHolder
)
(MenuItem
enabled: hasClassSelectedHolder
label: 'Visitor Method'
itemValue: classMenuGenerateAcceptVisitor
translateLabel: true
isVisible: hasNonMetaSelectedHolder
)
(MenuItem
enabled: hasClassSelectedHolder
label: 'Visitor and Visited Methods'
itemValue: classMenuGenerateVisitorMethods
translateLabel: true
isVisible: hasNonMetaSelectedHolder
)
(MenuItem
enabled: hasClassSelectedHolder
label: 'Classtype Test Methods for this Class (isXXX)'
itemValue: classMenuGenerateClassTypeTestMethodsForThisClass
translateLabel: true
isVisible: hasNonMetaSelectedHolder
)
(MenuItem
enabled: hasClassSelectedHolder
label: 'Classtype Test Methods for all Subclass(es) (isXXX)'
itemValue: classMenuGenerateClassTypeTestMethods
translateLabel: true
isVisible: hasNonMetaSelectedHolder
)
(MenuItem
label: '-'
isVisible: hasNonMetaSelectedHolder
)
)
nil
nil
)
"Created: / 10-08-2006 / 16:17:43 / cg"
!
classHierarchyMenu
"This resource specification was automatically generated
by the MenuEditor of ST/X."
"Do not manually edit this!! If it is corrupted,
the MenuEditor may not be able to read the specification."
"
MenuEditor new openOnClass:NewSystemBrowser andSelector:#categoryMenu
(Menu new fromLiteralArrayEncoding:(NewSystemBrowser categoryMenu)) startUp
"
<resource: #menu>
^
#(#Menu
#(
#(#MenuItem
#label: 'Select Class with Superclasses'
#translateLabel: true
#value: #classHierarchyMenuSelectWithSuperclasses
#enabled: #hasAtMostOneClassesSelectedHolder
)
#(#MenuItem
#label: 'Select Class with Subclasses'
#translateLabel: true
#value: #classHierarchyMenuSelectWithSubclasses
#enabled: #hasAtMostOneClassesSelectedHolder
)
#(#MenuItem
#label: 'Select Class with All Subclasses'
#translateLabel: true
#value: #classHierarchyMenuSelectWithAllSubclasses
#enabled: #hasAtMostOneClassesSelectedHolder
)
#(#MenuItem
#label: '-'
)
#(#MenuItem
#label: 'Update'
#translateLabel: true
#value: #classHierarchyMenuUpdate
#enabled: #hasSingleClassSelected
)
)
nil
nil
)
!
classInstanceVariablesMenu
"This resource specification was automatically generated
by the MenuEditor of ST/X."
"Do not manually edit this!! If it is corrupted,
the MenuEditor may not be able to read the specification."
"
MenuEditor new openOnClass:NewSystemBrowser andSelector:#classInstanceVariablesMenu
(Menu new fromLiteralArrayEncoding:(NewSystemBrowser classInstanceVariablesMenu)) startUp
"
<resource: #menu>
^
#(#Menu
#(
#(#MenuItem
#label: 'References...'
#translateLabel: true
#value: #variablesMenuBrowseAllInstVarOrClassInstVarRefs
#enabled: #hasClassSelectedHolder
#showBusyCursorWhilePerforming: true
)
#(#MenuItem
#label: 'Readers...'
#translateLabel: true
#value: #variablesMenuBrowseAllInstVarOrClassInstVarReads
#enabled: #hasClassSelectedHolder
#showBusyCursorWhilePerforming: true
)
#(#MenuItem
#label: 'Writers...'
#translateLabel: true
#value: #variablesMenuBrowseAllInstVarOrClassInstVarMods
#enabled: #hasClassSelectedHolder
#showBusyCursorWhilePerforming: true
)
#(#MenuItem
#label: '-'
)
#(#MenuItem
#label: 'Add...'
#translateLabel: true
#value: #variablesMenuAddInstanceVariable
#enabled: #hasSingleClassSelectedAndCanUseRefactoringSupportHolder
#showBusyCursorWhilePerforming: true
)
#(#MenuItem
#label: 'Rename...'
#translateLabel: true
#value: #variablesMenuRenameInstanceVariable
#enabled: #hasSingleClassAndSingleVariableSelectedAndCanUseRefactoringSupportHolder
#showBusyCursorWhilePerforming: true
)
#(#MenuItem
#label: 'Remove'
#translateLabel: true
#value: #variablesMenuRemoveInstanceVariable
#enabled: #hasSingleClassAndSingleVariableSelectedAndCanUseRefactoringSupportHolder
#showBusyCursorWhilePerforming: true
)
#(#MenuItem
#label: '-'
)
#(#MenuItem
#label: 'Pull Up'
#translateLabel: true
#value: #codeMenuPullUpInstanceVariable
#enabled: #hasInstanceVariableSelectedInCodeViewOrVariableListAndCanUseRefactoringSupportHolder
#showBusyCursorWhilePerforming: true
)
#(#MenuItem
#label: 'Push Down'
#translateLabel: true
#value: #codeMenuPushDownInstanceVariable
#enabled: #hasInstanceVariableSelectedInCodeViewOrVariableListAndCanUseRefactoringSupportHolder
#showBusyCursorWhilePerforming: true
)
#(#MenuItem
#label: '-'
)
#(#MenuItem
#label: 'Convert to ValueHolder'
#translateLabel: true
#value: #codeMenuConvertToValueHolder
#enabled: #hasInstanceVariableSelectedInCodeViewOrVariableListAndCanUseRefactoringSupportHolder
#showBusyCursorWhilePerforming: true
)
#(#MenuItem
#label: 'Make Abstract (Access only via Getters/Setters)'
#translateLabel: true
#value: #codeMenuMakeAbstractVariable
#enabled: #hasSingleVariableSelectedInCodeViewOrVariableListHolder
#showBusyCursorWhilePerforming: true
)
#(#MenuItem
#label: 'Make Concrete (Protect from Access via Getters/Setters)'
#translateLabel: true
#value: #codeMenuProtectInstanceVariable
#enabled: #hasSingleVariableSelectedInCodeViewOrVariableListHolder
#showBusyCursorWhilePerforming: true
)
"/ #(#MenuItem
"/ #label: 'Type info...'
"/ #translateLabel: true
"/ #value: #variablesMenuInstanceVariableTypeInfo
"/ #enabled: #hasSingleVariableSelectedHolder
"/ #showBusyCursorWhilePerforming: true
"/ )
)
nil
nil
)
!
classMenu
"This resource specification was automatically generated
by the MenuEditor of ST/X."
"Do not manually edit this!! If it is corrupted,
the MenuEditor may not be able to read the specification."
"
MenuEditor new openOnClass:Tools::NewSystemBrowser andSelector:#classMenu
(Menu new fromLiteralArrayEncoding:(Tools::NewSystemBrowser classMenu)) startUp
"
<resource: #menu>
^
#(Menu
(
(MenuItem
enabled: hasClassSelectedHolder
label: 'FileOut'
translateLabel: true
submenu:
(Menu
(
(MenuItem
enabled: hasClassSelectedHolder
label: 'as...'
itemValue: classMenuFileOutAs
translateLabel: true
isVisible: hasSingleClassSelectedHolder
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasClassSelectedAndCanFileOutXMLHolder
label: 'XML as...'
itemValue: classMenuFileOutXMLAs
translateLabel: true
isVisible: hasSingleClassSelectedHolder
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasClassSelectedAndCanFileOutSIFHolder
label: 'SIF as...'
itemValue: classMenuFileOutSIFAs
translateLabel: true
isVisible: hasSingleClassSelectedHolder
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasClassSelectedAndCanFileOutBinaryHolder
label: 'Binary as...'
itemValue: classMenuFileOutBinaryAs
translateLabel: true
isVisible: hasSingleClassSelectedHolder
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasClassSelectedHolder
label: 'Each in...'
itemValue: classMenuFileOutEachIn
translateLabel: true
isVisible: hasMultipleClassesSelectedHolder
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasClassSelectedAndCanFileOutXMLHolder
label: 'Each XML in...'
itemValue: classMenuFileOutEachXMLIn
translateLabel: true
isVisible: hasMultipleClassesSelectedHolder
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasClassSelectedAndCanFileOutSIFHolder
label: 'Each SIF in...'
itemValue: classMenuFileOutEachSIFIn
translateLabel: true
isVisible: hasMultipleClassesSelectedHolder
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasClassSelectedHolder
label: 'Each Binary in...'
itemValue: classMenuFileOutEachBinaryIn
translateLabel: true
isVisible: hasMultipleClassesSelectedHolder
showBusyCursorWhilePerforming: true
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasClassSelectedAndCanSendMailHolder
label: 'Mail To...'
itemValue: classMenuMailTo
translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasClassSelectedHolder
label: 'Copy Source to Clipboard'
itemValue: classMenuCopySourceToClipboard
translateLabel: true
showBusyCursorWhilePerforming: true
)
)
nil
nil
)
)
(MenuItem
enabled: hasClassSelectedAndSourceCodeManagerHolder
label: 'CVS'
translateLabel: true
submenuChannel: classMenuCVS
labelImage: (ResourceRetriever ToolbarIconLibrary repositoryCVSIcon 'CVS')
keepLinkedMenu: true
)
(MenuItem
enabled: hasClassesSelectedAndSubversionRepositoryExistsHolder
label: 'SubVersion'
translateLabel: true
isVisible: hasSubversionSupport
submenuChannel: classMenuSubversion
labelImage: (ResourceRetriever ToolbarIconLibrary repositorySVNIcon 'SubVersion')
)
(MenuItem
label: 'SmallTeam'
translateLabel: true
isVisible: smallTeamAvailable
submenuChannel: classSmallTeamMenu
keepLinkedMenu: true
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasClassSelectedHolder
label: 'Documentation'
translateLabel: true
submenu:
(Menu
(
(MenuItem
enabled: hasClassSelectedHolder
label: 'PrintOut'
itemValue: classMenuPrintOut
translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasClassSelectedHolder
label: 'PrintOut Protocol'
itemValue: classMenuPrintOutProtocol
translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasClassSelectedHolder
label: 'HTML Documentation'
itemValue: classMenuDocumentation
translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasClassSelectedHolder
label: 'Save HTML Documentation As...'
itemValue: classMenuSaveDocumentationAs
translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
label: '-'
)
(MenuItem
label: 'Show Comment'
itemValue: classMenuComment
translateLabel: true
)
(MenuItem
label: 'Show Hierarchy'
itemValue: classMenuHierarchy
translateLabel: true
)
(MenuItem
label: 'Show Definition'
itemValue: classMenuDefinition
translateLabel: true
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasOOMPackageLoadedHolder
label: 'Metrics Report'
itemValue: classMenuMetrics
translateLabel: true
)
)
nil
nil
)
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasClassSelectedHolder
label: 'Spawn'
translateLabel: true
submenu:
(Menu
(
(MenuItem
enabled: hasClassSelectedHolder
label: 'Buffer with References to Class'
itemValue: classMenuSpawnBufferWithClassReferences
translateLabel: true
)
(MenuItem
enabled: hasClassSelectedHolder
label: 'Buffer with References to Class or Subclass'
itemValue: classMenuSpawnBufferWithClassOrSubclassReferences
translateLabel: true
)
(MenuItem
enabled: hasClassSelectedHolder
label: 'Buffer with Subclasses'
itemValue: classMenuSpawnBufferWithAllSubclasses
translateLabel: true
)
(MenuItem
enabled: hasClassSelectedHolder
label: 'Buffer with Superclasses'
itemValue: classMenuSpawnBufferWithAllSuperclasses
translateLabel: true
)
(MenuItem
enabled: hasClassSelectedHolder
label: 'Buffer with Projects'
itemValue: classMenuSpawnBufferWithClassProjects
translateLabel: true
isVisible: false
)
(MenuItem
enabled: hasClassSelectedHolder
label: 'Buffer'
itemValue: classMenuSpawnClassBuffer
translateLabel: true
isVisible: false
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasClassSelectedHolder
label: 'Browser on References to Class'
itemValue: classMenuSpawnClassReferences
translateLabel: true
)
(MenuItem
enabled: hasClassSelectedHolder
label: 'Browser on References to Class or Subclass'
itemValue: classMenuSpawnClassOrSubclassReferences
translateLabel: true
)
(MenuItem
enabled: hasClassSelectedHolder
label: 'Browser on Subclasses'
itemValue: classMenuSpawnWithAllSubclasses
translateLabel: true
)
(MenuItem
enabled: hasClassSelectedHolder
label: 'Browser on Superclasses'
itemValue: classMenuSpawnWithAllSuperclasses
translateLabel: true
)
(MenuItem
enabled: hasClassSelectedHolder
label: 'Browser on Projects'
itemValue: classMenuSpawnClassProjects
translateLabel: true
isVisible: false
)
(MenuItem
enabled: hasClassSelectedHolder
label: 'Browser'
itemValue: classMenuSpawnClass
translateLabel: true
isVisible: false
)
)
nil
nil
)
)
(MenuItem
enabled: hasClassSelectedHolder
label: 'Find'
translateLabel: true
isVisible: false
submenu:
(Menu
(
(MenuItem
enabled: hasClassSelectedHolder
label: 'String...'
itemValue: classMenuFindString
translateLabel: true
)
)
nil
nil
)
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasClassSelectedHolder
label: 'Instance Variables'
translateLabel: true
isVisible: hasNonMetaSelectedHolder
submenuChannel: classInstanceVariablesMenu
)
(MenuItem
enabled: hasClassSelectedHolder
label: 'Class Instance Variables'
translateLabel: true
isVisible: hasMetaSelectedHolder
submenuChannel: classInstanceVariablesMenu
)
(MenuItem
enabled: hasClassSelectedHolder
label: 'Class Variables'
translateLabel: true
submenuChannel: classClassVariablesMenu
)
(MenuItem
label: '-'
)
(MenuItem
label: 'New'
translateLabel: true
submenu:
(Menu
(
(MenuItem
label: 'classNewSlice'
translateLabel: true
submenuChannel: classNewSlice
isMenuSlice: true
)
)
nil
nil
)
)
(MenuItem
enabled: hasSingleClassSelectedHolder
label: 'Copy...'
itemValue: classMenuCopyAs
translateLabel: true
)
(MenuItem
enabled: hasClassSelectedHolder
label: 'Move'
translateLabel: true
submenu:
(Menu
(
(MenuItem
enabled: hasNonPrivateClassSelected
label: 'To Category...'
itemValue: classMenuMoveToCategory
translateLabel: true
)
(MenuItem
enabled: hasNonPrivateClassSelected
label: 'To Namespace...'
itemValue: classMenuMoveToNamespace
translateLabel: true
)
(MenuItem
enabled: hasNonPrivateClassSelected
label: 'To Project...'
itemValue: classMenuMoveToProject
translateLabel: true
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasClassSelectedHolder
label: 'Make Private in...'
itemValue: classMenuMakePrivateIn
translateLabel: true
)
(MenuItem
enabled: canMakePublicClass
label: 'Make Public'
itemValue: classMenuMakePublic
translateLabel: true
)
(MenuItem
enabled: canMakePublicClass
label: 'Make Public in...'
itemValue: classMenuMakePublicIn
translateLabel: true
)
(MenuItem
label: '-'
)
(MenuItem
enabled: canConvertToSiblingsHolder
label: 'New Common Superclass with Children (Convert to Siblings)...'
itemValue: classMenuChildrenToSiblings
nameKey: convertToSibling
translateLabel: true
)
(MenuItem
enabled: canInsertSuperclassHolder
label: 'New Common Superclass (Insert Superclass)...'
itemValue: classMenuInsertNewSuperclass
nameKey: insertSuperclass
translateLabel: true
)
)
nil
nil
)
)
(MenuItem
enabled: hasSingleClassSelectedHolder
label: 'Rename...'
itemValue: classMenuRename
translateLabel: true
shortcutKey: Rename
ignoreShortcutKeys: true
)
(MenuItem
enabled: hasClassSelectedHolder
label: 'Safe Remove...'
itemValue: classMenuSaveRemove
translateLabel: true
)
(MenuItem
enabled: hasClassSelectedHolder
label: 'Remove...'
itemValue: classMenuRemove
translateLabel: true
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasClassSelectedHolder
label: 'Compare'
translateLabel: true
submenu:
(Menu
(
(MenuItem
enabled: hasClassSelectedAndSourceCodeManagerHolder
label: 'With Newest in Repository...'
itemValue: classMenuCompareAgainstNewestInRepository
translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasSingleClassSelectedAndSourceCodeManagerHolder
label: 'With Original in Repository...'
itemValue: classMenuCompareAgainstOriginalInRepository
translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasSingleClassSelectedAndSourceCodeManagerHolder
label: 'With Repository...'
itemValue: classMenuCompareWithRepository
translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasSingleClassSelected
label: 'With File...'
itemValue: classMenuCompareWithFile
translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
label: '-'
isVisible: smallTeamAvailable
)
(MenuItem
label: 'With SmallTeam Version On Host'
translateLabel: true
isVisible: smallTeamAvailable
submenuChannel: compareClassWithSmallTeamVersionMenu
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasSingleClassSelectedHolder
label: 'With Class...'
itemValue: classMenuCompareWithClass
translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasExactlyTwoClassesSelectedHolder
label: 'With each other'
itemValue: classMenuCompareTwoSelectedClasses
translateLabel: true
showBusyCursorWhilePerforming: true
)
)
nil
nil
)
)
(MenuItem
label: 'Generate'
translateLabel: true
submenuChannel: classGenerateMenu
keepLinkedMenu: true
)
(MenuItem
label: 'Debug'
translateLabel: true
submenuChannel: classDebugMenu
keepLinkedMenu: true
)
(MenuItem
label: 'Special'
translateLabel: true
submenuChannel: classSpecialMenu
keepLinkedMenu: true
)
(MenuItem
label: '-'
isVisible: false
)
(MenuItem
label: 'Update'
itemValue: classMenuUpdate
translateLabel: true
isVisible: false
)
)
nil
nil
)
"Modified: / 05-10-2010 / 12:25:55 / cg"
!
classMenuCVS
"This resource specification was automatically generated
by the MenuEditor of ST/X."
"Do not manually edit this!! If it is corrupted,
the MenuEditor may not be able to read the specification."
"
MenuEditor new openOnClass:Tools::NewSystemBrowser andSelector:#classMenuCVS
(Menu new fromLiteralArrayEncoding:(Tools::NewSystemBrowser classMenuCVS)) startUp
"
<resource: #menu>
^
#(Menu
(
(MenuItem
label: '** No SourceCodeManager - See Settings in the Launcher **'
translateLabel: true
isVisible: hasNoSourceCodeManagerHolder
)
(MenuItem
label: '-'
isVisible: hasNoSourceCodeManagerHolder
)
(MenuItem
enabled: hasClassSelectedHolderAndSourceCodeManagerHolder
label: 'CheckIn...'
itemValue: classMenuCheckIn
translateLabel: true
labelImage: (ResourceRetriever ToolbarIconLibrary repositoryCheckIn 'CheckIn...')
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasClassWithExtensionsSelectedHolder
label: 'CheckIn Extensions For'
translateLabel: true
submenuChannel: browseClassExtensionsMenu
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: changeSetContainsChangedClassesAndSourceCodeManagerHolder
label: 'CheckIn All Changed Classes'
itemValue: classMenuCheckInAllChangedClasses
translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
label: 'Quick CheckIn...'
itemValue: classMenuQuickCheckIn
translateLabel: true
isVisible: hasClassSelectedAndControlKeyDownHolder
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasProjectDefinitionSelectedAndSourceCodeManagerHolder
label: 'CheckIn Build Support Files...'
itemValue: classMenuCheckInBuildSupportFiles
translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasNonPrivateClassSelectedAndSourceCodeManagerHolder
label: 'Set Tag...'
itemValue: classMenuSetTag
translateLabel: true
labelImage: (ResourceRetriever ToolbarIconLibrary repositoryTag 'Set Tag...')
showBusyCursorWhilePerforming: true
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasNonPrivateClassSelectedAndSourceCodeManagerHolder
label: 'CheckOut Newest'
itemValue: classMenuCheckOutNewest
translateLabel: true
labelImage: (ResourceRetriever ToolbarIconLibrary repositoryCheckOut 'CheckOut Newest')
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasNonPrivateClassSelectedAndSourceCodeManagerHolder
label: 'CheckOut Previous Version...'
itemValue: classMenuCheckOut
translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasNonPrivateClassSelectedAndSourceCodeManagerHolder
label: 'Revision Log (Recent Changes)'
itemValue: classMenuShortRevisionLog
translateLabel: true
showBusyCursorWhilePerforming: true
labelImage: (ResourceRetriever ToolbarIconLibrary repositoryLog 'Revision Log (Recent Changes)')
)
(MenuItem
enabled: hasNonPrivateClassSelectedAndSourceCodeManagerHolder
label: 'Revision Log (Full)'
itemValue: classMenuRevisionLog
translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasClassSelectedAndSourceCodeManagerHolder
label: 'Compare with Newest in Repository...'
itemValue: classMenuCompareAgainstNewestInRepository
translateLabel: true
labelImage: (ResourceRetriever ToolbarIconLibrary repositoryVersions 'Compare with Newest in Repository...')
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasSingleClassSelectedAndSourceCodeManagerHolder
label: 'Compare with Original in Repository...'
itemValue: classMenuCompareAgainstOriginalInRepository
translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasSingleClassSelectedAndSourceCodeManagerHolder
label: 'Compare with Repository...'
itemValue: classMenuCompareWithRepository
translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasSingleClassSelectedAndSourceCodeManagerHolder
label: 'Compare two Repository Versions...'
itemValue: classMenuCompareTwoRepositoryVersions
translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasProjectDefinitionSelectedAndSourceCodeManagerHolder
label: 'Compare Extensions with Repository...'
translateLabel: true
itemValue: classMenuCompareExtensionsWithRepository
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasProjectDefinitionSelectedAndSourceCodeManagerHolder
label: 'Compare Build Support File'
translateLabel: true
submenuChannel: compareBuildSupportFileMenu
)
)
nil
nil
)
!
classNewHaskellClassSlice
"This resource specification was automatically generated
by the MenuEditor of ST/X."
"Do not manually edit this!! If it is corrupted,
the MenuEditor may not be able to read the specification."
"
MenuEditor new openOnClass:Tools::NewSystemBrowser andSelector:#classNewSlice
(Menu new fromLiteralArrayEncoding:(Tools::NewSystemBrowser classNewSlice)) startUp
"
<resource: #menu>
^
#(Menu
(
(MenuItem
enabled: isHaskellModulePresent
label: 'Haskell Module'
itemValue: classMenuNewHaskellModule
translateLabel: true
isVisible: isHaskellModulePresent
)
)
nil
nil
)
!
classNewJavaScriptClassSlice
"This resource specification was automatically generated
by the MenuEditor of ST/X."
"Do not manually edit this!! If it is corrupted,
the MenuEditor may not be able to read the specification."
"
MenuEditor new openOnClass:Tools::NewSystemBrowser andSelector:#classNewSlice
(Menu new fromLiteralArrayEncoding:(Tools::NewSystemBrowser classNewSlice)) startUp
"
<resource: #menu>
^
#(Menu
(
(MenuItem
enabled: isJavaScriptMetaclassPresent
label: 'JavaScript Class'
itemValue: classMenuNewJavaScriptClass
translateLabel: true
)
)
nil
nil
)
!
classNewPLSQLClassSlice
"This resource specification was automatically generated
by the MenuEditor of ST/X."
"Do not manually edit this!! If it is corrupted,
the MenuEditor may not be able to read the specification."
"
MenuEditor new openOnClass:Tools::NewSystemBrowser andSelector:#classNewSlice
(Menu new fromLiteralArrayEncoding:(Tools::NewSystemBrowser classNewSlice)) startUp
"
<resource: #menu>
^
#(Menu
(
(MenuItem
label: 'PLSQL ObjectType'
itemValue: classMenuNewPLSQLObjectType
translateLabel: true
isVisible: isPlsqlMetaclassPresent
)
)
nil
nil
)
!
classNewSlice
"This resource specification was automatically generated
by the MenuEditor of ST/X."
"Do not manually edit this!! If it is corrupted,
the MenuEditor may not be able to read the specification."
"
MenuEditor new openOnClass:Tools::NewSystemBrowser andSelector:#classNewSlice
(Menu new fromLiteralArrayEncoding:(Tools::NewSystemBrowser classNewSlice)) startUp
"
<resource: #menu>
^
#(Menu
(
(MenuItem
label: 'Class Wizard'
itemValue: classMenuOpenClassCreationWizard
translateLabel: true
labelImage: (ResourceRetriever ToolbarIconLibrary newClassWizardIcon 'Class Wizard')
)
(MenuItem
label: '-'
)
(MenuItem
label: 'Class'
itemValue: classMenuNewClass
translateLabel: true
)
(MenuItem
enabled: hasSingleClassSelectedHolder
label: 'Subclass'
itemValue: classMenuNewSubclass
translateLabel: true
)
(MenuItem
label: '-'
)
(MenuItem
label: 'Smalltalk Class Slice'
nameKey: classNewSmalltalkSlice
translateLabel: true
submenuChannel: classNewSmalltalkSlice
isMenuSlice: true
)
(MenuItem
label: 'Ruby Class Slice'
nameKey: classNewRubyClassSlice
translateLabel: true
submenuChannel: classNewRubyClassSlice
isMenuSlice: true
)
(MenuItem
label: 'JavaScript Class Slice'
nameKey: classNewJavaScriptClassSlice
translateLabel: true
submenuChannel: classNewJavaScriptClassSlice
isMenuSlice: true
)
(MenuItem
label: 'Haskell Class Slice'
nameKey: classNewHaskellClassSlice
translateLabel: true
submenuChannel: classNewHaskellClassSlice
isMenuSlice: true
)
(MenuItem
label: 'PLSQL Class Slice'
nameKey: classNewPLSQLClassSlice
translateLabel: true
submenuChannel: classNewPLSQLClassSlice
isMenuSlice: true
)
)
nil
nil
)
!
classNewSmalltalkSlice
"This resource specification was automatically generated
by the MenuEditor of ST/X."
"Do not manually edit this!! If it is corrupted,
the MenuEditor may not be able to read the specification."
"
MenuEditor new openOnClass:Tools::NewSystemBrowser andSelector:#classNewSmalltalkSlice
(Menu new fromLiteralArrayEncoding:(Tools::NewSystemBrowser classNewSmalltalkSlice)) startUp
"
<resource: #menu>
^
#(Menu
(
#(MenuItem
label: 'Smalltalk'
translateLabel: true
submenu:
(Menu
(
(MenuItem
label: 'Class'
itemValue: classMenuNewClass
translateLabel: true
)
(MenuItem
enabled: hasSingleLoadedNonJavascriptClassSelectedHolder
label: 'Private Class'
itemValue: classMenuNewPrivateClass
translateLabel: true
)
(MenuItem
label: '-'
)
(MenuItem
label: 'Application'
itemValue: classMenuNewApplication
translateLabel: true
)
(MenuItem
label: 'Dialog'
itemValue: classMenuNewDialog
translateLabel: true
)
(MenuItem
label: 'WebService'
itemValue: classMenuNewWebService
translateLabel: true
)
(MenuItem
label: 'WebApplication'
itemValue: classMenuNewWebApplication
translateLabel: true
isVisible: false
)
(MenuItem
label: 'Widget (View)'
itemValue: classMenuNewWidgetClass
translateLabel: true
)
(MenuItem
label: '-'
)
(MenuItem
label: 'Error'
itemValue: classMenuNewError
translateLabel: true
)
(MenuItem
label: 'Notification'
itemValue: classMenuNewNotification
translateLabel: true
)
(MenuItem
label: 'Shared Pool'
itemValue: classMenuNewSharedPool
translateLabel: true
)
(MenuItem
label: 'TestCase'
itemValue: classMenuNewTestCase
translateLabel: true
)
)
nil
nil
)
)
)
nil
nil )
!
classSmallTeamMenu
"This resource specification was automatically generated
by the MenuEditor of ST/X."
"Do not manually edit this!! If it is corrupted,
the MenuEditor may not be able to read the specification."
"
MenuEditor new openOnClass:Tools::NewSystemBrowser andSelector:#classSmallTeamMenu
(Menu new fromLiteralArrayEncoding:(Tools::NewSystemBrowser classSmallTeamMenu)) startUp
"
<resource: #menu>
^
#(Menu
(
(MenuItem
label: 'Compare with Version On Host'
translateLabel: true
submenuChannel: compareClassWithSmallTeamVersionMenu
keepLinkedMenu: true
)
)
nil
nil
)
!
classSpecialMenu
"This resource specification was automatically generated
by the MenuEditor of ST/X."
"Do not manually edit this!! If it is corrupted,
the MenuEditor may not be able to read the specification."
"
MenuEditor new openOnClass:Tools::NewSystemBrowser andSelector:#classSpecialMenu
(Menu new fromLiteralArrayEncoding:(Tools::NewSystemBrowser classSpecialMenu)) startUp
"
<resource: #menu>
^
#(Menu
(
(MenuItem
enabled: hasAnyUnloadedClassSelectedHolder
label: 'Load'
itemValue: classMenuLoad
translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasProjectDefinitionWithAnyUnloadedClassSelectedHolder
label: 'Load Project'
itemValue: classMenuLoadProject
translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasClassSelectedHolder
label: 'Unload'
itemValue: classMenuUnload
translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasClassSelectedHolder
label: 'Initialize Class(es)'
itemValue: classMenuInitialize
translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasClassSelectedHolder
label: 'Compile Lazy Methods'
itemValue: classMenuCompileLazyMethods
translateLabel: true
isVisible: false
showBusyCursorWhilePerforming: true
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasClassSelectedWhichCanBeIncludedInProjectHolder
label: 'Include in Project as Compiled Class'
itemValue: classMenuIncludeInProject
translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasClassSelectedWhichCanBeMadeAutoloadedInProject
label: 'Include in Project as Autoloaded Class'
itemValue: classMenuMakeAutoloadedInProject
translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasClassSelectedWhichCanBeExcludedFromProject
label: 'Exclude from Project'
itemValue: classMenuExcludeFromProject
translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasSingleLoadedClassSelectedHolder
label: 'Primitive Definitions'
itemValue: classMenuPrimitiveDefinitions
translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasSingleLoadedClassSelectedHolder
label: 'Primitive Functions'
itemValue: classMenuPrimitiveFunctions
translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasSingleLoadedClassSelectedHolder
label: 'Primitive Variables'
itemValue: classMenuPrimitiveVariables
translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasClassSelectedHolder
label: 'Remove from ChangeSet'
itemValue: classMenuCleanUpChangeSet
translateLabel: true
)
(MenuItem
label: 'Special ClassOPS'
translateLabel: true
submenuChannel: classOperationsMenu
isMenuSlice: true
)
)
nil
nil
)
!
compareBuildSupportFileMenu
"This resource specification was automatically generated
by the MenuEditor of ST/X."
"Do not manually edit this!! If it is corrupted,
the MenuEditor may not be able to read the specification."
"
MenuEditor new openOnClass:Tools::NewSystemBrowser andSelector:#compareBuildSupportFileMenu
(Menu new fromLiteralArrayEncoding:(Tools::NewSystemBrowser compareBuildSupportFileMenu)) startUp
"
<resource: #menu>
^
#(Menu
(
(MenuItem
enabled: hasSingleProjectOrProjectDefinitionSelected
label: 'Make.spec'
itemValue: projectMenuShowGeneratedBuildFile:
translateLabel: true
argument: 'Make.spec'
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasSingleProjectOrProjectDefinitionSelected
label: 'Make.proto'
itemValue: projectMenuShowGeneratedBuildFile:
translateLabel: true
argument: 'Make.proto'
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasSingleProjectOrProjectDefinitionSelected
label: 'bc.mak'
itemValue: projectMenuShowGeneratedBuildFile:
translateLabel: true
argument: 'bc.mak'
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasSingleProjectOrProjectDefinitionSelected
label: 'libInit.cc'
itemValue: projectMenuShowGeneratedBuildFile:
translateLabel: true
argument: 'libInit.cc'
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasSingleProjectOrProjectDefinitionSelected
label: 'modules.stx'
itemValue: projectMenuShowGeneratedBuildFile:
translateLabel: true
argument: 'modules.stx'
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasSingleProjectOrProjectDefinitionSelected
label: 'lib.rc / app.rc'
itemValue: projectMenuShowGeneratedBuildFile:
translateLabel: true
argument: 'lib.rc'
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasSingleProjectOrProjectDefinitionSelected
label: 'app.nsi'
itemValue: projectMenuShowGeneratedBuildFile:
translateLabel: true
argument: 'app.nsi'
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasSingleProjectOrProjectDefinitionSelected
label: 'abbrev.stc'
itemValue: projectMenuShowGeneratedBuildFile:
translateLabel: true
argument: 'abbrev.stc'
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasSingleProjectOrProjectDefinitionSelected
label: 'loadAll'
itemValue: projectMenuShowGeneratedBuildFile:
translateLabel: true
argument: 'loadAll'
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasSingleProjectOrProjectDefinitionSelected
label: 'bmake.bat'
itemValue: projectMenuShowGeneratedBuildFile:
translateLabel: true
argument: 'bmake.bat'
showBusyCursorWhilePerforming: true
)
)
nil
nil
)
!
editModeInfoLabelMenu
"This resource specification was automatically generated
by the MenuEditor of ST/X."
"Do not manually edit this!! If it is corrupted,
the MenuEditor may not be able to read the specification."
"
MenuEditor new openOnClass:Tools::NewSystemBrowser andSelector:#editModeInfoLabelMenu
(Menu new fromLiteralArrayEncoding:(Tools::NewSystemBrowser editModeInfoLabelMenu)) startUp
"
<resource: #menu>
^
#(Menu
(
(MenuItem
label: 'Insert'
itemValue: editModeInsert
translateLabel: true
)
(MenuItem
label: 'Overwrite'
itemValue: editModeOverwrite
translateLabel: true
)
(MenuItem
label: 'Insert Selecting'
itemValue: editModeInsertAndSelect
translateLabel: true
)
)
nil
nil
)
!
inheritanceViewMenu
"This resource specification was automatically generated
by the MenuEditor of ST/X."
"Do not manually edit this!! If it is corrupted,
the MenuEditor may not be able to read the specification."
"
MenuEditor new openOnClass:Tools::NewSystemBrowser andSelector:#inheritanceViewMenu
(Menu new fromLiteralArrayEncoding:(Tools::NewSystemBrowser inheritanceViewMenu)) startUp
"
<resource: #menu>
^
#(Menu
(
(MenuItem
label: 'Navigate to Selected Class'
itemValue: inheritanceMenuNavigateToClass
translateLabel: true
)
(MenuItem
label: '-'
)
(MenuItem
label: 'Update'
itemValue: inheritanceMenuUpdate
translateLabel: true
)
)
nil
nil
)
!
lintMenu
"This resource specification was automatically generated
by the MenuEditor of ST/X."
"Do not manually edit this!! If it is corrupted,
the MenuEditor may not be able to read the specification."
"
MenuEditor new openOnClass:Tools::NewSystemBrowser andSelector:#lintMenu
(Menu new fromLiteralArrayEncoding:(Tools::NewSystemBrowser lintMenu)) startUp
"
<resource: #menu>
^
#(Menu
(
(MenuItem
label: 'All'
itemValue: classMenuCheckAll
translateLabel: true
)
(MenuItem
label: '-'
)
(MenuItem
label: 'Errors'
itemValue: classMenuCheckErrors
translateLabel: true
)
(MenuItem
label: 'Possible Errors'
itemValue: classMenuCheckWarnings
translateLabel: true
)
(MenuItem
label: 'Style'
itemValue: classMenuCheckStyle
translateLabel: true
)
(MenuItem
label: '-'
)
(MenuItem
label: 'Individual Checks...'
itemValue: classMenuCheckIndividual
translateLabel: true
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasClassSelectedHolder
label: 'Check Compilability'
itemValue: classMenuCheckCompilability
translateLabel: true
showBusyCursorWhilePerforming: true
)
)
nil
nil
)
!
mainMenu
"This resource specification was automatically generated
by the MenuEditor of ST/X."
"Do not manually edit this!! If it is corrupted,
the MenuEditor may not be able to read the specification."
"
MenuEditor new openOnClass:Tools::NewSystemBrowser andSelector:#mainMenu
(Menu new fromLiteralArrayEncoding:(Tools::NewSystemBrowser mainMenu)) startUp
"
<resource: #menu>
^
#(Menu
(
(MenuItem
label: 'B&uffers'
translateLabel: true
submenuChannel: bufferMenu
)
(MenuItem
label: 'Browse'
translateLabel: true
submenuChannel: browseMenu
keepLinkedMenu: true
)
(MenuItem
label: 'Find'
translateLabel: true
isVisible: searchMenuVisible
submenuChannel: searchMenu
keepLinkedMenu: true
)
(MenuItem
label: 'Find'
translateLabel: true
isVisible: searchMenuInMethodListVisible
submenuChannel: searchMenuInMethodList
keepLinkedMenu: true
)
(MenuItem
label: 'View'
translateLabel: true
isVisible: viewMenuVisible
submenuChannel: viewMenu
keepLinkedMenu: true
)
(MenuItem
label: 'View'
translateLabel: true
isVisible: viewMenuForMethodListVisible
submenuChannel: viewMenuForMethodList
keepLinkedMenu: true
)
(MenuItem
label: 'Project'
translateLabel: true
isVisible: projectMenuVisible
submenuChannel: projectMenu
keepLinkedMenu: true
)
(MenuItem
label: 'Namespace'
translateLabel: true
isVisible: nameSpaceMenuVisible
submenuChannel: nameSpaceMenu
keepLinkedMenu: true
)
(MenuItem
label: 'Category'
translateLabel: true
isVisible: categoryMenuVisible
submenuChannel: categoryMenu
keepLinkedMenu: true
)
(MenuItem
label: 'Hierarchy'
translateLabel: true
isVisible: classHierarchyMenuVisible
submenuChannel: classHierarchyMenu
keepLinkedMenu: true
)
(MenuItem
label: 'Class'
translateLabel: true
isVisible: classMenuVisible
submenuChannel: classMenu
keepLinkedMenu: true
)
(MenuItem
label: 'Protocol'
translateLabel: true
isVisible: protocolMenuVisible
submenuChannel: protocolMenu
keepLinkedMenu: true
)
(MenuItem
label: 'Selector'
translateLabel: true
isVisible: selectorMenuVisible
submenuChannel: selectorMenu
keepLinkedMenu: true
)
(MenuItem
label: 'Code'
translateLabel: true
isVisible: codeMenuVisible
submenuChannel: codeMenu
keepLinkedMenu: true
)
(MenuItem
label: 'Debug'
translateLabel: true
isVisible: selectorMenuVisible
submenuChannel: methodDebugMenu
keepLinkedMenu: true
)
(MenuItem
label: 'Operations'
translateLabel: true
submenuChannel: operationsMenu
)
(MenuItem
label: 'MENU_Help'
translateLabel: true
startGroup: conditionalRight
submenu:
(Menu
(
(MenuItem
label: 'ST/X Documentation'
itemValue: openSTXDocumentation
translateLabel: true
)
(MenuItem
label: 'Class Documentation'
itemValue: openClassDocumentation
translateLabel: true
)
(MenuItem
label: 'Browser Documentation'
itemValue: openDocumentation
translateLabel: true
)
(MenuItem
label: 'Refactorings'
itemValue: openRefactoringDocumentation
translateLabel: true
)
(MenuItem
label: 'Keyword Index'
itemValue: openKeywordIndexDocumentation
translateLabel: true
)
(MenuItem
label: '-'
)
(MenuItem
label: 'About SystemBrowser...'
itemValue: openAboutThisApplication
translateLabel: true
)
)
nil
nil
)
)
)
nil
nil
)
"Modified: / 11-09-2007 / 11:44:33 / cg"
!
methodDebugMenu
"This resource specification was automatically generated
by the MenuEditor of ST/X."
"Do not manually edit this!! If it is corrupted,
the MenuEditor may not be able to read the specification."
"
MenuEditor new openOnClass:NewSystemBrowser andSelector:#methodDebugMenu
(Menu new fromLiteralArrayEncoding:(NewSystemBrowser methodDebugMenu)) startUp
"
<resource: #menu>
^
#(#Menu
#(
#(#MenuItem
#label: 'Remove Break/Trace'
#translateLabel: true
#value: #debugMenuRemoveBreakOrTrace
#isVisible: #hasNoMethodOrMixedWrapsSelectedHolder
#enabled: #hasMethodWithWrapSelectedHolder
)
#(#MenuItem
#label: 'Remove Break'
#translateLabel: true
#value: #debugMenuRemoveBreakOrTrace
#isVisible: #hasOnlyMethodsWithBreakPointSelected
#enabled: #hasMethodWithBreakPointSelectedHolder
)
#(#MenuItem
#label: 'Remove Trace'
#translateLabel: true
#value: #debugMenuRemoveBreakOrTrace
#isVisible: #hasOnlyMethodsWithTracePointSelected
#enabled: #hasMethodWithTracePointSelectedHolder
)
#(#MenuItem
#label: 'Remove all Break && Tracepoints'
#translateLabel: true
#value: #debugMenuRemoveAllBreakpoints
#enabled: #anyBreakOrTracePointsAreSetHolder
)
#(#MenuItem
#label: '-'
)
#(#MenuItem
#label: 'BreakPoint'
#translateLabel: true
#value: #debugMenuBreakPoint
#enabled: #hasMethodSelectedHolder
)
#(#MenuItem
#label: 'BreakPoint in Process...'
#translateLabel: true
#value: #debugMenuBreakPointIn
#enabled: #hasMethodSelectedHolder
)
#(#MenuItem
#label: 'BreakPoint for Instances Of...'
#translateLabel: true
#value: #debugMenuBreakPointFor
#enabled: #hasMethodSelectedHolder
)
#(#MenuItem
#label: 'BreakPoint After...'
#translateLabel: true
#value: #debugMenuBreakPointAfter
#enabled: #hasMethodSelectedHolder
)
#(#MenuItem
#label: 'BreakPoint If...'
#translateLabel: true
#value: #debugMenuBreakPointIf
#enabled: #hasMethodSelectedHolder
)
#(#MenuItem
#label: '-'
)
#(#MenuItem
#label: 'Trace'
#translateLabel: true
#value: #debugMenuTrace
#enabled: #hasMethodSelectedHolder
)
#(#MenuItem
#label: 'Trace Sender'
#translateLabel: true
#value: #debugMenuTraceSender
#enabled: #hasMethodSelectedHolder
)
#(#MenuItem
#label: 'Trace Full Walkback'
#translateLabel: true
#value: #debugMenuTraceFullWalkback
#enabled: #hasMethodSelectedHolder
)
#(#MenuItem
#label: 'Trace Change->Update Reason'
#translateLabel: true
#value: #debugMenuTraceChangeUpdate
#enabled: #hasUpdateMethodSelectedHolder
)
#(#MenuItem
#label: '-'
)
#(#MenuItem
#label: 'Start Message Tally'
#translateLabel: true
#value: #debugMenuStartMessageTally
#enabled: #hasMethodSelectedHolder
#isVisible: false
)
#(#MenuItem
#label: '-'
#isVisible: false
)
#(#MenuItem
#label: 'Start Timing'
#translateLabel: true
#value: #debugMenuStartTiming
#enabled: #hasMethodSelectedHolder
)
#(#MenuItem
#label: 'Start Counting'
#translateLabel: true
#value: #debugMenuStartCounting
#enabled: #hasMethodSelectedHolder
)
#(#MenuItem
#label: 'Start Memory Usage'
#translateLabel: true
#value: #debugMenuStartMemoryUsage
#enabled: #hasMethodSelectedHolder
)
#(#MenuItem
#label: '-'
)
(MenuItem
label: 'Run Tests'
itemValue: runTestCases
translateLabel: true
enabled: hasAnyTestCaseSelectedHolder
showBusyCursorWhilePerforming: true
)
(MenuItem
label: 'Debug Tests'
itemValue: runTestCasesWithDebug
translateLabel: true
enabled: hasAnyTestCaseSelectedHolder
showBusyCursorWhilePerforming: true
)
(MenuItem
label: 'Run Tests for Coverage'
itemValue: runTestCasesForCoverage
translateLabel: true
enabled: hasAnyTestCaseSelectedHolder
showBusyCursorWhilePerforming: true
"/ enabled: hasAnyClassWithCoverageInfoSelectedHolder
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasMethodSelectedAndInstrumentingCompilerExistsHolder
label: 'Recompile with Instrumentation'
itemValue: debugMenuRecompileMethodsInstrumented
translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasMethodSelectedAndInstrumentingCompilerExistsAndOOMPackageLoadedHolder
label: 'Call Graph'
itemValue: debugMenuOpenCallGraphForMethods
translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
label: 'Clear all Coverage Info (Systemwide)'
itemValue: debugMenuClearCoverageInfo
translateLabel: true
"/ enabled: hasAnyClassWithCoverageInfoSelectedHolder
)
)
nil
nil
)
"Created: / 11-09-2007 / 11:43:37 / cg"
"Modified: / 10-08-2010 / 14:42:53 / cg"
!
methodListMenu
"This resource specification was automatically generated
by the MenuEditor of ST/X."
"Do not manually edit this!! If it is corrupted,
the MenuEditor may not be able to read the specification."
"
MenuEditor new openOnClass:Tools::NewSystemBrowser andSelector:#methodListMenu
(Menu new fromLiteralArrayEncoding:(Tools::NewSystemBrowser methodListMenu)) startUp
"
<resource: #menu>
^
#(Menu
(
(MenuItem
label: 'FileOutPrintOutSlice'
translateLabel: true
submenuChannel: selectorMenuFileOutPrintOutSlice
isMenuSlice: true
)
(MenuItem
label: '-'
)
(MenuItem
label: 'SpawnSlice'
translateLabel: true
submenuChannel: selectorMenuSpawnSlice
isMenuSlice: true
)
(MenuItem
label: '-'
)
(MenuItem
label: 'SearchSlice'
translateLabel: true
submenuChannel: selectorMenuSearchSlice
isMenuSlice: true
)
(MenuItem
label: '-'
)
(MenuItem
label: 'CopyMoveRemoveSlice'
translateLabel: true
submenuChannel: selectorMenuCopyMoveRemoveSlice
isMenuSlice: true
)
(MenuItem
label: '-'
)
(MenuItem
label: 'CompareGenerateDebugSlice'
translateLabel: true
submenuChannel: selectorMenuCompareGenerateDebugSlice
isMenuSlice: true
)
(MenuItem
label: '-'
)
(MenuItem
label: 'Update'
itemValue: methodListMenuUpdate
translateLabel: true
)
)
nil
nil
)
!
methodRefactorMenu
"This resource specification was automatically generated
by the MenuEditor of ST/X."
"Do not manually edit this!! If it is corrupted,
the MenuEditor may not be able to read the specification."
"
MenuEditor new openOnClass:NewSystemBrowser andSelector:#methodDebugMenu
(Menu new fromLiteralArrayEncoding:(NewSystemBrowser methodDebugMenu)) startUp
"
<resource: #menu>
^
#(#Menu
#(
#(#MenuItem
#label: 'Add Parameter'
#enabled: #hasSingleMethodSelectedAndCanUseRefactoringSupportHolder
#translateLabel: true
#value: #selectorMenuAddParameter
showBusyCursorWhilePerforming: true
)
(MenuItem
label: 'Inline Parameter'
enabled: hasSingleMethodSelectedAndSingleSelectedMethodHasParameterAndCanUseRefactoringSupportHolder
itemValue: selectorMenuInlineParameter
translateLabel: true
showBusyCursorWhilePerforming: true
)
#(#MenuItem
label: 'Remove Parameter'
enabled: hasSingleMethodSelectedAndSingleSelectedMethodHasParameterAndCanUseRefactoringSupportHolder
translateLabel: true
value: #selectorMenuRemoveParameter
showBusyCursorWhilePerforming: true
)
#(#MenuItem
#label: '-'
)
#(#MenuItem
#label: 'Inline All Self Sends'
#translateLabel: true
#value: #selectorMenuInlineSelfSends
#enabled: #hasSingleMethodSelectedAndCanUseRefactoringSupportHolder
)
)
nil
nil
)
"Created: / 11-09-2007 / 11:43:37 / cg"
!
nameSpaceMenu
"This resource specification was automatically generated
by the MenuEditor of ST/X."
"Do not manually edit this!! If it is corrupted,
the MenuEditor may not be able to read the specification."
"
MenuEditor new openOnClass:Tools::NewSystemBrowser andSelector:#nameSpaceMenu
(Menu new fromLiteralArrayEncoding:(Tools::NewSystemBrowser nameSpaceMenu)) startUp
"
<resource: #menu>
^
#(Menu
(
(MenuItem
enabled: hasNameSpaceSelectedAndSourceCodeManagerHolder
label: 'CVS'
translateLabel: true
submenu:
(Menu
(
(MenuItem
enabled: hasNameSpaceSelectedAndSourceCodeManagerHolder
label: 'CheckIn All...'
itemValue: nameSpaceMenuCheckInAll
translateLabel: true
labelImage: (ResourceRetriever ToolbarIconLibrary repositoryCheckIn 'CheckIn All...')
showBusyCursorWhilePerforming: true
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasNameSpaceSelectedAndSourceCodeManagerHolder
label: 'CheckOut Newest All'
itemValue: nameSpaceMenuCheckOutNewest
translateLabel: true
labelImage: (ResourceRetriever ToolbarIconLibrary repositoryCheckOut 'CheckOut Newest All')
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasNameSpaceSelectedAndSourceCodeManagerHolder
label: 'CheckOut Previous Version All...'
itemValue: nameSpaceMenuCheckOut
translateLabel: true
showBusyCursorWhilePerforming: true
)
)
nil
nil
)
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasNameSpaceSelectedHolder
label: 'Spawn'
translateLabel: true
submenu:
(Menu
(
(MenuItem
enabled: hasNameSpaceSelectedHolder
label: 'Buffer'
itemValue: nameSpaceMenuSpawnBuffer
translateLabel: true
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasNameSpaceSelectedHolder
label: 'Browser'
itemValue: nameSpaceMenuSpawn
translateLabel: true
)
)
nil
nil
)
)
(MenuItem
label: 'Find'
translateLabel: true
submenuChannel: searchMenu
)
(MenuItem
label: '-'
)
(MenuItem
label: 'New...'
itemValue: nameSpaceMenuNew
translateLabel: true
)
(MenuItem
label: '-'
)
(MenuItem
enabled: canRenameNameSpaceHolder
label: 'Rename'
itemValue: nameSpaceMenuRename
translateLabel: true
)
(MenuItem
enabled: canRemoveNameSpaceHolder
label: 'Remove'
itemValue: nameSpaceMenuRemove
translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
label: '-'
)
(MenuItem
label: 'Update'
itemValue: nameSpaceMenuUpdate
translateLabel: true
showBusyCursorWhilePerforming: true
)
)
nil
nil
)
!
projectDebugMenu
"This resource specification was automatically generated
by the MenuEditor of ST/X."
"Do not manually edit this!! If it is corrupted,
the MenuEditor may not be able to read the specification."
"
MenuEditor new openOnClass:Tools::NewSystemBrowser andSelector:#classDebugMenu
(Menu new fromLiteralArrayEncoding:(Tools::NewSystemBrowser classDebugMenu)) startUp
"
<resource: #menu>
^
#(Menu
(
(MenuItem
enabled: hasProjectSelectedAndInstrumentingCompilerExistsHolder
label: 'Recompile all Methods with Instrumentation'
itemValue: projectMenuRecompileInstrumented
translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasProjectSelectedAndInstrumentingCompilerExistsAndOOMPackageLoadedHolder
label: 'Call Graph'
itemValue: debugMenuOpenCallGraphForProjects
translateLabel: true
showBusyCursorWhilePerforming: true
)
)
nil
nil
)
"Created: / 27-04-2010 / 12:41:02 / cg"
"Modified: / 27-04-2010 / 14:06:33 / cg"
!
projectMenu
"This resource specification was automatically generated
by the MenuEditor of ST/X."
"Do not manually edit this!! If it is corrupted,
the MenuEditor may not be able to read the specification."
"
MenuEditor new openOnClass:Tools::NewSystemBrowser andSelector:#projectMenu
(Menu new fromLiteralArrayEncoding:(Tools::NewSystemBrowser projectMenu)) startUp
"
<resource: #menu>
^
#(Menu
(
(MenuItem
enabled: hasProjectSelectedHolder
label: 'File out'
translateLabel: true
submenu:
(Menu
(
(MenuItem
enabled: hasProjectSelectedHolder
label: 'as...'
itemValue: projectMenuFileOutAs
translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasProjectSelectedAndCanFileOutXMLHolder
label: 'XML as...'
itemValue: projectMenuFileOutXMLAs
translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasProjectSelectedAndCanFileOutSIFHolder
label: 'SIF as...'
itemValue: projectMenuFileOutSIFAs
translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasProjectSelectedHolder
label: 'Each in...'
itemValue: projectMenuFileOutEachIn
translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasProjectSelectedAndCanFileOutXMLHolder
label: 'Each XML in...'
itemValue: projectMenuFileOutEachXMLIn
translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasProjectSelectedAndCanFileOutSIFHolder
label: 'Each SIF in...'
itemValue: projectMenuFileOutEachSIFIn
translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasProjectSelectedHolder
label: 'Each Binary in...'
itemValue: projectMenuFileOutEachBinaryIn
translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasProjectSelectedHolder
label: 'Mail To...'
itemValue: projectMenuMailTo
translateLabel: true
showBusyCursorWhilePerforming: true
)
)
nil
nil
)
)
(MenuItem
label: 'CVS'
translateLabel: true
submenuChannel: projectMenuCVS
labelImage: (ResourceRetriever ToolbarIconLibrary repositoryCVSIcon 'CVS')
)
(MenuItem
enabled: hasProjectSelectedSubversionRepositoryExistsHolder
label: 'SubVersion'
translateLabel: true
isVisible: hasSubversionSupport
submenuChannel: projectMenuSubversion
labelImage: (ResourceRetriever ToolbarIconLibrary repositorySVNIcon 'SubVersion')
)
(MenuItem
label: '-'
)
(MenuItem
label: 'Documentation'
translateLabel: true
submenu:
(Menu
(
(MenuItem
enabled: hasSingleRealProjectSelectedHolder
label: 'Generate Project Documentation'
itemValue: projectMenuDocumentation
translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasOOMPackageLoadedAndSingleRealProjectSelectedHolder
label: 'Metrics Summary Report'
itemValue: projectMenuMetricsSummary
translateLabel: true
)
)
nil
nil
)
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasProjectSelectedHolder
label: 'Spawn'
translateLabel: true
submenu:
(Menu
(
(MenuItem
enabled: hasProjectSelectedHolder
label: 'Buffer'
itemValue: projectMenuSpawnBuffer
translateLabel: true
)
(MenuItem
enabled: hasProjectSelectedHolder
label: 'Buffer with Extensions'
itemValue: projectMenuSpawnExtensionsBuffer
translateLabel: true
)
(MenuItem
enabled: hasProjectSelectedHolder
label: 'Buffer with Projects Requiring this Project'
itemValue: projectMenuSpawnPreRequirerBuffer
translateLabel: true
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasProjectSelectedHolder
label: 'Browser'
itemValue: projectMenuSpawn
translateLabel: true
)
(MenuItem
enabled: hasProjectSelectedHolder
label: 'Browser on Extensions'
itemValue: projectMenuSpawnExtensionsBrowser
translateLabel: true
)
(MenuItem
enabled: hasProjectSelectedHolder
label: 'Browser on Projects Requiring this Project'
itemValue: projectMenuSpawnPreRequirerBrowser
translateLabel: true
)
)
nil
nil
)
)
(MenuItem
enabled: hasProjectSelectedHolder
label: 'Find'
translateLabel: true
submenuChannel: searchMenu
)
(MenuItem
label: '-'
)
(MenuItem
label: 'New...'
itemValue: projectMenuNew
translateLabel: true
)
(MenuItem
label: 'Load...'
itemValue: projectMenuLoad
translateLabel: true
isVisible: hasNoProjectSelectedHolder
showBusyCursorWhilePerforming: true
)
(MenuItem
label: 'Load'
itemValue: projectMenuLoad
translateLabel: true
isVisible: hasProjectSelectedHolder
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasProjectSelectedHolder
label: 'Rename...'
itemValue: projectMenuRename
translateLabel: true
)
(MenuItem
enabled: hasProjectSelectedHolder
label: 'Remove...'
itemValue: projectMenuRemove
translateLabel: true
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasSingleRealProjectSelectedHolder
label: 'Properties...'
itemValue: projectMenuProperties
translateLabel: true
)
(MenuItem
enabled: hasSingleRealProjectSelectedHolder
label: 'Generate'
translateLabel: true
submenu:
(Menu
(
(MenuItem
enabled: hasProjectSelectedHolder
label: 'Generate Project Definition Methods'
itemValue: projectMenuGenerateProjectDefinitions
translateLabel: true
)
(MenuItem
enabled: hasProjectSelectedHolder
label: 'Update Project Contents Definition Methods'
itemValue: projectMenuUpdateProjectContentsDefinitions
translateLabel: true
)
(MenuItem
enabled: hasProjectSelectedHolder
label: 'Regenerate Project Contents Definition Methods'
itemValue: projectMenuRegenerateProjectContentsDefinitions
translateLabel: true
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasSingleRealProjectSelectedHolder
label: 'Build Binaries for Deployment'
itemValue: projectMenuBuild
translateLabel: true
showBusyCursorWhilePerforming: true
)
)
nil
nil
)
)
(MenuItem
label: 'Debug'
translateLabel: true
submenuChannel: projectDebugMenu
keepLinkedMenu: true
)
(MenuItem
label: 'Special'
translateLabel: true
submenu:
(Menu
(
(MenuItem
enabled: hasSingleRealProjectSelectedHolder
label: 'Remove from ChangeSet'
itemValue: projectMenuCleanUpChangeSet
translateLabel: true
)
(MenuItem
label: '-'
isVisible: false
)
(MenuItem
enabled: hasSingleRealProjectSelectedHolder
label: 'Make Current Project'
itemValue: projectMenuMakeCurrentProject
translateLabel: true
isVisible: false
)
)
nil
nil
)
)
(MenuItem
label: '-'
)
(MenuItem
label: 'Update'
itemValue: projectMenuUpdate
translateLabel: true
)
)
nil
nil
)
"Modified: / 27-04-2010 / 12:42:43 / cg"
!
projectMenuCVS
"This resource specification was automatically generated
by the MenuEditor of ST/X."
"Do not manually edit this!! If it is corrupted,
the MenuEditor may not be able to read the specification."
"
MenuEditor new openOnClass:Tools::NewSystemBrowser andSelector:#projectMenuCVS
(Menu new fromLiteralArrayEncoding:(Tools::NewSystemBrowser projectMenuCVS)) startUp
"
<resource: #menu>
^
#(Menu
(
(MenuItem
enabled: hasProjectSelectedAndSourceCodeManagerHolder
label: 'CheckIn...'
itemValue: projectMenuCheckInAll
translateLabel: true
labelImage: (ResourceRetriever ToolbarIconLibrary repositoryCheckIn 'CheckIn...')
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasProjectSelectedAndSourceCodeManagerHolder
label: 'CheckIn Classes Only...'
itemValue: projectMenuCheckInClasses
translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasProjectSelectedAndSourceCodeManagerHolder
label: 'CheckIn Extensions Only...'
itemValue: projectMenuCheckInExtensions
translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasProjectSelectedAndSourceCodeManagerHolder
label: 'CheckIn Build Support Files Only...'
itemValue: projectMenuCheckInBuildSupportFiles
translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasProjectSelectedAndSourceCodeManagerHolder
label: 'Set Tag (Release As)...'
itemValue: projectMenuSetTag
translateLabel: true
labelImage: (ResourceRetriever ToolbarIconLibrary repositoryTag 'Set Tag (Release As)...')
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasProjectSelectedAndSourceCodeManagerHolder
label: 'CheckOut Newest'
itemValue: projectMenuCheckOutNewest
translateLabel: true
labelImage: (ResourceRetriever ToolbarIconLibrary repositoryCheckOut 'CheckOut Newest')
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasProjectSelectedAndSourceCodeManagerHolder
label: 'CheckOut Previous Version...'
itemValue: projectMenuCheckOut
translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasProjectSelectedAndSourceCodeManagerHolder
label: 'CheckOut Extensions Only...'
itemValue: projectMenuCheckOutExtensions
translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
label: '-'
)
(MenuItem
label: 'Import Structure...'
itemValue: projectMenuImport
translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
label: 'Import...'
itemValue: projectMenuImportAndLoadClasses
translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasProjectSelectedAndSourceCodeManagerHolder
label: 'Repository History...'
itemValue: projectMenuRepositoryHistory
translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasProjectSelectedAndSourceCodeManagerHolder
label: 'Compare with Newest in Repository...'
itemValue: projectMenuCompareAgainstNewestInRepository
translateLabel: true
)
(MenuItem
enabled: hasProjectSelectedAndSourceCodeManagerHolder
label: 'Compare with Repository at Date...'
itemValue: projectMenuCompareAgainstRepository
translateLabel: true
)
(MenuItem
label: 'Compare Build Support File'
translateLabel: true
submenuChannel: compareBuildSupportFileMenu
)
(MenuItem
enabled: hasProjectSelectedAndSourceCodeManagerHolder
label: 'Consistency Check...'
itemValue: projectMenuCheckRepositoryConsistency
translateLabel: true
)
(MenuItem
label: '-'
isVisible: false
)
(MenuItem
enabled: hasProjectSelectedHolder
label: 'Resource Files...'
itemValue: projectMenuResources
translateLabel: true
isVisible: false
)
(MenuItem
enabled: hasProjectSelectedHolder
label: 'Bitmap Files...'
itemValue: projectMenuBitmapFiles
translateLabel: true
isVisible: false
)
)
nil
nil
)
!
protocolMenu
"This resource specification was automatically generated
by the MenuEditor of ST/X."
"Do not manually edit this!! If it is corrupted,
the MenuEditor may not be able to read the specification."
"
MenuEditor new openOnClass:Tools::NewSystemBrowser andSelector:#protocolMenu
(Menu new fromLiteralArrayEncoding:(Tools::NewSystemBrowser protocolMenu)) startUp
"
<resource: #menu>
^
#(Menu
(
(MenuItem
enabled: hasProtocolSelectedHolder
label: 'FileOut'
translateLabel: true
submenu:
(Menu
(
(MenuItem
enabled: hasProtocolSelectedHolder
label: 'as...'
itemValue: protocolMenuFileOutAs
translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasProtocolSelectedAndCanFileOutXMLHolder
label: 'XML as...'
itemValue: protocolMenuFileOutXMLAs
translateLabel: true
isVisible: false
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasProtocolSelectedAndCanFileOutSIFHolder
label: 'SIF as...'
itemValue: protocolMenuFileOutSIFAs
translateLabel: true
isVisible: false
showBusyCursorWhilePerforming: true
)
)
nil
nil
)
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasProtocolSelectedHolder
label: 'Documentation'
translateLabel: true
isVisible: false
submenu:
(Menu
(
(MenuItem
enabled: hasProtocolSelectedHolder
label: 'PrintOut'
itemValue: protocolMenuPrintOut
translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasProtocolSelectedHolder
label: 'PrintOut Protocol'
itemValue: protocolMenuPrintOutProtocol
translateLabel: true
isVisible: false
showBusyCursorWhilePerforming: true
)
)
nil
nil
)
)
(MenuItem
enabled: hasProtocolSelectedHolder
label: 'PrintOut'
itemValue: protocolMenuPrintOut
translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
label: '-'
)
(MenuItem
label: 'Spawn'
translateLabel: true
submenu:
(Menu
(
(MenuItem
enabled: hasProtocolSelectedHolder
label: 'Buffer'
itemValue: protocolMenuSpawnBuffer
translateLabel: true
)
(MenuItem
enabled: hasProtocolSelectedHolder
label: 'Buffer with Full Protocol'
itemValue: protocolMenuSpawnFullCategoryBuffer
translateLabel: true
)
(MenuItem
label: 'Buffer with Full Protocols Matching...'
itemValue: protocolMenuSpawnMatchingFullCategoryBuffer
translateLabel: true
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasProtocolSelectedHolder
label: 'Browser'
itemValue: protocolMenuSpawn
translateLabel: true
)
(MenuItem
enabled: hasProtocolSelectedHolder
label: 'Browser on Full Protocol'
itemValue: protocolMenuSpawnFullCategory
translateLabel: true
)
(MenuItem
label: 'Browser on Full Protocols Matching...'
itemValue: protocolMenuSpawnMatchingFullCategoryBrowser
translateLabel: true
)
)
nil
nil
)
)
(MenuItem
enabled: hasProtocolSelectedHolder
label: 'Find'
translateLabel: true
isVisible: false
submenu:
(Menu
(
(MenuItem
enabled: hasProtocolSelectedHolder
label: 'String...'
itemValue: protocolMenuFindString
translateLabel: true
)
)
nil
nil
)
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasClassSelectedHolder
label: 'New...'
itemValue: protocolMenuNew
translateLabel: true
)
(MenuItem
enabled: hasProtocolSelectedHolder
label: 'Copy...'
itemValue: protocolMenuCopyToClass
translateLabel: true
)
(MenuItem
enabled: hasProtocolSelectedHolder
label: 'Move'
translateLabel: true
submenu:
(Menu
(
(MenuItem
enabled: hasProtocolSelectedHolder
label: 'To Class...'
itemValue: protocolMenuMoveToClass
translateLabel: true
)
(MenuItem
enabled: hasProtocolSelectedHolder
label: 'To Project...'
itemValue: protocolMenuMoveToProject
translateLabel: true
)
)
nil
nil
)
)
(MenuItem
enabled: hasSingleRealProtocolSelectedHolder
label: 'Rename...'
itemValue: protocolMenuRename
translateLabel: true
shortcutKey: Rename
ignoreShortcutKeys: true
)
(MenuItem
enabled: hasProtocolSelectedHolder
label: 'Remove...'
itemValue: protocolMenuRemove
translateLabel: true
)
(MenuItem
label: '-'
)
(MenuItem
label: 'Generate'
translateLabel: true
submenu:
(Menu
(
(MenuItem
label: 'Common Categories'
itemValue: protocolMenuGenerateCommonProtocols
translateLabel: true
)
)
nil
nil
)
)
"/ (MenuItem
"/ label: 'Special'
"/ translateLabel: true
"/ submenu:
"/ (Menu
"/ (
"/ (MenuItem
"/ label: 'Auto Assign'
"/ itemValue: protocolMenuAutoAssignMethods
"/ translateLabel: true
"/ )
"/ )
"/ nil
"/ nil
"/ )
"/ ) (MenuItem
"/ label: '-'
"/ isVisible: false
"/ )
(MenuItem
label: 'Update'
itemValue: protocolMenuUpdate
translateLabel: true
isVisible: false
)
)
nil
nil
)
!
refactoringMenu
"get here via codeViewMenu (holder in codeView)"
"
MenuEditor new openOnClass:Tools::NewSystemBrowser andSelector:#refactoringMenu
(Menu new fromLiteralArrayEncoding:(Tools::NewSystemBrowser refactoringMenu)) startUp
"
<resource: #menu>
^
#(Menu
(
(MenuItem
enabled: hasClassNameSelectedInCodeView
label: 'Goto Class'
itemValue: codeMenuGotoClass
translateLabel: true
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasTemporaryVariableSelectedInCodeViewHolder
label: 'Rename Local Variable...'
itemValue: codeMenuRenameTemporary
translateLabel: true
shortcutKey: Rename
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasTemporaryVariableSelectedInCodeViewHolder
label: 'Make Instance Variable'
itemValue: codeMenuMakeInstanceVariable
translateLabel: true
isVisible: hasNotMultipleTemporaryVariablesSelectedInCodeViewHolder
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasMultipleTemporaryVariablesSelectedInCodeViewHolder
label: 'Make Instance Variables'
itemValue: codeMenuMakeInstanceVariable
translateLabel: true
isVisible: hasMultipleTemporaryVariablesSelectedInCodeViewHolder
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasUndefinedUppercaseIdentifierSelectedInCodeViewHolder
label: 'Declare as Class Variable'
itemValue: codeMenuDeclareSelectionAsClassVariable
translateLabel: true
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasSingleMethodSelectedAndSelectionInCodeViewAndCanUseRefactoringSupportHolder
label: 'Inline Message'
itemValue: codeMenuInlineMessage
translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasSingleMethodSelectedAndSelectionInCodeViewAndCanUseRefactoringSupportHolder
label: 'Extract Selection to Temporary...'
itemValue: codeMenuExtractSelectionToTemporary
translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasSingleMethodSelectedAndSelectionInCodeViewAndCanUseRefactoringSupportHolder
label: 'Extract Method...'
itemValue: codeMenuExtractMethod
translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasSingleMethodSelectedAndSelectionInCodeViewAndSingleSelectedMethodHasParameterAndCanUseRefactoringSupportHolder
label: 'Inline Parameter of Method'
itemValue: codeMenuInlineParameter
translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasSingleMethodSelectedAndSelectionInCodeViewAndSingleSelectedMethodHasParameterAndCanUseRefactoringSupportHolder
label: 'Remove Parameter from Method'
itemValue: codeMenuRemoveParameter
translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasSingleMethodSelectedAndCanUseRefactoringSupportHolder
label: 'Format'
itemValue: codeMenuFormat
translateLabel: true
showBusyCursorWhilePerforming: true
)
)
nil
nil
)
!
searchMenu
"This resource specification was automatically generated
by the MenuEditor of ST/X."
"Do not manually edit this!! If it is corrupted,
the MenuEditor may not be able to read the specification."
"
MenuEditor new openOnClass:NewSystemBrowser andSelector:#searchMenu
(Menu new fromLiteralArrayEncoding:(NewSystemBrowser searchMenu)) startUp
"
<resource: #menu>
^
#(#Menu
#(
#(#MenuItem
#label: 'Class...'
#translateLabel: true
#value: #searchMenuFindClass
shortcutKey: #'Cmds'
ignoreShortcutKeys: true
)
#(#MenuItem
#label: 'Class Hierarchy'
#translateLabel: true
#enabled: #hasSelectedClassWithSuperclassHolder
#submenuChannel: #selectedClassesHierarchyMenu
)
#(#MenuItem
#label: 'Changed Classes'
#translateLabel: true
#enabled: #hasChangedClassesHolder
#submenuChannel: #changedClassesMenu
)
#(#MenuItem
#label: 'Visited Classes'
#translateLabel: true
#enabled: #hasVisitedClassesHolder
#submenuChannel: #visitedClassesMenu
)
#(#MenuItem
#label: '-'
)
#(#MenuItem
#label: 'Method...'
#translateLabel: true
#value: #searchMenuFindMethod
)
#(#MenuItem
#label: 'Changed Methods'
#translateLabel: true
#enabled: #hasChangedMethodsHolder
#submenuChannel: #changedMethodsMenu
)
#(#MenuItem
#label: 'Visited Methods'
#translateLabel: true
#enabled: #hasFindHistoryClassesHolder
#submenuChannel: #findHistoryMenu
)
#(#MenuItem
#label: '-'
)
#(#MenuItem
#label: 'Response to...'
#translateLabel: true
#value: #searchMenuFindResponseTo
#enabled: #hasSingleClassOrMethodSelectedHolder
)
#(#MenuItem
#label: 'Response to'
#translateLabel: true
#submenuChannel: #sentMessagesResponseMenu
#isVisible: #hasSingleMethodSelectedHolder
)
#(#MenuItem
#label: '-'
)
#(#MenuItem
#label: 'Bookmarks'
#translateLabel: true
#submenuChannel: #boockmarksMenu
)
)
nil
nil
)
!
searchMenuInMethodList
"This resource specification was automatically generated
by the MenuEditor of ST/X."
"Do not manually edit this!! If it is corrupted,
the MenuEditor may not be able to read the specification."
"
MenuEditor new openOnClass:NewSystemBrowser andSelector:#searchMenu
(Menu new fromLiteralArrayEncoding:(NewSystemBrowser searchMenu)) startUp
"
<resource: #menu>
^
#(#Menu
#(
#(#MenuItem
#label: 'Response to...'
#translateLabel: true
#value: #searchMenuFindResponseTo
#enabled: #hasSingleClassOrMethodSelectedHolder
)
#(#MenuItem
#label: '-'
)
#(#MenuItem
#label: 'Back'
#translateLabel: true
#enabled: #hasFindHistoryClassesHolder
#submenuChannel: #findHistoryMenu
)
#(#MenuItem
#label: 'Changed Methods'
#translateLabel: true
#enabled: #hasChangedMethodsHolder
#submenuChannel: #changedMethodsMenu
)
)
nil
nil
)
!
selectorMenu
"This resource specification was automatically generated
by the MenuEditor of ST/X."
"Do not manually edit this!! If it is corrupted,
the MenuEditor may not be able to read the specification."
"
MenuEditor new openOnClass:Tools::NewSystemBrowser andSelector:#selectorMenu
(Menu new fromLiteralArrayEncoding:(Tools::NewSystemBrowser selectorMenu)) startUp
"
<resource: #menu>
^
#(Menu
(
(MenuItem
label: 'FileOutPrintOutSlice'
translateLabel: true
submenuChannel: selectorMenuFileOutPrintOutSlice
isMenuSlice: true
)
(MenuItem
label: '-'
)
(MenuItem
label: 'SpawnSlice'
translateLabel: true
submenuChannel: selectorMenuSpawnSlice
isMenuSlice: true
)
(MenuItem
label: '-'
)
(MenuItem
label: 'SearchSlice'
translateLabel: true
submenuChannel: selectorMenuSearchSlice
isMenuSlice: true
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasClassSelectedHolder
label: 'New'
translateLabel: true
submenu:
(Menu
(
(MenuItem
enabled: hasClassSelectedHolder
label: 'Method'
itemValue: selectorMenuNewMethod
translateLabel: true
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasClassSelectedHolder
label: 'Window Spec'
itemValue: selectorMenuNewWindowSpec
translateLabel: true
)
(MenuItem
enabled: hasClassSelectedHolder
label: 'Menu Spec'
itemValue: selectorMenuNewMenuSpec
translateLabel: true
)
(MenuItem
enabled: hasClassSelectedHolder
label: 'Image Spec'
itemValue: selectorMenuNewImageSpec
translateLabel: true
)
(MenuItem
enabled: hasClassSelectedHolder
label: 'Table-Column Spec'
itemValue: selectorMenuNewTableColumnSpec
translateLabel: true
)
)
nil
nil
)
)
(MenuItem
label: 'CopyMoveRemoveSlice'
translateLabel: true
submenuChannel: selectorMenuCopyMoveRemoveSlice
isMenuSlice: true
)
(MenuItem
label: '-'
)
(MenuItem
label: 'CompareGenerateDebugSlice'
translateLabel: true
submenuChannel: selectorMenuCompareGenerateDebugSlice
isMenuSlice: true
)
)
nil
nil
)
!
selectorMenuCVS
"This resource specification was automatically generated
by the MenuEditor of ST/X."
"Do not manually edit this!! If it is corrupted,
the MenuEditor may not be able to read the specification."
"
MenuEditor new openOnClass:Tools::NewSystemBrowser andSelector:#selectorMenuFileOutPrintOutSlice
(Menu new fromLiteralArrayEncoding:(Tools::NewSystemBrowser selectorMenuFileOutPrintOutSlice)) startUp
"
<resource: #menu>
^
#(Menu
(
(MenuItem
enabled: hasMethodSelected
label: 'CheckIn Class(es)...'
itemValue: methodListMenuCheckInClass
translateLabel: true
labelImage: (ResourceRetriever ToolbarIconLibrary repositoryCheckIn 'CheckIn Class(es)...')
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasRealExtensionMethodSelectedHolder
label: 'CheckIn Extensions for Project...'
itemValue: selectorMenuCheckInProjectExtensions
translateLabel: true
isVisible: hasExtensionMethodSelectedHolder
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasMethodSelectedAndSourceCodeManagerHolder
label: 'Compare with Newest in Repository...'
itemValue: selectorMenuCompareAgainstNewestInRepository
translateLabel: true
labelImage: (ResourceRetriever ToolbarIconLibrary repositoryVersions 'Compare with Newest in Repository...')
)
(MenuItem
enabled: hasMethodSelectedAndSourceCodeManagerHolder
label: 'Compare Class with Newest in Repository...'
itemValue: selectorMenuCompareClassAgainstNewestInRepository
translateLabel: true
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasSingleMethodSelected
label: 'Browse Repository Versions...'
itemValue: selectorMenuBrowseRepositoryVersions
translateLabel: true
)
)
nil
nil
)
!
selectorMenuCompareGenerateDebugSlice
"This resource specification was automatically generated
by the MenuEditor of ST/X."
"Do not manually edit this!! If it is corrupted,
the MenuEditor may not be able to read the specification."
"
MenuEditor new openOnClass:Tools::NewSystemBrowser andSelector:#selectorMenuCompareGenerateDebugSlice
(Menu new fromLiteralArrayEncoding:(Tools::NewSystemBrowser selectorMenuCompareGenerateDebugSlice)) startUp
"
<resource: #menu>
^
#(Menu
(
(MenuItem
enabled: hasMethodSelectedHolder
label: 'Compare'
translateLabel: true
submenu:
(Menu
(
(MenuItem
enabled: methodRedefinesSuperclassVersionHolder
label: 'With Inherited Method'
itemValue: selectorMenuCompareWithInherited
translateLabel: true
)
(MenuItem
enabled: methodHasPreviousVersionHolder
label: 'With Previous Version'
itemValue: selectorMenuCompareWithPreviousVersion
translateLabel: true
)
(MenuItem
enabled: hasSingleMethodSelectedAndCodeModifiedHolder
label: 'With Methods Actual Source'
itemValue: selectorMenuCompareWithMethod
translateLabel: true
)
(MenuItem
enabled: hasExactlyTwoMethodsSelectedHolder
label: 'With Each Other'
itemValue: selectorMenuCompareTwoSelectedMethods
translateLabel: true
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasMethodSelectedAndSourceCodeManagerHolder
label: 'With Newest in CVS Repository...'
itemValue: selectorMenuCompareAgainstNewestInRepository
translateLabel: true
)
(MenuItem
enabled: smallTeamAvailable
label: 'With SmallTeam Version On Host'
translateLabel: true
submenuChannel: compareMethodWithSmallTeamVersionMenu
)
)
nil
nil
)
)
(MenuItem
label: 'Refactor'
translateLabel: true
submenuChannel: methodRefactorMenu
)
(MenuItem
label: 'Generate'
translateLabel: true
submenu:
(Menu
(
(MenuItem
enabled: methodNotImplementedInSuperclass
label: 'SubclassResponsibility in SuperClass'
itemValue: selectorMenuGenerateSubclassResponsibilityInSuperclass
translateLabel: true
)
(MenuItem
enabled: methodNotImplementedInClass
label: 'SubclassResponsibility here'
itemValue: selectorMenuGenerateSubclassResponsibilityHere
translateLabel: true
)
(MenuItem
label: 'Templates in Subclasses'
itemValue: selectorMenuGenerateTemplateInSubclasses
translateLabel: true
)
(MenuItem
label: 'Templates in all Subclasses'
itemValue: selectorMenuGenerateTemplateInAllSubclasses
translateLabel: true
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasInstanceMethodsSelectedHolder
label: 'Corresponding Instance Creation in Class'
itemValue: selectorMenuGenerateCorrespondingInstanceCreationInClass
translateLabel: true
)
(MenuItem
enabled: hasClassMethodsSelectedHolder
label: 'Forwarding Method in Instance Protocol'
itemValue: selectorMenuGenerateForwardingMethodForInstances
translateLabel: true
)
)
nil
nil
)
)
(MenuItem
label: 'Debug'
translateLabel: true
submenuChannel: methodDebugMenu
shortcutKey: Ctrl
)
(MenuItem
label: 'Special'
translateLabel: true
submenu:
(Menu
(
(MenuItem
label: 'Select'
translateLabel: true
isVisible: false
submenu:
(Menu
(
(MenuItem
label: 'Methods with String...'
itemValue: selectorMenuSelectMethodsWithString
translateLabel: true
)
(MenuItem
label: 'Methods Sending...'
itemValue: selectorMenuSelectMethodsSending
translateLabel: true
)
(MenuItem
label: 'Methods Refering to Global...'
itemValue: selectorMenuSelectMethodsReferingToGlobal
translateLabel: true
)
)
nil
nil
)
)
(MenuItem
label: '-'
isVisible: false
)
(MenuItem
enabled: methodHasPreviousVersionHolder
label: 'Back to Previous Version'
itemValue: selectorMenuBackToPrevious
translateLabel: true
)
(MenuItem
enabled: methodHasPreviousVersionHolder
label: 'Previous Versions'
itemValue: selectorMenuBrowsePreviousVersions
translateLabel: true
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasSingleMethodSelectedHolder
label: 'Inspect Method'
itemValue: selectorMenuInspect
translateLabel: true
)
(MenuItem
enabled: hasSingleResourceMethodSelectedHolder
label: 'Edit Resource'
itemValue: selectorMenuEdit
translateLabel: true
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasMethodSelectedHolder
label: 'Recompile'
itemValue: selectorMenuRecompile
translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasMethodSelectedHolder
label: 'Compile with stc'
itemValue: selectorMenuCompileWithSTC
translateLabel: true
)
(MenuItem
enabled: hasSingleMethodWithBytecodeSelectedHolder
label: 'Decompile'
itemValue: selectorMenuDecompile
translateLabel: true
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasMethodSelectedHolder
label: 'Process...'
itemValue: selectorMenuProcess
translateLabel: true
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasMethodsInList
label: 'Copy List to Clipboard'
itemValue: methodListMenuCopyList
translateLabel: true
)
(MenuItem
enabled: hasMethodsInList
label: 'Copy List of Classes to Clipboard'
itemValue: methodListMenuCopyListOfClasses
translateLabel: true
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasMethodSelectedHolder
label: 'Remove from ChangeSet'
itemValue: selectorMenuCleanUpChangeSet
translateLabel: true
)
)
nil
nil
)
)
)
nil
nil
)
!
selectorMenuCopyMoveRemoveSlice
"This resource specification was automatically generated
by the MenuEditor of ST/X."
"Do not manually edit this!! If it is corrupted,
the MenuEditor may not be able to read the specification."
"
MenuEditor new openOnClass:Tools::NewSystemBrowser andSelector:#selectorMenuCopyMoveRemoveSlice
(Menu new fromLiteralArrayEncoding:(Tools::NewSystemBrowser selectorMenuCopyMoveRemoveSlice)) startUp
"
<resource: #menu>
^
#(Menu
(
(MenuItem
enabled: hasMethodSelectedHolder
label: 'Copy...'
itemValue: selectorMenuCopy
translateLabel: true
)
(MenuItem
enabled: hasMethodSelectedHolder
label: 'Move'
translateLabel: true
submenu:
(Menu
(
(MenuItem
enabled: hasMethodSelectedHolder
label: 'To Protocol...'
itemValue: selectorMenuMoveToProtocol
translateLabel: true
)
(MenuItem
enabled: hasMethodSelectedHolder
label: 'To Class...'
itemValue: selectorMenuMoveToClass
translateLabel: true
)
(MenuItem
enabled: hasClassMethodsSelectedHolder
label: 'To Class with Forwarding...'
itemValue: selectorMenuMoveToClassWithForwarding
translateLabel: true
)
(MenuItem
enabled: hasMethodSelectedHolder
label: 'To Project...'
itemValue: selectorMenuMoveToProject
translateLabel: true
)
(MenuItem
enabled: hasExtensionMethodSelectedHolder
label: 'To Classes Project'
itemValue: selectorMenuMoveToClassProject
translateLabel: true
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasInstanceMethodsSelectedHolder
label: 'To Class Protocol (Make Class Method)'
itemValue: selectorMenuMakeClassMethod
translateLabel: true
)
(MenuItem
enabled: hasInstanceMethodsSelectedHolder
label: 'To Class Protocol (Make Class Method) with Forwarding'
itemValue: selectorMenuMakeClassMethodWithForwarding
translateLabel: true
)
(MenuItem
enabled: hasClassMethodsSelectedHolder
label: 'To Instance Protocol (Make Instance Method)'
itemValue: selectorMenuMakeInstanceMethod
translateLabel: true
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasMethodSelectedAndCanUseRefactoringSupportHolder
label: 'Push Up'
itemValue: selectorMenuPushUpMethod
translateLabel: true
)
(MenuItem
enabled: hasMethodSelectedAndCanUseRefactoringSupportHolder
label: 'Push Down'
itemValue: selectorMenuPushDownMethod
translateLabel: true
)
)
nil
nil
)
)
(MenuItem
enabled: hasMethodSelectedHolder
label: 'Visibility'
translateLabel: true
submenu:
(Menu
(
(MenuItem
enabled: hasAnyNonPublicMethodSelectedHolder
label: 'Public'
itemValue: selectorMenuMakePublic
translateLabel: true
)
(MenuItem
enabled: hasAnyNonProtectedMethodSelectedHolder
label: 'Protected'
itemValue: selectorMenuMakeProtected
translateLabel: true
labelImage: (ResourceRetriever SystemBrowser protectedMethodIcon 'Protected')
)
(MenuItem
enabled: hasAnyNonPrivateMethodSelectedHolder
label: 'Private'
itemValue: selectorMenuMakePrivate
translateLabel: true
labelImage: (ResourceRetriever SystemBrowser privateMethodIcon 'Private')
)
(MenuItem
enabled: hasAnyNonIgnoredMethodSelectedHolder
label: 'Ignored'
itemValue: selectorMenuMakeIgnored
translateLabel: true
labelImage: (ResourceRetriever SystemBrowser ignoredMethodIcon 'Ignored')
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasMethodSelectedHolder
label: 'Mark as Obsolete'
itemValue: selectorMenuMarkAsObsolete
translateLabel: true
)
)
nil
nil
)
)
(MenuItem
enabled: hasMethodSelectedAndCanUseRefactoringSupportHolder
label: 'Rename...'
itemValue: selectorMenuRename
translateLabel: true
"/ shortcutKey: #'Cmdr'
shortcutKey: #'Rename'
ignoreShortcutKeys: true
)
(MenuItem
enabled: hasMethodSelectedAndCanUseRefactoringSupportHolder
label: 'Safe Remove...'
itemValue: selectorMenuSaveRemove
translateLabel: true
)
(MenuItem
enabled: hasMethodSelectedHolder
label: 'Remove...'
itemValue: selectorMenuRemove
translateLabel: true
)
)
nil
nil
)
"Modified: / 23-11-2006 / 12:29:25 / cg"
!
selectorMenuFileOutPrintOutSlice
"This resource specification was automatically generated
by the MenuEditor of ST/X."
"Do not manually edit this!! If it is corrupted,
the MenuEditor may not be able to read the specification."
"
MenuEditor new openOnClass:Tools::NewSystemBrowser andSelector:#selectorMenuFileOutPrintOutSlice
(Menu new fromLiteralArrayEncoding:(Tools::NewSystemBrowser selectorMenuFileOutPrintOutSlice)) startUp
"
<resource: #menu>
^
#(Menu
(
(MenuItem
enabled: hasMethodSelectedHolder
label: 'FileOut'
translateLabel: true
submenu:
(Menu
(
(MenuItem
enabled: hasMethodSelectedHolder
label: 'as...'
itemValue: selectorMenuFileOutAs
translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasMethodSelectedAndCanFileOutXMLHolder
label: 'XML as...'
itemValue: selectorMenuFileOutXMLAs
translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasMethodSelectedAndCanFileOutSIFHolder
label: 'SIF as...'
itemValue: selectorMenuFileOutSIFAs
translateLabel: true
showBusyCursorWhilePerforming: true
)
)
nil
nil
)
)
(MenuItem
enabled: hasMethodSelected
label: 'CVS'
translateLabel: true
submenuChannel: selectorMenuCVS
labelImage: (ResourceRetriever ToolbarIconLibrary repositoryCVSIcon 'CVS')
)
(MenuItem
label: 'SmallTeam'
translateLabel: true
isVisible: smallTeamAvailable
submenuChannel: selectorSmallTeamMenu
keepLinkedMenu: true
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasMethodSelectedHolder
label: 'PrintOut'
itemValue: selectorMenuPrintOut
translateLabel: true
showBusyCursorWhilePerforming: true
)
)
nil
nil
)
!
selectorMenuSearchSlice
"This resource specification was automatically generated
by the MenuEditor of ST/X."
"Do not manually edit this!! If it is corrupted,
the MenuEditor may not be able to read the specification."
"
MenuEditor new openOnClass:Tools::NewSystemBrowser andSelector:#selectorMenuSearchSlice
(Menu new fromLiteralArrayEncoding:(Tools::NewSystemBrowser selectorMenuSearchSlice)) startUp
"
<resource: #menu>
^
#(Menu
(
(MenuItem
label: 'Senders...'
itemValue: browseSendersOf
translateLabel: true
)
(MenuItem
label: 'Senders of Any...'
itemValue: browseSendersOfAny
translateLabel: true
isVisible: hasMultipleMethodsSelectedHolder
)
(MenuItem
label: 'Senders'
translateLabel: true
isVisible: hasSingleMethodSelectedHolder
submenuChannel: sentMessagesMenu
)
(MenuItem
label: 'Implementors...'
itemValue: browseMenuImplementorsOf
translateLabel: true
shortcutKey: #'Cmdi'
ignoreShortcutKeys: true
)
(MenuItem
label: 'Implementors of Any...'
itemValue: browseMenuImplementorsOfAny
translateLabel: true
isVisible: hasMultipleMethodsSelectedHolder
)
(MenuItem
label: 'Implementors'
translateLabel: true
"/ isVisible: hasSingleMethodSelectedHolder
submenuChannel: implementedMessagesMenu
)
(MenuItem
label: 'String Search...'
itemValue: browseMenuMethodsWithString
translateLabel: true
shortcutKey: #'Cmdt'
ignoreShortcutKeys: true
)
(MenuItem
label: 'Code Search...'
itemValue: browseMenuMethodsWithCode
translateLabel: true
)
)
nil
nil
)
!
selectorMenuSpawnSlice
"This resource specification was automatically generated
by the MenuEditor of ST/X."
"Do not manually edit this!! If it is corrupted,
the MenuEditor may not be able to read the specification."
"
MenuEditor new openOnClass:Tools::NewSystemBrowser andSelector:#selectorMenuSpawnSlice
(Menu new fromLiteralArrayEncoding:(Tools::NewSystemBrowser selectorMenuSpawnSlice)) startUp
"
<resource: #menu>
^
#(Menu
(
(MenuItem
enabled: hasMethodSelectedHolder
label: 'Spawn'
translateLabel: true
submenu:
(Menu
(
(MenuItem
enabled: hasMethodSelectedHolder
label: 'Buffer with Full Class(es)'
itemValue: methodListMenuSpawnFullBrowserBuffer
translateLabel: true
isVisible: isMethodListBrowserOrHasMultipleClassesSelectedHolder
)
(MenuItem
enabled: hasMethodSelectedHolder
label: 'Buffer with Class(es)'
itemValue: methodListMenuSpawnClassesBuffer
translateLabel: true
isVisible: isMethodListBrowserOrHasMultipleClassesSelectedHolder
)
(MenuItem
enabled: hasMethodSelectedHolder
label: 'Buffer with References to Class'
itemValue: methodListMenuSpawnBufferWithClassReferences
translateLabel: true
)
(MenuItem
enabled: hasMethodSelectedHolder
label: 'Buffer with References to Class or Subclass'
itemValue: methodListMenuSpawnBufferWithClassOrSubclassReferences
translateLabel: true
)
(MenuItem
enabled: hasMethodSelectedHolder
label: 'Buffer'
itemValue: selectorMenuSpawnMethodBuffer
translateLabel: true
)
(MenuItem
enabled: hasMethodSelectedHolder
label: 'Buffer with Implementors'
itemValue: selectorMenuSpawnImplementorsBuffer
translateLabel: true
isVisible: false
)
(MenuItem
enabled: hasMethodSelectedHolder
label: 'Buffer with Senders'
itemValue: selectorMenuSpawnSendersBuffer
translateLabel: true
isVisible: false
)
(MenuItem
enabled: hasRealExtensionMethodSelectedHolder
label: 'Buffer with Extensions for Project'
itemValue: selectorMenuSpawnProjectExtensionsBuffer
translateLabel: true
isVisible: hasExtensionMethodSelectedHolder
)
(MenuItem
enabled: hasRealExtensionMethodSelectedHolder
label: 'Buffer with Extension''s Project'
itemValue: selectorMenuSpawnExtensionsProjectBuffer
translateLabel: true
isVisible: hasExtensionMethodSelectedHolder
)
(MenuItem
enabled: hasUnassignedExtensionMethodSelectedHolder
label: 'Buffer with Unassigned Extensions'
itemValue: selectorMenuSpawnProjectExtensionsBuffer
translateLabel: true
isVisible: hasExtensionMethodSelectedHolder
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasMethodSelectedHolder
label: 'Browser on Full Class(es)'
itemValue: methodListMenuSpawnFullBrowser
translateLabel: true
isVisible: isMethodListBrowserOrHasMultipleClassesSelectedHolder
)
(MenuItem
enabled: hasMethodSelectedHolder
label: 'Browser on Class(es)'
itemValue: methodListMenuSpawnClasses
translateLabel: true
isVisible: isMethodListBrowserOrHasMultipleClassesSelectedHolder
)
(MenuItem
enabled: hasMethodSelectedHolder
label: 'Browser on References to Class'
itemValue: methodListMenuSpawnClassReferences
translateLabel: true
)
(MenuItem
enabled: hasMethodSelectedHolder
label: 'Browser on References to Class or Subclass'
itemValue: methodListMenuSpawnClassOrSubclassReferences
translateLabel: true
)
(MenuItem
enabled: hasMethodSelectedHolder
label: 'Browser'
itemValue: selectorMenuSpawnMethod
translateLabel: true
)
(MenuItem
enabled: hasMethodSelectedHolder
label: 'Browser on Implementors'
itemValue: selectorMenuSpawnImplementors
translateLabel: true
isVisible: false
)
(MenuItem
enabled: hasMethodSelectedHolder
label: 'Browser on Senders'
itemValue: selectorMenuSpawnSenders
translateLabel: true
isVisible: false
)
(MenuItem
enabled: hasRealExtensionMethodSelectedHolder
label: 'Browser on Extensions for Project'
itemValue: selectorMenuSpawnExtensionsProject
translateLabel: true
isVisible: hasExtensionMethodSelectedHolder
)
(MenuItem
enabled: hasRealExtensionMethodSelectedHolder
label: 'Browser on Extension''s Project'
itemValue: selectorMenuSpawnExtensionsProject
translateLabel: true
isVisible: hasExtensionMethodSelectedHolder
)
(MenuItem
enabled: hasUnassignedExtensionMethodSelectedHolder
label: 'Browser on Unassigned Extensions'
itemValue: selectorMenuSpawnProjectExtensions
translateLabel: true
isVisible: hasExtensionMethodSelectedHolder
)
)
nil
nil
)
)
(MenuItem
enabled: hasMethodSelectedHolder
label: 'Inheritance'
itemValue: selectorMenuSpawnInheritanceBuffer
translateLabel: true
)
)
nil
nil
)
"Modified: / 06-08-2006 / 12:09:31 / cg"
!
selectorSmallTeamMenu
"This resource specification was automatically generated
by the MenuEditor of ST/X."
"Do not manually edit this!! If it is corrupted,
the MenuEditor may not be able to read the specification."
"
MenuEditor new openOnClass:Tools::NewSystemBrowser andSelector:#selectorSmallTeamMenu
(Menu new fromLiteralArrayEncoding:(Tools::NewSystemBrowser selectorSmallTeamMenu)) startUp
"
<resource: #menu>
^
#(Menu
(
(MenuItem
enabled: hasMethodSelected
label: 'Load Version from Host'
translateLabel: true
submenuChannel: loadMethodFromSmallTeamHostMenu
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasMethodSelected
label: 'Compare with Version On Host'
translateLabel: true
submenuChannel: compareMethodWithSmallTeamVersionMenu
keepLinkedMenu: true
)
)
nil
nil
)
!
specialBrowseMenu
"This resource specification was automatically generated
by the MenuEditor of ST/X."
"Do not manually edit this!! If it is corrupted,
the MenuEditor may not be able to read the specification."
"
MenuEditor new openOnClass:NewSystemBrowser andSelector:#specialBrowseMenu
(Menu new fromLiteralArrayEncoding:(NewSystemBrowser specialBrowseMenu)) startUp
"
<resource: #menu>
^
#(#Menu
#(
#(#MenuItem
#enabled: #hasSourceCodeManagerHolder
#label: 'CVS Repository Diffs'
#translateLabel: true
#submenu:
#(#Menu
#(
#(#MenuItem
#label: 'Buffer'
#itemValue: #browseMenuSpawnRepositoryDiffsInBuffer
#translateLabel: true
)
#(#MenuItem
#label: '-'
)
#(#MenuItem
#label: 'Browser'
#itemValue: #browseMenuSpawnRepositoryDiffs
#translateLabel: true
)
)
nil
nil
)
)
#(#MenuItem
#label: 'Full Class Source'
#translateLabel: true
#submenu:
#(#Menu
#(
#(#MenuItem
#label: 'Buffer'
#itemValue: #browseMenuSpawnFullClassSourceInBuffer
#translateLabel: true
)
#(#MenuItem
#label: '-'
)
#(#MenuItem
#label: 'Browser'
#itemValue: #browseMenuSpawnFullClassSource
#translateLabel: true
)
)
nil
nil
)
)
#(#MenuItem
#label: 'Class Documentation'
#translateLabel: true
#submenu:
#(#Menu
#(
#(#MenuItem
#label: 'Buffer'
#itemValue: #spawnClassDocumentationBrowserIn:
#translateLabel: true
#argument: #newBuffer
)
#(#MenuItem
#label: '-'
)
#(#MenuItem
#label: 'Browser'
#itemValue: #spawnClassDocumentationBrowserIn:
#translateLabel: true
#argument: #newBrowser
)
)
nil
nil
)
)
)
nil
nil
)
!
variablesMenu
"This resource specification was automatically generated
by the MenuEditor of ST/X."
"Do not manually edit this!! If it is corrupted,
the MenuEditor may not be able to read the specification."
"
MenuEditor new openOnClass:Tools::NewSystemBrowser andSelector:#variablesMenu
(Menu new fromLiteralArrayEncoding:(Tools::NewSystemBrowser variablesMenu)) startUp
"
<resource: #menu>
^
#(Menu
(
(MenuItem
enabled: hasSingleClassSelectedAndCanUseRefactoringSupportHolder
label: 'Add...'
itemValue: variablesMenuAdd
translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasSingleClassSelectedAndCanUseRefactoringSupportHolder
label: 'Add ValueHolder...'
itemValue: variablesMenuAddValueHolder
translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasNonMetaSelectedAndClassSelectedHolder
label: 'Instance Variables'
translateLabel: true
submenu:
(Menu
(
(MenuItem
enabled: hasClassSelectedHolder
label: 'All References...'
itemValue: variablesMenuBrowseAllInstVarRefs
translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasClassSelectedHolder
label: 'All Readers...'
itemValue: variablesMenuBrowseAllInstVarReads
translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasClassSelectedHolder
label: 'All Writers...'
itemValue: variablesMenuBrowseAllInstVarMods
translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasClassSelectedHolder
label: 'Local References...'
itemValue: variablesMenuBrowseInstVarRefs
translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasClassSelectedHolder
label: 'Local Readers...'
itemValue: variablesMenuBrowseInstVarReads
translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasClassSelectedHolder
label: 'Local Writers...'
itemValue: variablesMenuBrowseInstVarMods
translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasInstanceVariableSelectedInCodeViewOrVariableListAndCanUseRefactoringSupportHolder
label: 'Pull Up'
itemValue: codeMenuPullUpInstanceVariable
translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasInstanceVariableSelectedInCodeViewOrVariableListAndCanUseRefactoringSupportHolder
label: 'Push Down'
itemValue: codeMenuPushDownInstanceVariable
translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasInstanceVariableSelectedInCodeViewOrVariableListAndCanUseRefactoringSupportHolder
label: 'Convert to ValueHolder'
itemValue: codeMenuConvertToValueHolder
translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasSingleVariableSelectedInCodeViewOrVariableListHolder
label: 'Make Abstract (Access only via Getters/Setters)'
itemValue: codeMenuMakeAbstractVariable
translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasSingleVariableSelectedInCodeViewOrVariableListHolder
label: 'Make Concrete (Protect from Access via Getters/Setters)'
itemValue: codeMenuProtectInstanceVariable
translateLabel: true
showBusyCursorWhilePerforming: true
)
)
nil
nil
)
)
(MenuItem
enabled: hasMetaSelectedAndClassSelectedHolder
label: 'Class Instance Variables'
translateLabel: true
submenu:
(Menu
(
(MenuItem
enabled: hasClassSelectedHolder
label: 'All References...'
itemValue: variablesMenuBrowseAllClassInstVarRefs
translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasClassSelectedHolder
label: 'All Readers...'
itemValue: variablesMenuBrowseAllClassInstVarReads
translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasClassSelectedHolder
label: 'All Writers...'
itemValue: variablesMenuBrowseAllClassInstVarMods
translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasClassSelectedHolder
label: 'Local References...'
itemValue: variablesMenuBrowseClassInstVarRefs
translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasClassSelectedHolder
label: 'Local Readers...'
itemValue: variablesMenuBrowseClassInstVarReads
translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasClassSelectedHolder
label: 'Local Writers...'
itemValue: variablesMenuBrowseClassInstVarMods
translateLabel: true
showBusyCursorWhilePerforming: true
)
)
nil
nil
)
)
(MenuItem
enabled: hasClassSelectedHolder
label: 'Class Variables'
translateLabel: true
submenu:
(Menu
(
(MenuItem
enabled: hasClassSelectedHolder
label: 'All References...'
itemValue: variablesMenuBrowseAllClassVarRefs
translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasClassSelectedHolder
label: 'All Readers...'
itemValue: variablesMenuBrowseAllClassVarReads
translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasClassSelectedHolder
label: 'All Writers...'
itemValue: variablesMenuBrowseAllClassVarMods
translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasClassSelectedHolder
label: 'Local References...'
itemValue: variablesMenuBrowseClassVarRefs
translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasClassSelectedHolder
label: 'Local Readers...'
itemValue: variablesMenuBrowseClassVarReads
translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasClassSelectedHolder
label: 'Writers...'
itemValue: variablesMenuBrowseClassVarMods
translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasClassVariableSelectedInCodeViewOrVariableListAndCanUseRefactoringSupportHolder
label: 'Pull Up'
itemValue: codeMenuPullUpClassVariable
translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasClassVariableSelectedInCodeViewOrVariableListAndCanUseRefactoringSupportHolder
label: 'Push Down'
itemValue: codeMenuPushDownClassVariable
translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasClassVariableSelectedInCodeViewOrVariableListAndCanUseRefactoringSupportHolder
label: 'Make Abstract (Access only via Getters/Setters)'
itemValue: codeMenuMakeAbstractVariable
translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasClassVariableSelectedInCodeViewOrVariableListAndCanUseRefactoringSupportHolder
label: 'Make Concrete (Protect from Access via Getters/Setters)'
itemValue: codeMenuProtectClassVariable
translateLabel: true
showBusyCursorWhilePerforming: true
)
)
nil
nil
)
)
(MenuItem
label: '-'
)
(MenuItem
label: 'Move'
translateLabel: true
submenu:
(Menu
(
(MenuItem
enabled: hasSingleClassAndSingleVariableSelectedAndCanUseRefactoringSupportHolder
label: 'Pull Up'
itemValue: variablesMenuPullUp
translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasSingleClassAndSingleVariableSelectedAndCanUseRefactoringSupportHolder
label: 'Push Down'
itemValue: variablesMenuPushDown
translateLabel: true
showBusyCursorWhilePerforming: true
)
)
nil
nil
)
)
(MenuItem
enabled: hasSingleClassAndSingleVariableSelectedAndCanUseRefactoringSupportHolder
label: 'Rename...'
itemValue: variablesMenuRename
translateLabel: true
shortcutKey: Rename
showBusyCursorWhilePerforming: true
ignoreShortcutKeys: true
)
(MenuItem
enabled: hasClassesWithCommonSuperclassAndVariableSelectedAndCanUseRefactoringSupportHolder
label: 'Remove'
itemValue: variablesMenuRemove
translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasVariableSelected
label: 'Copy Selected Name'
itemValue: variablesMenuCopySelectedName
translateLabel: true
)
(MenuItem
label: '-'
isVisible: false
)
(MenuItem
enabled: hasVariableSelected
label: 'Find Variable'
itemValue: doFindVariable
translateLabel: true
isVisible: false
)
(MenuItem
label: '-'
)
(MenuItem
label: 'Show ClassVars (Statics)'
translateLabel: true
hideMenuOnActivated: false
indication: showClassVarsInVariableList
)
(MenuItem
label: 'Sort by Name'
translateLabel: true
hideMenuOnActivated: false
indication: sortVariablesByName
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasClassSelectedHolder
label: 'Generate'
translateLabel: true
submenu:
(Menu
(
(MenuItem
enabled: canGenerateAccessMethodsHolder
label: 'Access Methods'
itemValue: variablesMenuGenerateAccessMethods
translateLabel: true
isVisible: hasVariableSelected
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: canGenerateAccessMethodsForAllHolder
label: 'Access Methods for All'
itemValue: variablesMenuGenerateAccessMethodsForAll
translateLabel: true
isVisible: hasNoVariableSelected
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: canGenerateAccessMethodsHolder
label: 'Getter Method(s)'
itemValue: variablesMenuGenerateGetterMethods
translateLabel: true
isVisible: hasVariableSelected
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: canGenerateAccessMethodsForAllHolder
label: 'Getter Method(s) for All'
itemValue: variablesMenuGenerateGetterMethodsForAll
translateLabel: true
isVisible: hasNoVariableSelected
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: canGenerateAccessMethodsHolder
label: 'Setter Method(s)'
itemValue: variablesMenuGenerateSetterMethods
translateLabel: true
isVisible: hasVariableSelected
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: canGenerateAccessMethodsForAllHolder
label: 'Setter Method(s) for All'
itemValue: variablesMenuGenerateSetterMethodsForAll
translateLabel: true
isVisible: hasNoVariableSelected
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: canGenerateMultiSetterMethodHolder
label: 'Multi-Setter Method'
itemValue: variablesMenuGenerateMultiSetterMethod
translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
label: '-'
isVisible: hasNonMetaSelectedHolder
)
(MenuItem
enabled: canGenerateAccessMethodsHolder
label: 'Access Methods with Lazy Initialization in Getter'
itemValue: variablesMenuGenerateAccessMethodsWithLazyInitialization
translateLabel: true
isVisible: hasNonMetaSelectedHolder
)
(MenuItem
enabled: canGenerateAccessMethodsHolder
label: 'Access Methods with Change Notification'
itemValue: variablesMenuGenerateAccessMethodsWithChange
translateLabel: true
isVisible: hasNonMetaSelectedHolder
)
(MenuItem
enabled: canGenerateAccessMethodsHolder
label: 'Access Methods for ValueHolder'
itemValue: variablesMenuGenerateAccessMethodsForValueHolder
translateLabel: true
isVisible: hasNonMetaSelectedHolder
)
(MenuItem
enabled: canGenerateAccessMethodsHolder
label: 'Access Methods for ValueHolder with Change Notification'
itemValue: variablesMenuGenerateAccessMethodsForValueHolderWithChange
translateLabel: true
isVisible: hasNonMetaSelectedHolder
)
(MenuItem
enabled: canGenerateAccessMethodsHolder
label: 'Collection Access Methods'
itemValue: variablesMenuGenerateCollectionAccessMethods
translateLabel: true
isVisible: hasNonMetaSelectedHolder
)
)
nil
nil
)
)
(MenuItem
label: 'Debug'
translateLabel: true
submenu:
(Menu
(
(MenuItem
enabled: hasClassVariableSelectedHolder
label: 'Inspect...'
itemValue: variablesMenuInspect
translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasSingleVariableSelectedHolder
label: 'Show Type(s)...'
itemValue: variablesMenuTypeInfo
translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasSingleVariableSelectedHolder
label: 'Browse Type(s)'
itemValue: variablesMenuTypeBrowe
translateLabel: true
showBusyCursorWhilePerforming: true
)
)
nil
nil
)
)
)
nil
nil
)
!
viewMenu
"This resource specification was automatically generated
by the MenuEditor of ST/X."
"Do not manually edit this!! If it is corrupted,
the MenuEditor may not be able to read the specification."
"
MenuEditor new openOnClass:Tools::NewSystemBrowser andSelector:#viewMenu
(Menu new fromLiteralArrayEncoding:(Tools::NewSystemBrowser viewMenu)) startUp
"
<resource: #menu>
^
#(Menu
(
(MenuItem
label: 'Category'
translateLabel: true
isVisible: viewMenuOrganizerItemsVisible
hideMenuOnActivated: false
choice: organizerModeForMenu
choiceValue: category
)
(MenuItem
enabled: hasSingleClassSelected
label: 'Class Hierarchy'
translateLabel: true
isVisible: viewMenuOrganizerItemsVisible
hideMenuOnActivated: false
choice: organizerModeForMenu
choiceValue: classHierarchy
)
(MenuItem
enabled: hasSingleClassSelected
label: 'Class Inheritance'
translateLabel: true
isVisible: classInheritanceMenuItemVisible
hideMenuOnActivated: false
choice: organizerModeForMenu
choiceValue: classInheritance
)
(MenuItem
label: 'Hierarchy'
translateLabel: true
isVisible: viewMenuOrganizerItemsVisible
hideMenuOnActivated: false
choice: organizerModeForMenu
choiceValue: hierarchy
)
(MenuItem
label: 'Namespace'
translateLabel: true
isVisible: viewMenuOrganizerItemsVisible
hideMenuOnActivated: false
choice: organizerModeForMenu
choiceValue: namespace
)
(MenuItem
label: 'Project'
translateLabel: true
isVisible: viewMenuOrganizerItemsVisible
hideMenuOnActivated: false
choice: organizerModeForMenu
choiceValue: project
)
(MenuItem
label: 'Project Diagram'
translateLabel: true
isVisible: packageDiagramMenuItemVisible
hideMenuOnActivated: false
choice: organizerModeForMenu
choiceValue: packageDiagram
)
(MenuItem
label: '-'
isVisible: viewMenuOrganizerItemsVisible
)
(MenuItem
label: 'viewMenuCommonSlice'
translateLabel: true
submenuChannel: viewMenuCommonSlice
isMenuSlice: true
)
)
nil
nil
)
!
viewMenuCommonSlice
"This resource specification was automatically generated
by the MenuEditor of ST/X."
"Do not manually edit this!! If it is corrupted,
the MenuEditor may not be able to read the specification."
"
MenuEditor new openOnClass:Tools::NewSystemBrowser andSelector:#viewMenuCommonSlice
(Menu new fromLiteralArrayEncoding:(Tools::NewSystemBrowser viewMenuCommonSlice)) startUp
"
<resource: #menu>
^
#(Menu
(
(MenuItem
label: 'Toolbar'
translateLabel: true
hideMenuOnActivated: false
indication: toolBarVisibleHolder
)
(MenuItem
label: 'Searchbar'
translateLabel: true
hideMenuOnActivated: false
indication: stringSearchToolVisibleHolder
)
(MenuItem
label: 'Info'
translateLabel: true
hideMenuOnActivated: false
indication: codeInfoVisible
)
(MenuItem
label: '-'
)
(MenuItem
label: 'Multitab Mode'
translateLabel: true
hideMenuOnActivated: false
indication: showMultitabMode
)
(MenuItem
label: 'Enable Embedded Resource Editors'
translateLabel: true
hideMenuOnActivated: false
indication: showSpecialResourceEditors
)
(MenuItem
label: 'Coverage Info'
translateLabel: true
hideMenuOnActivated: false
indication: showCoverageInformation
)
(MenuItem
label: '-'
)
(MenuItem
label: 'Class'
translateLabel: true
submenu:
(Menu
(
(MenuItem
label: 'Hide Unloaded Classes'
translateLabel: true
hideMenuOnActivated: false
indication: hideUnloadedClasses
)
(MenuItem
label: 'Show All Classes in NameSpace View'
translateLabel: true
hideMenuOnActivated: false
indication: showAllClassesInNameSpaceOrganisation
)
(MenuItem
label: '-'
)
(MenuItem
enabled: showUnloadedClasses
label: 'Emphasize Unloaded Classes'
translateLabel: true
hideMenuOnActivated: false
indication: emphasizeUnloadedClasses
)
(MenuItem
label: 'Show Class Type Indicator'
translateLabel: true
hideMenuOnActivated: false
indication: markApplicationsHolder
)
(MenuItem
label: 'Short Class Names in Tabs'
translateLabel: true
hideMenuOnActivated: false
indication: shortNamesInTabs
)
(MenuItem
label: 'Show Class-Packages'
translateLabel: true
hideMenuOnActivated: false
indication: showClassPackages
)
)
nil
nil
)
)
(MenuItem
label: 'Protocol'
translateLabel: true
submenu:
(Menu
(
(MenuItem
label: 'Show Pseudo Protocols'
translateLabel: true
hideMenuOnActivated: false
indication: showPseudoProtocols
)
)
nil
nil
)
)
(MenuItem
label: 'Selector'
translateLabel: true
submenu:
(Menu
(
(MenuItem
label: 'Show Inherited Methods'
translateLabel: true
hideMenuOnActivated: false
choice: methodVisibilityHolder
choiceValue: all
)
(MenuItem
label: 'Show Inherited Methods except Object''s'
translateLabel: true
hideMenuOnActivated: false
choice: methodVisibilityHolder
choiceValue: allButObject
)
(MenuItem
label: 'Do not Show Inherited Methods'
translateLabel: true
hideMenuOnActivated: false
choice: methodVisibilityHolder
choiceValue: class
)
(MenuItem
label: '-'
)
(MenuItem
label: 'Show Method Inheritance Indicator'
translateLabel: true
hideMenuOnActivated: false
indication: showMethodInheritance
)
(MenuItem
label: 'Show Method Type Indicator'
translateLabel: true
hideMenuOnActivated: false
indication: showMethodTypeIcon
)
(MenuItem
enabled: hasOOMPackageLoadedHolder
label: 'Show Method-Complexity'
translateLabel: true
hideMenuOnActivated: false
indication: showMethodComplexity
)
)
nil
nil
)
)
(MenuItem
label: 'Code'
translateLabel: true
submenu:
(Menu
(
(MenuItem
label: 'Syntax Coloring'
translateLabel: true
hideMenuOnActivated: false
indication: doSyntaxColoring
)
(MenuItem
enabled: doSyntaxColoring
label: 'Immediate Syntax Coloring'
translateLabel: true
hideMenuOnActivated: false
indication: doImmediateSyntaxColoring
)
(MenuItem
label: 'Immediate Explaining'
translateLabel: true
hideMenuOnActivated: false
indication: doImmediateExplaining
)
(MenuItem
label: 'Auto-Format Code'
translateLabel: true
hideMenuOnActivated: false
indication: doAutoFormat
)
(MenuItem
label: 'Show MethodTemplate for New Methods'
translateLabel: true
hideMenuOnActivated: false
indication: showMethodTemplate
)
)
nil
nil
)
)
(MenuItem
label: '-'
)
(MenuItem
label: 'Settings...'
itemValue: openSettingsDialog
translateLabel: true
)
)
nil
nil
)
"Modified: / 27-04-2010 / 16:26:10 / cg"
!
viewMenuForChainBrowser
"This resource specification was automatically generated
by the MenuEditor of ST/X."
"Do not manually edit this!! If it is corrupted,
the MenuEditor may not be able to read the specification."
"
MenuEditor new openOnClass:Tools::NewSystemBrowser andSelector:#viewMenuForChainBrowser
(Menu new fromLiteralArrayEncoding:(Tools::NewSystemBrowser viewMenuForChainBrowser)) startUp
"
<resource: #menu>
^
#(Menu
(
(MenuItem
label: 'Original Order'
translateLabel: true
hideMenuOnActivated: false
choice: sortBy
choiceValue: false
)
(MenuItem
label: 'Sort by Class'
translateLabel: true
hideMenuOnActivated: false
choice: sortBy
choiceValue: class
)
(MenuItem
label: 'Sort by Selector'
translateLabel: true
hideMenuOnActivated: false
choice: sortBy
choiceValue: selector
)
(MenuItem
label: '-'
)
(MenuItem
label: 'Menu Slice'
translateLabel: true
submenuChannel: viewMenuCommonSlice
isMenuSlice: true
)
"/ (MenuItem
"/ label: '-'
"/ )
"/ (MenuItem
"/ label: 'Hide Unloaded Classes'
"/ translateLabel: true
"/ isVisible: false
"/ hideMenuOnActivated: false
"/ indication: hideUnloadedClasses
"/ )
"/ (MenuItem
"/ label: 'Short Class Names in Tabs'
"/ translateLabel: true
"/ isVisible: false
"/ hideMenuOnActivated: false
"/ indication: shortNamesInTabs
"/ )
"/ (MenuItem
"/ enabled: showUnloadedClasses
"/ label: 'Emphasize Unloaded Classes'
"/ translateLabel: true
"/ isVisible: false
"/ hideMenuOnActivated: false
"/ indication: emphasizeUnloadedClasses
"/ )
"/ (MenuItem
"/ label: '-'
"/ isVisible: false
"/ )
"/ (MenuItem
"/ label: 'Indicators'
"/ translateLabel: true
"/ submenu:
"/ (Menu
"/ (
"/ (MenuItem
"/ label: 'Show Class-Packages'
"/ translateLabel: true
"/ hideMenuOnActivated: false
"/ indication: showClassPackages
"/ )
"/ (MenuItem
"/ label: 'Show Inheritance Indicator'
"/ translateLabel: true
"/ hideMenuOnActivated: false
"/ indication: showMethodInheritance
"/ )
"/ (MenuItem
"/ label: 'Show Type Indicator'
"/ translateLabel: true
"/ hideMenuOnActivated: false
"/ indication: showMethodTypeIcon
"/ )
"/ (MenuItem
"/ enabled: hasOOMPackageLoadedHolder
"/ label: 'Show Complexity'
"/ translateLabel: true
"/ hideMenuOnActivated: false
"/ indication: showMethodComplexity
"/ )
"/ )
"/ nil
"/ nil
"/ )
"/ )
)
nil
nil
)
!
viewMenuForMethodList
"This resource specification was automatically generated
by the MenuEditor of ST/X."
"Do not manually edit this!! If it is corrupted,
the MenuEditor may not be able to read the specification."
"
MenuEditor new openOnClass:Tools::NewSystemBrowser andSelector:#viewMenuForMethodList
(Menu new fromLiteralArrayEncoding:(Tools::NewSystemBrowser viewMenuForMethodList)) startUp
"
<resource: #menu>
^
#(Menu
(
(MenuItem
label: 'Original Order'
translateLabel: true
hideMenuOnActivated: false
choice: sortBy
choiceValue: false
)
(MenuItem
label: 'Sort by Class'
translateLabel: true
hideMenuOnActivated: false
choice: sortBy
choiceValue: class
)
(MenuItem
label: 'Sort by Selector'
translateLabel: true
hideMenuOnActivated: false
choice: sortBy
choiceValue: selector
)
(MenuItem
label: 'Sort by Category'
translateLabel: true
hideMenuOnActivated: false
choice: sortBy
choiceValue: category
)
(MenuItem
label: '-'
)
(MenuItem
label: 'Menu Slice'
translateLabel: true
submenuChannel: viewMenuCommonSlice
isMenuSlice: true
)
"/ (MenuItem
"/ label: 'Toolbar'
"/ translateLabel: true
"/ hideMenuOnActivated: false
"/ indication: toolBarVisibleHolder
"/ )
"/ (MenuItem
"/ label: 'Searchbar'
"/ translateLabel: true
"/ hideMenuOnActivated: false
"/ indication: stringSearchToolVisibleHolder
"/ )
"/ (MenuItem
"/ label: 'Info'
"/ translateLabel: true
"/ hideMenuOnActivated: false
"/ indication: codeInfoVisible
"/ )
"/ (MenuItem
"/ label: '-'
"/ )
"/ (MenuItem
"/ label: 'Hide Unloaded Classes'
"/ translateLabel: true
"/ isVisible: false
"/ hideMenuOnActivated: false
"/ indication: hideUnloadedClasses
"/ )
"/ (MenuItem
"/ label: 'Short Class Names in Tabs'
"/ translateLabel: true
"/ isVisible: false
"/ hideMenuOnActivated: false
"/ indication: shortNamesInTabs
"/ )
"/ (MenuItem
"/ enabled: showUnloadedClasses
"/ label: 'Emphasize Unloaded Classes'
"/ translateLabel: true
"/ isVisible: false
"/ hideMenuOnActivated: false
"/ indication: emphasizeUnloadedClasses
"/ )
"/ (MenuItem
"/ label: '-'
"/ isVisible: false
"/ )
"/ (MenuItem
"/ label: 'Indicators'
"/ translateLabel: true
"/ submenu:
"/ (Menu
"/ (
"/ (MenuItem
"/ label: 'Show Class-Packages'
"/ translateLabel: true
"/ hideMenuOnActivated: false
"/ indication: showClassPackages
"/ )
"/ (MenuItem
"/ label: 'Show Inheritance Indicator'
"/ translateLabel: true
"/ hideMenuOnActivated: false
"/ indication: showMethodInheritance
"/ )
"/ (MenuItem
"/ label: 'Show Type Indicator'
"/ translateLabel: true
"/ hideMenuOnActivated: false
"/ indication: showMethodTypeIcon
"/ )
"/ (MenuItem
"/ enabled: hasOOMPackageLoadedHolder
"/ label: 'Show Complexity'
"/ translateLabel: true
"/ hideMenuOnActivated: false
"/ indication: showMethodComplexity
"/ )
"/ )
"/ nil
"/ nil
"/ )
"/ )
)
nil
nil
)
! !
!NewSystemBrowser class methodsFor:'menu specs-dialogs'!
classesWhichHaveBeenModifiedPopupMenu
"This resource specification was automatically generated
by the MenuEditor of ST/X."
"Do not manually edit this!! If it is corrupted,
the MenuEditor may not be able to read the specification."
"
MenuEditor new openOnClass:NewSystemBrowser andSelector:#classesWithMissingContainerPopupMenu
(Menu new fromLiteralArrayEncoding:(NewSystemBrowser classesWithMissingContainerPopupMenu)) startUp
"
<resource: #menu>
^
#(#Menu
#(
#(#MenuItem
#label: 'File out as...'
#translateLabel: true
#value: #classMenu3FileOutAs
#showBusyCursorWhilePerforming: true
)
#(#MenuItem
#label: 'Check Into Repository...'
#translateLabel: true
#value: #classMenu3CheckIn
#showBusyCursorWhilePerforming: true
)
#(#MenuItem
#label: '-'
)
#(#MenuItem
#label: 'Spawn'
#translateLabel: true
#value: #classMenu3SpawnClass
)
#(#MenuItem
#label: '-'
)
#(#MenuItem
#label: 'Compare With Newest in Repository...'
#translateLabel: true
#value: #classMenu3CompareAgainstNewestInRepository
#showBusyCursorWhilePerforming: true
)
)
nil
nil
)
!
classesWithMissingContainerPopupMenu
"This resource specification was automatically generated
by the MenuEditor of ST/X."
"Do not manually edit this!! If it is corrupted,
the MenuEditor may not be able to read the specification."
"
MenuEditor new openOnClass:NewSystemBrowser andSelector:#classesWithMissingContainerPopupMenu
(Menu new fromLiteralArrayEncoding:(NewSystemBrowser classesWithMissingContainerPopupMenu)) startUp
"
<resource: #menu>
^
#(#Menu
#(
#(#MenuItem
#label: 'File out as...'
#translateLabel: true
#value: #classMenuFileOutAs
#showBusyCursorWhilePerforming: true
)
#(#MenuItem
#label: 'Check Into Repository...'
#translateLabel: true
#value: #classMenuCheckIn
#showBusyCursorWhilePerforming: true
)
#(#MenuItem
#label: '-'
)
#(#MenuItem
#label: 'Spawn'
#translateLabel: true
#value: #classMenuSpawnClass
)
#(#MenuItem
#label: '-'
)
#(#MenuItem
#label: 'Remove...'
#translateLabel: true
#value: #classMenuRemove
)
)
nil
nil
)
!
classesWithNewerVersionInRepositoryPopupMenu
"This resource specification was automatically generated
by the MenuEditor of ST/X."
"Do not manually edit this!! If it is corrupted,
the MenuEditor may not be able to read the specification."
"
MenuEditor new openOnClass:NewSystemBrowser andSelector:#classesWithMissingContainerPopupMenu
(Menu new fromLiteralArrayEncoding:(NewSystemBrowser classesWithMissingContainerPopupMenu)) startUp
"
<resource: #menu>
^
#(#Menu
#(
#(#MenuItem
#label: 'CheckOut Newest...'
#translateLabel: true
#value: #classMenu2CheckOutNewest
#showBusyCursorWhilePerforming: true
)
#(#MenuItem
#label: '-'
)
#(#MenuItem
#label: 'Spawn'
#translateLabel: true
#value: #classMenu2SpawnClass
)
#(#MenuItem
#label: '-'
)
#(#MenuItem
#label: 'Compare With Newest in Repository...'
#translateLabel: true
#value: #classMenu2CompareAgainstNewestInRepository
#showBusyCursorWhilePerforming: true
)
)
nil
nil
)
"Modified: / 29-09-2006 / 16:10:31 / cg"
!
obsoleteContainersPopupMenu
"This resource specification was automatically generated
by the MenuEditor of ST/X."
"Do not manually edit this!! If it is corrupted,
the MenuEditor may not be able to read the specification."
"
MenuEditor new openOnClass:NewSystemBrowser andSelector:#classesWithMissingContainerPopupMenu
(Menu new fromLiteralArrayEncoding:(NewSystemBrowser classesWithMissingContainerPopupMenu)) startUp
"
<resource: #menu>
^
#(#Menu
#(
#(#MenuItem
#label: 'CheckOut...'
#translateLabel: true
#value: #classMenu4CheckOut
#showBusyCursorWhilePerforming: true
)
#(#MenuItem
#label: '-'
)
#(#MenuItem
#label: 'Remove Container'
#translateLabel: true
#value: #classMenu4RemoveContainer
)
)
nil
nil
)
"Modified: / 29-09-2006 / 16:11:08 / cg"
! !
!NewSystemBrowser class methodsFor:'menu specs-obsolete'!
codeMenu
"This resource specification was automatically generated
by the MenuEditor of ST/X."
"Do not manually edit this!! If it is corrupted,
the MenuEditor may not be able to read the specification."
"
MenuEditor new openOnClass:Tools::NewSystemBrowser andSelector:#codeMenu
(Menu new fromLiteralArrayEncoding:(Tools::NewSystemBrowser codeMenu)) startUp
"
<resource: #menu>
^
#(Menu
(
(MenuItem
enabled: canUseRefactoringSupport
label: 'Variables'
translateLabel: true
submenu:
(Menu
(
(MenuItem
enabled: hasTemporaryVariableSelectedInCodeViewHolder
label: 'xxxxRename Local Variable...'
itemValue: codeMenuRenameTemporary
translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasTemporaryVariableSelectedInCodeViewHolder
label: 'Move to Inner Scope...'
itemValue: codeMenuMoveVariableToInnerScope
translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasTemporaryVariableSelectedInCodeViewHolder
label: 'Make Instance Variable'
itemValue: codeMenuMakeInstanceVariable
translateLabel: true
isVisible: hasNotMultipleTemporaryVariablesSelectedInCodeViewHolder
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasMultipleTemporaryVariablesSelectedInCodeViewHolder
label: 'Make Instance Variables'
itemValue: codeMenuMakeInstanceVariable
translateLabel: true
isVisible: hasMultipleTemporaryVariablesSelectedInCodeViewHolder
showBusyCursorWhilePerforming: true
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasUndefinedUppercaseIdentifierSelectedInCodeViewHolder
label: 'Declare as Class Variable'
itemValue: codeMenuDeclareSelectionAsClassVariable
translateLabel: true
)
)
nil
nil
)
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasSingleMethodSelectedAndSelectionInCodeViewAndCanUseRefactoringSupportHolder
label: 'Inline Message'
itemValue: codeMenuInlineMessage
translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasSingleMethodSelectedAndSelectionInCodeViewAndCanUseRefactoringSupportHolder
label: 'Extract Selection to Temporary...'
itemValue: codeMenuExtractSelectionToTemporary
translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasSingleMethodSelectedAndSelectionInCodeViewAndCanUseRefactoringSupportHolder
label: 'Extract Method...'
itemValue: codeMenuExtractMethod
translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasSingleMethodSelectedAndSelectionInCodeViewAndCanUseRefactoringSupportHolder
label: 'Extract Method to Component...'
itemValue: codeMenuExtractMethodToComponent
translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasSingleMethodSelectedAndCanUseRefactoringSupportHolder
label: 'Add Parameter to Method...'
itemValue: codeMenuAddParameter
translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasSingleMethodSelectedAndSelectionInCodeViewAndSingleSelectedMethodHasParameterAndCanUseRefactoringSupportHolder
label: 'Inline Parameter of Method'
itemValue: codeMenuInlineParameter
translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasSingleMethodSelectedAndSelectionInCodeViewAndSingleSelectedMethodHasParameterAndCanUseRefactoringSupportHolder
label: 'Remove Parameter from Method'
itemValue: codeMenuRemoveParameter
translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasSingleMethodSelectedAndCanUseRefactoringSupportHolder
label: 'Format'
itemValue: codeMenuFormat
translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
label: '-'
isVisible: canLoadRefactoringSupport
)
(MenuItem
label: 'Load Refactoring and Undo Features'
itemValue: doLoadRefactoringSupport
translateLabel: true
isVisible: canLoadRefactoringSupport
showBusyCursorWhilePerforming: true
)
)
nil
nil
)
! !
!NewSystemBrowser class methodsFor:'menu specs-popup'!
categoryPopUpMenu
"return the popUpMenu for the class-category-list view"
<resource: #programMenu>
^ self categoryMenuWithFind
"Created: / 18.2.2000 / 11:58:25 / cg"
!
classPopUpMenu
"return the popUpMenu for the regular class-list view"
<resource: #programMenu>
^ self classMenu
"Created: / 18.2.2000 / 11:58:25 / cg"
!
hierarchyPopUpMenu
"return the popUpMenu for the class-hierarchy-list view"
<resource: #programMenu>
^ self classPopUpMenu
"Created: / 18.2.2000 / 11:58:25 / cg"
!
nameSpacePopUpMenu
<resource: #programMenu>
^ self nameSpaceMenu
"Created: / 18.2.2000 / 11:58:25 / cg"
!
projectPopUpMenu
"return the popUpMenu for the project-list view"
<resource: #programMenu>
^ self projectMenu
"Created: / 18.2.2000 / 11:58:25 / cg"
!
shiftedCodeViewPopUpMenu
"return the Shift-popUpMenu for the code-view.
get here via codeViewMenu (holder in codeView)"
<resource: #programMenu>
^ self refactoringMenu
!
tabMenuWithRemove
"This resource specification was automatically generated
by the MenuEditor of ST/X."
"Do not manually edit this!! If it is corrupted,
the MenuEditor may not be able to read the specification."
"
MenuEditor new openOnClass:Tools::NewSystemBrowser andSelector:#tabMenuWithRemove
(Menu new fromLiteralArrayEncoding:(Tools::NewSystemBrowser tabMenuWithRemove)) startUp
"
<resource: #menu>
^
#(Menu
(
(MenuItem
label: 'Add Page'
itemValue: bufferMenuCreateBuffer
nameKey: CreateBuffer
translateLabel: true
)
(MenuItem
label: '-'
)
(MenuItem
label: 'Remove Page'
itemValue: bufferMenuRemoveBuffer:
nameKey: RemoveBuffer
translateLabel: true
argument: 0
)
(MenuItem
label: 'Remove all other Pages'
itemValue: bufferMenuRemoveAllButBuffer:
nameKey: RemoveAllButBuffer
translateLabel: true
argument: 0
)
)
nil
nil
)
!
tabMenuWithoutRemove
"This resource specification was automatically generated
by the MenuEditor of ST/X."
"Do not manually edit this!! If it is corrupted,
the MenuEditor may not be able to read the specification."
"
MenuEditor new openOnClass:NewSystemBrowser andSelector:#tabMenu
(Menu new fromLiteralArrayEncoding:(NewSystemBrowser tabMenu)) startUp
"
<resource: #menu>
^
#(#Menu
#(
#(#MenuItem
#label: 'Add Tab'
#translateLabel: true
#nameKey: #CreateBuffer
#value: #bufferMenuCreateBuffer
)
)
nil
nil
)
!
variablesPopUpMenu
"return the popUpMenu for the variable-list view"
<resource: #programMenu>
^ self variablesMenu
"Created: / 18.2.2000 / 11:58:25 / cg"
! !
!NewSystemBrowser class methodsFor:'menu specs-toolbar'!
toolBarMenu
"This resource specification was automatically generated
by the MenuEditor of ST/X."
"Do not manually edit this!! If it is corrupted,
the MenuEditor may not be able to read the specification."
"
MenuEditor new openOnClass:Tools::NewSystemBrowser andSelector:#toolBarMenu
(Menu new fromLiteralArrayEncoding:(Tools::NewSystemBrowser toolBarMenu)) startUp
"
<resource: #menu>
^
#(Menu
(
(MenuItem
label: ''
)
(MenuItem
activeHelpKey: createBuffer
label: 'CreateBuffer'
itemValue: createBufferForCurrentClassOrSelectionInCodeView
translateLabel: true
isButton: true
labelImage: (ResourceRetriever ToolbarIconLibrary addBufferIcon)
)
(MenuItem
label: '-'
isVisible: organizerIsShowingClasses
)
(MenuItem
activeHelpKey: showCategories
label: 'ShowCategory'
itemValue: switchToCategoryView
translateLabel: true
isButton: true
isVisible: organizerIsShowingClassesAndIsNotShowingCategories
labelImage: (ResourceRetriever NewSystemBrowser showCategoriesIcon)
showBusyCursorWhilePerforming: true
)
(MenuItem
activeHelpKey: showClassHierarchy
label: 'ShowClassHierarchy'
itemValue: switchToClassHierarchyView
translateLabel: true
isButton: true
isVisible: organizerIsShowingClassesAndIsShowingCategories
labelImage: (ResourceRetriever NewSystemBrowser showClassHierarchyIcon)
showBusyCursorWhilePerforming: true
)
(MenuItem
label: '-'
)
(MenuItem
activeHelpKey: recentChanges
label: 'Recently Changed'
translateLabel: true
isButton: true
submenuChannel: changedMenu
labelImage: (ResourceRetriever ToolbarIconLibrary changesBrowserIcon)
showBusyCursorWhilePerforming: true
)
(MenuItem
activeHelpKey: recentClassChanges
label: 'Recently Changed Classes'
translateLabel: true
isButton: true
isVisible: false
submenuChannel: changedClassesMenu
labelImage: (ResourceRetriever ToolbarIconLibrary empty1x20Icon)
showBusyCursorWhilePerforming: true
)
(MenuItem
activeHelpKey: recentlyVisitedMethods
label: 'Recently Visited Methods'
translateLabel: true
isButton: true
submenuChannel: findHistoryMenu
labelImage: (ResourceRetriever ToolbarIconLibrary historyBackIcon)
showBusyCursorWhilePerforming: true
)
(MenuItem
label: ''
isVisible: false
)
(MenuItem
activeHelpKey: undoOperation
enabled: hasUndoableOperations
label: 'Undo'
itemValue: operationsMenuUndo
translateLabel: true
isButton: true
isVisible: false
labelImage: (ResourceRetriever ToolbarIconLibrary undoIcon)
showBusyCursorWhilePerforming: true
)
(MenuItem
activeHelpKey: redoOperation
enabled: hasUndoableOperations
label: 'Redo'
itemValue: operationsMenuRedo
translateLabel: true
isButton: true
isVisible: false
labelImage: (ResourceRetriever ToolbarIconLibrary redoIcon)
showBusyCursorWhilePerforming: true
)
(MenuItem
label: '-'
isVisible: classWizardVisibleHolder
)
(MenuItem
label: 'Class Wizard'
itemValue: classMenuOpenClassCreationWizard
translateLabel: true
isButton: true
isVisible: classWizardVisibleHolder
labelImage: (ResourceRetriever ToolbarIconLibrary newClassWizardIcon)
)
(MenuItem
label: '-'
isVisible: hasAnyTestCaseOrExecutableClassMethodOrStartableApplicationSelectedHolder
)
(MenuItem
activeHelpKey: launchSelectedApplication
label: 'Launch Selected Application'
itemValue: launchSelectedApplication
translateLabel: true
isButton: true
isVisible: hasStartableApplicationSelectedHolder
labelImage: (ResourceRetriever ToolbarIconLibrary start22x22Icon)
showBusyCursorWhilePerforming: true
)
(MenuItem
activeHelpKey: executeSelectedClassMethod
label: 'Execute Selected Class Method'
itemValue: executeSelectedClassMethod
translateLabel: true
isButton: true
isVisible: hasAnyExecutableClassMethodSelectedHolder
labelImage: (ResourceRetriever ToolbarIconLibrary executeMethod20x20Icon)
showBusyCursorWhilePerforming: true
)
(MenuItem
activeHelpKey: runTestCases
label: 'Run Tests'
itemValue: runTestCases
translateLabel: true
isButton: true
isVisible: hasAnyTestCaseSelectedHolder
labelImage: (ResourceRetriever ToolbarIconLibrary sUnit24x24Icon)
showBusyCursorWhilePerforming: true
)
(MenuItem
activeHelpKey: runTestCasesWithDebug
label: 'Debug Tests'
itemValue: runTestCasesWithDebug
translateLabel: true
isButton: true
isVisible: hasAnyTestCaseSelectedHolder
labelImage: (ResourceRetriever ToolbarIconLibrary sUnit24x24DebugIcon)
showBusyCursorWhilePerforming: true
)
(MenuItem
label: ''
)
(MenuItem
label: '-'
startGroup: right
)
(MenuItem
activeHelpKey: showInheritedMethods
label: 'ShowInheritedMethods'
itemValue: showInheritedMethods
translateLabel: true
isButton: true
startGroup: right
isVisible: notShowingInheritedMethods
labelImage: (ResourceRetriever NewSystemBrowser showInheritedMethodsIcon)
showBusyCursorWhilePerforming: true
)
(MenuItem
activeHelpKey: doNotShowInheritedMethods
label: 'DoNotShowInheritedMethods'
itemValue: doNotShowInheritedMethods
translateLabel: true
isButton: true
startGroup: right
isVisible: showingInheritedMethods
labelImage: (ResourceRetriever NewSystemBrowser doNotShowInheritedMethodsIcon)
showBusyCursorWhilePerforming: true
)
(MenuItem
activeHelpKey: formatCode
enabled: hasMethodSelectedHolder
label: 'Format'
itemValue: codeMenuFormat
translateLabel: true
isButton: true
startGroup: right
labelImage: (ResourceRetriever ToolbarIconLibrary formatCode16x16Icon)
showBusyCursorWhilePerforming: true
)
(MenuItem
activeHelpKey: addBreakPoint
enabled: hasMethodWithoutBreakPointSelectedHolder
label: 'Add BreakPoint'
itemValue: debugMenuBreakPoint
translateLabel: true
isButton: true
startGroup: right
labelImage: (ResourceRetriever nil addBreakPointIcon2)
)
(MenuItem
activeHelpKey: removeBreakPoint
enabled: hasMethodWithBreakPointSelectedHolder
label: 'Remove BreakPoint'
itemValue: debugMenuRemoveBreakOrTrace
translateLabel: true
isButton: true
labelImage: (ResourceRetriever nil removeBreakPointIcon2)
)
(MenuItem
label: ''
)
)
nil
nil
)
! !
!NewSystemBrowser class methodsFor:'startup'!
browseClass:aClass
"launch a single class browser."
|browser|
browser := self basicNew spawnClassBrowserFor:(Array with:aClass theNonMetaclass) in:#newBrowser.
aClass isMeta ifTrue:[
browser switchToClass:aClass.
].
^ browser.
"
self browseClass:Array
"
"Modified: / 15-01-2011 / 14:07:36 / cg"
!
browseClasses:aCollectionOfClasses
"launch a multi class browser."
^ self browseClasses:aCollectionOfClasses label:nil
"
self browseClasses:(Array with:Array with:Number)
"
!
browseClasses:aCollectionOfClasses label:titleOrNil
"launch a multi class browser."
^ self basicNew
spawnClassBrowserFor:aCollectionOfClasses
label:titleOrNil
in:#newBrowser.
"
self browseClasses:(Array with:Array with:Number) label:'Some classes'
"
!
browseMethods:aListOfMethods title:title sort:doSort
"launch a multi-method browser."
^ self basicNew
spawnMethodBrowserFor:aListOfMethods
in:#newBrowser
label:title
perMethodInfo:nil
sortBy:(doSort ifTrue:[#class] ifFalse:[nil])
"
self
browseMethods:(Array with:(OrderedCollection compiledMethodAt:#at:)
with:(Array compiledMethodAt:#at:)
)
title:'some methods'
sort:true
self
browseMethods:(Array with:(OrderedCollection compiledMethodAt:#at:)
with:(Array compiledMethodAt:#at:)
)
title:'some methods'
sort:false
self
browseMethods:(Array with:(Array compiledMethodAt:#at:)
with:(Array compiledMethodAt:#at:put:))
title:'some methods'
sort:false
"
!
open
|lastClass classHistory|
classHistory := self classHistory.
classHistory size > 0 ifTrue:[
lastClass := Smalltalk classNamed:(classHistory first className).
lastClass notNil ifTrue:[
^ self openInClass:lastClass selector:nil
]
].
^ super open
"
self open
"
!
openInClass:aClass selector:aSelector
"launch a full browser, with aClass/aSelector initially selected."
|browser|
browser := self new.
browser allButOpen.
browser switchToClass:aClass selector:aSelector.
browser openWindow.
^ browser
"
self openInClass:Array selector:#at:
"
"Created: / 5.2.2000 / 00:34:02 / cg"
"Modified: / 5.2.2000 / 00:36:15 / cg"
!
openInMethod:aMethod
"launch a full browser, with aMethod initially selected."
|w|
w := aMethod who.
^ self openInClass:w methodClass selector:w methodSelector
"
self openInMethod:(Array compiledMethodAt:#at:)
"
"Modified: / 5.2.2000 / 00:34:46 / cg"
"Created: / 5.2.2000 / 00:38:41 / cg"
!
openOnClassesInChangeSet
"open a browser, showing all classes in the changeSet."
^ self basicNew
browseMenuClassesInCurrentChangeSetOpenAs:#newBrowser
"
self openOnClassesInChangeSet
"
!
openOnMethodsInChangeSet
"open a browser, showing all methods in the changeSet."
^ self basicNew basicInitialize
browseMenuMethodsInCurrentChangeSetIn:#newBrowser
"
self openOnMethodsInChangeSet
"
!
openOnPackage:aPackage
"open a browser, showing all classes in the given package."
^ self basicNew
spawnProjectBrowserFor:(Array with:aPackage) in:#newBrowser
"
self openOnPackage:'stx:libbasic'
"
! !
!NewSystemBrowser class methodsFor:'utilities'!
allProjectsIDs
<resource: #obsolete>
^ Smalltalk allProjectIDs
!
enterBoxTitle:title okText:okText label:label
"convenient method: setup an enterBox"
|box rresources|
rresources := self classResources.
box := EnterBox new.
box label:(rresources string:label).
box
title:(rresources string:title)
okText:(rresources string:okText).
^ box
"Created: / 6.2.2000 / 01:07:11 / cg"
! !
!NewSystemBrowser methodsFor:'aspects'!
bufferNameList
"the list of buffer-name-labels (model of the notebook)"
bufferNameList isNil ifTrue:[
bufferNameList := List new.
].
^ bufferNameList
"Created: / 5.2.2000 / 04:15:32 / cg"
!
classDocumentationHolder
"the current buffers html-doc holder"
^ self navigationState classDocumentationHolder
"Created: / 25.2.2000 / 01:58:03 / cg"
!
classesProjectInfoHolder
"the project-info label (used in the revisionDiffBrowser)"
|holder|
(holder := builder bindingAt:#classesProjectInfoHolder) isNil ifTrue:[
builder aspectAt:#classesProjectInfoHolder put:(holder := '' asValue).
].
^ holder.
!
codeAspect
"the current buffers codeAspect; a symbol such as #method, #classDefinition, #comment etc."
^ self navigationState codeAspect
"Created: / 11.2.2000 / 13:07:07 / cg"
!
codeAspect:newAspect
^ self navigationState codeAspect:newAspect
"Created: / 11.2.2000 / 13:07:19 / cg"
!
codeHolder
"the current buffers code holder"
^ self navigationState codeHolder
!
codeModifiedHolder
"the current buffers codeModified holder;
That is the codeViews modified flag and should not be taken as a modified flag,
because the syntaxHighlighter clears this flag to be informed about user unput"
^ self navigationState codeModifiedHolder
!
codeReallyModified
^ self reallyModified:(self navigationState)
!
cursorColLabelHolder
"the current buffers cursorColumn Holder (info field)"
^ self navigationState cursorColLabelHolder
!
cursorLineLabelHolder
"the current buffers cursorLineumn Holder (info field)"
^ self navigationState cursorLineLabelHolder
!
doEnableRefactoringSupport
^ builder
valueAspectFor:#doEnableRefactoringSupport
computeInitialValueWith:[ self canUseRefactoringSupport ]
!
doLoadRefactoringSupport
RefactoryChangeManager autoload.
!
editModeHolder
"the current buffers editMode Holder (insert/overwrite/...)"
^ self navigationState editModeHolder
!
filterClassVars
^ self navigationState filterClassVars
"Created: / 24.2.2000 / 23:28:06 / cg"
!
immediateUpdate
immediateUpdate isNil ifTrue:[
immediateUpdate := false asValue.
].
^ immediateUpdate
"Created: / 13.2.2000 / 22:29:47 / cg"
!
implementingClassListGenerator
^ self navigationState implementingClassListGenerator
!
infoLabelHolder
"the current buffers infoLabel (info field)"
^ self navigationState infoLabelHolder
!
metaToggleLabelHolder
^ self navigationState metaToggleLabelHolder
!
methodInfo
^ self navigationState methodInfo
!
modeLabelHolder
"the current buffers mode label Holder (insert/learn info field)"
^ self navigationState modeLabelHolder
!
navigationState
|theCanvas theCanvasType|
navigationState isNil ifTrue:[
navigationState := NavigationState new.
"/ the kludge below is required to allow
"/ subSpecs to be opened in full-window (without a noteBook) as well
"/ (without that, we get trouble accessing the codeView later ...)
browserCanvas isNil ifTrue:[
"/ opened spec as top-spec (there is no canvas)
^ navigationState.
"/ theCanvas := self.
"/ bldr := self builder.
"/
"/ bldr notNil ifTrue:[
"/ theCanvasType := bldr spec name.
"/ ] ifFalse:[
"/ theCanvasType := self browserCanvasType.
"/ ]
] ifFalse:[
"/ opened spec in canvas
theCanvas := self browserCanvas value.
theCanvasType := self browserCanvasType.
].
self assert:theCanvas notNil.
navigationState canvas:theCanvas.
theCanvasType isNil ifTrue:[
theCanvasType := theCanvas spec.
].
navigationState canvasType:theCanvasType.
].
^ navigationState
"Created: / 4.2.2000 / 16:00:10 / cg"
"Modified: / 18.2.2000 / 13:50:27 / cg"
!
noAllItem
^ self navigationState noAllItem
!
packageLabelHolder
"the current buffers packageLabel (info field)"
^ self navigationState packageLabelHolder
!
searchedClassNameHolder
|holder|
(holder := builder bindingAt:#searchedClassNameHolder) isNil ifTrue:[
holder := '' asValue.
builder aspectAt:#searchedClassNameHolder put:holder.
holder onChangeEvaluate:[
self switchToClassNameMatching: holder value].
].
^ holder
!
searchedClassNameOrSelectorHolder
|holder|
(holder := builder bindingAt:#searchedClassNameOrSelectorHolder) isNil ifTrue:[
holder := '' asValue.
builder aspectAt:#searchedClassNameOrSelectorHolder put:holder.
holder onChangeEvaluate:[ self switchToSearchItemMatching: holder value].
].
^ holder
"Modified: / 10-08-2006 / 18:10:46 / cg"
!
selectedBuffer
selectedBuffer isNil ifTrue:[
selectedBuffer := nil asValue.
selectedBuffer addDependent:self.
].
^ selectedBuffer
"Created: / 5.2.2000 / 04:21:11 / cg"
!
selectionChangeConditionFor:aSubApplication
|answer|
navigationState modified ifFalse:[^ true].
answer := self askIfModified:'Modifications have not been saved.\\Change selection anyway ?'.
answer ifTrue:[
navigationState modified:false.
navigationState realModifiedState:false.
(self codeAspect == #classDefinition
and:[aSubApplication ~~ self classListApp]) ifTrue:[
self classListApp forceReselect
] ifFalse:[
aSubApplication forceSelectionClear.
]
].
^ answer
"Created: / 23.2.2000 / 12:14:38 / cg"
!
selectionChangeConditionHolder
^ [:whichSubApplication | self selectionChangeConditionFor:whichSubApplication ]
"Modified: / 23.2.2000 / 12:14:50 / cg"
!
sortBy
^ self navigationState sortBy
!
suppressChangeSetUpdate
^ (builder bindingAt:#suppressChangeSetUpdate) ? false
!
suppressChangeSetUpdate:aBoolean
builder aspectAt:#suppressChangeSetUpdate put:aBoolean
! !
!NewSystemBrowser methodsFor:'aspects-kludges'!
metaToggle
^ self navigationState metaToggle
!
notMetaToggle
^ self navigationState notMetaToggle
! !
!NewSystemBrowser methodsFor:'aspects-menus'!
categoryMenu
"to avoid generation of an aspect method by GUI definer"
^ self class categoryMenu
"Created: / 18.2.2000 / 12:17:07 / cg"
!
classMenu
"to avoid generation of an aspect method by GUI definer"
^ self class classMenu
"Created: / 18.2.2000 / 12:16:42 / cg"
!
methodListPopUpMenu
"to avoid generation of an aspect method by GUI definer"
<resource: #programMenu>
^ [
|m|
self window sensor ctrlDown ifTrue:[
m := self class methodDebugMenu
] ifFalse:[
m := self class methodListMenu
].
m := m decodeAsLiteralArray.
m findGuiResourcesIn:self.
]
"Modified: / 11-09-2007 / 11:44:04 / cg"
!
nameSpaceMenu
"to avoid generation of an aspect method by GUI definer"
^ self class nameSpaceMenu
"Created: / 18.2.2000 / 12:17:22 / cg"
!
projectMenu
"to avoid generation of an aspect method by GUI definer"
^ self class projectMenu
"Created: / 18.2.2000 / 12:17:28 / cg"
!
protocolMenu
"to avoid generation of an aspect method by GUI definer"
^ self class protocolMenu
"Created: / 18.2.2000 / 12:17:40 / cg"
!
selectorMenu
"to avoid generation of an aspect method by GUI definer"
^ self class selectorMenu
"Created: / 18.2.2000 / 12:17:49 / cg"
!
selectorPopUpMenu
"to avoid generation of an aspect method by GUI definer"
<resource: #programMenu>
^ [
|m|
self window sensor ctrlDown ifTrue:[
m := self class methodDebugMenu
] ifFalse:[
m := self class selectorMenu
].
m := m decodeAsLiteralArray.
m findGuiResourcesIn:self.
]
"Modified: / 11-09-2007 / 11:44:09 / cg"
!
tabMenu:index
<resource: #programMenu>
|m i|
m := self class tabMenuWithRemove.
m := m decodeAsLiteralArray.
i := m detectItem:[:item | item nameKey == #RemoveBuffer] ifNone:nil.
i notNil ifTrue:[
i label:(resources string:i label with:index printString).
i argument:index.
index ~~ self selectedBuffer value ifTrue:[
"/ for now: if that buffer is modified,
"/ do not allow removing.
"/ (must be brought to front, in order for check-for-modification to work)
(buffers at:index) modified ifTrue:[
i disable
].
].
].
i := m detectItem:[:item | item nameKey == #RemoveAllButBuffer] ifNone:nil.
i notNil ifTrue:[
i label:(resources string:i label with:index printString).
i argument:index.
].
m findGuiResourcesIn:self.
^ m
"/ index == self selectedBuffer value ifTrue:[
"/ ^ self class tabMenuWithRemove.
"/ ].
"/ ^ self class tabMenuWithoutRemove.
!
visitedClassesHistory
|holder|
(holder := builder bindingAt:#visitedClassesHistory) isNil ifTrue:[
builder aspectAt:#visitedClassesHistory put:(holder := List new).
holder addAll:(self class visitedClassNamesHistory).
SystemBrowser addDependent:self.
].
^ holder
"Modified: / 20-11-2006 / 12:25:18 / cg"
!
visitedClassesHistoryList
<resource: #obsolete>
^ self class visitedClassNamesHistory
! !
!NewSystemBrowser methodsFor:'aspects-navigation'!
categoryList
"the current buffers categoryList"
^ self navigationState categoryList
"Created: / 25.2.2000 / 01:58:03 / cg"
!
categoryListGenerator
"the current buffers categoryList generator"
^ self navigationState categoryListGenerator
!
classHierarchyTopClass
"the current buffers topClass holder (if showing a hierarchy)"
^ self navigationState classHierarchyTopClass
!
classListGenerator
"the current buffers classList generator"
^ self navigationState classListGenerator
!
classListPerNameSpaceGenerator
"the current buffers first classList generator (input to categoryList)"
^ self navigationState classListPerNameSpaceGenerator
"Created: / 18.8.2000 / 14:15:07 / cg"
!
meta
^ self navigationState meta
!
nameSpaceFilter
^ self navigationState nameSpaceFilter
"Created: / 18.8.2000 / 14:25:49 / cg"
!
nameSpaceListGenerator
^ self navigationState nameSpaceListGenerator
"Created: / 18.8.2000 / 14:26:09 / cg"
!
packageFilter
^ self navigationState packageFilter
"Created: / 24.2.2000 / 23:28:06 / cg"
!
projectListGenerator
^ self navigationState projectListGenerator
"Created: / 25.2.2000 / 02:52:33 / cg"
!
protocolListGenerator
^ self navigationState protocolListGenerator
!
selectedCategories
^ self navigationState selectedCategories
!
selectedCategoriesValue
^ self selectedCategories value ? #()
!
selectedClasses
^ self navigationState selectedClasses
!
selectedClassesValue
^ self selectedClasses value ? #()
!
selectedMethods
^ self navigationState selectedMethods
!
selectedMethods1
^ self navigationState selectedMethodsArrayAt:1
!
selectedMethods2
^ self navigationState selectedMethodsArrayAt:2
!
selectedMethods3
^ self navigationState selectedMethodsArrayAt:3
!
selectedMethods4
^ self navigationState selectedMethodsArrayAt:4
!
selectedMethodsClasses
^ (self selectedMethods value collect:[:m | m mclass]) asSet
"Created: / 07-08-2006 / 12:13:37 / cg"
!
selectedNamespaces
^ self navigationState selectedNamespaces
!
selectedNamespacesValue
^ self selectedNamespaces value ? #()
!
selectedProjects
^ self navigationState selectedProjects
!
selectedProjectsValue
^ self selectedProjects value ? #()
!
selectedProtocols
^ self navigationState selectedProtocols
!
selectedProtocolsValue
^ self selectedProtocols value ? #()
!
selectedVariables
^ self variableFilter
!
selectorListGenerator
^ self navigationState selectorListGenerator
!
selectorListGenerator1
^ self navigationState selectorListGeneratorArrayAt:1
!
selectorListGenerator2
^ self navigationState selectorListGeneratorArrayAt:2
!
selectorListGenerator3
^ self navigationState selectorListGeneratorArrayAt:3
!
selectorListGenerator4
^ self navigationState selectorListGeneratorArrayAt:4
!
variableFilter
^ self navigationState variableFilter
"Created: / 24.2.2000 / 23:28:06 / cg"
! !
!NewSystemBrowser methodsFor:'aspects-organization'!
categoryMenuVisible
|holder|
(holder := builder bindingAt:#categoryMenuVisible) isNil ifTrue:[
holder := BlockValue
with:[:v1 :v2 | |n|
n := self navigationState.
n isClassBrowser not
and:[n isProtocolOrFullProtocolBrowser not
and:[n isMethodBrowser not
and:[n isClassExtensionBrowser not
and:[n isChainBrowser not
and:[(n isNameSpaceFullBrowser or:[n isNameSpaceBrowser not])
and:[n isVersionDiffBrowser not
and:[(n isNameSpaceFullBrowser or:[v1 == OrganizerCanvas organizerModeCategory])]]]]]]]
]
argument:(self organizerModeForMenu)
argument:(self browserCanvas).
builder aspectAt:#categoryMenuVisible put: holder
].
^ holder
"Modified: / 08-03-2007 / 23:00:27 / cg"
!
classHierarchyMenuVisible
|holder|
(holder := builder bindingAt:#classHierarchyMenuVisible) isNil ifTrue:[
holder := BlockValue
with:[:orgMode :v2 |
(orgMode == OrganizerCanvas organizerModeClassHierarchy)
or:[orgMode == OrganizerCanvas organizerModeHierarchy]
]
argument:(self organizerModeForMenu)
argument:(self browserCanvas).
builder aspectAt:#classHierarchyMenuVisible put: holder
].
^ holder
"Created: / 17-02-2000 / 22:19:11 / cg"
"Modified: / 08-03-2007 / 23:00:34 / cg"
!
classInheritanceMenuItemVisible
^ false "^ self viewMenuOrganizerItemsVisible"
!
classMenuVisible
|holder|
(holder := builder bindingAt:#classMenuVisible) isNil ifTrue:[
holder := BlockValue
with:[:v | |n|
n := self navigationState.
n isProtocolOrFullProtocolBrowser not
and:[n isMethodBrowser not
and:[n isChainBrowser not]]
]
argument:(self browserCanvas).
builder aspectAt:#classMenuVisible put: holder
].
^ holder
!
codeMenuVisible
|holder|
(holder := builder bindingAt:#codeMenuVisible) isNil ifTrue:[
holder := BlockValue
with:[:v | |n|
n := self navigationState.
n isClassDocumentationBrowser not
and:[n isVersionDiffBrowser not
and:[n isFullClassSourceBrowser not]]
]
argument:(self browserCanvas).
builder aspectAt:#codeMenuVisible put: holder
].
^ holder
"Created: / 24.2.2000 / 14:57:52 / cg"
!
isNotFullProtocolBrowser
|holder|
(holder := builder bindingAt:#isNotFullProtocolBrowser) isNil ifTrue:[
holder := BlockValue
with:[:v | |n|
n := self navigationState.
n isFullProtocolBrowser not
]
argument:(self browserCanvas).
builder aspectAt:#isNotFullProtocolBrowser put: holder
].
^ holder
"Created: / 24.2.2000 / 14:57:52 / cg"
!
methodListMenuVisible
|holder|
(holder := builder bindingAt:#methodListMenuVisible) isNil ifTrue:[
holder := BlockValue
with:[:v | |n|
n := self navigationState.
n isMethodListBrowser
]
argument:(self browserCanvas).
builder aspectAt:#methodListMenuVisible put: holder
].
^ holder
!
nameSpaceMenuVisible
|holder|
(holder := builder bindingAt:#nameSpaceMenuVisible) isNil ifTrue:[
holder := BlockValue
with:[:orgMode :v2 |
orgMode == OrganizerCanvas organizerModeNamespace
or:[self navigationState isNameSpaceFullBrowser]
]
argument:(self organizerModeForMenu)
argument:(self browserCanvas).
builder aspectAt:#nameSpaceMenuVisible put: holder
].
^ holder
"Created: / 17-02-2000 / 22:19:11 / cg"
"Modified: / 08-03-2007 / 23:00:55 / cg"
!
notShowingInheritedMethods
|holder|
(holder := builder bindingAt:#notShowingInheritedMethods) isNil ifTrue:[
holder := BlockValue
with:[:h :o | self isMethodListBrowser not and:[h == #class] ]
argument:(self methodVisibilityHolder)
argument:(self organizerModeForMenu).
builder aspectAt:#notShowingInheritedMethods put: holder
].
^ holder
"Modified: / 08-03-2007 / 23:01:01 / cg"
!
operationsMenuEnabled
^ [
(self canUseRefactoringSupport)
]
!
operationsMenuVisible
^ [
(self canUseRefactoringSupport)
]
!
organizerIsNotShowingCategories
|holder|
(holder := builder bindingAt:#organizerIsNotShowingCategories) isNil ifTrue:[
holder := BlockValue
with:[:h | h ~~ OrganizerCanvas organizerModeCategory]
argument:(self organizerModeForMenu)
].
^ holder
"Modified: / 08-03-2007 / 23:01:05 / cg"
!
organizerIsShowingCategories
|holder|
(holder := builder bindingAt:#organizerIsShowingCategories) isNil ifTrue:[
holder := BlockValue
with:[:h | h == OrganizerCanvas organizerModeCategory]
argument:(self organizerModeForMenu)
].
^ holder
"Modified: / 08-03-2007 / 23:01:08 / cg"
!
organizerIsShowingClasses
|holder|
(holder := builder bindingAt:#organizerIsShowingClasses) isNil ifTrue:[
holder := BlockValue
with:[:h :b | navigationState isMethodListBrowser not]
arguments:(Array with:self organizerModeForMenu with:self selectedBuffer)
].
^ holder
!
organizerIsShowingClassesAndIsNotShowingCategories
|holder|
(holder := builder bindingAt:#organizerIsShowingClassesAndIsNotShowingCategories) isNil ifTrue:[
holder := BlockValue
with:[:h | navigationState isMethodListBrowser not and:[h ~~ OrganizerCanvas organizerModeCategory]]
argument:(self organizerModeForMenu)
].
^ holder
"Modified: / 08-03-2007 / 23:01:17 / cg"
!
organizerIsShowingClassesAndIsShowingCategories
|holder|
(holder := builder bindingAt:#organizerIsShowingClassesAndIsShowingCategories) isNil ifTrue:[
holder := BlockValue
with:[:h | navigationState isMethodListBrowser not and:[h == OrganizerCanvas organizerModeCategory]]
argument:(self organizerModeForMenu)
].
^ holder
"Modified: / 08-03-2007 / 23:01:20 / cg"
!
organizerMode
^ self navigationState organizerMode
"Modified: / 18.2.2000 / 18:36:40 / cg"
!
organizerModeForMenu
"need this, since the menu fetches the aspect only once during
creation - but thats the mode-holder of the first buffer,
and not the dynamic mode-holder of the current buffer"
|holder|
(holder := builder bindingAt:#organizerModeForMenu) isNil ifTrue:[
holder := (PluggableAdaptor new)
getBlock:[:m | self organizerMode value ]
putBlock:[:m :newValue | self organizerMode value:newValue.]
updateBlock:[:m :aspect :param | ].
builder aspectAt:#organizerModeForMenu put:holder.
holder addDependent:self.
].
^ holder
"Modified: / 24.2.2000 / 18:36:13 / cg"
!
projectMenuVisible
|holder|
(holder := builder bindingAt:#projectMenuVisible) isNil ifTrue:[
holder := BlockValue
with:[:orgMode :v2 |
orgMode == OrganizerCanvas organizerModeProject
or:[self navigationState isClassExtensionBrowser]
]
argument:(self organizerModeForMenu)
argument:(self browserCanvas).
builder aspectAt:#projectMenuVisible put: holder
].
^ holder
"Created: / 17-02-2000 / 22:19:11 / cg"
"Modified: / 08-03-2007 / 23:01:24 / cg"
!
protocolMenuVisible
|holder|
(holder := builder bindingAt:#protocolMenuVisible) isNil ifTrue:[
holder := BlockValue
with:[:v | |n|
n := self navigationState.
n isFullClassSourceBrowser not
and:[n isClassDocumentationBrowser not
and:[n isVersionDiffBrowser not
and:[n isMethodBrowser not
and:[n isChainBrowser not]]]]
]
argument:(self browserCanvas).
builder aspectAt:#protocolMenuVisible put: holder
].
^ holder
"Modified: / 24.2.2000 / 14:55:11 / cg"
!
searchMenuInMethodListVisible
|holder|
(holder := builder bindingAt:#searchMenuInMethodListVisible) isNil ifTrue:[
holder := BlockValue
with:[:v | |n|
n := self navigationState.
self searchMenuVisible value not
and:[n isMethodBrowser]
]
argument:(self browserCanvas).
builder aspectAt:#searchMenuInMethodListVisible put: holder
].
^ holder
!
searchMenuVisible
|holder|
(holder := builder bindingAt:#searchMenuVisible) isNil ifTrue:[
holder := BlockValue
with:[:v | |n|
n := self navigationState.
n isProtocolOrFullProtocolBrowser not
and:[n isChainBrowser not
and:[n isVersionDiffBrowser not
and:[n isCategoryBrowser not]]]
]
argument:(self browserCanvas).
builder aspectAt:#searchMenuVisible put: holder
].
^ holder
!
selectorMenuVisible
|holder|
(holder := builder bindingAt:#selectorMenuVisible) isNil ifTrue:[
holder := BlockValue
with:[:v | |n|
n := self navigationState.
n isClassDocumentationBrowser not
and:[n isVersionDiffBrowser not
and:[n isFullClassSourceBrowser not]]
]
argument:(self browserCanvas).
builder aspectAt:#selectorMenuVisible put: holder
].
^ holder
"Created: / 24.2.2000 / 14:55:44 / cg"
!
showingInheritedMethods
|holder|
(holder := builder bindingAt:#showingInheritedMethods) isNil ifTrue:[
holder := BlockValue
with:[:h :o | self isMethodListBrowser not and:[h ~~ #class] ]
argument:(self methodVisibilityHolder)
argument:(self organizerModeForMenu).
builder aspectAt:#showingInheritedMethods put: holder
].
^ holder
"Modified: / 08-03-2007 / 23:01:39 / cg"
!
viewMenuForMethodListVisible
|holder|
(holder := builder bindingAt:#viewMenuForMethodListVisible) isNil ifTrue:[
holder := BlockValue
with:[:v | |n|
n := self navigationState.
n isMethodListBrowser or:[n isChainBrowser]
]
argument:(self browserCanvas).
builder aspectAt:#viewMenuForMethodListVisible put: holder
].
^ holder
!
viewMenuOrganizerItemsVisible
|holder|
(holder := builder bindingAt:#viewMenuOrganizerItemsVisible) isNil ifTrue:[
holder := BlockValue
with:[:v | |n|
n := self navigationState.
n isClassBrowser not
and:[n isProtocolOrFullProtocolBrowser not
and:[n isProjectFullBrowser not
and:[n isMethodBrowser not
and:[n isChainBrowser not
and:[n isCategoryBrowser not
and:[n isNameSpaceBrowser not
and:[n isNameSpaceFullBrowser not
and:[n isVersionDiffBrowser not
and:[n isProjectBrowser not]]]]]]]]]
]
argument:(self browserCanvas).
builder aspectAt:#viewMenuOrganizerItemsVisible put: holder
].
^ holder
"Modified: / 18.8.2000 / 19:03:48 / cg"
!
viewMenuVisible
|holder|
(holder := builder bindingAt:#viewMenuVisible) isNil ifTrue:[
holder := BlockValue
with:[:v | |n|
n := self navigationState.
true "n isClassBrowser not"
and:[true "n isProtocolOrFullProtocolBrowser not"
and:[true "n isProjectFullBrowser not"
and:[n isMethodBrowser not
and:[n isMethodListBrowser not
and:[n isChainBrowser not
and:[n isCategoryBrowser not
and:[n isNameSpaceBrowser not
and:[n isNameSpaceFullBrowser not
and:[n isVersionDiffBrowser not
and:[n isProjectBrowser not]]]]]]]]]]
]
argument:(self browserCanvas).
builder aspectAt:#viewMenuVisible put: holder
].
^ holder
"Modified: / 18.8.2000 / 19:03:48 / cg"
! !
!NewSystemBrowser methodsFor:'aspects-presentation'!
codeInfoVisible
|holder|
(holder := builder bindingAt:#codeInfoVisible) isNil ifTrue:[
holder := (DefaultCodeInfoVisible ? true "false") asValue.
builder aspectAt:#codeInfoVisible put: holder.
holder addDependent:self.
].
^ holder
"Modified: / 18.2.2000 / 17:34:18 / cg"
"Created: / 18.2.2000 / 17:44:17 / cg"
!
doAutoFormat
|holder|
(holder := builder bindingAt:#doAutoFormat) isNil ifTrue:[
holder := (DefaultAutoFormat ? UserPreferences current autoFormatting) asValue.
builder aspectAt:#doAutoFormat put:holder.
holder onChangeEvaluate:[ DefaultAutoFormat := holder value.
self enqueueDelayedUpdateCodeWithoutAutoSearch].
].
^ holder.
!
doImmediateExplaining
|holder|
(holder := builder bindingAt:#doImmediateExplaining) isNil ifTrue:[
holder := (DefaultImmediateExplaining ? true) asValue.
builder aspectAt:#doImmediateExplaining put:holder.
holder onChangeEvaluate:[ DefaultImmediateExplaining := holder value.
].
].
^ holder
!
doImmediateSyntaxColoring
|holder|
(holder := builder bindingAt:#doImmediateSyntaxColoring) isNil ifTrue:[
holder := (DefaultImmediateSyntaxColoring ? true) asValue.
builder aspectAt:#doImmediateSyntaxColoring put:holder.
holder onChangeEvaluate:[ DefaultImmediateSyntaxColoring := holder value.
self startSyntaxHighlightProcess
].
].
^ holder
!
doSyntaxColoring
|holder|
(holder := builder bindingAt:#doSyntaxColoring) isNil ifTrue:[
holder := (DefaultSyntaxColoring ? UserPreferences current syntaxColoring) asValue.
builder aspectAt:#doSyntaxColoring put:holder.
holder onChangeEvaluate:[ DefaultSyntaxColoring := holder value.
self enqueueDelayedUpdateCodeWithoutAutoSearch].
].
^ holder.
!
editorNoteBookCanvasHolder
^ navigationState editorNoteBookCanvasHolder
!
editorNoteBookListHolder
^ navigationState editorNoteBookListHolder
!
emphasizeUnloadedClasses
|holder|
(holder := builder bindingAt:#emphasizeUnloadedClasses) isNil ifTrue:[
holder := (DefaultEmphasizeUnloadedClasses ? false) asValue.
builder aspectAt:#emphasizeUnloadedClasses put: holder.
holder onChangeSend:#emphasizeUnloadedClassesChanged to:self.
].
^ holder
"Modified: / 18.2.2000 / 17:34:18 / cg"
"Created: / 18.2.2000 / 17:44:17 / cg"
!
emphasizeUnloadedClassesChanged
|classListApp clr e|
classListApp := self classListApp.
DefaultEmphasizeUnloadedClasses := e := self emphasizeUnloadedClasses value.
e ifTrue:[
clr := Color red:(classListApp window font boldness < 0.6
ifTrue:[20] ifFalse:[10]).
] ifFalse:[
clr := nil
].
classListApp unloadedClassesColor:clr.
"/ classListApp updateList.
classListApp invalidateList.
"Modified: / 31.10.2001 / 11:14:50 / cg"
!
hidePrivateClasses
^ self navigationState hidePrivateClasses
"Modified: / 24.2.2000 / 16:17:38 / cg"
!
hideUnloadedClasses
|holder|
(holder := builder bindingAt:#hideUnloadedClasses) isNil ifTrue:[
holder := (DefaultHideUnloadedClasses ? false) asValue.
builder aspectAt:#hideUnloadedClasses put: holder.
holder onChangeEvaluate:[ DefaultHideUnloadedClasses := holder value ].
].
^ holder
"Modified: / 18.2.2000 / 17:34:18 / cg"
"Created: / 18.2.2000 / 17:44:17 / cg"
!
markApplicationsHolder
|holder|
(holder := builder bindingAt:#markApplicationsHolder) isNil ifTrue:[
holder := (DefaultMarkApplications ? true) asValue.
builder aspectAt:#markApplicationsHolder put: holder.
holder onChangeEvaluate:[ DefaultMarkApplications := holder value ].
].
^ holder
"Modified: / 18.2.2000 / 17:34:18 / cg"
"Created: / 18.2.2000 / 17:44:17 / cg"
!
methodVisibilityHolder
^ builder valueAspectFor:#methodVisibilityHolder initialValue:#class
!
packageDiagramMenuItemVisible
^ OOM::MetricVisualizer notNil and:[ self viewMenuOrganizerItemsVisible value ]
"Modified: / 25-04-2010 / 13:43:35 / cg"
!
selectedEditorNoteBookTabIndexHolder
|holder|
holder := navigationState selectedEditorNoteBookTabIndexHolder.
holder addDependent:self.
^ holder
!
shortNamesInTabs
|holder|
(holder := builder bindingAt:#shortNamesInTabs) isNil ifTrue:[
holder := (DefaultShortNameInTabs ? true) asValue.
builder aspectAt:#shortNamesInTabs put: holder.
holder onChangeEvaluate:[ DefaultShortNameInTabs := holder value ].
].
^ holder
!
showAllClassesInNameSpaceOrganisation
|holder|
(holder := builder bindingAt:#showAllClassesInNameSpaceOrganisation) isNil ifTrue:[
holder := (DefaultShortAllClassesInNameSpaceOrganisation ? false) asValue.
builder aspectAt:#showAllClassesInNameSpaceOrganisation put: holder.
holder onChangeEvaluate:[ DefaultShortAllClassesInNameSpaceOrganisation := holder value ].
].
^ holder
"Created: / 05-03-2007 / 16:30:29 / cg"
"Modified: / 06-03-2007 / 12:20:19 / cg"
!
showClassPackages
showClassPackages isNil ifTrue:[
showClassPackages := false asValue.
].
^ showClassPackages.
"/ ^ self navigationState showClassPackages
"Modified: / 24.2.2000 / 16:17:38 / cg"
!
showClassVarsInVariableList
^ builder valueAspectFor:#showClassVarsInVariableList initialValue:false
!
showCoverageInformation
|holder|
(holder := builder bindingAt:#showCoverageInformation) isNil ifTrue:[
holder := false asValue.
builder aspectAt:#showCoverageInformation put: holder.
].
^ holder
"Created: / 27-04-2010 / 16:02:49 / cg"
!
showMethodComplexity
|holder|
(holder := builder bindingAt:#showMethodComplexity) isNil ifTrue:[
holder := (DefaultShowMethodComplexity ? false) asValue.
builder aspectAt:#showMethodComplexity put: holder.
holder onChangeEvaluate:[ DefaultShowMethodComplexity := holder value ].
].
^ holder
!
showMethodInheritance
|holder|
(holder := builder bindingAt:#showMethodInheritance) isNil ifTrue:[
holder := (DefaultShowMethodInheritance ? true) asValue.
builder aspectAt:#showMethodInheritance put: holder.
holder onChangeEvaluate:[ DefaultShowMethodInheritance := holder value ].
].
^ holder
"Modified: / 18.2.2000 / 17:34:18 / cg"
"Created: / 18.2.2000 / 17:44:17 / cg"
!
showMethodTemplate
|holder|
(holder := builder bindingAt:#showMethodTemplate) isNil ifTrue:[
holder := (DefaultShowMethodTemplate ? true) asValue.
builder aspectAt:#showMethodTemplate put: holder.
holder onChangeEvaluate:[ DefaultShowMethodTemplate := holder value ].
].
^ holder
"Modified: / 18.2.2000 / 17:34:18 / cg"
"Created: / 18.2.2000 / 17:44:17 / cg"
!
showMethodTypeIcon
|holder|
(holder := builder bindingAt:#showMethodTypeIcon) isNil ifTrue:[
holder := (DefaultShowMethodTypeIcon ? true) asValue.
builder aspectAt:#showMethodTypeIcon put: holder.
holder onChangeEvaluate:[ DefaultShowMethodTypeIcon := holder value ].
].
^ holder
!
showMultitabMode
|holder|
(holder := builder bindingAt:#showMultitabMode) isNil ifTrue:[
holder := (DefaultShowMultitabMode ? false) asValue.
builder aspectAt:#showMultitabMode put: holder.
holder onChangeEvaluate:[
self updateSpecialCodeEditorVisibility.
DefaultShowMultitabMode := holder value.
].
].
^ holder
!
showPseudoProtocols
|holder|
(holder := builder bindingAt:#showPseudoProtocols) isNil ifTrue:[
holder := (DefaultShowPseudoProtocols ? true) asValue.
builder aspectAt:#showPseudoProtocols put: holder.
holder onChangeEvaluate:[ DefaultShowPseudoProtocols := holder value ].
].
^ holder
!
showSpecialResourceEditors
|holder|
(holder := builder bindingAt:#showSpecialResourceEditors) isNil ifTrue:[
holder := (DefaultShowSpecialResourceEditors ? false) asValue.
builder aspectAt:#showSpecialResourceEditors put: holder.
holder onChangeEvaluate:[
self updateSpecialCodeEditorVisibility.
DefaultShowSpecialResourceEditors := holder value
].
].
^ holder
!
showUnloadedClasses
|holder|
(holder := builder bindingAt:#showUnloadedClasses) isNil ifTrue:[
holder := BlockValue forLogicalNot:(self hideUnloadedClasses).
builder aspectAt:#showUnloadedClasses put: holder.
holder onChangeEvaluate:[self classListApp invalidateList].
].
^ holder
"Created: / 18.2.2000 / 17:44:17 / cg"
"Modified: / 31.10.2001 / 11:09:32 / cg"
!
sortVariablesByName
^ builder valueAspectFor:#sortVariablesByName initialValue:false
!
stringSearchToolVisibleHolder
|holder|
(holder := builder bindingAt:#stringSearchToolVisibleHolder) isNil ifTrue:[
holder := false asValue.
builder aspectAt:#stringSearchToolVisibleHolder put: holder.
holder addDependent:self.
].
^ holder
!
toolBarVisibleHolder
|holder|
(holder := builder bindingAt:#toolBarVisibleHolder) isNil ifTrue:[
holder := (DefaultToolBarVisible ? true "false") asValue.
builder aspectAt:#toolBarVisibleHolder put: holder.
holder addDependent:self.
].
^ holder
"Created: / 18.2.2000 / 17:44:17 / cg"
"Modified: / 31.10.2001 / 11:09:32 / cg"
! !
!NewSystemBrowser methodsFor:'aspects-queries'!
anyBreakOrTracePointsAreSet
^ MessageTracer notNil
and:[MessageTracer isLoaded
and:[MessageTracer areAnyMethodsWrapped]]
!
anyBreakOrTracePointsAreSetHolder
^ [ self anyBreakOrTracePointsAreSet ]
!
canConvertToSiblings
|selected|
^ (selected := self theSingleSelectedClass) notNil
and:[ selected subclasses size > 0].
!
canConvertToSiblingsHolder
^ [ self canConvertToSiblings ]
!
canFileOutBinaryHolder
^ [ self canFileOutBinary ]
!
canFileOutSIFHolder
^ [ self canFileOutSIF ]
!
canFileOutXMLHolder
^ [ self canFileOutXML ]
!
canGenerateAccessMethodsHolder
^ self hasClassAndVariableSelectedHolder
!
canGenerateAccessMethodsHolderForAll
^ self hasClassAndNoVariableSelectedHolder
!
canGenerateMultiSetterMethodHolder
^ self hasSingleLoadedClassSelectedAndMultipleVariablesSelectedHolder
!
canInsertSuperclass
|selected|
^ (selected := self selectedClasses value) size > 0
and:[ (selected collect:[:each | each superclass ]) asSet size == 1].
!
canInsertSuperclassHolder
^ [ self canInsertSuperclass ]
!
changeSetContainsChangedClasses
^ ChangeSet current changedClasses notEmptyOrNil
!
changeSetContainsChangedClassesAndSourceCodeManagerHolder
^ [ self changeSetContainsChangedClasses and:[ self hasSourceCodeManager]]
!
classOfSelectedMethodOrSelectedClass
| mthd mclass|
(mthd := self theSingleSelectedMethod) notNil ifTrue:[
mclass := mthd mclass.
] ifFalse:[
"/ self codeAspect value ~= #classDefinition ifTrue:[
"/ ^ nil
"/ ].
mclass := self theSingleSelectedClass.
].
^ mclass
!
classWizardVisibleHolder
^ true.
"/ ^ builder booleanValueAspectFor:#classWizardVisibleHolder
!
currentClass
"the current buffers single selected class;
nil if no selection or if multiple classes are selected"
^ self theSingleSelectedClass
!
currentNamespace
|nsSymbol cls|
(nsSymbol := self theSingleSelectedNamespace) notNil ifTrue:[
nsSymbol ~= BrowserList nameListEntryForALL ifTrue:[
^ NameSpace name:nsSymbol
]
].
(cls := self theSingleSelectedClass) notNil ifTrue:[
^ cls topNameSpace
].
^ Class nameSpaceQuerySignal query ? Smalltalk
!
currentProject
|prj projects|
(prj := self theSingleSelectedProject) notNil ifTrue:[
prj ~= BrowserList nameListEntryForALL ifTrue:[
^ prj
]
].
projects := ((self selectedClasses value ? #()) collect:[:cls | cls package]) asSet.
projects size == 1 ifTrue:[
^ projects first
].
projects := ((self selectedMethods value ? #()) collect:[:m | m package]) asSet.
projects size == 1 ifTrue:[
^ projects first
].
^ nil
"Modified: / 28-08-2006 / 23:33:08 / cg"
!
hasAnyAutoLoadedClassSelected
|selected|
^ (selected := self selectedNonMetaclasses) size > 0
and:[ selected contains:[:cls | cls wasAutoloaded ]].
"Modified: / 12-09-2006 / 13:46:56 / cg"
!
hasAnyAutoLoadedClassSelectedHolder
^ [ self hasAnyAutoLoadedClassSelected ]
!
hasAnyCategoryWithAnyAutoLoadedClassSelected
|selected|
^ (selected := self selectedCategoryClasses value) size > 0
and:[ selected contains:[:cls | cls theNonMetaclass wasAutoloaded ]].
!
hasAnyCategoryWithAnyAutoLoadedClassSelectedHolder
^ [ self hasAnyCategoryWithAnyAutoLoadedClassSelected ]
!
hasAnyCategoryWithAnyUnLoadedClassSelected
|selected|
^ (selected := self selectedCategoryClasses value) size > 0
and:[ selected contains:[:cls | cls theNonMetaclass isLoaded not ]].
!
hasAnyCategoryWithAnyUnLoadedClassSelectedHolder
^ [ self hasAnyCategoryWithAnyUnLoadedClassSelected ]
!
hasAnyClassWithCoverageInfoSelected
|selected|
selected := self selectedClasses value.
selected isEmptyOrNil ifTrue:[
selected := self selectedCategoryClasses
].
selected size > 0 ifTrue:[
selected do:[ :cls |
cls instAndClassMethodsDo:[:m | m isInstrumented ifTrue:[^ true]].
].
].
^ false.
"Created: / 27-04-2010 / 16:22:59 / cg"
!
hasAnyClassWithCoverageInfoSelectedHolder
^ [self hasAnyClassWithCoverageInfoSelected]
"Created: / 27-04-2010 / 16:23:13 / cg"
!
hasAnyExecutableClassMethodSelectedHolder
^ self hasNonTestCaseClassMethodWithoutArgsSelectedHolder
!
hasAnyLoadedClassSelected
^ self selectedNonMetaclasses contains:[:cls | cls isLoaded ].
"Modified: / 12-09-2006 / 13:45:27 / cg"
!
hasAnyLoadedClassSelectedHolder
^ [ self hasAnyLoadedClassSelected ]
!
hasAnyNonIgnoredMethodSelected
|sel|
sel := self selectedMethods value.
^ (sel size > 0)
and:[ sel contains:[:m | m isIgnored not] ]
!
hasAnyNonIgnoredMethodSelectedHolder
^ [ self hasAnyNonIgnoredMethodSelected ]
!
hasAnyNonPrivateMethodSelected
|sel|
sel := self selectedMethods value.
^ (sel size > 0)
and:[ sel contains:[:m | m isPrivate not] ]
!
hasAnyNonPrivateMethodSelectedHolder
^ [ self hasAnyNonPrivateMethodSelected ]
!
hasAnyNonProtectedMethodSelected
|sel|
sel := self selectedMethods value.
^ (sel size > 0)
and:[ sel contains:[:m | m isProtected not] ]
!
hasAnyNonProtectedMethodSelectedHolder
^ [ self hasAnyNonProtectedMethodSelected ]
!
hasAnyNonPublicMethodSelected
|sel|
sel := self selectedMethods value.
^ (sel size > 0)
and:[ sel contains:[:m | m isPublic not] ]
!
hasAnyNonPublicMethodSelectedHolder
^ [ self hasAnyNonPublicMethodSelected ]
!
hasAnyTestCaseOrExecutableClassMethodOrStartableApplicationSelectedHolder
^ BlockValue
forLogical:(self hasAnyExecutableClassMethodSelectedHolder)
or:(self hasAnyTestCaseSelectedHolder)
or:(self hasStartableApplicationSelectedHolder)
!
hasAnyTestCaseOrExecutableClassMethodSelectedHolder
^ BlockValue
forLogical:(self hasAnyExecutableClassMethodSelectedHolder)
or:(self hasAnyTestCaseSelectedHolder)
!
hasAnyTestCaseSelected
|selected|
selected := self selectedClasses value.
selected isEmptyOrNil ifTrue:[
selected := self selectedCategoryClasses
].
selected size > 0 ifTrue:[
^ selected
contains:[ :cls |
(cls theNonMetaclass isSubclassOf:TestCase)
and:[ cls theNonMetaclass isAbstract not ]]
].
^ false.
"Modified: / 29-08-2006 / 14:35:47 / cg"
!
hasAnyTestCaseSelectedHolder
|holder|
(holder := builder bindingAt:#hasAnyTestCaseSelectedHolder) isNil ifTrue:[
holder := ValueHolder with:false.
builder aspectAt:#hasAnyTestCaseSelectedHolder put: holder.
].
^ holder
"Modified: / 05-08-2006 / 13:22:29 / cg"
!
hasAnyUnloadedClassSelected
|selected|
^ (selected := self selectedNonMetaclasses) size > 0
and:[ selected contains:[:cls | cls isLoaded not ]].
"Modified: / 12-09-2006 / 13:46:31 / cg"
!
hasAnyUnloadedClassSelectedHolder
^ [ self hasAnyUnloadedClassSelected ]
!
hasApplicationClassSelected
|selectedClasses|
selectedClasses := self selectedNonMetaclasses.
selectedClasses size == 0 ifTrue:[^ false].
^ selectedClasses conform:[:each | each isSubclassOf:ApplicationModel].
"Modified: / 12-09-2006 / 13:46:13 / cg"
!
hasApplicationClassSelectedHolder
^ [ self hasApplicationClassSelected ]
"Created: / 4.2.2000 / 22:02:53 / cg"
!
hasApplicationOrHTTPServiceClassSelectedHolder
^ [ self hasApplicationClassSelected
| self hasWebApplicationClassSelected]
"Created: / 4.2.2000 / 22:02:53 / cg"
!
hasAtMostOneClassesSelected
^ self selectedClasses value size <= 1
!
hasAtMostOneClassesSelectedHolder
^ [ self hasAtMostOneClassesSelected ]
!
hasBothMethodsWithBreakAndTraceSelected
|foundBreak foundTrace|
foundBreak := false.
foundTrace := false.
self
selectedMethodsDo:[ :aMethod |
aMethod isWrapped ifTrue:[
foundBreak := foundBreak or:[ aMethod isBreakpointed ].
foundTrace := foundTrace or:[ aMethod isBreakpointed not ]
]
].
^ foundBreak and:[ foundTrace ]
!
hasCategorySelected
^ self selectedCategoriesValue size > 0
"Created: / 4.2.2000 / 22:03:45 / cg"
!
hasCategorySelectedAndCanFileOutSIFHolder
^ [ self hasCategorySelected and:[self canFileOutSIF] ]
!
hasCategorySelectedAndCanFileOutXMLHolder
^ [ self hasCategorySelected and:[self canFileOutXML] ]
!
hasCategorySelectedAndSourceCodeManager
^ self hasCategorySelected and:[self hasSourceCodeManager]
"Created: / 4.2.2000 / 22:04:12 / cg"
!
hasCategorySelectedAndSourceCodeManagerHolder
^ [ self hasCategorySelectedAndSourceCodeManager ]
"Created: / 4.2.2000 / 22:04:12 / cg"
!
hasCategorySelectedHolder
^ [ self hasCategorySelected ]
"Created: / 4.2.2000 / 22:04:12 / cg"
!
hasChangedClasses
^ Project current changeSet contains:[:change | change isClassChange]
!
hasChangedClassesHolder
^ [ self hasChangedClasses ]
!
hasChangedMethods
^ Project current changeSet contains:[:change | change isMethodChange]
!
hasChangedMethodsHolder
^ [ self hasChangedMethods ]
!
hasClassAndNoVariableSelected
^ self hasClassSelected and:[self hasVariableSelected not ]
!
hasClassAndNoVariableSelectedHolder
^ [ self hasClassAndNoVariableSelected ]
"Created: / 4.2.2000 / 22:02:53 / cg"
!
hasClassAndSingleVariableSelected
^ self hasClassSelected and:[self hasSingleVariableSelected]
!
hasClassAndSingleVariableSelectedHolder
^ [ self hasClassAndSingleVariableSelected ]
"Created: / 4.2.2000 / 22:02:53 / cg"
!
hasClassAndVariableSelected
^ self hasClassSelected and:[self hasVariableSelected]
!
hasClassAndVariableSelectedHolder
^ [ self hasClassAndVariableSelected ]
"Created: / 4.2.2000 / 22:02:53 / cg"
!
hasClassMethodsSelected
|methods|
methods := self selectedMethods value.
methods size == 0 ifTrue:[ ^ false ].
^ (methods conform:[:eachMethod | eachMethod mclass isMeta])
!
hasClassMethodsSelectedHolder
^ [ self hasClassMethodsSelected ]
"Created: / 4.2.2000 / 22:23:39 / cg"
!
hasClassNameSelectedInCodeView
^ self selectedClassNameInCodeViewOrNil notNil
!
hasClassSelected
^ self selectedClasses value size > 0
"Created: / 4.2.2000 / 22:02:25 / cg"
"Modified: / 6.2.2000 / 01:12:40 / cg"
!
hasClassSelectedAndCanFileOutBinaryHolder
^ [ self hasClassSelected and:[self canFileOutBinary]]
"Created: / 4.2.2000 / 22:02:53 / cg"
!
hasClassSelectedAndCanFileOutSIFHolder
^ [ self hasClassSelected and:[self canFileOutSIF]]
"Created: / 4.2.2000 / 22:02:53 / cg"
!
hasClassSelectedAndCanFileOutXMLHolder
^ [ self hasClassSelected and:[self canFileOutXML]]
"Created: / 4.2.2000 / 22:02:53 / cg"
!
hasClassSelectedAndCanSendMailHolder
^ [ self hasClassSelected and:[ SendMailTool notNil] ]
"Created: / 05-10-2010 / 12:26:23 / cg"
!
hasClassSelectedAndControlKeyDown
^ self hasClassSelected and:[self window sensor ctrlDown]
!
hasClassSelectedAndControlKeyDownHolder
^ [ self hasClassSelectedAndControlKeyDown ]
"Created: / 4.2.2000 / 22:02:53 / cg"
!
hasClassSelectedAndInstrumentingCompilerExistsAndOOMPackageLoadedHolder
^ [ self hasClassSelectedAndInstrumentingCompilerExistsHolder value
and:[ OOM::MetricVisualizer notNil ]
]
"Created: / 27-04-2010 / 12:33:41 / cg"
!
hasClassSelectedAndInstrumentingCompilerExistsHolder
^ [ self hasClassSelected and:[ self instrumentingCompilerExists] ]
"Created: / 4.2.2000 / 22:11:34 / cg"
!
hasClassSelectedAndSourceCodeManagerHolder
^ [ self hasClassSelected and:[ self hasSourceCodeManager]]
"Created: / 4.2.2000 / 22:02:53 / cg"
!
hasClassSelectedHolder
^ [ self hasClassSelected ]
"Created: / 4.2.2000 / 22:02:53 / cg"
!
hasClassSelectedHolderAndSourceCodeManagerHolder
^ [ self hasClassSelected and:[ self hasSourceCodeManager] ]
"Created: / 4.2.2000 / 22:11:34 / cg"
!
hasClassSelectedWhichCanBeExcludedFromProject
|selectedClasses|
selectedClasses := self selectedClasses value.
selectedClasses isEmptyOrNil ifTrue:[^ false].
^ selectedClasses
contains:[:cls |
|def|
def := ProjectDefinition definitionClassForPackage:cls package.
def notNil
and:[ def isLoaded
and:[ (def allClassNames includes:cls name)
and:[ cls isProjectDefinition not ]]]
]
"Created: / 22-02-2007 / 13:55:03 / cg"
"Modified: / 30-08-2007 / 18:58:08 / cg"
!
hasClassSelectedWhichCanBeExcludedFromProjectHolder
^ [ self hasClassSelectedWhichCanBeExcludedFromProject ]
"Created: / 22-02-2007 / 13:55:09 / cg"
!
hasClassSelectedWhichCanBeIncludedInProject
|selectedClasses|
selectedClasses := self selectedClasses value.
selectedClasses isEmptyOrNil ifTrue:[^ false].
^ selectedClasses
contains:[:cls |
|def|
def := ProjectDefinition definitionClassForPackage:cls package.
def notNil
and:[ def isLoaded
and:[ (def compiled_classNames includes:cls name) not
and:[ cls isProjectDefinition not ]]]
]
"Created: / 22-02-2007 / 13:54:16 / cg"
"Modified: / 28-03-2007 / 21:53:51 / cg"
!
hasClassSelectedWhichCanBeIncludedInProjectHolder
^ [ self hasClassSelectedWhichCanBeIncludedInProject ]
"Created: / 22-02-2007 / 13:54:23 / cg"
!
hasClassSelectedWhichCanBeMadeAutoloadedInProject
|selectedClasses|
selectedClasses := self selectedClasses value.
selectedClasses isEmptyOrNil ifTrue:[^ false].
^ selectedClasses
contains:[:cls |
|def|
def := ProjectDefinition definitionClassForPackage:cls package.
def notNil
and:[ def isLoaded
and:[ (def autoloaded_classNames includes:cls name) not
and:[ cls isProjectDefinition not ]]]
]
"Created: / 30-08-2007 / 18:48:59 / cg"
!
hasClassSelectedWhichCanBeMadeAutoloadedInProjectHolder
^ [ self hasClassSelectedWhichCanBeMadeAutoloadedInProject ]
"Created: / 30-08-2007 / 18:49:11 / cg"
!
hasClassVariableSelected
^ self hasVariableSelected
"/ and:[ self showingClassVarsInVariableList ]
!
hasClassVariableSelectedHolder
^ [ self hasClassVariableSelected ]
"Created: / 4.2.2000 / 22:08:22 / cg"
!
hasClassVariableSelectedInCodeView
|mthd mclass selection|
(self hasSingleWordSelectedInCodeView) ifFalse:[^ false].
selection := self selectionInCodeView.
(mthd := self theSingleSelectedMethod) notNil ifTrue:[
mclass := mthd mclass.
].
mclass isNil ifTrue:[
mclass := self theSingleSelectedClass.
mclass isNil ifTrue:[^ false].
].
^ (mclass theNonMetaclass whichClassDefinesClassVar:selection) notNil.
"/ the following is too slow
"/ node := self findNode.
"/ (node isNil or:[node isVariable not]) ifTrue:[
"/ ^ false
"/ ].
"/ ^ true
"Modified: / 01-03-2007 / 20:54:01 / cg"
!
hasClassVariableSelectedInCodeViewHolder
^ [ self hasClassVariableSelectedInCodeView ]
!
hasClassVariableSelectedInCodeViewOrVariableList
(self hasClassVariableSelectedInCodeView) ifTrue:[^ true].
^ self hasClassVariableSelectedInVariableList
!
hasClassVariableSelectedInCodeViewOrVariableListAndCanUseRefactoringSupportHolder
^ [ self canUseRefactoringSupport
and:[self hasClassVariableSelectedInCodeViewOrVariableList] ]
!
hasClassVariableSelectedInCodeViewOrVariableListHolder
^ [ self hasClassVariableSelectedInCodeViewOrVariableList ]
!
hasClassVariableSelectedInVariableList
|var mclass|
var := self theSingleSelectedVariable.
var isNil ifTrue:[^ false].
mclass := self classOfSelectedMethodOrSelectedClass.
mclass isNil ifTrue:[^ false].
^ (mclass theNonMetaclass whichClassDefinesClassVar:var) notNil.
!
hasClassWithExtensionsSelected
^ (self selectedClasses value ? #())
contains:[:cls | cls hasExtensions].
!
hasClassWithExtensionsSelectedHolder
^ [ self hasClassWithExtensionsSelected ]
"Created: / 4.2.2000 / 22:02:53 / cg"
!
hasClassesSelectedAndSubversionRepositoryExists
| classes |
classes := self selectedClasses value.
classes size = 0 ifTrue:[^false].
^ classes
allSatisfy:
[:cls | self hasSubversionRepositoryFor: cls theNonMetaclass package]
!
hasClassesSelectedAndSubversionRepositoryExistsHolder
^ [
| classes |
classes := self selectedClasses value.
classes isEmptyOrNil ifTrue:[
false
] ifFalse:[
classes
allSatisfy:
[:cls | self hasSubversionRepositoryFor: cls theNonMetaclass package]
]
]
!
hasClassesWithCommonSuperclassAndVariableSelectedAndCanUseRefactoringSupportHolder
^ [ self canUseRefactoringSupport
and:[self hasClassesWithCommonSuperclassSelected
and:[self hasVariableSelectedInCodeViewOrVariableList]] ]
"Created: / 4.2.2000 / 22:02:53 / cg"
!
hasClassesWithCommonSuperclassSelected
|selectedClasses commonSuper|
selectedClasses := self selectedClasses value.
selectedClasses isEmptyOrNil ifTrue:[^ false].
selectedClasses size == 1 ifTrue:[^ true].
commonSuper := Behavior commonSuperclassOf:(selectedClasses ? #()).
^ commonSuper notNil and:[ selectedClasses includes: commonSuper ].
"Modified: / 11-02-2007 / 13:47:14 / cg"
!
hasEmptyNamespacesSelected
"return true, if only empty namespaces are selected"
|selectedNamespaces|
selectedNamespaces := self selectedNamespaces value.
selectedNamespaces size == 0 ifTrue:[^ false].
^ (selectedNamespaces
contains:[:nm |
|ns|
ns := Smalltalk at:nm asSymbol ifAbsent:nil.
ns notNil
and:[ns allClasses size ~~ 0]
]
) not
!
hasEmptyNamespacesSelectedHolder
"return true, if only empty namespaces are selected"
^ [ self hasEmptyNamespacesSelected ]
!
hasEnumTypeClassSelected
^ self hasClassSelected
and:[self selectedClasses value
contains:[:cls |
cls isLoaded
and:[(cls theNonMetaclass askFor:#isAbstract) not
and:[ cls withAllSuperclasses contains:[:aSuperClass |
aSuperClass theNonMetaclass name includesString:'Enum']]] ]]
"Modified: / 07-09-2007 / 15:38:45 / cg"
!
hasEnumTypeClassSelectedHolder
^ [ self hasEnumTypeClassSelected ]
"Created: / 4.2.2000 / 22:02:53 / cg"
!
hasExactlyTwoClassesSelected
^ self selectedClasses value size == 2
!
hasExactlyTwoClassesSelectedHolder
^ [ self hasExactlyTwoClassesSelected ]
"Created: / 4.2.2000 / 22:11:34 / cg"
!
hasExactlyTwoMethodsSelected
^ self selectedMethods value size == 2
!
hasExactlyTwoMethodsSelectedHolder
^ [ self hasExactlyTwoMethodsSelected ]
"Created: / 4.2.2000 / 22:11:34 / cg"
!
hasExtensionMethodSelected
^ self selectedMethods value ? #()
contains:[:aMethod | aMethod containingClass isNil
or:[ aMethod package ~= aMethod containingClass package ]
]
!
hasExtensionMethodSelectedHolder
^ BlockValue
with:[:m | m and:[self hasExtensionMethodSelected]]
argument:(self hasMethodSelectedHolder)
"Modified: / 08-03-2007 / 23:00:43 / cg"
!
hasFindHistoryClassesHolder
^ [ FindHistory size > 0 ]
!
hasInstanceMethodsSelected
|methods|
methods := self selectedMethods value.
methods size == 0 ifTrue:[ ^ false ].
^ (methods conform:[:eachMethod | eachMethod mclass isMeta not])
!
hasInstanceMethodsSelectedHolder
^ [ self hasInstanceMethodsSelected ]
"Created: / 4.2.2000 / 22:23:39 / cg"
!
hasInstanceVariableSelectedInCodeView
|mthd mclass selection|
(self hasSingleWordSelectedInCodeView) ifFalse:[^ false].
selection := self selectionInCodeView.
(mthd := self theSingleSelectedMethod) notNil ifTrue:[
mclass := mthd mclass.
].
mclass isNil ifTrue:[
self codeAspect value ~= #classDefinition ifTrue:[
^ false
].
mclass := self theSingleSelectedClass.
(mclass isNil or:[mclass isMeta]) ifTrue:[ ^ false].
].
^ (mclass whichClassDefinesInstVar:selection) notNil.
"/ the following is too slow
"/ node := self findNode.
"/ (node isNil or:[node isVariable not]) ifTrue:[
"/ ^ false
"/ ].
"/ ^ true
!
hasInstanceVariableSelectedInCodeViewHolder
^ [ self hasInstanceVariableSelectedInCodeView ]
!
hasInstanceVariableSelectedInCodeViewOrVariableList
| mclass var|
self hasInstanceVariableSelectedInCodeView ifTrue:[^ true].
var := self theSingleSelectedVariable.
var isNil ifTrue:[^ false].
mclass := self classOfSelectedMethodOrSelectedClass.
mclass isNil ifTrue:[^ false].
^ (mclass whichClassDefinesInstVar:var) notNil.
!
hasInstanceVariableSelectedInCodeViewOrVariableListAndCanUseRefactoringSupportHolder
^ [ self canUseRefactoringSupport
and:[self hasInstanceVariableSelectedInCodeViewOrVariableList]]
!
hasInstanceVariableSelectedInCodeViewOrVariableListHolder
^ [ self hasInstanceVariableSelectedInCodeViewOrVariableList]
!
hasLoadedClassSelected
^ self hasClassSelected
and:[self selectedClasses value contains:[:aClass | aClass isLoaded]]
!
hasLoadedClassSelectedHolder
^ [ self hasLoadedClassSelected ]
"Created: / 4.2.2000 / 22:02:53 / cg"
!
hasLocalSelectorSelectedInCodeView
|sel|
self hasSelectorSelectedInCodeView ifFalse:[^ false].
sel := self selectedSelectorInCodeViewOrNil.
sel isNil ifTrue:[^ false].
(self selectedClasses value ? #()) contains:[:cls |
(cls canUnderstand:sel) ifTrue:[^ true].
].
^ true.
!
hasLocalVariableSelectedInCodeView
|"node" selectionInCode|
self codeAspect value == #method ifFalse:[^ false].
selectionInCode := self codeView selection.
selectionInCode size == 0 ifTrue:[ ^ false ].
selectionInCode asString string asCollectionOfWords size == 1 ifFalse:[^ false].
"/ the following is too slow
"/ node := self findNode.
"/ (node isNil or:[node isVariable not]) ifTrue:[
"/ ^ false
"/ ].
^ true
!
hasLocalVariableSelectedInCodeViewHolder
^ [ self hasLocalVariableSelectedInCodeView ]
!
hasMetaMethodSelectedHolder
^ [ (self hasMethodSelected and:[self hasMetaSelected])
or:[self hasClassMethodsSelected ]]
!
hasMetaSelected
^ self meta value
!
hasMetaSelectedAndClassSelectedHolder
^ [ self meta value and:[ self hasClassSelected] ]
!
hasMetaSelectedHolder
^ self meta
!
hasMethodSelected
^ self selectedMethods value size > 0
"Created: / 4.2.2000 / 22:09:52 / cg"
"Modified: / 5.2.2000 / 23:06:44 / cg"
!
hasMethodSelectedAndCanFileOutSIFHolder
^ [ self hasMethodSelected and:[ self canFileOutSIF] ]
"Created: / 4.2.2000 / 22:23:39 / cg"
!
hasMethodSelectedAndCanFileOutXMLHolder
^ [ self hasMethodSelected and:[ self canFileOutXML] ]
"Created: / 4.2.2000 / 22:23:39 / cg"
!
hasMethodSelectedAndCanUseRefactoringSupportHolder
^ [ self canUseRefactoringSupport
and:[self hasMethodSelected] ]
"Created: / 4.2.2000 / 22:23:39 / cg"
!
hasMethodSelectedAndInstrumentingCompilerExistsAndOOMPackageLoadedHolder
^ [ self hasMethodSelectedAndInstrumentingCompilerExistsHolder value
and:[ OOM::MetricVisualizer notNil ]
]
"Created: / 10-08-2010 / 14:42:18 / cg"
!
hasMethodSelectedAndInstrumentingCompilerExistsHolder
^ [ self hasMethodSelected and:[ self instrumentingCompilerExists] ]
"Created: / 10-08-2010 / 14:42:38 / cg"
!
hasMethodSelectedAndIsMethodListBrowser
^ self hasMethodSelected
and:[navigationState isMethodListBrowser ]
"Created: / 4.2.2000 / 22:23:39 / cg"
!
hasMethodSelectedAndIsMethodListBrowserHolder
^ [ self hasMethodSelectedAndIsMethodListBrowser ]
"Created: / 4.2.2000 / 22:23:39 / cg"
!
hasMethodSelectedAndSourceCodeManagerHolder
^ [ self hasMethodSelected and:[ self hasSourceCodeManager]]
"Created: / 4.2.2000 / 22:23:39 / cg"
!
hasMethodSelectedHolder
^ builder booleanValueAspectFor:#hasMethodSelected
"/ ^ [ self hasMethodSelected ]
"Created: / 4.2.2000 / 22:23:39 / cg"
!
hasMethodWithBreakPointSelected
^ self selectedMethods value ? #()
contains:[:aMethod | aMethod isBreakpointed ]
!
hasMethodWithBreakPointSelectedHolder
^ builder booleanValueAspectFor:#hasMethodWithBreakPointSelectedHolder.
!
hasMethodWithTracePointSelected
^ self selectedMethods value ? #()
contains:[:aMethod | aMethod isWrapped and:[aMethod isBreakpointed not] ]
!
hasMethodWithTracePointSelectedHolder
^ [ self hasMethodWithTracePointSelected ]
!
hasMethodWithWrapSelected
^ self selectedMethods value ? #()
contains:[:aMethod | aMethod isWrapped ]
!
hasMethodWithWrapSelectedHolder
^ [ self hasMethodWithWrapSelected ]
!
hasMethodWithoutBreakPointSelected
^ self selectedMethods value ? #()
contains:[:aMethod | aMethod isBreakpointed not ]
!
hasMethodWithoutBreakPointSelectedHolder
^ builder booleanValueAspectFor:#hasMethodWithoutBreakPointSelectedHolder.
!
hasMethodsInList
|app|
^ (app := self methodListApp) notNil
and:[ app methodList size > 0 ]
!
hasMultipleClassesSelected
^ self selectedClasses value size > 1
!
hasMultipleClassesSelectedHolder
^ [ self hasMultipleClassesSelected ]
"Created: / 4.2.2000 / 22:03:08 / cg"
!
hasMultipleMethodsSelected
^ self selectedMethods value size > 1
!
hasMultipleMethodsSelectedHolder
^ [ self hasMultipleMethodsSelected ]
"Created: / 4.2.2000 / 22:03:08 / cg"
!
hasMultipleSelectorsSelected
^ (self selectedMethods value collect:[:eachMethod | eachMethod selector]) size > 1
!
hasMultipleSelectorsSelectedHolder
^ [ self hasMultipleSelectorsSelected ]
!
hasMultipleTemporaryVariablesSelectedInCodeView
self codeAspect value ~~ #method ifTrue:[^ false].
(self hasMultipleWordsSelectedInCodeView) ifFalse:[^ false].
^ true
!
hasMultipleTemporaryVariablesSelectedInCodeViewHolder
^ [ self hasMultipleTemporaryVariablesSelectedInCodeView ]
!
hasMultipleVariablesSelected
^ self selectedVariables value size > 1
!
hasMultipleWordsSelectedInCodeView
|codeView selectionInCode|
codeView := self codeView.
codeView isNil ifTrue:[^ false].
selectionInCode := self selectionInCodeView.
selectionInCode isEmptyOrNil ifTrue:[ ^ false ].
^ selectionInCode asCollectionOfWords size > 1.
!
hasNameSpaceSelected
^ self selectedNamespaces value size > 0
"Created: / 4.2.2000 / 22:03:45 / cg"
!
hasNameSpaceSelectedAndSourceCodeManager
^ self hasNameSpaceSelected and:[self hasSourceCodeManager]
"Created: / 4.2.2000 / 22:03:45 / cg"
!
hasNameSpaceSelectedAndSourceCodeManagerHolder
^ [ self hasNameSpaceSelectedAndSourceCodeManager ]
"Created: / 4.2.2000 / 22:04:12 / cg"
!
hasNameSpaceSelectedHolder
^ [ self hasNameSpaceSelected ]
"Created: / 4.2.2000 / 22:04:12 / cg"
!
hasNoClassSelected
^ [ self hasClassSelected not ]
!
hasNoMethodOrMixedWrapsSelectedHolder
^ [ self hasMethodSelected not
or:[ self hasBothMethodsWithBreakAndTraceSelected
or:[ self hasMethodWithWrapSelected not] ]]
!
hasNoProjectSelectedHolder
^ [ self hasProjectSelected not ]
"Created: / 14-09-2006 / 17:36:32 / cg"
!
hasNoSourceCodeManagerHolder
^ [ self hasSourceCodeManager not ]
"Created: / 19-03-2007 / 11:15:14 / cg"
!
hasNoVariableSelected
^ self selectedVariables value size == 0
!
hasNonMetaMethodSelectedHolder
^ [ self hasNonMetaSelected and:[self hasMethodSelected] ]
!
hasNonMetaSelected
^self meta value not
!
hasNonMetaSelectedAndClassSelectedHolder
^ [ self hasNonMetaSelected and:[ self hasClassSelected] ]
!
hasNonMetaSelectedHolder
^ [ self hasNonMetaSelected ]
!
hasNonPrivateClassSelected
|classes|
(classes := self selectedClasses value) size > 0 ifTrue:[
^ classes contains:[:aClass | aClass owningClass isNil]
].
^ false
"Created: / 11.2.2000 / 11:07:54 / cg"
!
hasNonPrivateClassSelectedAndSourceCodeManagerHolder
^ [ self hasNonPrivateClassSelected and:[self hasSourceCodeManager] ]
"Created: / 19-03-2007 / 11:13:03 / cg"
!
hasNonPrivateClassSelectedHolder
^ [ self hasNonPrivateClassSelected ]
"Created: / 11.2.2000 / 11:08:03 / cg"
!
hasNonProjectDefinitionSelected
^ self selectedClassesValue
contains:[:cls | cls theNonMetaclass isProjectDefinition not]
"Created: / 10-08-2006 / 16:26:02 / cg"
"Modified: / 13-10-2006 / 11:54:45 / cg"
!
hasNonProjectDefinitionSelectedHolder
^ [ self hasNonProjectDefinitionSelected ]
"Created: / 10-08-2006 / 16:25:50 / cg"
!
hasNonTestCaseClassMethodWithoutArgsSelected
|m |
self hasAnyTestCaseSelected ifTrue:[^ false].
(m := self theSingleSelectedMethod) isNil ifTrue:[^ false].
"/ self hasMetaSelected ifFalse:[^ false].
^ m mclass isMeta
and:[ m numArgs == 0
and:[ m isDocumentationMethod not
and:[ m isVersionMethod not
and:[ m hasImageResource not
and:[ m hasMenuResource not
and:[ m hasCanvasResource not ]]]]]]
!
hasNonTestCaseClassMethodWithoutArgsSelectedHolder
|holder|
(holder := builder bindingAt:#hasNonTestCaseClassMethodWithoutArgsSelectedHolder) isNil ifTrue:[
holder := ValueHolder with:false.
builder aspectAt:#hasNonTestCaseClassMethodWithoutArgsSelectedHolder put: holder.
].
^ holder
"Modified: / 05-08-2006 / 13:22:29 / cg"
!
hasNotMultipleClassesSelected
^ self hasMultipleClassesSelected not
!
hasNotMultipleClassesSelectedHolder
^ [ self hasNotMultipleClassesSelected ]
!
hasNotMultipleTemporaryVariablesSelectedInCodeViewHolder
^ [ self hasMultipleTemporaryVariablesSelectedInCodeView not ]
!
hasOOMPackageLoaded
^ OOM::MethodMetrics notNil
!
hasOOMPackageLoadedAndSingleRealProjectSelectedHolder
^ [self hasOOMPackageLoaded and:[ self hasSingleRealProjectSelectedHolder value ]]
!
hasOOMPackageLoadedHolder
^ [ self hasOOMPackageLoaded ]
!
hasOnlyMethodsWithBreakPointSelected
|anyBreak anyWrap|
anyBreak := anyWrap := false.
self
selectedMethodsDo:[:aMethod |
aMethod isBreakpointed ifTrue:[
anyBreak := true
] ifFalse:[
aMethod isWrapped ifTrue:[
anyWrap := true
]
]
].
^ anyBreak and:[anyWrap not]
!
hasOnlyMethodsWithTracePointSelected
|anyBreak anyWrap|
anyBreak := anyWrap := false.
self
selectedMethodsDo:[:aMethod |
aMethod isBreakpointed ifTrue:[
anyBreak := true
] ifFalse:[
aMethod isWrapped ifTrue:[
anyWrap := true
]
]
].
^ anyWrap and:[anyBreak not]
!
hasProjectDefinitionSelected
^ self selectedClassesValue contains:[:cls | cls theNonMetaclass isProjectDefinition]
"Created: / 10-08-2006 / 16:25:38 / cg"
!
hasProjectDefinitionSelectedAndSourceCodeManagerHolder
^ [ self hasProjectDefinitionSelected and:[self hasSourceCodeManager] ]
"Created: / 4.2.2000 / 22:09:02 / cg"
!
hasProjectDefinitionSelectedHolder
^ [ self hasProjectDefinitionSelected ]
"Created: / 10-08-2006 / 16:26:17 / cg"
!
hasProjectDefinitionWithAnyUnloadedClassSelected
((self selectedClasses value) ? #()) do:[:cls |
cls isLoaded ifFalse:[^ true].
cls isProjectDefinition ifTrue:[
cls hasAllExtensionsLoaded ifFalse:[^ true].
cls hasAllClassesLoaded ifFalse:[^ true].
].
].
^ true
"Created: / 17-08-2006 / 00:49:24 / cg"
"Modified: / 12-10-2006 / 21:51:16 / cg"
!
hasProjectDefinitionWithAnyUnloadedClassSelectedHolder
^ [ self hasProjectDefinitionWithAnyUnloadedClassSelected ]
"Created: / 17-08-2006 / 00:46:45 / cg"
!
hasProjectSelected
^ self selectedProjects value size > 0
!
hasProjectSelectedAndCanFileOutSIFHolder
^ [ self hasProjectSelected and:[self canFileOutSIF] ]
"Created: / 4.2.2000 / 22:09:02 / cg"
!
hasProjectSelectedAndCanFileOutXMLHolder
^ [ self hasProjectSelected and:[self canFileOutXML] ]
"Created: / 4.2.2000 / 22:09:02 / cg"
!
hasProjectSelectedAndSourceCodeManagerHolder
^ [ self hasProjectSelected and:[self hasSourceCodeManager] ]
"Created: / 4.2.2000 / 22:09:02 / cg"
!
hasProjectSelectedHolder
^ [ self hasProjectSelected ]
"Created: / 4.2.2000 / 22:09:02 / cg"
!
hasProjectSelectedSubversionRepositoryExistsHolder
^ [ self hasProjectSelected
and:[self selectedProjects value size = 1
and:[self hasSubversionRepositoryFor: self selectedProjects value anyOne]]]
"Created: / 31-03-2008 / 15:07:52 / janfrog"
!
hasProtocolSelected
^ self selectedProtocols value size > 0
"Created: / 4.2.2000 / 22:07:55 / cg"
"Modified: / 4.2.2000 / 22:08:49 / cg"
!
hasProtocolSelectedAndCanFileOutSIFHolder
^ [ self hasProtocolSelected and:[self canFileOutSIF] ]
"Created: / 4.2.2000 / 22:09:02 / cg"
!
hasProtocolSelectedAndCanFileOutXMLHolder
^ [ self hasProtocolSelected and:[self canFileOutXML] ]
"Created: / 4.2.2000 / 22:09:02 / cg"
!
hasProtocolSelectedHolder
^ [ self hasProtocolSelected ]
"Created: / 4.2.2000 / 22:09:02 / cg"
!
hasRealExtensionMethodSelected
^ self selectedMethods value ? #()
contains:[:aMethod | |mPackage|
mPackage := aMethod package.
aMethod containingClass notNil
and:[mPackage ~= aMethod containingClass package
and:[mPackage ~= PackageId noProjectID]] ]
"Modified: / 12-10-2006 / 20:51:30 / cg"
!
hasRealExtensionMethodSelectedHolder
^ BlockValue
with:[:m | m and:[self hasRealExtensionMethodSelected]]
argument:(self hasMethodSelectedHolder)
"Modified: / 08-03-2007 / 23:00:45 / cg"
!
hasRealProtocolSelected
"true, if at least one real method protocol (i.e. not *all*) item is selected"
|selectedProtocols|
selectedProtocols := self selectedProtocols value.
^ selectedProtocols size > 0
and:[selectedProtocols contains:[:p | p ~= BrowserList nameListEntryForALL]]
!
hasRealProtocolSelectedHolder
^ [ self hasRealProtocolSelected ]
"Created: / 4.2.2000 / 22:09:02 / cg"
!
hasRedoableOperations
|manager|
manager := RefactoryChangeManager instance.
manager isNil ifTrue:[^ false].
^ manager hasRedoableOperations
!
hasSelectedClassWithSuperclassHolder
^ [ self theSingleSelectedClass notNil
and:[self theSingleSelectedClass superclass notNil ]]
!
hasSelectionInCodeView
"/ ^ self codeView selectionAsString size > 0
^ self codeView hasSelection
!
hasSelectionInCodeViewAndCanUseRefactoringSupportHolder
^ [ self canUseRefactoringSupport
and:[self hasSelectionInCodeView]
]
!
hasSelectionInCodeViewHolder
^ [ self hasSelectionInCodeView ]
!
hasSelectorSelectedInCodeView
self hasSelectionInCodeView ifFalse:[^ false].
self canUseRefactoringSupport ifFalse:[^ false].
self selectedSelectorInCodeViewOrNil isNil ifTrue:[^ false].
^ true.
!
hasSharedPoolClassSelected
^ self hasClassSelected
and:[self selectedClasses value
contains:[:cls |
cls isLoaded
and:[cls theNonMetaclass isAbstract not
and:[ cls inheritsFrom:SharedPool ]]] ]
"Created: / 25-10-2006 / 09:23:07 / cg"
"Modified: / 27-04-2010 / 13:01:57 / cg"
!
hasSharedPoolClassSelectedHolder
^ [ self hasSharedPoolClassSelected ]
!
hasSingleCategorySelected
^ self selectedCategoriesValue size == 1
"Created: / 4.2.2000 / 22:05:40 / cg"
!
hasSingleCategorySelectedHolder
^ [ self hasSingleCategorySelected ]
"Created: / 4.2.2000 / 22:05:52 / cg"
!
hasSingleClassAndClassVariableSelected
^ self hasSingleClassSelected
and:[self hasClassVariableSelectedInCodeViewOrVariableList]
!
hasSingleClassAndClassVariableSelectedAndCanUseRefactoringSupportHolder
^ [ self canUseRefactoringSupport
and:[self hasSingleClassAndClassVariableSelected] ]
"Created: / 4.2.2000 / 22:02:53 / cg"
!
hasSingleClassAndSingleClassVariableSelected
^ self hasSingleClassSelected
and:[self hasSingleClassVariableSelectedInCodeViewOrVariableList]
!
hasSingleClassAndSingleVariableSelected
^ self hasSingleClassSelected
and:[self hasSingleVariableSelectedInCodeViewOrVariableList]
!
hasSingleClassAndSingleVariableSelectedAndCanUseRefactoringSupportHolder
^ [ self canUseRefactoringSupport
and:[self hasSingleClassAndSingleVariableSelected] ]
"Created: / 4.2.2000 / 22:02:53 / cg"
!
hasSingleClassAndSingleVariableSelectedHolder
^ [ self hasSingleClassAndSingleVariableSelected ]
"Created: / 4.2.2000 / 22:02:53 / cg"
!
hasSingleClassAndVariableSelected
^ self hasSingleClassSelected
and:[self hasVariableSelectedInCodeViewOrVariableList]
!
hasSingleClassAndVariableSelectedAndCanUseRefactoringSupportHolder
^ [ self canUseRefactoringSupport
and:[self hasSingleClassSelected
and:[self hasVariableSelectedInCodeViewOrVariableList]] ]
"Created: / 4.2.2000 / 22:02:53 / cg"
!
hasSingleClassAndVariableSelectedHolder
^ [ self hasSingleClassAndVariableSelected ]
"Created: / 4.2.2000 / 22:02:53 / cg"
!
hasSingleClassOrMethodSelected
^ self hasSingleClassSelected or:[self hasSingleMethodSelected]
!
hasSingleClassOrMethodSelectedHolder
^ [ self hasSingleClassOrMethodSelected ]
"Created: / 4.2.2000 / 22:03:08 / cg"
!
hasSingleClassSelected
^ self selectedClasses value size == 1
"Created: / 4.2.2000 / 22:03:24 / cg"
"Modified: / 6.2.2000 / 01:12:45 / cg"
!
hasSingleClassSelectedAndCanUseRefactoringSupportHolder
^ [ self canUseRefactoringSupport
and:[self hasSingleClassSelected] ]
"Created: / 4.2.2000 / 22:03:08 / cg"
!
hasSingleClassSelectedAndSourceCodeManagerHolder
^ [ self hasSingleClassSelected and:[self hasSourceCodeManager] ]
!
hasSingleClassSelectedHolder
^ [ self hasSingleClassSelected ]
"Created: / 4.2.2000 / 22:03:08 / cg"
!
hasSingleLoadedClassSelected
|cls|
^ (cls := self theSingleSelectedClass) notNil
and:[cls isLoaded]
"Created: / 17.2.2000 / 23:27:45 / cg"
!
hasSingleLoadedClassSelectedAndMultipleVariablesSelected
^ self hasSingleLoadedClassSelected
and:[ self hasMultipleVariablesSelected ]
!
hasSingleLoadedClassSelectedAndMultipleVariablesSelectedHolder
^ [ self hasSingleLoadedClassSelectedAndMultipleVariablesSelected ]
"Created: / 17.2.2000 / 23:28:03 / cg"
!
hasSingleLoadedClassSelectedHolder
^ [ self hasSingleLoadedClassSelected ]
"Created: / 17.2.2000 / 23:28:03 / cg"
!
hasSingleLoadedClassWithCommentSelected
|cls|
^ (cls := self theSingleSelectedClass) notNil
and:[cls isLoaded
and:[cls comment notEmptyOrNil]]
!
hasSingleLoadedClassWithCommentSelectedHolder
^ [ self hasSingleLoadedClassWithCommentSelected ]
!
hasSingleLoadedNonJavascriptClassSelected
|cls|
^ (cls := self theSingleSelectedClass) notNil
and:[cls isLoaded
and:[cls theMetaclass isJavaScriptMetaclass not ]]
"Created: / 17.2.2000 / 23:27:45 / cg"
!
hasSingleLoadedNonJavascriptClassSelectedHolder
^ [ self hasSingleLoadedNonJavascriptClassSelected ]
"Created: / 17.2.2000 / 23:28:03 / cg"
!
hasSingleLoadedNonMetaClassSelected
|cls|
^ (cls := self theSingleSelectedClass) notNil
and:[cls isLoaded
and:[cls isMeta not]]
!
hasSingleLoadedNonMetaClassSelectedHolder
^ [ self hasSingleLoadedNonMetaClassSelected ]
"Created: / 17.2.2000 / 23:28:03 / cg"
!
hasSingleMethodSelected
^ self selectedMethods value size == 1
"Created: / 4.2.2000 / 22:10:05 / cg"
"Modified: / 5.2.2000 / 23:06:51 / cg"
!
hasSingleMethodSelectedAndCanUseRefactoringSupportHolder
^ [ self canUseRefactoringSupport
and:[self hasSingleMethodSelected]
]
"Created: / 4.2.2000 / 22:11:34 / cg"
!
hasSingleMethodSelectedAndCodeModifiedHolder
^ [
self codeReallyModified
and:[self hasSingleMethodSelected]
]
"Created: / 4.2.2000 / 22:11:34 / cg"
!
hasSingleMethodSelectedAndSelectionInCodeView
^ self hasSelectionInCodeView
and:[self hasSingleMethodSelected]
!
hasSingleMethodSelectedAndSelectionInCodeViewAndCanUseRefactoringSupportHolder
^ [ self canUseRefactoringSupport
and:[self hasSingleMethodSelectedAndSelectionInCodeView ]
]
!
hasSingleMethodSelectedAndSelectionInCodeViewAndSingleSelectedMethodHasParameter
^ self hasSingleMethodSelectedAndSelectionInCodeView
and:[self theSingleSelectedMethod numArgs > 0]
!
hasSingleMethodSelectedAndSelectionInCodeViewAndSingleSelectedMethodHasParameterAndCanUseRefactoringSupportHolder
^ [ self canUseRefactoringSupport
and:[self hasSingleMethodSelectedAndSelectionInCodeViewAndSingleSelectedMethodHasParameter]
]
!
hasSingleMethodSelectedAndSelectionInCodeViewAndSingleSelectedMethodHasParameterHolder
^ [ self hasSingleMethodSelectedAndSelectionInCodeViewAndSingleSelectedMethodHasParameter ]
!
hasSingleMethodSelectedAndSelectionInCodeViewHolder
^ [ self hasSingleMethodSelectedAndSelectionInCodeView ]
!
hasSingleMethodSelectedAndSingleSelectedMethodHasParameter
^ self hasSingleMethodSelected
and:[self theSingleSelectedMethod numArgs > 0]
!
hasSingleMethodSelectedAndSingleSelectedMethodHasParameterAndCanUseRefactoringSupportHolder
^ [ self canUseRefactoringSupport
and:[self hasSingleMethodSelectedAndSingleSelectedMethodHasParameter]
]
!
hasSingleMethodSelectedHolder
^ [ self hasSingleMethodSelected ]
"Created: / 4.2.2000 / 22:11:34 / cg"
!
hasSingleMethodWithBytecodeSelected
|mthd|
mthd := self theSingleSelectedMethod.
^ mthd notNil and:[mthd byteCode notNil]
!
hasSingleMethodWithBytecodeSelectedHolder
^ [ self hasSingleMethodWithBytecodeSelected ]
"Created: / 4.2.2000 / 22:11:34 / cg"
!
hasSingleNameSpaceSelected
^ self selectedNamespaces value size == 1
"Created: / 4.2.2000 / 22:07:55 / cg"
!
hasSingleNonPrivateClassSelected
|selected|
^ (selected := self theSingleSelectedClass) notNil
and:[selected isPrivate not]
!
hasSingleNonPrivateClassSelectedAndSourceCodeManagerHolder
^ [ self hasSingleNonPrivateClassSelected and:[self hasSourceCodeManager] ]
"Created: / 4.2.2000 / 22:03:08 / cg"
!
hasSingleNonPrivateClassSelectedHolder
^ [ self hasSingleNonPrivateClassSelected ]
"Created: / 4.2.2000 / 22:03:08 / cg"
!
hasSinglePrivateClassSelected
|selected|
^ (selected := self theSingleSelectedClass) notNil
and:[selected isPrivate]
!
hasSinglePrivateClassSelectedHolder
^ [ self hasSinglePrivateClassSelected ]
!
hasSingleProjectOrProjectDefinitionSelected
^ self hasSingleProjectSelected
or:[ self hasProjectDefinitionSelected ]
!
hasSingleProjectSelected
^ self selectedProjects value size == 1
!
hasSingleProjectSelectedHolder
^ [ self hasSingleProjectSelected ]
"Created: / 4.2.2000 / 22:09:02 / cg"
!
hasSingleProtocolSelected
"true if exactly one method protocol item is selected (could be *all*)"
^ self selectedProtocols value size == 1
"Created: / 4.2.2000 / 22:07:55 / cg"
!
hasSingleProtocolSelectedHolder
"holding true, if exactly one method protocol item is selected (could be *all*)"
^ [ self hasSingleProtocolSelected ]
"Created: / 4.2.2000 / 22:08:22 / cg"
!
hasSingleRealProjectSelectedHolder
^ [ self hasSingleProjectSelected
and:[ self theSingleSelectedProject notNil
and:[ self theSingleSelectedProject string asPackageId isModuleId not ]]]
!
hasSingleRealProtocolSelected
"true, if one real method protocol (i.e. not *all*) item is selected"
|p|
p := self theSingleSelectedProtocol.
^ p notNil and:[p ~= BrowserList nameListEntryForALL]
!
hasSingleRealProtocolSelectedHolder
"holding true, if one real method protocol (i.e. not *all*) item is selected"
^ [ self hasSingleRealProtocolSelected ]
"Created: / 4.2.2000 / 22:08:22 / cg"
!
hasSingleResourceMethodSelected
|currentMethod methodsResources|
currentMethod := self theSingleSelectedMethod.
^ currentMethod notNil
and:[(methodsResources := currentMethod resources) notNil
and:[(self class resourceEditorClassForResources:methodsResources) notNil]]
!
hasSingleResourceMethodSelectedHolder
^ builder
valueAspectFor:#hasSingleResourceMethodSelectedHolder
computeInitialValueWith:[ self hasSingleResourceMethodSelected ]
!
hasSingleVariableSelected
^ self selectedVariables value size == 1
!
hasSingleVariableSelectedHolder
^ [ self hasSingleVariableSelected ]
"Created: / 4.2.2000 / 22:08:22 / cg"
!
hasSingleVariableSelectedInCodeViewOrVariableList
self hasSingleVariableSelected ifTrue:[^ true].
(self hasClassVariableSelectedInCodeView) ifTrue:[^ true].
(self hasInstanceVariableSelectedInCodeView) ifTrue:[^ true].
^ false
!
hasSingleVariableSelectedInCodeViewOrVariableListHolder
^ [ self hasSingleVariableSelectedInCodeViewOrVariableList ]
!
hasSingleWordSelectedInCodeView
|codeView selectionInCode|
codeView := self codeView.
codeView isNil ifTrue:[^ false].
"/ first, see if more than a line is selected ...
codeView selectionStartLine == codeView selectionEndLine ifFalse:[^ false ].
selectionInCode := self selectionInCodeView.
selectionInCode isEmptyOrNil ifTrue:[ ^ false ].
^ selectionInCode asCollectionOfWords size == 1.
!
hasSourceCodeManager
^ SourceCodeManager notNil
"Created: / 4.2.2000 / 22:11:34 / cg"
!
hasSourceCodeManagerHolder
^ [ self hasSourceCodeManager ]
"Created: / 4.2.2000 / 22:11:34 / cg"
!
hasStartableApplicationSelected
|cls|
^ (cls := self theSingleSelectedClass) notNil
and:[ cls theNonMetaclass isVisualStartable ]
!
hasStartableApplicationSelectedHolder
|holder|
(holder := builder bindingAt:#hasStartableApplicationSelectedHolder) isNil ifTrue:[
holder := ValueHolder with:false.
builder aspectAt:#hasStartableApplicationSelectedHolder put: holder.
].
^ holder
!
hasSubversionRepositoryFor: package
^ self hasSubversionSupport
"/ use Smalltalk-at to trick the dependency/prerequisite generator
and:[(Smalltalk at:#'SVN::RepositoryManager') hasRepositoryForPackage: package]
"Created: / 31-03-2008 / 15:08:13 / janfrog"
"Modified: / 22-08-2009 / 10:49:33 / Jan Vrany <vranyj1@fel.cvut.cz>"
!
hasSubversionSupport
|subVersionRepository|
"/ use Smalltalk-at to trick the dependency/prerequisite generator
subVersionRepository := Smalltalk at: #'SVN::RepositoryManager'.
^ subVersionRepository notNil
and:[ subVersionRepository isLoaded
and:[ subVersionRepository enabled ]
]
!
hasTemporaryVariableSelectedInCodeView
"/ |node|
self codeAspect value ~~ #method ifTrue:[^ false].
(self hasSingleWordSelectedInCodeView) ifFalse:[^ false].
"/ the following is too slow
"/ node := self findNode.
"/ (node isNil or:[node isVariable not]) ifTrue:[
"/ ^ false
"/ ].
^ true
!
hasTemporaryVariableSelectedInCodeViewHolder
^ [ self hasTemporaryVariableSelectedInCodeView ]
!
hasUnassignedExtensionMethodSelected
^ self selectedMethods value ? #()
contains:[:aMethod |
|mPackage mClass|
mPackage := aMethod package.
mClass := aMethod containingClass.
mClass isNil or:[
mPackage ~= aMethod containingClass package
and:[mPackage = PackageId noProjectID]]
]
"Modified: / 12-10-2006 / 20:51:23 / cg"
!
hasUnassignedExtensionMethodSelectedHolder
^ BlockValue
with:[:m | m and:[self hasUnassignedExtensionMethodSelected]]
argument:(self hasMethodSelectedHolder)
"Modified: / 08-03-2007 / 23:00:47 / cg"
!
hasUndefinedUppercaseIdentifierSelectedInCodeView
|s|
^ self codeView hasSelection
and:[ (s := self codeView selectionAsString) isValidSmalltalkIdentifier
and:[ s isUppercaseFirst
and:[ (Smalltalk includesKey:s) not
and:[ self theSingleSelectedClass notNil
and:[ (self theSingleSelectedClass theNonMetaclass classVarNames includes:s) not ]]]]]
!
hasUndefinedUppercaseIdentifierSelectedInCodeViewHolder
^ [ self hasUndefinedUppercaseIdentifierSelectedInCodeView ]
!
hasUndoableOperations
|manager|
RefactoryChangeManager isNil ifTrue:[^ false]. "/ returns false if the class is not present
manager := RefactoryChangeManager instance.
manager isNil ifTrue:[^ false].
^ manager hasUndoableOperations
!
hasUpdateMethodSelected
^ self hasMethodSelected
and:[self selectedMethods value
conform:[:eachMethod | #(
#'update:'
#'update:with:'
#'update:with:from:'
) includes:eachMethod selector ]]
!
hasUpdateMethodSelectedHolder
^ [ self hasUpdateMethodSelected ]
"Created: / 4.2.2000 / 22:23:39 / cg"
!
hasUppercaseIdentifierSelectedInCodeView
|s|
^ self codeView hasSelection
and:[ (s := self codeView selectionAsString) isValidSmalltalkIdentifier ]
and:[ s isUppercaseFirst ]
!
hasUppercaseIdentifierSelectedInCodeViewHolder
^ [ self hasUppercaseIdentifierSelectedInCodeView ]
!
hasVariableSelected
^ self selectedVariables value size > 0
!
hasVariableSelectedInCodeViewOrVariableList
self hasVariableSelected ifTrue:[^ true].
(self hasClassVariableSelectedInCodeView) ifTrue:[^ true].
(self hasInstanceVariableSelectedInCodeView) ifTrue:[^ true].
^ false
!
hasVariableSelectedInCodeViewOrVariableListAndCanUseRefactoringSupportHolder
^ [ self canUseRefactoringSupport
and:[self hasVariableSelectedInCodeViewOrVariableList] ]
!
hasVariableSelectedInCodeViewOrVariableListHolder
^ [ self hasVariableSelectedInCodeViewOrVariableList ]
!
hasVisitedClasses
^ self class classHistory size > 0
!
hasVisitedClassesHolder
^ [ self hasVisitedClasses ]
!
hasWebApplicationClassSelected
|selectedClasses|
selectedClasses := self selectedClasses value.
selectedClasses size == 0 ifTrue:[^ false].
^ selectedClasses conform:[:each | each theNonMetaclass isSubclassOf:HTTPService].
!
instrumentingCompilerExists
^ InstrumentingCompiler notNil
!
isAnyOtherMetaclassPresent
^ self isJavaScriptMetaclassPresent
or:[ self isPlsqlMetaclassPresent
or:[ self isHaskellModulePresent ]]
!
isHaskellModulePresent
^ HaskellModule notNil and:[HaskellParser notNil]
!
isJavaScriptMetaclassPresent
^ JavaScriptMetaclass notNil and:[JavaScriptParser notNil]
!
isLispEnvironmentPresent
^ LispEnvironment notNil
!
isMethodListBrowser
^ navigationState isMethodListBrowser
!
isMethodListBrowserHolder
^ [ navigationState isMethodListBrowser ]
"Created: / 4.2.2000 / 22:23:39 / cg"
!
isMethodListBrowserOrHasMultipleClassesSelectedHolder
^ [navigationState isMethodListBrowser
or:[self selectedClasses value size > 1] ]
"Created: / 4.2.2000 / 22:23:39 / cg"
!
isPlsqlMetaclassPresent
^ PLSQLObjectTypeMetaclass notNil
!
isRubyMetaclassPresent
|rubyMetaclass rubyParser|
rubyMetaclass := Smalltalk classNamed:#'Ruby::Metaclass'.
rubyParser := Smalltalk classNamed:#'Ruby::Parser'.
^ (rubyMetaclass notNil
and:[rubyMetaclass isLoaded])
and:[rubyParser notNil
and:[rubyParser isLoaded]]
"Created: / 11-08-2009 / 16:06:11 / Jan Vrany <vranyj1@fel.cvut.cz>"
!
javaScriptMetaclassPresent
^ JavaScriptMetaclass notNil and:[JavaScriptParser notNil]
!
methodHasPreviousVersion
^ self methodsPreviousVersionCode notNil
!
methodHasPreviousVersionHolder
^ [ self methodHasPreviousVersion ]
!
methodIsSubclassResponsibility
self selectedMethodsDo:[:eachMethod |
(eachMethod sends:#subclassResponsibility) ifTrue:[^ true].
].
^ false.
!
methodNotImplementedInClass
|selector|
selector := self selectionInCodeView.
selector isEmptyOrNil ifTrue:[^ false].
selector := selector asSymbol.
self selectedClassesDo:[:eachClass |
(eachClass includesSelector:selector) ifTrue:[^ false].
].
^ true.
!
methodNotImplementedInSuperclass
self selectedMethodsDo:[:eachMethod |
|selector category mclass|
selector := eachMethod selector.
category := eachMethod category.
mclass := eachMethod mclass.
mclass notNil ifTrue:[
mclass superclass notNil ifTrue:[
(mclass superclass includesSelector:selector) ifFalse:[^ true].
]
].
].
^ false.
!
methodRedefinesSuperclassVersion
|m cls selector superClass|
m := self theSingleSelectedMethod.
^ m notNil
and:[(cls := m mclass) notNil
and:[(selector := m selector) notNil
and:[(superClass := cls superclass) notNil
and:[(superClass lookupMethodFor:selector) notNil]]]]
"Modified: / 23.8.2001 / 12:31:12 / cg"
!
methodRedefinesSuperclassVersionHolder
^ [ self methodRedefinesSuperclassVersion ]
!
selectedClassNameInCodeViewOrNil
|cls selection|
(self hasSingleWordSelectedInCodeView) ifFalse:[^ nil].
selection := self selectionInCodeView.
selection := selection withoutSeparators.
cls := Smalltalk classNamed:selection.
^ cls
!
shiftNotPressedHolder
^ [ self window sensor shiftDown not ]
!
shiftPressedHolder
^ [ self window sensor shiftDown ]
!
singleSelectedMethodIsSubclassResponsibility
|m|
m := self theSingleSelectedMethod.
m isNil ifTrue:[^ false].
^ (m sends:#subclassResponsibility)
!
smallTeamAvailable
^ SmallTeam notNil
"Created: / 13-11-2006 / 13:08:32 / cg"
!
useSearchBarInBrowser
^ UserPreferences current useSearchBarInBrowser or:[self codeView searchBarActionBlock notNil]
! !
!NewSystemBrowser methodsFor:'change & update'!
categorySelectionChanged
"category selection changed by user interaction"
self enqueueDelayedUpdateBufferLabel.
self updateSpecialCodeEditorVisibility.
self normalLabel. "/ update my window label
"Created: / 24.2.2000 / 22:01:46 / cg"
!
classReselected
self selectProtocols:nil.
"/ prevent the methodCategory from autoselecting
self clearAutoSelectOfLastSelectedProtocol.
!
classSelectionChanged
"class selection changed by user interaction"
|selectedClassesHolder selectedClasses|
selectedClassesHolder := self selectedClasses.
selectedClasses := selectedClassesHolder value.
"/ self classWizardVisibleHolder value:(selectedClasses size == 0).
(navigationState isClassDocumentationBrowser) ifTrue:[
"/ kludge - docBrowser can only show one single class
selectedClasses size > 1 ifTrue:[
selectedClassesHolder value:(Array with:selectedClasses first).
self enqueueDelayedUpdateBufferLabel.
^ self.
]
].
"/ selectedClasses size == 1 ifTrue:[
"/ self selectedProtocols value:nil.
"/ ].
navigationState isVersionDiffBrowser ifFalse:[
self class addToHistory:(self theSingleSelectedClass) selector:nil.
].
self enqueueDelayedClassSelectionChange.
"Modified: / 25.2.2000 / 14:07:08 / cg"
!
clearAutoSelectOfLastSelectedProtocol
|mc|
"/ prevent the methodCategory from autoselecting the last selected protocol
"/ when the next class is selected
(mc := self methodCategoryListApp) notNil ifTrue:[
mc clearLastSelectedProtocol
]
!
delayedCheckReallyModified
self reallyModified:(self navigationState)
!
delayedClassSelectionChange
self normalLabel.
self enqueueDelayedUpdateCode.
self setDoitActionForClass.
self updateCategorySelectionForChangedClassSelection.
self updateMetaToggleForClassSelection.
self updateInfoForChangedClassSelection.
self updateTestRunnerVisibility.
self updateExecuteMethodVisibility.
self updateLaunchApplicationVisibility.
"Modified: / 05-08-2006 / 13:21:10 / cg"
!
delayedExplainSelection
|codeView|
self synchronousUpdate == true ifFalse:[
self windowGroup sensor hasUserEvents ifTrue:[
"/ re-enqueue at the end to delay until all user input has been handled
self
enqueueMessage:#delayedExplainSelection
for:self
arguments:#().
^ self
].
].
self clearInfo.
codeView := self codeView.
self explainInCode:(codeView contentsAsString string) short:true withTimeout:true
"Modified: / 05-09-2006 / 10:37:10 / cg"
!
delayedLabelUpdate
self normalLabel
!
delayedMethodsSelectionChanged
|codeAspect process|
self hasMethodSelectedHolder value:(self hasMethodSelected).
self hasMethodWithoutBreakPointSelectedHolder value:(self hasMethodWithoutBreakPointSelected).
self hasMethodWithBreakPointSelectedHolder value:(self hasMethodWithBreakPointSelected).
"/ if showing history or log,
"/ dont update codeView, as long as no protocol is selected
((codeAspect := self codeAspect) == #repositoryLog
or:[codeAspect == #repositoryHistory]) ifTrue:[
self selectedMethods value size == 0 ifTrue:[
^ self
]
].
self enqueueDelayedUpdateCodeWithAutoSearch.
self hasSingleResourceMethodSelectedHolder value:(self hasSingleResourceMethodSelected).
self updateExecuteMethodVisibility.
self setDoitActionForClass.
"/ self showMethodInfo.
process := methodInfoProcess.
process notNil ifTrue:[
process terminate.
process := nil.
].
methodInfoProcess := [ self asyncShowMethodInfo. methodInfoProcess := nil. ] fork.
"Modified: / 18.8.2000 / 19:23:55 / cg"
!
delayedProtocolSelectionChanged
(ShowMethodTemplateWhenProtocolIsSelected == true
or:[ self codeAspect ~~ #classDefinition
or:[ navigationState methodList size == 0 ]])
ifTrue:[
self enqueueDelayedUpdateCode
]
!
delayedUpdateCode
self delayedUpdateCodeWithAutoSearch:false
!
delayedUpdateCodeWithAutoSearch:withAutoSearch
self delayedUpdateCodeWithAutoSearch:withAutoSearch checkModified:true
"Modified: / 29-08-2006 / 13:59:22 / cg"
!
delayedUpdateCodeWithAutoSearch:withAutoSearch checkModified:checkModified
|methods mthd selectedClass protocol
codeView code filteredVariables searchAction searchPattern doShowMethodTemplate|
self enqueueDelayedUpdateBufferLabel.
navigationState isClassDocumentationBrowser ifTrue:[
"/ show classes documentation
self showClassDocumentation.
^ self.
].
navigationState isVersionDiffBrowser ifTrue:[
"/ show version differences
self showVersionDiff.
^ self.
].
codeView := self codeView.
checkModified ifTrue:[
((codeView notNil and:[codeView modified])
or:[navigationState modified])
ifTrue:[
"/ recheck against the code (could have been unedited)
(self reallyModified:navigationState) ifTrue:[
"/ do not overwrite the users modifications;
"/ instead, flash and show the code all-red
"/ (to tell user, that she is editing obolete code)
self codeHolder
value:(codeView contentsAsString asText
emphasizeAllWith:(UserPreferences current emphasisForObsoleteCode)).
self codeHolder changed:#value.
codeView flash.
^ self.
]
].
].
navigationState isFullClassSourceBrowser ifTrue:[
"/ show full classes source - set accept action for fileIn
self showFullClassSource.
^ self.
].
"/ show method, or class definition
methods := self selectedMethods value.
methods size == 1 ifTrue:[
mthd := methods first.
].
mthd notNil ifTrue:[
"/ show methods source - set accept action to compile that single method
self setAcceptActionForMethod.
self showMethodsCode:mthd scrollToTop:false.
"/ if there is a variable filter,
"/ set the autoSearch for it
(navigationState isMethodListBrowser
or:[navigationState isFullProtocolBrowser
or:[navigationState isMethodBrowser]]) ifFalse:[
filteredVariables := self variableFilter value.
filteredVariables size > 0 ifTrue:[
self searchVariables:filteredVariables readers:true writers:true asAutoSearch:false.
"/ codeView notNil ifTrue:[codeView searchFwd]
] ifFalse:[
self autoSearchPattern:nil
].
].
] ifFalse:[
self updatePackageInfoForMethod:nil.
protocol := self theSingleSelectedProtocol.
(protocol isNil or:[protocol = BrowserList nameListEntryForALL]) ifTrue:[
doShowMethodTemplate := false
] ifFalse:[
doShowMethodTemplate := self showMethodTemplate value
"/ and:[ShowMethodTemplateWhenProtocolIsSelected == true
"/ or:[ navigationState methodList size == 0 ]].
].
doShowMethodTemplate ifTrue:[
methods size > 1 ifTrue:[
code := nil.
] ifFalse:[
code := self methodTemplate.
].
self setAcceptActionForMethod.
self codeAspect:#method.
self showCode:code.
] ifFalse:[
self hasProtocolSelected ifTrue:[
self showCode:''.
self setAcceptActionForMethod.
self codeAspect:#method.
] ifFalse:[
selectedClass := self theSingleSelectedClass.
selectedClass notNil ifTrue:[
self showClassAspect:(self codeAspect) forClass:selectedClass.
] ifFalse:[
"/ self organizerMode value == OrganizerCanvas organizerModeProject ifTrue:[
"/ package := self theSingleSelectedProject.
"/ package notNil ifTrue:[
"/ project := Project projectWithId:package.
"/ project notNil ifTrue:[
"/ code := project comment
"/ ].
"/ ].
"/ self showCode:code ? ''.
"/ self setAcceptActionForProjectComment.
"/ ] ifFalse:[
self showCode:code ? ''.
self setAcceptActionForClass.
"/ ]
]
]
]
].
self updateSpecialCodeEditorVisibility.
codeView notNil ifTrue:[
"/ perform an auto-search, unless the user did some other search
"/ in the meanwhile (i.e. the codeViews searchPattern is different from the autoSearchPattern)
withAutoSearch ifTrue:[
codeView numberOfLines > 0 ifTrue:[
searchAction := navigationState autoSearchAction.
searchAction notNil ifTrue:[
true "codeView searchAction isNil" ifTrue:[
true "codeView searchPattern isNil" ifTrue:[
codeView
cursorHome;
searchAction:searchAction;
searchUsingSearchAction:#forward ifAbsent:nil.
"/ The searchAction is mantained until a cut/replace or a search with a user selection is done
"/ codeView clearSearchAction.
]
"/ ] ifFalse:[
"/ codeView
"/ cursorHome;
"/ searchUsingSearchAction:#forward ifAbsent:nil
].
] ifFalse:[
searchPattern := navigationState autoSearchPattern.
searchPattern notNil ifTrue:[
searchPattern = codeView searchPattern ifTrue:[
codeView
cursorHome;
cursorRight; "/ to avoid finding the selector
searchFwd:searchPattern
ignoreCase:(navigationState autoSearchIgnoreCase)
ifAbsent:[codeView cursorHome].
].
].
].
].
] ifFalse:[
codeView clearSearchAction.
].
].
navigationState modified:false.
navigationState realModifiedState:false.
self updateProtocolSelectionForChangedMethodSelection.
"Created: / 29-08-2006 / 13:59:06 / cg"
"Modified: / 06-09-2006 / 16:37:56 / cg"
!
delayedVariableSelectionChanged
|var val mclass cls|
var := self theSingleSelectedVariable.
var isNil ifTrue:[
navigationState autoSearchAction:nil.
^ self
].
self selectedNonMetaclassesDo:[:eachClass |
|cls|
cls := eachClass whichClassDefinesClassVar:var.
cls notNil ifTrue:[
val := cls classVarAt:var asSymbol.
self showClassVarInfoFor:var in:cls value:val.
^ self
].
].
mclass := self classOfSelectedMethodOrSelectedClass.
mclass isNil ifTrue:[^ self].
cls := mclass theNonMetaclass whichClassDefinesClassVar:var.
cls notNil ifTrue:[
val := cls classVarAt:var asSymbol.
self showClassVarInfoFor:var in:cls value:val.
]
"Modified: / 12-09-2006 / 13:56:20 / cg"
!
enqueueDelayedCheckReallyModified
^ self
enqueueMessage:#delayedCheckReallyModified
for:self
arguments:#()
"Modified: / 26.2.2000 / 18:01:49 / cg"
!
enqueueDelayedClassSelectionChange
^ self
enqueueMessage:#delayedClassSelectionChange
for:self
arguments:#()
"Modified: / 26.2.2000 / 18:01:49 / cg"
!
enqueueDelayedLabelUpdate
^ self
enqueueMessage:#delayedLabelUpdate
for:self
arguments:#()
"Modified: / 26.2.2000 / 18:01:49 / cg"
!
enqueueDelayedMethodsSelectionChanged
^ self
enqueueMessage:#delayedMethodsSelectionChanged
for:self
arguments:#()
!
enqueueDelayedProtocolSelectionChanged
^ self
enqueueMessage:#delayedProtocolSelectionChanged
for:self
arguments:#()
!
enqueueDelayedStartSyntaxHighlightProcess
^ self
enqueueMessage:#startSyntaxHighlightProcess
for:self
arguments:#()
!
enqueueDelayedUpdateBufferLabel
^ self
enqueueMessage:#delayedUpdateBufferLabel
for:self
arguments:#()
"Modified: / 26.2.2000 / 18:01:49 / cg"
!
enqueueDelayedUpdateBufferLabelWithCheckIfModified
^ self
enqueueMessage:#delayedUpdateBufferLabelWithCheckIfModified
for:self
arguments:#()
"Modified: / 26.2.2000 / 18:01:49 / cg"
!
enqueueDelayedUpdateCode
^ self delayedUpdateCode.
^ self
enqueueMessage:#delayedUpdateCode
for:self
arguments:#()
"Modified: / 06-09-2006 / 19:07:15 / cg"
!
enqueueDelayedUpdateCodeWithAutoSearch
"/ ^ self delayedUpdateCodeWithAutoSearch:true.
^ self
enqueueMessage:#delayedUpdateCodeWithAutoSearch:
for:self
arguments:#( true )
"Modified: / 06-09-2006 / 19:07:10 / cg"
!
enqueueDelayedUpdateCodeWithoutAutoSearch
^ self delayedUpdateCodeWithAutoSearch:false.
^ self
enqueueMessage:#delayedUpdateCodeWithAutoSearch:
for:self
arguments:#( false )
"Modified: / 06-09-2006 / 19:07:00 / cg"
!
enqueueDelayedUpdateExecuteMethodVisibility
^ self
enqueueMessage:#updateExecuteMethodVisibility
for:self
arguments:#()
"Modified: / 26.2.2000 / 18:01:49 / cg"
!
enqueueDelayedUpdateTestRunnerVisibility
^ self
enqueueMessage:#updateTestRunnerVisibility
for:self
arguments:#()
"Modified: / 26.2.2000 / 18:01:49 / cg"
!
enqueueDelayedVariableSelectionChanged
^ self
enqueueMessage:#delayedVariableSelectionChanged
for:self
arguments:#()
!
enqueueMessage:selector for:someone arguments:argList
"/ Transcript show:'enqueue '; showCR:selector.
self synchronousUpdate == true ifTrue:[
someone perform:selector withArguments:argList.
^ self
].
^ super enqueueMessage:selector for:someone arguments:argList
!
methodsSelectionChanged
(self theSingleSelectedMethod) notNil ifTrue:[
self rememberLocationInHistory
].
self enqueueDelayedMethodsSelectionChanged.
!
methodsSelectionChanged1
self methodsSelectionChangedAt:1
!
methodsSelectionChanged2
self methodsSelectionChangedAt:2
!
methodsSelectionChanged3
self methodsSelectionChangedAt:3
!
methodsSelectionChanged4
self methodsSelectionChangedAt:4
!
methodsSelectionChangedAt:index
"in the chain-browsers, a selection in one of the 4 columns has changed"
|mySearchBlock "/ must again be the first local (see kludge below)
generator selectedMethods myGenerator myGeneratorsHome |
selectedMethods := (navigationState selectedMethodsArrayAt:index) value ? #().
"/ filter those which are lost due to recompilation ...
selectedMethods := selectedMethods select:[:m | m selector notNil].
selectedMethods isEmpty ifTrue:[
generator := #().
selectedMethods := #().
] ifFalse:[
"/ fetch the searchBlock - what a tricky kludge (no, really this should be done different)
myGenerator := (navigationState selectorListGeneratorArrayAt:index) value.
myGeneratorsHome := myGenerator block methodHome.
mySearchBlock := myGeneratorsHome at:(myGeneratorsHome numArgs + 1).
mySearchBlock isBlock ifFalse:[
mySearchBlock := myGeneratorsHome at:(myGeneratorsHome numArgs + 2)
].
generator := Iterator on:[:whatToDo |
|theMethodList|
theMethodList := IdentitySet new.
self withWaitCursorDo:[
selectedMethods do:[:selectedMethod |
theMethodList addAll:(mySearchBlock value:selectedMethod).
]
].
theMethodList do:[:aMethod |
whatToDo
value:aMethod mclass
value:aMethod category
value:aMethod selector
value:aMethod.
].
"/ theMethodList size == 1 ifTrue:[
whatToDo
value:nil
value:nil
value:nil
value:nil.
"/ ].
].
].
"/ the selection used in the other code...
navigationState selectedMethods value:selectedMethods.
self methodsSelectionChanged.
index+1 to:4 do:[:i |
(navigationState selectorListGeneratorArrayAt:i) value:#().
].
(navigationState selectorListGeneratorArrayAt:(index+1)) value:generator.
!
nameSpaceSelectionChanged
"namespace selection changed by user interaction"
self enqueueDelayedUpdateBufferLabel.
self updateSpecialCodeEditorVisibility.
self normalLabel. "/ update my window label
"Created: / 24.2.2000 / 22:02:01 / cg"
!
projectSelectionChanged
"project selection changed by user interaction"
"/ self enqueueDelayedUpdateCode.
self normalLabel. "/ update my window label
self updateSpecialCodeEditorVisibility.
"/ force update for packageFilter
"/ (must do it, since packageFilter is a vHolder
"/ holding a vHolder - i.e. it did not change yet)
"/ self packageFilter changed.
"/ self organizerMode == OrganizerCanvas organizerModeProject ifTrue:[
self packageFilter setValue:(self selectedProjects value).
self packageFilter changed.
"/ ] ifFalse:[
"/ self packageFilter value:nil
"/ ].
"Created: / 24.2.2000 / 22:02:10 / cg"
"Modified: / 18.8.2000 / 19:27:50 / cg"
!
projectSelectionChangedForFilter
"project selection changed by user interaction (here: used as filter)"
navigationState packageFilter value:(self selectedProjects value).
!
protocolSelectionChanged
|codeAspect|
"/ if showing history or log,
"/ dont update codeView, as long as no protocol is selected
((codeAspect := self codeAspect) == #repositoryLog
or:[codeAspect == #repositoryHistory]) ifTrue:[
self hasProtocolSelected ifFalse:[
^ self
]
].
self enqueueDelayedProtocolSelectionChanged
!
selectedEditorNoteBookTabIndexChanged
|m|
((m := self theSingleSelectedMethod) notNil
and:[m mclass isNil]) ifTrue:[
"/ kludge: still showing old code, but a change should be on its
"/ way, coming from the MethodList.
"/ push back the event, to allow for the change event to be handled first.
self
enqueueMessage:#selectedEditorNoteBookTabIndexChanged2
for:self
arguments:#().
^ self.
].
self selectedEditorNoteBookTabIndexChanged2.
!
selectedEditorNoteBookTabIndexChanged2
self updateSpecialCodeEditorVisibility.
self updateExecuteMethodVisibility
"Modified: / 17-08-2006 / 16:47:34 / cg"
!
update:something with:aParameter from:changedObject
|codeView mthd codeAspect isForAspect|
"/ (navigationState notNil
"/ and:[changedObject == navigationState codeModifiedHolder]) ifTrue:[
"/ self enqueueDelayedUpdateBufferLabel.
"/ ^ self.
"/ ].
changedObject == self selectedClasses ifTrue:[
self assert:(changedObject value includes:nil) not.
].
changedObject == self codeInfoVisible ifTrue:[
self codeInfoVisibilityChanged.
^ self
].
changedObject == self toolBarVisibleHolder ifTrue:[
self toolBarVisibilityChanged.
^ self
].
changedObject == self stringSearchToolVisibleHolder ifTrue:[
self stringSearchToolVisibilityChanged.
^ self
].
((codeView := self codeView) notNil
and:[changedObject == codeView modifiedChannel]) ifTrue:[
self codeModified.
^ self.
].
changedObject == self selectedEditorNoteBookTabIndexHolder ifTrue:[
self selectedEditorNoteBookTabIndexChanged.
^ self
].
changedObject == selectedBuffer ifTrue:[
self enqueueDelayedLabelUpdate.
self organizerModeForMenu changed.
self enqueueDelayedUpdateTestRunnerVisibility.
self enqueueDelayedUpdateExecuteMethodVisibility.
self updateCodeInfoAndStringSearchToolVisibility.
^ self.
].
changedObject == self organizerModeForMenu ifTrue:[
self enqueueDelayedUpdateBufferLabel.
^ self.
].
something == #visitedClassHistory ifTrue:[
self visitedClassesHistory contents:(self class visitedClassNamesHistory).
^ self.
].
changedObject == Smalltalk ifTrue:[
codeAspect := self codeAspect.
isForAspect := (codeAspect == something)
and:[ something == #classDefinition
or:[ something == #classComment
or:[ something == #classHierarchy
or:[ something == #primitiveDefinitions
or:[ something == #primitiveFunctions
or:[ something == #primitiveVariables ]]]]]].
isForAspect ifTrue:[
((self selectedClasses value ? #()) contains:[:cls | cls name = aParameter name]) ifTrue:[
self enqueueDelayedUpdateCode.
]
].
something == #methodInClass ifTrue:[
self codeAspect == #method ifTrue:[
mthd := self theSingleSelectedMethod.
(mthd notNil and:[aParameter third == mthd])
ifTrue:[
mthd mclass notNil ifTrue:[
"/ mhmh - Smalltalk tells me that a method has changed,
"/ but my selectedMethod has not yet been updated
"/ (the methodList seems to be behind me in the dependency chain).
"/ simply ignore this update here (assuming that the methodList will trigger
"/ another change soon).
self enqueueDelayedUpdateCodeWithoutAutoSearch.
].
].
]
].
^ self
].
super update:something with:aParameter from:changedObject
"Modified: / 20-11-2006 / 12:29:59 / cg"
!
updateCodeInfoAndStringSearchToolVisibility
|stringSearchToolVisible codeInfoVisible cFrame cBottomOffset sFrame sTopOffset sBottomOffset|
stringSearchToolVisible := self stringSearchToolVisibleHolder value.
codeInfoVisible := self codeInfoVisible value.
cFrame := self noteBookView.
cFrame isNil ifTrue:[^ self].
cFrame notNil ifTrue:[
(stringSearchToolVisible not and:[codeInfoVisible not]) ifTrue:[
cBottomOffset := 0.
sTopOffset := 0.
sBottomOffset := 0.
].
(stringSearchToolVisible not and:[codeInfoVisible]) ifTrue:[
cBottomOffset := -25.
sTopOffset := 0.
sBottomOffset := 0.
].
(stringSearchToolVisible and:[codeInfoVisible not]) ifTrue:[
cBottomOffset := -25.
sTopOffset := -24.
sBottomOffset := 0.
].
(stringSearchToolVisible and:[codeInfoVisible]) ifTrue:[
cBottomOffset := -50.
sTopOffset := -49.
sBottomOffset := -25.
].
cFrame layout notNil ifTrue:[
cFrame layout bottomOffset:cBottomOffset.
].
cFrame container notNil ifTrue:[
cFrame containerChangedSize.
].
sFrame := self stringSearchToolView.
sFrame notNil ifTrue:[
sFrame layout notNil ifTrue:[
sTopOffset notNil ifTrue:[sFrame layout topOffset:sTopOffset].
sBottomOffset notNil ifTrue:[sFrame layout bottomOffset:sBottomOffset].
sFrame container notNil ifTrue:[
sFrame containerChangedSize.
].
].
].
].
!
updateExecuteMethodVisibility
self hasNonTestCaseClassMethodWithoutArgsSelectedHolder
value:(self hasNonTestCaseClassMethodWithoutArgsSelected)
"Modified: / 05-08-2006 / 13:22:53 / cg"
!
updateLaunchApplicationVisibility
self hasStartableApplicationSelectedHolder
value:(self hasStartableApplicationSelected)
!
updateMetaToggleForClassSelection
|selectedClasses newMetaToggleLabel|
selectedClasses := self selectedNonMetaclasses.
(selectedClasses contains:[:eachClass | eachClass isJavaClass]) ifTrue:[
"/ selection contains at least on java class
(selectedClasses conform:[:eachClass | eachClass isJavaClass]) ifTrue:[
"/ only java classes selected
newMetaToggleLabel := 'Static'.
] ifFalse:[
"/ mixed ..
newMetaToggleLabel := 'Class / Static'.
]
] ifFalse:[
"/ only smalltalk classes selected
newMetaToggleLabel := 'Class'.
].
self navigationState metaToggleLabelHolder value:(resources string:newMetaToggleLabel)
"Modified: / 13-10-2006 / 11:56:44 / cg"
!
updateTestRunnerVisibility
self hasAnyTestCaseSelectedHolder value:(self hasAnyTestCaseSelected)
"Modified: / 05-08-2006 / 13:22:53 / cg"
!
variableSelectionChanged
"variable selection changed by user interaction"
self enqueueDelayedVariableSelectionChanged
!
versionDiffViewerCreated:aView
"kludge callBack, invoked when versionDiffBrowser is created.
Remember it for later setting of its parameter (when class is selected)"
|diffApp|
diffApp := aView client.
self navigationState versionDiffApplication:diffApp.
! !
!NewSystemBrowser methodsFor:'help specs'!
flyByHelpSpec
|changeSet spec|
spec := super flyByHelpSpec.
changeSet := ChangeSet current.
(changeSet contains:[:chg | chg isMethodChange and:[chg changeClass notNil]]) ifTrue:[
spec at:#recentChanges put:(spec at:#recentlyChangedMethods).
] ifFalse:[
"/ (changeSet contains:[:chg | chg isClassChange and:[chg changeClass notNil]]) ifTrue:[
"/ spec at:#recentChanges put:(spec at:#recentlyChangedClasses).
"/ ] ifFalse:[
spec at:#recentChanges put:'Recently Changed'.
"/ ]
].
^ spec.
!
flyByHelpTextFor:aComponent
"/ (aComponent == builder componentAt:) ifTrue:[
"/ ].
^ super flyByHelpTextFor:aComponent
! !
!NewSystemBrowser methodsFor:'menu actions-browse'!
browseImplementorsOf
"launch an enterBox for selector to search for"
^ self
askForMethodAndSpawnSearchTitle:'Selector to browse implementors of:\(TAB for completion; matchPattern allowed)'
browserLabel:'Implementors of %1'
searchWith:#( #'findImplementors:in:ignoreCase:match:' #'findImplementors:inMethods:ignoreCase:match:' )
searchWhat:#selector
searchArea:#everywhere
withCaseIgnore:true
withTextEntry:true
withMatch:true
withMethodList:true
setSearchPattern:nil
"Modified: / 17.11.2001 / 09:50:36 / cg"
!
browseImplementorsOfAny
|selectors|
selectors := self selectedMethods value collect:[:each | each selector].
^ self
askForMethodAndSpawnSearchTitle:'Browse Implementors of (any in selected):'
browserLabel:('Implementors (any of %1 selectors)' bindWith:selectors size)
searchWith:[:ignoredString :classes :ignoredCase :match|
match ifTrue:[
self class
findImplementorsMatchingAny:selectors
in:classes ignoreCase:false
] ifFalse:[
self class
findImplementorsOfAny:selectors
in:classes ignoreCase:false
].
]
searchWhat:#selector
searchArea:#everywhere
withCaseIgnore:false
withTextEntry:false
withMethodList:false
setSearchPattern:nil
!
browseInheritanceOf
"launch an enterBox for selector to search for"
|sel box b inputField selectorHolder openHow caseHolder|
sel := self selectorToSearchFor.
sel isEmptyOrNil ifTrue:[
"/ use last searchString
LastSearchPatterns size > 0 ifTrue:[
sel := LastSearchPatterns first.
].
].
selectorHolder := sel asValue.
box := Dialog new.
(box addTextLabel:(resources string:'Selector to browse inheritance of:')) adjust:#left.
inputField := box addComboBoxOn:selectorHolder tabable:true.
inputField list:LastSearchPatterns.
inputField selectAllInitially.
inputField entryCompletionBlock:[:contents |
|s what|
s := contents withoutSpaces.
box topView withWaitCursorDo:[
what := Smalltalk selectorCompletion:s.
inputField contents:what first.
(what at:2) size ~~ 1 ifTrue:[
self window beep
]
]
].
true "withCaseIgnore" ifTrue:[
box addCheckBox:(resources string:'Ignore case') on:(caseHolder := false asValue).
].
true "allowBuffer" ifTrue:[
box addButton:(b := Button label:(resources string:'Add Buffer')).
b action:[
openHow := #newBuffer.
box doAccept.
box okPressed.
].
].
true "allowBrowser" ifTrue:[
b := box addOkButtonLabelled:(resources string:'Browse').
b action:[
openHow := #newBrowser.
box doAccept.
box okPressed.
].
].
box addAbortButton.
box label:(resources string:'Search').
box open.
box accepted ifTrue:[
sel := selectorHolder value.
sel isEmpty ifTrue:[
self warn:'No selector entered for search'.
^ self.
].
self rememberSearchPattern:sel.
].
!
browseMenuAllSubclassesOf
"add a new buffer on all subclasses of an entered class"
self
askForClassToSearch:nil
single:true
msgTail:' subclass of'
thenDo:[:classNameArg :single :doWhat |
|className class searchBlock|
className := classNameArg.
className = 'nil' ifTrue:[
searchBlock := [ Behavior allSubInstances select:[:cls | cls superclass isNil] ].
] ifFalse:[
className includesMatchCharacters ifTrue:[
className := self askForClassNameMatching:className.
].
class := (Smalltalk classNamed:className) theNonMetaclass.
searchBlock := [ class allSubclasses ]
].
self
spawnClassBrowserForSearch:searchBlock
spec:#multipleClassBrowserSpec
sortBy:nil in:#newBuffer label:('All Subclasses of ' , className)
autoSelectIfOne:true
callBack:[:brwsr | ].
]
!
browseMenuApplicationClasses
"add a new buffer on all application classes"
|searchBlock|
searchBlock :=
[
Smalltalk allClassesForWhich:[:eachClass | eachClass isBrowserStartable].
].
self
spawnClassBrowserForSearch:searchBlock
spec:#multipleClassBrowserSpec
sortBy:nil in:#newBuffer label:'Applications'
autoSelectIfOne:true
callBack:[:brwsr | brwsr classListApp markApplications:true ].
"Modified: / 06-10-2006 / 11:42:02 / cg"
!
browseMenuAutoloadedClasses
"add a new buffer on all classes that have been autoloaded"
|searchBlock|
searchBlock := [
|classes|
classes := IdentitySet new.
Smalltalk allClassesDo:[:eachClass |
|cls|
eachClass wasAutoloaded ifTrue:[
classes add:eachClass.
].
].
classes asOrderedCollection
].
self
spawnClassBrowserForSearch:searchBlock
sortBy:nil
in:#newBuffer
label:'Classes which were autoloaded'
!
browseMenuClassExtensions
"open a new browser on all methods extending a class
(i.e. methods where the packageID is different from their classes packageID)"
self browseMenuClassExtensionsOpenAs:#newBrowser
!
browseMenuClassExtensionsBuffer
"add a new buffer on all methods extending a class
(i.e. methods where the packageID is different from their classes packageID)"
self browseMenuClassExtensionsOpenAs:#newBuffer.
!
browseMenuClassExtensionsFor:aCollectionOfPackagesOrNil in:aCollectionOfClasses label:labelOrNil openAs:openHow
"open a browser / add a new buffer on all methods extending a class
(i.e. methods where the packageID is different from their classes packageID)"
self withSearchCursorDo:[
|newBrowser|
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]
]
label:labelOrNil
in:openHow.
newBrowser navigationState selectedProjects value:aCollectionOfPackagesOrNil.
]
!
browseMenuClassExtensionsOpenAs:openHow
"open a browser / add a new buffer on all methods extending a class
(i.e. methods where the packageID is different from their classes packageID)"
^ self
browseMenuClassExtensionsFor:nil
in:Smalltalk allClasses
label:'All Class Extensions'
openAs:openHow
!
browseMenuClassesDefiningVariable
"open a dialog asking for a variable; search for classes defining
such a variable."
|box title okText okText2 okText3 varNameString varNamesToSearch checkFilterBlock
brwsr allInstVariables allClassInstVariables allClassVariables
list button2 button3 doWhat doWhat2 doWhat3 classes|
title := 'Browse/Search Class(es) which define Instance, Class or ClassInst Variables:\(MatchPattern Allowed; Separate multiple names/patterns by ";")\'.
okText2 := 'Open'. doWhat2 := #newBrowser.
okText := 'Add Buffer'. doWhat := #newBuffer.
navigationState isFullBrowser ifTrue:[
okText3 := 'Find'. doWhat3 := nil.
].
allInstVariables := Set new.
allClassVariables := Set new.
allClassInstVariables := Set new.
Smalltalk allClassesDo:[:cls |
cls isMeta ifFalse:[
allInstVariables addAll:(cls instVarNames).
allClassVariables addAll:(cls classVarNames).
allClassInstVariables addAll:(cls class instVarNames).
].
].
list := OrderedCollection new.
list add:'---- Instance Variables ----'.
list addAll:(allInstVariables asOrderedCollection sort).
list add:'---- Class Variables ----'.
list addAll:(allClassVariables asOrderedCollection sort).
list add:'---- Class Instance Variables ----'.
list addAll:(allClassInstVariables asOrderedCollection sort).
"/ using a comboBox...
box := self enterBoxForCodeSelectionTitle:title withCRs withList:list okText:okText.
"/ box := self enterBoxForClassWithCodeSelectionTitle:title withList:list okText:okText.
box listView selectConditionBlock:[:lineNr | ((list at:lineNr) startsWith:'----') not].
box label:(resources string:'Browse or Search Variable').
button2 := Button label:(resources string:okText2).
okText3 notNil ifTrue:[
button3 := Button label:(resources string:okText3).
].
(DialogBox defaultOKButtonAtLeft) ifFalse:[
box addButton:button2 before:(box okButton).
button3 notNil ifTrue:[box addButton:button3 before:button2].
] ifTrue:[
box addButton:button2 after:(box okButton).
button3 notNil ifTrue:[box addButton:button3 after:button2].
].
button2 action:[
doWhat := doWhat2.
box doAccept.
box okPressed.
].
button3 notNil ifTrue:[
button3 action:[
doWhat := doWhat3.
box doAccept.
box okPressed.
].
].
"/ box entryCompletionBlock:[:contents |
"/ |s what m|
"/
"/ s := contents withoutSpaces.
"/ what := Smalltalk classnameCompletion:s.
"/ box contents:what first.
"/ (what at:2) size ~~ 1 ifTrue:[
"/ self builder window beep
"/ ]
"/ ].
box action:[:aString | varNameString := aString].
box showAtPointer.
varNameString isEmptyOrNil ifTrue:[
^ self
].
varNamesToSearch := varNameString asCollectionOfSubstringsSeparatedBy:$; .
(varNamesToSearch contains:[:varNameToSearch | varNameToSearch includesMatchCharacters]) ifTrue:[
checkFilterBlock := [:v | varNamesToSearch contains:[:varNameToSearch | varNameToSearch match:v]]
] ifFalse:[
varNamesToSearch := varNamesToSearch asSet.
checkFilterBlock := [:v | varNamesToSearch includes:v]
].
classes := Smalltalk allClasses select:[:cls |
cls isMeta not
and:[(cls instVarNames contains:checkFilterBlock)
or:[(cls classVarNames contains:checkFilterBlock)
or:[cls class instVarNames contains:checkFilterBlock]]]
].
classes size == 0 ifTrue:[
self information:'None found.'.
^ self
].
classes := classes asOrderedCollection sort:[:a :b | a name < b name].
(doWhat == #newBrowser or:[ doWhat == #newBuffer ]) ifTrue:[
self spawnClassBrowserFor:classes in:doWhat.
^ self
].
brwsr := self.
doWhat == #newBuffer ifTrue:[
brwsr createBuffer.
].
brwsr selectClasses:classes.
"Created: / 1.3.2000 / 11:12:38 / cg"
"Modified: / 1.3.2000 / 12:01:06 / cg"
!
browseMenuClassesInAllChangeSets
"add a new buffer on all classes in the all changeSets
(i.e. that have been changed, but not yet checked into the source repository)"
^ self browseMenuClassesInAllChangeSetsOpenAs:#newBuffer
!
browseMenuClassesInAllChangeSetsOpenAs:openHow
"add a new buffer/open a new browser on all classes in all changeSets
(i.e. that have been changed, but not yet checked into the source repository)"
^ self
browseMenuClassesInChangeSets:(ChangeSet allInstances)
label:'Changed classes in any changeSet' openAs:openHow
!
browseMenuClassesInChangeSets:aSetOfChangeSets label:title openAs:openHow
"add a new buffer/open a new browser on all classes in the given changeSets
(i.e. that have been changed, but not yet checked into the source repository)"
|searchBlock|
searchBlock :=
[
|classes|
classes := IdentitySet new.
aSetOfChangeSets do:[:eachChangeSet |
eachChangeSet do:[:aChange |
|cls|
(aChange isMethodChange or:[aChange isClassChange]) ifTrue:[
(cls := aChange changeClass) notNil ifTrue:[
cls isRealNameSpace ifFalse:[
cls := cls theNonMetaclass.
classes add:cls.
cls isPrivate ifTrue:[
classes add:cls owningClass
].
].
]
].
].
].
classes asOrderedCollection
].
^ self spawnClassBrowserForSearch:searchBlock sortBy:nil in:openHow label:title
"Modified: / 10-11-2006 / 17:13:45 / cg"
!
browseMenuClassesInCurrentChangeSet
"add a new buffer on all classes in the current changeSet
(i.e. that have been changed, but not yet checked into the source repository)"
^ self browseMenuClassesInCurrentChangeSetOpenAs:#newBuffer
!
browseMenuClassesInCurrentChangeSetOpenAs:openHow
"add a new buffer/open a new browser on all classes in the changeSet
(i.e. that have been changed, but not yet checked into the source repository)"
^ self
browseMenuClassesInChangeSets:(Array with:ChangeSet current)
label:'Changed classes in current changeSet' openAs:openHow
!
browseMenuClassesWithFilter:aFilterBlock label:aLabelString
|searchBlock|
searchBlock := [ Smalltalk allClasses select:aFilterBlock ].
^ self
spawnClassBrowserForSearch:searchBlock
sortBy:nil
in:#newBuffer
label:aLabelString
!
browseMenuClassesWithNameMatching
"open a dialog asking for a string; search for classes having
such a string fragment in their comment/documentation."
self searchMenuFindClass:#newBuffer single:false.
!
browseMenuClassesWithStringInCommentOrDocumentation
"open a dialog asking for a string; search for classes having
such a string fragment in their comment/documentation."
|box title okText okText2 okText3 stringToSearch brwsr
button2 button3 doWhat doWhat2 doWhat3 classes withMatch|
title := 'Browse classes with string in comment/documentation (matchPattern allowed):'.
okText2 := 'Open'. doWhat2 := #newBrowser.
okText := 'Add Buffer'. doWhat := #newBuffer.
navigationState isFullBrowser ifTrue:[
title := 'Browse/search classes with string in comment/documentation (matchPattern allowed):'.
okText3 := 'Find'. doWhat3 := nil.
].
box := EnterBox new.
box title:title.
box okText:okText.
box label:(resources string:'Search for documentation string').
button2 := Button label:(resources string:okText2).
okText3 notNil ifTrue:[
button3 := Button label:(resources string:okText3).
].
(DialogBox defaultOKButtonAtLeft) ifFalse:[
box addButton:button2 before:(box okButton).
button3 notNil ifTrue:[box addButton:button3 before:button2].
] ifTrue:[
box addButton:button2 after:(box okButton).
button3 notNil ifTrue:[box addButton:button3 after:button2].
].
button2 action:[
doWhat := doWhat2.
box doAccept.
box okPressed.
].
button3 notNil ifTrue:[
button3 action:[
doWhat := doWhat3.
box doAccept.
box okPressed.
].
].
box action:[:aString | stringToSearch := aString].
box showAtPointer.
stringToSearch isNil ifTrue:[
^ self
].
withMatch := stringToSearch includesMatchCharacters.
withMatch ifTrue:[
stringToSearch := '*' , stringToSearch , '*'
].
self withWaitCursorDo:[
classes := Smalltalk allClasses select:[:cls |
|s m found|
(cls isLoaded and:[cls isMeta not]) ifTrue:[
self activityNotification:('searching %1 ...' bindWith:cls name).
found := false.
(s := cls comment) notNil ifTrue:[
withMatch ifTrue:[
found := stringToSearch match:s
] ifFalse:[
found := s includesString:stringToSearch
]
].
(m := cls theMetaclass compiledMethodAt:#documentation) notNil
ifTrue:[
s := m source ? ''.
withMatch ifTrue:[
found := stringToSearch match:s
] ifFalse:[
found := s includesString:stringToSearch
]
]
].
].
classes := classes asOrderedCollection.
].
self activityNotification:nil.
classes size == 0 ifTrue:[
self information:'None found.'.
^ self
].
doWhat == #newBrowser ifTrue:[
^ self spawnClassBrowserFor:classes in:#newBrowser
"/ brwsr := self class new.
"/ brwsr open.
] ifFalse:[
doWhat == #newBuffer ifTrue:[
^ self spawnClassBrowserFor:classes in:#newBuffer
].
brwsr := self.
doWhat == #newBuffer ifTrue:[
brwsr createBuffer.
]
].
brwsr selectClasses:classes.
"Created: / 1.3.2000 / 12:44:16 / cg"
"Modified: / 1.3.2000 / 12:45:44 / cg"
!
browseMenuClassesWithUserFilter
"launch an enterBox for area to search in"
|filterBlockString filterBlock dialog textHolder template|
template :=
'"/ general class search;
"/ the following block should evaluate to true for all classes
"/ you want to browse. Please change as required.
"/ Beginner warning: Smalltalk know-how is useful here.
[:class |
"/ any condition using class.
"/ Useful queries to the method are:
"/ - source to access its full sourceCode
"/ - package the classes package
"/ - name the classes name
"/ - category the classes category
"/ - nameSpace the classes namespace
"/ - superclass the classes superclass
"/ - hasExtension true if it has extensions (methods in other packages)
"/ - implements: true if it implements a particular message
"/ - isSubclassOf: true if it is a subclass of some other class
"/ - isSuperclassOf: true if it is a superclass of some other class
"/ - hasUnsavedChanges true if it has been changed but not saved in repository
"/
"/ example (search for classes which implement some message and are in the Smalltalk nameSpace)
(class nameSpace == Smalltalk
and:[ class implements:#at: ] )
]
'.
LastClassFilterBlockString isNil ifTrue:[
LastClassFilterBlockString := template.
].
textHolder := ValueHolder new.
dialog := Dialog
forRequestText:(resources string:'Enter filterBlock')
lines:25
columns:70
initialAnswer:LastClassFilterBlockString
model:textHolder.
dialog addButton:(Button label:'Template' action:[textHolder value:template. textHolder changed:#value.]).
dialog open.
dialog accepted ifFalse:[^ self].
filterBlockString := textHolder value.
LastClassFilterBlockString := filterBlockString.
filterBlock := Parser evaluate:filterBlockString.
self assert:filterBlock isBlock message:'bad input'.
self browseMenuClassesWithFilter:filterBlock label:'Class-Search result'
!
browseMenuClassesWithoutCVSRepositoryContainer
|searchBlock|
searchBlock := [
|classesWithVersion classesWithVersionCVS classesWithoutBoth|
classesWithVersion := self findClassesWithoutClassMethod:#version.
classesWithVersion := classesWithVersion reject:[:each | each isPrivate].
classesWithVersionCVS := self findClassesWithoutClassMethod: CVSSourceCodeManager nameOfVersionMethodInClasses.
classesWithVersionCVS := classesWithVersionCVS select:[:each | each isPrivate not].
classesWithoutBoth := classesWithVersion asSet intersect: classesWithVersionCVS.
].
^ self spawnClassBrowserForSearch:searchBlock sortBy:nil in:#newBuffer label:'Classes without CVS repository container'
"Modified: / 11-07-2010 / 16:41:55 / cg"
!
browseMenuClassesWithoutCopyright
|searchBlock|
searchBlock :=
[|classes|
classes := self findClassesWithoutClassMethod:#copyright.
classes := classes reject:[:each | each isPrivate].
classes].
self
spawnClassBrowserForSearch:searchBlock
sortBy:nil
in:#newBuffer
label:'Classes without copyright'
"Modified: / 11-07-2010 / 16:42:04 / cg"
!
browseMenuClassesWithoutDocumentation
|searchBlock|
searchBlock := [
self findClassesWithoutClassMethod:#documentation
].
self spawnClassBrowserForSearch:searchBlock sortBy:nil in:#newBuffer label:'Classes without documentation'
!
browseMenuClassesWithoutExamples
|searchBlock|
searchBlock := [ |classes|
classes := self findClassesWithoutClassMethod:#examples.
classes
select:[:each |
(each isPrivate not
or:[classes includes:each owningClass])
and:[ (each isSubclassOf:Exception) not ]
].
].
self spawnClassBrowserForSearch:searchBlock sortBy:nil in:#newBuffer label:'Classes without examples'
"Modified: / 11-07-2010 / 16:43:35 / cg"
!
browseMenuClassesWithoutSVNRepositoryContainer
|searchBlock nameOfVersionMethodInClasses sourceCodeManager|
sourceCodeManager := Smalltalk at: #SVNSourceCodeManager.
sourceCodeManager isNil ifTrue: [
Dialog warn: 'SVN Source Code Manager is not available'.
^ self.
].
nameOfVersionMethodInClasses := sourceCodeManager nameOfVersionMethodInClasses.
searchBlock := [
|classesWithVersion classesWithVersionSVN classesWithoutBoth|
classesWithVersion := self findClassesWithoutClassMethod:#version.
classesWithVersion := classesWithVersion reject:[:each | each isPrivate].
classesWithVersionSVN := self findClassesWithoutClassMethod: nameOfVersionMethodInClasses.
classesWithVersionSVN := classesWithVersionSVN select:[:each | each isPrivate not].
classesWithoutBoth := classesWithVersion asSet intersect: classesWithVersionSVN.
].
^ self spawnClassBrowserForSearch:searchBlock sortBy:nil in:#newBuffer label:'Classes without SVN repository container'
"Modified: / 11-07-2010 / 16:43:48 / cg"
!
browseMenuClone
|browser categoryListApp|
self window sensor shiftDown ifTrue:[
"/ temporary: allow old browser to be used
SystemBrowser openInClass:(self theSingleSelectedClass) selector:(self theSingleSelectedSelector).
^ self
].
"/ do not use self class new here - to avoid using obsolete classes instances
"/ while working on the browser itself ...
browser := (Smalltalk at:self class name) new.
browser allButOpen.
browser setupNavigationStateFrom:navigationState.
browser window extent:(self window extent).
self currentNamespace ~~ Smalltalk ifTrue:[
(categoryListApp := browser categoryListApp) notNil ifTrue:[
categoryListApp nameSpaceFilter value:(self navigationState selectedNamespaces value copy)
].
].
browser openWindow.
^ browser.
"Modified: / 08-08-2010 / 15:19:13 / cg"
!
browseMenuDeprecatedMethods
^ self
askForMethodAndSpawnSearchTitle:'Search for Deprecated Methods in:'
browserLabel:(LabelAndIcon icon:(self class menuIcon) string:'Deprecated Methods')
searchWith:[:classes | self class findMethodsIn:classes where:[:c :m :sel | m isObsolete]]
searchArea:(self defaultSearchArea)
!
browseMenuHTTPServiceClasses
"add a new buffer on all web service classes"
|searchBlock|
searchBlock :=
[
Smalltalk allClassesForWhich:[:eachClass | eachClass isBrowserStartable
and:[eachClass inheritsFrom:HTTPService] ].
].
self
spawnClassBrowserForSearch:searchBlock
spec:#multipleClassBrowserSpec
sortBy:nil in:#newBuffer label:'Web Services'
autoSelectIfOne:true
callBack:[:brwsr | brwsr classListApp markApplications:true ].
"Created: / 20-07-2007 / 10:02:14 / cg"
!
browseMenuImplementorsOf
self browseImplementorsOf
!
browseMenuImplementorsOfAny
self browseImplementorsOfAny
!
browseMenuInheritanceOf
self browseInheritanceOf
!
browseMenuMethodsInChangeSets:aSetOfChangeSets openAs:openHow
"add a new buffer on all methods in all given changeSets
(i.e. that have been changed, but not yet checked into the source repository)"
|searchBlock|
searchBlock := [
|methods methodsInOrder|
aSetOfChangeSets do:[:eachChangeSet |
methods := IdentitySet new.
methodsInOrder := OrderedCollection new.
eachChangeSet reverseDo:[:aChange |
|cls selector method|
(aChange isMethodChange) ifTrue:[
(cls := aChange changeClass) notNil ifTrue:[
method := cls compiledMethodAt:aChange selector.
method notNil ifTrue:[
(methods includes:method) ifFalse:[
methods add:method.
methodsInOrder add:method.
]
]
]
].
].
].
methodsInOrder
].
^ self
spawnMethodBrowserForSearch:searchBlock
sortBy:false "#class"
in:openHow
label:'Changed methods'
!
browseMenuMethodsInCurrentChangeSet
"add a new buffer on all methods in the changeSet
(i.e. that have been changed, but not yet checked into the source repository)"
^ self browseMenuMethodsInCurrentChangeSetIn:#newBuffer
!
browseMenuMethodsInCurrentChangeSetIn:openHow
"add a new buffer on all methods in the changeSet
(i.e. that have been changed, but not yet checked into the source repository)"
^ self browseMenuMethodsInChangeSets:(Array with:ChangeSet current) openAs:openHow
!
browseMenuMethodsWithCode
"launch an enterBox for code to search for"
|whereDefault|
whereDefault := SearchDialog lastCodeSearchArea ? #everywhere.
"/ whereDefault := self defaultSearchArea.
"/ whereDefault == #classes ifTrue:[
"/ ((self selectedMethods value ? #()) contains:[:anyMethod | anyMethod mclass isPrivate]) ifTrue:[
"/ whereDefault := #ownersWithPrivateClasses
"/ ]
"/ ].
self
askForMethodAndSpawnSearchTitle:'Code to Search:'
browserLabel:'Methods containing code'
searchWith:#( #'findCode:in:isMethod:' #'findCode:inMethods:isMethod:' )
searchWhat:#code
searchArea:whereDefault
withCaseIgnore:false
withTextEntry:true
withMethodList:true
setSearchPattern:[:brwsr :codePattern :isMethodSearch :doMatch|
isMethodSearch ifFalse:[
brwsr autoSearchCodePattern:codePattern
]
]
!
browseMenuMethodsWithExceptionHandlers
"launch an enterBox for area to search for"
|whereDefault|
whereDefault := SearchDialog lastCodeSearchArea ? #everywhere.
self
askForMethodAndSpawnSearchTitle:'Search Exception Raisers:'
browserLabel:'Methods containing Exception Raisers'
searchWith:#( #'findExceptionHandlersIn:' #'findExceptionHandlersInMethods:' )
searchWhat:nil
searchArea:whereDefault
withCaseIgnore:false
withTextEntry:false
withMethodList:true
setSearchPattern:[:brwsr :codePattern :isMethodSearch :doMatch | ]
"Created: / 11-05-2010 / 14:19:27 / cg"
!
browseMenuMethodsWithExceptionRaisers
"launch an enterBox for area to search for"
|whereDefault|
whereDefault := SearchDialog lastCodeSearchArea ? #everywhere.
self
askForMethodAndSpawnSearchTitle:'Search Exception Raisers:'
browserLabel:'Methods containing Exception Raisers'
searchWith:#( #'findExceptionRaisersIn:' #'findExceptionRaisersInMethods:' )
searchWhat:nil
searchArea:whereDefault
withCaseIgnore:false
withTextEntry:false
withMethodList:true
setSearchPattern:[:brwsr :codePattern :isMethodSearch :doMatch | ]
"Created: / 11-05-2010 / 14:19:14 / cg"
!
browseMenuMethodsWithExternalFunctionCalls
|whereDefault|
whereDefault := self defaultSearchArea.
^ self
askForMethodAndSpawnSearchTitle:'Search for Methods with Library Calls (FFI):'
browserLabel:'Library Calls (FFI)'
searchWith:[:classes |
self class
findMethodsIn:classes
where:[:cls :mthd :sel |
mthd isExternalLibraryFunctionCall
]
]
searchArea:whereDefault
!
browseMenuMethodsWithHelpSpec
"launch an enterBox for area to search in"
^ self
askForMethodAndSpawnSearchTitle:'Search for help texts (helpSpec methods) in:'
browserLabel:(LabelAndIcon icon:(self class menuIcon) string:'Help')
searchWith:[:classes | self class findResource:#(help) in:classes]
searchArea:(self defaultSearchArea)
!
browseMenuMethodsWithImageSpec
"launch an enterBox for area to search in"
^ self
askForMethodAndSpawnSearchTitle:'Search for images (imageSpec methods) in:'
browserLabel:(LabelAndIcon icon:(self class imageIcon) string:'Images') " 'Images' "
searchWith:[:classes | self class findResource:#(image fileImage) in:classes]
searchArea:(self defaultSearchArea)
!
browseMenuMethodsWithLeftoverDebugCode
|whereDefault codeStrings matcher|
codeStrings :=
#(
'Transcript `@msg: `@args'
'`@any halt'
'true ifTrue: `@stuff'
'true ifFalse: `@stuff'
'false ifTrue: `@stuff'
'false ifFalse: `@stuff'
'`@any handle:[] do:`@anyBlock'
'`@any handle:[:ex | ] do:`@anyBlock'
'`@any needsWork'
'#needsWork'
'#todo'
).
matcher := ParseTreeSearcher new.
matcher matchesAnyOf: codeStrings do: [:aNode :answer | aNode].
whereDefault := self defaultSearchArea.
^ self
askForMethodAndSpawnSearchTitle:'Search for methods with possible leftOver debug code in:'
browserLabel:'Methods with leftOver debug code'
searchWith:[:classes |
self class
findMethodsIn:classes
where:[:cls :mthd :sel |
self method:mthd selector:sel inClass:cls matchesParseTreeMatcher:matcher
]
]
searchArea:whereDefault
!
browseMenuMethodsWithMenuSpec
"launch an enterBox for area to search in"
^ self
askForMethodAndSpawnSearchTitle:'Search for menus (menuSpec methods) in:'
browserLabel:(LabelAndIcon icon:(self class menuIcon) string:'Menus') "'Menus'"
searchWith:[:classes | self class findResource:#(menu programMenu) in:classes]
searchArea:(self defaultSearchArea)
!
browseMenuMethodsWithPrimitiveCode
|whereDefault|
whereDefault := self defaultSearchArea.
^ self
askForMethodAndSpawnSearchTitle:'Search for Methods with Primitive Code:'
browserLabel:'Primitive Code'
searchWith:[:classes |
self class
findMethodsIn:classes
where:[:cls :mthd :sel |
mthd hasPrimitiveCode
]
]
searchArea:whereDefault
!
browseMenuMethodsWithResource
"launch an enterBox for area to search in"
^ self
askForMethodAndSpawnSearchTitle:'Search for resource methods in:'
browserLabel:" (LabelAndIcon icon:(self class resourceIcon) string:'Resources') " 'Resources'
searchWith:[:classes | self class findAnyResourceIn:classes]
searchArea:(self defaultSearchArea)
!
browseMenuMethodsWithString
"launch an enterBox for string to search for"
|whereDefault|
self isMethodListBrowser ifTrue:[
whereDefault := SearchDialog constantForListOfMethodsArea.
] ifFalse:[
whereDefault := SearchDialog lastStringSearchArea ? self defaultSearchArea.
whereDefault == #classes ifTrue:[
((self selectedMethods value ? #())
contains:[:anyMethod | anyMethod mclass notNil
and:[anyMethod mclass isPrivate]])
ifTrue:[
whereDefault := #ownersWithPrivateClasses
]
].
].
self
askForMethodAndSpawnSearchTitle:'String to Search for in Sources:'
browserLabel:'Methods containing ''%1'''
searchWith:#( #'findString:in:ignoreCase:match:' #'findString:inMethods:ignoreCase:match:' )
searchWhat:#string
searchArea:whereDefault
withCaseIgnore:true
withTextEntry:true
withMethodList:true
setSearchPattern:[:brwsr :string :ignoreCase :doMatch|
brwsr autoSearchPattern:string ignoreCase:ignoreCase.
]
"Modified: / 19-11-2010 / 12:11:55 / cg"
!
browseMenuMethodsWithStringInHelpSpec
"launch an enterBox for string to search for"
|whereDefault|
whereDefault := self defaultSearchArea.
whereDefault == #classes ifTrue:[
((self selectedMethods value ? #()) contains:[:anyMethod | anyMethod mclass isPrivate]) ifTrue:[
whereDefault := #ownersWithPrivateClasses
]
].
self
askForMethodAndSpawnSearchTitle:'String to search for in help spec methods:'
browserLabel:'HelpSpec Methods containing ''%1'''
searchWith:#findHelpSpecMethodsWithString:in:ignoreCase:match:
searchWhat:#string
searchArea:whereDefault
withCaseIgnore:true
setSearchPattern:[:brwsr :string :ignoreCase :doMatch|
brwsr autoSearchPattern:string ignoreCase:ignoreCase.
]
!
browseMenuMethodsWithStringInMenuSpec
"launch an enterBox for string to search for"
|whereDefault|
whereDefault := self defaultSearchArea.
whereDefault == #classes ifTrue:[
((self selectedMethods value ? #()) contains:[:anyMethod | anyMethod mclass isPrivate]) ifTrue:[
whereDefault := #ownersWithPrivateClasses
]
].
self
askForMethodAndSpawnSearchTitle:'String to search for in menu spec methods:'
browserLabel:'MenuSpec Methods containing ''%1'''
searchWith:#'findMenuSpecMethodsWithString:in:ignoreCase:match:'
searchWhat:#string
searchArea:whereDefault
withCaseIgnore:true
setSearchPattern:[:brwsr :string :ignoreCase :doMatch|
brwsr autoSearchPattern:string ignoreCase:ignoreCase.
]
!
browseMenuMethodsWithStringLiteral
"launch an enterBox for code to search for"
|whereDefault|
whereDefault := SearchDialog lastCodeSearchArea ? #everywhere.
"/ whereDefault := self defaultSearchArea.
"/ whereDefault == #classes ifTrue:[
"/ ((self selectedMethods value ? #()) contains:[:anyMethod | anyMethod mclass isPrivate]) ifTrue:[
"/ whereDefault := #ownersWithPrivateClasses
"/ ]
"/ ].
self
askForMethodAndSpawnSearchTitle:'Search Matchstring in Literal-Strings:'
browserLabel:'Methods with Literal-String Matching'
searchWith:#( #'findStringLiteral:in:ignoreCase:match:' #'findStringLiteral:inMethods:ignoreCase:match:' )
searchWhat:#string
searchArea:whereDefault
withCaseIgnore:true
withTextEntry:true
withMethodList:true
setSearchPattern:[:brwsr :string :ignoreCase :doMatch|
brwsr autoSearchPattern:string ignoreCase:ignoreCase.
]
!
browseMenuMethodsWithTableSpec
"launch an enterBox for area to search in"
^ self
askForMethodAndSpawnSearchTitle:'Search for tableSpec methods in:'
browserLabel:(LabelAndIcon icon:(self class menuIcon) string:'TableSpecs')
searchWith:[:classes | self class findResource:#(tableColumns) in:classes]
searchArea:(self defaultSearchArea)
!
browseMenuMethodsWithUglyCodingStyle
|whereDefault|
whereDefault := self defaultSearchArea.
^ self
askForMethodAndSpawnSearchTitle:'Search for methods with ugly coding style in:'
browserLabel:'Methods with ugly coding style'
searchWith:[:classes |
self class
findMethodsIn:classes
where:[:cls :mthd :sel |
|note|
note := self methodHasUglyCodingStyle:mthd selector:sel inClass:cls.
note notNil
]
]
searchArea:whereDefault
!
browseMenuMethodsWithUserFilter
"launch an enterBox for area to search in"
|whereDefault filterBlockString filterBlock dialog textHolder template dummyMethod|
template :=
'"/ general method search;
"/ the following block should evaluate to true for all methods
"/ you want to browse. Please change as required.
"/ Beginner warning: Smalltalk know-how is useful here ;-).
[:class :method :selector |
"/ any condition using class, method or selector.
"/ Useful queries to the method are:
"/ - package the methods packageID
"/ - source to access its sourceCode
"/ - messagesSent a collection of sent messages (all)
"/ - messagesSentToSuper a collection of super messages
"/ - sends: query a particular message
"/ - referencesLiteral: query for direct literal access
"/ - refersToLiteral: query for direct or indirect literal access
"/ - literals the methods literal-array
"/ - usedGlobals a collection of used global names
false
"/ "/
"/ "/ example: search for methods which contain a string AND send a particular message
"/ "/
"/ (method source includesString:''Useful'')
"/ and:[ method sends:#for: ]
"/ "/
"/ "/ example: search for methods which send #foo AND #bar
"/ "/
"/ |msgSet|
"/ msgSet := method messagesSent.
"/ (msgSet includes:#foo) and:[msgSet includes:#bar]
"/ "/
"/ "/ example: search for methods which send #foo OR #bar
"/ "/
"/ |msgSet|
"/ msgSet := method messagesSent.
"/ (msgSet includes:#foo) or:[msgSet includes:#bar]
"/ "/ the same, but faster
"/ "/ (messagesSent requires a source-parse in contrast,
"/ "/ in contrast, referencesLiteral accesses the literalArray)
"/ "/ thus, prefiltering helps a lot.
"/ ((method referencesLiteral:#foo) or:[method referencesLiteral:#bar])
"/ and:[
"/ |msgSet|
"/ msgSet := method messagesSent.
"/ (msgSet includes:#foo) or:[msgSet includes:#bar]
"/ ]
"/ "/
"/ "/ example: search for methods which contain a string constant
"/ "/ which contains some string-fragment
"/ "/ (i.e. which method generates a particular message-string)
"/ |lits|
"/ lits := method literals.
"/ (lits contains:[:aLit | aLit isString and:[aLit asLowercase includesString:''error'']])
]
'.
LastMethodFilterBlockString isNil ifTrue:[
LastMethodFilterBlockString := template.
].
textHolder := ValueHolder new.
dialog := Dialog
forRequestText:(resources string:'Enter filterBlock')
editViewClass:CodeView
lines:25
columns:70
initialAnswer:LastMethodFilterBlockString
model:textHolder.
dialog addButton:(Button label:'Template' action:[textHolder value:template. textHolder changed:#value.]).
dialog open.
dialog accepted ifFalse:[^ self].
filterBlockString := textHolder value.
LastMethodFilterBlockString := filterBlockString.
dummyMethod := Compiler
compile:('dummy ^' , filterBlockString)
forClass:UndefinedObject
inCategory:nil
notifying:nil
install:false.
"/ filterBlock := Parser evaluate:filterBlockString.
"/ filterBlock isBlock ifFalse:[
(dummyMethod isMethod not
or:[(filterBlock := dummyMethod valueWithReceiver:nil arguments:nil) isBlock not])
ifTrue:[
self error:'bad input'.
^ self
].
whereDefault := self defaultSearchArea.
self
askForMethodAndSpawnSearchTitle:'Search for methods in:'
browserLabel:'Method-Search'
searchWith:[:classes |
self class
findMethodsIn:classes
where:[:cls :mthd :sel | filterBlock value:cls value:mthd value:sel ]
]
searchArea:whereDefault.
"Created: / 18.8.2000 / 21:26:37 / cg"
"Modified: / 18.8.2000 / 21:58:31 / cg"
!
browseMenuMethodsWithWindowSpec
"launch an enterBox for area to search in"
|whereDefault|
whereDefault := self defaultSearchArea.
^ self
askForMethodAndSpawnSearchTitle:'Search for GUI specs (windowSpec methods) in:'
browserLabel:(LabelAndIcon icon:(self class canvasIcon) string:'UISpecs') "'UISpecs'"
searchWith:[:classes | self class findResource:#canvas in:classes]
searchArea:whereDefault
!
browseMenuMethodsWithWrap
"add a new buffer on all wrapped methods
(i.e. that have a break, trace or watchPoint)"
self
spawnMethodBrowserForSearch:[ MessageTracer allWrappedMethods ]
sortBy:#class in:#newBuffer label:'Wrapped methods'
!
browseMenuMethodsWithoutComment
"launch an enterBox for area to search in"
|whereDefault|
whereDefault := self defaultSearchArea.
^ self
askForMethodAndSpawnSearchTitle:'Search for methods without comment in:'
browserLabel:'Methods without comment'
searchWith:[:classes |
self class
findMethodsIn:classes
where:[:cls :mthd :sel |
(cls isMeta not or:[(AbstractSourceCodeManager isVersionMethodSelector:sel) not])
and:[ mthd comment size == 0 ]
]
]
searchArea:whereDefault
!
browseMenuOpenInClass
self searchMenuFindClass:#newBuffer "/ open new
!
browseMenuOverwrittenMethods:openHow
|searchBlock|
searchBlock := [
|defaultId methods methodsInOrder|
methods := OrderedCollection new.
Smalltalk allMethodsDo:[:mthd |
mthd previousVersion notNil ifTrue:[
methods add:mthd.
].
].
methods
].
^ self
spawnMethodBrowserForSearch:searchBlock
sortBy:#class
in:openHow
label:'Changed Methods'
!
browseMenuRecentChanges
"launch a changeSet browser"
ChangeSetBrowser open
"Created: / 9.11.2001 / 02:22:08 / cg"
!
browseMenuReferencesToGlobal
"launch an enterBox for global to search for"
|labelHolder alreadyAsked searchAllLabel|
labelHolder := 'Methods referring to global ''%1''' asValue.
self
askForMethodAndSpawnSearchTitle:'Global to search:\(TAB for completion; matchPattern allowed)'
browserLabel:labelHolder
searchWith:[:string :classes :dummyIgnoreCase :dummyMatch|
|globlNames globlNamesAndSymbols globlName sym baseName matchBlock realClasses val
keysReferringToValue otherKeysReferringToValue msg searchAll|
globlNames := string withoutSeparators asCollectionOfSubstringsSeparatedByAny:',;| '.
globlNames size > 1 ifTrue:[
globlNames := globlNames collect:[:nm | nm asSymbol].
matchBlock := [:cls :mthd :sel |
|mSource usedGlobals|
mthd isLazyMethod ifTrue:[
mSource := mthd source.
(mSource notNil
and:[(globlNames contains:[:nm |
(mSource includesString:nm)
and:[
usedGlobals isNil ifTrue:[ usedGlobals := mthd usedGlobals].
usedGlobals includes:nm
]])]).
] ifFalse:[
globlNames contains:[:nm |
(mthd referencesLiteral:nm)
and:[
usedGlobals isNil ifTrue:[ usedGlobals := mthd usedGlobals].
usedGlobals includes:nm
]].
]
]
] ifFalse:[
globlName := globlNames first.
globlName knownAsSymbol ifFalse:[
globlName includesMatchCharacters ifFalse:[
^ self warn:'No such global (''' , globlName , ''')'.
].
matchBlock := [:cls :mthd :sel |
(mthd literals contains:[:lit | globlName match:lit])
and:[mthd usedGlobals contains:[:lit | globlName match:lit] ]
]
] ifTrue:[
searchAll := false.
sym := globlName asSymbol.
val := globlName lastIndexOf:$:.
val ~~ 0 ifTrue:[
baseName := (globlName copyFrom:val+1) asSymbol.
] ifFalse:[
baseName := sym.
].
(val := Smalltalk at:sym) isBehavior ifTrue:[
otherKeysReferringToValue := OrderedCollection new.
Smalltalk keysAndValuesDo:[:k :v | v == val ifTrue:[
k ~~ sym ifTrue:[
otherKeysReferringToValue add:k
]
]
].
otherKeysReferringToValue size > 0 ifTrue:[
keysReferringToValue := otherKeysReferringToValue copyWith:sym.
otherKeysReferringToValue size == 1 ifTrue:[
msg := '''%1'' also refers to that value. Search these references too ?'.
searchAllLabel := 'Methods referring to ''%1'' or ''%2''' bindWithArguments:keysReferringToValue.
] ifFalse:[
searchAllLabel := 'Methods referring to the value of ''%1'''.
otherKeysReferringToValue size <= 3 ifTrue:[
msg := (otherKeysReferringToValue copyWithoutLast:1) asStringWith:', '.
msg := msg , ' and ' , otherKeysReferringToValue last.
msg := msg , ' also refer to that value. Search those references too ?'.
] ifFalse:[
msg := 'There are %2 other globals referring to that value. Search those references too ?'.
]
].
alreadyAsked isNil ifTrue:[
searchAll := Dialog
confirmWithCancel:(msg bindWith:otherKeysReferringToValue first with:otherKeysReferringToValue size)
default:true.
searchAll isNil ifTrue:[^ self].
alreadyAsked := searchAll.
] ifFalse:[
searchAll := alreadyAsked.
].
]
].
searchAll ifTrue:[
labelHolder value:searchAllLabel.
matchBlock := [:cls :mthd :sel |
"/ kludge: Lazy methods do not include symbols in the literal array - sigh
mthd isLazyMethod ifTrue:[
(mthd usedGlobals includesAny:keysReferringToValue)
] ifFalse:[
(keysReferringToValue contains:[:globl | mthd refersToLiteral:globl])
and:[mthd usedGlobals includesAny:keysReferringToValue]
]
]
] ifFalse:[
matchBlock := [:cls :mthd :sel | |mSource|
"/ kludge: Lazy methods do not include symbols in the literal array - sigh
mthd isLazyMethod ifTrue:[
mSource := mthd source.
(mSource notNil
and:[(mSource includesString:baseName)
and:[mthd usedGlobals includes:sym]])
] ifFalse:[
(((mthd referencesLiteral:baseName) or:[baseName ~~ sym and:[mthd referencesLiteral:sym]])
and:[mthd usedGlobals includes:sym])
]
]
]
].
].
"/ recollect realClasses from names (in case of class-changes)
realClasses := classes collect:[:eachClass | Smalltalk at:eachClass name].
self class
findMethodsIn:realClasses
where:matchBlock
]
searchWhat:#globalName
searchArea:#everywhere
withCaseIgnore:false
setSearchPattern:[:brwsr :string :ignoreCase :doMatch|
|globlNames|
globlNames := string withoutSeparators asCollectionOfSubstringsSeparatedByAny:',;| '.
brwsr autoSearchVariables:globlNames.
"/ brwsr autoSearchPattern:string ignoreCase:ignoreCase.
]
"Modified: / 5.11.2001 / 14:19:22 / cg"
!
browseMenuReferencesToSymbol
"launch an enterBox for symbol to search for"
self
askForMethodAndSpawnSearchTitle:'Symbol to search:'
browserLabel:'Methods referring to #''%1'''
searchWith:[:string :classes :dummyIgnoreCase :dummyMatch|
|sym stringToSearch searchBlock|
stringToSearch := string.
(string startsWith:'#') ifTrue:[
stringToSearch := Symbol readFrom:string.
Dialog information:'Searching for ',stringToSearch
].
(sym := stringToSearch asSymbolIfInterned) notNil ifTrue:[
searchBlock := [:cls :mthd :sel | |mSource|
"/ kludge: stc does not include symbols in the literal array - sigh
"/ (also: Lazy methods)
mthd byteCode isNil ifTrue:[
mSource := mthd source.
(mSource notNil
and:[(mSource includesString:(sym upTo:$:))
and:[mthd usedSymbols includes:sym]])
] ifFalse:[
((mthd refersToLiteral:sym)
and:[mthd usedSymbols includes:sym])
]
].
] ifFalse:[
stringToSearch includesMatchCharacters ifFalse:[
^ self warn:'No such symbol'.
].
searchBlock := [:cls :mthd :sel | |mSource|
"/ kludge: stc does not include symbols in the literal array - sigh
"/ (also: Lazy methods)
mthd byteCode isNil ifTrue:[
mSource := mthd source.
(mSource notNil
and:[mthd usedSymbols contains:[:sym | stringToSearch match:sym]])
] ifFalse:[
mthd usedSymbols contains:[:sym | stringToSearch match:sym]
]
].
].
self class
findMethodsIn:classes
where:searchBlock
]
searchWhat:#selector
searchArea:(self defaultSearchArea)
withCaseIgnore:false
setSearchPattern:[:brwsr :string :ignoreCase :doMatch|
brwsr autoSearchPattern:string ignoreCase:ignoreCase.
]
"Modified: / 25-11-2010 / 11:41:10 / cg"
!
browseMenuSpawnFullClassSource
"open a browser showing full classes (file-like)"
self spawnFullClassSourceBrowserIn:#newBrowser
"Created: / 24.2.2000 / 14:37:51 / cg"
!
browseMenuSpawnFullClassSourceInBuffer
"add a buffer showing full classes (file-like)"
self spawnFullClassSourceBrowserIn:#newBuffer
"Created: / 24.2.2000 / 14:38:09 / cg"
!
browseMenuSpawnRepositoryDiffs
^ self browseMenuSpawnRepositoryDiffsIn:#newBrowser
!
browseMenuSpawnRepositoryDiffsIn:where
|searchBlock|
searchBlock := [
|changes classes|
changes := ChangeSet current.
classes := IdentitySet new.
changes do:[:aChange |
|cls|
(aChange isMethodChange or:[aChange isClassChange]) ifTrue:[
(cls := aChange changeClass) notNil ifTrue:[
cls := cls theNonMetaclass.
(classes includes:cls) ifFalse:[
classes add:cls.
]
]
].
].
classes asOrderedCollection
].
^ self
spawnClassBrowserForSearch:searchBlock spec:#multipleClassRepositoryDiffBrowserSpec
sortBy:nil in:where label:'Repository Diffs' autoSelectIfOne:false
!
browseMenuSpawnRepositoryDiffsInBuffer
^ self browseMenuSpawnRepositoryDiffsIn:#newBuffer
!
browseMenuTestCaseClasses
"add a new buffer on all testcases"
|searchBlock|
searchBlock := [
|classes|
classes := OrderedCollection new.
Smalltalk allClassesDo:[:eachClass |
(eachClass isSubclassOf:TestCase) ifTrue:[
classes add:eachClass
]
].
classes
].
self
spawnClassBrowserForSearch:searchBlock
spec:#multipleClassBrowserSpec
sortBy:nil in:#newBuffer label:'TestCases'
autoSelectIfOne:true
callBack:[:brwsr | brwsr classListApp markApplications:true ].
"Modified: / 5.11.2001 / 09:37:17 / cg"
!
browseMenuUnassignedMethods:openHow
|searchBlock|
searchBlock := [
|defaultId methods methodsInOrder|
methods := OrderedCollection new.
defaultId := PackageId noProjectID.
Smalltalk allMethodsDo:[:mthd |
mthd package = defaultId ifTrue:[
methods add:mthd.
].
].
methods
].
^ self
spawnMethodBrowserForSearch:searchBlock
sortBy:#class
in:openHow
label:'Loose methods'
"Modified: / 12-10-2006 / 20:51:48 / cg"
!
browseResponseToIt
|selector|
selector := self selectedSelectorInCodeViewOrNil.
selector isNil ifTrue:[^ self].
self findResponseTo:selector
!
browseSendersOf
"launch an enterBox for selector to search for"
^ self
askForMethodAndSpawnSearchTitle:'Selector to browse senders of:\(TAB for completion; matchPattern allowed)'
browserLabel:'Senders of %1'
searchWith:#( #'findSendersOf:in:ignoreCase:match:' #'findSendersOf:inMethods:ignoreCase:match:' )
searchWhat:#selector
searchArea:#everywhere
withCaseIgnore:true
withTextEntry:true
withMethodList:true
setSearchPattern:[:brwsr :selector :ignoreCase :doMatch|
brwsr autoSearchSelector:selector ignoreCase:ignoreCase doMatch:doMatch.
]
"Modified: / 17.11.2001 / 09:51:00 / cg"
!
browseSendersOfAny
|selectors|
selectors := self selectedMethods value collect:[:each | each selector].
false ifTrue:[
self autoSearchSelector:selectors ignoreCase:false doMatch:true.
].
^ self
askForMethodAndSpawnSearchTitle:'Browse Senders of (any in selected):'
browserLabel:('Senders (any of %1 selectors)' bindWith:selectors size)
searchWith:[:ignoredString :classes :ignoredCase :match|
self class
findSendersOfAny:selectors
in:classes
ignoreCase:false
]
searchWhat:#selector
searchArea:#everywhere
withCaseIgnore:false
withTextEntry:false
withMethodList:false
setSearchPattern:[:brwsr :string :ignoreCase :doMatch|
brwsr autoSearchSelector:selectors ignoreCase:ignoreCase doMatch:doMatch.
]
"Modified: / 13.11.2001 / 11:18:02 / cg"
!
defaultSearchArea
"return a useful default seach area"
self hasClassSelected ifTrue:[
^ #classes.
].
self hasCategorySelected ifTrue:[
^ #classCategories.
].
self hasNameSpaceSelected ifTrue:[
^ #currentNameSpace.
].
^ nil
!
findClassesWithoutClassMethod:selector
|classes|
classes := IdentitySet new.
Smalltalk allClassesDo:[:eachClass |
(eachClass isMeta not
and:[eachClass isLoaded
and:[eachClass isNameSpace not
and:[(eachClass class includesSelector:selector) not]]])
ifTrue:[
classes add:eachClass
].
].
^ classes asOrderedCollection
!
spawnClassDocumentationBrowserIn:where
"browse documentation;
where is: #newBrowser - open a new browser
where is: #newBuffer - add a new buffer"
|selectedClasses selectedCategories|
selectedClasses := self selectedNonMetaclasses.
selectedCategories := self selectedCategoriesValue copy.
^ self
newBrowserOrBufferDependingOn:where
label:nil
forSpec:#classDocumentationBrowserSpec
setupWith:[:brwsr |
brwsr selectCategories:selectedCategories.
brwsr selectClasses:selectedClasses.
]
"Modified: / 12-09-2006 / 13:44:08 / cg"
!
spawnClassExtensionBrowserFor:classes in:where
"browse extensions on selected classes;
where is: #newBrowser - open a new browser showing the projects
where is: #newBuffer - add a new buffer showing the projects"
|spec classList "singleSelection"|
spec := #multipleClassExtensionBrowserSpec.
"/ (singleSelection := projects size == 1) ifTrue:[
"/ spec := #singleProjectBrowserSpec.
"/ spec := #singleProjectFullBrowserSpec.
"/ ] ifFalse:[
"/ spec := #multipleProjectBrowserSpec.
"/ ].
classList := classes copy.
^ self
newBrowserOrBufferDependingOn:where
label: 'Class Extensions'
forSpec:spec
setupWith:[:brwsr |
|packageListGeneratorBlock|
"/ setup for a constant list ...
"/ brwsr organizerMode value:#project.
brwsr showClassPackages value:true.
brwsr classListGenerator value:classList.
packageListGeneratorBlock := [
|packages|
packages := Set new.
(brwsr selectedClasses value ? #()) do:[:eachClass |
packages add:eachClass package.
eachClass instAndClassSelectorsAndMethodsDo:[:sel :mthd |
packages add:mthd package
].
].
packages asOrderedCollection sort.
].
brwsr projectListGenerator value:(packageListGeneratorBlock value).
brwsr selectedClasses onChangeEvaluate:[brwsr projectListGenerator value:(packageListGeneratorBlock value).].
brwsr packageFilter value:#().
"/ singleSelection ifTrue:[
"/ brwsr selectProjects:projectList.
"/ ].
"/ brwsr packageFilter value:projectList.
]
"Modified: / 18.8.2000 / 18:48:40 / cg"
!
spawnClassExtensionBrowserForSearch:searchBlock label:labelOrNil in:where
"browse extensions on a searchBlock;
where is: #newBrowser - open a new browser showing the projects
where is: #newBuffer - add a new buffer showing the projects"
^ self
newBrowserOrBufferDependingOn:where
label:(labelOrNil ? 'Class Extensions')
forSpec:#multipleClassExtensionBrowserSpec
setupWith:[:brwsr |
|classListGenerator packageListGeneratorBlock theClassList|
classListGenerator := Iterator on:[:whatToDo |
theClassList isNil ifTrue:[
theClassList := searchBlock value.
].
theClassList notNil ifTrue:[
theClassList do:[:aClass |
whatToDo value:aClass
].
theClassList := nil.
].
].
"/ brwsr organizerMode value:#project.
brwsr showClassPackages value:true.
brwsr classListGenerator value:classListGenerator.
packageListGeneratorBlock := [
|packages|
packages := Set new.
(brwsr selectedClasses value ? #()) do:[:eachClass |
packages add:eachClass package.
eachClass instAndClassSelectorsAndMethodsDo:[:sel :mthd |
packages add:mthd package
].
].
packages asOrderedCollection sort.
].
brwsr projectListGenerator value:(packageListGeneratorBlock value).
brwsr selectedClasses onChangeEvaluate:[brwsr projectListGenerator value:(packageListGeneratorBlock value).].
brwsr packageFilter value:#().
]
"Modified: / 18.8.2000 / 18:48:40 / cg"
!
spawnFullClassSourceBrowserIn:where
"browse full classes (file-like);
where is: #newBrowser - open a new browser
where is: #newBuffer - add a new buffer"
|selectedClasses selectedCategories|
selectedClasses := self selectedNonMetaclasses.
selectedCategories := self selectedCategoriesValue copy.
^ self
newBrowserOrBufferDependingOn:where
label:nil
forSpec:#fullClassSourceBrowserSpec
setupWith:[:brwsr |
brwsr meta value:false.
brwsr selectCategories:selectedCategories.
brwsr selectClasses:selectedClasses.
]
"Modified: / 12-09-2006 / 13:43:48 / cg"
!
viewMenuSelectAllClasses
! !
!NewSystemBrowser methodsFor:'menu actions-buffers'!
bufferMenuCreateBuffer
"add a new buffer"
self createBufferForCurrentClassOrSelectionInCodeView.
!
bufferMenuRemoveAllButBuffer:bNrToLeaveOpen
"remove all other than the numbered buffer"
buffers size to:1 by:-1 do:[:bNrToClose |
bNrToClose ~~ bNrToLeaveOpen ifTrue:[
(self
askIfModified:'Code was modified.\\Remove buffer anyway ?'
in:(buffers at:bNrToClose))
ifTrue:[
self removeBuffer:bNrToClose.
].
].
].
"Modified: / 11.2.2000 / 10:55:02 / cg"
!
bufferMenuRemoveBuffer:nr
"remove the numbered buffer"
buffers size > 0 ifTrue:[
(self
askIfModified:'Code was modified.\\Remove buffer anyway ?'
in:(buffers at:nr)
)
ifTrue:[
self removeBuffer:nr.
].
]
"Modified: / 11.2.2000 / 10:55:02 / cg"
!
bufferMenuRemoveCurrentBuffer
"remove the current buffer"
self bufferMenuRemoveBuffer:(selectedBuffer value)
!
bufferSelectionChanged
"switch buffers"
|nr|
nr := selectedBuffer value.
(nr notNil and:[nr between:1 and:buffers size]) ifTrue:[
navigationState := buffers at:selectedBuffer value.
self browserCanvas value:(navigationState canvas)
].
"/ force update of the menus orgMode aspect
"/ required since the menu has a single orgMode aspect,
"/ (i.e. there is no per-canvas menu).
self organizerModeForMenu changed.
navigationState codeModifiedHolder addDependent:self.
bufferUsageOrder removeIdentical:navigationState ifAbsent:nil.
bufferUsageOrder addFirst:navigationState.
"Modified: / 24.2.2000 / 18:52:16 / cg"
!
createBuffer
^ self createBufferWithSpec:#fullBrowserSpec
!
createBufferForCurrentClassOrSelectionInCodeView
|navigationState cls|
cls := self selectedClassNameInCodeViewOrNil.
navigationState := self createBuffer.
cls notNil ifTrue:[
self switchToClass:cls
]
!
createBufferWithSpec:aSpec
|nr bNameList oldNavigationState|
bNameList := self bufferNameList. "/ for lazy setup
buffers size == 0 ifTrue:[
"the original (initial) buffer is created here (lazy)"
buffers := OrderedCollection new.
bufferUsageOrder := OrderedCollection new.
navigationState canvasType isNil ifTrue:[
navigationState canvas:self browserCanvas value.
navigationState canvasType:(self browserCanvasType ? navigationState canvasType).
].
buffers add:navigationState.
bNameList add:(self currentBufferLabel).
bufferUsageOrder add:navigationState.
].
oldNavigationState := navigationState.
navigationState := NavigationState new.
navigationState canvasType:aSpec.
self setupNavigationStateFrom:oldNavigationState.
navigationState canvas:(self newCanvasWithSpec:aSpec).
buffers add:navigationState.
bNameList add:'no class'.
bufferUsageOrder addFirst:navigationState.
nr := buffers size.
self selectedBuffer value:nr.
^ navigationState.
"Modified: / 29-09-2006 / 22:26:19 / cg"
!
destroyTab:tabIndex
self bufferMenuRemoveBuffer:tabIndex
!
spawnFullBrowserInClass:aClass selector:selector in:openHow
|brwsr|
openHow == #newBrowser ifTrue:[
brwsr := self class openInClass:aClass selector:selector
] ifFalse:[
brwsr := self.
brwsr createBuffer.
brwsr selectedCategories value:nil. "/ kludge workaround; classList needs a change to update.
brwsr switchToClass:aClass selector:selector.
].
^ brwsr
"Modified: / 09-10-2006 / 12:03:24 / cg"
! !
!NewSystemBrowser methodsFor:'menu actions-category'!
categoryMenuCheckInEach
"check a class into the source repository"
|classes|
(self askIfModified:'Code was modified.\\CheckIn (without that modification) anyway ?')
ifFalse:[^ self].
classes := IdentitySet new.
self selectedCategoryClassesDo:[:aClass | classes add:aClass].
classes isEmpty ifTrue:[
self warn:'No classes matched (all private classes)'.
^ self.
].
classes := classes asSortedCollection:[:a :b | a name < b name].
SourceCodeManagerUtilities checkinClasses:classes.
self normalLabel.
!
categoryMenuCheckOut
"check-out all classes in the selected category from the source repository.
Individually ask for class revisions.
Offer chance to either overwrite the current version,
or merge-in the repository version.
"
self checkOutClasses:(self selectedCategoryClasses) askForRevision:true
!
categoryMenuCheckOutNewest
"check-out the newest version of all classes in the selected category
from the source repository.
Offer chance to either overwrite the current version,
or merge-in the repository version.
"
|classes |
classes := self selectedCategoryClasses.
classes := classes reject:[:each | each isPrivate].
self checkOutClasses:classes askForRevision:false
"Modified: / 11-07-2010 / 16:43:59 / cg"
!
categoryMenuCleanUpChangeSet
"remove all changes for the selected category-class(es) from the changeSet"
(self confirm:'This will remove all changes for all classes from the selected categories from the changeSet.\\Really cleanup ?' withCRs)
ifFalse:[ ^ self].
self withWaitCursorDo:[
self selectedCategoryClassesDo:[:eachClass |
ChangeSet current condenseChangesForClass:eachClass
].
]
"Created: / 31-01-2011 / 11:10:13 / cg"
!
categoryMenuFileOutAs
"fileOut selected categories - standard format"
^ self categoryMenuFileOutAsWithFormat:nil
!
categoryMenuFileOutAsWithFormat:aFormatSymbolOrNil
"fileOut selected categories - file format as specified by the argument:
nil - standard format
#xml - XML standard format
#sif - SIF (smalltalk interchange file) standard format
#binary - ST/X binary format
"
|currentClassCategory fileName suffix saveName aStream classesToInitialize classesToFileout mgr|
currentClassCategory := self theSingleSelectedCategory.
currentClassCategory notNil ifTrue:[
fileName := currentClassCategory asString.
fileName replaceAll:Character space with:$_.
] ifFalse:[
fileName := 'someCategories'
].
aFormatSymbolOrNil == #xml ifTrue:[
suffix := '.xml'
] ifFalse:[
aFormatSymbolOrNil == #sif ifTrue:[
suffix := '.sif'
] ifFalse:[
aFormatSymbolOrNil == #binary ifTrue:[
suffix := '.cls'
] ifFalse:[
suffix := '.st'
]
]
].
fileName := fileName , suffix.
aFormatSymbolOrNil == #binary ifTrue:[
self error:'binary must go into separate files'.
^ self
].
saveName := self
fileNameDialogForFileOut:(resources string:'FileOut %1 as:' with:(currentClassCategory ? 'selected categories'))
default:fileName.
saveName isNil ifTrue:[
^ self
].
saveName isEmpty ifTrue:[
self warn:'Bad name given'.
^ self
].
FileSelectionBox lastFileSelectionDirectory:(saveName asFilename directoryName).
fileName := saveName.
classesToInitialize := OrderedCollection new.
classesToFileout := OrderedCollection new.
self selectedCategoryClassesDo:[:eachClassInCategory |
|eachClass|
eachClass := eachClassInCategory theNonMetaclass.
eachClass isPrivate ifFalse:[
eachClass isLoaded ifFalse:[
self warn:'Cannot fileOut unloaded class: %1\\skipped.' with:eachClass name allBold.
] ifTrue:[
classesToFileout add:eachClass.
(eachClass class includesSelector:#initialize) ifTrue:[
classesToInitialize add:eachClass
].
]
]
].
"
if file exists, save original in a .sav file
"
fileName asFilename exists ifTrue:[
self busyLabel:'saving existing %1' with:fileName.
fileName asFilename copyTo:(fileName , '.sav')
].
classesToFileout topologicalSort:[:a :b | b isSubclassOf:a].
aFormatSymbolOrNil == #xml ifTrue:[
self warn:'Not yet implemented: XML saving'.
^ self
].
aFormatSymbolOrNil == #sif ifTrue:[
mgr := SmalltalkInterchangeFileManager newForFileOut.
mgr fileName: fileName.
classesToFileout do:[:eachClass |
mgr addClass: eachClass.
].
self busyLabel:'writing...'.
mgr fileOut.
] ifFalse:[
[
aStream := fileName asFilename newReadWriteStream.
classesToFileout do:[:eachClass |
self busyLabel:'writing: %1' with:eachClass name.
eachClass fileOutOn:aStream withTimeStamp:true withInitialize:false.
aStream cr.
].
"/ all class-inits at the end
"/ (this makes certain, that all classes have been loaded
"/ before possibly used/needed in an initializer
classesToInitialize do:[:aClass |
aClass printClassNameOn:aStream. aStream nextPutAll:' initialize'.
aStream nextPutChunkSeparator.
aStream cr
].
aStream close.
] on:FileStream openErrorSignal do:[
self warn:'Cannot create: %1' with:fileName allBold
].
].
self normalLabel.
!
categoryMenuFileOutEachBinaryIn
"fileOut selected categories as individual files - binary format"
self categoryMenuFileOutEachInWithFormat:#binary
!
categoryMenuFileOutEachIn
"fileOut selected categories as individual files - st-source format"
self categoryMenuFileOutEachInWithFormat:nil
!
categoryMenuFileOutEachInWithFormat:aFormatSymbolOrNil
"fileOut selected categories as individual files"
|currentCategory dirName|
currentCategory := self theSingleSelectedCategory ? 'selected categories'.
dirName := self
askForDirectoryToFileOut:(resources string:'FileOut %1 in:' with:currentCategory)
default:nil.
dirName isEmptyOrNil ifTrue:[^ self].
self
fileOutEachClassIn:(self selectedCategoryClasses)
in:dirName
withFormat:aFormatSymbolOrNil.
"Modified: / 23-08-2006 / 12:31:28 / cg"
!
categoryMenuFileOutEachSIFIn
"fileOut selected categories as individual files - sif format"
self categoryMenuFileOutEachInWithFormat:#sif
!
categoryMenuFileOutEachXMLIn
"fileOut selected categories as individual files - xml format"
self categoryMenuFileOutEachInWithFormat:#xml
!
categoryMenuFileOutSIFAs
"fileOut selected categories - sif format"
^ self categoryMenuFileOutAsWithFormat:#sif
!
categoryMenuFileOutXMLAs
"fileOut selected categories - xml format"
^ self categoryMenuFileOutAsWithFormat:#xml
!
categoryMenuLoad
"load autoloaded classes in the selected categories.
Invoked on doubleClick on a class or via the menu"
self loadClasses:self selectedCategoryClasses value.
"/ to force update.
"/ (I guess, this is not needed)
self selectedCategories changed.
"/ self selectedCategories value:(self selectedCategories value copy).
!
categoryMenuNewCategory
|box newCategory allClassCategories|
allClassCategories := Smalltalk allClassCategories.
box := self
enterBoxTitle:'Name of new class category:'
okText:'Create'
label:'Create Category'.
(allClassCategories includes:'* as yet unspecified *')
ifFalse:[
box initialAnswer:'* as yet unspecified *'.
].
box entryCompletionBlock:[:contents |
|s what cat|
s := contents withoutSpaces.
what := self navigationState environment classCategoryCompletion:s.
cat := what first.
(allClassCategories includes:cat) ifTrue:[
cat := cat , '-'.
].
box contents:cat.
(what at:2) size ~~ 1 ifTrue:[
self builder window beep
]
].
box action:[:aString | newCategory := aString].
box open.
newCategory notNil ifTrue:[
"/ self immediateUpdate value:true.
self categoryListApp addAdditionalCategory:newCategory.
"/ self immediateUpdate value:false.
self codeReallyModified ifFalse:[
self selectCategory:newCategory.
]
].
"Modified: / 25.2.2000 / 00:50:48 / cg"
!
categoryMenuRemove
|box txt answer selectedCategories classes count categories includesBuiltIn
affectedSubClasses classesToReallyRemove|
selectedCategories := self selectedCategoriesValue asSet.
classes := IdentitySet new.
categories := Set new.
includesBuiltIn := false.
self selectedCategoryClassesDo:[:aClass |
classes add:aClass.
categories add:aClass category.
aClass isBuiltInClass ifTrue:[includesBuiltIn := true].
].
classes size == 0 ifTrue:[
"/ removing an empty category
self selectedCategories value:#().
self categoryListApp removeAdditionalCategories:selectedCategories.
^ self
].
"/ count affected sub-classes
affectedSubClasses := IdentitySet new.
classes do:[:aClassToRemove |
affectedSubClasses addAll:(aClassToRemove allSubclasses).
].
affectedSubClasses := affectedSubClasses reject:[:eachClass | classes includes:eachClass ].
count := affectedSubClasses size.
classes size == 1 ifTrue:[
txt := 'Really remove %1'.
] ifFalse:[
txt := 'Really remove %2 classes'.
].
count ~~ 0 ifTrue:[
txt := txt , '\(with %3 subclass'.
count ~~ 1 ifTrue:[
txt := txt , 'es in other categories)'
] ifFalse:[
txt := txt , ' - ', affectedSubClasses first name , ' - in category ''' , affectedSubClasses first category, ''')'
]
].
categories size > 1 ifTrue:[
txt := txt , ' in %4 categories'.
] ifFalse:[
txt := txt , ' in %5'.
].
txt := txt , ' ?'.
txt := (resources
string:txt
with:classes first name allBold
with:classes size printString
with:count
with:categories size printString
with:categories first) withCRs.
box := YesNoBox
title:txt
yesText:(resources string:'Remove')
noText:(resources string:'Cancel').
box label:(resources string:'Remove Class(es)').
answer := box confirm.
box destroy.
(answer and:[includesBuiltIn]) ifTrue:[
"/ ask again - severe damage is to be expected ...
answer := Dialog confirm:('The set of classes to remove includes at least one systemClass,\without which ST/X will fail to work.\Be prepared for a crash, if you proceed.\\Really remove ?' withCRs)
].
answer ifTrue:[
self withWaitCursorDo:[
classesToReallyRemove := OrderedCollection new.
"after querying user - do really remove the classes
and all subclasses
"
classes do:[:aClassToRemove |
|doRemove didRemove|
didRemove := false.
doRemove := true.
aClassToRemove withAllSubclasses do:[:eachClass |
eachClass hasExtensions ifTrue:[
doRemove := self confirm:(resources string:'''%1'' has extensions (methods in other packages) - remove anyway ?' with:eachClass name).
]
].
doRemove ifTrue:[
"
query ?
"
aClassToRemove allSubclassesDo:[:aSubClass |
(CheckForInstancesWhenRemovingClasses == false
or:[aSubClass hasInstances not
or:[self confirm:(resources string:'''%1'' has instances - remove anyway ?' with:aSubClass name)]])
ifTrue:[
classesToReallyRemove add:aSubClass
]
].
(CheckForInstancesWhenRemovingClasses == false
or:[aClassToRemove hasInstances not
or:[self confirm:(resources string:'''%1'' has instances - remove anyway ?' with:aClassToRemove name)]])
ifTrue:[
didRemove := true.
classesToReallyRemove add:aClassToRemove
].
].
].
"/ classesToReallyRemove do:[:each |
"/ each removeFromSystem.
"/ ].
classesToReallyRemove notEmpty ifTrue:[
self removeClasses:classesToReallyRemove pullUpSubclasses:false
]
].
]
"Modified: / 11-07-2010 / 16:44:24 / cg"
!
categoryMenuRename
|categoriesToRename allCategories newCategory box
cancelAll guess combosList change numClasses|
self canUseRefactoringSupport ifTrue:[
change := CompositeRefactoryChange named:'Rename categories'.
].
numClasses := 0.
self withWaitCursorDo:[
categoriesToRename := self selectedCategoriesValue copy.
categoriesToRename do:[:eachCategory |
guess := DoWhatIMeanSupport
goodRenameDefaultFor:eachCategory
lastOld:LastCategoryRenameOld
lastNew:LastCategoryRenameNew.
guess isNil ifTrue:[
guess := eachCategory string.
].
allCategories := Smalltalk allClassCategories asArray sort.
combosList := LastCategoryRenames.
(combosList size > 0 and:[combosList includes:eachCategory]) ifFalse:[
combosList size == 0 ifTrue:[
combosList := List with:eachCategory
] ifFalse:[
combosList := (List with:eachCategory with:'-') , combosList
]
].
box := ListSelectionBox new.
box title:(resources string:'Rename category ''%1'' to:' with:eachCategory allBold).
box useComboBoxWithList:combosList.
box list:allCategories.
box okAction:[:sel | newCategory := sel].
box initialText:guess.
cancelAll := false.
categoriesToRename size > 1 ifTrue:[
|cancelAllButton|
cancelAllButton := Button label:(resources string:'Cancel All').
box addButton:cancelAllButton before:box cancelButton.
cancelAllButton action:[
cancelAll := true.
box doAccept.
box okPressed.
].
].
box label:(resources string:'Rename ClassCategory').
box showAtPointer.
cancelAll ifTrue:[^ self].
newCategory notNil ifTrue:[
newCategory := newCategory withoutSeparators asSymbol.
LastCategoryRenames isNil ifTrue:[
LastCategoryRenames := OrderedCollection new
].
LastCategoryRenames addFirst:newCategory.
LastCategoryRenames size > 20 ifTrue:[
LastCategoryRenames removeLast
].
LastCategoryRenameOld := eachCategory.
LastCategoryRenameNew := newCategory.
(self selectedClassesInCategories:(Array with:eachCategory)) do:[:aClass |
"/ must be loaded ...
aClass autoload
].
(self selectedClassesInCategories:(Array with:eachCategory)) do:[:aClass |
aClass category ~= newCategory ifTrue:[
numClasses := numClasses + 1.
change notNil ifTrue:[
change changeClassCategoryOf:aClass to:newCategory
] ifFalse:[
aClass category:newCategory.
].
]
].
self selectedCategories value:(Array with:newCategory).
].
].
].
change notNil ifTrue:[
numClasses > 0 ifTrue:[
change name:('Rename category of %1 classes' bindWith:numClasses).
RefactoryChangeManager performChange:change
]
].
"Modified: / 06-02-2007 / 10:31:45 / cg"
!
categoryMenuRepositoryHistory
self repositoryHistoryForProjects:nil
"Modified: / 12-09-2006 / 15:03:50 / cg"
!
categoryMenuSpawnBrowser
"open a browser showing the selected categories only"
self spawnCategoryBrowserIn:#newBrowser
"Created: / 18.8.2000 / 19:06:22 / cg"
!
categoryMenuSpawnBuffer
"add a buffer showing the selected categories only"
self spawnCategoryBrowserIn:#newBuffer
!
categoryMenuSpawnMatchingCategoriesBrowser
"open a new browser showing all classes in macthing categories"
^ self categoryMenuSpawnMatchingCategoryIn:#newBrowser
!
categoryMenuSpawnMatchingCategoriesBuffer
"add a buffer showing all classes in macthing categories"
^ self categoryMenuSpawnMatchingCategoryIn:#newBuffer
!
categoryMenuSpawnMatchingCategoryIn:openHow
"add a buffer/ open a new browser showing all classes in matching categories"
|pattern matchingCategories|
pattern := Dialog request:'Match pattern for categories:' initialAnswer:(self theSingleSelectedCategory ? '').
pattern size == 0 ifTrue:[^ self].
pattern := pattern string.
matchingCategories := Set new.
Smalltalk allClassesAndMetaclassesDo:[:eachClass |
|cat|
cat := eachClass category.
(pattern match:cat) ifTrue:[
matchingCategories add:cat.
]
].
^ self spawnCategoryBrowserFor:matchingCategories in:openHow
!
categoryMenuUnload
"load autoloaded classes in the selected categories.
Invoked on doubleClick on a class or via the menu"
self unloadClasses:self selectedCategoryClasses value.
"/ to force update.
"/ (I guess, this is not needed)
self selectedCategories changed.
"/ self selectedCategories value:(self selectedCategories value copy).
!
categoryMenuUpdate
self categoryListApp removeAllAdditionalCategories; forceUpdateList
!
fileNameDialogForFileOut:tite default:defaultFileName
^ self fileNameDialogForFileOut:tite default:defaultFileName withCancelAll:nil
!
fileNameDialogForFileOut:tite default:defaultFileName withCancelAll:cancelAllActionOrNil
|currentClassCategory saveName fileBox
defaultDir cancelAllButton|
defaultDir := FileSelectionBox lastFileSelectionDirectory.
defaultDir isNil ifTrue:[
"
this test allows a smalltalk to be built without Projects/ChangeSets
"
Project notNil ifTrue:[
defaultDir := Project currentProjectDirectory asFilename
].
defaultDir isNil ifTrue:[
defaultDir := Filename currentDirectory
]
].
currentClassCategory := self theSingleSelectedCategory.
UserPreferences current useNewFileDialog ifTrue:[
saveName := Dialog
requestFileName:(resources string:'FileOut %1 as:' with:(currentClassCategory ? 'selected categories'))
default:defaultFileName
ok:(resources string:'FileOut')
abort:(resources string:'Cancel')
pattern:nil
fromDirectory:defaultDir.
saveName isEmptyOrNil ifTrue:[
saveName := nil
].
] ifFalse:[
fileBox := FileSelectionBox
title:(resources string:'FileOut %1 as:' with:(currentClassCategory ? 'selected categories'))
okText:(resources string:'FileOut')
abortText:(resources string:'Cancel')
action:[:fileName | saveName := fileName.].
fileBox initialText:defaultFileName.
fileBox directory:defaultDir.
cancelAllActionOrNil notNil ifTrue:[
cancelAllButton := Button label:(resources string:'Cancel All').
fileBox addButton:cancelAllButton before:fileBox cancelButton.
cancelAllButton action:[
cancelAllActionOrNil value.
fileBox doAccept.
fileBox okPressed.
].
].
fileBox showAtPointer.
fileBox destroy.
fileBox := nil.
].
^ saveName
!
fileOutEachClassIn:aCollectionOfClasses in:aDirectory withFormat:aFormatSymbolOrNil
"fileOut a bunch of classes as individual files into some directory"
|savedClasses privateClasses owningClasses unsavedOwners answer|
privateClasses := aCollectionOfClasses select:[:eachClass | eachClass isPrivate].
savedClasses := (aCollectionOfClasses select:[:eachClass | eachClass isPrivate not]) asIdentitySet.
owningClasses := (privateClasses collect:[:eachPrivateClass | eachPrivateClass topOwningClass]) asIdentitySet.
unsavedOwners := owningClasses copy.
unsavedOwners removeAllFoundIn:savedClasses.
unsavedOwners notEmpty ifTrue:[
answer := self confirmWithCancel:'Private classes are saved with their owningClasses;\\Save owners as well ?' withCRs.
answer isNil ifTrue:[^ self].
answer == true ifTrue:[
savedClasses addAll:unsavedOwners
]
].
savedClasses do:[:eachClass |
|fn answer|
eachClass isPrivate ifFalse:[
self busyLabel:'saving: %1' with:eachClass name.
Class fileOutErrorSignal handle:[:ex |
answer := DialogBox
confirm:(resources string:'Cannot fileOut: %1\(%2)\\skipped.'
with:(eachClass name allBold)
with:ex description) withCRs
yesLabel:'ok' noLabel:'cancel'.
answer == false ifTrue:[
^ self
].
self normalLabel.
ex return.
] do:[
fn := (Smalltalk fileNameForClass:eachClass) , '.st'.
eachClass fileOutAs:(aDirectory asFilename constructString:fn).
]
]
].
self normalLabel.
"Modified: / 06-10-2006 / 16:17:56 / cg"
!
spawnCategoryBrowserFor:categories in:where
"browse selected category(ies);
where is: #newBrowser - open a new browser showing the categories
where is: #newBuffer - add a new buffer showing the categories"
|spec categoryList selectedClasses selectedProtocols selectedMethods
singleSelection|
(singleSelection := categories size == 1) ifTrue:[
spec := #singleCategoryBrowserSpec.
] ifFalse:[
spec := #multipleCategoryBrowserSpec.
].
categoryList := categories copy.
selectedClasses := self selectedClasses value copy.
selectedProtocols := self selectedProtocols value copy.
selectedMethods := self selectedMethods value copy.
self
newBrowserOrBufferDependingOn:where
label:nil
forSpec:spec
setupWith:[:brwsr |
|allMeta|
"/ setup for a constant list ...
brwsr immediateUpdate value:true.
brwsr categoryListGenerator value:categoryList.
brwsr selectCategories:categoryList.
selectedClasses notNil ifTrue:[
allMeta := selectedClasses conform:[:aClass | aClass isMeta].
allMeta ifTrue:[
brwsr meta value:true.
]
].
selectedClasses size > 0 ifTrue:[brwsr selectClasses:selectedClasses].
selectedProtocols size > 0 ifTrue:[brwsr selectProtocols:selectedProtocols].
selectedMethods size > 0 ifTrue:[brwsr selectMethods:selectedMethods].
brwsr immediateUpdate value:false.
]
"Modified: / 13-10-2006 / 11:55:53 / cg"
!
spawnCategoryBrowserIn:where
"browse selected category(ies);
where is: #newBrowser - open a new browser showing the categories
where is: #newBuffer - add a new buffer showing the categories"
self spawnCategoryBrowserFor:(self selectedCategoriesValue) in:where
! !
!NewSystemBrowser methodsFor:'menu actions-checks'!
classMenuCheck
"perform all checks on the selected class(es)."
self classMenuCheck:#allChecks
!
classMenuCheck:whichCheck
"perform an individual check on the selected class(es)."
self classMenuCheckEach:(Array with:whichCheck)
"Modified: / 18.8.2000 / 22:44:19 / cg"
!
classMenuCheckAll
"perform all checks on the selected class(es)."
self classMenuCheck:#allChecks
!
classMenuCheckEach:aCollectionOfCheckSymbols
"perform a bunch of checks on the selected class(es)."
|classes theSingleClass lbl badMethodsGenerator badMethodInfoHolder badClassInfoHolder|
classes := self selectedClasses value ? #().
(theSingleClass := self theSingleSelectedClass) notNil ifTrue:[
lbl := 'Check results of ' , theSingleClass name
] ifFalse:[
lbl := 'Checker result'
].
badMethodInfoHolder := ValueHolder new.
badClassInfoHolder := ValueHolder new.
badMethodsGenerator := [
|checker badMethodInfo badClassInfo badMethods|
checker := ClassChecker new.
self withWaitCursorDo:[
classes do:[:eachClass |
|cls|
cls := eachClass theNonMetaclass.
cls isLoaded ifTrue:[
self activityNotification:('checking ' , cls name , '...').
checker checkedClass:cls.
aCollectionOfCheckSymbols do:[:eachCheck |
checker doCheck:eachCheck
]
]
].
].
badClassInfo := checker badClassInfo.
badMethodInfo := checker badMethodInfo.
(badMethodInfo isEmptyOrNil and:[ badClassInfo isEmptyOrNil ]) ifTrue:[
"/ self information:'Nothing special found'.
badClassInfoHolder value:nil.
badMethodInfoHolder value:nil.
#().
] ifFalse:[
badClassInfoHolder value:badClassInfo.
badMethodInfoHolder value:badMethodInfo.
badMethodInfo size > 0 ifTrue:[
badMethods := badMethodInfo keys.
] ifFalse:[
badMethods := #()
].
badMethods
].
].
self
spawnMethodBrowserFor:badMethodsGenerator
in:#newBuffer
label:lbl
perClassInfo:badClassInfoHolder
perMethodInfo:badMethodInfoHolder
sortBy:#class
"Created: / 18-08-2000 / 22:43:56 / cg"
"Modified: / 18-05-2010 / 15:13:52 / cg"
!
classMenuCheckErrors
"perform error-checks on the selected class(es)."
self classMenuCheck:#errorChecks
!
classMenuCheckIndividual
"allow individual checks to be selected and perform those on the selected class(es)."
|allChecks selectedChecks|
allChecks := ClassChecker individualChecks.
selectedChecks := List new.
LastIndividualChecks notNil ifTrue:[
selectedChecks addAll:LastIndividualChecks
].
selectedChecks := Dialog
chooseMultiple:'Select check(s) to perform on selected classes\(toggle items using CTRL-click)\' withCRs
fromList:allChecks values:allChecks
initialSelection:selectedChecks
lines:10.
selectedChecks isNil ifTrue:[^ self].
LastIndividualChecks := selectedChecks.
self classMenuCheckEach:selectedChecks.
"Modified: / 18.8.2000 / 22:44:36 / cg"
!
classMenuCheckStyle
"perform style-checks on the selected class(es)."
self classMenuCheck:#styleChecks
!
classMenuCheckWarnings
"perform warning-checks on the selected class(es)."
self classMenuCheck:#warningChecks
! !
!NewSystemBrowser methodsFor:'menu actions-class'!
addClassesToRemoveForClass:aClass to:classesToRemove removingSubclasses:removingSubclasses withCancel:withCancel
self
addClassesToRemoveForClass:aClass
to:classesToRemove
removingSubclasses:removingSubclasses
withCancel:withCancel
withConfirm:true
!
addClassesToRemoveForClass:aClass to:classesToRemove removingSubclasses:removingSubclasses withCancel:withCancel withConfirm:withConfirm
|countSubClasses countPrivateClasses t confirmed didRemove includesBuiltIn
answer toRemove stillSearchingForMore more|
(classesToRemove includes:aClass) ifTrue:[
"/ already in list
^ self
].
aClass wasAutoloaded ifTrue:[
answer := self
confirmWithCancel:(resources
string:'%1 was autoloaded.\\Reinstall as autoloaded ?'
with:aClass name allBold) withCRs.
answer isNil ifTrue:[
^ self
].
answer == true ifTrue:[
self withWaitCursorDo:[
aClass unload.
Smalltalk changed:#classDefinition with:aClass
].
^ self
]
].
countSubClasses := aClass allSubclasses size.
t := 'Remove Class ''%1'''.
countSubClasses ~~ 0 ifTrue:[
removingSubclasses ifTrue:[
t := t , '\(with %2 subclass'.
] ifFalse:[
t := t , '\(and pull up %2 subclass'.
].
countSubClasses ~~ 1 ifTrue:[
t := t , 'es'
]
].
countPrivateClasses := aClass allPrivateClasses size.
countPrivateClasses ~~ 0 ifTrue:[
removingSubclasses ifFalse:[
self warn:('%1 has private classes - please make them public; then try again' bindWith:aClass name allBold).
^ self
].
countSubClasses ~~ 0 ifTrue:[
t := t , ' and'
] ifFalse:[
t := t , '\(with'
].
t := t , ' %3 private class'.
countPrivateClasses ~~ 1 ifTrue:[
t := t , 'es'
]
].
(countSubClasses ~~ 0 or:[countPrivateClasses ~~ 0]) ifTrue:[
t := t , ')'
].
t := t , ' ?'.
t := (resources
string:t
with:aClass name allBold
with:countSubClasses
with:countPrivateClasses) withCRs.
YesToAllConfirmation query ifTrue:[
] ifFalse:[
(countSubClasses ~~ 0 or:[countPrivateClasses ~~ 0 or:[withConfirm]]) ifTrue:[
withCancel ifTrue:[
confirmed := OptionBox
request:t
label:(resources string:'Remove Class')
image:(YesNoBox iconBitmap)
buttonLabels:(resources array:#('Cancel' 'No' 'Yes' 'Yes to All'))
values:#(nil false true #yesToAll)
default:false
onCancel:false.
"/ confirmed := Dialog confirmWithCancel:t default:false
] ifFalse:[
confirmed := Dialog confirm:t
].
confirmed isNil ifTrue:[
"/ cancelled
AbortOperationRequest raise
].
confirmed == #yesToAll ifTrue:[
YesToAllConfirmation notify.
confirmed := true.
].
confirmed ifFalse:[
^ self
]
].
].
didRemove := false.
includesBuiltIn := aClass isBuiltInClass.
aClass allSubclassesDo:[:aSubClass |
includesBuiltIn := includesBuiltIn or:[aSubClass isBuiltInClass]
].
includesBuiltIn ifTrue:[
"/ ask again - severe damage is to be expected ...
confirmed := Dialog
confirmWithCancel:'The set of classes to remove includes at least one systemClass,\without which ST/X will fail to work.\Be prepared for a crash, if you proceed.\\Really remove ?'
withCRs
default:false.
confirmed isNil ifTrue:[
"/ cancelled
AbortSignal raise
].
confirmed ifFalse:[
^ self
]
].
"/ check if any of the classes to remove has a repository container - warn about this if so
aClass withAllSubclassesDo:[:eachClassToRemove |
eachClassToRemove isPrivate ifFalse:[
eachClassToRemove revision notNil ifTrue:[
(removingSubclasses or:[eachClassToRemove == aClass])
ifTrue:[
confirmed := Dialog
confirmWithCancel:(resources
string:'Remove the source container for ''%1'' in the repository ?\\Warning: can only be undone by manually fixing the CVS repository !!'
with:eachClassToRemove name allBold) withCRs
default:false.
confirmed isNil ifTrue:[
"/ cancelled
AbortSignal raise
].
confirmed ifTrue:[
SourceCodeManagerUtilities
removeSourceContainerForClass:eachClassToRemove
confirm:true
warn:true
]
]
].
]
].
"/ check if any of the classes to be removed from the ProjectDefinition
aClass withAllSubclassesDo:[:eachClassToRemove |
eachClassToRemove isPrivate ifFalse:[
|def|
def := eachClassToRemove projectDefinitionClass.
def notNil and:[
(eachClassToRemove ~~ def
and:[ def allClassNames includes:eachClassToRemove name ]) ifTrue:[
(Dialog confirm:(resources string:'Remove %1 from its Package definition ?'
with:eachClassToRemove name))
ifTrue:[
self excludeClasses: (Array with: eachClassToRemove) fromProject:def using:Compiler.
].
]
]
]
].
toRemove := IdentitySet new.
toRemove addAll:classesToRemove.
removingSubclasses ifTrue:[
aClass allSubclassesDo:[:aSubClass |
(CheckForInstancesWhenRemovingClasses == false or:[
aSubClass hasInstances not or:[
self confirm:(resources string:'''%1'' has instances - remove anyway ?'
with:aSubClass name allBold)
]
]) ifTrue:[
classesToRemove add:aSubClass.
toRemove add:aSubClass
]
].
].
(CheckForInstancesWhenRemovingClasses == false or:[
aClass hasInstances not or:[
self confirm:(resources string:'''%1'' has instances - remove anyway ?'
with:aClass name allBold)
]
]) ifTrue:[
didRemove := true.
aClass allPrivateClassesDo:[:eachPrivate |
classesToRemove addFirst:eachPrivate.
toRemove add:eachPrivate
].
classesToRemove add:aClass.
toRemove add:aClass
].
stillSearchingForMore := true.
[
stillSearchingForMore
] whileTrue:[
stillSearchingForMore := false.
more := IdentitySet new.
classesToRemove do:[:eachClass |
eachClass allPrivateClasses do:[:eachPrivate |
classesToRemove addFirst:eachPrivate.
(toRemove includes:eachPrivate) ifFalse:[
toRemove add:eachPrivate.
more := true
]
]
]
]
"Modified: / 30-08-2007 / 19:01:37 / cg"
!
askForSuperclassToGenerateTestMethod:selector
|newClass newClassName sup initial m
supers list currentClass reqString okLabel title|
"/ provide a reasonable default in the pull-down-list
currentClass := self anySelectedClass.
currentClass isNil ifTrue:[
m := self anySelectedMethod.
currentClass := m mclass.
].
LastMethodMoveOrCopyTargetClass notNil ifTrue:[
initial := Smalltalk classNamed:LastMethodMoveOrCopyTargetClass.
initial notNil ifTrue:[
(currentClass notNil and:[currentClass theNonMetaclass name = initial name]) ifTrue:[
initial := nil
]
].
initial notNil ifTrue:[
currentClass isMeta ifTrue:[
initial := initial theMetaclass
] ifFalse:[
initial := initial theNonMetaclass
].
initial := initial name.
].
].
initial isNil ifTrue:[
(sup := currentClass superclass) notNil ifTrue:[
initial := sup name
] ifFalse:[
initial := nil.
].
].
supers := currentClass allSuperclasses reverse.
currentClass isMeta ifTrue:[
supers := supers select:[:each | each isSubclassOf:Class].
].
supers := supers collect:[:cls | cls name].
list := supers.
self selectedClasses value size > 1 ifTrue:[
reqString := 'Generate isXXX methods in which superclass ?'.
title := 'Generate isXXX methods'.
] ifFalse:[
reqString := 'Generate %1 method in which superclass ?'.
title := 'Generate %1 method'.
].
okLabel := 'Generate'.
newClassName := Dialog
request:(resources stringWithCRs:reqString with:selector)
initialAnswer:(initial ? '')
okLabel:(resources string:okLabel)
title:(resources string:title with:selector)
onCancel:nil
list:list
entryCompletionBlock:(DoWhatIMeanSupport classNameEntryCompletionBlock).
newClassName isNil ifTrue:[^ nil].
(newClassName startsWith:'---- ') ifTrue:[^ nil].
newClass := self classIfValidNonMetaClassName:newClassName.
newClass isNil ifTrue:[
^ nil
].
LastMethodMoveOrCopyTargetClass := newClass theNonMetaclass name.
^ newClass.
"Modified: / 22.12.2001 / 03:04:48 / cg"
!
checkCompilabilityOf:aClass errorsOnly:errorsOnly outputTo:outStream
"check compilability of aClass; write warning and errormessages to outStream.
(meant for a human to read)"
|warningCollector|
warningCollector := TextCollectingCompilationErrorHandler new.
warningCollector collectingStream:outStream.
warningCollector errorsOnly:errorsOnly.
aClass theNonMetaclass withAllPrivateClassesDo:[:eachClass |
eachClass instAndClassSelectorsAndMethodsDo:[:aSelector :aMethod |
Parser warningSignal
handle:[:ex | self halt ]
do:[
eachClass compilerClass
compile:aMethod source
forClass:aMethod mclass
inCategory:'others'
notifying:warningCollector
install:false
skipIfSame:false
silent:false
]
].
].
"Created: / 02-11-2010 / 13:11:17 / cg"
"Modified: / 02-11-2010 / 20:02:53 / cg"
!
checkCompilabilityOfAll:aCollectionOfClasses errorsOnly:errorsOnly
"check compilability of aClass; write warning and errormessages to outStream.
(meant for a human to read)"
|stream|
stream := WriteStream on:(Text new:100).
self checkCompilabilityOfAll:aCollectionOfClasses errorsOnly:errorsOnly outputTo:stream.
^ stream contents.
"Created: / 02-11-2010 / 13:14:47 / cg"
!
checkCompilabilityOfAll:aCollectionOfClasses errorsOnly:errorsOnly outputTo:outStream
"check compilability of aClass; write warning and errormessages to outStream.
(meant for a human to read)"
self
selectedClassesDo:[:eachClass |
self checkCompilabilityOf:eachClass errorsOnly:errorsOnly outputTo:outStream.
].
"Created: / 02-11-2010 / 13:11:47 / cg"
!
classClassDefinitionTemplateFor:aClass in:cat asNamespace:isNameSpace private:isPrivate
"common helper for newClass and newSubclass
- show a template to define a subclass of aClass in category cat.
Also, set acceptaction to install the class."
^ self
classClassDefinitionTemplateFor:aClass in:cat
asNamespace:isNameSpace private:isPrivate metaClassUsed:nil
!
classClassDefinitionTemplateFor:aClass in:cat asNamespace:isNameSpace private:isPrivate metaClassUsed:metaClassUsedOrNil
"common helper for newClass and newSubclass
- show a template to define a subclass of aClass in category cat.
Also, set the accept-action to install the class."
|theSuperClass|
(aClass == Autoload
or:[aClass isNil or:[aClass isLoaded not]]) ifTrue:[
self javaMode ifTrue:[
theSuperClass := Java at:'java.lang.Object'
] ifFalse:[
theSuperClass := Object
]
] ifFalse:[
theSuperClass := aClass
].
"/ self switchToClass:nil.
self showCode:(self
classTemplateFor:theSuperClass
in:cat
asNamespace:isNameSpace
private:isPrivate
metaClassUsed:metaClassUsedOrNil).
self setAcceptActionForMetaClassUsed:metaClassUsedOrNil.
self codeAspect:#newClassDefinition.
"Modified: / 10.12.2001 / 19:55:31 / cg"
!
classListMenuAddClassToList
"for classLists only: allow adding another class to the shown list"
|className class classList|
classList := self classListGenerator value.
self assert:classList isOrderedCollection.
className := self searchMenuFindClassToAdd.
className isNil ifTrue:[^ self].
class := Smalltalk at:className asSymbol ifAbsent:nil.
class isNil ifTrue:[
^ self warn:'No such class'
].
classList add:class.
classList sort:[:a :b | a name < b name].
self classListGenerator changed.
!
classListMenuRemoveClassesFromList
"for classLists only: allow removing class(es) from the shown list"
|classList classesToHide|
classList := self classListGenerator value.
self assert:classList isOrderedCollection.
classesToHide := self selectedClasses value copy.
classesToHide do:[:classToHide |
classList removeIdentical:classToHide
].
classList sort:[:a :b | a name < b name].
self classListGenerator changed.
!
classMenuChangeAspect:aspect
"show a classes comment/hierarchy or definition"
|cls|
(self askIfModified:'Code was modified.\\Show anyway ?')
ifFalse:[^ self].
self selectedMethods value:nil.
self selectProtocols:nil.
"/ kludge - trick lastSelectedProtocol handling in protocol-list
self clearAutoSelectOfLastSelectedProtocol.
cls := self theSingleSelectedClass.
cls notNil ifTrue:[
cls := cls theNonMetaclass
].
aspect == #classComment ifTrue:[
self showClassComment:cls.
^ self
].
aspect == #classHierarchy ifTrue:[
self showClassHierarchy:cls.
^ self
].
aspect == #classDefinition ifTrue:[
self showClassDefinition:cls.
^ self
].
self error:'unknown aspect: ', aspect printString.
"Created: / 8.11.2001 / 23:02:46 / cg"
"Modified: / 8.11.2001 / 23:17:33 / cg"
!
classMenuCheckCompilability
"check compilability of selected classes (kludge - for me)"
|allMessages|
allMessages := self checkCompilabilityOfAll:(self selectedClasses) errorsOnly:false.
allMessages notEmpty ifTrue:[
Dialog warn:allMessages
].
"Created: / 16-11-2006 / 14:53:21 / cg"
"Modified: / 02-11-2010 / 13:15:12 / cg"
!
classMenuChildrenToSiblings
|currentClass name subclasses|
currentClass := self theSingleSelectedLoadedNonMetaclassOrNil.
currentClass isNil ifTrue:[
self warn:'Cannot copy unloaded classes.'.
^ self
].
name := Dialog request:(resources
string:'Enter name for new parent class of "%1" and its subclasses:'
with:currentClass name allBold).
name isEmpty ifTrue: [^self].
subclasses := self selectSubclassesOf:currentClass.
subclasses isNil ifTrue: [^self].
self performRefactoring:
(ChildrenToSiblingsRefactoring name: name
class: currentClass
subclasses: subclasses).
self switchToClassNamed:name.
"/ meta: self isMeta
"/ categories: self categories
"Modified: / 01-03-2007 / 20:48:59 / cg"
!
classMenuCleanUpChangeSet
"remove all changes for the selected class(es) from the changeSet"
(self confirm:'This will remove all changes for the selected class(es) from the changeSet.\\Really cleanup ?' withCRs)
ifFalse:[ ^ self].
self withWaitCursorDo:[
self selectedClassesDo:[:eachClass |
ChangeSet current condenseChangesForClass:eachClass
].
]
!
classMenuComment
"show a classes comment"
self classMenuChangeAspect:#classComment
"Modified: / 8.11.2001 / 23:05:41 / cg"
!
classMenuCompareTwoSelectedClasses
"open a diff-textView comparing the selected class
against some other class (useful when refactoring subclasses)."
|sel class1 class2|
sel := self selectedNonMetaclasses value.
sel size == 2 ifTrue:[
class1 := sel first.
class2 := sel second.
self doCompareClass:class1 withClass:class2
]
"Modified: / 12-09-2006 / 13:52:57 / cg"
!
classMenuCompareWithClass
"open a diff-textView comparing the selected class
against some other class (useful when refactoring subclasses)."
|currentClass supers subs list otherClassName otherClass|
currentClass := self theSingleSelectedLoadedNonMetaclassOrNil.
currentClass isNil ifTrue:[
self warn:'Cannot compare unloaded classes.'.
^ self.
].
supers := (currentClass allSuperclasses reverse collect:[:cls | cls name]).
subs := (currentClass allSubclasses collect:[:cls | cls name]).
list := supers.
(supers notEmpty and:[subs notEmpty]) ifTrue:[
list := list , (Array with:'---- ' , currentClass name , ' ----')
].
list := list , subs.
otherClassName := Dialog
request:(resources string:'Compare this class against which class:')
initialAnswer:''
okLabel:(resources string:'Compare')
title:(resources string:'Compare class')
onCancel:nil
list:list.
otherClassName isNil ifTrue:[^ self].
(otherClassName startsWith:'---- ') ifTrue:[^ self].
otherClass := Smalltalk classNamed:otherClassName.
otherClass isNil ifTrue:[
self warn:'no such class: ', otherClassName.
^ self
].
otherClass := otherClass theNonMetaclass.
self doCompareClass:currentClass withClass:otherClass
"Modified: / 01-03-2007 / 20:49:25 / cg"
!
classMenuCompileLazyMethods
"compile selected classes' lazy methods (kludge - for me)"
self selectedClassesDo:[:eachClass |
eachClass instAndClassSelectorsAndMethodsDo:[:sel :mthd |
mthd isLazyMethod ifTrue:[
mthd makeRealMethod
]
]
].
!
classMenuCopyAs
"create a copy of the selected class."
|currentClass currentClassName owningClass newClassName newOwnerClass ownerName idx
newClass|
currentClass := self theSingleSelectedLoadedNonMetaclassOrNil.
currentClass isNil ifTrue:[
self warn:'Cannot copy unloaded classes.'.
^ self
].
currentClassName := currentClass name.
newClassName := currentClassName.
"/ (nameSpace := currentClass nameSpace) == Smalltalk ifTrue:[
"/ newClassName := 'CopyOf' , currentClassName.
"/ ] ifFalse:[
"/ newClassName := nameSpace name , '::' , 'CopyOf' , currentClass nameWithoutPrefix.
"/ ].
newClassName := Dialog
request:(resources string:'Copy class %1 as:' with:currentClassName allBold)
initialAnswer:newClassName.
(newClassName isEmptyOrNil or:[newClassName withoutSeparators = currentClassName]) ifTrue:[
^ self
].
(Smalltalk classNamed:newClassName) notNil ifTrue:[
(self confirm:(resources string:'A class named: ''%1'' already exists.\\Overwrite ?' with:newClassName) withCRs)
ifFalse:[^ self]
].
(owningClass := currentClass owningClass) notNil ifTrue:[
(newClassName startsWith:(owningClass name , '::')) ifTrue:[
newClassName := newClassName copyFrom:(owningClass name , '::') size + 1.
newOwnerClass := owningClass.
] ifFalse:[
(newClassName includes:$:) ifTrue:[
idx := newClassName lastIndexOf:$:.
ownerName := newClassName copyTo:idx.
[ownerName endsWith:$:] whileTrue:[ownerName := ownerName copyWithoutLast:1].
newClassName := newClassName copyFrom:idx+1.
] ifFalse:[
(self confirm:(resources string:'Copy as public class ''%1'' ?' with:newClassName) withCRs)
ifFalse:[^ self].
]
].
] ifFalse:[
idx := newClassName lastIndexOf:$:.
idx ~~ 0 ifTrue:[
ownerName := newClassName copyTo:idx-2.
newClassName := newClassName copyFrom:idx+1.
].
].
ownerName notNil ifTrue:[
(Smalltalk classNamed:ownerName) isNil ifTrue:[
(Dialog confirm:(resources
stringWithCRs:'No class or nameSpace named: "%1"\\Create as Namespace ?' with:ownerName))
ifFalse:[
^ self
].
newOwnerClass := NameSpace fullName:ownerName.
].
newOwnerClass := Smalltalk at:ownerName asSymbol.
(newOwnerClass == Smalltalk or:[newOwnerClass isNameSpace]) ifTrue:[
newOwnerClass == Smalltalk ifFalse:[
newClassName := ownerName , '::' , newClassName.
].
newOwnerClass := nil.
].
].
self busyLabel:'copying class ...' with:nil.
self withWaitCursorDo:[
newClass := self doCopyClass:currentClass as:newClassName privateIn:newOwnerClass.
].
"Modified: / 01-03-2007 / 20:50:33 / cg"
!
classMenuDefinition
"show a classes definition"
self classMenuChangeAspect:#classDefinition
"Modified: / 8.11.2001 / 23:06:09 / cg"
"Created: / 8.11.2001 / 23:17:00 / cg"
!
classMenuDocumentation
"show classes documentation (i.e. open doc-View on it)"
self
selectedClassesNonMetaDo:
[:cls |
self openClassDocumentationFor:cls
]
ifUnloaded:
[:cls |
true
]
ifPrivate:
[:cls |
]
!
classMenuExcludeFromProject
|projectDefinitionClasses|
projectDefinitionClasses := (self selectedClasses value collect:[:cls | cls projectDefinitionClass]) asSet.
projectDefinitionClasses do:[:eachDefinitionClass |
|toExcludeForThis|
toExcludeForThis := self selectedClasses value select:[:cls | cls projectDefinitionClass == eachDefinitionClass].
self
generateUndoableChange:(resources string:'Exclude %1 class(es) from Project %2' with:toExcludeForThis size with:eachDefinitionClass name)
overClasses:(Array with: eachDefinitionClass)
via:[:generator :projectDefinition |
self excludeClasses:toExcludeForThis fromProject:projectDefinition using:generator
].
].
"Created: / 19-02-2007 / 17:29:12 / cg"
"Modified: / 30-08-2007 / 18:28:10 / cg"
!
classMenuFileOutAs
"fileOut selected classes - standard format"
^ self classMenuFileOutAsWithFormat:nil
!
classMenuFileOutAsWithFormat:aFormatSymbolOrNil
"fileOut selected classes - file format as specified by the argument:
nil - standard format
#xml - XML standard format
#sif - SIF (smalltalk interchange file) standard format
#binary - ST/X binary format
"
|mode|
aFormatSymbolOrNil == #binary ifTrue:[
mode := Dialog choose:(resources string:'Save including sources ?')
labels:(resources array:#('Cancel' 'Discard' 'By file reference' 'Include source'))
values:#(nil #discard #reference #keep)
default:#keep.
mode isNil ifTrue:[^ self]. "/ cancelled
].
self
selectedClassesNonMetaDo:
[:cls |
self
fileOutClass:cls
askForFile:true
withCancelAll:(self selectedClasses value size > 1)
format:aFormatSymbolOrNil
sourceMode:mode.
]
ifUnloaded:
[:cls |
self warn:'Cannot fileOut unloaded class: %1' with:cls name allBold.
false.
]
ifPrivate:
[:cls | |owner|
owner := cls owningClass.
(self selectedClasses value includes:owner) ifFalse:[
self warn:'Cannot fileOut private class: %1\\Please fileOut the owning class (%2).'
with:cls nameWithoutPrefix allBold
with:owner name.
]
]
!
classMenuFileOutBinaryAs
"fileOut selected classes - binary file format"
^ self classMenuFileOutAsWithFormat:#binary
!
classMenuFileOutEachBinaryIn
"fileOut selected classes as individual files - binary format"
self classMenuFileOutEachInWithFormat:#binary
!
classMenuFileOutEachIn
"fileOut selected classes as individual files - st-source format"
self classMenuFileOutEachInWithFormat:nil
!
classMenuFileOutEachInWithFormat:aFormatSymbolOrNil
"fileOut selected classes as individual files"
|classes dirName|
classes := self selectedNonMetaclasses.
classes := classes reject:[:eachClass | eachClass isPrivate].
classes size == 0 ifTrue:[
^ self warn:'Only private classes selected'.
].
dirName := self
askForDirectoryToFileOut:(resources string:'FileOut %1 classes in:' with:classes size)
default:nil.
dirName isNil ifTrue:[^ self].
self
fileOutEachClassIn:classes
in:dirName
withFormat:aFormatSymbolOrNil.
"Modified: / 11-07-2010 / 16:44:33 / cg"
!
classMenuFileOutEachSIFIn
"fileOut selected classes as individual files - sif format"
self classMenuFileOutEachInWithFormat:#sif
!
classMenuFileOutEachXMLIn
"fileOut selected classes as individual files - xml format"
self classMenuFileOutEachInWithFormat:#xml
!
classMenuFileOutIn
"fileOut selected classes - standard format"
^ self classMenuFileOutInWithFormat:nil
!
classMenuFileOutInWithFormat:aFormatSymbolOrNil
"fileOut selected classes - file format as specified by the argument:
nil - standard format
#xml - XML standard format
#sif - SIF (smalltalk interchange file) standard format
#binary - ST/X binary format
"
self fileOutClasses:(self selectedNonMetaclasses) withFormat:aFormatSymbolOrNil
"Modified: / 12-09-2006 / 13:52:17 / cg"
!
classMenuFileOutSIFAs
"fileOut selected classes - smalltalk interchange file format"
^ self classMenuFileOutAsWithFormat:#sif
!
classMenuFileOutXMLAs
"fileOut selected classes - XML file format"
^ self classMenuFileOutAsWithFormat:#xml
!
classMenuGenerateAcceptVisitor
"create a visitor acceptor method"
self
generateUndoableChangeOverSelectedClasses:'Generate Accept-Visitor Method for %(singleClassNameOrNumberOfClasses)'
via:[:generator :eachClass |
generator createAcceptVisitorMethodIn:eachClass theNonMetaclass
].
!
classMenuGenerateAccessMethods
"create access methods for instvars.
If no variable is selected, for all instvars;
otherwise for that selected instvar."
self
classMenuGenerateAccessMethodsWithChange:false
asValueHolder:false
readersOnly:false
writersOnly:false
lazyInitialization:false
!
classMenuGenerateAccessMethodsForValueHolder
"create access methods for instvars as ValueHolder.
If no variable is selected, for all instvars;
otherwise for that selected instvar."
self
classMenuGenerateAccessMethodsWithChange:false
asValueHolder:true
readersOnly:false
writersOnly:false
lazyInitialization:false
!
classMenuGenerateAccessMethodsForValueHolderWithChange
"create access methods for instvars as ValueHolder.
If no variable is selected, for all instvars;
otherwise for that selected instvar."
self
classMenuGenerateAccessMethodsWithChange:true
asValueHolder:true
readersOnly:false
writersOnly:false
lazyInitialization:false
!
classMenuGenerateAccessMethodsWithChange
"create access methods for instvars.
If no variable is selected, for all instvars;
otherwise for that selected instvar."
self
classMenuGenerateAccessMethodsWithChange:true
asValueHolder:false
readersOnly:false
writersOnly:false
lazyInitialization:false
!
classMenuGenerateAccessMethodsWithChange:aBoolean asValueHolder:asValueHolder readersOnly:readersOnly writersOnly:writersOnly
"create access methods for instvars.
If no variable is selected, for all instvars;
otherwise for that selected instvar."
self
classMenuGenerateAccessMethodsWithChange:aBoolean
asValueHolder:asValueHolder
readersOnly:readersOnly
writersOnly:writersOnly
lazyInitialization:false
!
classMenuGenerateAccessMethodsWithChange:aBoolean asValueHolder:asValueHolder readersOnly:readersOnly writersOnly:writersOnly lazyInitialization:lazyInitialization
"create access methods for instvars.
If no variable is selected, for all instvars;
otherwise for that selected instvar."
self
generateUndoableChangeOverSelectedClasses:'Generate Access Methods in %(singleClassNameOrNumberOfClasses)'
via:[:generator :eachClass |
|names|
names := self variableFilter value.
names size == 0 ifTrue:[
names := eachClass instVarNames
].
generator
createAccessMethodsFor:names
in:eachClass
withChange:aBoolean
asValueHolder:asValueHolder
readersOnly:readersOnly
writersOnly:writersOnly
lazyInitialization:lazyInitialization
]
"Modified: / 18.8.1997 / 15:44:10 / cg"
"Created: / 7.8.1998 / 18:17:18 / cg"
!
classMenuGenerateAccessMethodsWithLazyInitialization
"create access methods for instvars with lazy initialization in getters.
If no variable is selected, for all instvars;
otherwise for that selected instvar."
self
classMenuGenerateAccessMethodsWithChange:true
asValueHolder:false
readersOnly:false
writersOnly:false
lazyInitialization:true
!
classMenuGenerateApplicationCode
"create application code methods"
self
generateUndoableChangeOverSelectedClasses:'Generate ApplicationCode in %(singleClassNameOrNumberOfClasses)'
via:[:generator :eachClass |
self classMenuGenerateApplicationCodeFor:(eachClass theNonMetaclass) using:generator
]
!
classMenuGenerateApplicationCodeFor:cls using:generator
"create application code methods"
(cls isSubclassOf:WebApplicationModel) ifTrue:[
generator createWebApplicationCodeFor:cls.
] ifFalse:[
(cls isSubclassOf:HTTPService) ifTrue:[
generator createWebServiceCodeFor:cls
] ifFalse:[
(cls isSubclassOf:ApplicationModel) ifTrue:[
generator createApplicationCodeFor:cls
]
]
]
!
classMenuGenerateClassInitializationCode
"create #initialize method on the class side"
self
generateUndoableChangeOverSelectedClasses:'Generate Class Initializer in %(singleClassNameOrNumberOfClasses)'
via:[:generator :eachClass |
generator createClassInitializeMethodIn:eachClass theMetaclass.
]
!
classMenuGenerateClassTypeTestMethods
"create isXXX test- methods here and in subclasses"
|cls subclasses|
(cls := self theSingleSelectedLoadedNonMetaclassOrNil) isNil ifTrue:[
self information:'You must select a single (abstract) superclass'.
^ self.
].
subclasses := cls subclasses.
subclasses isEmpty ifTrue:[
self information:'(Abstract) superclass ' , cls name , ' has no subclasses.'.
^ self.
].
self
generateUndoableChangeOverSelectedClasses:'Generate ClassType Testers'
via:[:generator :eachClass |
generator createClassTypeTestMethodsIn:cls theNonMetaclass forClasses:subclasses
].
"Modified: / 01-03-2007 / 20:51:07 / cg"
!
classMenuGenerateClassTypeTestMethodsForThisClass
"create isXXX test- methods here and in a superclass"
|cls sel superclass|
(cls := self theSingleSelectedClass) notNil ifTrue:[
sel := 'is' , cls nameWithoutPrefix.
] ifFalse:[
sel := 'isXXX'.
].
superclass := self askForSuperclassToGenerateTestMethod:sel.
superclass isNil ifTrue:[^ self].
self
generateUndoableChangeOverSelectedClasses:'Generate ClassType Testers'
via:[:generator :eachClass |
generator createClassTypeTestMethodsIn:(superclass theNonMetaclass) forClasses:(Array with:eachClass)
].
!
classMenuGenerateCopyrightMethod
"create copyright methods"
|copyRightText|
copyRightText := Dialog
requestText:'Copyright-Text:'
lines:20 columns:80
initialAnswer:(SmalltalkCodeGeneratorTool copyrightTemplate).
copyRightText isEmptyOrNil ifTrue:[^ self].
SmalltalkCodeGeneratorTool copyrightTemplate:copyRightText.
self
generateUndoableChangeOverSelectedClasses:'Generate Copyright Method in %(singleClassNameOrNumberOfClasses)'
via:[:generator :eachClass |
|metaClass |
metaClass := eachClass theMetaclass.
generator createCopyrightMethodFor:copyRightText for:metaClass.
]
"Modified: / 31-01-2011 / 18:30:04 / cg"
!
classMenuGenerateDocumentationMethodFromComment
"create documentation method from comment"
self
generateUndoableChangeOverSelectedClasses:'Generate Documentation method in %(singleClassNameOrNumberOfClasses)'
via:[:generator :eachClass |
|cls|
cls := eachClass theMetaclass.
(cls includesSelector:#documentation) ifFalse:[
generator createDocumentationMethodFor:cls.
(cls includesSelector:#documentation) ifTrue:[
cls theNonMetaclass comment:nil
].
].
]
!
classMenuGenerateDocumentationStubs
"create documentation methods"
self
generateUndoableChangeOverSelectedClasses:'Generate Documentation in %(singleClassNameOrNumberOfClasses)'
via:[:generator :eachClass |
|metaClass |
metaClass := eachClass theMetaclass.
generator createDocumentationMethodsFor:metaClass.
"/ add examples method containing examples template
"/ but only if not already present.
generator createExamplesMethodFor:metaClass.
]
!
classMenuGenerateEnumTypeCode
"create an enumeration type"
self
generateUndoableChangeOverSelectedClasses:'Generate EnumTypeCode in %(singleClassNameOrNumberOfClasses)'
via:[:generator :eachClass |
|cls|
cls := eachClass theNonMetaclass.
generator createEnumTypeCodeFor:cls
]
!
classMenuGenerateGetterMethods
"create getter methods for instvars.
If no variable is selected, for all instvars;
otherwise for that selected instvar."
self
classMenuGenerateAccessMethodsWithChange:false
asValueHolder:false
readersOnly:true
writersOnly:false
lazyInitialization:false
!
classMenuGenerateInitializationMethod
"create initialize method"
self
generateUndoableChangeOverSelectedClasses:'Initialization Code for %(singleClassNameOrNumberOfClasses)'
via:[:generator :eachClass |
generator createInitializationMethodIn:eachClass theNonMetaclass
].
!
classMenuGenerateInitializeMethod
"create the initialize method"
self
generateUndoableChangeOverSelectedClasses:'Initializer for %(singleClassNameOrNumberOfClasses)'
via:[:generator :eachClass |
generator createInitializationMethodIn:eachClass theNonMetaclass
].
!
classMenuGenerateInitializedInstanceCreationMethods
"create new and initialize methods"
self
generateUndoableChangeOverSelectedClasses:'Initialized Instance Creation Code for %(singleClassNameOrNumberOfClasses)'
via:[:generator :eachClass |
generator createInitializedInstanceCreationMethodsIn:eachClass theNonMetaclass
].
!
classMenuGenerateMultiSetterMethod
"create a multi setter method for selected instvars."
|cls vars|
cls := self theSingleSelectedClass.
vars := cls allInstVarNames
select:[:var | self selectedVariables value includes:var].
self
generateUndoableChange:'Generate multi-setter'
overClasses:(Array with:cls)
via:[:generator :eachClass |
generator createMultiSetterMethodFor:vars in:cls
].
!
classMenuGenerateParametrizedInstanceCreationMethods
"create for: instance creation and initialize methods"
|selector|
selector := Dialog
requestSelector:'Name of Instance Creation Method:'
initialAnswer:'for:'.
selector isEmptyOrNil ifTrue:[^ self].
selector := selector asSymbol.
self
generateUndoableChangeOverSelectedClasses:'Parametrized Instance Creation Code for %(singleClassNameOrNumberOfClasses)'
via:[:generator :eachClass |
generator createParametrizedInstanceCreationMethodsNamed:selector in:eachClass theNonMetaclass
].
!
classMenuGeneratePoolInitializationCode
"create a Pool initialization template method"
self
generateUndoableChangeOverSelectedClasses:'Generate Pool Initialization in %(singleClassNameOrNumberOfClasses)'
via:[:generator :eachClass |
|cls|
cls := eachClass theNonMetaclass.
generator createPoolInitializationCodeFor:cls
]
"Created: / 25-10-2006 / 09:24:48 / cg"
!
classMenuGenerateProjectDefinitions
self generateProjectDefinitionsIn:(self selectedClasses value ? #())
!
classMenuGenerateRedefinedInstanceCreationMethods
"create redefined new methods"
self
generateUndoableChangeOverSelectedClasses:'Redefined Instance Creation for %(singleClassNameOrNumberOfClasses)'
via:[:generator :eachClass |
generator createRedefinedInstanceCreationMethodsIn:eachClass theNonMetaclass
].
!
classMenuGenerateRequiredProtocol
"create required protocol (all inherited subclassResponsibility methods)"
self
generateUndoableChangeOverSelectedClasses:'Generate Required Protocol in %(singleClassNameOrNumberOfClasses)'
via:[:generator :eachClass |
generator createClassResponsibleProtocolFor:eachClass
]
!
classMenuGenerateSetterMethods
"create setter methods for instvars.
If no variable is selected, for all instvars;
otherwise for that selected instvar."
self
classMenuGenerateAccessMethodsWithChange:false
asValueHolder:false
readersOnly:false
writersOnly:true
lazyInitialization:false
!
classMenuGenerateStandardPrintOnMethod
self
generateUndoableChangeOverSelectedClasses:'Generate PrintOn Method for %(singleClassNameOrNumberOfClasses)'
via:[:generator :eachClass |
generator createStandardPrintOnMethodIn:eachClass theNonMetaclass
].
!
classMenuGenerateUpdateMethod
"create a standard update method template"
self
generateUndoableChangeOverSelectedClasses:'Generate%(numClassesOrEmpty)Update Method%(sForPlural)%(forSingleClassOrEmpty)'
via:[:generator :eachClass |
generator createUpdateMethodIn:eachClass theNonMetaclass
].
!
classMenuGenerateVisitorMethods
"create visitor and visited methods"
|visitorClassName visitorClass|
visitorClassName := Dialog
request:'Name of Visitor class'
initialAnswer:(LastVisitorClassName ? '')
okLabel:(resources string:'Create')
title:'Visitor class'
onCancel:nil
list:#()
entryCompletionBlock:(DoWhatIMeanSupport classNameEntryCompletionBlock).
visitorClass := self classIfValidNonMetaClassName:visitorClassName.
visitorClass isNil ifTrue:[^ nil].
LastVisitorClassName := visitorClassName.
self
generateUndoableChangeOverSelectedClasses:'Generate Visitor Pattern'
via:[:generator :eachClass |
generator createVisitorMethodsIn:eachClass theNonMetaclass andVisitorClass:visitorClass
].
"Modified: / 11.10.2001 / 22:19:09 / cg"
"Created: / 11.10.2001 / 22:26:08 / cg"
!
classMenuHierarchy
"show a classes hierarchy"
self classMenuChangeAspect:#classHierarchy
"Modified: / 8.11.2001 / 23:06:09 / cg"
!
classMenuIncludeInProject
|projectDefinitionClasses|
projectDefinitionClasses := (self selectedClasses value collect:[:cls | cls projectDefinitionClass]) asSet.
projectDefinitionClasses do:[:eachDefinitionClass |
|toIncludeForThis|
toIncludeForThis := self selectedClasses value select:[:cls | cls projectDefinitionClass == eachDefinitionClass].
self
generateUndoableChange:(resources string:'Include %1 class(es) in Project %2 (Make Compiled Class)' with:toIncludeForThis size with:eachDefinitionClass name)
overClasses:(Array with: eachDefinitionClass)
via:[:generator :projectDefinition |
self includeClasses:toIncludeForThis inProject:projectDefinition using:generator
].
].
"Created: / 19-02-2007 / 16:46:16 / cg"
"Modified: / 20-02-2007 / 10:39:30 / cg"
!
classMenuInitialize
"reinit selected classes (kludge - for me)"
self selectedNonMetaclassesDo:[:eachClass |
(eachClass class includesSelector:#initialize) ifTrue:[
eachClass initialize.
]
].
"Modified: / 12-09-2006 / 13:51:50 / cg"
!
classMenuInsertNewSuperclass
"initiate the well known refactoring"
|selectedClasses superClasses superClass name existingClass|
selectedClasses := self selectedClasses value.
selectedClasses do:[:each | each autoload].
superClasses := selectedClasses collect:[:c | c superclass].
superClasses asSet size > 1 ifTrue:[
Dialog warn:'Classes must have a common superclass'.
^ self
].
superClass := superClasses anElement.
name := Dialog request:(resources
string:'Enter name for new parent class of the selected class(es):').
name isEmpty ifTrue: [^self].
existingClass := Smalltalk classNamed:name.
existingClass notNil ifTrue:[
(Dialog confirm:(resources
string:'A Class named "%1" already exists - make the selected class(es) a subclass of it ?'))
ifFalse:[
^ self
].
].
self performRefactoring:
(AddClassRefactoring
addClass:name
superclass:superClass
subclasses:selectedClasses
category:(selectedClasses first category) "dialog categoryName").
self switchToClassNamed:name.
"/ meta: self isMeta
"/ categories: self categories
!
classMenuInspectClass
"open an inspector on the class (useful to look at class instvars)"
|classes toInspect|
(classes := self selectedNonMetaclasses) size > 0 ifTrue:[
classes size == 1 ifTrue:[
toInspect := classes first.
] ifFalse:[
toInspect := classes
].
toInspect inspect
].
"Modified: / 12-09-2006 / 13:51:26 / cg"
!
classMenuInspectDerivedInstances
"open an inspector on all derived instances of the selected class(es)"
|classes insts|
classes := self selectedNonMetaclasses.
insts := OrderedCollection new.
classes do:[:eachClass |
insts addAll:(eachClass allSubInstances).
].
insts size == 0 ifTrue:[
self information:'No instances or subInstances.'
] ifFalse:[
insts size == 1 ifTrue:[
insts first inspect.
] ifFalse:[
insts inspect
]
]
"Modified: / 12-09-2006 / 13:51:09 / cg"
!
classMenuInspectInstances
"open an inspector on all instances of the selected class(es)"
|classes insts|
classes := self selectedNonMetaclasses.
insts := OrderedCollection new.
classes do:[:eachClass |
insts addAll:(eachClass allInstances).
].
insts size == 0 ifTrue:[
self information:'No instances.'
] ifFalse:[
insts size == 1 ifTrue:[
insts first inspect.
] ifFalse:[
insts inspect
]
]
"Modified: / 12-09-2006 / 13:51:02 / cg"
!
classMenuInspectReferencesToInstances
"open an inspector on all objects which contain a reference to
an instance of the selected class(es)"
|classes insts|
classes := self selectedNonMetaclasses.
insts := OrderedCollection new.
ObjectMemory garbageCollect.
ObjectMemory allObjectsDo:[:obj |
(classes contains:[:cls | (obj referencesInstanceOf:cls)])
ifTrue:[
insts add:obj
].
].
insts remove:(insts instVarAt:1) ifAbsent:nil.
insts size == 0 ifTrue:[
self information:'Noone references any instance of the selected class(es).'
] ifFalse:[
insts size == 1 ifTrue:[
insts first inspect.
] ifFalse:[
insts inspect
]
]
"Modified: / 12-09-2006 / 13:50:54 / cg"
!
classMenuInspectSubclasses
"open an inspector on all subclasses. Useful to look at classInstvars"
|classes toInspect|
(classes := self selectedNonMetaclasses) size > 0 ifTrue:[
toInspect := classes collectAll:[:cls | cls allSubclasses].
toInspect inspect
].
!
classMenuLoad
"load selected classes"
self classLoad
!
classMenuLoadProject
"load all classes from the selected project definitions"
(self selectedNonMetaclasses copy) do:[:cls |
cls autoload.
cls isProjectDefinition ifTrue:[
self activityNotification:('Loading ', cls description , '..').
cls load
].
].
"Modified: / 12-09-2006 / 13:50:41 / cg"
!
classMenuMailTo
"fileOut selected classes (chunk format) and eMail to someone"
self
mailClasses:self selectedClasses value
subject:'Class Source from Browser'
"Modified: / 20-09-2007 / 15:03:32 / cg"
!
classMenuMakeAutoloadedInProject
|projectDefinitionClasses|
projectDefinitionClasses := (self selectedClasses value collect:[:cls | cls theNonMetaclass projectDefinitionClass]) asSet.
projectDefinitionClasses do:[:eachDefinitionClass |
|toMakeAutoloadedForThis|
toMakeAutoloadedForThis := self selectedClasses value select:[:cls | cls theNonMetaclass projectDefinitionClass == eachDefinitionClass].
self
generateUndoableChange:(resources string:'Make %1 class(es) autoloaded in %2' with:toMakeAutoloadedForThis size with:eachDefinitionClass name)
overClasses:(Array with: eachDefinitionClass)
via:[:generator :projectDefinition |
self makeClassesAutoloaded:toMakeAutoloadedForThis inProject:projectDefinition using:generator
].
].
"Created: / 30-08-2007 / 18:51:35 / cg"
!
classMenuMakePrivateIn
"make the selected class(es) private in another class."
|list newOwnerName newOwner currentClass supers subs newName classes|
currentClass := self theSingleSelectedClass.
currentClass isNil ifTrue:[
currentClass := self selectedClasses value first
].
currentClass := currentClass theNonMetaclass.
supers := (currentClass allSuperclasses reverse collect:[:cls | cls name]).
subs := (currentClass allSubclasses collect:[:cls | cls name]).
list := supers.
(supers notEmpty and:[subs notEmpty]) ifTrue:[
list := list , (Array with:'---- ' , currentClass name , ' ----')
].
list := list , subs.
newOwnerName := Dialog
request:(resources string:'Make private in which class:')
initialAnswer:''
okLabel:(resources string:'OK')
title:(resources string:'Make class private')
onCancel:nil
list:list
entryCompletionBlock:(DoWhatIMeanSupport classNameEntryCompletionBlock).
newOwnerName isNil ifTrue:[^ self].
(newOwnerName startsWith:'---- ') ifTrue:[^ self].
newOwner := Smalltalk classNamed:newOwnerName.
newOwner isNil ifTrue:[
(currentClass nameSpace notNil and:[currentClass nameSpace ~~ Smalltalk]) ifTrue:[
newOwner := currentClass nameSpace classNamed:newOwnerName
].
].
newOwner isNil ifTrue:[
self warn:'No such class: ', newOwnerName.
^ self
].
classes := self selectedNonMetaclasses.
classes do:[:eachClass |
eachClass autoload.
newName := newOwner name , '::' , eachClass nameWithoutPrefix.
(Smalltalk classNamed:newName) notNil ifTrue:[
(Smalltalk classNamed:newName) ~~ eachClass ifTrue:[
self warn:'A class named ' , newName , ' already exists.'.
^ self
].
].
(newOwner == eachClass) ifTrue:[
self warn:'A class cannot be its own owner.'.
^ self
].
(newOwner topOwningClass == eachClass) ifTrue:[
self warn:'Cannot create mutual (cyclic) ownership.'.
^ self
].
].
classes do:[:eachClass |
newName := newOwner name , '::' , eachClass nameWithoutPrefix.
Smalltalk renameClass:eachClass theNonMetaclass to:newName.
eachClass theMetaclass setOwningClass:newOwner.
].
"Modified: / 12-09-2006 / 13:50:04 / cg"
!
classMenuMakePublic
"change a class from private to public;
check if a public class with the same name exists,
before doing this."
|nsName ns baseName|
self selectedNonMetaclassesDo:[:eachClass |
baseName := eachClass nameWithoutPrefix.
(ns := eachClass topOwningClass nameSpace) ~~ Smalltalk ifTrue:[
nsName := Dialog confirmWithCancel:(resources string:'Make public in ''Smalltalk'' or in its nameSpace ''%1'' ?' with:ns name)
labels:(Array with:'Cancel' with:'In Smalltalk' with:'In ' , ns name)
values:(Array with:nil with:Smalltalk with:ns)
default:3.
nsName isEmptyOrNil ifTrue:[^ self].
nsName isNameSpace ifTrue:[
ns := nsName
] ifFalse:[
ns := Smalltalk at:nsName.
].
].
(ns classNamed:baseName) notNil ifTrue:[
self warn:(resources
string:'A public class named ''%1'' already exists in %2.\\Please remove/rename that one first,\or rename the private class ''%1'' here\and try again.'
with:baseName with:ns name) withCRs.
] ifFalse:[
eachClass makePublicIn:ns
]
]
"Modified: / 04-07-2006 / 18:48:23 / fm"
"Modified: / 10-10-2007 / 21:56:23 / cg"
!
classMenuMakePublicIn
"change a class from private to public;
check if a public class with the same name exists, before doing this."
|nsName ns baseName|
nsName := self
askForNameSpace:(resources string:'Make classes public in which Namespace ?')
title:(resources string:'Move to Namespace')
initialText:(LastNameSpaceMove ? '').
nsName isEmptyOrNil ifTrue:[^ self].
ns := Smalltalk at:nsName asSymbol.
self selectedNonMetaclassesDo:[:eachClass |
baseName := eachClass nameWithoutPrefix.
(ns classNamed:baseName) notNil ifTrue:[
self warn:(resources
string:'A public class named ''%1'' already exists in %2.\\Please remove/rename that one first,\or rename the private class ''%1'' here\and try again.'
with:baseName with:ns name) withCRs.
] ifFalse:[
eachClass makePublicIn:ns
]
]
"Created: / 04-07-2006 / 18:48:23 / fm"
"Modified: / 12-09-2006 / 13:49:26 / cg"
!
classMenuMoveToCategory
|allCategories box|
allCategories := Smalltalk allClassCategories asArray sort.
box := ListSelectionBox new.
box title:(resources string:'Move class(es) to which category:').
box list:allCategories.
box okAction:[:sel |
self withWaitCursorDo:[
self moveSelectedClassesToCategory:sel
]
].
box initialText:(LastCategoryRenames ? #('')) first.
box entryCompletionBlock:[:contents |
|s what|
s := contents withoutLeadingSeparators.
what := Smalltalk classCategoryCompletion:s.
box contents:what first.
(what at:2) size ~~ 1 ifTrue:[
self builder window beep
]
].
box label:(resources string:'Change Class-Category').
box showAtPointer
"Modified: / 17.11.2001 / 12:21:48 / cg"
!
classMenuMoveToNamespace
"change the package-id of the selected classes.
Will eventually update the Project-object"
|newNameSpace ns|
newNameSpace := self
askForNameSpace:'Move class(es) to which nameSpace:'
title:(resources string:'Move to Namespace')
initialText:(LastNameSpaceMove ? '').
newNameSpace size == 0 ifTrue:[^ self].
ns := Smalltalk at:newNameSpace asSymbol.
ns isNil ifTrue:[
(self confirm:(resources string:'No such nameSpace exists.\\Create "%1" ?' with:newNameSpace) withCRs) ifFalse:[
^ self
].
ns := NameSpace name:newNameSpace asSymbol
] ifFalse:[
ns isNameSpace ifFalse:[
self warn:(resources string:'Not a NameSpace: %1' with:newNameSpace).
^ self
]
].
LastNameSpaceMove := newNameSpace.
self withWaitCursorDo:[
self selectedNonMetaclassesDo:[:classToMove |
|className doMove oldSym oldBaseSym|
classToMove isPrivate ifTrue:[
self warn:'Cannot move a private class - please move the owner.'.
] ifFalse:[
classToMove nameSpace ~~ ns ifTrue:[
className := classToMove nameWithoutPrefix.
"/ check if the target already exists - confirm if so.
doMove := true.
(ns at:className asSymbol) notNil ifTrue:[
doMove := self confirmWithCancel:(resources string:'Attention: a class named ''%1'' already present (in ''%2'' category).\\Move over it ?'
with:className allBold
with:ns name allBold) withCRs.
doMove isNil ifTrue:[
^ self
]
].
doMove ifTrue:[
oldSym := classToMove name asSymbol.
oldBaseSym := classToMove nameWithoutPrefix asSymbol.
"/
"/ renaming is actually more complicated as one might
"/ think (care for classVariables, privateClasses etc.)
"/ Smalltalk knows all about that ...
ns == Smalltalk ifTrue:[
Smalltalk renameClass:classToMove to:className asSymbol.
] ifFalse:[
Smalltalk renameClass:classToMove to:(ns name , '::' , className) asSymbol.
ns changed.
].
Smalltalk changed.
Transcript showCR:('searching for users of ' , oldSym); endEntry.
SystemBrowser browseReferendsOf:oldSym warnIfNone:false.
oldBaseSym ~= oldSym ifTrue:[
Transcript showCR:('searching for users of ' , oldBaseSym); endEntry.
SystemBrowser browseReferendsOf:oldBaseSym warnIfNone:false
]
]
]
]
]
]
"Modified: / 12-09-2006 / 13:49:01 / cg"
!
classMenuMoveToProject
"change the package-id of the selected classes.
Will eventually update the Project-object"
|newProject packages msg|
packages := self selectedClasses value collect:[:each | each package].
packages size == 1 ifTrue:[
msg := resources string:'Move class(es) from ''%1'' to which project:'
with:packages first allBold.
] ifFalse:[
msg := resources string:'Move class(es) to which project:'
].
newProject := self askForProject:msg.
newProject notNil ifTrue:[
self withWaitCursorDo:[
self moveSelectedClassesToProject:newProject.
]
].
"Created: / 17.2.2000 / 22:50:07 / cg"
"Modified: / 17.2.2000 / 23:03:01 / cg"
!
classMenuNewApplication
"create a class-definition prototype for an application"
self
classClassDefinitionTemplateFor:ApplicationModel
in:(self theSingleSelectedCategory ? 'Applications')
asNamespace:false
private:false.
self codeAspect:#newApplication.
!
classMenuNewClass
"create a class-definition template in codeview"
self classMenuNewClass:nil
!
classMenuNewClass:metaClassUsedOrNil
"create a class-definition template in codeview"
|theClass superClass cat|
(theClass := self theSingleSelectedClass) notNil ifTrue:[
(superClass := theClass theNonMetaclass superclass) notNil ifTrue:[
theClass := superClass
]
] ifFalse:[
self javaMode ifTrue:[
theClass := Java at:'java.lang.Object'
] ifFalse:[
theClass := Object.
].
].
self hasCategorySelected ifTrue:[
cat := self selectedCategoriesValue first
] ifFalse:[
cat := Compiler defaultMethodCategory "/ '* As yet uncategorized *'
].
self
classClassDefinitionTemplateFor:theClass
in:cat
asNamespace:false
private:false
metaClassUsed:metaClassUsedOrNil
"Modified: / 15.11.2001 / 18:01:04 / cg"
!
classMenuNewDialog
"create a class-definition prototype for a dialog"
self
classClassDefinitionTemplateFor:SimpleDialog
in:(self theSingleSelectedCategory ? 'Applications - Dialogs')
asNamespace:false
private:false.
self codeAspect:#newDialog.
!
classMenuNewError
"create a class-definition prototype for an error class"
self
classClassDefinitionTemplateFor:Error
in:(self theSingleSelectedCategory ? 'Errors')
asNamespace:false
private:false.
self codeAspect:#newError.
!
classMenuNewHaskellModule
self classMenuNewClass:HaskellModule
!
classMenuNewJavaScriptClass
"create a class-definition template in codeview"
self classMenuNewClass:JavaScriptMetaclass
!
classMenuNewNotification
"create a class-definition prototype for an exception class"
self
classClassDefinitionTemplateFor:Notification
in:(self theSingleSelectedCategory ? 'Exceptions')
asNamespace:false
private:false.
self codeAspect:#newNotification.
!
classMenuNewPLSQLObjectType
self classMenuNewClass:PLSQLObjectTypeMetaclass
!
classMenuNewPrivateClass
"create a class-definition prototype for a dialog"
self
classClassDefinitionTemplateFor:Object
in:nil
asNamespace:false
private:true.
!
classMenuNewSharedPool
"create a class-definition prototype for a shared pool"
self
classClassDefinitionTemplateFor:SharedPool
in:(self theSingleSelectedCategory ? 'Pools')
asNamespace:false
private:false.
"/ self codeAspect:#newSharedPool.
!
classMenuNewSubclass
"create a class-definition template in codeview"
|theClass cat metaClassUsedOrNil|
(theClass := self theSingleSelectedClass) isNil ifTrue:[
self javaMode ifTrue:[
theClass := Java at:'java.lang.Object'
].
theClass isNil ifTrue:[
theClass := Object.
].
] ifFalse:[
theClass := theClass theNonMetaclass.
metaClassUsedOrNil := theClass theMetaclass class.
].
self hasCategorySelected ifTrue:[
cat := self selectedCategoriesValue first
] ifFalse:[
cat := theClass category.
].
self
classClassDefinitionTemplateFor:theClass
in:cat
asNamespace:false
private:false
metaClassUsed:metaClassUsedOrNil
"Created: / 17.2.2000 / 23:25:33 / cg"
!
classMenuNewTestCase
"create a class-definition prototype for a testCase"
TestCase isNil ifTrue:[ Smalltalk loadPackage:'stx:goodies/sunit' ].
TestCase autoload.
self
classClassDefinitionTemplateFor:TestCase
in:(self theSingleSelectedCategory ? 'TestCases')
asNamespace:false
private:false.
self codeAspect:#newTestCase.
"Modified: / 16-10-2006 / 12:24:31 / cg"
!
classMenuNewWebApplication
"create a class-definition prototype for a web page"
self
classClassDefinitionTemplateFor:WebApplicationModel
in:(self theSingleSelectedCategory ? 'WebServices')
asNamespace:false
private:false.
self codeAspect:#newWebApplication.
!
classMenuNewWebService
"create a class-definition prototype for a web application"
self
classClassDefinitionTemplateFor:HTTPService
in:(self theSingleSelectedCategory ? 'WebServices')
asNamespace:false
private:false.
self codeAspect:#newWebService.
"Modified: / 24-11-2006 / 15:52:51 / cg"
!
classMenuNewWidgetClass
"create a class-definition prototype for a widget"
self
classClassDefinitionTemplateFor:View
in:(self theSingleSelectedCategory ? 'Views-Misc')
asNamespace:false
private:false.
self codeAspect:#newWidget.
!
classMenuOpenClassCreationWizard
|dialog newClassName superclassName superclass package namespace namespaceName
namespacePrefix createdClass category language|
dialog := NewClassWizardDialog new.
dialog masterApplication:self.
dialog categoryHolder value:(self theSingleSelectedCategory).
dialog packageHolder value:(self theSingleSelectedProject).
dialog openModal.
dialog accepted ifFalse:[^ self].
language := dialog language.
newClassName := dialog classNameHolder value withoutSeparators.
superclassName := dialog superclassNameHolder value withoutSeparators.
superclass := Smalltalk classNamed:superclassName.
package := (dialog packageHolder value ? '') withoutSeparators.
namespaceName := (dialog nameSpaceHolder value ? 'Smalltalk') withoutSeparators.
category := (dialog categoryHolder value ? '* as yet unspecified *') withoutSeparators.
(namespaceName = 'Smalltalk') ifTrue:[
namespacePrefix := ''
] ifFalse:[
namespacePrefix := namespaceName , '::'
].
namespace := NameSpace name:namespaceName.
Class packageQuerySignal answer:package
do:[
|builder|
"/ createdClass :=
"/ superclass
"/ subclass: (namespacePrefix,newClassName) asSymbol
"/ instanceVariableNames: dialog instVarNamesHolder value
"/ classVariableNames: dialog classVarNamesHolder value
"/ poolDictionaries: ' '
"/ category: category.
"/
"/ dialog classInstVarNamesHolder value notEmptyOrNil ifTrue:[
"/ createdClass class instanceVariableNames: dialog classInstVarNamesHolder value
"/ ].
builder := ClassBuilder new.
builder metaclass:(language metaClass).
builder
name:(namespacePrefix,newClassName) asSymbol
inEnvironment:namespace
subclassOf:superclass
instanceVariableNames:(dialog instVarNamesHolder value)
variable:false
words:false
pointers:false
classVariableNames:(dialog classVarNamesHolder value)
poolDictionaries:''
category:category
comment:nil
changed:true
classInstanceVariableNames:(dialog classInstVarNamesHolder value).
createdClass := builder buildClass.
].
createdClass isNil ifTrue:[^ self ].
self switchToClass:createdClass.
Class packageQuerySignal answer:package
do:[
self
generateUndoableChange:'Generate Code for %(singleClassNameOrNumberOfClasses)'
overClasses:(Array with:createdClass)
via:[:generator :cls |
|theNonMetaclass theMetaclass inheritedInitializeMethod|
theNonMetaclass := cls theNonMetaclass.
theMetaclass := cls theMetaclass.
dialog createAccessors ifTrue:[
generator
createAccessMethodsFor:(cls instVarNames)
in:cls
withChange:false
asValueHolder:false
readersOnly:false
writersOnly:false
lazyInitialization:false.
].
dialog createInitializer ifTrue:[
inheritedInitializeMethod := cls theMetaclass responseTo:#new.
(inheritedInitializeMethod isNil or:[ (inheritedInitializeMethod sends:#initialize) not ]) ifTrue:[
generator createInitializedInstanceCreationMethodsIn:theNonMetaclass
] ifFalse:[
generator createInitializationMethodIn:theNonMetaclass
].
generator createClassInitializeMethodIn:theMetaclass.
].
dialog createUpdateMethod ifTrue:[
generator createUpdateMethodIn:theNonMetaclass
].
dialog createRequiredMethods ifTrue:[
generator createClassResponsibleProtocolFor:theNonMetaclass
].
dialog createInitialGUICode ifTrue:[
self classMenuGenerateApplicationCodeFor:theNonMetaclass using:generator
].
].
].
"Modified: / 30-01-2011 / 15:51:57 / cg"
!
classMenuPrimitiveCode:aspect
"show the classes primitiveFunction in the codeView.
Also, set accept action to change it."
(self askIfModified:'Code was modified.\\Show ' , aspect , ' anyway ?')
ifFalse:[^ self].
self selectedMethods value:nil.
self selectProtocols:nil.
self
showClassPrimitive:aspect
class:(self theSingleSelectedClass theNonMetaclass)
!
classMenuPrimitiveDefinitions
"show the classes primitiveDefinition in the codeView.
Also, set accept action to change it."
self classMenuPrimitiveCode:#primitiveDefinitions
!
classMenuPrimitiveFunctions
"show the classes primitiveFunction in the codeView.
Also, set accept action to change it."
self classMenuPrimitiveCode:#primitiveFunctions
!
classMenuPrimitiveVariables
"show the classes primitiveVariable in the codeView.
Also, set accept action to change it."
self classMenuPrimitiveCode:#primitiveVariables
!
classMenuPrintOut
self printOutClassesWithSelector:#printOutOn:
!
classMenuPrintOutFullProtocol
self printOutClassesWithSelector:#printOutFullProtocolOn:
!
classMenuPrintOutProtocol
self printOutClassesWithSelector:#printOutProtocolOn:
!
classMenuRecompile
"recompile selected classes (kludge - for me)"
self selectedClassesDo:[:eachClass |
eachClass theNonMetaclass recompile.
eachClass theMetaclass recompile.
].
!
classMenuRecompileInstrumented
self selectedClassesDo:[:eachClass |
self recompileClassWithInstrumentation:eachClass
].
"Modified: / 10-08-2010 / 14:36:42 / cg"
!
classMenuRegenerateProjectContentsDefinitions
self updateProjectContentsDefinitionsIn:(self selectedClasses value ? #()) regenerate:true
"Created: / 12-10-2006 / 16:53:30 / cg"
!
classMenuRemove
"remove the selected classes (and all of its subclasses)"
self withWaitCursorDo:[
self classMenuRemoveAndPullUpSubclasses:false
]
"Modified: / 27-07-2006 / 09:33:35 / cg"
!
classMenuRemoveAndPullUpSubclasses:pullUpSubclasses
"remove the selected classes.
If pullUpSubclasses is true, the classes subclasses are pulled up;
otherwise, these are removed."
|offerCancel offerYesToAll classesToRemove|
classesToRemove := OrderedCollection new.
offerCancel := self selectedClasses value size > 1.
offerYesToAll := self selectedClasses value size > 1.
YesToAllConfirmation handleConfirmationIn:[
self
selectedClassesNonMetaDo:[:cls |
self
addClassesToRemoveForClass:cls
to:classesToRemove
removingSubclasses:pullUpSubclasses not
withCancel:offerCancel
]
ifUnloaded:[:cls |
|answer|
YesToAllConfirmation query ifTrue:[
answer := true
] ifFalse:[
offerYesToAll ifTrue:[
answer := OptionBox
request:(resources
string:'Class ''%1'' is autoloaded - remove anyway ?'
with:cls name allBold)
label:(resources string:'Confirm')
image:(YesNoBox iconBitmap)
buttonLabels:(resources array:#('Cancel' 'No' 'Yes' 'Yes to All'))
values:#(nil false true #yesToAll)
default:false
onCancel:false.
answer == #yesToAll ifTrue:[
YesToAllConfirmation notify.
answer := true
].
] ifFalse:[
answer := Dialog
confirmWithCancel:
(resources
string:'Class ''%1'' is autoloaded - remove anyway ?'
with:cls name allBold)
default:
false.
].
answer == nil ifTrue:[
^ self "/ cancelled
].
].
answer == true ifTrue:[
self
addClassesToRemoveForClass:cls
to:classesToRemove
removingSubclasses:pullUpSubclasses not
withCancel:offerCancel
withConfirm:false
].
false
]
ifPrivate:[:cls |
self
addClassesToRemoveForClass:cls
to:classesToRemove
removingSubclasses:pullUpSubclasses not
withCancel:offerCancel
].
].
classesToRemove notEmpty ifTrue:[
self removeClasses:classesToRemove pullUpSubclasses:pullUpSubclasses.
(Dialog
confirm:(resources
stringWithCRs:'Cleanup the ChangeSet ?\\i.e. remove entries for removed class(es)')
yesLabel:(resources string:'Cleanup'))
ifTrue:[
classesToRemove do:[:eachClass |
ChangeSet current condenseChangesForClass:eachClass
].
].
]
"Modified: / 04-09-2006 / 11:22:02 / cg"
!
classMenuRename
"rename the selected class"
|currentClass box newNameString
oldSym oldBaseSym cls newOwnerOrNameSpacePath nsOrOwner s nextWord t hardRename
answer referingMethods refactoring browser askForNewContainer question|
currentClass := self theSingleSelectedClass.
currentClass isNil ifTrue:[^ nil].
currentClass := currentClass theNonMetaclass.
box := self
enterBoxTitle:(resources
string:'Rename ''%1'' to:'
with:currentClass name allBold)
okText:'Rename'
label:'Rename Class'.
box initialText:(currentClass name).
box action:[:aString | newNameString := aString].
box showAtPointer.
newNameString isNil ifTrue:[^ self].
newNameString = currentClass name ifTrue:[^ self].
"/ extract owner or namespace, to see if this implies a change
newOwnerOrNameSpacePath := OrderedCollection new.
nsOrOwner := Smalltalk.
s := newNameString readStream.
[s atEnd] whileFalse:[
nextWord := s nextAlphaNumericWord.
[s peek == $_] whileTrue:[
nextWord := nextWord , '_' , s nextAlphaNumericWord.
].
s skipSeparators.
s atEnd ifFalse:[
nsOrOwner isNameSpace ifTrue:[
t := nsOrOwner at:nextWord asSymbol
] ifFalse:[
t := nsOrOwner privateClassesAt:nextWord asSymbol
].
t isNil ifTrue:[
self warn:('Name: ''' , newNameString , ''' specifies a non-existing NameSpace or Ownerclass.\\(no ''' , nextWord , ''' in ''' , nsOrOwner name , ')') withCRs.
^ self
].
nsOrOwner := t.
s peek == $. ifTrue:[
s next.
] ifFalse:[
s peek == $: ifTrue:[
s next.
s next ~= $: ifTrue:[
self warn:'Bad name: ''' , newNameString , ''' (either use ''.'' or ''::'' as nameSpace separator)'.
^ self
]
]
]
]
].
nsOrOwner isNil ifTrue:[
self warn:'Name ''' , newNameString , ''' specifies a non-existing NameSpace or Ownerclass'.
^ self
].
hardRename := false.
currentClass isPrivate ifTrue:[
"/ check if the new name implies an owner-change
hardRename := (nsOrOwner ~~ currentClass owningClass)
] ifFalse:[
hardRename := (nsOrOwner ~~ currentClass nameSpace)
].
hardRename ifTrue:[
(self confirm:'New name implies a NameSpace or OwningClass change - is this what you want ?') ifFalse:[
^ self
]
].
"/ check if the target already exists - confirm if so.
(cls := Smalltalk classNamed:newNameString) notNil ifTrue:[
(self confirm:(resources string:'Attention: a class named ''%1'' already present (in the ''%2'' category).\\Rename over it ?'
with:newNameString allBold
with:cls category allBold) withCRs)
ifFalse:[^ self]
].
oldSym := currentClass name asSymbol.
oldBaseSym := currentClass nameWithoutPrefix asSymbol.
"/ renaming is actually more complicated as one might
"/ think (care for classVariables, privateClasses etc.)
"/ Smalltalk knows all about that ...
askForNewContainer := false.
"/ check if the class has a repository container - warn about this if so
currentClass isPrivate ifFalse:[
currentClass revision notNil ifTrue:[
(self confirm:(resources string:'Remove the (old) source container for ''%1'' in the repository ?' with:oldSym allBold))
ifTrue:[
SourceCodeManagerUtilities
removeSourceContainerForClass:currentClass
confirm:false
warn:true.
askForNewContainer := true.
].
]
].
self busyLabel:('Searching for references to ' , oldSym).
referingMethods := SystemBrowser
allMethodsIn:(Smalltalk allClasses)
where:(SystemBrowser searchBlockForReferendsOf:oldSym).
self normalLabel.
referingMethods isEmpty ifTrue:[
Smalltalk renameClass:currentClass to:newNameString.
] ifFalse:[
RenameClassRefactoring isNil ifTrue:[
Smalltalk renameClass:currentClass to:newNameString.
answer := OptionBox
request:(resources
stringWithCRs:'Browse %1 references to "%2" ?'
with:referingMethods size
with:oldSym allBold
with:newNameString allBold)
label:(resources string:'Renaming class "%1" to "%2"' with:oldSym with:newNameString)
buttonLabels:(resources array:#('Cancel' 'Browse' 'Rename'))
values:#(false #browse #rename)
default:#rename
onCancel:false.
] ifFalse:[
referingMethods size == 1 ifTrue:[
question := 'There is 1 reference to "%2"\from %4.\\Rename only or Rename and Rewrite to "%3" ?'
] ifFalse:[
question := 'There are %1 references to "%2".\\Rename only or Rename and Rewrite to "%3" ?'
].
answer := OptionBox
request:(resources
stringWithCRs:question
with:referingMethods size
with:oldSym allBold
with:newNameString allBold
with:(referingMethods first whoString))
label:(resources string:'Renaming class "%1" to "%2"' with:oldSym with:newNameString)
buttonLabels:(resources array:#('Cancel' 'Browse' 'Rename && Browse' 'Rename' 'Rename && Rewrite' ))
values:#(false #browse #renameAndBrowse #rename #renameAndRewrite )
default:#renameAndRewrite
onCancel:false.
].
(answer == #browse or:[answer == #renameAndBrowse]) ifTrue:[
browser := self
spawnMethodBrowserFor:referingMethods
in:#newBuffer
label:(resources string:'Methods referring to %1' with:oldSym)
].
(answer == #rename or:[answer == #renameAndBrowse]) ifTrue:[
Smalltalk renameClass:currentClass to:newNameString.
browser := self
spawnMethodBrowserFor:referingMethods
in:#newBuffer
label:(resources string:'Methods referring to %1 which was renamed to %2' with:oldSym with:newNameString)
].
answer == #renameAndRewrite ifTrue:[
refactoring := RenameClassRefactoring renameClassNamed:oldSym to:newNameString.
self performRefactoring:refactoring.
referingMethods := SystemBrowser
allMethodsIn:(Smalltalk allClasses)
where:(SystemBrowser searchBlockForReferendsOf:newNameString).
UserInformation ignoreIn:[
browser := self
spawnMethodBrowserFor:referingMethods
in:#newBuffer
label:(resources string:'Rewritten Methods now referring to %1' with:newNameString).
].
].
browser notNil ifTrue:[
browser autoSearchVariable:oldBaseSym.
].
].
askForNewContainer ifTrue:[
(self confirm:(resources string:'Create a new source container for ''%1'' ?' with:newNameString allBold))
ifTrue:[
currentClass setClassFilename:nil.
SourceCodeManagerUtilities createSourceContainerForClass:(Smalltalk at:newNameString asSymbol)
]
].
"Modified: / 15-08-2010 / 11:54:23 / cg"
!
classMenuSaveDocumentationAs
"write classes documentation to a file"
self
selectedClassesNonMetaDo:
[:cls |
self saveClassDocumentationFor:cls
]
ifUnloaded:
[:cls |
true
]
ifPrivate:
[:cls |
]
!
classMenuSaveRemove
"remove the selected classes and pull up their subclasses"
(self canUseRefactoringSupport) ifFalse:[
^ self warn:'Sorry - need refactoring support for this function'.
].
^ self classMenuRemoveAndPullUpSubclasses:true
"Modified: / 12-10-2006 / 14:09:02 / cg"
!
classMenuSpawnBufferWithAllSubclasses
"open a new browser showing the selected classes with all subclasses"
self spawnWithAllSubclassesIn:#newBuffer
!
classMenuSpawnBufferWithAllSuperclasses
"open a new browser showing the selected classes with all superclasses"
self spawnWithAllSuperclassesIn:#newBuffer
!
classMenuSpawnBufferWithClassOrSubclassReferences
"add a buffer showing references to any of the selected classes or any of its subclasses"
self spawnClassOrSubclassReferencesBrowserFor:(self selectedClasses value) in:#newBuffer
!
classMenuSpawnBufferWithClassProjects
"add a new buffer showing the selected classes projects"
self spawnClassProjectsBrowserFor:(self selectedClasses value) in:#newBuffer
"Created: / 18.8.2000 / 19:12:33 / cg"
!
classMenuSpawnBufferWithClassReferences
"add a buffer showing references to any of the selected classes"
self spawnClassReferencesBrowserFor:(self selectedClasses value) in:#newBuffer
!
classMenuSpawnClass
"open a new browser showing the selected classes only"
self spawnClassBrowserFor:(self selectedClasses value) in:#newBrowser
!
classMenuSpawnClassBuffer
"add a buffer showing the selected classes only"
self spawnClassBrowserFor:(self selectedClasses value) in:#newBuffer
!
classMenuSpawnClassOrSubclassReferences
"open a new browser showing references to the selected classes or any of its subclass"
self spawnClassOrSubclassReferencesBrowserFor:(self selectedClasses value) in:#newBrowser
!
classMenuSpawnClassProjects
"open a new browser showing the selected classes projects"
self spawnClassProjectsBrowserFor:(self selectedClasses value) in:#newBrowser
"Created: / 18.8.2000 / 19:12:14 / cg"
!
classMenuSpawnClassReferences
"open a new browser showing references to the selected classes "
self spawnClassReferencesBrowserFor:(self selectedClasses value) in:#newBrowser
!
classMenuSpawnWithAllSubclasses
"open a new browser showing the selected classes with all subclasses"
self spawnWithAllSubclassesIn:#newBrowser
!
classMenuSpawnWithAllSuperclasses
"open a new browser showing the selected classes with all superclasses"
self spawnWithAllSuperclassesIn:#newBrowser
!
classMenuUpdate
self classListApp forceUpdateList
!
classMenuUpdateProjectContentsDefinitions
self updateProjectContentsDefinitionsIn:(self selectedClasses value ? #()) regenerate:false
"Created: / 10-10-2006 / 20:50:23 / cg"
!
classTemplateFor:aSuperClass in:categoryString asNamespace:asNameSpace private:isPrivateWanted metaClassUsed:metaClassUsedOrNilArg
"return a class definition template - be smart in what is offered initially"
|cat name nameProto namePrefix nameUsed i existingNames withNameSpaceDirective
className ownerName s currentNamespace currentClass nsTemplate
selectedNamespaces isPrivate ownerClass superclassesNamespace
metaClassUsedOrNil|
metaClassUsedOrNil := metaClassUsedOrNilArg.
currentClass := self currentClass.
isPrivate := isPrivateWanted.
isPrivate ifTrue:[
ownerClass := currentClass.
ownerClass notNil ifTrue:[
ownerClass := ownerClass theNonMetaclass.
].
].
aSuperClass isPrivate ifTrue:[
isPrivate := true.
ownerClass := aSuperClass theNonMetaclass owningClass
].
isPrivate ifTrue:[
metaClassUsedOrNil isNil ifTrue:[
metaClassUsedOrNil := ownerClass theMetaclass class
] ifFalse:[
]
].
(metaClassUsedOrNil notNil
and:[(metaClassUsedOrNil ~~ Metaclass)
and:[metaClassUsedOrNil ~~ PrivateMetaclass]
" and:[(metaClassUsedOrNil isSubclassOf:Metaclass) not] " ]) ifTrue:[
^ metaClassUsedOrNil
classTemplateFor:aSuperClass
in:categoryString
asNamespace:asNameSpace
private:isPrivate
].
(self javaMode
or:[aSuperClass notNil and:[aSuperClass isJavaClass]])
ifTrue:[
^ self javaClassTemplateFor:aSuperClass in:categoryString private:isPrivate
].
nsTemplate := ''.
self organizerMode value ~~ OrganizerCanvas organizerModeNamespace ifTrue:[
(aSuperClass notNil
and:[(superclassesNamespace := aSuperClass nameSpace) ~~ Smalltalk]) ifTrue:[
(superclassesNamespace isNameSpace
or:[superclassesNamespace ~~ ownerClass]) ifTrue:[
nsTemplate := superclassesNamespace name , '::'.
].
]
] ifFalse:[
(selectedNamespaces := self selectedNamespaces value) size > 0 ifTrue:[
selectedNamespaces size == 1 ifTrue:[
selectedNamespaces first ~= BrowserList nameListEntryForALL ifTrue:[
currentNamespace := Smalltalk at:selectedNamespaces first asSymbol.
]
]
]
].
s := TextStream on:''.
asNameSpace ifTrue:[
s nextPutLine:'NameSpace name:''' , nsTemplate , 'NewNameSpace'''.
s cr.
s emphasis:(UserPreferences current commentEmphasisAndColor).
s nextPutAll:'"
Replace ''NewNameSpace'' by the desired name.
Create the namespace by ''accepting'',
either via the menu or the keyboard (usually CMD-A).
"
'.
^ s contents.
].
currentNamespace isNil ifTrue:[
currentNamespace := self currentNamespace.
].
currentClass notNil ifTrue:[
currentClass := currentClass theNonMetaclass.
].
withNameSpaceDirective :=
currentNamespace notNil
and:[currentNamespace ~= (BrowserList nameListEntryForALL)
and:[currentNamespace ~= Smalltalk]].
withNameSpaceDirective ifTrue:[
s nextPutAll:('"{ NameSpace: ''' , currentNamespace name , ''' }"').
s cr; cr.
aSuperClass nameSpace = currentNamespace ifTrue:[
className := aSuperClass nameWithoutNameSpacePrefix.
] ifFalse:[
className := aSuperClass name.
].
] ifFalse:[
className := aSuperClass name.
].
nsTemplate := ''.
withNameSpaceDirective ifFalse:[
self organizerMode value ~~ OrganizerCanvas organizerModeNamespace ifTrue:[
(aSuperClass notNil
and:[(superclassesNamespace := aSuperClass nameSpace) ~~ Smalltalk]) ifTrue:[
(superclassesNamespace isNameSpace
or:[superclassesNamespace ~~ ownerClass]) ifTrue:[
nsTemplate := superclassesNamespace name , '::'.
].
]
].
].
cat := categoryString.
(cat isNil or:[cat startsWith:$*]) ifTrue:[
cat := Compiler defaultMethodCategory "/ '** As yet uncategorized **'
].
((aSuperClass == SimpleDialog) or:[aSuperClass isSubclassOf:SimpleDialog]) ifTrue:[
nameProto := 'NewDialog'.
] ifFalse:[
((aSuperClass == ApplicationModel) or:[aSuperClass isSubclassOf:ApplicationModel]) ifTrue:[
nameProto := 'NewApplication'.
] ifFalse:[
aSuperClass == TestCase ifTrue:[
nameProto := 'NewTestCase'.
] ifFalse:[ aSuperClass == Error ifTrue:[
nameProto := 'NewError'.
] ifFalse:[ aSuperClass == Exception ifTrue:[
nameProto := 'NewException'.
] ifFalse:[ aSuperClass == SharedPool ifTrue:[
nameProto := 'NewSharedPool'.
] ifFalse:[
nameProto := 'NewClass'.
]]]]
]
].
i := 1.
isPrivate ifTrue:[
namePrefix := ownerClass name , '::'.
existingNames := ownerClass privateClasses.
existingNames size > 0 ifTrue:[
existingNames := existingNames collect:[:cls | cls name].
]
] ifFalse:[
namePrefix := ''.
existingNames := Smalltalk keys
].
name := nsTemplate , nameProto , i printString.
existingNames notNil ifTrue:[
nameUsed := namePrefix , name.
[nameUsed knownAsSymbol and:[existingNames includes:nameUsed asSymbol]] whileTrue:[
i := i + 1.
name := nsTemplate , nameProto , i printString.
nameUsed := namePrefix , name
].
].
s emphasis:#bold.
s nextPutAll:className.
s emphasis:nil.
s nextPutAll:' subclass: '.
s emphasis:#bold.
s nextPutAll:name asSymbol storeString.
s emphasis:nil.
s cr.
s nextPutLine:' instanceVariableNames: '''''.
aSuperClass == SharedPool ifTrue:[
s nextPutLine:' classVariableNames: ''PoolVar1 PoolVar2...'''.
] ifFalse:[
s nextPutLine:' classVariableNames: '''''.
].
s nextPutLine:' poolDictionaries: '''''.
isPrivate ifTrue:[
withNameSpaceDirective ifTrue:[
ownerName := ownerClass nameWithoutNameSpacePrefix
] ifFalse:[
ownerName := ownerClass name
].
s nextPutAll:' privateIn: ' , ownerName
] ifFalse:[
s nextPutAll:' category: '''.
cat notNil ifTrue:[
cat printWithQuotesDoubledOn:s
].
s nextPutAll: ''''
].
s cr; cr.
s emphasis:(UserPreferences current commentEmphasisAndColor).
s nextPutAll:'
"
Replace ''' , className , ''', ''', name , ''' and
the empty string arguments by true values.
Install (or change) the class by ''accepting'',
either via the menu or the keyboard (usually CMD-A).
You can also change the category simply by editing
the categoryString and accepting.
To be nice to others (and yourself later), do not forget to
add some documentation; preferably under the classes documentation
protocol.
(see the `create documentation stubs'' item in the methodList menu;
switch from instance to class to find this menu item.)
Notice, that ST/X uses the convention to document the class using
comment-only class methods (however, ST80 comments are supported and
can be changed via the class-documentation menu).
"
'.
^ s contents
"Created: / 23-12-1996 / 12:46:31 / cg"
"Modified: / 11-08-2006 / 14:41:09 / cg"
!
debugMenuRecompileMethodsInstrumented
self selectedMethodsDo:[:eachMethod |
self recompileMethodWithInstrumentation:eachMethod
].
"Created: / 10-08-2010 / 14:36:33 / cg"
!
doCompareClass:class1 withClass:class2
"open a diff-textView comparing the two classes (useful when refactoring)."
|lbl1 lbl2|
(class1 isLoaded not or:[class2 isLoaded not]) ifTrue:[
self warn:'Cannot compare unloaded classes.'.
^ self.
].
self busyLabel:'comparing ...' with:nil.
lbl1 := class1 name.
lbl2 := class2 name.
(UserPreferences versionDiffViewerClass)
openOnClass:class1
labelA:lbl1
andClass:class2
labelB:lbl2
title:('comparing ' , lbl1 , ' against ' , lbl2)
ifSame:[ self information:'sources are identical' ].
self normalLabel.
!
doCopyClass:aClass as:newClassName privateIn:ownerOrNil
self
doCopyClass:aClass
as:newClassName
privateIn:ownerOrNil
ignore:(IdentitySet new)
!
doCopyClass:aClass as:newClassName privateIn:ownerOrNil ignore:setOfClassesToIgnore
|newClass newMetaclass sel realNewClassName privateClassesBefore|
privateClassesBefore := aClass privateClasses.
ownerOrNil isNil ifTrue:[
sel := aClass definitionSelector.
realNewClassName := newClassName asSymbol.
] ifFalse:[
sel := aClass definitionSelectorPrivate.
realNewClassName := (ownerOrNil name , '::' , newClassName) asSymbol.
].
newClass := aClass superclass
perform:sel
with:newClassName asSymbol
with:aClass instanceVariableString
with:aClass classVariableString
with:aClass poolDictionaries
with:(ownerOrNil ifNil:[aClass category] ifNotNil:[ownerOrNil]). "/ category: or privateIn:
newClass isNil ifTrue:[
self error:'Internal class-definition error (should not happen)' mayProceed:true.
^ self.
].
newMetaclass := newClass class.
newMetaclass instanceVariableNames:(aClass class instanceVariableString).
"/ sigh - must refetch in case of changed instVars.
newClass := Smalltalk at:realNewClassName.
newMetaclass := newClass class.
aClass methodDictionary
keysAndValuesDo:[:sel :mthd |
newClass compile:(mthd source) classified:(mthd category)
].
aClass class methodDictionary
keysAndValuesDo:[:sel :mthd |
"/ skip the version method (to avoid confusing the repository)
(AbstractSourceCodeManager isVersionMethodSelector:sel) ifFalse:[
newMetaclass compile:(mthd source) classified:(mthd category)
]
].
setOfClassesToIgnore add:newClass.
privateClassesBefore do:[:eachPrivateClass |
(setOfClassesToIgnore includes:eachPrivateClass) ifFalse:[
self
doCopyClass:eachPrivateClass
as:(eachPrivateClass nameWithoutPrefix)
privateIn:newClass
ignore:setOfClassesToIgnore.
].
].
(newMetaclass includesSelector:#initialize) ifTrue:[
newClass initialize.
].
newClass package:(Class packageQuerySignal query).
^ newClass
"Modified: / 22-12-2010 / 18:44:04 / cg"
!
doMoveMethodsOfClass:aClass fromProject:oldProject toProject:newProject
|movedInstMethods movedClassMethods|
movedInstMethods := OrderedCollection new.
movedClassMethods := OrderedCollection new.
aClass theNonMetaclass methodDictionary keysAndValuesDo:[:sel :mthd |
mthd package = oldProject ifTrue:[
mthd setPackage:newProject.
movedInstMethods add:mthd.
].
].
aClass theMetaclass methodDictionary keysAndValuesDo:[:sel :mthd |
mthd package = oldProject ifTrue:[
mthd setPackage:newProject.
movedClassMethods add:mthd.
].
].
movedInstMethods notEmpty ifTrue:[
aClass theNonMetaclass changed:#projectOrganization.
Smalltalk changed:#projectOrganization with:(Array with:aClass theNonMetaclass with:movedInstMethods).
].
movedClassMethods notEmpty ifTrue:[
aClass theMetaclass changed:#projectOrganization.
Smalltalk changed:#projectOrganization with:(Array with:aClass theMetaclass with:movedClassMethods).
]
!
doRemoveClass:aClass
^ self doRemoveClass:aClass withCancel:true
!
executeSelectedClassMethod
"run the selected method"
self withWaitCursorDo:[
|m t retVal retvalString|
m := self theSingleSelectedMethod.
t := Time millisecondsToRun:[
retVal := m mclass theNonMetaclass perform:(m selector).
].
(retVal isString
or:[ retVal isLiteral ]) ifTrue:[
retvalString := retVal storeString.
] ifFalse:[
retvalString := retVal printString.
].
Transcript showCR:'Exec. Time: %1' with:t milliseconds.
Transcript showCR:'Answer: %1' with:retvalString.
]
"Modified: / 19-11-2010 / 12:07:05 / cg"
!
fileOutClass:aClass askForFile:doAsk withCancelAll:withCancelAll
"fileOut a class."
^ self
fileOutClass:aClass
askForFile:doAsk
withCancelAll:withCancelAll
format:nil
sourceMode:nil
!
fileOutClass:aClass askForFile:doAsk withCancelAll:withCancelAll format:formatSymbolOrNil sourceMode:sourceMode
"fileOut a class."
|saveName stillAsking cancelAll suffix|
suffix := self fileSuffixForClass:aClass format:formatSymbolOrNil.
formatSymbolOrNil notNil ifTrue:[
saveName := aClass theNonMetaclass name , '.' , suffix.
].
stillAsking := doAsk.
[stillAsking] whileTrue:[
saveName := self
fileNameDialogForFileOut:(resources string:'FileOut ''%1'' as:' with:aClass name allBold)
default:((Smalltalk fileNameForClass:aClass) , '.' , suffix)
withCancelAll:(withCancelAll
ifTrue:[
cancelAll := true.
]
ifFalse:nil).
cancelAll == true ifTrue:[
AbortOperationRequest raise
].
saveName isNil ifTrue:[
^ self
].
saveName isEmpty ifTrue:[ "/ can no longer happen ...
(self confirm:'Bad name given - try again ?') ifFalse:[
^ self.
].
stillAsking := true.
] ifFalse:[
FileSelectionBox lastFileSelectionDirectory:(saveName asFilename directoryName).
stillAsking := false.
].
].
self busyLabel:'saving %1' with:aClass name.
self withCursor:Cursor write do:[
Class fileOutErrorSignal handle:[:ex |
self warn:'Cannot fileOut: %1\(%2)' with:aClass name with:ex description.
self normalLabel.
ex return.
] do:[
formatSymbolOrNil == #sif ifTrue:[
SmalltalkInterchangeFileManager newForFileOut
fileName: saveName;
addClass: aClass;
fileOut
] ifFalse:[
formatSymbolOrNil == #xml ifTrue:[
saveName notNil ifTrue:[
aClass fileOutXMLAs:saveName.
] ifFalse:[
aClass fileOutXML.
]
] ifFalse:[
formatSymbolOrNil == #binary ifTrue:[
aClass binaryFileOutOn:(saveName asFilename writeStream binary) sourceMode:sourceMode
] ifFalse:[
saveName notNil ifTrue:[
aClass fileOutAs:saveName.
] ifFalse:[
aClass fileOut.
]
]
]
]
].
].
self normalLabel.
"Modified: / 12.11.2001 / 18:53:29 / cg"
!
fileOutClasses:aBunchOfClasses withFormat:aFormatSymbolOrNil
"fileOut some classes as individual files; ask for directory"
|dirName|
dirName := self
askForDirectoryToFileOut:(resources string:'FileOut %1 class(es) in:'
with:aBunchOfClasses size)
default:nil.
dirName isNil ifTrue:[
^ self
].
self
fileOutEachClass:aBunchOfClasses
in:dirName
withFormat:aFormatSymbolOrNil
!
fileOutEachClass:aCollectionOfClasses in:aDirectory withFormat:aFormatSymbolOrNil
"fileOut a bunch of classes as individual files into some directory"
|savedClasses privateClasses owningClasses unsavedOwners answer|
privateClasses := aCollectionOfClasses
select:[:eachClass | eachClass isPrivate].
savedClasses := (aCollectionOfClasses
select:[:eachClass | eachClass isPrivate not]) asIdentitySet.
owningClasses := (privateClasses
collect:[:eachPrivateClass | eachPrivateClass topOwningClass])
asIdentitySet.
unsavedOwners := owningClasses copy.
unsavedOwners removeAllFoundIn:savedClasses.
unsavedOwners notEmpty ifTrue:[
answer := self
confirmWithCancel:'Private classes are saved with their owningClasses;\\Save owners as well ?'
withCRs.
answer isNil ifTrue:[
^ self
].
answer == true ifTrue:[
savedClasses addAll:unsavedOwners
]
].
savedClasses do:[:eachClass |
|fn|
eachClass isPrivate ifFalse:[
self busyLabel:'saving: %1' with:eachClass name.
Class fileOutErrorSignal handle:[:ex |
self
warn:'cannot fileOut: %1\(%2)\\skipped.'
with:eachClass name allBold
with:ex description.
self normalLabel.
ex return
]
do:[
fn := (Smalltalk fileNameForClass:eachClass) , '.st'.
eachClass fileOutAs:(aDirectory asFilename constructString:fn)
]
]
].
self normalLabel
!
generateUndoableChange:nameOfOperation overClasses:classes via:aBlock
"helper for code generators"
|generator count dict className codeGeneratorClass|
"/ remove this a.s.a.p
(classes conform:[:cls | |lang| lang := cls programmingLanguage. lang isSmalltalk or:[lang isSTXJavaScript]]) ifFalse:[
Dialog warn:('Sorry.\\For now, this works only for Smalltalk classes.' withCRs).
^ self.
].
codeGeneratorClass := classes first programmingLanguage codeGeneratorClass.
codeGeneratorClass isNil ifTrue:[
Dialog warn:('Sorry.\\For now, there seems to be no codeGeneratorClass defined for this language.' withCRs).
^ self.
].
generator := codeGeneratorClass new.
generator startCollectChanges.
count := 0.
self withWaitCursorDo:[
classes do:[:eachClass |
eachClass isLoaded ifFalse:[
Transcript showCR:'skipping unloaded class: ' , eachClass name.
] ifTrue:[
aBlock value:generator value:eachClass.
count := count + 1.
]
].
dict := Dictionary new.
dict at:1 put:count.
dict at:#numClasses put:count.
count ~~ 1 ifTrue:[
dict at:#numClassesOrEmpty put:( ' ' , count printString, ' ').
dict at:#inSingleClassOrEmpty put:''.
dict at:#forSingleClassOrEmpty put:''.
dict at:#sForPlural put:'s'.
dict at:#singleClassNameOrNumberOfClasses put:(count printString , ' classes').
] ifFalse:[
className := classes first theNonMetaclass name.
dict at:#numClassesOrEmpty put:' '.
dict at:#inSingleClassOrEmpty put:' in ' , className.
dict at:#forSingleClassOrEmpty put:' for ' , className.
dict at:#sForPlural put:''.
dict at:#singleClassNameOrNumberOfClasses put:className.
].
UserInformation handle:[:ex |
self showInfo:(ex messageText).
] do:[
generator executeCollectedChangesNamed:(nameOfOperation expandPlaceholdersWith:dict)
]
]
"Modified: / 30-01-2011 / 15:20:03 / cg"
!
generateUndoableChangeOverSelectedClasses:nameOfOperation via:aBlock
"helper for code generators"
self
generateUndoableChange:nameOfOperation
overClasses:(self selectedClasses value ? #())
via:aBlock
!
generateUndoableChangeOverSelectedMethods:nameOfOperation via:aBlock
"helper for code generators"
|generator count dict method methodName languageOfFirstMethod|
languageOfFirstMethod := self selectedMethods value first mclass language.
(self selectedMethods value conform:[:mthd | (mthd mclass language) = languageOfFirstMethod]) ifFalse:[
Dialog warn:'All methods must be defined in the same programming language'.
^ self
].
generator := languageOfFirstMethod codeGeneratorClass new.
generator startCollectChanges.
count := 0.
self selectedMethodsDo:[:eachClass |
aBlock value:generator value:eachClass.
count := count + 1.
].
dict := Dictionary new.
dict at:1 put:count.
dict at:#numMethods put:count.
count ~~ 1 ifTrue:[
dict at:#numMethodsOrEmpty put:( ' ' , count printString allBold, ' ').
dict at:#inSingleMethodOrEmpty put:''.
dict at:#forSingleMethodOrEmpty put:''.
dict at:#sForPlural put:'s'.
dict at:#singleMethodNameOrNumberOfMethods put:(count printString allBold , ' methods').
] ifFalse:[
method := self selectedMethods value first.
methodName := method mclass nameWithoutPrefix , '>>' , method selector allBold.
dict at:#numMethodsOrEmpty put:' '.
dict at:#inSingleMethodOrEmpty put:' in ' , methodName.
dict at:#forSingleMethodOrEmpty put:' for ' , methodName.
dict at:#sForPlural put:''.
dict at:#singleMethodNameOrNumberOfMethods put:methodName.
].
generator executeCollectedChangesNamed:(nameOfOperation expandPlaceholdersWith:dict)
"Modified: / 30-01-2011 / 15:20:35 / cg"
!
launchSelectedApplication
self startApplication:(self theSingleSelectedClass).
!
moveClasses:classes toCategory:newCategory
"change the class-category of the given classes"
classes do:[:aClass |
"/ must be loaded ...
aClass theNonMetaclass autoload
].
classes do:[:eachClass |
|cls|
cls := eachClass theNonMetaclass.
cls isPrivate ifFalse:[
Smalltalk changeCategoryOf:cls to:newCategory.
]
].
LastCategoryRenames isNil ifTrue:[
LastCategoryRenames := OrderedCollection new.
].
LastCategoryRenames remove:newCategory ifAbsent:nil.
LastCategoryRenames addFirst:newCategory.
LastCategoryRenames size > 10 ifTrue:[
LastCategoryRenames removeLast.
].
!
moveClasses:classes toProject:newProject
"change the packageID of the given classes
(and optionally the packageID of any methods (if they are from different packages)"
|anyClassMoved anyMethodMoved|
anyClassMoved := false.
anyMethodMoved := false.
classes do:[:eachClass |
|oldProject theClass|
theClass := eachClass theNonMetaclass.
(oldProject := theClass package) ~= newProject ifTrue:[
theClass package:newProject.
self doMoveMethodsOfClass:theClass fromProject:oldProject toProject:newProject.
theClass allPrivateClassesDo:[:eachPrivateClass |
self doMoveMethodsOfClass:eachPrivateClass fromProject:oldProject toProject:newProject.
].
anyClassMoved := true.
].
theClass hasExtensions ifTrue:[
(self confirm:(resources string:'%1 has extensions in other packages - move those methods as well ?' with:theClass name))
ifTrue:[
theClass instAndClassSelectorsAndMethodsDo:[:sel :eachMethod |
eachMethod package ~= newProject ifTrue:[
eachMethod package:newProject.
anyMethodMoved := true.
]
].
anyMethodMoved ifTrue:[
theClass changed:#projectOrganization.
theClass theMetaclass changed:#projectOrganization.
Smalltalk changed:#projectOrganization with:(Array with:theClass with:oldProject).
].
].
].
].
anyClassMoved ifTrue:[
Smalltalk changed:#projectOrganization.
].
self rememberLastProjectMoveTo:newProject
"Modified: / 17.2.2000 / 23:04:18 / cg"
!
moveSelectedClassesToCategory:newCategory
"change the class-category of the selected classes"
self moveClasses:(self selectedClasses value) toCategory:newCategory
!
moveSelectedClassesToProject:newProject
"change the packageID of the selected classes
(and optionally the packageID of any methods (if they are from different packages)"
self moveClasses:(self selectedClasses value) toProject:newProject
!
openClassDocumentationFor:aClass
"show a classes documentation (i.e. open doc-View on it)"
Autoload autoloadFailedSignal handle:[:ex |
self warn:'autoload failed.
Check your source directory and/or
the abbreviation file for the classes (correct) shortened name.'.
ex return.
] do:[
|text v|
text := HTMLDocGenerator htmlDocOf:aClass.
text notNil ifTrue:[
v := HTMLDocumentView
openFullOnText:text
inDirectory:(Smalltalk getSystemFileName:'doc/online/english/classDoc').
v nameSpaceForExecution:(aClass nameSpace).
]
]
!
printOutClass:aClass withSelector:aSelector
|printStream|
printStream := Printer new.
aClass perform:aSelector with:printStream.
printStream close
!
printOutClassesWithSelector:aSelector
self selectedClassesWithWaitCursorDo:[:eachClass |
self printOutClass:eachClass withSelector:aSelector
]
!
recompileClassWithInstrumentation:aClass
|cls compile|
"/ aClass theNonMetaclass recompileUsingCompilerClass:InstrumentingCompiler.
"/ aClass theMetaclass recompileUsingCompilerClass:InstrumentingCompiler.
compile :=
[:cls :sel :mthd |
(mthd sends:#subclassResponsibility) ifFalse:[
mthd hasPrimitiveCode ifFalse:[
cls recompile:sel usingCompilerClass:InstrumentingCompiler
]
]
].
(cls := aClass theNonMetaclass)
selectorsAndMethodsDo:[:aSelector :aMethod |
compile value:cls value:aSelector value:aMethod.
].
(cls := aClass theMetaclass)
selectorsAndMethodsDo:[:aSelector :aMethod |
aMethod category ~= 'documentation' ifTrue:[
compile value:cls value:aSelector value:aMethod.
]
].
"Created: / 10-08-2010 / 14:36:45 / cg"
!
recompileMethodWithInstrumentation:aMethod
(aMethod sends:#subclassResponsibility) ifFalse:[
aMethod hasPrimitiveCode ifFalse:[
aMethod mclass
recompile:aMethod selector
usingCompilerClass:InstrumentingCompiler
]
]
"Created: / 10-08-2010 / 14:41:17 / cg"
!
removeClasses:classesToRemove pullUpSubclasses:pullUpSubclasses
"remove the selected classes (and all of its subclasses) without confirmation"
|numClasses change nm|
classesToRemove size == 0 ifTrue:[^ self].
self withWaitCursorDo:[
self canUseRefactoringSupport ifFalse:[
classesToRemove do:[:each |
each removeFromSystem.
].
^ self.
].
pullUpSubclasses ifTrue:[
classesToRemove do:[:eachClass |
self performRefactoring:(RemoveClassRefactoring className:eachClass name).
]
] ifFalse:[
numClasses := classesToRemove size.
numClasses > 1 ifTrue:[
numClasses == 2 ifTrue:[
nm := 'Remove ', classesToRemove first theNonMetaclass name , ' and ' , classesToRemove second theNonMetaclass name
] ifFalse:[
nm := 'Remove ', numClasses printString , ' classes'
]
] ifFalse:[
nm := 'Remove ', classesToRemove first theNonMetaclass name
].
change := CompositeRefactoryChange named:nm.
classesToRemove do:[:eachClass |
change removeClass:eachClass
].
RefactoryChangeManager performChange:change
]
]
!
saveClassDocumentationFor:aClass
"save a classes documentation to a file"
Autoload autoloadFailedSignal handle:[:ex |
self warn:'autoload failed.
Check your source directory and/or
the abbreviation file for the classes (correct) shortened name.'.
ex return.
] do:[
|fileBox dir saveName|
fileBox := FileSelectionBox
title:(resources string:'save HTML doc of ''%1'' as:' with:aClass name)
okText:(resources string:'save')
abortText:(resources string:'cancel')
action:[:fileName | saveName := fileName].
fileBox initialText:((Smalltalk fileNameForClass:aClass) , '.html').
dir := FileSelectionBox lastFileSelectionDirectory.
dir notNil ifTrue:[
fileBox directory:dir.
].
fileBox showAtPointer.
fileBox destroy.
saveName isNil ifTrue:[
^ self
].
saveName isEmpty ifTrue:[
self warn:'bad name given'.
^ self
].
FileSelectionBox lastFileSelectionDirectory:(saveName asFilename directoryName).
self saveClassDocumentationFor:aClass as:saveName
]
!
saveClassDocumentationFor:aClass as:aFileName
"save a classes documentation to a file"
|text f|
text := HTMLDocGenerator htmlDocOf:aClass.
text notNil ifTrue:[
f := aFileName asFilename writeStream.
f nextPutAll:text asString.
f close.
]
!
spawnClassBrowserFor:classes in:where
"browse selected class(es);
where is: #newBrowser - open a new browser showing the classes
where is: #newBuffer - add a new buffer showing the classes"
^ self spawnClassBrowserFor:classes label:nil in:where
!
spawnClassBrowserFor:classes in:where select:doSelect
"browse selected class(es);
where is: #newBrowser - open a new browser showing the classes
where is: #newBuffer - add a new buffer showing the classes"
^ self spawnClassBrowserFor:classes label:nil in:where select:doSelect
!
spawnClassBrowserFor:classes label:titleOrNil in:where
"browse selected class(es);
where is: #newBrowser - open a new browser showing the classes
where is: #newBuffer - add a new buffer showing the classes"
|allClasses|
allClasses := OrderedCollection new.
classes do:[:eachClass |
eachClass withAllPrivateClassesDo:[:everyClass |
allClasses add:everyClass
].
].
^ self spawnClassBrowserFor:allClasses label:titleOrNil in:where select:true
!
spawnClassBrowserFor:classes label:labelOrNil in:where select:doSelectIn
"browse selected class(es);
where is: #newBrowser - open a new browser showing the classes
where is: #newBuffer - add a new buffer showing the classes"
|spec meta allClasses selectedClasses selectedProtocols selectedMethods
singleSelection singleClass doSelect|
doSelect := doSelectIn.
(singleSelection := (classes size == 1)) ifTrue:[
spec := #singleClassBrowserSpec.
singleClass := classes first.
meta := singleClass isMeta.
doSelect := true.
] ifFalse:[
spec := #multipleClassBrowserSpec.
meta := self meta value ? false.
].
allClasses := classes collect:[:cls | cls theNonMetaclass].
doSelect ifTrue:[
selectedClasses := classes copy.
navigationState notNil ifTrue:[
selectedProtocols := self selectedProtocols value copy.
selectedMethods := self selectedMethods value copy.
(selectedMethods size > 0
and:[ selectedProtocols size == 0 ]) ifTrue:[
selectedProtocols := (selectedMethods collect:[:each | each category]) asSet asOrderedCollection
].
]
].
^ self
newBrowserOrBufferDependingOn:where
label:labelOrNil
forSpec:spec
setupWith:[:brwsr |
brwsr immediateUpdate value:true.
brwsr classListGenerator value:allClasses.
brwsr meta value:meta.
doSelect ifTrue:[
brwsr selectClasses:selectedClasses.
selectedProtocols size > 0 ifTrue:[
brwsr selectProtocols:selectedProtocols.
].
brwsr selectMethods:selectedMethods.
].
brwsr immediateUpdate value:false.
"/ kludge - enforce generator update when meta changes
brwsr meta onChangeEvaluate:[ brwsr classListGenerator changed ].
]
"Modified: / 1.3.2000 / 11:54:08 / cg"
!
spawnClassBrowserForSearch:searchBlock sortBy:sortByWhat in:openHow label:lbl
"browse some class(es);
openHow is: #newBrowser - open a new browser showing the method(s)
openHow is: #newBuffer - add a new buffer showing the method(s)
and sortByWhat is:
nil
or #class
"
^ self
spawnClassBrowserForSearch:searchBlock
spec:#multipleClassBrowserSpec
sortBy:sortByWhat in:openHow label:lbl
"Modified: / 2.11.2001 / 09:57:35 / cg"
!
spawnClassBrowserForSearch:searchBlock spec:spec sortBy:sortByWhat in:openHow label:lbl
"browse some class(es);
openHow is: #newBrowser - open a new browser showing the method(s)
openHow is: #newBuffer - add a new buffer showing the method(s)
and sortByWhat is:
nil
or #class
"
^ self
spawnClassBrowserForSearch:searchBlock
spec:spec
sortBy:sortByWhat in:openHow label:lbl
autoSelectIfOne:true
"Modified: / 2.11.2001 / 09:58:01 / cg"
!
spawnClassBrowserForSearch:searchBlock spec:spec sortBy:sortByWhat in:openHow label:lbl autoSelectIfOne:doAutoSelectIfOne
"browse some class(es);
openHow is: #newBrowser - open a new browser showing the method(s)
openHow is: #newBuffer - add a new buffer showing the method(s)
and sortByWhat is:
nil
or #class
"
^ self
spawnClassBrowserForSearch:searchBlock
spec:spec
sortBy:sortByWhat in:openHow label:lbl
autoSelectIfOne:doAutoSelectIfOne callBack:nil
"Modified: / 5.11.2001 / 09:36:13 / cg"
!
spawnClassBrowserForSearch:searchBlock spec:spec sortBy:sortByWhat in:openHow label:lbl autoSelectIfOne:doAutoSelectIfOne callBack:callBack
"browse some class(es);
openHow is: #newBrowser - open a new browser showing the method(s)
openHow is: #newBuffer - add a new buffer showing the method(s)
and sortByWhat is:
nil
or #class
"
|initialList|
initialList := searchBlock value.
initialList size == 0 ifTrue:[
self warn:(lbl , ' - none found.').
^ nil
].
^ self
newBrowserOrBufferDependingOn:openHow
label:lbl
forSpec:spec
setupWith:[:brwsr |
|generator theClassList|
generator := Iterator on:[:whatToDo |
initialList size > 0 ifTrue:[
theClassList := initialList.
initialList := nil
] ifFalse:[
theClassList isNil ifTrue:[
theClassList := searchBlock value.
].
].
theClassList do:[:aClass |
whatToDo value:aClass
].
theClassList := nil.
].
sortByWhat notNil ifTrue:[brwsr sortBy value:sortByWhat].
brwsr classListGenerator value:generator.
"/ auto-select the first class, if there is only one
callBack notNil ifTrue:[callBack value:brwsr].
initialList isNil ifTrue:[
"/ newBuffer will evaluate the generator later;
"/ newBrowser might have it already evaluated ... (sigh)
initialList := theClassList := searchBlock value
].
(doAutoSelectIfOne and:[initialList size == 1]) ifTrue:[
brwsr selectClasses:initialList.
brwsr classSelectionChanged.
].
]
"Modified: / 3.11.2001 / 14:11:05 / cg"
"Created: / 5.11.2001 / 09:35:52 / cg"
!
spawnClassOrSubclassReferencesBrowserFor:aCollectionOfClasses in:openHow
"add a buffer/open a new browser showing references to selected classes and their subclasses"
|lbl searchBlock cachedList brwsr singleClassName|
aCollectionOfClasses size == 1 ifTrue:[
singleClassName := aCollectionOfClasses first theNonMetaclass name.
lbl := 'References to ' , singleClassName , ' and its subclasses'
] ifFalse:[
lbl := 'References to classes and their subclasses'
].
searchBlock := [
|allRefs|
cachedList notNil ifTrue:[
allRefs := cachedList.
cachedList := nil.
] ifFalse:[
allRefs := IdentitySet new.
aCollectionOfClasses do:[:eachClassInQuestion |
|syms refsHere|
syms := eachClassInQuestion theNonMetaclass withAllSubclasses collect:[:cls | cls name].
refsHere := self class
findMethodsIn:(Smalltalk allClasses)
where:[:cls :mthd :sel | |mSource|
"/ kludge: Lazy methods do not include symbols in the literal array - sigh
mthd isLazyMethod ifTrue:[
mSource := mthd source.
(mSource notNil
and:[(syms contains:[:sym | (mSource includesString:sym)])
and:[|usedGlobals|
usedGlobals := mthd usedGlobals.
syms contains:[:sym | usedGlobals includes:sym]]])
] ifFalse:[
((syms contains:[:sym | mthd referencesLiteral:sym])
and:[|usedGlobals|
usedGlobals := mthd usedGlobals.
syms contains:[:sym | usedGlobals includes:sym]])
]
].
allRefs addAll:refsHere.
].
].
allRefs
].
(cachedList := searchBlock value) isEmpty ifTrue:[
self information:(lbl , ' - none found').
^ self
].
brwsr := self spawnMethodBrowserForSearch:searchBlock sortBy:#class in:openHow label:lbl.
brwsr notNil ifTrue:[
singleClassName notNil ifTrue:[
brwsr autoSearchPattern:singleClassName ignoreCase:false.
]
].
!
spawnClassProjectsBrowserFor:aCollectionOfClasses in:openHow
"add a buffer / open a new browser showing the selected classes projects"
|projects|
projects := Set new.
aCollectionOfClasses do:[:eachClass |
projects add:eachClass package.
eachClass instAndClassSelectorsAndMethodsDo:[:sel :mthd | projects add:(mthd package)].
].
self spawnProjectBrowserFor:projects in:openHow
"Modified: / 18.8.2000 / 19:25:11 / cg"
!
spawnClassReferencesBrowserFor:aCollectionOfClasses in:openHow
"add a buffer/open a new browser showing references to selected classes"
|lbl searchBlock cachedList brwsr singleClassName|
aCollectionOfClasses size == 1 ifTrue:[
singleClassName := aCollectionOfClasses first theNonMetaclass name.
lbl := 'References to ' , singleClassName
] ifFalse:[
lbl := 'References to classes'
].
searchBlock := [
|allRefs|
cachedList notNil ifTrue:[
allRefs := cachedList.
cachedList := nil.
] ifFalse:[
allRefs := IdentitySet new.
aCollectionOfClasses do:[:eachClassInQuestion |
|sym symInsideNamespace symInsideOwner refsHere|
sym := eachClassInQuestion theNonMetaclass name.
refsHere := self class
findMethodsIn:(Smalltalk allClasses)
where:[:cls :mthd :sel |
|mSource|
"/ kludge: Lazy methods do not include symbols in the literal array - sigh
mthd isLazyMethod ifTrue:[
mSource := mthd source.
(mSource notNil
and:[(mSource includesString:sym)
and:[mthd usedGlobals includes:sym]])
] ifFalse:[
((mthd referencesLiteral:sym)
and:[mthd usedGlobals includes:sym])
]
].
allRefs addAll:refsHere.
(eachClassInQuestion nameSpace notNil
and:[ eachClassInQuestion nameSpace ~~ Smalltalk ]) ifTrue:[
symInsideNamespace := eachClassInQuestion theNonMetaclass nameWithoutNameSpacePrefix asSymbol.
refsHere := self class
findMethodsIn:(eachClassInQuestion topNameSpace allClassesWithAllPrivateClasses)
where:[:cls :mthd :sel |
|mSource|
"/ kludge: Lazy methods do not include symbols in the literal array - sigh
mthd isLazyMethod ifTrue:[
mSource := mthd source.
(mSource notNil
and:[(mSource includesString:symInsideNamespace)
and:[mthd usedGlobals includes:sym]])
] ifFalse:[
((mthd referencesLiteral:symInsideNamespace)
and:[mthd usedGlobals includes:sym])
]
].
allRefs addAll:refsHere.
].
(eachClassInQuestion owningClass notNil) ifTrue:[
symInsideOwner := eachClassInQuestion theNonMetaclass nameWithoutPrefix asSymbol.
refsHere := self class
findMethodsIn:(Array with:eachClassInQuestion owningClass)
where:[:cls :mthd :sel |
|mSource|
"/ kludge: Lazy methods do not include symbols in the literal array - sigh
mthd isLazyMethod ifTrue:[
mSource := mthd source.
(mSource notNil
and:[(mSource includesString:symInsideOwner)
and:[mthd usedGlobals includes:sym]])
] ifFalse:[
((mthd referencesLiteral:symInsideOwner)
and:[mthd usedGlobals includes:sym])
]
].
allRefs addAll:refsHere.
].
].
].
allRefs
].
self withSearchCursorDo:[
cachedList := searchBlock value.
].
cachedList isEmpty ifTrue:[
self information:(lbl , ' - none found').
^ self
].
brwsr := self spawnMethodBrowserForSearch:searchBlock sortBy:#class in:openHow label:lbl.
brwsr notNil ifTrue:[
singleClassName notNil ifTrue:[
brwsr autoSearchPattern:singleClassName ignoreCase:false.
]
].
!
spawnMultipleClassBrowserFor:classes sortBy:sortHow in:where
"browse selected class(es);
where is: #newBrowser - open a new browser showing the classes
where is: #newBuffer - add a new buffer showing the classes"
|allClasses
"/ selectedClasses selectedProtocols selectedMethods
|
allClasses := classes collect:[:cls | cls theNonMetaclass].
"/ selectedClasses := classes copy.
"/ selectedProtocols := self selectedProtocols value copy.
"/ selectedMethods := self selectedMethods value copy.
^ self
newBrowserOrBufferDependingOn:where
label:nil
forSpec:#multipleClassBrowserSpec
setupWith:[:brwsr |
brwsr sortBy value:sortHow.
brwsr immediateUpdate value:true.
brwsr classListGenerator value:allClasses.
brwsr meta value:(self meta value).
"/ brwsr selectClasses:selectedClasses.
"/ brwsr selectProtocols:selectedProtocols.
"/ brwsr selectMethods:selectedMethods.
"/ kludge - enforce generator update when meta changes
brwsr immediateUpdate value:false.
brwsr meta onChangeEvaluate:[ brwsr classListGenerator changed ].
]
"Modified: / 1.3.2000 / 11:54:08 / cg"
!
spawnWithAllSubclassesIn:how
"open a new browser showing the selected classes with all subclasses"
|all allOrdered brwsr|
all := IdentitySet new.
allOrdered := OrderedCollection new.
self selectedNonMetaclassesDo:[:each |
each withAllSubclasses do:[:eachClass |
(all includesIdentical:eachClass) ifFalse:[
all add:eachClass.
allOrdered add:eachClass
]
]
].
(all removeAllFoundIn:self selectedClasses value; yourself) isEmpty ifTrue:[
self information:'No additional subclasses (same as selected).'.
^ self
].
brwsr := self spawnMultipleClassBrowserFor:allOrdered sortBy:#doNotSort in:how.
"Modified: / 12-09-2006 / 13:43:19 / cg"
!
spawnWithAllSuperclassesIn:how
"open a new browser showing the selected classes with all superclasses"
|all allOrdered brwsr|
all := IdentitySet new.
allOrdered := OrderedCollection new.
self selectedNonMetaclassesDo:[:each |
each withAllSuperclasses reverse do:[:eachClass |
(all includesIdentical:eachClass) ifFalse:[
all add:eachClass.
allOrdered add:eachClass
]
]
].
(all removeAllFoundIn:(self selectedClasses value); yourself) isEmpty ifTrue:[
self information:'No additional superclasses (same as selected).'.
^ self
].
brwsr := self spawnMultipleClassBrowserFor:allOrdered sortBy:#doNotSort in:how.
"Modified: / 12-09-2006 / 13:43:11 / cg"
!
variablesMenuGenerateMultiSetterMethod
"create a multi setter method for selected instvars."
self classMenuGenerateMultiSetterMethod
! !
!NewSystemBrowser methodsFor:'menu actions-class hierarchy'!
classHierarchyMenuSelectWithAllSubclasses
|topClasses classes|
topClasses := self selectedClassHierarchyClasses.
classes := topClasses asSet collectAll:[:eachClass | eachClass withAllSubclasses].
self selectedClasses value:classes.
!
classHierarchyMenuSelectWithSubclasses
|topClasses classes|
topClasses := self selectedClassHierarchyClasses.
classes := topClasses asSet collectAll:[:eachClass | eachClass subclasses].
classes addAll: topClasses.
self selectedClasses value:classes.
!
classHierarchyMenuSelectWithSuperclasses
|topClasses classes|
topClasses := self selectedClassHierarchyClasses.
classes := topClasses asSet collectAll:[:eachClass | eachClass withAllSuperclasses].
self selectedClasses value:classes.
!
classHierarchyMenuUpdate
self classHierarchyTopClass value:(self theSingleSelectedClass).
!
selectedClassHierarchyClasses
|class|
class := self theSingleSelectedClass.
class isNil ifTrue:[
class := self classHierarchyTopClass value.
class notNil ifTrue:[
self meta value ifTrue:[
class := class theMetaclass.
] ifFalse:[
class := class theNonMetaclass.
]
].
].
class notNil ifTrue:[
^ Array with:class
].
^ self selectedClasses
! !
!NewSystemBrowser methodsFor:'menu actions-class packaging'!
excludeClasses: toExclude fromProject:aDefinitionClass using:generator
"exclude (remove from classList) a number of classes."
aDefinitionClass excludeClasses:toExclude usingCompiler:generator.
!
includeClassInProject:aClass using:compiler
"include (add to classList) a class."
self
includeClasses:(Array with: aClass)
inProject:aClass projectDefinitionClass
using:compiler
!
includeClasses: toInclude inProject:aDefinitionClass using:compiler
"include (add to classList) a number of classes."
aDefinitionClass includeClasses:toInclude usingCompiler:compiler.
!
makeClassesAutoloaded:toMakeAutoloaded inProject:aDefinitionClass using:generator
"include as autoloaded (add to classList) a number of classes."
aDefinitionClass makeClassesAutoloaded:toMakeAutoloaded usingCompiler:generator
! !
!NewSystemBrowser methodsFor:'menu actions-class repository'!
checkInClasses:aCollectionOfClasses withInfo:logInfoOrNil withCheck:doCheck
"check a bunch of classes into the source repository.
If logInfoOrNil isNil, ask for one."
|classesNotInPackage msg answer errors|
errors := self checkCompilabilityOfAll:aCollectionOfClasses errorsOnly:true.
errors notEmptyOrNil ifTrue:[
(TextBox openOn:errors title:'Attention: about to check in class with errors' readOnly:true) isNil
ifTrue:[
AbortSignal raise
].
].
self withActivityNotificationsRedirectedToInfoLabelDo:[
SourceCodeManagerUtilities
checkinClasses:aCollectionOfClasses
withInfo:logInfoOrNil
withCheck:doCheck.
].
classesNotInPackage := aCollectionOfClasses select:[:cls |
|pkg def|
pkg := cls package.
pkg notNil ifTrue:[
def := ProjectDefinition definitionClassForPackage:pkg.
].
def notNil and:[
(def allClassNames includes:cls name) not]
].
classesNotInPackage := classesNotInPackage collect:[:cls | cls theNonMetaclass].
classesNotInPackage notEmpty ifTrue:[
classesNotInPackage size > 1 ifTrue:[
msg := 'Add %2 classes to their Package definition (Make compiled or autoloaded) ?'
] ifFalse:[
msg := 'Add %1 to its Package definition (Make compiled or autoloaded) ?'
].
answer := Dialog
confirmWithCancel:((resources string:msg
with:classesNotInPackage first name
with:classesNotInPackage size)
, (resources
stringWithCRs:'\\(Notice: You have to "checkIn build support files" for the package\for the compilation to become effective)')
)
labels:(resources array:#('Cancel' 'Autoloaded' 'Compiled')).
answer == nil ifTrue:[^ self ].
answer == true ifTrue:[
classesNotInPackage do:[:eachClass |
eachClass projectDefinitionClass
includeClasses:{ eachClass } usingCompiler:nil
].
] ifFalse:[
classesNotInPackage do:[:eachClass |
eachClass projectDefinitionClass
makeClassesAutoloaded:{ eachClass } usingCompiler:nil
].
].
].
"Modified: / 02-11-2010 / 13:19:35 / cg"
!
checkOutClass:aClass askForRevision:askForRevision
"check-out a single class from the source repository.
Offer a chance to either merge-in a version, or overload the current version.
If askForRevision is false, fetch the newest revision(s),
otherwise ask for the revision."
self withActivityNotificationsRedirectedToInfoLabelDo:[
SourceCodeManagerUtilities
checkoutClass:aClass askForRevision:askForRevision askForMerge:true.
]
"Modified: / 01-03-2007 / 17:47:32 / cg"
!
checkOutClasses:classes askForRevision:askForRevision
"check-out a bunch of classes from the source repository.
Offer chance to either overwrite the current version,
or merge-in the repository version.
If askForRevision is false, fetch the newest revision(s),
otherwise ask for the revision."
|alreadyCheckedOut|
(self askIfModified:'Code was modified.\\CheckOut anyway ?')
ifFalse:[^ self].
classes isEmpty ifTrue:[
Dialog warn:'No classes to checkout'.
"/ SourceCodeManagerUtilities
"/ checkoutClass:nil
"/ askForRevision:true
"/ askForMerge:false.
^ self
].
alreadyCheckedOut := IdentitySet new.
AbortAllOperationRequest handle:[:ex |
ex return.
] do:[
self
classes:classes
nonMetaDo:
[:cls |
UserInformation handle:[:ex |
classes size > 1 ifTrue:[
Transcript showCR:ex description.
] ifFalse:[
(Dialog confirm:ex description noLabel:'Cancel') ifFalse:[
AbortSignal raise
].
].
ex proceed.
] do:[
self withActivityNotificationsRedirectedToInfoLabelDo:[
SourceCodeManagerUtilities
checkoutClass:cls askForRevision:askForRevision askForMerge:true askForConfirmation:false.
].
alreadyCheckedOut add:cls.
]
]
ifUnloaded:
[:cls | true]
ifPrivate:
[:cls | |owner answer|
owner := cls topOwningClass.
(alreadyCheckedOut includes:owner) ifFalse:[
(self selectedClasses value includes:owner) ifFalse:[
answer := Dialog
confirmWithCancel:(resources string:'Cannot checkOut private class: %1\\Shall the owner ''%2'' be checked out ?'
with:cls nameWithoutPrefix allBold
with:owner name) withCRs
default:true.
answer == nil ifTrue:[
AbortAllOperationRequest raise "/ cancel
].
answer == true ifTrue:[
self checkOutClass:owner askForRevision:askForRevision.
alreadyCheckedOut add:owner.
].
]
]
].
].
self normalLabel.
"Modified: / 15-10-2007 / 11:40:35 / cg"
!
classMenuCheckIn
"check a class into the source repository (with checks)"
|doChecks|
doChecks := (UserPreferences current at:#checkClassesWhenCheckingIn ifAbsent:true).
doChecks := doChecks asValue.
self classMenuCheckIn:doChecks.
doChecks value ~~ (UserPreferences current at:#checkClassesWhenCheckingIn ifAbsent:true) ifTrue:[
UserPreferences current at:#checkClassesWhenCheckingIn put:doChecks value
].
!
classMenuCheckIn:doCheck
"check a class into the source repository.
If doCheck is true, perform some checks (leftover halts etc.) on
the class (which may take some time with huge classes).
Otherwise, a no check is done, and the class is quickly checked in.
"
^ self
classMenuCheckIn:doCheck
classes:(self selectedClasses value)
!
classMenuCheckIn:doCheck classes:classesSelected
"check a class into the source repository.
If doCheck is true, perform some checks (leftover halts etc.) on
the class (which may take some time with huge classes).
Otherwise, a no check is done, and the class is quickly checked in.
"
|classesToCheckIn|
(self askIfModified:'Code was modified.\\CheckIn (without that modification) anyway ?')
ifFalse:[^ self].
classesToCheckIn := IdentitySet new.
self
classes:classesSelected
nonMetaDo:
[:cls |
InformationSignal handle:[:ex |
Transcript showCR:ex description.
ex proceed.
] do:[
classesToCheckIn add:cls.
]
]
ifUnloaded:
[:cls |
(Dialog confirm:('Cannot checkin unloaded class: %1.' bindWith:cls name allBold)
title:'Cannot Checkin' yesLabel:'OK' noLabel:'Cancel' ) ifFalse:[^ self].
false.
]
ifPrivate:
[:cls | |owner answer|
owner := cls topOwningClass.
(classesToCheckIn includes:owner) ifFalse:[
(classesSelected "self selectedClasses value" includes:owner) ifFalse:[
answer := Dialog
confirmWithCancel:(resources string:'Cannot checkin private class: %1\\Shall the owner ''%2'' be checked in ?'
with:cls nameWithoutPrefix allBold
with:owner name allBold) withCRs
default:true.
answer == nil ifTrue:[
^ self
].
answer == true ifTrue:[
classesToCheckIn add:owner.
].
]
]
].
classesToCheckIn notEmpty ifTrue:[
self checkInClasses:classesToCheckIn withInfo:nil withCheck:doCheck.
].
self normalLabel.
!
classMenuCheckInAllChangedClasses
"check in all changed classes into the source repository (with checks)"
|doChecks|
doChecks := (UserPreferences current at:#checkClassesWhenCheckingIn ifAbsent:true).
^ self classMenuCheckInAllChangedClasses:doChecks
!
classMenuCheckInAllChangedClasses:doCheck
"check all changed classes into the source repository.
If doCheck is true, perform some checks (leftover halts etc.) on
the class (which may take some time with huge classes).
Otherwise, a no check is done, and the class is quickly checked in.
"
^ self
classMenuCheckIn:doCheck
classes:(ChangeSet current changedClasses)
!
classMenuCheckInExtensions
"check a classes extensions into the source repository (with checks)"
|doChecks|
doChecks := (UserPreferences current at:#checkClassesWhenCheckingIn ifAbsent:true).
^ self classMenuCheckInExtensions:doChecks
!
classMenuCheckInExtensions:doCheck
"check a classes extensions into the source repository.
If doCheck is true, perform some checks (leftover halts etc.) on
the class (which may take some time with huge classes).
Otherwise, a no check is done, and the class is quickly checked in.
"
|projects|
(self askIfModified:'Code was modified.\\CheckIn (without that modification) anyway ?')
ifFalse:[^ self].
projects := Set new.
self selectedClassesDo:[:eachClass |
eachClass instAndClassSelectorsAndMethodsDo:[:sel :mthd | projects add:mthd package].
].
projects do:[:eachProject |
self
projectMenuCheckInProject:eachProject
classes:false
extensions:true
buildSupport:false
askForMethodsInOtherPackages:false
].
!
classMenuCheckInExtensionsFor:aProjectID
"check some of a classes extensions into the source repository."
(self askIfModified:'Code was modified.\\CheckIn (without that modification) anyway ?')
ifFalse:[^ self].
self
projectMenuCheckInProject:aProjectID
classes:false
extensions:true
buildSupport:false
askForMethodsInOtherPackages:false
!
classMenuCheckOut
"check-out selected class(es) from the source repository.
Individually ask for class revisions.
Offer chance to either overwrite the current version,
or merge-in the repository version.
"
self checkOutClasses:(self selectedClasses value) askForRevision:true
!
classMenuCheckOutNewest
"check-out the newest version of the selected class(es) from the source repository.
Offer chance to either overwrite the current version,
or merge-in the repository version.
"
self checkOutClasses:(self selectedClasses value) askForRevision:false
!
classMenuCompareAgainstNewestInRepository
"open a diff-textView comparing the current (in-image) version
with the the newest version found in the repository.
That is the most recent version."
self doCompareClassesWithRepository:(self selectedClasses value).
"Modified: / 13-10-2006 / 11:44:09 / cg"
!
classMenuCompareAgainstOriginalInRepository
"open a diff-textView comparing the current (in-image) version
with the the base version found in the repository.
That is the version on which the class was based upon, not the most recent one."
|currentClass
aStream comparedSource currentSource rev revString thisRevString mgr
nm msg newestRev brwsr|
currentClass := self theSingleSelectedLoadedNonMetaclassOrNil.
currentClass isNil ifTrue:[
self warn:'Cannot compare unloaded classes.'.
^ self.
].
nm := currentClass name.
mgr := SourceCodeManagerUtilities sourceCodeManagerFor:currentClass.
mgr isNil ifTrue:[
^ self
].
rev := currentClass binaryRevision.
rev isNil ifTrue:[
rev := currentClass revision.
].
rev isNil ifTrue:[
self warn:'The class seems to have no repository information.'.
^ self
].
"/
"/ class in repository - ask for revision
"/
msg := 'extracting revision %1'.
self busyLabel:msg with:rev.
self withActivityNotificationsRedirectedToInfoLabelDo:[
aStream := mgr getSourceStreamFor:currentClass revision:rev.
].
aStream isNil ifTrue:[
self warn:'Could not extract source from repository.'.
^ self
].
aStream class readErrorSignal handle:[:ex |
self warn:('Read error while reading extracted source:\\' , ex description) withCRs.
aStream close.
^ self
] do:[
comparedSource := aStream contents asString.
].
aStream close.
self busyLabel:'generating current source ...' with:nil.
aStream := '' writeStream.
Method flushSourceStreamCache.
currentClass fileOutOn:aStream withTimeStamp:false.
currentSource := aStream contents asString.
aStream close.
self busyLabel:'comparing ...' with:nil.
comparedSource = currentSource ifTrue:[
self information:'Versions are identical.'.
] ifFalse:[
thisRevString := currentClass revision.
thisRevString isNil ifTrue:[
thisRevString := 'no revision'
].
revString := rev.
"/ this takes some time ... is it worth ?
(newestRev := mgr newestRevisionOf:currentClass) notNil ifTrue:[
newestRev ~= rev ifTrue:[
revString := rev , ' (newest is ' , newestRev , ')'
]
].
self busyLabel:'comparing ...' with:nil.
brwsr := (UserPreferences versionDiffViewerClass)
openOnClass:currentClass
labelA:('repository: ' , revString)
sourceA:comparedSource
labelB:('current: (based on: ' , rev , ')')
sourceB:currentSource
title:('comparing ' , currentClass name)
ifSame:[self normalLabel. self information:'Versions are identical.'. ^ self].
brwsr classChangeSet
classBeingCompared:currentClass;
versionA:rev;
versionB:rev , 'mod'.
].
self normalLabel.
"Modified: / 01-03-2007 / 20:47:37 / cg"
!
classMenuCompareExtensionsWithRepository
"open a diff-textView comparing the current (in-image) extensions version
with the some extensions version found in the repository."
|currentClass projectDefinition rev revString mgr msg newestRev diffSet info versionsAreTheSame changeSetForMethodsInRepository changeSetForMethodsInImage|
currentClass := self theSingleSelectedLoadedNonMetaclassOrNil.
(currentClass isNil
or:[(projectDefinition := currentClass theNonMetaclass) isProjectDefinition not]) ifTrue:[
self warn:'Oops - select a ProjectDefinition class.'.
^ self.
].
mgr := SourceCodeManagerUtilities sourceCodeManagerFor:projectDefinition.
mgr isNil ifTrue:[
^ self
].
revString := projectDefinition perform:(mgr nameOfVersionMethodForExtensions) ifNotUnderstood:nil.
revString isNil ifTrue:[
self warn:('%1 seems to not have any extensions (loaded)' bindWith:projectDefinition package).
^ self.
].
info := mgr revisionInfoFromString:revString.
rev := info revision.
"/
"/ ask for revision
"/
newestRev := mgr
newestRevisionInFile:'extensions.st'
directory:(projectDefinition directory)
module:(projectDefinition module).
msg := resources string:'Compare to revision: (empty for newest)'.
rev notNil ifTrue:[
msg := msg , '\\' , (resources string:'Current extensions.st is based upon rev %1.'
with:rev).
].
newestRev notNil ifTrue:[
msg := msg , '\' , (resources string:'Newest in reporitory is %1.'
with:newestRev)
].
self normalLabel.
rev := SourceCodeManagerUtilities
askForExistingRevision:msg
title:'Compare Extensions against Revision'
class:nil
manager:mgr
module:projectDefinition module package:projectDefinition directory
fileName:'extensions.st'.
versionsAreTheSame := false.
rev isNil ifTrue:[
self normalLabel.
^ self.
].
rev withoutSpaces isEmpty ifTrue:[
msg := 'extracting newest %1 (' , (newestRev ? '???') , ')'.
rev := newestRev.
revString := 'newest'.
] ifFalse:[
msg := 'extracting previous %1'.
revString := rev
].
changeSetForMethodsInRepository :=
SourceCodeManagerUtilities
changeSetForExtensionMethodsForPackage:projectDefinition package
revision:revString orAskForRevision:false
using:mgr.
changeSetForMethodsInImage := ChangeSet forExistingMethods:(
Method allInstances
select:[:m | m package = projectDefinition package
and:[ m mclass isNil
or:[m package ~= m mclass package]]]).
diffSet := changeSetForMethodsInImage diffSetsAgainst:changeSetForMethodsInRepository.
(UserPreferences versionDiffViewerClass)
openOnDiffSet:diffSet
labelA:'Current (In Image)'
labelB:'Repository (',rev,')'
title:'Diffs'.
self normalLabel.
"Created: / 04-01-1997 / 15:48:20 / cg"
"Modified: / 01-03-2007 / 20:50:08 / cg"
!
classMenuCompareTwoRepositoryVersions
"open a diff-textView comparing two versions found in the repository."
|currentClass source1 source2 sources mgr
nm rev1 rev2 versionsAreTheSame|
currentClass := self theSingleSelectedLoadedNonMetaclassOrNil.
currentClass isNil ifTrue:[
self warn:'Cannot compare unloaded classes.'.
^ self.
].
nm := currentClass name.
mgr := SourceCodeManagerUtilities sourceCodeManagerFor:currentClass.
mgr isNil ifTrue:[
^ self
].
self normalLabel.
rev1 := SourceCodeManagerUtilities
askForExistingRevision:(resources string:'Compare which revision:')
title:(resources string:'Compare which repository version')
class:currentClass.
rev1 isNil ifTrue:[^ self].
rev2 := SourceCodeManagerUtilities
askForExistingRevision:(resources string:'Against which revision:')
title:(resources string:'Against which repository version')
class:currentClass.
rev2 isNil ifTrue:[^ self].
self breakPoint:#cg.
versionsAreTheSame := false.
sources := (Array with:rev1 with:rev2)
collect:[:rev |
|msg stream source|
msg := 'extracting previous %1'.
stream := mgr getSourceStreamFor:currentClass revision:rev.
self busyLabel:msg with:rev.
stream isNil ifTrue:[
self warn:(resources
string:'Could not extract source of rev %1 from repository'
with:rev).
^ self
].
stream class readErrorSignal handle:[:ex |
self warn:('read error while reading extracted source\\' , ex description) withCRs.
stream close.
^ self
] do:[
source := stream contents asString.
].
stream close.
source
].
source1 := sources at:1.
source2 := sources at:2.
self busyLabel:'comparing ...' with:nil.
versionsAreTheSame := (source1 = source2).
versionsAreTheSame ifFalse:[
self busyLabel:'comparing ...' with:nil.
(UserPreferences versionDiffViewerClass)
openOnClass:currentClass
labelA:(rev1)
sourceA:source1
labelB:(rev2)
sourceB:source2
title:('comparing ' , currentClass name)
ifSame:[versionsAreTheSame := true].
versionsAreTheSame ifTrue:[
self information:'Versions are identical.'.
].
].
self normalLabel.
!
classMenuCompareWithFile
"compare the class against a version in a file"
|collectionOfClasses classes classesToUnload current fileName fileVersion remote diffs allDiffs title|
collectionOfClasses := self selectedClasses value.
collectionOfClasses do:[:eachClass |
|className metaclassName|
className := eachClass theNonMetaclass name.
metaclassName := eachClass theMetaclass name.
eachClass isLoaded ifFalse:[
Transcript showCR:('Cannot compare unloaded class: ' , eachClass name).
] ifTrue:[
fileName := Dialog requestFileName:'Compare against:'.
fileName isNil ifTrue:[^ self].
self busyLabel:'comparing ...' with:nil.
current := ChangeSet forExistingClass:eachClass theNonMetaclass.
fileVersion := ChangeSet fromFile:fileName.
diffs := fileVersion diffSetsAgainst:current.
allDiffs isNil ifTrue:[
allDiffs := diffs.
] ifFalse:[
allDiffs changed addAll:(diffs changed).
allDiffs onlyInArg addAll:(diffs onlyInArg).
allDiffs onlyInReceiver addAll:(diffs onlyInReceiver).
].
].
].
allDiffs isEmpty ifTrue:[
self information:'The Versions are Equal.'.
] ifFalse:[
title := collectionOfClasses size == 1
ifTrue:['Differences of %1' bindWith:collectionOfClasses first name]
ifFalse:['Differences of %1 classes' bindWith:collectionOfClasses size].
VersionDiffBrowser
openOnDiffSet:allDiffs
labelA:'Version in File ',fileName
labelB:'Image'
title:title.
].
self normalLabel.
"Created: / 29-08-2010 / 14:32:51 / cg"
!
classMenuCompareWithRepository
"open a diff-textView comparing the current (in-image) version
with the some version found in the repository."
|currentClass
aStream comparedSource currentSource rev revString thisRevString mgr
nm msg rev2 newestRev
containerModule containerPackage containerFile rslt
pkg info mod dir versionsAreTheSame|
currentClass := self theSingleSelectedLoadedNonMetaclassOrNil.
currentClass isNil ifTrue:[
self warn:'Cannot compare unloaded classes.'.
^ self.
].
nm := currentClass name.
mgr := SourceCodeManagerUtilities sourceCodeManagerFor:currentClass.
mgr isNil ifTrue:[
^ self
].
rev := currentClass binaryRevision.
rev2 := currentClass revision.
rev isNil ifTrue:[
rev := rev2
].
rev isNil ifTrue:[
"/
"/ class not in repository - allow compare against any other containers newest contents
"/
self normalLabel.
pkg := currentClass package.
(pkg notNil and:[pkg ~= PackageId noProjectID]) ifTrue:[
containerModule := pkg upTo:$:.
containerPackage := pkg copyFrom:(containerModule size + 2).
].
containerModule size == 0 ifTrue:[
containerModule := (SourceCodeManagerUtilities lastModule) ? Project current repositoryModule.
].
containerPackage size == 0 ifTrue:[
containerPackage := (SourceCodeManagerUtilities lastPackage) ? Project current package.
].
rslt := SourceCodeManagerUtilities
askForContainer:(resources string:'The class seems to have no repository information.\\Do you want to compare it against an existing containers contents ?')
title:'Container to compare' note:nil
initialModule:containerModule
initialPackage:containerPackage
initialFileName:(currentClass nameWithoutPrefix , '.st')
forNewContainer:false.
rslt isNil ifTrue:[
"/ canel
^ self
].
containerModule := rslt at:#module.
containerPackage := rslt at:#package.
containerFile := rslt at:#fileName.
SourceCodeManagerUtilities lastModule:containerModule.
SourceCodeManagerUtilities lastPackage:containerPackage.
] ifFalse:[
"/
"/ class in repository - ask for revision
"/
newestRev := mgr newestRevisionOf:currentClass.
msg := resources string:'Compare to revision: (empty for newest)'.
rev notNil ifTrue:[
msg := msg , '\\' , (resources string:'Current %1 is based upon rev %2.'
with:nm allBold with:rev).
(rev2 notNil and:[rev2 ~= rev]) ifTrue:[
msg := msg , '\' , (resources string:'And has been checked into the repository as %1.'
with:rev2)
]
].
newestRev notNil ifTrue:[
msg := msg , '\' , (resources string:'Newest in reporitory is %1.'
with:newestRev)
].
self normalLabel.
rev := SourceCodeManagerUtilities
askForExistingRevision:msg
title:'Compare with repository'
class:currentClass
].
versionsAreTheSame := false.
(rev notNil or:[containerFile notNil]) ifTrue:[
rev notNil ifTrue:[
rev withoutSpaces isEmpty ifTrue:[
msg := 'extracting newest %1 (' , (newestRev ? '???') , ')'.
"/ aStream := mgr getMostRecentSourceStreamForClassNamed:nm.
rev := newestRev.
revString := 'newest'.
] ifFalse:[
msg := 'extracting previous %1'.
revString := rev
].
aStream := mgr getSourceStreamFor:currentClass revision:rev.
] ifFalse:[
msg := 'extracting newest version from ' , containerModule , '/' , containerPackage, '/' , containerFile.
aStream := mgr streamForClass:nil fileName:containerFile revision:#newest directory:containerPackage module:containerModule cache:false.
revString := '???'
].
self busyLabel:msg with:nm.
aStream isNil ifTrue:[
info := mgr sourceInfoOfClass:currentClass.
info notNil ifTrue:[
mod := info at:#module ifAbsent:'??'.
dir := info at:#directory ifAbsent:'??'.
].
self warn:(resources
string:'Could not extract source from repository (for module: ''%1'' , directory: ''%2'' , revision: ''%3'')'
with:mod with:dir with:revString).
^ self
].
aStream class readErrorSignal handle:[:ex |
self warn:('read error while reading extracted source\\' , ex description) withCRs.
aStream close.
^ self
] do:[
comparedSource := aStream contents asString.
].
aStream close.
self busyLabel:'generating current source ...' with:nil.
aStream := '' writeStream.
Method flushSourceStreamCache.
"/ currentClass fileOutOn:aStream withTimeStamp:false.
"/ currentSource := aStream contents asString.
Class fileOutErrorSignal handle:[:ex |
ex proceed
] do:[
currentSource := currentClass source asString.
].
self busyLabel:'comparing ...' with:nil.
versionsAreTheSame := (comparedSource = currentSource).
versionsAreTheSame ifFalse:[
thisRevString := currentClass revision.
thisRevString isNil ifTrue:[
thisRevString := 'no revision'
].
revString = '(newest)' ifTrue:[
(rev := mgr newestRevisionOf:currentClass) notNil ifTrue:[
revString := '(newest is ' , rev , ')'
]
].
self busyLabel:'comparing ...' with:nil.
(UserPreferences versionDiffViewerClass)
openOnClass:currentClass
labelA:('repository: ' , revString)
sourceA:comparedSource
labelB:('current: (based on: ' , thisRevString , ')')
sourceB:currentSource
title:('comparing ' , currentClass name)
ifSame:[versionsAreTheSame := true].
].
versionsAreTheSame ifTrue:[
((currentClass revision = newestRev)
and:[currentClass hasUnsavedChanges]) ifTrue:[
(self confirm:'Versions are identical.\\Remove entries from changeSet ?' withCRs) ifTrue:[
ChangeSet current condenseChangesForClass:currentClass.
].
] ifFalse:[
self information:'Versions are identical.'.
]
].
].
self normalLabel.
"Created: / 04-01-1997 / 15:48:20 / cg"
"Modified: / 01-03-2007 / 20:50:08 / cg"
!
classMenuCompareWithSmallTeamVersionOnHost:hostName
"compare the class against a version on another SmallTeam host"
|collectionOfClasses classes classesToUnload current remote diffs allDiffs
title|
collectionOfClasses := self selectedClasses value.
classesToUnload := IdentitySet new.
classes :=
collectionOfClasses
collect:[:eachClass |
|loadedClass|
eachClass isLoaded ifFalse:[
loadedClass := eachClass autoload.
loadedClass notNil ifTrue:[classesToUnload add:loadedClass].
] ifTrue:[
loadedClass := eachClass
].
loadedClass isNil
ifTrue:nil
ifFalse:[loadedClass theNonMetaclass]]
thenSelect:[:cls | cls notNil].
classes do:[:eachClass |
|className metaclassName|
className := eachClass theNonMetaclass name.
metaclassName := eachClass theMetaclass name.
eachClass isLoaded ifFalse:[
Transcript showCR:('Cannot compare unloaded class: ' , eachClass name).
] ifTrue:[
self busyLabel:'comparing ...' with:nil.
current := ChangeSet forExistingClass:eachClass theNonMetaclass.
remote := (SmallTeam changesOnHost:hostName) select:[:ch | (ch className = className) or:[(ch className = metaclassName)] ].
diffs := remote diffSetsAgainst:current.
allDiffs isNil ifTrue:[
allDiffs := diffs.
] ifFalse:[
allDiffs changed addAll:(diffs changed).
allDiffs onlyInArg addAll:(diffs onlyInArg).
allDiffs onlyInReceiver addAll:(diffs onlyInReceiver).
].
].
].
allDiffs isEmpty ifTrue:[
self information:'The Versions are Equal.'.
] ifFalse:[
title := collectionOfClasses size == 1
ifTrue:['Differences of %1' bindWith:collectionOfClasses first name]
ifFalse:['Differences of %1 classes' bindWith:collectionOfClasses size].
VersionDiffBrowser
openOnDiffSet:allDiffs
labelA:'Version on Host ',hostName
labelB:'Image'
title:title.
].
self normalLabel.
"Modified: / 18-10-2006 / 13:08:21 / User"
"Created: / 11-11-2006 / 15:36:43 / cg"
"Modified: / 12-11-2006 / 15:41:49 / cg"
!
classMenuQuickCheckIn
"check a class into the source repository (without checks)"
^ self classMenuCheckIn:false
!
classMenuRevisionLog
"show a classes revision log"
self classMenuRevisionLog:false
!
classMenuRevisionLog:shortOrNot
"show a classes revision log"
|codeView|
(self askIfModified:'Code was modified.\\Show log anyway ?')
ifFalse:[^ self].
self codeAspect:#repositoryLog.
self selectedMethods value:nil.
self selectProtocols:nil.
codeView := self codeView.
codeView contents:nil.
codeView modified:false.
navigationState realModifiedState:false.
self
selectedClassesNonMetaDo:
[:cls |
self
showRepositoryLogOf:cls short:shortOrNot
beforeLogDo:[:s |
self selectedClasses value size > 1 ifTrue:[
s nextPutLine:'-----------------------------------------------------------'.
s nextPutLine:('%1 log for %2:'
bindWith:(shortOrNot ifTrue:['Short'] ifFalse:['Full'])
with:cls name).
s nextPutLine:'-----------------------------------------------------------'.
s cr.
]
]
]
ifUnloaded:
[:cls |
true.
]
ifPrivate:
[:cls |
|owner|
owner := cls owningClass.
(self selectedClasses value includes:owner) ifFalse:[
self warn:'cannot show log of private class: %1\\Please see the log of the owning class (%2).'
with:cls nameWithoutPrefix allBold
with:owner name.
]
].
self normalLabel.
!
classMenuSetTag
|log tag knownTags|
(Dialog confirm:'Fetch known tags to choose from ?\(this may take some time)' withCRs) ifTrue:[
knownTags := Set new.
self selectedNonMetaclasses do:[:eachClass |
log := eachClass sourceCodeManager revisionLogOf:eachClass fromRevision:nil toRevision:nil finishAfter:20.
log isNil ifTrue:[
(Dialog confirm:'Oops - could not fetch log for %1 (cvs connection error?)\\Skip this class and proceed?' withCRs)
ifFalse:[
^ self.
].
].
knownTags addAll:(log at:#symbolicNames) keys.
].
knownTags := knownTags asSortedCollection.
tag := Dialog
request:(resources string:'Tag:')
initialAnswer:LastTag
list:knownTags.
] ifFalse:[
tag := Dialog
request:(resources string:'Tag:')
initialAnswer:LastTag.
].
tag isEmptyOrNil ifTrue:[^ self ].
LastTag := tag.
self withWaitCursorDo:[
SourceCodeManagerUtilities tagClasses:(self selectedNonMetaclasses) as:tag.
]
"Created: / 12-09-2006 / 13:36:59 / cg"
"Modified: / 13-01-2011 / 14:12:40 / cg"
!
classMenuShortRevisionLog
"show a short (last 20 entries) classes repository log"
self classMenuRevisionLog:true
!
compareAgainstNewestInRepository:aClass
"open a diff-textView comparing the current (in-image) version
with the the newest version found in the repository.
That is the most recent version."
SourceCodeManagerUtilities compareClassWithRepository:aClass askForRevision:false.
self normalLabel.
!
doCompareClassesWithRepository:collectionOfClasses
|classes s
aStream comparedSource currentSource thisRevString
classesToUnload current repository diffs allDiffs
title|
collectionOfClasses size == 1 ifTrue:[
self compareAgainstNewestInRepository:(collectionOfClasses first theNonMetaclass).
^ self.
].
classesToUnload := IdentitySet new.
classes :=
collectionOfClasses
collect:[:eachClass |
|loadedClass|
eachClass isLoaded ifFalse:[
loadedClass := eachClass autoload.
loadedClass notNil ifTrue:[classesToUnload add:loadedClass].
] ifTrue:[
loadedClass := eachClass
].
loadedClass isNil
ifTrue:nil
ifFalse:[loadedClass theNonMetaclass]]
thenSelect:[:cls | cls notNil].
classes do:[:eachClass |
eachClass isLoaded ifFalse:[
Transcript showCR:('Cannot compare unloaded class: ' , eachClass name).
] ifTrue:[
aStream := self sourceStreamForRepositorySourceOfClass:eachClass.
aStream notNil ifTrue:[
aStream class readErrorSignal handle:[:ex |
self warn:('read error while reading extracted source\\' , ex description) withCRs.
aStream close.
^ self
] do:[
comparedSource := aStream contents asString.
].
aStream close.
self busyLabel:'generating current source ...' with:nil.
aStream := '' writeStream.
Method flushSourceStreamCache.
"/ eachClass fileOutOn:aStream withTimeStamp:false.
"/ currentSource := aStream contents asString.
currentSource := eachClass source asString.
aStream close.
self busyLabel:'comparing ...' with:nil.
comparedSource = currentSource ifTrue:[
((eachClass revision = (eachClass sourceCodeManager newestRevisionOf:eachClass))
and:[eachClass hasUnsavedChanges]) ifTrue:[
(self confirm:'Versions are identical.\\Remove entries from changeSet ?' withCRs) ifTrue:[
ChangeSet current condenseChangesForClass:eachClass.
].
] ifFalse:[
self information:'Versions are identical.'.
]
] ifFalse:[
thisRevString := eachClass revision.
thisRevString isNil ifTrue:[
thisRevString := 'no revision'
].
self busyLabel:'comparing ...' with:nil.
current := ChangeSet fromStream:(s := currentSource readStream). s close.
repository := ChangeSet fromStream:(s := comparedSource readStream). s close.
diffs := repository diffSetsAgainst:current.
allDiffs isNil ifTrue:[
allDiffs := diffs.
] ifFalse:[
allDiffs changed addAll:(diffs changed).
allDiffs onlyInArg addAll:(diffs onlyInArg).
allDiffs onlyInReceiver addAll:(diffs onlyInReceiver).
].
].
].
].
].
allDiffs isEmpty ifTrue:[
(classes contains:[:someClass |
(someClass hasUnsavedChanges)])
ifTrue:[
(self confirm:(resources
stringWithCRs:'The classes are up-to-date.\\Remove entries from changeSet ?'))
ifTrue:[
classes do:[:eachClass |
ChangeSet current condenseChangesForClass:eachClass.
]
].
] ifFalse:[
self information:'The classes are up-to-date.'.
ChangeSet current unrememberChangedClasses.
].
] ifFalse:[
title := collectionOfClasses size == 1
ifTrue:['Differences of %1' bindWith:collectionOfClasses first name]
ifFalse:['Differences of %1 classes' bindWith:collectionOfClasses size].
VersionDiffBrowser
openOnDiffSet:allDiffs
labelA:'Repository'
labelB:'Image'
title:title.
].
self normalLabel.
"Created: / 04-01-1997 / 15:48:20 / cg"
"Modified: / 18-10-2006 / 13:08:21 / User"
"Modified: / 26-10-2006 / 15:13:33 / cg"
!
generateDiffSetForClasses:collectionOfClasses newest:newest
|classes s
aStream comparedSource currentSource rev revString thisRevString mgr
nm msg rev2 newestRev
containerModule containerPackage containerFile rslt
pkg info mod dir classesToUnload current repository diffs allDiffs
title|
classesToUnload := IdentitySet new.
classes := collectionOfClasses collect:[:eachClass |
|loadedClass|
eachClass isLoaded ifFalse:[
loadedClass := eachClass autoload.
classesToUnload add:loadedClass.
] ifTrue:[
loadedClass := eachClass
].
loadedClass theNonMetaclass
].
classes do:[:currentClass |
nm := currentClass name.
mgr := SourceCodeManagerUtilities sourceCodeManagerFor:currentClass.
mgr isNil ifTrue:[
(Dialog
confirm:('No sourceCode manager defined for %1 - check settings.\\Skip this class ?' bindWith:currentClass name) withCRs)
ifFalse:[
^ self
].
].
rev := currentClass binaryRevision.
rev2 := currentClass revision.
rev isNil ifTrue:[
rev := rev2
].
rev isNil ifTrue:[
"/
"/ class not in repository - allow compare against any other containers newest contents
"/
self normalLabel.
pkg := currentClass package.
(pkg notNil and:[pkg ~= PackageId noProjectID]) ifTrue:[
containerModule := pkg upTo:$:.
containerPackage := pkg copyFrom:(containerModule size + 2).
].
containerModule size == 0 ifTrue:[
containerModule := (SourceCodeManagerUtilities lastModule) ? Project current repositoryModule.
].
containerPackage size == 0 ifTrue:[
containerPackage := (SourceCodeManagerUtilities lastPackage) ? Project current package.
].
rslt := SourceCodeManagerUtilities
askForContainer:(resources string:'The class seems to have no repository information.\\Do you want to compare it against an existing containers contents ?')
title:'Container to compare' note:nil
initialModule:containerModule
initialPackage:containerPackage
initialFileName:(currentClass name , '.st')
forNewContainer:false.
rslt isNil ifTrue:[
"/ canel
^ self
].
containerModule := rslt at:#module.
containerPackage := rslt at:#package.
containerFile := rslt at:#fileName.
SourceCodeManagerUtilities lastModule:containerModule.
SourceCodeManagerUtilities lastPackage:containerPackage.
] ifFalse:[
"/
"/ class in repository - ask for revision
"/
newestRev := mgr newestRevisionOf:currentClass.
rev := newestRev.
].
(rev notNil or:[containerFile notNil]) ifTrue:[
rev notNil ifTrue:[
rev withoutSpaces isEmpty ifTrue:[
msg := 'extracting newest %1 (' , (newestRev ? '???') , ')'.
"/ aStream := mgr getMostRecentSourceStreamForClassNamed:nm.
aStream := mgr getSourceStreamFor:currentClass revision:newestRev.
revString := 'newest'.
] ifFalse:[
msg := 'extracting previous %1'.
aStream := mgr getSourceStreamFor:currentClass revision:rev.
revString := rev
].
] ifFalse:[
msg := 'extracting newest version from ' , containerModule , '/' , containerPackage, '/' , containerFile.
aStream := mgr streamForClass:nil fileName:containerFile revision:#newest directory:containerPackage module:containerModule cache:false.
revString := '???'
].
self busyLabel:msg with:nm.
aStream isNil ifTrue:[
info := mgr sourceInfoOfClass:currentClass.
info notNil ifTrue:[
mod := info at:#module ifAbsent:'??'.
dir := info at:#directory ifAbsent:'??'.
].
self warn:(resources
string:'Could not extract source from repository (for module: ''%1'' , directory: ''%2'' , revision: ''%3'')'
with:mod with:dir with:revString).
^ self
].
aStream class readErrorSignal handle:[:ex |
self warn:('read error while reading extracted source\\' , ex description) withCRs.
aStream close.
^ self
] do:[
comparedSource := aStream contents asString.
].
aStream close.
self busyLabel:'generating current source ...' with:nil.
aStream := '' writeStream.
Method flushSourceStreamCache.
"/ currentClass fileOutOn:aStream withTimeStamp:false.
"/ currentSource := aStream contents asString.
currentSource := currentClass source asString.
aStream close.
self busyLabel:'comparing ...' with:nil.
comparedSource = currentSource ifTrue:[
((currentClass revision = newestRev)
and:[currentClass hasUnsavedChanges]) ifTrue:[
(self confirm:'Versions are identical.\\Remove entries from changeSet ?' withCRs) ifTrue:[
ChangeSet current condenseChangesForClass:currentClass.
].
] ifFalse:[
self information:'Versions are identical.'.
]
] ifFalse:[
thisRevString := currentClass revision.
thisRevString isNil ifTrue:[
thisRevString := 'no revision'
].
revString = '(newest)' ifTrue:[
(rev := mgr newestRevisionOf:currentClass) notNil ifTrue:[
revString := '(newest is ' , rev , ')'
]
].
self busyLabel:'comparing ...' with:nil.
current := ChangeSet fromStream:(s := currentSource readStream). s close.
repository := ChangeSet fromStream:(s := comparedSource readStream). s close.
diffs := repository diffSetsAgainst:current.
allDiffs isNil ifTrue:[
allDiffs := diffs.
] ifFalse:[
allDiffs changed addAll:(diffs changed).
allDiffs onlyInArg addAll:(diffs onlyInArg).
allDiffs onlyInReceiver addAll:(diffs onlyInReceiver).
].
].
].
].
title := collectionOfClasses size == 1
ifTrue:['Differences of %1' bindWith:collectionOfClasses first name]
ifFalse:['Differences of %1 classes' bindWith:collectionOfClasses size].
VersionDiffBrowser
openOnDiffSet:allDiffs
labelA:'Repository'
labelB:'Image'
title:title.
self normalLabel.
"Created: / 04-01-1997 / 15:48:20 / cg"
"Modified: / 12-10-2006 / 23:30:12 / cg"
!
repositoryHistoryForProjects:projectListOrNil
(self askIfModified:'Code was modified.\\Show history anyway ?')
ifFalse:[^ self].
self withWaitCursorDo:[
|timeGoal moduleFilter moduleFilterHolder repositoryFilter userFilter aStream box y component
timeGoalListPop moduleFilterPop userFilterPop dateList userList|
timeGoal := 'yesterday' asValue.
moduleFilterHolder := nil asValue.
userFilter := nil asValue.
box := Dialog new.
(box addTextLabel:(resources string:'Repository change report')) adjust:#left.
box addVerticalSpace:20.
y := box yPosition.
component := box addTextLabel:(resources string:'List changes since (yyyy-mm-dd):').
component width:0.5; adjust:#right; borderWidth:0.
box yPosition:y.
timeGoalListPop := box addComboBoxOn:timeGoal tabable:true.
timeGoalListPop width:0.5; left:0.5; immediateAccept:true; acceptOnLeave:false; cursorMovementWhenUpdating:#beginOfLine.
dateList := OrderedCollection new.
dateList add:(Timestamp now printStringFormat:'%(year)-%(month)-%(day)').
dateList add:((Timestamp now subtractHours:1) printStringFormat:'%(year)-%(month)-%(day) %h:%m').
dateList addAll:#('yesterday'
'1 hour ago'
'1 week ago'
'1 month ago'
'1 year ago'
'all'
).
timeGoalListPop list:dateList.
projectListOrNil notNil ifTrue:[
moduleFilter := (projectListOrNil collect:[:prj | prj asPackageId module]) asSet.
moduleFilterHolder := nil.
] ifFalse:[
y := box yPosition.
component := box addTextLabel:(resources string:'For CVS repository (empty for all):').
component width:0.5; adjust:#right; borderWidth:0.
box yPosition:y.
moduleFilterPop := box addComboBoxOn:moduleFilterHolder tabable:true.
moduleFilterPop width:0.5; left:0.5; immediateAccept:true; acceptOnLeave:false; cursorMovementWhenUpdating:#beginOfLine.
moduleFilterPop list:(SourceCodeManager knownModules asOrderedCollection sort addFirst:'stx'; yourself).
].
y := box yPosition.
component := box addTextLabel:(resources string:'For user (empty for all):').
component width:0.5; adjust:#right; borderWidth:0.
box yPosition:y.
userFilterPop := box addComboBoxOn:userFilter tabable:true.
userFilterPop width:0.5; left:0.5; immediateAccept:true; acceptOnLeave:false; cursorMovementWhenUpdating:#beginOfLine.
"Fetch the list of konwn user names (which are possibly used when cheking in):
- Try the repository names (smething like ':method:user@host:....')
- If nothing found, use the login name"
userList := Set new.
SourceCodeManager knownRepositories do:[:eachRepository|
|user idx|
(eachRepository includes:$@) ifTrue:[
user := eachRepository copyUpTo:$@.
idx := user lastIndexOf:$:.
idx ~~ 0 ifTrue:[
user := user copyFrom:idx+1.
].
userList add:user.
].
].
userList isEmpty ifTrue:[
userList add:OperatingSystem getLoginName.
].
userFilterPop list:userList asArray sort.
box addAbortAndOkButtons.
box open.
box accepted ifTrue:[
moduleFilterHolder notNil ifTrue:[
moduleFilter := moduleFilterHolder value.
moduleFilter size == 0
ifTrue:[moduleFilter := nil]
ifFalse:[moduleFilter := Set with:moduleFilter].
].
moduleFilter notNil ifTrue:[
repositoryFilter := moduleFilter
collect:[:eachModule|
SourceCodeManager getCVSROOTForModule:eachModule.
].
].
userFilter := userFilter value.
userFilter size == 0
ifTrue:[userFilter := nil]
ifFalse:[userFilter := Array with:userFilter].
timeGoal := timeGoal value.
self busyLabel:'extracting history ...' with:nil.
aStream := WriteStream on:(String new:200).
Processor activeProcess
withPriority:Processor activePriority-1 to:Processor activePriority
do:[
SourceCodeManager notNil ifTrue:[
SourceCodeManager
writeHistoryLogSince:timeGoal
filterSTSources:true
filterUser:userFilter
filterRepository:repositoryFilter
filterModules:moduleFilter
filterProjects:projectListOrNil
to:aStream.
] ifFalse:[
aStream nextPutLine:'no history available (no SourceCodeManagement installed)'
].
].
self codeView
contents:(aStream contents);
modified:false.
navigationState realModifiedState:false.
self codeAspect:#repositoryHistory.
self selectedMethods value:nil.
self selectProtocols:nil.
"/ self clearAcceptAction.
"/ self clearExplainAction.
self normalLabel
].
]
"Created: / 12-09-2006 / 15:03:24 / cg"
!
showRepositoryLogOf:aClass
"show a classes repository log - append to codeView.
CAVEAT: that is almost the same code as found in SystemBrowser;
move to SourceCodeManagerUtilities"
self showRepositoryLogOf:aClass short:false
!
showRepositoryLogOf:aClass short:shortOrNot
"show a classes repository log - append to codeView."
self showRepositoryLogOf:aClass short:shortOrNot beforeLogDo:[:s | ].
!
showRepositoryLogOf:aClass short:shortOrNot beforeLogDo:aBlock
"show a classes repository log - append to codeView.
CAVEAT: that is almost the same code as found in SystemBrowser;
move to SourceCodeManagerUtilities."
|codeView aStream|
aStream := WriteStream on:(String new:200).
Processor activeProcess
withPriority:Processor activePriority-1 to:Processor activePriority
do:[
self busyLabel:'Extracting log of %1' with:aClass name.
aBlock value:aStream.
SourceCodeManagerUtilities repositoryLogOf:aClass short:shortOrNot onto:aStream
].
self codeAspect:#repositoryLog.
self selectedMethods value:nil.
self selectProtocols:nil.
codeView := self codeView.
codeView contents:(codeView contents ,
Character cr asString ,
Character cr asString ,
aStream contents).
codeView modified:false.
navigationState realModifiedState:false.
"/ self clearAcceptAction.
"/ self clearExplainAction.
self normalLabel
!
sourceStreamForRepositorySourceOfClass:aClass
"ask for a classes revision and return a stream on this revisions source; nil on error"
|mgr rev rev2 pkg containerModule containerPackage rslt containerFile newestRev msg sourceStream revString
info mod dir|
mgr := SourceCodeManagerUtilities sourceCodeManagerFor:aClass.
mgr isNil ifTrue:[
^ nil
].
rev := aClass binaryRevision.
rev2 := aClass revision.
rev isNil ifTrue:[
rev := rev2
].
rev isNil ifTrue:[
"/
"/ class not in repository - allow compare against any other containers newest contents
"/
self normalLabel.
pkg := aClass package.
(pkg notNil and:[pkg ~= PackageId noProjectID]) ifTrue:[
containerModule := pkg upTo:$:.
containerPackage := pkg copyFrom:(containerModule size + 2).
].
containerModule size == 0 ifTrue:[
containerModule := (SourceCodeManagerUtilities lastModule) ? Project current repositoryModule.
].
containerPackage size == 0 ifTrue:[
containerPackage := (SourceCodeManagerUtilities lastPackage) ? Project current package.
].
rslt := SourceCodeManagerUtilities
askForContainer:(resources
stringWithCRs:'The "%1"-class seems to have no repository information.\\Do you want to compare it against an existing containers contents ?'
with:aClass name)
title:'Container to compare' note:nil
initialModule:containerModule
initialPackage:containerPackage
initialFileName:(aClass name , '.st')
forNewContainer:false.
rslt isNil ifTrue:[
"/ cancel
^ nil
].
containerModule := rslt at:#module.
containerPackage := rslt at:#package.
containerFile := rslt at:#fileName.
SourceCodeManagerUtilities lastModule:containerModule.
SourceCodeManagerUtilities lastPackage:containerPackage.
] ifFalse:[
"/
"/ class in repository - ask for revision
"/
newestRev := mgr newestRevisionOf:aClass.
rev := newestRev.
].
(rev notNil or:[containerFile notNil]) ifTrue:[
rev notNil ifTrue:[
rev withoutSpaces isEmpty ifTrue:[
msg := 'extracting newest %1 (' , (newestRev ? '???') , ')'.
sourceStream := mgr getSourceStreamFor:aClass revision:newestRev.
revString := 'newest'.
] ifFalse:[
msg := 'extracting previous %1'.
sourceStream := mgr getSourceStreamFor:aClass revision:rev.
revString := rev
].
] ifFalse:[
msg := 'extracting newest version from ' , containerModule , '/' , containerPackage, '/' , containerFile.
sourceStream := mgr streamForClass:nil fileName:containerFile revision:#newest directory:containerPackage module:containerModule cache:false.
revString := '???'
].
self busyLabel:msg with:(aClass name).
sourceStream isNil ifTrue:[
info := mgr sourceInfoOfClass:aClass.
info notNil ifTrue:[
mod := info at:#module ifAbsent:'??'.
dir := info at:#directory ifAbsent:'??'.
].
self warn:(resources
string:'Could not extract source from repository (for module: ''%1'' , directory: ''%2'' , revision: ''%3'')'
with:mod with:dir with:revString).
^ nil
].
^ sourceStream
].
^ nil
"Modified: / 12-10-2006 / 20:51:19 / cg"
! !
!NewSystemBrowser methodsFor:'menu actions-code'!
codeMenuAddClassVariable:newName inClass:aClass asValueHolder:asValueHolder
"add a class variable"
|refactoring cls nonMeta|
nonMeta := aClass theNonMetaclass.
(cls := nonMeta whichClassDefinesClassVar:newName) notNil ifTrue:[
cls == aClass ifTrue:[
Dialog information:(resources string:'A variable named ''%1'' is already defined in ''%2''.'
with:newName allBold
with:cls name allBold).
^ self
].
(Dialog confirm:(resources stringWithCRs:'Attention: a variable named ''%1'' is already defined in ''%2''.\\Proceed ?'
with:newName allBold
with:cls name allBold))
ifFalse:[
^ self
].
].
refactoring := AddClassVariableChange add:newName to:nonMeta.
"/ refactoring := AddClassVariableRefactoring variable:newName class:nonMeta.
self performRefactoring:refactoring.
"Modified: / 18-11-2006 / 16:15:49 / cg"
!
codeMenuAddInstanceVariable:newName inClass:aClass
"add an instance variable"
self codeMenuAddInstanceVariable:newName inClass:aClass asValueHolder:false
!
codeMenuAddInstanceVariable:newName inClass:aClass asValueHolder:asValueHolder
"add an instance variable"
|refactoring cls generator varName pseudoVarName|
asValueHolder ifTrue:[
varName := newName.
varName isUppercaseFirst ifTrue:[
varName := varName asLowercaseFirst.
].
(varName endsWith:'Holder') ifTrue:[
pseudoVarName := varName copyWithoutLast:6.
] ifFalse:[
pseudoVarName := varName.
varName := pseudoVarName , 'Holder'.
].
] ifFalse:[
varName := newName
].
(cls := aClass whichClassDefinesInstVar:varName) notNil ifTrue:[
Dialog warn:(resources string:'An instance variable named ''%1'' is already defined in ''%2''.'
with:varName allBold
with:cls name allBold).
^ self
].
"/ refactoring := AddInstanceVariableRefactoring variable:newName class:aClass.
"/ refactoring model name:('Add instvar %1 to %2' bindWith:newName with:aClass name).
asValueHolder ifTrue:[
generator := SmalltalkCodeGeneratorTool new.
generator startCollectChanges.
generator addChange:(AddInstanceVariableChange add:varName to:aClass).
generator createValueHoldersFor:(Array with:varName) in:aClass lazyInitialization:false.
generator executeCollectedChangesNamed:'Add ValueHolder'
] ifFalse:[
refactoring := AddInstanceVariableChange add:varName to:aClass.
self performRefactoring:refactoring.
].
"Modified: / 31-01-2011 / 18:29:55 / cg"
!
codeMenuAddParameter
|currentMethod cls selector refactoring initializer newSelector l initialAnswer
senders nSenders tree args dialog|
(self askIfModified) ifFalse:[
^ self
].
currentMethod := self theSingleSelectedMethod.
cls := currentMethod mclass.
selector := currentMethod selector.
"/ how many senders are there ?
senders := SystemBrowser findSendersOf:selector in:(Smalltalk allClasses) ignoreCase:false match:false.
nSenders := senders size.
tree := cls parseTreeFor:selector.
tree isNil ifTrue:[
self warn: 'Could not parse the method'.
^ self
].
args := tree argumentNames.
args := args copyWith:('arg%1' bindWith:args size + 1).
selector numArgs == 0 ifTrue:[
initialAnswer := selector , ':'.
l := 'Enter new selector:'.
] ifFalse:[
initialAnswer := selector , 'xxxx:'.
l := 'Enter new selector (replace xxxx as desired):'.
].
dialog := MethodNameDialogForAddParameter methodNameFor: args initial:initialAnswer.
nSenders == 0 ifTrue:[
dialog askForDefaultValue:false.
].
dialog cancelAllVisible value:(AbortAllOperationRequest isHandled).
dialog renameOnlyVisible value:true.
dialog renameSelectedMethodsOnlyVisible value:true.
dialog rewriteLocalMethodsOnlyFlagHolder value:true.
dialog allButOpen.
dialog window label:(resources string:l).
dialog openWindow.
dialog accepted ifFalse: [^ self].
newSelector := dialog methodName.
initializer := dialog defaultValue.
"/ newSelector := Dialog request:(resources string:l) initialAnswer:initialAnswer.
newSelector isEmptyOrNil ifTrue:[
^ nil "/ cancelled
].
"/ nSenders > 0 ifTrue:[
"/ initializer := Dialog request:(resources string:'Enter default value for parameter (will be used in %1 sending methods):' with:nSenders printString) initialAnswer:'nil'.
"/ initializer isEmptyOrNil ifTrue:[
"/ ^ nil "/ cancelled
"/ ].
"/ ] ifFalse:[
"/ initializer := 'nil' "/ dummy - not used anyway
"/ ].
newSelector := newSelector asSymbol.
refactoring := AddParameterRefactoring
addParameterToMethod:selector
in:cls
newSelector:newSelector
initializer:initializer.
(self findSendersOf:selector in:(Smalltalk allClasses) andConfirmRefactoring:refactoring) ifTrue:[
self performRefactoring:refactoring.
self switchToSelector:newSelector
]
!
codeMenuConvertToValueHolder
"replace all accesses to selected instvar by value-get/set method sends;
add aspects if not yet present."
|varName|
varName := self selectedInstanceVariableOrNil.
varName notNil ifTrue:[
self codeMenuConvertToValueHolder:varName
]
!
codeMenuConvertToValueHolder:aString
"replace all accesses to selected instvar by value-get/set method sends;
add aspects if not yet present."
|refactoring|
(self askIfModified) ifFalse:[
^ self
].
(self confirm:'About to rewrite methods...') ifFalse:[^ self].
refactoring := (ValueHolderRefactoring
variable: aString
class: (self theSingleSelectedClass whichClassDefinesInstVar: aString)).
self performRefactoring:refactoring.
!
codeMenuDeclareSelectionAsClassVariable
"add a class variable"
|varName cls refactoring|
varName := self codeView selectionAsString.
(varName isValidSmalltalkIdentifier
and:[ varName isUppercaseFirst
and:[ (Smalltalk includesKey:varName) not
and:[ (cls := self theSingleSelectedClass) notNil
and:[ (cls theNonMetaclass classVarNames includes:varName) not
]]]]) ifFalse:[
^ self.
].
refactoring := AddClassVariableChange add:varName to:cls theNonMetaclass.
self performRefactoring:refactoring.
!
codeMenuExtractMethod
self withCurrentMethodsClassAndSelectorDo:[:mClass :mSelector |
| refactoring |
refactoring := (ExtractMethodRefactoring
extract: (self selectedInterval)
from: mSelector
in: mClass).
refactoring source:self codeView contentsAsString.
self performRefactoring:refactoring.
]
!
codeMenuExtractMethodToComponent
self withCurrentMethodsClassAndSelectorDo:[:mClass :mSelector |
| refactoring |
refactoring := (ExtractMethodToComponentRefactoring
extract: (self selectedInterval)
from: mSelector
in: mClass).
refactoring source:self codeView contentsAsString.
self performRefactoring:refactoring.
]
!
codeMenuExtractSelectionToTemporary
|currentMethod cls selector refactoring newName node varName source codeTree |
RBParser isNil ifTrue:[^ self].
(self askIfModified:'Text was modified - please accept first' default:false) ~~ true
ifTrue:[
^ self
].
node := self findNode.
(node notNil and: [node isValue]) ifFalse: [
^ self warn: 'Could not find the node (please select the message expression to extract)'
].
(node isMessage and:[node isUnary]) ifTrue:[
varName := node selector
] ifFalse:[
varName := LastTemporaryVariableName ? 't'.
].
source := self codeView contentsAsString string.
codeTree := RBParser
parseMethod:source
onError: [:str :err ":nodesSoFar" | nil].
codeTree notNil ifTrue:[
(codeTree body temporaries contains:[:nd | nd name = varName]) ifTrue:[varName := nil].
].
newName := Dialog request: 'Enter name for Temporary:' initialAnswer:varName.
newName isEmpty ifTrue: [^self].
LastTemporaryVariableName := newName.
currentMethod := self theSingleSelectedMethod.
cls := currentMethod mclass.
selector := currentMethod selector.
(cls isNil or:[selector isNil]) ifTrue:[
self information:'Oops - no class/selector. Please reselect.'.
^ self.
].
refactoring := (ExtractToTemporaryRefactoring
extract: (node sourceInterval)
to: newName
from: selector
in: cls).
refactoring source:self codeView contentsAsString.
self performRefactoring:refactoring.
!
codeMenuFormat
"format (prettyPrint) the selected method(s)"
|modifiedBefore|
self hasSingleMethodSelected ifTrue:[
modifiedBefore := navigationState modified.
self formatCode.
("autoAcceptFormattedCode" false or:[modifiedBefore not]) ifTrue:[
self codeView accept
].
] ifFalse:[
self information:'Bulk formatting is currently disabled, because the formatter
has still problems to layout comments in an acceptable way (although its much better
than it used to be...) Therefore, please have an eye on each formatted method.'.
^ self.
"/ self selectedMethodsDo:[:each |
"/ self formatMethod:each
"/ ].
].
!
codeMenuGotoClass
self switchToClass:(self selectedClassNameInCodeViewOrNil)
!
codeMenuInlineAllSelfSends
|currentMethod selector refactoring|
(self askIfModified) ifFalse:[
^ self
].
currentMethod := self theSingleSelectedMethod.
selector := currentMethod selector.
refactoring := InlineAllSelfSendersRefactoring
sendersOf: selector
in: currentMethod mclass.
refactoring setOption: #inlineExpression toUse: [:ref :string | true].
self performRefactoring: refactoring.
(self findSendersOf:selector andConfirmRefactoring:refactoring) ifTrue:[
self performRefactoring:refactoring.
]
!
codeMenuInlineMessage
|currentMethod node cls selector refactoring receiverNode inlinedSelector senders rslt|
(self askIfModified) ifFalse:[
^ self
].
currentMethod := self theSingleSelectedMethod.
cls := currentMethod mclass.
selector := currentMethod selector.
node := self findNode.
(node isNil or: [node isMessage not]) ifTrue: [
^ self warn: 'Could not find message send (please select the messageSelector or part of it)'
].
receiverNode := node receiver.
inlinedSelector := node selector.
(receiverNode isVariable
and: [#('self' 'super') includes: receiverNode name])
ifTrue:[
refactoring := (InlineMethodRefactoring
inline: node sourceInterval
inMethod: selector
forClass: cls)
] ifFalse:[
refactoring := (InlineMethodFromComponentRefactoring
inline: node sourceInterval
inMethod: selector
forClass: cls)
].
"/ refactoring model name:('inline %1 into %2' bindWith:inlinedSelector with:selector).
rslt := self performRefactoring:refactoring.
rslt isNil ifTrue:[^ self ].
senders := self class findSendersOf:inlinedSelector
in:Smalltalk allClasses
ignoreCase:false
match:false.
senders isEmpty ifTrue:[
(self confirm:('There seem to be no more senders of ', inlinedSelector , '.\\Remove the implementation in ' , cls name , ' ?') withCRs)
ifFalse:[^ self].
self doRemoveMethodsUnconfirmed:(Array with:(refactoring inlineClass realClass compiledMethodAt:inlinedSelector)).
].
"Modified: / 17-11-2006 / 13:51:06 / cg"
!
codeMenuInlineParameter
"inline the parameter which is selected in the codeView"
self codeMenuInlineParameter:(self selectionInCodeView).
!
codeMenuInlineParameter:parameterName
"inline the parameter named parameterName"
|currentMethod cls selector refactoring|
(self askIfModified) ifFalse:[
^ self
].
currentMethod := self theSingleSelectedMethod.
cls := currentMethod mclass.
selector := currentMethod selector.
"/ (self confirm:(resources string:'Inline parameter ''%1'' ?' with:parameterName allBold)) ifFalse:[^ self].
refactoring := InlineParameterRefactoring inlineParameter:parameterName in:cls selector:selector.
(self findSendersOf:selector andConfirmRefactoring:refactoring) ifTrue:[
self performRefactoring:refactoring.
self switchToSelector:refactoring newSelector.
]
!
codeMenuMakeAbstractClassVariable:aString
"replace all accesses to selected classvar by setter/getter method sends;
add accessors if not yet present."
|selectedClass definingClass cls|
(self askIfModified) ifFalse:[
^ self
].
selectedClass := self theSingleSelectedClass theNonMetaclass.
cls := definingClass := selectedClass whichClassDefinesClassVar:aString.
definingClass ~~ selectedClass ifTrue:[
cls := OptionBox
request:(resources string:'Rewrite methods below %1 (defining) or %2 (selected) ?'
with:definingClass name allBold
with:selectedClass name allBold)
label:'Rewrite which classes'
buttonLabels:(Array with:'cancel' with:definingClass name with:selectedClass name)
values:(Array with:nil with:definingClass with:selectedClass).
cls isNil ifTrue:[^ self].
].
(self confirm:(resources string:'About to rewrite references to ''%1'' (in and below %2).'
with:aString allBold
with:cls name)) ifFalse:[^ self].
self performRefactoring:(AbstractClassVariableRefactoring variable:aString class:cls).
!
codeMenuMakeAbstractInstanceVariable:aString
"replace all accesses to selected instvar by setter/getter method sends;
add accessors if not yet present."
|selectedClass definingClass cls|
(self askIfModified) ifFalse:[
^ self
].
selectedClass := self theSingleSelectedClass.
cls := definingClass := selectedClass whichClassDefinesInstVar:aString.
definingClass ~~ selectedClass ifTrue:[
cls := OptionBox
request:(resources string:'Rewrite methods below %1 (defining) or %2 (selected) ?'
with:definingClass name allBold
with:selectedClass name allBold)
label:'Rewrite which classes'
buttonLabels:(Array with:'cancel' with:definingClass name with:selectedClass name)
values:(Array with:nil with:definingClass with:selectedClass).
cls isNil ifTrue:[^ self].
].
(self confirm:(resources string:'About to rewrite references to ''%1'' (in and below %2).'
with:aString allBold
with:cls name)) ifFalse:[^ self].
self performRefactoring:(AbstractInstanceVariableRefactoring variable:aString class:cls).
!
codeMenuMakeAbstractVariable
"replace all accesses to selected instvar by setter/getter method sends;
add accessors if not yet present."
|varName|
varName := self selectedInstanceVariableOrNil.
varName notNil ifTrue:[
^ self codeMenuMakeAbstractInstanceVariable:varName.
].
varName := self selectedClassVariableOrNil.
varName notNil ifTrue:[
^ self codeMenuMakeAbstractClassVariable:varName
].
self warn:'Please select either an instance or a class variable (in the codeView or the variableList).'
!
codeMenuMakeInstanceVariable
"make selected local variable an instance variable."
|varNames|
varNames := self selectedTemporaryVariablesInCodeViewOrNil.
varNames isEmptyOrNil ifTrue:[
self warn:'Please select at least one temporary variable in the code.'.
^ self.
].
varNames do:[:varName |
self codeMenuMakeInstanceVariable:varName.
].
!
codeMenuMakeInstanceVariable:aString
"make selected local an instvar."
self withCurrentMethodsClassAndSelectorDo:[:mClass :mSelector |
|refactoring newClass newMethod|
refactoring := (TemporaryToInstanceVariableRefactoring
class: mClass
selector: mSelector
variable: aString).
(self confirm:'About to rewrite methods for ',aString,'...') ifFalse:[^ self].
"/ cannot delay the update class/method
"/ (otherwise, selectedMethod will be wrong for the second variable)
immediateUpdate value:true.
self performRefactoring:refactoring.
immediateUpdate value:false.
"/ must reselect manually here
newClass := Smalltalk classNamed:(mClass name).
newMethod := newClass compiledMethodAt:mSelector.
newClass ~~ self theSingleSelectedClass ifTrue:[
self selectClass:newClass.
].
newMethod ~~ self theSingleSelectedMethod ifTrue:[
self selectMethod:newMethod.
].
].
!
codeMenuMoveVariableToInnerScope
"move a temporary/local variable to the innermost possible scope"
|node varName definingNode |
node := self findNode.
(node isNil or:[node isVariable not]) ifTrue:[
^ self warn:'Please select a temporary variable in the code.'
].
varName := node name.
definingNode := node whoDefines:varName.
definingNode isNil ifTrue: [
self warn:varName , ' is not a temporary variable in the method'.
^ self
].
self withCurrentMethodsClassAndSelectorDo:[:mClass :mSelector |
|refactoring|
refactoring := MoveVariableDefinitionRefactoring
bindTight: (node sourceInterval)
in: mClass
selector: mSelector.
self performRefactoring: refactoring.
].
self switchToMethod:(self theSingleSelectedMethod).
!
codeMenuProtectInstanceVariable
"replace all accesses to selected instvar by setter/getter method sends;
add accessors if not yet present."
|varName|
varName := self selectedInstanceVariableOrNil.
varName notNil ifTrue:[
^ self codeMenuProtectInstanceVariable:varName.
].
varName := self selectedClassVariableOrNil.
varName notNil ifTrue:[
^ self warn:'Sorry: This Refactoring is (currently) only supported for instance variables.'.
].
self warn:'Please select an instance variable (in the codeView or the variableList).'
!
codeMenuProtectInstanceVariable:aString
"replace all indirect setter/getter references selected instvar by direct accesses,
then remove the setter/getter methods"
|selectedClass definingClass cls|
(self askIfModified) ifFalse:[
^ self
].
selectedClass := self theSingleSelectedClass.
cls := definingClass := selectedClass whichClassDefinesInstVar:aString.
definingClass ~~ selectedClass ifTrue:[
cls := OptionBox
request:(resources string:'Rewrite methods below %1 (defining) or %2 (selected) ?'
with:definingClass name allBold
with:selectedClass name allBold)
label:'Rewrite which classes'
buttonLabels:(Array with:'cancel' with:definingClass name with:selectedClass name)
values:(Array with:nil with:definingClass with:selectedClass).
cls isNil ifTrue:[^ self].
].
(self confirm:(resources string:'About to rewrite references to ''%1'' (in and below %2).'
with:aString allBold
with:cls name)) ifFalse:[^ self].
self performRefactoring:(ProtectInstanceVariableRefactoring variable:aString class:cls).
!
codeMenuPullUpClassVariable
"pull a class variable up to its superclasses"
self withCurrentClassDo:[:cls |
|oldName node mthd nonMeta definingClass|
nonMeta := cls theNonMetaclass.
node := self findNode.
node isNil ifTrue:[
(self hasClassVariableSelectedInCodeView) ifFalse:[
oldName := self theSingleSelectedVariable.
oldName isNil ifTrue:[
^ self warn:'Please select a variable'
]
] ifTrue:[
oldName := self selectionInCodeView.
]
] ifFalse:[
node isVariable ifFalse:[
^ self warn:'Please select a variable'
].
oldName := node name.
].
definingClass := nonMeta whichClassDefinesClassVar:oldName.
definingClass isNil ifTrue:[
self warn:'Oops - could not find the defining class'.
^ self
].
definingClass ~~ nonMeta ifTrue:[
(self confirm:'Will pull in ' , definingClass name , ' - OK ?')
ifFalse:[
^ self
].
].
self codeMenuPullUpClassVariable:oldName inClass:definingClass.
mthd notNil ifTrue:[
"/ self switchToSelector:mthd selector.
self switchToMethod:mthd.
].
].
!
codeMenuPullUpClassVariable:oldName inClass:aClass
"pull a class variable up to its superclass"
|refactoring|
(self askIfModified) ifFalse:[
^ self
].
(Dialog
confirm:'About to rewrite methods...'
title:'About to rewrite methods...'
yesLabel:'proceed'
noLabel:'cancel')
ifFalse:[
^ self
].
refactoring := PullUpClassVariableRefactoring variable:oldName class:aClass superclass.
self performRefactoring:refactoring.
!
codeMenuPullUpInstanceVariable
"pull an instance variable up to its superclasses"
self withCurrentClassDo:[:cls |
|oldName node mthd definingClass|
cls isMeta ifTrue:[
^ self warn:'Please switch to the non-meta side.'
].
node := self findNode.
node isNil ifTrue:[
(self hasInstanceVariableSelectedInCodeView) ifFalse:[
oldName := self theSingleSelectedVariable.
oldName isNil ifTrue:[
^ self warn:'Please select a variable'
]
] ifTrue:[
oldName := self selectionInCodeView.
]
] ifFalse:[
node isVariable ifFalse:[
^ self warn:'Please select a variable'
].
oldName := node name.
].
definingClass := cls whichClassDefinesInstVar:oldName.
definingClass isNil ifTrue:[
self warn:'Oops - could not find the defining class'.
^ self
].
definingClass ~~ cls ifTrue:[
(self confirm:'Will pull in ' , definingClass name , ' - OK ?')
ifFalse:[
^ self
].
].
self codeMenuPullUpInstanceVariable:oldName inClass:definingClass.
mthd notNil ifTrue:[
"/ self switchToSelector:mthd selector.
self switchToMethod:mthd.
].
].
!
codeMenuPullUpInstanceVariable:varName inClass:aClass
"pull an instance variable up to its superclass"
|superClass refactoring|
(self askIfModified) ifFalse:[
^ self
].
superClass := aClass superclass.
superClass isNil ifTrue:[
^ self warn:'No superClass to pull variables into.'.
].
superClass == Object ifTrue:[
^ self warn:'Cannot pull variables into Object (may not have instVars).'.
].
(Dialog
confirm:('About to pull ''%1'' up into %2...'bindWith:varName allBold with:superClass name)
title:('About to pullUp ''%1''...' bindWith:varName)
yesLabel:'Proceed'
noLabel:'Cancel')
ifFalse:[
^ self
].
refactoring := PullUpInstanceVariableRefactoring variable:varName class:superClass.
self performRefactoring:refactoring.
!
codeMenuPullUpVariable
"pull a variable up to its superclasses"
|varName|
varName := self selectedInstanceVariableOrNil.
varName notNil ifTrue:[
^ self codeMenuPullUpInstanceVariable
].
varName := self selectedClassVariableOrNil.
varName notNil ifTrue:[
^ self codeMenuPullUpClassVariable
].
^ self warn:'Please select a variable and try again.'
!
codeMenuPushDownClassVariable
"push a class variable down to its subclasses"
self withCurrentClassDo:[:cls |
|oldName node mthd nonMeta definingClass|
nonMeta := cls theNonMetaclass.
node := self findNode.
node isNil ifTrue:[
(self hasClassVariableSelectedInCodeView) ifFalse:[
oldName := self theSingleSelectedVariable.
oldName isNil ifTrue:[
^ self warn:'Please select a variable'
]
] ifTrue:[
oldName := self selectionInCodeView.
]
] ifFalse:[
node isVariable ifFalse:[
^ self warn:'Please select a variable'
].
oldName := node name.
].
definingClass := nonMeta whichClassDefinesClassVar:oldName.
definingClass isNil ifTrue:[
self warn:'Oops - could not find the defining class'.
^ self
].
definingClass ~~ nonMeta ifTrue:[
(self confirm:'Will push in ' , definingClass name , ' - OK ?')
ifFalse:[
^ self
].
].
self codeMenuPushDownClassVariable:oldName inClass:definingClass.
mthd notNil ifTrue:[
"/ self switchToSelector:mthd selector.
self switchToMethod:mthd.
].
].
!
codeMenuPushDownClassVariable:oldName inClass:aClass
"push a class variable down to its subclasses"
|cls refactoring|
(self askIfModified) ifFalse:[
^ self
].
(Dialog
confirm:'About to rewrite methods...'
title:'About to rewrite methods...'
yesLabel:'proceed'
noLabel:'cancel')
ifFalse:[
^ self
].
cls := aClass whichClassDefinesClassVar:oldName.
refactoring := PushDownClassVariableRefactoring variable:oldName class:cls.
self performRefactoring:refactoring.
!
codeMenuPushDownInstanceVariable
"push an instance variable down to its subclasses"
self withCurrentClassDo:[:cls |
|oldName node mthd definingClass|
cls isMeta ifTrue:[
^ self warn:'Please switch to the non-meta side.'
].
node := self findNode.
node isNil ifTrue:[
(self hasInstanceVariableSelectedInCodeView) ifFalse:[
oldName := self theSingleSelectedVariable.
oldName isNil ifTrue:[
^ self warn:'Please select a variable'
]
] ifTrue:[
oldName := self selectionInCodeView.
]
] ifFalse:[
node isVariable ifFalse:[
^ self warn:'Please select a variable'
].
oldName := node name.
].
definingClass := cls whichClassDefinesInstVar:oldName.
definingClass isNil ifTrue:[
self warn:'Oops - could not find the defining class'.
^ self
].
definingClass ~~ cls ifTrue:[
(self confirm:'Will pull ''' , oldName , ''' from ' , definingClass name , ' - OK ?')
ifFalse:[
^ self
].
].
self codeMenuPushDownInstanceVariable:oldName inClass:definingClass.
mthd notNil ifTrue:[
"/ self switchToSelector:mthd selector.
self switchToMethod:mthd.
].
].
!
codeMenuPushDownInstanceVariable:varName inClass:aClass
"push an instance variable down to its subclasses"
|cls refactoring|
(self askIfModified) ifFalse:[
^ self
].
(Dialog
confirm:('About to push instance variable ''%1'' down to subclasses which use it...' bindWith:varName allBold)
title:('About to pushDown ''%1''...' bindWith:varName)
yesLabel:'Proceed'
noLabel:'Cancel')
ifFalse:[
^ self
].
cls := aClass whichClassDefinesInstVar:varName.
refactoring := PushDownInstanceVariableRefactoring variable:varName class:cls.
self performRefactoring:refactoring.
!
codeMenuPushDownVariable
"push a variable down to its subclasses"
|varName|
varName := self selectedInstanceVariableOrNil.
varName notNil ifTrue:[
^ self codeMenuPushDownInstanceVariable
].
varName := self selectedClassVariableOrNil.
varName notNil ifTrue:[
^ self codeMenuPushDownClassVariable
].
^ self warn:'Please select a variable and try again.'
!
codeMenuRemoveClassVariable:oldName inClass:aClass
"remove a class variable"
|cls change methods|
(self askIfModified) ifFalse:[
^ self
].
cls := aClass theNonMetaclass whichClassDefinesClassVar:oldName.
methods := self class
findClassRefsTo:oldName
under:cls access:#readOrWrite.
"/ methods addAll:(self class
"/ findClassRefsTo:oldName
"/ under:cls theMetaclass access:#readOrWrite).
methods notEmpty ifTrue:[
(Dialog confirm:(resources
stringWithCRs:'"%1" is still referenced by %2 method(s).\\Remove anyway ?'
with:oldName
with:methods size)) ifFalse:[^ self].
].
change := RemoveClassVariableChange remove:oldName from:cls.
self performRefactoring:change.
!
codeMenuRemoveInstanceVariable:oldName inClass:aClass
"remove an instance variable"
|cls refactoring methods answer whatTypeOfMethods|
(self askIfModified) ifFalse:[ ^ self ].
cls := aClass whichClassDefinesInstVar:oldName.
cls isNil ifTrue:[
self error:'no class'
].
methods := self class
findInstRefsTo:oldName
under:cls access:#readOrWrite.
methods notEmpty ifTrue:[
whatTypeOfMethods := 'method'.
(methods conform:[:m |
|tree searcher|
tree := RBParser
parseSearchMethod:m source
onError: [:str :pos | nil].
searcher := ParseTreeSearcher isGetterOrSetterMethod:oldName.
searcher executeTree:tree initialAnswer:false.
]) ifTrue:[ whatTypeOfMethods := 'accessor' ].
answer := OptionBox
request:(resources
stringWithCRs:'"%1" is still referenced by %2 %3(s).\\Remove these methods ?'
with:oldName
with:methods size
with:whatTypeOfMethods)
label:'Confirm Removal'
image:(WarningBox iconBitmap)
buttonLabels:(resources array:#('Cancel' 'Browse' 'No' 'Remove Methods'))
values:#(#abort #browse false true)
default:#abort
onCancel:#abort.
answer == #abort ifTrue:[^ self].
answer == #browse ifTrue:[
self class
browseMethods:methods
title:(resources string:'Methods referring to %1' with:oldName).
^ self.
].
answer == true ifTrue:[
self doRemoveMethodsUnconfirmed:methods
].
].
refactoring := RemoveInstanceVariableChange remove:oldName from:cls.
"/ refactoring := RemoveInstanceVariableRefactoring variable:oldName class:cls.
"/ refactoring model name:('remove instvar %1 from %2' bindWith:oldName with:cls name).
self performRefactoring:refactoring.
!
codeMenuRemoveParameter
"remove the parameter which is selected in the codeView"
self codeMenuRemoveParameter:(self selectionInCodeView).
!
codeMenuRemoveParameter:parameterName
"remove the parameter named parameterName"
| cls selector refactoring|
(self askIfModified) ifFalse:[
^ self
].
cls := self theSingleSelectedMethod mclass.
selector := self theSingleSelectedMethod selector.
(self confirm:(resources string:'Remove parameter ''%1'' ?' with:parameterName allBold)) ifFalse:[^ self].
refactoring := RemoveParameterRefactoring removeParameter:parameterName in:cls selector:selector.
(self findSendersOf:selector andConfirmRefactoring:refactoring) ifTrue:[
self performRefactoring:refactoring.
self switchToSelector:refactoring newSelector.
]
!
codeMenuRenameClassVariable
"rename a class variable"
self withCurrentClassDo:[:cls |
|oldName node mthd cls definingClass|
node := self findNode.
node isNil ifTrue:[
(self hasClassVariableSelectedInCodeView) ifFalse:[
oldName := self theSingleSelectedVariable.
oldName isNil ifTrue:[
^ self warn:'Please select a variable'
]
] ifTrue:[
oldName := self selectionInCodeView.
]
] ifFalse:[
node isVariable ifFalse:[
^ self warn:'Please select a variable'
].
oldName := node name.
].
definingClass := cls whichClassDefinesClassVar:oldName.
definingClass isNil ifTrue:[
self warn:'Oops - could not find the defining class'.
^ self
].
definingClass ~~ cls ifTrue:[
(self confirm:'Will rename in ' , definingClass name , ' - OK ?')
ifFalse:[
^ self
].
].
self codeMenuRenameClassVariable:oldName inClass:definingClass.
].
!
codeMenuRenameClassVariable:oldName inClass:aClass
"rename a class variable"
|newName refactoring cls|
(self askIfModified) ifFalse:[
^ self
].
newName := Dialog request:('Enter the new name for classVariable ''%1'':' bindWith:oldName) initialAnswer:oldName.
newName isEmpty ifTrue:[
^ self
].
(cls := aClass whichClassDefinesClassVar:newName) notNil ifTrue:[
(Dialog confirm:(resources string:'Attention: a variable named ''%1'' is already defined in ''%2''.\\Proceed ?'
with:newName allBold
with:cls name allBold))
ifFalse:[
^ self
].
].
(self confirm:'About to rewrite methods...') ifFalse:[^ self].
cls := aClass whichClassDefinesClassVar:oldName.
"/ refactoring := RenameClassVariableChange rename: oldName to: newName in: aClass.
refactoring := RenameClassVariableRefactoring rename:oldName to:newName in:cls.
self performRefactoring:refactoring.
!
codeMenuRenameInstanceVariable
"rename an instance variable"
self withCurrentClassDo:[:cls |
|oldName node mthd definingClass|
cls isMeta ifTrue:[
^ self warn:'Please switch to the non-meta side.'
].
node := self findNode.
node isNil ifTrue:[
(self hasInstanceVariableSelectedInCodeView) ifFalse:[
oldName := self theSingleSelectedVariable.
oldName isNil ifTrue:[
^ self warn:'Please select a variable'
]
] ifTrue:[
oldName := self selectionInCodeView.
]
] ifFalse:[
node isVariable ifFalse:[
^ self warn:'Please select a variable'
].
oldName := node name.
].
definingClass := cls whichClassDefinesInstVar:oldName.
definingClass isNil ifTrue:[
self warn:'Oops - could not find the defining class'.
^ self
].
definingClass ~~ cls ifTrue:[
(self confirm:'Will rename in ' , definingClass name , ' - OK ?')
ifFalse:[
^ self
].
].
self codeMenuRenameInstanceVariable:oldName inClass:definingClass.
mthd notNil ifTrue:[
"/ self switchToSelector:mthd selector.
self switchToMethod:mthd.
].
].
!
codeMenuRenameInstanceVariable:oldName inClass:aClass
"rename an instance variable"
|newName refactoring cls|
(self askIfModified) ifFalse:[ ^ self ].
newName := Dialog
request:(resources
string:'Enter new name for %2 variable ''%1'':'
with:oldName allBold
with:(self meta value ifTrue:['classInstance'] ifFalse:['instance']))
title:(resources string:'Rename Variable')
initialAnswer:oldName.
newName isEmpty ifTrue:[
^ self
].
(cls := aClass whichClassDefinesInstVar:newName) notNil ifTrue:[
Dialog warn:(resources string:'Sorry: a variable named ''%1'' is already defined in ''%2''.\\Proceed ?'
with:newName allBold
with:cls name allBold).
^ self
].
(Dialog
confirm:(resources string:'About to rewrite methods...')
title:(resources string:'About to rewrite methods...')
yesLabel:(resources string:'Proceed')
noLabel:(resources string:'Cancel'))
ifFalse:[
^ self
].
cls := aClass whichClassDefinesInstVar:oldName.
refactoring := RenameInstanceVariableRefactoring rename:oldName to:newName in:cls.
self performRefactoring:refactoring.
!
codeMenuRenameTemporary
"rename a temporary variable"
|oldName newName node definingNode refactoring mthd initial|
(self askIfModified) ifFalse:[
^ self
].
node := self findNode.
(node isNil or:[node isVariable not]) ifTrue:[
^ self warn:'Please select a temporary variable in the code.'
].
oldName := node name.
definingNode := node whoDefines: oldName.
definingNode isNil ifTrue: [self warn: oldName , ' is not a temporary variable in the method'. ^ self].
LastVariableRenames isNil ifTrue:[
LastVariableRenames := CacheDictionary new:30.
].
initial := LastVariableRenames at:oldName ifAbsent:oldName.
newName := Dialog request:('Enter new name for ''%1'':' bindWith:oldName allBold) initialAnswer:initial.
newName size == 0 ifTrue:[
^ self "/ cancel
].
newName = oldName ifTrue: [self warn: 'Same name given.'. ^ self].
LastVariableRenames at:oldName put:newName.
refactoring := RenameTemporaryRefactoring
renameTemporaryFrom:node sourceInterval
to:newName
in:(mthd := self theSingleSelectedMethod) mclass
selector:mthd selector.
refactoring source:(self codeView contentsAsString).
refactoring okToRenameAsKnownVariable:true.
"/ refactoring model name:('rename local variable %1 to %2' bindWith:oldName with:newName).
self performRefactoring:refactoring.
self switchToMethod:mthd.
!
findNode
|interval|
interval := self selectedInterval.
^ self findNodeForInterval:interval
!
findNodeForInterval:interval
^ DoWhatIMeanSupport
findNodeForInterval:interval
in:(self codeView contentsAsString string).
!
findNodeForInterval:interval allowErrors:allowErrors
^ DoWhatIMeanSupport
findNodeForInterval:interval
in:(self codeView contentsAsString string)
allowErrors:allowErrors.
!
findNodeIn:tree forInterval:interval
<resource: #obsolete>
|node wouldReturn|
self obsoleteMethodWarning.
node := nil.
tree nodesDo:[:each |
(each intersectsInterval:interval) ifTrue:[
(node isNil or:[node == each parent]) ifTrue:[
node := each
] ifFalse:[
(node parent notNil
and:[node parent isCascade and:[each parent isCascade]]) ifFalse:[^ nil]
]
] ifFalse:[
node notNil ifTrue:[
"/ already found one - beyond that one; leave
wouldReturn notNil ifTrue:[wouldReturn := node].
]
].
].
"/ (wouldReturn notNil and:[wouldReturn ~~ node]) ifTrue:[self halt].
^ node
"Modified: / 20-11-2006 / 12:31:12 / cg"
!
findSendersOf:selector andConfirmRefactoring:refactoring
^ self findSendersOf:selector in:(Smalltalk allClasses) andConfirmRefactoring:refactoring
"Modified: / 28-02-2007 / 21:20:23 / cg"
!
findSendersOf:selector in:aSetOfClasses andConfirmRefactoring:refactoring
|senders nSenders classes nClasses firstClassName secondClassName infoMsg answer brwsr|
"/ how many senders are there ?
senders := SystemBrowser findSendersOf:selector in:aSetOfClasses ignoreCase:false match:false.
nSenders := senders size.
nSenders == 0 ifTrue:[ ^ true ].
classes := (senders collect:[:eachMethod | eachMethod mclass]) asIdentitySet.
nClasses := classes size.
nClasses > 0 ifTrue:[
firstClassName := classes first name allBold.
nClasses > 1 ifTrue:[
secondClassName := classes second name allBold.
].
].
nClasses == 1 ifTrue:[
nSenders == 1 ifTrue:[
infoMsg := 'Proceed to rewrite sending method %5'
] ifFalse:[
infoMsg := 'Proceed to rewrite %1 sending method(s) in %3'
]
] ifFalse:[
nClasses == 2 ifTrue:[
infoMsg := 'Proceed to rewrite %1 sending method(s) in %3 and %4'
] ifFalse:[
infoMsg := 'Proceed to rewrite %1 sending method(s) in %2 class(es)'
]
].
infoMsg := resources
string:infoMsg
with:nSenders printString
with:nClasses printString
with:firstClassName
with:secondClassName
with:senders first whoString allBold.
infoMsg := infoMsg , (resources stringWithCRs:'\for "%1" ?' with:refactoring changeString).
answer := Dialog
confirmWithCancel:infoMsg
labels:#('Cancel' 'Browse' 'Rewrite' )
values:#(nil #browse #rewrite)
default:3.
answer == nil ifTrue:[
"/ cancel
^ false
].
answer == #browse ifTrue:[
brwsr := self
spawnMethodBrowserFor:senders in:#newBuffer
label:'Senders of ' , selector
perMethodInfo:nil
sortBy:#class.
brwsr autoSearchPattern:selector.
^ false
].
^ true
"Created: / 28-02-2007 / 21:20:10 / cg"
!
formatCode
"format (prettyPrint) the selected method's code"
|tree newText mthd codeView|
RBParser isNil ifTrue:[^ nil].
codeView := self codeView.
mthd := self theSingleSelectedMethod.
tree := RBParser
parseMethod:(codeView contentsAsString)
onError: [:aString :position |
codeView selectFromCharacterPosition:1 to:position.
self showInfo:aString.
^ nil "ignore any error"
].
tree isNil ifTrue:[^ nil].
newText := tree printString.
self doSyntaxColoring value ~~ false ifTrue:[
newText := self syntaxHighlightedCodeFor:newText method:mthd.
].
codeView
undoableDo:[ codeView replaceContentsWith:newText ]
info:'Format'.
codeView modified:true.
navigationState realModifiedState:true.
^ newText.
!
handlingRefactoringErrorDo:aBlock
^ Refactoring preconditionSignal
handle:[:ex |
|param answer errMsg dialogMsg|
errMsg := ex description.
param := ex parameter.
ex willProceed ifTrue:[
dialogMsg := (errMsg last == $?)
ifTrue:[errMsg]
ifFalse:[errMsg , '\\Do you want to proceed?' withCRs].
param notNil ifTrue:[
answer := Dialog
choose:dialogMsg
labels:#('No' 'No, Browse' 'Yes')
values:#(false #browse true)
default:true
] ifFalse:[
answer := Dialog confirm:dialogMsg
].
answer == #browse ifTrue:[
"/ param is either a collection of classes, or methods;
param := param collect:[:each | (each isKindOf:RBAbstractClass) ifTrue:[
each realClass
] ifFalse:[
self error:'should not happen' mayProceed:true.
(each isKindOf:RBMethod) ifTrue:[
] ifFalse:[
].
each
]
].
param first isBehavior ifTrue:[
self
spawnClassBrowserFor:param
label:'Classes affected by change'
in:#newBrowser
select:false
] ifFalse:[
self
spawnMethodBrowserFor:param
in:#newBrowser
label:'Methods affected by change'
].
answer := false
"/ answer := Dialog confirm: (ex description last == $?
"/ ifTrue: [ex description]
"/ ifFalse: [ex description , '\Do you want to proceed?' withCRs]).
].
answer ifTrue:[
ex proceed
]
] ifFalse:[
param notNil ifTrue:[
(Dialog confirm:errMsg) ifTrue:[
ex parameter value
]
] ifFalse:[
ex mayProceed ifTrue:[
(Dialog
confirm:('Missing Precondition for refactoring:\\' withCRs , errMsg)
yesLabel:'Proceed Anyway'
noLabel:'Cancel')
ifTrue:[
ex proceed.
].
] ifFalse:[
Dialog warn:('Refactoring failed:\\' withCRs , errMsg)
].
]
].
ex return
]
do:[self topApplication withWaitCursorDo:aBlock]
!
operationsMenuRedo
|manager|
manager := RefactoryChangeManager instance.
self changeRequest ifTrue:[
manager redoOperation.
]
!
operationsMenuUndo
|manager|
manager := RefactoryChangeManager instance.
self changeRequest ifTrue:[
manager undoOperation.
]
!
operationsMenuUndo:aChange
aChange execute
!
performRefactoring:aRefactoring
|rslt|
aRefactoring isNil ifTrue:[
^ self
].
rslt := self
handlingRefactoringErrorDo:
[
aRefactoring isRefactoryChange ifTrue:[
RefactoryChangeManager performChange:aRefactoring
] ifFalse:[
aRefactoring execute
].
].
self enqueueDelayedUpdateCodeWithoutAutoSearch.
^ rslt
"Modified: / 16-11-2006 / 19:34:19 / cg"
!
selectedClassVariableOrNil
"return the selected class variable from either the variableList or
the codeView. Return nil, if nothing is selected, or the selection is not
a class variable."
|varName cls|
varName := self selectedClassVariableInCodeViewOrNil.
varName notNil ifTrue:[
cls := self theSingleSelectedClass theNonMetaclass whichClassDefinesClassVar:varName.
cls notNil ifTrue:[
^ varName
].
].
self showingClassVarsInVariableList ifTrue:[
varName := self theSingleSelectedVariable.
^ varName.
].
^ nil.
!
selectedInstanceVariableOrNil
"return the selected instance variable from either the variableList or
the codeView. Return nil, if nothing is selected, or the selection is not
an instance variable."
|varName cls|
varName := self selectedInstanceVariableInCodeViewOrNil.
varName notNil ifTrue:[
cls := self theSingleSelectedClass whichClassDefinesInstVar:varName.
cls notNil ifTrue:[
^ varName.
].
].
self showingClassVarsInVariableList ifFalse:[
varName := self theSingleSelectedVariable.
^ varName.
].
^ nil.
!
selectedInterval
| codeView |
codeView := self codeView.
codeView isNil ifTrue:[^1 to: 0].
^ codeView selectedInterval
!
setUndoCount
| undoString undoSize |
(self canUseRefactoringSupport) ifFalse:[^ self].
undoString := Dialog request: 'Enter undo stack size:\(i.e.: Number of remembered operations)' withCRs
initialAnswer:(RefactoryChangeManager undoSize printString).
undoSize := Integer readFrom:undoString onError:nil.
undoSize isNil ifTrue: [^self].
RefactoryChangeManager undoSize: undoSize
!
synchronousUpdate
^ self class synchronousUpdate
!
treeForCodeAllowErrors:allowErrors
<resource: #obsolete>
|source tree|
self obsoleteMethodWarning.
source := self codeView contentsAsString string.
tree := RBParser
parseMethod:source
onError: [:str :err :nodesSoFar :parser|
allowErrors ifTrue:[
^ parser currentMethodNode
].
^ nil
]
proceedAfterError:false
rememberNodes:true.
^ tree
"Modified: / 10-11-2006 / 13:13:58 / cg"
!
withCurrentClassDo:aOneArgBlock
|mthd cls|
(self askIfModified) ifFalse:[
^ self
].
(mthd := self theSingleSelectedMethod) notNil ifTrue:[
cls := mthd mclass.
] ifFalse:[
self codeAspect value ~= #classDefinition ifTrue:[
^ self warn:'Select either a class or a method.'
].
cls := self theSingleSelectedClass.
].
aOneArgBlock value:cls.
!
withCurrentMethodsClassAndSelectorDo:aTwoArgBlock
|currentMethod cls selector|
(self askIfModified) ifFalse:[
^ self
].
currentMethod := self theSingleSelectedMethod.
cls := currentMethod mclass.
selector := currentMethod selector.
self assert:(cls notNil and:[selector notNil]) message:'no class/method'.
aTwoArgBlock value:cls value:selector.
! !
!NewSystemBrowser methodsFor:'menu actions-debug'!
commonTraceHelperWith:aSelector with:argumentOrNil clear:doClear
"install a break/trace or countPoint for the current method(s)"
self selectedMethodsDo:[:mthdArg |
|mthd originalMethod cls sel|
mthd := mthdArg.
cls := mthd mclass.
cls notNil ifTrue:[
sel := mthd selector.
doClear ifTrue:[
mthd isWrapped ifTrue:[
originalMethod := mthd originalMethod.
mthd clearBreakPoint.
mthd := originalMethod.
sel isNil ifTrue:[sel := mthd selector].
].
].
aSelector == #changeUpdateTrace ifTrue:[
MessageTracer traceUpdateMethod:mthd on:Transcript
] ifFalse:[
aSelector numArgs == 0 ifTrue:[
mthd perform:aSelector.
] ifFalse:[
mthd perform:aSelector with:argumentOrNil.
]
].
sel isNil ifTrue:[sel := mthd selector].
(sel isNil
and:[mthd isWrapped
and:[(originalMethod := mthd originalMethod) notNil]]) ifTrue:[
sel := originalMethod selector
].
]
].
!
debugMenuBreakPoint
"set a breakpoint on the selected method(s)"
self commonTraceHelperWith:#setBreakPoint with:nil clear:true.
!
debugMenuBreakPointAfter
"set a breakpoint on the current method(s), which only trigger(s) if
the method has been invoked some number of times."
|answer n|
answer := DialogBox request:'Enter debugger after how many invocations:'.
answer isNil ifTrue:[^self].
n := Number readFrom:answer onError:nil.
n isNil ifTrue:[^self].
self commonTraceHelperWith:#breakPointAfter: with:n clear:true
!
debugMenuBreakPointFor
"set a breakpoint on the current method(s), which only trigger(s) if
the receiver is an instance or subInstance of some class"
|mthd classList initialSelection class conditionBlock|
initialSelection := nil.
"/ LastBreakPointClassName notNil ifTrue:[
"/ initialSelection := LastBreakPointClassName.
"/ ].
mthd := self theSingleSelectedMethod.
classList := mthd mclass withAllSubclasses.
classList sort:[:a :b | a name < b name].
"/ resources := ResourcePack for:self class.
Dialog aboutToOpenBoxNotificationSignal
handle:[:ex |
ex parameter window minExtent:300@300.
ex proceed.
] do:[
class := Dialog
choose:(resources string:'Break for (Sub-)Instances of')
fromList:classList
lines:20
initialSelection:initialSelection
title:(resources string:'Break for some Instances only').
].
class isNil ifTrue:[^ self].
"/ LastBreakPointClassName := class name.
conditionBlock := [:context :method | context receiver isKindOf:class ].
self commonTraceHelperWith:#breakPointIf: with:conditionBlock clear:true
!
debugMenuBreakPointIf
"set a breakpoint on the current method(s), which only trigger(s) if
some conditionBlock evaluates to true."
|conditionBlockString conditionBlock dialog textHolder template|
template :=
'"/ General breakpoint
"/
"/ the following block should evaluate to true, if the breakPoint is to fire.
"/ Please change as required.
"/ Beginner warning: Smalltalk know-how is useful here.
|counter|
counter := 0.
[:context :method |
counter := counter + 1.
"/ Define condition for breakpoint below:
"/ Useful queries are:
"/ - Processor activeProcess the active process
"/
"/ Useful queries to the context are:
"/ - receiver the receiver
"/ - argAt:N the N''th argument
"/ - receiver instVarNamed:''nm'' an instance variable in the receiver
"/ - sender the sender context
"/ - sender selector the sender context''s selector
"/ - sender receiver the sender context''s receiver
"/
"/ Other Useful stuff:
"/ - counter invocation counter
"/ examples:
"/ stop if the receiver is a NewSystemBrowser
"/ (context receiver isMemberOf:NewSystemBrowser)
"/ stop if some argument has a particular value
"/ (context argAt:1) = ''hello''
"/ (context argAt:1) = 1234
"/ (context argAt:1) = (context argAt:2)
"/ stop if the sender is a Workspace
"/ (context sender receiver isMemberOf:Workspace)
"/ stop if an instance variable is true
"/ ((context receiver instVarNamed:''foo'') == true)
"/ stop after 5 calls (notice the scope of the counter variable, outside the block)
"/ counter >= 5
"/ stop always
"/ true
]
'.
LastBreakPointConditionString isNil ifTrue:[
LastBreakPointConditionString := template.
].
"/ resources := ResourcePack for:self class.
textHolder := ValueHolder new.
dialog := Dialog
forRequestText:(resources string:'Enter condition for breakpoint')
lines:20
columns:70
initialAnswer:LastBreakPointConditionString
model:textHolder.
dialog addButton:(Button label:'Template' action:[textHolder value:template. textHolder changed:#value.]).
dialog open.
dialog accepted ifFalse:[^ self].
conditionBlockString := textHolder value.
LastBreakPointConditionString := conditionBlockString.
conditionBlock := Parser evaluate:conditionBlockString.
conditionBlock isBlock ifFalse:[
self error:'bad input'.
^ self
].
self commonTraceHelperWith:#breakPointIf: with:conditionBlock clear:true
"Modified: / 20-10-2010 / 09:33:57 / cg"
!
debugMenuBreakPointIn
"set a breakpoint on the current method(s), which only trigger(s) if
executed by some particular process."
|processes processNames box windowGroups selectedProcessIndex|
windowGroups := WindowGroup allInstances.
processes := ProcessorScheduler knownProcesses asOrderedCollection.
processes := processes select:[:aProcess |
aProcess notNil
and:[aProcess id notNil]
].
processes := processes sort:[:a :b | a id < b id].
processNames := processes collect:[:aProcess |
|pName theGroup top topLabel winLabel|
pName := aProcess nameOrId.
"/ if its a windowGroup process,
"/ fetch its first topViews name and add.
"/ (allows selecting among multiple browsers ...)
winLabel := ''.
theGroup := windowGroups detect:[:g | g process == aProcess] ifNone:nil.
theGroup notNil ifTrue:[
top := theGroup topViews.
top size > 0 ifTrue:[
top := top first.
topLabel := top label.
(topLabel notNil and:[topLabel ~= pName]) ifTrue:[
winLabel := ' ("' , topLabel , '")'.
]
].
].
aProcess id printString , ' [' , pName , ']' , winLabel
].
"/ let user specify which one ...
box := ListSelectionBox new.
box noEnterField.
box list:processNames.
box label:(resources string:'process selection').
box title:(resources
string:'Stop if method is executed by process:\\(current process is %1)'
with:(Processor activeProcess id)
with:(Processor activeProcess nameOrId)) withCRs.
box action:[:selection | selectedProcessIndex := box selectionIndex].
box initialSelection:(processes identityIndexOf:Processor activeProcess).
box showAtPointer.
box destroy.
selectedProcessIndex notNil ifTrue:[
self
commonTraceHelperWith:#breakPointInProcess:
with:(processes at:selectedProcessIndex)
clear:true
].
"Created: / 14.10.1996 / 15:40:53 / cg"
"Modified: / 12.1.1998 / 19:14:37 / cg"
"Modified: / 2.2.1998 / 12:39:38 / stefan"
!
debugMenuClearCoverageInfo
"clear all coverage information"
InstrumentedMethod cleanAllInfo
"Created: / 27-04-2010 / 19:00:32 / cg"
!
debugMenuOpenCallGraphForClasses
"open an OOM CallGraph view on the selected class(es)"
self debugMenuOpenCallGraphForClasses:(self selectedClasses value).
"Created: / 27-04-2010 / 14:07:58 / cg"
!
debugMenuOpenCallGraphForClasses:classes
"open an OOM CallGraph view on the selected class(es)"
|methods|
methods := classes collectAll:[:cls | cls instAndClassMethods].
self debugMenuOpenCallGraphForMethods:methods.
"Created: / 27-04-2010 / 14:09:29 / cg"
!
debugMenuOpenCallGraphForMethods:methods
"open an OOM CallGraph view on the selected class(es)"
|callingMethods allMethods|
OOM::MetricVisualizer isNil ifTrue:[
Dialog information:'Missing class: OOM::MetricVisualizer'.
^ self.
].
callingMethods := Set new.
methods
do:[:eachMethod |
|info|
InstrumentingCompiler callersOf:eachMethod do:[:callingMethod |
callingMethod == eachMethod ifFalse:[
callingMethods add:callingMethod
]
]
].
callingMethods removeAllFoundIn:methods.
callingMethods do:[:caller |
"/ dont do primitives...
caller hasPrimitiveCode ifFalse:[
caller mclass notNil ifTrue:[
caller isInstrumented ifFalse:[
InstrumentingCompiler compileMethod:caller
].
]
].
].
allMethods := Set withAll:methods.
allMethods addAll:callingMethods.
OOM::MetricVisualizer
openViewerOnDiagramForMethods:allMethods
setupWith:[:viewer | viewer set_DynamicMethodInvocationDiagram]
"Created: / 27-04-2010 / 14:07:07 / cg"
!
debugMenuOpenCallGraphForProjects
"open an OOM CallGraph view on the selected project(s) classes"
self debugMenuOpenCallGraphForClasses:(self selectedProjectClasses).
"Created: / 27-04-2010 / 14:08:02 / cg"
!
debugMenuRemoveAllBreakpoints
"remove all breakpoints in the system"
(MessageTracer notNil and:[MessageTracer isLoaded]) ifTrue:[
self withExecuteCursorDo:[
MessageTracer unwrapAllMethods
]
]
!
debugMenuRemoveBreakOrTrace
"remove any break/trace on the selected method(s)"
self commonTraceHelperWith:#clearBreakPoint with:nil clear:false.
!
debugMenuStartCounting
"set a countpoint on the current method"
self commonTraceHelperWith:#startCounting with:nil clear:true
!
debugMenuStartMemoryUsage
"set a countpoint for memory usage on the current method"
self commonTraceHelperWith:#startCountingMemoryUsage with:nil clear:true
!
debugMenuStartTiming
"set a timing on the current method"
self commonTraceHelperWith:#startTiming with:nil clear:true
!
debugMenuStopCounting
"show the number of invocations & remove a countpoint on the current method"
self commonTraceHelperWith:#stopCounting with:nil clear:true
!
debugMenuStopMemoryUsage
"stop counting of memory usage for this method"
self commonTraceHelperWith:#stopCountingMemoryUsage with:nil clear:true.
!
debugMenuStopTiming
"stop timing the current method"
self commonTraceHelperWith:#stopTiming with:nil clear:true
!
debugMenuTrace
"set a tracepoint on the selected method(s)"
self commonTraceHelperWith:#setTracePoint with:nil clear:true.
!
debugMenuTraceChangeUpdate
"set a change-update tracepoint on the selected method(s).
Like a regular trace, but knows about the observer pattern"
self commonTraceHelperWith:#changeUpdateTrace with:nil clear:true.
!
debugMenuTraceFullWalkback
"set a full-tracepoint on the selected method(s)"
self commonTraceHelperWith:#setTraceFullPoint with:nil clear:true.
!
debugMenuTraceSender
"set a sender-tracepoint on the selected method(s)"
self commonTraceHelperWith:#setTraceSenderPoint with:nil clear:true.
!
runTestCases
"run selected testcases (not opening a debugger on error)"
self runTestCasesWithDebug:false
"Modified: / 05-08-2006 / 17:32:19 / cg"
!
runTestCasesForCoverage
"run selected testcases for coverage tests;
First, compile all affected testee-classes with instrumentation,
then run the tests, then open a browser on the tested classes."
|testedClassNames testedClasses browser|
testedClassNames := Set new.
self selectedNonAbstractTestCaseClassesDo:[:eachClass |
testedClassNames addAll:(eachClass testedClasses).
].
testedClasses := testedClassNames collect:[:eachClassName | Smalltalk at:eachClassName].
testedClasses do:[:eachClass |
self recompileClassWithInstrumentation:eachClass
].
self runTestCasesWithDebug:false protocols:nil.
browser := self class browseClasses:testedClasses.
browser showCoverageInformation value:true.
browser windowLabel:'Coverage Info after Test Execution'.
"Modified: / 10-08-2010 / 14:36:51 / cg"
!
runTestCasesWithDebug
"run selected testcases (opening a debugger on error)"
self runTestCasesWithDebug:true
"Created: / 05-08-2006 / 17:32:24 / cg"
!
runTestCasesWithDebug:withDebug
"run selected testcases"
^ self runTestCasesWithDebug:withDebug protocols:self selectedProtocolsValue.
!
runTestCasesWithDebug:withDebug protocols:protocolsOrNil
"run selected testcases"
|t|
[
t := Time millisecondsToRun:[
self selectedNonAbstractTestCaseClassesDo:[:cls |
|isCompleteSuite suite selectors toRun result|
(protocolsOrNil isEmptyOrNil
or:[protocolsOrNil includes:BrowserList nameListEntryForALL]) ifTrue:[
isCompleteSuite := true.
suite := cls buildSuite.
] ifFalse:[
isCompleteSuite := false.
(selectors := self selectedSelectors) isEmptyOrNil ifTrue:[
selectors := OrderedCollection new.
self selectedProtocolMethodsDo:[:cls :category :sel :mthd |
((cls isSubclassOf:TestCase) and:[cls isAbstract not]) ifTrue:[
(cls isTestSelector:sel) ifTrue:[
selectors add:sel
].
].
].
].
suite := cls buildSuiteFromMethods:selectors.
].
self busyLabel:'running test %1 ...' with:cls name.
toRun := suite tests size.
result := TestResult new.
withDebug ifTrue:[
suite tests do:[:each |
|errorHappened|
errorHappened := false.
GenericException handle:[:ex |
(HaltInterrupt accepts:ex signal) ifFalse:[
ex signal == NoHandlerError ifFalse:[
errorHappened := true.
]
].
ex reject.
] do:[
each debug
].
errorHappened ifTrue:[
cls rememberFailedTest:each selector.
result failures add:each.
] ifFalse:[
cls rememberPassedTest:each selector.
result passed add:each.
]
]
] ifFalse:[
suite
run: result
beforeEachTestCaseDo:[:case :result |
self showInfo:('To Run: %1 ; executing %2...' bindWith:toRun with:case printString).
]
afterEachTestCaseDo:[:case :result |
toRun := toRun - 1.
].
cls rememberPassedTestsFromResult:result.
cls rememberFailedTestsFromResult:result.
].
result hasPassed ifTrue:[
result passedCount > 0 ifTrue:[
isCompleteSuite ifTrue:[ cls rememberPassedTestRun ].
self showInfo:(result printString asText colorizeAllWith:Color black on:Color green).
].
] ifFalse:[
isCompleteSuite ifTrue:[ cls rememberFailedTestRun ].
self showInfo:(result printString asText colorizeAllWith:Color black on:Color red).
].
].
].
] ensure:[
self normalLabel.
].
Transcript showCR:(TimeDuration new setMilliseconds:t).
"Created: / 05-08-2006 / 17:32:06 / cg"
"Modified: / 08-08-2010 / 05:15:50 / cg"
!
selectedNonAbstractTestCaseClassesDo:aBlock
"run selected testcases for coverage tests;
First, compile all affected testee-classes with instrumentation,
then run the tests, then open a browser on the tested classes."
|selectedClasses|
selectedClasses := self selectedClasses value.
selectedClasses isEmptyOrNil ifTrue:[
selectedClasses := self selectedCategoryClasses
].
selectedClasses do:[:eachClass |
|cls|
cls := eachClass.
cls isLoaded ifFalse:[
cls := eachClass autoload.
].
cls := cls theNonMetaclass.
((cls isSubclassOf:TestCase)
and:[cls isAbstract not]) ifTrue:[
aBlock value:cls
]
].
! !
!NewSystemBrowser methodsFor:'menu actions-help'!
openClassDocumentation
HTMLDocumentView openFullOnDocumentationFile:'overview/basicClasses/TOP.html'
!
openDocumentation
HTMLDocumentView openFullOnDocumentationFile:'tools/newbrowser/TOP.html'
!
openKeywordIndexDocumentation
HTMLDocumentView openFullOnDocumentationFile:'index.html'
!
openRefactoringDocumentation
HTMLDocumentView openFullOnDocumentationFile:'tools/newbrowser/refactorings.html'
!
openSTXDocumentation
HTMLDocumentView openFullOnDocumentationFile:'TOP.html'
! !
!NewSystemBrowser methodsFor:'menu actions-inheritance'!
inheritanceMenuNavigateToClass
self switchToClass:(navigationState inheritanceView scrolledView selectionHolder value)
!
inheritanceMenuUpdate
self updateSpecialCodeEditorVisibility
! !
!NewSystemBrowser methodsFor:'menu actions-methodList'!
methodListMenuCheckInClass
"check the selected methods class(es) into the source repository."
|classes|
classes := self selectedMethods value collect:[:each | each mclass].
classes := classes asIdentitySet.
^ self
classMenuCheckIn:true
classes:(classes asOrderedCollection)
!
methodListMenuCopyList
"copy the method list to the clipBoard "
|text|
text := (self methodListApp methodList collect:[:mthd | mthd whoString]) asStringCollection asString.
self window setClipboardText:text
!
methodListMenuCopyListOfClasses
"copy the list of classes to the clipBoard "
|text|
text := (self methodListApp methodList collect:[:mthd | mthd mclass name]) asSet asStringCollection asString.
self window setClipboardText:text
"Created: / 09-10-2006 / 12:41:05 / cg"
!
methodListMenuFileOutAllAs
"fileOut all methods from the list - standard format"
^ self methodListMenuFileOutAllAsWithFormat:nil
"Created: / 15.11.2001 / 17:53:09 / cg"
!
methodListMenuFileOutAllAsWithFormat:aFormatSymbolOrNil
"fileOut all methods from the list - file format as specified by the argument:
nil - standard format
#xml - XML standard format
#sif - SIF (smalltalk interchange file) standard format
#binary - ST/X binary format
"
|methods|
methods := self methodListApp methodList.
methods size == 0 ifTrue:[ ^ self ].
self
fileOutMethods:methods
format:aFormatSymbolOrNil
fileNameTemplate:'someMethods'
boxTitle:'FileOut all listed methods as:'
"Created: / 15.11.2001 / 17:53:22 / cg"
"Modified: / 15.11.2001 / 18:00:20 / cg"
!
methodListMenuFileOutAllSIFAs
"fileOut all methods from the list - sif format"
^ self methodListMenuFileOutAllAsWithFormat:#sif
"Created: / 15.11.2001 / 17:53:33 / cg"
!
methodListMenuFileOutAllXMLAs
"fileOut all methods from the list - xml format"
^ self methodListMenuFileOutAllAsWithFormat:#xml
"Created: / 15.11.2001 / 17:53:43 / cg"
!
methodListMenuSpawnBufferWithClassOrSubclassReferences
"add a buffer showing references to any of the selected classes or any of its subclasses"
self spawnClassOrSubclassReferencesBrowserFor:(self selectedMethodsClasses) in:#newBuffer
"Created: / 07-08-2006 / 12:13:16 / cg"
!
methodListMenuSpawnBufferWithClassReferences
"add a buffer showing references to any of the selected classes"
self spawnClassReferencesBrowserFor:(self selectedMethodsClasses) in:#newBuffer
"Created: / 07-08-2006 / 12:12:47 / cg"
!
methodListMenuSpawnClassOrSubclassReferences
"open a new browser showing references to the selected classes or any of its subclass"
self spawnClassOrSubclassReferencesBrowserFor:(self selectedMethodsClasses) in:#newBrowser
"Created: / 07-08-2006 / 12:15:26 / cg"
!
methodListMenuSpawnClassReferences
"open a new browser showing references to the selected classes "
self spawnClassReferencesBrowserFor:(self selectedMethodsClasses) in:#newBrowser
"Created: / 07-08-2006 / 12:14:45 / cg"
!
methodListMenuSpawnClasses
"add a buffer showing the selected methodss classes"
^ self methodListMenuSpawnClasses:#newBrowser
!
methodListMenuSpawnClasses:where
"add a buffer/open a browser showing the selected methods classes"
|classes|
classes := (self selectedMethods value collect:[:each | each mclass]) asIdentitySet asOrderedCollection.
^ self spawnClassBrowserFor:classes in:where select:false
!
methodListMenuSpawnClassesBuffer
"add a buffer showing the selected methodss classes"
^ self methodListMenuSpawnClasses:#newBuffer
!
methodListMenuSpawnFullBrowser
"add a buffer showing the selected methodss classes"
^ self methodListMenuSpawnFullBrowserIn:#newBrowser
!
methodListMenuSpawnFullBrowserBuffer
"add a buffer showing the selected methodss classes"
^ self methodListMenuSpawnFullBrowserIn:#newBuffer
!
methodListMenuSpawnFullBrowserIn:where
"add a buffer/open a browser showing the selected methods classes"
|methods classes brwsr anyMeta anyNonMeta|
methods := self selectedMethods value.
classes := (methods collect:[:each | each mclass]) asIdentitySet asOrderedCollection.
brwsr := self spawnFullBrowserInClass:nil selector:nil in:where.
classes size > 0 ifTrue:[
brwsr immediateUpdate value:true.
brwsr selectedCategories value:(classes collect:[:each | each theNonMetaclass category]) asSet asOrderedCollection.
anyNonMeta := classes contains:[:any | any isMeta not].
anyMeta := classes contains:[:any | any isMeta].
anyMeta ifFalse:[
brwsr selectedClasses value:classes
] ifTrue:[
anyNonMeta ifFalse:[
brwsr meta value:true.
brwsr selectedClasses value:classes.
]
].
methods size == 1 ifTrue:[
brwsr selectProtocols:(methods collect:[:each | each category]) asSet asOrderedCollection.
brwsr selectedMethods value:methods
].
brwsr immediateUpdate value:false.
].
^ brwsr
! !
!NewSystemBrowser methodsFor:'menu actions-namespace'!
nameSpaceMenuCheckOut
"check-out all classes in the selected nameSpace from the source repository.
Individually ask for class revisions.
Offer chance to either overwrite the current version,
or merge-in the repository version.
"
|selectedNameSpaces selectedNameSpaceClasses|
selectedNameSpaces := self selectedNamespaces value.
selectedNameSpaceClasses := Smalltalk allClasses select:[:eachClass |
eachClass isPrivate not
and:[selectedNameSpaces includes:eachClass nameSpace name]
] .
self checkOutClasses:selectedNameSpaceClasses askForRevision:true
!
nameSpaceMenuNew
"nm"
|nm ns existing|
nm := Dialog request:(resources string:'Name of new NameSpace:').
(nm isNil or:[(nm := nm withoutSeparators) size == 0]) ifTrue:[
^ self
].
existing := Smalltalk at:nm asSymbol ifAbsent:nil.
existing notNil ifTrue:[
existing isNameSpace ifTrue:[
self warn:'A NameSpace named ''%1'' alread exists.' with:nm.
^ self
].
existing isBehavior ifFalse:[
self warn:'A class named ''%1'' alread exists.' with:nm.
^ self
].
self warn:'A global named ''%1'' alread exists.\(Currently bound to %2)' with:nm with:existing classNameWithArticle.
^ self
].
Class nameSpaceQuerySignal answer:Smalltalk do:[
ns := NameSpace fullName:nm.
].
ns isNil ifTrue:[
self warn:'Could not create new NameSpace ''%1''.' with:nm.
^ self
].
self selectedNamespaces value:(Array with:nm)
!
nameSpaceMenuRemove
"remove the selected namespace(s)"
self selectedNamespacesValue do:[:nm |
|ns|
nm ~= BrowserList nameListEntryForALL ifTrue:[
ns := Smalltalk at:nm asSymbol.
Smalltalk removeClass:ns.
]
].
!
nameSpaceMenuRename
self information:'Sorry - this functionality is not yet implemented'
!
nameSpaceMenuSpawn
"open a browser showing the selected namespaces only"
self spawnNamespaceBrowserFor:(self selectedNamespacesValue) in:#newBrowser
"Created: / 24.2.2000 / 21:25:28 / cg"
!
nameSpaceMenuSpawnBuffer
"add a buffer showing the selected namespaces only"
self spawnNamespaceBrowserFor:(self selectedNamespacesValue) in:#newBuffer
"Created: / 24.2.2000 / 21:25:40 / cg"
"Modified: / 18.8.2000 / 14:57:04 / cg"
!
nameSpaceMenuUpdate
self nameSpaceListApp forceUpdateList
!
spawnNamespaceBrowserFor:namespaces in:where
"browse selected namespace(s);
where is: #newBrowser - open a new browser showing the namespaces
where is: #newBuffer - add a new buffer showing the namespaces"
|spec namespaceList singleSelection selectedClasses|
(singleSelection := namespaces size == 1) ifTrue:[
spec := #singleNameSpaceBrowserSpec.
spec := #singleNameSpaceFullBrowserSpec.
] ifFalse:[
spec := #multipleNameSpaceBrowserSpec.
spec := #multipleNameSpaceFullBrowserSpec.
].
namespaceList := namespaces copy.
selectedClasses := self selectedClasses value.
self
newBrowserOrBufferDependingOn:where
label:nil
forSpec:spec
setupWith:[:brwsr |
"/ setup for a constant list ...
"/ brwsr immediateUpdate value:true.
brwsr organizerMode value:(OrganizerCanvas organizerModeNamespace).
brwsr nameSpaceListGenerator value:namespaceList.
brwsr selectNamespaces:(singleSelection ifTrue:[namespaceList] ifFalse:[#()]).
"/ brwsr immediateUpdate value:false.
]
"Modified: / 18.8.2000 / 16:13:15 / cg"
! !
!NewSystemBrowser methodsFor:'menu actions-other'!
editModeInsert
self codeView editModeInsert
!
editModeInsertAndSelect
self codeView editModeInsertAndSelect
!
editModeOverwrite
self codeView editModeOverwrite
!
openSettingsDialog
|settingsList settingsApp|
settingsList :=
#(
#('Editor' #'AbstractSettingsApplication::EditSettingsAppl' )
#('Syntax Color' #'AbstractSettingsApplication::SyntaxColorSettingsAppl' )
#('Code Format' #'AbstractSettingsApplication::SourceCodeFormatSettingsAppl' )
#('System Browser' #'AbstractSettingsApplication::SystemBrowserSettingsAppl' )
#('Compiler' #'AbstractSettingsApplication::GeneralCompilerSettingsAppl' )
#('Compiler/ByteCode' #'AbstractSettingsApplication::ByteCodeCompilerSettingsAppl' )
#('Source Code Management' #'AbstractSettingsApplication::SourceCodeManagementSettingsAppl')
).
settingsApp := SettingsDialog new.
"/ settingsApp requestor:self.
settingsApp installSettingsEntries:settingsList.
settingsApp allButOpen.
settingsApp window label:('Debugger Settings').
settingsApp openWindow.
! !
!NewSystemBrowser methodsFor:'menu actions-project'!
classMenuCheckInBuildSupportFiles
self selectedNonMetaclassesDo:[:eachClass |
eachClass isProjectDefinition ifTrue:[
self projectMenuCheckInBuildSupportFilesForProject:eachClass package
]
]
"Created: / 09-08-2006 / 19:04:52 / fm"
"Modified: / 12-09-2006 / 13:53:28 / cg"
!
classMenuCopySourceToClipboard
|stream|
stream := '' writeStream.
self selectedClasses value do:[:cls |
cls theNonMetaclass fileOutOn:stream.
].
self window setClipboardText:stream contents
!
generateProjectDefinitionsIn:classes
self
generateUndoableChange:'Generate Project Definitions'
overClasses:classes
via:[:generator :eachClass |
Class packageQuerySignal
answer:eachClass package
do:[
eachClass theNonMetaclass
forEachMethodsCodeToCompileDo:
[:code :category |
generator
compile:code
forClass:eachClass theMetaclass
inCategory:category.
]
ignoreOldDefinition:false
].
].
"Created: / 10-08-2006 / 16:33:07 / cg"
"Modified: / 14-09-2006 / 10:53:13 / cg"
!
mailClasses:classes subject:subject
"fileOut classes (chunk format) and eMail to someone"
|tempFile stream|
[
tempFile := Filename newTemporary.
[
stream := tempFile writeStream.
classes do:[:cls |
cls theNonMetaclass fileOutOn:stream.
].
] ensure:[
stream close.
].
self sendFileViaEmail:tempFile subject:subject.
] ensure:[
tempFile delete
].
"Created: / 20-09-2007 / 15:01:42 / cg"
!
openRepositoryConsistencyDialogForObsoleteContainers:obsoleteContainers classesWithRepositoryMismatches:classesWithRepositoryMismatches classesWithMissingContainer:classesWithMissingContainer classesWhichHaveBeenModified:classesWhichHaveBeenModified classesWithNewerVersionInRepository:classesWithNewerVersionInRepository needExtensionsContainer:needExtensionsContainer hasExtensionContainer:hasExtensionContainer
|bindings listOfObsoleteContainers listOfObsoleteContainerAssocs menuPerformer|
needExtensionsContainer ~~ hasExtensionContainer ifTrue:[
self halt
].
listOfObsoleteContainers := OrderedCollection new.
listOfObsoleteContainerAssocs := OrderedCollection new.
obsoleteContainers do:[:eachAssoc |
eachAssoc value do:[:eachObsolete |
listOfObsoleteContainerAssocs add:eachAssoc key -> eachObsolete.
listOfObsoleteContainers add:eachObsolete , ' (in ' , eachAssoc key , ')'
]
].
bindings := IdentityDictionary new.
bindings at:#listOfObsoleteContainers put:listOfObsoleteContainers.
bindings at:#listOfClassesWithRepositoryMismatches
put:classesWithRepositoryMismatches.
bindings at:#listOfClassesWithMissingContainer
put:classesWithMissingContainer.
bindings at:#listOfClassesWhichHaveBeenModified
put:classesWhichHaveBeenModified.
bindings at:#listOfClassesWithNewerVersionInRepository
put:classesWithNewerVersionInRepository.
bindings at:#obsoleteContainersBoxVisible
put:listOfObsoleteContainers size > 0.
bindings at:#classesWithInvalidInfoBoxVisible
put:classesWithRepositoryMismatches size > 0.
bindings at:#classesWithoutContainerBoxVisible
put:classesWithMissingContainer size > 0.
bindings at:#classesWhichHaveBeenModifiedBoxVisible
put:classesWhichHaveBeenModified size > 0.
bindings at:#classesWithNewerVersionInRepositoryBoxVisible
put:classesWithNewerVersionInRepository size > 0.
bindings at:#selectedClassesWithMissingContainer put:ValueHolder new.
bindings at:#selectedClassesWithRepositoryMismatches put:ValueHolder new.
bindings at:#selectedObsoleteContainers put:ValueHolder new.
bindings at:#selectedClassesWhichHaveBeenModified put:ValueHolder new.
bindings at:#selectedClassesWithNewerVersionInRepository
put:ValueHolder new.
menuPerformer := Plug new.
menuPerformer respondTo:#classMenuFileOutAs
with:[
|classes|
classes := (bindings at:#selectedClassesWithMissingContainer) value
collect:[:idx | classesWithMissingContainer at:idx].
classes do:[:cls |
self
fileOutClass:cls
askForFile:true
withCancelAll:false
format:nil
sourceMode:nil
]
].
menuPerformer respondTo:#classMenuCheckIn
with:[
|classes|
classes := (bindings at:#selectedClassesWithMissingContainer) value
collect:[:idx | classesWithMissingContainer at:idx].
SourceCodeManagerUtilities
checkinClasses:classes
withInfo:nil
withCheck:true
].
menuPerformer respondTo:#classMenuSpawnClass
with:[
|classes|
classes := (bindings at:#selectedClassesWithMissingContainer) value
collect:[:idx | classesWithMissingContainer at:idx].
self spawnClassBrowserFor:classes in:#newBrowser
].
menuPerformer respondTo:#classMenuRemove
with:[
|classes classesToRemove|
classes := (bindings at:#selectedClassesWithMissingContainer) value
collect:[:idx | classesWithMissingContainer at:idx].
classes do:[:cls |
classesToRemove := OrderedCollection new.
self
addClassesToRemoveForClass:cls
to:classesToRemove
removingSubclasses:true
withCancel:nil.
self removeClasses:classesToRemove pullUpSubclasses:false
]
].
menuPerformer respondTo:#classMenu2SpawnClass
with:[
|classes|
classes := (bindings at:#selectedClassesWithNewerVersionInRepository)
value collect:[:idx | classesWithNewerVersionInRepository at:idx].
self spawnClassBrowserFor:classes in:#newBrowser
].
menuPerformer respondTo:#classMenu2CheckOutNewest
with:[
|classes|
classes := (bindings at:#selectedClassesWithNewerVersionInRepository)
value collect:[:idx | classesWithNewerVersionInRepository at:idx].
self checkOutClasses:classes askForRevision:false
].
menuPerformer respondTo:#classMenu2CompareAgainstNewestInRepository
with:[
|classes|
classes := (bindings at:#selectedClassesWithNewerVersionInRepository)
value collect:[:idx | classesWithNewerVersionInRepository at:idx].
classes do:[:cls |
self compareAgainstNewestInRepository:cls
]
].
menuPerformer respondTo:#classMenu3FileOutAs
with:[
|classes|
classes := (bindings at:#selectedClassesWhichHaveBeenModified) value
collect:[:idx | classesWhichHaveBeenModified at:idx].
classes do:[:cls |
self
fileOutClass:cls
askForFile:true
withCancelAll:false
format:nil
sourceMode:nil
]
].
menuPerformer respondTo:#classMenu3CheckIn
with:[
|classes|
classes := (bindings at:#selectedClassesWhichHaveBeenModified) value
collect:[:idx | classesWhichHaveBeenModified at:idx].
SourceCodeManagerUtilities
checkinClasses:classes
withInfo:nil
withCheck:true
].
menuPerformer respondTo:#classMenu3SpawnClass
with:[
|classes|
classes := (bindings at:#selectedClassesWhichHaveBeenModified) value
collect:[:idx | classesWhichHaveBeenModified at:idx].
self spawnClassBrowserFor:classes in:#newBrowser
].
menuPerformer respondTo:#classMenu3CompareAgainstNewestInRepository
with:[
|classes|
classes := (bindings at:#selectedClassesWhichHaveBeenModified) value
collect:[:idx | classesWhichHaveBeenModified at:idx].
classes do:[:cls |
self compareAgainstNewestInRepository:cls
]
].
menuPerformer respondTo:#classMenu4CheckOut
with:[
|containers|
containers := (bindings at:#selectedObsoleteContainers) value.
containers do:[:container |
|def packageID moduleDir packageDir fileName|
def := listOfObsoleteContainerAssocs at:container.
packageID := def key.
moduleDir := packageID upTo:$:.
packageDir := packageID copyFrom:moduleDir size + 2.
fileName := def value.
"/ check out that module ...
SourceCodeManager
checkoutModule:moduleDir
directory:packageDir
andDo:[:tempDir |
"/ (Dialog confirm:'FileIn ' , fileName , ' ?') ifTrue:[
Smalltalk fileIn:(tempDir asFilename construct:fileName)
"/ ]
]
]
].
bindings at:#classesWithMissingContainerPopupMenu
put:self class classesWithMissingContainerPopupMenu.
bindings at:#classesWithNewerVersionInRepositoryPopupMenu
put:self class classesWithNewerVersionInRepositoryPopupMenu.
bindings at:#classesWhichHaveBeenModifiedPopupMenu
put:self class classesWhichHaveBeenModifiedPopupMenu.
bindings at:#obsoleteContainersPopupMenu
put:self class obsoleteContainersPopupMenu.
bindings at:#dialogMenuPerformer put:menuPerformer.
SimpleDialog new openSpec:self class repositoryConsistencyDialogSpec
withBindings:bindings
"Modified: / 23-08-2006 / 14:08:28 / cg"
!
projectDefinitionClassesForSelectedProjects
|projectClasses|
projectClasses := OrderedCollection new.
self selectedProjectsDo:[:packageID |
|defClass answer|
defClass := ProjectDefinition definitionClassForPackage:packageID createIfAbsent:false.
defClass isNil ifTrue:[
answer := Dialog
confirm:(resources
stringWithCRs:'Missing ProjectDefinition for %1\\Create ?'
with:packageID allBold)
withCancel:(self selectedProjects value size > 1)
default: true.
answer isNil ifTrue:[^ self ].
answer == true ifTrue:[
defClass := self projectDefinitionDialogFor:packageID.
].
].
defClass notNil ifTrue:[
projectClasses add:defClass.
]
].
^ projectClasses
"Created: / 15-09-2006 / 16:46:27 / cg"
!
projectDefinitionDialogFor:aProjectIDOrNil
|boxLabel box initial newProjectID currentProject field
packageIDHolder projectTypeHolder
projectDefinitionClass y defaultProjectType setupDefaultType|
setupDefaultType :=
[:package |
|classesInPackage|
classesInPackage := Smalltalk allClassesInPackage:package.
(classesInPackage contains:[:cls | cls isBrowserStartable]) ifTrue:[
(classesInPackage contains:[:cls | cls isVisualStartable])
ifTrue:[ defaultProjectType := ProjectDefinition guiApplicationType]
ifFalse:[ defaultProjectType := ProjectDefinition nonGuiApplicationType]
] ifFalse:[
defaultProjectType := ProjectDefinition libraryType
].
].
aProjectIDOrNil notNil ifTrue:[
initial := aProjectIDOrNil.
boxLabel := 'Create ProjectDefinition Class'.
setupDefaultType value:aProjectIDOrNil.
] ifFalse:[
initial := 'module:directory'.
currentProject := self theSingleSelectedProject.
currentProject notNil ifTrue:[
initial := currentProject.
(initial includes:$:) ifTrue:[
(ProjectDefinition definitionClassForPackage:initial) notNil ifTrue:[
initial := initial , '/newProject'.
].
] ifFalse:[
initial := initial , ':newProject'.
].
] ifFalse:[
initial := OperatingSystem getLoginName , ':newProject'.
].
defaultProjectType := ProjectDefinition defaultProjectType.
setupDefaultType value:initial.
boxLabel := 'Create New Project'.
].
packageIDHolder := ValueHolder with:initial.
projectTypeHolder := defaultProjectType asValue.
box := DialogBox new.
box label:(resources string:boxLabel).
y := box yPosition.
box addVerticalSpace.
field := box addTextLabel:(resources string:'Package-ID (module:directory):').
field adjust:#right.
field width:0.3; left:0.0; leftInset:3.
box yPosition:y.
field := box addInputFieldOn:packageIDHolder tabable:true.
field width:0.7; left:0.3; rightInset:3.
aProjectIDOrNil notNil ifTrue:[
field readOnly:true.
] ifFalse:[
field acceptOnLeave:true.
field immediateAccept:true.
field entryCompletionBlock:(DoWhatIMeanSupport packageNameEntryCompletionBlock).
].
y := box yPosition.
box addVerticalSpace.
field := box addTextLabel:(resources string:'Type:').
field adjust:#right.
field width:0.3; left:0.0; leftInset:3.
box yPosition:y.
field := box addComboListOn:projectTypeHolder tabable:true.
field width:0.7; left:0.3; rightInset:3.
field list:(ProjectDefinition projectTypes).
box addVerticalSpace.
box addAbortButton; addOkButtonLabelled:(resources string:'Create').
box minExtent:400@(box height).
box open.
box accepted ifFalse:[
^ nil
].
self withWaitCursorDo:[
aProjectIDOrNil notNil ifTrue:[
newProjectID := aProjectIDOrNil.
] ifFalse:[
newProjectID := packageIDHolder value.
newProjectID notEmptyOrNil ifTrue:[
"/ self immediateUpdate value:true.
self projectListApp addAdditionalProject:newProjectID.
"/ self immediateUpdate value:false.
self selectProject:newProjectID.
self selectedClasses value:#().
].
].
projectDefinitionClass := ProjectDefinition
definitionClassForPackage:newProjectID
projectType: (projectTypeHolder value)
createIfAbsent:true.
].
^ projectDefinitionClass
"Modified: / 06-10-2006 / 11:44:05 / cg"
!
projectMenuBitmapFiles
self information:'Sorry - this functionality is not yet implemented'
!
projectMenuBuild
|projectToBuild projectDefinitionClasses projectDefinition|
projectToBuild := self theSingleSelectedProject.
projectDefinitionClasses := self projectDefinitionClassesForSelectedProjects.
projectDefinition := projectDefinitionClasses firstIfEmpty:nil.
projectDefinition isNil ifTrue:[
^ self
].
Tools::ProjectBuilderAssistantApplication new
projectType:projectDefinition projectType.
Tools::ProjectBuilder new
package:projectToBuild;
build
!
projectMenuCheckInAll
self selectedProjectsDo:[:packageToCheckIn |
self
projectMenuCheckInProject:packageToCheckIn
classes:true
extensions:true
buildSupport:true.
]
"Modified: / 09-08-2006 / 18:57:28 / fm"
!
projectMenuCheckInBuildSupportFiles
self selectedProjectsDo:[:packageToCheckIn |
self projectMenuCheckInBuildSupportFilesForProject:packageToCheckIn
]
"Created: / 09-08-2006 / 19:04:52 / fm"
!
projectMenuCheckInBuildSupportFilesForProject:packageID
|anyFailure module directory defClass mgr|
anyFailure := false.
defClass := ProjectDefinition definitionClassForPackage:packageID createIfAbsent:false.
defClass isNil ifTrue:[
defClass := self projectDefinitionDialogFor:packageID.
defClass isNil ifTrue:[ ^ self ].
defClass compileDescriptionMethods.
].
defClass validateDescription.
defClass hasAllCompiledClassesFullyLoaded ifFalse:[
(Dialog confirm:('%1: the dependency information as generated will be incomplete,%<cr>because some compiled class(es) are not loaded (see Transcript).%<cr>%<cr>%2%<cr>Continue anyway ?'
bindWith:defClass name
with:('Warning: these classes will be excluded from the list of compiled classes.' allBold)))
ifFalse:[
^ self.
]
].
mgr := SourceCodeManagerUtilities sourceCodeManagerFor:defClass.
mgr isNil ifTrue:[
self warn:'No sourceCode manager - cannot checkin.'.
^ self.
].
module := packageID asPackageId module.
directory := packageID asPackageId directory.
self activityNotification:(resources string:'checking in build-support files...').
self withActivityNotificationsRedirectedToInfoLabelDo:[
defClass forEachFileNameAndGeneratedContentsDo:[:fileName :fileContents |
|realFileName realDirectory|
realDirectory := directory.
realFileName := fileName.
(realFileName includes:$/) ifTrue:[
realDirectory := (realDirectory asFilename construct:(realFileName asFilename directoryName)) name.
realFileName := realFileName asFilename baseName.
].
self showInfo:(resources string:'checking in %1...' with:realFileName).
UserInformation
handle:[:ex | Transcript showCR:ex description ]
do:[
(mgr
checkForExistingContainer:realFileName inModule:module directory:realDirectory)
ifFalse:[
(mgr
createContainerForText:fileContents
inModule:module
package:realDirectory
container:realFileName)
ifFalse:[
self warn:(resources
stringWithCRs:'Cannot create new container: ''%3'' (in %1:%2)'
with:module
with:realDirectory
with:realFileName)
translate:false.
].
] ifTrue:[
(mgr
checkin:realFileName
text:fileContents
directory:realDirectory
module:module
logMessage:'automatically generated by browser'
force:false)
ifFalse:[
Transcript showCR:'checkin of ' , realFileName , ' failed'.
anyFailure := true.
].
].
].
].
defClass instAndClassMethodsDo:[:m | m package:defClass package].
self
checkInClasses:(Array with:defClass)
withInfo:'automatic checkIn'
withCheck:false.
].
self activityNotification:nil.
anyFailure ifTrue:[
self warn:'Checkin failed - see Transcript.'.
self showInfo:'Checkin of build-support files failed - see Transcript.'.
] ifFalse:[
self showInfo:'Build-support files checked into the repository.'.
].
"Created: / 09-08-2006 / 18:59:42 / fm"
"Modified: / 16-08-2006 / 18:38:49 / User"
"Modified: / 22-12-2010 / 17:05:04 / cg"
!
projectMenuCheckInClasses
self selectedProjectsDo:[:packageToCheckIn |
self
projectMenuCheckInProject:packageToCheckIn
classes:true
extensions:false
buildSupport:false
]
!
projectMenuCheckInExtensions
self selectedProjectsDo:[:packageToCheckIn |
self
projectMenuCheckInProject:packageToCheckIn
classes:false
extensions:true
buildSupport:false
]
!
projectMenuCheckInProject:packageToCheckIn classes:doClasses extensions:doExtensions buildSupport:doBuild
^ self
projectMenuCheckInProject:packageToCheckIn
classes:doClasses
extensions:doExtensions
buildSupport:doBuild
askForMethodsInOtherPackages:true
"Modified: / 21-08-2006 / 19:43:22 / cg"
!
projectMenuCheckInProject:packageToCheckIn classes:doClasses extensions:doExtensions buildSupport:doBuild askForMethodsInOtherPackages:askForMethodsInOtherPackages
|classes classesToCheckIn methodsToCheckIn
methodsInOtherPackages looseMethods otherPackages
msg classesInChangeSet checkinInfo originalCheckinInfo classesToTag|
classes := Smalltalk allClasses.
classesToCheckIn := IdentitySet new.
methodsToCheckIn := IdentitySet new.
methodsInOtherPackages := IdentitySet new.
looseMethods := IdentitySet new.
"/ classes ...
classes do:[:aClass | |owner classPackage|
(owner := aClass owningClass) notNil ifTrue:[
classPackage := aClass topOwningClass package
] ifFalse:[
classPackage := aClass package
].
(classPackage = packageToCheckIn) ifTrue:[
classesToCheckIn add:aClass.
].
].
classesInChangeSet := classesToCheckIn select:[:cls | cls hasUnsavedChanges].
"/ individual methods ...
classes do:[:aClass |
aClass isMeta ifFalse:[
"/ ... whose class is not in the chechIn-set
(classesToCheckIn includes:aClass) ifFalse:[
aClass instAndClassSelectorsAndMethodsDo:[:sel :mthd |
"/ methods in this project ...
(mthd package = packageToCheckIn) ifTrue:[
methodsToCheckIn add:mthd
]
]
].
].
].
doExtensions ifTrue:[
methodsToCheckIn notEmpty ifTrue:[
doClasses ifTrue:[
msg := '%1 classes (%4 changed) '.
] ifFalse:[
msg := ''.
].
doExtensions ifTrue:[
doClasses ifTrue:[
msg := msg , 'and '.
].
msg := msg , '%2 extensions '.
].
msg := msg , 'of project "%3"'.
checkinInfo := SourceCodeManagerUtilities
getCheckinInfoFor:(msg
bindWith:classesToCheckIn size
with:methodsToCheckIn size
with:packageToCheckIn allBold
with:classesInChangeSet size)
initialAnswer:nil
withQuickOption:(classesToCheckIn size > 0).
checkinInfo isNil ifTrue:[
^ self.
].
(SourceCodeManagerUtilities
checkinExtensionMethods:methodsToCheckIn
forPackage:packageToCheckIn
withInfo:checkinInfo)
ifFalse:[
self warn:'Could not check in extensions for project %1' with:packageToCheckIn.
^ self.
]
] ifFalse:[
"/ there may have been extension-methods previously - if so, remove them
(SourceCodeManager
checkForExistingContainer:'extensions.st' inPackage:packageToCheckIn)
ifTrue:[
"/ self halt.
(SourceCodeManagerUtilities
checkinExtensionMethods:#()
forPackage:packageToCheckIn
withInfo:'No extensions any more')
ifFalse:[
self warn:'Could not check in extensions for project %1' with:packageToCheckIn.
^ self.
]
]
].
].
checkinInfo isNil ifTrue:[
checkinInfo := SourceCodeManagerUtilities
getCheckinInfoFor:('%1 classes (%4 changed) and %2 extensions for project "%3"'
bindWith:classesToCheckIn size
with:methodsToCheckIn size
with:packageToCheckIn allBold
with:classesInChangeSet size)
initialAnswer:nil
withQuickOption:(classesToCheckIn size > 0).
checkinInfo isNil ifTrue:[
^ self.
].
].
checkinInfo quickCheckIn ifTrue:[
(checkinInfo isStable or:[checkinInfo tagIt]) ifTrue:[
classesToTag := classesToCheckIn.
originalCheckinInfo := checkinInfo.
checkinInfo := checkinInfo copy.
checkinInfo isStable:false.
checkinInfo tag:nil.
].
classesToCheckIn := classesInChangeSet.
].
"/ check if any of the classes contains methods for other packages ...
classesToCheckIn do:[:eachClass |
eachClass instAndClassMethodsDo:[:eachMethod |
|mPgk|
mPgk := eachMethod package.
(mPgk = packageToCheckIn) ifFalse:[
mPgk == PackageId noProjectID ifTrue:[
looseMethods add:eachMethod
] ifFalse:[
methodsInOtherPackages add:eachMethod
]
]
].
].
askForMethodsInOtherPackages ifTrue:[
methodsInOtherPackages notEmpty ifTrue:[
otherPackages := Set new.
methodsInOtherPackages do:[:eachMethod | otherPackages add:eachMethod package].
methodsInOtherPackages size == 1 ifTrue:[
msg := 'The ''%4'' method in ''%5'' is contained in the ''%2'' package.'.
msg := msg , '\\This method will remain in its package.'.
] ifFalse:[
otherPackages size == 1 ifTrue:[
msg := 'The %1 methods from the %2 package will remain in its package.'
] ifFalse:[
msg := 'The %1 methods from %3 other packages will remain in their packages.'
].
msg := msg , '\\Hint: if these are meant to belong to this package,'.
msg := msg , '\move them first, then repeat the checkin operation.'.
].
msg := msg withCRs.
msg := msg bindWith:methodsInOtherPackages size
with:otherPackages first allBold
with:otherPackages size
with:methodsInOtherPackages first selector allBold
with:methodsInOtherPackages first mclass name allBold.
(Dialog confirm:msg noLabel:(resources string:'Cancel')) ifFalse:[^ self].
].
].
doClasses ifTrue:[
classesToCheckIn notEmpty ifTrue:[
looseMethods notEmpty ifTrue:[
looseMethods size == 1 ifTrue:[
msg := 'The ''%2'' method in ''%3'' is unassigned (loose).'.
msg := msg , '\\If you proceed, this method will be moved to the ''%4'' package'.
msg := msg , '\\Hint: if this is meant to be an extension of another package,'.
msg := msg , '\cancel and move it to the appropriate package first.'.
] ifFalse:[
msg := 'There are %1 unassigned (loose) methods in classes from this project.'.
msg := msg , '\\If you proceed, those will be moved to the ''%4'' package ?'.
msg := msg , '\\Hint: if these are meant to be extensions of another package,'.
msg := msg , '\cancel and move them to the appropriate package first.'.
].
doClasses ifTrue:[
msg := msg , '\\If you answer with "No" here, you will be asked for each class individually.'.
].
msg := msg withCRs.
msg := msg bindWith:looseMethods size
with:(looseMethods isEmpty ifTrue:[''] ifFalse:[looseMethods first selector allBold])
with:(looseMethods isEmpty ifTrue:[''] ifFalse:[looseMethods first mclass name allBold])
with:packageToCheckIn allBold.
(Dialog confirm:msg noLabel:(resources string:'Cancel')) ifFalse:[^ self].
looseMethods do:[:mthd |
mthd package:packageToCheckIn
].
].
SourceCodeManagerUtilities checkinClasses:classesToCheckIn withInfo:checkinInfo.
].
originalCheckinInfo notNil ifTrue:[
originalCheckinInfo isStable ifTrue:[
classesToTag do:[:eachClass |
SourceCodeManagerUtilities tagClass:eachClass as:#stable
].
].
originalCheckinInfo tagIt ifTrue:[
classesToTag do:[:eachClass |
SourceCodeManagerUtilities tagClass:eachClass as:(originalCheckinInfo tag)
].
].
].
].
doBuild ifTrue:[
self projectMenuCheckInBuildSupportFilesForProject:packageToCheckIn
].
self normalLabel.
"Modified: / 28-11-2006 / 15:44:24 / cg"
!
projectMenuCheckOut
"check-out all classes in the selected project from the source repository.
Individually ask for class revisions.
Offer chance to either overwrite the current version,
or merge-in the repository version.
"
self checkOutClasses:(self selectedProjectClasses) askForRevision:true
!
projectMenuCheckOutExtensions
self selectedProjectsDo:[:packageToCheckOut |
SourceCodeManagerUtilities
checkoutExtensionMethodsForPackage:packageToCheckOut
askForRevision:true
askForMerge:true
using:(SourceCodeManager defaultManager)
]
"Created: / 10-08-2006 / 18:16:51 / cg"
!
projectMenuCheckOutNewest
"check-out the newest version from the source repository of
all classes in the selected project.
Offer chance to either overwrite the current version,
or merge-in the repository version.
"
|classesInImage filesInImage|
(Dialog confirm:('This functionality is not yet completely implemented.'
, String lf
,'For now, only existing classes are updated - no new classes are added or old ones removed.'
, String lf
, 'Please use the import-structure function to get new definitions.')) ifFalse:[^ self].
self checkOutClasses:(self selectedProjectClasses) askForRevision:false.
^ self.
#TODO.
self selectedProjects value do:[:eachProject |
|module directory perProjectInfo
classesNotInRepository filesNotInImage classesDeletedInRepository
classesModifiedInImage classesModifiedInRepository
classesDeletedInImage classesAddedInImage
anyDifference box doRemove classDefs changeSets filePerClassDefintion
classesToCheckIn|
module := eachProject asPackageId module.
directory := eachProject asPackageId directory.
perProjectInfo := SourceCodeManager newestRevisionsInModule:module directory:directory.
perProjectInfo := perProjectInfo ? #().
perProjectInfo := perProjectInfo select:[:info | info key asFilename hasSuffix:'st'].
perProjectInfo := Dictionary withAssociations:perProjectInfo.
classesInImage := Smalltalk allClassesInPackage:eachProject.
filesInImage := (classesInImage collect:[:cls | cls classBaseFilename]) asSet.
"/ any differences ?
classesNotInRepository := classesInImage reject:[:cls | (perProjectInfo includesKey:cls classBaseFilename)].
classesDeletedInRepository := classesInImage select:[:cls | (perProjectInfo at:cls classBaseFilename ifAbsent:nil) == #deleted].
perProjectInfo := perProjectInfo reject:[:v | v == #deleted].
filesNotInImage := perProjectInfo keys reject:[:file | (filesInImage includes:file)].
classesModifiedInImage := classesInImage select:[:cls | ChangeSet current includesChangeForClassOrMetaclass:cls].
classesModifiedInRepository := classesInImage select:[:cls | |v|
v := (perProjectInfo at:cls classBaseFilename ifAbsent:nil).
v notNil and:[ v > cls revision]].
anyDifference := false.
filesNotInImage notEmpty ifTrue:[
filePerClassDefintion := Dictionary new.
classDefs := ChangeSet new.
changeSets := OrderedCollection new.
filesNotInImage do:[:eachSTFile |
|s chgSet classDefinitions|
s := SourceCodeManager
streamForClass:nil fileName:eachSTFile revision:#newest directory:directory module:module cache:true.
chgSet := ChangeSet fromStream:s.
s close.
changeSets add:chgSet.
classDefinitions := chgSet select:[:change | change isClassDefinitionChange and:[change isPrivateClassDefinitionChange not]].
classDefinitions do:[:def | filePerClassDefintion at:def put:eachSTFile].
classDefs addAll:classDefinitions.
].
"/ now, install ...
classDefs do:[:eachClassDefinition |
|cls oldPackage|
eachClassDefinition package:eachProject.
eachClassDefinition installAsAutoloadedClassIfPublicWithFilename:(filePerClassDefintion at:eachClassDefinition).
(cls := eachClassDefinition changeClass) notNil ifTrue:[
(oldPackage := cls package) ~= eachProject ifTrue:[
(Dialog confirm:('Move the %1-class from %2 to %3 ?' bindWith:cls name allBold with:oldPackage allBold with:eachProject allBold)) ifTrue:[
cls package:eachProject.
cls instAndClassMethodsDo:[:m | m package = oldPackage ifTrue:[ m package:eachProject]].
]
].
].
].
changeSets do:[:chgSet |
chgSet apply
].
].
classesModifiedInImage notEmpty ifTrue:[
classesToCheckIn := OrderedCollection new.
classesModifiedInImage do:[:eachChangedClass |
|currentVersion repositoryVersion s stFile diffs|
stFile := eachChangedClass classBaseFilename.
s := SourceCodeManager
streamForClass:nil fileName:stFile revision:#newest directory:directory module:module cache:true.
repositoryVersion := ChangeSet fromStream:s.
s close.
currentVersion := ChangeSet forExistingClass:eachChangedClass.
diffs := currentVersion diffSetsAgainst:repositoryVersion.
diffs isEmpty ifTrue:[
ChangeSet current condenseChangesForClass:eachChangedClass
] ifFalse:[
self halt.
classesToCheckIn add:eachChangedClass.
].
].
classesToCheckIn notEmpty ifTrue:[
self halt.
].
].
classesModifiedInRepository notEmpty ifTrue:[
box := Dialog
forRequestText:(resources stringWithCRs:'The following classes need to be updated from the repository.')
editViewClass:ListView
lines:10 columns:20
initialAnswer:nil model:nil
setupWith:
[:v :d |
|removeButton|
v list:classesModifiedInRepository.
d okButton label:(resources string:'Update').
d okButton isReturnButton:true.
].
box open.
box accepted ifFalse:[
^ self
].
classesModifiedInRepository do:[:eachClass|
|s chgSet|
s := SourceCodeManager
streamForClass:eachClass fileName:nil revision:#newest directory:directory module:module cache:true.
chgSet := ChangeSet fromStream:s.
s close.
chgSet apply.
].
].
classesDeletedInRepository notEmpty ifTrue:[
self halt.
].
classesNotInRepository notEmpty ifTrue:[
"/ if there are no changeSet entries for those classes, they seem to be
"/ no longer in the repository (possibly moved ?)
"/ If there are entries, these might have been added in the image and need a check-in
classesAddedInImage := classesNotInRepository select:[:cls | ChangeSet current includesChangeForClassOrMetaclass:cls].
classesAddedInImage isEmpty ifTrue:[
doRemove := false.
box := Dialog
forRequestText:(resources stringWithCRs:'The following classes are no longer in the repository (or moved to another package).\\Remove classes from the image ?')
editViewClass:ListView
lines:10 columns:20
initialAnswer:nil model:nil
setupWith:
[:v :d |
|removeButton|
removeButton := Button label:(resources string:'Remove').
removeButton action:[ doRemove := true. box okPressed. ].
v list:classesNotInRepository.
d addButton:removeButton after:(d okButton).
d okButton label:(resources string:'Continue').
d okButton isReturnButton:true.
].
box open.
box accepted ifFalse:[
^ self
].
doRemove ifTrue:[
self halt.
classesNotInRepository do:[:eachClassToRemove |
|subClasses|
subClasses := eachClassToRemove allSubclasses.
(subClasses conform:
[:subClass |
|ownerOrClassItself|
ownerOrClassItself := subClass topOwningClass ? subClass.
(classesNotInRepository includes:ownerOrClassItself)
])
ifTrue:[
Smalltalk removeClass:eachClassToRemove.
ChangeSet current condenseChangesForClass:eachClassToRemove.
] ifFalse:[
Dialog warn:'Cannit simply remove the class - more repair needed due to subclass(es)'.
].
].
].
] ifFalse:[
self halt.
].
].
anyDifference ifFalse:[
"/ Dialog information:(resources string:'%1 is up-to-date.' with:eachProject allBold).
Transcript showCR:('%1 is up-to-date.' bindWith:eachProject allBold).
ChangeSet current condenseChangesForPackage:eachProject.
] ifTrue:[
self halt.
self checkOutClasses:(self selectedProjectClasses) askForRevision:false
].
].
"Modified: / 13-10-2006 / 01:31:43 / cg"
!
projectMenuCheckRepositoryConsistency
"check for container consistency in the source repository.
That is: for every class in the project there must be a container (unstored classes),
and for every container there must be a class (obsolete containers).
Display this information as required..
"
SourceCodeManager isNil ifTrue:[^ self warn:'No SourceCodeManagement is configured.'].
self withWaitCursorDo:[
|classesToLoad classesToUnload classesWithMissingContainer classesWithRepositoryMismatches
obsoleteContainers allChangeSets answer needExtensionsContainer hasExtensionContainer
classesWithNewerVersionInRepository classesWhichHaveBeenModified|
classesWithRepositoryMismatches := OrderedCollection new.
classesWithMissingContainer := OrderedCollection new.
obsoleteContainers := OrderedCollection new.
classesWithNewerVersionInRepository := OrderedCollection new.
classesWhichHaveBeenModified := OrderedCollection new.
self selectedProjectsDo:[:packageToCheck |
|containerModule containerPackage containers allContainers
hasLoadAll hasMakeProto hasMakeSpec hasBcMakefile hasNtMakefile hasAbbrev
otherFiles classesInProject |
containerModule := packageToCheck upTo:$:.
containerPackage := packageToCheck copyFrom:(containerModule size + 2).
self busyLabel:'Checking ' , packageToCheck , '...'.
allContainers := SourceCodeManager getExistingContainersInModule:containerModule directory:containerPackage.
allContainers := allContainers select:[:each | (each startsWith:'.') not].
hasLoadAll := allContainers includes:'loadAll'.
hasMakeProto := allContainers includes:'Make.proto'.
hasMakeSpec := allContainers includes:'Make.spec'.
hasBcMakefile := allContainers includes:'bc.mak'.
hasNtMakefile := allContainers includes:'nt.mak'.
hasAbbrev := allContainers includes:'abbrev.stc'.
hasExtensionContainer := allContainers includes:'extensions.st'.
containers := allContainers copyAsOrderedCollection.
containers removeAllFoundIn:#('loadAll' 'Make.proto' 'Make.spec' 'nt.mak' 'bc.mak' 'abbrev.stc' 'extensions.st').
otherFiles := containers select:[:each | (each asFilename hasSuffix:'st') not].
containers removeAllFoundIn:otherFiles.
classesInProject := IdentitySet new.
needExtensionsContainer := false.
Smalltalk allClassesDo:[:aClass |
(packageToCheck = aClass package) ifTrue:[
aClass isPrivate ifFalse:[
classesInProject add:aClass .
]
] ifFalse:[
needExtensionsContainer := needExtensionsContainer or:[aClass hasExtensionsFrom:packageToCheck].
]
].
"/ load unloaded classes...
classesToLoad := OrderedCollection new.
classesInProject do:[:eachClassInProject |
eachClassInProject isLoaded ifFalse:[
classesToLoad add:eachClassInProject
].
].
classesToLoad size > 0 ifTrue:[
answer := Dialog confirmWithCancel:(resources string:'%1 class(es) are not loaded.\(Unloaded classes will be skipped when checking)\\Load them first ?'
with:classesToLoad size) withCRs
default:false.
answer isNil ifTrue:[^ self].
answer ifTrue:[
classesToUnload := OrderedCollection new.
classesInProject do:[:eachClassInProject |
eachClassInProject isLoaded ifFalse:[
eachClassInProject autoload.
classesToUnload add:eachClassInProject
].
].
].
].
"/ any class without container ?
classesInProject do:[:eachClassInProject |
|mgr info classesModule classesPackageDir classesContainerFileName|
eachClassInProject isPrivate ifFalse:[
"/ eachClassInProject isLoaded ifTrue:[
self busyLabel:'Checking ' , packageToCheck , ' - ' , eachClassInProject name.
mgr := SourceCodeManagerUtilities sourceCodeManagerFor:eachClassInProject.
info := mgr sourceInfoOfClass:eachClassInProject.
info isNil ifTrue:[
"/ no container for that class
] ifFalse:[
(info includesKey:#module) ifTrue:[
classesModule := (info at:#module).
].
(info includesKey:#directory) ifTrue:[
classesPackageDir := (info at:#directory).
].
classesContainerFileName := mgr containerFromSourceInfo:info.
"/ module & packageDir must match
((classesModule ~= containerModule)
or:[classesPackageDir ~= containerPackage]) ifTrue:[
classesWithRepositoryMismatches add:eachClassInProject
].
(containers includes:classesContainerFileName) ifFalse:[
classesWithMissingContainer add:eachClassInProject.
] ifTrue:[
eachClassInProject isLoaded ifTrue:[
eachClassInProject revision ~= (mgr newestRevisionOf:eachClassInProject)
ifTrue:[
classesWithNewerVersionInRepository add:eachClassInProject.
].
].
].
containers remove:classesContainerFileName ifAbsent:nil.
].
].
].
"/ any container left ?
containers notEmpty ifTrue:[
obsoleteContainers add:(packageToCheck -> containers).
].
"/ any version mismatches ?
classesInProject do:[:eachClassInProject |
eachClassInProject isLoaded ifTrue:[
(classesWithMissingContainer includes:eachClassInProject) ifFalse:[
(classesWithRepositoryMismatches includes:eachClassInProject) ifFalse:[
"/ class modified ?
allChangeSets isNil ifTrue:[
allChangeSets := ChangeSet allInstances.
].
(allChangeSets contains:[:aChangeSet |
(eachClassInProject hasUnsavedChanges)
or:[eachClassInProject allPrivateClasses contains:[:aPrivateClass |
aPrivateClass hasUnsavedChanges]]
])
ifTrue:[
classesWhichHaveBeenModified add:eachClassInProject
]
]
]
]
].
classesToUnload size >0 ifTrue:[
answer := Dialog confirm:(resources string:'%1 class(es) were loaded - unload them now ?'
with:classesToLoad size)
default:false.
answer ifTrue:[
"/ unload classes which have been loaded temporarily
classesToUnload do:[:eachClassToUnload |
eachClassToUnload unload
].
]
]
].
(obsoleteContainers notEmpty
or:[ classesWithRepositoryMismatches notEmpty
or:[ classesWithMissingContainer notEmpty
or:[ classesWhichHaveBeenModified notEmpty
or:[ classesWithNewerVersionInRepository notEmpty
or:[ needExtensionsContainer ~~ hasExtensionContainer ]]]]])
ifTrue:[
self
openRepositoryConsistencyDialogForObsoleteContainers:obsoleteContainers
classesWithRepositoryMismatches:classesWithRepositoryMismatches
classesWithMissingContainer:classesWithMissingContainer
classesWhichHaveBeenModified:classesWhichHaveBeenModified
classesWithNewerVersionInRepository:classesWithNewerVersionInRepository
needExtensionsContainer:needExtensionsContainer
hasExtensionContainer:hasExtensionContainer
]
].
self normalLabel
"Modified: / 12-09-2006 / 14:21:07 / cg"
!
projectMenuCleanUpChangeSet
"remove all changes for the selected project(s) from the changeSet"
(self confirm:'This will remove all changes for the selected project(s) from the changeSet.\\Really cleanup ?' withCRs)
ifFalse:[ ^ self].
self withWaitCursorDo:[
self selectedProjectsDo:[:eachProject |
ChangeSet current condenseChangesForPackage:eachProject
].
]
"Created: / 26-10-2006 / 19:41:27 / cg"
!
projectMenuCompareAgainstNewestInRepository
"Comparing the current (in-image) version of the project(s)
against the the newest version found in the repository."
self withWaitCursorDo:[
self selectedProjects value do:[:eachProject |
SourceCodeManagerUtilities compareProjectWithRepository:eachProject
].
].
"Created: / 12-10-2006 / 17:41:55 / cg"
"Modified: / 12-10-2006 / 21:46:14 / cg"
!
projectMenuCompareAgainstRepository
"Comparing the current (in-image) version of the project(s)
against some older version found in the repository."
|string date|
string := Dialog
request:(resources
string:'Compare with version from date: (%1)'
with:(UserPreferences current dateInputFormat))
initialAnswer:(Date today printStringFormat:(UserPreferences current dateInputFormat)).
string isEmptyOrNil ifTrue:[^ self].
date := Date readFrom:string printFormat:(UserPreferences current dateInputFormat).
self withWaitCursorDo:[
self selectedProjects value do:[:eachProject |
SourceCodeManagerUtilities compareProject:eachProject withRepositoryVersionFrom:date
].
].
"Created: / 12-10-2006 / 17:41:55 / cg"
"Modified: / 12-10-2006 / 21:46:14 / cg"
!
projectMenuDocumentation
self information:'Sorry - this functionality is not yet implemented'
!
projectMenuFileOutAs
"fileOut selected projects - st-source format"
self projectMenuFileOutAsWithFormat:nil
!
projectMenuFileOutAsWithFormat:aFormatSymbolOrNil
|currentProject selectedProjects fileBox suffix saveName dir
fileName "methodsToFileOut fileNameForExtensions" mgr s classesToFileout|
selectedProjects := self selectedProjectsValue.
currentProject := self theSingleSelectedProject.
currentProject notNil ifTrue:[
fileName := currentProject asString copy replaceAny:' :/' with:$_.
] ifFalse:[
fileName := 'someProjects'
].
aFormatSymbolOrNil == #xml ifTrue:[
suffix := '.xml'
] ifFalse:[
aFormatSymbolOrNil == #sif ifTrue:[
suffix := '.sif'
] ifFalse:[
aFormatSymbolOrNil == #binary ifTrue:[
suffix := '.cls'
] ifFalse:[
suffix := '.st'
]
]
].
fileName := fileName , suffix.
aFormatSymbolOrNil == #binary ifTrue:[
self error:'binary must go into separate files' mayProceed:true.
^ self
].
saveName := Dialog
requestFileNameForSave:(resources string:'FileOut %1 as:' with:(currentProject ? 'selected projects'))
default:fileName
fromDirectory:(FileSelectionBox lastFileSelectionDirectory).
"/ fileBox := FileSelectionBox
"/ title:(resources string:'FileOut %1 as:' with:(currentProject ? 'selected projects'))
"/ okText:(resources string:'FileOut')
"/ abortText:(resources string:'Cancel')
"/ action:[:fileName | saveName := fileName.].
"/
"/ fileBox initialText:fileName.
"/ dir := FileSelectionBox lastFileSelectionDirectory.
"/ dir notNil ifTrue:[
"/ fileBox directory:dir.
"/ ].
"/ fileBox showAtPointer.
"/
"/ fileBox destroy.
"/ fileBox := nil.
saveName isEmptyOrNil ifTrue:[
^ self
].
FileSelectionBox lastFileSelectionDirectory:(saveName asFilename directoryName).
fileName := saveName.
aFormatSymbolOrNil == #sif ifTrue:[
SmalltalkInterchangeSTXFileOutManager initialize.
mgr := SmalltalkInterchangeFileManager newForFileOut.
mgr fileName: fileName.
self selectedProjectClasses do:[:eachClass |
mgr addClass:eachClass.
].
Smalltalk allClassesDo:[:eachClass |
eachClass instAndClassSelectorsAndMethodsDo:[:sel :mthd |
|mPckg|
mPckg := mthd package.
mPckg ~= eachClass package ifTrue:[
(selectedProjects includes:mPckg) ifTrue:[
mgr addMethodNamed:mthd selector ofClass:mthd mclass
]
]
]
].
self busyLabel:'writing...'.
mgr fileOut.
self normalLabel.
^ self
].
aFormatSymbolOrNil isNil ifTrue:[
self busyLabel:'writing...'.
s := fileName asFilename writeStream.
classesToFileout := OrderedCollection withAll:(self selectedProjectClasses).
classesToFileout topologicalSort:[:a :b | b isSubclassOf:a].
classesToFileout do:[:eachClass |
eachClass fileOutOn:s.
].
Smalltalk allClassesDo:[:eachClass |
eachClass instAndClassSelectorsAndMethodsDo:[:sel :mthd |
|mPckg|
mPckg := mthd package.
(mPckg = currentProject and:[mPckg ~= eachClass package]) ifTrue:[
eachClass
fileOutCategory:mthd category
methodFilter:[:m | m == mthd]
on:s.
s cr.
]
]
].
s close.
self normalLabel.
^ self.
].
self shouldImplement.
"Modified: / 27-10-2010 / 11:34:45 / cg"
!
projectMenuFileOutEachBinaryIn
"fileOut selected projects as individual files - binary format"
self projectMenuFileOutEachInWithFormat:#binary
!
projectMenuFileOutEachIn
"fileOut selected projects as individual files - st-source format"
self projectMenuFileOutEachInWithFormat:nil
!
projectMenuFileOutEachInWithFormat:aFormatSymbolOrNil
|currentProject dirName methodsToFileOut fileNameForExtensions|
currentProject := self theSingleSelectedProject ? 'selected projects'.
dirName := self
askForDirectoryToFileOut:(resources string:'FileOut %1 in:'
with:currentProject)
default:nil.
dirName isNil ifTrue:[
^ self
].
self
fileOutEachClassIn:self selectedProjectClasses
in:dirName
withFormat:aFormatSymbolOrNil.
methodsToFileOut := OrderedCollection new.
Smalltalk allClassesDo:[:eachClass |
eachClass instAndClassSelectorsAndMethodsDo:[:sel :mthd |
|mPckg|
mPckg := mthd package.
(mPckg = currentProject and:[mPckg ~= eachClass package]) ifTrue:[
methodsToFileOut add:mthd
]
]
].
dirName := dirName asFilename.
fileNameForExtensions := (dirName construct:'extensions') withSuffix:(self fileSuffixForFormat:aFormatSymbolOrNil).
self
fileOutMethods:methodsToFileOut
format:aFormatSymbolOrNil
toFile:fileNameForExtensions
withPackage:true
!
projectMenuFileOutEachSIFIn
"fileOut selected projects as individual files - sif format"
self projectMenuFileOutEachInWithFormat:#sif
!
projectMenuFileOutEachXMLIn
"fileOut selected projects as individual files - xml format"
self projectMenuFileOutEachInWithFormat:#xml
!
projectMenuFileOutSIFAs
"fileOut selected projects - sif format"
self projectMenuFileOutAsWithFormat:#sif
!
projectMenuFileOutXMLAs
"fileOut selected projects - xml format"
self projectMenuFileOutAsWithFormat:#xml
!
projectMenuGenerateProjectDefinitions
|projectClasses|
projectClasses := self projectDefinitionClassesForSelectedProjects.
self generateProjectDefinitionsIn:projectClasses
"Modified: / 15-09-2006 / 16:46:51 / cg"
!
projectMenuImport
"import packages - but do not load classes"
self projectMenuImport:false
!
projectMenuImport:doLoadClasses
|currentProject default pkg fromWhere module checkedOutPackageDir package numImported numSkipped msg classDefs
filePerClassDefintion importFromFilesystem importDirectory importFromDirectoryAction|
importFromFilesystem := false.
currentProject := self theSingleSelectedProject.
currentProject isNil ifTrue:[
default := 'module:package'
] ifFalse:[
module := currentProject upTo:$:.
module size + 2 > currentProject size ifTrue:[
default := currentProject , ':*'
] ifFalse:[
default := currentProject , '/*'
]
].
SourceCodeManager notNil ifTrue:[
fromWhere := 'repository'
] ifFalse:[
fromWhere := 'file system'
].
msg := 'Name of package to import '.
doLoadClasses ifFalse:[
msg := msg , '(i.e. install as autoloaded) '.
].
msg := msg , 'from ' , fromWhere , ':\'.
msg := msg , ' use ''module:*'' to import a complete module;\'.
msg := msg , ' use ''module:package'' to import a package with all of its subpackages;\'.
msg := msg , ' use ''module:package/*'' to import subpackages only.'.
pkg := Dialog
request:msg withCRs
initialAnswer:default.
pkg size == 0 ifTrue:[^ self].
"/ see if such a module/package exists in the repository
module := pkg asPackageId module.
module size + 2 > pkg size ifTrue:[
package := checkedOutPackageDir := nil. "/ i.e. all
] ifFalse:[
package := checkedOutPackageDir := pkg asPackageId directory.
(package includesMatchCharacters) ifTrue:[
"if the match-char is not at the end..."
((package endsWith:'/*') and:[ (package copyWithoutLast:2) includesMatchCharacters not ])
ifTrue:[
checkedOutPackageDir := package copyWithoutLast:2
] ifFalse:[
checkedOutPackageDir := nil. "/ must check out everything and filter
]
].
].
SourceCodeManagerError handle:[:ex |
(Dialog confirm:
(resources stringWithCRs:'Cannot access module "%1".\\' with:module)
,(resources string:(ex errorString ? ('No module "%1" in the repository.')) with:module)
,(resources stringWithCRs:('\\Import from the filesystem ?')))
ifFalse:[
^ self.
].
importFromFilesystem := true.
checkedOutPackageDir isNil ifTrue:[
default := Smalltalk projectDirectoryForPackage:module.
] ifFalse:[
default := Smalltalk projectDirectoryForPackage:pkg.
].
(default notNil
and:[ (default := default asFilename) exists
and:[ default isDirectory ]])
ifFalse:[
default := nil.
].
importDirectory := Dialog
requestDirectoryName:(resources
string:'Import "%1" from Directory:'
with:pkg)
default:default.
importDirectory isEmptyOrNil ifTrue:[
^ self
].
importDirectory := importDirectory asFilename pathName asFilename.
] do:[
SourceCodeManager isNil ifTrue:[ SourceCodeManagerError raise ].
SourceCodeManager checkForExistingModule:module.
checkedOutPackageDir notNil ifTrue:[
(SourceCodeManager checkForExistingModule:module directory:checkedOutPackageDir) ifFalse:[
^ self warn:'No package ''' , checkedOutPackageDir , ''' in the repository (but the module exists).'.
]
].
].
"/ check out that module ...
importFromDirectoryAction :=
[:tempDir |
|filesThere skip|
numImported := numSkipped := 0.
tempDir asFilename withAllDirectoriesDo:[:eachDir |
|relDir theProject anyFound anyUnsavedClass|
( #( 'CVS' 'bitmaps' 'resources' ) includes:eachDir baseName)
ifFalse:[
relDir := eachDir name.
(relDir startsWith:tempDir name) ifTrue:[
relDir := relDir copyFrom:tempDir name size + 2.
] ifFalse:[
self halt:'mhmh - can this happen ?'.
].
checkedOutPackageDir notNil ifTrue:[
relDir size > 0 ifTrue:[
relDir := checkedOutPackageDir asFilename constructString:relDir
] ifFalse:[
relDir := checkedOutPackageDir
]
].
relDir := relDir copy replaceAll:$\ with:$/.
relDir size > 0 ifTrue:[
theProject := module , ':' , relDir
] ifFalse:[
theProject := module
].
skip := false.
(checkedOutPackageDir isNil and:[package notNil]) ifTrue:[
skip := (package ~= (relDir , '/*') ) and:[ (package match:relDir) not ].
].
anyFound := false.
skip ifTrue:[
numSkipped := numSkipped + 1.
] ifFalse:[
Transcript showCR:('processing ' , relDir , '...').
filesThere := eachDir directoryContents select:[:eachFile | eachFile asFilename hasSuffix:'st'].
filesThere isEmpty ifTrue:[
Transcript showCR:(eachDir pathName , ': no smalltalk files in package.').
] ifFalse:[
anyFound := true.
"/ cannot simply fileIn that stuff (because of load order)
"/ instead, create a change set containing all class definitions,
"/ and define them first ...
filePerClassDefintion := Dictionary new.
classDefs := ChangeSet new.
filesThere do:[:eachSTFile |
|s classDefinitions chgSet|
s := (eachDir asFilename construct:eachSTFile) readStream.
chgSet := ChangeSet fromStream:s.
s close.
classDefinitions := chgSet select:[:change | change isClassDefinitionChange and:[change isPrivateClassDefinitionChange not]].
classDefinitions do:[:def | filePerClassDefintion at:def put:eachSTFile].
classDefs addAll:classDefinitions.
].
"/ now, install ...
classDefs do:[:eachClassDefinition |
|cls oldPackage|
eachClassDefinition package:theProject.
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:[
cls package:theProject.
cls instAndClassMethodsDo:[:m | m package = oldPackage ifTrue:[ m package:theProject]].
]
].
].
].
doLoadClasses ifTrue:[
anyUnsavedClass := classDefs
contains:[:someClassDefinition |
|cls|
((cls := someClassDefinition changeClass) notNil
and:[cls isLoaded
and:[ChangeSet current includesChangeForClassOrMetaclass:cls]])
].
anyUnsavedClass ifTrue:[
(Dialog
confirm:'There is at least one unsaved class (changed but not yet checked in) in the project.\\Load (i.e. overwrite) ?' withCRs)
ifFalse:[ AbortSignal raise ].
].
filesThere do:[:eachSTFile |
Transcript showCR:(' loading ' , (eachDir asFilename constructString:eachSTFile) , '...').
self activityNotification:('loading ',eachSTFile,'...').
Class packageQuerySignal answer:theProject do:[
Smalltalk fileIn:(eachDir asFilename construct:eachSTFile).
]
].
numImported := numImported + 1.
].
].
].
(anyFound and:[theProject notNil]) ifTrue:[
self projectListApp addAdditionalProject:theProject.
]
]
]
].
importFromFilesystem ifTrue:[
importFromDirectoryAction value:importDirectory
] ifFalse:[
"/ check out that module ...
SourceCodeManagerError handle:[:ex |
Dialog warn:ex description
] do:[
SourceCodeManager
checkoutModule:module
directory:checkedOutPackageDir
andDo:importFromDirectoryAction.
].
].
numImported == 0 ifTrue:[
numSkipped ~~ 0 ifTrue:[
(package endsWith:'*') ifTrue:[
self information:('Nothing imported. Notice:\You may want to try ''' ,
(package copyWithoutLast:2) , ''' (i.e. not the matching sub-packages).') withCRs
] ifFalse:[
self information:'Nothing imported.'
]
].
].
"Modified: / 17-10-2006 / 18:48:37 / cg"
!
projectMenuImportAndLoadClasses
"import packages AND load classes"
self projectMenuImport:true
!
projectMenuLoad
|projects projectsString|
LastLoadedPackages isNil ifTrue:[
LastLoadedPackages := OrderedCollection new.
].
projects := self selectedProjects value.
projects isEmptyOrNil ifTrue:[
projectsString := Dialog
request:'Load which package(s):'
initialAnswer:projectsString
list:LastLoadedPackages.
projectsString size == 0 ifTrue:[^ self].
projects := projectsString asCollectionOfWords.
].
projects do:[:packageToLoad |
LastLoadedPackages add:packageToLoad.
LastLoadedPackages size > 20 ifTrue:[
LastLoadedPackages removeFirst.
].
Smalltalk loadPackage:packageToLoad
].
"Modified: / 14-09-2006 / 17:38:00 / cg"
!
projectMenuMailTo
"fileOut selected classes (chunk format) and eMail to someone"
self
mailClasses:self selectedProjectClasses
subject:'Project Source from Browser'
"Modified: / 20-09-2007 / 15:03:00 / cg"
!
projectMenuMakeCurrentProject
|theProject id|
id := self theSingleSelectedProject asSymbol.
theProject := Project projectWithId:id.
theProject isNil ifTrue:[
"/ create it
theProject := Project new.
theProject name:id.
theProject package:id.
].
Project current:theProject.
!
projectMenuMetricsSummary
|codeView resultStream |
(self askIfModified:'Code was modified.\\Show metrics anyway ?') ifFalse:[^ self].
OOM::MetricsSummaryGenerator isNil ifTrue:[^ self].
codeView := self codeView.
codeView contents:nil.
codeView modified:false.
navigationState realModifiedState:false.
"/
"/TODO:
"/ Number of top-level classes.
"/ Cyclomatic complexity.
"/ Total cyclomatic complexity.
resultStream := WriteStream on:String new.
self
projectMenuWithAllClassesLoadedDo:[:module :package :classesInProject |
|moduleAndPackage text metrics allClasses|
moduleAndPackage := module , ':' , package.
self busyLabel:'Computing metrics for ' , moduleAndPackage , '...'.
Transcript showCR:'Computing metrics for ' , moduleAndPackage , '...'.
allClasses := OrderedCollection new.
allClasses addAll:classesInProject.
classesInProject do:[:eachClass |
allClasses addAll:(eachClass allPrivateClasses).
].
metrics := OOM::MetricsSummaryGenerator new.
metrics computeMetricsForClasses:allClasses.
text := metrics generateSummaryReport.
resultStream nextPutLine:'Package: ', moduleAndPackage.
resultStream cr.
resultStream nextPutLine:text.
].
codeView contents:(resultStream contents).
codeView modified:false.
navigationState realModifiedState:false.
!
projectMenuNew
|projectDefinitionClass|
projectDefinitionClass := self projectDefinitionDialogFor:nil.
projectDefinitionClass isNil ifTrue:[
^ self
].
projectDefinitionClass compileDescriptionMethods.
self selectClass:projectDefinitionClass.
!
projectMenuProperties
|project defClass|
project := self theSingleSelectedProject.
project isNil ifTrue:[^ self ].
project asPackageId directory isEmptyOrNil ifTrue:[
Dialog warn:(resources
stringWithCRs:'"%1" is a topLevel module identifier.\\Real packages are required to consist of module:directory (i.e. %1:xxx).\Please create a package below this module first'
with:(ProjectDefinition initialClassNameForDefinitionOf:project)).
].
defClass := ProjectDefinition definitionClassForPackage:project.
defClass isNil ifTrue:[
Dialog warn:(resources
string:'Missing ProjectDefinition class: %1'
with:(ProjectDefinition initialClassNameForDefinitionOf:project)).
^ self
].
ProjectDefinitionEditor new
definitionClass:defClass;
open
"Modified: / 09-02-2007 / 12:17:29 / cg"
!
projectMenuRecompileInstrumented
self selectedProjectClasses do:[:eachClass |
eachClass theNonMetaclass recompileUsingCompilerClass:InstrumentingCompiler.
eachClass theMetaclass recompileUsingCompilerClass:InstrumentingCompiler.
].
"Created: / 27-04-2010 / 12:39:43 / cg"
"Modified: / 27-04-2010 / 14:09:13 / cg"
!
projectMenuRegenerateProjectContentsDefinitions
|projectClasses|
projectClasses := self projectDefinitionClassesForSelectedProjects.
self updateProjectContentsDefinitionsIn:projectClasses regenerate:true
"Created: / 10-10-2006 / 21:05:51 / cg"
!
projectMenuRemove
(self selectedProjects value includes:(BrowserList nameListEntryForALL)) ifTrue:[
self warn:'I won''t do that !!'.
^ self
].
self withWaitCursorDo:[
self selectedProjectsDo:[:packageToRemove |
self projectMenuRemoveProject:packageToRemove
]
]
!
projectMenuRemoveProject:projectToRemove
"remove a project - removes all classes and extensions for that project"
|classesToRemove methodsToRemove msg|
classesToRemove := IdentitySet new.
methodsToRemove := IdentitySet new.
"/ classes ...
"/ ... and individual methods (extensions)
Smalltalk allClassesDo:[:aClass |
(aClass package = projectToRemove) ifTrue:[
classesToRemove add:aClass.
] ifFalse:[
aClass instAndClassSelectorsAndMethodsDo:[:sel :mthd |
(mthd package = projectToRemove) ifTrue:[
methodsToRemove add:mthd
]
].
]
].
msg := 'Remove project ''%1'' with\'.
classesToRemove size > 0 ifTrue:[
classesToRemove size == 1 ifTrue:[
msg := msg , '1 class'.
] ifFalse:[
msg := msg , '%2 classes'.
].
methodsToRemove size > 0 ifTrue:[
msg := msg , ' and '
]
].
methodsToRemove size > 0 ifTrue:[
methodsToRemove size == 1 ifTrue:[
msg := msg , '1 method extension in another class'.
] ifFalse:[
msg := msg , '%3 method extensions in other classes'.
]
].
msg := msg , '.'.
(classesToRemove contains:[:someClass | someClass wasAutoloaded]) ifTrue:[
msg := msg , '\\Notice: this is a real remove (no autoload stubs will remain)'.
].
msg := msg
bindWith:projectToRemove string allBold
with:classesToRemove size
with:methodsToRemove size.
msg := msg withCRs.
(classesToRemove size > 0
or:[methodsToRemove size > 0]) ifTrue:[
(Dialog confirm:msg) ifFalse:[^ self].
].
self withWaitCursorDo:[
methodsToRemove do:[:eachMethod |
eachMethod mclass removeSelector:eachMethod selector.
].
classesToRemove do:[:eachClass |
eachClass removeFromSystem.
].
self projectListApp removeAdditionalProjects:(Array with:projectToRemove).
].
self normalLabel.
!
projectMenuRename
self information:'Sorry - this functionality is not yet implemented'
!
projectMenuRepositoryHistory
|projects|
projects := self selectedProjects value.
projects size == 0 ifTrue:[projects := nil].
self repositoryHistoryForProjects:projects
"Modified: / 12-09-2006 / 15:06:02 / cg"
!
projectMenuResources
self information:'Sorry - this functionality is not yet implemented'
!
projectMenuSetTag
|tag|
tag := Dialog request:'Tag:'.
tag isEmptyOrNil ifTrue:[^ self ].
self withWaitCursorDo: [
self selectedProjectsDo:[:packageToTag |
|classes|
classes := Smalltalk allClassesInPackage:packageToTag.
SourceCodeManagerUtilities tagClasses:classes as:tag.
]
]
"Created: / 12-09-2006 / 13:25:09 / cg"
!
projectMenuShowGeneratedBuildFile:whichFile
"/ intermediate - this will be removed later
|package defClass newFile oldFile editor differ theFile|
self hasProjectDefinitionSelected ifTrue:[
self hasSingleClassSelected ifTrue:[
defClass := self theSingleSelectedClass
].
defClass isNil ifTrue:[
self warn:(resources string:'Please select a single project definition class').
^ self.
].
defClass := defClass theNonMetaclass.
package := defClass package.
] ifFalse:[
self hasSingleProjectSelected ifTrue:[
package := self theSingleSelectedProject.
defClass := ProjectDefinition definitionClassForPackage:package.
defClass isNil ifTrue:[
self warn:(resources string:'Missing project definition class (%1)\for package: %2.'
with:(ProjectDefinition initialClassNameForDefinitionOf:package)
with:package allBold).
^ self.
].
]
].
theFile := whichFile.
theFile = 'lib.rc' ifTrue:[
theFile := defClass rcFilename.
].
theFile = 'app.nsi' ifTrue:[
theFile := defClass nsiFilename.
].
(defClass allClassNames "compiled_classNames"
contains:[:aName |
|cls|
cls := Smalltalk at:aName asSymbol.
cls isNil
])
ifTrue:[
(Dialog confirm:('Some class from the list of compiled classes is missing in the image!!\\Continue anyway ?') withCRs)
ifFalse:[^ self ].
].
whichFile = 'abbrev.stc' ifTrue:[
(defClass compiled_classNames
contains:[:aName |
|cls|
cls := Smalltalk at:aName asSymbol.
cls notNil and:[cls isLoaded not]
])
ifTrue:[
(Dialog confirm:'Autoload missing class(es) ?\\Notice: generated abbrev.stc file is wrong if autoloaded classes are unloaded' withCRs) ifTrue:[
defClass compiled_classNames do:[:aName |
(Smalltalk at:aName asSymbol) autoload
].
].
].
].
[
newFile := defClass generateFile:theFile.
] on:Error do:[:ex|
self errorNotify:ex description.
^ self.
].
SourceCodeManager notNil ifTrue:[
oldFile := SourceCodeManager
getFile:theFile
revision:#newest
directory:(package asPackageId directory)
module:(package asPackageId module).
].
oldFile isNil ifTrue:[
editor := EditTextView openOnModel:newFile.
editor topView label:(resources string:'Generated %1' with:theFile).
] ifFalse:[
differ := DiffCodeView
openOn:oldFile label:(resources string:'Newest %1 in Repository' with:theFile)
and:newFile label:(resources string:'Generated %1' with:theFile).
].
"Created: / 29-08-2006 / 15:35:44 / cg"
"Modified: / 19-12-2006 / 12:15:33 / cg"
!
projectMenuSpawn
"open a browser showing the selected projects only"
self spawnProjectBrowserFor:(self selectedProjects value) in:#newBrowser
"Created: / 24.2.2000 / 21:42:26 / cg"
!
projectMenuSpawnBuffer
"add a buffer showing the selected projects only"
self spawnProjectBrowserFor:(self selectedProjects value) in:#newBuffer
"Created: / 24.2.2000 / 21:42:40 / cg"
!
projectMenuSpawnExtensionsBrowser
"open a browser showing the selected projects extensions only"
self spawnProjectExtensionBrowserFor:(self selectedProjects value) in:#newBrowser
!
projectMenuSpawnExtensionsBuffer
"add a buffer showing the selected projects extensions only"
self spawnProjectExtensionBrowserFor:(self selectedProjects value) in:#newBuffer
!
projectMenuSpawnPreRequirerBrowser
"open a browser showing projects which have the selected project(s) as prerequisite"
self spawnProjectPreRequirerBrowserFor:(self selectedProjects value) in:#newBrowser
"Created: / 23-01-2007 / 19:23:43 / cg"
!
projectMenuSpawnPreRequirerBuffer
"open a browser showing projects which have the selected project(s) as prerequisite"
self spawnProjectPreRequirerBrowserFor:(self selectedProjects value) in:#newBuffer
"Created: / 23-01-2007 / 19:23:32 / cg"
!
projectMenuUpdate
self projectListApp forceUpdateList
!
projectMenuUpdateProjectContentsDefinitions
|projectClasses|
projectClasses := self projectDefinitionClassesForSelectedProjects.
self updateProjectContentsDefinitionsIn:projectClasses regenerate:false
"Created: / 10-10-2006 / 20:59:14 / cg"
!
projectMenuWithAllClassesLoadedDo:aBlock
"/ helper for gen-abbrev and gen-loadAll
"/ intermediate - this will move into a commonly used utility class
"/ (where all the project code support will be collected).
SourceCodeManager isNil ifTrue:[^ self warn:'No SourceCodeManagement is configured.'].
self withWaitCursorDo:[
|classesToLoad classesToUnload answer outStream classesSorted|
self selectedProjectsDo:[:packageToCheck |
|module package containers classesInProject classesWithoutContainer|
module := packageToCheck asPackageId module.
package := packageToCheck asPackageId directory.
"/ containers := SourceCodeManager getExistingContainersInModule:module package:package.
"/ containers := containers select:[:each | (each startsWith:'.') not].
classesInProject := IdentitySet new.
Smalltalk allClassesDo:[:aClass |
(packageToCheck = aClass package) ifTrue:[
aClass isPrivate ifFalse:[
aClass isObsolete ifTrue:[
Transcript showCR:'skipping obsolete class: ' , aClass name.
] ifFalse:[
classesInProject add:aClass .
]
]
]
].
"/ load unloaded classes...
classesToLoad := OrderedCollection new.
classesInProject do:[:eachClassInProject |
eachClassInProject isLoaded ifFalse:[
classesToLoad add:eachClassInProject
].
].
classesToLoad size > 0 ifTrue:[
answer := Dialog confirmWithCancel:(resources string:'%1 class(es) are not loaded.\In order to proceed, these must be loaded first.\\Load them now ?'
with:classesToLoad size) withCRs
default:false.
answer isNil ifTrue:[^ self].
answer ifTrue:[
self busyLabel:'Autoloading all classes in ' , packageToCheck , '...'.
classesToUnload := OrderedCollection new.
classesInProject do:[:eachClassInProject |
eachClassInProject isLoaded ifFalse:[
eachClassInProject autoload.
classesToUnload add:eachClassInProject
].
].
].
].
self busyLabel:'Checking for classes without container in ' , packageToCheck , '...'.
"/ any class without container ?
classesWithoutContainer := IdentitySet new.
classesInProject do:[:eachClassInProject |
|mgr info classesModule classesPackageDir classesContainerFileName|
eachClassInProject isPrivate ifFalse:[
mgr := SourceCodeManagerUtilities sourceCodeManagerFor:eachClassInProject.
info := mgr sourceInfoOfClass:eachClassInProject.
info isNil ifTrue:[
"/ no container for that class
classesWithoutContainer add:eachClassInProject
].
].
].
"/ any container left ?
classesWithoutContainer notEmpty ifTrue:[
answer := Dialog warn:(resources string:'%1 class(es) have no container in the repository.\\Please do not forget to check them in.'
with:classesToLoad size) withCRs.
].
aBlock value:module value:package value:classesInProject.
classesToUnload size >0 ifTrue:[
answer := Dialog confirm:(resources string:'%1 class(es) were loaded - unload them now ?'
with:classesToLoad size)
default:false.
answer ifTrue:[
self busyLabel:'Unloading autoloaded classes in ' , packageToCheck , '...'.
"/ unload classes which have been loaded temporarily
classesToUnload do:[:eachClassToUnload |
eachClassToUnload unload
].
]
]
].
].
self normalLabel
"Modified: / 12-09-2006 / 14:22:58 / cg"
!
selectedProjectsDo:aBlock
|selectedProjects allProjects|
selectedProjects := self selectedProjects value.
(selectedProjects includes:(BrowserList nameListEntryForALL)) ifTrue:[
allProjects := (Smalltalk allClasses collect:[:eachClass | eachClass package]) asSet.
selectedProjects := allProjects.
].
selectedProjects := selectedProjects asOrderedCollection.
selectedProjects sort do:aBlock
!
spawnProjectBrowserFor:projects in:where
"browse selected project(s);
where is: #newBrowser - open a new browser showing the projects
where is: #newBuffer - add a new buffer showing the projects"
|spec projectList singleSelection|
(singleSelection := projects size == 1) ifTrue:[
"/ spec := #singleProjectBrowserSpec.
spec := #singleProjectFullBrowserSpec.
] ifFalse:[
"/ spec := #multipleProjectBrowserSpec.
spec := #multipleProjectFullBrowserSpec.
].
projectList := projects copy.
self
newBrowserOrBufferDependingOn:where
label:nil
forSpec:spec
setupWith:[:brwsr |
"/ setup for a constant list ...
brwsr immediateUpdate value:true.
brwsr projectListApp slaveMode:false.
brwsr organizerMode value:#project.
brwsr projectListGenerator value:projectList.
brwsr packageFilter value:projectList.
brwsr selectProjects:(singleSelection ifTrue:[projectList] ifFalse:[#()]).
brwsr immediateUpdate value:false.
]
"Modified: / 23-01-2007 / 19:42:18 / cg"
!
spawnProjectExtensionBrowserFor:projects in:where
"browse selected project(s) extensions;
where is: #newBrowser - open a new browser showing the projects
where is: #newBuffer - add a new buffer showing the projects"
|classes title|
classes := Smalltalk allClasses
select:[:each | (projects includes:each package) not].
projects size == 1 ifTrue:[
title := 'Extensions for Project ''' , projects first , ''''
] ifFalse:[
title := 'Extensions for Projects'
].
^ self
browseMenuClassExtensionsFor:projects
in:classes
label:title
openAs:where
!
spawnProjectPreRequirerBrowserFor:someProjects in:how
"open a browser/buffer showing projects which have the selected project(s) as prerequisite"
|requirer|
requirer := Set new.
ProjectDefinition allSubclassesDo:[:eachProjectDefinition |
(eachProjectDefinition preRequisites includesAny:someProjects) ifTrue:[
requirer add:(eachProjectDefinition package).
]
].
requirer isEmpty ifTrue:[
Dialog warn:'Noone seems to require this package (not found in any prerequisites).'.
^ self.
].
self spawnProjectBrowserFor:(requirer asOrderedCollection sort) in:how
"Created: / 23-01-2007 / 19:25:00 / cg"
!
updateProjectContentsDefinitionsIn:classes regenerate:doRegenerate
self
generateUndoableChange:(doRegenerate ifTrue:'Generate Project Definitions' ifFalse:'Update Project Definitions')
overClasses:classes
via:[:generator :eachClass |
Class packageQuerySignal
answer:eachClass package
do:[
eachClass theNonMetaclass
forEachContentsMethodsCodeToCompileDo:
[:code :category |
generator
compile:code
forClass:eachClass theMetaclass
inCategory:category.
]
ignoreOldDefinition:doRegenerate
].
].
"Created: / 10-10-2006 / 21:05:14 / cg"
"Modified: / 23-10-2006 / 11:01:42 / cg"
! !
!NewSystemBrowser methodsFor:'menu actions-protocol'!
doMoveSelectedProtocolsToProject:newProject
"change the package-id of all methods in the selected protocols.
Will eventually update the Project-object"
self selectedProtocolMethodsDo:[:cls :protocol :sel :eachMethod |
eachMethod package:newProject.
].
self rememberLastProjectMoveTo:newProject
!
methodListMenuUpdate
self methodListApp updateList
!
printOutProtocolsWithSelector:aSelector
|printStream|
printStream := Printer new.
(self selectedClasses value) do:[:eachClass |
(self selectedProtocols value sort) do:[:eachProtocol |
(eachClass methodDictionary contains:[:m | m category = eachProtocol])
ifTrue:[
eachClass perform:aSelector with:eachProtocol with:printStream.
].
].
].
printStream close
!
protocolMenuCopyToClass
"copy all methods in the selected protocols to some other class."
self protocolMenuMoveOrCopy:#copy
!
protocolMenuFileOutAs
"fileOut all methods in the selected methodcategory of
the current class"
|methods protocols|
protocols := self selectedProtocolsValue.
methods := self methodListApp methodList.
methods := methods select:[:eachMethod| protocols includes:eachMethod category].
self
fileOutMethods:methods
format:nil
fileNameTemplate:self currentClass name , '-' , protocols first
boxTitle:'FileOut protocol as:'
!
protocolMenuGenerateCommonProtocols
"these are needed so often; let the browser do it for me"
|protocols|
self hasMetaSelected ifTrue:[
protocols := #('instance creation' 'documentation' 'defaults')
] ifFalse:[
protocols := #('accessing' 'adding & removing' 'testing' 'initialization' 'queries' 'private'
'printing & storing' 'change & update')
].
protocols do:[:newProtocol |
"/ self immediateUpdate value:true.
self selectedClassesDo:[:cls |
self methodCategoryListApp addAdditionalProtocol:newProtocol forClass:cls.
].
self clearAutoSelectOfLastSelectedProtocol.
"/ self immediateUpdate value:false.
].
!
protocolMenuMoveOrCopy:doWhat
"move or copy the selected protocols methods to some other class - typically a sister class"
|newClass newClassName sup initial m changes
supers subs list "holders" currentClass reqString okLabel title|
"/ provide a reasonable default in the pull-down-list
currentClass := self anySelectedClass.
currentClass isNil ifTrue:[
m := self anySelectedMethod.
currentClass := m mclass.
].
LastMethodMoveOrCopyTargetClass notNil ifTrue:[
initial := LastMethodMoveOrCopyTargetClass.
].
initial isNil ifTrue:[
(sup := currentClass superclass) notNil ifTrue:[
initial := sup name
] ifFalse:[
initial := nil.
].
].
supers := (currentClass allSuperclasses reverse collect:[:cls | cls name]).
subs := (currentClass allSubclasses collect:[:cls | cls name]).
list := supers.
(supers notEmpty and:[subs notEmpty]) ifTrue:[
list := list , (Array with:'---- ' , currentClass name , ' ----')
].
list := list , subs.
"/ preps to use windowSpecs ...
"/
"/ holders := IdentityDictionary new.
"/ holders at:#className put:initial asValue.
"/ holders at:#classList put:list.
"/
"/ (SystemBrowser
"/ openDialogInterface:#methodMoveDialogSpec
"/ withBindings:holders) ifFalse:[
"/ ^ self
"/ ].
"/ newClassName := (holders at:#className) value.
doWhat == #copy ifTrue:[
reqString := 'Copy selected protocols method(s) to which class:'.
okLabel := 'Copy'.
title := 'Copy protocol'.
] ifFalse:[
reqString := 'Move selected protocols method(s) to which class:'.
okLabel := 'Move'.
title := 'Move protocol'.
].
newClassName := Dialog
request:(resources string:reqString)
initialAnswer:initial
okLabel:(resources string:okLabel)
title:(resources string:title)
onCancel:nil
list:list
entryCompletionBlock:(DoWhatIMeanSupport classNameEntryCompletionBlock).
newClassName isNil ifTrue:[^ self].
(newClassName startsWith:'---- ') ifTrue:[^ self].
newClass := Smalltalk classNamed:newClassName.
newClass isNil ifTrue:[
self warn:'no such class: ', newClassName.
^ self
].
LastMethodMoveOrCopyTargetClass := newClassName.
self meta value ifTrue:[
newClass := newClass theMetaclass
] ifFalse:[
newClass := newClass theNonMetaclass
].
(self canUseRefactoringSupport) ifTrue:[
changes := CompositeRefactoryChange named:((doWhat == #copy) ifTrue:['Copy protocol(s)'] ifFalse:['Move protocol(s)']).
].
self selectedProtocolMethodsDo:[:cls :protocol :sel :methodToCopyOrMove |
|question msg selectorToCopyOrMove dontDoIt newMethod|
"/ skip the version method (to avoid confusing the repository)
((AbstractSourceCodeManager isVersionMethodSelector:sel) and:[newClass isMeta]) ifFalse:[
dontDoIt := false.
selectorToCopyOrMove := methodToCopyOrMove selector.
(newClass includesSelector:selectorToCopyOrMove) ifTrue:[
question := (doWhat == #copy)
ifTrue:['%1 already implements #%2\\Copy anyway ?']
ifFalse:['%1 already implements #%2\\Move anyway ?'].
(self confirm:(resources string:question
with:newClass name allBold
with:selectorToCopyOrMove) withCRs) ifFalse:[
dontDoIt := true
]
].
dontDoIt ifFalse:[
lastMethodMoveClass := newClassName.
changes notNil ifTrue:[
changes
compile: (methodToCopyOrMove source)
in: newClass
classified: (methodToCopyOrMove category).
newMethod := #dummy. "/ to make following if happy
] ifFalse:[
newMethod := newClass
compile:(methodToCopyOrMove source)
classified:(methodToCopyOrMove category).
].
(newMethod isNil or:[newMethod == #Error]) ifTrue:[
msg := (doWhat == #copy)
ifTrue:['#%1 not copied - compilation failed due to an error']
ifFalse:['#%1 not moved - compilation failed due to an error'].
self warn:(resources string:msg with:selectorToCopyOrMove)
] ifFalse:[
(doWhat == #move) ifTrue:[
changes notNil ifTrue:[
changes removeMethod: selectorToCopyOrMove from: (methodToCopyOrMove mclass)
] ifFalse:[
(methodToCopyOrMove mclass) removeSelector:selectorToCopyOrMove.
]
]
]
]
]
].
changes notNil ifTrue:[
RefactoryChangeManager performChange: changes
].
!
protocolMenuMoveToClass
"move all methods in the selected protocols to some other class."
self protocolMenuMoveOrCopy:#move
!
protocolMenuMoveToProject
"change the package-id of all methods in the selected protocols.
Will eventually update the Project-object"
|newProject|
newProject := self askForProject:'Move all methods in protocol(s) to which project:'.
newProject notNil ifTrue:[
self doMoveSelectedProtocolsToProject:newProject.
].
!
protocolMenuNew
|newProtocol classesMethodCategories allMethodCategories someMethodCategories
someRecentlyVisitedMethodCategories
cls suggestion|
LastNewProtocols notEmptyOrNil ifTrue:[
suggestion := LastNewProtocols first.
].
"/ allMethodCategories := Set new.
"/ Smalltalk allBehaviorsDo:[:eachClass |
"/ allMethodCategories addAll:eachClass categories
"/ ].
"/
SharedMethodCategoryCache isNil ifTrue:[
SharedMethodCategoryCache := MethodCategoryCache new
].
allMethodCategories := SharedMethodCategoryCache allMethodCategories.
"/ remove existing ones ...
(cls := self theSingleSelectedClass) notNil ifTrue:[
classesMethodCategories := cls categories asSet.
someMethodCategories := allMethodCategories select:[:cat | (classesMethodCategories includes:cat) not].
"/ someMethodCategories removeAllFoundIn:classesMethodCategories.
(classesMethodCategories includes:suggestion) ifTrue:[
suggestion := nil.
].
].
someMethodCategories := (someMethodCategories ? allMethodCategories) asOrderedCollection sort.
someRecentlyVisitedMethodCategories := self methodCategoryListApp lastSelectedProtocols.
someRecentlyVisitedMethodCategories notEmptyOrNil ifTrue:[
someRecentlyVisitedMethodCategories := someRecentlyVisitedMethodCategories asOrderedCollection sort.
someMethodCategories addFirst:''.
someMethodCategories addAllFirst:someRecentlyVisitedMethodCategories.
suggestion isNil ifTrue:[
suggestion := someRecentlyVisitedMethodCategories first
].
].
newProtocol := self
askForMethodCategory:'Name of new protocol:\(Tab for completion)' withCRs
title:'New MethodCategory'
okLabel:'Create'
list:someMethodCategories
recentList:LastNewProtocols
initialAnswer:suggestion.
newProtocol isNil ifTrue:[^ self].
newProtocol bitsPerCharacter > 8 ifTrue:[
Dialog warn:'Sorry - for now, non-ascii categories are not allowed (no 2-byte symbols).'.
^ self.
].
self immediateUpdate value:true.
self selectedClassesDo:[:cls |
self methodCategoryListApp addAdditionalProtocol:newProtocol forClass:cls.
].
self selectProtocol:newProtocol.
self clearAutoSelectOfLastSelectedProtocol.
self immediateUpdate value:false.
LastNewProtocols isNil ifTrue:[
LastNewProtocols := OrderedCollection new
].
LastNewProtocols remove:newProtocol ifAbsent:[].
LastNewProtocols addFirst:newProtocol.
LastNewProtocols size > 10 ifTrue:[
LastNewProtocols removeLast
].
"Modified: / 25.2.2000 / 00:56:04 / cg"
!
protocolMenuPrintOut
self printOutProtocolsWithSelector:#'printOutCategory:on:'.
!
protocolMenuRemove
"confirm removal of the selected protocols"
|classes protocols methods numClasses numProtocols numMethods msg
methodCategoryListApp|
"/ count them ...
classes := IdentitySet new.
protocols := Set new.
methods := IdentitySet new.
self selectedProtocolMethodsDo:[:cls :protocol :sel :eachMethod |
classes add:cls.
protocols add:protocol.
methods add:eachMethod.
].
numClasses := classes size.
numProtocols := protocols size.
numMethods := methods size.
numMethods ~~ 0 ifTrue:[
numMethods == 1 ifTrue:[
msg := resources
string:'Really remove %1 from ''%2'''
with:(methods first selector allBold)
with:classes first name allBold.
] ifFalse:[
msg := 'Really remove %1 methods'.
numProtocols > 1 ifTrue:[
msg := msg , ' (in %3 categories)'
] ifFalse:[
msg := msg , ' categorized as ''%4'''
].
numClasses > 1 ifTrue:[
msg := msg , ' from %2 classes'
] ifFalse:[
msg := msg , ' from ''%5'''
].
msg := msg , ' ?'.
msg := resources
string:msg
with:numMethods printString
with:numClasses printString
with:numProtocols printString
with:protocols first allBold
with:classes first name allBold.
].
(self confirm:msg) ifFalse:[^ self].
].
classes := protocols := nil.
"/ then, remove them
self doRemoveMethodsUnconfirmed:methods.
methods := nil.
"/ kludge: remove the simulated entries ...
methodCategoryListApp := self methodCategoryListApp.
methodCategoryListApp notNil ifTrue:[
self selectedClassesDo:[:cls |
methodCategoryListApp
removeAdditionalProtocol:self selectedProtocols value
forClass:cls.
].
methodCategoryListApp updateList.
]
!
protocolMenuRename
"launch an enterBox to rename current method category"
|"box" selClasses someCategories suggestion last currentMethodCategory
msg newCategory selMethods methodCategoryListApp|
self hasProtocolSelected ifFalse:[^ self].
LastProtocolRenames isNil ifTrue:[
LastProtocolRenames := OrderedCollection new.
].
currentMethodCategory := self theSingleSelectedProtocol.
currentMethodCategory isNil ifTrue:[
LastProtocolRenames size > 0 ifTrue:[
last := LastProtocolRenames last
].
] ifFalse:[
currentMethodCategory := currentMethodCategory string.
last := LastProtocolRenames detect:[:ren | ren key = currentMethodCategory] ifNone:nil.
last notNil ifTrue:[
suggestion := last value
]
].
last isNil ifTrue:[
suggestion := currentMethodCategory
].
currentMethodCategory isNil ifTrue:[
msg := resources string:'Rename selected categories to:'
] ifFalse:[
msg := resources string:'Rename method category ''%1'' to:'
with:currentMethodCategory allBold
].
"/ box := self class
"/ enterBoxTitle:msg
"/ okText:'rename'
"/ label:'rename category'.
"/
"/ box initialText:suggestion.
"/
"/ box action:[:aString | newCategory := aString].
"/ box showAtPointer.
someCategories := Set new.
"/ offer the current classes's protocols in the dialog
(selClasses := self selectedClasses value) notNil ifTrue:[
selClasses do:[:eachClass |
someCategories addAll:(eachClass categories).
]
] ifFalse:[
"/ offer the current method-classes' protocols in the dialog
(selMethods := self selectedMethods value) notNil ifTrue:[
selMethods do:[:eachMethod | |cls|
(cls := eachMethod mclass) notNil ifTrue:[
someCategories addAll:cls categories
]
]
]
].
someCategories := someCategories asOrderedCollection sort.
someCategories notEmpty ifTrue:[
someCategories add:''.
].
someCategories addAll:(Smalltalk allMethodCategories select:[:cat | (someCategories includes:cat) not]) asOrderedCollection sort.
newCategory := self
askForMethodCategory:msg
title:'Rename MethodCategory'
okLabel:'Rename'
list:someCategories
initialAnswer:suggestion.
newCategory isNil ifTrue:[^ self].
newCategory := newCategory withoutSeparators.
newCategory isEmptyOrNil ifTrue:[^ self].
newCategory = currentMethodCategory ifTrue:[^ self].
newCategory bitsPerCharacter > 8 ifTrue:[
Dialog warn:'Sorry - for now, non-ascii categories are not allowed (no 2-byte symbols).'.
^ self.
].
self withWaitCursorDo:[
LastProtocolRenames := LastProtocolRenames select:[:ren | ren key ~= currentMethodCategory].
LastProtocolRenames addLast:(currentMethodCategory -> newCategory).
LastProtocolRenames size > 20 ifTrue:[LastProtocolRenames removeFirst].
methodCategoryListApp := self methodCategoryListApp.
newCategory := newCategory asSymbol.
self selectedProtocolsDo:[:cls :protocol |
|methods|
methods := cls methodDictionary values select:[:m | m category = protocol].
self moveMethods:methods toProtocol:newCategory.
"/ cls renameCategory:protocol to:newCategory.
"/ kludge - must also rename in addedProtocols
methodCategoryListApp notNil ifTrue:[
methodCategoryListApp renameAdditionalProtocol:protocol to:newCategory forClass:cls.
]
].
methodCategoryListApp notNil ifTrue:[
(self selectedClasses value ? #()) do:[:cls |
"/ kludge - must also rename in addedProtocols
methodCategoryListApp renameAdditionalProtocol:currentMethodCategory to:newCategory forClass:cls.
].
methodCategoryListApp updateList.
].
self immediateUpdate value:true.
self selectProtocol:newCategory.
self immediateUpdate value:false.
]
"Modified: / 06-02-2007 / 10:21:34 / cg"
!
protocolMenuSpawn
"open a new browser showing the selected category only"
^ self
spawnProtocolBrowserFor:(self selectedClasses value)
and:(self selectedProtocols value)
in:#newBrowser
!
protocolMenuSpawnBuffer
"add a new buffer showing the selected category only"
^ self
spawnProtocolBrowserFor:(self selectedClasses value)
and:(self selectedProtocols value)
in:#newBuffer
!
protocolMenuSpawnFullCategory
"open a new browser showing all methods (from all classes) in that category"
^ self
spawnFullProtocolBrowserFor:(self selectedProtocols value)
in:#newBrowser
!
protocolMenuSpawnFullCategoryBuffer
"add a new buffer showing all methods (from all classes) in that category"
^ self
spawnFullProtocolBrowserFor:(self selectedProtocols value)
in:#newBuffer
!
protocolMenuSpawnMatchingFullCategoryBrowser
"open a new browser showing all methods (from all classes) in macthing categories"
^ self protocolMenuSpawnMatchingFullCategoryIn:#newBrowser
!
protocolMenuSpawnMatchingFullCategoryBuffer
"add a buffer showing all methods (from all classes) in macthing categories"
^ self protocolMenuSpawnMatchingFullCategoryIn:#newBuffer
!
protocolMenuSpawnMatchingFullCategoryIn:openHow
"add a buffer/ open a new browser showing all methods (from all classes) in matching categories"
|pattern matchingProtocols|
pattern := Dialog request:'Match pattern for protocols:' initialAnswer:(self theSingleSelectedProtocol ? '').
pattern size == 0 ifTrue:[^ self].
pattern := pattern string.
matchingProtocols := Set new.
Smalltalk allClassesAndMetaclassesDo:[:eachClass |
eachClass isLoaded ifTrue:[
eachClass categories do:[:cat |
(pattern match:cat) ifTrue:[
matchingProtocols add:cat.
]
]
]
].
^ self spawnFullProtocolBrowserFor:matchingProtocols in:openHow
!
protocolMenuUpdate
|methodCategoryListApp|
(methodCategoryListApp := self methodCategoryListApp) notNil ifTrue:[
(self selectedClasses value ? #()) do:[:aClass |
methodCategoryListApp removeAllAdditionalProtocolForClass:aClass
].
methodCategoryListApp forceUpdateList
]
!
spawnFullProtocolBrowserFor:protocols in:where
"browse selected protocols;
where is: #newBrowser - open a new browser showing the classes
where is: #newBuffer - add a new buffer showing the classes"
|spec lbl|
protocols size == 1 ifTrue:[
spec := #singleFullProtocolBrowserSpec.
lbl := protocols first , ' [full Protocol]'
] ifFalse:[
spec := #multipleFullProtocolBrowserSpec.
lbl := '[full Protocols]'
].
"/ selectedMethods := self selectedMethods value copy.
^ self
newBrowserOrBufferDependingOn:where
label:lbl
forSpec:spec
setupWith:[:brwsr |
|generator protocolList|
protocolList := protocols collect:[:each | each string].
"/ setup a special generator ...
generator :=
Iterator on:[:whatToDo |
|all protocols|
protocols := protocolList.
"/ protocols := (brwsr selectedProtocols value) ? protocolList.
all := protocols includes:(BrowserList nameListEntryForALL).
self withWaitCursorDo:[
Smalltalk allClassesAndMetaclassesDo:[:eachClass |
eachClass categories do:[:cat |
(all or:[protocols includes:cat]) ifTrue:[
whatToDo value:eachClass value:cat.
]
]
]
].
].
brwsr noAllItem value:true.
brwsr sortBy value:#class.
"/ brwsr immediateUpdate value:true.
"/ kludge - need a dummy organizer (with constant classList/protocolList)
brwsr withWaitCursorDo:[
brwsr protocolListGenerator value:generator.
protocolList size == 1 ifTrue:[brwsr selectProtocols:protocolList copy].
].
"/ brwsr selectMethods:selectedMethods.
"/ brwsr immediateUpdate value:false.
]
!
spawnProtocolBrowserFor:classes and:protocols in:where
"browse selected protocols;
where is: #newBrowser - open a new browser showing the classes
where is: #newBuffer - add a new buffer showing the classes"
|spec selectedMethods singleSelection|
(singleSelection := protocols size) == 1 ifTrue:[
spec := #singleProtocolBrowserSpec.
] ifFalse:[
spec := #multipleProtocolBrowserSpec.
].
selectedMethods := self selectedMethods value copy.
^ self
newBrowserOrBufferDependingOn:where
label:nil
forSpec:spec
setupWith:[:brwsr |
|generator classList protocolList|
classList := classes copy.
protocolList := protocols collect:[:each | each string].
brwsr selectClasses:classList.
"/ setup a special generator ...
generator :=
Iterator on:[:whatToDo |
|all remainingClasses remainingCategories|
remainingClasses := classList copy asIdentitySet.
remainingCategories := protocolList copy asSet.
all := protocolList includes:(BrowserList nameListEntryForALL).
classList do:[:aClass |
aClass methodDictionary keysAndValuesDo:[:sel :mthd |
|cat|
cat := mthd category.
(all
or:[protocolList includes:cat]) ifTrue:[
whatToDo value:aClass value:cat.
remainingClasses remove:aClass ifAbsent:nil.
remainingCategories remove:cat ifAbsent:nil.
]
]
].
remainingClasses do:[:aClass |
whatToDo value:aClass value:nil.
].
].
"/ kludge - need a dummy organizer (with constant classList/protocolList)
brwsr immediateUpdate value:true.
brwsr protocolListGenerator value:generator.
brwsr selectProtocols:protocolList copy.
brwsr selectMethods:selectedMethods.
brwsr immediateUpdate value:false.
]
! !
!NewSystemBrowser methodsFor:'menu actions-searching'!
askForClassToSearch:doWhatByDefault single:singleClass msgTail:msgTail resources:resourcesOrNil thenDo:aBlock
"common code for both opening a new browser on a class and
to search for a class in this browser.
doWhat is: #newBrowser, #newBuffer or nil.
If singleClass is true, a single class will be asked for and browsed,
otherwise, a match pattern is allowed and a multi-class browser is opened."
|box boxLabel title okText okText2 okText3 className canFind
button2 button3 doWhat doWhat2 doWhat3 classNameHolder updateList
allClasses allNames resources|
resources := resourcesOrNil ? self class classResources.
doWhat := doWhatByDefault.
canFind := navigationState notNil and:[ navigationState isFullBrowser ].
doWhat isNil ifTrue:[
title := ''.
boxLabel := (resources string:'Select a class').
okText := 'OK'.
okText2 := nil. doWhat2 := nil.
okText3 := nil. doWhat3 := nil.
] ifFalse:[
title := (singleClass ifTrue:[ 'Class to browse' ] ifFalse:[ 'Class(es) to browse' ]).
boxLabel := (resources string:'Browse or Search').
(doWhat isNil and:[canFind not]) ifTrue:[
doWhat := #newBuffer.
].
doWhat == #newBrowser ifTrue:[
okText := 'Open'.
okText2 := 'Add Buffer'. doWhat2 := #newBuffer.
okText3 := 'Find'. doWhat3 := nil.
] ifFalse:[ doWhat == #newBuffer ifTrue:[
okText := 'Add Buffer'.
okText2 := 'Open New'. doWhat2 := #newBrowser.
okText3 := 'Find'. doWhat3 := nil.
] ifFalse:[
title := (singleClass ifTrue:[ 'Class to find' ] ifFalse:[ 'Class(es) to find' ]).
okText := 'Find'.
okText2 := 'Open New'. doWhat2 := #newBrowser.
okText3 := 'Add Buffer'. doWhat3 := #newBuffer.
]].
].
title := (resources string:title) , msgTail , '.\' , (resources string:'(TAB to complete; matchPattern allowed):').
box := self
enterBoxForClassWithCodeSelectionTitle:title withCRs
withList:(self class visitedClassNamesHistory)
okText:okText.
box label:boxLabel.
doWhat notNil ifTrue:[
button2 := Button label:(resources string:okText2).
navigationState isFullBrowser "singleClass" ifTrue:[
button3 := Button label:(resources string:okText3)
].
(DialogBox defaultOKButtonAtLeft) ifFalse:[
box addButton:button2 before:(box okButton).
button3 notNil ifTrue:[box addButton:button3 before:button2].
] ifTrue:[
box addButton:button2 after:(box okButton).
button3 notNil ifTrue:[box addButton:button3 after:button2].
].
button2 action:[
doWhat := doWhat2.
box doAccept.
box okPressed.
].
button3 notNil ifTrue:[
button3 action:[
doWhat := doWhat3.
box doAccept.
box okPressed.
].
].
].
allClasses := Smalltalk allClasses asOrderedCollection.
allNames := (allClasses
collect:[:cls |
|ns|
ns := cls topNameSpace name.
ns = 'Smalltalk'
ifTrue:[ ns := '' ]
ifFalse:[ns := ' (in ',ns,')'].
cls nameWithoutNameSpacePrefix,ns
]) sortWith:allClasses.
updateList := [
|nameToSearch list namesStarting namesIncluding lcName|
(nameToSearch := classNameHolder value withoutSeparators) isEmpty ifTrue:[
list := self class visitedClassNamesHistory
] ifFalse:[
lcName := nameToSearch asLowercase.
(lcName includes:'::') ifTrue:[
list := OrderedCollection new.
allClasses doWithIndex:[:cls :idx |
(lcName match:cls name) ifTrue:[
list add:(allNames at:idx)
]
].
] ifFalse:[
(nameToSearch includesMatchCharacters) ifTrue:[
list := allNames select:[:nm | lcName match:nm asLowercase]
] ifFalse:[
namesIncluding := allNames
select:[:nm |
"/ nm asLowercase startsWith:lcName
nm asLowercase includesString:lcName caseSensitive:false
].
namesStarting := namesIncluding select:[:nm | nm asLowercase startsWith:lcName].
list := namesStarting , {nil} , (namesIncluding \ namesStarting).
]
]
].
box listView list:list.
box listView scrollToLine:((list findFirst:[:line | (line ? '') startsWith:lcName]) max:1)
].
classNameHolder := '' asValue.
box enterField
model:classNameHolder;
immediateAccept:true.
classNameHolder onChangeEvaluate:updateList.
box entryCompletionBlock:(DoWhatIMeanSupport classNameEntryCompletionBlock).
box action:[:aString | className := aString].
box extent:(400 @ 350).
box open.
className isNil ifTrue:[^ nil "cancel"].
(className endsWith:$) ) ifTrue:[
className := ((className copyFrom:(className indexOfSubCollection:'(in ')+4)
copyWithoutLast:1)
, '::' , className asCollectionOfWords first
].
doWhat isNil ifTrue:[
aBlock notNil ifTrue:[aBlock value:className].
^ className
].
self withSearchCursorDo:[
aBlock value:className value:singleClass value:doWhat.
].
^ className
"Modified: / 01-12-2010 / 09:50:36 / cg"
!
askForClassToSearch:doWhatByDefault single:singleClass msgTail:msgTail thenDo:aBlock
"common code for both opening a new browser on a class and
to search for a class in this browser.
doWhat is: #newBrowser, #newBuffer or nil.
If singleClass is true, a single class will be asked for and browsed,
otherwise, a match pattern is allowed and a multi-class browser is opened."
^ self
askForClassToSearch:doWhatByDefault
single:singleClass
msgTail:msgTail
resources:resources
thenDo:aBlock
!
findClass:classNameArg single:singleClass in:doWhat
|className brwsr class classes box classNames aliases currentNamespace browseButton|
className := classNameArg.
singleClass ifTrue:[
className includesMatchCharacters ifFalse:[
currentNamespace := self currentNamespace.
aliases := Smalltalk
keysAndValuesSelect:[:nm :val | (nm sameAs:classNameArg) ]
thenCollect:[:nm :val | val isBehavior ifTrue:[val] ifFalse:[val class]].
classes := (self class classesWithNameSimilarTo:className from:currentNamespace) asOrderedCollection.
classes := classes select:[:each | each isRealNameSpace not].
aliases := aliases select:[:eachAlias | (classes includesIdentical:eachAlias) not].
classes addAll:aliases.
class := classes firstIfEmpty:nil.
class isNil ifTrue:[
className := self askForClassNameMatching:className.
"/ ^ self warn:('No such class: ' , className).
] ifFalse:[
classes size == 1 ifTrue:[
className := class name
] ifFalse:[
classNames := classes collect:[:each| (each name?'') , ' (',(each package?'?'),')'].
classNameArg includesMatchCharacters ifFalse:[
classNames := classNames
collect:[:nm |
|idx|
idx := nm asLowercase indexOfSubCollection:classNameArg asLowercase.
idx == 0 ifTrue:[
nm
] ifFalse:[
nm asText emphasizeFrom:idx to:idx+classNameArg size-1 with:#bold
]
]
].
box := self listBoxTitle:('Multiple class with name similar to/containing ''',classNameArg allBold,'''\\Select class to switch to:') withCRs
okText:'OK'
list:classNames "asSortedCollection".
box initialText:(classes first name).
box entryCompletionBlock:(DoWhatIMeanSupport classNameEntryCompletionBlock).
box action:[:aString | className := aString string].
browseButton := Button label:(resources string:'Browse All').
browseButton action:[
self
spawnClassBrowserFor:classes
label:('Classes named like "%1"' bindWith:classNameArg)
in:#newBrowser
select:false.
box hide
].
box addButton:browseButton before:box okButton.
box extent:(400 @ 300).
box open.
className isNil ifTrue:[ "/ cancel
^ nil
].
className := (className upTo:$( ) withoutTrailingSeparators.
].
].
] ifTrue:[
className := self askForClassNameMatching:className.
].
className notNil ifTrue:[
doWhat == #newBrowser ifTrue:[
brwsr := self class new.
brwsr allButOpen.
brwsr switchToClassNamed:className.
brwsr openWindow.
] ifFalse:[
brwsr := self.
doWhat == #newBuffer ifTrue:[
brwsr createBuffer.
] ifFalse:[
"/ self rememberLocationInHistory
].
brwsr switchToClassNamed:className.
].
].
^ self.
].
className includesMatchCharacters ifFalse:[
class := Smalltalk at:className asSymbol.
class isBehavior ifTrue:[
classes := Array with:class
]
] ifTrue:[
classes := Smalltalk allClasses select:[:each | className match:each name].
classes := classes asOrderedCollection.
].
classes size == 0 ifTrue:[
^ self warn:'No className matches'.
].
classes := classes asSet.
classes copy do:[:eachClass |
|owner|
owner := eachClass owningClass.
[owner notNil] whileTrue:[classes add:owner. owner := owner owningClass].
].
classes := classes asOrderedCollection.
doWhat isNil ifTrue:[
"/ select them ...
self immediateUpdate value:true.
self selectedCategories value: (classes collect:[:each | each category]) asSet asOrderedCollection.
self selectedClasses value:classes.
self immediateUpdate value:false.
] ifFalse:[
self spawnClassBrowserFor:classes label:('classes matching ''',className,'''') in:doWhat select:false
]
"Created: / 13-02-2000 / 20:35:30 / cg"
"Modified: / 17-06-2010 / 12:24:21 / cg"
!
findResponseTo:selector
^ self findResponseTo:selector in:#newBuffer
!
findResponseTo:selector in:whereWanted
|where searchClass class mthd currentMethod|
where := whereWanted.
currentMethod := self theSingleSelectedMethod.
searchClass := self theSingleSelectedClass.
searchClass isNil ifTrue:[
searchClass := self classHierarchyTopClass value.
searchClass isNil ifTrue:[
currentMethod notNil ifTrue:[
searchClass := currentMethod mclass
].
].
searchClass isNil ifTrue:[
self information:'No class or method selected (cannot search).'.
^ self
]
].
(currentMethod notNil
and:[currentMethod selector == selector]) ifTrue:[
searchClass := searchClass superclass.
].
"/ search for the implementaion
class := searchClass whichClassIncludesSelector:selector.
class isNil ifTrue:[
searchClass isMeta ifTrue:[
class := searchClass theNonMetaclass whichClassIncludesSelector:selector.
] ifFalse:[
class := searchClass theMetaclass whichClassIncludesSelector:selector.
]
].
"/ cannot switch method in a singleMethod browser ...
(where isNil and:[navigationState isSingleMethodBrowser])
ifTrue:[
where := #newBuffer.
].
class isNil ifTrue:[
self information:'None found'.
] ifFalse:[
mthd := class compiledMethodAt:selector.
where isNil ifTrue:[
self rememberLocationInHistory.
self switchToClass:class selector:selector.
] ifFalse:[
self spawnMethodBrowserFor:(Array with:mthd) in:where
label:(resources string:'Response to %1' with:selector)
]
].
!
searchMenuAddToBookmarks
"bookmark the currently selected method/selector"
|cls mthd sel|
cls := self anySelectedClass.
mthd := self anySelectedMethod.
(mthd notNil and:[cls isNil]) ifTrue:[
cls := mthd mclass
].
mthd notNil ifTrue:[
sel := mthd selector.
self class addToBookMarks:cls selector:sel
] ifFalse:[
self warn:'no method selected'
]
!
searchMenuFindClass
self rememberLocationInHistory.
self searchMenuFindClass:#find "/ do not open new
!
searchMenuFindClass:doWhatByDefault
"common code for both opening a new browser on a class and
to search for a class in this browser.
doWhat is: #newBrowser, #newBuffer or nil"
^ self searchMenuFindClass:doWhatByDefault single:true
!
searchMenuFindClass:doWhatByDefault single:singleClass
"common code for both opening a new browser on a class and
to search for a class in this browser.
doWhat is: #newBrowser, #newBuffer or nil.
If singleClass is true, a single class will be asked for and browsed,
otherwise, a match pattern is allowed and a multi-class browser is opened."
self
askForClassToSearch:doWhatByDefault
single:singleClass
msgTail:''
thenDo:[:className :single :doWhat |
self findClass:className single:singleClass in:doWhat.
]
!
searchMenuFindImplementationOf
self
askForSelector:'Search for implementation of (if sent to selected class):'
allowBuffer:true
allowBrowser:true
thenDo:[:selector :where |
|searchClass class mthd currentMethod|
searchClass := self theSingleSelectedClass.
searchClass isNil ifTrue:[
searchClass := self classHierarchyTopClass value.
searchClass isNil ifTrue:[
self information:'No class selected (cannot search).'.
^ self
]
].
currentMethod := self theSingleSelectedMethod.
(currentMethod notNil
and:[currentMethod selector == selector]) ifTrue:[
searchClass := searchClass superclass.
].
"/ search for the implementaion
class := searchClass whichClassIncludesSelector:selector.
class isNil ifTrue:[
self information:'None found'.
] ifFalse:[
mthd := class compiledMethodAt:selector.
where isNil ifTrue:[
self rememberLocationInHistory.
self switchToClass:class selector:selector.
] ifFalse:[
self spawnMethodBrowserFor:(Array with:mthd) in:where
label:(resources string:'Implementation of %1' with:selector)
]
].
]
!
searchMenuFindMethod
|box matchBlock title entryCompletionBlock b openHow|
title := 'selector to find:\(TAB for completion; matchPattern allowed)'.
box := self
listBoxForCodeSelectionTitle:title withCRs
isSelector:true
okText:'Find'.
box label:(resources string:'find method').
matchBlock :=
[
|searchPattern matchingSelectors|
searchPattern := box contents.
searchPattern includesMatchCharacters ifTrue:[
matchingSelectors := Set new.
Smalltalk allMethodsWithSelectorDo:[:eachMethod :eachSelector |
(searchPattern match:eachSelector) ifTrue:[
matchingSelectors add:eachSelector.
].
].
box list:(matchingSelectors asOrderedCollection sort).
false.
] ifFalse:[
true
]
].
entryCompletionBlock :=
[:contents |
|s what longest matching|
box topView withWaitCursorDo:[
s := contents withoutSpaces.
s includesMatchCharacters ifTrue:[
matchBlock value
] ifFalse:[
what := Smalltalk selectorCompletion:s.
longest := what first.
matching := what last.
box list:matching.
box contents:longest.
matching size ~~ 1 ifTrue:[
self window beep
]
]
]
].
box entryCompletionBlock:entryCompletionBlock.
box acceptCheck:matchBlock.
box extent:(300@300).
openHow := nil.
box addButton:(b := Button label:(resources string:'Add Buffer')).
b action:[
openHow := #newBuffer.
box doAccept.
box okPressed.
].
box addButton:(b := Button label:(resources string:'Browse')).
b action:[
openHow := #newBrowser.
box doAccept.
box okPressed.
].
[:restart |
box
action:[:aString |
|browser|
aString includesMatchCharacters ifFalse:[
openHow == #newBuffer ifTrue:[
browser := self.
browser createBuffer
] ifFalse:[
openHow == #newBrowser ifTrue:[
browser := self browseMenuClone.
] ifFalse:[
(self
askIfModified:'Code was modified.\\Switch to that method anyway ?'
default:false
withAccept:false
withCompare:true) ifTrue:[
browser := self.
].
]
].
browser notNil ifTrue:[
browser switchToAnyMethod:aString string.
]
] ifTrue:[
restart value
]
].
box contents size > 0 ifTrue:[
entryCompletionBlock value:(box contents).
].
box showAtPointer.
] valueWithRestart
!
searchMenuFindResponseTo
self
askForSelector:'Search for implementation of (if sent to selected class):'
allowBuffer:true
allowBrowser:true
thenDo:[:selector :whereWanted |
self findResponseTo:selector in:whereWanted
]
!
searchMenuRemoveFromBookmarks
"remove the currently selected method/selector"
|cls mthd sel meta|
BookMarks size == 0 ifTrue:[^ self].
cls := self anySelectedClass.
mthd := self anySelectedMethod.
(mthd notNil and:[cls isNil]) ifTrue:[
cls := mthd mclass
].
mthd notNil ifTrue:[
sel := mthd selector.
meta := cls isMetaclass.
cls := cls theNonMetaclass.
BookMarks := BookMarks
select:[:each |
meta ~~ each meta
or:[each className ~= cls name
or:[each selector ~= sel]]
].
] ifFalse:[
self warn:'no method selected'
]
! !
!NewSystemBrowser methodsFor:'menu actions-selector'!
askForClassToMoveOrCopy:doWhat
|newClass newClassName sup initial m
supers subs list currentClass reqString okLabel title|
"/ provide a reasonable default in the pull-down-list
currentClass := self anySelectedClass.
currentClass isNil ifTrue:[
m := self anySelectedMethod.
currentClass := m mclass.
].
LastMethodMoveOrCopyTargetClass notNil ifTrue:[
initial := Smalltalk classNamed:LastMethodMoveOrCopyTargetClass.
initial notNil ifTrue:[
(currentClass notNil and:[currentClass theNonMetaclass name = initial name]) ifTrue:[
initial := nil
]
].
initial notNil ifTrue:[
currentClass isMeta ifTrue:[
initial := initial theMetaclass
] ifFalse:[
initial := initial theNonMetaclass
].
initial := initial name.
].
].
initial isNil ifTrue:[
(sup := currentClass superclass) notNil ifTrue:[
initial := sup name
] ifFalse:[
initial := nil.
].
].
supers := currentClass allSuperclasses reverse.
currentClass isMeta ifTrue:[
supers := supers select:[:each | each isSubclassOf:Class].
].
supers := supers collect:[:cls | cls name].
subs := (currentClass allSubclasses collect:[:cls | cls name]).
list := OrderedCollection withAll:supers.
(supers notEmpty and:[subs notEmpty]) ifTrue:[
list add:'---- '; add:currentClass name; add:' ----'
].
list addAll:(subs sort).
doWhat == #copy ifTrue:[
reqString := 'Copy selected method(s) to which class ?\(enter ''Foo class'' to copy to Metaclass)'.
okLabel := 'Copy'.
title := 'Copy method(s)'.
] ifFalse:[
okLabel := 'Move'.
title := 'Move method(s)'.
doWhat == #move ifTrue:[
reqString := 'Move selected method(s) to which class ?\(enter ''Foo class'' to move to Metaclass)'.
] ifFalse:[
doWhat == #moveAndForward ifTrue:[
reqString := 'Move selected method(s) to which class ?'.
] ifFalse:[
self error:'unknown aspect: ', doWhat printString.
].
].
].
newClassName := Dialog
request:(resources string:reqString) withCRs
initialAnswer:(initial ? '')
okLabel:(resources string:okLabel)
title:(resources string:title)
onCancel:nil
list:list
entryCompletionBlock:(DoWhatIMeanSupport classNameEntryCompletionBlock).
newClassName isNil ifTrue:[^ nil].
(newClassName startsWith:'---- ') ifTrue:[^ nil].
newClass := self classIfValidNonMetaClassName:newClassName.
newClass isNil ifTrue:[
^ nil
].
LastMethodMoveOrCopyTargetClass := newClass theNonMetaclass name.
^ newClass.
"Modified: / 22.12.2001 / 03:04:48 / cg"
!
copyMethods:methods toClass:newClass
"copy some methods to some other class - typically a sister class"
self moveOrCopyMethods:methods toClass:newClass moveOrCopy:#copy
!
doCompareMethod:m1 against:m2 label:label
"compare two methods"
|source1 source2 v m1Class m2Class|
source1 := m1 source string.
source1 isNil ifTrue:[
self warn:'Oops - methods source is gone. Cannot compare source.'.
^ self
].
source2 := m2 source string.
source2 isNil ifTrue:[
self warn:'Oops - methods source is gone. Cannot compare source.'.
^ self
].
m1Class := m1 mclass.
m2Class := m2 mclass.
v := DiffCodeView
openOn:source1
label:(m1Class name , ' ' , (m1 printStringForBrowserWithSelector:m1 selector inClass:m1Class))
and:source2
label:(m2Class name , ' ' , (m2 printStringForBrowserWithSelector:m2 selector inClass:m2Class)).
v label:label.
v waitUntilVisible.
^ self
!
doCompareMethodsWithRepository:methods
"open a diff-textView comparing the current (in-image) versions
with the the newest versions found in the repository.
That is the most recent version."
|s aStream comparedSource currentSource thisRevString
current repositoryChangeSet diffs allDiffs
mclass mselector theNonMetaclass lastClass lastRepositoryChangeSet
isExtension title labelA labelB|
self withWaitCursorDo:[
Method flushSourceStreamCache.
methods do:[:eachMethod |
|classPackage methodPackage|
mclass := eachMethod mclass.
mclass isNil ifTrue:[
self warn:('Cannot find methods class (obsolete).').
] ifFalse:[
classPackage := mclass package.
methodPackage := eachMethod package.
(classPackage == methodPackage or:[ methodPackage == PackageId noProjectID ]) ifTrue:[
theNonMetaclass := mclass theNonMetaclass.
isExtension := false.
] ifFalse:[
isExtension := true.
].
mselector := eachMethod selector.
currentSource := eachMethod source asString.
current := ChangeSet new.
current addMethodChange:eachMethod in:mclass.
self busyLabel:'getting repository source...' with:nil.
isExtension ifTrue:[
repositoryChangeSet := SourceCodeManagerUtilities
changeSetForExtensionMethodsForPackage:methodPackage
askForRevision:false
using:SourceCodeManager.
repositoryChangeSet := repositoryChangeSet
select:[:eachChange | eachChange isMethodChange
and:[eachChange selector = mselector
and:[eachChange className = mclass name]]].
lastClass := nil.
] ifFalse:[
(lastClass ~~ theNonMetaclass) ifTrue:[
aStream := self sourceStreamForRepositorySourceOfClass:theNonMetaclass.
aStream notNil ifTrue:[
aStream class readErrorSignal handle:[:ex |
self warn:('read error while reading extracted source\\' , ex description) withCRs.
aStream close.
comparedSource := nil.
] do:[
comparedSource := aStream contents asString.
].
aStream close.
thisRevString := theNonMetaclass revision.
thisRevString isNil ifTrue:[
thisRevString := 'no revision'
].
lastRepositoryChangeSet := ChangeSet fromStream:(s := comparedSource readStream). s close.
lastClass := theNonMetaclass.
self busyLabel:'comparing...' with:nil.
].
].
repositoryChangeSet := lastRepositoryChangeSet
select:[:eachChange | eachChange isMethodChange
and:[eachChange selector = mselector
and:[eachChange className = mclass name]]].
].
diffs := repositoryChangeSet diffSetsAgainst:current.
allDiffs isNil ifTrue:[
allDiffs := diffs.
] ifFalse:[
allDiffs changed addAll:(diffs changed).
allDiffs onlyInArg addAll:(diffs onlyInArg).
allDiffs onlyInReceiver addAll:(diffs onlyInReceiver).
].
].
].
].
(allDiffs isNil or:[allDiffs isEmpty]) ifTrue:[
(methods
contains:[:m |
ChangeSet current includesChangeForClass:m mclass selector:m selector
]
) ifTrue:[
(self confirm:'Versions are identical.\\Remove entries from changeSet ?' withCRs)
ifTrue:[
methods do:[:m |
ChangeSet current condenseChangesForClass:m mclass selector:m selector.
].
].
] ifFalse:[
self information:'Versions are identical.'.
].
^ self.
].
title := methods size == 1
ifTrue:['Difference of %1' bindWith:methods first whoString]
ifFalse:['Differences of %1 classes' bindWith:methods size].
labelA := 'Repository'.
labelB := 'Image'.
(methods collect:[:m | m mclass theNonMetaclass]) asSet size == 1 ifTrue:[
"/ all methods of the same class
(methods collect:[:m | m package]) asSet size == 1 ifTrue:[
"/ all methods from the same package (source container)
labelA := 'Repository (%1)' bindWith:(thisRevString ? '?').
labelB := 'Image (based on %1)' bindWith:(methods first mclass theNonMetaclass revision).
].
].
VersionDiffBrowser
openOnDiffSet:allDiffs
labelA:labelA
labelB:labelB
title:title.
self normalLabel.
"Created: / 04-01-1997 / 15:48:20 / cg"
"Modified: / 07-05-2010 / 10:33:10 / cg"
!
doMoveSelectedMethodsToProject:newProject
self moveMethods:(self selectedMethods value) toProject:newProject
!
doRemoveMethodsConfirmed:methodsToRemove
"confirm removal of the selected methods (but does not search for senders),
then remove them"
|classes methods numClasses numMethods msg numVersionMethods firstClassName|
"/ count them ...
classes := IdentitySet new.
methods := IdentitySet new.
numVersionMethods := 0.
methodsToRemove do:[:eachMethod |
classes add:(eachMethod mclass).
methods add:eachMethod.
(AbstractSourceCodeManager isVersionMethodSelector:eachMethod selector) ifTrue:[
eachMethod mclass isMeta ifTrue:[
numVersionMethods := numVersionMethods + 1
]
]
].
numClasses := classes size.
numMethods := methodsToRemove value size.
numMethods == 0 ifTrue:[^ self].
numMethods == 1 ifTrue:[
msg := 'Really remove ''%3'' from ''%4'' ?'.
] ifFalse:[
(methods collect:[:m | m selector]) size == 1 ifTrue:[
msg := 'Really remove ''%3'''.
] ifFalse:[
msg := 'Really remove %1 methods'.
].
numClasses > 1 ifTrue:[
msg := msg , ' from %2 classes'
] ifFalse:[
msg := msg , ' from ''%4'''
].
msg := msg , ' ?'
].
classes notEmpty ifTrue:[
firstClassName := classes first name
] ifFalse:[
firstClassName := '???'
].
msg := resources
string:msg
with:numMethods printString
with:numClasses printString
with:(methods first selector ? '?') allBold
with:firstClassName allBold.
numVersionMethods > 0 ifTrue:[
msg := msg , '\\' ,
(resources
string:'ATTENTION: Removing a classes version method might make the versionManagers life hard.' allBold).
(OptionBox
request:msg withCRs
label:(resources string:'Attention')
image:(WarningBox iconBitmap)
buttonLabels:(resources array:#('Cancel' 'Remove'))
values:#(false true)
default:false
onCancel:false) ifFalse:[^ self].
] ifFalse:[
(self confirm:msg withCRs) ifFalse:[^ self].
].
classes := methods := nil.
"/ then, remove them
self withWaitCursorDo:[
self doRemoveSelectedMethodsUnconfirmed.
]
!
doRemoveMethodsUnconfirmed:methods
"remove selected methods without asking questions"
|numMethods mthd change|
numMethods := methods size.
numMethods == 0 ifTrue:[^ self].
(self canUseRefactoringSupport) ifTrue:[
numMethods > 1 ifTrue:[
change := CompositeRefactoryChange named:('Remove ', numMethods printString , ' methods').
methods do:[:eachMethod |
change removeMethod:(eachMethod selector) from:(eachMethod mclass)
].
] ifFalse:[
mthd := methods first.
change := RemoveMethodChange remove:(mthd selector) from:(mthd mclass)
].
RefactoryChangeManager performChange: change
] ifFalse:[
methods do:[:eachMethod |
(eachMethod mclass) removeSelector:(eachMethod selector).
].
]
!
doRemoveSelectedMethodsUnconfirmed
"remove selected methods without asking questions"
self doRemoveMethodsUnconfirmed:self selectedMethods value copy
!
fileOutMethods:aCollectionOfMethods format:formatSymbolOrNil fileNameTemplate:nameOrNil boxTitle:boxTitleOrNil
"fileOut a bunch of methods;
used both from fileOutMethod-list and fileOut-selected methods."
|saveName stillAsking suffix defaultName|
suffix := self fileSuffixForFormat:formatSymbolOrNil.
defaultName := (nameOrNil ? 'some_methods') , '.' , suffix.
stillAsking := true.
[stillAsking] whileTrue:[
saveName := self
fileNameDialogForFileOut:(resources string:(boxTitleOrNil ? 'FileOut methods as:'))
default:defaultName.
saveName isNil ifTrue:[
^ self
].
saveName isEmpty ifTrue:[ "/ can no longer happen ...
(self confirm:'Bad name given - try again ?') ifFalse:[
^ self.
].
stillAsking := true.
] ifFalse:[
FileSelectionBox lastFileSelectionDirectory:(saveName asFilename directoryName).
stillAsking := false.
].
].
self busyLabel:'saving...'.
self fileOutMethods:aCollectionOfMethods format:formatSymbolOrNil toFile:saveName withPackage:false.
!
fileOutMethods:aCollectionOfMethods format:formatSymbolOrNil toFile:aFilename withPackage:withPackage
"fileOut a bunch of methods;
used both from fileOutMethod-list and fileOut-selected methods."
|aStream fileName lastPackage|
self busyLabel:'saving...'.
Class fileOutErrorSignal
handle:[:ex |
self warn:'Cannot fileOut\(%2)' with:ex description.
self normalLabel.
ex return.
] do:[
formatSymbolOrNil == #sif ifTrue:[
(SmalltalkInterchangeFileManager newForFileOut)
fileName:aFilename;
addMethods:aCollectionOfMethods;
fileOut
] ifFalse:[
fileName := aFilename asFilename.
"
if file exists, save original in a .sav file
"
fileName exists ifTrue:[
fileName copyTo:(fileName withSuffix:'sav')
].
[
aStream := fileName newReadWriteStream.
] on:FileStream openErrorSignal do:[:ex|
^ self warn:('Cannot create file:', fileName name)
].
(formatSymbolOrNil ~~ #xml
and:[formatSymbolOrNil ~~ #binary]) ifTrue:[
aStream := EncodedStream stream:aStream encoder:(CharacterEncoder encoderForUTF8).
aStream nextPutLine:'"{ Encoding: utf8 }" !!'.
].
aCollectionOfMethods do:[:aMethod |
formatSymbolOrNil == #xml ifTrue:[
aMethod mclass fileOutXMLMethod:aMethod on:aStream
] ifFalse:[
formatSymbolOrNil == #binary ifTrue:[
self shouldImplement. "unimplemented: binary fileout"
"/ aClass binaryFileOutOn:(saveName asFilename writeStream binary)
] ifFalse:[
withPackage ifTrue:[
lastPackage ~= aMethod package ifTrue:[
lastPackage := aMethod package.
aStream nextPutAll:('"{ Package: ''%1'' }" !!\\' bindWith:(lastPackage)) withCRs.
].
].
aMethod mclass fileOutMethod:aMethod on:aStream.
aStream cr.
]
]
].
aStream close
]
].
self normalLabel
!
methodTemplate
"return a method definition template string or nil"
|classes cls|
cls := self theSingleSelectedClass.
cls isNil ifTrue:[
classes := self selectedClasses value.
classes notEmptyOrNil ifTrue:[
cls := classes first.
]
].
cls notNil ifTrue:[
^ cls programmingLanguage methodTemplate
].
^ SystemBrowser methodTemplate
!
methodsPreviousVersionCode
"return the methods previous versions code"
|m|
m := self theSingleSelectedMethod.
m isNil ifTrue:[^ nil].
^ m previousVersionCode.
!
methodsPreviousVersions
"return a collection of the selected methods previous versions"
|m|
m := self theSingleSelectedMethod.
m isNil ifTrue:[^ #()].
^ m previousVersions.
!
moveMethods:methods toClass:newClass
"move some methods to some other class - typically a sister class"
self moveOrCopyMethods:methods toClass:newClass moveOrCopy:#move
!
moveMethods:methods toProject:newProject
|classesChanged numMethods change|
classesChanged := IdentitySet new.
numMethods := methods size.
(self canUseRefactoringSupport and:[numMethods > 1]) ifTrue:[
change := CompositeRefactoryChange named:('Move ', numMethods printString , ' methods to project ' , newProject).
methods do:[:eachMethod |
|mClass|
mClass := eachMethod mclass.
change
changeProjectOf:(eachMethod selector)
in:mClass
to:newProject.
].
RefactoryChangeManager performChange: change.
] ifFalse:[
methods do:[:eachMethod |
|mClass|
mClass := eachMethod mclass.
self canUseRefactoringSupport ifTrue:[
change := RefactoryMethodProjectChange
changeProjectOf:(eachMethod selector)
in:mClass
to:newProject.
RefactoryChangeManager performChange: change.
] ifFalse:[
eachMethod package:newProject.
].
classesChanged add:eachMethod mclass.
].
].
self rememberLastProjectMoveTo:newProject.
classesChanged do:[:eachClass |
eachClass changed:#projectOrganization.
Smalltalk changed:#projectOrganization with:(Array with:eachClass theNonMetaclass with:(methods select:[:m | m mclass == eachClass])).
].
"Created: / 17-02-2000 / 23:04:45 / cg"
"Modified: / 23-11-2006 / 17:02:10 / cg"
!
moveMethods:methods toProtocol:newCategory
"move some methods to some other category"
|change numMethods|
newCategory isNil ifTrue:[^ self].
lastMethodCategory := newCategory.
numMethods := methods size.
(self canUseRefactoringSupport and:[numMethods > 1]) ifTrue:[
change := CompositeRefactoryChange named:('Change category of ', numMethods printString , ' methods').
methods do:[:eachMethod |
|mClass|
mClass := eachMethod mclass.
change
changeCategoryOf:(eachMethod selector)
in:mClass
to:newCategory.
].
RefactoryChangeManager performChange: change.
] ifFalse:[
methods do:[:mthd |
|mClass|
mClass := mthd mclass.
(self canUseRefactoringSupport) ifTrue:[
change := RefactoryMethodCategoryChange
changeCategoryOf:(mthd selector)
in:mClass
to:newCategory.
RefactoryChangeManager performChange: change.
] ifFalse:[
mthd category:newCategory.
].
].
].
"Modified: / 23-11-2006 / 17:00:01 / cg"
!
moveMethodsWithForwarding:methods toClass:newClass
"move some methods to some other class"
self moveOrCopyMethods:methods toClass:newClass moveOrCopy:#moveAndForward
!
moveOrCopyMethods:methods toClass:newClass moveOrCopy:doWhat
"move or copy some methods to some other class - typically a sister class"
|canUseRefactoringSupport changes nm newClassName|
canUseRefactoringSupport := self canUseRefactoringSupport.
canUseRefactoringSupport ifTrue:[
nm := (doWhat == #copy)
ifTrue:['Copy %1 to %2']
ifFalse:[
(doWhat == #moveAndForward)
ifTrue:['Move with Forwarding %1 to %2']
ifFalse:['Move %1 to %2']].
nm := nm bindWith:(methods size == 1 ifTrue:[methods first whoString] ifFalse:[methods size printString , ' methods'])
with:newClass name.
changes := CompositeRefactoryChange named:nm.
].
methods copy do:[:methodToCopyOrMove |
|question msg selectorToCopyOrMove
category source dontDoIt newMethod oldClass
template|
dontDoIt := false.
selectorToCopyOrMove := methodToCopyOrMove selector.
(newClass includesSelector:selectorToCopyOrMove) ifTrue:[
question := (doWhat == #copy)
ifTrue:['%1 already implements #%2\\Copy anyway ?']
ifFalse:['%1 already implements #%2\\Move anyway ?'].
(self confirm:(resources string:question
with:newClass name allBold
with:selectorToCopyOrMove) withCRs) ifFalse:[
dontDoIt := true
]
] ifFalse:[
"/ confirm copy/move of the version method (to avoid confusing the repository)
((AbstractSourceCodeManager isVersionMethodSelector:selectorToCopyOrMove) and:[newClass isMeta]) ifTrue:[
question := (doWhat == #copy)
ifTrue:['Copying the version method might confuse the repository.\\Copy anyway ?']
ifFalse:['Moving the version method might confuse the repository.\\Move anyway ?'].
(self confirm:(resources string:question) withCRs) ifFalse:[
dontDoIt := true
]
].
].
dontDoIt ifFalse:[
source := methodToCopyOrMove source.
category := methodToCopyOrMove category.
lastMethodMoveClass := newClass name.
canUseRefactoringSupport ifTrue:[
changes
compile:source
in:newClass
classified:category.
newMethod := #dummy. "/ to make following if happy
] ifFalse:[
newMethod := newClass
compile:source
classified:category.
].
(newMethod isNil or:[newMethod == #Error]) ifTrue:[
msg := (doWhat == #copy)
ifTrue:['#%1 not copied - compilation failed due to an error']
ifFalse:['#%1 not moved - compilation failed due to an error'].
self warn:(resources string:msg with:selectorToCopyOrMove)
] ifFalse:[
oldClass := methodToCopyOrMove mclass.
(doWhat == #copy) ifFalse:[
canUseRefactoringSupport ifTrue:[
changes removeMethod: selectorToCopyOrMove from:oldClass
] ifFalse:[
oldClass removeSelector:selectorToCopyOrMove.
].
(doWhat == #moveAndForward) ifTrue:[
template := Parser methodSpecificationForSelector:selectorToCopyOrMove.
newClass == oldClass class ifTrue:[
newClassName := 'self class'.
] ifFalse:[
newClass nameSpace = oldClass nameSpace ifTrue:[
newClassName := newClass theNonMetaclass nameWithoutNameSpacePrefix.
] ifFalse:[
newClassName := newClass theNonMetaclass name
].
].
source := template , '
^ ' , newClassName , ' ' , template , '
'.
canUseRefactoringSupport ifTrue:[
changes
compile:source
in:oldClass
classified:category.
] ifFalse:[
oldClass
compile:source
classified:category.
].
]
]
]
]
].
canUseRefactoringSupport ifTrue:[
RefactoryChangeManager performChange: changes
].
!
renameMethod:oldSelector in:aClass
|newSelector tree dialog args newArgs map refactoring rslt
renameSelectedMethodsOnly renameOnly rewriteLocalSendersOnly
affectedClasses classesOfSelectedMethods suggestion|
RBParser isNil ifTrue:[
Dialog warn:'Missing class: RBParser'.
^ self
].
RBParser autoload.
MethodNameDialog isNil ifTrue:[
Dialog warn:'Missing class: MethodNameDialog'.
^ self
].
MethodNameDialog autoload.
tree := aClass parseTreeFor:oldSelector.
tree isNil ifTrue:[
self warn: 'Could not parse the method'.
^ self
].
args := tree argumentNames.
suggestion := DoWhatIMeanSupport goodRenameDefaultFor:oldSelector lastOld:LastRenamedOld lastNew:LastRenamedNew.
dialog := MethodNameDialog methodNameFor: args initial:(suggestion ? oldSelector).
dialog cancelAllVisible value:(AbortAllOperationRequest isHandled).
dialog renameOnlyVisible value:true.
dialog renameSelectedMethodsOnlyVisible value:true.
dialog rewriteLocalMethodsOnlyFlagHolder value:true.
dialog allButOpen.
dialog window label:(resources string:'Rename "%1" to' with:oldSelector).
dialog openWindow.
dialog accepted ifFalse: [^ self].
newArgs := dialog arguments asOrderedCollection.
map := Array new: args size.
1 to: args size do: [:i | map at: i put: (newArgs indexOf: (args at: i))].
newSelector := dialog methodName.
newSelector = oldSelector ifTrue:[
newArgs = args ifTrue:[
Dialog information:'no change'.
^ self.
].
].
LastRenamedOld := oldSelector.
LastRenamedNew := newSelector.
renameSelectedMethodsOnly := dialog isRenameSelectedMethodsOnly.
renameOnly := dialog isRenameOnly.
rewriteLocalSendersOnly := dialog isRewritingLocalSendersOnly.
refactoring := RenameMethodRefactoring
renameMethod: oldSelector
in: aClass
to: newSelector
permuation: map.
refactoring suppressRewriteOfSenders:renameOnly.
renameOnly ifFalse:[
affectedClasses := rewriteLocalSendersOnly
ifTrue:[ Smalltalk allClasses ]
ifFalse:[ aClass withAllSubclasses ].
"/ ask if so many methods should be rewritten; give chance to cancel
(self findSendersOf:oldSelector in:affectedClasses andConfirmRefactoring:refactoring) ifFalse:[ ^ self ].
].
renameSelectedMethodsOnly ifTrue:[
(self selectedMethods value collect:[:m | m selector]) asSet size == 1 ifFalse:[
Dialog warn:'Multiple different selectors selected'.
^ self.
].
classesOfSelectedMethods := self selectedMethods value collect:[:m|m mclass].
"/ classesOfSelectedMethods := classesOfSelectedMethods
"/ collect:[:cls |
"/ |className rbClass|
"/
"/ className := cls theNonMetaclass name.
"/ cls isMeta
"/ ifTrue:[rbClass := RBMetaclass existingNamed: className]
"/ ifFalse:[rbClass := RBClass existingNamed: className].
"/ rbClass model:(RBNamespace new).
"/ rbClass
"/ ].
refactoring onlyRenameTheseImplementors:classesOfSelectedMethods.
].
self withWaitCursorDo:[
|classesOfSelectedMethods affectedImplementors|
"/ refactoring model name:('rename %1 to %2' bindWith:oldSelector storeString with:newSelector storeString).
rslt := self performRefactoring:refactoring.
self switchToSelector:newSelector asSymbol.
]
"Modified: / 28-02-2007 / 21:24:09 / cg"
!
selectVariableForMoveMethod
self halt:'not yet needed'.
^ nil.
"/ | mthd mClass parseTree nameList ignoreList |
"/
"/ mthd := self theSingleSelectedMethod.
"/ mClass := mthd mclass.
"/
"/ parseTree := mClass parseTreeFor:mthd selector.
"/ parseTree isNil ifTrue: [^self warn: 'Could not parse sources'].
"/
"/ nameList := OrderedCollection new.
"/ nameList
"/ add: '---- Arguments ----';
"/ addAll: parseTree argumentNames asSortedCollection;
"/ add: '---- Instance Variables ----'.
"/
"/ ignoreList := OrderedCollection with: 1 with: nameList size.
"/ nameList addAll: mClass allInstVarNames asSortedCollection.
"/
"/ ^ self
"/ choose: 'Select variable to move method into:'
"/ fromList: nameList
"/ values: nameList
"/ ignore: ignoreList
"/ initialSelection: nil
"/ lines: 8
"/ cancel: [nil]
!
selectorMenuAddParameter
self codeMenuAddParameter
!
selectorMenuBackToPrevious
"show the methods previous version in the codeView (to be accepted)"
|m previousCode|
m := self theSingleSelectedMethod.
previousCode := self methodsPreviousVersionCode.
previousCode isNil ifTrue:[
self information:'Oops - no previous code found'.
^ self
].
self showCode:previousCode scrollToTop:false.
self codeView modified:true.
self startSyntaxHighlightProcess.
!
selectorMenuBrowsePreviousVersions
"show old versions"
|m previousMethods dummyChangeSet browser|
m := self theSingleSelectedMethod.
previousMethods := self methodsPreviousVersions.
previousMethods isEmpty ifTrue:[
self information:'Oops - no previous versions found'.
^ self
].
dummyChangeSet := ChangeSet new addAll:previousMethods.
dummyChangeSet reverse. "/ youngest first.
browser := ChangeSetBrowser openOn:dummyChangeSet.
browser readOnly:true.
!
selectorMenuBrowseRepositoryVersions
|method mclass mselector className mgr revisions previousMethods browser
lastSource currentSource lastRevision lastDate lastChange thisIsAnExtensionMethod
packageId directory module|
method := self theSingleSelectedMethod.
method isNil ifTrue:[^ self].
mclass := method mclass.
mselector := method selector.
className := mclass name.
[
|set|
set := ChangeSet forExistingMethods:(Array with:method).
set := set select:[:c | c isMethodChange].
lastChange := set first.
] value.
thisIsAnExtensionMethod := (method package ~= mclass package).
thisIsAnExtensionMethod ifTrue:[
packageId := method package asPackageId.
mgr := packageId projectDefinitionClass sourceCodeManager.
] ifFalse:[
packageId := mclass package asPackageId.
"/ mgr := packageId projectDefinitionClass sourceCodeManager.
mgr := SourceCodeManagerUtilities sourceCodeManagerFor:mclass.
self assert:(mgr = packageId projectDefinitionClass sourceCodeManager).
].
directory := packageId directory.
module := packageId module.
self withWaitCursorDo:[
|revisionLog start stop answer t tS list msg first|
thisIsAnExtensionMethod ifTrue:[
revisionLog := mgr
revisionLogOf:nil
fromRevision:nil
toRevision:nil
numberOfRevisions:nil
fileName:'extensions.st'
directory:directory
module:module.
] ifFalse:[
revisionLog := mgr revisionLogOf:mclass.
].
revisions := revisionLog at:#revisions.
start := 1.
stop := revisions size.
stop > 20 ifTrue:[
thisIsAnExtensionMethod ifTrue:[
t := 500. "/ fake time
] ifFalse:[
"/ measure the time it takes to checkout a version...
t := Time millisecondsToRun:[
|revSourceStream|
revSourceStream := mgr getSourceStreamFor:mclass revision:((revisions at:10) at:#revision).
ChangeSet fromStream:revSourceStream.
revSourceStream close.
].
].
list := revisions collect:[:entry |
|rev author dateString date msg|
rev := entry at:#revision.
author := entry at:#author.
dateString := entry at:#date.
date := Timestamp readGeneralizedFrom:dateString.
dateString := date printStringFormat:'%(year)-%(mon)-%(day) %h:%m:%s'.
entry at:#date put:dateString.
msg := (entry at:#logMessage) asStringCollection first asString.
rev,' ',author,' ',dateString,' ',msg
].
msg := 'There are %1 revisions to extract from the repository'.
t := (t * revisions size / 1000) rounded.
t < 10 ifTrue:[
msg := msg,'\(this will take a few seconds).'.
tS := t.
] ifFalse:[
t := t * revisions size // 1000 // 10 * 10.
tS := (TimeDuration fromSeconds:t) printStringForApproximation.
msg := msg,'\(this will take roughly %2).'
].
msg := msg,'\\Do you want to see all or only some of the revisions ?'.
answer := Dialog
choose:(resources stringWithCRs:msg
with:revisions size
with:tS)
fromList:list values:revisions initialSelection:nil
buttons:nil
values:nil
default:nil
lines:20
cancel:[^ self]
multiple:false
title:(resources string:'Confirmation')
postBuildBlock:[:dialog |
|b|
b := Button label:(resources string:'Browse Newer than Selected').
b action:[ stop := (dialog componentAt:#ListView) selection. dialog okPressed].
b := dialog addButton:b before:dialog okButton.
dialog okButton label:(resources string:'Browse All').
dialog okButton action:[ stop := revisions size. dialog okPressed].
].
stop isNil ifTrue:[^ self ].
].
t := Time millisecondsToRun:[
previousMethods := ChangeSet new.
lastSource := currentSource := method source.
lastRevision := lastDate := nil.
first := true.
revisions from:start to:stop do:[:eachLogEntry |
|revision date revSourceStream|
revision := eachLogEntry at:#revision.
date := eachLogEntry at:#date.
[
|chg nChg classChangeSet changeSource changeName|
self activityNotification:('Fetching revision ',revision,'...').
thisIsAnExtensionMethod ifTrue:[
revSourceStream := mgr
streamForClass:nil
fileName:'extensions.st'
revision:revision
directory:directory
module:module
cache:true.
] ifFalse:[
revSourceStream := mgr getSourceStreamFor:mclass revision:revision.
].
classChangeSet := ChangeSet fromStream:revSourceStream.
chg := classChangeSet
detect:[:chg | chg isMethodChange
and:[chg selector = mselector
and:[chg className = className]]]
ifNone:nil.
chg isNil ifTrue:[
"the method was created in the next version (previous one processed)"
] ifFalse:[
changeSource := chg source.
].
((changeSource isNil and:[lastSource isNil])
or:[ changeSource asString = lastSource asString ]) ifTrue:[
] ifFalse:[
lastChange isNil ifTrue:[
"/ mhm - was not in the previous version
] ifFalse:[
nChg := lastChange asNamedMethodChange
].
lastRevision isNil ifTrue:[
(stop = revisions size) ifTrue:[
changeName := 'current (not in the repository)'.
] ifFalse:[
"/ not showing all - dont really know
changeName := 'current'.
].
] ifFalse:[
changeName := lastRevision,' [',lastDate,']'.
first ifTrue:[
changeName := changeName,' (= current)'.
]
].
nChg notNil ifTrue:[
nChg changeName:changeName.
previousMethods add:nChg.
].
lastSource := changeSource.
lastChange := chg.
first := false.
].
lastRevision := revision.
lastDate := date.
] ensure:[
revSourceStream notNil ifTrue:[revSourceStream close].
].
].
].
"/ Transcript showCR:('it took %1 seconds' bindWith:(t /1000)printString).
self activityNotification:nil.
browser := ChangeSetBrowser openOn:previousMethods.
browser window label:('Revisions of ' , mclass name , ' ' , mselector).
browser readOnly:true.
].
"Modified: / 12-09-2006 / 14:23:24 / cg"
!
selectorMenuChangePrivacyTo:privacySymbol
self selectedMethodsDo:[:eachMethod |
(eachMethod privacy ~~ privacySymbol) ifTrue:[
eachMethod privacy:privacySymbol.
]
].
"Modified: / 23-11-2006 / 17:03:39 / cg"
!
selectorMenuCheckInProjectExtensions
|projects|
projects := ((self selectedMethods value) collect:[:each | each package]) asSet.
projects do:[:packageToCheckIn |
self
projectMenuCheckInProject:packageToCheckIn
classes:false
extensions:true
buildSupport:false
].
!
selectorMenuCleanUpChangeSet
"remove all changes for the selected method(s) from the changeSet"
(self confirm:'This will remove all changes for the selected method(s) from the changeSet.\\Really cleanup ?' withCRs)
ifFalse:[ ^ self].
self withWaitCursorDo:[
self selectedMethods value do:[:eachMethod |
ChangeSet current condenseChangesForClass:eachMethod mclass selector:eachMethod selector
]
]
"Created: / 06-10-2006 / 16:36:44 / cg"
!
selectorMenuCompareAgainstNewestInRepository
"open a diff-textView comparing the current (in-image) version
with the the newest version found in the repository.
That is the most recent version."
self doCompareMethodsWithRepository:(self selectedMethods value).
!
selectorMenuCompareClassAgainstNewestInRepository
"open a diff-textView comparing the current (in-image) version of the class(es)
with the the newest version found in the repository.
That is the most recent version."
|classes|
classes := (self selectedMethods value collect:[:m | m mclass theNonMetaclass]) asSet.
self doCompareClassesWithRepository:classes.
"Created: / 13-10-2006 / 11:40:23 / cg"
!
selectorMenuCompareTwoSelectedMethods
"compare the two selected methods"
|selectedMethods|
selectedMethods := self selectedMethods value.
self
doCompareMethod:(selectedMethods first)
against:(selectedMethods second)
label:(resources string:'Comparing methods')
!
selectorMenuCompareWithInherited
"compare the selected method against the inherited"
|m1 m2|
m1 := self selectedMethods value first.
m2 := m1 mclass superclass lookupMethodFor:(m1 selector).
self
doCompareMethod:m1
against:m2
label:(resources string:'Comparing against inherited')
!
selectorMenuCompareWithMethod
"compare the codeViews contents against the methods actual code"
self doCompareIn:self navigationState.
!
selectorMenuCompareWithPreviousVersion
"compare the codeViews contents against the methods previous version"
|m previousCode v|
m := self theSingleSelectedMethod.
previousCode := self methodsPreviousVersionCode.
previousCode isNil ifTrue:[
self information:'Oops - no previous code found'.
^ self
].
self withWaitCursorDo:[
v := DiffCodeView
openOn:previousCode
label:'previous version'
and:m source
label:'current version'.
v label:(resources string:'comparing method').
v waitUntilVisible.
].
^ self
!
selectorMenuCompareWithSmallTeamVersionOnHost:hostName
"compare the codeViews contents against a SmallTeam version"
self selectedMethods value do:[:eachMethod |
|v changeList change|
changeList := SmallTeam changesOnHost:hostName.
change := changeList
detectLast:[:change |
change changeClass == eachMethod mclass
and:[ change selector == eachMethod selector ] ]
ifNone:nil.
change notNil ifTrue:[
v := DiffCodeView
openOn:(change source)
label:'Version on ',hostName
and:eachMethod source
label:'Your Version'.
v label:(resources string:'Comparing method').
].
].
"Created: / 11-11-2006 / 15:15:26 / cg"
"Modified: / 12-11-2006 / 15:50:02 / cg"
!
selectorMenuCompileWithSTC
"compile the current method to machine code via the stc compiler.
This is not supported on all machines."
self theSingleSelectedMethod isNil ifTrue:[^ self].
ParserFlags
withSTCCompilation:#always
do:[
self codeView accept.
].
!
selectorMenuCopy
"copy the selected methods to some other class - typically a sister class"
self selectorMenuMoveOrCopy:#copy
!
selectorMenuDecompile
"show selected methods bytecode"
|currentMethod s codeView|
(currentMethod := self theSingleSelectedMethod) notNil ifTrue:[
(self askIfModified:'Code was modified.\\Decompile anyway ?')
ifFalse:[^ self].
s := '' writeStream.
(currentMethod decompileTo:s) ifFalse:[
self warn:'No decompiler available'.
].
codeView := self codeView.
codeView contents:s contents.
codeView modified:false.
navigationState modified:false.
navigationState realModifiedState:false.
codeView acceptAction:nil.
]
!
selectorMenuEdit
|methodsResources editorClass currentMethod|
currentMethod := self theSingleSelectedMethod.
"/
"/ double clicking on a resource-methods opens
"/ an appropriate editor
"/
(currentMethod notNil
and:[(methodsResources := currentMethod resources) notNil]
) ifTrue:[
"/
"/ kludge - this info should come from somewhere else ...
"/
editorClass := self class resourceEditorClassForResources:methodsResources.
editorClass notNil ifTrue: [
editorClass
openOnClass:currentMethod mclass theNonMetaclass
andSelector:currentMethod selector.
^ self.
]
].
!
selectorMenuFileOutAs
"fileOut selected methods from the list - standard format"
^ self selectorMenuFileOutAsWithFormat:nil
!
selectorMenuFileOutAsWithFormat:aFormatSymbolOrNil
"fileOut selected methods from the list - file format as specified by the argument:
nil - standard format
#xml - XML standard format
#sif - SIF (smalltalk interchange file) standard format
#binary - ST/X binary format
"
|methods fileNameTemplate m|
methods := self selectedMethods value.
methods size > 1 ifTrue:[
fileNameTemplate := 'someMethods'.
] ifFalse:[
m := methods first.
fileNameTemplate := m mclass nameWithoutPrefix , '-' , m selector.
].
self
fileOutMethods:methods
format:aFormatSymbolOrNil
fileNameTemplate:fileNameTemplate
boxTitle:'FileOut selected method(s) as:'
"Modified: / 15.11.2001 / 17:57:52 / cg"
!
selectorMenuFileOutSIFAs
"fileOut selected methods from the list - sif format"
^ self selectorMenuFileOutAsWithFormat:#sif
!
selectorMenuFileOutXMLAs
"fileOut selected methods from the list - xml format"
XMLCoder isNil ifTrue:[
self warn:'Sorry - missing class: XMLCoder.\\Cannot generate XML file.' withCRs.
^ self
].
^ self selectorMenuFileOutAsWithFormat:#xml
!
selectorMenuGenerateCorrespondingInstanceCreationInClass
"generate a subclassResponsibility method in the methods superclass"
self
generateUndoableChangeOverSelectedMethods:'Generate Instance creation for %(singleMethodNameOrNumberOfMethods)'
via:[:generator :eachMethod |
|selector mclass|
selector := eachMethod selector.
mclass := eachMethod mclass.
generator
createInstanceCreationMethodWithSetupFor:selector category:'instance creation' in:mclass theMetaclass.
]
!
selectorMenuGenerateForwardingMethodForInstances
"generate a forwarding method on the instance side"
self
generateUndoableChangeOverSelectedMethods:'Generate Forwarder for %(singleMethodNameOrNumberOfMethods)'
via:[:generator :eachMethod |
|selector category mclass implClass defineIt parser spec code|
selector := eachMethod selector.
category := eachMethod category.
mclass := eachMethod mclass.
mclass isMeta ifTrue:[
parser := Parser for:eachMethod source.
parser parseMethod.
spec := Parser methodSpecificationForSelector:selector argNames:parser methodArgs.
(mclass theNonMetaclass includesSelector:selector) ifFalse:[
code := (spec , '\ ^ self class ' , spec , '.') withCRs.
generator
compile:code
forClass:mclass theNonMetaclass
inCategory:category
].
].
]
!
selectorMenuGenerateSubclassResponsibilityHere
"generate a subclassResponsibility method (for the selected string)
in the current class"
|selector|
selector := self selectionInCodeView.
selector isEmpty ifTrue:[^ self].
selector := selector asSymbol.
self selectedClassesDo:[:eachClass |
|category|
category := '* as yet unspecified *'.
SmalltalkCodeGeneratorTool
createSubclassResponsibilityMethodFor:selector category:category in:eachClass.
]
"Modified: / 31-01-2011 / 18:29:52 / cg"
!
selectorMenuGenerateSubclassResponsibilityInSuperclass
"generate a subclassResponsibility method in the methods superclass"
self
generateUndoableChangeOverSelectedMethods:'Generate Responsibility in superclass for %(singleMethodNameOrNumberOfMethods)'
via:[:generator :eachMethod |
|selector category mclass implClass defineIt answer|
selector := eachMethod selector.
category := eachMethod category.
mclass := eachMethod mclass.
mclass superclass notNil ifTrue:[
(mclass superclass includesSelector:selector) ifFalse:[
defineIt := true.
implClass := mclass superclass whichClassIncludesSelector:selector.
implClass notNil ifTrue:[
answer := Dialog
confirmWithCancel:(resources
string:'%1 is inherited from %2.\\Define as subclassResponsibility in %3 anyway ?'
with:selector allBold
with:implClass name allBold
with:mclass superclass name allBold
) withCRs.
answer isNil ifTrue:[^ self].
defineIt := answer.
].
defineIt ifTrue:[
generator
createSubclassResponsibilityMethodFor:selector category:category in:mclass superclass.
]
].
].
]
!
selectorMenuGenerateTemplateInAllSubclasses
"generate a template in all subclasses (recursive) for each subclassResponsibility method"
self selectorMenuGenerateTemplateInClassesEnumeratedWith:#allSubclasses
!
selectorMenuGenerateTemplateInClassesEnumeratedWith:aSubclassEnumeratingSelector
"generate a template in some subclass for each subclassResponsibility method"
self
generateUndoableChangeOverSelectedMethods:'Generate Responsibility for %(singleMethodNameOrNumberOfMethods)'
via:[:generator :eachMethod |
|selector category mclass implClass defineIt parser spec |
selector := eachMethod selector.
category := eachMethod category.
mclass := eachMethod mclass.
parser := Parser for:eachMethod source.
parser parseMethod.
spec := Parser methodSpecificationForSelector:selector argNames:parser methodArgs.
(mclass perform:aSubclassEnumeratingSelector) do:[:eachSubClass |
|code|
(eachSubClass includesSelector:selector) ifFalse:[
code := spec , '\ self halt.\ ^ self' withCRs.
generator
compile:code
forClass:eachSubClass
inCategory:category
].
].
]
!
selectorMenuGenerateTemplateInSubclasses
"generate a template in every subclass for each subclassResponsibility method"
self selectorMenuGenerateTemplateInClassesEnumeratedWith:#subclasses
!
selectorMenuInlineParameter
|currentMethod cls selector tree args whichParameter|
(self askIfModified) ifFalse:[
^ self
].
currentMethod := self theSingleSelectedMethod.
cls := currentMethod mclass.
selector := currentMethod selector.
tree := cls parseTreeFor:selector.
tree isNil ifTrue:[
self warn: 'Could not parse the method'.
^ self
].
args := tree argumentNames.
args size > 1 ifTrue:[
whichParameter := self selectionInCodeView.
(whichParameter notEmptyOrNil and:[ args includes:whichParameter]) ifFalse:[
whichParameter := Dialog choose:'Inline which Parameter ?' fromList:args lines:5 title:'Inline Parameter'.
whichParameter isEmptyOrNil ifTrue:[^ self].
].
] ifFalse:[
whichParameter := args first.
].
self codeMenuInlineParameter:whichParameter
!
selectorMenuInlineSelfSends
self codeMenuInlineAllSelfSends
!
selectorMenuInspect
"open an inspector on the single selected method"
|mthd|
mthd := self theSingleSelectedMethod.
mthd notNil ifTrue:[
mthd inspect
].
"Created: / 6.2.2000 / 01:53:56 / cg"
!
selectorMenuLoadSmallTeamVersionFromHost:hostName
"load a smallTeam version"
self selectedMethods value do:[:eachMethod |
|changeList change|
changeList := SmallTeam changesOnHost:hostName.
change := changeList
detectLast:[:change |
change changeClass == eachMethod mclass
and:[ change selector == eachMethod selector ] ]
ifNone:nil.
change notNil ifTrue:[
change apply
].
].
"Created: / 12-11-2006 / 15:48:43 / cg"
!
selectorMenuMakeClassMethod
"move the selected methods from inst to their class side or vice versa"
self selectorMenuMakeClassOrInstanceMethod
!
selectorMenuMakeClassMethodWithForwarding
"move the selected methods from inst to their class side
and generate a forwarding method on the instance side"
self selectorMenuMakeClassOrInstanceMethodWithForwarder:true.
!
selectorMenuMakeClassOrInstanceMethod
"move the selected methods from inst to their class side or vice versa"
self selectorMenuMakeClassOrInstanceMethodWithForwarder:false
!
selectorMenuMakeClassOrInstanceMethodWithForwarder:withForwarder
"move the selected methods from inst to their class side or vice versa"
self selectedMethods value copy do:[:methodToMove |
|mclass question msg selectorToMove dontDoIt newMethod dstClass|
mclass := methodToMove mclass.
mclass isMeta ifTrue:[
dstClass := mclass theNonMetaclass.
] ifFalse:[
dstClass := mclass theMetaclass.
].
self
moveOrCopyMethods:(Array with:methodToMove)
toClass:dstClass
moveOrCopy:(withForwarder ifTrue:#moveAndForward ifFalse:#move).
"/ dontDoIt := false.
"/ selectorToMove := methodToMove selector.
"/ (dstClass includesSelector:selectorToMove) ifTrue:[
"/ question := '%1 already implements #%2\\Move anyway ?'.
"/ (self confirm:(resources string:question
"/ with:dstClass name allBold
"/ with:selectorToMove) withCRs) ifFalse:[
"/ dontDoIt := true
"/ ]
"/ ].
"/ dontDoIt ifFalse:[
"/ newMethod := dstClass
"/ compile:(methodToMove source)
"/ classified:(methodToMove category).
"/
"/ (newMethod isNil or:[newMethod == #Error]) ifTrue:[
"/ msg := '#%1 not moved - compilation failed due to an error'.
"/ self warn:(resources string:msg with:selectorToMove)
"/ ] ifFalse:[
"/ mclass removeSelector:selectorToMove.
"/ withForwarder ifTrue:[
"/ mClass
"/ compile:(methodToMove source)
"/ classified:(methodToMove category).
"/ self halt.
"/ ].
"/ ]
"/ ]
]
!
selectorMenuMakeIgnored
"make selected methods ignored"
self selectorMenuChangePrivacyTo:#ignored
!
selectorMenuMakeInstanceMethod
"move the selected methods from inst to their class side or vice versa"
self selectorMenuMakeClassOrInstanceMethod
!
selectorMenuMakePrivate
"make selected methods private"
self selectorMenuChangePrivacyTo:#private
!
selectorMenuMakeProtected
"make selected methods protected"
self selectorMenuChangePrivacyTo:#protected
!
selectorMenuMakePublic
"make selected methods public"
self selectorMenuChangePrivacyTo:#public
!
selectorMenuMarkAsObsolete
|useRefactoringSupport changes methodsToChangePackage|
useRefactoringSupport := self canUseRefactoringSupport.
useRefactoringSupport ifTrue:[
changes := CompositeRefactoryChange named:'Mark Method(s) as Obsolete'.
].
methodsToChangePackage := OrderedCollection new.
self selectedMethodsDo:[:eachMethod |
|rs mClass selector source parser definitionPart bodyPart newSource newMethod result
s p1 indent category bodyStartsWithNewLine|
eachMethod isObsolete ifFalse:[
rs := eachMethod resources.
false "rs notEmptyOrNil" ifTrue:[
self halt.
] ifFalse:[
mClass := eachMethod mclass.
selector := eachMethod selector.
source := eachMethod source.
category := eachMethod category.
parser := Parser for:source in:nil.
parser ignoreErrors:true; ignoreWarnings:true; saveComments:true.
parser parseMethodSpec.
"/ insert an obsolete-resource into the first line after the selector-spec
definitionPart := source copyTo:parser endOfSelectorPosition.
bodyPart := source copyFrom:parser endOfSelectorPosition+1.
bodyStartsWithNewLine := false.
s := bodyPart readStream.
[ s peek == Character cr or:[ s peek == Character nl ] ] whileTrue:[ bodyStartsWithNewLine := true. s next ].
p1 := s position.
[ s peek == Character space ] whileTrue:[ s next ].
indent := s position - p1.
indent := indent max:4.
newSource := definitionPart
, '\' withCRs, (String new:indent), '<resource: #obsolete>'.
bodyStartsWithNewLine ifFalse:[
newSource := newSource , '\' withCRs.
].
newSource := newSource , bodyPart.
result := Compiler compile:newSource forClass:mClass install:false.
(result isNil or:[result == #Error]) ifTrue:[
Dialog warn:(resources string:'Failed to compile new version of %1' with:eachMethod whoString allBold).
] ifFalse:[
useRefactoringSupport ifTrue:[
changes
compile:newSource
in:mClass
classified:category.
] ifFalse:[
newMethod := mClass
compile:newSource
classified:category.
].
methodsToChangePackage add:(Array with:mClass
with:selector
with:eachMethod package).
].
].
].
].
useRefactoringSupport ifTrue:[
RefactoryChangeManager performChange: changes.
].
methodsToChangePackage triplesDo:[:cls :sel :pkg|
(cls compiledMethodAt:sel) setPackage:pkg.
].
"Created: / 23-11-2006 / 16:52:27 / cg"
"Modified: / 28-03-2007 / 21:39:59 / cg"
!
selectorMenuMoveOrCopy:doWhat
"move or copy the selected methods to some other class - typically a sister class"
|newClass methods|
newClass := self askForClassToMoveOrCopy:doWhat.
newClass isNil ifTrue:[^ self].
doWhat == #moveAndForward ifTrue:[
newClass isMeta ifFalse:[
(Dialog
confirm:(resources
stringWithCRs:'Destination must be a Metaclass.\\Moving to %1.'
with:newClass theMetaclass name)
noLabel:(resources string:'Cancel')
) ifFalse:[
^ self
].
newClass := newClass theMetaclass.
].
].
methods := self selectedMethods value.
self moveOrCopyMethods:methods toClass:newClass moveOrCopy:doWhat
"Modified: / 24-11-2006 / 12:22:23 / cg"
!
selectorMenuMoveToClass
"move the selected methods to some other class - typically a superclass"
self selectorMenuMoveOrCopy:#move
!
selectorMenuMoveToClassProject
"change the package-id of the selected methods to the classes package-id."
|perPackageMethods|
perPackageMethods := Dictionary new.
self selectedMethods value do:[:eachMethod |
|methodsPackage classPackage set|
methodsPackage := eachMethod package.
classPackage := eachMethod mclass package.
methodsPackage ~= classPackage ifTrue:[
set := perPackageMethods at:classPackage ifAbsentPut:[Set new].
set add:eachMethod.
].
].
perPackageMethods keysAndValuesDo:[:pkg :setOfMethods |
self moveMethods:setOfMethods toProject:pkg
].
"Created: / 22-11-2006 / 13:17:00 / cg"
!
selectorMenuMoveToClassWithForwarding
"move the selected methods to some other class - typically a superclass"
self selectorMenuMoveOrCopy:#moveAndForward
!
selectorMenuMoveToProject
"change the package-id of the selected methods.
Will eventually update the Project-object"
|newProject classProjects offered affectedMethods msg|
affectedMethods := self selectedMethods value.
classProjects := (affectedMethods collect:[:eachMethod | eachMethod mclass package]) asSet.
LastProjectMoves size > 0 ifTrue:[
offered := LastProjectMoves first
] ifFalse:[
classProjects size == 1 ifTrue:[
offered := classProjects first
] ifFalse:[
offered := "classesProject ? "Project current package
].
].
classProjects remove:offered ifAbsent:[].
classProjects := classProjects asOrderedCollection.
classProjects size == 1 ifTrue:[
msg := resources stringWithCRs:'Move method(s) to which project:\(Hint: The class is in ''%1'')\'
with:(classProjects first allBold).
] ifFalse:[
msg := resources stringWithCRs:'Move method(s) to which project:\'.
].
newProject := self
askForProject:msg
initialText:offered
moreSuggestions:classProjects.
newProject notNil ifTrue:[
self doMoveSelectedMethodsToProject:newProject.
].
"Created: / 17-02-2000 / 23:02:49 / cg"
"Modified: / 11-08-2006 / 13:40:58 / cg"
!
selectorMenuMoveToProtocol
"move selected methods to some other category"
|mthd superClass inherited someCategories goodCandidates newCategory selClasses
initialAnswer methodSelection selectors|
methodSelection := self selectedMethods value copy.
someCategories := Set new.
goodCandidates := Set new.
"/ offer the current classes's protocols in the dialog
(selClasses := self selectedClasses value) notNil ifTrue:[
selClasses do:[:eachClass |
someCategories addAll:(eachClass categories).
]
] ifFalse:[
"/ offer the current method-classes' protocols in the dialog
methodSelection do:[:eachMethod | |cls|
(cls := eachMethod mclass) notNil ifTrue:[
someCategories addAll:cls categories
]
]
].
selectors := methodSelection collect:[:each | each selector].
"/ if all selectors are getters/setters, add 'accessing'
RBParser notNil ifTrue:[
|searcher allGettersOrSetters allReturnTrueOrFalse|
searcher := ParseTreeSearcher isGetterOrSetterMethod.
allGettersOrSetters :=
methodSelection
conform:[:eachMethod |
|tree|
tree := RBParser
parseSearchMethod:(eachMethod source)
onError: [:str :pos | nil].
searcher executeTree:tree initialAnswer:false.
].
allGettersOrSetters ifTrue:[
someCategories add:'accessing'.
goodCandidates add:'accessing'.
initialAnswer := 'accessing'.
].
searcher := ParseTreeSearcher isJustReturningTrueOrFalse.
allReturnTrueOrFalse :=
methodSelection
conform:[:eachMethod |
|tree|
tree := RBParser
parseSearchMethod:(eachMethod source)
onError: [:str :pos | nil].
searcher executeTree:tree initialAnswer:false.
].
allReturnTrueOrFalse ifTrue:[
someCategories add:'testing'.
goodCandidates add:'testing'.
initialAnswer := 'testing'.
].
].
"/ add actual categories of selected methods
(SystemBrowser findImplementorsOfAny:selectors in:(Smalltalk allClasses) ignoreCase:false)
do:[:otherMethod |
|cat|
(methodSelection includesIdentical:otherMethod) ifFalse:[
cat := otherMethod category.
someCategories add:cat.
goodCandidates add:cat.
]
].
"/ for isXXX methods, add 'testing'
(methodSelection conform:[:method | method selector = ('is',method mclass name) ]) ifTrue:[
someCategories add:'testing'.
goodCandidates add:'testing'.
].
someCategories := someCategories asOrderedCollection sort.
goodCandidates size == 1 ifTrue:[
initialAnswer := goodCandidates anElement
] ifFalse:[
(mthd := self theSingleSelectedMethod) notNil ifTrue:[
superClass := mthd mclass superclass.
superClass notNil ifTrue:[
superClass := superClass whichClassIncludesSelector:mthd selector.
superClass notNil ifTrue:[
inherited := superClass compiledMethodAt:mthd selector.
inherited notNil ifTrue:[
initialAnswer := inherited category
]
]
]
]
].
newCategory := self
askForMethodCategory:'Move to which protocol ?'
title:'Change MethodCategory'
okLabel:'Move'
list:someCategories
initialAnswer:(initialAnswer ? (lastMethodCategory ? self theSingleSelectedProtocol)).
self moveMethods:methodSelection toProtocol:newCategory
"Modified: / 22-12-2010 / 11:45:59 / cg"
!
selectorMenuNewImageSpec
"open a bitmap painter for a new image-spec method"
self selectorMenuNewSpecMethodWithType:#image
"Modified: / 01-03-2007 / 20:56:09 / cg"
!
selectorMenuNewMenuSpec
"open a Menu painter for a new menu-spec method"
self selectorMenuNewSpecMethodWithType:#menu
"Modified: / 01-03-2007 / 20:56:19 / cg"
!
selectorMenuNewMethod
"show a template for a new method"
self setAcceptActionForMethod.
^ self showCode:(self showMethodTemplate value ifTrue:[self methodTemplate] ifFalse:[''])
"Modified: / 17.2.2000 / 23:14:14 / cg"
!
selectorMenuNewSpecMethodWithType:specTypeSymbol
"open a painter for a new specTypeSymbol-spec method.
specTypeSymbol is one of #image, #canvas or #menu"
|editorClass currentClass|
(currentClass := self theSingleSelectedClass) notNil ifTrue:[
"/
"/ kludge - this info should come from somewhere else ...
"/
editorClass := self class resourceEditorClassFor:specTypeSymbol.
editorClass notNil ifTrue: [
editorClass
openOnClass:currentClass theNonMetaclass
andSelector:nil
]
]
"Created: / 01-03-2007 / 20:55:46 / cg"
!
selectorMenuNewTableColumnSpec
"open a GUI painter for a new tableColumn-spec method"
self selectorMenuNewSpecMethodWithType:#tableColumns
!
selectorMenuNewWindowSpec
"open a GUI painter for a new window-spec method"
self selectorMenuNewSpecMethodWithType:#canvas
"Modified: / 01-03-2007 / 20:56:49 / cg"
!
selectorMenuPrintOut
"print out the current method(s)"
|printStream|
printStream := Printer new.
self selectedMethodsDo:[:eachMethod |
eachMethod mclass printOutSource:(eachMethod source) on:printStream.
].
printStream close
!
selectorMenuProcess
"process methods"
|processingBlockString processingBlock dialog textHolder template|
template :=
'"/ general method code processor;
"/ the following block will be evaluated for each selected method.
"/ Beginner warning: Smalltalk know-how is recommended here.
[:class :selector :method|
"/ Useful queries to the method are:
"/ - source to access its full sourceCode
"/ - package the classes package
"/ - hasExtentsion true if it has extensions (methods in other packages)
"/ - implements: true if it implements a particular message
"/ - isSubclassOf: true if it is a subclass of some other class
"/ - isSuperclassOf: true if it is a superclass of some other class
"/ - name the classes name
"/ - category the classes category
"/ - nameSpace the classes namespace
"/ example (rename all foo* methods)
(selector startsWith:''foo'') ifTrue:[
newSource := ''bar'' , (method source copyFrom:3+1).
class
compile:newSource
classified:(method category).
class removeSelector:selector.
].
].
'.
LastMethodProcessingBlockString isNil ifTrue:[
LastMethodProcessingBlockString := template.
].
textHolder := ValueHolder new.
dialog := Dialog
forRequestText:(resources string:'Enter method processing block')
lines:25
columns:70
initialAnswer:LastMethodProcessingBlockString
model:textHolder.
dialog addButton:(Button label:'Template' action:[textHolder value:template. textHolder changed:#value.]).
dialog open.
dialog accepted ifFalse:[^ self].
processingBlockString := textHolder value.
LastMethodProcessingBlockString := processingBlockString.
processingBlock := Parser evaluate:processingBlockString.
processingBlock isBlock ifFalse:[
self error:'bad input'.
^ self
].
self
selectedMethodsDo:[:eachMethod |
processingBlock
value:(eachMethod mclass)
value:(eachMethod selector)
value:eachMethod
]
!
selectorMenuPushDownMethod
"push method(s) into subclass(s)"
self selectorMenuPushMethod:#down
!
selectorMenuPushMethod:upOrDown
"push method(s) into subclass(s) or up into superclas"
|selectedMethods refactoring|
(self askIfModified:'Code was modified.\\Push method(s) anyway ?')
ifFalse:[^ self].
selectedMethods := self selectedMethods value.
(selectedMethods collect:[:m | m mclass]) asIdentitySet do:[:eachClass |
|methods selectors nm|
methods := selectedMethods select:[:m | m mclass == eachClass].
selectedMethods := selectedMethods select:[:m | m mclass ~~ eachClass].
selectors := methods collect:[:each | each selector].
upOrDown == #down ifTrue:[
refactoring := PushDownMethodRefactoring pushDown:selectors from:eachClass.
nm := 'Push down '.
] ifFalse:[
refactoring := PushUpMethodRefactoring pushUp:selectors from:eachClass.
nm := 'Push up '.
].
selectors size == 1 ifTrue:[
nm := nm , selectors first.
] ifFalse:[
nm := nm , selectors size printString , ' methods'.
].
nm := nm , ' from ' , eachClass name.
refactoring model name:nm.
self performRefactoring:refactoring.
].
!
selectorMenuPushUpMethod
"push method(s) into superclass"
self selectorMenuPushMethod:#up
!
selectorMenuRecompile
"recompile the selected methods (for Debug only)"
self selectedMethods value do:[:eachMethod |
eachMethod mclass recompile:eachMethod selector
]
!
selectorMenuRemove
"confirm removal of the selected methods (but does not search for senders),
then remove them."
self doRemoveMethodsConfirmed:(self selectedMethods value)
!
selectorMenuRemoveParameter
|currentMethod cls selector tree args whichParameter|
(self askIfModified) ifFalse:[
^ self
].
currentMethod := self theSingleSelectedMethod.
cls := currentMethod mclass.
selector := currentMethod selector.
tree := cls parseTreeFor:selector.
tree isNil ifTrue:[
self warn: 'Could not parse the method'.
^ self
].
args := tree argumentNames.
args size > 1 ifTrue:[
whichParameter := self selectionInCodeView.
(whichParameter notEmptyOrNil and:[ args includes:whichParameter]) ifFalse:[
whichParameter := Dialog choose:'Remove which Parameter ?' fromList:args lines:5 title:'Remove Parameter'.
whichParameter isEmptyOrNil ifTrue:[^ self].
].
] ifFalse:[
whichParameter := args first.
].
self codeMenuRemoveParameter:whichParameter
!
selectorMenuRename
"rename a method (and rewrite all of its callers)"
|mthd methods selectorsDone|
mthd := self theSingleSelectedMethod.
mthd isNil ifTrue:[
methods := self selectedMethods value ? #().
(methods asSet collect:[:eachMethod | eachMethod selector]) size == 1 ifTrue:[
mthd := methods first.
]
].
mthd isNil ifTrue:[
AbortAllSignal catch:[
selectorsDone := Set new.
methods do:[:eachMethod |
|eachSelector|
eachSelector := eachMethod selector.
(selectorsDone includes:eachSelector) ifFalse:[
self renameMethod:eachSelector in:eachMethod mclass.
selectorsDone add:eachSelector.
]
]
]
] ifFalse:[
self renameMethod:(mthd selector) in:(mthd mclass).
]
"/ |mthd|
"/
"/ mthd := self theSingleSelectedMethod.
"/ self renameMethod:mthd selector in:mthd mclass.
!
selectorMenuSaveRemove
"check for senders (and windowSpec/menuSpec refs) to methods selector,
then confirm removal of the selected methods"
|selectorsToRemove selectorsToCheckForInvokation selectorsToCheckForSelectorUse
possiblyInvoked possiblyUsedAsSelector msg isAre answer selInfo methods brwsr numVersionMethods|
selectorsToRemove := IdentitySet new.
numVersionMethods := 0.
self selectedMethodsDo:[:eachMethod |
selectorsToRemove add:(eachMethod selector).
(AbstractSourceCodeManager isVersionMethodSelector:eachMethod selector) ifTrue:[
eachMethod mclass isMeta ifTrue:[
numVersionMethods := numVersionMethods + 1
]
]
].
selectorsToCheckForInvokation := IdentitySet new addAll:selectorsToRemove; yourself.
selectorsToCheckForSelectorUse := IdentitySet new addAll:selectorsToRemove; yourself.
possiblyInvoked := IdentitySet new.
possiblyUsedAsSelector := IdentitySet new.
self withSearchCursorDo:[
"/ search through all of the system
Smalltalk allMethodsDo:[:mthd |
|sent resources newFound any|
any := false.
mthd literalsDo:[:eachLiteral |
(selectorsToRemove includes:eachLiteral) ifTrue:[any := true].
"/ could be an array (as in a spec)
eachLiteral isArray ifTrue:[
selectorsToRemove contains:[:selToRemove |
(eachLiteral refersToLiteral:selToRemove) ifTrue:[
possiblyUsedAsSelector add:mthd.
]
]
]
].
any ifTrue:[
selectorsToRemove do:[:eachSelectorToRemove |
sent := mthd messagesSent.
(sent includes:eachSelectorToRemove) ifTrue:[
(self selectedMethods value includesIdentical:mthd) ifFalse:[
possiblyInvoked add:mthd.
]
]
]
].
mthd hasResource ifTrue:[
newFound := IdentitySet new.
selectorsToRemove do:[:eachSelectorToRemove |
(mthd refersToLiteral:eachSelectorToRemove) ifTrue:[
(self selectedMethods value includesIdentical:mthd) ifFalse:[
possiblyUsedAsSelector add:mthd.
]
].
].
].
].
].
self normalLabel.
possiblyInvoked isEmpty ifTrue:[
possiblyUsedAsSelector isEmpty ifTrue:[
self selectorMenuRemove.
^ self.
]
].
selectorsToRemove size == 1 ifTrue:[
selInfo := selectorsToRemove first allBold.
isAre := 'is'
] ifFalse:[
selInfo := 'selectors to remove'.
isAre := 'are'
].
msg := selInfo , ' '.
possiblyInvoked notEmpty ifTrue:[
msg := msg , isAre , ' possibly sent by %1 methods '
].
possiblyUsedAsSelector notEmpty ifTrue:[
possiblyInvoked notEmpty ifTrue:[
msg := msg , 'and '
].
msg := msg , 'possibly used as selector by %2 methods'
].
numVersionMethods > 0 ifTrue:[
msg := msg , '\\' ,
(resources
string:'ATTENTION: Removing a classes version method might make the versionManagers life hard.' allBold).
].
answer := OptionBox
request:((resources string:msg with:possiblyInvoked size printString with:possiblyUsedAsSelector size printString)
, '\\Really remove ?') withCRs
label:(resources string:'Attention')
image:(WarningBox iconBitmap)
buttonLabels:(resources array:#( 'Cancel' 'Remove' 'Browse Methods'))
values:#(false true #browse)
default:#browse
onCancel:false.
answer == false ifTrue:[^ self].
answer == #browse ifTrue:[
methods := IdentitySet new.
methods addAll:possiblyInvoked.
methods addAll:possiblyUsedAsSelector.
brwsr := self
spawnMethodBrowserFor:methods in:#newBuffer
label:'methods referring to ' , selInfo
perMethodInfo:nil
sortBy:#class.
selectorsToRemove size == 1 ifTrue:[
brwsr autoSearchPattern:selInfo
].
^ self
].
self doRemoveSelectedMethodsUnconfirmed
!
selectorMenuSelectMethodsWithString
"select all methods containing a particular string"
self shouldImplement.
^ self selectMethodsWhere:[:mthd | self shouldImplement ]
!
selectorMenuSpawnExtensionsProject
"open a new browser showing the selected extension methods' project(s)"
|projects|
projects := (self selectedMethods value collect:[:m | m package]) asSet asSortedCollection.
^ self
spawnProjectBrowserFor:projects
in:#newBrowser
!
selectorMenuSpawnExtensionsProjectBuffer
"open a new browser showing the selected extension methods' project(s)"
|projects|
projects := (self selectedMethods value collect:[:m | m package]) asSet asSortedCollection.
^ self
spawnProjectBrowserFor:projects
in:#newBuffer
!
selectorMenuSpawnImplementors
"open a new browser showing implementations of the selected method"
^ self
spawnMethodImplementorsBrowserFor:(self selectedSelectors)
in:#newBrowser
!
selectorMenuSpawnImplementorsBuffer
"add a new buffer showing implementations of the selected method"
^ self
spawnMethodImplementorsBrowserFor:(self selectedSelectors)
in:#newBuffer
!
selectorMenuSpawnInheritance
"open a new browser showing inheritance of the selected method(s)"
^ self
spawnMethodInheritanceBrowserFor:(self selectedSelectors)
in:#newBrowser
!
selectorMenuSpawnInheritanceBuffer
"add a buffer showing inheritance of the selected method(s)"
^ self
spawnMethodInheritanceBrowserFor:(self selectedSelectors)
in:#newBuffer
!
selectorMenuSpawnMethod
"open a new browser showing the selected methods only"
^ self
spawnMethodBrowserFor:(self selectedMethods value)
in:#newBrowser
label:nil
!
selectorMenuSpawnMethodBuffer
"add a new buffer showing the selected methods only"
^ self
spawnMethodBrowserFor:(self selectedMethods value)
in:#newBuffer
label:nil
!
selectorMenuSpawnProjectExtensions
"open a new browser showing all extension methods for the
selected methods project(s)"
^ self
spawnProjectExtensionsBrowserFor:(self selectedMethods value)
in:#newBrowser
!
selectorMenuSpawnProjectExtensionsBuffer
"add a new buffer showing all extension methods for the
selected methods project(s)"
^ self
spawnProjectExtensionsBrowserFor:(self selectedMethods value)
in:#newBuffer
!
selectorMenuSpawnSenders
"open a new browser showing senders of the selected method"
^ self
spawnMethodSendersBrowserFor:(self selectedSelectors)
in:#newBrowser
!
selectorMenuSpawnSendersBuffer
"add a new buffer showing senders of the selected methods selector"
^ self
spawnMethodSendersBrowserFor:(self selectedSelectors)
in:#newBuffer
!
spawnBrowserOnAllImplementorsOf:aSelector
"open a new browser or add a buffer showing the selected methods implementations only"
^ self spawnMethodImplementorsBrowserFor:(Array with:aSelector) match:false in:#newBuffer
!
spawnBrowserOnAllSendersOf:aSelector
"open a new browser or add a buffer showing the selected methods senders only"
^ self spawnMethodSendersBrowserFor:(Array with:aSelector) in:#newBuffer
!
spawnCallersBrowser
"browse callers of the selected method(s)"
^ self spawnCallersIn:#newBrowser
"Created: / 27-04-2010 / 15:09:20 / cg"
!
spawnCallersBrowserFor:aMethodCollection in:openHow
"open a new browser or add a buffer showing the selected method's callers"
|label|
self withSearchCursorDo:[
|cachedList newBrowser searchBlock|
aMethodCollection size == 1 ifTrue:[
label := resources string:('Callers of %1') with:aMethodCollection first whoString allBold.
] ifFalse:[
label := resources string:'Callers of Any'.
].
searchBlock := [
|l|
cachedList notNil ifTrue:[
l := cachedList.
cachedList := nil
] ifFalse:[
l := IdentitySet new.
aMethodCollection do:[:eachCalledMethod |
|info|
info := eachCalledMethod methodInvocationInfo.
info notNil ifTrue:[
info callingMethodsDo:[:caller |
l add:caller
]
]
].
l := l asOrderedCollection
].
l
].
newBrowser := self
spawnMethodBrowserForSearch:searchBlock
sortBy:#class
in:openHow
label:label.
]
"Created: / 27-04-2010 / 15:16:40 / cg"
!
spawnCallersBuffer
"browse callers of the selected method(s)"
^ self spawnCallersIn:#newBuffer
"Created: / 27-04-2010 / 15:09:02 / cg"
!
spawnCallersIn:openHow
"open a new browser or add a buffer showing the selected method's callers"
self spawnCallersBrowserFor:(self selectedMethods value) in:openHow
"Created: / 27-04-2010 / 15:17:33 / cg"
!
spawnImplementorChainBrowser
"browse implementations chain"
^ self spawnImplementorChainIn:#newBrowser
!
spawnImplementorChainBuffer
"browse implementations chain"
^ self spawnImplementorChainIn:#newBuffer
!
spawnImplementorChainIn:openHow
"browse implementation chain;
openHow is: #newBrowser - open a new browser showing the method(s)
openHow is: #newBuffer - add a new buffer showing the method(s)
"
|searchBlock "must be first local in block (see #methodsSelectionChangedAt:index, which fetches this value)"
spec aMethod multipleMethods methods lbl|
multipleMethods := self selectedMethods value size > 1.
multipleMethods ifTrue:[
methods := self selectedMethods value copy.
lbl := resources string:'implementor chains'.
] ifFalse:[
aMethod := self theSingleSelectedMethod.
lbl := resources string:'implementor chain of %1' with:aMethod selector.
].
spec := #chainBrowserSpec.
^ self
newBrowserOrBufferDependingOn:openHow
label:lbl
forSpec:spec
setupWith:[:brwsr |
|methodListGenerator generator theMethodList|
searchBlock := [:whichMethod |
| sentMessages |
sentMessages := whichMethod messagesSent.
self class findImplementorsOfAny:sentMessages in:(Smalltalk allClasses) ignoreCase:false.
].
generator := Iterator on:[:whatToDo |
theMethodList isNil ifTrue:[
theMethodList := searchBlock value:aMethod.
].
theMethodList do:[:aMethod |
whatToDo
value:aMethod mclass
value:aMethod category
value:aMethod selector
value:aMethod.
].
"enforce display of class in methodList"
whatToDo
value:nil
value:nil
value:nil
value:nil.
multipleMethods ifFalse:[
theMethodList := nil.
]
].
multipleMethods ifTrue:[
theMethodList := methods.
].
brwsr selectorListGenerator1 value:generator.
"/ auto-select the first methods, if there is only one
multipleMethods ifFalse:[
theMethodList isNil ifTrue:[
"/ newBuffer will evaluate the generator later;
"/ newBrowser might have it already evaluated ... (sigh)
theMethodList := searchBlock value:aMethod.
].
theMethodList size == 1 ifTrue:[
brwsr selectedMethods1 value:theMethodList.
brwsr methodsSelectionChanged.
].
].
]
"Modified: / 1.3.2000 / 21:03:34 / cg"
!
spawnLocalImplementorsBuffer
"add a new buffer showing implementations of the selected method"
^ self
spawnMethodLocalImplementorsBrowserFor:(self selectedSelectors)
in:#newBuffer
"Created: / 05-09-2006 / 10:51:47 / cg"
!
spawnLocalSendersBuffer
"add a new buffer showing local senders of the selected methods selector"
^ self
spawnMethodLocalSendersBrowserFor:(self selectedSelectors)
in:#newBuffer
"Created: / 05-09-2006 / 10:44:28 / cg"
!
spawnMethodBrowserFor:methods in:where label:labelOrNil
"browse selected method(s);
where is: #newBrowser - open a new browser showing the method(s)
where is: #newBuffer - add a new buffer showing the method(s)"
^ self
spawnMethodBrowserFor:methods
in:where
label:labelOrNil
perMethodInfo:nil
sortBy:nil
!
spawnMethodBrowserFor:methods in:where label:labelOrNil perClassInfo:perClassInfoOrNil perMethodInfo:perMethodInfoOrNil sortBy:sortHow
"browse selected method(s);
where is: #newBrowser - open a new browser showing the method(s)
where is: #newBuffer - add a new buffer showing the method(s)"
^ self
spawnMethodBrowserFor:methods
in:where
label:labelOrNil
perClassInfo:perClassInfoOrNil
perMethodInfo:perMethodInfoOrNil
sortBy:sortHow
select:true
!
spawnMethodBrowserFor:methodsOrMethodGeneratorBlock in:where label:labelOrNil perClassInfo:perClassInfoHolder perMethodInfo:perMethodInfoHolder sortBy:sortHow select:doSelect
"browse selected method(s);
where is: #newBrowser - open a new browser showing the method(s)
where is: #newBuffer - add a new buffer showing the method(s)"
|theMethodList spec "singleSelection"|
methodsOrMethodGeneratorBlock isBlock ifTrue:[
theMethodList := methodsOrMethodGeneratorBlock value.
] ifFalse:[
theMethodList := methodsOrMethodGeneratorBlock copy.
].
(theMethodList isEmptyOrNil and:[perClassInfoHolder value isEmptyOrNil]) ifTrue:[
self information:'Nothing special found'.
^ self.
].
(perMethodInfoHolder value notEmptyOrNil) ifTrue:[
(perClassInfoHolder value notEmptyOrNil) ifTrue:[
"/ both present
spec := #multipleClassWithInfoAndMethodWithInfoBrowserSpec.
] ifFalse:[
"/ methodInfo present
spec := #multipleMethodWithInfoBrowserSpec.
].
] ifFalse:[
(perClassInfoHolder value notEmptyOrNil) ifTrue:[
"/ classInfo present
spec := #multipleClassWithInfoBrowserSpec.
] ifFalse:[
"/ none present
spec := #multipleMethodBrowserSpec.
].
].
^ self
newBrowserOrBufferDependingOn:where
label:labelOrNil
forSpec:spec
setupWith:[:brwsr |
|methodGenerator classGenerator perClassInfo perMethodInfo
theMethodNameList|
theMethodList isNil ifTrue:[
methodsOrMethodGeneratorBlock isBlock ifTrue:[
theMethodList := methodsOrMethodGeneratorBlock value.
] ifFalse:[
theMethodList := methodsOrMethodGeneratorBlock copy.
].
].
perClassInfo := perClassInfoHolder value.
perMethodInfo := perMethodInfoHolder value.
methodGenerator := Iterator on:[:whatToDo |
theMethodList isNil ifTrue:[
methodsOrMethodGeneratorBlock isBlock ifTrue:[
theMethodList := methodsOrMethodGeneratorBlock value.
] ifFalse:[
theMethodList := methodsOrMethodGeneratorBlock copy.
].
].
perClassInfo := perClassInfoHolder value.
perMethodInfo := perMethodInfoHolder value.
theMethodNameList := theMethodList collect:[:eachMethod | eachMethod mclass -> eachMethod selector].
theMethodNameList do:[:mAssoc |
|methodClass methodSelector method|
methodClass := mAssoc key.
methodSelector := mAssoc value.
methodClass notNil ifTrue:[
method := methodClass compiledMethodAt:methodSelector.
method notNil ifTrue:[
whatToDo
value:methodClass
value:method category
value:methodSelector
value:method.
].
].
].
methodsOrMethodGeneratorBlock isBlock ifTrue:[
theMethodList := nil.
].
"enforce display of class in methodList"
whatToDo
value:nil
value:nil
value:nil
value:nil.
].
sortHow notNil ifTrue:[brwsr sortBy value:sortHow].
brwsr selectorListGenerator value:methodGenerator.
perClassInfo notNil ifTrue:[
classGenerator := perClassInfo keys.
brwsr classListGenerator value:classGenerator.
brwsr meta value:false.
].
perClassInfo notNil ifTrue:[
brwsr selectedClasses
onChangeEvaluate:[
|class infoText|
brwsr selectedMethods value:nil.
class := brwsr theSingleSelectedClass.
class notNil ifTrue:[
brwsr meta value:false.
infoText := perClassInfoHolder value at:class theNonMetaclass ifAbsent:nil.
infoText isNil ifTrue:[
infoText := perClassInfo at:class theMetaclass ifAbsent:nil
]
].
brwsr methodInfo value:infoText.
]
].
perMethodInfo notNil ifTrue:[
brwsr selectedMethods
onChangeEvaluate:[
|mthd infoText|
brwsr selectedClasses value:nil.
mthd := brwsr theSingleSelectedMethod.
mthd notNil ifTrue:[
infoText := perMethodInfo at:mthd ifAbsent:nil
].
brwsr methodInfo value:infoText.
]
] ifFalse:[
(doSelect and:[theMethodList size == 1]) ifTrue:[
brwsr selectMethods:(Array with:theMethodList first).
brwsr methodsSelectionChanged.
]
].
methodsOrMethodGeneratorBlock isBlock ifTrue:[
theMethodList := nil "/ force re-evaluation
]
]
"Modified: / 18-05-2010 / 15:15:27 / cg"
!
spawnMethodBrowserFor:methods in:where label:labelOrNil perMethodInfo:infoDictionaryOrNil sortBy:sortHow
"browse selected method(s);
where is: #newBrowser - open a new browser showing the method(s)
where is: #newBuffer - add a new buffer showing the method(s)"
^ self
spawnMethodBrowserFor:methods
in:where
label:labelOrNil
perMethodInfo:infoDictionaryOrNil
sortBy:sortHow
select:true
!
spawnMethodBrowserFor:methods in:where label:labelOrNil perMethodInfo:infoDictionaryOrNil sortBy:sortHow select:doSelect
"browse selected method(s);
where is: #newBrowser - open a new browser showing the method(s)
where is: #newBuffer - add a new buffer showing the method(s)"
^ self
spawnMethodBrowserFor:methods in:where label:labelOrNil
perClassInfo:nil perMethodInfo:infoDictionaryOrNil sortBy:sortHow select:doSelect.
"/ |theMethodList spec|
"/
"/ theMethodList := methods copy.
"/ infoDictionaryOrNil notNil ifTrue:[
"/ spec := #multipleMethodWithInfoBrowserSpec.
"/ ] ifFalse:[
"/ spec := #multipleMethodBrowserSpec.
"/ ].
"/
"/ ^ self
"/ newBrowserOrBufferDependingOn:where
"/ label:labelOrNil
"/ forSpec:spec
"/ setupWith:[:brwsr |
"/ |generator|
"/
"/ generator := Iterator on:[:whatToDo |
"/ theMethodList do:[:aMethod |
"/ whatToDo
"/ value:aMethod mclass
"/ value:aMethod category
"/ value:aMethod selector
"/ value:aMethod.
"/ ].
"/ "/ enforce display of class
"/ "/ theMethodList size == 1 ifTrue:[
"/ whatToDo
"/ value:nil
"/ value:nil
"/ value:nil
"/ value:nil.
"/ "/ ].
"/ ].
"/
"/ sortHow notNil ifTrue:[brwsr sortBy value:sortHow].
"/ brwsr selectorListGenerator value:generator.
"/ infoDictionaryOrNil notNil ifTrue:[
"/ brwsr selectedMethods
"/ onChangeEvaluate:[
"/ |mthd infoText|
"/
"/ mthd := brwsr theSingleSelectedMethod.
"/ mthd notNil ifTrue:[
"/ infoText := infoDictionaryOrNil at:mthd ifAbsent:nil
"/ ].
"/ brwsr methodInfo value:infoText.
"/ ]
"/ ] ifFalse:[
"/ (doSelect and:[theMethodList size == 1]) ifTrue:[
"/ brwsr selectMethods:(Array with:theMethodList first).
"/ brwsr methodsSelectionChanged.
"/ ]
"/ ].
"/ ]
"Modified: / 1.3.2000 / 21:03:34 / cg"
!
spawnMethodBrowserForSearch:searchBlock sortBy:sortByWhat in:openHow label:lbl
"browse selected method(s);
openHow is: #newBrowser - open a new browser showing the method(s)
openHow is: #newBuffer - add a new buffer showing the method(s)
and sortByWhat is:
#selector
or #class
"
|spec theMethodList|
theMethodList := searchBlock value.
theMethodList size == 0 ifTrue:[
self information:(lbl , ' - none found').
^ self.
].
spec := #methodListBrowserSpec.
^ self
newBrowserOrBufferDependingOn:openHow
label:lbl
forSpec:spec
setupWith:[:brwsr |
|generator|
generator := Iterator on:[:whatToDo |
brwsr window withWaitCursorDo:[
theMethodList isNil ifTrue:[
theMethodList := searchBlock value.
].
theMethodList notNil ifTrue:[
theMethodList do:[:aMethod |
whatToDo
value:aMethod mclass
value:aMethod category
value:aMethod selector
value:aMethod.
].
].
"enforce display of class in methodList"
whatToDo
value:nil
value:nil
value:nil
value:nil.
].
theMethodList := nil.
].
sortByWhat notNil ifTrue:[brwsr sortBy value:sortByWhat].
"/ sortByWhat notNil ifTrue:[brwsr sortBy:sortByWhat].
brwsr selectorListGenerator value:generator.
"/ auto-select the first methods, if there is only one
"/ theMethodList isNil ifTrue:[
"/ "/ newBuffer will evaluate the generator later;
"/ "/ newBrowser might have it already evaluated ... (sigh)
"/ self withWaitCursorDo:[
"/ theMethodList := searchBlock value
"/ ]
"/ ].
theMethodList size == 1 ifTrue:[
brwsr selectMethods:theMethodList.
brwsr methodsSelectionChanged.
].
]
"Modified: / 1.3.2000 / 21:03:34 / cg"
!
spawnMethodImplementorsBrowserFor:aSelectorCollection in:openHow
"open a new browser or add a buffer showing the selected methods only"
^ self
spawnMethodImplementorsBrowserFor:aSelectorCollection
match:true
in:openHow
"Modified: / 05-09-2006 / 10:49:28 / cg"
!
spawnMethodImplementorsBrowserFor:aSelectorCollection match:doMatch in:openHow
"open a new browser or add a buffer showing the selected methods"
self
spawnMethodImplementorsBrowserFor:aSelectorCollection
match:doMatch
in:openHow
classes:Smalltalk allClasses
label:'Implementors'
"Modified: / 05-09-2006 / 11:07:20 / cg"
!
spawnMethodImplementorsBrowserFor:aSelectorCollection match:doMatch in:openHow classes:classes label:labelPrefix
"open a new browser or add a buffer showing the selected methods only"
self withSearchCursorDo:[
|newBrowser label impls searchBlock cachedList theSingleSelector|
aSelectorCollection size == 1 ifTrue:[
theSingleSelector := aSelectorCollection first.
label := resources string:(labelPrefix,' of %1') with:(theSingleSelector allBold)
] ifFalse:[
label := resources string:labelPrefix.
].
searchBlock := [
|list|
(list := cachedList) notNil ifTrue:[
cachedList := nil
] ifFalse:[
list := IdentitySet new.
aSelectorCollection do:[:aSelector |
doMatch ifTrue:[
list addAll:(self class
findImplementorsMatching:aSelector
in:classes
ignoreCase:false
)
] ifFalse:[
list addAll:(self class
findImplementorsOf:aSelector
in:Smalltalk allClasses
ignoreCase:false
)
].
].
list := list asOrderedCollection
].
list
].
cachedList := searchBlock value.
(cachedList size == 1 and:[cachedList first == self theSingleSelectedMethod]) ifTrue:[
(Dialog confirm:label,' - ',(resources stringWithCRs:'only the selected method found.\\Browse anyway ?'))
ifFalse:[
^ self
]
].
newBrowser := self
spawnMethodBrowserForSearch:searchBlock
sortBy:nil
in:openHow
label:label.
aSelectorCollection size == 1 ifTrue:[
newBrowser sortBy value:#classes
].
newBrowser
]
"Created: / 05-09-2006 / 11:07:05 / cg"
"Modified: / 13-09-2006 / 11:39:42 / cg"
!
spawnMethodInheritanceBrowserFor:aSelectorCollection in:openHow
"open a new browser or add a buffer showing the selected methods inheritance only"
self withSearchCursorDo:[
|selectedMethods classes list newBrowser label searchBlock
initialList anyRedefined|
(selectedMethods := self selectedMethods value) size == 0 ifTrue:[
self warn:'No method selected.'.
^ self
].
"/ classes := self selectedClasses value.
classes isNil ifTrue:[
classes := selectedMethods
collect:[:eachMethod | eachMethod mclass]
thenSelect:[:eachClass | eachClass notNil].
].
searchBlock := [
|list subList already|
(list := initialList) size > 0 ifTrue:[
initialList := nil
] ifFalse:[
already := IdentitySet new.
list := OrderedCollection new.
aSelectorCollection do:[:eachSelector |
classes do:[:eachClass |
(eachClass withAllSuperclasses copy reverse , eachClass allSubclasses)
do:[:eachSuperAndSubclass |
|mthd|
(eachSuperAndSubclass includesSelector:eachSelector) ifTrue:[
mthd := eachSuperAndSubclass compiledMethodAt:eachSelector.
(already includes:mthd) ifFalse:[
eachSuperAndSubclass ~~ eachClass ifTrue:[anyRedefined := true].
list add:mthd.
already add:mthd.
]
]
]
].
].
].
list
].
anyRedefined := false.
initialList := searchBlock value.
anyRedefined ifFalse:[
|msg|
selectedMethods size == 1 ifTrue:[
msg := 'The method does not redefine any superclass method and is not redefined in any subclass.'.
] ifFalse:[
msg := 'None of the methods redefines any superclass method or is redefined in any subclass.'.
].
self warn:msg.
^ self
].
aSelectorCollection size == 1 ifTrue:[
label := 'Inheritance of %1' bindWith:(aSelectorCollection first)
] ifFalse:[
label := 'Inheritance'.
].
newBrowser := self
spawnMethodBrowserForSearch:searchBlock
sortBy:nil
in:openHow
label:label.
newBrowser selectMethods:(selectedMethods copy).
newBrowser sortBy value:false.
]
!
spawnMethodLocalImplementorsBrowserFor:aSelectorCollection in:openHow
"open a new browser or add a buffer showing the selected methods only"
^ self
spawnMethodImplementorsBrowserFor:aSelectorCollection
match:true
in:openHow
classes:(self selectedLocalMethodClasses)
label:'Local Implementors'
"Created: / 05-09-2006 / 10:49:50 / cg"
!
spawnMethodLocalSendersBrowserFor:aSelectorCollection in:openHow
"open a new browser or add a buffer showing the selected methods local senders"
self
spawnMethodSendersBrowserFor:aSelectorCollection
in:openHow
classes:(self selectedLocalMethodClasses)
label:'Local Senders'
"Created: / 05-09-2006 / 10:46:35 / cg"
!
spawnMethodSendersBrowserFor:aSelectorCollection in:openHow
"open a new browser or add a buffer showing the selected methods senders only"
self
spawnMethodSendersBrowserFor:aSelectorCollection
in:openHow
classes:Smalltalk allClasses
label:'Senders'
"Modified: / 05-09-2006 / 10:42:46 / cg"
!
spawnMethodSendersBrowserFor:aSelectorCollection in:openHow classes:setOfClasses label:labelPrefix
"open a new browser or add a buffer showing the selected methods senders from setOfClasses"
|label|
self withSearchCursorDo:[
|cachedList newBrowser theSingleSelector searchBlock|
aSelectorCollection size == 1 ifTrue:[
theSingleSelector := aSelectorCollection first.
label := resources string:(labelPrefix,' of %1') with:theSingleSelector allBold.
] ifFalse:[
label := resources string:labelPrefix.
].
searchBlock := [
|l|
cachedList notNil ifTrue:[
l := cachedList.
cachedList := nil
] ifFalse:[
l := IdentitySet new.
aSelectorCollection do:[:aSelector |
l addAll:(self class
findSendersOf:aSelector
in:setOfClasses
ignoreCase:false
match:false
)
].
l := l asOrderedCollection
].
l
].
theSingleSelector notNil ifTrue:[
cachedList := searchBlock value.
cachedList size == 0 ifTrue:[
self information:(label , ' - none found').
^ self
].
(cachedList size == 1 and:[cachedList first == self theSingleSelectedMethod]) ifTrue:[
(Dialog confirm:(label,' - ',(resources stringWithCRs:'only the selected method found.\\Browse anyway ?')))
ifFalse:[
^ self
]
].
].
newBrowser := self
spawnMethodBrowserForSearch:searchBlock
sortBy:#class
in:openHow
label:label.
theSingleSelector notNil ifTrue:[
newBrowser autoSearchSelector:theSingleSelector ignoreCase:false doMatch:false.
].
]
"Created: / 05-09-2006 / 10:43:21 / cg"
!
spawnProjectExtensionsBrowserFor:aMethodCollection in:openHow
"open a new browser or add a buffer showing the selected methods senders only"
|label|
self withSearchCursorDo:[
|packages cachedList newBrowser theSinglePackage searchBlock|
packages := (aMethodCollection collect:[:each | each package]) asSet.
packages size == 1 ifTrue:[
theSinglePackage := packages first.
label := 'Extensions for %1' bindWith:theSinglePackage.
] ifFalse:[
label := 'Extensions'.
].
searchBlock := [
|l|
cachedList notNil ifTrue:[
l := cachedList.
cachedList := nil
] ifFalse:[
l := OrderedCollection new.
Smalltalk allClasses
do:[:eachClass |
l addAll:(eachClass extensions
select:[:extensionMethod |
(packages includes:extensionMethod package)])
].
].
l
].
theSinglePackage notNil ifTrue:[
cachedList := searchBlock value.
cachedList size == 0 ifTrue:[
self information:(label , ' - none found').
^ self
].
(cachedList size == 1 and:[cachedList first == self theSingleSelectedMethod]) ifTrue:[
(self confirm:((label bindWith:label) , ' - only the selected method found.\\Browse anyway ?' withCRs))
ifFalse:[
^ self
]
].
].
newBrowser := self
spawnMethodBrowserForSearch:searchBlock
sortBy:#class
in:openHow
label:label.
]
"Modified: / 12-10-2006 / 20:59:02 / cg"
!
spawnSenderChainBrowser
"browse selected methods sender chain"
^ self spawnSenderChainIn:#newBrowser
!
spawnSenderChainBuffer
"browse selected methods sender chain"
^ self spawnSenderChainIn:#newBuffer
!
spawnSenderChainIn:openHow
"browse selected methods sender chain;
openHow is: #newBrowser - open a new browser showing the method(s)
openHow is: #newBuffer - add a new buffer showing the method(s)
"
|searchBlock "must be first local in block (see #methodsSelectionChangedAt:index, which fetches this value)"
spec aMethod multipleMethods methods lbl|
multipleMethods := self selectedMethods value size > 1.
multipleMethods ifTrue:[
methods := self selectedMethods value copy.
lbl := resources string:'Sender chains'.
] ifFalse:[
aMethod := self theSingleSelectedMethod.
lbl := resources string:'Sender chain of %1' with:aMethod selector.
].
spec := #chainBrowserSpec.
^ self
newBrowserOrBufferDependingOn:openHow
label:lbl
forSpec:spec
setupWith:[:brwsr |
|generator theMethodList|
searchBlock := [:whichMethod | |selector|
selector := whichMethod selector.
selector isNil ifTrue:[
#()
] ifFalse:[
self class allCallsOn:selector in:(Smalltalk allClasses) ignoreCase:false match:false.
].
].
generator := Iterator on:[:whatToDo |
theMethodList isNil ifTrue:[
theMethodList := searchBlock value:aMethod.
].
theMethodList do:[:aMethod |
whatToDo
value:aMethod mclass
value:aMethod category
value:aMethod selector
value:aMethod.
].
"enforce display of class in methodList"
whatToDo
value:nil
value:nil
value:nil
value:nil.
multipleMethods ifFalse:[
theMethodList := nil.
]
].
multipleMethods ifTrue:[
theMethodList := methods.
].
brwsr selectorListGenerator1 value:generator.
"/ auto-select the first methods, if there is only one
multipleMethods ifFalse:[
theMethodList isNil ifTrue:[
"/ newBuffer will evaluate the generator later;
"/ newBrowser might have it already evaluated ... (sigh)
theMethodList := searchBlock value:aMethod.
].
theMethodList size == 1 ifTrue:[
brwsr selectedMethods1 value:theMethodList.
brwsr methodsSelectionChanged.
].
].
]
"Modified: / 1.3.2000 / 21:03:34 / cg"
! !
!NewSystemBrowser methodsFor:'menu actions-variables'!
browseVarRefsOrModsWithTitle:browserTitle boxTitle:boxTitle variables:varType access:accessType all:browseAll
"show an enterbox for instVar/classVar to search for.
Then open a new browser or add a buffer showing methods referring/modifying to that var"
|box b varNames varNameList openHow classes|
openHow := #newBuffer.
box := self enterBoxForVariableSearch:boxTitle.
box action:[:enteredString | varNames := enteredString].
b := Button label:(resources string:'Browser').
(DialogBox defaultOKButtonAtLeft) ifFalse:[
box addButton:b before:box okButton.
] ifTrue:[
box addButton:b after:box okButton.
].
b action:[
openHow := #newBrowser.
box doAccept.
box okPressed.
].
box label:(resources string:'Search Variable References').
box showAtPointer.
box destroy.
varNames size == 0 ifTrue:[^ self].
varNameList := varNames string asCollectionOfSubstringsSeparatedByAny:' ;,/|'.
classes := self classesToSearchForVariable.
self
browseVarRefsToAny:varNameList
classes:classes
variables:varType access:accessType all:browseAll
title:browserTitle in:openHow
!
browseVarRefsToAny:varNameList classes:classesIn variables:varType access:accessType all:browseAll title:browserTitle in:openHow
"Open a new browser or add a buffer showing methods referring/modifying to any var in varNames.
accessType is one of #readOrWrite, #read or #write."
|varNames brwsr classes searchBlock methods|
varNameList size == 0 ifTrue:[^ self].
varNames := varNameList asStringWith:'|'.
"/ the find* methods expect nonMetaclasses ...
classes := classesIn collect:[:each | each theNonMetaclass].
searchBlock := [
|allMethods|
methods notNil ifTrue:[
allMethods := methods.
methods := nil.
] ifFalse:[
allMethods := IdentitySet new.
varNameList do:[:aVariableName |
|homeClasses methods1 methods2|
browseAll ifTrue:[
homeClasses := self findClassesOfVariable:aVariableName accessWith:varType in:classes.
homeClasses do:[:homeClass |
varType == #classVarNames ifTrue:[
methods1 := self class findClassRefsTo:aVariableName under:homeClass theNonMetaclass access:accessType.
methods2 := self class findClassRefsTo:aVariableName under:homeClass theMetaclass access:accessType.
] ifFalse:[
varType == #classInstVarNames ifTrue:[
methods1 := self class findInstRefsTo:aVariableName under:homeClass theMetaclass access:accessType
] ifFalse:[
methods1 := self class findInstRefsTo:aVariableName under:homeClass theNonMetaclass access:accessType
]
].
allMethods addAll:methods1.
methods2 notNil ifTrue:[allMethods addAll:methods2].
].
] ifFalse:[
classes do:[:eachClass |
varType == #classVarNames ifTrue:[
methods1 := self class findClassRefsTo:aVariableName inClass:eachClass theNonMetaclass access:accessType.
methods2 := self class findClassRefsTo:aVariableName inClass:eachClass theMetaclass access:accessType.
] ifFalse:[
varType == #classInstVarNames ifTrue:[
methods1 := self class findInstRefsTo:aVariableName inClass:eachClass theMetaclass access:accessType
] ifFalse:[
methods1 := self class findInstRefsTo:aVariableName inClass:eachClass theNonMetaclass access:accessType
]
].
allMethods addAll:methods1.
methods2 notNil ifTrue:[allMethods addAll:methods2].
].
].
].
allMethods := allMethods asOrderedCollection
].
allMethods
].
self busyLabel:'searching...'.
methods := searchBlock value.
self normalLabel.
methods size == 0 ifTrue:[
self information:((browserTitle bindWith:varNames allBold) , ' - none found').
^ self
].
brwsr := self spawnMethodBrowserForSearch:searchBlock
sortBy:#class
in:openHow
label:(browserTitle bindWith:varNames).
brwsr variableFilter value:varNameList.
self autoSearchVariables:varNameList readers:(accessType ~~ #write) writers:(accessType ~~ #read).
!
findClassesOfVariable:aVariableName accessWith:aSelector in:collectionOfClasses
"this method returns the classes, in which a variable is defined;
needs either #instVarNames, #classInstVarNames or #classVarNames as aSelector."
|cls homeClass list homeClasses|
homeClasses := IdentitySet new.
collectionOfClasses do:[:currentClass |
cls := currentClass.
[cls notNil] whileTrue:[
"
first, find the class, where the variable is declared
"
aSelector == #classInstVarNames ifTrue:[
list := cls class instVarNames
] ifFalse:[
list := cls perform:aSelector
].
(list includes:aVariableName) ifTrue:[
homeClass := cls.
cls := nil.
] ifFalse:[
cls := cls superclass
]
].
homeClass isNil ifTrue:[
"nope, must be one below ... (could optimize a bit, by searching down
for the declaring class ...
"
homeClass := currentClass
] ifFalse:[
"/ Transcript showCR:'starting search in ' , homeClass name.
].
homeClasses add:homeClass.
].
^ homeClasses
!
instVarNamesOfAllSelectedClasses
|names|
names := Set new.
self selectedClassesDo:[:eachClass | names addAll:eachClass instVarNames. ].
^ names
!
showingClassVarsInVariableList
"true if classVars are shown; false if classInstVars are shown"
^ navigationState variableListApplication showClassVarsInVariableList value
!
variablesMenuAdd
"add a new variable."
^ self variablesMenuAdd:(self showingClassVarsInVariableList) asValueHolder:false
!
variablesMenuAdd:asClassVariableBoolean
"add a new variable."
self variablesMenuAdd:asClassVariableBoolean asValueHolder:false
!
variablesMenuAdd:asClassVariableBoolean asValueHolder:asValueHolder
"add new variable(s)."
|words variablesToAdd initial selectedClass boxTitle msg generateAccessorsHolder|
"/ (self askIfModified) ~~ true ifTrue:[ ^ self ].
initial := ''.
words := (self selectionInCodeView ? '') asCollectionOfWords.
words size == 1 ifTrue:[
initial := words first.
].
boxTitle := 'Add Variable'.
asValueHolder ifTrue:[
(initial isEmpty or:[initial endsWith:'Holder']) ifFalse:[
initial := initial , 'Holder'
].
boxTitle := 'Add ValueHolder'.
].
msg := 'Name of new %1 %2'.
msg := msg
bindWith:
(asClassVariableBoolean
ifTrue:['Class']
ifFalse:[
self meta value
ifTrue:['Class Instance']
ifFalse:['Instance']
])
with:
(asValueHolder
ifTrue:['ValueHolder(s)']
ifFalse:['Variable(s)']).
generateAccessorsHolder := true asValue.
Dialog aboutToOpenBoxNotificationSignal handle:[:ex |
|box|
box := ex parameter.
box verticalPanel
add:((CheckBox
label:(resources string:'Generate Getters and Setters'))
model:generateAccessorsHolder).
ex proceed
] do:[
variablesToAdd :=
Dialog
request:(resources string:msg)
title:(resources string:boxTitle)
initialAnswer:initial.
].
variablesToAdd size == 0 ifTrue:[^ self].
selectedClass := self theSingleSelectedClass.
variablesToAdd := variablesToAdd asCollectionOfWords.
variablesToAdd do:[:variableToAdd |
asClassVariableBoolean ifTrue:[
self codeMenuAddClassVariable:variableToAdd inClass:selectedClass asValueHolder:asValueHolder
] ifFalse:[
self codeMenuAddInstanceVariable:variableToAdd inClass:selectedClass asValueHolder:asValueHolder
]
].
generateAccessorsHolder value ifTrue:[
self
variablesMenuGenerateAccessMethodsFor:variablesToAdd
withChange:false
asValueHolder:false
readersOnly:false
writersOnly:false
lazyInitialization:false.
].
!
variablesMenuAddClassVariable
"add a new variable."
^ self variablesMenuAdd:true asValueHolder:false
!
variablesMenuAddInstanceVariable
"add a new variable."
^ self variablesMenuAdd:false asValueHolder:false
!
variablesMenuAddValueHolder
"add a new variable."
^ self variablesMenuAdd:(self showingClassVarsInVariableList) asValueHolder:true
!
variablesMenuBrowseAllClassInstVarMods
"show an enterbox for classInstVar to search for.
Then open a new browser or add a buffer showing all methods modifying to that var"
self
browseVarRefsOrModsWithTitle:'all writers of class-instance variable %1'
boxTitle:'class-instance variable to browse writers:'
variables:#classInstVarNames access:#write all:true
!
variablesMenuBrowseAllClassInstVarReads
"show an enterbox for classInstVar to search for.
Then open a new browser or add a buffer showing all methods reading to that var"
self
browseVarRefsOrModsWithTitle:'all readers of class-instance variable %1'
boxTitle:'class-instance variable to browse readers:'
variables:#classInstVarNames access:#read all:true
!
variablesMenuBrowseAllClassInstVarRefs
"show an enterbox for classInstVar to search for.
Then open a new browser or add a buffer showing all methods referring to that var"
self
browseVarRefsOrModsWithTitle:'All references to class-instance variable %1'
boxTitle:'Class-instance variable to browse all references to:'
variables:#classInstVarNames access:#readOrWrite all:true
!
variablesMenuBrowseAllClassVarMods
"show an enterbox for classVar to search for.
Then open a new browser or add a buffer showing all methods modifying to that var"
self
browseVarRefsOrModsWithTitle:'All writers of class variable %1'
boxTitle:'Class variable to browse all writers:'
variables:#classVarNames access:#write all:true
!
variablesMenuBrowseAllClassVarReads
"show an enterbox for classVar to search for.
Then open a new browser or add a buffer showing all methods reading to that var"
self
browseVarRefsOrModsWithTitle:'all readers of class variable %1'
boxTitle:'class variable to browse readers:'
variables:#classVarNames access:#read all:true
!
variablesMenuBrowseAllClassVarRefs
"show an enterbox for classVar to search for.
Then open a new browser or add a buffer showing all methods referring to that var"
self
browseVarRefsOrModsWithTitle:'All references to class variable %1'
boxTitle:'Class variable to browse all references to:'
variables:#classVarNames access:#readOrWrite all:true
!
variablesMenuBrowseAllInstVarMods
"show an enterbox for instVar to search for.
Then open a new browser or add a buffer showing all methods modifying to that var"
self
browseVarRefsOrModsWithTitle:'All writers of instance variable %1'
boxTitle:'Instance variable to browse all writers:'
variables:#instVarNames access:#write all:true
!
variablesMenuBrowseAllInstVarOrClassInstVarMods
"show an enterbox for instVar to search for.
Then open a new browser or add a buffer showing all methods writing that var"
self meta value ifTrue:[
self variablesMenuBrowseAllClassInstVarMods.
] ifFalse:[
self variablesMenuBrowseAllInstVarMods.
].
!
variablesMenuBrowseAllInstVarOrClassInstVarReads
"show an enterbox for instVar to search for.
Then open a new browser or add a buffer showing all methods reading that var"
self meta value ifTrue:[
self variablesMenuBrowseAllClassInstVarReads.
] ifFalse:[
self variablesMenuBrowseAllInstVarReads.
].
!
variablesMenuBrowseAllInstVarOrClassInstVarRefs
"show an enterbox for instVar to search for.
Then open a new browser or add a buffer showing all methods referring to that var"
self meta value ifTrue:[
self variablesMenuBrowseAllClassInstVarRefs.
] ifFalse:[
self variablesMenuBrowseAllInstVarRefs.
].
!
variablesMenuBrowseAllInstVarReads
"show an enterbox for instVar to search for.
Then open a new browser or add a buffer showing all methods reading that var"
self
browseVarRefsOrModsWithTitle:'All readers of instance variable %1'
boxTitle:'Instance variable to browse all readers:'
variables:#instVarNames access:#read all:true
!
variablesMenuBrowseAllInstVarRefs
"show an enterbox for instVar to search for.
Then open a new browser or add a buffer showing all methods referring to that var"
self
browseVarRefsOrModsWithTitle:'All references to instance variable %1'
boxTitle:'Instance variable to browse all references to:'
variables:#instVarNames access:#readOrWrite all:true
!
variablesMenuBrowseClassInstVarMods
"show an enterbox for classInstVar to search for.
Then open a new browser or add a buffer showing methods modifying to that var"
self
browseVarRefsOrModsWithTitle:'writers of class-instance variable %1'
boxTitle:'class-instance variable to browse writers:'
variables:#classInstVarNames access:#write all:false
!
variablesMenuBrowseClassInstVarReads
"show an enterbox for classInstVar to search for.
Then open a new browser or add a buffer showing methods reading that var"
self
browseVarRefsOrModsWithTitle:'readers of class-instance variable %1'
boxTitle:'class-instance variable to browse readers:'
variables:#classInstVarNames access:#read all:false
!
variablesMenuBrowseClassInstVarRefs
"show an enterbox for classInstVar to search for.
Then open a new browser or add a buffer showing methods referring to that var"
self
browseVarRefsOrModsWithTitle:'references to class-instance variable %1'
boxTitle:'class-instance variable to browse references to:'
variables:#classInstVarNames access:#readOrWrite all:false
!
variablesMenuBrowseClassVarMods
"show an enterbox for classVar to search for.
Then open a new browser or add a buffer showing methods modifying to that var"
self
browseVarRefsOrModsWithTitle:'writers of class variable %1'
boxTitle:'class variable to browse writers:'
variables:#classVarNames access:#write all:false
!
variablesMenuBrowseClassVarReads
"show an enterbox for classVar to search for.
Then open a new browser or add a buffer showing methods reading that var"
self
browseVarRefsOrModsWithTitle:'readers of class variable %1'
boxTitle:'class variable to browse readers:'
variables:#classVarNames access:#read all:false
!
variablesMenuBrowseClassVarRefs
"show an enterbox for classVar to search for.
Then open a new browser or add a buffer showing methods referring to that var"
self
browseVarRefsOrModsWithTitle:'references to class variable %1'
boxTitle:'class variable to browse references to:'
variables:#classVarNames access:#readOrWrite all:false
!
variablesMenuBrowseInstVarMods
"show an enterbox for instVar to search for.
Then open a new browser or add a buffer showing methods modifying to that var"
self
browseVarRefsOrModsWithTitle:'writers of instance variable %1'
boxTitle:'instance variable to browse writers:'
variables:#instVarNames access:#write all:false
!
variablesMenuBrowseInstVarReads
"show an enterbox for instVar to search for.
Then open a new browser or add a buffer showing methods modifying to that var"
self
browseVarRefsOrModsWithTitle:'readers of instance variable %1'
boxTitle:'instance variable to browse readers:'
variables:#instVarNames access:#read all:false
!
variablesMenuBrowseInstVarRefs
"show an enterbox for instVar to search for.
Then open a new browser or add a buffer showing methods referring to that var"
self
browseVarRefsOrModsWithTitle:'references to instance variable %1'
boxTitle:'instance variable to browse references to:'
variables:#instVarNames access:#readOrWrite all:false
!
variablesMenuCopySelectedName
"copy selected variable name(s) to clipboard"
|names first|
first := true.
names :=
String streamContents:[:s |
self selectedVariables value do:[:variableName |
first ifTrue:[
first := false
] ifFalse:[
s space.
].
s nextPutAll:variableName.
]
].
self window setClipboardText:names
!
variablesMenuFindVariable
self shouldImplement
!
variablesMenuGenerateAccessMethods
"create access methods for selected instvars."
self
variablesMenuGenerateAccessMethodsWithChange:false
asValueHolder:false
readersOnly:false
writersOnly:false
lazyInitialization:false
!
variablesMenuGenerateAccessMethodsFor:names withChange:withChange asValueHolder:asValueHolder readersOnly:readersOnly writersOnly:writersOnly lazyInitialization:lazyInitialization
"common helper to create access methods."
|what|
names isEmptyOrNil ifTrue:[^ self].
what := readersOnly
ifTrue:'Getters'
ifFalse:[
writersOnly
ifTrue:'Setters'
ifFalse:'Accessors'].
self
generateUndoableChangeOverSelectedClasses:'Generate ',what,' in %(singleClassNameOrNumberOfClasses)'
via:[:generator :eachClass |
|classVars instVars|
classVars := names select:[:var | eachClass classVarNames includes:var].
classVars notEmpty ifTrue:[
generator
createAccessMethodsFor:classVars
in:eachClass theMetaclass
withChange:withChange
asValueHolder:asValueHolder
readersOnly:readersOnly
writersOnly:writersOnly
lazyInitialization:lazyInitialization
].
instVars := names reject:[:var | classVars includes:var].
instVars notEmpty ifTrue:[
generator
createAccessMethodsFor:instVars
in:eachClass
withChange:withChange
asValueHolder:asValueHolder
readersOnly:readersOnly
writersOnly:writersOnly
lazyInitialization:lazyInitialization
]
]
!
variablesMenuGenerateAccessMethodsForAll
|names|
names := self instVarNamesOfAllSelectedClasses.
self
variablesMenuGenerateAccessMethodsFor:names
withChange:false
asValueHolder:false
readersOnly:false
writersOnly:false
lazyInitialization:false
!
variablesMenuGenerateAccessMethodsForValueHolder
"create access methods for selected instvars as valueHolders."
self
variablesMenuGenerateAccessMethodsWithChange:false
asValueHolder:true
readersOnly:false
writersOnly:false
lazyInitialization:false
!
variablesMenuGenerateAccessMethodsForValueHolderWithChange
"create access methods for selected instvars as valueHolders with change notification."
self
variablesMenuGenerateAccessMethodsWithChange:true
asValueHolder:true
readersOnly:false
writersOnly:false
lazyInitialization:false
!
variablesMenuGenerateAccessMethodsWithChange
"create access methods with change notification for selected instvars."
self
variablesMenuGenerateAccessMethodsWithChange:true
asValueHolder:false
readersOnly:false
writersOnly:false
lazyInitialization:false
!
variablesMenuGenerateAccessMethodsWithChange:withChange asValueHolder:asValueHolder readersOnly:readersOnly writersOnly:writersOnly
"common helper to create access methods."
^ self
variablesMenuGenerateAccessMethodsWithChange:withChange
asValueHolder:asValueHolder
readersOnly:readersOnly
writersOnly:writersOnly
lazyInitialization:false
!
variablesMenuGenerateAccessMethodsWithChange:withChange asValueHolder:asValueHolder readersOnly:readersOnly writersOnly:writersOnly lazyInitialization:lazyInitialization
"common helper to create access methods."
|names|
names := self variableFilter value.
self
variablesMenuGenerateAccessMethodsFor:names
withChange:withChange asValueHolder:asValueHolder readersOnly:readersOnly writersOnly:writersOnly lazyInitialization:lazyInitialization
!
variablesMenuGenerateAccessMethodsWithLazyInitialization
"create access methods for selected instvars with lazy ini."
self
variablesMenuGenerateAccessMethodsWithChange:false
asValueHolder:false
readersOnly:false
writersOnly:false
lazyInitialization:true
!
variablesMenuGenerateCollectionAccessMethods
|names|
names := self instVarNamesOfAllSelectedClasses.
self
variablesMenuGenerateCollectionAccessMethodsFor:names withChange:false
"Created: / 04-02-2007 / 15:56:24 / cg"
!
variablesMenuGenerateCollectionAccessMethodsFor:names withChange:withChange
"common helper to create access methods."
self
generateUndoableChangeOverSelectedClasses:'Generate collection access in %(singleClassNameOrNumberOfClasses)'
via:[:generator :eachClass |
names size > 0 ifTrue:[
generator
createCollectionAccessMethodsFor:names
in:eachClass
withChange:withChange
]
]
"Created: / 04-02-2007 / 15:57:22 / cg"
!
variablesMenuGenerateGetterMethods
"create access methods for selected instvars."
self
variablesMenuGenerateAccessMethodsWithChange:false
asValueHolder:false
readersOnly:true
writersOnly:false
lazyInitialization:false
!
variablesMenuGenerateGetterMethodsForAll
|names|
names := self instVarNamesOfAllSelectedClasses.
self
variablesMenuGenerateAccessMethodsFor:names
withChange:false
asValueHolder:false
readersOnly:true
writersOnly:false
lazyInitialization:false
!
variablesMenuGenerateSetterMethods
"create setter methods for selected instvars."
self
variablesMenuGenerateAccessMethodsWithChange:false
asValueHolder:false
readersOnly:false
writersOnly:true
lazyInitialization:false
!
variablesMenuGenerateSetterMethodsForAll
|names|
names := self instVarNamesOfAllSelectedClasses.
self
variablesMenuGenerateAccessMethodsFor:names
withChange:false
asValueHolder:false
readersOnly:false
writersOnly:true
lazyInitialization:false
!
variablesMenuInspect
"inspect the selected variable(s)."
|cls|
cls := self theSingleSelectedClass.
cls isNil ifTrue:[
Dialog warn:'Please select a single class.'.
^ self.
].
cls := cls theNonMetaclass.
self withSelectedVariableDo:[:variableToInspect :isClassVar |
|value|
isClassVar ifTrue:[
value := cls classVarAt:variableToInspect
] ifFalse:[
value := cls instVarNamed:variableToInspect
].
value inspect
]
!
variablesMenuPullUp
"pull selected variable into superclass."
self withSelectedVariableDo:[:variableToPull :isClassVar |
|cls|
cls := self theSingleSelectedClass.
isClassVar ifTrue:[
self codeMenuPullUpClassVariable:variableToPull inClass:(cls theNonMetaclass)
] ifFalse:[
self codeMenuPullUpInstanceVariable:variableToPull inClass:cls
]
]
!
variablesMenuPushDown
"push selected variable into subclass."
self withSelectedVariableDo:[:variableToPush :isClassVar |
|cls|
cls := self theSingleSelectedClass.
isClassVar ifTrue:[
self codeMenuPushDownClassVariable:variableToPush inClass:(cls theNonMetaclass)
] ifFalse:[
self codeMenuPushDownInstanceVariable:variableToPush inClass:cls
]
]
!
variablesMenuRemove
"remove selected variable(s)."
|variablesToRemove classVar cls|
(variablesToRemove := self selectedVariables value) size > 0 ifTrue:[
classVar := self showingClassVarsInVariableList.
] ifFalse:[
variablesToRemove := Array with:(self selectionInCodeView).
classVar := self hasClassVariableSelectedInCodeView.
].
"/ cls := self theSingleSelectedClass.
cls := Behavior commonSuperclassOf:(self selectedClasses value).
variablesToRemove do:[:variableToRemove |
classVar ifTrue:[
self codeMenuRemoveClassVariable:variableToRemove inClass:(cls theNonMetaclass)
] ifFalse:[
self codeMenuRemoveInstanceVariable:variableToRemove inClass:cls
]
].
"Modified: / 12-10-2006 / 21:55:29 / cg"
!
variablesMenuRemoveClassVariable
"remove selected class variable."
|variableToRemove cls|
self showingClassVarsInVariableList ifTrue:[
variableToRemove := self theSingleSelectedVariable.
].
variableToRemove isNil ifTrue:[
self hasClassVariableSelectedInCodeView ifTrue:[
variableToRemove := self selectionInCodeView.
]
].
cls := self theSingleSelectedClass.
self codeMenuRemoveClassVariable:variableToRemove inClass:(cls theNonMetaclass)
!
variablesMenuRemoveInstanceVariable
"remove selected instance variable."
|variableToRemove cls|
self showingClassVarsInVariableList ifFalse:[
variableToRemove := self theSingleSelectedVariable.
].
variableToRemove isNil ifTrue:[
self hasInstanceVariableSelectedInCodeView ifTrue:[
variableToRemove := self selectionInCodeView.
]
].
cls := self theSingleSelectedClass.
self codeMenuRemoveInstanceVariable:variableToRemove inClass:cls
!
variablesMenuRename
"rename selected variable."
self withSelectedVariableDo:[:variableToRename :isClassVar |
|cls|
cls := self theSingleSelectedClass.
isClassVar ifTrue:[
self codeMenuRenameClassVariable:variableToRename inClass:(cls theNonMetaclass)
] ifFalse:[
self codeMenuRenameInstanceVariable:variableToRename inClass:cls
]
]
!
variablesMenuRenameClassVariable
"rename selected variable."
|variableToRename|
self showingClassVarsInVariableList ifTrue:[
variableToRename := self theSingleSelectedVariable.
].
variableToRename isNil ifTrue:[
self hasClassVariableSelectedInCodeView ifTrue:[
variableToRename := self selectionInCodeView.
]
].
self
codeMenuRenameClassVariable:variableToRename
inClass:(self theSingleSelectedClass theNonMetaclass)
!
variablesMenuRenameInstanceVariable
"rename selected variable."
|variableToRename|
self showingClassVarsInVariableList ifFalse:[
variableToRename := self theSingleSelectedVariable.
].
variableToRename isNil ifTrue:[
self hasInstanceVariableSelectedInCodeView ifTrue:[
variableToRename := self selectionInCodeView.
]
].
self
codeMenuRenameInstanceVariable:variableToRename
inClass:(self theSingleSelectedClass theNonMetaclass)
!
variablesMenuTypeBrowe
"browse typical types of a variable"
self variablesMenuTypeInfoOrBrowseTypes:true.
!
variablesMenuTypeInfo
"show typical usage of a variable"
self variablesMenuTypeInfoOrBrowseTypes:false.
!
variablesMenuTypeInfoHelper
"common code for show typical usage of a variable, inspect or browse it"
|name idx classes values value msg cut names instCount subInstCount
searchClass s canInspect canInspectMultiple showingInstVars showingClassVars currentClass
nilIncluded commonSuperClass info|
name := self theSingleSelectedVariable.
name isNil ifTrue:[^ nil].
name := name allBold.
canInspect := canInspectMultiple := false.
showingClassVars := self showingClassVarsInVariableList.
showingClassVars ifFalse:[
showingInstVars := self meta value not
].
currentClass := self theSingleSelectedClass.
showingClassVars ifTrue:[
currentClass isNil ifTrue:[
self selectedNonMetaclassesDo:[:cls |
|sCls|
sCls := (cls whichClassDefinesClassVar:name).
sCls notNil ifTrue:[ searchClass := sCls ]
].
] ifFalse:[
searchClass := currentClass theNonMetaclass whichClassDefinesClassVar:name.
].
value := searchClass classVarAt:(name asSymbol).
values := Array with:value.
s := value displayString.
s size > 60 ifTrue:[
s := (s copyTo:60) , ' ...'
].
msg := name , ' is (currently):\\' , s.
s ~= value classNameWithArticle ifTrue:[
msg := msg , '\\(' , value class name , ')'
].
canInspect := true.
] ifFalse:[
searchClass := currentClass whichClassDefinesInstVar:name.
idx := searchClass instVarOffsetOf:name.
idx isNil ifTrue:[^ nil].
classes := IdentitySet new.
values := IdentitySet new.
instCount := 0.
subInstCount := 0.
searchClass allSubInstancesDo:[:i |
|val|
val := i instVarAt:idx.
val notNil ifTrue:[values add:val].
classes add:val class name.
(i isMemberOf:searchClass) ifTrue:[
instCount := instCount + 1.
] ifFalse:[
subInstCount := subInstCount + 1
]
].
classes := classes collect:[:eachName | Smalltalk classNamed:eachName].
(instCount == 0 and:[subInstCount == 0]) ifTrue:[
self warn:(resources
string:'There are currently no instances or subInstances of %1.'
with:currentClass name allBold).
^ nil
].
instCount ~~ 0 ifTrue:[
msg := 'in (currently: ' , instCount printString,') instances '.
subInstCount ~~ 0 ifTrue:[
msg := msg , 'and '
]
] ifFalse:[
msg := 'in '.
].
subInstCount ~~ 0 ifTrue:[
msg := msg , '(currently: ' , subInstCount printString, ') derived instances '
].
msg := msg, 'of ' , searchClass name , ',\'.
msg := msg , name allBold , ' '.
canInspectMultiple := values size > 0.
((values size == 1)
or:[classes size == 1 and:[classes first == UndefinedObject]]) ifTrue:[
values size == 1 ifTrue:[
value := values first.
].
(value isNil or:[value == true or:[value == false]]) ifTrue:[
(instCount+subInstCount) == 1 ifTrue:[
msg := msg , 'is'
] ifFalse:[
msg := msg , 'is always'.
classes size > 1 ifTrue:[
"/ must be nil
msg := msg , ' nil or'
].
].
msg := msg , ':\\ ' , value printString.
] ifFalse:[
(instCount+subInstCount) == 1 ifTrue:[
msg := msg , 'is'
] ifFalse:[
classes size > 1 ifTrue:[
"/ must be nil
msg := msg , 'is always nil or the same'
] ifFalse:[
msg := msg , 'is always the same'
]
].
msg := msg , ':\\'.
msg := msg , ' ' , value class name.
value isLiteral ifTrue:[
msg := msg , ' (' , (value storeString copyToMax:50) , ')'
].
canInspect := true.
]
] ifFalse:[
classes size == 1 ifTrue:[
msg := msg , 'is always:\\' , ' ' , classes first name , '\'.
] ifFalse:[
msg := msg , 'is one of:\\'.
classes := classes asOrderedCollection.
classes size > 20 ifTrue:[
classes := classes copyFrom:1 to:20.
cut := true
] ifFalse:[
cut := false.
].
names := classes collect:[:cls |
cls == UndefinedObject ifTrue:[
'nil'
] ifFalse:[
cls == True ifTrue:[
'true'
] ifFalse:[
cls == False ifTrue:[
'false'
] ifFalse:[
cls name
]
]
].
].
names sort.
names do:[:nm |
msg := msg , ' ' , nm , '\'.
].
]
].
"/ generate a type-decl string
(nilIncluded := (classes includes:UndefinedObject)) ifTrue:[
classes remove:UndefinedObject.
].
classes size > 0 ifTrue:[
commonSuperClass := Behavior commonSuperclassOf:(classes collect:[:each| each name]).
((commonSuperClass == True) or:[commonSuperClass == False]) ifTrue:[
commonSuperClass := Boolean
].
(commonSuperClass == SmallInteger) ifTrue:[
commonSuperClass := Integer
].
commonSuperClass == Object class ifTrue:[
commonSuperClass := Class
].
msg := msg , '\\'.
msg := msg , 'suggested type (for documentation):\\'.
msg := msg , ' <' , commonSuperClass name.
nilIncluded ifTrue:[
msg := msg , ' | nil'
].
msg := msg , '>'.
]
].
info := Dictionary new
at:#message put:msg;
at:#values put:values;
at:#classes put:classes;
at:#searchClass put:searchClass;
yourself.
^ info
!
variablesMenuTypeInfoOrBrowseTypes:doBrowseTypes
"show typical usage of a variable"
|name classes values value msg searchClass canInspect canInspectMultiple showingInstVars showingClassVars currentClass boxLabels boxValues answer info|
name := self theSingleSelectedVariable.
name isNil ifTrue:[^ self].
name := name allBold.
showingClassVars := self showingClassVarsInVariableList.
showingClassVars ifFalse:[
showingInstVars := self meta value not
].
currentClass := self theSingleSelectedClass.
info := self variablesMenuTypeInfoHelper.
info isNil ifTrue:[^ self].
msg := info at:#message.
classes := info at:#classes.
values := info at:#values.
searchClass := info at:#searchClass.
canInspect := values size > 0.
canInspectMultiple := values size > 1.
doBrowseTypes ifTrue:[
classes size > 0 ifTrue:[
self spawnClassBrowserFor:classes in:#newBuffer.
^ self
].
].
boxLabels := #('OK').
boxValues := #(true).
(canInspect or:[canInspectMultiple]) ifTrue:[
canInspectMultiple ifTrue:[
boxLabels := boxLabels , #('Inspect all Values').
boxValues := boxValues , #(#inspectValues).
boxLabels := boxLabels , #('Inspect a Value').
boxValues := boxValues , #(#inspectAValue).
] ifFalse:[
boxLabels := boxLabels , #('Inspect Value').
boxValues := boxValues , #(#inspectAValue).
].
showingClassVars ifFalse:[
canInspectMultiple ifTrue:[
boxLabels := boxLabels , #('Inspect all Instances').
boxValues := boxValues , #(#inspectInstances).
boxLabels := boxLabels , #('Inspect an Instance').
boxValues := boxValues , #(#inspectAnInstance).
] ifFalse:[
boxLabels := boxLabels , #('Inspect Instance').
boxValues := boxValues , #(#inspectAnInstance).
].
].
].
Dialog defaultOKButtonAtLeft ifFalse:[
boxLabels reverse.
boxValues reverse.
].
answer := OptionBox
request:msg withCRs
label:'Variable Type Information'
image:(InfoBox iconBitmap)
buttonLabels:boxLabels
values:boxValues
default:true
onCancel:nil.
answer == #inspectAValue ifTrue:[
canInspect ifTrue:[
value inspect
] ifFalse:[
value := values inject:nil into:[:max :this | this size > max size ifTrue:[this] ifFalse:[max]].
value notNil ifTrue:[
value inspect
] ifFalse:[
values first inspect
].
].
^ self
].
answer == #inspectValues ifTrue:[
(canInspect ifTrue:value ifFalse:values) inspect.
^ self
].
answer == #inspectInstances ifTrue:[
searchClass allSubInstances inspect.
^ self
].
answer == #inspectAnInstance ifTrue:[
searchClass allSubInstances first inspect.
^ self
].
"Modified: / 12-09-2006 / 13:59:24 / cg"
!
variablesRemoveWithConfirmation
"remove selected variable(s)."
|variablesToRemove|
variablesToRemove := self selectedVariables value.
variablesToRemove size == 0 ifTrue:[^ self ].
"/ because we'll ask again if the variable is still references,
"/ do not ask here...
"/ variablesToRemove size == 1 ifTrue:[
"/ msg := 'Remove variable ''%1'' ?'
"/ ] ifFalse:[
"/ msg := 'Remove %2 selected variables ?'.
"/ ].
"/ (self confirm:(resources
"/ string:msg
"/ with:variablesToRemove first allBold
"/ with:variablesToRemove size)) ifFalse:[^ self ]
self variablesMenuRemove
!
withSelectedVariableDo:aBlock
"pull/push common code"
|selectedVariable isClassVar|
selectedVariable := self theSingleSelectedVariable.
selectedVariable notNil ifTrue:[
isClassVar := self showingClassVarsInVariableList.
] ifFalse:[
selectedVariable := self selectionInCodeView.
selectedVariable isNil ifTrue:[
^ self
].
isClassVar := self hasClassVariableSelectedInCodeView.
].
aBlock value:selectedVariable value:isClassVar
! !
!NewSystemBrowser methodsFor:'menus-dynamic'!
boockmarksMenu
<resource: #programMenu >
^ [
|m item|
m := Menu new.
item := MenuItem label:(resources string:'Add Bookmark').
m addItem:item.
item value:#'searchMenuAddToBookmarks'.
BookMarks size > 0 ifTrue:[
item := MenuItem label:(resources string:'Remove Bookmark').
m addItem:item.
item value:#'searchMenuRemoveFromBookmarks'.
m addSeparator.
BookMarks do:[:entry |
|item name sel|
name := entry className.
(sel := entry selector) notNil ifTrue:[
name := name , ' ' , sel.
].
item := MenuItem label:name.
m addItem:item.
item value:#'switchToBookmarkEntry:'.
item argument:entry.
].
].
m findGuiResourcesIn:self.
m
].
"Modified: / 2.11.2001 / 09:33:41 / cg"
!
browseClassExtensionsMenu
<resource: #programMenu >
^ [
|m extensionProjectIDs classPackage item|
extensionProjectIDs := Set new.
self selectedClassesDo:[:eachClass |
classPackage := eachClass package.
eachClass instAndClassSelectorsAndMethodsDo:[:sel :mthd |
mthd package ~= classPackage ifTrue:[
extensionProjectIDs add:mthd package.
]
]
].
extensionProjectIDs size > 0 ifTrue:[
m := Menu new.
extensionProjectIDs size > 1 ifTrue:[
item := MenuItem label:'All'.
item value:#'classMenuCheckInExtensions:'.
m addItem:item.
m addSeparator.
].
extensionProjectIDs asSortedCollection do:[:eachExtensionPackage |
item := MenuItem label:eachExtensionPackage.
item value:#'classMenuCheckInExtensionsFor:'.
item argument:eachExtensionPackage.
m addItem:item.
].
].
m
].
!
bufferMenu
<resource: #programMenu >
^ [
|m selected|
m := self class bufferBaseMenu decodeAsLiteralArray.
m findGuiResourcesIn:self.
m addSeparator.
bufferNameList size > 0 ifTrue:[
selected := selectedBuffer value.
bufferNameList keysAndValuesDo:[:idx :nm |
|item|
item := MenuItem label:nm.
m addItem:item.
item indication:(idx == selected).
item value:[:i |
selectedBuffer value:idx.
]
].
m addSeparator.
] ifFalse:[
(m atNameKey:#'RemoveBuffer') disable
].
m addItem:(MenuItem label:(resources string:'Exit') value:#closeRequest).
m
].
!
changedClassesMenu
"returns a block evaluating to a popup menu to navigate
to the last few changed classes"
<resource: #programMenu >
^ [
self
changedMenuForFilter:[:chg | (chg isMethodChange or:[chg isClassChange and:[chg changeClass isNameSpace not]])]
itemClass:[:chg | chg changeClass theNonMetaclass]
itemSelector:[:chg | nil]
label:[:chg | chg changeClass theNonMetaclass name allBold]
browseActionOfLastItem:[NewSystemBrowser openOnClassesInChangeSet].
].
!
changedMenu
"returns a block evaluating to a popup menu to navigate
to the last few changes (from the changeSet)"
<resource: #programMenu >
^ [
|menu|
menu := self changedMethodsMenu value.
menu isNil ifTrue:[
menu := self changedClassesMenu value.
].
menu
].
!
changedMenuForFilter:aChangeFilter itemClass:itemClassBlock itemSelector:itemSelectorBlock label:labelBlock browseActionOfLastItem:browseActionOfLastItemOrNil
"returns a popup menu to navigate to the last few changes (from the changeSet)"
<resource: #programMenu >
|menu currentMenu nextMenu changes already
maxReached nMaxLevel nMaxItem nLevel nItem nOverAll|
changes := ChangeSet current.
already := OrderedCollection new.
menu := currentMenu := Menu new.
nItem := nOverAll := 0.
nLevel := 1.
nMaxItem := self class classHistoryMaxSize.
nMaxLevel := self class classHistoryMaxLevels.
maxReached := false.
changes reverseDo:[:aChange |
|item cls sel lbl histEntry|
maxReached ifTrue:[
(nOverAll = 0) ifTrue:[
^ nil
].
^ menu
].
nItem > nMaxItem ifTrue:[
nLevel < nMaxLevel ifTrue:[
nextMenu := Menu new.
item := MenuItem label:(resources string:'more').
currentMenu addItem:item.
item submenu:nextMenu.
currentMenu := nextMenu.
nItem := 0.
nLevel := nLevel + 1.
] ifFalse:[
maxReached ifFalse:[
maxReached := true.
item := MenuItem label:(resources string:'>> more changes ignored <<').
item enabled:false.
currentMenu addItem:item.
browseActionOfLastItemOrNil notNil ifTrue:[
item := MenuItem label:(resources string:'Browse all changes').
item value:browseActionOfLastItemOrNil.
].
currentMenu addItem:item.
]
]
].
maxReached ifFalse:[
cls := aChange changeClass.
cls notNil ifTrue:[
(aChangeFilter value:aChange) ifTrue:[
cls := itemClassBlock value:aChange.
sel := itemSelectorBlock value:aChange.
lbl := labelBlock value:aChange.
(already includes:lbl) ifFalse:[
histEntry := self class
historyEntryForClass:cls
selector:sel.
item := MenuItem label:(lbl contractTo:80).
currentMenu addItem:item.
item value:#'switchToHistoryEntry:'.
item argument:histEntry.
already add:lbl.
nItem := nItem + 1.
nOverAll := nOverAll + 1.
]
]
].
]
].
(nOverAll = 0) ifTrue:[
^ nil
].
^ menu
"Modified: / 18-10-2006 / 13:13:43 / cg"
!
changedMethodsMenu
"returns a block evaluating to a popup menu to navigate
to the last few method changes (from the changeSet)"
<resource: #programMenu >
^ [
self
changedMenuForFilter:[:chg | chg isMethodChange]
itemClass:[:chg | chg changeClass]
itemSelector:[:chg | chg selector]
label:[:chg | (chg className allBold?'???') , ' ' , (chg selector?'???') "chg printString"]
browseActionOfLastItem:[NewSystemBrowser openOnMethodsInChangeSet].
].
!
classOperationsMenu
"ask the class for its own special menu.
This allows for special classes (such as Enumeration or Pools) to add their own menu ops"
<resource: #programMenu >
^ [
|cls m |
cls := self theSingleSelectedClass.
cls notNil ifTrue:[
m := cls theNonMetaclass classOperationsMenu
].
m
].
"Modified: / 31-01-2011 / 11:09:04 / cg"
!
codeViewMenu
"add more functionality to the codeViews text-editor-menu.
Get here via the menuHolder-plug in codeView."
<resource: #programMenu>
|shiftedMenu codeView menu menuOthers sensor|
shiftedMenu := self class shiftedCodeViewPopUpMenu decodeAsLiteralArray.
shiftedMenu receiver:self.
shiftedMenu findGuiResourcesIn:self.
codeView := self codeView.
sensor := codeView sensor.
sensor shiftDown ifTrue:[
sensor ctrlDown ifFalse:[
^ shiftedMenu
].
].
menu := codeView editMenu.
sensor ctrlDown ifTrue:[
(menu isKindOf:MenuPanel) ifTrue:[
"/ a newStyle menuPanel
self shouldImplement.
] ifFalse:[
"/ an oldStyle popUpMenu
menuOthers := menu.
]
] ifFalse:[
(menu isKindOf:MenuPanel) ifTrue:[
"/ a newStyle menuPanel
self shouldImplement.
] ifFalse:[
"/ an oldStyle popUpMenu
"/ this is a kludge...
shiftedMenu := shiftedMenu asOldStylePopUpMenuFor:self.
"/ would like to add the shifted-menu here
menu menuView
addLabels:(Array with:'-' with:'Code')
selectors:#( nil refactorings)
accelerators:#(nil 'Shift')
after:#accept.
menu subMenuAt:#refactorings put:shiftedMenu.
menuOthers := menu subMenuAt:#others.
].
].
sensor shiftDown ifFalse:[
menuOthers notNil ifTrue:[
menuOthers menuView
addLabels:(Array with:'Response to it')
selectors:#( browseResponseToIt)
accelerators:#( nil )
after:#browseReferencesToIt.
menuOthers actionAt:#browseResponseToIt put:[ self browseResponseToIt ].
"/ hasLocalSelectorSelectedInCodeView takes too long...
self hasSelectionInCodeView "hasLocalSelectorSelectedInCodeView" ifFalse:[
menuOthers disable:#browseResponseToIt
].
].
].
^ menu
!
compareClassWithSmallTeamVersionMenu
<resource: #programMenu >
^ [
|m anyItem hosts|
m := Menu new.
hosts := Set new.
self selectedClasses value do:[:cls |
hosts addAll:(SmallTeam hostsWithChangeForClassOrMetaclass:cls theNonMetaclass).
].
hosts := hosts asOrderedCollection sort.
anyItem := false.
hosts do:[:eachHost |
|item|
item := MenuItem label:eachHost.
item value:#'classMenuCompareWithSmallTeamVersionOnHost:'.
item argument:eachHost.
m addItem:item.
anyItem := true.
].
anyItem ifFalse:[ nil ] ifTrue:[ m ]
].
"Created: / 11-11-2006 / 15:19:53 / cg"
!
compareMethodWithSmallTeamVersionMenu
<resource: #programMenu >
^ [
|m anyItem hosts|
anyItem := false.
SmallTeam notNil ifTrue:[
m := Menu new.
hosts := Set new.
self selectedMethods value do:[:m |
hosts addAll:(SmallTeam hostsWithChangeForClass:(m mclass) selector:(m selector)).
].
hosts := hosts asOrderedCollection sort.
hosts do:[:eachHost |
|item|
item := MenuItem label:eachHost.
item value:#'selectorMenuCompareWithSmallTeamVersionOnHost:'.
item argument:eachHost.
m addItem:item.
anyItem := true.
].
].
anyItem ifFalse:[ nil ] ifTrue:[ m ]
].
"Created: / 11-11-2006 / 15:19:18 / cg"
!
compareWithSmallTeamVersionMenu
<resource: #programMenu >
^ [
|m anyItem hosts|
m := Menu new.
hosts := Set new.
self selectedMethods value do:[:m |
hosts addAll:(SmallTeam hostsWithChangeForClass:(m mclass) selector:(m selector)).
].
hosts := hosts asOrderedCollection sort.
anyItem := false.
hosts do:[:eachHost |
|item|
item := MenuItem label:eachHost.
item value:#'selectorMenuCompareWithSmallTeamVersionOnHost:'.
item argument:eachHost.
m addItem:item.
anyItem := true.
].
anyItem ifFalse:[ nil ] ifTrue:[ m ]
].
"Created: / 11-11-2006 / 15:03:16 / cg"
!
editModeInfoLabelMenu
<resource: #programMenu >
^ self class editModeInfoLabelMenu.
!
findHistoryMenu
<resource: #programMenu >
^ [
|m|
FindHistory size > 0 ifTrue:[
m := Menu new.
FindHistory do:[:entry |
|item className name sel itemLabel|
className := entry className ? '?'.
entry meta ifTrue:[
className := className , ' class'.
].
name := className allBold.
(sel := entry selector) notNil ifTrue:[
name := name , ' ' , sel.
].
itemLabel := name contractTo:100.
item := MenuItem label:itemLabel.
m addItem:item.
item value:#'switchToFindHistoryEntry:'.
item argument:entry.
(Smalltalk classNamed:className) isBehavior ifFalse:[
item enabled:false.
item label:(LabelAndIcon icon:(ToolbarIconLibrary erase16x16Icon2) string:itemLabel)
].
].
].
m
].
!
implementedMessagesMenu
^ [
self
messagesMenuFor:#'spawnBrowserOnAllImplementorsOf:'
withSenderChain:false
withImplementorChain:true
withLocalSenders:false
withLocalImplementors:true
selfSendsOnly:false
]
"Modified: / 05-09-2006 / 10:34:10 / cg"
!
loadMethodFromSmallTeamHostMenu
<resource: #programMenu >
^ [
|m anyItem hosts|
m := Menu new.
hosts := Set new.
self selectedMethods value do:[:m |
hosts addAll:(SmallTeam hostsWithChangeForClass:(m mclass) selector:(m selector)).
].
hosts := hosts asOrderedCollection sort.
anyItem := false.
hosts do:[:eachHost |
|item|
item := MenuItem label:eachHost.
item value:#'selectorMenuLoadSmallTeamVersionFromHost:'.
item argument:eachHost.
m addItem:item.
anyItem := true.
].
anyItem ifFalse:[ nil ] ifTrue:[ m ]
].
"Created: / 12-11-2006 / 15:47:43 / cg"
!
messagesMenuFor:actionSelector withSenderChain:withSenderChain withImplementorChain:withImplementorChain
^ self
messagesMenuFor:actionSelector
withSenderChain:withSenderChain
withImplementorChain:withImplementorChain
selfSendsOnly:false
"Modified: / 05-09-2006 / 10:26:26 / cg"
!
messagesMenuFor:actionSelector withSenderChain:withSenderChain withImplementorChain:withImplementorChain selfSendsOnly:selfSendsOnly
^ [
self
messagesMenuFor:actionSelector
withSenderChain:withSenderChain
withImplementorChain:withImplementorChain
withLocalSenders:false
withLocalImplementors:false
selfSendsOnly:selfSendsOnly
]
"Modified: / 05-09-2006 / 10:33:05 / cg"
!
messagesMenuFor:actionSelector
withSenderChain:withSenderChain withImplementorChain:withImplementorChain
withLocalSenders:withLocalSenders withLocalImplementors:withLocalImplementors
selfSendsOnly:selfSendsOnly
^ self
messagesMenuFor:actionSelector
withSenderChain:withSenderChain withImplementorChain:withImplementorChain
withLocalSenders:withLocalSenders withLocalImplementors:withLocalImplementors
withCallersOfThisMethod:true "false" withMethodsCalledByThisMethod:false
selfSendsOnly:selfSendsOnly
"Modified: / 27-04-2010 / 15:07:13 / cg"
!
messagesMenuFor:actionSelector
withSenderChain:withSenderChain withImplementorChain:withImplementorChain
withLocalSenders:withLocalSenders withLocalImplementors:withLocalImplementors
withCallersOfThisMethod:withCallersOfThisMethod withMethodsCalledByThisMethod:withMethodsCalledByThisMethod
selfSendsOnly:selfSendsOnly
<resource: #programMenu >
|m mthd mSel contractedSelector item l methods allMessagesSent|
m := Menu new.
mthd := self theSingleSelectedMethod.
(mthd notNil and:[ (mSel := mthd selector) notNil]) ifTrue:[
contractedSelector := mSel contractTo:80.
item := MenuItem label:(' ' , contractedSelector , ' '). "/ ' ' is a kludge - to allow '-' selector
item value:actionSelector.
item argument:mSel.
m addItem:item.
"/ true "withInstanceProtocolOnly" ifTrue:[
"/ item := MenuItem label:(resources string:' %1 - Instance Protocol Only' with:contractedSelector).
"/ item value:actionSelector.
"/ item argument:(#instanceProtocolOnly -> mSel).
"/ m addItem:item.
"/ ].
"/ true "withClassProtocolOnly" ifTrue:[
"/ item := MenuItem label:(resources string:' %1 - Class Protocol Only' with:contractedSelector).
"/ item value:actionSelector.
"/ item argument:(#classProtocolOnly -> mSel).
"/ m addItem:item.
"/ ].
(withLocalSenders | withSenderChain | withLocalImplementors | withImplementorChain) ifTrue:[
m addSeparator.
].
withLocalSenders ifTrue:[
"/ item := MenuItem label:(resources string:' %1 - Local Senders' with:contractedSelector).
item := MenuItem label:(resources string:'Local Senders of %1' with:contractedSelector).
item value:#spawnLocalSendersBuffer.
m addItem:item.
].
withSenderChain ifTrue:[
"/ item := MenuItem label:(resources string:' %1 - Sender Chain' with:contractedSelector).
item := MenuItem label:(resources string:'Sender Chain of %1' with:contractedSelector).
item value:#spawnSenderChainBuffer.
m addItem:item.
].
(withCallersOfThisMethod and:[mthd isInstrumented]) ifTrue:[
item := MenuItem label:(resources string:'Callers of this %1' with:contractedSelector).
item value:#spawnCallersBuffer.
m addItem:item.
].
withLocalImplementors ifTrue:[
item := MenuItem label:(resources string:'Local Implementors of %1' with:contractedSelector).
item value:#spawnLocalImplementorsBuffer.
m addItem:item.
].
withImplementorChain ifTrue:[
item := MenuItem label:(resources string:'Implementor Chain of %1' with:contractedSelector).
item value:#spawnImplementorChainBuffer.
m addItem:item.
].
withMethodsCalledByThisMethod ifTrue:[
item := MenuItem label:(resources string:'Methods Called by this %1' with:contractedSelector).
item value:#spawnMethodsCalledByBuffer.
m addItem:item.
].
selfSendsOnly ifTrue:[
l := mthd messagesSentToSelf.
] ifFalse:[
l := mthd messagesSent.
].
l := l asSortedCollection.
l size > 0 ifTrue:[
m addSeparator.
"
(l size > 30) ifTrue:[
l removeAllFoundIn:#(ifTrue: ifFalse: ifTrue:ifFalse: ifFalse:ifTrue:
whileTrue: whileFalse:
isNil notNil
and: or:
).
(l size > 30) ifTrue:[
l removeAllFoundIn:#(#'==' #'~~' class
).
]
].
(cut := l size > 30) ifTrue:[
l := l copyTo:30
].
"
l do:[:eachMessage |
item := MenuItem label:(' ' , (eachMessage contractTo:100), ' '). "/ ' ' is a kludge - to allow '-' selector
item value:actionSelector.
item argument:eachMessage asSymbol.
m addItem:item.
].
"
cut ifTrue:[
m addItem:(MenuItem label:'-').
m addItem:(MenuItem label:'<< more items ignored >>').
]
"
]
] ifFalse:[
allMessagesSent := Set new.
"/ not exactly one method selected;
"/ generate a menu for all selected method's implementors and sent messages.
methods := self selectedMethods value.
methods isEmptyOrNil ifTrue:[
methods := OrderedCollection new.
self selectedClassesDo:[:cls |
cls methodsDo:[:eachMethod | methods add:eachMethod].
].
].
methods do:[:eachMethod |
mSel := eachMethod selector ? '?'.
contractedSelector := mSel contractTo:80.
item := MenuItem label:(' ' , contractedSelector , ' '). "/ ' ' is a kludge - to allow '-' selector
item value:actionSelector.
item argument:mSel.
m addItem:item.
selfSendsOnly ifTrue:[
allMessagesSent addAll:(eachMethod messagesSentToSelf).
] ifFalse:[
allMessagesSent addAll:(eachMethod messagesSent).
].
].
allMessagesSent := allMessagesSent asSortedCollection.
allMessagesSent size > 0 ifTrue:[
m addSeparator.
allMessagesSent do:[:eachMessage |
item := MenuItem label:(' ' , (eachMessage contractTo:100), ' '). "/ ' ' is a kludge - to allow '-' selector
item value:actionSelector.
item argument:eachMessage asSymbol.
m addItem:item.
].
].
].
^ m
"Created: / 27-04-2010 / 15:05:52 / cg"
"Modified: / 07-05-2010 / 20:00:20 / cg"
!
operationsMenu
<resource: #programMenu >
| manager item menu undoCountMenuItem lRedo lUndo
undoListMenu|
(self canUseRefactoringSupport) ifFalse:[
^
#(#Menu
#(
#(#MenuItem
#label: 'Load Refactoring and Undo Features'
#translateLabel: true
#showBusyCursorWhilePerforming: true
#value: #doLoadRefactoringSupport
)
)
nil
nil
)
].
manager := RefactoryChangeManager instance.
menu := Menu new.
lUndo := (manager hasUndoableOperations
ifTrue: [resources string:'Undo: %1' with:(manager undoChange name contractTo:100)]
ifFalse: [resources string:'Undo']).
item := MenuItem labeled:lUndo.
item showBusyCursorWhilePerforming:true.
item value:[ self operationsMenuUndo ].
manager hasUndoableOperations ifFalse: [item disable].
menu addItem:item.
lRedo := (manager hasRedoableOperations
ifTrue: [resources string:'Redo: %1' with:(manager redoChange name contractTo:100)]
ifFalse: [resources string:'Redo']).
item := MenuItem labeled:lRedo.
item showBusyCursorWhilePerforming:true.
item value:[ self operationsMenuRedo].
manager hasRedoableOperations ifFalse: [item disable].
menu addItem:item.
undoListMenu := Menu new.
manager undoableOperations reverseDo:[:eachUndoChange |
item := MenuItem labeled:(eachUndoChange name contractTo:100).
item showBusyCursorWhilePerforming:true.
item value:[ self operationsMenuUndo:eachUndoChange ].
undoListMenu addItem:item.
].
item := MenuItem labeled:(resources string:'Undo Recent').
item submenu:undoListMenu.
item enabled:manager hasUndoableOperations.
menu addItem:item.
undoCountMenuItem := (MenuItem labeled: (resources string:'Set Undo Count...'))
value: [self setUndoCount];
yourself.
menu addItemGroup: (Array with: undoCountMenuItem).
^menu
!
selectedClassesHierarchyMenu
<resource: #programMenu >
^ [
|m cls classes|
cls := self theSingleSelectedClass.
(cls notNil and:[cls superclass notNil]) ifTrue:[
m := Menu new.
cls := cls superclass.
[cls notNil] whileTrue:[
|item className|
className := cls name.
item := MenuItem label:className.
m addItem:item beforeIndex:1. "/ reverse
item value:#'switchToClassNamed:'.
item argument:className.
cls := cls superclass.
].
].
m
].
!
sentMessagesMenu
^ [
self
messagesMenuFor:#'spawnBrowserOnAllSendersOf:'
withSenderChain:true "(self window sensor ctrlDown)"
withImplementorChain:false
withLocalSenders:true
withLocalImplementors:false
selfSendsOnly:false
]
"Modified: / 05-09-2006 / 10:33:41 / cg"
!
sentMessagesResponseMenu
^ self
messagesMenuFor:#'findResponseTo:'
withSenderChain:false
withImplementorChain:false
selfSendsOnly:true
"Modified: / 05-09-2006 / 10:33:49 / cg"
!
visitedClassesMenu
<resource: #programMenu >
^ [
|m classHistory currentClass|
currentClass := self theSingleSelectedClass.
classHistory := self class classHistory.
classHistory size > 0 ifTrue:[
m := Menu new.
classHistory do:[:entry |
|item className|
className := entry className ? ''.
(currentClass notNil
and:[currentClass name = className])
ifFalse:[
item := MenuItem label:(className contractTo:100).
m addItem:item.
item value:#'switchToHistoryEntry:'.
item argument:entry.
].
].
].
m
].
"Modified: / 20-11-2006 / 12:23:08 / cg"
! !
!NewSystemBrowser methodsFor:'navigation'!
askForClassNameMatching:matchStringArg
"open a dialog to ask for a class name"
^ self class
askForClassNameMatching:matchStringArg
inEnvironment:self navigationState environment
for:self
!
delayedSwitchToCategory:aCategory
self window sensor
pushUserEvent:#selectCategory:
for:self
withArguments:(Array with:aCategory)
"Created: / 6.2.2000 / 02:14:44 / cg"
"Modified: / 25.2.2000 / 00:50:31 / cg"
!
delayedSwitchToProtocol:aCategory
self window sensor
pushUserEvent:#selectProtocol:
for:self
withArguments:(Array with:aCategory)
"Created: / 6.2.2000 / 02:14:44 / cg"
"Modified: / 25.2.2000 / 00:56:09 / cg"
!
initialOrganizerMode
|canvasType|
(canvasType := browserCanvasType) isNil ifTrue:[
canvasType := navigationState canvasType.
].
canvasType == #singleNameSpaceFullBrowserSpec ifTrue:[^ OrganizerCanvas organizerModeNamespace ].
canvasType == #singleProjectFullBrowserSpec ifTrue:[^ OrganizerCanvas organizerModeProject ].
canvasType == #multipleClassExtensionBrowserSpec ifTrue:[^ nil ].
"/ self halt.
^ OrganizerCanvas organizerModeCategory
!
selectCategories:aCollectionOfCategories
"switch to some categories (by the program)"
self selectedCategories value:aCollectionOfCategories.
"Created: / 25.2.2000 / 00:48:48 / cg"
"Modified: / 25.2.2000 / 00:51:40 / cg"
!
selectCategory:aCategory
self selectCategories:(Array with:aCategory).
"Created: / 25.2.2000 / 00:50:14 / cg"
!
selectClass:aClass
"switch to a class (by the program)"
self selectClasses:(Array with:aClass)
"Created: / 25.2.2000 / 00:57:06 / cg"
!
selectClasses:aCollectionOfClasses
"switch to some classes (by the program)"
|nonNilClasses|
nonNilClasses := aCollectionOfClasses select:[:cls | cls notNil].
self selectedClasses value:nonNilClasses
"Created: / 25.2.2000 / 00:47:10 / cg"
!
selectMethod:aMethod
self selectMethods:(Array with:aMethod).
!
selectMethods:aCollectionOfMethods
"switch to some methods (by the program)"
self selectedMethods value:aCollectionOfMethods
"Created: / 25.2.2000 / 00:52:39 / cg"
!
selectNamespace:aNamespace
self selectNamespaces:(Array with:aNamespace).
"Created: / 25.2.2000 / 02:39:01 / cg"
!
selectNamespaces:aCollectionOfNamespaces
self selectedNamespaces value:aCollectionOfNamespaces.
"Created: / 25.2.2000 / 00:53:29 / cg"
!
selectProject:aProject
self selectProjects:(Array with:aProject).
"Created: / 25.2.2000 / 02:49:23 / cg"
!
selectProjects:aCollectionOfProjects
self selectedProjects value:aCollectionOfProjects.
"Created: / 25.2.2000 / 00:54:14 / cg"
!
selectProtocol:aProtocol
self selectProtocols:(Array with:aProtocol).
"Created: / 25.2.2000 / 00:55:50 / cg"
!
selectProtocols:aCollectionOfProtocols
self selectedProtocols value:aCollectionOfProtocols.
"Created: / 25.2.2000 / 00:55:05 / cg"
!
selectProtocolsMatching:aMatchPattern
|allProtocols|
allProtocols := Set new.
self selectedClassesDo:[:eachClass |
allProtocols addAll:(eachClass categories).
].
allProtocols := allProtocols select:[:each | aMatchPattern match:each].
self selectProtocols:allProtocols asOrderedCollection.
!
setupNavigationStateFrom:anotherNavigationState
"setup my navigationState from another navigationState"
|selectedClasses projects categories protocols namespaces canvasType meta selectedMethods
otherOrganizerMode isMethodBrowser|
otherOrganizerMode := anotherNavigationState organizerMode value.
selectedClasses := anotherNavigationState selectedClasses value copy.
canvasType := navigationState canvasType ? #fullBrowserSpec.
canvasType == #fullBrowserSpec ifTrue:[
isMethodBrowser := anotherNavigationState isMethodListBrowser or:[anotherNavigationState isSingleMethodBrowser].
(isMethodBrowser
or:[otherOrganizerMode == OrganizerCanvas organizerModeCategory]) ifTrue:[
selectedMethods := anotherNavigationState selectedMethods value ? #().
isMethodBrowser ifTrue:[
selectedClasses := (selectedMethods collect:[:each | each mclass]) asIdentitySet.
protocols := (selectedMethods collect:[:each | each category]) asSet.
meta := (selectedClasses size == 1) and:[ selectedClasses anElement isMeta ].
] ifFalse:[
protocols := anotherNavigationState selectedProtocols value ? #().
meta := anotherNavigationState meta value.
categories := anotherNavigationState selectedCategories value ? #().
].
] ifFalse:[
protocols := anotherNavigationState selectedProtocols value copy.
meta := anotherNavigationState meta value.
navigationState selectedNamespaces value:(anotherNavigationState selectedNamespaces value).
navigationState nameSpaceFilter value:(anotherNavigationState selectedNamespaces value).
].
categories size == 0 ifTrue:[
"/ collect categories from selected classes.
categories := ((selectedClasses ? #()) collect:[:eachClass | eachClass theNonMetaclass category]) asSet
].
navigationState selectedCategories value:categories.
otherOrganizerMode == OrganizerCanvas organizerModeProject ifTrue:[
navigationState organizerMode value:otherOrganizerMode.
projects := anotherNavigationState selectedProjects value copy.
navigationState selectedProjects value:projects.
].
navigationState meta value:meta.
"/ self immediateUpdate value:true.
"/ selectedClasses := selectedClasses collect:[:each | each theNonMetaclass].
navigationState selectedClasses value:selectedClasses.
navigationState selectedProtocols value:protocols.
"/ self immediateUpdate value:false.
navigationState selectedMethods value:(anotherNavigationState selectedMethods value copy).
^ self
].
navigationState isFullClassSourceBrowser ifTrue:[
otherOrganizerMode == OrganizerCanvas organizerModeCategory ifTrue:[
categories := anotherNavigationState selectedCategories value copy.
] ifFalse:[
"/ collect categories from selected classes.
categories := ((selectedClasses ? #())
collect:[:eachClass | eachClass category]) asSet
].
navigationState selectedCategories value:categories.
selectedClasses size > 0 ifTrue:[
navigationState selectedClasses value:(selectedClasses collect:[:each | each theNonMetaclass]).
].
self enqueueDelayedUpdateCode.
^ self
].
navigationState isFullClassSourceBrowser ifTrue:[
otherOrganizerMode == OrganizerCanvas organizerModeCategory ifTrue:[
categories := anotherNavigationState selectedCategories value copy.
] ifFalse:[
"/ collect categories from selected classes.
categories := ((selectedClasses ? #())
collect:[:eachClass | eachClass category]) asSet
].
navigationState selectedCategories value:categories.
selectedClasses size > 0 ifTrue:[
navigationState selectedClasses value:(selectedClasses collect:[:each | each theNonMetaclass]).
].
self enqueueDelayedUpdateCode.
^ self
].
navigationState isNameSpaceBrowser ifTrue:[
otherOrganizerMode == OrganizerCanvas organizerModeNamespace ifTrue:[
namespaces := anotherNavigationState selectedNamespaces value copy.
] ifFalse:[
"/ collect namespaces from selected classes.
namespaces := ((selectedClasses ? #())
collect:[:eachClass | eachClass nameSpace name]) asSet
].
navigationState selectedNamespaces value:namespaces.
selectedClasses size > 0 ifTrue:[
navigationState selectedClasses value:selectedClasses.
].
self enqueueDelayedUpdateCode.
^ self
].
(navigationState isCategoryBrowser
or:[navigationState isNameSpaceFullBrowser
or:[navigationState isProjectFullBrowser]]) ifTrue:[
otherOrganizerMode == OrganizerCanvas organizerModeCategory ifTrue:[
categories := anotherNavigationState selectedCategories value copy.
] ifFalse:[
"/ collect categories from selected classes.
categories := ((selectedClasses ? #())
collect:[:eachClass | eachClass category]) asSet
].
navigationState selectedCategories value:categories.
selectedClasses size > 0 ifTrue:[
navigationState selectedClasses value:selectedClasses.
].
self enqueueDelayedUpdateCode.
^ self
].
"Modified: / 29-09-2006 / 22:35:33 / cg"
!
sortBy:what
"change the sort-order (some methodLists only)"
self sortBy value:what
"Created: / 25.2.2000 / 00:47:10 / cg"
!
switchToAnyMethod:aSelectorString
"find all implementors of aSelectorString, and present a list
to choose from. When an entry is selected, switch to that class/selector.
This allows for quickly moving around in the system."
|classes sel box theClassName|
classes := OrderedCollection new.
(sel := aSelectorString asSymbolIfInterned) notNil ifTrue:[
Smalltalk allClassesDo:[:aClass |
(aClass includesSelector:sel) ifTrue:[
classes add:aClass.
].
(aClass class includesSelector:sel) ifTrue:[
classes add:aClass class.
].
]
].
classes size == 0 ifTrue:[
self class showNoneFound.
^ self
].
classes size > 1 ifTrue:[
box := ListSelectionBox
title:(resources stringWithCRs:'searching for #%1 method.\\in which class ?\\(Tab for completion or select)' with:aSelectorString).
box label:'find method'.
box okText:(resources string:'show').
box list:(classes collect:[:aClass | aClass name]) asSortedCollection.
box action:[:aString | theClassName := aString].
box entryCompletionBlock:[:contents |
|s l names|
s := contents withoutSpaces.
s size == 0 ifTrue:[
l := classes
] ifFalse:[
l := classes select:[:cls | cls name startsWith:s].
].
l size == 0 ifTrue:[
l := classes select:[:cls | cls name asLowercase startsWith:s asLowercase].
].
l size > 0 ifTrue:[
box list:(names := l collect:[:aClass | aClass name]) asSortedCollection.
box contents:(names longestCommonPrefix). "/ l first name.
l size ~~ 1 ifTrue:[
self window beep
]
]
].
box showAtPointer.
] ifFalse:[
theClassName := classes first name
].
theClassName notNil ifTrue:[
self rememberLocationInHistory.
self switchToClassNamed:theClassName.
self switchToSelector:aSelectorString.
].
"Modified: / 1.9.1995 / 01:39:58 / claus"
"Modified: / 25.1.2000 / 20:43:35 / cg"
!
switchToBookmarkEntry:entry
"invoked when switching to a method from the bookmark history"
self switchToHistoryEntry:entry.
!
switchToClass:aClass
self switchToClass:aClass selector:nil
!
switchToClass:aClass selector:aSelector
"switch to some class (by the program)"
|orgMode cls namespaces nsName cat pkg holder newValue doSwitchMeta mthd answer
ns classes|
aClass isNil ifTrue:[
^ self
].
aSelector notNil ifTrue:[
mthd := aClass compiledMethodAt:aSelector.
].
(navigationState isMethodListBrowser
or:[navigationState isMethodBrowser]) ifTrue:[
"/ must check if that method is in the list ...
mthd isNil ifTrue:[
"/ (self confirm:'Add a buffer for the class ?' withCRs) ifFalse:[
"/ ^ self
"/ ].
self spawnFullBrowserInClass:aClass selector:nil in:#newBuffer.
^ self
].
navigationState methodListApplication isNil ifTrue:[
self spawnFullBrowserInClass:aClass selector:aSelector in:#newBuffer.
^ self
].
(navigationState methodList includesIdentical:mthd) ifFalse:[
answer := OptionBox request:'Method not in list.\\Add a buffer for it ?' withCRs
label:'New Browser ?'
image:(WarningBox iconBitmap)
buttonLabels:(resources array:#('New Browser' 'Add Buffer' 'Cancel'))
values:#(#newBrowser #newBuffer nil)
default:#newBuffer
onCancel:nil.
answer notNil ifTrue:[
self spawnFullBrowserInClass:aClass selector:aSelector in:answer.
].
^ self
].
self selectedMethods value:(OrderedCollection with:mthd).
^ self
].
(navigationState isClassBrowser) ifTrue:[
"/ must check if that class is in the list ...
((navigationState classList value ? #()) includesIdentical:aClass) ifFalse:[
navigationState isSingleClassBrowser ifTrue:[
navigationState classList value:(Array with:aClass).
] ifFalse:[
(self confirm:'Class not in list.\\Add a buffer for it ?' withCRs) ifTrue:[
self spawnFullBrowserInClass:aClass selector:aSelector in:#newBuffer.
].
^ self
].
].
self meta value:(aClass isMeta).
self selectedClasses value:(OrderedCollection with:aClass).
^ self
].
(navigationState isProtocolBrowser) ifTrue:[
(self confirm:'Add a buffer for it ?' withCRs) ifTrue:[
self spawnFullBrowserInClass:aClass selector:aSelector in:#newBuffer.
].
^ self
].
orgMode := self organizerMode value.
"/ if the class is a namespace, ask if mode should be changed
(aClass isRealNameSpace) ifTrue:[
orgMode ~~ OrganizerCanvas organizerModeNamespace ifTrue:[
answer := self
confirmWithCancel:(resources string:'Browser: %1 is a namespace - switch organizers display mode ?' with:aClass name)
defaultAnswer:false.
answer isNil ifTrue:[
AbortOperationRequest raise.
^ self
].
answer ifTrue:[
self organizerMode value:(OrganizerCanvas organizerModeNamespace).
orgMode := self organizerMode value.
] ifFalse:[
((self selectedClasses value ? #()) contains:[:cls | cls nameSpace == aClass]) ifTrue:[^ self ].
"/ select the first class of that namespace
classes := aClass allClasses.
classes notEmpty ifTrue:[
self switchToClass:(classes first) selector:nil.
^ self.
]
]
].
].
"/ if the class is unloaded, turn hideUnloaded off
(aClass isLoaded not
and:[self hideUnloadedClasses value == true]) ifTrue:[
self hideUnloadedClasses value:false
].
doSwitchMeta := true.
"/ FIX bug in protocol-list; will not update selection otherwise ...
self immediateUpdate value:true.
namespaces := self selectedNamespaces value ? #().
ns := aClass topNameSpace.
ns notNil ifTrue:[nsName := ns name].
(namespaces includes:nsName) ifFalse:[
(namespaces includes:(NavigatorModel nameListEntryForALL)) ifFalse:[
self selectedNamespaces value:(OrderedCollection with: NavigatorModel nameListEntryForALL)
]
].
"/ namespaces := self nameSpaceFilter value ? #().
"/ (namespaces includes:aClass nameSpace name) ifFalse:[
"/ (namespaces includes:(NavigatorModel nameListEntryForALL)) ifFalse:[
"/ self nameSpaceFilter value:(OrderedCollection with: NavigatorModel nameListEntryForALL)
"/ ]
"/ ].
orgMode == OrganizerCanvas organizerModeCategory ifTrue:[
cat := aClass category ? '* no category *'.
(self selectedCategoriesValue includes:cat) ifFalse:[
self selectedCategories value:(OrderedCollection with:cat).
]
] ifFalse:[ orgMode == OrganizerCanvas organizerModeNamespace ifTrue:[
aClass isNameSpace ifTrue:[
nsName := aClass name.
] ifFalse:[
nsName := aClass nameSpace name.
].
(self selectedNamespacesValue includes:nsName) ifFalse:[
self selectedNamespaces value:(OrderedCollection with:nsName).
]
] ifFalse:[ orgMode == OrganizerCanvas organizerModeProject ifTrue:[
pkg := aClass package.
holder := self selectedProjects.
newValue := holder value ? #().
(newValue includes:pkg) ifFalse:[
newValue := OrderedCollection with:pkg.
].
mthd notNil ifTrue:[
"/ careful - the method could be in an extension ...
mthd package ~= pkg ifTrue:[
(newValue includes:mthd package) ifFalse:[
newValue := newValue asOrderedCollection.
newValue add:mthd package.
].
].
].
newValue ~= holder value ifTrue:[
holder value:newValue.
].
] ifFalse:[ (orgMode == OrganizerCanvas organizerModeClassHierarchy
or:[orgMode == OrganizerCanvas organizerModeClassInheritance]) ifTrue:[
"/ make sure, that the class is in the hierarchy;
"/ if required, update the hierarchy.
holder := self classHierarchyTopClass.
cls := holder value.
(cls isNil or:[(cls theNonMetaclass withAllSuperclasses includesIdentical:aClass theNonMetaclass) not]) ifTrue:[
holder value:aClass.
].
"/ doSwitchMeta := false.
]]]].
doSwitchMeta ifTrue:[
self meta value:(aClass isMeta).
].
(self selectedClassesValue includesIdentical:aClass) ifFalse:[
self selectedClasses value:(OrderedCollection with:aClass).
].
mthd notNil ifTrue:[
(self selectedProtocolsValue contains:[:cat | cat string = mthd category]) ifFalse:[
self selectProtocols:(OrderedCollection with:mthd category).
].
self switchToMethod:mthd.
] ifFalse:[
self switchToSelector:aSelector.
].
self immediateUpdate value:false.
self class addToHistory:aClass selector:aSelector.
self normalLabel.
self enqueueDelayedClassSelectionChange.
"Modified: / 10-11-2006 / 17:14:41 / cg"
!
switchToClassNameMatching:aMatchString
|className class|
class := Smalltalk classNamed:aMatchString.
class notNil ifTrue:[
self switchToClass:class
] ifFalse:[
className := self askForClassNameMatching:aMatchString.
className notNil ifTrue:[
self switchToClassNamed:className.
]
]
"Modified: / 13.2.2000 / 20:57:42 / cg"
!
switchToClassNameOrSelectorMatching:aMatchString
|className class implementors answer classesMatchingCaseless|
aMatchString knownAsSymbol ifTrue:[
class := Smalltalk classNamed:aMatchString.
class notNil ifTrue:[
self switchToClass:class.
^ self.
].
classesMatchingCaseless := Smalltalk keys select:[:nm | nm sameAs:aMatchString].
"/ impl := Smalltalk allImplementorsOf:aMatchString asSymbol.
"/ impl notEmptyOrNil ifTrue:[
"/ ].
(aMatchString first isLetter not
or:[ aMatchString first isLowercase]) ifTrue:[
implementors := SystemBrowser findImplementorsMatching:aMatchString in:(Smalltalk allClasses) ignoreCase:true.
implementors size > 0 ifTrue:[
(classesMatchingCaseless isEmpty and:[implementors size == 1]) ifTrue:[
answer := Dialog
confirm:(resources
stringWithCRs:'No class named "%1".\But "%2" implements it. Go there ?'
with:aMatchString allBold
with:implementors first mclass name).
answer ifTrue:[
self switchToClass:implementors first mclass selector:implementors first selector.
].
^ self.
].
implementors := implementors asOrderedCollection sort:[:a :b | a mclass name < b mclass name].
classesMatchingCaseless isEmpty ifTrue:[
answer := Dialog
choose:(resources
stringWithCRs:'No class named "%1.\But there are %2 implementors of it.\\Goto one of them ?'
with:aMatchString allBold
with:implementors size)
fromList:(implementors collect:[:m | m mclass name])
values:implementors
buttons:#('No, Search for a Class') values:#(searchClass)
lines:10 cancel:nil
postBuildBlock:[:box | box minExtent:300@250].
] ifFalse:[
answer := Dialog
choose:(resources
stringWithCRs:'No class named "%1.\But there are %2 implementors of it and %3 classes with a similar name.\\Goto one of them ?'
with:aMatchString allBold
with:implementors size
with:classesMatchingCaseless size)
fromList:({'Implementors:' colorizeAllWith:Color grey}
,(implementors collect:[:m | m mclass name])
,{'Classes:' colorizeAllWith:Color grey}
,classesMatchingCaseless)
values:(#(nil),implementors,#(nil),classesMatchingCaseless)
buttons:#('No, Search for a Class') values:#(searchClass)
lines:10 cancel:nil
postBuildBlock:[:box | box minExtent:300@250].
].
answer isNil ifTrue:[^ self].
answer ~~ #searchClass ifTrue:[
answer isSymbol ifTrue:[
self switchToClass:(Smalltalk classNamed:answer).
] ifFalse:[
self switchToClass:(answer mclass) selector:(answer selector).
].
^ self.
].
].
].
].
className := self askForClassNameMatching:aMatchString.
className notNil ifTrue:[
self switchToClassNamed:className.
]
"Modified: / 13-02-2000 / 20:57:42 / cg"
"Modified: / 04-07-2006 / 18:48:25 / fm"
!
switchToClassNamed:aString
|str theClass|
str := aString.
(aString endsWith:' class') ifTrue:[
str := aString copyWithoutLast:6.
].
theClass := self findClassNamed:str.
((theClass == self theSingleSelectedClass) or:[theClass isBehavior not]) ifTrue:[^ self].
"/ if currently in meta-mode,
"/ switch to the metaClass
self meta value ifTrue:[
theClass := theClass theMetaclass
] ifFalse:[
theClass := theClass theNonMetaclass
].
self switchToClass:theClass.
"Created: / 13.2.2000 / 21:05:01 / cg"
!
switchToFindHistoryEntry:entry
"invoked when switching back to a method from the find history"
FindHistory removeIdentical:entry ifAbsent:nil.
self switchToHistoryEntry:entry.
FindHistory addFirst:entry.
!
switchToHistoryEntry:entry
"invoked when switching to a class from the visited history"
|cls|
cls := Smalltalk at:entry className.
cls isNil ifTrue:[
self warn:'Oops - class is gone'.
^ self
].
entry meta ifTrue:[
cls := cls theMetaclass
].
self switchToClass:cls selector:entry selector
!
switchToMethod:aMethod
|orgMode pkg holder category|
"/ care for method being in another package
orgMode := self organizerMode value.
orgMode == OrganizerCanvas organizerModeProject ifTrue:[
pkg := aMethod package.
holder := self selectedProjects.
((holder value ? #()) includes:pkg) ifFalse:[
holder value:(Array with:pkg).
]
].
category := aMethod category.
(self selectedProtocolsValue contains:[:p | p string = category]) ifFalse:[
(self selectedProtocolsValue includes:BrowserList nameListEntryForALL) ifFalse:[
self selectProtocols:(Array with:category).
]
].
self theSingleSelectedMethod ~~ aMethod ifTrue:[
self selectedMethods value:(Array with:aMethod).
]
!
switchToSearchItemMatching:aMatchString
self switchToClassNameOrSelectorMatching:aMatchString
"Created: / 10-08-2006 / 18:10:36 / cg"
!
switchToSelector:aSelector
|mthd cls orgMode pkg holder|
aSelector notNil ifTrue:[
(cls := self theSingleSelectedClass) notNil ifTrue:[
mthd := cls compiledMethodAt:aSelector asSymbol.
mthd notNil ifTrue:[
"/ care for method being in another package
orgMode := self organizerMode value.
orgMode == OrganizerCanvas organizerModeProject ifTrue:[
pkg := mthd package.
holder := self selectedProjects.
((holder value ? #()) includes:pkg) ifFalse:[
holder value:(Array with:pkg).
]
].
(self selectedProtocolsValue contains:[:p | p string = mthd category]) ifFalse:[
(self selectedProtocolsValue includes:BrowserList nameListEntryForALL) ifFalse:[
self selectProtocols:(Array with:mthd category).
]
].
self theSingleSelectedMethod ~~ mthd ifTrue:[
self selectedMethods value:(Array with:mthd).
]
]
]
].
"Created: / 4.2.2000 / 23:20:34 / cg"
"Modified: / 5.2.2000 / 23:07:10 / cg"
! !
!NewSystemBrowser methodsFor:'private-buffers'!
removeBuffer:nr
|prevBuffer previouslyUsedBuffer newIndex state|
state := buffers at:nr.
"/ the buffer before that one
prevBuffer := nr - 1.
prevBuffer == 0 ifTrue:[
prevBuffer := nr.
].
bufferUsageOrder removeIdentical:state.
"/ the buffer used before that one
previouslyUsedBuffer := buffers identityIndexOf:(bufferUsageOrder first).
"/ which one to use prev, next or prevUsed ???
"/ newIndex := prevBuffer.
newIndex := nr.
"/ newIndex := previouslyUsedBuffer.
selectedBuffer value:(newIndex min:buffers size-1).
buffers removeIndex:nr.
bufferNameList removeIndex:nr.
state canvas destroy.
"/ oops
newIndex > buffers size ifTrue:[
selectedBuffer value:buffers size.
].
buffers size == 1 ifTrue:[
selectedBuffer value:nil.
buffers := bufferUsageOrder := nil.
bufferNameList removeAll.
]
"Modified: / 01-03-2007 / 17:17:11 / cg"
!
removeCurrentBuffer
self removeBuffer:(selectedBuffer value)
! !
!NewSystemBrowser methodsFor:'private-checks'!
anySpecialEditorModified
self showSpecialResourceEditors value ifTrue:[
^ navigationState anySpecialEditorModified
].
^ false.
!
canAcceptCode
"code can be accepted if the current navigationState can do so.
(that is if either a method is selected, or a classDefinition is shown)"
^ self canAcceptCodeIn:navigationState
!
canAcceptCodeIn:aNavigationState
"code can be accepted, if either a method is selected,
or a classDefinition is shown"
|codeAspect codeView|
codeView := aNavigationState codeView.
codeView isNil ifTrue:[^ false].
codeView acceptAction isNil ifTrue:[^ false].
codeAspect := aNavigationState codeAspect.
^ codeAspect == #classDefinition or:[codeAspect == #method]
"Modified: / 24.2.2000 / 15:37:42 / cg"
!
canCompareCode
"code can be compared, if a method is selected"
^ self canCompareCodeIn:navigationState
!
canCompareCodeIn:aNavigationState
"code can be compared, if a method is selected"
^ aNavigationState codeAspect == #method
"Modified: / 11.2.2000 / 12:44:08 / cg"
!
canFileOutBinary
^ self hasOnlySmalltalkClassesSelected
!
canFileOutSIF
^ SmalltalkInterchangeFileManager notNil
and:[ self hasOnlySmalltalkClassesSelected ]
!
canFileOutXML
^ XMLCoder notNil
and:[ self hasOnlySmalltalkClassesSelected ]
!
canLoadRefactoringSupport
^ RefactoryChangeManager notNil and:[RefactoryChangeManager isLoaded not]
!
canMakePublicClass
"can make public, if selected and any selected class is private"
self selectedClassesDo:[:cls |
cls owningClass notNil ifTrue:[^ true].
].
^ false
"Created: / 23.2.2000 / 00:36:16 / cg"
"Modified: / 23.2.2000 / 00:56:09 / cg"
!
canRemoveNameSpace
"ns can be only be removed, if empty"
^ self hasEmptyNamespacesSelected
!
canRemoveNameSpaceHolder
"ns can be only be removed, if empty"
^ [ self canRemoveNameSpace ]
!
canRenameNameSpace
^ self hasSingleNameSpaceSelected
!
canRenameNameSpaceHolder
^ [ self canRenameNameSpace ]
!
canUseRefactoringParser
^ SmalltalkCodeGeneratorTool canUseRefactoringSupport
"Modified: / 31-01-2011 / 18:29:35 / cg"
!
canUseRefactoringSupport
"for now:
We cannot use refactoring support for non-smalltalk classes"
(self theSingleSelectedClass isNil
or:[ self theSingleSelectedClass programmingLanguage isSmalltalk ]) ifTrue:[
^ SmalltalkCodeGeneratorTool canUseRefactoringSupport
].
^ false
"Modified: / 31-01-2011 / 18:30:00 / cg"
!
canUseRefactoringSupportAndHasClassSelected
^ self canUseRefactoringSupport and:[self hasClassSelected]
!
hasOnlySmalltalkClassesSelected
^ (self selectedClasses value ? #()) conform:[:cls | cls programmingLanguage isSmalltalk]
!
javaMode
"/ ^ currentnamespace == JAVA
^ false
!
parseTreeSearcherAvailable
"/ rb-stuff not available ?
ParseTreeSearcher isNil ifTrue:[ ^ false ].
RBSearchRule isNil ifTrue:[ ^ false ].
^ true
! !
!NewSystemBrowser methodsFor:'private-code update'!
autoSearch:aString
"for compatibility with old browser"
self autoSearchPattern:aString
!
autoSearchCodePattern:codePattern
|searchAction codeView|
codePattern notNil ifTrue:[
codeView := self codeView.
searchAction :=
[:direction :startLine :startCol :foundBlock :notFoundBlock|
self
searchForCodePattern:codePattern direction:direction
startLine:(codeView cursorLine ? startLine) startCol:(codeView cursorCol ? startCol)
ifFound:[:charPos1 :charPos2 |
codeView
cursorToCharacterPosition:charPos1;
selectFromCharacterPosition:charPos1 to:charPos2
]
ifNotFound:notFoundBlock
].
navigationState autoSearchAction:searchAction.
codeView clearSearchAction. "/ searchAction
codeView setSearchPattern:nil.
]
"Modified: / 11-05-2010 / 14:13:34 / cg"
!
autoSearchPattern
^ navigationState autoSearchPattern
!
autoSearchPattern:aString
self autoSearchPattern:aString ignoreCase:false
!
autoSearchPattern:aString ignoreCase:doIgnoreCase
navigationState autoSearchPattern:aString; autoSearchIgnoreCase:doIgnoreCase.
aString notNil ifTrue:[
self codeView setSearchPattern:aString ignoreCase:doIgnoreCase.
]
!
autoSearchSelector:aSelectorOrCollectionOfSelectors ignoreCase:doIgnoreCase doMatch:doMatch
|searchAction|
aSelectorOrCollectionOfSelectors notNil ifTrue:[
searchAction :=
[:direction :startLine :startCol :foundBlock :notFoundBlock|
|codeView|
codeView := self codeView.
self
searchForSelector:aSelectorOrCollectionOfSelectors direction:direction
startLine:(startLine ? codeView cursorLine) startCol:(startCol ? codeView cursorCol)
ignoreCase:doIgnoreCase doMatch:doMatch
ifFound:
[:charPos1 :charPos2 |
codeView
cursorToCharacterPosition:charPos1;
selectFromCharacterPosition:charPos1 to:charPos2
]
ifNotFound:notFoundBlock
].
navigationState autoSearchAction:searchAction.
self codeView clearSearchAction. "/ searchAction
self codeView setSearchPattern:nil.
]
!
autoSearchVariable:aVariable
self autoSearchVariables:(Array with:aVariable)
!
autoSearchVariables:aCollectionOfVariables
self autoSearchVariables:aCollectionOfVariables readers:true writers:true
!
autoSearchVariables:aCollectionOfVariables readers:doReaders writers:doWriters
self searchVariables:aCollectionOfVariables readers:doReaders writers:doWriters asAutoSearch:true.
!
classDefinitionStringFor:aClass
|s|
s := '' writeStream.
(aClass isRealNameSpace) ifTrue:[
aClass fileOutDefinitionOn:s
] ifFalse:[
aClass theNonMetaclass isJavaClass ifTrue:[
aClass fileOutDefinitionOn:s
] ifFalse:[
aClass isMeta ifTrue:[
aClass
fileOutClassInstVarDefinitionOn:s
withNameSpace:true.
] ifFalse:[
"/
"/ here, show it with a nameSpace pragma
"/ and prefer short names.
"/
aClass
basicFileOutDefinitionOn:s
withNameSpace:true
withPackage:false
].
].
].
^ s contents withTabsExpanded.
"Modified: / 10-11-2006 / 17:13:54 / cg"
!
commentOrDocumentationStringFromClass:aClass
"the classes documentation-method's comment, or nil"
|m s isComment infoStream info|
"/ (aClass language isSmalltalk) ifFalse:[^ nil].
m := aClass theMetaclass compiledMethodAt:#documentation.
m notNil ifTrue:[
s := m comment.
isComment := false.
] ifFalse:[
"try comment"
s := aClass comment.
s isString ifTrue:[
s isEmpty ifTrue:[
s := nil
] ifFalse:[
(s includes:$") ifTrue:[
s := s copyReplaceAll:$" with:$'.
].
isComment := true.
s size > 80 ifTrue:[
s := s asCollectionOfSubstringsSeparatedBy:$..
s := s asStringCollection.
s := s collect:[:each | (each startsWith:Character space) ifTrue:[
each copyFrom:2
] ifFalse:[
each
]
].
s := s asStringWith:('.' , Character cr).
].
]
] ifFalse:[
"/ class redefines comment ?
s := nil
].
].
s notNil ifTrue:[
s asStringCollection withoutLeadingBlankLines
].
infoStream := TextStream on:''.
infoStream "cr; cr;" cr.
s isNil ifTrue:[
infoStream nextPutLine:' no comment or documentation method found'.
] ifFalse:[
"/ nextPutLine:' Documentation:'.
infoStream nextPutLine:s; cr.
infoStream nextPutLine:' Notice: '.
infoStream nextPutAll:' the above text has been extracted from the classes '.
infoStream nextPutLine:(isComment ifTrue:['comment.'] ifFalse:['documentation method.']).
infoStream nextPutLine:' Any change in it will be lost if you ''accept'' here.'.
infoStream nextPutAll:' To change the '.
infoStream nextPutAll:(isComment ifTrue:['comment'] ifFalse:['documentation']).
infoStream nextPutAll:', switch to the '.
infoStream nextPutAll:(isComment ifTrue:['comment'] ifFalse:['documentation method']).
infoStream nextPutLine:' and ''accept'' any changes there.'.
].
infoStream cr.
info := String streamContents:[:s |
aClass programmingLanguage writeComment:(infoStream contents) on:s
].
info := info emphasizeAllWith:UserPreferences current commentEmphasisAndColor.
^ info
!
searchForCodePattern:codePattern direction:direction startLine:startLine startCol:startCol
ifFound:foundBlock ifNotFound:notFoundBlock
|searcher|
self parseTreeSearcherAvailable ifFalse:[ ^ self ].
searcher := ParseTreeSearcher new.
searcher
matches: codePattern
do:[:aNode :answer | answer add:aNode. answer ].
^ self
searchUsingSearcher:searcher
direction:direction
startLine:startLine startCol:startCol
ifFound:foundBlock ifNotFound:notFoundBlock.
!
searchForSelector:aSelectorOrCollectionOfSelectors direction:direction
startLine:startLine startCol:startCol
ignoreCase:ignoreCase doMatch:doMatch
ifFound:foundBlock ifNotFound:notFoundBlock
|searcher|
self parseTreeSearcherAvailable ifFalse:[ ^ self ].
doMatch ifTrue:[
(aSelectorOrCollectionOfSelectors isSymbol or:[aSelectorOrCollectionOfSelectors isString]) ifTrue:[
searcher := ParseTreeSearcher allMessageSendsMatching:aSelectorOrCollectionOfSelectors ignoreCase:ignoreCase.
] ifFalse:[
searcher := ParseTreeSearcher allMessageSendsMatchingAny:aSelectorOrCollectionOfSelectors ignoreCase:ignoreCase.
].
] ifFalse:[
(aSelectorOrCollectionOfSelectors isSymbol or:[aSelectorOrCollectionOfSelectors isString]) ifTrue:[
searcher := ParseTreeSearcher allMessageSendsTo:aSelectorOrCollectionOfSelectors ignoreCase:ignoreCase.
] ifFalse:[
searcher := ParseTreeSearcher allMessageSendsToAny:aSelectorOrCollectionOfSelectors ignoreCase:ignoreCase.
].
].
^ self
searchUsingSearcher:searcher
direction:direction
startLine:startLine startCol:startCol
ifFound:foundBlock ifNotFound:notFoundBlock.
!
searchForVariable:aVariableNameOrCollectionOfVariableNames direction:direction
startLine:startLine startCol:startCol
readers:searchReaders writers:searchWriters
ifFound:foundBlock ifNotFound:notFoundBlock
|searcher|
self parseTreeSearcherAvailable ifFalse:[ ^ self ].
searchReaders ifTrue:[
searchWriters ifTrue:[
searcher := ParseTreeSearcher allReferencesToAnyVariableIn:aVariableNameOrCollectionOfVariableNames.
] ifFalse:[
searcher := ParseTreeSearcher allReadsOfAnyVariableIn:aVariableNameOrCollectionOfVariableNames.
].
] ifFalse:[
searchWriters ifTrue:[
searcher := ParseTreeSearcher allModificationsOfAnyVariableIn:aVariableNameOrCollectionOfVariableNames.
] ifFalse:[
self error:'missing search criteria'
].
].
^ self searchUsingSearcher:searcher direction:direction
startLine:startLine startCol:startCol
ifFound:foundBlock ifNotFound:notFoundBlock.
!
searchUsingSearcher:searcher direction:direction
startLine:startLine startCol:startCol
ifFound:foundBlock ifNotFound:notFoundBlock
|codeTree nodes searchStartPos prevNode|
RBParser isNil ifTrue:[^ self].
codeTree := RBParser
parseSearchMethod:self codeView contents
onError: [:str :pos | "Transcript showCR:str. Transcript showCR:pos." nil].
codeTree notNil ifTrue:[
searcher executeTree:codeTree initialAnswer:(nodes := OrderedCollection new).
searchStartPos := self codeView characterPositionOfLine:startLine col:startCol.
nodes do:[:aNode |
|nodeStartPos nodeEndPos selStartLine selEndLine|
nodeStartPos := aNode start.
nodeEndPos := aNode stop.
"/ self codeView selectFromCharacterPosition:nodeStartPos to:nodeEndPos.
direction == #backward ifTrue:[
nodeEndPos >= (searchStartPos-1) ifTrue:[
prevNode isNil ifTrue:[^ self].
foundBlock value:(prevNode start) value:(prevNode stop).
^ self.
].
prevNode := aNode.
] ifFalse:[
nodeStartPos >= searchStartPos ifTrue:[
foundBlock value:nodeStartPos value:nodeEndPos.
^ self.
].
].
].
prevNode notNil ifTrue:[
foundBlock value:(prevNode start) value:(prevNode stop).
^ self
].
].
notFoundBlock value
!
searchVariables:aCollectionOfVariables readers:doReaders writers:doWriters asAutoSearch:asAutoSearch
|searchAction|
aCollectionOfVariables size > 0 ifTrue:[
searchAction :=
[:direction :startLine :startCol :foundBlock :notFoundBlock|
|codeView|
codeView := self codeView.
self
searchForVariable:aCollectionOfVariables direction:direction
startLine:(codeView cursorLine ? startLine) startCol:(codeView cursorCol ? startCol)
readers:doReaders writers:doWriters
ifFound:
[:charPos1 :charPos2 |
codeView
cursorToCharacterPosition:charPos1;
selectFromCharacterPosition:charPos1 to:charPos2
]
ifNotFound:(asAutoSearch ifTrue:[notFoundBlock] ifFalse:[nil])
].
navigationState autoSearchAction:searchAction.
self codeView searchAction:searchAction
]
!
showClassAspect:codeAspect forClass:aClass
|theNonMetaclass|
theNonMetaclass := aClass theNonMetaclass.
codeAspect == #classComment ifTrue:[
self showClassComment:theNonMetaclass.
^ self.
].
codeAspect == #classHierarchy ifTrue:[
self showClassHierarchy:theNonMetaclass.
^ self.
].
((codeAspect == #primitiveDefinitions)
or:[ (codeAspect == #primitiveFunctions)
or:[ (codeAspect == #primitiveVariables) ]]) ifTrue:[
self showClassPrimitive:codeAspect class:aClass theNonMetaclass.
^ self.
].
self setAcceptActionForClass.
self showClassDefinition:aClass.
!
showClassComment:aClass
|code codeView|
self codeAspect:#classComment.
self setAcceptActionForClassComment.
"/ self selectedMethods value:nil.
"/ self selectedProtocols value:nil.
aClass notNil ifTrue:[
aClass isLoaded ifFalse:[
code := 'Class is not loaded.'.
] ifTrue:[
code := aClass comment.
].
codeView := self codeView.
codeView contents:code.
codeView modified:false.
navigationState realModifiedState:false.
]
"Modified: / 8.11.2001 / 23:08:31 / cg"
!
showClassDefinition:aClass
|definition highlighter info text|
self codeAspect:#classDefinition.
self setAcceptActionForClass.
aClass isNil ifTrue:[ ^ self ].
(aClass isClass or:[aClass isMetaclass]) ifFalse:[ ^ self ].
definition := self classDefinitionStringFor:aClass.
self doSyntaxColoring value ~~ false ifTrue:[
highlighter := aClass syntaxHighlighterClass.
highlighter notNil ifTrue:[
definition := highlighter formatClassDefinition:definition in:nil.
]
].
self showCode:definition.
self normalLabel.
aClass isLoaded ifTrue:[
"/ continue fetching the documentation,
"/ which may take longer, if the source must be fetched
"/ from the repository.
"
add documentation as a comment, if there is any
"
info := self commentOrDocumentationStringFromClass:aClass.
info notNil ifTrue:[
text := definition,(Character cr),info.
].
self codeHolder setValue:text.
self codeView notNil ifTrue:[
self codeView setContents:text
].
].
self updatePackageInfoForClass:aClass.
"Modified: / 14-08-2010 / 12:05:08 / cg"
!
showClassDocumentation
|cls text|
"/ show classes documentation
cls := self theSingleSelectedClass.
cls notNil ifTrue:[
cls isLoaded ifFalse:[
text := 'Class is not loaded.'.
] ifTrue:[
text := HTMLDocGenerator htmlDocOf:cls.
].
self classDocumentationHolder value:text.
] ifFalse:[
self showNothing.
].
"Modified: / 01-03-2007 / 20:58:34 / cg"
!
showClassHierarchy:aClass
|code codeView s indent|
self codeAspect:#classHierarchy.
self setAcceptActionForNothing.
aClass notNil ifTrue:[
s := '' writeStream.
indent := 0.
aClass withAllSuperclasses reverse do:[:cls |
s spaces:indent * 2.
s nextPutAll:cls name.
s cr.
indent := indent + 1.
].
code := s contents.
codeView := self codeView.
codeView contents:code.
codeView modified:false.
navigationState realModifiedState:false.
]
"Modified: / 8.11.2001 / 23:07:57 / cg"
!
showClassPrimitive:aspect class:aClass
|primCode codeView|
self codeAspect:aspect.
aClass isLoaded ifFalse:[
primCode := 'Class is not loaded'.
self setAcceptActionForNothing.
] ifTrue:[
aspect == #primitiveDefinitions ifTrue:[
primCode := aClass primitiveDefinitionsStringOrDefault.
] ifFalse:[
aspect == #primitiveFunctions ifTrue:[
primCode := aClass primitiveFunctionsStringOrDefault.
] ifFalse:[
aspect == #primitiveVariables ifTrue:[
primCode := aClass primitiveVariablesStringOrDefault.
] ifFalse:[
self error:'unknown primitive aspect'.
]
]
].
self setAcceptAction:[:theCode | self doAcceptClassPrimitive:theCode].
].
codeView := self codeView.
codeView contents:primCode.
codeView modified:false.
navigationState realModifiedState:false.
!
showClassPrimitiveDefinitions:aClass
self showClassPrimitive:#primitiveDefinitions class:aClass
!
showClassPrimitiveVariables:aClass
self showClassPrimitive:#primitiveVariables class:aClass
!
showClassVarInfoFor:var in:aClass value:val
|text valText lines|
text := '%1 (%2) : %3'.
val isNumber ifTrue:[
text := '%1 (%2) : %3 (%4)'.
valText := val printString.
] ifFalse:[
val isLiteral ifTrue:[
text := '%1 (%2) : %4'.
lines := val storeString asCollectionOfLines.
valText := lines first contractTo:30.
valText := valText copy.
valText replaceAllForWhich:[:ch | ch isControlCharacter] with:$?.
lines size > 1 ifTrue:[
valText := valText , '...'.
].
] ifFalse:[
val isCollection ifTrue:[
text := '%1 (%2) : %3 (%4)'.
valText := val isEmpty
ifTrue:['empty']
ifFalse:['size: ' , val size printString].
] ifFalse:[
val isBehavior ifTrue:[
(val isSubclassOf:Error) ifTrue:[
text := '%1 (%2) : %4 (an Error subclass)'.
valText := val name.
] ifFalse:[
(val isSubclassOf:Exception) ifTrue:[
text := '%1 (%2) : %4 (an Exception subclass)'.
valText := val name.
] ifFalse:[
text := '%1 (%2) : %4'.
valText := val name.
]
]
]
]
].
].
text := text
bindWith:var allBold
with:(aClass name)
with:(val class nameWithArticle)
with:valText.
self showInfo:text.
!
showCode:aString
self showCode:aString scrollToTop:true
"Modified: / 1.3.2000 / 11:38:33 / cg"
!
showCode:aString scrollToTop:doScrollToTop
|codeView shownCode prevCode|
(codeView := self codeView) notNil ifTrue:[
codeView numberOfLines < 1000 ifTrue:[
shownCode := codeView contents.
].
prevCode := (shownCode ? '') asString.
(codeView modified
or:[
(prevCode asText sameStringAndEmphasisAs:(aString ? '') asString asText) not
]) ifTrue:[
(prevCode isNil
or:[aString isNil
or:[(prevCode withTabsExpanded sameStringAndEmphasisAs: aString withTabsExpanded) not]]) ifTrue:[
aString = self codeHolder value ifTrue:[
"/ a reselect without accepting before ...
"/ sigh - must use setValue, and enforce a change
"/ (workaround for proceed after changed text-warning)
self codeHolder setValue:aString.
aString = shownCode ifFalse:[
codeView setContents:aString.
]
] ifFalse:[
self codeHolder value:aString.
].
].
doScrollToTop ifTrue:[
codeView cursorHome.
]
]
] ifFalse:[
aString = self codeHolder value ifTrue:[
"/ a reselect without accepting before ...
"/ sigh - must use setValue, and enforce a change
"/ (workaround for proceed after changed text-warning)
self codeHolder setValue:aString.
"/ codeView setContents:aString.
] ifFalse:[
self codeHolder value:aString.
]
].
"Created: / 1.3.2000 / 11:38:07 / cg"
"Modified: / 1.3.2000 / 11:40:53 / cg"
!
showFullClassDefinition:aClass
|definition|
aClass isLoaded ifFalse:[
self showClassDefinition:aClass.
^ self.
].
definition := aClass source.
self showCode:definition.
self codeAspect:#classDefinition.
self normalLabel.
"Modified: / 24.2.2000 / 15:46:08 / cg"
!
showFullClassSource
|cls|
"/ show full classes source - set accept action for fileIn
cls := self theSingleSelectedClass.
cls notNil ifTrue:[
self setAcceptActionForClass.
self showFullClassDefinition:cls.
] ifFalse:[
self showNothing.
].
navigationState modified:false.
navigationState realModifiedState:false.
"Modified: / 01-03-2007 / 20:58:37 / cg"
!
showMethodsCode:mthd
self showMethodsCode:mthd scrollToTop:true
"Modified: / 1.3.2000 / 11:39:14 / cg"
!
showMethodsCode:mthd scrollToTop:doScrollToTop
|code codeView doAutoFormat doSyntaxColoring|
doSyntaxColoring := self doSyntaxColoring value == true.
doAutoFormat := self doAutoFormat value and:[RBFormatter notNil].
codeView := self codeView.
self assert:codeView notNil.
code := self sourceOfMethod:mthd.
code isText ifTrue:[
doSyntaxColoring := false.
].
doAutoFormat ifTrue:[
Error catch:[
code := RBFormatter format:code
].
].
doSyntaxColoring ifTrue:[
"/ immediate coloring, if code is not too large;
"/ otherwise, do it in the background.
code size < 2000 " 10000 " ifTrue:[
Error catch:[
code := self syntaxHighlightedCodeFor:code method:mthd.
].
] ifFalse:[
self enqueueDelayedStartSyntaxHighlightProcess.
].
[
codeView modifiedChannel removeDependent:self.
codeView modified:false.
self showCode:code scrollToTop:doScrollToTop.
] ensure:[
codeView modifiedChannel addDependent:self.
]
] ifFalse:[
self showCode:code scrollToTop:doScrollToTop.
].
mthd sourceLineNumber ~~ 1 ifTrue:[
doScrollToTop ifTrue:[
codeView scrollToLine:mthd sourceLineNumber
]
].
self codeAspect:(code ifNil:[nil] ifNotNil:[#method]).
self normalLabel.
self updatePackageInfoForMethod:mthd.
"Modified: / 13.2.2000 / 22:30:40 / cg"
"Created: / 1.3.2000 / 11:38:57 / cg"
!
showNothing
self setAcceptActionForNothing.
self showCode:nil.
self codeAspect:nil.
self normalLabel.
"Modified: / 01-03-2007 / 20:58:30 / cg"
!
showVersionDiff
|ownerClass cls diffApp info mgr sourceInfo packageDir moduleDir classFileName|
diffApp := self navigationState versionDiffApplication.
"/ show version differences against repository
cls := self theSingleSelectedClass.
cls notNil ifTrue:[
cls := cls theNonMetaclass.
(ownerClass := cls topOwningClass) isNil ifTrue:[ownerClass := cls].
mgr := SourceCodeManagerUtilities sourceCodeManagerFor:ownerClass.
info := 'Package: ' , ownerClass package.
"/ (mgr checkForExistingContainerForClass:ownerClass) ifFalse:[
"/ info := info , ' not in repository (?)'
"/ ] ifTrue:[
info := info , ' Version: ' , (ownerClass revision ? 'no-version').
info := info , ' Repository: ' , ((ownerClass sourceCodeManager ? SourceCodeManager) newestRevisionOf:ownerClass).
info := info , ' Location: '.
sourceInfo := mgr sourceInfoOfClass:ownerClass.
sourceInfo notNil ifTrue:[
moduleDir := mgr moduleFromSourceInfo:sourceInfo.
packageDir := mgr directoryFromSourceInfo:sourceInfo.
classFileName := mgr containerFromSourceInfo:sourceInfo.
info := info , ' ' , (moduleDir ? '???').
info := info , '/' , (packageDir ? '???').
info := info , '/' , (classFileName ? '???').
].
"/ ].
] ifFalse:[
info := 'Please select a single class to see the diffs.'
].
diffApp setupForClass:cls againstVersion:nil. "/ #newest
self classesProjectInfoHolder value:info.
self setAcceptActionForNothing.
self normalLabel.
"Modified: / 12-09-2006 / 14:23:40 / cg"
!
sourceOfMethod:mthd
|code|
code := mthd source.
code notNil ifTrue:[ ^ code].
self setNoAcceptAction.
(mthd sourcePosition isNil
or:[mthd getSource isNil]) ifTrue:[
^ '"
Sorry, but the methods sourceCode is not available.
Probably, the methods sourceCode-info was stripped from the system.
"'.
].
^ '"
Sorry, but the methods sourceCode is not available or corrupted.
Please check the setting of your packagePath, which contains a collection of pathNames.
The system searches those directories for a package-subdirectories,
which should either contain the classes source file.
Also, check if that directory and/or sourceFile grants read access.
The packagePath can be accessed via
Smalltalk packagePath
To fix this (in the running system), evaluate:
Smalltalk packagePath addFirst:''<<pathOfDirContainingPackageDir>>''.
Smalltalk flushPathCaches.
You may also want to add those statements to the end of your ''private.rc''
file - so you will not get this error again and again.
Also, check if you have the sourceCodeManagement (CVS) enabled,
and (if so) configured correctly.
If all of the above fail, and you know the path of the source file,
you can workaround the problem, by adding a symbolic link to that sourcefile
in the ''source'' directory.
"'.
!
updatePackageInfoForClass:aClass
|packageLabel loadInfo revisionInfo revision lastUser|
(aClass notNil and:[aClass isClass or:[aClass isMetaclass]]) ifTrue:[
"/ packageLabel := 'Base: ' , (aClass package ? '?').
packageLabel := (aClass package ? '?') allBold.
aClass isLoaded ifTrue:[
revisionInfo := aClass theNonMetaclass revisionInfo.
(revisionInfo notNil and:[(revisionInfo at:#revision) notNil]) ifTrue:[
revision := revisionInfo at:#revision.
lastUser := ' ',(revisionInfo at:#user).
] ifFalse:[
revision := aClass theNonMetaclass revision.
lastUser := ''.
].
loadInfo := ' [%1%2]' bindWith:(revision ? 'no revision') with:lastUser.
aClass wasAutoloaded ifTrue:[
loadInfo := loadInfo , ' {Auto}'.
].
] ifFalse:[
loadInfo := ' {Unloaded}'.
].
packageLabel := packageLabel , loadInfo.
"/ packageLabel := packageLabel,' (Base)'.
].
navigationState packageLabelHolder value:packageLabel.
"Modified: / 14-08-2010 / 12:04:39 / cg"
!
updatePackageInfoForMethod:aMethod
|mpkg info info2 mClass clsRevision|
aMethod isNil ifTrue:[
^ self updatePackageInfoForClass:self theSingleSelectedClass.
].
mClass := aMethod mclass.
mClass isNil ifTrue:[
info := 'Unassigned'
] ifFalse:[
mpkg := aMethod package.
info := mpkg allBold.
(mpkg ~= mClass package) ifTrue:[
mpkg = PackageId noProjectID ifTrue:[
info2 := ' (Unassigned)'
] ifFalse:[
info2 := ' (Extension)'
].
] ifFalse:[
clsRevision := mClass theNonMetaclass revision printString.
(ChangeSet current includesChangeForClass:mClass selector:aMethod selector) ifTrue:[
info2 := ' [derived from ' , clsRevision , ']'.
] ifFalse:[
info2 := ' [' , clsRevision , ']'.
]
].
info := info,info2
].
navigationState packageLabelHolder value:info
"Modified: / 01-03-2007 / 21:03:22 / cg"
! !
!NewSystemBrowser methodsFor:'private-dialogs'!
askForDirectoryToFileOut:title default:defaultDirOrNil
|dirName dir|
dir := defaultDirOrNil.
dir isNil ifTrue:[
dir := FileSelectionBox lastFileSelectionDirectory.
dir isNil ifTrue:[
"
this test allows a smalltalk to be built without Projects/ChangeSets
"
Project notNil ifTrue:[
dir := Project currentProjectDirectory
]
]
].
dirName := Dialog
requestDirectoryName:title
default:dir
ok:(resources string:'FileOut')
abort:(resources string:'Cancel').
dirName isEmptyOrNil ifTrue:[ ^ nil ].
FileSelectionBox lastFileSelectionDirectory:dirName.
^ dirName.
"/
"/ fileBox := FileSelectionBox
"/ title:title
"/ okText:(resources string:'FileOut')
"/ abortText:(resources string:'Cancel')
"/ action:[:fileName |dirName := fileName.].
"/
"/ dir notNil ifTrue:[
"/ fileBox directory:dir.
"/ ].
"/ fileBox selectingDirectory:true.
"/ fileBox open.
"/
"/ fileBox destroy.
"/ fileBox := nil.
"/
"/ dirName notNil ifTrue:[
"/ FileSelectionBox lastFileSelectionDirectory:dirName.
"/ ].
"/ ^ dirName
"Modified: / 23-08-2006 / 12:32:31 / cg"
!
askForMethodAndSpawnSearchTitle:title browserLabel:label searchWith:aSelectorOrBlock searchArea:whereDefault
"convenient helper method: setup an enterBox for method browsing without text-entry.
SearchArea may be one of
#everywhere,
#currentNameSpace
#currentClassesNameSpace
#classCategories
#classes
#classesWithPrivateClasses
#classHierarchies
#classHierarchiesWithPrivateClasses"
^ self
askForMethodAndSpawnSearchTitle:title
browserLabel:label
searchWith:aSelectorOrBlock
searchArea:whereDefault
allowFind:false
allowBuffer:true
allowBrowser:true
!
askForMethodAndSpawnSearchTitle:title browserLabel:label searchWith:aSelectorOrBlock searchArea:whereDefault allowFind:allowFind allowBuffer:allowBuffer allowBrowser:allowBrowser
"convenient helper method: setup an enterBox for method browsing without text-entry.
SearchArea may be one of
#everywhere,
#currentNameSpace
#currentClassesNameSpace
#classCategories
#classes
#classesWithPrivateClasses
#classHierarchies
#classHierarchiesWithPrivateClasses"
^ self
askForMethodAndSpawnSearchTitle:title
browserLabel:label
searchWith:[:dummyString :classes :dummyCaseIgnore :dummyMatch |
aSelectorOrBlock value:classes
]
searchWhat:#special
searchArea:whereDefault
withCaseIgnore:false
withTextEntry:false
withMatch:false
withMethodList:false
setSearchPattern:nil
!
askForMethodAndSpawnSearchTitle:title browserLabel:labelHolderOrBlock searchWith:aSelectorOrBlock searchWhat:searchWhat searchArea:whereDefault withCaseIgnore:withCaseIgnore setSearchPattern:setSearchPatternAction
"convenient helper method: setup an enterBox with text from codeView or selected
method for browsing based on a selector. Set action and launch box.
SearchArea may be one of
#everywhere,
#currentNameSpace
#currentClassesNameSpace
#classCategories
#classes
#classesWithPrivateClasses
#classHierarchies
#classHierarchiesWithPrivateClasses"
^ self
askForMethodAndSpawnSearchTitle:title
browserLabel:labelHolderOrBlock
searchWith:aSelectorOrBlock
searchWhat:searchWhat
searchArea:whereDefault
withCaseIgnore:withCaseIgnore
withTextEntry:true
withMethodList:false
setSearchPattern:setSearchPatternAction
!
askForMethodAndSpawnSearchTitle:title browserLabel:labelHolderOrBlock searchWith:aSelectorOrBlock searchWhat:searchWhat searchArea:whereDefault
withCaseIgnore:withCaseIgnore withTextEntry:withTextEntry withMatch:withMatch withMethodList:withMethodList setSearchPattern:setSearchPatternAction
"convenient helper method: setup an enterBox with text from codeView or selected
method for browsing based on a selector. Set action and launch box.
SearchArea may be one of
#everywhere,
#currentNameSpace
#currentClassesNameSpace
#classCategories
#classes
#classesWithPrivateClasses
#classHierarchies
#classHierarchiesWithPrivateClasses"
|restart dialog|
dialog := SearchDialog new
setupToAskForMethodSearchTitle:title
forBrowser:self
searchWhat:searchWhat
searchArea:whereDefault
withCaseIgnore:withCaseIgnore
withMatch:withMatch
withMethodList:withMethodList
allowFind:(self navigationState isMethodBrowser)
allowBuffer:true
allowBrowser:true
withTextEntry:withTextEntry.
restart := Signal new.
restart
handle:[:ex |
ex restart
]
do:[
dialog askThenDo:[
|classes string ignoreCase openHow match methods isMethod|
classes := dialog classesToSearch.
string := dialog selectorToSearch.
ignoreCase := dialog searchIgnoringCase.
openHow := dialog openHow.
match := dialog searchWithMatch.
methods := dialog methodsToSearch.
isMethod := dialog matchMethods.
self withSearchCursorDo:[
|initialList list newBrowser numFound label selector entities arguments numArgs answer
alternativeSelector question altArguments|
aSelectorOrBlock isArray ifTrue:[
classes notNil ifTrue:[
selector := aSelectorOrBlock first.
entities := classes.
] ifFalse:[
selector := aSelectorOrBlock second.
entities := methods.
].
numArgs := selector numArgs.
] ifFalse:[
entities := classes.
aSelectorOrBlock isSymbol ifTrue:[
selector := aSelectorOrBlock.
] ifFalse:[
selector := nil
].
numArgs := aSelectorOrBlock numArgs.
].
(selector notNil
and:[ (selector numArgs == 1)
and:[ (selector endsWith:'In:') or:[ selector endsWith:'inMethods:' ]]]) ifTrue:[
arguments := Array with:entities
] ifFalse:[
arguments := (Array
with:string
with:entities
with:((selector notNil and:[selector endsWith:'isMethod:']) ifTrue:[isMethod] ifFalse:[ignoreCase])
with:match
) copyTo:numArgs.
].
selector notNil ifTrue:[
initialList := self class perform:selector withArguments:arguments.
] ifFalse:[
initialList := aSelectorOrBlock valueWithArguments:arguments
].
label := labelHolderOrBlock value.
numFound := initialList size.
numFound == 0 ifTrue:[
question := resources stringWithCRs:label with:((string ? '') allBold colorizeAllWith:Color red darkened).
question := question , (resources string:' - none found.').
((selector == #findImplementors:in:ignoreCase:match:)
and:[ (arguments first numArgs == 0)
and:[
string := ((arguments at:1),':') asSymbol.
altArguments := arguments copy.
altArguments at:1 put:string.
initialList := self class perform:selector withArguments:altArguments.
numFound := initialList size.
numFound ~~ 0
]]) ifTrue:[
question := question,(resources stringWithCRs:'\\But there are %1 implementations of %2 (with colon).\Browse those ?' with:numFound with:(altArguments first)).
answer := Dialog
confirmWithCancel:question
labels:(resources array:#('Cancel' 'Search Again' 'Yes'))
default:2.
answer isNil ifTrue:[
^ self
].
answer ifFalse:[
restart raiseRequest
].
arguments := altArguments.
] ifFalse:[
answer := Dialog
confirm:question
yesLabel:(resources string:'Search Again')
noLabel:(resources string:'Cancel').
answer ifFalse:[
^ self
].
restart raiseRequest
].
].
(initialList asSet = (self selectedMethods value ? #()) asSet)
"/ (numFound == 1 and:[initialList first == self theSingleSelectedMethod])
ifTrue:[
answer := Dialog
confirmWithCancel:((resources stringWithCRs:label with:(string ? 'messages') allBold)
, '.\\' withCRs
, (resources stringWithCRs:'Only the selected method(s) found.\Browse anyway ?'))
labels:(resources array:#('Cancel' 'Search Again' 'Yes' ))
values:#(nil #again true)
default:2.
answer == nil ifTrue:[
^ self
].
answer == #again ifTrue:[
restart raiseRequest
]
].
newBrowser := self
spawnMethodBrowserForSearch:[
initialList notNil ifTrue:[
list := initialList.
initialList := nil
] ifFalse:[
selector notNil ifTrue:[
list := self class perform:selector withArguments:arguments.
] ifFalse:[
list := aSelectorOrBlock valueWithArguments:arguments
].
].
list
]
sortBy:#class
in:openHow
label:(resources string:label string with:string).
setSearchPatternAction notNil ifTrue:[
setSearchPatternAction value:newBrowser value:string value:((selector notNil and:[selector endsWith:'isMethod:']) ifTrue:[isMethod] ifFalse:[ignoreCase]) value:match.
].
^ newBrowser.
].
].
].
"Modified: / 11-05-2010 / 16:51:50 / cg"
!
askForMethodAndSpawnSearchTitle:title browserLabel:labelHolderOrBlock searchWith:aSelectorOrBlock searchWhat:searchWhat searchArea:whereDefault
withCaseIgnore:withCaseIgnore withTextEntry:withTextEntry withMethodList:withMethodList setSearchPattern:setSearchPatternAction
"convenient helper method: setup an enterBox with text from codeView or selected
method for browsing based on a selector. Set action and launch box.
SearchArea may be one of
#everywhere,
#currentNameSpace
#currentClassesNameSpace
#classCategories
#classes
#classesWithPrivateClasses
#classHierarchies
#classHierarchiesWithPrivateClasses"
^self
askForMethodAndSpawnSearchTitle:title
browserLabel:labelHolderOrBlock
searchWith:aSelectorOrBlock
searchWhat:searchWhat
searchArea:whereDefault
withCaseIgnore:withCaseIgnore
withTextEntry:withTextEntry
withMatch:true
withMethodList:withMethodList
setSearchPattern:setSearchPatternAction
!
askForMethodCategory:question title:boxTitle okLabel:okLabel list:someCategories initialAnswer:initialText
"convenient helper method: setup a box asking for a method category"
^ self
askForMethodCategory:question
title:boxTitle
okLabel:okLabel
list:someCategories
recentList:nil
initialAnswer:initialText
!
askForMethodCategory:title title:boxTitle okLabel:okLabel list:someCategories recentList:recentListOrNil initialAnswer:initialText
"convenient helper method: setup a box asking for a method category"
|box retVal shownCategories allMethodCategories|
box := self
listBoxTitle:title
okText:okLabel
list:someCategories.
box label:boxTitle.
recentListOrNil notNil ifTrue:[
box useComboBoxWithList:recentListOrNil.
].
shownCategories := someCategories.
box initialText:initialText.
box action:[:aString | aString notEmpty ifTrue:[retVal := aString] ].
box entryCompletionBlock:[:contents |
|s what best idx|
s := contents withoutLeadingSeparators.
what := self navigationState environment methodProtocolCompletion:s.
best := what first.
box contents:best.
idx := shownCategories findFirst:[:l | l startsWith:best].
idx == 0 ifTrue:[
allMethodCategories isNil ifTrue:[
allMethodCategories := Smalltalk allMethodCategories asArray sort.
].
box list:allMethodCategories.
shownCategories := allMethodCategories.
idx := shownCategories findFirst:[:l | l startsWith:best].
].
idx ~~ 0 ifTrue:[
box listView scrollToLine:idx.
].
(what at:2) size ~~ 1 ifTrue:[
self builder window beep
].
].
box open.
^ retVal
"Created: / 29.2.2000 / 10:53:09 / cg"
!
askForMethodCategoryForAcceptInClass:cls selector:selectorOrNil
"convenient helper method: setup a box asking for a method category"
|methodCategoryListApp meta someCategories initial inheritedMethod|
methodCategoryListApp := navigationState methodCategoryListApplication.
someCategories := Set new.
meta := cls isMeta.
"/ do not include above Class if meta.
cls theNonMetaclass withAllSuperclassesDo:[:eachNonMetaClass |
|eachClass|
eachClass := eachNonMetaClass.
meta ifTrue:[eachClass := eachNonMetaClass theMetaclass].
someCategories addAll:eachClass categories.
methodCategoryListApp notNil ifTrue:[
someCategories addAll:(methodCategoryListApp additionalProtocolForClass:eachClass).
]
].
someCategories := someCategories asOrderedCollection sort.
"/ look for inherited; default to that category
selectorOrNil notNil ifTrue:[
inheritedMethod := cls lookupMethodFor:selectorOrNil.
inheritedMethod notNil ifTrue:[
initial := inheritedMethod category
]
].
initial isNil ifTrue:[
lastMethodCategory isNil ifTrue:[
initial := Compiler defaultMethodCategory "/ 'new methods' '* As yet uncategorized *'
] ifFalse:[
initial := lastMethodCategory
].
].
^ self
askForMethodCategory:'Accept in which method category ?'
title:'Methods Category'
okLabel:'Accept'
list:someCategories
initialAnswer:initial
"Created: / 29.2.2000 / 10:50:38 / cg"
"Modified: / 29.2.2000 / 10:54:26 / cg"
!
askForNameSpace:title title:boxTitle initialText:initialTextOrNil
"Ask for the new namespaces name"
^ Dialog requestNameSpace:title title:boxTitle initialAnswer:initialTextOrNil
!
askForProject:title
"helper for move-class-to-project and move-method-to-ptoject;
Ask for the new project (package-id)"
^ self askForProject:title initialText:(LastProjectMoves ? #('')) first
!
askForProject:title initialText:initialTextOrNil
"helper for move-class-to-project and move-method-to-ptoject;
Ask for the new project (package-id)"
^ self askForProject:title initialText:initialTextOrNil moreSuggestions:#()
"Modified: / 11-08-2006 / 13:31:45 / cg"
!
askForProject:title initialText:initialTextOrNil moreSuggestions:moreSuggestions
"helper for move-class-to-project and move-method-to-ptoject;
Ask for the new project (package-id)"
|offered already allProjects classesProjects selectedClasses selectedMethods|
allProjects := Smalltalk allProjectIDs.
selectedClasses := self selectedClasses value.
selectedClasses notNil ifTrue:[
classesProjects := selectedClasses
collectAll:[:cls |
(cls methodDictionary values
collect:[:m | m package ]) asSet ].
] ifFalse:[
selectedMethods := self selectedMethods value.
selectedMethods notNil ifTrue:[
classesProjects := selectedMethods
collectAll:[:mthd |
(mthd mclass methodDictionary values
collect:[:m | m package ]) asSet ].
] ifFalse:[
classesProjects := #()
]
].
classesProjects remove:(PackageId noProjectID) ifAbsent:nil.
classesProjects removeAllFoundIn:(moreSuggestions ? #()).
classesProjects removeAllFoundIn:(LastProjectMoves ? #()).
classesProjects := classesProjects asOrderedCollection sort.
offered := OrderedCollection new.
already := Set new.
(moreSuggestions ? #()) do:[:p |
(already includes:p) ifFalse:[ offered add:p]
].
(LastProjectMoves ? #()) do:[:p |
(already includes:p) ifFalse:[ offered add:p]
].
classesProjects do:[:p |
(already includes:p) ifFalse:[ offered add:p]
].
^ Dialog
requestProject:((resources ? self class classResources) string:title)
initialAnswer:initialTextOrNil
suggestions:offered
"Created: / 11-08-2006 / 13:31:34 / cg"
"Modified: / 12-10-2006 / 20:51:57 / cg"
!
askForSelector:title allowBuffer:allowBuffer allowBrowser:allowBrowser thenDo:aBlock
"helper for find-implementation;
Ask for the selector "
|methods selectors selector firstMethod firstSelector
box b openHow prevButton searchClass listInBox|
openHow := nil.
selectors := Set new.
methods := self selectedMethods value.
methods size > 0 ifTrue:[
firstMethod := methods first.
firstSelector := firstMethod selector.
].
searchClass := self theSingleSelectedClass ? self classHierarchyTopClass value.
searchClass isNil ifTrue:[
self theSingleSelectedMethod notNil ifTrue:[
searchClass := self theSingleSelectedMethod mclass
]
].
searchClass notNil ifTrue:[
searchClass withAllSuperclassesDo:[:cls |
selectors addAll:(cls methodDictionary keys copy)
]
].
selectors := selectors asOrderedCollection sort.
listInBox := selectors
collect:[:eachSel | eachSel , (' [ ' , (searchClass whichClassIncludesSelector:eachSel) name , ' ]')].
UserPreferences current avoidSlowDrawingOperationsUnderWindows ifFalse:[
listInBox := listInBox collect:[:eachEntry | eachEntry allItalic].
].
box := ListSelectionBox new.
box title:(resources string:title).
box list:listInBox.
box okAction:[:sel | selector := (sel upTo:$[ ) withoutSeparators asSymbol].
"/ selector := self codeView selection.
"/ selector notNil ifTrue:[
"/ selector := selector asString string
"/ ] ifFalse:[
"/ selector := firstSelector.
"/ ].
selector := self selectorToSearchFor.
selector isNil ifTrue:[
selector := firstSelector
].
box initialText:selector.
box entryCompletionBlock:[:contents |
|s what longest matching|
box topView withWaitCursorDo:[
s := contents withoutSpaces.
what := Smalltalk selectorCompletion:s.
longest := what first.
matching := what last.
box list:matching.
box contents:longest.
matching size ~~ 1 ifTrue:[
self window beep
]
]
].
box okText:(resources string:'Find').
allowBuffer ifTrue:[
b := Button label:(resources string:'Add Buffer').
(DialogBox defaultOKButtonAtLeft) ifFalse:[
box addButton:b before:box okButton.
] ifTrue:[
box addButton:b before:nil.
].
b action:[
openHow := #newBuffer.
box doAccept.
box okPressed.
].
prevButton := b.
].
allowBrowser ifTrue:[
b := Button label:(resources string:'Browse').
(DialogBox defaultOKButtonAtLeft) ifFalse:[
box addButton:b before:box okButton.
] ifTrue:[
box addButton:b before:nil.
].
b action:[
openHow := #newBrowser.
box doAccept.
box okPressed.
].
prevButton := b.
].
"/ prevButton notNil ifTrue:[prevButton isReturnButton:true].
selector := nil.
box width:380.
box showAtPointer.
selector notNil ifTrue:[
aBlock value:selector asSymbol value:openHow
].
^ selector
!
askIfModified
"if codeView was modified, return the answer from asking question;
otherwise, return true"
^ self askIfModified:'Modifications have not been saved - please accept first.\\(or continue to forget those modifications)'
!
askIfModified:question
"if codeView was modified, return the answer from asking question;
otherwise, return true"
^ self askIfModified:question default:false
!
askIfModified:question default:default
"if codeView was modified, return the answer from asking question;
otherwise, return true"
^ self
askIfModified:question
default:default
withAccept:(self canAcceptCode)
withCompare:(self canCompareCode)
"Created: / 11.2.2000 / 10:52:28 / cg"
"Modified: / 11.2.2000 / 12:37:34 / cg"
!
askIfModified:question default:default in:aNavigationState
"if codeView was modified, return the answer from asking question;
otherwise, return true"
^ self
askIfModified:question
default:default
withAccept:(self canAcceptCode)
withCompare:(self canCompareCode)
in:aNavigationState
"Created: / 11.2.2000 / 10:52:28 / cg"
"Modified: / 11.2.2000 / 12:37:34 / cg"
!
askIfModified:question default:default withAccept:acceptOffered withCompare:compareOffered
"if codeView was not modified, return true.
If it was, return the answer from asking question, which can be
true - go on
false - cancel
#compare - open a diff-viewer on the code vs. its original
#accept - accept, then proceed
If compareOffered is true, offer the compare option.
If acceptOffered is true, offer the accept option.
Used to confirm selectionChange, closing or buffer removal when code
was modified.
question is the message to ask, or nil for a standard message."
^ self
askIfModified:question
default:default
withAccept:acceptOffered
withCompare:compareOffered
in:navigationState
!
askIfModified:question default:default withAccept:acceptOffered withCompare:compareOffered in:aNavigationState
"if codeView was not modified, return true.
If it was, return the answer from asking question, which can be
true - go on
false - cancel
If compareOffered is true, offer the compare option.
If acceptOffered is true, offer the accept option.
Used to confirm selectionChange, closing or buffer removal when code was modified.
Question is the message to ask, or nil for a standard message."
|answer labels values msg textModified specialEditorModified|
self codeView isNil ifTrue:[
"/ if in documentation browser ...
^ true
].
specialEditorModified := self anySpecialEditorModified.
"/ compare - in case its not really modified
textModified := navigationState modified and:[ self reallyModified:aNavigationState ].
(specialEditorModified not
and:[ textModified not ]) ifTrue:[
^ true
].
(compareOffered and:[ specialEditorModified not ]) ifTrue:[
acceptOffered ifTrue:[
labels := #('Cancel' 'Compare' 'Accept' 'Continue').
values := #(false #compare #accept true).
] ifFalse:[
labels := #('Cancel' 'Compare' 'Continue').
values := #(false #compare true).
]
] ifFalse:[
acceptOffered ifTrue:[
labels := #('Cancel' 'Accept' 'Continue').
values := #(false #accept true).
] ifFalse:[
labels := #('Cancel' 'Continue').
values := #(false true).
].
].
msg := question ? 'Modifications have not been saved.\\Your changes will be lost when continuing.'.
answer := OptionBox
request:(resources string:msg) withCRs
label:(resources string:'Attention')
image:(WarningBox iconBitmap)
buttonLabels:(resources array:labels)
values:values
default:default
onCancel:false.
answer == #accept ifTrue:[
"/ self halt.
specialEditorModified ifTrue:[
self doSaveInSpecialEditors
] ifFalse:[
self doAcceptCodeIn:aNavigationState.
].
^ true
].
answer == #compare ifTrue:[
self doCompareIn:aNavigationState.
^ false.
].
answer ifTrue:[
navigationState modified:false.
].
^ answer
"Modified: / 23.2.2000 / 00:02:29 / cg"
!
askIfModified:question in:aNavigationState
"if codeView was modified, return the answer from asking question;
otherwise, return true"
^ self askIfModified:question default:false in:aNavigationState
!
enterBoxForClassWithCodeSelectionTitle:title withList:listOrNil okText:okText
"convenient method: setup an enterBox with initial text taken
from the codeviews selection."
|sel box initialText superclass currentClass
methods someMethod offeredClass anyClose closeName s usedGlobals list|
currentClass := self theSingleSelectedClass.
list := listOrNil.
sel := self selectionInCodeView.
sel notNil ifTrue:[
self selectedNamespacesValue doWithExit:[:eachNs :exit |
s := eachNs , '::' , sel asSymbol.
(s knownAsSymbol
and:[(Smalltalk at:s asSymbol) isBehavior]) ifTrue:[
"/ a private class of current ...
sel := eachNs , '::' , sel asSymbol.
exit value:nil.
].
].
(sel knownAsSymbol and:[currentClass notNil
and:[(currentClass theNonMetaclass privateClassesAt:sel asSymbol) notNil]]) ifTrue:[
"/ a private class of current ...
sel := (currentClass theNonMetaclass privateClassesAt:sel asSymbol) name
] ifFalse:[
(sel knownAsSymbol and:[(Smalltalk at:sel asSymbol) isBehavior]) ifFalse:[
"/ ignore it, if there is no class-name which comes close.
anyClose := false.
Smalltalk keysAndValuesDo:[:aGlobalName :aGlobal|
aGlobal isBehavior ifTrue:[
aGlobal isMeta ifFalse:[
aGlobal name == aGlobalName ifTrue:[
((aGlobalName startsWith:sel)
or:[(sel startsWith:aGlobalName)]) ifTrue:[
closeName isNil ifTrue:[closeName := aGlobalName].
anyClose := true.
]
]
]
]
].
anyClose ifFalse:[
sel := nil
] ifTrue:[
sel := closeName
]
]
]
].
sel notNil ifTrue:[
initialText := sel asString withoutSeparators
] ifFalse:[
self codeAspect == #method ifTrue:[
methods := self selectedMethods value.
methods size > 0 ifTrue:[
someMethod := methods first.
usedGlobals := someMethod usedGlobals collect:[:eachVar | eachVar asSymbol].
usedGlobals := usedGlobals select:[:eachVar | (Smalltalk at:eachVar) isBehavior].
usedGlobals size > 0 ifTrue:[
list := list reject:[:each | usedGlobals includes:each ].
list := usedGlobals asOrderedCollection sort , list.
offeredClass := Smalltalk at:usedGlobals first
] ifFalse:[
offeredClass := someMethod mclass
]
]
] ifFalse:[
(navigationState isVersionDiffBrowser
or:[navigationState isClassDocumentationBrowser]) ifTrue:[
offeredClass := currentClass.
(offeredClass notNil and:[offeredClass isPrivate]) ifTrue:[
offeredClass := offeredClass owningClass
]
] ifFalse:[
(currentClass notNil
and:[(superclass := currentClass superclass) notNil]) ifTrue:[
offeredClass := superclass
]
]
].
offeredClass notNil ifTrue:[
initialText := offeredClass theNonMetaclass name
]
].
box := self
enterBoxTitle:((resources ? self class classResources) string:title)
withList:list
okText:((resources ? self class classResources) string:okText).
initialText notNil ifTrue:[
box initialText:initialText
].
^ box
"Created: / 13-02-2000 / 20:56:18 / cg"
"Modified: / 11-07-2010 / 16:44:45 / cg"
!
enterBoxForCodeSelectionTitle:title okText:okText
"convenient method: setup enterBox with text from codeview"
^ self
enterBoxForCodeSelectionTitle:title withList:nil okText:okText
!
enterBoxForCodeSelectionTitle:title withList:listOrNil okText:okText
"convenient method: setup enterBox with text from codeview"
|sel box initialText|
box := self
enterBoxTitle:(resources string:title)
withList:listOrNil
okText:(resources string:okText).
sel := self codeView selection.
sel notNil ifTrue:[
initialText := sel asString string withoutSeparators
].
initialText notNil ifTrue:[
box initialText:initialText
].
^ box
!
enterBoxForVariableSearch:title
|box sel selectedVariables|
box := self enterBoxForCodeSelectionTitle:title okText:'Add Buffer'.
self codeView hasSelection ifTrue:[
sel := self selectionInCodeView.
sel size > 0 ifTrue:[
sel := sel withoutSeparators.
sel asCollectionOfWords size == 1 ifFalse:[
sel := nil
]
]
].
sel size == 0 ifTrue:[
selectedVariables := self variableFilter value.
selectedVariables size > 0 ifTrue:[
box initialText:(selectedVariables asStringCollection asStringWith:Character space)
]
].
^ box
!
enterBoxTitle:title okText:okText label:label
"convenient method: setup enterBox (especially do the resource stuff)"
|box|
box := EnterBox new.
box label:(resources string:label).
box title:(resources string:title)
okText:(resources string:okText).
^ box
!
enterBoxTitle:title withList:aListOrNil okText:okText
"convenient method: setup enterBox"
|box rsrcs|
aListOrNil notNil ifTrue:[
box := ListSelectionBox new.
"/ box := EnterBoxWithList new.
box list:aListOrNil.
] ifFalse:[
box := EnterBox new.
].
rsrcs := (resources ? self class classResources).
box title:(rsrcs string:title) okText:(rsrcs string:okText).
^ box
"Created: / 13.2.2000 / 20:53:53 / cg"
"Modified: / 1.3.2000 / 11:15:09 / cg"
!
listBoxForCodeSelectionTitle:title isSelector:isSelector okText:okText
"convenient method: setup a listBox with text from codeview"
|sel box|
box := self listBoxTitle:title okText:okText list:nil.
sel := self codeView selection.
sel notNil ifTrue:[
sel := sel asString string withoutSeparators.
isSelector ifTrue:[
sel knownAsSymbol ifFalse:[
sel := SystemBrowser extractSelectorFrom:sel
].
].
box initialText:sel
].
^ box
!
listBoxForCodeSelectionTitle:title okText:okText
"convenient method: setup a listBox with text from codeview"
^ self listBoxForCodeSelectionTitle:title isSelector:false okText:okText
!
listBoxTitle:title okText:okText list:aList
"convenient method: setup a listBox & return it"
^ self class listBoxTitle:title okText:okText list:aList
!
searchMenuFindClassToAdd
|box title className|
title := 'class to add to list (Tab to complete or use matchPattern):'.
box := self
enterBoxForClassWithCodeSelectionTitle:title
withList:(self class visitedClassNamesHistory)
okText:'add'.
box label:(resources string:'add class to list').
box entryCompletionBlock:(DoWhatIMeanSupport classNameEntryCompletionBlock).
box action:[:aString | className := aString].
box showAtPointer.
^ className
"Modified: / 20-11-2006 / 12:22:44 / cg"
!
selectSubclassesOf:aClass
| subclasses |
subclasses := aClass subclasses asSortedCollection: [:a :b | a name < b name].
subclasses isEmpty ifTrue: [^#()].
^Dialog
chooseMultiple: 'Choose Subclasses:'
fromList: subclasses
values: subclasses
buttons: #()
values: #()
lines: 8
cancel: [nil]
! !
!NewSystemBrowser methodsFor:'private-helpers'!
anySelectedClass
"return any (the first) selected class - nil if there is none"
|sel|
sel := self selectedClasses value.
sel size > 0 ifTrue:[^ sel first].
^ nil
!
anySelectedMethod
"return any (the first) selected method - nil if there is none"
|sel|
sel := self selectedMethods value.
sel size > 0 ifTrue:[^ sel anElement].
^ nil
!
classIfValidNonMetaClassName:aClassName
|class selectedClass ns|
aClassName isNil ifTrue:[^ nil].
class := Smalltalk classNamed:aClassName.
class isNil ifTrue:[
selectedClass := self theSingleSelectedClass.
selectedClass notNil ifTrue:[
selectedClass isPrivate ifTrue:[
class := (selectedClass owningClass privateClassesAt:aClassName).
class notNil ifTrue:[
(self confirm:(resources
string:'No class named: %1 exists (in Smalltalk).\\Do you mean the private class %1 in %2 ?'
with:aClassName allBold with:selectedClass owningClass name allBold) withCRs)
ifTrue:[
^ class
].
^ nil.
].
].
(ns := selectedClass nameSpace) isNameSpace ifTrue:[
ns ~~ Smalltalk ifTrue:[
class := ns at:aClassName.
class notNil ifTrue:[
(self confirm:(resources
string:'No class named: %1 exists (in Smalltalk).\\Do you mean the class %1 in namespace %2 ?'
with:aClassName allBold with:ns name allBold) withCRs)
ifTrue:[
^ class
].
^ nil.
].
]
].
].
self warn:'No such class: ', aClassName.
^ nil
].
class isBehavior ifFalse:[
self warn:'Not a class: ', aClassName.
^ nil
].
(class isNameSpace
and:[class ~~ Smalltalk]) ifTrue:[
self warn:'Is a nameSpace: ', aClassName.
^ nil
].
(class theNonMetaclass isNameSpace
and:[class theNonMetaclass ~~ Smalltalk]) ifTrue:[
self warn:'Is meta of a nameSpace: ', aClassName.
^ nil
].
^ class
!
classNameEntryCompletionBlock
<resource: #obsolete>
"obsolete"
^ DoWhatIMeanSupport classNameEntryCompletionBlock
!
classes:aCollectionOfClasses nonMetaDo:aBlock ifUnloaded:unloadedBlock ifPrivate:privateBlock
"evaluate aBlock for all selected classes;
pass the non-metaclass as arg"
aCollectionOfClasses do:[:aClass |
|cls|
cls := aClass theNonMetaclass.
cls isLoaded ifFalse:[
(unloadedBlock value:cls) ifTrue:[
cls owningClass notNil ifTrue:[
privateBlock value:cls
] ifFalse:[
aBlock value:cls
]
]
] ifTrue:[
cls owningClass notNil ifTrue:[
privateBlock value:cls
] ifFalse:[
aBlock value:cls
]
]
]
!
classesToSearchForVariable
"return the set of selected classes or the classes of the selected methods"
|classes|
classes := self selectedClasses value copy.
classes size == 0 ifTrue:[
self isMethodListBrowser ifTrue:[
classes := ((self selectedMethods value collect:[:m | m mclass])
collect:[:each| each theNonMetaclass]) asIdentitySet.
]
].
^ classes
!
codeView
"the current buffers codeView"
^ self navigationState codeView
!
fileSuffixForClass:aClass format:formatSymbolOrNil
formatSymbolOrNil == #sif ifTrue:[
^ 'sif'.
].
formatSymbolOrNil == #xml ifTrue:[
^ 'xml'.
].
formatSymbolOrNil == #binary ifTrue:[
^ 'cls'
].
aClass notNil ifTrue:[
^ aClass sourceFileSuffix
].
^ 'st'.
!
fileSuffixForFormat:formatSymbolOrNil
^ self fileSuffixForClass:nil format:formatSymbolOrNil
!
findClassNamed:aClassName
"search through namespaces for aClassName."
|nm nameSym cls meta currentNamespace listOfNamespaces|
meta := false.
nm := aClassName.
(nm endsWith:' class') ifTrue:[
meta := true.
nm := nm copyWithoutLast:6.
].
nameSym := nm asSymbol.
currentNamespace := self theSingleSelectedNamespace.
listOfNamespaces := self selectedNamespaces value.
currentNamespace = (BrowserList nameListEntryForALL) ifTrue:[
(cls := Smalltalk at:nameSym) notNil ifTrue:[
meta ifTrue:[^ cls class].
^ cls
]
].
("(Array with:Smalltalk) ," (self listOfNamespaces)) do:[:aNamespace |
aNamespace = (BrowserList nameListEntryForALL) ifFalse:[
(cls := aNamespace at:nameSym) notNil ifTrue:[
meta ifTrue:[^ cls class].
^ cls
]
]
].
currentNamespace ~= (BrowserList nameListEntryForALL) ifTrue:[
(cls := Smalltalk at:nameSym) notNil ifTrue:[
meta ifTrue:[^ cls class].
^ cls
]
].
(nm startsWith:'Smalltalk::') ifTrue:[
cls := Smalltalk classNamed:(nm copyFrom:'Smalltalk::' size + 1).
cls notNil ifTrue:[
meta ifTrue:[^ cls class].
^ cls
]
].
^ nil
"Created: / 13.2.2000 / 21:15:29 / cg"
"Modified: / 24.2.2000 / 13:49:44 / cg"
!
findClassNamedInNameSpace:aClassName
"search through current namespaces for aClassName.
Return the class or nil, if not found."
self listOfNamespaces do:[:aNamespace |
|cls|
(cls := aNamespace at:aClassName asSymbol) notNil ifTrue:[
(cls topNameSpace == aNamespace) ifTrue:[
^ cls
]
]
].
^ nil
!
globalNameToSearchFor
"look in codeView and methodListView for a search-string when searching for globals"
|sel nSel mthd classes|
sel := self selectionInCodeView.
sel notNil ifTrue:[
(sel knownAsSymbol and:[Smalltalk includesKey:sel asSymbol]) ifTrue:[
^ sel
].
"/ validate
nSel := (Parser new findBestVariablesFor:sel) first.
nSel ~= sel ifTrue:[
"/ is it a known classVar or classInstance variable ?
classes := self classesToSearchForVariable.
classes do:[:eachClass |
eachClass withAllSuperclassesDo:[:classToLookFor |
(classToLookFor classVarNames includes:sel) ifTrue:[
self information:('''%1'' is a class variable in %2.'
bindWith:sel with:classToLookFor name).
^ self variablesMenuBrowseAllClassVarRefs.
]
]
].
].
].
"/ take selected classes name as default
(classes := self selectedClasses value) notEmptyOrNil ifTrue:[
sel := (classes collect:[:cls | cls theNonMetaclass name]) asSortedCollection asStringWith:$|
].
sel isNil ifTrue:[
(mthd := self theSingleSelectedMethod) notNil ifTrue:[
sel := mthd mclass name
].
].
"/ "/ take last search as default
"/ sel isNil ifTrue:[
"/ sel := LastGlobalSearched
"/ ].
^ sel
!
listOfAllNamespaces
"return a list of all namespaces"
|allNamespaces|
allNamespaces isNil ifTrue:[
allNamespaces := NameSpace allNameSpaces.
self showAllNamespaces ifFalse:[
"/ only topLevel namespaces are shown
"/ i.e. ignore subspaces
allNamespaces := allNamespaces select:[:ns | ns isTopLevelNameSpace].
]
].
^ allNamespaces
!
listOfNamespaces
"return a list of considered namespaces"
|currentNamespace|
currentNamespace := self currentNamespace.
currentNamespace isNil ifTrue:[
^ Array with:Smalltalk
].
currentNamespace = (BrowserList nameListEntryForALL) ifTrue:[
^ self listOfAllNamespaces
].
^ Array with:currentNamespace
"Modified: / 24.2.2000 / 13:49:20 / cg"
!
newBrowserOrBufferDependingOn:openHow label:labelOrNil forSpec:spec setupWith:aBlock
|brwsr|
openHow == #newBrowser ifTrue:[
brwsr := self class new.
brwsr browserCanvasType:spec.
"/ cannot invoke aBlock here
"/ (it requires that all components are built,
"/ in order to perform selection changes).
"/ therefore, ensure that the components are built:
brwsr allButOpen.
"/ ... do the setup ...
aBlock value:brwsr.
"/ and finally open it.
navigationState notNil ifTrue:[
brwsr setupNavigationStateFrom:navigationState.
].
brwsr openWindow.
] ifFalse:[
openHow == #newBuffer ifTrue:[
self createBufferWithSpec:spec.
] ifFalse:[
"/ find here
].
brwsr := self.
aBlock value:brwsr.
].
brwsr enqueueDelayedUpdateBufferLabel.
labelOrNil notNil ifTrue:[
openHow == #newBrowser ifTrue:[
brwsr windowLabel:labelOrNil.
] ifFalse:[
brwsr bufferLabel:labelOrNil
]
].
^ brwsr
"Created: / 24.2.2000 / 19:15:56 / cg"
"Modified: / 18.8.2000 / 16:04:33 / cg"
!
noteBookView
"the current buffers noteBookView"
^ self navigationState noteBookView
"/ ^ self navigationState canvas builder findComponentAt: 'EditorNoteBook'.
"/ | editorNoteBookCanvas|
"/
"/ editorNoteBookCanvas := self navigationState canvas.
"/ editorNoteBookCanvas isNil ifTrue:[^ nil].
"/ ^ editorNoteBookCanvas superView
"/ | editorNoteBookCanvas|
"/
"/ editorNoteBookCanvas := self navigationState editorNoteBookCanvasHolder value.
"/ editorNoteBookCanvas isNil ifTrue:[^ nil].
"/ ^ editorNoteBookCanvas superView
!
reallyModified:aNavigationState
"check for modified code by comparing the source against
the codeViews contents.
Thats the true modified value (in case user undid its changes,
and the displayed text is actually original"
|modified codeAspect changedSource originalSource methods classes mthd cls s1 s2|
aNavigationState modified ifFalse:[^ false].
(codeAspect := aNavigationState codeAspect) isNil ifTrue:[
"/ no aspect yet (i.e. there is nothing shown)
^ aNavigationState codeView modified.
].
"/ higher prio to prevent it from being changed while we convert it (by editing)
Processor activeProcess
withHigherPriorityDo:[
changedSource := aNavigationState codeView contentsAsString asStringCollection.
].
changedSource := changedSource collect:[:line | line string withoutTrailingSeparators withTabsExpanded].
changedSource := changedSource collect:[:line | line isEmpty ifTrue:[nil] ifFalse:[line]].
[changedSource size > 0 and:[changedSource last isNil]] whileTrue:[
changedSource := changedSource copyWithoutLast:1
].
changedSource := changedSource asString.
codeAspect == #method ifTrue:[
methods := aNavigationState selectedMethods value.
methods size > 0 ifTrue:[
mthd := methods first.
].
mthd isNil ifTrue:[
"/ method was either removed by someone else or never accepted;
"/ however, the code is modified anyhow.
^ true.
].
originalSource := mthd source.
originalSource isNil ifTrue:[
"/ cannot get methods code ..
^ true
].
originalSource := originalSource asStringCollection.
originalSource := originalSource collect:[:line | line string withoutTrailingSeparators withTabsExpanded].
originalSource := originalSource collect:[:line | line isEmpty ifTrue:[nil] ifFalse:[line]].
[originalSource size > 0 and:[originalSource last isNil]] whileTrue:[
originalSource := originalSource copyWithoutLast:1
].
s1 := originalSource asString.
s2 := changedSource asString.
modified := (s1 ~= s2)
] ifFalse:[
codeAspect == #classDefinition ifTrue:[
classes := aNavigationState selectedClasses value.
classes size > 0 ifTrue:[
cls := classes first.
].
cls isNil ifTrue:[
"/ class was either removed by someone else or never accepted;
"/ however, the code is modified anyhow.
^ true
].
originalSource := self classDefinitionStringFor:cls.
modified := (originalSource string withTabsExpanded ~= changedSource string withTabsExpanded)
] ifFalse:[
^ true
]
].
modified ifFalse:[
aNavigationState codeModifiedHolder value:false.
aNavigationState realModifiedState:false.
self updateBufferLabel.
].
^ modified
"Created: / 22.2.2000 / 23:47:04 / cg"
"Modified: / 23.2.2000 / 00:13:47 / cg"
!
rememberLastProjectMoveTo:aProject
LastProjectMoves isNil ifTrue:[
LastProjectMoves := OrderedCollection new.
].
LastProjectMoves remove:aProject ifAbsent:nil.
LastProjectMoves addFirst:aProject.
LastProjectMoves size > 10 ifTrue:[
LastProjectMoves removeLast.
].
"Created: / 17.2.2000 / 23:03:50 / cg"
!
selectedCategoryClasses
"return a collection containing all classes affected by the category selection"
|selectedCategories allCategories|
selectedCategories := self selectedCategoriesValue.
allCategories := selectedCategories includes:BrowserList nameListEntryForALL.
^ self
selectedClassesInCategories:selectedCategories orAll:allCategories
!
selectedCategoryClassesDo:aBlock
"evaluate aBlock for each class in any selected class category"
self selectedCategoryClasses do:aBlock
!
selectedClassVariableInCodeView
|varName|
varName := self selectedClassVariableInCodeViewOrNil.
varName isNil ifTrue:[
self warn:'Please select a variable'.
].
^ varName
!
selectedClassVariableInCodeViewOrNil
|node mthd cls|
(mthd := self theSingleSelectedMethod) notNil ifTrue:[
cls := mthd mclass.
] ifFalse:[
self codeAspect value ~= #classDefinition ifTrue:[
^ nil
].
cls := self theSingleSelectedClass.
].
node := self findNode.
node isNil ifTrue:[
(self hasClassVariableSelectedInCodeView) ifFalse:[
^ nil
].
^ self selectionInCodeView.
].
node isVariable ifFalse:[
^ nil
].
^ node name.
!
selectedClassesDo:aBlock
"evaluate aBlock for each selected class."
(self selectedClasses value ? #()) do:aBlock
!
selectedClassesInCategories:aCollectionOfCategories
"return a collection containing all classes in aCollectionOfCategories,
caring for nameSpace and packageFilters"
^ self
selectedClassesInCategories:aCollectionOfCategories orAll:false
!
selectedClassesInCategories:aCollectionOfCategories orAll:allCategories
"return a collection containing all classes in aCollectionOfCategories,
caring for nameSpace and packageFilters"
|nameSpaceFilter packageFilter|
nameSpaceFilter := self selectedNamespaces value.
nameSpaceFilter isNil ifTrue:[
nameSpaceFilter := navigationState nameSpaceFilter value.
].
(nameSpaceFilter notNil and:[nameSpaceFilter includes:BrowserList nameListEntryForALL])
ifTrue:[nameSpaceFilter := nil].
packageFilter := navigationState packageFilter value.
(packageFilter notNil and:[packageFilter includes:BrowserList nameListEntryForALL])
ifTrue:[packageFilter := nil].
^ Smalltalk allClassesForWhich:[:aClass |
(allCategories or:[aCollectionOfCategories includes:aClass category])
and:[ (nameSpaceFilter isNil or:[nameSpaceFilter includes:aClass nameSpace name])
and:[ (packageFilter isNil or:[packageFilter includes:aClass package]) ]].
].
"Modified: / 10-08-2006 / 15:58:11 / cg"
!
selectedClassesNonMetaDo:aBlock ifUnloaded:unloadedBlock ifPrivate:privateBlock
"evaluate aBlock for all selected classes;
pass the non-metaclass as arg.
For unloaded classes, evaluate unloadedBlock;
for private classes, evaluate privateBlock."
self
classes:(self selectedClasses value)
nonMetaDo:aBlock
ifUnloaded:unloadedBlock
ifPrivate:privateBlock
!
selectedClassesWithWaitCursorDo:aBlock
"evaluate aBlock for each selected class, while showing a busy cursor."
self withWaitCursorDo:[
self selectedClassesDo:aBlock
]
!
selectedInstanceVariableInCodeView
|varName|
varName := self selectedInstanceVariableInCodeViewOrNil.
varName isNil ifTrue:[
self warn:'Please select an instance variable'.
].
^ varName
!
selectedInstanceVariableInCodeViewOrNil
|node mthd cls|
(mthd := self theSingleSelectedMethod) notNil ifTrue:[
cls := mthd mclass.
] ifFalse:[
self codeAspect value ~= #classDefinition ifTrue:[
^ nil
].
cls := self theSingleSelectedClass.
].
cls isMeta ifTrue:[
^ nil
].
node := self findNode.
node isNil ifTrue:[
(self hasInstanceVariableSelectedInCodeView) ifFalse:[
^ nil
].
^ self selectionInCodeView.
].
node isVariable ifFalse:[
^ nil
].
^ node name.
!
selectedLocalMethodClasses
"returns a set of all local classes (for all selected methods)"
|classes|
classes := Set new.
self selectedMethodsClasses
do:[:cls |
classes addAll:(cls withAllSuperclasses).
classes addAll:(cls allSubclasses).
].
^ classes
"Created: / 05-09-2006 / 10:50:48 / cg"
!
selectedMethodsDo:aBlock
"evaluate aBlock for each selected method."
(self selectedMethods value ? #()) do:aBlock
!
selectedNonMetaclasses
^ (self selectedClasses value ? #()) collect:[:cls | cls theNonMetaclass].
"Created: / 12-09-2006 / 13:40:25 / cg"
!
selectedNonMetaclassesDo:aBlock
"evaluate aBlock for each selected class."
self selectedNonMetaclasses do:aBlock
"Created: / 12-09-2006 / 13:42:24 / cg"
!
selectedProjectClasses
"return a collection containing all classes affected by the project selection"
|selectedProjects setOfClasses allIncluded|
selectedProjects := self selectedProjects value.
allIncluded := selectedProjects includes:(BrowserList nameListEntryForALL).
allIncluded ifTrue:[ ^ Smalltalk allClasses ].
setOfClasses := IdentitySet new.
Smalltalk allClassesDo:[:aClass |
(selectedProjects includes:aClass package) ifTrue:[
setOfClasses add:aClass .
]
].
^ setOfClasses
!
selectedProtocolMethodsDo:aBlock
"evaluate aBlock for each selected protocols methods.
(each class-protocol combination)"
|protocols allIncluded targets|
protocols := self selectedProtocolsValue.
protocols := protocols collect:[:each | each string].
allIncluded := protocols includes:(BrowserList nameListEntryForALL).
navigationState isFullProtocolBrowser ifTrue:[
targets := Smalltalk allClassesAndMetaclasses
] ifFalse:[
targets := self selectedClasses value
].
targets do:[:cls |
allIncluded ifTrue:[
cls methodDictionary keysAndValuesDo:[:sel :mthd |
aBlock value:cls value:mthd category value:sel value:mthd
]
] ifFalse:[
protocols do:[:aCategory |
cls methodDictionary keysAndValuesDo:[:sel :mthd |
aCategory = mthd category ifTrue:[
aBlock value:cls value:aCategory value:sel value:mthd
]
]
]
]
].
"Modified: / 29.2.2000 / 11:18:40 / cg"
!
selectedProtocolsDo:aBlock
"evaluate aBlock for each selected protocol.
(class-protocol combination)"
|protocols targets allIncluded|
protocols := self selectedProtocolsValue.
navigationState isFullProtocolBrowser ifTrue:[
targets := Smalltalk allClassesAndMetaclasses
] ifFalse:[
targets := self selectedClasses value
].
allIncluded := protocols includes:(BrowserList nameListEntryForALL).
targets do:[:cls |
allIncluded ifTrue:[
cls categories do:[:cat |
aBlock value:cls value:cat
]
] ifFalse:[
protocols do:[:aCategory |
|cat|
cat := aCategory string.
(cls methodDictionary contains:[:mthd | cat = mthd category]) ifTrue:[
aBlock value:cls value:cat
]
]
]
].
!
selectedSelectorInCodeViewOrNil
"look in codeView for a selector"
|sel t goodSelectors|
sel := self selectionInCodeView.
sel isNil ifTrue:[^ nil].
sel := sel asSingleByteStringIfPossible.
t := SystemBrowser extractSelectorFrom:sel.
t notNil ifTrue:[
sel := t.
].
sel knownAsSymbol ifFalse:[
goodSelectors := Parser findBest:5 selectorsFor:sel in:nil forCompletion:false.
goodSelectors size == 0 ifTrue:[
^ nil
].
sel := goodSelectors first
].
sel isNil ifTrue:[^ nil].
^ sel asSymbol
!
selectedSelectors
^ (self selectedMethods value ? #()) collect:[:mthd | mthd selector]
"Created: / 11.2.2000 / 10:29:30 / cg"
!
selectedTemporaryVariableInCodeViewOrNil
|node name definingNode|
node := self findNode.
(node isNil or:[node isVariable not]) ifTrue:[^ nil].
name := node name.
definingNode := node whoDefines:name.
definingNode isNil ifTrue: [^ nil].
^ name
!
selectedTemporaryVariablesInCodeViewOrNil
|namesOrNil names|
RBParser isNil ifTrue:[^ #()].
namesOrNil := RBParser parseVariableNames:(self selectionInCodeView).
namesOrNil notNil ifTrue:[
names := namesOrNil collect:[:each |each name].
].
^ names
!
selectedVariableInCodeViewOrNil
|node|
node := self findNode.
(node isNil or:[node isVariable not]) ifTrue:[^ nil].
^ node name.
!
selectionInCodeView
|codeView|
(codeView := self codeView) notNil ifTrue:[
^ codeView selectionAsString.
].
^ nil
!
selectorToSearchFor
"look in codeView and methodListView for a search-string when searching for selectors"
|sel|
sel := self selectedSelectorInCodeViewOrNil.
sel isNil ifTrue:[
"/ sel := self selectionInCodeView.
"/ sel notNil ifTrue:[
"/ t := SystemBrowser extractSelectorFrom:sel.
"/ t notNil ifTrue:[
"/ sel := t.
"/ ].
"/ sel knownAsSymbol ifFalse:[
"/ goodSelectors := Parser new findBestSelectorsFor:sel.
"/ goodSelectors size == 0 ifTrue:[
"/ sel := ''
"/ ] ifFalse:[
"/ sel := goodSelectors first
"/ ]
"/ ]
"/ ] ifFalse:[
sel := self theSingleSelectedSelector.
sel notNil ifTrue:[
sel := sel withoutSpaces upTo:(Character space)
] ifFalse:[
sel := ''
]
].
^ sel string
"Modified: / 1.3.2000 / 12:59:13 / cg"
!
sendFileViaEmail:aFile subject:subject
SendMailTool
openForFile:aFile
withSubject:subject
recipient:nil
"Created: / 20-09-2007 / 15:02:49 / cg"
!
showAllNamespaces
"showing all or topLevel namespaces only ?"
^ true
!
stringSearchToolView
"the current buffers stringSearchToolView"
^ self navigationState stringSearchToolView
"/ ^ self navigationState viewOfComponent: 'StringSearchToolCanvas' "'StringSearchTool'".
!
stringToSearchFor
"look in codeView for a search-string when searching for strings"
|sel|
sel := self selectionInCodeView.
sel notNil ifTrue:[
^ sel string
].
^ sel
!
theSingleSelectedCategory
"the current buffers single selected category;
nil if no selection or if multiple categories are selected"
|categories|
categories := self selectedCategoriesValue.
categories size == 1 ifTrue:[
^ categories first string
].
^ nil
"Created: / 6.2.2000 / 01:13:21 / cg"
!
theSingleSelectedClass
"the current buffers single selected class;
nil if no selection or if multiple classes are selected"
^ self navigationState theSingleSelectedClass
!
theSingleSelectedLoadedNonMetaclassOrNil
|currentClass|
currentClass := self theSingleSelectedClass.
currentClass isNil ifTrue:[^ nil].
currentClass isLoaded ifFalse:[^ nil].
^ currentClass theNonMetaclass.
"Created: / 01-03-2007 / 20:47:18 / cg"
!
theSingleSelectedMethod
"the current buffers single selected method;
nil if no selection or if multiple methods are selected"
^ self navigationState theSingleSelectedMethod
!
theSingleSelectedNamespace
"the current buffers single selected namespace;
nil if no selection or if multiple namespaces are selected"
|namespaces|
namespaces := self selectedNamespaces value.
namespaces size == 1 ifTrue:[
^ namespaces first
].
^ nil
"Created: / 23.2.2000 / 11:53:47 / cg"
!
theSingleSelectedProject
"the current buffers single selected project;
nil if no selection or if multiple projects are selected"
|projects p|
projects := self selectedProjects value.
projects size == 1 ifTrue:[
p := projects first.
p ~= (BrowserList nameListEntryForALL) ifTrue:[
^ p
]
].
^ nil
"Created: / 24.2.2000 / 21:51:33 / cg"
!
theSingleSelectedProtocol
"return the selected protocol, but only if exactly one is selected.
Otherwise, return nil."
|selectedProtocols|
(selectedProtocols := self selectedProtocols value) size == 1 ifTrue:[
^ selectedProtocols first
].
^ nil
"Modified: / 6.2.2000 / 01:02:18 / cg"
!
theSingleSelectedSelector
"the current buffers single selected selector;
nil if no selection or if multiple selectors are selected"
|mthd sel|
mthd := self theSingleSelectedMethod.
mthd notNil ifTrue:[
sel := mthd name "/ who methodSelector
].
^ sel
"Created: / 5.2.2000 / 23:09:57 / cg"
!
theSingleSelectedVariable
"return the selected variable, but only if exactly one is selected.
Otherwise, return nil."
|selectedVariables|
(selectedVariables := self selectedVariables value) size == 1 ifTrue:[
^ selectedVariables first
].
^ nil
!
view:view belongsToSubApplication:anAppOrNil
|appView|
anAppOrNil isNil ifTrue:[
^ false
].
appView := anAppOrNil window.
^ appView notNil
and:[ (view isSameOrComponentOf:appView) ]
! !
!NewSystemBrowser methodsFor:'private-helpers-subApps'!
categoryListApp
^ navigationState classCategoryListApplication
!
classHierarchyListApp
^ navigationState classHierarchyListApplication
!
classListApp
^ navigationState classListApplication
!
methodCategoryListApp
^ navigationState methodCategoryListApplication
"Created: / 23.2.2000 / 09:33:47 / cg"
!
methodListApp
^ navigationState methodListApplication
!
nameSpaceListApp
^ navigationState nameSpaceListApplication
!
projectListApp
^ navigationState projectListApplication
! !
!NewSystemBrowser methodsFor:'private-history'!
lastSearchPatterns
^ self class lastSearchPatterns
!
rememberLocationInHistory
|newEntry mthd cls sel |
mthd := self theSingleSelectedMethod.
mthd isNil ifTrue:[
cls := self theSingleSelectedClass.
] ifFalse:[
cls := mthd mclass.
sel := mthd selector.
].
cls isNil ifTrue:[
^ self
].
newEntry := self class historyEntryForClass:cls selector:sel.
newEntry isNil ifTrue:[^ self].
FindHistory isNil ifTrue:[
FindHistory := OrderedCollection new.
].
FindHistory := FindHistory select:[:entry | entry className ~= newEntry className
or:[entry selector ~= newEntry selector
or:[entry meta ~= newEntry meta]]].
FindHistory addFirst:newEntry.
FindHistory size > 30 ifTrue:[
FindHistory removeLast.
].
"Modified: / 24-11-2010 / 12:51:22 / cg"
!
rememberSearchPattern:aString
LastSearchPatterns isNil ifTrue:[
LastSearchPatterns := OrderedCollection new.
].
(LastSearchPatterns includes:aString) ifTrue:[
LastSearchPatterns remove:aString.
] ifFalse:[
LastSearchPatterns size > 20 ifTrue:[
LastSearchPatterns removeFirst
]
].
LastSearchPatterns addFirst:aString.
"Modified: / 24-11-2010 / 12:51:31 / cg"
! !
!NewSystemBrowser methodsFor:'private-presentation'!
asyncShowMethodInfo
self
enqueueMessage:#showInfo:
for:self
arguments:(Array with:self getMethodInfo)
!
busyLabel:what
"set the title for some warning"
|window|
(window := builder window) isTopView ifTrue:[
window
label:('SystemBrowser - ' , (resources string:what))
]
!
busyLabel:what with:someArgument
"set the title for some warning"
|window|
(window := builder window) isTopView ifTrue:[
window
label:('SystemBrowser - ' , (resources string:what with:someArgument))
]
!
classCategoryInfo
|selectedClasses categories category msg|
self codeInfoVisible value ifFalse:[^ nil].
selectedClasses := self selectedClasses value.
selectedClasses isEmptyOrNil ifTrue:[^ nil].
categories := (selectedClasses collect:[:each|each category]) asSet.
categories size ~~ 1 ifTrue:[^ nil].
category := categories anElement.
selectedClasses size == 1 ifTrue:[
msg := 'Category of %1: %3'
] ifFalse:[
msg := 'Category of %2 classes: %3'
].
^ resources string:msg
with:selectedClasses first name
with:selectedClasses size
with:category
!
classInheritanceInfo
|singleSelectedClass subclasses msg|
self codeInfoVisible value ifFalse:[^ nil].
singleSelectedClass := self theSingleSelectedClass.
singleSelectedClass isNil ifTrue:[^ nil].
self organizerMode value == OrganizerCanvas organizerModeHierarchy ifTrue:[^ nil].
subclasses := singleSelectedClass subclasses.
msg := self infoStringForClasses:subclasses withPrefix:'sub'.
^ resources string:('%1: ' , msg)
with:singleSelectedClass theNonMetaclass name
with:subclasses size
"Modified: / 27-07-2006 / 10:10:38 / cg"
!
clearInfo
self showInfo:''.
"Created: / 15.11.2001 / 18:19:10 / cg"
!
currentBufferLabel
self shortNamesInTabs value ifTrue:[
^ navigationState shortNameString
].
^ navigationState nameString
"Modified: / 23.2.2000 / 10:39:56 / cg"
!
currentWindowLabel
^ navigationState nameStringOrNil ? 'SystemBrowser'
!
defaultLabel
"return the defaultLabel"
navigationState isCategoryBrowser ifTrue:[
^ 'Category'
].
(navigationState isNameSpaceBrowser
or:[navigationState isNameSpaceFullBrowser]) ifTrue:[
^ 'NameSpace'
].
(navigationState isProjectBrowser
or:[navigationState isProjectFullBrowser]) ifTrue:[
^ 'Project'
].
navigationState isFullClassSourceBrowser ifTrue:[
^ 'FullClass'
].
navigationState isClassDocumentationBrowser ifTrue:[
^ 'Documentation'
].
navigationState isVersionDiffBrowser ifTrue:[
^ 'Revisions'
].
navigationState isClassDocumentationBrowser ifTrue:[
^ 'Documentation'
].
^ ''
"Created: / 24.2.2000 / 21:48:32 / cg"
"Modified: / 18.8.2000 / 20:40:34 / cg"
!
delayedUpdateBufferLabel
self updateBufferLabel.
"/ |nr|
"/
"/ (nr := selectedBuffer value) notNil ifTrue:[
"/ nr ~~ 0 ifTrue:[
"/ bufferNameList at:nr put:(self currentBufferLabel).
"/ ]
"/ ]
"Modified: / 5.2.2000 / 04:23:21 / cg"
"Created: / 5.2.2000 / 04:25:54 / cg"
!
delayedUpdateBufferLabelWithCheckIfModified
self reallyModified:navigationState
"/ |nr|
"/
"/ (nr := selectedBuffer value) notNil ifTrue:[
"/ nr ~~ 0 ifTrue:[
"/ bufferNameList at:nr put:(self currentBufferLabel).
"/ ]
"/ ]
"Modified: / 5.2.2000 / 04:23:21 / cg"
"Created: / 5.2.2000 / 04:25:54 / cg"
!
displayedClassNameOf:aClass
"depending on the current nameSpace, either show a classes
fullname or its name without the namespace prefix (if its in the current)"
|nm ns currentNamespace|
aClass isJavaClass ifTrue:[
^ aClass nameInBrowser "/ fullName "/ asString replaceAll:$/ with:$.
].
ns := aClass topNameSpace.
ns isNil ifTrue:[ "/ this 'cannot' happen (should always be Smalltalk)
^ aClass name
].
currentNamespace := self currentNamespace.
currentNamespace = (BrowserList nameListEntryForALL) ifTrue:[
(ns == Smalltalk) ifTrue:[
nm := aClass nameWithoutNameSpacePrefix.
^ nm
].
nm := aClass nameWithoutNameSpacePrefix.
^ ns name , '::' , nm "/ full name
].
nm := aClass nameWithoutNameSpacePrefix.
"/ is it in one of the selected namespaces ?
(self findClassNamedInNameSpace:nm) isNil ifTrue:[
^ ns name , '::' , nm "/ full name
].
currentNamespace == ns ifFalse:[
^ ns name , '::' , nm "/ full name
].
^ nm.
"Created: / 20.12.1996 / 17:46:41 / cg"
"Modified: / 24.2.2000 / 13:49:06 / cg"
!
explain:selection inCode:code
self explainInCode:code short:false withTimeout:false
"Modified: / 05-09-2006 / 10:37:30 / cg"
!
explainInCode:code short:short withTimeout:withTimeout
"explain the selection or, if there is none, the node under the cursor"
|explanation explainTookTooLong|
explainTookTooLong := false.
withTimeout ifTrue:[
explanation :=
[ self explanationForCode:code short:short ]
valueWithWatchDog:[explainTookTooLong := true]
afterMilliseconds:500.
] ifFalse:[
explanation := self explanationForCode:code short:short
].
self activityNotification:nil.
explainTookTooLong ifTrue:[
self showInfo:'Explain took too long - cancelled.'.
^ self.
].
explanation notNil ifTrue:[
short ifTrue:[
self showInfo:explanation
] ifFalse:[
self information:explanation
].
builder window flush
].
"Created: / 05-09-2006 / 10:37:04 / cg"
!
explanationForCode:code short:short
"explain the selection or, if there is none, the node under the cursor"
|selection codeView cls crsrPos interval node explanation|
cls := self classOfSelectedMethodOrSelectedClass.
cls isNil ifTrue:[ ^ nil ].
codeView := self codeView.
interval := self selectedInterval.
interval isEmpty ifTrue:[
crsrPos := codeView characterPositionOfCursor.
codeView characterUnderCursor isSeparator ifTrue:[
crsrPos := (crsrPos - 1) max:1
].
interval := crsrPos to:crsrPos.
].
node := self findNodeForInterval:interval.
node notNil ifTrue: [
Error
handle:[:ex | ]
do:[
explanation := Explainer explainNode:node in:code forClass:cls short:short interval:interval
]
].
explanation isNil ifTrue:[
codeView hasSelection ifTrue:[
selection := codeView selection.
] ifFalse:[
"/ selection := codeView characterBeforeCursor.
].
selection notNil ifTrue:[
selection := selection asString string withoutSeparators.
explanation := Explainer explain:selection in:code forClass:cls short:short
].
].
^ explanation
"Modified: / 15-07-2006 / 19:28:16 / cg"
!
getClassInfo
|organizerMode msg|
organizerMode := self organizerMode value.
(organizerMode == OrganizerCanvas organizerModeClassHierarchy
or:[ organizerMode == OrganizerCanvas organizerModeHierarchy] ) ifTrue:[
^ self classCategoryInfo.
].
msg := self classInheritanceInfo.
"/ msg isNil ifTrue:[
"/ msg := self methodInheritanceInfo.
"/ msg isNil ifTrue:[
"/ msg := self methodImplementorsInfo
"/ ]
"/ ].
^ (msg ? '').
"Modified: / 29-08-2006 / 14:20:14 / cg"
!
getMethodInfo
|msg selectedMethods firstMethod source1 differentSourceButSameSemantic prefix|
self codeInfoVisible value ifFalse:[^ nil].
selectedMethods := self selectedMethods value.
selectedMethods isEmptyOrNil ifTrue:[^ nil].
firstMethod := selectedMethods first.
selectedMethods size == 1 ifTrue:[
^ self getMethodInfoForMethod:firstMethod.
].
differentSourceButSameSemantic := false.
source1 := firstMethod source.
selectedMethods from:2 do:[:eachOtherMethod |
eachOtherMethod source ~= source1 ifTrue:[
Error
handle:[:ex | ^ nil]
do:[
firstMethod parseTree ~= eachOtherMethod parseTree ifTrue:[
^ nil.
].
].
differentSourceButSameSemantic := true.
].
].
prefix := differentSourceButSameSemantic ifTrue:['Same effect'] ifFalse:['Same source'].
"/ all are the same.
msg := self getMethodInfoForMethod:firstMethod.
msg isEmptyOrNil ifTrue:[
^ prefix.
].
^ prefix,' - ' , msg.
!
getMethodInfoForMethod:aMethod
|msg method|
method := aMethod.
method isNil ifTrue:[ ^ nil ].
method wrapper notNil ifTrue:[
method := method wrapper
].
method isNil ifTrue:[
^ 'oops - this method is not attached to any class'.
].
msg := self methodSpecialInfoFor:method.
msg isNil ifTrue:[
msg := self methodRedefinitionInfoFor:method.
msg isNil ifTrue:[
msg := self methodInheritanceInfoFor:method.
msg isNil ifTrue:[
msg := self methodImplementorsInfoFor:method
]
].
].
^ (msg ? '').
!
infoStringForClasses:aCollectionOfClasses withPrefix:prefix
|nClassNames sortedByName classNames|
aCollectionOfClasses isEmpty ifTrue:[
^ 'No %1classes.' bindWith:prefix.
].
classNames := aCollectionOfClasses asIdentitySet asOrderedCollection collect:[:each | each theNonMetaclass name].
nClassNames := classNames size.
nClassNames <= 3 ifTrue:[
nClassNames == 1 ifTrue:[
^ '1 %1class: %2' bindWith:prefix with:(classNames first allBold).
].
sortedByName := classNames sort.
nClassNames == 2 ifTrue:[
^ '2 %1classes: %2 and %3' bindWith:prefix
with:(sortedByName first allBold)
with:(sortedByName second allBold).
].
^ '3 %1classes: %2, %3 and %4' bindWith:prefix
with:(sortedByName first allBold)
with:(sortedByName second allBold)
with:(sortedByName third allBold).
].
^ '%1 %2classes' bindWith:nClassNames printString allBold with:prefix
"Modified: / 27-07-2006 / 10:09:02 / cg"
!
methodImplementorsInfoFor:aMethod
|implementors msg senders msg2|
implementors := SystemBrowser
findImplementorsOf:aMethod selector
in:(Smalltalk allClasses)
ignoreCase:false.
implementors notEmpty ifTrue:[
msg := 'Only implemented here.'.
implementors remove:aMethod ifAbsent:nil.
implementors notEmpty ifTrue:[
implementors := implementors collect:[:mthd | mthd mclass].
implementors notEmpty ifTrue:[
msg := 'Also implemented in '.
msg := msg , (self infoStringForClasses:implementors withPrefix:'other ').
msg := msg , '.'.
]
].
].
false ifTrue:[ "/ too slow
senders := SystemBrowser
findSendersOf:aMethod selector
in:(Smalltalk allClasses)
ignoreCase:false.
senders notEmpty ifTrue:[
msg2 := 'Sent from ' , senders size printString, ' methods.'.
] ifFalse:[
msg2 := 'No senders.'.
].
msg := msg , '/' , msg2
].
^ msg
!
methodInheritanceInfoFor:aMethod
|superclass inheritedClass msg cls sel mthd|
cls := aMethod mclass.
cls isNil ifTrue:[^ nil].
superclass := cls superclass.
superclass isNil ifTrue:[^ nil].
sel := aMethod selector.
inheritedClass := superclass whichClassIncludesSelector:sel.
inheritedClass notNil ifTrue:[
mthd := inheritedClass compiledMethodAt:sel.
msg := (sel contractTo:30) allBold.
(mthd sends:#'subclassResponsibility') ifTrue:[
msg := msg , ' overrides subclassResponsibility in '.
] ifFalse:[
msg := msg , ' overrides implementation in '.
].
msg := msg , inheritedClass name allBold.
msg := msg , '.'.
].
^ msg
!
methodRedefinitionInfoFor:aMethod
|redefiningClasses msg cls|
cls := aMethod mclass.
cls isNil ifTrue:[^ nil].
redefiningClasses := cls allSubclasses select:[:cls | cls includesSelector:aMethod selector. ].
redefiningClasses size > 0 ifTrue:[
msg := 'redefined in '.
msg := msg , (self infoStringForClasses:redefiningClasses withPrefix:'sub').
msg := msg , '.'.
].
^ msg
!
methodSpecialInfoFor:aMethod
"handles special cases - such as documentation methods"
|cls sel|
cls := aMethod mclass.
cls isNil ifTrue:[^ nil].
sel := aMethod selector.
cls isNil ifTrue:[^ nil].
cls isMeta ifTrue:[
(AbstractSourceCodeManager isVersionMethodSelector:sel) ifTrue:[
^ 'The version method is required for the source code repository - do not modify.'.
].
sel == #documentation ifTrue:[
^ 'ST/X stores documentation in this method (not in comment slots)'.
].
].
^ nil
!
nameListEntryForALL
^ BrowserList nameListEntryForALL
!
normalLabel
"set the normal (inactive) window- and icon labels"
|window l il|
builder isNil ifTrue:[^ self]. "/ if invoked during setup
window := builder window.
(window notNil and:[window isTopView]) ifFalse:[
"/ if I am used as a subApp, do not update the label
^ self
].
"/ windowLabel notNil ifTrue:[
"/ "if I have been given an explicit label,
"/ and its not the default, take that one"
"/
"/ windowLabel ~= 'NewSystemBrowser' ifTrue:[
"/ l := il := windowLabel
"/ ]
"/ ].
l isNil ifTrue:[
l := il := self currentWindowLabel.
].
navigationState realModifiedState == true
ifTrue:[
l := l , ' [modified]'
].
window label:l; iconLabel:il.
"Modified: / 18.8.2000 / 21:12:17 / cg"
!
showActivity:someMessage
"some activityNotification to be forwarded to the user;
show it in the windows title area here
(invoked, for example, by the CVSManager showing some activity)."
self showInfo:someMessage.
"/ someMessage size == 0 ifTrue:[
"/ self normalLabel
"/ ] ifFalse:[
"/ self busyLabel:someMessage with:nil
"/ ]
!
showInfo:msg
self infoLabelHolder value:msg.
"Created: / 15.11.2001 / 18:01:23 / cg"
!
showMethodInfo
|method metrics complexity msg|
self showInfo:(self getMethodInfo).
self showMethodComplexity value ifTrue:[
OOM::MethodMetrics notNil ifTrue:[
method := self theSingleSelectedMethod.
method notNil ifTrue:[
metrics := OOM::MethodMetrics forMethod:method.
complexity := metrics complexity.
complexity notNil ifTrue:[
msg := metrics class descriptiveName,': ',complexity printString.
].
]
]
].
!
updateBufferLabel
"update the current buffers label (in the tab-list)"
|nr newLabel|
(nr := selectedBuffer value) notNil ifTrue:[
nr ~~ 0 ifTrue:[
newLabel := self currentBufferLabel.
(newLabel sameStringAndEmphasisAs:(bufferNameList at:nr)) ifTrue:[
^ self.
].
bufferNameList at:nr put:newLabel.
]
].
self normalLabel
"Modified: / 5.2.2000 / 04:23:21 / cg"
"Created: / 5.2.2000 / 04:25:54 / cg"
!
updateCategorySelectionForChangedClassSelection
|classes selectedCategories oldSelectedCategories nameListEntryForALL|
classes := self selectedClasses value.
classes size > 0 ifTrue:[
"/ category-selection feedBack:
"/ update the category-selection, if '* all *' is in its selection
"/ (add the selected categories to the category-selection)
nameListEntryForALL := BrowserList nameListEntryForALL.
selectedCategories := self selectedCategoriesValue.
(selectedCategories includes:nameListEntryForALL)
ifTrue:[
oldSelectedCategories := selectedCategories asSet.
selectedCategories := Set with:nameListEntryForALL.
selectedCategories addAll:(classes collect:[:eachClass | eachClass category]).
selectedCategories ~= oldSelectedCategories ifTrue:[
self selectedCategories value:selectedCategories.
].
].
].
"Created: / 24-02-2000 / 14:10:09 / cg"
"Modified: / 12-09-2006 / 13:57:50 / cg"
!
updateInfoForChangedClassSelection
|selectedClasses singleSelectedClass categories msg|
navigationState organizerMode value == OrganizerCanvas organizerModeCategory ifTrue:[
self selectedCategoriesValue size > 1 ifTrue:[
singleSelectedClass := self theSingleSelectedClass.
singleSelectedClass notNil ifTrue:[
msg := (resources string:'Category: %2'
with:singleSelectedClass name allBold
with:singleSelectedClass category allBold).
] ifFalse:[
selectedClasses := self selectedClasses value.
categories := ((selectedClasses ? #()) collect:[:cls | cls category]) asSet.
categories size == 1 ifTrue:[
msg := (resources string:'Category: %1'
with:categories anElement allBold).
].
].
].
].
msg isNil ifTrue:[
msg := self getClassInfo.
].
msg notNil ifTrue:[
self showInfo:msg.
^ self.
].
self clearInfo.
!
updateProtocolSelectionForChangedMethodSelection
|methods selectedProtocolsHolder selectedProtocols oldSelectedProtocols|
methods := self selectedMethods value.
methods size > 0 ifTrue:[
"/ protocol-selection feedBack:
"/ update the protocol-selection, if '* all *' is in its selection
"/ (add the selected methods categories to the protocol-selection)
selectedProtocolsHolder := self selectedProtocols.
selectedProtocols := selectedProtocolsHolder value.
(selectedProtocols size > 0 and:[selectedProtocols includes:(BrowserList nameListEntryForALL)])
ifTrue:[
oldSelectedProtocols := selectedProtocols asSet.
selectedProtocols := Set with:(BrowserList nameListEntryForALL).
selectedProtocols addAll:(methods collect:[:eachMethod | eachMethod category]).
selectedProtocols ~= oldSelectedProtocols ifTrue:[
self selectProtocols:selectedProtocols.
].
].
].
!
withActivityNotificationsRedirectedToInfoLabelDo:aBlock
ActivityNotification handle:[:ex |
self showInfo:(ex messageText).
ex proceed.
] do:aBlock
"Created: / 01-03-2007 / 17:45:27 / cg"
!
withSearchCursorDo:aBlock
[
self busyLabel:'searching...'.
self withCursor:(Cursor questionMark) do:aBlock
] ensure:[
self normalLabel
]
! !
!NewSystemBrowser methodsFor:'private-semantic checks'!
checkAcceptedMethod:aMethod inClass:aClass
"do some semantic checks on the just accepted method:
does new method redefine an inherited method, which does the same ?
"
|msg selector subMethods answer|
selector := aMethod selector.
"/ skip for some...
(aClass isMeta) ifTrue:[
(AbstractSourceCodeManager isVersionMethodSelector:selector) ifTrue:[
^ self
].
( #(
documentation
copyright
legalCopyright
) includes:selector) ifTrue:[
^ self
].
].
(self canUseRefactoringParser) ifTrue:[
"/ does new method redefine an inherited method,
"/ which does the same ?
msg := self checkIfSameSemanticsRedefinedWith:aMethod inClass:aClass.
msg notNil ifTrue:[
(Dialog
confirm:msg withCRs
title:'Remove duplicate method'
yesLabel:(resources string:'Remove Here')
noLabel:(resources string:'Keep')
initialAnswer:false)
ifTrue:[
self doRemoveMethodsUnconfirmed:(Array with:aMethod)
].
^ self
].
subMethods := OrderedCollection new.
aClass allSubclassesDo:[:eachInheritingClass |
|redefiningMethod|
redefiningMethod := eachInheritingClass compiledMethodAt:selector.
redefiningMethod notNil ifTrue:[
msg := self checkIfSameSemanticsRedefinedWith:redefiningMethod inClass:eachInheritingClass.
msg notNil ifTrue:[
(eachInheritingClass superclass whichClassIncludesSelector:selector) == aClass
ifTrue:[
subMethods add:redefiningMethod.
]
].
]
].
subMethods size > 0 ifTrue:[
msg := 'The same code is found in the subclass(es):\\'.
subMethods do:[:eachMethod | msg := msg , ' ' , eachMethod mclass name , '\'].
msg := msg , '\You may want to remove it there.'.
answer := Dialog
confirmWithCancel:msg withCRs
labels:(resources array:#('Keep' 'Remove here' 'Remove in Subclass(es)'))
values:#(true #removeHere #removeThere)
default:1.
answer == #removeHere ifTrue:[
self doRemoveMethodsUnconfirmed:(Array with:aMethod)
] ifFalse:[
answer == #removeThere ifTrue:[
self doRemoveMethodsUnconfirmed:subMethods
]
]
]
].
ParserFlags warnAboutBadComments ifFalse:[
"/ check for empty method comment
self checkForEmptyMethodComment:aMethod inClass:aClass.
].
"/ "/ super-send probably missing ?
"/ (self checkIfSuperSendIsProbablyMissingIn:aMethod inClass:aClass)
"/ ifTrue:[^ self].
"Modified: / 29-08-2006 / 10:16:20 / cg"
!
checkForEmptyMethodComment:aMethod inClass:aClass
|src parser firstComment comments|
src := aMethod source ? ''.
src isNil ifTrue:[^ self].
parser := Parser for:src in:nil.
parser ignoreErrors:true; ignoreWarnings:true; saveComments:true.
parser parseMethodSpec.
comments := parser comments.
comments isEmptyOrNil ifTrue:[^ self].
firstComment := comments first.
firstComment string withoutSeparators isEmpty ifTrue:[
firstComment isEndOfLineComment ifFalse:[
Dialog
warn:'Useless (empty) Method-Comment. Please add flesh or remove it !!'.
^ self
]
].
!
checkIfSameSemanticsRedefinedWith:methodHere inClass:aClass
"does just accepted method redefine an inherited method, which does the same ?
Return an info-message string or nil.
"
|sel superCls implClass methodThere treeThere treeHere
dictionary mClass|
RBParser isNil ifTrue:[^ nil].
sel := methodHere selector.
"/ these are meant to be empty nad only contain different comments...
( #(
documentation
version
examples
copyright
history
initialize "/ because that is not invoked if only inherited
) includes:sel) ifTrue:[
aClass isMeta ifTrue:[
^ nil
]
].
superCls := aClass superclass.
superCls notNil ifTrue:[
implClass := superCls whichClassIncludesSelector:sel.
].
implClass isNil ifTrue:[^ nil].
"/ ok, it is redefined
methodThere := implClass compiledMethodAt:sel.
treeHere := RBParser
parseMethod:methodHere source ? ''
onError: [:aString :position | ^ nil "ignore any error"].
treeHere isNil ifTrue:[^ nil].
treeThere := RBParser
parseMethod:methodThere source ? ''
onError: [:aString :position | ^ nil "ignore any error"].
treeThere isNil ifTrue:[^ nil].
dictionary := Dictionary new.
(treeHere body equalTo: treeThere body withMapping: dictionary) ifTrue:[
mClass := methodHere mclass theNonMetaclass.
"/ must try again, but remove mappings to classVariables and classInstanceVariables ...
mClass allClassVarNames do:[:each |
dictionary removeKey:each ifAbsent:nil.
dictionary removeValue:each ifAbsent:nil.
].
mClass allInstVarNames do:[:each |
"/ dictionary removeKey:each ifAbsent:nil.
"/ dictionary removeValue:each ifAbsent:nil.
dictionary at:each put:each
].
mClass allClassVarNames do:[:each |
dictionary at:each put:each
].
(treeHere body equalTo: treeThere body withMapping: dictionary) ifTrue:[
"/ look at the mapping dictionary ..
"/ remove equivalently mapped ones ..
dictionary keys
select:[:key | (dictionary at:key) = key]
thenDo:[:key | dictionary removeKey:key].
"/ now, no upper-case variables are allowed ...
(dictionary keys contains:[:key | key isUppercaseFirst]) ifFalse:[
"/ ignore (possibly renamed) arguments ...
dictionary keys
select:[:key | treeHere arguments contains:[:argVar | argVar name = key]]
thenDo:[:eachArgHere |
|argIndexHere argThere argIndexThere|
argIndexHere := treeHere arguments findFirst:[:argVar | argVar name = eachArgHere].
argThere := dictionary at:eachArgHere.
argIndexThere := treeThere arguments findFirst:[:argVar | argVar name = argThere].
argIndexHere == argIndexThere ifTrue:[
dictionary removeKey:eachArgHere
].
].
(dictionary keys contains:[:key | treeHere arguments contains:[:argVar | argVar name = key]])
ifFalse:[
(dictionary keys contains:[:key | treeThere arguments contains:[:argVar | argVar name = key]])
ifFalse:[
^ 'This method''s functionality is already inherited from ', implClass name , '.\\You may want to remove it here.'.
]
]
].
].
].
^ nil
"Modified: / 22-01-2011 / 13:56:12 / cg"
!
checkIfSuperSendIsProbablyMissingIn:methodHere inClass:aClass
"is there a chance, that the just accepted method should invoke the
redefined, inherited super method ?
"
|sel superCls implClass methodThere parser treeThere |
aClass compilerClass == Compiler ifFalse:[^ false].
methodHere selector == #initialize ifTrue:[
aClass isMeta ifTrue:[^ false].
aClass == Object ifTrue:[^ false].
aClass superclass == Object ifTrue:[^ false].
].
sel := methodHere selector.
"/ see if new method already invokes the redefined super method
(methodHere referencesLiteral:sel) ifTrue:[
(methodHere messagesSentToSuper includes:sel) ifTrue:[ ^ false ]
].
superCls := aClass superclass.
superCls notNil ifTrue:[
implClass := superCls whichClassIncludesSelector:sel.
].
implClass isNil ifTrue:[^ false].
"/ ok, it is redefined
methodThere := implClass compiledMethodAt:sel.
(methodThere notNil and:[methodThere referencesLiteral:sel]) ifTrue:[
(methodThere messagesSentToSuper includes:sel) ifTrue:[
self information:(resources
string:'Could it be possible, that you forgot a ''super %1''\(I found a ''super %1'' in the overwritten #%1-method) ?'
with:sel) withCRs.
^ true
]
].
"/ see if the redefined method is empty
methodThere notNil ifTrue:[
parser := Parser parseMethod:methodThere source in:methodThere mclass.
treeThere := parser tree.
treeThere isNil ifTrue:[
"/ yes, empty
^ false
].
treeThere isReturnNode ifTrue:[
treeThere expression isSelf ifTrue:[
"/ yes, a simple ^ self
^ false
].
].
].
"/ look if all any subclasses of the superclass do a super-send
"/ implClass allSubclassesDo:[:eachSubclass |
"/ eachSubclass ~~ aClass ifTrue:[
"/ methodThere := eachSubclass compiledMethodAt:sel.
"/ (methodThere notNil and:[methodThere referencesLiteral:sel]) ifTrue:[
"/ (methodThere messagesSentToSuper includes:sel) ifTrue:[
"/ self information:(resources
"/ string:'Could it be possible, that you forgot a ''super %1''\(I found a ''super %1'' in %2''s #%1-method) ?'
"/ with:sel
"/ with:eachSubclass name
"/ ) withCRs.
"/ ^ true
"/ ]
"/ ].
"/ ]
"/ ].
^ false
!
method:mthd selector:sel inClass:cls matchesParseTreeMatcher:aMatcher
|parseTree|
(aMatcher canMatchMethod:mthd) ifFalse: [^ false].
parseTree := RBParser
parseMethod:mthd source
onError: [:str :pos | Transcript showCR:str. Transcript showCR:pos.
nil].
parseTree isNil ifTrue:[^ false ].
(aMatcher executeTree: parseTree initialAnswer: false) ifTrue:[
^ true
].
^ false
!
methodHasUglyCodingStyle:mthd selector:sel inClass:cls
"nil if ok, a string with a description of the uglyness if not.
More has to come here..."
|comment|
comment := mthd comment.
cls isMeta ifTrue:[
(AbstractSourceCodeManager isVersionMethodSelector:sel) ifTrue:[^ nil].
sel == #documentation ifTrue:[
comment isBlank ifTrue:[ ^ 'no documentation in documentation method' ].
^ nil
].
].
comment size == 0 ifTrue:[^ 'missing comment' ].
comment asCollectionOfLines last isEmptyOrNil ifTrue:[^ 'extra line at end of comment' ].
^ nil.
! !
!NewSystemBrowser methodsFor:'private-syntax coloring'!
startSyntaxHighlightProcess
"start a background process, which does the syntax coloring.
When it finishes, it pushes a user event to show the new text in the codeView.
(This is done as an event to synchronize the coloring with modifications
done to the text - the colored text will discarded, if there were
any new modifications in the meanwhile)"
|dontDoIt oldCodeList highlighterClass prio currentMethod methodsClass codeView|
dontDoIt := (currentMethod := self theSingleSelectedMethod) isNil.
dontDoIt := dontDoIt
or:[self doSyntaxColoring value ~~ true
or:[(self doImmediateSyntaxColoring) value ~~ true]].
dontDoIt ifFalse:[
methodsClass := currentMethod mclass.
methodsClass isNil ifTrue:[
dontDoIt := true
].
highlighterClass := self syntaxHighlighterForMethod:currentMethod.
].
highlighterClass isNil ifTrue:[
syntaxColoringProcess notNil ifTrue:[
self stopSyntaxHighlightProcess
].
^ self
].
codeView := self codeView.
"/ this clobbers the codeViews modified state; therefore, we have to remember
"/ this info somewhere ...
codeView modified ifTrue:[
self navigationState realModifiedState:true
].
codeView modifiedChannel setValue:false.
syntaxColoringProcess notNil ifTrue:[
syntaxColoringProcessRunning ~~ true ifTrue:[
"/ process already created, but did not get a change to start yet;
^ self
].
self stopSyntaxHighlightProcess
].
prio := Processor userBackgroundPriority - 1.
codeView shown ifFalse:[
prio := prio - 1 max:1
].
syntaxColoringProcess := [
|oldCode newCode cls sensor|
[
syntaxColoringProcessRunning := true.
cls := methodsClass.
(cls notNil and:[cls isObsolete]) ifTrue:[
cls isMeta ifTrue:[
cls := (Smalltalk at:cls theNonMetaclass name) class
] ifFalse:[
cls := Smalltalk at:cls name
].
].
codeView modified ifFalse:[
oldCodeList := codeView list copy.
codeView modified ifFalse:[
oldCodeList isNil ifFalse:[
oldCode := oldCodeList asStringWithoutEmphasis.
codeView modified ifFalse:[
Screen currentScreenQuerySignal answer:device
do:[
Parser::ParseError handle:[:ex |
|errMsg|
errMsg := ex description asStringCollection first asString.
"/ Transcript topView raiseDeiconified.
"/ Transcript showCR:'ParseError: ', ex description.
"/ self halt.
self showInfo:(errMsg colorizeAllWith:Color red).
newCode := nil.
] do:[
self codeAspect == #method ifTrue:[
newCode := highlighterClass formatMethod:currentMethod source:oldCode in:cls
] ifFalse:[
self codeAspect == #classDefinition ifTrue:[
newCode := highlighterClass formatExpression:oldCode in:cls
].
].
]
].
newCode notNil ifTrue:[
codeView modified ifFalse:[
newCode := newCode asStringCollection.
codeView modified ifFalse:[
syntaxColoringProcess := nil.
(codeView := self codeView) notNil ifTrue:[
"/ must add this event - and not been interrupted
"/ by any arriving key-event.
self showInfo:nil.
codeView sensor
pushUserEvent:#syntaxHighlightedCode:
for:self
withArguments:(Array with:newCode).
self delayedUpdateBufferLabelWithCheckIfModified
]
]
]
]
]
]
]
]
] ensure:[
syntaxColoringProcessRunning := false.
syntaxColoringProcess := nil
]
] forkAt:prio
"Modified: / 28-04-2010 / 14:27:53 / cg"
!
stopSyntaxHighlightProcess
"stop any syntax coloring background process."
|p|
(p := syntaxColoringProcess) notNil ifTrue:[
syntaxColoringProcess := nil.
p terminate.
"/ raise its prio to make it terminate quickly
p priority:(Processor userSchedulingPriority + 1)
]
!
syntaxHighlightedCode:newCode
"the background synhighlighter has generated new colored text,
with highlighted syntax.
If there have been no modifications in the meantime, install it."
|firstShown lastShown cursorWasOn anyChange newLines l replaceAction codeView list|
codeView := self codeView.
codeView modified ifTrue:[
"/ new input arrived in the meantime
^ self
].
syntaxColoringProcess notNil ifTrue:[
"/ another coloring process has already been started.
"/ ignore this (leftover) code.
^ self
].
self theSingleSelectedMethod isNil ifTrue:[
"/ have already switched to some other method,
"/ or closed.
^ self
].
firstShown := codeView firstLineShown.
lastShown := codeView lastLineShown.
replaceAction := [:lNr :line |
|oldLine|
oldLine := list at:lNr ifAbsent:nil.
oldLine notNil ifTrue:[
line notNil ifTrue:[
"/ this check is needed - there is a race
"/ when the text is converted. This detects the
"/ resulting error.
"/ Certainly a kludge.
oldLine string = line string ifTrue:[
oldLine emphasis ~= line emphasis ifTrue:[
codeView modifiedChannel removeDependent:self.
list at:lNr put:line.
codeView modifiedChannel addDependent:self.
(lNr between:firstShown and:lastShown) ifTrue:[
anyChange ifFalse:[
anyChange := true.
cursorWasOn := codeView hideCursor
].
codeView redrawLine:lNr
]
]
]
]
]
].
anyChange := false.
newLines := newCode asStringCollection.
list := codeView list.
list isNil ifTrue:[
codeView list:newLines.
] ifFalse:[
"/ the cursor line first - thats where your eyes are ...
(l := codeView cursorLine) notNil ifTrue:[
l <= newLines size ifTrue:[
replaceAction value:l value:(newLines at:l)
]
].
newLines keysAndValuesDo:replaceAction.
anyChange ifTrue:[
cursorWasOn ifTrue:[
codeView showCursor
]
]
].
"Modified: / 09-10-2006 / 11:50:17 / cg"
!
syntaxHighlightedCodeFor:oldText method:mthd
|highlighter cls|
cls := mthd mclass ? Object.
highlighter := self syntaxHighlighterForMethod:mthd.
highlighter isNil ifTrue:[ ^ oldText ].
^ highlighter formatMethod:mthd source:oldText in:cls.
"Modified: / 28-04-2010 / 13:44:34 / cg"
!
syntaxHighlighterForMethod:mthd
|highlighterClass cls|
cls := mthd mclass ? Object.
highlighterClass := mthd syntaxHighlighterClass.
highlighterClass == #askClass ifTrue:[
highlighterClass := cls syntaxHighlighterClass.
].
(mthd isInstrumented
and:[ self showCoverageInformation value ]) ifTrue:[
highlighterClass == SyntaxHighlighter ifTrue:[
highlighterClass := CodeCoverageHighlighter
].
].
^ highlighterClass
"Created: / 28-04-2010 / 12:49:54 / cg"
! !
!NewSystemBrowser methodsFor:'setup'!
browserCanvas
"return a holder on the current canvas"
browserCanvas isNil ifTrue:[
browserCanvas := ValueHolder new.
browserCanvas value:(self newCanvasWithSpec:(self browserCanvasType ? #fullBrowserSpec))
].
^ browserCanvas
"Modified: / 24.2.2000 / 15:11:31 / cg"
!
browserCanvasType
^ browserCanvasType
!
browserCanvasType:aSpecSymbol
browserCanvasType := aSpecSymbol
!
bufferLabel:aString
navigationState notNil ifTrue:[
navigationState browserLabel:aString.
self enqueueDelayedUpdateBufferLabel.
].
!
hideToolBarButtonCreated:aButton
aButton passiveLevel:(MenuPanel defaultLevel).
"/ aButton passiveLevel:1.
aButton activeLevel:-1.
aButton backgroundColor:(MenuPanel defaultBackgroundColor).
!
newCanvasWithSpec:aSpec
"create a new canvas and build componenents from aSpec.
Invoked when a new buffer is added"
|canvas|
canvas := SubCanvas new.
canvas client:self spec:aSpec builder:(UIBuilder new).
canvas level:0.
canvas origin:0.0@0.0 corner:1.0@1.0.
^ canvas
"Created: / 5.2.2000 / 04:46:04 / cg"
"Modified: / 24.2.2000 / 15:10:45 / cg"
!
postBuildAsSubcanvasWith:aBuilder
self postBuildFixup.
super postBuildAsSubcanvasWith:aBuilder.
"Created: / 24.2.2000 / 16:04:09 / cg"
"Modified: / 24.2.2000 / 16:10:59 / cg"
!
postBuildCodeView:codeView
" this is not more called. see #postBuildFixup instead"
builder componentAt:#CodeView put:codeView.
"/ self codeInfoVisible value ifFalse:[
"/ "/ info not visible
"/ bottomOffset := 0.
"/ ] ifTrue:[
"/ "/ info visible
"/ bottomOffset := -25.
"/ ].
"/ codeView layout bottomOffset:bottomOffset.
self updateCodeInfoAndStringSearchToolVisibility.
codeView formatAction:[:code | self formatCode ].
codeView menuHolder:self; menuMessage:#codeViewMenu.
self stringSearchToolVisibleHolder value ifTrue:[
self codeView searchBarActionBlock: self searchBarActionBlock.
].
!
postBuildEditModeInfoLabel:aLabel
aLabel menuHolder:self; menuMessage:#editModeInfoLabelMenu.
!
postBuildEditorNoteBook:editorNoteBook
builder componentAt:#EditorNoteBook put:editorNoteBook.
self navigationState noteBookView: editorNoteBook.
"/ self codeInfoVisible value ifFalse:[
"/ "/ info not visible
"/ bottomOffset := 0.
"/ ] ifTrue:[
"/ "/ info visible
"/ bottomOffset := -25.
"/ ].
"/ editorNoteBook layout bottomOffset:bottomOffset.
self updateCodeInfoAndStringSearchToolVisibility.
editorNoteBook selectConditionBlock:
[:index |
|canSelect editorCanvas method|
canSelect := true.
self showSpecialResourceEditors value ifTrue:[
(method := self theSingleSelectedMethod) notNil ifTrue:[
"/ toggling away from the special editor - see if it was modified and ask for accept if so
navigationState modified ifTrue:[
canSelect := self askIfModified.
]
].
].
canSelect
].
!
postBuildFixup
|newNavigationState orgModeHolder|
newNavigationState := self navigationState.
self assert:newNavigationState canvasType notNil.
newNavigationState isFullClassSourceBrowser ifTrue:[
self hidePrivateClasses value:true.
].
"/ newNavigationState setUpScrollableCodeView.
self editorNoteBookCanvasHolder value:(newNavigationState scrollableCodeView).
self codeView formatAction:[:code | self formatCode ].
self codeView menuHolder:self; menuMessage:#codeViewMenu.
UserPreferences current useSearchBarInBrowser ifTrue:[
"/ self stringSearchToolVisibleHolder value:true. "/ Initially hidden. Show search bar after pressing CTRL+f or clicking view menu
self codeView searchBarActionBlock: self searchBarActionBlock.
].
self normalLabel.
orgModeHolder := self organizerMode.
newNavigationState isNameSpaceBrowser ifTrue:[
orgModeHolder value:(OrganizerCanvas organizerModeNamespace)
] ifFalse:[
newNavigationState isCategoryBrowser ifTrue:[
orgModeHolder value:(OrganizerCanvas organizerModeCategory)
] ifFalse:[
newNavigationState isProjectBrowser ifTrue:[
orgModeHolder value:(OrganizerCanvas organizerModeProject)
].
].
].
self theSingleSelectedMethod notNil ifTrue:[
"/ fetch the initially selected methods code
self methodsSelectionChanged.
] ifFalse:[
self theSingleSelectedClass notNil ifTrue:[
"/ to show the classes definition initially
self classSelectionChanged.
].
].
newNavigationState codeModifiedHolder addDependent:self.
!
postBuildSpecialEditor:specialEditorSubcanvas
builder componentAt:#SpecialEditorCanvas put:specialEditorSubcanvas.
!
postBuildStringSearchTool:aStringSearchTool
builder componentAt:#StringSearchTool put: aStringSearchTool.
self navigationState stringSearchToolView: aStringSearchTool.
aStringSearchTool client textView: self codeView.
!
postBuildWith:aBuilder
"/ no need to fixup here - I am always installed as subcanvas
"/ (via noteBookView)
super postBuildWith:aBuilder.
Smalltalk addDependent:self.
self codeInfoVisible value ifTrue:[ self codeInfoVisibilityChanged ].
self toolBarVisibleHolder value ifTrue:[ self toolBarVisibilityChanged ].
"/ self editorNoteBookCanvasHolder value:(navigationState scrollableCodeView).
"/ self codeView formatAction:[:code | self formatCode ].
"/ self codeView menuHolder:self; menuMessage:#codeViewMenu.
"Modified: / 24.2.2000 / 16:11:27 / cg"
!
postOpenWith:aBuilder
self windowGroup addPreEventHook:self.
"/ self window sensor addEventListener:self.
"/ whenever some action takes longer, automatically
"/ show a busy cursor
self windowGroup showWaitCursorWhenBusyForMillis:100.
super postOpenWith:aBuilder.
!
searchFieldCreated:anInputField
anInputField emptyFieldReplacementText:(resources string:'Class Search & History').
!
searchFieldPanelCreated:aPanel
aPanel level:(MenuPanel defaultLevel).
aPanel basicViewBackground:(MenuPanel defaultBackgroundColor).
!
windowLabel:aString
navigationState notNil ifTrue:[
navigationState browserLabel:aString
].
self normalLabel.
! !
!NewSystemBrowser methodsFor:'special editors'!
specialEditorCanvasForMethod:aMethod
|methodsResources|
(methodsResources := aMethod resources) notEmptyOrNil ifTrue:[
#( #image #fileImage #programImage #menu #canvas #help #tableColumns )
do:[:triedResourceType |
|editorCanvas list|
(methodsResources includesKey:triedResourceType) ifTrue:[
editorCanvas := navigationState specialEditorCanvasForResourceType:triedResourceType.
editorCanvas notNil ifTrue:[
^ editorCanvas
].
].
].
].
^ nil
!
updateCodeEditorVisibilityForCanvasEditor:editorCanvas class:aClassOrNil method:aMethod
|editorApplication|
self editorNoteBookCanvasHolder value:editorCanvas.
editorApplication := editorCanvas application.
editorApplication masterApplication:self.
aMethod notNil ifTrue:[
editorApplication
specClass:(aMethod mclass theNonMetaclass);
specSelector:(aMethod selector);
loadFromClass:(aMethod mclass theNonMetaclass)
andSelector:(aMethod selector).
] ifFalse:[
editorApplication
specClass:(aClassOrNil theNonMetaclass)
].
!
updateCodeEditorVisibilityForDocumentationOf:aClass
|view comment|
view := navigationState documentationView.
aClass isLoaded ifFalse:[
comment := 'Class is not loaded.'.
] ifTrue:[
comment := aClass comment.
].
view scrolledView contents:comment.
self editorNoteBookCanvasHolder value:view.
!
updateCodeEditorVisibilityForHTMLDocumentationOf:aClass
|text documentView|
documentView := HTMLDocumentView new.
self editorNoteBookCanvasHolder value:(HVScrollableView forView:documentView).
text := HTMLDocGenerator htmlDocOf:aClass.
text notNil ifTrue:[
documentView top:(Smalltalk getSystemFileName:'doc/online/english/classDoc').
documentView nameSpaceForExecution:(aClass nameSpace).
].
documentView setText:text
!
updateCodeEditorVisibilityForInheritanceOf:aClass
|inheritanceView classTreeView|
inheritanceView := navigationState inheritanceView.
classTreeView := inheritanceView scrolledView.
"/ classTreeView := ClassTreeGraphView new.
classTreeView interestingNode:aClass.
classTreeView topNode:(aClass allSuperclasses reverse firstIfEmpty:[aClass]).
classTreeView selectNode:aClass.
classTreeView middleButtonMenu:nil.
classTreeView menuHolder:[ self class inheritanceViewMenu ].
classTreeView menuPerformer:self.
self editorNoteBookCanvasHolder value:inheritanceView.
!
updateCodeEditorVisibilityForLint
!
updateCodeEditorVisibilityForRewrite
!
updateCodeEditorVisibilityForSource
self editorNoteBookCanvasHolder value:(navigationState scrollableCodeView).
!
updateCodeEditorVisibilityForTestRuns
!
updateCodeEditorVisibilityForTypes
!
updateCodeEditorVisibilityForUML
!
updateCodeEditorVisibilityForWelcomePage
|documentView|
documentView := HTMLDocumentView new.
self editorNoteBookCanvasHolder value:(HVScrollableView forView:documentView).
documentView homeDocument:(HTMLDocumentView documentFileFor:'help/Browser/IntroPage.html')
!
updateDiffViewerVisibilityFor:source1 and:source2
|scr diffView|
diffView := DiffCodeView new.
diffView text1:source1 text2:source2.
diffView addNextPreviousButtons.
diffView moveToNextChanged.
scr := HVScrollableView forView:diffView.
self editorNoteBookCanvasHolder value:scr.
!
updateSpecialCodeEditorVisibility
"update the visibility of the special editors in the codeEditor area,
as appropriate to what is shown currently"
|cls mthd|
cls := self theSingleSelectedClass.
mthd := self theSingleSelectedMethod.
"/ temporary kludge: check if the selected method is really still in the class
mthd notNil ifTrue:[
mthd mclass isNil ifTrue:[
mthd := nil
].
].
self
updateSpecialCodeEditorVisibilityForClass:cls
method:mthd
"Created: / 17-08-2006 / 16:46:50 / cg"
!
updateSpecialCodeEditorVisibilityForClass:aClassOrNil method:aMethod
"update the visibility of the special editors in the codeEditor area,
as appropriate to what is shown currently"
|hideSpecialEditor editorCanvas tabList actionList|
"/ that is a first hack - I dont like it, though...
hideSpecialEditor := true.
tabList := OrderedCollection new.
actionList := OrderedCollection new.
self showMultitabMode value ifTrue:[
"/ self halt.
aMethod isNil ifTrue:[
"/ no method selected
aClassOrNil isNil ifTrue:[
(self selectedClasses value isEmptyOrNil
and:[ self selectedCategories value isEmptyOrNil
and:[ self selectedProjects value isEmptyOrNil
and:[ navigationState isNameSpaceBrowser not
or:[ self selectedNamespaces value isEmptyOrNil ] ]]]) ifTrue:[
"/ no class selected
navigationState isFullBrowser ifTrue:[
tabList add:'Welcome'. actionList add:[ self updateCodeEditorVisibilityForWelcomePage ].
]
].
].
tabList add:'Definition'. actionList add:[ self updateCodeEditorVisibilityForSource ].
aClassOrNil notNil ifTrue:[
"/ tabList add:'Doc-Gen'. actionList add:[ self updateCodeEditorVisibilityForHTMLDocumentationOf:aClassOrNil ].
"/ tabList add:'Comment'. actionList add:[ self updateCodeEditorVisibilityForDocumentationOf:aClassOrNil ].
ClassTreeGraphView notNil ifTrue:[
tabList add:'Inheritance'. actionList add:[ self updateCodeEditorVisibilityForInheritanceOf:aClassOrNil ].
].
"/ tabList add:'UML'. actionList add:[ self updateCodeEditorVisibilityForUMLOf:aClassOrNil ].
"/ tabList add:'Lint'. actionList add:[ self updateCodeEditorVisibilityForLintOf:aClassOrNil ].
"/ tabList add:'Rewrite'. actionList add:[ self updateCodeEditorVisibilityForRewriteOf:aClassOrNil ].
"/ tabList add:'Types'. actionList add:[ self updateCodeEditorVisibilityForTypesOf:aClassOrNil ].
"/ ((aClassOrNil inheritsFrom:TestCase) and:[aClassOrNil isAbstract not]) ifTrue:[
"/ tabList add:'Test'. actionList add:[ self updateCodeEditorVisibilityForTestRunsOf:aClassOrNil ].
"/ ].
].
] ifFalse:[
tabList add:'Source'. actionList add:[ self updateCodeEditorVisibilityForSource ].
"/ tabList add:'Lint'. actionList add:[ self updateCodeEditorVisibilityForLintOfMethod:aMethod ].
].
self selectedMethods value size == 2 ifTrue:[
tabList add:'Diff'.
actionList add:[ self updateDiffViewerVisibilityFor:(self selectedMethods value first source)
and:(self selectedMethods value second source) ].
].
] ifFalse:[
tabList add:'Source'. actionList add:[ self updateCodeEditorVisibilityForSource ].
].
self showSpecialResourceEditors value ifTrue:[
aMethod notNil ifTrue:[
editorCanvas := self specialEditorCanvasForMethod:aMethod.
] ifFalse:[
(aClassOrNil notNil and:[aClassOrNil theNonMetaclass isProjectDefinition]) ifTrue:[
editorCanvas := navigationState specialEditorCanvasForResourceType:#projectDefinition.
].
].
].
editorCanvas notNil ifTrue:[
hideSpecialEditor := false.
tabList add:(editorCanvas application class nameWithoutPrefix asUppercaseFirst).
actionList add:[ self updateCodeEditorVisibilityForCanvasEditor:editorCanvas class:aClassOrNil method:aMethod ].
].
(hideSpecialEditor and:[tabList size = 1]) ifTrue:[
"/ sigh - setting an empty list also changes the selection to 0 (side effect in NoteBookView).
"/ To avoid flickering change messages, preSet its value to 0.
self selectedEditorNoteBookTabIndexHolder setValue:0.
self editorNoteBookListHolder value notEmptyOrNil ifTrue:[
self editorNoteBookListHolder value:#().
].
self updateCodeEditorVisibilityForSource.
] ifFalse:[
tabList = self editorNoteBookListHolder value ifFalse:[
self editorNoteBookListHolder value:tabList.
].
"/ self selectedEditorNoteBookTabIndexHolder value:1.
"/ make one of the codeViews visible...
self selectedEditorNoteBookTabIndexHolder value == 0 ifTrue:[
self selectedEditorNoteBookTabIndexHolder value:1.
^ self.
].
(actionList at:(self selectedEditorNoteBookTabIndexHolder value)) value.
].
"Created: / 17-08-2006 / 16:44:51 / cg"
"Modified: / 06-09-2006 / 19:22:45 / cg"
! !
!NewSystemBrowser methodsFor:'startup & release'!
closeRequest
"asks for permission before closing"
|nModified modifiedBuffers|
buffers isNil ifTrue:[
(self
askIfModified:'Modifications have not been saved.\\Exit anyway ?'
default:false
withAccept:false
withCompare:true)
ifFalse:[
^ self
].
] ifFalse:[
nModified := 0.
modifiedBuffers := buffers select:[:aBuffer | aBuffer modified].
modifiedBuffers do:[:aBuffer | |bufferIndex|
bufferIndex := buffers identityIndexOf:aBuffer.
self selectedBuffer value:bufferIndex.
(self
askIfModified:(resources stringWithCRs:'Buffer "%1" was modified.\\Exit anyway ?' with:aBuffer nameString allBold)
default:false
withAccept:(self canAcceptCodeIn:aBuffer)
withCompare:(self canCompareCodeIn:aBuffer)
in:aBuffer)
ifFalse:[
^ self
]
]
].
Smalltalk removeDependent:self.
super closeRequest.
"Created: / 11.2.2000 / 13:23:00 / cg"
"Modified: / 11.2.2000 / 13:38:51 / cg"
!
release
"/ self class classHistory removeDependent:self.
SystemBrowser removeDependent:self.
super release.
"Modified: / 20-11-2006 / 12:16:37 / cg"
! !
!NewSystemBrowser methodsFor:'string search tool'!
hideSearchBar
self stringSearchToolVisibleHolder value: false.
!
searchBackwardWithSearchBar
self stringSearchToolView application searchPreviousText.
!
searchBackwardWithSearchBarWith: aString
self setInitialSearchString: aString.
self searchBackwardWithSearchBar.
!
searchBarActionBlock
^ [:how :view |
how == #search ifTrue:[self showSearchBarWith: view searchPatternForSearchBar ].
how == #forward ifTrue:[self searchForwardWithSearchBarWith: view searchPatternForSearchBar ].
how == #backward ifTrue:[self searchBackwardWithSearchBarWith: view searchPatternForSearchBar ].
]
!
searchForwardWithSearchBar
self stringSearchToolView application searchNextText.
!
searchForwardWithSearchBarWith: aString
self setInitialSearchString: aString.
self searchForwardWithSearchBar.
!
setFocusToSearchBar
|stringSearchTool|
stringSearchTool := self stringSearchToolView.
stringSearchTool notNil ifTrue:[
stringSearchTool takeFocus.
stringSearchTool client searchBarOpened.
].
!
setInitialSearchString: aString
|stringSearchTool|
stringSearchTool := self stringSearchToolView client.
stringSearchTool notNil ifTrue:[
aString notEmptyOrNil ifTrue:[
stringSearchTool initialSearchString: aString string.
].
].
!
showSearchBar
self stringSearchToolVisibleHolder value: true.
self setFocusToSearchBar
!
showSearchBarWith:aString
|stringSearchTool|
self stringSearchToolVisibleHolder value: true.
self setInitialSearchString: aString.
stringSearchTool := self stringSearchToolView client.
stringSearchTool notNil ifTrue:[
stringSearchTool setFocusToSearchTextView.
stringSearchTool searchTextStarted.
].
! !
!NewSystemBrowser methodsFor:'user actions'!
askUserForCompletion:what from:allTheBest
<resource: #obsolete>
self obsoleteMethodWarning.
allTheBest isEmpty ifTrue:[ ^ nil ].
allTheBest size == 1 ifTrue:[ ^ allTheBest first ].
allTheBest size < 20 ifTrue:[
|menu idx exitKey|
menu := PopUpMenu labels:allTheBest.
menu hideOnKeyFilter:[:key | |hide|
hide := ( #( CursorDown CursorUp Escape Return ) includes: key) not.
hide ifTrue:[
exitKey := key.
].
hide].
idx := menu startUp.
idx == 0 ifTrue:[
exitKey notNil ifTrue:[
self codeView keyPress:exitKey x:0 y:0.
].
^ nil
].
^ allTheBest at:idx.
] ifFalse:[
^ Dialog
choose:(resources string:'Choose ',what)
fromList:allTheBest
lines:10
title:(resources string:'Code completion').
].
"Created: / 10-11-2006 / 14:00:53 / cg"
!
backToLastClass
|history entry|
history := self class classHistory.
history size > 0 ifTrue:[
entry := history first.
self switchToFindHistoryEntry:entry
]
!
classCategoryDoubleClicked
"double click on a category: add a buffer on that category"
|cat|
cat := self theSingleSelectedCategory.
cat notNil ifTrue:[
self spawnCategoryBrowserFor:(self selectedCategoriesValue) in:#newBuffer.
^ self
].
"Created: / 18.8.2000 / 20:03:28 / cg"
"Modified: / 18.8.2000 / 20:13:26 / cg"
!
classDoubleClicked
"double click on a class:
if unloaded : load it
if browserStartable: start the application
if its a testcase : run it
"
|cls clsName organizerModeHolder organizerMode newMode doSwitchDisplayMode|
cls := self theSingleSelectedClass.
cls isNil ifTrue:[^ self].
(navigationState isVersionDiffBrowser
or:[navigationState isCheckOutputBrowser]) ifTrue:[
self spawnFullBrowserInClass:cls selector:nil in:#newBuffer.
^ self
].
self withWaitCursorDo:[
cls := cls theNonMetaclass.
clsName := cls name.
self window sensor shiftDown ifTrue:[
self spawnClassReferencesBrowserFor:(Array with:cls) in:#newBuffer.
^ self.
].
doSwitchDisplayMode := true.
self window sensor metaDown ifFalse:[
(cls isBrowserStartable) ifTrue:[
(self startApplication:cls) ifTrue:[
doSwitchDisplayMode := false.
].
] ifFalse:[
cls isLoaded ifFalse:[
self busyLabel:'loading %1' with:clsName.
self classLoad.
doSwitchDisplayMode := false.
] ifTrue:[
(TestRunner notNil
and:[(cls isSubclassOf:TestCase)
and:[cls isAbstract not]]) ifTrue:[
TestRunner openOnTestCase:cls.
doSwitchDisplayMode := false.
].
].
].
].
doSwitchDisplayMode ifTrue:[
organizerModeHolder := navigationState organizerMode.
organizerMode := organizerModeHolder value.
"/ toggle view mode (between category and class hierarchy)
organizerMode == OrganizerCanvas organizerModeClassHierarchy ifTrue:[
newMode := OrganizerCanvas organizerModeCategory
] ifFalse:[
organizerMode == OrganizerCanvas organizerModeCategory ifTrue:[
newMode := OrganizerCanvas organizerModeClassHierarchy
].
].
newMode notNil ifTrue:[
organizerModeHolder value:newMode.
self organizerModeForMenu changed.
]
].
self normalLabel.
].
^ self
"Modified: / 06-10-2006 / 11:38:20 / cg"
!
codeCompletion
|cls codeView
"/ crsrPos interval node checkedNode
"/ char start stop selectorSoFar matchingSelectors
|
codeView := self codeView.
cls := self classOfSelectedMethodOrSelectedClass.
cls isNil ifTrue:[
self showInfo:'No class'.
^ self.
].
UserInformation handle:[:ex |
self showInfo:(ex messageText).
ex proceed.
] do:[
self withWaitCursorDo:[
DoWhatIMeanSupport codeCompletionForClass:cls codeView:codeView.
]
].
^ self.
"/
"/ interval := self selectedInterval.
"/ interval isEmpty ifTrue:[
"/ crsrPos := codeView characterPositionOfCursor - 1.
"/ char := codeView characterUnderCursor.
"/ [crsrPos > 1 and:[char isSeparator or:['.' includes:char]]] whileTrue:[
"/ crsrPos := crsrPos - 1.
"/ char := codeView characterAtCharacterPosition:crsrPos.
"/ ].
"/ interval := crsrPos to:crsrPos.
"/ ].
"/
"/ node := self findNodeForInterval:interval allowErrors:true.
"/ [node isNil] whileTrue:[
"/ "/ expand to the left ...
"/ interval start > 1 ifFalse:[
"/ self showInfo:'No parseNode found'.
"/ ^ self.
"/ ].
"/ interval start:(interval start - 1).
"/ node := self findNodeForInterval:interval allowErrors:true.
"/ ].
"/
"/ node isVariable ifTrue:[
"/ self codeCompletionForVariable:node inClass:cls.
"/ ^ self.
"/ ].
"/
"/ checkedNode := node.
"/ [checkedNode notNil] whileTrue:[
"/ checkedNode isMessage ifTrue:[
"/ self codeCompletionForMessage:checkedNode inClass:cls.
"/ ^ self
"/ ].
"/ checkedNode isMethod ifTrue:[
"/ self codeCompletionForMethod:checkedNode inClass:cls.
"/ ^ self.
"/ ].
"/ checkedNode := checkedNode parent.
"/ ].
"/
"/ self showInfo:'Node is neither variable nor message.'.
"Modified: / 04-07-2006 / 18:48:26 / fm"
"Modified: / 20-11-2006 / 12:30:59 / cg"
!
codeCompletionForMessage:node inClass:cls
<resource: #obsolete>
|codeView selector receiver nm srchClass implClass
bestSelectors bestPrefixes best nodeVal info numArgs
newParts nSelParts oldLen newLen selectorParts|
self obsoleteMethodWarning.
codeView := self codeView.
selector := node selector.
receiver := node receiver.
receiver isVariable ifTrue:[
nm := receiver name.
nm = 'self' ifTrue:[
srchClass := cls
].
nm = 'super' ifTrue:[
srchClass := cls superclass
].
(Smalltalk includesKey:nm asSymbol) ifTrue:[
nodeVal := Smalltalk at:nm asSymbol.
nodeVal notNil ifTrue:[
srchClass := nodeVal class
]
]
].
receiver isLiteral ifTrue:[
srchClass := receiver value class
].
srchClass notNil ifTrue:[
bestSelectors := Parser findBest:30 selectorsFor:selector in:srchClass forCompletion:true.
(bestSelectors includes:selector) ifTrue:[
bestSelectors := bestSelectors select:[:sel | sel size > selector size].
].
bestSelectors size > 0 ifTrue:[
bestPrefixes := bestSelectors select:[:sel | sel asLowercase startsWith:selector asLowercase].
bestPrefixes size > 0 ifTrue:[
bestSelectors := bestPrefixes
].
best := bestSelectors first.
bestSelectors size > 1 ifTrue:[
best = selector ifTrue:[
best := bestSelectors second.
].
bestSelectors size < 20 ifTrue:[
|idx|
idx := (PopUpMenu labels:bestSelectors) startUp.
idx == 0 ifTrue:[ ^ self].
best := bestSelectors at:idx.
] ifFalse:[
best := Dialog request:'Matching selectors:' initialAnswer:best list:bestSelectors.
best size == 0 ifTrue:[^ self].
].
] ifFalse:[
best := bestSelectors first.
].
implClass := srchClass whichClassIncludesSelector:best.
].
] ifFalse:[
"/ class not known
self withSearchCursorDo:[
bestSelectors := Parser findBest:30 selectorsFor:selector in:nil forCompletion:true.
].
(bestSelectors includes:selector) ifTrue:[
bestSelectors := bestSelectors select:[:sel | sel size > selector size].
].
bestSelectors size > 0 ifTrue:[
best := bestSelectors first.
bestSelectors size > 1 ifTrue:[
best = selector ifTrue:[
best := bestSelectors second.
].
bestSelectors size < 20 ifTrue:[
|idx|
idx := (PopUpMenu labels:bestSelectors) startUp.
idx == 0 ifTrue:[ ^ self].
best := bestSelectors at:idx.
] ifFalse:[
best := Dialog request:'Matching selectors:' initialAnswer:best list:bestSelectors.
best size == 0 ifTrue:[^ self].
]
] ifFalse:[
best := bestSelectors first.
].
implClass := Smalltalk allClasses select:[:cls | (cls includesSelector:best) or:[cls class includesSelector:best]].
implClass size == 1 ifTrue:[
implClass := implClass first.
] ifFalse:[
implClass := nil
]
].
].
best notNil ifTrue:[
info := best storeString.
implClass notNil ifTrue:[
info := implClass name , ' >> ' , info.
].
self showInfo:info.
best ~= selector ifTrue:[
numArgs := best numArgs.
selectorParts := node selectorParts.
nSelParts := selectorParts size.
newParts := best asCollectionOfSubstringsSeparatedBy:$:.
newParts := newParts select:[:part | part size > 0].
codeView
undoableDo:[
|stop|
numArgs > nSelParts ifTrue:[
stop := selectorParts last stop.
"/ append the rest ...
numArgs downTo:nSelParts+1 do:[:idx |
|newPart|
newPart := newParts at:idx.
(best endsWith:$:) ifTrue:[
newPart := newPart , ':'
].
(codeView characterAtCharacterPosition:stop) == $: ifFalse:[
newPart := ':' , newPart.
].
newPart := (codeView characterAtCharacterPosition:stop) asString , newPart.
codeView replaceFromCharacterPosition:stop to:stop with:newPart
]
].
nSelParts downTo:1 do:[:idx |
|newPart oldPartialToken start stop|
newPart := newParts at:idx.
oldPartialToken := selectorParts at:idx.
start := oldPartialToken start.
stop := oldPartialToken stop.
(best endsWith:$:) ifTrue:[
(codeView characterAtCharacterPosition:stop+1) == $: ifFalse:[
newPart := newPart , ':'
]
] ifFalse:[
(codeView characterAtCharacterPosition:stop) == $: ifTrue:[
newPart := newPart , ':'
] ifFalse:[
(codeView characterAtCharacterPosition:stop+1) isSeparator ifFalse:[
newPart := newPart , ' '
]
]
"/ codeView replaceFromCharacterPosition:start to:stop with:(newPart , ':').
"/ ] ifFalse:[
"/ codeView replaceFromCharacterPosition:start to:stop with:newPart.
].
codeView replaceFromCharacterPosition:start to:stop with:newPart.
oldLen := stop - start + 1.
newLen := newPart size.
codeView selectFromCharacterPosition:start+oldLen to:start+newLen-1.
].
codeView dontReplaceSelectionOnInput.
]
info:'completion'.
].
].
"Created: / 10-11-2006 / 13:18:27 / cg"
!
codeCompletionForMethod:node inClass:cls
<resource: #obsolete>
|codeView crsrPos
selectorSoFar matchingSelectors
selectors distances best rest|
self obsoleteMethodWarning.
codeView := self codeView.
crsrPos := codeView characterPositionOfCursor - 1.
selectorSoFar := ''.
node selectorParts do:[:partToken |
|part|
part := partToken value.
selectorSoFar := selectorSoFar , part.
(crsrPos >= partToken start
and:[crsrPos <= partToken stop]) ifTrue:[
matchingSelectors := Smalltalk allClasses
inject:(Set new)
into:[:theSet :eachClass |
|md|
cls isMeta ifTrue:[
md := eachClass theMetaclass methodDictionary
] ifFalse:[
md := eachClass theNonMetaclass methodDictionary
].
theSet addAll:(md keys select:[:sel |sel startsWith:selectorSoFar]).
theSet.
].
selectors := matchingSelectors asOrderedCollection.
distances := selectors collect:[:each | each spellAgainst:selectorSoFar].
distances sortWith:selectors.
selectors reverse.
best := self askUserForCompletion:'selector' from:selectors.
best isNil ifTrue:[^ self].
rest := best copyFrom:selectorSoFar size.
codeView
undoableDo:[
codeView
replaceFromCharacterPosition:crsrPos
to:crsrPos
with:rest
]
info:'completion'.
codeView cursorToCharacterPosition:(crsrPos + rest size - 1).
codeView cursorRight.
].
].
"Modified: / 04-07-2006 / 18:48:26 / fm"
"Created: / 10-11-2006 / 13:46:44 / cg"
!
codeCompletionForVariable:node inClass:cls
<resource: #obsolete>
|codeView nonMetaClass crsrPos nm
allVariables allDistances best nodeVal
char start stop oldLen newLen oldVar
getDistanceComputeBlockWithWeight addWithFactorBlock names allTheBest bestAssoc
globalFactor localFactor selectorOfMessageToNode tree|
self obsoleteMethodWarning.
nonMetaClass := cls theNonMetaclass.
codeView := self codeView.
nm := node name.
"/ if we are behind the variable and a space has already been entered,
"/ the user is probably looking for a message selector.
"/ If the variable represents a global, present its instance creation messages
crsrPos := codeView characterPositionOfCursor.
char := codeView characterAtCharacterPosition:crsrPos-1.
char isSeparator ifTrue:[
nodeVal := self currentClass nameSpace at:nm asSymbol ifAbsent:[Smalltalk at:nm asSymbol].
nodeVal isBehavior ifTrue:[
|methods menu exitKey idx|
methods := nodeVal class methodDictionary values
select:[:m | |cat|
cat := m category asLowercase.
cat = 'instance creation'
].
menu := PopUpMenu labels:(methods collect:[:each | each selector]).
menu hideOnKeyFilter:[:key | |hide|
hide := ( #( CursorDown CursorUp Escape Return ) includes: key) not.
hide ifTrue:[
exitKey := key.
].
hide].
idx := menu startUp.
idx == 0 ifTrue:[
exitKey notNil ifTrue:[
codeView keyPress:exitKey x:0 y:0.
].
^ self
].
best := (methods at:idx) selector.
codeView
undoableDo:[
codeView insertString:best atCharacterPosition:crsrPos.
codeView cursorToCharacterPosition:crsrPos+best size.
]
info:'completion'.
^ self.
].
].
(node parent notNil and:[node parent isMessage]) ifTrue:[
node == node parent receiver ifTrue:[
selectorOfMessageToNode := node parent selector
]
].
nm isUppercaseFirst ifTrue:[
globalFactor := 2.
localFactor := 1.
] ifFalse:[
globalFactor := 1.
localFactor := 2.
].
getDistanceComputeBlockWithWeight :=
[:weight |
[:each |
|dist factor|
dist := each spellAgainst:nm.
factor := 1.
(each startsWith:nm) ifTrue:[
factor := 4 * nm size.
] ifFalse:[
(each asLowercase startsWith:nm asLowercase) ifTrue:[
factor := 3 * nm size.
].
].
dist := dist + (weight*factor).
each -> (dist * weight)
]
].
addWithFactorBlock :=
[:names :factor | |namesToAdd|
namesToAdd := names select:[:nameToAdd | nameToAdd ~= nm ].
namesToAdd := namesToAdd reject:[:each | allVariables includes:each ].
allVariables addAll:namesToAdd.
allDistances addAll:(namesToAdd collect:(getDistanceComputeBlockWithWeight value:factor)).
].
allVariables := OrderedCollection new.
allDistances := OrderedCollection new.
"/ locals in the block/method
names := node allVariablesOnScope.
"/ if there were no variables (due to a parse error)
"/ do another parse and see what we have
names isEmpty ifTrue:[
tree := self treeForCodeAllowErrors:true.
"/ better if we already have a body (include locals then)
"/ otherwise, only the arguments are considered
names := (tree body ? tree) allVariablesOnScope.
].
addWithFactorBlock value:names value:(4 * localFactor).
"/ instance variables
addWithFactorBlock value:cls instVarNames value:(3 * localFactor).
"/ inherited instance variables
cls superclass notNil ifTrue:[
addWithFactorBlock value:cls superclass allInstVarNames value:(2.5 * localFactor).
].
selectorOfMessageToNode notNil ifTrue:[
|names responders nonResponders|
"/ responding to that messsage
"/ class variables
names := nonMetaClass classVarNames.
responders := names select:[:classVar | (nonMetaClass classVarAt:classVar) respondsTo:selectorOfMessageToNode].
nonResponders := names reject:[:classVar | (nonMetaClass classVarAt:classVar) respondsTo:selectorOfMessageToNode].
addWithFactorBlock value:responders value:(1.5 * globalFactor).
addWithFactorBlock value:nonResponders value:(0.5 * 1.5 * globalFactor).
nonMetaClass allSuperclassesDo:[:superClass |
names := superClass classVarNames.
responders := names select:[:classVar | (superClass classVarAt:classVar) respondsTo:selectorOfMessageToNode].
nonResponders := names reject:[:classVar | (superClass classVarAt:classVar) respondsTo:selectorOfMessageToNode].
addWithFactorBlock value:responders value:(1 * globalFactor).
addWithFactorBlock value:nonResponders value:(0.5 * 1 * globalFactor).
].
"/ globals
cls nameSpace ~~ Smalltalk ifTrue:[
names := cls topNameSpace keys.
names := names reject:[:nm | nm includes:$:].
names := names select:[:nm | nm isUppercaseFirst ].
responders := names select:[:nsVar | |c| c := cls topNameSpace at:nsVar. c isBehavior not or:[c isLoaded and:[c respondsTo:selectorOfMessageToNode]]].
nonResponders := names reject:[:nsVar | |c| c := cls topNameSpace at:nsVar. c isBehavior not or:[c isLoaded and:[c respondsTo:selectorOfMessageToNode]]].
addWithFactorBlock value:responders value:(1.5 * globalFactor).
addWithFactorBlock value:nonResponders value:(0.5 * 1.5 * globalFactor).
].
names := Smalltalk keys.
names := names reject:[:nm | nm includes:$:].
names := names select:[:nm | nm isUppercaseFirst ].
responders := names select:[:glblVar | |c| c := Smalltalk at:glblVar. c isBehavior not or:[c isLoaded and:[c respondsTo:selectorOfMessageToNode]]].
nonResponders := names reject:[:glblVar | |c| c := Smalltalk at:glblVar. c isBehavior not or:[c isLoaded and:[c respondsTo:selectorOfMessageToNode]]].
addWithFactorBlock value:responders value:(1.5 * globalFactor).
addWithFactorBlock value:nonResponders value:(0.5 * 1.5 * globalFactor).
] ifFalse:[
"/ class variables
addWithFactorBlock value:nonMetaClass classVarNames value:(1.5 * globalFactor).
cls superclass notNil ifTrue:[
addWithFactorBlock value:nonMetaClass superclass allClassVarNames value:(1 * globalFactor).
].
"/ globals
cls nameSpace ~~ Smalltalk ifTrue:[
names := cls nameSpace isNameSpace ifTrue:[cls nameSpace keys] ifFalse:[cls nameSpace privateClasses collect:[:c | c nameWithoutPrefix]].
names := names select:[:nm | nm isUppercaseFirst ].
addWithFactorBlock value:names value:(1.5 * globalFactor).
].
names := Smalltalk keys.
names := names select:[:nm | nm isUppercaseFirst ].
addWithFactorBlock value:names value:(1.5 * globalFactor).
].
"/ pseudos - assuming that thisContext is seldom used.
"/ also assuming, that nil is short so its usually typed in.
addWithFactorBlock value:#('self') value:(2.5 * localFactor).
addWithFactorBlock value:#('nil') value:(0.5 * localFactor).
addWithFactorBlock value:#('super' 'false') value:(2 * localFactor).
addWithFactorBlock value:#('thisContext') value:(1 * localFactor).
bestAssoc := allDistances at:1.
bestAssoc := allDistances inject:bestAssoc into:[:el :best | el value > best value
ifTrue:[el]
ifFalse:[best]
].
allDistances sort:[:a :b | a value > b value].
allTheBest := allDistances select:[:entry | entry value >= (bestAssoc value * 0.8)].
best := self askUserForCompletion:'variable' from:(allTheBest collect:[:assoc | assoc key]).
best isNil ifTrue:[^ self].
"/ self showInfo:best.
start := node start.
stop := node stop.
oldVar := (codeView textFromCharacterPosition:start to:stop) asString string withoutSeparators.
codeView
undoableDo:[ codeView replaceFromCharacterPosition:start to:stop with:best ]
info:'completion'.
(best startsWith:oldVar) ifTrue:[
oldLen := stop - start + 1.
newLen := best size.
codeView selectFromCharacterPosition:start+oldLen to:start+newLen-1.
codeView dontReplaceSelectionOnInput
].
"Created: / 10-11-2006 / 13:16:33 / cg"
"Modified: / 16-11-2006 / 14:15:59 / cg"
!
codeInfoVisibilityChanged
self updateCodeInfoAndStringSearchToolVisibility
"/ |visible cFrame bottomOffset|
"/
"/ visible := self codeInfoVisible value.
"/
"/ cFrame := builder findComponentAt:#EditorNoteBook. "/ #CodeView.
"/ cFrame notNil ifTrue:[
"/ visible ifFalse:[
"/ bottomOffset := 0.
"/ ] ifTrue:[
"/ bottomOffset := -25.
"/ ].
"/ cFrame layout bottomOffset:bottomOffset.
"/ cFrame container notNil ifTrue:[
"/ cFrame containerChangedSize.
"/ ].
"/ ].
"/ DefaultCodeInfoVisible := visible
!
codeModified
"invoked when the user edits the text shown in the codeView"
|navigationState|
navigationState := self navigationState.
self codeView modified ifTrue:[
navigationState realModifiedState:true.
self startSyntaxHighlightProcess.
].
"/ self enqueueDelayedCheckReallyModified.
self updateBufferLabel.
!
doNotShowInheritedMethods
self methodVisibilityHolder value:#class.
!
hideToolbar
self toolBarVisibleHolder value:false
"Created: / 10.12.2001 / 21:00:13 / cg"
!
methodDoubleClicked
|currentMethod|
currentMethod := self theSingleSelectedMethod.
currentMethod isNil ifTrue:[
^ self
].
self methodDoubleClicked:currentMethod
!
methodDoubleClicked1
self methodDoubleClickedAt:1
!
methodDoubleClicked2
self methodDoubleClickedAt:2
!
methodDoubleClicked3
self methodDoubleClickedAt:3
!
methodDoubleClicked4
self methodDoubleClickedAt:4
!
methodDoubleClicked:aMethod
|isMethodListLikeBrowser resources editorClass mSelector mClass|
isMethodListLikeBrowser := navigationState isMethodBrowser
or:[navigationState isMethodListBrowser
or:[navigationState isProtocolOrFullProtocolBrowser
or:[navigationState isChainBrowser ]]].
mSelector := aMethod selector.
mClass := aMethod mclass.
mClass isNil ifTrue:[
Dialog information:'oops - method''s class is gone (try to reselect)'.
^ self.
].
isMethodListLikeBrowser ifTrue:[
self window sensor shiftDown ifTrue:[
self spawnFullBrowserInClass:mClass
selector:mSelector
in:(DoubleClickIsOpenBrowser == true ifTrue:[#newBrowser] ifFalse:[#newBuffer]).
^ self
].
].
"/
"/ double clicking on wrapped method removes the wrap
"/
aMethod isWrapped ifTrue:[
self debugMenuRemoveBreakOrTrace.
^ self
].
"/
"/ double clicking on a resource-methods opens
"/ an appropriate editor
"/
(resources := aMethod resources) notNil
ifTrue:[
"/
"/ kludge - this info should come from somewhere else ...
"/
editorClass := self class resourceEditorClassForResources:resources.
editorClass notNil ifTrue: [
mClass isMeta ifTrue:[
"/ these uzdsakfhiv-stupid editors cannot edit nonMeta-methods - sigh
self withExecuteCursorDo:[
editorClass
openOnClass:mClass theNonMetaclass
andSelector:mSelector.
^ self.
]
]
]
].
"/
"/ double clicking on a normal-method adds a buffer on the class;
"/ but not if I am already a class browser.
"/
isMethodListLikeBrowser ifTrue:[
self spawnFullBrowserInClass:mClass selector:mSelector
in:(DoubleClickIsOpenBrowser == true ifTrue:[#newBrowser] ifFalse:[#newBuffer]).
"/
"/ brwsr := self spawnClassBrowserFor:(Array with:mClass) in:#newBuffer.
"/ "/ brwsr selectClass:mClass.
"/ brwsr immediateUpdate value:true.
"/ brwsr selectProtocol:(aMethod category).
"/ brwsr selectMethod:(aMethod).
"/ brwsr immediateUpdate value:false.
^ self
].
"/
"/ double clicking on any other method adds a senders buffer
"/
"/ self
"/ spawnMethodSendersBrowserFor:(Array with:mSelector)
"/ in:#newBuffer
self
spawnMethodInheritanceBrowserFor:(Array with:mSelector)
in:#newBuffer
"Modified: / 05-07-2010 / 15:53:42 / cg"
!
methodDoubleClickedAt:index
|selectedMethods selectedMethod|
selectedMethods := (navigationState selectedMethodsArrayAt:index) value.
selectedMethods size == 1 ifTrue:[
selectedMethod := selectedMethods first.
self methodDoubleClicked:selectedMethod.
]
!
nameSpaceDoubleClicked
"double click on a nameSpace:
add a buffer browsing that namespace"
self withWaitCursorDo:[
DoubleClickIsOpenBrowser == true ifTrue:[
self nameSpaceMenuSpawn
] ifFalse:[
self nameSpaceMenuSpawnBuffer
]
].
self normalLabel.
!
projectDoubleClicked
"double click on a project:
add a buffer browsing that project"
self withWaitCursorDo:[
DoubleClickIsOpenBrowser == true ifTrue:[
self projectMenuSpawn
] ifFalse:[
self projectMenuSpawnBuffer
]
].
self normalLabel.
!
protocolDoubleClicked
"double click on a protocol:
open a full-protocol browser"
"/ self theSingleSelectedProtocol notNil ifTrue:[
"/ self protocolMenuSpawnFullCategoryBuffer
"/ ]
"Modified: / 25-07-2010 / 14:45:46 / cg"
!
showInheritedMethods
self methodVisibilityHolder value:#allButObject.
!
startApplication:clsArg
"double-click on a class to exec; or launch button.
Return true if successful"
|cls|
cls := clsArg theNonMetaclass.
(cls isBrowserStartable) ifFalse:[^ false].
(cls isVisualStartable) ifTrue:[
self busyLabel:'starting application %1' with:cls name.
MessageNotUnderstood handle:[:ex |
ex selector ~~ #windowSpec ifTrue:[
ex reject.
]
] do:[
cls open.
].
^ true.
].
(cls isStartableWithMain) ifTrue:[
self busyLabel:'invoking main of %1' with:cls name.
"/ (self confirm:('Invoke %1''s main ?' bindWith:clsName)) ifTrue:[
cls main.
"/ ].
^ true.
].
(cls isStartableWithStart) ifTrue:[
self busyLabel:'invoking start of %1' with:cls name.
"/ (self confirm:('Invoke %1''s start ?' bindWith:clsName)) ifTrue:[
cls start.
"/ ].
^ true.
].
^ false.
!
stringSearchToolVisibilityChanged
|stringSearchToolVisible|
self updateCodeInfoAndStringSearchToolVisibility.
stringSearchToolVisible := self stringSearchToolVisibleHolder value.
stringSearchToolVisible ifTrue:[
self setFocusToSearchBar.
].
!
switchToCategoryView
self organizerMode value:(OrganizerCanvas organizerModeCategory).
self organizerModeForMenu changed
!
switchToClassHierarchyView
self organizerMode value:OrganizerCanvas organizerModeClassHierarchy.
self organizerModeForMenu changed
!
toolBarVisibilityChanged
|visible toolBar noteBook topOffset|
toolBar := self componentAt:#ToolBar.
toolBar isNil ifTrue:[
topOffset := 0.
] ifFalse:[
visible := self toolBarVisibleHolder value.
DefaultToolBarVisible := visible.
visible ifTrue:[
topOffset := toolBar height.
]
].
noteBook := self componentAt:#NoteBook.
noteBook notNil ifTrue:[
noteBook layout topOffset:topOffset.
noteBook container notNil ifTrue:[
noteBook containerChangedSize.
].
].
!
variableDoubleClicked
"double click on a variable:
add a buffer showing all references to this variable"
|names type title|
names := self variableFilter value.
names size == 0 ifTrue:[^ self].
self showingClassVarsInVariableList ifTrue:[
type := #classVarNames.
title := 'all references to class variable ''%1'''.
] ifFalse:[
self meta value ifTrue:[
type := #classInstVarNames.
title := 'all references to class-instance variable ''%1'''.
] ifFalse:[
type := #instVarNames.
title := 'all references to instance variable ''%1'''.
].
].
self
browseVarRefsToAny:names
classes:self selectedClasses value
variables:type access:#readOrWrite all:true
title:title in:#newBuffer
! !
!NewSystemBrowser methodsFor:'user actions-accepting'!
acceptMethod:codeArg inClass:cls check:doCheck
"accept a new method.
Return false, if NOT accepted (i.e. compilation canceled)"
|code cat returnValue newSelector existingMethod|
code := codeArg.
returnValue := false.
"/ a quick parse for the selector ...
newSelector := self selectorOfMethodFromCode:code in:cls.
existingMethod := cls compiledMethodAt:newSelector ifAbsent:[].
cat := self protocolToAcceptMethod:newSelector class:cls.
AbortOperationRequest catch:[
(Class methodRedefinitionNotification) handle:[:ex |
|answer|
answer := SystemBrowser askForPackageChangeFrom:ex oldPackage
to:ex newPackage.
(answer ~~ #cancel) ifTrue:[
ex proceedWith:answer
].
] do:[
|codeView package oldMethod oldSelector defPackage answer rslt lang|
"/ used to be
"/ oldSelector := self theSingleSelectedSelector.
"/ here; however, with Ruby, a funny selector (fact) instead of fact: is returned...
oldMethod := self theSingleSelectedMethod.
oldMethod notNil ifTrue:[
oldSelector := oldMethod selector.
].
"/ check for overwritten version method
(cls isMeta and:[(AbstractSourceCodeManager isVersionMethodSelector:newSelector)]) ifTrue:[
(self confirm:'ATTENTION: you are about to accept the classes version method.
This method is required by the sourceCodeManager and should correctly return
the classes version as present in the source repository.
An incorrect version method may lead to failures when accessing/showing/changing
the classes source code - i.e. lead to trouble.
You have been warned.
Accept anyway ?')
ifFalse:[
^ false
]
] ifFalse:[
"/ check if accepting a different selector than the selected one,
"/ and a method for the new selector exists.
(existingMethod notNil and:[oldSelector ~= newSelector]) ifTrue:[
answer := OptionBox
request:('You are about to overwrite an existing method.\\Accept anyway ?' withCRs)
label:(resources string:'Attention')
image:(WarningBox iconBitmap)
buttonLabels:(resources array:#('Cancel' 'Compare' 'Yes'))
values:#(false #compare true)
default:false
onCancel:false.
answer == false ifTrue:[
^ false
].
answer == #compare ifTrue:[
self openDiffViewForText:code againstSourceOfMethod:existingMethod.
^ false
].
]
].
codeView := self codeView.
codeView cursorMovementWhenUpdating:nil.
codeView scrollWhenUpdating:nil.
existingMethod notNil ifTrue:[
"keep old package if selector does already exist in class"
package := existingMethod package.
] ifFalse:[
cls theNonMetaclass canHaveExtensions ifFalse:[
defPackage := package := cls package.
] ifTrue:[
defPackage := Class packageQuerySignal query.
].
"/ if in project-mode,
"/ assign the currently selected packageID (or ask, if there is none or multiple)
"/ otherwise, use the current project
(navigationState isProjectBrowser
or:[navigationState organizerMode value == OrganizerCanvas organizerModeProject])
ifTrue:[
cls theNonMetaclass canHaveExtensions ifTrue:[
package := self theSingleSelectedProject.
].
package isNil ifTrue:[
package := self
askForProject:'Method shall be assigned to which project ?'
initialText:(LastAcceptPackage ? cls package).
package isNil ifTrue:[^ false].
LastAcceptPackage := package.
] ifFalse:[
package := package asSymbol.
"/ if the current project is different from the selected one
package ~= defPackage ifTrue:[
"/ and the current project is not the default project
(defPackage = PackageId noProjectID) ifFalse:[
"/ ask
package := self
askForProject:('The browsers selected project is ''%1''\however, your currently active (default) project is ''%2''.\\To which project shall the method be assigned ?'
bindWith:package allBold with:defPackage allBold) withCRs
initialText:package.
package isNil ifTrue:[^ false].
LastAcceptPackage := package.
]
]
].
].
package isNil ifTrue:[
package := defPackage
].
].
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.
[
|codeCritics|
code := code asString.
"/ cg: for now, only smalltalk critics is possible...
(self enforceCodeStyle and:[lang isSmalltalk]) ifTrue:[
codeCritics := CodeCritics checkCodeQuality:code.
codeCritics notNil ifTrue:[
codeCritics do:[:eachCritic |
codeView
highlightingErrorLine:(eachCritic key)
do:[
Dialog
warn:(resources
stringWithCRs:'Ugly code warning\\ %1\\Please beautify.'
with:eachCritic value allBold).
].
].
].
].
self enforceComment ifTrue:[
"/ allow simple getters, setters, basicNew etc...
"/ 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.')
].
].
].
"/ do not react on the methodSelectionChanged notification
"/ (which is enforced by the methodList)
self selectedMethods retractInterestsFor:self.
"/ self immediateUpdate value:true.
"/ Transcript showCR:'accepting in package: ', (package ? '__NoPackage__').
Class packageQuerySignal answer:package do:[ |change|
ClassDescription updateHistoryLineQuerySignal answer:true do:[
(ClassDescription updateChangeFileQuerySignal
, ClassDescription updateChangeListQuerySignal) answer:self suppressChangeSetUpdate not
do:[
Class nameSpaceQuerySignal
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 ? '???').
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
inCategory:cat
notifying:codeView
install:true.
].
].
].
].
].
"/ give subcanvases a chance to synchronize ...
"/ self immediateUpdate value:true.
rslt isMethod ifTrue:[
"/ rslt resourceType == #image ifTrue:[
"/ Icon flushCachedIcons
"/ ].
navigationState realModifiedState:false.
codeView modified:false.
"/ immediateUpdate value:true.
"/ self switchToSelector:rslt selector.
codeView cursorMovementWhenUpdating:nil.
codeView scrollWhenUpdating:nil.
codeView setSearchPattern:nil.
lastMethodCategory := rslt category.
(self selectedProtocolsValue contains:[:p | p string = lastMethodCategory]) ifFalse:[
(self selectedProtocolsValue includes:BrowserList nameListEntryForALL) ifFalse:[
"/ self selectedProtocols setValue:(Array with:rslt category).
self selectProtocols:(Array with:lastMethodCategory).
]
].
oldSelector ~= rslt selector ifTrue:[
self selectedMethods value:(Array with:rslt).
"/ self switchToSelector:rslt selector
] ifFalse:[
"/ "/ do not notify myself (to avoid scroll-to-top)
"/
"/ self selectedMethods value:(Array with:rslt).
].
"/ self showMethodsCode:rslt scrollToTop:false.
"/ self selectedMethods setValue:(Array with:rslt).
"/ self switchToClass:cls selector:rslt selector.
"/ immediateUpdate value:false.
doCheck ifTrue:[
self checkAcceptedMethod:rslt inClass:cls.
].
returnValue := true.
"/ self updateBufferLabel.
].
] ensure:[
"/ do again react on the methodSelectionChanged notification
self selectedMethods onChangeSend:#methodsSelectionChanged to:self.
"/ self immediateUpdate value:false.
].
]
].
^ returnValue.
"Modified: / 17-07-2010 / 14:54:53 / cg"
!
askForInitialApplicationCodeFor:aClass
|cls mcls codeAspect msg|
cls := aClass theNonMetaclass.
mcls := aClass theMetaclass.
codeAspect := self codeAspect.
codeAspect == #newApplication ifTrue:[ msg := 'Generate initial application code ?' ].
codeAspect == #newDialog ifTrue:[ msg := 'Generate initial dialog code ?' ].
codeAspect == #newWebService ifTrue:[ msg := 'Generate initial webService code ?' ].
codeAspect == #newWebPage ifTrue:[ msg := 'Generate initial webPage code ?' ].
codeAspect == #newWidget ifTrue:[ msg := 'Generate initial widget code ?' ].
(msg notNil and:[self confirm:(resources string:msg)])
ifTrue:[
SmalltalkCodeGeneratorTool createDocumentationMethodsFor:mcls.
(codeAspect == #newWebService) ifTrue:[
SmalltalkCodeGeneratorTool createWebServiceCodeFor:cls.
^ self.
].
(codeAspect == #newWebPage) ifTrue:[
SmalltalkCodeGeneratorTool createWebPageCodeFor:cls.
^ self.
].
codeAspect == #newApplication ifTrue:[
SmalltalkCodeGeneratorTool createExamplesMethodFor:mcls.
SmalltalkCodeGeneratorTool createApplicationCodeFor:cls.
].
codeAspect == #newWidget ifTrue:[
SmalltalkCodeGeneratorTool createWidgetCodeFor:cls.
].
^ self.
].
(codeAspect == #newTestCase) ifTrue:[
SmalltalkCodeGeneratorTool createDocumentationMethodsFor:mcls.
SmalltalkCodeGeneratorTool createTestCaseSampleCodeFor:cls.
^ self.
]
"Modified: / 31-01-2011 / 18:29:32 / cg"
!
checkCodeQuality:code
code asCollectionOfLines keysAndValuesDo:[:lineNr :eachLine |
|lineString column|
lineString := eachLine string.
(lineString withoutLeadingSeparators startsWith:'^') ifTrue:[
column := lineString indexOf:$^.
(column-1) \\ 4 ~~ 0 ifTrue:[
^ (lineNr -> 'bad indentation').
].
]
].
^ nil
!
classToAcceptMethodIn
| cls mthd className classes classNameList initial commonSuper|
cls := self theSingleSelectedClass.
cls isNil ifTrue:[
mthd := self theSingleSelectedMethod.
mthd notNil ifTrue:[
cls := mthd mclass
]
].
cls isNil ifTrue:[
classes := self selectedClasses value.
classes isEmptyOrNil ifTrue:[
self warn:'oops class is gone; reselect and try again'.
^ nil
].
"/ ask for class in which to accept
commonSuper := Behavior commonSuperclassOf:classes.
(classes includes:commonSuper) ifTrue:[
initial := commonSuper name.
].
classNameList := classes collect:[:cls|cls name].
classNameList size > 0 ifTrue:[
classNameList addLast:'-'.
classNameList addLast:'*'.
].
className := Dialog
request:'Accept code for which class ? ("*" for all)'
initialAnswer:initial
list:classNameList.
className size == 0 ifTrue:[
^ nil
].
className = '*' ifTrue:[
^ classes asArray.
].
cls := Smalltalk at:className asSymbol.
cls isNil ifTrue:[
self warn:'No such class - try again'.
^ nil
].
].
^ cls
"Modified: / 12-10-2006 / 21:53:50 / cg"
!
doAcceptClassAspect:aspect get:getSelector set:setSelector code:theCode
"accept comment or primitiveDefs/vars/funs (in the codeView)."
|codeView currentClass|
codeView := self codeView.
currentClass := self theSingleSelectedLoadedNonMetaclassOrNil.
currentClass isNil ifTrue:[
^ self warn:'oops - no loaded class selected'
].
((currentClass class includesSelector:getSelector)
or:[ (currentClass class includesSelector:setSelector) ]) ifTrue:[
self warn:('The "%1"-class redefines the "%2" and/or the "%3"-message.\\The Accept may fail - please check manually.'
bindWith:currentClass name allBold
with:getSelector allBold
with:setSelector allBold) withCRs.
].
[
Smalltalk removeDependent:self. "/ avoid update
ClassDescription updateHistoryLineQuerySignal answer:true do:[
(ClassDescription updateChangeFileQuerySignal
, ClassDescription updateChangeListQuerySignal) answer:self suppressChangeSetUpdate not
do:[
currentClass perform:setSelector with:theCode asString string.
].
].
codeView contents:(currentClass perform:getSelector).
codeView modified:false.
navigationState realModifiedState:false.
] ensure:[
Smalltalk addDependent:self.
].
self codeAspect:aspect.
"Modified: / 01-03-2007 / 20:53:42 / cg"
!
doAcceptClassComment:theCode
"accept a classComment (in the codeView)."
self doAcceptClassAspect:#classComment get:#comment set:#comment: code:theCode
!
doAcceptClassDefinition:theCode fullClass:thisIsAFullClassesCode usingCompiler:aCompilerClass
"tell the codeView what to do on accept.
Return false, if NOT accepted (i.e. compilation canceled)"
|codeView returnValue package|
returnValue := false.
codeView := self codeView.
codeView modified:false.
self withExecuteCursorDo:[
|currentCategory currentClass ns|
currentClass := self theSingleSelectedClass.
currentClass notNil ifTrue:[
ns := currentClass nameSpace
] ifFalse:[
ns := nil
].
ns := nil. "/ experimental - needed for JS parsing; is it still needed for ST ?
currentCategory := self theSingleSelectedCategory.
currentCategory isNil ifTrue:[
currentClass notNil ifTrue:[
currentCategory := currentClass category
]
].
self organizerMode value == OrganizerCanvas organizerModeProject ifTrue:[
currentClass notNil ifTrue:[
package := currentClass package.
] ifFalse:[
package := self theSingleSelectedProject.
].
package isNil ifTrue:[
package := Dialog request:'Add to which project ?'.
package size == 0 ifTrue:[^ self].
].
package := package asSymbol.
] ifFalse:[
package := Class packageQuerySignal query.
].
Class classCategoryQuerySignal answer:(currentCategory ? '* as yet unspecified *')
do:[
Class packageQuerySignal answer:package
do:[
Class nameSpaceQuerySignal handle:[:ex |
ns isNil ifTrue:[
ex reject
].
ex proceedWith:ns
] do:[
AbortOperationRequest catch:[
UndefinedObject createMinimumProtocolInNewSubclassQuery
answer:true
do:[
(Class classRedefinitionNotification) handle:[:ex |
|answer|
"/ cg: now always keep the old packageID
Class catchClassRedefinitions ifFalse:[
ex proceedWith:#keep
].
answer := OptionBox
request:
('You are about to change the definition of a class from another (system-) package.
The class is part of the ''%1'' package.
PS: you can disable this check in the launchers settings-compilation dialog.'
bindWith:(ex oldPackage allBold))
label:'Class redefinition'
image:(WarningBox iconBitmap)
buttonLabels:#('Cancel' 'Continue')
values:#(#cancel #keep)
default:#keep
onCancel:#cancel.
(answer ~~ #cancel) ifTrue:[
ex proceedWith:answer
]
] do:[
|rslt cls mcls|
self immediateUpdate value:true.
navigationState realModifiedState:false.
navigationState modified:false.
ClassDescription updateHistoryLineQuerySignal answer:true do:[
(ClassDescription updateChangeFileQuerySignal
, ClassDescription updateChangeListQuerySignal) answer:self suppressChangeSetUpdate not
do:[
thisIsAFullClassesCode ifTrue:[
rslt := (ReadStream on:theCode asString) fileIn.
] ifFalse:[
ClassBuildError handle:[:ex |
self warn:ex description
] do:[
rslt := (aCompilerClass ? Compiler)
evaluate:theCode asString string
notifying:codeView
compile:false.
].
].
].
].
self immediateUpdate value:false.
rslt isBehavior ifTrue:[
self switchToClass:rslt.
"/ self switchToClassNamed:rslt name.
returnValue := true.
].
returnValue ifTrue:[
cls := rslt theNonMetaclass.
mcls := rslt theMetaclass.
self askForInitialApplicationCodeFor:mcls.
].
]
]
].
].
].
]
].
self codeAspect:#classDefinition.
^ returnValue
"Created: / 13-02-2000 / 22:43:59 / cg"
"Modified: / 30-01-2011 / 17:06:14 / cg"
!
doAcceptClassDefinition:theCode usingCompiler:aCompilerClass
"tell the codeView what to do on accept.
Return false, if NOT accepted (i.e. compilation canceled)"
^ self
doAcceptClassDefinition:theCode
fullClass:false
usingCompiler:aCompilerClass
"Modified: / 24.2.2000 / 15:40:11 / cg"
!
doAcceptClassPrimitive:theCode
"accept primitive-definitions/functions or variables (in the codeView)."
|codeAspect setter getter|
codeAspect := self codeAspect.
codeAspect == #primitiveDefinitions ifTrue:[
getter := #'primitiveDefinitionsString'.
setter := #'primitiveDefinitions:'.
] ifFalse:[
codeAspect == #primitiveFunctions ifTrue:[
getter := #'primitiveFunctionsString'.
setter := #'primitiveFunctions:'.
] ifFalse:[
codeAspect == #primitiveVariables ifTrue:[
getter := #'primitiveVariablesString'.
setter := #'primitiveVariables:'.
] ifFalse:[
self error:'unknown codeAspect: ', codeAspect printString.
]
]
].
self doAcceptClassAspect:codeAspect get:getter set:setter code:theCode.
!
doAcceptCodeIn:aNavigationState
"accept changed code in aNavigationState"
|acceptAction codeView codeAspect|
codeView := aNavigationState codeView.
acceptAction := codeView acceptAction.
acceptAction isNil ifTrue:[^ self].
codeAspect := aNavigationState codeAspect.
(codeAspect == #classDefinition or:[codeAspect == #method]) ifTrue:[
acceptAction value:(codeView contentsAsString)
].
"Modified: / 24.2.2000 / 15:38:07 / cg"
!
doAcceptFullClassDefinition:theCode usingCompiler:aCompilerClass
"tell the codeView what to do on accept.
Return false, if NOT accepted (i.e. compilation canceled)"
^ self
doAcceptClassDefinition:theCode
fullClass:true
usingCompiler:aCompilerClass
"Created: / 24.2.2000 / 15:40:19 / cg"
!
doAcceptFullJavaClassDefinition:theCode
"tell the codeView what to do on accept.
Return false, if NOT accepted (i.e. compilation canceled)"
self warn:'Accept of Java classes is not yet implemented'.
^ false
!
doAcceptJavaClassDefinition:theCode
"tell the codeView what to do on accept.
Return false, if NOT accepted (i.e. compilation canceled)"
self warn:'Accept of Java classes is not yet implemented'.
^ false
!
doAcceptMethod:theCode
"accept a new/modified method"
|codeWithoutEmphasis classOrClassCollection|
theCode isStringCollection ifTrue:[
codeWithoutEmphasis := theCode
collect:[:eachLine |
eachLine isNil ifTrue:[
nil
] ifFalse:[
eachLine string
]
].
] ifFalse:[
codeWithoutEmphasis := theCode
].
classOrClassCollection := self classToAcceptMethodIn.
classOrClassCollection notNil ifTrue:[
self
withWaitCursorVisibleDo:[
classOrClassCollection isArray ifTrue:[
classOrClassCollection do:[:eachClass |
self
acceptMethod:codeWithoutEmphasis
inClass:eachClass
check:false.
].
] ifFalse:[
self
acceptMethod:codeWithoutEmphasis
inClass:classOrClassCollection
check:true.
].
]
].
!
doSaveInSpecialEditors
"accept changes in special editor"
self navigationState doSaveInSpecialEditors.
!
enforceCodeStyle
^ UserPreferences current enforceCodeStyle
!
enforceComment
^ UserPreferences current enforceComment
"Created: / 17-07-2010 / 14:18:26 / cg"
!
openDiffViewForText:theCode againstSourceOfMethod:aMethod
|originalSource changedSource v|
originalSource := aMethod source.
changedSource := theCode asString string.
v := DiffCodeView
openOn:changedSource
label:(resources string:'Code here (to be accepted ?)')
and:originalSource
label:(resources string:'Method''s actual code').
v topView label:(resources string:'Comparing methods').
v waitUntilVisible.
!
protocolToAcceptMethod:selector class:aClass
| cat mthd protocols |
mthd := self theSingleSelectedMethod.
mthd notNil ifTrue:[
cat := mthd category
] ifFalse:[
protocols := ((self selectedMethods value ? #()) collect:[:m | m category]) asSet.
protocols size == 1 ifTrue:[
cat := protocols first
] ifFalse:[
cat := self theSingleSelectedProtocol.
(cat isNil or:[cat = (BrowserList nameListEntryForALL)]) ifTrue:[
"must check from which category this code came from ...
... thanks to Arno for pointing this out"
cat := self askForMethodCategoryForAcceptInClass:aClass selector:selector.
cat size == 0 ifTrue:[
^ nil
].
]
]
].
^ cat
!
selectorOfMethodFromCode:someCode in:aClass
"a quick parse for the selector - is done BEFORE we actually compile something,
to be able to get the existing method's category (q: is that really needed - can change
the category afterwards, if the compiled method is installed late)"
|parser|
"/ that's a stupid interface - should ask for a tree and then for a selector...
parser := aClass parserClass
perform:#'parseMethodSpecification:in:ignoreErrors:ignoreWarnings:'
withArguments:(Array with:(someCode asString)
with:aClass
with:true
with:true)
ifNotUnderstood:[ nil ].
(parser notNil and:[parser ~~ #Error]) ifTrue:[
^ parser selector asSymbol.
].
^ nil
"Modified: / 23-04-2009 / 09:32:05 / Jan Vrany <vranyj1@fel.cvut.cz>"
!
setAcceptAction:aBlockOrNil
"tell the codeView what to do on accept"
|codeView|
(codeView := self codeView) notNil ifTrue:[
codeView acceptAction:aBlockOrNil.
].
!
setAcceptActionForClass
"tell the codeView what to do on accept and explain"
self setAcceptActionForMetaClassUsed:nil
!
setAcceptActionForClassComment
"tell the codeView what to do on accept"
|currentClass|
currentClass := self theSingleSelectedClass.
(currentClass isNil
or:[ currentClass programmingLanguage isSmalltalk not
or:[ currentClass isRealNameSpace ]])
ifTrue:[
self setAcceptActionForNothing.
^ self
].
self setAcceptAction:[:theCode | self doAcceptClassComment:theCode].
"Modified: / 10-11-2006 / 17:14:28 / cg"
!
setAcceptActionForJavaClass
"tell the codeView what to do on accept and explain"
|currentClass action|
currentClass := self theSingleSelectedClass.
navigationState isFullClassSourceBrowser ifTrue:[
action := [:theCode | self doAcceptFullJavaClassDefinition:theCode].
] ifFalse:[
action := [:theCode | self doAcceptJavaClassDefinition:theCode].
].
self setAcceptAction:action.
!
setAcceptActionForJavaClassComment
"tell the codeView what to do on accept"
self setAcceptActionForNothing
!
setAcceptActionForMetaClassUsed:metaClassUsedOrNil
"tell the codeView what to do on accept and explain"
|currentClass action compiler|
currentClass := self theSingleSelectedClass.
metaClassUsedOrNil isNil ifTrue:[
currentClass isJavaClass ifTrue:[
^ self setAcceptActionForJavaClass.
].
].
(currentClass isRealNameSpace) ifTrue:[
self setAcceptActionForNothing.
^ self
].
metaClassUsedOrNil notNil ifTrue:[
compiler := metaClassUsedOrNil basicNew realSubclassDefinerClass
] ifFalse:[
compiler := currentClass
ifNil:[Compiler]
ifNotNil:[ (currentClass subclassDefinerClass ? Compiler) ].
].
navigationState isFullClassSourceBrowser ifTrue:[
action := [:theCode | self doAcceptFullClassDefinition:theCode
usingCompiler:compiler
].
] ifFalse:[
action := [:theCode | self doAcceptClassDefinition:theCode
usingCompiler:compiler
].
].
self setAcceptAction:action.
"Modified: / 10-11-2006 / 17:14:34 / cg"
!
setAcceptActionForMethod
"tell the codeView what to do on accept"
|codeView|
self setAcceptAction:[:theCode | self doAcceptMethod:theCode].
(codeView := self codeView) notNil ifTrue:[
codeView
explainAction:[:theCode :theSelection |
self explain:theSelection inCode:theCode
].
]
!
setAcceptActionForNothing
"tell the codeView what to do on accept"
self setAcceptAction:[:code | self window beep].
!
setAcceptActionForProjectComment
"tell the codeView what to do on accept"
self setAcceptAction:[:code | |package project|
package := self theSingleSelectedProject.
project := Project projectWithId:package.
project isNil ifTrue:[
self warn:'No such project.'
] ifFalse:[
project comment:(code asString string).
navigationState modified:false.
navigationState realModifiedState:false.
].
].
!
setDoitActionForClass
"tell the codeView what to do on doIt"
"set self for doits. This allows accessing the current class
as self, and access to the class variables by name.
Also, the current nameSpace (if there is one) is set for
the doIt.
"
|codeView|
codeView := self codeView.
codeView isNil ifTrue:[^ self].
codeView doItAction:[:theCode |
|compiler nsName ns currentClass currentNonMetaClass currentMethod result|
currentClass := self theSingleSelectedClass.
currentClass isNil ifTrue:[
currentMethod := self theSingleSelectedMethod.
currentMethod notNil ifTrue:[
currentClass := currentMethod mclass
]
].
currentClass notNil ifTrue:[
currentNonMetaClass := currentClass theNonMetaclass.
ns := currentNonMetaClass nameSpace
] ifFalse:[
self organizerMode == OrganizerCanvas organizerModeNamespace ifTrue:[
nsName := self theSingleSelectedNamespace.
nsName notNil ifTrue:[
ns := NameSpace name:nsName
].
]
].
Class nameSpaceQuerySignal handle:[:ex |
ns isNil ifTrue:[
ex reject
].
ex proceedWith:ns
] do:[
currentClass isNil ifTrue:[
compiler := Compiler
] ifFalse:[
compiler := currentClass evaluatorClass
].
result := compiler
evaluate:theCode string
in:nil
receiver:currentNonMetaClass
notifying:codeView
logged:false
ifFail:nil.
].
result
].
"Created: / 23.2.2000 / 11:54:24 / cg"
"Modified: / 23.2.2000 / 11:57:10 / cg"
!
setNoAcceptAction
"tell the codeView what accept is not allowed"
self setAcceptAction:[:code | self codeView flash].
! !
!NewSystemBrowser methodsFor:'user actions-class'!
classLoad
"load an autoloaded class.
Invoked on doubleClick on a class or via the menu"
self loadClasses:self selectedClasses value.
"/ to force update.
"/ (I guess, this is not needed)
self selectedClasses value:(self selectedClasses value copy).
!
classMenuUnload
"unload an autsoloaded class"
self unloadClasses:self selectedNonMetaclasses.
"/ to force update.
"/ (I guess, this is not needed)
self selectedClasses value:(self selectedClasses value copy).
"Modified: / 12-09-2006 / 13:48:12 / cg"
!
loadClasses:aCollectionOfClasses
"load a collection of autoloaded classes.
Invoked on doubleClick on an unloaded class or via the menu"
[
|numClasses|
numClasses := aCollectionOfClasses size.
aCollectionOfClasses do:[:eachClass |
|cls nm nameShown msg|
cls := eachClass theNonMetaclass.
cls isLoaded ifFalse:[
nm := cls name.
nameShown := self displayedClassNameOf:cls.
Autoload autoloadFailedSignal handle:[:ex |
msg := 'Autoload of %1 failed.
Check for a file named ''%2.st'' either in the package ''%3''
along your packagePath, or in the current directory.
The packagePath is: %4.
You can also try to load the class(es) from the repository,
via the ''import and load classes'' menu function of the
project list.'.
msg := (resources string:msg
with:nameShown
with:(Smalltalk fileNameForClass:cls)
with:cls package
with:(Smalltalk packagePath asStringCollection asStringWith:' , ')).
numClasses > 1 ifTrue:[
(Dialog
confirm:msg
yesLabel:'OK' noLabel:'Cancel') ifFalse:[^ self].
] ifFalse:[
Dialog warn:msg.
].
ex return.
] do:[
self busyLabel:'loading %1 ...' with:nameShown.
cls autoload.
].
]
].
] ensure:[
self normalLabel.
].
!
unloadClasses:aCollectionOfClasses
"unload an autoloaded classes in aCollectionOfClasses"
|notAutoloaded force|
notAutoloaded := OrderedCollection new.
aCollectionOfClasses do:[:eachClass |
|eachNonMetaClass|
eachNonMetaClass := eachClass theNonMetaclass.
(eachNonMetaClass isLoaded and:[eachNonMetaClass wasAutoloaded not]) ifTrue:[
notAutoloaded add:eachNonMetaClass.
].
].
notAutoloaded notEmpty ifTrue:[
force := Dialog
confirm:(resources
stringWithCRs:(notAutoloaded size == 1
ifTrue:['%1 was not autoloaded.\\Force unloading it anyway ?']
ifFalse:['Some (%2) classes were not autoloaded.\\Force unloading them anyway ?'])
with:notAutoloaded first name
with:notAutoloaded size).
] ifFalse:[
force := false.
].
aCollectionOfClasses do:[:eachClass |
|nm nameShown doIt eachNonMetaClass|
eachNonMetaClass := eachClass theNonMetaclass.
(force or:[(eachNonMetaClass isLoaded and:[eachNonMetaClass wasAutoloaded])]) ifTrue:[
nm := eachNonMetaClass name.
nameShown := self displayedClassNameOf:eachNonMetaClass.
doIt := true.
eachNonMetaClass hasDerivedInstances ifTrue:[
doIt := self confirm:(resources string:'''%1'' has (derived) instances. Unload anyway ?' with:nameShown allBold)
].
doIt ifTrue:[
self busyLabel:'unloading %1 ...' with:nameShown.
[
eachNonMetaClass unload.
] ensure:[
self normalLabel.
].
].
]
].
"Modified: / 12-09-2006 / 13:48:12 / cg"
! !
!NewSystemBrowser methodsFor:'user actions-comparing'!
doCompareIn:aNavigationState
"compare the codeViews contents in a buffer against its original"
|v selectedMethod selectedClass changedSource originalSource|
changedSource := aNavigationState codeView contentsAsString string.
aNavigationState codeAspect == #method ifTrue:[
selectedMethod := aNavigationState theSingleSelectedMethod.
selectedMethod isNil ifTrue:[
aNavigationState selectedMethods value size > 0 ifTrue:[
self warn:'Oops - multiple methods selected. Cannot compare.'.
] ifFalse:[
self warn:'Oops - method is gone. Cannot compare.'.
].
^ self
].
originalSource := selectedMethod source string.
originalSource isNil ifTrue:[
self warn:'Oops - methods source is gone. Cannot compare source.'.
^ self
].
originalSource string = changedSource string ifTrue:[
self information:'Same text.'.
^ self.
].
self openDiffViewForText:changedSource againstSourceOfMethod:selectedMethod.
"/
"/ v := DiffTextView
"/ openOn:changedSource
"/ label:(resources string:'Code here (to be accepted ?)')
"/ and:originalSource
"/ label:(resources string:'Method''s actual code').
"/ v label:(resources string:'Comparing method versions').
"/ v waitUntilVisible.
^ self
].
aNavigationState codeAspect == #classDefinition ifTrue:[
selectedClass := aNavigationState theSingleSelectedClass.
selectedClass isNil ifTrue:[
aNavigationState selectedClasses value size > 0 ifTrue:[
self warn:'Oops - multiple classes selected. Cannot compare.'.
] ifFalse:[
self warn:'Oops - class is gone. Cannot compare.'.
].
^ self
].
originalSource := self classDefinitionStringFor:selectedClass.
originalSource isNil ifTrue:[
self warn:'Oops - class is gone. Cannot compare source.'.
^ self
].
v := DiffCodeView
openOn:changedSource
label:(resources string:'Changed definition (to be accepted ?)')
and:originalSource
label:(resources string:'Classes actual definition').
v label:(resources string:'Comparing class definitions').
v waitUntilVisible.
^ self
].
^ self.
! !
!NewSystemBrowser methodsFor:'user actions-events'!
keyInCategoryListView:key rawKey:rawKey
"filter keyboard events for some function key.
Return true, if I have eaten the event"
((rawKey == #BackSpace) or:[ key == #CursorLeft ]) ifTrue:[
self
enqueueMessage:#backToLastClass
for:self
arguments:#().
^ true
].
(key == #Rename "rawKey == #Cmdr") ifTrue:[
self
enqueueMessage:#categoryMenuRename
for:self
arguments:#().
^ true
].
(key == #Find or:[ key == #FindNext ]) ifTrue:[
self
enqueueMessage:#searchMenuFindClass
for:self
arguments:#().
^ true
].
^ false
!
keyInClassHierarchyListView:key rawKey:rawKey
"filter keyboard events for some function key.
Return true, if I have eaten the event"
((rawKey == #BackSpace) or:[ key == #CursorLeft ]) ifTrue:[
self
enqueueMessage:#backToLastClass
for:self
arguments:#().
^ true
].
(key == #Rename "rawKey == #Cmdr") ifTrue:[
self
enqueueMessage:#classMenuRename
for:self
arguments:#().
^ true
].
"/ (rawKey == #Delete) ifTrue:[
"/ self
"/ enqueueMessage:#classMenuRemove
"/ for:self
"/ arguments:#().
"/ ^ true
"/ ].
(key == #Find or:[ key == #FindNext ]) ifTrue:[
self
enqueueMessage:#searchMenuFindClass
for:self
arguments:#().
^ true
].
^ false
!
keyInClassListView:key rawKey:rawKey
"filter keyboard events for some function key.
Return true, if I have eaten the event"
((rawKey == #BackSpace) or:[ key == #CursorLeft ]) ifTrue:[
self
enqueueMessage:#backToLastClass
for:self
arguments:#().
^ true
].
(key == #Rename "rawKey == #Cmdr") ifTrue:[
self
enqueueMessage:#classMenuRename
for:self
arguments:#().
^ true
].
(rawKey == #Delete) ifTrue:[
self
enqueueMessage:#classMenuRemove
for:self
arguments:#().
^ true
].
(key == #Find or:[ key == #FindNext ]) ifTrue:[
self
enqueueMessage:#searchMenuFindClass
for:self
arguments:#().
^ true
].
^ false
!
keyInCodeView:key rawKey:rawKey
"filter keyboard events for Find key (unless typed into the codeView).
Return true, if I have eaten the event"
key == #CodeCompletion ifTrue:[
"/ complete the word before/under the cursor.
self
enqueueMessage:#codeCompletion
for:self
arguments:#().
^ true
].
key == #Rename ifTrue:[
self hasLocalVariableSelectedInCodeView ifTrue:[
self
enqueueMessage:#codeMenuRenameTemporary
for:self
arguments:#().
].
^ true
].
^ false
!
keyInMethodCategoryListView:key rawKey:rawKey
"filter keyboard events for some function key.
Return true, if I have eaten the event"
(key == #Rename "rawKey == #Cmdr") ifTrue:[
self
enqueueMessage:#protocolMenuRename
for:self
arguments:#().
^ true
].
"/ cg: no longer; these keys are now ALWAYS forwarded to the codeView
"/ (key == #Find or:[ key == #FindNext ]) ifTrue:[
"/ self
"/ enqueueMessage:#searchMenuFindResponseTo
"/ for:self
"/ arguments:#().
"/ ^ true
"/ ].
(rawKey == #Cmdt) ifTrue:[
self
enqueueMessage:#browseMenuMethodsWithString
for:self
arguments:#().
^ true
].
^ false
!
keyInMethodListView:key rawKey:rawKey
"filter keyboard events for some function key.
Return true, if I have eaten the event"
(rawKey == #CtrlCursorUp) ifTrue:[
self
enqueueMessage:#selectorMenuPushUpMethod
for:self
arguments:#().
^ true
].
(rawKey == #Delete) ifTrue:[
self
enqueueMessage:#selectorMenuRemove
for:self
arguments:#().
^ true
].
(key == #Rename "rawKey == #Cmdr") ifTrue:[
self
enqueueMessage:#selectorMenuRename
for:self
arguments:#().
^ true
].
(rawKey == #Cmdi) ifTrue:[
self
enqueueMessage:#browseImplementorsOf
for:self
arguments:#().
^ true
].
(rawKey == #Cmdt) ifTrue:[
self
enqueueMessage:#browseMenuMethodsWithString
for:self
arguments:#().
^ true
].
"/ cg: no longer; these keys are now ALWAYS forwarded to the codeView
"/ (key == #Find or:[ key == #FindNext ]) ifTrue:[
"/ self
"/ enqueueMessage:#searchMenuFindResponseTo
"/ for:self
"/ arguments:#().
"/ ^ true
"/ ].
^ false
!
keyInProjectListView:key rawKey:rawKey
"filter keyboard events for some function key.
Return true, if I have eaten the event"
((rawKey == #BackSpace) or:[ key == #CursorLeft ]) ifTrue:[
self
enqueueMessage:#backToLastClass
for:self
arguments:#().
^ true
].
(key == #Find or:[ key == #FindNext ]) ifTrue:[
self
enqueueMessage:#searchMenuFindClass
for:self
arguments:#().
^ true
].
^ false
!
keyInVariableListView:key rawKey:rawKey
"filter keyboard events for some function key.
Return true, if I have eaten the event"
|variablesToRemove|
(rawKey == #Delete) ifTrue:[
variablesToRemove := self selectedVariables value.
variablesToRemove size > 0 ifTrue:[
self
enqueueMessage:#variablesRemoveWithConfirmation
for:self
arguments:#().
].
^ true
].
(key == #Rename "rawKey == #Cmdr") ifTrue:[
self
enqueueMessage:#variablesMenuRename
for:self
arguments:#().
^ true
].
^ false
!
processEvent:anEvent
"filter keyboard events for Find key (unless typed into the codeView).
Return true, if I have eaten the event"
|codeView evView key rawKey sensor|
codeView := self codeView.
evView := anEvent targetView.
evView notNil ifTrue:[
anEvent isKeyPressEvent ifTrue:[
key := anEvent key.
rawKey := anEvent rawKey.
(evView isSameOrComponentOf:codeView) ifTrue:[
^ self keyInCodeView:key rawKey:rawKey
].
"/ cg: these keys are now ALWAYS forwarded to the codeView
(false "key == #Find" or:[ key == #FindNext or:[ key == #FindPrev ]]) ifTrue:[
anEvent dispatchTo:self codeView.
^ true
].
"/ key == #Find ifTrue:[
"/ self
"/ enqueueMessage:#searchMenuFindClass
"/ for:self
"/ arguments:#().
"/ ^ true
"/ ].
"/ key == #Cmdt ifTrue:[
"/ self
"/ enqueueMessage:#browseMenuMethodsWithString
"/ for:self
"/ arguments:#().
"/ ^ true
"/ ].
(self view:evView belongsToSubApplication:self categoryListApp) ifTrue:[
^ self keyInCategoryListView:key rawKey:rawKey
].
(self view:evView belongsToSubApplication:self projectListApp) ifTrue:[
^ self keyInProjectListView:key rawKey:rawKey
].
(self view:evView belongsToSubApplication:self classListApp) ifTrue:[
^ self keyInClassListView:key rawKey:rawKey
].
(self view:evView belongsToSubApplication:self classHierarchyListApp) ifTrue:[
^ self keyInClassHierarchyListView:key rawKey:rawKey
].
(self view:evView belongsToSubApplication:self methodCategoryListApp) ifTrue:[
^ self keyInMethodCategoryListView:key rawKey:rawKey
].
(self view:evView belongsToSubApplication:self methodListApp) ifTrue:[
^ self keyInMethodListView:key rawKey:rawKey
].
(self view:evView belongsToSubApplication:navigationState variableListApplication) ifTrue:[
^ self keyInVariableListView:key rawKey:rawKey
].
].
anEvent isButtonReleaseEvent ifTrue:[
anEvent delegatedFrom isNil ifTrue:[
evView == codeView ifTrue:[
self codeInfoVisible value ifTrue:[
self doImmediateExplaining value ifTrue:[
anEvent delegatedFrom:self.
sensor := evView sensor.
sensor pushEvent:anEvent. "/ must be first in queue
"/ (for the buttonRelease to be processed)
self
enqueueMessage:#delayedExplainSelection
for:self
arguments:#() .
^ true "/ release event has been added already
].
].
]
]
].
].
anEvent isButtonMultiPressEvent ifTrue:[
anEvent view name = 'CursorLineLabel' ifTrue:[
self codeView gotoLine
].
].
^ false
"Modified: / 10.12.2001 / 21:02:48 / cg"
! !
!NewSystemBrowser class methodsFor:'documentation'!
version
^ '$Header: /cvs/stx/stx/libtool/Attic/NewSystemBrowser.st,v 1.1508 2011-01-31 17:30:35 cg Exp $'
!
version_CVS
^ '$Header: /cvs/stx/stx/libtool/Attic/NewSystemBrowser.st,v 1.1508 2011-01-31 17:30:35 cg Exp $'
! !
NewSystemBrowser initialize!