"
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 LastCodeSearchArea LastClassFilterBlockString
LastMethodFilterBlockString LastBreakPointConditionString
LastIndividualChecks LastAcceptPackage LastVariableRenames
LastVisitorClassName LastTemporaryVariableName BookMarks
FindHistory CheckForInstancesWhenRemovingClasses
SynchronousUpdate DefaultIsNewBuffer DoubleClickIsOpenBrowser
ShowMethodTemplateWhenProtocolIsSelected
DefaultShowMethodTemplate DefaultShowMethodInheritance
DefaultEmphasizeUnloadedClasses DefaultImmediateSyntaxColoring
DefaultSyntaxColoring DefaultToolBarVisible
DefaultCodeInfoVisible DefaultShortNameInTabs
DefaultHideUnloadedClasses DefaultMarkApplications
DefaultAutoFormat'
poolDictionaries:''
category:'Interface-Browsers-New'
!
!NewSystemBrowser class methodsFor:'documentation'!
aboutThisApplicationText
^ super aboutThisApplicationText ,
'\\Written by Claus Gittinger, eXept Software AG\Thanks to John Brant & Dan Roberts for their Refactory Code.' withCRs
!
copyright
"
COPYRIGHT (c) 2000 by eXept Software AG
All Rights Reserved
This software is furnished under a license and may be used
only in accordance with the terms of that license and with the
inclusion of the above copyright notice. This software may not
be provided or otherwise made available to, or used by, any
other person. No title to or ownership of the software is
hereby transferred.
"
!
documentation
"
A new, much improved, system browser,
providing:
multiple buffers
multi-select in most selectionLists
view-selection (by namespace, by project, by category ...)
embedded repository diff
more search operations
code checker (not yet complete)
some refactoryBrowser functionality
completely built using GUI painter and reusable components.
[author:]
cg@exept.de
[see also:]
SystemBrowser BrowserView
VersionDiffBrowser
"
!
examples
"
NewSystemBrowser open
"
! !
!NewSystemBrowser class methodsFor:'initialization'!
initialize
Icon initialize.
Color initialize.
self installInLauncher.
!
installInLauncher
"add myself to the launcher menu and toolBar"
|menuItem icon action currentLauncher|
NewLauncher isNil ifTrue:[^ self].
action := [NewSystemBrowser open].
icon := NewLauncher startNewSystemBrowserIcon. "/ self defaultIcon magnifiedTo:28@28.
menuItem := MenuItem new
value: action;
isButton: false;
translateLabel: true;
label:'New SystemBrowser' 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.
! !
!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 name
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:#(
#addBreakPoint
'Add Breakpoint on Method'
#createBuffer
'Add Buffer'
#removeBreakPoint
'Remove Breakpoint'
#recentChanges
'Recently Changed Methods'
#recentVisits
'Recently Visited'
#recentlyVisitedMethods
'Visited Methods'
#runTestCases
'Run 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'
).
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: / 10.12.2001 / 21:17:07 / 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:NewSystemBrowser
"
<resource: #help>
^ super helpSpec addPairsFrom:#(
#formatCode
''
#showClassHierarchy
''
)
! !
!NewSystemBrowser class methodsFor:'image specs'!
addBufferIcon
"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 addBufferIcon inspect
ImageEditor openOnClass:self andSelector:#addBufferIcon
Icon flushCachedIcons
"
<resource: #image>
^Icon
constantNamed:#'NewSystemBrowser class addBufferIcon'
ifAbsentPut:[(Depth4Image new) width: 13; height: 11; photometric:(#palette); bitsPerSample:(#(4 )); samplesPerPixel:(1); bits:(ByteArray fromPackedString:'@@@@@@@@@@;.;.;.; @N???/??8@C.;.;.;.@@Y&Y&Y&XP@FY&Y&Y&D@A&Y&Y&Y!!@@Y&Y&Y&XP@FY&Y&Y&D@@QDQDQDQ@@@@@@@@@@@b') ; colorMapFromArray:#[0 0 0 255 255 255 255 0 0 0 255 0 0 0 255 0 255 255 255 255 0 255 0 255 127 0 0 0 127 0 0 0 127 0 127 127 127 127 0 127 0 127 127 127 127 170 170 170]; mask:((Depth1Image new) width: 13; height: 11; photometric:(#blackIs0); bitsPerSample:(#(1 )); samplesPerPixel:(1); bits:(ByteArray fromPackedString:'??#?>O?8??#?>O?8??#?>O?8??#?>@@a') ; yourself); yourself]
!
addBufferIcon2
"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 addBufferIcon2 inspect
ImageEditor openOnClass:self andSelector:#addBufferIcon2
Icon flushCachedIcons
"
<resource: #image>
^Icon
constantNamed:#'NewSystemBrowser class addBufferIcon2'
ifAbsentPut:[(Depth4Image new) width: 16; height: 16; photometric:(#palette); bitsPerSample:(#(4 )); samplesPerPixel:(1); bits:(ByteArray fromPackedString:'
@@@@@@@@@@@ADQDPDQDQ@@D3L>@SL38@@SL38AL3O @@@@@@@@@@@@L3L3L3L3L@@3L3L3L3L0@CL3L6L3X3A L3L3M#M#M @3L3L3X6M @@@@@@@FY @@@@
@@Y&Y&Y&@@@@@@Y&Y&@@@@@@A Y&@@@@@@A Y&A @@@@A @F@@Xb') ; colorMapFromArray:#[0 0 0 255 255 255 255 0 0 192 192 192 0 0 255 0 255 255 255 255 0 255 0 255 127 0 0 0 127 0 0 0 127 0 127 127 127 127 0 127 0 127 127 127 127]; mask:((Depth1Image new) width: 16; height: 16; photometric:(#blackIs0); bitsPerSample:(#(1 )); samplesPerPixel:(1); bits:(ByteArray fromPackedString:'??;??/?>??;??/?>??;????>??;?? G?@C @U@BR@QDb') ; yourself); yourself]
!
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
"
<resource: #image>
^Icon
constantNamed:#'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@ @@H@@@@ @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
@@@@@@@@@@@@@@@@@@@@@@@@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
)
)
#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
)
)
#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
)
)
#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
)
)
#createNewApplication: true
#createNewBuilder: true
)
)
)
#handles: #(#Any 0.25 0.5 0.75 1.0)
)
#(#CodeViewSpec
#name: 'CodeView'
#model: #codeHolder
#hasHorizontalScrollBar: true
#hasVerticalScrollBar: true
#miniScrollerHorizontal: true
)
)
)
#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:NewSystemBrowser andSelector:#codePaneSpec
NewSystemBrowser new openInterface:#codePaneSpec
"
<resource: #canvas>
^
#(#FullSpec
#name: #codePaneSpec
#window:
#(#WindowSpec
#label: 'SystemBrowser'
#name: 'SystemBrowser'
#min: #(#Point 0 0)
#bounds: #(#Rectangle 16 46 479 369)
#icon: #defaultIcon
)
#component:
#(#SpecCollection
#collection: #(
#(#CodeViewSpec
#name: 'CodeView'
#layout: #(#LayoutFrame 0 0.0 0 0.0 0 1.0 -25 1.0)
#model: #codeHolder
#hasHorizontalScrollBar: true
#hasVerticalScrollBar: true
#miniScrollerHorizontal: true
#modifiedChannel: #codeModifiedHolder
#postBuildCallback: #postBuildCodeView:
)
#(#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)
#level: -1
#translateLabel: true
#labelChannel: #modeLabelHolder
)
#(#LabelSpec
#name: 'CursorLineLabel'
#layout: #(#LayoutFrame -50 1 0 0.0 -20 1 0 1.0)
#level: -1
#translateLabel: true
#labelChannel: #cursorLineLabelHolder
#adjust: #right
)
#(#LabelSpec
#name: 'CursorColLabel'
#layout: #(#LayoutFrame -20 1 0 0.0 0 1.0 0 1.0)
#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
)
#(#CodeViewSpec
#name: 'CodeView'
#model: #codeHolder
#hasHorizontalScrollBar: true
#hasVerticalScrollBar: true
#miniScrollerHorizontal: true
)
)
)
#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: #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'
)
#(#CodeViewSpec
#name: 'CodeView'
#model: #codeHolder
#hasHorizontalScrollBar: true
#hasVerticalScrollBar: true
#miniScrollerHorizontal: true
)
)
)
#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'
)
#(#CodeViewSpec
#name: 'CodeView'
#model: #codeHolder
#hasHorizontalScrollBar: true
#hasVerticalScrollBar: true
#miniScrollerHorizontal: true
)
)
)
#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'
)
#(#CodeViewSpec
#name: 'CodeView'
#model: #codeHolder
#hasHorizontalScrollBar: true
#hasVerticalScrollBar: true
#miniScrollerHorizontal: true
)
)
)
#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
)
#(#CodeViewSpec
#name: 'CodeView'
#model: #codeHolder
#hasHorizontalScrollBar: true
#hasVerticalScrollBar: true
#miniScrollerHorizontal: true
)
)
)
#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
)
#(#CodeViewSpec
#name: 'CodeView'
#model: #codeHolder
#hasHorizontalScrollBar: true
#hasVerticalScrollBar: true
#miniScrollerHorizontal: true
)
)
)
#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'
)
#(#CodeViewSpec
#name: 'CodeView'
#model: #codeHolder
#hasHorizontalScrollBar: true
#hasVerticalScrollBar: true
#miniScrollerHorizontal: true
)
)
)
#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: #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
)
#(#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"
!
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: #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
)
#(#CodeViewSpec
#name: 'CodeView'
#model: #codeHolder
#hasHorizontalScrollBar: true
#hasVerticalScrollBar: true
#miniScrollerHorizontal: true
)
)
)
#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'
)
#(#CodeViewSpec
#name: 'CodeView'
#model: #codeHolder
#hasHorizontalScrollBar: true
#hasVerticalScrollBar: true
#miniScrollerHorizontal: true
)
)
)
#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'
)
#(#CodeViewSpec
#name: 'CodeView'
#model: #codeHolder
#hasHorizontalScrollBar: true
#hasVerticalScrollBar: true
#miniScrollerHorizontal: true
)
)
)
#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'
)
#(#CodeViewSpec
#name: 'CodeView'
#model: #codeHolder
#hasHorizontalScrollBar: true
#hasVerticalScrollBar: true
#miniScrollerHorizontal: true
)
)
)
#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'
)
#(#CodeViewSpec
#name: 'CodeView'
#model: #codeHolder
#hasHorizontalScrollBar: true
#hasVerticalScrollBar: true
#miniScrollerHorizontal: true
)
)
)
#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'
)
#(#CodeViewSpec
#name: 'CodeView'
#model: #codeHolder
#hasHorizontalScrollBar: true
#hasVerticalScrollBar: true
#miniScrollerHorizontal: true
)
)
)
#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: (
(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: searchedClassNameHolder
acceptOnReturn: true
acceptOnPointerLeave: false
acceptIfUnchanged: true
comboList: visitedClassesHistory
extent: (Point 244 20)
)
)
)
postBuildCallback: searchFieldPanelCreated:
)
)
)
)
(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: false
canvas: browserCanvas
canvasInset: 0
keepCanvasAlive: true
tabLevel: 1
)
)
)
)
!
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'
)
#(#CodeViewSpec
#name: 'CodeView'
#model: #codeHolder
#hasHorizontalScrollBar: true
#hasVerticalScrollBar: true
#miniScrollerHorizontal: true
#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: #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: #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: #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: #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)
)
#(#CodeViewSpec
#name: 'CodeView'
#model: #codeHolder
#hasHorizontalScrollBar: true
#hasVerticalScrollBar: true
#miniScrollerHorizontal: true
)
)
)
#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'
)
#(#CodeViewSpec
#name: 'CodeView'
#model: #codeHolder
#hasHorizontalScrollBar: true
#hasVerticalScrollBar: true
#miniScrollerHorizontal: true
)
)
)
#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'
)
#(#CodeViewSpec
#name: 'CodeView'
#model: #codeHolder
#hasHorizontalScrollBar: true
#hasVerticalScrollBar: true
#miniScrollerHorizontal: true
)
)
)
#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'
)
#(#CodeViewSpec
#name: 'CodeView'
#model: #codeHolder
#hasHorizontalScrollBar: true
#hasVerticalScrollBar: true
#miniScrollerHorizontal: true
)
)
)
#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
)
#(#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
)
)
)
)
"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
)
#(#CodeViewSpec
#name: 'CodeView'
#model: #codeHolder
#hasHorizontalScrollBar: true
#hasVerticalScrollBar: true
#miniScrollerHorizontal: true
)
)
)
#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
)
#(#CodeViewSpec
#name: 'CodeView'
#model: #codeHolder
#hasHorizontalScrollBar: true
#hasVerticalScrollBar: true
#miniScrollerHorizontal: true
)
)
)
#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
)
#(#CodeViewSpec
#name: 'CodeView'
#model: #codeHolder
#hasHorizontalScrollBar: true
#hasVerticalScrollBar: true
#miniScrollerHorizontal: true
)
)
)
#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'
)
#(#CodeViewSpec
#name: 'CodeView'
#model: #codeHolder
#hasHorizontalScrollBar: true
#hasVerticalScrollBar: true
#miniScrollerHorizontal: true
)
)
)
#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'
)
#(#CodeViewSpec
#name: 'CodeView'
#model: #codeHolder
#hasHorizontalScrollBar: true
#hasVerticalScrollBar: true
#miniScrollerHorizontal: true
)
)
)
#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'
)
#(#CodeViewSpec
#name: 'CodeView'
#model: #codeHolder
#hasHorizontalScrollBar: true
#hasVerticalScrollBar: true
#miniScrollerHorizontal: true
)
)
)
#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
)
(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: 'Wrapped Methods (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 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:NewSystemBrowser andSelector:#bufferBaseMenu
(Menu new fromLiteralArrayEncoding:(NewSystemBrowser bufferBaseMenu)) startUp
"
<resource: #menu>
^
#(#Menu
#(
#(#MenuItem
#label: 'Add Buffer'
#translateLabel: true
#nameKey: #CreateBuffer
#value: #bufferMenuCreateBuffer
)
#(#MenuItem
#label: 'Remove Buffer'
#translateLabel: true
#nameKey: #RemoveBuffer
#value: #bufferMenuRemoveCurrentBuffer
)
)
nil
nil
)
"Modified: / 15.11.2001 / 17:28:38 / cg"
!
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:NewSystemBrowser andSelector:#categoryMenu
(Menu new fromLiteralArrayEncoding:(NewSystemBrowser categoryMenu)) startUp
"
<resource: #menu>
^
#(#Menu
#(
#(#MenuItem
#label: 'FileOut'
#translateLabel: true
#enabled: #hasCategorySelectedHolder
#submenu:
#(#Menu
#(
#(#MenuItem
#label: 'as...'
#translateLabel: true
#value: #categoryMenuFileOutAs
#enabled: #hasCategorySelectedHolder
#showBusyCursorWhilePerforming: true
)
#(#MenuItem
#label: 'XML as...'
#translateLabel: true
#value: #categoryMenuFileOutXMLAs
#enabled: #hasCategorySelectedAndCanFileOutXMLHolder
#showBusyCursorWhilePerforming: true
)
#(#MenuItem
#label: 'SIF as...'
#translateLabel: true
#value: #categoryMenuFileOutSIFAs
#enabled: #hasCategorySelectedAndCanFileOutSIFHolder
#showBusyCursorWhilePerforming: true
)
#(#MenuItem
#label: '-'
)
#(#MenuItem
#label: 'Each in...'
#translateLabel: true
#value: #categoryMenuFileOutEachIn
#enabled: #hasCategorySelectedHolder
#showBusyCursorWhilePerforming: true
)
#(#MenuItem
#label: 'Each XML in...'
#translateLabel: true
#value: #categoryMenuFileOutEachXMLIn
#enabled: #hasCategorySelectedAndCanFileOutXMLHolder
#showBusyCursorWhilePerforming: true
)
#(#MenuItem
#label: 'Each SIF in...'
#translateLabel: true
#value: #categoryMenuFileOutEachSIFIn
#enabled: #hasCategorySelectedAndCanFileOutSIFHolder
#showBusyCursorWhilePerforming: true
)
#(#MenuItem
#label: 'Each Binary in...'
#translateLabel: true
#value: #categoryMenuFileOutEachBinaryIn
#enabled: #hasCategorySelectedHolder
#showBusyCursorWhilePerforming: true
)
)
nil
nil
)
)
#(#MenuItem
#label: 'Repository'
#translateLabel: true
#enabled: #hasCategorySelectedAndSourceCodeManagerHolder
#submenu:
#(#Menu
#(
#(#MenuItem
#label: 'CheckIn all...'
#translateLabel: true
#value: #categoryMenuCheckInEach
#enabled: #hasCategorySelectedAndSourceCodeManagerHolder
#showBusyCursorWhilePerforming: true
)
#(#MenuItem
#label: '-'
)
#(#MenuItem
#label: 'CheckOut Newest all (Update)...'
#translateLabel: true
#value: #categoryMenuCheckOutNewest
#enabled: #hasCategorySelectedAndSourceCodeManagerHolder
#showBusyCursorWhilePerforming: true
)
#(#MenuItem
#label: 'CheckOut all (Load old Revisions)...'
#translateLabel: true
#value: #categoryMenuCheckOut
#enabled: #hasCategorySelectedAndSourceCodeManagerHolder
#showBusyCursorWhilePerforming: true
)
#(#MenuItem
#label: '-'
)
#(#MenuItem
#label: 'History...'
#translateLabel: true
#value: #categoryMenuRepositoryHistory
#enabled: #hasSourceCodeManagerHolder
#showBusyCursorWhilePerforming: true
)
)
nil
nil
)
)
#(#MenuItem
#label: '-'
)
#(#MenuItem
#label: 'Documentation'
#translateLabel: true
#enabled: #hasCategorySelectedHolder
#submenu:
#(#Menu
#(
#(#MenuItem
#label: 'PrintOut'
#translateLabel: true
#value: #categoryMenuPrintOut
#enabled: #hasCategorySelectedHolder
#showBusyCursorWhilePerforming: true
)
#(#MenuItem
#label: 'PrintOut Protocol'
#translateLabel: true
#value: #categoryMenuPrintOutProtocol
#enabled: #hasCategorySelectedHolder
#showBusyCursorWhilePerforming: true
)
#(#MenuItem
#label: '-'
)
#(#MenuItem
#label: 'Save HTML Documentation in...'
#translateLabel: true
#value: #categoryMenuSaveDocumentationIn
#enabled: #hasCategorySelectedHolder
#showBusyCursorWhilePerforming: true
)
)
nil
nil
)
)
#(#MenuItem
#label: '-'
)
#(#MenuItem
#label: 'Spawn'
#translateLabel: true
#enabled: #hasCategorySelectedHolder
#submenu:
#(#Menu
#(
#(#MenuItem
#label: 'Buffer'
#translateLabel: true
#value: #categoryMenuSpawnBuffer
#enabled: #hasCategorySelectedHolder
)
#(#MenuItem
#label: 'Buffer with Categories Matching...'
#translateLabel: true
#value: #categoryMenuSpawnMatchingCategoriesBuffer
)
#(#MenuItem
#label: '-'
)
#(#MenuItem
#label: 'Browser'
#translateLabel: true
#value: #categoryMenuSpawnBrowser
#enabled: #hasCategorySelectedHolder
)
#(#MenuItem
#label: 'Browser on Categories Matching...'
#translateLabel: true
#value: #categoryMenuSpawnMatchingCategoriesBrowser
)
)
nil
nil
)
)
#(#MenuItem
#label: '-'
)
#(#MenuItem
#label: 'New...'
#translateLabel: true
#value: #categoryMenuNewCategory
)
#(#MenuItem
#label: 'Rename...'
#translateLabel: true
#value: #categoryMenuRename
#enabled: #hasCategorySelectedHolder
)
#(#MenuItem
#label: 'Remove...'
#translateLabel: true
#value: #categoryMenuRemove
#enabled: #hasCategorySelectedHolder
)
#(#MenuItem
#label: '-'
)
#(#MenuItem
#label: 'Update'
#translateLabel: true
#value: #categoryMenuUpdate
)
)
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:NewSystemBrowser andSelector:#categoryMenuWithFind
(Menu new fromLiteralArrayEncoding:(NewSystemBrowser categoryMenuWithFind)) startUp
"
<resource: #menu>
^
#(#Menu
#(
#(#MenuItem
#label: 'FileOut'
#translateLabel: true
#enabled: #hasCategorySelectedHolder
#submenu:
#(#Menu
#(
#(#MenuItem
#label: 'as...'
#translateLabel: true
#value: #categoryMenuFileOutAs
#enabled: #hasCategorySelectedHolder
#showBusyCursorWhilePerforming: true
)
#(#MenuItem
#label: 'XML as...'
#translateLabel: true
#value: #categoryMenuFileOutXMLAs
#enabled: #hasCategorySelectedAndCanFileOutXMLHolder
#showBusyCursorWhilePerforming: true
)
#(#MenuItem
#label: 'SIF as...'
#translateLabel: true
#value: #categoryMenuFileOutSIFAs
#enabled: #hasCategorySelectedAndCanFileOutSIFHolder
#showBusyCursorWhilePerforming: true
)
#(#MenuItem
#label: '-'
)
#(#MenuItem
#label: 'Each in...'
#translateLabel: true
#value: #categoryMenuFileOutEachIn
#enabled: #hasCategorySelectedHolder
#showBusyCursorWhilePerforming: true
)
#(#MenuItem
#label: 'Each XML in...'
#translateLabel: true
#value: #categoryMenuFileOutEachXMLIn
#enabled: #hasCategorySelectedAndCanFileOutXMLHolder
#showBusyCursorWhilePerforming: true
)
#(#MenuItem
#label: 'Each SIF in...'
#translateLabel: true
#value: #categoryMenuFileOutEachSIFIn
#enabled: #hasCategorySelectedAndCanFileOutSIFHolder
#showBusyCursorWhilePerforming: true
)
#(#MenuItem
#label: 'Each Binary in...'
#translateLabel: true
#value: #categoryMenuFileOutEachBinaryIn
#enabled: #hasCategorySelectedHolder
#showBusyCursorWhilePerforming: true
)
)
nil
nil
)
)
#(#MenuItem
#label: 'Repository'
#translateLabel: true
#enabled: #hasSourceCodeManagerHolder
#submenu:
#(#Menu
#(
#(#MenuItem
#label: 'CheckIn all...'
#translateLabel: true
#value: #categoryMenuCheckInEach
#enabled: #hasCategorySelectedAndSourceCodeManagerHolder
#showBusyCursorWhilePerforming: true
)
#(#MenuItem
#label: '-'
)
#(#MenuItem
#label: 'CheckOut Newest all (Update)...'
#translateLabel: true
#value: #categoryMenuCheckOutNewest
#enabled: #hasCategorySelectedAndSourceCodeManagerHolder
#showBusyCursorWhilePerforming: true
)
#(#MenuItem
#label: 'CheckOut all (Load old Revisions)...'
#translateLabel: true
#value: #categoryMenuCheckOut
#enabled: #hasCategorySelectedAndSourceCodeManagerHolder
#showBusyCursorWhilePerforming: true
)
#(#MenuItem
#label: '-'
)
#(#MenuItem
#label: 'History...'
#translateLabel: true
#value: #categoryMenuRepositoryHistory
#enabled: #hasSourceCodeManagerHolder
#showBusyCursorWhilePerforming: true
)
)
nil
nil
)
)
#(#MenuItem
#label: '-'
)
#(#MenuItem
#label: 'Documentation'
#translateLabel: true
#enabled: #hasCategorySelectedHolder
#submenu:
#(#Menu
#(
#(#MenuItem
#label: 'PrintOut'
#translateLabel: true
#value: #categoryMenuPrintOut
#enabled: #hasCategorySelectedHolder
#showBusyCursorWhilePerforming: true
)
#(#MenuItem
#label: 'PrintOut Protocol'
#translateLabel: true
#value: #categoryMenuPrintOutProtocol
#enabled: #hasCategorySelectedHolder
#showBusyCursorWhilePerforming: true
)
#(#MenuItem
#label: '-'
)
#(#MenuItem
#label: 'Save HTML Documentation in...'
#translateLabel: true
#value: #categoryMenuSaveDocumentationIn
#enabled: #hasCategorySelectedHolder
#showBusyCursorWhilePerforming: true
)
)
nil
nil
)
)
#(#MenuItem
#label: '-'
)
#(#MenuItem
#label: 'Spawn'
#translateLabel: true
#enabled: #hasCategorySelectedHolder
#submenu:
#(#Menu
#(
#(#MenuItem
#label: 'Buffer'
#translateLabel: true
#value: #categoryMenuSpawnBuffer
#enabled: #hasCategorySelectedHolder
)
#(#MenuItem
#label: 'Buffer with Categories Matching...'
#translateLabel: true
#value: #categoryMenuSpawnMatchingCategoriesBuffer
)
#(#MenuItem
#label: '-'
)
#(#MenuItem
#label: 'Browser'
#translateLabel: true
#value: #categoryMenuSpawnBrowser
#enabled: #hasCategorySelectedHolder
)
#(#MenuItem
#label: 'Browser on Categories Matching...'
#translateLabel: true
#value: #categoryMenuSpawnMatchingCategoriesBrowser
)
)
nil
nil
)
)
#(#MenuItem
#label: 'Find'
#translateLabel: true
#submenuChannel: #searchMenu
)
#(#MenuItem
#label: '-'
)
#(#MenuItem
#label: 'New...'
#translateLabel: true
#value: #categoryMenuNewCategory
)
#(#MenuItem
#label: 'Rename...'
#translateLabel: true
#value: #categoryMenuRename
#enabled: #hasCategorySelectedHolder
)
#(#MenuItem
#label: 'Remove...'
#translateLabel: true
#value: #categoryMenuRemove
#enabled: #hasCategorySelectedHolder
)
#(#MenuItem
#label: '-'
)
#(#MenuItem
#label: 'Update'
#translateLabel: true
#value: #categoryMenuUpdate
)
)
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
)
!
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:NewSystemBrowser andSelector:#classMenu
(Menu new fromLiteralArrayEncoding:(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
#label: 'Repository'
#translateLabel: true
#submenu:
#(#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
#label: 'Quick CheckIn...'
#itemValue: #classMenuQuickCheckIn
#translateLabel: true
#isVisible: #hasClassSelectedAndControlKeyDownHolder
#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
)
)
#(#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
)
)
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: 'Class'
#itemValue: #classMenuNewClass
#translateLabel: true
)
#(#MenuItem
#enabled: #hasSingleClassSelectedHolder
#label: 'Subclass'
#itemValue: #classMenuNewSubclass
#translateLabel: true
)
#(#MenuItem
#enabled: #hasSingleLoadedClassSelectedHolder
#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: '-'
)
#(#MenuItem
#label: 'Error'
#itemValue: #classMenuNewError
#translateLabel: true
)
#(#MenuItem
#label: 'Notification'
#itemValue: #classMenuNewNotification
#translateLabel: true
)
#(#MenuItem
#label: '-'
)
#(#MenuItem
#label: 'TestCase'
#itemValue: #classMenuNewTestCase
#translateLabel: true
)
#(#MenuItem
#label: '-'
#isVisible: #javaScriptMetaclassPresent
)
#(#MenuItem
#label: 'JavaScript Class'
#itemValue: #classMenuNewJavaScriptClass
#translateLabel: true
#isVisible: #javaScriptMetaclassPresent
)
#(#MenuItem
#label: 'Haskell Module'
#itemValue: #classMenuNewHaskellModule
#translateLabel: true
#isVisible: #haskellModulePresent
)
)
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
)
)
nil
nil
)
)
#(#MenuItem
#enabled: #hasSingleClassSelectedHolder
#label: 'Rename...'
#itemValue: #classMenuRename
#translateLabel: 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
#enabled: #hasClassSelectedHolder
#label: 'Generate'
#translateLabel: true
#submenu:
#(#Menu
#(
#(#MenuItem
#enabled: #hasSingleLoadedClassSelectedHolder
#label: 'Access Methods'
#itemValue: #classMenuGenerateAccessMethods
#translateLabel: true
)
#(#MenuItem
#enabled: #hasSingleLoadedClassSelectedHolder
#label: 'Getter Methods'
#itemValue: #classMenuGenerateGetterMethods
#translateLabel: true
)
#(#MenuItem
#enabled: #hasSingleLoadedClassSelectedHolder
#label: 'Setter Methods'
#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
)
#(#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'
#itemValue: #classMenuGenerateClassTypeTestMethods
#translateLabel: true
#isVisible: #hasNonMetaSelectedHolder
)
#(#MenuItem
#label: '-'
#isVisible: #hasNonMetaSelectedHolder
)
#(#MenuItem
#enabled: #hasLoadedClassSelectedHolder
#label: 'Documentation Stubs'
#itemValue: #classMenuGenerateDocumentationStubs
#translateLabel: true
)
#(#MenuItem
#enabled: #hasSingleLoadedClassWithCommentSelectedHolder
#label: 'Documentation Method from Comment'
#itemValue: #classMenuGenerateDocumentationMethodFromComment
#translateLabel: true
)
#(#MenuItem
#enabled: #hasSingleLoadedClassSelectedHolder
#label: 'Initialized Instance Creation'
#itemValue: #classMenuGenerateStandardInitializationMethods
#translateLabel: true
)
#(#MenuItem
#enabled: #hasApplicationClassSelectedHolder
#label: 'Application Code'
#itemValue: #classMenuGenerateApplicationCode
#translateLabel: true
)
#(#MenuItem
#enabled: #hasLoadedClassSelectedHolder
#label: 'Required Protocol'
#itemValue: #classMenuGenerateRequiredProtocol
#translateLabel: true
)
)
nil
nil
)
)
#(#MenuItem
#enabled: #hasClassSelectedHolder
#label: 'Check'
#translateLabel: true
#submenuChannel: #checkMenu
)
#(#MenuItem
#enabled: #hasClassSelectedHolder
#label: 'Special'
#translateLabel: true
#submenu:
#(#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: #hasAnyAutoLoadedClassSelectedHolder
#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
#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: 'Cleanup ChangeSet'
#itemValue: #classMenuCleanUpChangeSet
#translateLabel: true
)
)
nil
nil
)
)
#(#MenuItem
#label: '-'
#isVisible: false
)
#(#MenuItem
#label: 'Update'
#itemValue: #classMenuUpdate
#translateLabel: true
#isVisible: false
)
)
nil
nil
)
!
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:NewSystemBrowser andSelector:#codeMenu
(Menu new fromLiteralArrayEncoding:(NewSystemBrowser codeMenu)) startUp
"
<resource: #menu>
^
#(#Menu
#(
#(#MenuItem
#label: 'Variables'
#translateLabel: true
#enabled: #canUseRefactoringSupportAndHasClassSelected
#submenu:
#(#Menu
#(
#(#MenuItem
#label: 'Move to Inner Scope...'
#translateLabel: true
#value: #codeMenuMoveVariableToInnerScope
#enabled: #hasTemporaryVariableSelectedInCodeViewHolder
#showBusyCursorWhilePerforming: true
)
#(#MenuItem
#label: '-'
)
#(#MenuItem
#label: 'Rename Local Variable...'
#translateLabel: true
#value: #codeMenuRenameTemporary
#enabled: #hasTemporaryVariableSelectedInCodeViewHolder
#showBusyCursorWhilePerforming: true
)
#(#MenuItem
#label: '-'
)
#(#MenuItem
#label: 'Make Instance Variable'
#translateLabel: true
#value: #codeMenuMakeInstanceVariable
#enabled: #hasTemporaryVariableSelectedInCodeViewHolder
#isVisible: #hasNotMultipleTemporaryVariablesSelectedInCodeViewHolder
#showBusyCursorWhilePerforming: true
)
#(#MenuItem
#label: 'Make Instance Variables'
#translateLabel: true
#value: #codeMenuMakeInstanceVariable
#enabled: #hasMultipleTemporaryVariablesSelectedInCodeViewHolder
#isVisible: #hasMultipleTemporaryVariablesSelectedInCodeViewHolder
#showBusyCursorWhilePerforming: true
)
)
nil
nil
)
)
#(#MenuItem
#label: '-'
)
#(#MenuItem
#label: 'Inline Message'
#translateLabel: true
#value: #codeMenuInlineMessage
#enabled: #hasSingleMethodSelectedAndSelectionInCodeViewAndCanUseRefactoringSupportHolder
#showBusyCursorWhilePerforming: true
)
#(#MenuItem
#label: 'Extract Selection to Temporary...'
#translateLabel: true
#value: #codeMenuExtractSelectionToTemporary
#enabled: #hasSingleMethodSelectedAndSelectionInCodeViewAndCanUseRefactoringSupportHolder
#showBusyCursorWhilePerforming: true
)
#(#MenuItem
#label: 'Extract Method...'
#translateLabel: true
#value: #codeMenuExtractMethod
#enabled: #hasSingleMethodSelectedAndSelectionInCodeViewAndCanUseRefactoringSupportHolder
#showBusyCursorWhilePerforming: true
)
#(#MenuItem
#label: 'Extract Method to Component...'
#translateLabel: true
#value: #codeMenuExtractMethodToComponent
#enabled: #hasSingleMethodSelectedAndSelectionInCodeViewAndCanUseRefactoringSupportHolder
#showBusyCursorWhilePerforming: true
)
#(#MenuItem
#label: '-'
)
#(#MenuItem
#label: 'Add Parameter to Method...'
#translateLabel: true
#value: #codeMenuAddParameter
#enabled: #hasSingleMethodSelectedAndCanUseRefactoringSupportHolder
#showBusyCursorWhilePerforming: true
)
#(#MenuItem
#label: 'Remove Parameter from Method'
#translateLabel: true
#value: #codeMenuRemoveParameter
#enabled: #hasSingleMethodSelectedAndSelectionInCodeViewAndSingleSelectedMethodHasParameterAndCanUseRefactoringSupportHolder
#showBusyCursorWhilePerforming: true
)
#(#MenuItem
#label: '-'
)
#(#MenuItem
#label: 'Format'
#translateLabel: true
#value: #codeMenuFormat
#enabled: #hasSingleMethodSelectedAndCanUseRefactoringSupportHolder
#showBusyCursorWhilePerforming: true
)
#(#MenuItem
#label: '-'
)
#(#MenuItem
#label: 'Syntax Coloring'
#translateLabel: true
#hideMenuOnActivated: false
#indication: #doSyntaxColoring
)
#(#MenuItem
#label: 'Immediate Syntax Coloring'
#translateLabel: true
#hideMenuOnActivated: false
#enabled: #doSyntaxColoring
#indication: #doImmediateSyntaxColoring
)
#(#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: 'Load Refactoring and Undo Features'
#translateLabel: true
#showBusyCursorWhilePerforming: true
#value: #doLoadRefactoringSupport
#isVisible: #canLoadRefactoringSupport
)
)
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 Trace && Breakpoints'
#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
)
)
nil
nil
)
"Modified: / 18.8.2000 / 22:20:22 / cg"
!
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: methodListViewMenuVisible
submenuChannel: methodListViewMenu
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: '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:NewSystemBrowser andSelector:#methodListMenu
(Menu new fromLiteralArrayEncoding:(NewSystemBrowser methodListMenu)) startUp
"
<resource: #menu>
^
#(Menu
(
(MenuItem
label: 'File out'
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
)
(MenuItem
label: '-'
)
(MenuItem
label: 'All as...'
itemValue: methodListMenuFileOutAllAs
translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: canFileOutXMLHolder
label: 'All XML as...'
itemValue: methodListMenuFileOutAllXMLAs
translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: canFileOutSIFHolder
label: 'All SIF as...'
itemValue: methodListMenuFileOutAllSIFAs
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
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasSingleMethodSelected
label: 'All Versions'
itemValue: selectorMenuBrowseRepositoryVersions
translateLabel: true
)
)
nil
nil
)
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasMethodSelectedHolder
label: 'Print out'
itemValue: selectorMenuPrintOut
translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasMethodSelectedHolder
label: 'Spawn'
translateLabel: true
submenu:
(Menu
(
(MenuItem
label: 'Buffer with Full Class(es)'
itemValue: methodListMenuSpawnFullBrowserBuffer
translateLabel: true
)
(MenuItem
label: 'Buffer with Class(es)'
itemValue: methodListMenuSpawnClassesBuffer
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
label: 'Browser on Full Class(es)'
itemValue: methodListMenuSpawnFullBrowser
translateLabel: true
)
(MenuItem
label: 'Browser on Class(es)'
itemValue: methodListMenuSpawnClasses
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
label: '-'
)
(MenuItem
enabled: hasMethodSelectedHolder
label: 'Inheritance'
itemValue: selectorMenuSpawnInheritanceBuffer
translateLabel: true
)
(MenuItem
enabled: hasMethodSelectedHolder
label: 'Sender Chain'
itemValue: spawnSenderChainBuffer
translateLabel: true
)
(MenuItem
enabled: hasMethodSelectedHolder
label: 'Implementor Chain'
itemValue: spawnImplementorChainBuffer
translateLabel: true
)
(MenuItem
label: '-'
)
(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
)
(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
)
(MenuItem
label: 'Code Search...'
itemValue: browseMenuMethodsWithCode
translateLabel: true
)
(MenuItem
label: '-'
)
(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: hasMethodSelectedHolder
label: 'To Project...'
itemValue: selectorMenuMoveToProject
translateLabel: true
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasInstanceMethodsSelectedHolder
label: 'To Class Side (Make Class Method)'
itemValue: selectorMenuMakeClassMethod
translateLabel: true
)
(MenuItem
enabled: hasClassMethodsSelectedHolder
label: 'To Instance Side (Make Instance Method)'
itemValue: selectorMenuMakeInstanceMethod
translateLabel: true
)
)
nil
nil
)
)
(MenuItem
enabled: hasSingleMethodSelectedHolder
label: 'Rename...'
itemValue: selectorMenuRename
translateLabel: true
)
(MenuItem
enabled: hasMethodSelectedHolder
label: 'Safe Remove...'
itemValue: selectorMenuSaveRemove
translateLabel: true
)
(MenuItem
enabled: hasMethodSelectedHolder
label: 'Remove...'
itemValue: selectorMenuRemove
translateLabel: true
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasMethodSelectedHolder
label: 'Compare'
translateLabel: true
submenu:
(Menu
(
(MenuItem
enabled: hasMethodSelectedHolder
label: 'With Method...'
itemValue: selectorMenuCompareWithMethod
translateLabel: true
isVisible: false
)
(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
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: 'Compile with stc'
itemValue: selectorMenuCompileWithSTC
translateLabel: true
)
(MenuItem
enabled: hasSingleMethodSelectedHolder
label: 'Decompile'
itemValue: selectorMenuDecompile
translateLabel: true
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasMethodsInList
label: 'Copy List to Clipboard'
itemValue: methodListMenuCopyList
translateLabel: true
)
)
nil
nil
)
)
(MenuItem
label: '-'
)
(MenuItem
label: 'Update'
itemValue: methodListMenuUpdate
translateLabel: true
)
)
nil
nil
)
!
methodListViewMenu
"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:#methodListViewMenu
(Menu new fromLiteralArrayEncoding:(NewSystemBrowser methodListViewMenu)) 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: '-'
)
#(#MenuItem
#label: 'Toolbar'
#translateLabel: true
#hideMenuOnActivated: false
#indication: #toolBarVisibleHolder
)
#(#MenuItem
#label: 'Info'
#translateLabel: true
#hideMenuOnActivated: false
#indication: #codeInfoVisible
#isVisible: 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:NewSystemBrowser andSelector:#projectMenu
(Menu new fromLiteralArrayEncoding:(NewSystemBrowser projectMenu)) startUp
"
<resource: #menu>
^
#(#Menu
#(
#(#MenuItem
#label: 'File out'
#translateLabel: true
#enabled: #hasProjectSelectedHolder
#submenu:
#(#Menu
#(
#(#MenuItem
#label: 'as...'
#translateLabel: true
#value: #projectMenuFileOutAs
#enabled: #hasProjectSelectedHolder
#showBusyCursorWhilePerforming: true
)
#(#MenuItem
#label: 'XML as...'
#translateLabel: true
#value: #projectMenuFileOutXMLAs
#enabled: #hasProjectSelectedAndCanFileOutXMLHolder
#showBusyCursorWhilePerforming: true
)
#(#MenuItem
#label: 'SIF as...'
#translateLabel: true
#value: #projectMenuFileOutSIFAs
#enabled: #hasProjectSelectedAndCanFileOutSIFHolder
#showBusyCursorWhilePerforming: true
)
#(#MenuItem
#label: '-'
)
#(#MenuItem
#label: 'Each in...'
#translateLabel: true
#value: #projectMenuFileOutEachIn
#enabled: #hasProjectSelectedHolder
#showBusyCursorWhilePerforming: true
)
#(#MenuItem
#label: 'Each XML in...'
#translateLabel: true
#value: #projectMenuFileOutEachXMLIn
#enabled: #hasProjectSelectedAndCanFileOutXMLHolder
#showBusyCursorWhilePerforming: true
)
#(#MenuItem
#label: 'Each SIF in...'
#translateLabel: true
#value: #projectMenuFileOutEachSIFIn
#enabled: #hasProjectSelectedAndCanFileOutSIFHolder
#showBusyCursorWhilePerforming: true
)
#(#MenuItem
#label: 'Each Binary in...'
#translateLabel: true
#value: #projectMenuFileOutEachBinaryIn
#enabled: #hasProjectSelectedHolder
#showBusyCursorWhilePerforming: true
)
)
nil
nil
)
)
#(#MenuItem
#label: 'Repository'
#translateLabel: true
#enabled: #hasSourceCodeManagerHolder
#submenu:
#(#Menu
#(
#(#MenuItem
#label: 'CheckIn all...'
#translateLabel: true
#value: #projectMenuCheckInAll
#enabled: #hasProjectSelectedAndSourceCodeManagerHolder
#showBusyCursorWhilePerforming: true
)
#(#MenuItem
#label: 'CheckIn Classes only...'
#translateLabel: true
#value: #projectMenuCheckInClasses
#enabled: #hasProjectSelectedAndSourceCodeManagerHolder
#showBusyCursorWhilePerforming: true
)
#(#MenuItem
#label: 'CheckIn Extensions only...'
#translateLabel: true
#value: #projectMenuCheckInExtensions
#enabled: #hasProjectSelectedAndSourceCodeManagerHolder
#showBusyCursorWhilePerforming: true
)
#(#MenuItem
#label: '-'
)
#(#MenuItem
#label: 'CheckOut Newest all (Update)...'
#translateLabel: true
#value: #projectMenuCheckOutNewest
#enabled: #hasProjectSelectedAndSourceCodeManagerHolder
#showBusyCursorWhilePerforming: true
)
#(#MenuItem
#label: 'CheckOut all (Load old Revision)...'
#translateLabel: true
#value: #projectMenuCheckOut
#enabled: #hasProjectSelectedAndSourceCodeManagerHolder
#showBusyCursorWhilePerforming: true
)
#(#MenuItem
#label: '-'
)
#(#MenuItem
#label: 'History...'
#translateLabel: true
#value: #projectMenuRepositoryHistory
#enabled: #hasProjectSelectedAndSourceCodeManagerHolder
#showBusyCursorWhilePerforming: true
)
#(#MenuItem
#label: 'Consistency Check...'
#translateLabel: true
#value: #projectMenuCheckRepositoryConsistency
#enabled: #hasProjectSelectedAndSourceCodeManagerHolder
)
#(#MenuItem
#label: '-'
)
#(#MenuItem
#label: 'Import...'
#translateLabel: true
#value: #projectMenuImport
#showBusyCursorWhilePerforming: true
#isVisible: false
)
#(#MenuItem
#label: 'Import and Load Classes...'
#translateLabel: true
#value: #projectMenuImportAndLoadClasses
#showBusyCursorWhilePerforming: true
)
#(#MenuItem
#label: '-'
)
#(#MenuItem
#label: 'Resource Files...'
#translateLabel: true
#value: #projectMenuResources
#enabled: #hasProjectSelectedHolder
)
#(#MenuItem
#label: 'Bitmap Files...'
#translateLabel: true
#value: #projectMenuBitmapFiles
#enabled: #hasProjectSelectedHolder
)
)
nil
nil
)
)
#(#MenuItem
#label: '-'
)
#(#MenuItem
#label: 'Documentation'
#translateLabel: true
#value: #projectMenuDocumentation
#enabled: #hasProjectSelectedHolder
#showBusyCursorWhilePerforming: true
)
#(#MenuItem
#label: '-'
)
#(#MenuItem
#label: 'Spawn'
#translateLabel: true
#enabled: #hasProjectSelectedHolder
#submenu:
#(#Menu
#(
#(#MenuItem
#label: 'Buffer'
#translateLabel: true
#value: #projectMenuSpawnBuffer
#enabled: #hasProjectSelectedHolder
)
#(#MenuItem
#label: 'Buffer with Extensions'
#translateLabel: true
#value: #projectMenuSpawnExtensionsBuffer
#enabled: #hasProjectSelectedHolder
)
#(#MenuItem
#label: '-'
)
#(#MenuItem
#label: 'Browser'
#translateLabel: true
#value: #projectMenuSpawn
#enabled: #hasProjectSelectedHolder
)
#(#MenuItem
#label: 'Browser on Extensions'
#translateLabel: true
#value: #projectMenuSpawnExtensionsBrowser
#enabled: #hasProjectSelectedHolder
)
)
nil
nil
)
)
#(#MenuItem
#label: 'Find'
#translateLabel: true
#enabled: #hasProjectSelectedHolder
#submenuChannel: #searchMenu
)
#(#MenuItem
#label: '-'
)
#(#MenuItem
#label: 'New...'
#translateLabel: true
#value: #projectMenuNew
)
#(#MenuItem
#label: 'Load...'
#translateLabel: true
#value: #projectMenuLoad
#showBusyCursorWhilePerforming: true
)
#(#MenuItem
#label: 'Rename...'
#translateLabel: true
#value: #projectMenuRename
#enabled: #hasProjectSelectedHolder
)
#(#MenuItem
#label: 'Remove...'
#translateLabel: true
#value: #projectMenuRemove
#enabled: #hasProjectSelectedHolder
)
#(#MenuItem
#label: '-'
)
#(#MenuItem
#label: 'Properties...'
#translateLabel: true
#value: #projectMenuProperties
#enabled: #hasProjectSelectedHolder
)
#(#MenuItem
#label: '-'
)
#(#MenuItem
#label: 'Generate'
#translateLabel: true
#enabled: #hasProjectSelectedHolder
#submenu:
#(#Menu
#(
#(#MenuItem
#label: 'Makefiles'
#translateLabel: true
#value: #projectMenuGenerateMakefiles
#enabled: #hasProjectSelectedHolder
#showBusyCursorWhilePerforming: true
)
#(#MenuItem
#label: 'LoadAll File'
#translateLabel: true
#value: #projectMenuGenerateLoadAllFile
#enabled: #hasProjectSelectedHolder
#showBusyCursorWhilePerforming: true
)
#(#MenuItem
#label: 'Abbrev File'
#translateLabel: true
#value: #projectMenuGenerateAbbrevFile
#enabled: #hasProjectSelectedHolder
#showBusyCursorWhilePerforming: true
)
#(#MenuItem
#label: 'Compiled class library'
#translateLabel: true
#value: #projectMenuGenerateClassLibrary
#enabled: #hasProjectSelectedHolder
#showBusyCursorWhilePerforming: true
)
)
nil
nil
)
)
#(#MenuItem
#label: '-'
)
#(#MenuItem
#label: 'Make current Project'
#translateLabel: true
#value: #projectMenuMakeCurrentProject
#enabled: #hasSingleProjectSelectedHolder
)
#(#MenuItem
#label: '-'
)
#(#MenuItem
#label: 'Update'
#translateLabel: true
#value: #projectMenuUpdate
)
)
nil
nil
)
"Modified: / 17.1.2001 / 11:36:14 / 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
)
(MenuItem
enabled: hasProtocolSelectedHolder
label: 'Remove...'
itemValue: protocolMenuRemove
translateLabel: true
)
(MenuItem
label: '-'
isVisible: false
)
(MenuItem
label: 'Update'
itemValue: protocolMenuUpdate
translateLabel: true
isVisible: false
)
)
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
)
#(#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:NewSystemBrowser andSelector:#selectorMenu
(Menu new fromLiteralArrayEncoding:(NewSystemBrowser selectorMenu)) 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: hasSingleMethodSelected
label: 'All Versions'
itemValue: selectorMenuBrowseRepositoryVersions
translateLabel: true
)
)
nil
nil
)
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasMethodSelectedHolder
label: 'PrintOut'
itemValue: selectorMenuPrintOut
translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
label: '-'
)
(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'
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'
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
label: '-'
)
(MenuItem
enabled: hasMethodSelectedHolder
label: 'Inheritance'
itemValue: selectorMenuSpawnInheritanceBuffer
translateLabel: true
)
(MenuItem
enabled: hasMethodSelectedHolder
label: 'Sender Chain'
itemValue: spawnSenderChainBuffer
translateLabel: true
)
(MenuItem
enabled: hasMethodSelectedHolder
label: 'Implementor Chain'
itemValue: spawnImplementorChainBuffer
translateLabel: true
)
(MenuItem
label: '-'
)
(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
)
(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
)
(MenuItem
label: 'Code Search...'
itemValue: browseMenuMethodsWithCode
translateLabel: 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
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: 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: 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: hasMethodSelectedAndCanUseRefactoringSupportHolder
label: 'Rename...'
itemValue: selectorMenuRename
translateLabel: true
)
(MenuItem
enabled: hasMethodSelectedAndCanUseRefactoringSupportHolder
label: 'Safe Remove...'
itemValue: selectorMenuSaveRemove
translateLabel: true
)
(MenuItem
enabled: hasMethodSelectedHolder
label: 'Remove...'
itemValue: selectorMenuRemove
translateLabel: true
)
(MenuItem
label: '-'
)
(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
label: '-'
)
(MenuItem
enabled: hasNonMetaMethodSelectedHolder
label: 'Corresponding Instance Creation in Class'
itemValue: selectorMenuGenerateCorrespondingInstanceCreationInClass
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: '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
)
!
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
)
!
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:NewSystemBrowser andSelector:#tabMenu
(Menu new fromLiteralArrayEncoding:(NewSystemBrowser tabMenu)) startUp
"
<resource: #menu>
^
#(#Menu
#(
#(#MenuItem
#label: 'Add Buffer'
#translateLabel: true
#nameKey: #CreateBuffer
#value: #bufferMenuCreateBuffer
)
#(#MenuItem
#label: 'Remove Buffer'
#translateLabel: true
#nameKey: #RemoveBuffer
#value: #'bufferMenuRemoveBuffer:'
#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 buffer'
#translateLabel: true
#nameKey: #CreateBuffer
#value: #bufferMenuCreateBuffer
)
)
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:NewSystemBrowser andSelector:#variablesMenu
(Menu new fromLiteralArrayEncoding:(NewSystemBrowser variablesMenu)) startUp
"
<resource: #menu>
^
#(#Menu
#(
#(#MenuItem
#label: 'Instance Variables'
#translateLabel: true
#enabled: #hasNonMetaSelectedAndClassSelectedHolder
#submenu:
#(#Menu
#(
#(#MenuItem
#label: 'References...'
#translateLabel: true
#value: #variablesMenuBrowseInstVarRefs
#enabled: #hasClassSelectedHolder
#showBusyCursorWhilePerforming: true
)
#(#MenuItem
#label: 'Readers...'
#translateLabel: true
#value: #variablesMenuBrowseInstVarReads
#enabled: #hasClassSelectedHolder
#showBusyCursorWhilePerforming: true
)
#(#MenuItem
#label: 'Writers...'
#translateLabel: true
#value: #variablesMenuBrowseInstVarMods
#enabled: #hasClassSelectedHolder
#showBusyCursorWhilePerforming: true
)
#(#MenuItem
#label: '-'
)
#(#MenuItem
#label: 'All References...'
#translateLabel: true
#value: #variablesMenuBrowseAllInstVarRefs
#enabled: #hasClassSelectedHolder
#showBusyCursorWhilePerforming: true
)
#(#MenuItem
#label: 'All Readers...'
#translateLabel: true
#value: #variablesMenuBrowseAllInstVarReads
#enabled: #hasClassSelectedHolder
#showBusyCursorWhilePerforming: true
)
#(#MenuItem
#label: 'All Writers...'
#translateLabel: true
#value: #variablesMenuBrowseAllInstVarMods
#enabled: #hasClassSelectedHolder
#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
)
)
nil
nil
)
)
#(#MenuItem
#label: 'Class Inst Variables'
#translateLabel: true
#enabled: #hasMetaSelectedAndClassSelectedHolder
#submenu:
#(#Menu
#(
#(#MenuItem
#label: 'References...'
#translateLabel: true
#value: #variablesMenuBrowseClassInstVarRefs
#enabled: #hasClassSelectedHolder
#showBusyCursorWhilePerforming: true
)
#(#MenuItem
#label: 'Readers...'
#translateLabel: true
#value: #variablesMenuBrowseClassInstVarReads
#enabled: #hasClassSelectedHolder
#showBusyCursorWhilePerforming: true
)
#(#MenuItem
#label: 'Writers...'
#translateLabel: true
#value: #variablesMenuBrowseClassInstVarMods
#enabled: #hasClassSelectedHolder
#showBusyCursorWhilePerforming: true
)
#(#MenuItem
#label: '-'
)
#(#MenuItem
#label: 'All References...'
#translateLabel: true
#value: #variablesMenuBrowseAllClassInstVarRefs
#enabled: #hasClassSelectedHolder
#showBusyCursorWhilePerforming: true
)
#(#MenuItem
#label: 'All Readers...'
#translateLabel: true
#value: #variablesMenuBrowseAllClassInstVarReads
#enabled: #hasClassSelectedHolder
#showBusyCursorWhilePerforming: true
)
#(#MenuItem
#label: 'All Writers...'
#translateLabel: true
#value: #variablesMenuBrowseAllClassInstVarMods
#enabled: #hasClassSelectedHolder
#showBusyCursorWhilePerforming: true
)
)
nil
nil
)
)
#(#MenuItem
#label: 'Class Variables'
#translateLabel: true
#enabled: #hasClassSelectedHolder
#submenu:
#(#Menu
#(
#(#MenuItem
#label: 'References...'
#translateLabel: true
#value: #variablesMenuBrowseClassVarRefs
#enabled: #hasClassSelectedHolder
#showBusyCursorWhilePerforming: true
)
#(#MenuItem
#label: 'Readers...'
#translateLabel: true
#value: #variablesMenuBrowseClassVarReads
#enabled: #hasClassSelectedHolder
#showBusyCursorWhilePerforming: true
)
#(#MenuItem
#label: 'Writers...'
#translateLabel: true
#value: #variablesMenuBrowseClassVarMods
#enabled: #hasClassSelectedHolder
#showBusyCursorWhilePerforming: true
)
#(#MenuItem
#label: '-'
)
#(#MenuItem
#label: 'All References...'
#translateLabel: true
#value: #variablesMenuBrowseAllClassVarRefs
#enabled: #hasClassSelectedHolder
#showBusyCursorWhilePerforming: true
)
#(#MenuItem
#label: 'All Readers...'
#translateLabel: true
#value: #variablesMenuBrowseAllClassVarReads
#enabled: #hasClassSelectedHolder
#showBusyCursorWhilePerforming: true
)
#(#MenuItem
#label: 'All Writers...'
#translateLabel: true
#value: #variablesMenuBrowseAllClassVarMods
#enabled: #hasClassSelectedHolder
#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: #codeMenuProtectClassVariable
#enabled: #hasClassVariableSelectedInCodeViewOrVariableListAndCanUseRefactoringSupportHolder
#showBusyCursorWhilePerforming: true
)
)
nil
nil
)
)
#(#MenuItem
#label: '-'
)
#(#MenuItem
#label: 'Add...'
#translateLabel: true
#value: #variablesMenuAdd
#enabled: #hasSingleClassSelectedAndCanUseRefactoringSupportHolder
#showBusyCursorWhilePerforming: true
)
#(#MenuItem
#label: 'Add ValueHolder...'
#translateLabel: true
#value: #variablesMenuAddValueHolder
#enabled: #hasSingleClassSelectedAndCanUseRefactoringSupportHolder
#showBusyCursorWhilePerforming: true
)
#(#MenuItem
#label: 'Move'
#translateLabel: true
#submenu:
#(#Menu
#(
#(#MenuItem
#label: 'Pull Up'
#translateLabel: true
#value: #variablesMenuPullUp
#enabled: #hasSingleClassAndSingleVariableSelectedAndCanUseRefactoringSupportHolder
#showBusyCursorWhilePerforming: true
)
#(#MenuItem
#label: 'Push Down'
#translateLabel: true
#value: #variablesMenuPushDown
#enabled: #hasSingleClassAndSingleVariableSelectedAndCanUseRefactoringSupportHolder
#showBusyCursorWhilePerforming: true
)
)
nil
nil
)
)
#(#MenuItem
#label: 'Rename...'
#translateLabel: true
#value: #variablesMenuRename
#enabled: #hasSingleClassAndSingleVariableSelectedAndCanUseRefactoringSupportHolder
#showBusyCursorWhilePerforming: true
)
#(#MenuItem
#label: 'Remove'
#translateLabel: true
#value: #variablesMenuRemove
#enabled: #hasSingleClassAndVariableSelectedAndCanUseRefactoringSupportHolder
#showBusyCursorWhilePerforming: true
)
#(#MenuItem
#label: '-'
)
#(#MenuItem
#label: 'Copy Selected Name'
#translateLabel: true
#value: #variablesMenuCopySelectedName
#enabled: #hasVariableSelected
)
#(#MenuItem
#label: '-'
#isVisible: false
)
#(#MenuItem
#label: 'Find Variable'
#translateLabel: true
#value: #doFindVariable
#enabled: #hasVariableSelected
#isVisible: false
)
#(#MenuItem
#label: '-'
)
#(#MenuItem
#label: 'Show ClassVars (Statics)'
#translateLabel: true
#indication: #showClassVarsInVariableList
)
#(#MenuItem
#label: 'Sort By Name'
#translateLabel: true
#indication: #variableListSortByName
)
#(#MenuItem
#label: '-'
)
#(#MenuItem
#label: 'Generate'
#translateLabel: true
#enabled: #hasClassSelectedHolder
#submenu:
#(#Menu
#(
#(#MenuItem
#label: 'Access Methods'
#translateLabel: true
#value: #variablesMenuGenerateAccessMethods
#enabled: #hasClassAndVariableSelectedHolder
#showBusyCursorWhilePerforming: true
)
#(#MenuItem
#label: 'Getter Method(s)'
#translateLabel: true
#value: #variablesMenuGenerateGetterMethods
#enabled: #hasClassAndVariableSelectedHolder
#showBusyCursorWhilePerforming: true
)
#(#MenuItem
#label: 'Setter Method(s)'
#translateLabel: true
#value: #variablesMenuGenerateSetterMethods
#enabled: #hasClassAndVariableSelectedHolder
)
#(#MenuItem
#label: 'Multi-Setter Method'
#translateLabel: true
#value: #variablesMenuGenerateMultiSetterMethod
#enabled: #hasSingleLoadedClassSelectedAndMultipleVariablesSelectedHolder
)
#(#MenuItem
#label: '-'
#isVisible: #hasNonMetaSelectedHolder
)
#(#MenuItem
#label: 'Access Methods with Lazy Initialization in Getter'
#itemValue: #variablesMenuGenerateAccessMethodsWithLazyInitialization
#isVisible: #hasNonMetaSelectedHolder
#translateLabel: true
#enabled: #hasClassAndVariableSelectedHolder
)
#(#MenuItem
#label: 'Access Methods with Change Notification'
#translateLabel: true
#isVisible: #hasNonMetaSelectedHolder
#value: #variablesMenuGenerateAccessMethodsWithChange
#enabled: #hasClassAndVariableSelectedHolder
)
#(#MenuItem
#label: 'Access Methods for ValueHolder'
#translateLabel: true
#isVisible: #hasNonMetaSelectedHolder
#value: #variablesMenuGenerateAccessMethodsForValueHolder
#enabled: #hasClassAndVariableSelectedHolder
)
#(#MenuItem
#label: 'Access Methods for ValueHolder with Change Notification'
#translateLabel: true
#isVisible: #hasNonMetaSelectedHolder
#value: #variablesMenuGenerateAccessMethodsForValueHolderWithChange
#enabled: #hasClassAndVariableSelectedHolder
)
)
nil
nil
)
)
#(#MenuItem
#label: 'Debug'
#translateLabel: true
#submenu:
#(#Menu
#(
#(#MenuItem
#label: 'Show Type(s)...'
#translateLabel: true
#value: #variablesMenuTypeInfo
#enabled: #hasSingleVariableSelectedHolder
#showBusyCursorWhilePerforming: true
)
#(#MenuItem
#label: 'Browse Type(s)'
#translateLabel: true
#value: #variablesMenuTypeBrowe
#enabled: #hasSingleVariableSelectedHolder
#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:NewSystemBrowser andSelector:#viewMenu
(Menu new fromLiteralArrayEncoding:(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
#enabled: #showUnloadedClasses
#label: 'Emphasize Unloaded Classes'
#translateLabel: true
#hideMenuOnActivated: false
#indication: #emphasizeUnloadedClasses
)
#(#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 Classtype Indicator'
#translateLabel: true
#hideMenuOnActivated: false
#indication: #markApplicationsHolder
)
#(#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
)
)
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"
!
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"
!
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:NewSystemBrowser andSelector:#toolBarMenu
(Menu new fromLiteralArrayEncoding:(NewSystemBrowser toolBarMenu)) startUp
"
<resource: #menu>
^
#(Menu
(
(MenuItem
label: ''
)
(MenuItem
activeHelpKey: createBuffer
label: 'CreateBuffer'
itemValue: createBuffer
translateLabel: true
isButton: true
labelImage: (ResourceRetriever NewSystemBrowser addBufferIcon2)
)
(MenuItem
label: '-'
)
(MenuItem
activeHelpKey: showCategories
label: 'ShowCategory'
itemValue: switchToCategoryView
translateLabel: true
isButton: true
isVisible: organizerIsShowingClassesAndIsNotShowingCategories
labelImage: (ResourceRetriever NewSystemBrowser showCategoriesIcon)
showBusyCursorWhilePerforming: true
)
(MenuItem
activeHelpKey: showClassHierarchy
"/ enabled: hasClassSelectedHolder
label: 'ShowClassHierarchy'
itemValue: switchToClassHierarchyView
translateLabel: true
isButton: true
isVisible: organizerIsShowingClassesAndIsShowingCategories
labelImage: (ResourceRetriever NewSystemBrowser showClassHierarchyIcon)
showBusyCursorWhilePerforming: true
)
(MenuItem
label: '-'
)
(MenuItem
activeHelpKey: recentChanges
label: 'Recent Changes'
translateLabel: true
isButton: true
submenuChannel: changedMenu
labelImage: (ResourceRetriever ToolbarIconLibrary changesBrowser24x24Icon)
showBusyCursorWhilePerforming: true
)
(MenuItem
activeHelpKey: recentlyVisited
label: 'Back'
translateLabel: true
isButton: true
submenuChannel: findHistoryMenu
labelImage: (ResourceRetriever ToolbarIconLibrary back16x16Icon)
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: ''
)
(MenuItem
activeHelpKey: runTestCases
label: 'RunTest'
itemValue: runTestCases
translateLabel: true
isButton: true
isVisible: hasAnyTestCaseSelectedHolder
labelImage: (ResourceRetriever ToolbarIconLibrary sUnit24x24Icon)
showBusyCursorWhilePerforming: true
)
(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
label: 'Format'
itemValue: codeMenuFormat
translateLabel: true
isButton: true
startGroup: right
labelImage: (ResourceRetriever ToolbarIconLibrary formatCode16x16Icon)
showBusyCursorWhilePerforming: true
)
(MenuItem
activeHelpKey: addBreakPoint
enabled: hasMethodSelectedHolder
label: 'Add BreakPoint'
itemValue: debugMenuBreakPoint
translateLabel: true
isButton: true
startGroup: right
labelImage: (ResourceRetriever nil addBreakPointIcon2)
)
(MenuItem
activeHelpKey: removeBreakPoint
enabled: hasMethodSelectedHolder
label: 'Remove BreakPoint'
itemValue: debugMenuRemoveBreakOrTrace
translateLabel: true
isButton: true
labelImage: (ResourceRetriever nil removeBreakPointIcon2)
)
(MenuItem
label: ''
)
)
nil
nil
)
! !
!NewSystemBrowser class methodsFor:'startup'!
browseClass:aClass
"launch a single class browser."
^ self basicNew spawnClassBrowserFor:(Array with:aClass) in:#newBrowser.
"
self browseClass:Array
"
!
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
|allProjects|
allProjects := Set new.
Smalltalk allClassesDo:[:eachClass |
|cls pkg|
cls := eachClass theNonMetaclass.
pkg := cls package.
pkg "withoutSeparators" size > 0 ifTrue:[
allProjects add:pkg.
] ifFalse:[
"/ for now, nameSpaces are not in any package;
"/ this might change. Then, 0-sized packages are
"/ illegal, and the following should be enabled.
"/ self halt
].
cls isJavaClass ifFalse:[
cls instAndClassSelectorsAndMethodsDo:[:sel :mthd |
allProjects add:mthd package asSymbol.
].
].
].
allProjects := allProjects asOrderedCollection sort.
^ allProjects
"Created: / 17.2.2000 / 23:55:19 / cg"
!
enterBoxTitle:title okText:okText label:label
"convenient method: setup an enterBox"
|box resources|
resources := self classResources.
box := EnterBox new.
box label:(resources string:label).
box
title:(resources string:title)
okText:(resources string:okText).
^ box
"Created: / 6.2.2000 / 01:07:11 / cg"
!
resourceEditorClassFor:aResource
"resources are from a methods resource-info;
return an appropriate editor class."
(aResource == #canvas) ifTrue:[
^ UIPainter
].
(aResource == #menu) ifTrue:[
^ MenuEditor
].
((aResource == #image) or:[aResource == #fileImage]) ifTrue:[
^ ImageEditor
].
(aResource == #help) ifTrue:[
^ UIHelpTool
].
(aResource == #tableColumns) ifTrue:[
^ DataSetBuilder
].
(aResource == #tabList) ifTrue:[
^ TabListEditor
].
(aResource == #hierarchicalList) ifTrue:[
^ HierarchicalListEditor
].
^ nil
!
resourceEditorClassForResources:resources
"resources are from a methods resource-info;
return an appropriate editor class."
(resources includesKey:#canvas) ifTrue:[
^ self resourceEditorClassFor:#canvas
].
(resources includesKey:#menu) ifTrue:[
^ self resourceEditorClassFor:#menu
].
(resources includesKey:#image) ifTrue:[
^ self resourceEditorClassFor:#image
].
(resources includesKey:#fileImage) ifTrue:[
^ self resourceEditorClassFor:#fileImage
].
(resources includesKey:#help) ifTrue:[
^ self resourceEditorClassFor:#help
].
(resources includesKey:#tableColumns) ifTrue:[
^ self resourceEditorClassFor:#tableColumns
].
(resources includesKey:#tabList) ifTrue:[
^ self resourceEditorClassFor:#tabList
].
(resources includesKey:#hierarchicalList) ifTrue:[
^ self resourceEditorClassFor:#hierarchicalList
].
^ nil
! !
!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.
!
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 bldr|
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)
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.
].
theCanvas isNil ifTrue:[self halt:'should not happen'].
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
!
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:'Code was modified.\\Change selection anyway ?')
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
! !
!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"
^ [
|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
<resource: #programMenu >
"to avoid generation of an aspect method by GUI definer"
^ [
|m|
self window sensor ctrlDown ifTrue:[
m := self class debugMenu
] ifFalse:[
m := self class selectorMenu
].
m := m decodeAsLiteralArray.
m findGuiResourcesIn:self.
]
!
tabMenu:index
|m i|
m := self class tabMenuWithRemove.
m := m decodeAsLiteralArray.
i := m detectItem:[:item | item itemValue == #bufferMenuRemoveBuffer:] ifNone:nil.
i notNil ifTrue:[
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
].
].
].
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
!
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 isChainBrowser not
and:[(n isNameSpaceFullBrowser or:[n isNameSpaceBrowser not])
and:[n isVersionDiffBrowser not
and:[(n isNameSpaceFullBrowser or:[v1 value == #category])]]]]]]
]
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 == #classHierarchy)
or:[orgMode == #hierarchy]
]
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
!
methodListViewMenuVisible
|holder|
(holder := builder bindingAt:#methodListViewMenuVisible) isNil ifTrue:[
holder := BlockValue
with:[:v | |n|
n := self navigationState.
n isMethodListBrowser
]
argument:(self browserCanvas).
builder aspectAt:#methodListViewMenuVisible put: holder
].
^ holder
!
nameSpaceMenuVisible
|holder|
(holder := builder bindingAt:#nameSpaceMenuVisible) isNil ifTrue:[
holder := BlockValue
with:[:v1 :v2 | v1 value == #namespace
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 ~~ #category]
argument:(self organizerModeForMenu)
].
^ holder
!
organizerIsShowingCategories
|holder|
(holder := builder bindingAt:#organizerIsShowingCategories) isNil ifTrue:[
holder := BlockValue
with:[:h | h value == #category]
argument:(self organizerModeForMenu)
].
^ holder
!
organizerIsShowingClassesAndIsNotShowingCategories
|holder|
(holder := builder bindingAt:#organizerIsShowingClassesAndIsNotShowingCategories) isNil ifTrue:[
holder := BlockValue
with:[:h | navigationState isMethodListBrowser not and:[h value ~~ #category]]
argument:(self organizerModeForMenu)
].
^ holder
!
organizerIsShowingClassesAndIsShowingCategories
|holder|
(holder := builder bindingAt:#organizerIsShowingClassesAndIsShowingCategories) isNil ifTrue:[
holder := BlockValue
with:[:h | navigationState isMethodListBrowser not and:[h value == #category]]
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 == #project]
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
!
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 enqueueDelayedUpdateCode].
].
^ 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 enqueueDelayedUpdateCode].
].
^ holder.
!
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
!
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
!
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"
!
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"
!
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"
!
variableListSortByName
|holder|
(holder := builder bindingAt:#variableListSortByName) isNil ifTrue:[
holder := false asValue.
builder aspectAt:#variableListSortByName put: holder
].
^ holder
! !
!NewSystemBrowser methodsFor:'aspects-queries'!
anyBreakOrTracePointsAreSet
^ MessageTracer notNil
and:[MessageTracer isLoaded
and:[MessageTracer areAnyMethodsWrapped]]
!
anyBreakOrTracePointsAreSetHolder
^ [ self anyBreakOrTracePointsAreSet ]
!
canFileOutSIFHolder
^ [ self canFileOutSIF ]
!
canFileOutXMLHolder
^ [ self canFileOutXML ]
!
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
!
currentNameSpaceIsEmpty
self halt.
!
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
!
hasAnyAutoLoadedClassSelected
|selected|
^ (selected := self selectedClasses value) size > 0
and:[ selected contains:[:cls | cls theNonMetaclass wasAutoloaded ]].
!
hasAnyAutoLoadedClassSelectedHolder
^ [ self hasAnyAutoLoadedClassSelected ]
!
hasAnyLoadedClassSelected
|selected|
^ (selected := self selectedClasses value) size > 0
and:[ selected contains:[:cls | cls theNonMetaclass isLoaded ]].
!
hasAnyLoadedClassSelectedHolder
^ [ self hasAnyLoadedClassSelected ]
!
hasAnyTestCaseSelected
|selected|
^ (selected := self selectedClasses value) size > 0
and:[ selected contains:[ :cls | cls theNonMetaclass isSubclassOf:TestCase ] ]
!
hasAnyTestCaseSelectedHolder
|holder|
(holder := builder bindingAt:#hasAnyTestCaseSelectedHolder) isNil ifTrue:[
holder := BlockValue
with:[:m1 :m2| self hasAnyTestCaseSelected]
argument:self selectedClasses
argument:self browserCanvas.
builder aspectAt:#hasAnyTestCaseSelectedHolder put: holder.
].
^ holder
!
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"
!
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 selectedCategories value 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 ]
!
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"
!
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"
!
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 ]
!
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 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"
!
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 ]
!
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
^ [ self hasMethodWithBreakPointSelected ]
!
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 ]
!
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"
!
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] ]]
!
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"
!
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]
!
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.
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 ]
!
hasSingleCategorySelected
^ self selectedCategories value 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 hasSingleClassAndVariableSelected] ]
"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 ]
!
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|
mPackage := aMethod package.
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 ]
!
haskellModulePresent
^ HaskellModule notNil and:[HaskellParser 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"
!
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 ]
!
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.
!
delayedExplainSelection
|codeView|
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 withWaitCursorDo:[
self clearInfo.
codeView := self codeView.
"/ self explainInCode:(codeView contentsAsString string) short:true
"/ ]
!
delayedLabelUpdate
self normalLabel
!
delayedMethodsSelectionChanged
|codeAspect|
self hasMethodSelectedHolder value:(self hasMethodSelected).
"/ 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 enqueueDelayedUpdateCode.
self hasSingleResourceMethodSelectedHolder value:(self hasSingleResourceMethodSelected).
self setDoitActionForClass.
"/ self showMethodInfo.
methodInfoProcess notNil ifTrue:[
methodInfoProcess terminate.
].
methodInfoProcess := [ self asyncShowMethodInfo ] 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
|methods mthd selectedClass cls protocol
codeView code filteredVariables autoSearch
package project doShowMethodTemplate codeAspect|
self enqueueDelayedUpdateBufferLabel.
navigationState isClassDocumentationBrowser ifTrue:[
"/ show classes documentation
self showClassDocumentation.
^ self.
].
navigationState isVersionDiffBrowser ifTrue:[
"/ show version differences
self showVersionDiff.
^ self.
].
codeView := self codeView.
((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 withWaitCursorDo:[
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.
self 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.
"/ self codeAspect:nil.
] ifFalse:[
code := self methodTemplate.
"/ self setAcceptActionForMethod.
"/ self codeAspect:#method.
].
self setAcceptActionForMethod.
self codeAspect:#method.
self showCode:code.
] ifFalse:[
self hasProtocolSelected "protocol notNil" ifTrue:[
self showCode:''.
self setAcceptActionForMethod.
self codeAspect:#method.
] ifFalse:[
cls := selectedClass := self theSingleSelectedClass.
cls notNil ifTrue:[
cls := cls theNonMetaclass.
codeAspect := self codeAspect.
codeAspect == #classComment ifTrue:[
self showClassComment:cls.
] ifFalse:[ codeAspect == #classHierarchy ifTrue:[
self showClassHierarchy:cls.
] ifFalse:[ codeAspect == #primitiveDefinitions ifTrue:[
self showClassPrimitive:codeAspect class:cls
] ifFalse:[ codeAspect == #primitiveFunctions ifTrue:[
self showClassPrimitive:codeAspect class:cls.
] ifFalse:[ codeAspect == #primitiveVariables ifTrue:[
self showClassPrimitive:codeAspect class:cls.
] ifFalse:[
self setAcceptActionForClass.
self showClassDefinition:selectedClass.
]]]]]
] ifFalse:[
self organizerMode value == #project 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.
]
]
]
]
].
"/ perform an auto-search, unless the user did some other search
"/ in the meanwhile (i.e. the codeViews searchPattern is different from the autoSearchPattern)
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].
].
].
].
navigationState modified:false.
navigationState realModifiedState:false.
self updateProtocolSelectionForChangedMethodSelection.
"Modified: / 24.2.2000 / 15:45:30 / 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"
!
enqueueDelayedVariableSelectionChanged
^ self
enqueueMessage:#delayedVariableSelectionChanged
for:self
arguments:#()
!
enqueueMessage:selector for:someone arguments:argList
"/ Transcript show:'enqueue '; showCR:selector.
self class synchronousUpdate == true ifTrue:[
someone perform:selector withArguments:argList.
^ self
].
^ super enqueueMessage:selector for:someone arguments:argList
!
metaChanged
self halt:'should not be invoked'.
"Created: / 4.2.2000 / 15:17:52 / cg"
!
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 == #project 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
!
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.
!
update:something with:aParameter from:changedObject
|codeView mthd codeAspect isForAspect|
"/ (navigationState notNil
"/ and:[changedObject == navigationState codeModifiedHolder]) ifTrue:[
"/ self enqueueDelayedUpdateBufferLabel.
"/ ^ self.
"/ ].
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 == selectedBuffer ifTrue:[
self enqueueDelayedLabelUpdate.
self organizerModeForMenu changed.
^ 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 enqueueDelayedUpdateCode.
].
].
]
].
^ 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)
!
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:'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:
isSelector:true
searchArea:#everywhere
withCaseIgnore:true
withMatch:true
withTextEntry: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|
className := classNameArg.
className includesMatchCharacters ifTrue:[
className := self askForClassNameMatching:className.
].
class := (Smalltalk classNamed:className) theNonMetaclass.
self
spawnClassBrowserForSearch:[ class allSubclasses ]
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])
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 := 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.
filterBlock isBlock ifFalse:[
self halt:'oops - bad input'.
^ self
].
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 ctrlDown 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"
!
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 := 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)
!
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 := 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 := LastCodeSearchArea ? #everywhere.
"/ whereDefault := self defaultSearchArea.
"/ whereDefault == #classes ifTrue:[
"/ ((self selectedMethods value ? #()) contains:[:anyMethod | anyMethod mclass isPrivate]) ifTrue:[
"/ whereDefault := #ownersWithPrivateClasses
"/ ]
"/ ].
self
askForMethodAndSpawnSearchTitle:'Search Matchstring in String-Literals:'
browserLabel:'Methods with Matching String-Literal'
searchWith:#( #'findStringLiteral:in:isMethod:' #'findStringLiteral:inMethods:isMethod:' )
isSelector:#code
searchArea:whereDefault
withCaseIgnore:false
withTextEntry:true
withMethodList:true
setSearchPattern:[:brwsr :codePattern :ignoreCase :doMatch|
"/ brwsr autoSearchCodePattern:codePattern
]
!
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
"/ "/
"/ "/ example1 (search for methods which contain a string AND send a particular message)
"/ "/
"/ (method source includesString:''Useful'')
"/ and:[ method sends:#for: ]
"/ "/
"/ "/ example2 (search for methods which send #foo AND #bar)
"/ "/
"/ |l|
"/ l := method messagesSent.
"/ (l includes:#foo) and:[l includes:#bar]
"/ "/
"/ "/ example3 (search for methods which send #foo OR #bar)
"/ "/
"/ |l|
"/ l := method messagesSent.
"/ (l includes:#foo) or:[l 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:[l referencesLiteral:#bar])
"/ and:[
"/ |l|
"/ l := method messagesSent.
"/ (l includes:#foo) or:[l includes:#bar]
"/ ]
]
'.
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 halt:'oops - 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 allClassesDo:[:eachClass |
eachClass instAndClassMethodsDo:[: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 allClassesDo:[:eachClass |
eachClass instAndClassMethodsDo:[:mthd |
mthd package = defaultId ifTrue:[
methods add:mthd.
].
].
].
methods
].
^ self
spawnMethodBrowserForSearch:searchBlock
sortBy:#class
in:openHow
label:'Loose methods'
!
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 createBuffer
"Modified: / 25.2.2000 / 22:22:31 / cg"
!
bufferMenuRemoveBuffer:nr
"remove the current buffer"
buffers size > 0 ifTrue:[
(self askIfModified:'Code was modified.\\Remove buffer anyway ?')
ifTrue:[
self removeBuffer:nr.
].
]
"Modified: / 11.2.2000 / 10:55:02 / cg"
!
bufferMenuRemoveCurrentBuffer
"remove the current buffer"
buffers size > 0 ifTrue:[
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.
bufferUsageOrder addFirst:navigationState.
"Modified: / 24.2.2000 / 18:52:16 / cg"
!
createBuffer
self createBufferWithSpec:#fullBrowserSpec
!
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.
"Modified: / 29.2.2000 / 10:40:04 / cg"
!
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.
].
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 halt:'oops - 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
].
].
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 isNil ifTrue:[^ self].
self
fileOutEachClassIn:(self selectedCategoryClasses)
in:dirName
withFormat:aFormatSymbolOrNil.
!
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
!
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 at:'Remove')
noText:(resources at:'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 > 0 ifTrue:[
|cancelAllButton|
cancelAllButton := Button label:(resources string:'Cancel All').
box addButton:cancelAllButton before:box cancelButton.
cancelAllButton action:[
cancelAll := true.
box doAccept.
box okPressed.
].
].
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:[
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 repositoryFilter userFilter aStream box y component
timeGoalListPop repositoryFilterPop userFilterPop|
timeGoal := 'yesterday' asValue.
repositoryFilter := 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 (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'
'mm/dd'
'mm/01'
'a week ago'
'a month ago'
'a year ago'
'all'
).
y := box yPosition.
component := box addTextLabel:(resources string:'For repository (empty for all):').
component width:0.5; adjust:#right; borderWidth:0.
box yPosition:y.
repositoryFilterPop := box addComboBoxOn:repositoryFilter tabable:true.
repositoryFilterPop width:0.5; left:0.5; immediateAccept:true; acceptOnLeave:false; cursorMovementWhenUpdating:#beginOfLine.
repositoryFilterPop list:#(
"/ to do - get list of available repositories ...
'stx'
'exept'
''
).
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.
box addAbortAndOkButtons.
box open.
box accepted ifTrue:[
repositoryFilter := repositoryFilter value.
repositoryFilter size == 0
ifTrue:[repositoryFilter := nil]
ifFalse:[repositoryFilter := Array with:repositoryFilter].
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
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
AbortSignal 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
]
]
]
]
!
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.
classList isOrderedCollection ifFalse:[
self halt:'should not happen'.
^ self
].
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.
classList isOrderedCollection ifFalse:[
self halt:'should not happen'.
^ self
].
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 halt:'oops - aspect'.
"Created: / 8.11.2001 / 23:02:46 / cg"
"Modified: / 8.11.2001 / 23:17:33 / cg"
!
classMenuCleanUpChangeSet
"remove all changes for the selected class(es) from the changeSet"
(self confirm:'This will remove all changes for the selected class(es) from the changeSet.\\Really cleanup ?' withCRs)
ifFalse:[ ^ self].
self 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.
(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 size == 0 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 |
generator createApplicationCodeFor:eachClass theNonMetaclass
]
!
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
].
!
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.
]
!
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
!
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
!
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
!
classMenuGenerateStandardInitializationMethods
"create new and initialize methods"
self
generateUndoableChangeOverSelectedClasses:'Generate Initialization Code for %(singleClassNameOrNumberOfClasses)'
via:[:generator :eachClass |
generator createStandardInitializationMethodsIn: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.
]
].
!
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
!
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
].
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:[
self warn:'No such class: ', newOwnerName.
^ self
].
classes := self selectedClasses value.
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."
|ns baseName|
self selectedClassesDo:[:eachClass |
baseName := eachClass nameWithoutPrefix.
(ns := eachClass topOwningClass nameSpace) ~~ Smalltalk ifTrue:[
ns := 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.
ns isNil ifTrue:[^ self].
].
(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.
^ self
].
eachClass theNonMetaclass makePublicIn:ns
]
"Modified: 3.7.1997 / 13:26:21 / cg"
!
classMenuMoveToCategory
|allCategories box|
allCategories := Smalltalk allClassCategories asArray sort.
box := ListSelectionBox new.
box title:(resources string:'Move class(es) to which category:').
box list:allCategories.
box okAction:[:sel |
self withWaitCursorDo:[
self moveSelectedClassesToCategory:sel
]
].
box initialText:(LastCategoryRenames ? #('')) first.
box entryCompletionBlock:[:contents |
|s what|
s := contents withoutLeadingSeparators.
what := Smalltalk classCategoryCompletion:s.
box contents:what first.
(what at:2) size ~~ 1 ifTrue:[
self builder window beep
]
].
box 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:'.
newNameSpace size == 0 ifTrue:[^ self].
ns := Smalltalk at:newNameSpace asSymbol.
ns isNil ifTrue:[
(self confirm:'No such NameSpace exists.\\Create ?' withCRs) ifFalse:[
^ self
].
ns := NameSpace name:newNameSpace asSymbol
] ifFalse:[
ns isNameSpace ifFalse:[
self warn:'Not a NameSpace: ' , 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.
!
classMenuNewPrivateClass
"create a class-definition prototype for a dialog"
self
classClassDefinitionTemplateFor:Object
in:nil
asNamespace:false
private:true.
!
classMenuNewSubclass
"create a class-definition template in codeview"
|theClass cat|
(theClass := self theSingleSelectedClass) isNil ifTrue:[
self javaMode ifTrue:[
theClass := Java at:'java.lang.Object'
].
theClass isNil ifTrue:[
theClass := Object.
].
] ifFalse:[
theClass := theClass theNonMetaclass
].
self hasCategorySelected ifTrue:[
cat := self selectedCategoriesValue first
] ifFalse:[
cat := theClass category.
].
self
classClassDefinitionTemplateFor:theClass
in:cat
asNamespace:false
private:false.
"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.
!
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.
].
!
classMenuRemove
"remove the selected classes (and all of its subclasses)"
^ self classMenuRemoveAndPullUpSubclasses:false
!
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
]
"Modified: / 24.2.2000 / 09:31:23 / 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 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 allClassesDo:[:eachClass |
eachClass instAndClassSelectorsAndMethodsDo:[:sel :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 halt:'automatic rewrite not yet implemented'.
]
].
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 isSubclassOf:Metaclass) not]]) ifTrue:[
^ metaClassUsedOrNil
classTemplateFor:aSuperClass
in:categoryString
asNamespace:asNameSpace
private:isPrivate
].
(aSuperClass notNil and:[aSuperClass isJavaClass not]) ifFalse:[
(self javaMode
or:[aSuperClass notNil and:[aSuperClass isJavaClass]])
ifTrue:[
^ self javaClassTemplateFor:aSuperClass in:categoryString private:isPrivate
].
].
nsTemplate := ''.
self organizerMode value ~~ #namespace 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 ~~ #namespace 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:[
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: '''''.
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: / 24.2.2000 / 13:48:53 / 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:[
AbortSignal 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
!
generateMultipleClassUndoableMethods:nameOfOperation via:aBlock
"helper for code generators"
|generator count dict className|
generator := CodeGeneratorTool new.
generator startCollectChanges.
count := 0.
self selectedClassesWithWaitCursorDo:[:eachClass |
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 := self selectedClasses value 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.
].
generator executeCollectedChangesNamed:(nameOfOperation expandPlaceholdersWith:dict)
!
generateUndoableChangeOverSelectedClasses:nameOfOperation via:aBlock
"helper for code generators"
|generator count dict className|
generator := CodeGeneratorTool new.
generator startCollectChanges.
count := 0.
self selectedClassesWithWaitCursorDo:[: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 := self selectedClasses value 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:[
generator executeCollectedChangesNamed:(nameOfOperation expandPlaceholdersWith:dict)
]
!
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, ' ').
dict at:#inSingleMethodOrEmpty put:''.
dict at:#forSingleMethodOrEmpty put:''.
dict at:#sForPlural put:'s'.
dict at:#singleMethodNameOrNumberOfMethods put:(count printString , ' methods').
] ifFalse:[
method := self selectedMethods value first.
methodName := method mclass nameWithoutPrefix , '>>' , method selector.
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.
].
theClass changed:#package.
Smalltalk changed:#projectOrganization with:(Array with:theClass with:oldProject).
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 selectedClassesDo:[:eachClass |
|cls|
cls := eachClass.
cls isLoaded ifFalse:[
cls := eachClass autoload.
].
cls := cls theNonMetaclass.
((cls isSubclassOf:TestCase)
and:[cls isAbstract not]) ifTrue:[
self busyLabel:'running test %1 ...' with:cls name.
cls runTests.
]
].
] ensure:[
self normalLabel.
]
!
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'!
checkInClass:aClass withLog:logMessageOrNil withCheck:doCheck
"check a class into the source repository.
If logMessageOrNil isNil, ask for one."
SourceCodeManagerUtilities checkinClass:aClass withLog:logMessageOrNil withCheck:doCheck.
!
checkInClasses:aCollectionOfClasses withLog:logMessageOrNil withCheck:doCheck
"check a bunch of classes into the source repository.
If logMessageOrNil isNil, ask for one."
SourceCodeManagerUtilities checkinClasses:aCollectionOfClasses withLog:logMessageOrNil 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.
Object abortAllSignal 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:[
Object abortAllSignal "/ cancel
].
answer == true ifTrue:[
self checkOutClass:owner askForRevision:askForRevision.
alreadyCheckedOut add:owner.
].
]
]
].
].
self normalLabel.
!
classMenuCheckIn
"check a class into the source repository (with checks)"
^ self classMenuCheckIn:(UserPreferences current at:#checkClassesWhenCheckingIn ifAbsent:true)
!
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 answer log|
(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 size > 1 ifTrue:[
answer := true.
"/ answer := Dialog
"/ confirmWithCancel:'Use the same log message for all checkIns ?'
"/ default:true.
"/ answer isNil ifTrue:[^ self].
answer == true ifTrue:[
log := SourceCodeManagerUtilities getLogMessageFor:(resources string:'%1 classes to checkin' with:classesToCheckIn size).
log isNil ifTrue:[
^ self
].
]
].
classesToCheckIn notEmpty ifTrue:[
self checkInClasses:classesToCheckIn withLog:log withCheck:doCheck.
].
self normalLabel.
!
classMenuCheckInExtensions
"check a classes extensions into the source repository (with checks)"
^ self classMenuCheckInExtensions:true
!
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
askForMethodsInOtherPackages:false
forClasses:(Smalltalk allClasses)
].
!
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
askForMethodsInOtherPackages:false
forClasses:(Smalltalk allClasses)
!
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
!
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.
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."
|classToCompare aStream comparedSource currentSource rev revString thisRevString mgr
nm msg brwsr versionsAreTheSame|
classToCompare := aClass.
classToCompare isLoaded ifFalse:[
self warn:'Cannot compare unloaded classes.'.
^ self.
].
classToCompare := classToCompare theNonMetaclass.
nm := classToCompare name.
mgr := classToCompare sourceCodeManager.
mgr isNil ifTrue:[
self warn:'No sourceCode manager - check settings'.
^ self
].
rev := classToCompare binaryRevision.
rev isNil ifTrue:[
rev := classToCompare revision.
].
rev isNil ifTrue:[
self warn:'The class seems to have no repository information.'.
^ self
].
rev := mgr newestRevisionOf:classToCompare.
"/
"/ class in repository - ask for revision
"/
msg := 'extracting revision %1'.
self busyLabel:msg with:rev.
aStream := mgr getSourceStreamFor:classToCompare 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.
classToCompare fileOutOn:aStream withTimeStamp:false.
currentSource := aStream contents asString.
aStream close.
self busyLabel:'comparing ...' with:nil.
versionsAreTheSame := false.
comparedSource = currentSource ifTrue:[
versionsAreTheSame := true.
] ifFalse:[
thisRevString := classToCompare revision.
thisRevString isNil ifTrue:[
thisRevString := 'no revision'
].
revString := rev , ' (newest)'.
self busyLabel:'comparing ...' with:nil.
brwsr := (UserPreferences versionDiffViewerClass)
openOnClass:classToCompare
labelA:('repository: ' , revString)
sourceA:comparedSource
labelB:('current: (based on: ' , rev , ')')
sourceB:currentSource
title:('comparing ' , classToCompare name)
ifSame:[versionsAreTheSame := true].
versionsAreTheSame ifFalse:[
brwsr classChangeSet
classBeingCompared:classToCompare;
versionA:rev;
versionB:rev , 'mod'.
].
].
versionsAreTheSame ifTrue:[
(ChangeSet current includesChangeForClassOrMetaclassOrPrivateClassOf:classToCompare) ifTrue:[
(self confirm:'Versions are identical.\\Remove entries from changeSet ?' withCRs) ifTrue:[
ChangeSet current condenseChangesForClass:classToCompare.
].
] ifFalse:[
self information:'Versions are identical.'.
]
].
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 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:(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 first isUppercase 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 classes nClasses infoMsg|
(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 isEmpty ifTrue:[
^ nil
].
newSelector := newSelector asSymbol.
"/ 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 isEmpty ifTrue:[
"/ cancelled
^ nil
].
] ifFalse:[
initializer := 'nil' "/ dummy - not used anyway
].
refactoring := AddParameterRefactoring
addParameterToMethod:selector
in:cls
newSelector:newSelector
initializer:initializer.
nSenders > 0 ifTrue:[
classes := (senders collect:[:eachMethod | eachMethod mclass]) asIdentitySet.
nClasses := classes size.
nClasses == 1 ifTrue:[
infoMsg := 'About to rewrite %1 sending method(s) in %3...'
] ifFalse:[
infoMsg := 'About to rewrite %1 sending method(s) in %2 class(es)...'
].
(self confirm:(resources string:infoMsg
with:nSenders printString
with:nClasses printString
with:classes first name allBold)) ifFalse:[^ self].
].
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.
(cls isNil or:[mthd isNil]) ifTrue:[
self halt:'oops - no class/method'.
^ self.
].
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.
(cls isNil or:[mthd isNil]) ifTrue:[
self halt:'oops - no class/method'.
^ self.
].
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 |
(self askIfModified:'Text was modified - please accept first' default:false) ~~ true
ifTrue:[
^ self
].
node := self findNode.
(node isNil or: [node isValue not])
ifTrue: [^self warn: 'Could not find the node'].
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"
|newText|
self hasSingleMethodSelected ifFalse:[^ self].
newText := self formatCode.
newText isNil ifTrue:[
^ self
].
"autoAcceptFormattedCode" false ifTrue:[
self doAcceptMethod:newText.
] ifFalse:[
self codeView contents:newText.
]
!
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 size == 0 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 senders nSenders classes nClasses infoMsg|
(self askIfModified) ifFalse:[
^ self
].
cls := self theSingleSelectedMethod mclass.
selector := self theSingleSelectedMethod selector.
selectedParameter := self selectionInCodeView.
(self confirm:(resources string:'Inline parameter ''%1'' ?' with:selectedParameter)) ifFalse:[^ self].
refactoring := InlineParameterRefactoring inlineParameter:selectedParameter in:cls selector:selector.
"/ how many senders are there ?
senders := SystemBrowser findSendersOf:selector in:(Smalltalk allClasses) ignoreCase:false match:false.
nSenders := senders size.
nSenders > 0 ifTrue:[
classes := (senders collect:[:eachMethod | eachMethod mclass]) asIdentitySet.
nClasses := classes size.
nClasses == 1 ifTrue:[
infoMsg := 'About to rewrite %1 sending method(s) in %3...'
] ifFalse:[
infoMsg := 'About to rewrite %1 sending method(s) in %2 class(es)...'
].
(self confirm:(resources string:infoMsg
with:nSenders printString
with:nClasses printString
with:classes first name allBold)) ifFalse:[^ self].
].
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 at:(mClass name).
newMethod := newClass compiledMethodAt:mSelector.
newClass ~~ self theSingleSelectedClass ifTrue:[
self halt.
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 halt:'oops'
].
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 senders nSenders classes nClasses infoMsg|
(self askIfModified) ifFalse:[
^ self
].
cls := self theSingleSelectedMethod mclass.
selector := self theSingleSelectedMethod selector.
selectedParameter := self selectionInCodeView.
(self confirm:(resources string:'Inline parameter ''%1'' ?' with:selectedParameter)) ifFalse:[^ self].
refactoring := InlineParameterRefactoring inlineParameter:selectedParameter in:cls selector:selector.
"/ how many senders are there ?
senders := SystemBrowser findSendersOf:selector in:(Smalltalk allClasses) ignoreCase:false match:false.
nSenders := senders size.
nSenders > 0 ifTrue:[
classes := (senders collect:[:eachMethod | eachMethod mclass]) asIdentitySet.
nClasses := classes size.
nClasses == 1 ifTrue:[
infoMsg := 'About to rewrite %1 sending method(s) in %3...'
] ifFalse:[
infoMsg := 'About to rewrite %1 sending method(s) in %2 class(es)...'
].
(self confirm:(resources string:infoMsg
with:nSenders printString
with:nClasses printString
with:classes first name allBold)) ifFalse:[^ self].
].
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 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
with:(self meta value ifTrue:['classInstance'] ifFalse:['instance']))
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).
self performRefactoring:refactoring.
"/ self switchToSelector:mthd selector.
self switchToMethod:mthd.
!
findNode
|interval|
interval := self selectedInterval.
^ self findNodeForInterval:interval
!
findNodeForInterval:interval
|tree node source|
interval isEmpty 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].
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
!
formatCode
"format (prettyPrint) the selected methods"
|tree newText mthd codeView|
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:[
|highlighter cls|
highlighter := mthd syntaxHighlighterClass.
highlighter == #askClass ifTrue:[
cls := mthd mclass ? Object.
highlighter := cls syntaxHighlighterClass.
].
highlighter notNil ifTrue:[
newText := highlighter formatMethod:newText in:cls.
]
].
codeView contents:newText.
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:'oops - 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 enqueueDelayedUpdateCode.
^ 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
! !
!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 halt:'oops - 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 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'
! !
!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 setTextSelection: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"
!
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:#namespace.
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'!
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].
classes do:[:cls |
self
checkInClass:cls
withLog: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].
classes do:[:cls |
self
checkInClass:cls
withLog: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
package: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
!
projectMenuBitmapFiles
self information:'Sorry - this functionality is not yet implemented'
!
projectMenuCheckInAll
self selectedProjectsDo:[:packageToCheckIn |
self
projectMenuCheckInProject:packageToCheckIn
classes:true
extensions:true
]
!
projectMenuCheckInClasses
self selectedProjectsDo:[:packageToCheckIn |
self
projectMenuCheckInProject:packageToCheckIn
classes:true
extensions:false
]
!
projectMenuCheckInExtensions
self selectedProjectsDo:[:packageToCheckIn |
self
projectMenuCheckInProject:packageToCheckIn
classes:false
extensions:true
]
!
projectMenuCheckInProject:packageToCheckIn classes:doClasses extensions:doExtensions
^ self
projectMenuCheckInProject:packageToCheckIn classes:doClasses extensions:doExtensions
forClasses:(Smalltalk allClasses)
!
projectMenuCheckInProject:packageToCheckIn classes:doClasses extensions:doExtensions askForMethodsInOtherPackages:askForMethodsInOtherPackages forClasses:classes
|classesToCheckIn methodsToCheckIn
methodsInOtherPackages otherPackages
msg classesWithExtensions logMsg answer labels values|
classesToCheckIn := IdentitySet new.
methodsToCheckIn := IdentitySet new.
methodsInOtherPackages := 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.
].
].
"/ individual methods ...
classes do:[:aClass |
aClass isMeta ifFalse:[
aClass instAndClassSelectorsAndMethodsDo:[:sel :mthd |
"/ methods in this project ...
(mthd package = packageToCheckIn) ifTrue:[
"/ ... whose class is not in the ckechIn-set
(classesToCheckIn includes:aClass) ifFalse:[
methodsToCheckIn add:mthd
]
]
].
].
].
doExtensions ifTrue:[
methodsToCheckIn notEmpty ifTrue:[
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.
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:[ AbortSignal raise ].
answer == #browse ifTrue:[
self
spawnMethodBrowserFor:methodsToCheckIn
in:#newBrowser
label:('Extension Methods of Project %1' bindWith:packageToCheckIn).
AbortSignal raise
].
answer == true ifTrue:[
logMsg := SourceCodeManagerUtilities getLogMessageFor:'Extensions in project ''' , packageToCheckIn , ''''.
(SourceCodeManagerUtilities
checkinExtensionMethods:methodsToCheckIn
forPackage:packageToCheckIn
withLog:logMsg) ifFalse:[
self warn:'Could not check in extensions for project %1' with:packageToCheckIn.
^ self.
]
]
]
].
"/ check if any of the classes contains methods for other packages ...
classesToCheckIn do:[:eachClass |
eachClass methodDictionary do:[:eachMethod |
(eachMethod package = packageToCheckIn) ifFalse:[
methodsInOtherPackages add:eachMethod
]
].
eachClass class methodDictionary do:[:eachMethod |
(eachMethod package = packageToCheckIn) ifFalse:[
methodsInOtherPackages add:eachMethod
]
].
].
askForMethodsInOtherPackages ifTrue:[
methodsInOtherPackages notEmpty ifTrue:[
otherPackages := Set new.
methodsInOtherPackages do:[:eachMethod | otherPackages add:eachMethod package].
methodsInOtherPackages size == 1 ifTrue:[
msg := 'The ''%4'' method in ''%5'' is contained in the ''%2'' package.'.
msg := msg , '\\Shall this method be moved to the ''%6'' project and checked into the class container ?'.
] ifFalse:[
otherPackages size == 1 ifTrue:[
msg := '%1 methods from the %2 package were found in the projects classes.'
] ifFalse:[
msg := '%1 methods from %3 other packages were found in the projects classes.'
].
msg := msg , '\\Shall those methods be moved to their corresponding classes project and checked into their class container ?'.
].
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
with:methodsInOtherPackages first mclass package allBold.
(Dialog confirm:msg) ifTrue:[
methodsInOtherPackages do:[:eachMethod |
eachMethod package:(eachMethod mclass package)
].
] ifFalse:[
msg := 'When checking in, the methods from other packages will NOT be checked into the repository,'.
msg := msg , '\(They will be saved, when the other project(s) are checkedIn)'.
msg := msg , '\\Proceed anyway ?'.
msg := msg withCRs.
(Dialog confirm:msg) ifFalse:[
^ self
].
self halt:'untested code'.
].
].
].
doClasses ifTrue:[
classesToCheckIn notEmpty ifTrue:[
SourceCodeManagerUtilities checkinClasses:classesToCheckIn withLog:logMsg.
]
].
self normalLabel.
!
projectMenuCheckInProject:packageToCheckIn classes:doClasses extensions:doExtensions forClasses:classes
^ self
projectMenuCheckInProject:packageToCheckIn classes:doClasses extensions:doExtensions
askForMethodsInOtherPackages:true
forClasses:classes
!
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
!
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 package: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
!
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 halt:'oops - binary must go into separate files'.
^ 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 halt:'sorry: unimplemented'.
"/ 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
!
projectMenuGenerateAbbrevFile
"/ intermediate - this will move into a commonly used utility class
"/ (where all the project code support will be collected).
self
projectMenuWithAllClassesLoadedDo:[:module :package :classesInProject |
|moduleAndPackage classesSorted mgr outStream|
moduleAndPackage := module , ':' , package.
self busyLabel:'Generating abbrev.stc file for ' , moduleAndPackage , '...'.
"/ now, generate the abbrev.stc file
mgr := classesInProject first sourceCodeManager.
mgr isNil ifTrue:[
self warn:'No sourceCode manager - cannot checkin\(will generate an abbrev-file in the current directory).' withCRs.
'abbrev.stc' asFilename exists ifTrue:[
(self confirm:'An abbrev file exists in the current directory\\Overwrite ?' withCRs) ifFalse:[
^ self.
]
].
outStream := 'abbrev.stc' asFilename writeStream.
] ifFalse:[
(mgr checkForExistingContainerInModule:module package:package container:'abbrev.stc') ifFalse:[
(mgr createContainerForText:'' inModule:module package:package container:'abbrev.stc') ifFalse:[
self warn:(resources string:'cannot create new container: ''abbrev.stc'' (in %1:%2)'
with:module with:package).
^ self.
].
].
outStream := '' writeStream.
].
classesSorted := classesInProject asOrderedCollection.
classesSorted sort:[:a :b | a name < b name].
classesSorted do:[:eachClass |
|classFileName sourceInfo|
sourceInfo := eachClass sourceCodeManager sourceInfoOfClass:eachClass.
sourceInfo notNil ifTrue:[
classFileName := eachClass sourceCodeManager containerFromSourceInfo:sourceInfo.
] ifFalse:[
classFileName := eachClass classFilename ? eachClass nameWithoutPrefix.
].
outStream nextPutAll:eachClass name; space.
outStream nextPutAll:classFileName asFilename withoutSuffix baseName; space.
outStream nextPutAll:(module , ':' , package); space.
outStream nextPutAll:'''' , eachClass category , ''''.
outStream cr.
].
outStream close.
mgr notNil ifTrue:[
self activityNotification:(resources string:'checking in...').
UserInformation handle:[:ex |
Transcript showCR:ex description
] do:[
(mgr
checkin:'abbrev.stc'
text:(outStream contents)
directory:package
module:module
logMessage:'automatically generated by browser'
force:true)
ifFalse:[
Transcript showCR:'checkin of abbrev.stc failed'.
self warn:'checkin failed'.
].
].
].
].
!
projectMenuGenerateClassLibrary
self information:'Sorry - this functionality is not yet implemented'
!
projectMenuGenerateLoadAllFile
"/ intermediate - this will move into a commonly used utility class
"/ (where all the project code support will be collected).
self
projectMenuWithAllClassesLoadedDo:[:module :package :classesInProject |
|moduleAndPackage classesInLoadOrder mgr outStream hasExtensions|
moduleAndPackage := module , ':' , package.
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 package:package container:'loadAll') ifFalse:[
(mgr createContainerForText:'' inModule:module package:package container:'loadAll') ifFalse:[
self warn:(resources string:'cannot create new container: ''loadAll'' (in %1:%2)'
with:module with:package).
^ 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 ? (eachClass nameWithoutPrefix , '.st').
].
outStream nextPutLine:' ''' , classFilename asFilename baseName, ''''.
].
hasExtensions ifTrue:[
outStream nextPutLine:' ''extensions.st'''.
].
outStream nextPutAll:'
) asOrderedCollection.
"/ see if there is a classLibrary
(Smalltalk fileInClassLibrary:''' , package , ''') 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:package
module:module
logMessage:'automatically generated by browser'
force:false)
ifFalse:[
Transcript showCR:'checkin of loadAll failed'.
self warn:'checkin failed'.
].
].
].
].
!
projectMenuGenerateMakeProtoFile
"/ intermediate - this will move into a commonly used utility class
"/ (where all the project code support will be collected).
self
projectMenuWithAllClassesLoadedDo:[:module :package :classesInProject |
|moduleAndPackage classesInLoadOrder mgr outStream hasExtensions libName|
libName := package copyFrom:(package lastIndexOf:$/)+1.
moduleAndPackage := module , ':' , package.
self busyLabel:'Generating Make.proto file for ' , moduleAndPackage , '...'.
"/ now, generate the Make.proto 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 Make.proto-file in the current directory).' withCRs.
'Make.proto' asFilename exists ifTrue:[
(self confirm:'A Make.proto file exists in the current directory\\Overwrite ?' withCRs) ifFalse:[
^ self.
]
].
outStream := 'Make.proto' asFilename writeStream.
] ifFalse:[
(mgr checkForExistingContainerInModule:module package:package container:'Make.proto') ifFalse:[
(mgr createContainerForText:'' inModule:module package:package container:'Make.proto') ifFalse:[
self warn:(resources string:'cannot create new container: ''Make.proto'' (in %1:%2)'
with:module with:package).
^ self.
].
].
outStream := '' writeStream.
].
outStream nextPutAll:'#
# $' , 'Header' , '$
#
# --- Make.proto automatically created by the browsers generate-MakeProto function
#
# position in directory hierarchy:
TOP=../..
# subdirectories where targets are to be made:
SUBDIRS=
# subdirectories where Makefiles are to be made:
# (only to be defined if different from SUBDIRS)
# ALLSUBDIRS=
# ***************************** you may have to modify the next line ***
MODULE=' , module , '
MODULE_DIR=' , package , '
LIBNAME=' , libName , '
PACKAGE=$(MODULE):$(MODULE_DIR)
# -H. : create header files locally
# -Pxxx : defines the package
# -Zxxx : a prefix for variables within the classLib
# +optspace : optimized for space
# +optspace2 : optimized more for space
# +optspace3 : optimized even more for space
# +optinline : generate optimized inline code
# +inlineNew : additionally inline new
#
# ***************************** you may have to modify the following lines ***
# STCLOCALOPTIMIZATIONS=+optinline +inlineNew
# STCLOCALOPTIMIZATIONS=+optspace2
#
# sorry: must prevent stc from inlining #not - sigh
#
STCLOCALOPTIMIZATIONS=+optspace2 -inlinenot
#
# for a class-library package, you can uncomment the following:
# (it does not hurt much, if you leave it as is - but you may NOT
# uncomment it if object files are to be loaded individually later).
# INITCODESEPFLAG=$(SEPINITCODE)
#
# the following MAY ONLY be uncommented for classes/classLibs,
# which are ALWAYS statically included in the executable.
# (i.e. not for those which are subject to dynamic loading).
# COMMONSYMFLAG=$(COMMONSYMBOLS)
#
# SUPERCLASSINCL=-I$(TOP)/libbasic -I$(TOP)/libwidg2
STCLOCALOPT=$(SUPERCLASSINCL) $(STCLOCALOPTIMIZATIONS) -H. ''-P$(PACKAGE)'' -Z' ,libName,' $(COMMONSYMFLAG) $(INITCODESEPFLAG)
# if you use RCS, there are rules in the Makefile for ci/co
RCSSOURCES=*.st Make.proto
# additional C targets or libraries should be added below
LOCAL_EXTRA_TARGTES=
all:: classLibRule
OBJS= \
'.
classesInLoadOrder
do:[:eachClass |
|sourceInfo classFilename|
sourceInfo := eachClass sourceCodeManager sourceInfoOfClass:eachClass.
sourceInfo notNil ifTrue:[
classFilename := eachClass sourceCodeManager containerFromSourceInfo:sourceInfo.
] ifFalse:[
classFilename := eachClass classFilename ? (eachClass nameWithoutPrefix).
].
classFilename := classFilename asFilename withoutSuffix baseName.
outStream nextPutAll:' ' , classFilename , '.$(O)'.
]
separatedBy:[ outStream nextPutLine:' \' ].
hasExtensions ifTrue:[
outStream nextPutLine:' \'.
outStream nextPutAll:' extensions.$(O)'
].
outStream nextPutAll:'
cleanjunk::
clean::
' , Character tab , '@-rm -f *.c *.H *.o
clobber::
' , Character tab , '@-rm -f *.c *.H *.o
# BEGINMAKEDEPEND --- do not remove this line; make depend needs it
# ENDMAKEDEPEND --- do not remove this line
'.
outStream close.
mgr notNil ifTrue:[
self activityNotification:(resources string:'checking in...').
UserInformation handle:[:ex |
Transcript showCR:ex description
] do:[
(mgr
checkin:'Make.proto'
text:(outStream contents)
directory:package
module:module
logMessage:'automatically generated by browser'
force:false)
ifFalse:[
Transcript showCR:'checkin of Make.proto failed'.
self warn:'checkin failed'.
].
].
].
].
!
projectMenuGenerateMakefiles
"/ intermediate - this will move into a commonly used utility class
"/ (where all the project code support will be collected).
self projectMenuGenerateMakeProtoFile
!
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
package: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 |
eachClassDefinition installAsAutoloadedClassIfNotPrivate.
].
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.'
]
].
].
!
projectMenuImportAndLoadClasses
"import packages AND load classes"
self projectMenuImport:true
!
projectMenuLoad
|projects projectsString|
projects := (self selectedProjects value) ? #().
projectsString := projects asStringCollection asStringWith:Character space.
projectsString := Dialog request:'Load which package(s):' initialAnswer:projectsString.
projectsString size == 0 ifTrue:[^ self].
projects := projectsString asCollectionOfWords.
projects do:[:packageToLoad |
Smalltalk loadPackage:packageToLoad
]
!
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.
!
projectMenuNew
|box initial newProject currentProject|
initial := 'module:directory'.
currentProject := self theSingleSelectedProject.
currentProject notNil ifTrue:[
initial := currentProject upTo:$:.
initial := initial , ':' , 'newProject'.
] ifFalse:[
initial := OperatingSystem getLoginName , ':newProject'
].
box := self
enterBoxTitle:'package-ID (module:directory) of new project:'
okText:'create'
label:'Add new project'.
box initialText:initial.
box action:[:aString | newProject := aString].
box showAtPointer.
newProject size > 0 ifTrue:[
"/ self immediateUpdate value:true.
self projectListApp addAdditionalProject:newProject.
"/ self immediateUpdate value:false.
self selectProject:newProject.
self selectedClasses value:#().
].
!
projectMenuProperties
self information:'Sorry - this functionality is not yet implemented'
!
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 (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'
!
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 upTo:$:.
package := packageToCheck copyFrom:(module size + 2).
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
!
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 halt:'not yet implemented'.
"/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.
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
|"box" newProtocol classesCategories someCategories cls suggestion|
LastNewProtocols notEmptyOrNil ifTrue:[
suggestion := LastNewProtocols first.
].
someCategories := Set new.
Smalltalk allBehaviorsDo:[:eachClass |
someCategories addAll:eachClass categories
].
"/ remove existing ones ...
(cls := self theSingleSelectedClass) notNil ifTrue:[
classesCategories := cls categories.
someCategories removeAllFoundIn:classesCategories.
(classesCategories includes:suggestion) ifTrue:[
suggestion := nil.
].
].
someCategories := someCategories asOrderedCollection sort.
newProtocol := self
askForMethodCategory:'Name of new protocol:'
okLabel:'Create'
list:someCategories
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
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|
className := classNameArg.
singleClass ifTrue:[
className includesMatchCharacters ifFalse:[
classes := self class classesWithNameSimilarTo:className.
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].
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/containing to ''',classNameArg allBold,'''\\Select class to switch to:') withCRs
okText:'OK'
list:classNames.
box initialText:(classes first name).
box entryCompletionBlock:(self classNameEntryCompletionBlock).
box action:[:aString | className := aString string].
box open.
className isNil ifTrue:[ "/ cancel
^ nil
]
].
].
] 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.
].
]
] ifFalse:[
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'.
].
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.2.2000 / 20:35:30 / cg"
"Modified: / 30.10.2001 / 16:50:53 / 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 whichClassImplements:selector.
class isNil ifTrue:[
searchClass isMeta ifTrue:[
class := searchClass theNonMetaclass whichClassImplements:selector.
] ifFalse:[
class := searchClass theMetaclass whichClassImplements: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 whichClassImplements: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:[
reqString := 'Move selected method(s) to which class ?\(enter ''Foo class'' to move to Metaclass)'.
okLabel := 'Move'.
title := 'Move method(s)'.
].
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|
"/ 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 , ' ?'
].
msg := resources
string:msg
with:numMethods printString
with:numClasses printString
with:(methods first selector ? '?') allBold
with:classes first name 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 halt:'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 isJavaScriptClass 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.
].
].
!
moveOrCopyMethods:methods toClass:newClass moveOrCopy:doWhat
"move or copy some methods to some other class - typically a sister class"
|canUseRefactoringSupport changes nm|
canUseRefactoringSupport := self canUseRefactoringSupport.
canUseRefactoringSupport ifTrue:[
nm := (doWhat == #copy) ifTrue:['Copy %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|
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 == #move) ifTrue:[
canUseRefactoringSupport ifTrue:[
changes removeMethod: selectorToCopyOrMove from:oldClass
] ifFalse:[
oldClass removeSelector:selectorToCopyOrMove.
]
]
]
]
].
canUseRefactoringSupport ifTrue:[
RefactoryChangeManager performChange: changes
].
!
renameMethod:oldSelector in:aClass
| newSelector tree dialog args newArgs map refactoring senders nSenders classes nClasses infoMsg
rslt firstClassName secondClassName answer brwsr
renameSelectedMethodsOnly renameOnly|
RBParser autoload.
tree := aClass parseTreeFor:oldSelector.
tree isNil ifTrue:[
self warn: 'Could not parse the method'.
^ nil
].
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:'Rename ' , oldSelector , '...'.
dialog openWindow.
dialog accepted ifFalse: [^nil].
newSelector := dialog methodName.
renameSelectedMethodsOnly := dialog isRenameSelectedMethodsOnly.
renameOnly := dialog isRenameOnly.
renameOnly ifFalse:[
"/ how many senders are there ?
senders := SystemBrowser findSendersOf:oldSelector in:(Smalltalk allClasses) ignoreCase:false match:false.
nSenders := senders size.
nSenders > 0 ifTrue:[
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
^ self
].
answer == #browse ifTrue:[
brwsr := self
spawnMethodBrowserFor:senders in:#newBuffer
label:'Senders of ' , oldSelector
perMethodInfo:nil
sortBy:#class.
brwsr autoSearchPattern:oldSelector.
^ 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 lastRevision 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.
lastSource := method source.
lastRevision := 'current'.
mgr := mclass theNonMetaclass sourceCodeManager.
previousMethods := ChangeSet new.
self withWaitCursorDo:[
revisions := (mgr revisionLogOf:mclass) at:#revisions.
revisions do:[:eachLogEntry |
|revision date revSourceStream|
revision := eachLogEntry at:#revision.
date := eachLogEntry at:#date.
[
|chg nChg classChangeSet changeSource|
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"
] ifFalse:[
changeSource := chg source.
].
changeSource = lastSource ifTrue:[
] ifFalse:[
nChg := lastChange asNamedMethodChange.
nChg changeName:lastRevision.
previousMethods add:nChg.
lastSource := changeSource.
lastChange := chg.
].
lastRevision := revision.
] ensure:[
revSourceStream notNil ifTrue:[revSourceStream close].
].
].
browser := ChangeSetBrowser openOn:previousMethods.
browser window label:('Revisions of ' , mclass name , ' ' , mselector).
browser readOnly:true.
].
!
selectorMenuCheckInProjectExtensions
|projects|
projects := ((self selectedMethods value) collect:[:each | each package]) asSet.
projects do:[:packageToCheckIn |
self
projectMenuCheckInProject:packageToCheckIn
classes:false
extensions:true
].
!
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."
|prev|
self theSingleSelectedMethod isNil ifTrue:[^ self].
prev := Compiler stcCompilation:#always.
self withWaitCursorDo:[
[
self codeView accept.
] ensure:[
Compiler stcCompilation:prev
]
].
!
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.
]
!
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 whichClassImplements: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:[
CodeGeneratorTool
createSubclassResponsibilityMethodFor:selector category:category in:mclass superclass.
]
].
].
]
!
selectorMenuGenerateTemplateInSubclasses
"generate a template in every 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 subclasses do:[:eachSubClass |
|code|
(eachSubClass implements:selector) ifFalse:[
code := spec , '\ self halt.\ ^ self' withCRs.
generator
compile:code
forClass:eachSubClass
inCategory:category
].
].
]
!
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
!
selectorMenuMakeClassOrInstanceMethod
"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.
].
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:[
(methodToMove mclass) removeSelector:selectorToMove.
]
]
]
!
selectorMenuMakeInstanceMethod
"move the selected methods from inst to their class side or vice versa"
self selectorMenuMakeClassOrInstanceMethod
!
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].
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
!
selectorMenuMoveToProject
"change the package-id of the selected methods.
Will eventually update the Project-object"
|newProject classProjects offered|
LastProjectMoves size > 0 ifTrue:[
offered := LastProjectMoves first
] ifFalse:[
classProjects := (self selectedMethods value collect:[:eachMethod | eachMethod mclass theNonMetaclass package]) asSet.
classProjects size == 1 ifTrue:[
offered := classProjects first
] ifFalse:[
offered := "classesProject ? "Project current package
].
].
newProject := self askForProject:'Move method(s) to which project:' initialText:offered.
newProject notNil ifTrue:[
self doMoveSelectedMethodsToProject:newProject.
].
"Created: / 17.2.2000 / 23:02:49 / 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 whichClassImplements:mthd selector.
superClass notNil ifTrue:[
inherited := superClass compiledMethodAt:mthd selector.
inherited notNil ifTrue:[
initialAnswer := inherited category
]
]
]
]
].
newCategory := self
askForMethodCategory:'Move to which protocol ?'
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"
|mthd processingBlockString processingBlock dialog textHolder template
LastMethodProcessingBlockString|
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 halt:'oops - bad input'.
^ self
].
self
selectedMethodsDo:[:eachMethod |
processingBlock
value:(eachMethod mclass)
value:(eachMethod selector)
value:eachMethod
]
!
selectorMenuPushDownMethod
"push method(s) into subclass(s)"
|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].
refactoring := PushDownMethodRefactoring pushDown:selectors from:eachClass.
nm := 'Push down '.
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"
|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].
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.
].
!
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 allClassesDo:[:eachClass |
eachClass instAndClassSelectorsAndMethodsDo:[:sel :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 halt:'not yet implemented'.
^ self selectMethodsWhere:[:mthd | self halt]
!
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"
!
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
!
spawnMethodImplementorsBrowserFor:aSelectorCollection match:doMatch in:openHow
"open a new browser or add a buffer showing the selected methods only"
self withSearchCursorDo:[
|newBrowser label impls searchBlock cachedList|
aSelectorCollection size == 1 ifTrue:[
label := resources string:'Implementors of %1' with:(aSelectorCollection first)
] ifFalse:[
label := 'Implementors'.
].
searchBlock := [
|list|
(list := cachedList) notNil ifTrue:[
cachedList := nil
] ifFalse:[
list := IdentitySet new.
aSelectorCollection do:[:aSelector |
doMatch ifTrue:[
list addAll:(self class
findImplementorsMatching:aSelector
in:Smalltalk allClasses
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:[
(self confirm:((label bindWith:label) , ' - only the selected method found.\\Browse anyway ?' withCRs))
ifFalse:[
^ self
]
].
newBrowser := self
spawnMethodBrowserForSearch:searchBlock
sortBy:nil
in:openHow
label:label.
]
!
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.
]
!
spawnMethodSendersBrowserFor:aSelectorCollection in:openHow
"open a new browser or add a buffer showing the selected methods senders only"
|label|
self withSearchCursorDo:[
|cachedList newBrowser theSingleSelector searchBlock|
aSelectorCollection size == 1 ifTrue:[
theSingleSelector := aSelectorCollection first.
label := 'Senders of %1' bindWith:theSingleSelector.
] ifFalse:[
label := 'Senders'.
].
searchBlock := [
|l|
cachedList notNil ifTrue:[
l := cachedList.
cachedList := nil
] ifFalse:[
l := IdentitySet new.
aSelectorCollection do:[:aSelector |
l addAll:(self class
findSendersOf:aSelector
in:Smalltalk allClasses
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:[
(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.
theSingleSelector notNil ifTrue:[
newBrowser autoSearchSelector:theSingleSelector ignoreCase:false doMatch:false.
].
]
!
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
!
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 a new variable."
|words variableToAdd 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']
ifFalse:['variable']).
variableToAdd :=
Dialog
request:(resources string:msg)
title:(resources string:boxTitle)
initialAnswer:initial.
variableToAdd size == 0 ifTrue:[^ self].
selectedClass := self theSingleSelectedClass.
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 setTextSelection:names
!
variablesMenuFindVariable
self halt.
!
variablesMenuGenerateAccessMethods
"create access methods for selected instvars."
self
variablesMenuGenerateAccessMethodsWithChange: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."
self
generateUndoableChangeOverSelectedClasses:'Generate Accessors in %(singleClassNameOrNumberOfClasses)'
via:[:generator :eachClass |
|names|
names := self variableFilter value.
names size > 0 ifTrue:[
generator
createAccessMethodsFor:names
in:eachClass
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
!
variablesMenuGenerateSetterMethods
"create setter methods for selected instvars."
self
variablesMenuGenerateAccessMethodsWithChange: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.
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 := Explainer 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:[
boxLabels := boxLabels , #('Inspect Values').
boxValues := boxValues , #(#inspectValues).
showingClassVars ifFalse:[
boxLabels := boxLabels , #('Inspect Instances').
boxValues := boxValues , #(#inspectInstances).
].
boxLabels := boxLabels , #('Inspect a Value').
boxValues := boxValues , #(#inspectAValue).
showingClassVars ifFalse:[
boxLabels := boxLabels , #('Inspect an 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 inspect
] 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.
isClassVar := self hasClassVariableSelectedInCodeView.
].
aBlock value:selectedVariable value:isClassVar
! !
!NewSystemBrowser methodsFor:'menus-dynamic'!
boockmarksMenu
<resource: #programMenu >
^ [
|m item|
m := Menu new.
item := MenuItem label:(resources string:'Add Bookmark').
m addItem:item.
item value:#'searchMenuAddToBookmarks'.
BookMarks size > 0 ifTrue:[
item := MenuItem label:(resources string:'Remove Bookmark').
m addItem:item.
item value:#'searchMenuRemoveFromBookmarks'.
item := MenuItem label:'-'.
m addItem:item.
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 addItem:(MenuItem label:'-').
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 addItem:(MenuItem label:'-').
] 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])]
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)"
|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
!
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].
].
!
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
<resource: #programMenu >
^ self
messagesMenuFor:#'spawnBrowserOnAllImplementorsOf:'
withSenderChain:false
withImplementorChain:(self window sensor ctrlDown) "/ true
!
messagesMenuFor:actionSelector withSenderChain:withSenderChain withImplementorChain:withImplementorChain
^ self
messagesMenuFor:actionSelector
withSenderChain:withSenderChain
withImplementorChain:withImplementorChain
selfSendsOnly:false
!
messagesMenuFor:actionSelector withSenderChain:withSenderChain withImplementorChain:withImplementorChain selfSendsOnly:selfSendsOnly
<resource: #programMenu >
^ [
|m mthd mSel item l cut|
m := Menu new.
mthd := self theSingleSelectedMethod.
(mthd notNil and:[ (mSel := mthd selector) notNil]) ifTrue:[
item := MenuItem label:(' ' , (mSel contractTo:100) , ' '). "/ kludge - to allow '-' selector
item value:actionSelector.
item argument:mSel.
m addItem:item.
withSenderChain ifTrue:[
item := MenuItem label:(' ' , (mSel contractTo:80) , ' - sender chain').
item value:#spawnSenderChainBuffer.
m addItem:item.
].
withImplementorChain ifTrue:[
item := MenuItem label:(' all - implementor chain').
item value:#spawnImplementorChainBuffer.
m addItem:item.
].
selfSendsOnly ifTrue:[
l := mthd messagesSentToSelf.
] ifFalse:[
l := mthd messagesSent.
].
l := l asSortedCollection.
l size > 0 ifTrue:[
m addItem:(MenuItem label:'-').
"
(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), ' '). "/ 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
].
"Modified: / 12.11.2001 / 15:05:18 / 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:'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
<resource: #programMenu >
^ self
messagesMenuFor:#'spawnBrowserOnAllSendersOf:'
withSenderChain:(self window sensor ctrlDown) "/ true
withImplementorChain:false
!
sentMessagesResponseMenu
<resource: #programMenu >
^ self
messagesMenuFor:#'findResponseTo:'
withSenderChain:false
withImplementorChain:false
selfSendsOnly:true
!
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:[^ #namespace ].
canvasType == #singleProjectFullBrowserSpec ifTrue:[^ #project ].
canvasType == #multipleClassExtensionBrowserSpec ifTrue:[^ nil ].
"/ self halt.
^ #category
!
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)"
self selectedClasses value:aCollectionOfClasses
"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 == #category]) 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 == #category 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 == #namespace 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 == #category 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 string:'searching for #%1 method.\\in which class ?\\(Tab for completion or select)' with:aSelectorString) withCRs.
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|
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 isNil ifTrue:[^ self].
((navigationState classList value ? #()) includesIdentical: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 ~~ #namespace ifTrue:[
answer := self confirmWithCancel:('Browser: ' , aClass name , ' is a namespace - switch organizers display mode ?').
answer isNil ifTrue:[
AbortSignal raise.
^ self
].
answer ifTrue:[
self organizerMode value:#namespace.
orgMode := self organizerMode value.
]
].
].
"/ 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 ? #().
(namespaces includes:aClass topNameSpace name) 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 == #category ifTrue:[
cat := aClass category.
(self selectedCategoriesValue includes:cat) ifFalse:[
self selectedCategories value:(OrderedCollection with:cat).
]
] ifFalse:[ orgMode == #namespace 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 == #project 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 == #classHierarchy
or:[orgMode == #classInheritance]) 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.
"Modified: / 24.2.2000 / 13:25:28 / cg"
!
switchToClassNameMatching:aMatchString
|className|
className := self askForClassNameMatching:aMatchString.
className notNil ifTrue:[
self switchToClassNamed:className.
]
"Modified: / 13.2.2000 / 20:57:42 / cg"
!
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 == #project 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).
]
!
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 == #project 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'!
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|
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|
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|
searchReaders ifTrue:[
searchWriters ifTrue:[
searcher := ParseTreeSearcher allReferencesToAnyVariableIn:aVariableNameOrCollectionOfVariableNames.
] ifFalse:[
searcher := ParseTreeSearcher allReadsOfAnyVariableIn:aVariableNameOrCollectionOfVariableNames.
].
] ifFalse:[
searchWriters ifTrue:[
searcher := ParseTreeSearcher allModificationsOfAnyVariableIn:aVariableNameOrCollectionOfVariableNames.
] ifFalse:[
self error
].
].
^ 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|
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 formatExpression: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 isJavaScriptClass]) 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 halt.
]
]
].
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 doStartSyntax codeView highlighter cls|
(codeView := self codeView) isNil ifTrue:[
self halt:'oops'.
^ self.
].
code := self sourceOfMethod:mthd.
"/ code := mthd source.
(self doAutoFormat value
and:[RBFormatter notNil]) ifTrue:[
Error handle:[:ex |
] do:[
code := RBFormatter format:code
].
].
cls := mthd mclass ? Object.
highlighter := mthd syntaxHighlighterClass.
highlighter == #askClass ifTrue:[
highlighter := cls syntaxHighlighterClass.
].
doStartSyntax := false.
(highlighter notNil
and:[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 := highlighter formatMethod:code in:cls.
] ifFalse:[
doStartSyntax := true.
].
[
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.
doStartSyntax ifTrue:[
self enqueueDelayedStartSyntaxHighlightProcess.
].
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 packageFromSourceInfo: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: / 20.11.2001 / 09:44:39 / 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 := 'Package: ' , (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.
!
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/Extension (' , mpkg , ')'
] ifFalse:[
info := 'Extension in: ''' , mpkg , ''''
].
navigationState packageLabelHolder value:info
] ifFalse:[
info := 'In BasePackage: ''' , mpkg.
info := info , ''' [' , (aMethod mclass theNonMetaclass revision printString) , ']'.
].
].
navigationState packageLabelHolder value:info
! !
!NewSystemBrowser methodsFor:'private-dialogs'!
askForDirectoryToFileOut:title default:defaultDirOrNil
|fileBox dirName dir|
fileBox := FileSelectionBox
title:title
okText:(resources string:'FileOut')
abortText:(resources string:'Cancel')
action:[:fileName |dirName := fileName.].
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
]
]
].
dir notNil ifTrue:[
fileBox directory:dir.
].
fileBox selectingDirectory:true.
fileBox open.
fileBox destroy.
fileBox := nil.
dirName notNil ifTrue:[
FileSelectionBox lastFileSelectionDirectory:dirName.
].
^ dirName
!
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|
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:title okLabel:okLabel list:someCategories initialAnswer:initialText
"convenient helper method: setup a box asking for a method category"
^ self
askForMethodCategory:title
okLabel:okLabel
list:someCategories
recentList:nil
initialAnswer:initialText
!
askForMethodCategory:title okLabel:okLabel list:someCategories recentList:recentListOrNil initialAnswer:initialText
"convenient helper method: setup a box asking for a method category"
|box retVal|
box := self
listBoxTitle:title
okText:okLabel
list:someCategories.
recentListOrNil notNil ifTrue:[
box useComboBoxWithList:recentListOrNil.
].
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 := someCategories 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 ?'
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
"helper for move-class-to-nameSpace;
Ask for the new nameSpaces name"
^ self askForNameSpace:title initialText:(LastNameSpaceMove ? '')
!
askForNameSpace:title initialText:initialTextOrNil
"Ask for the new namespaces name"
^ Dialog requestNameSpace:title 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)"
|allProjects newProject box classesProjects selectedClasses selectedMethods|
allProjects := self class allProjectsIDs.
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 ].
].
].
classesProjects remove:(Project defaultProject package) ifAbsent:nil.
classesProjects := classesProjects asOrderedCollection sort.
classesProjects addAllFirst:(LastProjectMoves ? #()).
box := ListSelectionBox new.
box useComboBoxWithList:classesProjects.
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
!
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 whichClassImplements: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:'Text was modified - 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 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
#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."
|answer labels values msg|
self codeView isNil ifTrue:[
"/ if in documentation browser ...
^ true
].
"/ compare - in case its not really modified
(self reallyModified:aNavigationState) ifFalse:[
^ true
].
compareOffered ifTrue:[
acceptOffered ifTrue:[
labels := #('Compare' 'Accept' 'Continue').
values := #(#compare #accept true).
] ifFalse:[
labels := #('Compare' 'Continue').
values := #(#compare true).
]
] ifFalse:[
acceptOffered ifTrue:[
labels := #('Compare' 'Accept' 'Continue').
values := #(#compare #accept true).
] ifFalse:[
labels := #('Continue').
values := #(true).
].
].
"/ DialogBox defaultOKButtonAtLeft ifTrue:[
"/ labels := labels , #('cancel').
"/ values := values , #(false).
"/ ] ifFalse:[
labels := #('Cancel') , labels.
values := #(false) , values.
"/ ].
msg := question ? 'Text has not been accepted.\\Your modifications will be lost when continuing.'.
answer := OptionBox
request:(resources at:msg) withCRs
label:(resources string:'Attention')
image:(WarningBox iconBitmap)
buttonLabels:(resources array:labels)
values:values
default:default
onCancel:false.
answer == #accept ifTrue:[
self doAcceptIn:aNavigationState.
^ true
].
answer == #compare ifTrue:[
self doCompareIn:aNavigationState.
^ false.
].
^ answer
"Modified: / 23.2.2000 / 00:02:29 / cg"
!
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 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
! !
!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 first].
^ 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
^ [:contents :field |
|s what m|
s := contents withoutSpaces.
field topView withCursor:(Cursor questionMark) do:[
what := Smalltalk classnameCompletion:s.
].
field contents:(what first).
(what at:2) size ~~ 1 ifTrue:[
field device beep
]
].
!
classNameEntryCompletionBlockFor:anEntryField
^ [:contents |
|s what m|
s := contents withoutSpaces.
what := Smalltalk classnameCompletion:s.
anEntryField contents:what first.
(what at:2) size ~~ 1 ifTrue:[
self builder window beep
]
].
!
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
!
flyByHelpSpec
<resource: #help>
|spec|
spec := self class flyByHelpSpec.
"/ methodsBackList size > 1 ifTrue:[
"/ spec at:#backToPreviousMethod put:(self resources string:'Go to %1>>%2'
"/ with:methodsBackList second className
"/ with:methodsBackList second selector ? '').
"/ ].
"/ methodsForwardList size > 0 ifTrue:[
"/ spec at:#forwardToNextMethod put:(self resources string:'Go to %1>>%2'
"/ with:methodsForwardList first className
"/ with:methodsForwardList first selector ? '').
"/ ].
^ spec.
!
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
withPriority:9
do:[
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 setOfClasses|
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].
setOfClasses := IdentitySet new.
Smalltalk allClassesDo:[:aClass |
(allCategories or:[aCollectionOfCategories includes:aClass category]) ifTrue:[
(nameSpaceFilter isNil
or:[nameSpaceFilter includes:aClass nameSpace name])
ifTrue:[
(packageFilter isNil
or:[packageFilter includes:aClass package])
ifTrue:[
setOfClasses add:aClass .
]
]
]
].
^ setOfClasses
!
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.
!
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
]
]
]
].
!
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|
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 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 selectedCategories value.
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
! !
!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))
]
!
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
!
explainInCode:code short:short
|selection codeView cls crsrPos interval node explanation|
cls := self classOfSelectedMethodOrSelectedClass.
cls notNil ifTrue:[
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: [
explanation := self 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
].
].
short ifTrue:[
self showInfo:explanation
] ifFalse:[
self information:explanation
].
builder window flush
]
"Modified: / 15.11.2001 / 18:01:31 / cg"
!
explainNode:node in:code forClass:cls short:short
|receiver nm nmText srchClass definingNode
selector selectorString implClass
sendingMethods sendingClasses literalValue boldSelectorString|
node isVariable ifTrue:[
nm := node name.
(#( 'self' 'super' 'thisContext') includes:nm) ifTrue:[
^ Explainer explainPseudoVariable:nm in:cls short:short
].
nm notNil ifTrue:[ nmText := nm allBold ].
definingNode := node whoDefines:nm.
definingNode notNil ifTrue:[
definingNode isMethod ifTrue:[
(definingNode arguments contains:[:arg | arg name = nm]) ifTrue:[
^ '''' , nmText , ''' is a method argument.'
].
].
definingNode isBlock ifTrue:[
(definingNode arguments contains:[:arg | arg name = nm]) ifTrue:[
^ '''' , nmText , ''' is a block argument.'
].
].
definingNode parent notNil ifTrue:[
definingNode parent isMethod ifTrue:[
^ '''' , nmText , ''' is a method temporary.'
].
definingNode parent isBlock ifTrue:[
^ '''' , nmText , ''' is a block temporary.'
]
].
^ '''' , nmText , ''' is a temporary.'
].
^ Explainer explain:node name in:code forClass:cls short:short
].
node isLiteral ifTrue:[
literalValue := node value.
literalValue isArray ifTrue:[
literalValue size == 0 ifTrue:[
^ 'empty Array constant'
].
].
^ literalValue class name , '-constant.'
].
(node isMessage or:[node isMethod])
ifTrue:[
selector := node selector.
selectorString := selector printString contractTo:30.
boldSelectorString := selectorString allBold
].
node isMessage ifTrue:[
receiver := node receiver.
receiver isVariable ifTrue:[
nm := receiver name.
nm = 'self' ifTrue:[
srchClass := cls
].
nm = 'super' ifTrue:[
srchClass := cls superclass
]
].
receiver isLiteral ifTrue:[
srchClass := receiver value class
].
srchClass notNil ifTrue:[
implClass := srchClass whichClassImplements:selector.
implClass isNil ifTrue:[
^ '%1 is NOT understood here.' bindWith:boldSelectorString
].
^ '%1 >> %2' bindWith:implClass name allBold with:boldSelectorString
].
^ Explainer explainSelector:selector inClass:cls short:short
].
node isMethod ifTrue:[
(srchClass := cls superclass) notNil ifTrue:[
implClass := srchClass whichClassImplements:selector.
implClass notNil ifTrue:[
^ '%1 hides implementation in %2.'
bindWith:boldSelectorString
with:implClass name allBold
].
].
(cls implements:selector) ifFalse:[
^ '%1: a new method.' bindWith:boldSelectorString
].
sendingMethods := SystemBrowser allCallsOn:selector in:(cls withAllSubclasses) ignoreCase:false match:false.
sendingMethods := sendingMethods select:[:eachMethod | eachMethod mclass notNil]. "/ remove unbound ones
sendingClasses := (sendingMethods collect:[:eachMethod | eachMethod mclass]) asSet.
sendingMethods size == 1 ifTrue:[
sendingClasses first == cls ifTrue:[
^ '%1: sent locally from %2.'
bindWith:boldSelectorString
with:sendingMethods first selector allBold
].
^ '%1: sent from %2 in %3.'
bindWith:boldSelectorString
with:sendingMethods first selector allBold
with:sendingClasses first name.
].
sendingMethods size == 2 ifTrue:[
sendingClasses asIdentitySet size == 1 ifTrue:[
sendingClasses first == cls ifTrue:[
^ '%1: sent locally from %2 and %3.'
bindWith:boldSelectorString
with:sendingMethods first selector allBold
with:sendingMethods second selector allBold
].
^ '%1: sent from %2 and %3 in %4.'
bindWith:boldSelectorString
with:sendingMethods first selector allBold
with:sendingMethods second selector allBold
with:sendingClasses first name.
].
].
"/ the following is too expensive...
"/ sendingMethods := SystemBrowser allCallsOn:selector in:Smalltalk allClasses.
"/ sendingMethods size == 0 ifTrue:[
"/ ^ '%1: nowhere sent.' bindWith:boldSelectorString
"/ ].
"/ sendingMethods size == 1 ifTrue:[
"/ sendingMethods first mclass == cls ifTrue:[
"/ ^ '%1: only sent from %2.'
"/ bindWith:boldSelectorString
"/ with:sendingMethods first selector allBold
"/ ].
"/ ^ '%1: only sent from %2 in %3.'
"/ bindWith:boldSelectorString
"/ with:sendingMethods first selector allBold
"/ with:sendingMethods first mclass name.
"/ ].
"/ sendingClasses := (sendingMethods collect:[:eachMethod | eachMethod mclass]) asSet.
"/ sendingClasses size == 1 ifTrue:[
"/ sendingClasses first == cls ifTrue:[
"/ ^ '%1: locally sent from %2 methods.'
"/ bindWith:boldSelectorString
"/ with:sendingMethods size
"/ ].
"/ ^ '%1 only sent from %2 methods in %3.'
"/ bindWith:boldSelectorString
"/ with:sendingMethods size
"/ with:sendingClasses first name.
"/ ].
].
^ nil
!
getMethodInfo
|msg|
msg := self methodRedefinitionInfo.
msg isNil ifTrue:[
msg := self methodInheritanceInfo.
msg isNil ifTrue:[
msg := self methodImplementorsInfo
]
].
^ (msg ? '').
!
infoStringForClasses:aCollectionOfClasses withPrefix:prefix
|msg sortedByName|
aCollectionOfClasses size <= 3 ifTrue:[
sortedByName := (aCollectionOfClasses asIdentitySet asOrderedCollection collect:[:each | each name]) sort.
msg := sortedByName first allBold.
sortedByName size == 2 ifTrue:[
msg := msg , ' and ' , sortedByName second allBold.
] ifFalse:[
aCollectionOfClasses size == 3 ifTrue:[
msg := msg , ', ' , sortedByName second allBold.
msg := msg , ' and ' , sortedByName third allBold.
].
].
] ifFalse:[
msg := aCollectionOfClasses size printString allBold , ' ' , prefix , 'classes'.
].
^ msg.
!
methodImplementorsInfo
|singleSelectedMethod implementors msg|
self codeInfoVisible value ifTrue:[
singleSelectedMethod := self theSingleSelectedMethod.
singleSelectedMethod notNil ifTrue:[
implementors := SystemBrowser
findImplementorsOf:singleSelectedMethod selector
in:(Smalltalk allClasses)
ignoreCase:false.
implementors notEmpty ifTrue:[
implementors remove:singleSelectedMethod ifAbsent:nil.
implementors notEmpty ifTrue:[
implementors := implementors collect:[:mthd | mthd mclass].
msg := 'also implemented in '.
msg := msg , (self infoStringForClasses:implementors withPrefix:'other ').
msg := msg , '.'.
].
].
]
].
^ msg
!
methodInheritanceInfo
|singleSelectedMethod superclass inheritedClass msg cls sel mthd|
self codeInfoVisible value ifTrue:[
singleSelectedMethod := self theSingleSelectedMethod.
singleSelectedMethod notNil ifTrue:[
cls := singleSelectedMethod mclass.
cls notNil ifTrue:[
superclass := cls superclass.
superclass notNil ifTrue:[
sel := singleSelectedMethod 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
!
methodRedefinitionInfo
|singleSelectedMethod redefiningClasses msg cls|
self codeInfoVisible value ifTrue:[
singleSelectedMethod := self theSingleSelectedMethod.
singleSelectedMethod notNil ifTrue:[
"/ singleSelectedMethod isWrapped ifTrue:[
"/ singleSelectedMethod := singleSelectedMethod originalMethod ? singleSelectedMethod.
"/ ].
cls := singleSelectedMethod mclass.
cls isNil ifTrue:[
singleSelectedMethod wrapper isNil ifTrue:[
^ nil.
].
cls := singleSelectedMethod wrapper mclass.
].
redefiningClasses := cls allSubclasses select:[:cls | cls implements:singleSelectedMethod selector. ].
redefiningClasses size > 0 ifTrue:[
"/msg := singleSelectedMethod selector allBold , '- '.
msg := 'redefined in '.
msg := msg , (self infoStringForClasses:redefiningClasses withPrefix:'sub').
msg := msg , '.'.
]
]
].
^ msg
!
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) 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|
selectedClasses := self selectedClasses value.
navigationState organizerMode value == #category ifTrue:[
self selectedCategories value size > 1 ifTrue:[
singleSelectedClass := self theSingleSelectedClass.
singleSelectedClass notNil ifTrue:[
self showInfo:(resources string:'Category: %2'
with:singleSelectedClass name allBold
with:singleSelectedClass category allBold).
^ self
].
categories := ((self selectedClasses value ? #()) collect:[:cls | cls category]) asSet.
categories size == 1 ifTrue:[
self showInfo:(resources string:'Category: %1'
with:categories anElement allBold).
^ 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 subMethods answer|
(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:aMethod selector.
redefiningMethod notNil ifTrue:[
msg := self checkIfSameSemanticsRedefinedWith:redefiningMethod inClass:eachInheritingClass.
msg notNil ifTrue:[
(eachInheritingClass superclass whichClassImplements: aMethod 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
]
]
]
].
"/ "/ super-send probably missing ?
"/ (self checkIfSuperSendIsProbablyMissingIn:aMethod inClass:aClass)
"/ ifTrue:[^ 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|
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 whichClassImplements: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])
do:[:key|
dictionary removeKey:key.
].
"/ now, no upper-case variables are allowed ...
(dictionary keys contains:[:key | key first isUppercase]) ifFalse:[
"/ ignore (possibly renamed) arguments ...
(dictionary keys select:[:key | treeHere arguments contains:[:argVar | argVar name = key]])
do:[: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 whichClassImplements: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
! !
!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|
"/ (self windowGroup notNil
"/ and:[self windowGroup sensor notNil
"/ and:[ self windowGroup sensor hasUserEvents ]]) ifTrue:[
"/ self enqueueDelayedStartSyntaxHighlightProcess.
"/ ^ self
"/ ].
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:[
methodsClass isNil ifTrue:[
"/ self halt:'oops - unbound method'.
] ifFalse:[
highlighterClass := methodsClass syntaxHighlighterClass
].
].
highlighterClass isNil ifTrue:[
dontDoIt := true
]
].
dontDoIt 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;
"/ keep it.
"/ Transcript showCR:'already'.
^ 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 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:[
newCode := highlighterClass formatMethod:oldCode in:cls
].
"/ must add this event - and not been interrupted
"/ by any arriving key-event.
codeView modified ifFalse:[
newCode := newCode asStringCollection.
codeView modified ifFalse:[
syntaxColoringProcess := nil.
(codeView := self codeView) notNil ifTrue:[
codeView sensor
pushUserEvent:#syntaxHighlightedCode:
for:self
withArguments:(Array with:newCode).
self delayedUpdateBufferLabelWithCheckIfModified
]
]
]
]
]
]
]
]
] ensure:[
syntaxColoringProcessRunning := false.
syntaxColoringProcess := nil
]
] forkAt:prio
!
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:9
]
!
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 ].
!
postBuildFixup
|navigationState orgModeHolder|
navigationState := self navigationState.
navigationState canvasType isNil ifTrue:[
self halt:'should not happen'. "/ browserCanvasType:spec
].
navigationState isFullClassSourceBrowser ifTrue:[
self hidePrivateClasses value:true.
].
self normalLabel.
orgModeHolder := self organizerMode.
navigationState isNameSpaceBrowser ifTrue:[
orgModeHolder value:#namespace
] ifFalse:[
navigationState isCategoryBrowser ifTrue:[
orgModeHolder value:#category
] ifFalse:[
navigationState isProjectBrowser ifTrue:[
orgModeHolder value:#project
].
].
].
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.
].
].
navigationState codeModifiedHolder addDependent:self.
!
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 ].
"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
|nModified modifiedBuffers|
buffers isNil ifTrue:[
(self
askIfModified:'Code was modified.\\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"
! !
!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:'starting main of %1' with:clsName.
(self confirm:('Invoke %1''s main ?' bindWith:clsName)) ifTrue:[
cls main.
].
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 == #classHierarchy ifTrue:[
newMode := #category
] ifFalse:[
organizerMode == #category ifTrue:[
newMode := #classHierarchy
].
].
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|
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'.
^ self.
].
interval start:(interval start - 1).
node := self findNodeForInterval:interval allowErrors:true.
].
node isVariable ifTrue:[
allVariables := node allVariablesOnScope.
allVariables := OrderedCollection withAll:allVariables.
allVariables addAll:(Smalltalk keys).
allVariables addAll:#('self' 'super' 'thisContext' 'true' 'false' 'nil').
allDistances := allVariables collect:[:each |
|dist nm|
nm := node name.
dist := each spellAgainst:nm.
(each startsWith:nm) ifTrue:[
dist := dist + (10*nm size).
].
each -> dist
].
best := allDistances at:1.
best := allDistances inject:best into:[:el :best | el value > best value
ifTrue:[
el
] ifFalse:[
best
]
].
best := best key.
self showInfo:best.
start := node start.
stop := node stop.
oldVar := (codeView textFromCharacterPosition:start to:stop) asString string withoutSeparators.
codeView replaceFromCharacterPosition:start to:stop with:best.
(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.
].
best := Dialog request:'Matching selectors:' initialAnswer:best list:bestSelectors.
best size == 0 ifTrue:[^ self].
] ifFalse:[
best := bestSelectors first.
].
implClass := srchClass whichClassImplements: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.
].
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].
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 , ':'
].
self halt.
(codeView characterAtCharacterPosition:stop) == $: ifFalse:[
newPart := ':' , newPart.
].
newPart := (codeView characterAtCharacterPosition:stop) asString , newPart.
codeView replaceFromCharacterPosition:stop to:stop with:newPart.
self halt.
]
].
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.
].
].
^ self.
].
"Modified: / 15.11.2001 / 18:19:35 / cg"
!
codeInfoVisibilityChanged
|visible cFrame bottomOffset codeView|
visible := self codeInfoVisible value.
cFrame := builder findComponentAt:#CodeView.
"/ cFrame isNil ifTrue:[
"/ codeView := self codeView.
"/ cFrame := codeView container.
"/ ].
cFrame notNil ifTrue:[
visible ifFalse:[
bottomOffset := 0.
] ifTrue:[
bottomOffset := -25.
].
cFrame layout bottomOffset:bottomOffset.
cFrame container notNil ifTrue:[
cFrame containerChangedSize.
].
] ifFalse:[
"/ self halt:'oops - no codeView'.
"/ builder findComponentAt:#CodeView.
].
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: [
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.
!
processEvent:anEvent
"filter keyboard events for Find key (unless typed into the codeView)"
|codeView classListView categoryListView methodListView methodCategoryListView
variableListView evView key rawKey inCodeView app variablesToRemove msg|
codeView := self codeView.
evView := anEvent targetView.
evView notNil ifTrue:[
anEvent isKeyPressEvent ifTrue:[
key := anEvent key.
rawKey := anEvent rawKey.
inCodeView := evView isSameOrComponentOf:codeView.
inCodeView ifFalse:[
key == #Find ifTrue:[
self
enqueueMessage:#searchMenuFindClass
for:self
arguments:#().
^ true
].
key == #Cmdt ifTrue:[
self
enqueueMessage:#browseMenuMethodsWithString
for:self
arguments:#().
^ true
].
].
inCodeView ifTrue:[
key == #CodeCompletion ifTrue:[
"/ complete the word before/under the cursor.
self
enqueueMessage:#codeCompletion
for:self
arguments:#().
^ true
].
"/ key printCR.
"/ anEvent rawKey printCR.
].
((app := self categoryListApp) notNil
and:[(categoryListView := app window) notNil]) ifTrue:[
(evView isSameOrComponentOf:categoryListView) ifTrue:[
((rawKey == #BackSpace)
or:[key == #CursorLeft]) ifTrue:[
self
enqueueMessage:#backToLastClass
for:self
arguments:#().
^ true
].
].
].
((app := self classListApp) notNil
and:[(classListView := app window) notNil]) ifTrue:[
(evView isSameOrComponentOf:classListView) ifTrue:[
((rawKey == #BackSpace)
or:[key == #CursorLeft]) ifTrue:[
self
enqueueMessage:#backToLastClass
for:self
arguments:#().
^ true
].
].
].
((app := self methodListApp) notNil
and:[(methodListView := app window) notNil]) ifTrue:[
(evView isSameOrComponentOf:methodListView) ifTrue:[
(rawKey == #Delete) ifTrue:[
self
enqueueMessage:#selectorMenuRemove
for:self
arguments:#().
^ true
].
].
].
((app := navigationState variableListApplication) notNil
and:[(variableListView := app window) notNil]) ifTrue:[
(evView isSameOrComponentOf:variableListView) ifTrue:[
(rawKey == #Delete) ifTrue:[
variablesToRemove := self selectedVariables value.
variablesToRemove size > 0 ifTrue:[
variablesToRemove size == 1 ifTrue:[
msg := 'Remove variable ''%1'' ?'
] ifFalse:[
msg := 'Remove selected variables ?'.
].
(self confirm:(resources string:msg with:variablesToRemove first)) ifTrue:[
self
enqueueMessage:#variablesMenuRemove
for:self
arguments:#().
].
].
^ true
].
].
].
((app := self methodCategoryListApp) notNil
and:[(methodCategoryListView := app window) notNil]) ifTrue:[
(evView isSameOrComponentOf:methodCategoryListView) ifTrue:[
(rawKey == #Cmdr) ifTrue:[
self
enqueueMessage:#protocolMenuRename
for:self
arguments:#().
^ true
].
].
]
].
anEvent isButtonReleaseEvent ifTrue:[
evView == codeView ifTrue:[
self codeInfoVisible value ifTrue:[
anEvent delegatedFrom notNil ifTrue:[
^ false
].
anEvent delegatedFrom:self.
evView windowGroup sensor
pushEvent:anEvent. "/ must be first in queue
"/ (for the buttonRelease to be processed)
self
enqueueMessage:#delayedExplainSelection
for:self
arguments:#() .
^ true "/ release event has been added already
].
]
].
].
^ false
"Modified: / 10.12.2001 / 21:02:48 / cg"
!
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:#category.
self organizerModeForMenu changed
!
switchToClassHierarchyView
self organizerMode value:#classHierarchy.
self organizerModeForMenu changed
!
toolBarVisibilityChanged
|visible toolBar noteBook topOffset|
visible := self toolBarVisibleHolder value.
toolBar := self componentAt:#ToolBar.
noteBook := self componentAt:#NoteBook.
visible ifTrue:[
topOffset := toolBar height.
] ifFalse:[
topOffset := 0.
].
noteBook layout topOffset:topOffset.
noteBook container notNil ifTrue:[
noteBook containerChangedSize.
].
DefaultToolBarVisible := visible.
!
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 codeCritics cat rslt returnValue newSelector|
code := codeArg.
returnValue := false.
"/ a quick parse for the selector ...
newSelector := self selectorOfMethodFromCode:code in:cls.
cat := self protocolToAcceptMethod:newSelector class:cls.
Object abortSignal catch:[
(Class methodRedefinitionSignal) handle:[:ex |
|answer oldVsNew oldPkg newPkg|
oldVsNew := ex parameter.
oldPkg := oldVsNew key package.
newPkg := oldVsNew value package.
answer := SystemBrowser askForPackageChangeFrom:oldPkg to:newPkg.
(answer ~~ #cancel) ifTrue:[
ex proceedWith:answer
].
] do:[
|codeView package prevVersionMethod parser oldSelector change defPackage
originalSource changedSource v answer|
oldSelector := self theSingleSelectedSelector.
(parser notNil and:[parser ~~ #Error]) ifTrue:[
"/ 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.
(oldSelector ~= newSelector) ifTrue:[
(cls includesSelector: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.
"/ (self confirm:'You are about to overwrite an existing method.
"/
"/Accept anyway ?')
"/ ifFalse:[
"/ ^ false
"/ ].
answer == false ifTrue:[
^ false
].
answer == #compare ifTrue:[
self openDiffViewForText:code againstSourceOfMethod:(cls compiledMethodAt:newSelector).
^ false
].
]
]
]
].
codeView := self codeView.
codeView cursorMovementWhenUpdating:nil.
codeView scrollWhenUpdating:nil.
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 == #project])
ifTrue:[
package := self theSingleSelectedProject.
package notNil ifTrue:[package := package asSymbol].
package isNil ifTrue:[
package := self
askForProject:'Method shall be assigned to which project ?'
initialText:(LastAcceptPackage ? cls package).
package isNil ifTrue:[^ false].
LastAcceptPackage := package.
] ifFalse:[
"/ 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.
[
code := code asString.
self enforceCodeStyle ifTrue:[
codeCritics := self checkCodeQuality:code.
codeCritics notNil ifTrue:[
codeView
highlightingErrorLine:(codeCritics key)
do:[
Dialog warn:'Will not accept ugly code (' , codeCritics value , ') - please reformat.'.
].
^ false.
].
].
"/ 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:[
(self canUseRefactoringSupport) ifTrue:[
change := InteractiveAddMethodChange compile:code asString 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 asString
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.
!
checkCodeQuality:code
|col|
code asCollectionOfLines keysAndValuesDo:[:lineNr :eachLine |
|lineString|
lineString := eachLine string.
(lineString withoutLeadingSeparators startsWith:'^') ifTrue:[
col := lineString indexOf:$^.
"/ col <= 4 ifTrue:[
"/ ^ (lineNr -> 'bad indentation').
"/ ].
(col-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 := Explainer 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
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.
!
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 == #project 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:[
Object abortSignal catch:[
UndefinedObject createMinimumProtocolInNewSubclassQuery
answer:true
do:[
(Class classRedefinitionSignal)handle:[:ex |
|answer oldVsNew oldPkg newPkg|
oldVsNew := ex parameter.
oldPkg := oldVsNew key package.
newPkg := oldVsNew value package.
"/ 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:(oldPkg 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.
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 switchToClassNamed:rslt name.
returnValue := true.
].
returnValue ifTrue:[
cls := rslt theNonMetaclass.
mcls := rslt theMetaclass.
(((self codeAspect == #newApplication) and:[self confirm:'Generate initial application code ?'])
or:[ (self codeAspect == #newDialog) and:[self confirm:'Generate initial dialog code ?']])
ifTrue:[
CodeGeneratorTool createDocumentationMethodsFor:mcls.
CodeGeneratorTool createExamplesMethodFor:mcls.
CodeGeneratorTool createApplicationCodeFor:cls.
].
(self codeAspect == #newTestCase) ifTrue:[
CodeGeneratorTool createDocumentationMethodsFor:mcls.
CodeGeneratorTool createTestCaseSampleCodeFor:cls.
]
].
]
]
].
].
].
].
self codeAspect:#classDefinition.
^ returnValue
"Created: / 13.2.2000 / 22:43:59 / cg"
"Modified: / 24.2.2000 / 18:58: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 halt.
]
]
].
self doAcceptClassAspect:codeAspect get:getter set:setter code:theCode.
!
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
!
doAcceptIn:aNavigationState
"accept changed code in aNavigationState;
Return false, if NOT accepted (i.e. compilation cancelled), or an error occurred.
Return true if accepted ok."
|codeView|
codeView := aNavigationState codeView.
codeView acceptAction isNil ifTrue:[^ false].
(aNavigationState codeAspect == #classDefinition
or:[aNavigationState codeAspect == #method])
ifTrue:[
^ codeView acceptAction value:(codeView contentsAsString)
].
^ false
"Modified: / 24.2.2000 / 15:38:07 / cg"
!
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.
].
]
].
!
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"
self setAcceptAction:[:theCode | self doAcceptMethod:theCode].
self 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 == #namespace 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 or via menu"
[
|numClasses|
numClasses := self selectedClasses value size.
self selectedClassesDo:[: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.
].
"/ to force update.
"/ (I guess, this is not needed)
self selectedClasses value:(self selectedClasses value copy).
"Modified: / 23.2.2000 / 09:43:41 / cg"
!
classMenuUnload
"unload an autsoloaded class"
self selectedClassesDo:[:eachClass |
|cls nm nameShown doIt|
cls := eachClass theNonMetaclass.
(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: / 23.2.2000 / 09:43:41 / cg"
! !
!NewSystemBrowser methodsFor:'user actions-comparing'!
doCompareIn:aNavigationState
"compare the codeViews contents in a buffer against its original"
|v selectedMethod selectedClass changedSource originalSource|
changedSource := aNavigationState codeView contentsAsString string.
aNavigationState codeAspect == #method ifTrue:[
selectedMethod := aNavigationState theSingleSelectedMethod.
selectedMethod isNil ifTrue:[
aNavigationState selectedMethods value size > 0 ifTrue:[
self warn:'Oops - multiple methods selected. Cannot compare.'.
] ifFalse:[
self warn:'Oops - method is gone. Cannot compare.'.
].
^ self
].
originalSource := selectedMethod source string.
originalSource isNil ifTrue:[
self warn:'Oops - methods source is gone. Cannot compare source.'.
^ self
].
originalSource string = changedSource string ifTrue:[
self information:'Same text.'.
^ self.
].
self openDiffViewForText:changedSource againstSourceOfMethod:selectedMethod.
"/
"/ v := DiffTextView
"/ openOn:changedSource
"/ label:(resources string:'Code here (to be accepted ?)')
"/ and:originalSource
"/ label:(resources string:'Method''s actual code').
"/ v label:(resources string:'Comparing method versions').
"/ v waitUntilVisible.
^ self
].
aNavigationState codeAspect == #classDefinition ifTrue:[
selectedClass := aNavigationState theSingleSelectedClass.
selectedClass isNil ifTrue:[
aNavigationState selectedClasses value size > 0 ifTrue:[
self warn:'Oops - multiple classes selected. Cannot compare.'.
] ifFalse:[
self warn:'Oops - class is gone. Cannot compare.'.
].
^ self
].
originalSource := self classDefinitionStringFor:selectedClass.
originalSource isNil ifTrue:[
self warn:'Oops - class is gone. Cannot compare source.'.
^ self
].
v := 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 class methodsFor:'documentation'!
version
^ '$Header: /cvs/stx/stx/libtool/Attic/NewSystemBrowser.st,v 1.742 2004-05-19 10:08:47 penk Exp $'
! !
NewSystemBrowser initialize!