"
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 DefaultIsNewBuffer DoubleClickIsOpenBrowser
ShowMethodTemplateWhenProtocolIsSelected
DefaultShowMethodTemplate DefaultShowMethodInheritance
DefaultEmphasizeUnloadedClasses DefaultImmediateSyntaxColoring
DefaultImmediateExplaining DefaultSyntaxColoring
DefaultToolBarVisible DefaultCodeInfoVisible
DefaultShortNameInTabs DefaultHideUnloadedClasses
DefaultMarkApplications DefaultAutoFormat
DefaultShowMethodComplexity DefaultShowMethodTypeIcon
DefaultShowSpecialResourceEditors SharedMethodCategoryCache
LastMethodProcessingBlockString PreviousBuildDirectory
LastLoadedPackage'
poolDictionaries:''
category:'Interface-Browsers-New'
!
NewSystemBrowser comment:'declared from: ..\..\..\stx\libtool\abbrev.stc'
!
!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 := [self 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 loadPackageWithId:'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'
#modeLabel
'The editing mode (Insert/Overwrite). PopUpMenu to change.'
#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'
#recentlyVisited
'Recently Visited'
#recentlyVisitedMethods
'Visited Methods'
#runTestCases
'Run Selected TestCase(s)'
#runTestCasesWithDebug
'Debug Selected TestCase(s)'
#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'
#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: / 06-08-2006 / 10:24:23 / cg"
!
helpSpec
"This resource specification was automatically generated
by the UIHelpTool of ST/X."
"Do not manually edit this!! If it is corrupted,
the UIHelpTool may not be able to read the specification."
"
UIHelpTool openOnClass:Tools::NewSystemBrowser
"
<resource: #help>
^ super helpSpec addPairsFrom:#(
#formatCode
''
#removeBreakPoint
''
#showClassHierarchy
''
)
! !
!NewSystemBrowser class methodsFor:'image specs'!
defaultIcon
"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 defaultIcon inspect
ImageEditor openOnClass:self andSelector:#defaultIcon
Icon flushCachedIcons
"
<resource: #image>
^Icon
constantNamed:#'Tools::NewSystemBrowser class defaultIcon'
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:#'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 hideToolbar8x24Icon
"Created: / 10.12.2001 / 20:45:12 / cg"
"Modified: / 10.12.2001 / 20:59:19 / 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:#'SystemBrowser 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:#'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:#'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: #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: #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: #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: #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)
)
)
)
)
!
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 461 321)
icon: defaultIcon
)
component:
(SpecCollection
collection: (
(NoteBookViewSpec
name: 'EditorNoteBook'
layout: (LayoutFrame 0 0 0 0 0 1 -25 1)
level: 0
model: selectedEditorNoteBookTabIndexHolder
menu: editorNoteBookListHolder
direction: right
useIndex: true
canvas: editorNoteBookCanvasHolder
keepCanvasAlive: true
postBuildCallback: postBuildEditorNoteBook:
)
(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'
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: #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: / 1.3.2000 / 20:44:21 / 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: #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: #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)
)
)
)
)
!
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: #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: / 1.3.2000 / 20:44:21 / 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: #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)
)
)
)
)
!
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 30 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
acceptOnReturn: true
acceptOnPointerLeave: false
acceptIfUnchanged: true
comboList: visitedClassesHistory
extent: (Point 244 24)
)
)
)
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: #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: #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: #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: #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)
)
)
)
)
!
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: '-'
)
(MenuItem
label: 'All Subclasses of...'
itemValue: browseMenuAllSubclassesOf
translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
label: 'All Applications'
itemValue: browseMenuApplicationClasses
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 Repository Container'
itemValue: browseMenuClassesWithoutRepositoryContainer
translateLabel: true
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: '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: 'In ChangeSet'
itemValue: browseMenuMethodsInCurrentChangeSet
translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
label: 'Overwritten Methods'
itemValue: browseMenuOverwrittenMethods:
translateLabel: true
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: '-'
)
(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 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: 'With String-Literal Matching...'
itemValue: browseMenuMethodsWithStringLiteral
translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
label: 'For which...'
itemValue: browseMenuMethodsWithUserFilter
translateLabel: true
showBusyCursorWhilePerforming: true
)
)
nil
nil
)
)
)
nil
nil
)
!
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: 'Repository'
translateLabel: true
submenu:
(Menu
(
(MenuItem
enabled: hasCategorySelectedAndSourceCodeManagerHolder
label: 'CheckIn all...'
itemValue: categoryMenuCheckInEach
translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasCategorySelectedAndSourceCodeManagerHolder
label: 'CheckOut Newest all (Update)...'
itemValue: categoryMenuCheckOutNewest
translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasCategorySelectedAndSourceCodeManagerHolder
label: 'CheckOut all (Load old Revisions)...'
itemValue: categoryMenuCheckOut
translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasSourceCodeManagerHolder
label: 'History...'
itemValue: categoryMenuRepositoryHistory
translateLabel: true
showBusyCursorWhilePerforming: true
)
)
nil
nil
)
)
)
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: #Cmdr
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
)
)
nil
nil
)
!
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:NewSystemBrowser andSelector:#checkMenu
(Menu new fromLiteralArrayEncoding:(NewSystemBrowser checkMenu)) startUp
"
<resource: #menu>
^
#(#Menu
#(
#(#MenuItem
#label: 'All'
#translateLabel: true
#value: #classMenuCheckAll
)
#(#MenuItem
#label: 'Errors'
#translateLabel: true
#value: #classMenuCheckErrors
)
#(#MenuItem
#label: 'Possible Errors'
#translateLabel: true
#value: #classMenuCheckWarnings
)
#(#MenuItem
#label: 'Style'
#translateLabel: true
#value: #classMenuCheckStyle
)
#(#MenuItem
#label: '-'
)
#(#MenuItem
#label: 'Individual checks...'
#translateLabel: true
#value: #classMenuCheckIndividual
)
)
nil
nil
)
"Modified: / 18.8.2000 / 22:25:21 / cg"
!
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
)
!
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
label: '-'
)
(MenuItem
label: 'Project Definitions'
itemValue: classMenuGenerateProjectDefinitions
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: hasApplicationOrHTTPServiceClassSelectedHolder
label: 'Application Code'
itemValue: classMenuGenerateApplicationCode
translateLabel: true
isVisible: hasNonProjectDefinitionSelectedHolder
)
(MenuItem
enabled: hasEnumTypeClassSelectedHolder
label: 'EnumType Code'
itemValue: classMenuGenerateEnumTypeCode
translateLabel: true
isVisible: hasNonProjectDefinitionSelectedHolder
)
(MenuItem
enabled: hasLoadedClassSelectedHolder
label: 'Required Protocol'
itemValue: classMenuGenerateRequiredProtocol
translateLabel: true
isVisible: hasNonProjectDefinitionSelectedHolder
)
)
nil
nil
)
"Modified: / 10-08-2006 / 16:31:28 / cg"
!
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: '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: hasClassSelectedHolder
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
)
)
nil
nil
)
)
(MenuItem
enabled: hasClassSelectedHolder
label: 'Repository'
translateLabel: true
submenuChannel: classRepositoryMenu
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: oomPackageLoaded
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
label: 'New Common Superclass with Children (Convert to Siblings)...'
itemValue: classMenuChildrenToSiblings
nameKey: convertToSibling
translateLabel: true
enabled: canConvertToSiblingsHolder
)
(MenuItem
label: 'New Common Superclass (Insert Superclass)...'
itemValue: classMenuInsertNewSuperclass
nameKey: insertSuperclass
translateLabel: true
enabled: canInsertSuperclassHolder
)
)
nil
nil
)
)
(MenuItem
enabled: hasSingleClassSelectedHolder
label: 'Rename...'
itemValue: classMenuRename
translateLabel: true
shortcutKey: #'Cmdr'
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: hasSingleClassSelectedHolder
label: 'With Class...'
itemValue: classMenuCompareWithClass
translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasExactlyTwoClassesSelectedHolder
label: 'With each other'
itemValue: classMenuCompareTwoSelectedClasses
translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasSingleClassSelectedAndSourceCodeManagerHolder
label: 'With Repository...'
itemValue: classMenuCompareWithRepository
translateLabel: true
showBusyCursorWhilePerforming: true
)
(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
)
)
nil
nil
)
)
(MenuItem
label: 'Generate'
translateLabel: true
submenuChannel: classGenerateMenu
keepLinkedMenu: true
)
(MenuItem
enabled: hasClassSelectedHolder
label: 'Check'
translateLabel: true
submenuChannel: checkMenu
)
(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: / 04-07-2006 / 18:48:23 / fm"
"Modified: / 11-08-2006 / 14:35:56 / cg"
!
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:#classMenu
(Menu new fromLiteralArrayEncoding:(Tools::NewSystemBrowser classMenu)) startUp
"
<resource: #menu>
^
#(Menu
(
(MenuItem
label: 'Class'
itemValue: classMenuNewClass
translateLabel: true
)
(MenuItem
enabled: hasSingleClassSelectedHolder
label: 'Subclass'
itemValue: classMenuNewSubclass
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: 'WebApplication'
itemValue: classMenuNewWebApplication
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
)
(MenuItem
label: '-'
isVisible: isAnyOtherMetaclassPresent
)
(MenuItem
label: 'JavaScript Class'
itemValue: classMenuNewJavaScriptClass
translateLabel: true
isVisible: isJavaScriptMetaclassPresent
)
(MenuItem
label: 'PLSQL ObjectType'
itemValue: classMenuNewPLSQLObjectType
translateLabel: true
isVisible: isPlsqlMetaclassPresent
)
(MenuItem
label: 'Haskell Module'
itemValue: classMenuNewHaskellModule
translateLabel: true
isVisible: isHaskellModulePresent
)
)
nil
nil
)
"Created: / 11-08-2006 / 14:35:06 / cg"
!
classRepositoryMenu
"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:#classRepositoryMenu
(Menu new fromLiteralArrayEncoding:(Tools::NewSystemBrowser classRepositoryMenu)) startUp
"
<resource: #menu>
^
#(Menu
(
(MenuItem
enabled: hasClassSelectedHolder
label: 'CheckIn...'
itemValue: classMenuCheckIn
translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasClassWithExtensionsSelectedHolder
label: 'CheckIn Extensions For'
translateLabel: true
submenuChannel: browseClassExtensionsMenu
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: changeSetContainsChangedClasses
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: hasNonPrivateClassSelected
label: 'CheckOut Newest (Update)...'
itemValue: classMenuCheckOutNewest
translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
label: 'CheckOut (Load a Class)...'
itemValue: classMenuCheckOutNewest
translateLabel: true
isVisible: false
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasNonPrivateClassSelectedHolder
label: 'CheckOut (Load old Revision)...'
itemValue: classMenuCheckOut
translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasNonPrivateClassSelectedHolder
label: 'Revision Log'
itemValue: classMenuRevisionLog
translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasSingleClassSelectedAndSourceCodeManagerHolder
label: 'Compare with Repository...'
itemValue: classMenuCompareWithRepository
translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasClassSelectedAndSourceCodeManagerHolder
label: 'Compare with Newest in Repository...'
itemValue: classMenuCompareAgainstNewestInRepository
translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasSingleClassSelectedAndSourceCodeManagerHolder
label: 'Compare with Original in Repository...'
itemValue: classMenuCompareAgainstOriginalInRepository
translateLabel: true
showBusyCursorWhilePerforming: 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: 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 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
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
label: '-'
)
(MenuItem
enabled: hasClassSelectedHolder
label: 'Compile Lazy Methods'
itemValue: classMenuCompileLazyMethods
translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasClassSelectedHolder
label: 'Recompile all Methods'
itemValue: classMenuRecompile
translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
isVisible: instrumentingCompilerExists
enabled: hasClassSelectedHolder
label: 'Recompile all Methods with Instrumentation'
itemValue: classMenuRecompileInstrumented
translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasClassSelectedHolder
label: 'Initialize Class(es)'
itemValue: classMenuInitialize
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
)
"Modified: / 17-08-2006 / 00:46:31 / cg"
!
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: 'Rename 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
)
)
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: '-'
)
(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
)
(MenuItem
label: 'Enable Embedded Resource Editors'
translateLabel: true
indication: showSpecialResourceEditors
)
(MenuItem
label: 'Load Refactoring and Undo Features'
itemValue: doLoadRefactoringSupport
translateLabel: true
isVisible: canLoadRefactoringSupport
showBusyCursorWhilePerforming: true
)
)
nil
nil
)
!
debugMenu
"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:#debugMenu
(Menu new fromLiteralArrayEncoding:(NewSystemBrowser debugMenu)) 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...'
#translateLabel: true
#value: #debugMenuBreakPointIn
#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
)
)
nil
nil
)
"Modified: / 05-08-2006 / 17:31:54 / cg"
!
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
)
!
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:NewSystemBrowser andSelector:#mainMenu
(Menu new fromLiteralArrayEncoding:(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: debugMenu
keepLinkedMenu: true
)
(MenuItem
label: 'Operations'
translateLabel: true
submenuChannel: operationsMenu
)
(MenuItem
label: '&Help'
translateLabel: true
startGroup: right
submenu:
(Menu
(
(MenuItem
label: '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
)
!
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
)
!
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:NewSystemBrowser andSelector:#nameSpaceMenu
(Menu new fromLiteralArrayEncoding:(NewSystemBrowser nameSpaceMenu)) startUp
"
<resource: #menu>
^
#(#Menu
#(
#(#MenuItem
#label: 'Repository'
#translateLabel: true
#enabled: #hasNameSpaceSelectedAndSourceCodeManagerHolder
#submenu:
#(#Menu
#(
#(#MenuItem
#label: 'CheckIn all...'
#translateLabel: true
#value: #nameSpaceMenuCheckInAll
#enabled: #hasNameSpaceSelectedAndSourceCodeManagerHolder
#showBusyCursorWhilePerforming: true
)
#(#MenuItem
#label: '-'
)
#(#MenuItem
#label: 'CheckOut Newest all (Update)...'
#translateLabel: true
#value: #nameSpaceMenuCheckOutNewest
#enabled: #hasNameSpaceSelectedAndSourceCodeManagerHolder
#showBusyCursorWhilePerforming: true
)
#(#MenuItem
#label: 'CheckOut all (Load old Revision)...'
#translateLabel: true
#value: #nameSpaceMenuCheckOut
#enabled: #hasNameSpaceSelectedAndSourceCodeManagerHolder
#showBusyCursorWhilePerforming: true
)
)
nil
nil
)
)
#(#MenuItem
#label: '-'
)
#(#MenuItem
#label: 'Spawn'
#translateLabel: true
#enabled: #hasNameSpaceSelectedHolder
#submenu:
#(#Menu
#(
#(#MenuItem
#label: 'Buffer'
#translateLabel: true
#value: #nameSpaceMenuSpawnBuffer
#enabled: #hasNameSpaceSelectedHolder
)
#(#MenuItem
#label: '-'
)
#(#MenuItem
#label: 'Browser'
#translateLabel: true
#value: #nameSpaceMenuSpawn
#enabled: #hasNameSpaceSelectedHolder
)
)
nil
nil
)
)
#(#MenuItem
#label: 'Find'
#translateLabel: true
#submenuChannel: #searchMenu
)
#(#MenuItem
#label: '-'
)
#(#MenuItem
#label: 'New...'
#translateLabel: true
#value: #nameSpaceMenuNew
)
#(#MenuItem
#label: '-'
)
#(#MenuItem
#label: 'Rename'
#translateLabel: true
#value: #nameSpaceMenuRename
#enabled: #canRenameNameSpaceHolder
)
#(#MenuItem
#label: 'Remove'
#translateLabel: true
#value: #nameSpaceMenuRemove
#enabled: #canRemoveNameSpaceHolder
#showBusyCursorWhilePerforming: true
)
#(#MenuItem
#label: '-'
)
#(#MenuItem
#label: 'Update'
#translateLabel: true
#showBusyCursorWhilePerforming: true
#value: #nameSpaceMenuUpdate
)
)
nil
nil
)
"Modified: / 24.2.2000 / 22:29:17 / 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
)
)
nil
nil
)
)
(MenuItem
enabled: hasSourceCodeManagerHolder
label: 'Repository'
translateLabel: true
submenu:
(Menu
(
(MenuItem
enabled: hasProjectSelectedAndSourceCodeManagerHolder
label: 'CheckIn...'
itemValue: projectMenuCheckInAll
translateLabel: true
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: 'CheckOut Newest (Update)...'
itemValue: projectMenuCheckOutNewest
translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasProjectSelectedAndSourceCodeManagerHolder
label: 'CheckOut (Load old Revision)...'
itemValue: projectMenuCheckOut
translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasProjectSelectedAndSourceCodeManagerHolder
label: 'CheckOut Extensions Only...'
itemValue: projectMenuCheckOutExtensions
translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasProjectSelectedAndSourceCodeManagerHolder
label: 'History...'
itemValue: projectMenuRepositoryHistory
translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasProjectSelectedAndSourceCodeManagerHolder
label: 'Consistency Check...'
itemValue: projectMenuCheckRepositoryConsistency
translateLabel: true
)
(MenuItem
label: '-'
)
(MenuItem
label: 'Import...'
itemValue: projectMenuImport
translateLabel: true
isVisible: false
showBusyCursorWhilePerforming: true
)
(MenuItem
label: 'Import and Load Classes...'
itemValue: projectMenuImportAndLoadClasses
translateLabel: true
showBusyCursorWhilePerforming: 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
)
)
(MenuItem
enabled: hasProjectSelectedHolder
label: 'Build'
translateLabel: true
submenu:
(Menu
(
(MenuItem
label: 'Generate Project Definition Methods'
itemValue: projectMenuGenerateProjectDefinitions
translateLabel: true
enabled: hasProjectSelectedHolder
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasSingleProjectSelected
label: 'Binaries'
itemValue: projectMenuBuild
translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
label: 'Show Generated'
translateLabel: true
submenu:
(Menu
(
(MenuItem
enabled: hasSingleProjectSelected
label: 'Make.spec'
itemValue: projectMenuShowGeneratedBuildFile:
translateLabel: true
argument: 'Make.spec'
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasSingleProjectSelected
label: 'Make.proto'
itemValue: projectMenuShowGeneratedBuildFile:
translateLabel: true
argument: 'Make.proto'
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasSingleProjectSelected
label: 'nt.mak'
itemValue: projectMenuShowGeneratedBuildFile:
translateLabel: true
argument: 'nt.mak'
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasSingleProjectSelected
label: 'bc.def'
itemValue: projectMenuShowGeneratedBuildFile:
translateLabel: true
argument: 'bc.def'
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasSingleProjectSelected
label: 'libInit.cc'
itemValue: projectMenuShowGeneratedBuildFile:
translateLabel: true
argument: 'libInit.cc'
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasSingleProjectSelected
label: 'abbrev.stc'
itemValue: projectMenuShowGeneratedBuildFile:
translateLabel: true
argument: 'abbrev.stc'
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasSingleProjectSelected
label: 'modules.stx'
itemValue: projectMenuShowGeneratedBuildFile:
translateLabel: true
argument: 'modules.stx'
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasSingleProjectSelected
label: 'lib.rc'
itemValue: projectMenuShowGeneratedBuildFile:
translateLabel: true
argument: 'lib.rc'
showBusyCursorWhilePerforming: true
)
)
nil
nil
)
)
(MenuItem
enabled: hasProjectSelectedHolder
label: 'LoadAll File'
itemValue: projectMenuGenerateLoadAllFile
translateLabel: true
isVisible: false
showBusyCursorWhilePerforming: true
)
)
nil
nil
)
)
(MenuItem
label: '-'
)
(MenuItem
label: 'Documentation'
translateLabel: true
submenu:
(Menu
(
(MenuItem
enabled: hasProjectSelectedHolder
label: 'Generate Project Documentation'
itemValue: projectMenuDocumentation
translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
label: '-'
)
(MenuItem
enabled: oomPackageLoaded
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
label: '-'
)
(MenuItem
enabled: hasProjectSelectedHolder
label: 'Browser'
itemValue: projectMenuSpawn
translateLabel: true
)
(MenuItem
enabled: hasProjectSelectedHolder
label: 'Browser on Extensions'
itemValue: projectMenuSpawnExtensionsBrowser
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
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasProjectSelectedHolder
label: 'Rename...'
itemValue: projectMenuRename
translateLabel: true
)
(MenuItem
enabled: hasProjectSelectedHolder
label: 'Remove...'
itemValue: projectMenuRemove
translateLabel: true
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasSingleProjectSelectedHolder
label: 'Properties...'
itemValue: projectMenuProperties
translateLabel: true
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasSingleProjectSelectedHolder
label: 'Make Current Project'
itemValue: projectMenuMakeCurrentProject
translateLabel: true
isVisible: false
)
(MenuItem
label: '-'
isVisible: false
)
(MenuItem
label: 'Update'
itemValue: projectMenuUpdate
translateLabel: true
)
)
nil
nil
)
"Modified: / 05-09-2006 / 16:19:25 / cg"
!
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:NewSystemBrowser andSelector:#protocolMenu
(Menu new fromLiteralArrayEncoding:(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: #'Cmdr'
ignoreShortcutKeys: true
)
(MenuItem
enabled: hasProtocolSelectedHolder
label: 'Remove...'
itemValue: protocolMenuRemove
translateLabel: true
)
(MenuItem
label: '-'
isVisible: false
)
(MenuItem
label: 'Update'
itemValue: protocolMenuUpdate
translateLabel: true
isVisible: false
)
)
nil
nil
)
!
refactoringMenu
"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:#refactoringMenu
(Menu new fromLiteralArrayEncoding:(Tools::NewSystemBrowser refactoringMenu)) startUp
"
<resource: #menu>
^
#(Menu
(
(MenuItem
enabled: hasTemporaryVariableSelectedInCodeViewHolder
label: 'Rename Local Variable...'
itemValue: codeMenuRenameTemporary
translateLabel: true
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
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
)
)
nil
nil
)
)
(MenuItem
label: 'CopyMoveRemoveSlice'
translateLabel: true
submenuChannel: selectorMenuCopyMoveRemoveSlice
isMenuSlice: true
)
(MenuItem
label: '-'
)
(MenuItem
label: 'CompareGenerateDebugSlice'
translateLabel: true
submenuChannel: selectorMenuCompareGenerateDebugSlice
isMenuSlice: 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 Repository...'
itemValue: selectorMenuCompareAgainstNewestInRepository
translateLabel: true
)
)
nil
nil
)
)
(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
"/ enabled: singleSelectedMethodIsSubclassResponsibility
label: 'Templates in Subclasses'
itemValue: selectorMenuGenerateTemplateInSubclasses
translateLabel: true
)
(MenuItem
"/ enabled: singleSelectedMethodIsSubclassResponsibility
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
enabled: hasMethodSelectedHolder
label: 'Debug'
translateLabel: true
submenuChannel: debugMenu
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
)
)
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
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')
)
)
nil
nil
)
)
(MenuItem
enabled: hasMethodSelectedAndCanUseRefactoringSupportHolder
label: 'Rename...'
itemValue: selectorMenuRename
translateLabel: true
shortcutKey: #'Cmdr'
ignoreShortcutKeys: true
)
(MenuItem
enabled: hasMethodSelectedAndCanUseRefactoringSupportHolder
label: 'Safe Remove...'
itemValue: selectorMenuSaveRemove
translateLabel: true
)
(MenuItem
enabled: hasMethodSelectedHolder
label: 'Remove...'
itemValue: selectorMenuRemove
translateLabel: true
)
)
nil
nil
)
!
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: 'Repository'
translateLabel: true
submenu:
(Menu
(
(MenuItem
enabled: hasMethodSelected
label: 'CheckIn Class(es)...'
itemValue: methodListMenuCheckInClass
translateLabel: true
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
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasSingleMethodSelected
label: 'Browse Repository Versions...'
itemValue: selectorMenuBrowseRepositoryVersions
translateLabel: true
)
)
nil
nil
)
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasMethodSelectedHolder
label: 'PrintOut'
itemValue: selectorMenuPrintOut
translateLabel: true
showBusyCursorWhilePerforming: true
)
)
nil
nil
)
"Modified: / 22-08-2006 / 16:37:51 / cg"
!
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: 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: selectorMenuSpawnProjectExtensions
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"
!
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: '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: hasNonMetaSelectedAndClassSelectedHolder
label: 'Instance Variables'
translateLabel: true
submenu:
(Menu
(
(MenuItem
enabled: hasClassSelectedHolder
label: 'References...'
itemValue: variablesMenuBrowseInstVarRefs
translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasClassSelectedHolder
label: 'Readers...'
itemValue: variablesMenuBrowseInstVarReads
translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasClassSelectedHolder
label: 'Writers...'
itemValue: variablesMenuBrowseInstVarMods
translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
label: '-'
)
(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: 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 Inst Variables'
translateLabel: true
submenu:
(Menu
(
(MenuItem
enabled: hasClassSelectedHolder
label: 'References...'
itemValue: variablesMenuBrowseClassInstVarRefs
translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasClassSelectedHolder
label: 'Readers...'
itemValue: variablesMenuBrowseClassInstVarReads
translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasClassSelectedHolder
label: 'Writers...'
itemValue: variablesMenuBrowseClassInstVarMods
translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
label: '-'
)
(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
)
)
nil
nil
)
)
(MenuItem
enabled: hasClassSelectedHolder
label: 'Class Variables'
translateLabel: true
submenu:
(Menu
(
(MenuItem
enabled: hasClassSelectedHolder
label: 'References...'
itemValue: variablesMenuBrowseClassVarRefs
translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasClassSelectedHolder
label: 'Readers...'
itemValue: variablesMenuBrowseClassVarReads
translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasClassSelectedHolder
label: 'Writers...'
itemValue: variablesMenuBrowseClassVarMods
translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
label: '-'
)
(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: 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
enabled: hasSingleClassSelectedAndCanUseRefactoringSupportHolder
label: 'Add...'
itemValue: variablesMenuAdd
translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasSingleClassSelectedAndCanUseRefactoringSupportHolder
label: 'Add ValueHolder...'
itemValue: variablesMenuAddValueHolder
translateLabel: true
showBusyCursorWhilePerforming: true
)
(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: Cmdr
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
indication: showClassVarsInVariableList
)
(MenuItem
label: 'Sort by Name'
translateLabel: true
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
)
)
nil
nil
)
)
(MenuItem
label: 'Debug'
translateLabel: true
submenu:
(Menu
(
(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
hideMenuOnActivated: false
choice: organizerModeForMenu
choiceValue: category
)
(MenuItem
enabled: hasSingleClassSelected
label: 'Class Hierarchy'
translateLabel: true
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
hideMenuOnActivated: false
choice: organizerModeForMenu
choiceValue: hierarchy
)
(MenuItem
label: 'Namespace'
translateLabel: true
hideMenuOnActivated: false
choice: organizerModeForMenu
choiceValue: namespace
)
(MenuItem
label: 'Project'
translateLabel: true
hideMenuOnActivated: false
choice: organizerModeForMenu
choiceValue: project
)
(MenuItem
label: '-'
)
(MenuItem
label: 'Toolbar'
translateLabel: true
hideMenuOnActivated: false
indication: toolBarVisibleHolder
)
(MenuItem
label: 'Info'
translateLabel: true
hideMenuOnActivated: false
indication: codeInfoVisible
)
(MenuItem
label: '-'
)
(MenuItem
label: 'Hide Unloaded Classes'
translateLabel: true
hideMenuOnActivated: false
indication: hideUnloadedClasses
)
(MenuItem
label: '-'
)
(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: 'Indicators'
translateLabel: true
submenu:
(Menu
(
(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
)
(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
label: 'Show Method-Complexity'
translateLabel: true
hideMenuOnActivated: false
indication: showMethodComplexity
enabled: oomPackageLoaded
)
)
nil
nil
)
)
)
nil
nil
)
!
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:NewSystemBrowser andSelector:#viewMenuForChainBrowser
(Menu new fromLiteralArrayEncoding:(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: 'Hide Unloaded Classes'
#translateLabel: true
#hideMenuOnActivated: false
#indication: #hideUnloadedClasses
#isVisible: false
)
#(#MenuItem
#label: 'Short Class Names in Tabs'
#translateLabel: true
#hideMenuOnActivated: false
#indication: #shortNamesInTabs
#isVisible: false
)
#(#MenuItem
#label: 'Emphasize Unloaded Classes'
#translateLabel: true
#hideMenuOnActivated: false
#enabled: #showUnloadedClasses
#indication: #emphasizeUnloadedClasses
#isVisible: false
)
#(#MenuItem
#label: 'Show Class-Packages'
#translateLabel: true
#hideMenuOnActivated: false
#indication: #showClassPackages
)
#(#MenuItem
#label: 'Show Inheritance Indicator'
#translateLabel: true
#hideMenuOnActivated: false
#indication: #showMethodInheritance
#isVisible: true "false"
)
(MenuItem
label: 'Show Type Indicator'
translateLabel: true
hideMenuOnActivated: false
indication: showMethodTypeIcon
)
#(#MenuItem
#label: 'Show Complexity'
#translateLabel: true
#hideMenuOnActivated: false
#indication: #showMethodComplexity
#isVisible: true "false"
)
#(#MenuItem
#label: '-'
)
#(#MenuItem
#label: 'Toolbar'
#translateLabel: true
#hideMenuOnActivated: false
#indication: #toolBarVisibleHolder
)
#(#MenuItem
#label: 'Info'
#translateLabel: true
#hideMenuOnActivated: false
#indication: #codeInfoVisible
#isVisible: true
)
)
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:NewSystemBrowser andSelector:#viewMenuForMethodList
(Menu new fromLiteralArrayEncoding:(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: '-'
)
#(#MenuItem
#label: 'Hide Unloaded Classes'
#translateLabel: true
#hideMenuOnActivated: false
#indication: #hideUnloadedClasses
#isVisible: false
)
#(#MenuItem
#label: 'Short Class Names in Tabs'
#translateLabel: true
#hideMenuOnActivated: false
#indication: #shortNamesInTabs
#isVisible: false
)
#(#MenuItem
#label: 'Emphasize Unloaded Classes'
#translateLabel: true
#hideMenuOnActivated: false
#enabled: #showUnloadedClasses
#indication: #emphasizeUnloadedClasses
#isVisible: false
)
#(#MenuItem
#label: 'Show Class-Packages'
#translateLabel: true
#hideMenuOnActivated: false
#indication: #showClassPackages
)
#(#MenuItem
#label: 'Show Inheritance Indicator'
#translateLabel: true
#hideMenuOnActivated: false
#indication: #showMethodInheritance
#isVisible: true "false"
)
(MenuItem
label: 'Show Type Indicator'
translateLabel: true
hideMenuOnActivated: false
indication: showMethodTypeIcon
)
#(#MenuItem
#label: 'Show Complexity'
#translateLabel: true
#hideMenuOnActivated: false
#indication: #showMethodComplexity
#isVisible: true "false"
)
#(#MenuItem
#label: '-'
)
#(#MenuItem
#label: 'Toolbar'
#translateLabel: true
#hideMenuOnActivated: false
#indication: #toolBarVisibleHolder
)
#(#MenuItem
#label: 'Info'
#translateLabel: true
#hideMenuOnActivated: false
#indication: #codeInfoVisible
#isVisible: true
)
)
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: 'Check Out Newest (Update)...'
#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
)
!
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: 'Check Out...'
#translateLabel: true
#value: #classMenu4CheckOut
#showBusyCursorWhilePerforming: true
)
#(#MenuItem
#label: '-'
)
#(#MenuItem
#label: 'Remove Container'
#translateLabel: true
#value: #classMenu4RemoveContainer
)
)
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"
!
editModeMenu
"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:#editModeMenu
(Menu new fromLiteralArrayEncoding:(Tools::NewSystemBrowser editModeMenu)) startUp
"
<resource: #menu>
^
#(Menu
(
(MenuItem
label: 'Insert'
itemValue: editModeInsert
translateLabel: true
)
(MenuItem
label: 'Overwrite'
itemValue: editModeOverwrite
translateLabel: true
)
(MenuItem
label: 'Insert Selected'
itemValue: editModeInsertAndSelect
translateLabel: true
)
)
nil
nil
)
!
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"
<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: recentlyVisited
label: 'Recently Visited'
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
isVisible: false
labelImage: (ResourceRetriever ToolbarIconLibrary redoIcon)
showBusyCursorWhilePerforming: true
)
(MenuItem
label: '-'
isVisible: hasAnyTestCaseSelectedHolder
)
(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
)
"Modified: / 05-08-2006 / 20:35:02 / cg"
! !
!NewSystemBrowser class methodsFor:'startup'!
browseClass:aClass
"launch a single class browser."
^ self basicNew spawnClassBrowserFor:(Array with:aClass) in:#newBrowser.
"
self browseClass:Array
"
!
browseClasses:aCollectionOfClasses
"launch a multi class browser."
^ self basicNew spawnClassBrowserFor:aCollectionOfClasses in:#newBrowser.
"
self browseClasses:(Array with:Array with:Number)
"
!
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
"
! !
!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
|holder|
(holder := builder bindingAt:#doEnableRefactoringSupport) isNil ifTrue:[
holder := self canUseRefactoringSupport asValue.
builder aspectAt:#doEnableRefactoringSupport put:holder.
].
^ holder
!
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 debugMenu
] ifFalse:[
m := self class methodListMenu
].
m := m decodeAsLiteralArray.
m findGuiResourcesIn:self.
]
!
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 debugMenu
] ifFalse:[
m := self class selectorMenu
].
m := m decodeAsLiteralArray.
m findGuiResourcesIn:self.
]
!
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).
self class classHistory addDependent:self.
].
^ holder
! !
!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 value == OrganizerCanvas organizerModeCategory])]]]]]]]
]
argument:(self organizerModeForMenu)
argument:(self browserCanvas).
builder aspectAt:#categoryMenuVisible put: holder
].
^ holder
"Modified: / 18.8.2000 / 15:00:08 / cg"
!
classHierarchyMenuVisible
|holder|
(holder := builder bindingAt:#classHierarchyMenuVisible) isNil ifTrue:[
holder := BlockValue
with:[:v1 :v2 | |orgMode|
orgMode := v1 value.
(orgMode == OrganizerCanvas organizerModeClassHierarchy)
or:[orgMode == OrganizerCanvas organizerModeHierarchy]
]
argument:(self organizerModeForMenu)
argument:(self browserCanvas).
builder aspectAt:#classHierarchyMenuVisible put: holder
].
^ holder
"Created: / 17.2.2000 / 22:19:11 / cg"
"Modified: / 24.2.2000 / 16:51:42 / cg"
!
classInheritanceMenuItemVisible
^ false
!
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:[:v1 :v2 | v1 value == OrganizerCanvas organizerModeNamespace
or:[self navigationState isNameSpaceFullBrowser]
]
argument:(self organizerModeForMenu)
argument:(self browserCanvas).
builder aspectAt:#nameSpaceMenuVisible put: holder
].
^ holder
"Created: / 17.2.2000 / 22:19:11 / cg"
"Modified: / 18.8.2000 / 18:36:56 / cg"
!
notShowingInheritedMethods
|holder|
(holder := builder bindingAt:#notShowingInheritedMethods) isNil ifTrue:[
holder := BlockValue
with:[:h :o | self isMethodListBrowser not and:[h value == #class] ]
argument:(self methodVisibilityHolder)
argument:(self organizerModeForMenu).
builder aspectAt:#notShowingInheritedMethods put: holder
].
^ holder
!
operationsMenuEnabled
^ [
(self canUseRefactoringSupport)
]
!
operationsMenuVisible
^ [
(self canUseRefactoringSupport)
]
!
organizerIsNotShowingCategories
|holder|
(holder := builder bindingAt:#organizerIsNotShowingCategories) isNil ifTrue:[
holder := BlockValue
with:[:h | h value ~~ OrganizerCanvas organizerModeCategory]
argument:(self organizerModeForMenu)
].
^ holder
!
organizerIsShowingCategories
|holder|
(holder := builder bindingAt:#organizerIsShowingCategories) isNil ifTrue:[
holder := BlockValue
with:[:h | h value == OrganizerCanvas organizerModeCategory]
argument:(self organizerModeForMenu)
].
^ holder
!
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 value ~~ OrganizerCanvas organizerModeCategory]]
argument:(self organizerModeForMenu)
].
^ holder
!
organizerIsShowingClassesAndIsShowingCategories
|holder|
(holder := builder bindingAt:#organizerIsShowingClassesAndIsShowingCategories) isNil ifTrue:[
holder := BlockValue
with:[:h | navigationState isMethodListBrowser not and:[h value == OrganizerCanvas organizerModeCategory]]
argument:(self organizerModeForMenu)
].
^ holder
!
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:[:v1 :v2 |
v1 value == OrganizerCanvas organizerModeProject
or:[self navigationState isClassExtensionBrowser]
]
argument:(self organizerModeForMenu)
argument:(self browserCanvas).
builder aspectAt:#projectMenuVisible put: holder
].
^ holder
"Created: / 17.2.2000 / 22:19:11 / cg"
"Modified: / 24.2.2000 / 16:50:25 / 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 value ~~ #class] ]
argument:(self methodVisibilityHolder)
argument:(self organizerModeForMenu).
builder aspectAt:#showingInheritedMethods put: holder
].
^ holder
!
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
!
viewMenuVisible
|holder|
(holder := builder bindingAt:#viewMenuVisible) 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:#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:[
classListApp window font boldness < 0.6 ifTrue:[
clr := (Color red:20)
] ifFalse:[
clr := (Color red: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
|holder|
(holder := builder bindingAt:#methodVisibilityHolder) isNil ifTrue:[
holder := #class asValue.
builder aspectAt:#methodVisibilityHolder put: holder.
].
^ holder
!
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
!
showClassPackages
showClassPackages isNil ifTrue:[
showClassPackages := false asValue.
].
^ showClassPackages.
"/ ^ self navigationState showClassPackages
"Modified: / 24.2.2000 / 16:17:38 / cg"
!
showClassVarsInVariableList
|holder|
(holder := builder bindingAt:#showClassVarsInVariableList) isNil ifTrue:[
holder := false asValue.
builder aspectAt:#showClassVarsInVariableList put: holder
].
^ holder
!
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
!
showSpecialResourceEditors
|holder|
(holder := builder bindingAt:#showSpecialResourceEditors) isNil ifTrue:[
holder := (DefaultShowSpecialResourceEditors ? false) asValue.
builder aspectAt:#showSpecialResourceEditors put: holder.
holder onChangeEvaluate:[ 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
|holder|
(holder := builder bindingAt:#sortVariablesByName) isNil ifTrue:[
holder := false asValue.
builder aspectAt:#sortVariablesByName put: holder
].
^ 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 ]
!
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
!
classOfSelectedMethodOrSelectedClass
| mthd mclass|
(mthd := self theSingleSelectedMethod) notNil ifTrue:[
mclass := mthd mclass.
] ifFalse:[
"/ self codeAspect value ~= #classDefinition ifTrue:[
"/ ^ nil
"/ ].
mclass := self theSingleSelectedClass.
].
^ mclass
!
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 selectedClasses value) size > 0
and:[ selected contains:[:cls | cls theNonMetaclass wasAutoloaded ]].
!
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 ]
!
hasAnyLoadedClassSelected
|selected|
^ (selected := self selectedClasses value) size > 0
and:[ selected contains:[:cls | cls theNonMetaclass isLoaded ]].
!
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 ]
!
hasAnyTestCaseSelected
|selected|
selected := self selectedClasses value.
selected isEmptyOrNil ifTrue:[
selected := self selectedCategoryClasses
].
selected size > 0 ifTrue:[
^ selected contains:[ :cls | cls theNonMetaclass isSubclassOf:TestCase ]
].
^ 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 selectedClasses value) size > 0
and:[ selected contains:[:cls | cls theNonMetaclass isLoaded not ]].
!
hasAnyUnloadedClassSelectedHolder
^ [ self hasAnyUnloadedClassSelected ]
!
hasApplicationClassSelected
|selectedClasses|
selectedClasses := self selectedClasses value.
selectedClasses size == 0 ifTrue:[^ false].
^ selectedClasses conform:[:each | each theNonMetaclass isSubclassOf:ApplicationModel].
!
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"
!
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"
!
hasClassSelectedAndControlKeyDown
^ self hasClassSelected and:[self window sensor ctrlDown]
!
hasClassSelectedAndControlKeyDownHolder
^ [ self hasClassSelectedAndControlKeyDown ]
"Created: / 4.2.2000 / 22:02:53 / 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"
!
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
!
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"
!
hasClassesWithCommonSuperclassAndVariableSelectedAndCanUseRefactoringSupportHolder
^ [ self canUseRefactoringSupport
and:[self hasClassesWithCommonSuperclassSelected
and:[self hasVariableSelectedInCodeViewOrVariableList]] ]
"Created: / 4.2.2000 / 22:02:53 / cg"
!
hasClassesWithCommonSuperclassSelected
|selectedClasses commonSuper|
selectedClasses := self selectedClasses value.
commonSuper := Behavior commonSuperclassOf:selectedClasses.
^ commonSuper notNil and:[ selectedClasses includes: commonSuper ].
!
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 theNonMetaclass isAbstract not
and:[
cls withAllSuperclasses contains:[:aSuperClass |
aSuperClass theNonMetaclass name includesString:'Enum']] ]]
!
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 value and:[self hasExtensionMethodSelected]]
argument:(self hasMethodSelectedHolder)
!
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"
!
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] ]]
!
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"
!
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"
!
hasNonProjectDefinitionSelectedHolder
^ [ self hasNonProjectDefinitionSelected ]
"Created: / 10-08-2006 / 16:25:50 / cg"
!
hasNotMultipleClassesSelected
^ self hasMultipleClassesSelected not
!
hasNotMultipleClassesSelectedHolder
^ [ self hasNotMultipleClassesSelected ]
!
hasNotMultipleTemporaryVariablesSelectedInCodeViewHolder
^ [ self hasMultipleTemporaryVariablesSelectedInCodeView not ]
!
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
|selected|
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"
!
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"
!
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 ~= Project defaultProject package]] ]
!
hasRealExtensionMethodSelectedHolder
^ BlockValue
with:[:m | m value and:[self hasRealExtensionMethodSelected]]
argument:(self hasMethodSelectedHolder)
!
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.
!
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 ]
!
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 ]
!
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"
!
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
|holder|
(holder := builder bindingAt:#hasSingleResourceMethodSelectedHolder) isNil ifTrue:[
holder := self hasSingleResourceMethodSelected asValue.
builder aspectAt:#hasSingleResourceMethodSelectedHolder put:holder.
].
^ holder.
!
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"
!
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 = Project defaultProject package]]
]
!
hasUnassignedExtensionMethodSelectedHolder
^ BlockValue
with:[:m | m value and:[self hasUnassignedExtensionMethodSelected]]
argument:(self hasMethodSelectedHolder)
!
hasUndoableOperations
|manager|
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"
!
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]
!
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
!
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 implements:selector) ifTrue:[^ false].
].
^ true.
!
methodNotImplementedInSuperclass
self selectedMethodsDo:[:eachMethod |
|selector category mclass|
selector := eachMethod selector.
category := eachMethod category.
mclass := eachMethod mclass.
mclass superclass notNil ifTrue:[
(mclass superclass implements: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 ]
!
oomPackageLoaded
^ OOM::MethodMetrics notNil
!
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)
! !
!NewSystemBrowser methodsFor:'change & update'!
categorySelectionChanged
"category selection changed by user interaction"
self enqueueDelayedUpdateBufferLabel.
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.
(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.
"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 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 autoSearch
package project 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:[
navigationState autoSearchAction notNil ifTrue:[
codeView
cursorHome;
searchAction:navigationState autoSearchAction;
searchUsingSearchAction:#forward ifAbsent:nil
] ifFalse:[
(autoSearch := navigationState autoSearchPattern) notNil ifTrue:[
autoSearch = codeView searchPattern ifTrue:[
codeView cursorHome; cursorRight. "/ to avoid finding the selector
codeView
searchFwd:autoSearch ignoreCase:(navigationState autoSearchIgnoreCase)
ifAbsent:[codeView cursorHome].
].
].
].
] ifFalse:[
codeView
searchAction:nil
].
].
navigationState modified:false.
navigationState realModifiedState:false.
self updateProtocolSelectionForChangedMethodSelection.
"Created: / 29-08-2006 / 13:59:06 / cg"
!
delayedVariableSelectionChanged
|var val mclass cls|
var := self theSingleSelectedVariable.
var isNil ifTrue:[
navigationState autoSearchAction:nil.
^ self
].
(self selectedClasses value) do:[:eachClass |
cls := eachClass theNonMetaclass 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.
]
!
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
enqueueMessage:#delayedUpdateCode
for:self
arguments:#()
"Modified: / 1.3.2000 / 13:10:09 / cg"
!
enqueueDelayedUpdateCodeWithAutoSearch
^ self
enqueueMessage:#delayedUpdateCodeWithAutoSearch:
for:self
arguments:#( true )
"Modified: / 1.3.2000 / 13:10:09 / cg"
!
enqueueDelayedUpdateCodeWithoutAutoSearch
^ self
enqueueMessage:#delayedUpdateCodeWithAutoSearch:
for:self
arguments:#( false )
"Modified: / 1.3.2000 / 13:10:09 / 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 selectedMethod
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 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
"/ 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 value:(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:#selectedEditorNoteBookTabIndexChanged
for:self
arguments:#().
^ self.
].
self updateSpecialCodeEditorVisibility.
"Modified: / 17-08-2006 / 16:47:34 / cg"
!
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.
!
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.
!
specialEditorCanvasForMethod:aMethod
|methodsResources|
(methodsResources := aMethod resources) notEmptyOrNil ifTrue:[
#( #image #menu #canvas #help #tableColumns ) do:[:triedResourceType |
|editorCanvas list|
(methodsResources includesKey:triedResourceType) ifTrue:[
editorCanvas := navigationState specialEditorCanvasForResourceType:triedResourceType.
editorCanvas notNil ifTrue:[
^ editorCanvas
].
].
].
].
^ nil
!
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:(self selectedClasses value includes:nil) not.
].
changedObject == self codeInfoVisible ifTrue:[
self codeInfoVisibilityChanged.
^ self
].
changedObject == self toolBarVisibleHolder ifTrue:[
self toolBarVisibilityChanged.
^ 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.
].
changedObject == self organizerModeForMenu ifTrue:[
self enqueueDelayedUpdateBufferLabel.
^ self.
].
changedObject == self class classHistory ifTrue:[
self visitedClassesHistory
removeAll;
addAll:(self class classHistory collect:[:e | e className]).
^ 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
!
updateMetaToggleForClassSelection
|selectedClasses newMetaToggleLabel|
selectedClasses := self selectedClasses value ? #().
(selectedClasses contains:[:eachClass | eachClass theNonMetaclass isJavaClass]) ifTrue:[
"/ selection contains at least on javaClass
(selectedClasses contains:[:eachClass | eachClass theNonMetaclass isJavaClass not]) ifTrue:[
"/ mixed ..
newMetaToggleLabel := 'Class / Static'.
] ifFalse:[
"/ only javaclasses selected
newMetaToggleLabel := 'Static'.
]
] ifFalse:[
newMetaToggleLabel := 'Class'.
].
self navigationState metaToggleLabelHolder value:(resources string:newMetaToggleLabel)
!
updateSpecialCodeEditorVisibility
self
updateSpecialCodeEditorVisibilityForClass:(self theSingleSelectedClass)
method:(self theSingleSelectedMethod)
"Created: / 17-08-2006 / 16:46:50 / cg"
!
updateSpecialCodeEditorVisibilityForClass:aClassOrNil method:aMethod
|hideSpecialEditor editorCanvas tabList|
hideSpecialEditor := true.
aMethod notNil ifTrue:[
self showSpecialResourceEditors value ifTrue:[
editorCanvas := self specialEditorCanvasForMethod:aMethod.
editorCanvas notNil ifTrue:[
hideSpecialEditor := false.
tabList := Array
with:'Source'
with:(editorCanvas application class nameWithoutPrefix asUppercaseFirst).
tabList = self editorNoteBookListHolder value ifFalse:[
self editorNoteBookListHolder value:tabList.
].
self selectedEditorNoteBookTabIndexHolder value == 2 ifTrue:[
self editorNoteBookCanvasHolder value:editorCanvas.
editorCanvas application
masterApplication:self;
specClass:(aMethod mclass theNonMetaclass);
specSelector:(aMethod selector);
loadFromClass:(aMethod mclass theNonMetaclass)
andSelector:(aMethod selector).
^ self.
].
].
].
].
hideSpecialEditor ifTrue:[
"/ sigh - setting an empty list also changes the selection to 0 (side effect in NoteBokkView).
"/ To avoid flickering change messages, preSet its value to 0.
self selectedEditorNoteBookTabIndexHolder setValue:0.
self editorNoteBookListHolder value:#().
] ifFalse:[
self selectedEditorNoteBookTabIndexHolder value:1.
].
self editorNoteBookCanvasHolder value:(navigationState scrollableCodeView).
"Created: / 17-08-2006 / 16:44:51 / 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.
! !
!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:' )
isSelector:true
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
].
]
isSelector:true
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 size == 0 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 selectAll.
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 := [
|classes|
classes := OrderedCollection new.
Smalltalk allClassesDo:[:eachClass |
(eachClass isVisualStartable
or:[eachClass isStartableWithMain
or:[eachClass isStartableWithStart]])
ifTrue:[
classes add:eachClass.
].
].
classes
].
self
spawnClassBrowserForSearch:searchBlock
spec:#multipleClassBrowserSpec
sortBy:nil in:#newBuffer label:'Applications'
autoSelectIfOne:true
callBack:[:brwsr | brwsr classListApp markApplications:true ].
"Modified: / 5.11.2001 / 09:37:17 / 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:[
|list 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.
"/ newBrowser := self
"/ spawnMethodBrowserForSearch:[
"/ | methods |
"/
"/ methods := IdentitySet new.
"/ Smalltalk allClassesDo:[:aClass |
"/ |classPackage|
"/
"/ classPackage := aClass package.
"/ aClass selectorsAndMethodsDo:[:sel :mthd |
"/ mthd package ~= classPackage ifTrue:[
"/ methods add:mthd
"/ ]
"/ ].
"/ ].
"/ methods asOrderedCollection
"/ ]
"/ sortBy:#class
"/ in:openHow
"/ label:'All Class Extensions'.
]
!
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 varName brwsr allInstVariables allClassInstVariables allClassVariables
list button2 button3 doWhat doWhat2 doWhat3 classes|
title := 'Browse/Search Class(es) Defining Instance, Class or ClassInst Variables:\(MatchPattern Allowed)\'.
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 | varName := aString].
box showAtPointer.
varName isNil ifTrue:[
^ self
].
varName includesMatchCharacters ifTrue:[
classes := Smalltalk allClasses select:[:cls |
cls isMeta not
and:[(cls instVarNames contains:[:v | varName match:v])
or:[(cls classVarNames contains:[:v | varName match:v])
or:[cls class instVarNames contains:[:v | varName match:v]]]]
].
] ifFalse:[
classes := Smalltalk allClasses select:[:cls |
cls isMeta not
and:[(cls instVarNames includes:varName)
or:[(cls classVarNames includes:varName)
or:[cls class instVarNames includes:varName]]]
].
].
classes size == 0 ifTrue:[
self information:'None found.'.
^ self
].
classes := classes asOrderedCollection.
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 / 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 isNameSpace not or:[cls == Smalltalk]) ifTrue:[
cls := cls theNonMetaclass.
classes add:cls.
cls isPrivate ifTrue:[
classes add:cls owningClass
].
].
]
].
].
].
classes asOrderedCollection
].
^ self spawnClassBrowserForSearch:searchBlock sortBy:nil in:openHow label:title
!
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
"/ - 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 (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'
!
browseMenuClassesWithoutCopyright
|searchBlock|
searchBlock :=
[|classes|
classes := self findClassesWithoutClassMethod:#copyright.
classes := classes select:[:each | each isPrivate not].
classes].
self
spawnClassBrowserForSearch:searchBlock
sortBy:nil
in:#newBuffer
label:'Classes without copyright'
!
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 := classes select:[:each | each isPrivate not
or:[classes includes:each owningClass]].
classes := classes select:[:each | (each isSubclassOf:Exception) not].
classes
].
self spawnClassBrowserForSearch:searchBlock sortBy:nil in:#newBuffer label:'Classes without examples'
!
browseMenuClassesWithoutRepositoryContainer
|searchBlock|
searchBlock := [
|classes|
classes := self findClassesWithoutClassMethod:#version.
classes := classes select:[:each | each isPrivate not].
classes
].
^ self spawnClassBrowserForSearch:searchBlock sortBy:nil in:#newBuffer label:'Classes without repository container'
!
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:[
"/ browser window waitUntilVisible.
"/ self halt.
(categoryListApp := browser categoryListApp) ifNotNil:[
categoryListApp nameSpaceFilter value:(self navigationState selectedNamespaces value copy)
].
].
browser openWindow.
^ browser.
"Modified: / 1.3.2000 / 12:28:51 / 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)
!
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:' )
isSelector:#code
searchArea:whereDefault
withCaseIgnore:false
withTextEntry:true
withMethodList:true
setSearchPattern:[:brwsr :codePattern :ignoreCase :doMatch|
brwsr autoSearchCodePattern:codePattern
]
!
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)
!
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|
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:' )
isSelector:#string
searchArea:whereDefault
withCaseIgnore:true
withTextEntry:true
withMethodList:true
setSearchPattern:[:brwsr :string :ignoreCase :doMatch|
brwsr autoSearchPattern:string ignoreCase:ignoreCase.
]
!
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:
isSelector:#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:
isSelector:#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:' )
isSelector:#string
searchArea:whereDefault
withCaseIgnore:true
withTextEntry:true
withMethodList:true
setSearchPattern:[:brwsr :string :ignoreCase :doMatch|
brwsr autoSearchPattern:string ignoreCase:ignoreCase.
]
!
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 |
self methodHasUglyCodingStyle:mthd selector:sel inClass:cls
]
]
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:[sel ~~ #version])
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:'Overwritten 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|
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 map:#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 | |mSource|
"/ kludge: Lazy methods do not include symbols in the literal array - sigh
mthd isLazyMethod ifTrue:[
mSource := mthd source.
(mSource notNil
and:[mthd usedGlobals contains:[:lit | globlName match:lit]])
] ifFalse:[
((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 ?'.
labelHolder value:('Methods referring to ''%1'' or ''%2''' bindWithArguments:keysReferringToValue).
] ifFalse:[
labelHolder value:('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:[
"/ self halt.
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
]
isSelector:#globalName
searchArea:#everywhere
withCaseIgnore:false
setSearchPattern:[:brwsr :string :ignoreCase :doMatch|
|globlNames|
globlNames := string withoutSeparators asCollectionOfSubstringsSeparatedByAny:',;| '.
brwsr autoSearchVariables:globlNames readers:true writers:true.
"/ 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 searchBlock|
(sym := string 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:[
string 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 | string match:sym]])
] ifFalse:[
mthd usedSymbols contains:[:sym | string match:sym]
]
].
].
self class
findMethodsIn:classes
where:searchBlock
]
isSelector:true
searchArea:(self defaultSearchArea)
withCaseIgnore:false
setSearchPattern:[:brwsr :string :ignoreCase :doMatch|
brwsr autoSearchPattern:string ignoreCase:ignoreCase.
]
!
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 := Project defaultProject package.
Smalltalk allMethodsDo:[:mthd |
mthd package = defaultId ifTrue:[
methods add:mthd.
].
].
methods
].
^ self
spawnMethodBrowserForSearch:searchBlock
sortBy:#class
in:openHow
label:'Loose methods'
!
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:' )
isSelector:true
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].
^ 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
]
isSelector:true
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 selectedClasses value ? #()) collect:[:eachClass | eachClass theNonMetaclass].
selectedCategories := self selectedCategoriesValue copy.
^ self
newBrowserOrBufferDependingOn:where
label:nil
forSpec:#classDocumentationBrowserSpec
setupWith:[:brwsr |
brwsr selectCategories:selectedCategories.
brwsr selectClasses:selectedClasses.
]
!
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 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 selectedClasses value ? #()) collect:[:eachClass | eachClass theNonMetaclass].
selectedCategories := self selectedCategoriesValue copy.
^ self
newBrowserOrBufferDependingOn:where
label:nil
forSpec:#fullClassSourceBrowserSpec
setupWith:[:brwsr |
brwsr meta value:false.
brwsr selectCategories:selectedCategories.
brwsr selectClasses:selectedClasses.
]
!
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 canvas:(self newCanvasWithSpec:aSpec).
navigationState canvasType:aSpec.
self setupNavigationStateFrom:oldNavigationState.
buffers add:navigationState.
bNameList add:'no class'.
bufferUsageOrder addFirst:navigationState.
nr := buffers size.
self selectedBuffer value:nr.
^ navigationState.
"Modified: / 29.2.2000 / 10:40:04 / 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 switchToClass:aClass selector:selector.
].
^ brwsr
! !
!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 select:[:each | each isPrivate not].
self checkOutClasses:classes askForRevision:false
!
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 select:[:eachClass | (classes includes:eachClass) not].
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: / 24.2.2000 / 09:40:38 / 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
]
].
!
categoryMenuRepositoryHistory
(self askIfModified:'Code was modified.\\Show history anyway ?')
ifFalse:[^ self].
self withWaitCursorDo:[
|timeGoal moduleFilter repositoryFilter userFilter aStream box y component
timeGoalListPop moduleFilterPop userFilterPop dateList userList|
timeGoal := 'yesterday' asValue.
moduleFilter := 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.
y := box yPosition.
component := box addTextLabel:(resources string:'For module (empty for all):').
component width:0.5; adjust:#right; borderWidth:0.
box yPosition:y.
moduleFilterPop := box addComboBoxOn:moduleFilter 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:[
moduleFilter := moduleFilter 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
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: / 23.11.1995 / 11:41:38 / cg"
"Modified: / 17.1.2001 / 13:07:11 / 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
!
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
]
].
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.
].
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.
!
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 |
|anyNonMeta|
"/ setup for a constant list ...
brwsr immediateUpdate value:true.
brwsr categoryListGenerator value:categoryList.
brwsr selectCategories:categoryList.
selectedClasses notNil ifTrue:[
anyNonMeta := selectedClasses contains:[:aClass | aClass isMeta not].
anyNonMeta ifFalse:[
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: / 18.8.2000 / 15:52:31 / 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)."
|checker badMethodInfo badClassInfo theSingleClass lbl badMethods|
checker := ClassChecker new.
self selectedClassesWithWaitCursorDo:[: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 size == 0 ifTrue:[
badClassInfo size == 0 ifTrue:[
^ self information:'Nothing special found'.
]
].
(theSingleClass := self theSingleSelectedClass) notNil ifTrue:[
lbl := 'Check results of ' , theSingleClass name
] ifFalse:[
lbl := 'Checker result'
].
badMethodInfo size > 0 ifTrue:[
badMethods := badMethodInfo keys.
] ifFalse:[
badMethods := #()
].
self
spawnMethodBrowserFor:badMethods
in:#newBuffer
label:lbl
perClassInfo:badClassInfo
perMethodInfo:badMethodInfo
sortBy:#class
"Created: / 18.8.2000 / 22:43:56 / cg"
"Modified: / 18.8.2000 / 22:58:53 / 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.
(countSubClasses ~~ 0 or:[countPrivateClasses ~~ 0 or:[withConfirm]]) ifTrue:[
withCancel ifTrue:[
confirmed := Dialog confirmWithCancel:t default:false
] ifFalse:[
confirmed := Dialog confirm:t
].
confirmed isNil ifTrue:[
"/ cancelled
AbortOperationRequest raise
].
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
]
]
]
]
].
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
]
]
]
]
!
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:(self 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"
!
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 acceptaction 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"
!
classMenuChildrenToSiblings
|currentClass name subclasses|
currentClass := self theSingleSelectedClass.
currentClass isLoaded ifFalse:[
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 theNonMetaclass.
subclasses isNil ifTrue: [^self].
self performRefactoring:
(ChildrenToSiblingsRefactoring name: name
class: self currentClass theNonMetaclass
subclasses: subclasses).
self switchToClassNamed:name.
"/ meta: self isMeta
"/ categories: self categories
!
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 selectedClasses value.
sel size == 2 ifTrue:[
class1 := sel first theNonMetaclass.
class2 := sel second theNonMetaclass.
self doCompareClass:class1 withClass:class2
]
!
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 theSingleSelectedClass.
currentClass isLoaded ifFalse:[
self warn:'cannot compare unloaded classes.'.
^ self.
].
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.
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
!
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 nameSpace|
currentClass := self theSingleSelectedClass.
currentClass isLoaded ifFalse:[
self warn:'Cannot copy unloaded classes.'.
^ self
].
currentClass := currentClass theNonMetaclass.
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:[
self warn:(resources string:'No class or nameSpace named: ''%1''' with:ownerName) withCRs.
^ self
].
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.
].
!
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 |
]
!
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 selectedClasses value collect:[:eachClass | eachClass theNonMetaclass].
classes := classes select:[:eachClass | eachClass isPrivate not].
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.
!
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 selectedClasses value collect:[:each|each theNonMetaclass]) withFormat:aFormatSymbolOrNil
!
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 |
|cls|
cls := eachClass theNonMetaclass.
(cls isSubclassOf:HTTPService) ifTrue:[
generator createWebApplicationCodeFor:cls.
] ifFalse:[
generator createApplicationCodeFor:cls
]
]
!
classMenuGenerateClassTypeTestMethods
"create isXXX test- methods here and in subclasses"
|cls subclasses|
(cls := self theSingleSelectedClass) isNil ifTrue:[
self information:'You must select a single (abstract) superclass'.
^ self.
].
cls := cls theNonMetaclass.
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
].
!
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)
].
!
classMenuGenerateDocumentationMethodFromComment
"create documentation method from comment"
self
generateUndoableChangeOverSelectedClasses:'Generate Documentation method in %(singleClassNameOrNumberOfClasses)'
via:[:generator :eachClass |
|cls|
cls := eachClass theMetaclass.
(cls implements:#documentation) ifFalse:[
generator createDocumentationMethodFor:cls.
(cls implements:#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
!
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].
CodeGeneratorTool 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
].
!
classMenuGenerateProjectDefinitions
self generateProjectDefinitionsIn:(self selectedClasses value ? #())
!
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:(self 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"
!
classMenuInitialize
"reinit selected classes (kludge - for me)"
self selectedClassesDo:[:eachClass |
(eachClass theMetaclass implements:#initialize) ifTrue:[
eachClass theNonMetaclass initialize.
]
].
!
classMenuInsertNewSuperclass
|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
|classes toInspect|
(classes := self selectedClasses value) size > 0 ifTrue:[
classes := classes collect:[:eachClass | eachClass theNonMetaclass].
classes size == 1 ifTrue:[
toInspect := classes first.
] ifFalse:[
toInspect := classes
].
toInspect inspect
].
"Modified: / 11.2.2000 / 10:09:34 / cg"
!
classMenuInspectDerivedInstances
|classes insts|
classes := self selectedClasses value collect:[:eachClass | eachClass theNonMetaclass].
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
]
]
!
classMenuInspectInstances
|classes insts|
classes := self selectedClasses value collect:[:eachClass | eachClass theNonMetaclass].
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
]
]
!
classMenuInspectReferencesToInstances
|classes insts|
classes := self selectedClasses value collect:[:eachClass | eachClass theNonMetaclass].
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
]
]
!
classMenuLoad
"load selected classes"
self classLoad
!
classMenuLoadProject
"load all classes from the selected project definitions"
(self selectedClasses value copy) do:[:cls |
cls autoload.
cls theNonMetaclass isProjectDefinition ifTrue:[
self activityNotification:('Loading ', cls theNonMetaclass description , '..').
cls theNonMetaclass load
].
].
"Modified: / 17-08-2006 / 01:07:13 / 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:(self 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 selectedClasses value collect:[:eachClass| eachClass theNonMetaclass].
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.
].
!
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 selectedClassesDo:[: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].
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 theNonMetaclass makePublicIn:ns
]
]
"Modified: / 04-07-2006 / 15:00:29 / cg"
"Modified: / 04-07-2006 / 18:48:23 / fm"
!
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 selectedClassesDo:[: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 theNonMetaclass makePublicIn:ns
]
]
"Created: / 04-07-2006 / 18:48:23 / fm"
!
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 selectedClassesDo:[:eachClass |
|classToMove className doMove oldSym oldBaseSym|
classToMove := eachClass theNonMetaclass.
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
]
]
]
]
]
]
!
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 autoload.
self
classClassDefinitionTemplateFor:TestCase
in:(self theSingleSelectedCategory ? 'TestCases')
asNamespace:false
private:false.
self codeAspect:#newTestCase.
!
classMenuNewWebApplication
"create a class-definition prototype for a web application"
self
classClassDefinitionTemplateFor:HTTPActionService
in:(self theSingleSelectedCategory ? 'WebApplications')
asNamespace:false
private:false.
self codeAspect:#newWebApplication.
!
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 |
eachClass theNonMetaclass recompileUsingCompilerClass:InstrumentingCompiler.
eachClass theMetaclass recompileUsingCompilerClass:InstrumentingCompiler.
].
!
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 yesToAll|
classesToRemove := OrderedCollection new.
offerCancel := self selectedClasses value size > 1.
offerYesToAll := self selectedClasses value size > 1.
self
selectedClassesNonMetaDo:[:cls |
self
addClassesToRemoveForClass:cls
to:classesToRemove
removingSubclasses:pullUpSubclasses not
withCancel:offerCancel
]
ifUnloaded:[:cls |
|answer|
yesToAll == true 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:[
yesToAll := 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|
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 ...
Smalltalk renameClass:currentClass to:newNameString.
Smalltalk changed.
"/ 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.
(self confirm:(resources string:'Create a new source container for ''%1'' ?' with:newNameString allBold))
ifTrue:[
SourceCodeManagerUtilities createSourceContainerForClass:(Smalltalk at:newNameString asSymbol)
]
].
]
].
"/ answer := OptionBox
"/ request:(resources string:'Search for / Change references to ''%1''' with:oldSym allBold)
"/ label:'References to renamed class'
"/ form:(YesNoBox iconBitmap)
"/ buttonLabels:#('Search' 'Replace' 'cancel')
"/ values:#(#search #replace false).
answer := OptionBox
request:(resources string:'Search for references to ''%1'' ?' "/ 'Search for references to ''%1'' (and rewrite as ''%2'') ?'
with:oldSym allBold
with:newNameString allBold)
label:'References to renamed class'
buttonLabels:#('No' 'Search' " 'Search & Replace' ")
values:#(false #search " #replace ")
default:#search "#replace "
onCancel:false.
(answer ~~ false) ifTrue:[
self busyLabel:('searching for users of ' , oldSym).
referingMethods := IdentitySet new.
Smalltalk allMethodsDo:[:mthd |
((mthd refersToLiteral:oldSym) "/ (mthd referencesGlobal:oldSym)
or:[oldBaseSym ~= oldSym and:[(mthd refersToLiteral:oldBaseSym) "(mthd referencesGlobal:oldBaseSym)"]]) ifTrue:[
referingMethods add:mthd
]
].
self normalLabel.
referingMethods isEmpty ifTrue:[
self information:'No references found.'.
^ self
]
].
answer == #search ifTrue:[
browser := self spawnMethodBrowserFor:referingMethods in:#newBuffer label:('Methods referring to ' , oldSym).
] ifFalse:[
answer == #replace ifTrue:[
refactoring := RenameClassRefactoring renameClassNamed:oldSym to:newNameString.
browser := self spawnMethodBrowserFor:referingMethods in:#newBuffer label:('Methods referring to ' , oldSym).
self shouldImplement.
]
].
browser notNil ifTrue:[
browser autoSearch:oldBaseSym.
].
!
classMenuSaveDocumentationAs
"write classes documentation to a file"
self
selectedClassesNonMetaDo:
[:cls |
self saveClassDocumentationFor:cls
]
ifUnloaded:
[:cls |
true
]
ifPrivate:
[:cls |
]
!
classMenuSaveRemove
"remove the selected classes (and all of its subclasses)"
(self canUseRefactoringSupport) ifFalse:[
^ self warn:'Sorry - need refactoring support for this function'.
].
^ self classMenuRemoveAndPullUpSubclasses:true
!
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
!
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:[
className := aSuperClass nameWithoutNameSpacePrefix.
s nextPutAll:('"{ NameSpace: ''' , currentNamespace name , ''' }"').
s cr; cr.
] 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"
!
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 "/ instanceVariableNames:
with:aClass classVariableString "/ classVariableNames:
with:'' "/ 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)
sel ~~ #version ifTrue:[
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 implements:#initialize) ifTrue:[
newClass initialize.
].
newClass package:(Class packageQuerySignal query).
^ newClass
!
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
!
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."
|fileBox 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.
fileBox doAccept.
fileBox okPressed.
]
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|
generator := CodeGeneratorTool 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.
].
self withWaitCursorDo:[
UserInformation handle:[:ex |
self showInfo:(ex messageText).
] do:[
generator executeCollectedChangesNamed:(nameOfOperation expandPlaceholdersWith:dict)
]
]
!
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|
generator := CodeGeneratorTool 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)
!
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
]
!
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
]
]
!
runTestCases
"run selected testcases."
self runTestCasesWithDebug:false
"Modified: / 05-08-2006 / 17:32:19 / cg"
!
runTestCasesWithDebug
"run selected testcases."
self runTestCasesWithDebug:true
"Created: / 05-08-2006 / 17:32:24 / cg"
!
runTestCasesWithDebug:withDebug
"run selected testcases."
[
|selectedClasses|
selectedClasses := self selectedClasses value.
selectedClasses isEmptyOrNil ifTrue:[
selectedClasses := self selectedCategoryClasses
].
selectedClasses do:[:eachClass |
|cls isCompleteSuite suite result selectors toRun|
cls := eachClass.
cls isLoaded ifFalse:[
cls := eachClass autoload.
].
cls := cls theNonMetaclass.
((cls isSubclassOf:TestCase)
and:[cls isAbstract not]) ifTrue:[
(self selectedProtocolsValue isEmptyOrNil
or:[self selectedProtocolsValue 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:[
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.
]
"Created: / 05-08-2006 / 17:32:06 / cg"
"Modified: / 13-08-2006 / 17:53:58 / cg"
!
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"
|allClasses|
allClasses := OrderedCollection new.
classes do:[:eachClass |
eachClass withAllPrivateClassesDo:[:everyClass |
allClasses add:everyClass
].
].
^ self spawnClassBrowserFor:allClasses in:where select:true
!
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: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.
].
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 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.
].
].
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 selectedClassesDo:[:each |
each theNonMetaclass 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: / 18.8.2000 / 15:58:35 / cg"
!
spawnWithAllSuperclassesIn:how
"open a new browser showing the selected classes with all superclasses"
|all allOrdered brwsr|
all := IdentitySet new.
allOrdered := OrderedCollection new.
self selectedClassesDo:[:each |
each theNonMetaclass 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: / 18.8.2000 / 15:58:49 / cg"
!
variablesMenuGenerateMultiSetterMethod
"create a multi setter method for selected instvars."
self classMenuGenerateMultiSetterMethod
! !
!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."
SourceCodeManagerUtilities
checkinClasses:aCollectionOfClasses
withInfo:logInfoOrNil
withCheck:doCheck.
!
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."
SourceCodeManagerUtilities
checkoutClass:aClass askForRevision:askForRevision askForMerge:true.
!
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:[
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 information:ex description
].
ex proceed.
] do:[
self checkOutClass:cls askForRevision:askForRevision.
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.
!
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."
|currentClass|
currentClass := self theSingleSelectedClass.
currentClass isNil ifTrue:[
self doCompareClassesWithRepository:self selectedClasses value.
^ self
].
^ self compareAgainstNewestInRepository:currentClass theNonMetaclass
!
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 theSingleSelectedClass.
currentClass isLoaded ifFalse:[
self warn:'Cannot compare unloaded classes.'.
^ self.
].
currentClass := currentClass theNonMetaclass.
nm := currentClass name.
mgr := currentClass sourceCodeManager.
mgr isNil ifTrue:[
self warn:'No sourceCode manager - check settings'.
^ 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.
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.
!
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 theSingleSelectedClass.
currentClass isLoaded ifFalse:[
self warn:'Cannot compare unloaded classes.'.
^ self.
].
currentClass := currentClass theNonMetaclass.
nm := currentClass name.
mgr := currentClass sourceCodeManager.
mgr isNil ifTrue:[
self warn:'No sourceCode manager - check settings'.
^ 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 ~= Project defaultProject package]) 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:[ChangeSet current includesChangeForClassOrMetaclassOrPrivateClassOf:currentClass]) 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: / 4.1.1997 / 15:48:20 / cg"
"Modified: / 28.4.1998 / 17:40:02 / cg"
!
classMenuQuickCheckIn
"check a class into the source repository (without checks)"
^ self classMenuCheckIn:false
!
classMenuRevisionLog
"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
]
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.
!
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|
classesToUnload := IdentitySet new.
classes := collectionOfClasses collect:[:eachClass |
|loadedClass|
eachClass isLoaded ifFalse:[
loadedClass := eachClass autoload.
classesToUnload add:loadedClass.
] ifTrue:[
loadedClass := eachClass
].
loadedClass theNonMetaclass
].
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:[ChangeSet current includesChangeForClassOrMetaclassOrPrivateClassOf:eachClass]) 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).
].
].
].
].
].
VersionDiffBrowser
openOnDiffSet:allDiffs
labelA:'Repository'
labelB:'Image'
title:'Diffs'.
self normalLabel.
"Created: / 4.1.1997 / 15:48:20 / cg"
"Modified: / 28.4.1998 / 17:40:02 / 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|
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 := currentClass sourceCodeManager.
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 ~= Project defaultProject package]) 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:[ChangeSet current includesChangeForClassOrMetaclassOrPrivateClassOf:currentClass]) 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).
].
].
].
].
VersionDiffBrowser
openOnDiffSet:allDiffs
labelA:'Repository'
labelB:'Image'
title:'Diffs'.
self normalLabel.
"Created: / 4.1.1997 / 15:48:20 / cg"
"Modified: / 28.4.1998 / 17:40:02 / 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"
|codeView aStream|
aStream := WriteStream on:(String new:200).
Processor activeProcess
withPriority:Processor activePriority-1 to:Processor activePriority
do:[
self busyLabel:'extracting revision info' with:nil.
SourceCodeManagerUtilities repositoryLogOf:aClass 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"
|nm mgr rev rev2 pkg containerModule containerPackage rslt containerFile newestRev msg sourceStream revString
info mod dir|
nm := aClass name.
mgr := aClass sourceCodeManager.
mgr isNil ifTrue:[
self warn:'No sourceCode manager - check settings'.
^ 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 ~= Project defaultProject package]) 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 ? '???') , ')'.
"/ aStream := mgr getMostRecentSourceStreamForClassNamed:nm.
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:nm.
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
! !
!NewSystemBrowser methodsFor:'menu actions-classHierarchy'!
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-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:aClass.
"/ refactoring := AddClassVariableRefactoring variable:newName class:nonMeta.
self performRefactoring:refactoring.
!
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 := CodeGeneratorTool 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.
].
!
codeMenuAddParameter
|cls selector refactoring initializer newSelector l initialAnswer senders nSenders|
(self askIfModified) ifFalse:[
^ self
].
cls := self theSingleSelectedMethod mclass.
selector := self theSingleSelectedMethod selector.
selector numArgs == 0 ifTrue:[
initialAnswer := selector , ':'.
l := 'Enter new selector:'.
] ifFalse:[
initialAnswer := selector , 'xxxx:'.
l := 'Enter new selector (replace xxxx as desired):'.
].
newSelector := Dialog request:(resources string:l) initialAnswer:initialAnswer.
newSelector isEmptyOrNil ifTrue:[
^ nil "/ cancelled
].
"/ how many senders are there ?
senders := SystemBrowser findSendersOf:selector in:(Smalltalk allClasses) ignoreCase:false match:false.
nSenders := senders size.
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 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.
!
codeMenuExtractMethod
| mthd cls selector refactoring |
(self askIfModified) ifFalse:[
^ self
].
mthd := self theSingleSelectedMethod.
cls := mthd mclass.
selector := mthd selector.
self assert:(cls notNil and:[mthd notNil]) message:'no class/method'.
refactoring := (ExtractMethodRefactoring
extract: (self selectedInterval)
from: selector
in: cls).
refactoring source:self codeView contentsAsString.
self performRefactoring:refactoring.
!
codeMenuExtractMethodToComponent
| mthd cls selector refactoring |
(self askIfModified) ifFalse:[
^ self
].
mthd := self theSingleSelectedMethod.
cls := mthd mclass.
selector := mthd selector.
self assert:(cls notNil and:[mthd notNil]) message:'no class/method'.
refactoring := (ExtractMethodToComponentRefactoring
extract: (self selectedInterval)
from: selector
in: cls).
refactoring source:self codeView contentsAsString.
self performRefactoring:refactoring.
!
codeMenuExtractSelectionToTemporary
| 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.
cls := self theSingleSelectedMethod mclass.
selector := self theSingleSelectedMethod 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 methods"
self hasSingleMethodSelected ifFalse:[^ self].
self formatCode.
"autoAcceptFormattedCode" false ifTrue:[
self codeView accept
]
!
codeMenuInlineMessage
| node cls selector refactoring receiverNode inlinedSelector senders|
(self askIfModified) ifFalse:[
^ self
].
cls := self theSingleSelectedMethod mclass.
selector := self theSingleSelectedMethod 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).
self performRefactoring:refactoring.
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)).
].
!
codeMenuInlineParameter
| cls selector refactoring selectedParameter|
(self askIfModified) ifFalse:[
^ self
].
cls := self theSingleSelectedMethod mclass.
selector := self theSingleSelectedMethod selector.
selectedParameter := self selectionInCodeView.
(self confirm:(resources string:'Inline parameter ''%1'' ?' with:selectedParameter allBold)) ifFalse:[^ self].
refactoring := InlineParameterRefactoring inlineParameter:selectedParameter 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."
|refactoring mthd mClass mSelector newClass newMethod|
(self askIfModified) ifFalse:[
^ self
].
mthd := self theSingleSelectedMethod.
mClass := mthd mclass.
mSelector := mthd selector.
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"
|mthd node varName definingNode |
(self askIfModified) ifFalse:[
^ self
].
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].
mthd := self theSingleSelectedMethod.
self performRefactoring: (MoveVariableDefinitionRefactoring
bindTight: (node sourceInterval)
in: mthd mclass
selector: mthd selector).
self switchToMethod:mthd.
!
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"
|oldName node mthd cls definingClass|
(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.
].
cls isMeta ifTrue:[
cls := 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 := cls whichClassDefinesClassVar: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 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"
(self askIfModified) ifFalse:[
^ self
].
(Dialog
confirm:'About to rewrite methods...'
title:'About to rewrite methods...'
yesLabel:'proceed'
noLabel:'cancel')
ifFalse:[
^ self
].
self performRefactoring:(PullUpClassVariableRefactoring variable:oldName class:aClass superclass).
!
codeMenuPullUpInstanceVariable
"pull an instance variable up to its superclasses"
|oldName node mthd cls definingClass|
(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.
].
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|
(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
].
self performRefactoring:(PullUpInstanceVariableRefactoring variable:varName class:superClass).
!
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"
|oldName node mthd cls definingClass|
(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.
].
cls isMeta ifTrue:[
cls := 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 := cls whichClassDefinesClassVar:oldName.
definingClass isNil ifTrue:[
self warn:'Oops - could not find the defining class'.
^ self
].
definingClass ~~ cls 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|
(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.
self performRefactoring:(PushDownClassVariableRefactoring variable:oldName class:cls).
!
codeMenuPushDownInstanceVariable
"push an instance variable down to its subclasses"
|oldName node mthd cls definingClass|
(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.
].
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|
(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.
self performRefactoring:(PushDownInstanceVariableRefactoring variable:varName class:cls).
!
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|
(self askIfModified) ifFalse:[
^ self
].
cls := aClass theNonMetaclass whichClassDefinesClassVar:oldName.
"/ change := RemoveClassVariableRefactoring variable:oldName class:cls.
change := RemoveClassVariableChange remove:oldName from:cls.
self performRefactoring:change.
!
codeMenuRemoveInstanceVariable:oldName inClass:aClass
"remove an instance variable"
|cls refactoring|
(self askIfModified) ifFalse:[ ^ self ].
cls := aClass whichClassDefinesInstVar:oldName.
cls isNil ifTrue:[
self error:'no class'
].
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
| cls selector refactoring selectedParameter|
(self askIfModified) ifFalse:[
^ self
].
cls := self theSingleSelectedMethod mclass.
selector := self theSingleSelectedMethod selector.
selectedParameter := self selectionInCodeView.
(self confirm:(resources string:'Remove parameter ''%1'' ?' with:selectedParameter allBold)) ifFalse:[^ self].
refactoring := RemoveParameterRefactoring removeParameter:selectedParameter in:cls selector:selector.
(self findSendersOf:selector andConfirmRefactoring:refactoring) ifTrue:[
self performRefactoring:refactoring.
self switchToSelector:refactoring newSelector.
]
!
codeMenuRenameClassVariable
"rename a class variable"
|oldName node mthd cls definingClass|
(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.
].
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"
|oldName node mthd cls definingClass|
(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.
].
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 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
|tree node source|
interval isEmpty ifTrue: [^ nil].
RBParser isNil ifTrue: [^ nil].
source := self codeView contentsAsString string.
tree := RBParser
parseMethod:source
onError: [:str :err ":nodesSoFar" | ^ nil].
tree isNil ifTrue:[^ nil].
node := tree whichNodeIsContainedBy:interval.
node isNil ifTrue: [
node := self findNodeIn:tree forInterval:interval
].
^ node
!
findNodeForInterval:interval allowErrors:allowErrors
|tree node source "errCount"|
interval isEmpty ifTrue: [^ nil].
RBParser isNil ifTrue: [^ nil].
source := self codeView contentsAsString string.
tree := RBParser
parseMethod:source
onError: [:str :err :nodesSoFar |
|nodes|
allowErrors ifTrue:[
nodes := nodesSoFar collect:[:nd | nd whichNodeIntersects:interval].
nodes := nodes select:[:nd | nd notNil ].
nodes size == 1 ifTrue:[
^ nodes first
].
].
^ nil]
rememberNodes:true.
"/ onError: [:str :err | errCount := (errCount?0) + 1. self halt.]
"/ proceedAfterError:true.
tree isNil ifTrue:[^ nil].
node := tree whichNodeIsContainedBy:interval.
node isNil ifTrue: [
node := self findNodeIn:tree forInterval:interval
].
^ node
!
findNodeIn:tree forInterval:interval
|node wouldReturn|
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
!
findSendersOf:selector andConfirmRefactoring:refactoring
|senders nSenders classes nClasses firstClassName secondClassName infoMsg answer brwsr|
"/ how many senders are there ?
senders := SystemBrowser findSendersOf:selector in:(Smalltalk allClasses) 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) ?'
]
].
answer := Dialog
confirmWithCancel:(resources
string:infoMsg
with:nSenders printString
with:nClasses printString
with:firstClassName
with:secondClassName
with:senders first whoString allBold)
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
!
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 halt:'should not happen'.
(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 param 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
!
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 selectionStartIndex to:(codeView selectionStopIndex - 1)
!
setUndoCount
"Don't like the isKindOf:, but don't have a portable way to determine if something is a number."
| undoString undoTree |
(self canUseRefactoringSupport) ifFalse:[^ self].
undoString := Dialog request: 'Enter undo stack size:\(i.e.: Number of remembered operations)' withCRs
initialAnswer:(RefactoryChangeManager undoSize printString).
undoString isEmpty ifTrue: [^self].
undoTree := RBParser parseExpression: undoString onError: [:str :pos | ^self].
(undoTree isLiteral and: [undoTree value isKindOf: Integer])
ifFalse: [^self].
RefactoryChangeManager undoSize: undoTree value
!
synchronousUpdate
^ self class synchronousUpdate
!
syntaxHighlightedCodeFor:oldText method:mthd
|highlighter cls|
highlighter := mthd syntaxHighlighterClass.
highlighter == #askClass ifTrue:[
cls := mthd mclass ? Object.
highlighter := cls syntaxHighlighterClass.
].
highlighter isNil ifTrue:[ ^ oldText ].
^ highlighter formatMethod:oldText in:cls.
! !
!NewSystemBrowser methodsFor:'menu actions-debug'!
commonTraceHelperWith:aSelector with:argumentOrNil clear:doClear
"install a break/trace or countPoint for the current method"
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
!
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.
[:context :method |
"/ any condition using context and method.
"/ Useful queries are:
"/ - Processor activeProcess the active process
"/
"/ Useful queries to the context are:
"/ - receiver the receiver
"/ - sender the sender context
"/ - sender selector the sender contexts selector
"/ - sender receiver the sender contexts receiver
"/
"/ example (breakPoint hits if the receiver is a NewSystemBrowser)
(context receiver isMemberOf:NewSystemBrowser)
]
'.
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: / 18.8.2000 / 22:16:06 / 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"
!
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.
! !
!NewSystemBrowser methodsFor:'menu actions-help'!
openDocumentation
HTMLDocumentView openFullOnDocumentationFile:'tools/newbrowser/TOP.html'
!
openKeywordIndexDocumentation
HTMLDocumentView openFullOnDocumentationFile:'index.html'
!
openRefactoringDocumentation
HTMLDocumentView openFullOnDocumentationFile:'tools/newbrowser/refactorings.html'
! !
!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
!
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-project'!
classMenuCheckInBuildSupportFiles
self selectedClassesDo:[:eachClass |
eachClass theNonMetaclass isProjectDefinition ifTrue:[
self projectMenuCheckInBuildSupportFilesForProject:eachClass package
]
]
"Created: / 09-08-2006 / 19:04:52 / fm"
"Modified: / 21-08-2006 / 15:50:22 / cg"
!
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:true
].
].
"Created: / 10-08-2006 / 16:33:07 / 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"
!
projectDefinitionDialogFor:aProjectIDOrNil
|boxLabel box initial newProjectID currentProject field
packageIDHolder projectTypeHolder
projectDefinitionClass y defaultProjectType classesInPackage|
aProjectIDOrNil notNil ifTrue:[
initial := aProjectIDOrNil.
boxLabel := 'Create ProjectDefinition Class'.
classesInPackage := Smalltalk allClassesInPackage:aProjectIDOrNil.
(classesInPackage contains:[:cls | cls isVisualStartable])
ifTrue:[ defaultProjectType := ProjectDefinition guiApplicationType]
ifFalse:[
(classesInPackage contains:[:cls | cls isStartableWithMain])
ifTrue:[ defaultProjectType := ProjectDefinition nonGuiApplicationType]
ifFalse:[ defaultProjectType := ProjectDefinition libraryType]].
] ifFalse:[
initial := 'module:directory'.
currentProject := self theSingleSelectedProject.
currentProject notNil ifTrue:[
initial := currentProject.
(currentProject includes:$:) ifTrue:[
initial := initial , '/'.
] ifFalse:[
initial := initial , ':'.
].
] ifFalse:[
initial := OperatingSystem getLoginName , ':'.
].
initial := initial , 'newProject'.
boxLabel := 'Create New Project'.
defaultProjectType := ProjectDefinition defaultProjectType.
].
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: / 23-08-2006 / 14:28:32 / cg"
!
projectMenuBitmapFiles
self information:'Sorry - this functionality is not yet implemented'
!
projectMenuBuild
"/ intermediate - this will move into a commonly used utility class
"/ (where all the project code support will be collected).
|buildDirectory directoryIsOKForMe package module directory defClass mgr
repository stxRepository stc default|
package := self theSingleSelectedProject.
module := package upTo:$:.
directory := package copyFrom:(module size + 2).
"/ self projectMenuCheckInAll.
[
default := buildDirectory
ifNil:[ PreviousBuildDirectory
ifNil:[ Smalltalk packageDirectoryForPackageId:'']].
buildDirectory := Dialog requestDirectoryName:'Temporary Work-ROOT for build:'
default:default.
buildDirectory isEmptyOrNil ifTrue:[^ self].
buildDirectory := buildDirectory asFilename.
directoryIsOKForMe := true.
buildDirectory exists ifFalse:[
Dialog warn:(resources string:'Work directory %1 does not exist.' with:buildDirectory).
directoryIsOKForMe := false.
] ifTrue:[
(buildDirectory construct:'stx') exists ifFalse:[
Dialog warn:'Work directory must contain an stx subDirectory,\which contains (at least) the stc and include subdirectories.' withCRs.
directoryIsOKForMe := false.
] ifTrue:[
stc := (OperatingSystem isMSDOSlike) ifTrue:['stc.exe'] ifFalse:['stc'].
(((buildDirectory construct:'stx')construct:'stc')construct:stc) exists ifFalse:[
Dialog warn:'Work directory must contain an stc compiler in the stx/stc subDirectory.' withCRs.
directoryIsOKForMe := false.
].
((buildDirectory construct:'stx')construct:'include') exists ifFalse:[
Dialog warn:'Work directory must have had a make run before (for include files to exists).' withCRs.
directoryIsOKForMe := false.
].
]
]
] doUntil:[ directoryIsOKForMe ].
PreviousBuildDirectory := buildDirectory.
defClass := ProjectDefinition definitionClassForPackage:package.
mgr := defClass sourceCodeManager.
repository := (mgr repositoryNameForModule:module) ifNil:[mgr repositoryName].
stxRepository := mgr repositoryName.
(buildDirectory construct:'stx') exists ifFalse:[
(module ~= 'stx') ifTrue:[
OperatingSystem
executeCommand:('cvs -d ',stxRepository,' co stx')
inputFrom:nil
outputTo:Transcript
errorTo:Transcript
inDirectory:buildDirectory
onError:[:status| self error:'cvs update stx failed'].
].
].
((buildDirectory construct:module) construct:'CVS') exists ifFalse:[
OperatingSystem
executeCommand:('cvs -d ',repository,' co -l ',directory)
inputFrom:nil
outputTo:Transcript
errorTo:Transcript
inDirectory:buildDirectory
onError:[:status| self error:'cvs update failed'].
].
OperatingSystem
executeCommand:'cvs upd -d'
inputFrom:nil
outputTo:Transcript
errorTo:Transcript
inDirectory:(buildDirectory construct:module)
onError:[:status| self error:'cvs update failed'].
OperatingSystem
executeCommand:(ParserFlags makeCommand)
inputFrom:nil
outputTo:Transcript
errorTo:Transcript
inDirectory:((buildDirectory construct:module) construct:directory)
onError:[:status| self error:'make failed'].
"Created: / 09-08-2006 / 18:37:19 / fm"
"Modified: / 09-08-2006 / 19:55:50 / fm"
"Modified: / 23-08-2006 / 12:21:20 / cg"
!
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:true.
defClass isNil ifTrue:[
defClass := self projectDefinitionDialogFor:packageID.
defClass isNil ifTrue:[ ^ self ].
defClass compileDescriptionMethods.
].
defClass validateDescription.
mgr := defClass sourceCodeManager.
module := packageID asPackageId module.
directory := packageID asPackageId directory.
defClass forEachFileNameAndGeneratedContentsDo:[:fileName :fileContents |
mgr isNil ifTrue:[
self
warn:'No sourceCode manager - cannot checkin.\Will present generated '
, fileName , '-file in an editor.' withCRs.
EditTextView openOnModel:fileContents.
] ifFalse:[
self
activityNotification:(resources string:'checking in %1...' with:fileName).
UserInformation
handle:[:ex | Transcript showCR:ex description ]
do:[
(mgr
checkForExistingContainerInModule:module
directory:directory
container:fileName)
ifFalse:[
(mgr
createContainerForText:fileContents
inModule:module
package:directory
container:fileName)
ifFalse:[
self warn:(resources
string:'Cannot create new container: ''%3'' (in %1:%2)'
with:module
with:directory
with:fileName).
].
]
ifTrue:[
(mgr
checkin:fileName
text:fileContents
directory:directory
module:module
logMessage:'automatically generated by browser'
force:false)
ifFalse:[
Transcript showCR:'checkin of ' , fileName , ' failed'.
anyFailure := true.
].
].
].
].
].
defClass instAndClassMethodsDo:[:m | m package:defClass package].
self
checkInClasses:(Array with:defClass)
withInfo:'automatic checkIn'
withCheck:false.
anyFailure ifTrue:[
self warn:'Checkin failed - see Transcript.'.
] ifFalse:[
self activityNotification:'Build files checked into the repository'.
].
"Created: / 09-08-2006 / 18:59:42 / fm"
"Modified: / 16-08-2006 / 18:38:49 / User"
"Modified: / 23-08-2006 / 13:59:49 / 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 answer labels values 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 | ChangeSet current includesChangeForClassOrMetaclassOrPrivateClassOf:cls].
"/ individual methods ...
classes do:[:aClass |
aClass isMeta ifFalse:[
"/ ... whose class is not in the ckechIn-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:[
answer := true. "/ dont ask...
false ifTrue:[
|classesWithExtensions|
classesWithExtensions := (methodsToCheckIn collect:[:mthd | mthd mclass]) asIdentitySet.
msg := 'Found %1 extension method'.
methodsToCheckIn size > 1 ifTrue:[
msg := msg , 's'
].
classesWithExtensions size == 1 ifTrue:[
msg := msg , ' for ''%4'' in the %2 class.'
] ifFalse:[
msg := msg , ' for ''%4'' in %3 classes.'
].
methodsToCheckIn size == 1 ifTrue:[
msg := msg , '\\Check this method into the extensions container of the %4 project ?'.
] ifFalse:[
msg := msg , '\\Check these methods into the extensions container of the %4 project ?'.
].
msg := msg withCRs.
msg := msg bindWith:methodsToCheckIn size
with:classesWithExtensions first name allBold
with:classesWithExtensions size
with:packageToCheckIn allBold.
labels := #('Cancel' 'Browse' 'No' 'Yes').
values := #(#cancel #browse false true).
answer := OptionBox
request:msg withCRs
label:'Checkin project'
buttonLabels:(resources array:labels)
values:values
default:true
onCancel:#cancel.
answer == #cancel ifTrue:[ AbortOperationRequest raise ].
answer == #browse ifTrue:[
self
spawnMethodBrowserFor:methodsToCheckIn
in:#newBrowser
label:('Extension Methods of Project %1' bindWith:packageToCheckIn).
AbortOperationRequest raise
].
].
answer == true ifTrue:[
checkinInfo := SourceCodeManagerUtilities
getCheckinInfoFor:('%1 classes (%4 changed) and %2 extensions of project "%3"'
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.
]
]
]
].
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 tagIt:false.
].
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 == Project 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 := 'There ''%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.
answer := Dialog confirm:msg noLabel:(resources string:'Cancel').
answer ~~ true ifTrue:[^ 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.
answer := Dialog confirm:msg noLabel:(resources string:'Cancel').
answer ~~ true ifTrue:[^ 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.
!
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.
"
self checkOutClasses:(self selectedProjectClasses) askForRevision:false
!
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
hasLoadAll hasMakeProto hasNtMakefile hasAbbrev
otherFiles classesInProject |
containerModule := packageToCheck upTo:$:.
containerPackage := packageToCheck copyFrom:(containerModule size + 2).
self busyLabel:'Checking ' , packageToCheck , '...'.
containers := SourceCodeManager getExistingContainersInModule:containerModule directory:containerPackage.
containers := containers select:[:each | (each startsWith:'.') not].
hasLoadAll := containers includes:'loadAll'.
hasMakeProto := containers includes:'Make.proto'.
hasNtMakefile := containers includes:'nt.mak'.
hasAbbrev := containers includes:'abbrev.stc'.
hasExtensionContainer := containers includes:'extensions.st'.
containers removeAllFoundIn:#('loadAll' 'Make.proto' 'nt.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 := eachClassInProject sourceCodeManager.
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 |
(aChangeSet includesChangeForClassOrMetaclassOrPrivateClassOf:eachClassInProject)
or:[eachClassInProject allPrivateClasses contains:[:aPrivateClass |
aChangeSet includesChangeForClassOrMetaclassOrPrivateClassOf:aPrivateClass]]
])
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: / 23-08-2006 / 14:13:07 / 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|
selectedProjects := self selectedProjectsValue.
currentProject := self theSingleSelectedProject.
currentProject notNil ifTrue:[
fileName := currentProject asString.
fileName replaceAll:Character space with:$_.
fileName replaceAll:$: with:$_.
fileName replaceAll:$/ 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
].
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 isNil ifTrue:[
^ self
].
saveName isEmpty ifTrue:[
self warn:'Bad name given'.
^ 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
].
self shouldImplement.
"/ 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
!
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
!
projectMenuGenerateLoadAllFile
"/ intermediate - this will move into a commonly used utility class
"/ (where all the project code support will be collected).
self
projectMenuWithAllClassesLoadedDo:[:module :directory :classesInProject |
|moduleAndPackage classesInLoadOrder mgr outStream hasExtensions|
moduleAndPackage := module , ':' , directory.
self busyLabel:'Generating loadAll file for ' , moduleAndPackage , '...'.
"/ now, generate the loadAll file
classesInLoadOrder := self projectsClassesInLoadOrder:classesInProject.
hasExtensions := Smalltalk allClasses contains:[:cls | (cls hasExtensionsFrom:moduleAndPackage)].
mgr := classesInLoadOrder first sourceCodeManager.
mgr isNil ifTrue:[
self warn:'No sourceCode manager - cannot checkin\(will generate a loadAll-file in the current directory).' withCRs.
'loadAll' asFilename exists ifTrue:[
(self confirm:'A loadAll file exists in the current directory\\Overwrite ?' withCRs) ifFalse:[
^ self.
]
].
outStream := 'loadAll' asFilename writeStream.
] ifFalse:[
(mgr checkForExistingContainerInModule:module directory:directory container:'loadAll') ifFalse:[
(mgr createContainerForText:'' inModule:module package:directory container:'loadAll') ifFalse:[
self warn:(resources string:'cannot create new container: ''loadAll'' (in %1:%2)'
with:module with:directory).
^ self.
].
].
outStream := '' writeStream.
].
outStream nextPutAll:'"/
"/ $' , 'Header' , '$
"/
"/ loadAll-file to fileIn code for: ' , moduleAndPackage , '
"/
"/ Automatically generated by the browsers generate-loadAll function.
"/ DO NOT MODIFY THIS fILE;
"/
"/
"/ Prerequisites:
"/
"/ Smalltalk loadPackage:''module:directory''.
"/ Smalltalk loadPackage:''....''.
!!
"{ package:''' , moduleAndPackage , ''' }"
!!
|files|
''loading package ' , moduleAndPackage ,'...'' infoPrintCR.
files := #(
'.
classesInLoadOrder do:[:eachClass |
|sourceInfo classFilename|
sourceInfo := eachClass sourceCodeManager sourceInfoOfClass:eachClass.
sourceInfo notNil ifTrue:[
classFilename := eachClass sourceCodeManager containerFromSourceInfo:sourceInfo.
] ifFalse:[
classFilename := eachClass classFilename.
].
outStream nextPutLine:' ''' , classFilename asFilename baseName, ''''.
].
hasExtensions ifTrue:[
outStream nextPutLine:' ''extensions.st'''.
].
outStream nextPutAll:'
) asOrderedCollection.
"/ see if there is a classLibrary
(Smalltalk fileInClassLibrary:''' , directory , ''') ifTrue:[
|handle loaded|
handle := ObjectFileLoader loadedObjectHandles
detect:[:h | h package = ''' , moduleAndPackage , '''] ifNone:nil.
handle ifNotNil:[
loaded := Set new:(handle classes size).
handle classes do:[:c| c isMeta ifFalse:[loaded add:c classFilename]].
files := files asOrderedCollection select:[:f| (loaded includes:f) not].
].
].
"/ load files which are not in the classLibrary (all if there is none)
files size > 0 ifTrue:[
files do:[:f |
''.'' infoPrint.
f asFilename exists ifTrue:[
Smalltalk fileIn:f.
] ifFalse:[
Smalltalk fileIn:(''source/'' , f)
]
].
'' '' infoPrintCR.
].
'' done (' , moduleAndPackage ,').'' infoPrintCR.
'.
outStream close.
mgr notNil ifTrue:[
self activityNotification:(resources string:'checking in...').
UserInformation handle:[:ex |
Transcript showCR:ex description
] do:[
(mgr
checkin:'loadAll'
text:(outStream contents)
directory:directory
module:module
logMessage:'automatically generated by browser'
force:false)
ifFalse:[
Transcript showCR:'checkin of loadAll failed'.
self warn:'checkin failed'.
].
].
].
].
"Created: / 09-08-2006 / 18:55:49 / fm"
"Modified: / 23-08-2006 / 14:01:22 / cg"
!
projectMenuGenerateProjectDefinitions
|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.
]
].
self generateProjectDefinitionsIn:projectClasses
!
projectMenuImport
"import packages - but do not load classes"
self projectMenuImport:false
!
projectMenuImport:doLoadClasses
|currentProject default pkg fromWhere abbrevFile loadAllFile
moduleDir packageDir package numImported numSkipped msg chgSet classDefs s|
currentProject := self theSingleSelectedProject.
currentProject isNil ifTrue:[
default := 'module:package'
] ifFalse:[
moduleDir := currentProject upTo:$:.
moduleDir 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
moduleDir := pkg upTo:$:.
moduleDir size + 2 > pkg size ifTrue:[
package := packageDir := nil. "/ i.e. all
] ifFalse:[
package := packageDir := pkg copyFrom:moduleDir size + 2.
(package includesMatchCharacters) ifTrue:[
packageDir := nil. "/ must check out everything and filter
].
].
(SourceCodeManager checkForExistingModule:moduleDir) ifFalse:[
^ self warn:'No module ''' , moduleDir , ''' in the repository.'.
].
packageDir notNil ifTrue:[
(SourceCodeManager checkForExistingModule:moduleDir package:packageDir) ifFalse:[
^ self warn:'No package ''' , packageDir , ''' in the repository (but the module exists).'.
]
].
"/ check out that module ...
SourceCodeManager
checkoutModule:moduleDir
directory:packageDir
andDo:[:tempDir |
|filesThere skip|
numImported := numSkipped := 0.
tempDir asFilename withAllDirectoriesDo:[:eachDir |
|relDir theProject anyFound|
( #( 'CVS' 'bitmaps' 'resources' ) includes:eachDir baseName)
ifFalse:[
relDir := eachDir name copyFrom:tempDir name size + 2.
packageDir notNil ifTrue:[
relDir size > 0 ifTrue:[
relDir := packageDir asFilename constructString:relDir
] ifFalse:[
relDir := packageDir
]
].
relDir size > 0 ifTrue:[ theProject := moduleDir , ':' , relDir ].
skip := false.
(packageDir 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 , '...').
abbrevFile := eachDir construct:'abbrev.stc'.
abbrevFile exists ifTrue:[
anyFound := true.
Transcript showCR:(' loading ' , abbrevFile pathName , '...').
Smalltalk installAutoloadedClassesFrom:abbrevFile pathName.
numImported := numImported + 1.
] ifFalse:[
loadAllFile := eachDir construct:'loadAll'.
loadAllFile exists ifTrue:[
anyFound := true.
doLoadClasses ifTrue:[
Transcript showCR:(' loading ' , loadAllFile pathName , '...').
Smalltalk fileIn:loadAllFile.
].
numImported := numImported + 1.
] ifFalse:[
filesThere := eachDir directoryContents select:[:eachFile | eachFile asFilename hasSuffix:'st'].
filesThere isEmpty ifTrue:[
Transcript showCR:(eachDir pathName , ': no abbrev.stc, loadAll or smalltalk file found (although such a packageDir exists in the repository).').
] 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 ...
classDefs := ChangeSet new.
filesThere do:[:eachSTFile |
s := (eachDir asFilename construct:eachSTFile) readStream.
chgSet := ChangeSet fromStream:s.
s close.
classDefs addAll:(chgSet select:[:change | change isClassDefinitionChange]).
].
"/ now, install ...
classDefs do:[:eachClassDefinition |
"should set the filename here"
eachClassDefinition installAsAutoloadedClassIfPublicWithFilename:nil.
].
doLoadClasses ifTrue:[
filesThere do:[:eachSTFile |
Transcript showCR:(' loading ' , (eachDir asFilename constructString:eachSTFile) , '...').
Smalltalk fileIn:(eachDir asFilename construct:eachSTFile).
].
numImported := numImported + 1.
].
].
]
].
anyFound ifFalse:[
Transcript showCR:('Neither abbrev, nor loadAll file found - use import & load classes please.').
]
].
(anyFound and:[theProject notNil]) ifTrue:[
self projectListApp addAdditionalProject:theProject.
]
]
]
].
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: / 23-08-2006 / 14:08:31 / cg"
!
projectMenuImportAndLoadClasses
"import packages AND load classes"
self projectMenuImport:true
!
projectMenuLoad
|projects projectsString|
projects := (self selectedProjects value) ? #().
projectsString := projects asStringCollection asStringWith:', '.
LastLoadedPackages isNil ifTrue:[
LastLoadedPackages := OrderedCollection new.
].
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: / 30-08-2006 / 18:25:58 / 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].
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 ].
defClass := ProjectDefinition definitionClassForPackage:project.
(ProjectDefinitionEditor new
definitionClass:defClass) open
"Modified: / 05-09-2006 / 18:24:25 / 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
(self askIfModified:'Code was modified.\\Show history anyway ?')
ifFalse:[^ self].
self withWaitCursorDo:[
|timeGoal moduleFilter aStream box y component
timeGoalListPop |
box := Dialog new.
(box addTextLabel:(resources string:'repository change report')) adjust:#left.
box addVerticalSpace:20.
timeGoal := 'yesterday' asValue.
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.
timeGoalListPop list:#('yesterday'
'a week ago'
'a month ago'
'a year ago'
'all'
).
box addAbortAndOkButtons.
box open.
box accepted ifTrue:[
moduleFilter := self selectedProjects value.
moduleFilter size == 0
ifTrue:[moduleFilter := nil].
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:nil
filterRepository:nil
filterModules:moduleFilter
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: / 17.1.2001 / 13:06:40 / cg"
"Modified: / 17.1.2001 / 13:19:10 / cg"
!
projectMenuResources
self information:'Sorry - this functionality is not yet implemented'
!
projectMenuShowGeneratedBuildFile:whichFile
"/ intermediate - this will be removed later
|package defClass newFile oldFile editor differ theFile|
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 packageName,'.rc'.
].
newFile := defClass generateFile:theFile.
oldFile := SourceCodeManager
getFile:theFile
revision:#newest
directory:(package asPackageId directory)
module:(package asPackageId module).
differ := DiffTextView
openOn:oldFile label:(resources string:'Newest %1 in Repository' with:theFile)
and:newFile label:(resources string:'Generated %1' with:theFile).
"/ editor := EditTextView openOnModel:newFile.
"/ editor topView label:theFile.
"Created: / 29-08-2006 / 15:35:44 / 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
!
projectMenuUpdate
self projectListApp forceUpdateList
!
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 mgr 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 := eachClassInProject sourceCodeManager.
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: / 23-08-2006 / 14:00:28 / cg"
!
projectsClassesInLoadOrder:classesInProject
|classesInLoadOrder|
classesInLoadOrder := OrderedCollection new:(classesInProject size).
[classesInProject size > 0] whileTrue:[
|thoseWithOtherSuperclasses thoseWhichCanBeLoadedNow|
"/ all those, which have superclasses NOT in the package
thoseWithOtherSuperclasses := classesInProject select:[:eachClass | (classesInProject includesIdentical:eachClass superclass) not].
"/ all those with privateClasses, which have superclasses NOT in the package
thoseWhichCanBeLoadedNow := thoseWithOtherSuperclasses select:[:eachClass |
|anyPrivateClassWithSuperClassInPackage|
anyPrivateClassWithSuperClassInPackage := false.
eachClass privateClasses do:[:eachPrivateClass |
(classesInProject includesIdentical:eachPrivateClass superclass) ifTrue:[
anyPrivateClassWithSuperClassInPackage := true
]
].
anyPrivateClassWithSuperClassInPackage ifTrue:[
Transcript showCR:('later load of ' , eachClass name , ' due to a private classes superclass').
].
anyPrivateClassWithSuperClassInPackage not.
].
thoseWhichCanBeLoadedNow size == 0 ifTrue:[
self error:'load order is cyclic (care for private classes)' mayProceed:true.
thoseWhichCanBeLoadedNow := thoseWithOtherSuperclasses.
thoseWhichCanBeLoadedNow size == 0 ifTrue:[
self error:'load order is cyclic'.
]
].
thoseWhichCanBeLoadedNow := thoseWhichCanBeLoadedNow asOrderedCollection sort:[:a :b | a name < b name].
classesInLoadOrder addAll:thoseWhichCanBeLoadedNow.
classesInProject removeAllFoundIn:thoseWhichCanBeLoadedNow.
].
^ classesInLoadOrder
!
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 organizerMode value:#project.
brwsr projectListGenerator value:projectList.
brwsr packageFilter value:projectList.
brwsr selectProjects:(singleSelection ifTrue:[projectList] ifFalse:[#()]).
brwsr immediateUpdate value:false.
]
"Modified: / 18.8.2000 / 18:48:40 / 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
! !
!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
self shouldImplement.
"/methodCategoryFileOut
"/ "fileOut all methods in the selected methodcategory of
"/ the current class"
"/
"/ self checkClassSelected ifFalse:[^ self].
"/ self whenMethodCategorySelected:[
"/ self busyLabel:'saving: %1' with:currentClass name , '-' , currentMethodCategory.
"/ Class fileOutErrorSignal handle:[:ex |
"/ self warn:'cannot create: %1' with:ex parameter.
"/ self normalLabel.
"/ ex return.
"/ ] do:[
"/ actualClass fileOutCategory:currentMethodCategory.
"/ ].
"/ self normalLabel.
"/ ]
!
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)
((sel == #version) 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:'
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 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 |
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: / 6.2.2000 / 02:35:18 / 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).
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 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 title okText okText2 okText3 className canFind
button2 button3 doWhat doWhat2 doWhat3|
doWhat := doWhatByDefault.
canFind := navigationState isFullBrowser.
title := (singleClass ifTrue:[ 'Class to browse' ] ifFalse:[ 'Class(es) to browse' ]).
(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 classHistory collect: [:entry | entry className])
okText:okText.
box label:(resources string:'Browse or Search').
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.
].
].
box entryCompletionBlock:(self classNameEntryCompletionBlock).
box action:[:aString | className := aString].
box open.
className isNil ifTrue:[^ self "cancel"].
self withSearchCursorDo:[
aBlock value:className value:singleClass value:doWhat.
]
!
findClass:classNameArg single:singleClass in:doWhat
|className brwsr class classes box classNames aliases currentNamespace|
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.
classes := classes select:[:each | each isNameSpace not or:[each == Smalltalk]].
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:(self classNameEntryCompletionBlock).
box action:[:aString | className := aString string].
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: / 22-08-2006 / 13:22:45 / 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:nil "/ 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 := [ |s l|
s := box contents.
s includesMatchCharacters ifTrue:[
l := Set new.
Smalltalk allClassesDo:[:cls |
cls instAndClassSelectorsAndMethodsDo:[:sel :mthd | |info|
(s match:sel) ifTrue:[
l add:sel.
]
].
].
box list:(l 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:(self 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 := DiffTextView
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 repository diffs allDiffs
mclass mselector theNonMetaclass lastClass lastRepositoryChangeSet|
self withWaitCursorDo:[
Method flushSourceStreamCache.
methods do:[:eachMethod |
mclass := eachMethod mclass.
mclass isNil ifTrue:[
self warn:('Cannot find methods class (obsolete).').
] ifFalse:[
theNonMetaclass := mclass theNonMetaclass.
mselector := eachMethod selector.
currentSource := eachMethod source asString.
current := ChangeSet new.
current addMethodChange:eachMethod in:mclass.
(lastClass ~~ theNonMetaclass) ifTrue:[
self busyLabel:'getting repository source...' with:nil.
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.
].
].
repository := lastRepositoryChangeSet
select:[:eachChange | eachChange isMethodChange
and:[eachChange selector = mselector
and:[eachChange className = mclass name]]].
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 isNil
or:[allDiffs changed isEmptyOrNil
and:[allDiffs onlyInReceiver isEmptyOrNil
and:[allDiffs onlyInArg isEmptyOrNil]]
]
) ifTrue:[
self information:'Versions are identical.'.
^ self.
].
VersionDiffBrowser
openOnDiffSet:allDiffs
labelA:'Repository'
labelB:'Image'
title:'Diffs'.
self normalLabel.
"Created: / 4.1.1997 / 15:48:20 / cg"
"Modified: / 28.4.1998 / 17:40:02 / 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.
eachMethod selector == #version 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"
|s classes cls|
cls := self theSingleSelectedClass.
cls isNil ifTrue:[
classes := self selectedClasses value.
classes notEmptyOrNil ifTrue:[
cls := classes first.
]
].
cls notNil ifTrue:[
cls theMetaclass isJavaScriptMetaclass ifTrue:[
s := TextStream on:''.
s nextPutAll:'//
// comment stating purpose of this method
//
function name ( arg1 , ... )
{
var temp1, ... ;
statement;
statement;
}
'.
s nextPutAll:'
// change the above template into real code;
// remove this comment.
// Then `accept'' either via the menu
// or via the keyboard (usually CMD-A).
// You do not need this template; you can also
// select any existing methods code, change it,
// and finally `accept''. The method will then be
// installed under the selector as defined in the
// actual text - no matter which method is selected
// in the browser, or where the original text came from.
// Or clear this text, type in the method from scratch
// and install it with `accept''.
'.
^ s contents
].
].
^ 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.2.2000 / 23:04:45 / cg"
!
moveMethods:methods toProtocol:newCategory
"move some methods to some other category"
|change numMethods mClass|
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 := eachMethod mclass.
change
changeCategoryOf:(eachMethod selector)
in:mClass
to:newCategory.
mClass addChangeRecordForMethodCategory:eachMethod category:newCategory.
].
RefactoryChangeManager performChange: change.
] ifFalse:[
methods do:[:mthd |
mClass := mthd mclass.
(self canUseRefactoringSupport) ifTrue:[
change := RefactoryMethodCategoryChange
changeCategoryOf:(mthd selector)
in:mClass
to:newCategory.
RefactoryChangeManager performChange: change.
] ifFalse:[
mthd category:newCategory.
].
mClass addChangeRecordForMethodCategory:mthd category:newCategory.
].
].
!
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)
((selectorToCopyOrMove == #version) 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|
RBParser isNil ifTrue:[^ self].
RBParser autoload.
tree := aClass parseTreeFor:oldSelector.
tree isNil ifTrue:[
self warn: 'Could not parse the method'.
^ self
].
args := tree argumentNames.
dialog := MethodNameDialog methodNameFor: args initial: oldSelector.
dialog cancelAllVisible value:(AbortAllSignal isHandled).
dialog renameOnlyVisible value:true.
dialog renameSelectedMethodsOnlyVisible value:true.
dialog allButOpen.
dialog window label:(resources string:'Rename "%1" to' with:oldSelector).
dialog openWindow.
dialog accepted ifFalse: [^ self].
newSelector := dialog methodName.
renameSelectedMethodsOnly := dialog isRenameSelectedMethodsOnly.
renameOnly := dialog isRenameOnly.
renameOnly ifFalse:[
(self findSendersOf:oldSelector andConfirmRefactoring:refactoring) 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))].
self withWaitCursorDo:[
|classesOfSelectedMethods affectedImplementors|
refactoring := RenameMethodRefactoring
renameMethod: oldSelector
in: aClass
to: newSelector
permuation: map.
refactoring suppressRewriteOfSenders:renameOnly.
renameSelectedMethodsOnly ifTrue:[
classesOfSelectedMethods := self selectedMethods value collect:[:m|m mclass].
affectedImplementors := refactoring implementors select:[:eachClass | classesOfSelectedMethods contains:[:cls | eachClass name == cls name]].
refactoring onlyRenameTheseImplementors:affectedImplementors.
].
"/ refactoring model name:('rename %1 to %2' bindWith:oldSelector storeString with:newSelector storeString).
rslt := self performRefactoring:refactoring.
self switchToSelector:newSelector asSymbol.
]
!
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]
!
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.
browser := ChangeSetBrowser openOn:dummyChangeSet.
browser readOnly:true.
!
selectorMenuBrowseRepositoryVersions
|method mclass mselector className mgr revisions previousMethods browser
lastSource currentSource lastRevision lastDate lastChange|
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.
mgr := mclass theNonMetaclass sourceCodeManager.
self withWaitCursorDo:[
|start stop answer t list msg first|
revisions := (mgr revisionLogOf:mclass) at:#revisions.
start := 1.
stop := revisions size.
stop > 20 ifTrue:[
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).'
] ifFalse:[
msg := msg,'\(this will take roughly %2 seconds).'
].
msg := msg,'\\Do you want to see all or only some of the revisions ?'.
answer := Dialog
choose:(resources stringWithCRs:msg
with:revisions size
with:(t * revisions size // 1000 // 10 * 10))
fromList:list values:revisions initialSelection:nil
buttons:nil
values:nil
default:nil
lines:20
cancel:[^ self]
multiple:false
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').
].
answer 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,'...').
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 asString = lastSource asString ifTrue:[
] 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 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: / 29-08-2006 / 15:01:50 / cg"
!
selectorMenuChangePrivacyTo:privacySymbol
self selectedMethodsDo:[:eachMethod |
|cls|
(eachMethod privacy ~~ privacySymbol) ifTrue:[
eachMethod privacy:privacySymbol.
cls := eachMethod containingClass.
cls notNil ifTrue:[
cls addChangeRecordForMethodPrivacy:eachMethod.
] ifFalse:[
self warn:'Cannot write change record (no class).'
].
]
].
!
selectorMenuCheckInProjectExtensions
|projects|
projects := ((self selectedMethods value) collect:[:each | each package]) asSet.
projects do:[:packageToCheckIn |
self
projectMenuCheckInProject:packageToCheckIn
classes:false
extensions:true
buildSupport:false
].
!
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).
!
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
].
v := DiffTextView
openOn:previousCode
label:'previous version'
and:m source
label:'current version'.
v label:(resources string:'comparing method').
v waitUntilVisible.
^ self
!
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"
XMLRepresenter isNil ifTrue:[
self warn:'Sorry - missing class: XMLRepresenter.\\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 implements: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 *'.
CodeGeneratorTool
createSubclassResponsibilityMethodFor:selector category:category in:eachClass.
]
!
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 implements: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 implements: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
!
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"
!
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
!
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
!
selectorMenuMoveToClass
"move the selected methods to some other class - typically a superclass"
self selectorMenuMoveOrCopy:#move
!
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
]
]
].
"/ add actual categories of selected methods
selectors := methodSelection collect:[:each | each selector].
(SystemBrowser findImplementorsOfAny:selectors in:(Smalltalk allClasses) ignoreCase:false)
do:[:otherMethod |
|cat|
(methodSelection includesIdentical:otherMethod) ifFalse:[
cat := otherMethod category.
someCategories add:cat.
goodCandidates add:cat.
]
].
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
!
selectorMenuNewImageSpec
"open a bitmap painter for a new image-spec method"
|editorClass currentClass|
(currentClass := self theSingleSelectedClass) notNil ifTrue:[
"/
"/ kludge - this info should come from somewhere else ...
"/
editorClass := self class resourceEditorClassFor:#image.
editorClass notNil ifTrue: [
editorClass
openOnClass:currentClass theNonMetaclass
andSelector:nil
]
]
!
selectorMenuNewMenuSpec
"open a Menu painter for a new menu-spec method"
|editorClass currentClass|
(currentClass := self theSingleSelectedClass) notNil ifTrue:[
"/
"/ kludge - this info should come from somewhere else ...
"/
editorClass := self class resourceEditorClassFor:#menu.
editorClass notNil ifTrue: [
editorClass
openOnClass:currentClass theNonMetaclass
andSelector:nil
]
]
!
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"
!
selectorMenuNewWindowSpec
"open a GUI painter for a new window-spec method"
|editorClass currentClass|
(currentClass := self theSingleSelectedClass) notNil ifTrue:[
"/
"/ kludge - this info should come from somewhere else ...
"/
editorClass := self class resourceEditorClassFor:#canvas.
editorClass notNil ifTrue: [
editorClass
openOnClass:currentClass theNonMetaclass
andSelector:nil
]
]
!
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)
!
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).
eachMethod selector == #version 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 ]
!
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
!
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:methods in:where label:labelOrNil perClassInfo:perClassInfo perMethodInfo:perMethodInfo 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 theMethodNameList spec "singleSelection"|
theMethodList := methods copy.
theMethodNameList := methods collect:[:eachMethod | eachMethod mclass->eachMethod selector].
((perMethodInfo size > 0) or:[perClassInfo size > 0]) ifTrue:[
perClassInfo size > 0 ifTrue:[
perMethodInfo size > 0 ifTrue:[
spec := #multipleClassWithInfoAndMethodWithInfoBrowserSpec.
] ifFalse:[
spec := #multipleClassWithInfoBrowserSpec.
]
] ifFalse:[
spec := #multipleMethodWithInfoBrowserSpec.
]
] ifFalse:[
spec := #multipleMethodBrowserSpec.
"/ (singleSelection := theMethodList size) == 1 ifTrue:[
"/ spec := #singleMethodBrowserSpec.
"/ ].
].
^ self
newBrowserOrBufferDependingOn:where
label:labelOrNil
forSpec:spec
setupWith:[:brwsr |
|methodGenerator classGenerator|
methodGenerator := Iterator on:[:whatToDo |
theMethodNameList do:[:mAssoc |
|methodClass methodSelector method|
methodClass := mAssoc key.
methodSelector := mAssoc value.
method := methodClass compiledMethodAt:methodSelector.
method notNil ifTrue:[
whatToDo
value:methodClass
value:method category
value:methodSelector
value:method.
].
].
"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 := perClassInfo 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.
]
].
]
"Modified: / 5.11.2001 / 17:08:45 / 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.
]
"Created: / 05-09-2006 / 11:07:05 / 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]
].
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 := IdentitySet new.
Smalltalk allClasses do:[:eachClass |
|cPackage|
cPackage := eachClass package.
eachClass instAndClassMethodsDo:[:eachMethod |
|mPackage|
mPackage := eachMethod package.
mPackage ~= cPackage ifTrue:[
(theSinglePackage notNil
ifTrue:[theSinglePackage = mPackage]
ifFalse:[packages includes:mPackage])
ifTrue:[
l add:eachMethod
]
]
]
].
l := l asOrderedCollection
].
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.
]
!
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 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"
|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
^ 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|
"/ (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)']).
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
]
]
!
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|
what := readersOnly
ifTrue:'Getters'
ifFalse:[
writersOnly
ifTrue:'Setters'
ifFalse:'Accessors'].
self
generateUndoableChangeOverSelectedClasses:'Generate ',what,' in %(singleClassNameOrNumberOfClasses)'
via:[:generator :eachClass |
names size > 0 ifTrue:[
generator
createAccessMethodsFor:names
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
!
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
!
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
]
].
!
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.
!
variablesMenuTypeInfoOrBrowseTypes:doBrowseTypes
"show typical usage of a variable"
|name idx classes values value msg cut names instCount subInstCount
searchClass s canInspect canInspectMultiple showingInstVars showingClassVars currentClass
nilIncluded commonSuperClass boxLabels boxValues answer|
name := self theSingleSelectedVariable.
name isNil ifTrue:[^ self].
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 selectedClasses value do:[:cls | |sCls|
sCls := (cls theNonMetaclass whichClassDefinesClassVar:name).
sCls notNil ifTrue:[ searchClass := sCls ]].
] ifFalse:[
searchClass := currentClass theNonMetaclass whichClassDefinesClassVar:name.
].
value := searchClass classVarAt:(name asSymbol).
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:[^ self].
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).
^ self
].
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 , '>'.
]
].
doBrowseTypes ifTrue:[
classes size > 1 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
].
!
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:'menu-actions-other'!
editModeInsert
self codeView editModeInsert
!
editModeInsertAndSelect
self codeView editModeInsertAndSelect
!
editModeOverwrite
self codeView editModeOverwrite
! !
!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) 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: / 05-09-2006 / 10:26:07 / 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
<resource: #programMenu >
^ [
|cls m |
cls := self theSingleSelectedClass.
cls notNil ifTrue:[
m := cls theNonMetaclass classOperationsMenu
].
m
].
!
codeViewMenu
"add more functionality to the codeViews text-editor-menu"
<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 ].
self hasLocalSelectorSelectedInCodeView ifFalse:[
menuOthers disable:#browseResponseToIt
].
].
].
^ menu
!
editModeInfoLabelMenu
<resource: #programMenu >
^ self class editModeInfoLabelMenu.
!
findHistoryMenu
<resource: #programMenu >
^ [
|m|
FindHistory size > 0 ifTrue:[
m := Menu new.
FindHistory do:[:entry |
|item name sel|
name := entry className ? '?'.
entry meta ifTrue:[
name := name , ' class'.
].
name := name allBold.
(sel := entry selector) notNil ifTrue:[
name := name , ' ' , sel.
].
item := MenuItem label:(name contractTo:100).
m addItem:item.
item value:#'switchToFindHistoryEntry:'.
item argument:entry.
].
].
m
].
!
implementedMessagesMenu
^ self
messagesMenuFor:#'spawnBrowserOnAllImplementorsOf:'
withSenderChain:false
withImplementorChain:true
withLocalSenders:false
withLocalImplementors:true
selfSendsOnly:false
"Modified: / 05-09-2006 / 10:34:10 / 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
<resource: #programMenu >
^ [
|m mthd mSel contractedSelector item l cut|
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.
].
withLocalImplementors ifTrue:[
"/ item := MenuItem label:(resources string:' %1 - Local Implementors' with:contractedSelector).
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.
].
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 >>').
]
"
]
].
m
].
"Created: / 05-09-2006 / 10:32:43 / 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: / 10.12.2001 / 19:50:07 / cg"
! !
!NewSystemBrowser methodsFor:'navigation'!
askForClassNameMatching:matchStringArg
|classNames caselessMatchingNames
substringMatchingNames caselessSubstringMatchingNames
caselessWithoutPrefixSubstringMatchingNames
lcMatchString subMatch lcSubMatch box className
needSearch cls env searchBlock
idx pref aMatchString allNames sortedBySpellingDistance msg|
env := self navigationState environment.
aMatchString := matchStringArg.
"/ try to limit search to a namespace (but only if nameSpace is not a matchCharacter)
(aMatchString includesString:'::') ifTrue:[
"/ pref := aMatchString upTo:$:.
idx := aMatchString lastIndexOf:$:.
pref := aMatchString copyTo:idx-2.
pref includesMatchCharacters ifTrue:[
"/ search all in Smalltalk
] ifFalse:[
cls := Smalltalk at:pref asSymbol ifAbsent:nil.
(cls notNil and:[cls isBehavior]) ifTrue:[
env := cls.
aMatchString := aMatchString copyFrom:pref size + 1 + 2.
].
].
].
classNames := Set new.
caselessMatchingNames := Set new.
substringMatchingNames := Set new.
caselessSubstringMatchingNames := Set new.
caselessWithoutPrefixSubstringMatchingNames := Set new.
lcMatchString := aMatchString asLowercase.
needSearch := true.
aMatchString includesMatchCharacters ifFalse:[
subMatch := '*' , aMatchString , '*'.
lcSubMatch := subMatch asLowercase.
"/ if the name is already a good one, avoid the expensive search
className := aMatchString asSymbolIfInterned.
className notNil ifTrue:[
env isNameSpace ifTrue:[
cls := env at:className ifAbsent:nil.
] ifFalse:[
cls := env privateClassesAt:className.
].
(cls notNil and:[cls isBehavior]) ifTrue:[
needSearch := false.
]
]
].
needSearch ifTrue:[
searchBlock := [:aClass |
|thisName|
"/ use dotted names for java
aClass isJavaClass ifTrue:[
thisName := aClass displayString. "/ fullName copyReplaceAll:$/ with:$.
] ifFalse:[
thisName := aClass name
].
(lcMatchString match:aClass name asLowercase) ifTrue:[
caselessWithoutPrefixSubstringMatchingNames add:thisName
].
aClass nameWithoutPrefix ~= aClass name ifTrue:[
(lcMatchString match:aClass nameWithoutPrefix asLowercase) ifTrue:[
caselessWithoutPrefixSubstringMatchingNames add:thisName
].
].
(aMatchString match:thisName) ifTrue:[
classNames add:thisName
] ifFalse:[
(lcMatchString match:thisName asLowercase) ifTrue:[
caselessMatchingNames add:thisName
] ifFalse:[
subMatch notNil ifTrue:[
(subMatch match:thisName) ifTrue:[
substringMatchingNames add:thisName
] ifFalse:[
(lcSubMatch match:thisName asLowercase) ifTrue:[
caselessSubstringMatchingNames add:thisName
]
]
]
]
]
].
(env == Smalltalk or:[env isNameSpace]) ifTrue:[
env allClassesDo:searchBlock
] ifFalse:[
env allPrivateClasses do:searchBlock
].
sortedBySpellingDistance := false.
"/ if nothing matched - try caseless matches
classNames size == 0 ifTrue:[
classNames := caselessMatchingNames.
"/ if nothing matched - try substring matches
classNames size == 0 ifTrue:[
classNames := substringMatchingNames.
"/ if nothing matched - try caseless substring matches
classNames size == 0 ifTrue:[
classNames := caselessSubstringMatchingNames.
"/ if nothing matched - try best fitting
classNames size == 0 ifTrue:[
aMatchString includesMatchCharacters ifFalse:[
allNames := SortedCollection sortBlock:[:a :b | a value > b value].
env allClassesDo:[:aClass |
|thisName dist|
aClass isJavaClass ifTrue:[
thisName := aClass displayString. "/ fullName copyReplaceAll:$/ with:$.
] ifFalse:[
thisName := aClass name
].
dist := thisName asLowercase spellAgainst:lcMatchString.
(thisName asLowercase startsWith:lcMatchString) ifTrue:[
dist := dist + (thisName size * 10).
].
allNames add:(thisName -> dist).
].
classNames := (allNames copyTo:(allNames size min:40)) collect:[:each | each key].
sortedBySpellingDistance := true.
]
]
]
]
].
(classNames size == 0) ifTrue:[^ nil].
(classNames size == 1) ifTrue:[
className := classNames first
] ifFalse:[
sortedBySpellingDistance ifFalse:[
classNames := classNames asArray sort.
].
aMatchString includesMatchCharacters ifTrue:[
msg := 'Classes matching "%1"\\Select or enter name of class to switch to:'
] ifFalse:[
msg := 'Classes containing "%1"\\Select or enter name of class to switch to:'
].
box := self listBoxTitle:(msg bindWith:matchStringArg) withCRs
okText:'OK'
list:classNames.
caselessWithoutPrefixSubstringMatchingNames notEmpty ifTrue:[
box initialText:(caselessWithoutPrefixSubstringMatchingNames first).
].
box action:[:aString | className := aString].
box open.
(box accepted not or:[className isNil]) ifTrue:[ "/ cancel
^ nil
]
].
].
className notNil ifTrue:[
"/ use slashed javaName for search.
(className includes:$.) ifTrue:[
className := className copyReplaceAll:$. with:$/
].
].
"/ pref notNil ifTrue:[
"/ ^ pref , '::' , className
"/ ].
^ className
"Modified: / 13.2.2000 / 20:57:42 / cg"
!
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 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.
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 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: / 18.8.2000 / 20:37:17 / 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 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 isNameSpace and:[aClass ~~ Smalltalk]) ifTrue:[
orgMode ~~ OrganizerCanvas organizerModeNamespace ifTrue:[
answer := self confirmWithCancel:('Browser: ' , aClass name , ' is a namespace - switch organizers display mode ?').
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 withAllSuperclasses includesIdentical:aClass) 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: / 24.2.2000 / 13:25:28 / 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 impl|
aMatchString knownAsSymbol ifTrue:[
class := Smalltalk classNamed:aMatchString.
class notNil ifTrue:[
self switchToClass:class.
^ self.
].
"/ impl := Smalltalk allImplementorsOf:aMatchString asSymbol.
"/ impl notEmptyOrNil ifTrue:[
"/ ].
].
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"
self switchToHistoryEntry:entry.
FindHistory removeIdentical:entry ifAbsent:nil.
!
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
|prev state|
state := buffers at:nr.
"/ select the buffer before that one
prev := nr - 1.
prev == 0 ifTrue:[
prev := buffers size.
].
bufferUsageOrder removeIdentical:state.
"/ select the buffer used before that one
prev := buffers identityIndexOf:(bufferUsageOrder first).
selectedBuffer value:prev.
buffers removeIndex:nr.
bufferNameList removeIndex:nr.
state canvas destroy.
"/ oops
prev > buffers size ifTrue:[
selectedBuffer value:buffers size.
].
buffers size == 1 ifTrue:[
selectedBuffer value:nil.
buffers := bufferUsageOrder := nil.
bufferNameList removeAll.
]
"Modified: / 24.2.2000 / 22:34:31 / 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"
!
canFileOutSIF
^ SmalltalkInterchangeFileManager notNil
!
canFileOutXML
^ XMLRepresenter notNil
!
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
^ RBParser notNil and:[RBParser isLoaded]
!
canUseRefactoringSupport
^ CodeGeneratorTool canUseRefactoringSupport
!
canUseRefactoringSupportAndHasClassSelected
^ self canUseRefactoringSupport and:[self hasClassSelected]
!
javaMode
"/ ^ currentnamespace == JAVA
^ false
! !
!NewSystemBrowser methodsFor:'private-code update'!
autoSearch:aString
"for compatibility with old browser"
self autoSearchPattern:aString
!
autoSearchCodePattern:codePattern
|searchAction|
codePattern notNil ifTrue:[
searchAction :=
[:direction :startLine :startCol :foundBlock :notFoundBlock|
|codeView|
codeView := self codeView.
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.
self codeView searchAction:searchAction
]
!
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:(codeView cursorLine ? startLine) startCol:(codeView cursorCol ? startCol)
ignoreCase:doIgnoreCase doMatch:doMatch
ifFound:
[:charPos1 :charPos2 |
codeView
cursorToCharacterPosition:charPos1;
selectFromCharacterPosition:charPos1 to:charPos2
]
ifNotFound:notFoundBlock
].
navigationState autoSearchAction:searchAction.
self codeView searchAction:searchAction
]
!
autoSearchVariables:aCollectionOfVariables readers:doReaders writers:doWriters
self searchVariables:aCollectionOfVariables readers:doReaders writers:doWriters asAutoSearch:true.
!
classDefinitionStringFor:aClass
|s|
s := '' writeStream.
(aClass isNameSpace and:[aClass ~~ Smalltalk]) 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.
!
searchForCodePattern:codePattern direction:direction startLine:startLine startCol:startCol
ifFound:foundBlock ifNotFound:notFoundBlock
|searcher|
ParseTreeSearcher isNil ifTrue:[ ^ 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|
ParseTreeSearcher isNil ifTrue:[ ^ 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|
ParseTreeSearcher isNil ifTrue:[ ^ 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
]
!
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 m s isComment stream|
self codeAspect:#classDefinition.
self setAcceptActionForClass.
aClass isNil ifTrue:[ ^ 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
"
(aClass isJavaClass
or:[aClass class isJavaScriptMetaclass]) ifFalse:[
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
].
].
stream := TextStream on:''.
stream cr; cr; cr.
stream emphasis:(UserPreferences current commentEmphasisAndColor).
s isNil ifTrue:[
stream nextPut:$" ; cr; nextPutLine:' no comment or documentation method found'.
] ifFalse:[
stream nextPut:$" ; cr; nextPutLine:' Documentation:'.
stream cr; nextPutLine:s; cr.
stream nextPutLine:' Notice: '.
stream nextPutAll:' the above text has been extracted from the classes '.
stream nextPutLine:(isComment ifTrue:['comment.'] ifFalse:['documentation method.']).
stream nextPutLine:' Any change in it will be lost if you ''accept'' here.'.
stream nextPutAll:' To change the '.
stream nextPutAll:(isComment ifTrue:['comment'] ifFalse:['documentation']).
stream nextPutAll:', switch to the '.
stream nextPutAll:(isComment ifTrue:['comment'] ifFalse:['documentation method']).
stream nextPutLine:' and ''accept'' any changes there.'.
].
stream nextPut:$".
stream emphasis:nil.
definition := definition , stream contents.
self codeHolder setValue:definition.
self codeView notNil ifTrue:[self codeView setContents:definition].
].
].
self updatePackageInfoForClass:aClass.
"Modified: / 15.11.2001 / 18:20:43 / 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 setAcceptActionForNothing.
self showNothing.
].
!
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
!
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 setAcceptActionForNothing.
self showNothing.
].
navigationState modified:false.
navigationState realModifiedState:false.
!
showMethodsCode:mthd
self showMethodsCode:mthd scrollToTop:true
"Modified: / 1.3.2000 / 11:39:14 / cg"
!
showMethodsCode:mthd scrollToTop:doScrollToTop
|code codeView|
codeView := self codeView.
self assert:codeView notNil.
code := self sourceOfMethod:mthd.
"/ code := mthd source.
(self doAutoFormat value
and:[RBFormatter notNil]) ifTrue:[
Error catch:[
code := RBFormatter format:code
].
].
(self doSyntaxColoring value ~~ false) ifTrue:[
"/ immediate coloring, if code is not too large;
"/ otherwise, do it in the background.
code size < 2000 " 10000 " ifTrue:[
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 showCode:nil.
self codeAspect:nil.
self normalLabel.
!
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 := ownerClass sourceCodeManager ? SourceCodeManager.
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: / 23-08-2006 / 14:11:00 / 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|
aClass notNil ifTrue:[
packageLabel := 'Base: ' , (aClass package ? '?').
aClass isLoaded ifTrue:[
loadInfo := ' [' , (aClass theNonMetaclass revision printString) , ']'.
aClass wasAutoloaded ifTrue:[
loadInfo := loadInfo , ' {Auto}'.
].
] ifFalse:[
loadInfo := ' {Unloaded}'.
].
packageLabel := packageLabel , loadInfo
].
navigationState packageLabelHolder value:packageLabel.
"Modified: / 17-08-2006 / 00:44:00 / cg"
!
updatePackageInfoForMethod:aMethod
|mpkg info mClass|
aMethod isNil ifTrue:[
^ self updatePackageInfoForClass:self theSingleSelectedClass.
].
mClass := aMethod mclass.
mClass isNil ifTrue:[
info := 'Unassigned'
] ifFalse:[
(mpkg := aMethod package) ~= mClass package
ifTrue:[
mpkg = Project defaultProject package ifTrue:[
info := 'Unassigned (' , mpkg , ')'
] ifFalse:[
info := 'Extension: ''' , mpkg , ''''
].
navigationState packageLabelHolder value:info
] ifFalse:[
info := 'Base: ''' , mpkg.
info := info , ''' [' , (aMethod mclass theNonMetaclass revision printString) , ']'.
].
].
navigationState packageLabelHolder value:info
"Modified: / 17-08-2006 / 00:43:39 / cg"
! !
!NewSystemBrowser methodsFor:'private-dialogs'!
askForDirectoryToFileOut:title default:defaultDirOrNil
|fileBox 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:labelHolderOrBlock searchWith:aSelectorOrBlock isSelector:isSelector 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
isSelector:isSelector
searchArea:whereDefault
withCaseIgnore:withCaseIgnore
withTextEntry:true
withMethodList:false
setSearchPattern:setSearchPatternAction
!
askForMethodAndSpawnSearchTitle:title browserLabel:labelHolderOrBlock searchWith:aSelectorOrBlock isSelector:isSelector searchArea:whereDefault withCaseIgnore:withCaseIgnore withMatch:withMatch withTextEntry:withTextEntry 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
isSelector:isSelector
searchArea:whereDefault
withCaseIgnore:withCaseIgnore
withTextEntry:withTextEntry
withMatch:withMatch
withMethodList:false
setSearchPattern:setSearchPatternAction
!
askForMethodAndSpawnSearchTitle:title browserLabel:labelHolderOrBlock searchWith:aSelectorOrBlock isSelector:isSelector searchArea:whereDefault withCaseIgnore:withCaseIgnore withTextEntry:withTextEntry 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
isSelector:isSelector
searchArea:whereDefault
withCaseIgnore:withCaseIgnore
withTextEntry:withTextEntry
withMatch:true
withMethodList:false
setSearchPattern:setSearchPatternAction
!
askForMethodAndSpawnSearchTitle:title browserLabel:labelHolderOrBlock searchWith:aSelectorOrBlock isSelector:isSelector 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
isSelector:isSelector
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|
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.
].
numArgs := aSelectorOrBlock numArgs.
].
arguments := (Array
with:string
with:entities
with:(ignoreCase ? isMethod)
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:[
(Dialog
confirm:((label string bindWith:((string ? '') allBold colorizeAllWith:Color red darkened)) , ' - none found.')
yesLabel:(Dialog classResources string:'Search Again')
noLabel:(Dialog classResources string:'Cancel')
)
ifFalse:[
^ self
].
restart raiseRequest
].
(numFound == 1 and:[initialList first == self theSingleSelectedMethod]) ifTrue:[
answer := Dialog
confirmWithCancel:((label bindWith:string) , ' - only the selected method found.\\Browse anyway ?' withCRs)
labels:(Dialog classResources 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 with:string with:entities with:ignoreCase with:match.
] ifFalse:[
list := aSelectorOrBlock value:string value:entities value:ignoreCase value:match
]
].
list
]
sortBy:#class
in:openHow
label:(resources string:label with:string).
setSearchPatternAction notNil ifTrue:[
setSearchPatternAction value:newBrowser value:string value:ignoreCase value:match.
].
^ newBrowser.
].
].
].
"Modified: / 1.3.2000 / 13:03:19 / cg"
!
askForMethodAndSpawnSearchTitle:title browserLabel:labelHolderOrBlock searchWith:aSelectorOrBlock isSelector:isSelector 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
isSelector:isSelector
searchArea:whereDefault
withCaseIgnore:withCaseIgnore
withTextEntry:withTextEntry
withMatch:true
withMethodList:withMethodList
setSearchPattern:setSearchPatternAction
!
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
]
isSelector:false
searchArea:whereDefault
withCaseIgnore:false
withTextEntry:false
withMatch:false
withMethodList:false
setSearchPattern:nil
!
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"
!
askForMethodSearchTitle:title isSelector:isSelector searchArea:whereDefault withCaseIgnore:withCaseIgnore withMatch:withMatch allowFind:allowFind allowBuffer:allowBuffer allowBrowser:allowBrowser withTextEntry:withTextEntry thenDo:aBlock
"convenient helper method: setup a box to specify search area and
(optionally) text from codeView or selected method for browsing.
SearchArea may be one of
#everywhere,
#currentNameSpace
#currentClassesNameSpace
#classCategories
#classes
#classesWithPrivateClasses
#classHierarchies
#classHierarchiesWithPrivateClasses
#ownersWithPrivateClasses
#ownersHierarchiesWithPrivateClasses"
"/ ^ self
"/ askForMethodSearchTitle:title
"/ isSelector:isSelector
"/ searchArea:whereDefault
"/ withCaseIgnore:withCaseIgnore
"/ withMatch:withMatch
"/ withMethodList:false
"/ allowFind:allowFind
"/ allowBuffer:allowBuffer
"/ allowBrowser:allowBrowser
"/ withTextEntry:withTextEntry
"/ thenDo:aBlock
^ self
askForMethodAndSpawnSearchTitle:title
browserLabel:title
searchWith:aBlock
isSelector:isSelector
searchArea:whereDefault
withCaseIgnore:withCaseIgnore
withTextEntry:withTextEntry
withMatch:withMatch
withMethodList:false
setSearchPattern:nil
!
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 newProject box 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:(Project defaultProject package) 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]
].
box := ListSelectionBox new.
box useComboBoxWithList:offered.
box title:(resources string:title).
box list:allProjects.
box okAction:[:sel | newProject := sel].
box initialText:initialTextOrNil.
box label:'Project confirmation'.
box showAtPointer.
newProject notNil ifTrue:[
newProject := newProject withoutSeparators asSymbol.
].
^ newProject
"Created: / 11-08-2006 / 13:31:34 / 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 , ' ]') asText 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:[
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 select:[:each | (usedGlobals includes:each) not].
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 string:title)
withList:list
okText:(resources string:okText).
initialText notNil ifTrue:[
box initialText:initialText
].
^ box
"Modified: / 22.2.1999 / 18:57:22 / cg"
"Created: / 13.2.2000 / 20:56:18 / 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|
aListOrNil notNil ifTrue:[
box := ListSelectionBox new.
"/ box := EnterBoxWithList new.
box list:aListOrNil.
] ifFalse:[
box := EnterBox new.
].
box title:(resources string:title) okText:(resources 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"
|box|
box := ListSelectionBox
title:(resources string:title)
okText:(resources string:okText)
action:nil.
box list:aList.
^ box
!
searchMenuFindClassToAdd
|box title className|
title := 'class to add to list (Tab to complete or use matchPattern):'.
box := self
enterBoxForClassWithCodeSelectionTitle:title
withList:(self class classHistory collect: [:entry | entry className])
okText:'add'.
box label:(resources string:'add class to list').
box entryCompletionBlock:(self classNameEntryCompletionBlock).
box action:[:aString | className := aString].
box showAtPointer.
^ className
!
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
"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) size > 0 ifTrue:[
sel := ((classes map:#theNonMetaclass) map:#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"
!
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
!
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 new findBestSelectorsFor:sel.
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 t goodSelectors|
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"
!
showAllNamespaces
"showing all or topLevel namespaces only ?"
^ true
!
stringToSearchFor
"look in codeView and methodListView for a search-string when searching for strings"
|sel|
sel := self selectionInCodeView.
sel isNil ifTrue:[
sel := self theSingleSelectedSelector.
sel notNil ifTrue:[
sel := sel withoutSpaces upTo:(Character space)
] ifFalse:[
sel := ''
]
].
^ sel string
!
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
!
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
!
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 > 15 ifTrue:[
FindHistory removeLast.
].
!
rememberSearchPattern:aString
LastSearchPatterns isNil ifTrue:[
LastSearchPatterns := OrderedCollection new.
].
(LastSearchPatterns includes:aString) ifTrue:[
LastSearchPatterns remove:aString.
] ifFalse:[
LastSearchPatterns size > 15 ifTrue:[
LastSearchPatterns removeFirst
]
].
LastSearchPatterns addFirst:aString.
! !
!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
]
].
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 method|
self codeInfoVisible value ifFalse:[^ nil].
method := self theSingleSelectedMethod.
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
|nClasses sortedByName classNames|
nClasses := aCollectionOfClasses size.
nClasses == 0 ifTrue:[
^ 'No %1classes.' bindWith:prefix.
].
classNames := aCollectionOfClasses asIdentitySet asOrderedCollection collect:[:each | each theNonMetaclass name].
nClasses <= 3 ifTrue:[
nClasses == 1 ifTrue:[
^ '1 %1class: %2' bindWith:prefix with:(classNames first allBold).
].
sortedByName := classNames sort.
nClasses == 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:nClasses 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 , ' overwrites subclassResponsibility in '.
] ifFalse:[
msg := msg , ' overwrites 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 implements: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:[
sel == #version 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)."
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
self showInfo:(self getMethodInfo).
!
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 theNonMetaclass category]).
selectedCategories ~= oldSelectedCategories ifTrue:[
self selectedCategories value:selectedCategories.
].
].
].
"Created: / 24.2.2000 / 14:10:09 / 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 := ((self selectedClasses value ? #()) 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.
].
].
].
!
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:[
(selector = Class nameOfVersionMethod ) 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
]
]
]
].
"/ 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|
RBParser isNil ifTrue:[^ nil].
sel := methodHere selector.
( #(
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:[
"/ must try again, but remove mappings to classVariables and classInstanceVariables ...
methodHere mclass theNonMetaclass allClassVarNames do:[:each |
dictionary removeKey:each ifAbsent:nil.
dictionary removeValue:each ifAbsent:nil.
].
methodHere mclass theNonMetaclass allInstVarNames do:[:each |
"/ dictionary removeKey:each ifAbsent:nil.
"/ dictionary removeValue:each ifAbsent:nil.
dictionary at:each put:each
].
methodHere mclass theNonMetaclass 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 methods functionality is already inherited from ', implClass name , '.\\You may want to remove it here.'.
]
]
].
].
].
^ nil
!
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
|comment|
comment := mthd comment.
cls isMeta ifTrue:[
sel == #version ifTrue:[^ false].
sel == #documentation ifTrue:[^ comment size > 1].
].
comment size == 0 ifTrue:[^ true].
comment asCollectionOfLines last isEmptyOrNil ifTrue:[^ true].
^ false.
! !
!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 := currentMethod syntaxHighlighterClass.
highlighterClass == #askClass ifTrue:[
highlighterClass := (methodsClass ? Object) syntaxHighlighterClass
].
].
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:[
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 asText colorizeAllWith:Color red).
newCode := nil.
] do:[
newCode := highlighterClass formatMethod: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: / 22-08-2006 / 14:27:09 / 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.
"/ 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:[
"/ codeView textChanged.
cursorWasOn ifTrue:[
codeView showCursor
]
]
"Modified: / 5.2.1999 / 22:29:17 / 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
|bottomOffset|
builder componentAt:#CodeView put:codeView.
self codeInfoVisible value ifFalse:[
"/ info not visible
bottomOffset := 0.
] ifTrue:[
"/ info visible
bottomOffset := -25.
].
codeView layout bottomOffset:bottomOffset.
codeView formatAction:[:code | self formatCode ].
codeView menuHolder:self; menuMessage:#codeViewMenu.
!
postBuildEditModeInfoLabel:aLabel
aLabel menuHolder:self; menuMessage:#editModeInfoLabelMenu.
!
postBuildEditorNoteBook:editorNoteBook
|bottomOffset|
builder componentAt:#EditorNoteBook put:editorNoteBook.
self codeInfoVisible value ifFalse:[
"/ info not visible
bottomOffset := 0.
] ifTrue:[
"/ info visible
bottomOffset := -25.
].
editorNoteBook layout bottomOffset:bottomOffset.
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.
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.
!
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.
!
searchFieldPanelCreated:aPanel
aPanel level:(MenuPanel defaultLevel).
aPanel basicViewBackground:(MenuPanel defaultBackgroundColor).
!
windowLabel:aString
navigationState notNil ifTrue:[
navigationState browserLabel:aString
].
self normalLabel.
! !
!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:'Buffer ''' , aBuffer nameString allBold , ''' was modified.\\Exit anyway ?'
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.
super release.
! !
!NewSystemBrowser methodsFor:'user actions'!
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 visualStartable: start the applciation"
|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 isVisualStartable) ifTrue:[
self busyLabel:'starting application %1' with:clsName.
MessageNotUnderstood handle:[:ex |
ex selector ~~ #windowSpec ifTrue:[
ex reject.
]
] do:[
cls open.
].
doSwitchDisplayMode := false.
] ifFalse:[
(cls isStartableWithMain) ifTrue:[
self busyLabel:'invoking main of %1' with:clsName.
"/ (self confirm:('Invoke %1''s main ?' bindWith:clsName)) ifTrue:[
cls main.
"/ ].
doSwitchDisplayMode := false.
] ifFalse:[
(cls isStartableWithStart) ifTrue:[
self busyLabel:'invoking start of %1' with:clsName.
"/ (self confirm:('Invoke %1''s start ?' bindWith:clsName)) ifTrue:[
cls start.
"/ ].
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: / 2.11.2001 / 09:38:39 / cg"
!
codeCompletion
|codeView cls crsrPos interval node selector receiver nm srchClass implClass
bestSelectors bestPrefixes allVariables allDistances best nodeVal info numArgs
newParts char nSelParts start stop oldLen newLen oldVar selectorParts
getDistanceComputeBlockWithWeight addWithFactorBlock names allTheBest bestAssoc
globalFactor localFactor selectorOfMessageToNode|
cls := self classOfSelectedMethodOrSelectedClass.
cls isNil ifTrue:[
self showInfo:'No class'.
^ self.
].
codeView := self codeView.
interval := self selectedInterval.
interval isEmpty ifTrue:[
crsrPos := codeView characterPositionOfCursor.
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:[
(node parent notNil and:[node parent isMessage]) ifTrue:[
node == node parent receiver ifTrue:[
selectorOfMessageToNode := node parent selector
]
].
nm := node name.
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 := 3 * nm size.
] ifFalse:[
(each asLowercase startsWith:nm asLowercase) ifTrue:[
factor := 2 * nm size.
].
].
dist := dist + (weight*factor).
each -> (dist * weight)
]
].
addWithFactorBlock :=
[:names :factor |
allVariables addAll:names.
allDistances addAll:(names collect:(getDistanceComputeBlockWithWeight value:factor)).
].
allVariables := OrderedCollection new.
allDistances := OrderedCollection new.
"/ locals in the block/method
names := node allVariablesOnScope.
addWithFactorBlock value:names value:(4 * localFactor).
"/ instance variables
addWithFactorBlock value:cls instVarNames value:(3 * localFactor).
"/ 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 := cls classVarNames.
responders := names select:[:classVar | (cls classVarAt:classVar) respondsTo:selectorOfMessageToNode].
nonResponders := names reject:[:classVar | (cls classVarAt:classVar) respondsTo:selectorOfMessageToNode].
addWithFactorBlock value:responders value:(1.5 * globalFactor).
addWithFactorBlock value:nonResponders value:(0.5 * 1.5 * globalFactor).
cls 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:cls classVarNames value:(1.5 * globalFactor).
cls superclass notNil ifTrue:[
addWithFactorBlock value:cls 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)].
allTheBest size > 1 ifTrue:[
allTheBest size < 20 ifTrue:[
|menu idx exitKey|
menu := PopUpMenu labels:(allTheBest collect:[:each | each key]).
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 := (allTheBest at:idx) key.
] ifFalse:[
best := Dialog
choose:'Choose variable'
fromList:(allTheBest collect:[:each | each key])
lines:4.
best isNil ifTrue:[^ self].
].
] ifFalse:[
best := bestAssoc key.
].
"/ 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
].
^ self.
].
[node isMessage] whileFalse:[
node parent isNil ifTrue:[
self showInfo:'Node is neither variable nor message.'.
^ self
].
node := node parent.
].
node isMessage ifTrue:[
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 findBestSelectorsFor:selector in:srchClass.
(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 findBestSelectorsFor:selector.
].
(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:[
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|
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'.
].
].
^ self.
].
"Modified: / 04-07-2006 / 18:48:26 / fm"
"Modified: / 10-08-2006 / 12:52:40 / cg"
!
codeInfoVisibilityChanged
|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.
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: / 18.8.2000 / 19:50:45 / 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
]
!
showInheritedMethods
self methodVisibilityHolder value:#allButObject.
!
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 oldSelector defPackage answer rslt|
oldSelector := self theSingleSelectedSelector.
"/ check for overwritten version method
(cls isMeta and:[newSelector = #version]) 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 = Project defaultProject package) 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
].
].
"/ 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.
self enforceCodeStyle ifTrue:[
codeCritics := self checkCodeQuality:code.
codeCritics notNil ifTrue:[
codeView
highlightingErrorLine:(codeCritics key)
do:[
Dialog warn:'Ugly code warning (' , codeCritics value , ') - please reformat.'.
].
].
].
"/ 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:[
(self canUseRefactoringSupport and:[(Smalltalk at:cls theNonMetaclass name)==cls]) ifTrue:[
change := InteractiveAddMethodChange compile:code in:cls classified:cat.
change controller:codeView.
"/ change named:('Accept method ' , newSelector ? '???').
RefactoryChangeManager performChange: change.
rslt := cls compiledMethodAt:newSelector.
] ifFalse:[
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: / 30-08-2006 / 18:58:34 / 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 == #newWebApplication ifTrue:[ msg := 'Generate initial webApplication code ?' ].
(msg notNil and:[self confirm:(resources string:msg)])
ifTrue:[
CodeGeneratorTool createDocumentationMethodsFor:mcls.
(codeAspect == #newWebApplication) ifTrue:[
CodeGeneratorTool createWebApplicationCodeFor:cls.
] ifFalse:[
CodeGeneratorTool createExamplesMethodFor:mcls.
CodeGeneratorTool createApplicationCodeFor:cls.
].
^ self.
].
(codeAspect == #newTestCase) ifTrue:[
CodeGeneratorTool createDocumentationMethodsFor:mcls.
CodeGeneratorTool createTestCaseSampleCodeFor:cls.
^ self.
]
!
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 size == 0 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
!
doAcceptClassAspect:aspect get:getSelector set:setSelector code:theCode
"accept comment or primitiveDefs/vars/funs (in the codeView)."
|codeView currentClass|
codeView := self codeView.
currentClass := self theSingleSelectedClass.
currentClass isNil ifTrue:[
^ self warn:'oops - no class selected'
].
currentClass := currentClass theNonMetaclass.
((currentClass class implements:getSelector)
or:[ (currentClass class implements: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: / 05-07-2006 / 17:39:38 / 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:[
|currentClass ns|
currentClass := self theSingleSelectedClass.
currentClass notNil ifTrue:[
ns := currentClass nameSpace
] ifFalse:[
ns := nil
].
self organizerMode value == OrganizerCanvas organizerModeProject ifTrue:[
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 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:[
rslt := (aCompilerClass ? Compiler)
evaluate:theCode asString
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: / 05-07-2006 / 17:40:02 / 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 withWaitCursorDo:[
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
!
openDiffViewForText:theCode againstSourceOfMethod:aMethod
|originalSource changedSource v|
originalSource := aMethod source.
changedSource := theCode asString string.
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 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
|parser|
parser := Parser
parseMethodSpecification:someCode asString
in:aClass
ignoreErrors:true ignoreWarnings:true.
(parser notNil and:[parser ~~ #Error]) ifTrue:[
^ parser selector asSymbol.
].
^ nil
!
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 ifTrue:[
self setAcceptActionForNothing.
^ self
].
currentClass isJavaClass ifTrue:[
^ self setAcceptActionForJavaClassComment.
].
(currentClass isNameSpace and:[currentClass ~~ Smalltalk]) ifTrue:[
self setAcceptActionForNothing.
^ self
].
self setAcceptAction:[:theCode | self doAcceptClassComment:theCode].
"Modified: / 8.11.2001 / 23:09:24 / 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 isNameSpace and:[currentClass ~~ Smalltalk]) 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.
!
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"
|notAutoloaded force|
notAutoloaded := OrderedCollection new.
self selectedClassesDo:[:eachClass |
|cls|
cls := eachClass theNonMetaclass.
(cls isLoaded and:[cls wasAutoloaded not]) ifTrue:[
notAutoloaded add:cls.
].
].
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.
].
self selectedClassesDo:[:eachClass |
|cls nm nameShown doIt|
cls := eachClass theNonMetaclass.
(force or:[(cls isLoaded and:[cls wasAutoloaded])]) ifTrue:[
nm := cls name.
nameShown := self displayedClassNameOf:cls.
doIt := true.
cls hasDerivedInstances ifTrue:[
doIt := self confirm:(resources string:'''%1'' has (derived) instances. Unload anyway ?' with:nameShown allBold)
].
doIt ifTrue:[
self busyLabel:'unloading %1 ...' with:nameShown.
[
cls unload.
] ensure:[
self normalLabel.
].
].
]
].
"/ to force update.
"/ (I guess, this is not needed)
self selectedClasses value:(self selectedClasses value copy).
"Modified: / 27-07-2006 / 09:46:47 / 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.
].
! !
!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 := DiffTextView
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
].
(rawKey == #Cmdr) ifTrue:[
self
enqueueMessage:#categoryMenuRename
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
].
(rawKey == #Cmdr) ifTrue:[
self
enqueueMessage:#classMenuRename
for:self
arguments:#().
^ true
].
(rawKey == #Delete) ifTrue:[
self
enqueueMessage:#classMenuRemove
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
].
^ false
!
keyInMethodCategoryListView:key rawKey:rawKey
"filter keyboard events for some function key.
Return true, if I have eaten the event"
(rawKey == #Cmdr) ifTrue:[
self
enqueueMessage:#protocolMenuRename
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 == #Delete) ifTrue:[
self
enqueueMessage:#selectorMenuRemove
for:self
arguments:#().
^ true
].
(rawKey == #Cmdr) ifTrue:[
self
enqueueMessage:#selectorMenuRename
for:self
arguments:#().
^ true
].
(rawKey == #Cmdi) ifTrue:[
self
enqueueMessage:#browseImplementorsOf
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 msg|
(rawKey == #Delete) ifTrue:[
variablesToRemove := self selectedVariables value.
variablesToRemove size > 0 ifTrue:[
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)) ifTrue:[
self
enqueueMessage:#variablesMenuRemove
for:self
arguments:#().
].
].
^ true
].
(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
].
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 classListApp) ifTrue:[
^ self keyInClassListView: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:#() .
^ false "/ release event has been added already
].
].
]
]
].
].
^ false
"Modified: / 10.12.2001 / 21:02:48 / cg"
! !
!NewSystemBrowser class methodsFor:'documentation'!
version
^ '$Header: /cvs/stx/stx/libtool/Tools__NewSystemBrowser.st,v 1.1027 2006-09-05 16:29:11 cg Exp $'
! !
NewSystemBrowser initialize!