"
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' }"
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'
!
ApplicationModel subclass:#NavigatorModel
instanceVariableNames:''
classVariableNames:'AllEntry'
poolDictionaries:''
privateIn:NewSystemBrowser
!
NewSystemBrowser::NavigatorModel subclass:#BrowserList
instanceVariableNames:'menuHolder inGeneratorHolder outGeneratorHolder
selectionChangeCondition immediateUpdate doubleClickChannel
filter updateTrigger forceGeneratorTrigger hideUnloadedClasses
showClassPackages selectionHolder packageFilter nameSpaceFilter
organizerMode slaveMode listValid pseudoListLabelHolder icons
sortBy'
classVariableNames:'SynchronousUpdate Icons'
poolDictionaries:''
privateIn:NewSystemBrowser
!
Object subclass:#ClassChecker
instanceVariableNames:'checkedClass badClasses badClassInfo badMethods badMethodInfo
obsoleteWarners allObsoleteMethods checksPerformed'
classVariableNames:''
poolDictionaries:''
privateIn:NewSystemBrowser
!
NewSystemBrowser::BrowserList subclass:#ClassGeneratorList
instanceVariableNames:'organizerList categoryList namespaceList namespaceNameList
projectList selectedCategories selectedNamespaces
selectedProjects selectedClasses'
classVariableNames:'AdditionalEmptyCategories AdditionalEmptyProjects'
poolDictionaries:''
privateIn:NewSystemBrowser
!
NewSystemBrowser::BrowserList subclass:#ClassList
instanceVariableNames:'classList classNameList meta lastSelectedClasses
selectedClassNameIndices currentNamespace hidePrivateClasses
unloadedClassesColor markApplicationsHolder'
classVariableNames:''
poolDictionaries:''
privateIn:NewSystemBrowser
!
NewSystemBrowser::BrowserList subclass:#MethodCategoryList
instanceVariableNames:'variableFilter filterClassVars lastSelectedProtocols classes
leafClasses protocolList rawProtocolList selectedProtocolIndices
lastGeneratedProtocols noAllItem packageFilterOnInput
methodVisibilityHolder'
classVariableNames:'AdditionalEmptyCategoriesPerClassName'
poolDictionaries:''
privateIn:NewSystemBrowser
!
NewSystemBrowser::BrowserList subclass:#ClassCategoryList
instanceVariableNames:'categoryList classes allSelected'
classVariableNames:'AdditionalEmptyCategories'
poolDictionaries:''
privateIn:NewSystemBrowser
!
NewSystemBrowser::ClassList subclass:#HierarchicalClassList
instanceVariableNames:'topClassHolder'
classVariableNames:'InheritedEntry'
poolDictionaries:''
privateIn:NewSystemBrowser
!
NewSystemBrowser::BrowserList subclass:#ProjectList
instanceVariableNames:'projectList'
classVariableNames:'AdditionalEmptyProjects'
poolDictionaries:''
privateIn:NewSystemBrowser
!
NewSystemBrowser::BrowserList subclass:#MethodList
instanceVariableNames:'classes selectedMethodNameIndices methodList lastSelectedMethods
browserNameList variableFilter filterClassVars updateProcess
lastShowClass lastShowCategory lastShowClassFirst
showMethodInheritance lastMethodClass lastMethodClassesSubclasses
classAndSelectorsRedefinedBySubclassesOfClass showClass'
classVariableNames:''
poolDictionaries:''
privateIn:NewSystemBrowser
!
NewSystemBrowser::MethodList subclass:#ImplementingMethodList
instanceVariableNames:'selectorList selectedSelectors'
classVariableNames:''
poolDictionaries:''
privateIn:NewSystemBrowser
!
NewSystemBrowser::HierarchicalClassList subclass:#InheritanceClassList
instanceVariableNames:''
classVariableNames:''
poolDictionaries:''
privateIn:NewSystemBrowser
!
NewSystemBrowser::MethodCategoryList subclass:#FullMethodCategoryList
instanceVariableNames:''
classVariableNames:''
poolDictionaries:''
privateIn:NewSystemBrowser
!
NewSystemBrowser::MethodList subclass:#ImplementingClassList
instanceVariableNames:''
classVariableNames:''
poolDictionaries:''
privateIn:NewSystemBrowser
!
NewSystemBrowser::BrowserList subclass:#NamespaceList
instanceVariableNames:'namespaceNameList namespaceList'
classVariableNames:''
poolDictionaries:''
privateIn:NewSystemBrowser
!
Object subclass:#NavigationState
instanceVariableNames:'browserLabel codeModifiedHolder categoryList classList
packageFilter nameSpaceFilter hidePrivateClasses canvasType
notMetaToggle metaToggle metaToggleLabel organizerMode codeAspect
codeHolder classDocumentationHolder canvas selectorListGenerator
protocolListGenerator classListPerNameSpaceGenerator
classListGenerator categoryListGenerator nameSpaceListGenerator
projectListGenerator classHierarchyTopClass meta selectedMethods
selectedProtocols selectedClasses selectedCategories
selectedProjects selectedNamespaces variableFilter
filterClassVars sortBy noAllItem autoSearchPattern
autoSearchIgnoreCase autoSearchAction realModifiedState
methodInfo versionDiffApplication selectorListGeneratorArray
selectedMethodsArray infoLabelHolder packageLabelHolder
cursorLineLabelHolder cursorColLabelHolder modeLabelHolder
sortVariablesBy'
classVariableNames:''
poolDictionaries:''
privateIn:NewSystemBrowser
!
NewSystemBrowser::NavigatorModel subclass:#NavigatorCanvas
instanceVariableNames:''
classVariableNames:''
poolDictionaries:''
privateIn:NewSystemBrowser
!
NewSystemBrowser::ClassCategoryList subclass:#HierarchicalClassCategoryList
instanceVariableNames:'hierarchicalCategoryTree hierarchicalCategoryList
hierarchicalCategorySelection categoryToItemDictionary'
classVariableNames:''
poolDictionaries:''
privateIn:NewSystemBrowser
!
HierarchicalItem subclass:#ClassCategoryItem
instanceVariableNames:'label category'
classVariableNames:''
poolDictionaries:''
privateIn:NewSystemBrowser::HierarchicalClassCategoryList
!
NewSystemBrowser::NavigatorModel subclass:#OrganizerCanvas
instanceVariableNames:'projectListSlaveMode namespaceListSlaveMode categoryListSlaveMode
classInheritanceListSlaveMode classListSlaveMode
classHierarchyListSlaveMode organizerMode metaToggle
notMetaToggle meta classList classCategoryDoubleClickChannel
classDoubleClickChannel classGeneratorHolder
classGeneratorHolderFromClassCategory
classGeneratorHolderFromClassHierarchy
classGeneratorHolderFromProject classGeneratorHolderFromNamespace
classCategoryListMenuHolder categoryListShown
classCategoryListUpdateTrigger classListUpdateTrigger
classListMenuHolder classHierarchyListMenuHolder
projectListMenuHolder variablesMenuHolder filterClassVars
variableFilter packageFilter nameSpaceFilter hidePrivateClasses
hideUnloadedClasses showClassPackages immediateUpdate
metaToggleLabelHolder selectedCategories selectedClasses
selectedNamespaces selectedProjects selectionChangeCondition
nameSpaceFilterSelection markApplicationsHolder'
classVariableNames:''
poolDictionaries:''
privateIn:NewSystemBrowser
!
NewSystemBrowser::ProjectList subclass:#HierarchicalProjectList
instanceVariableNames:'hierarchicalProjectTree selectedProjectItems packageIcon
hierarchicalProjectList hierarchicalProjectSelection
packageToItemDictionary'
classVariableNames:''
poolDictionaries:''
privateIn:NewSystemBrowser
!
HierarchicalItem subclass:#ProjectItem
instanceVariableNames:'label packageID'
classVariableNames:''
poolDictionaries:''
privateIn:NewSystemBrowser::HierarchicalProjectList
!
DialogBox subclass:#SearchDialog
instanceVariableNames:'openHow classes methods selectedClasses selectedCategories
selectedMethods currentClass currentNamespace
currentClassCategory browser whereRadioGroup verticalPanel
searchAreas caseHolder matchHolder isMethodHolder codeField
selectorHolder defaultOpenHow withTextEntry allowFind allowBuffer
allowBrowser isSelector'
classVariableNames:'LastCodeSearched LastCodeSearchWasMethod LastGlobalSearched'
poolDictionaries:''
privateIn:NewSystemBrowser
!
ApplicationModel subclass:#SpecialCodeView
instanceVariableNames:'displayMode'
classVariableNames:''
poolDictionaries:''
privateIn:NewSystemBrowser
!
NewSystemBrowser::BrowserList subclass:#VariableList
instanceVariableNames:'variableList classHolder showClassVars sortVariablesByName'
classVariableNames:''
poolDictionaries:''
privateIn:NewSystemBrowser
!
!NewSystemBrowser class methodsFor:'documentation'!
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 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 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'
#removeBreakPoint
'Remove Breakpoint'
#recentChanges
'Recently Changed'
#recentVisits
'Recently Visited'
#recentlyVisitedMethods
'Visited Methods'
#runTestCases
'Run TestCase(s)'
#showCategories
'Class Categories'
#showClassHierarchy
'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'
#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: #'NewSystemBrowser::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: #'NewSystemBrowser::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: #'NewSystemBrowser::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: #'NewSystemBrowser::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: #'NewSystemBrowser::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: #'NewSystemBrowser::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: #'NewSystemBrowser::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: #'NewSystemBrowser::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: #'NewSystemBrowser::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: #'NewSystemBrowser::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: #'NewSystemBrowser::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: #'NewSystemBrowser::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: #'NewSystemBrowser::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: #'NewSystemBrowser::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: #'NewSystemBrowser::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: #'NewSystemBrowser::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: #'NewSystemBrowser::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: #'NewSystemBrowser::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: #'NewSystemBrowser::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: #'NewSystemBrowser::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: #'NewSystemBrowser::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: #'NewSystemBrowser::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: #'NewSystemBrowser::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:NewSystemBrowser andSelector:#noteBookWindowSpec
NewSystemBrowser new openInterface:#noteBookWindowSpec
"
<resource: #canvas>
^
#(FullSpec
name: noteBookWindowSpec
window:
(WindowSpec
label: 'NewSystemBrowser'
name: 'NewSystemBrowser'
min: (Point 0 0)
bounds: (Rectangle 13 23 813 723)
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:
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: #'NewSystemBrowser::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: #'NewSystemBrowser::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: #'NewSystemBrowser::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: #'NewSystemBrowser::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: #'NewSystemBrowser::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: #'NewSystemBrowser::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: #'NewSystemBrowser::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: #'NewSystemBrowser::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: #'NewSystemBrowser::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: #'NewSystemBrowser::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: #'NewSystemBrowser::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: #'NewSystemBrowser::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: #'NewSystemBrowser::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: #'NewSystemBrowser::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: #'NewSystemBrowser::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:NewSystemBrowser andSelector:#browseMenu
(Menu new fromLiteralArrayEncoding:(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 Code...'
itemValue: browseMenuMethodsWithCode
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: #hasSingleLoadedClassSelectedHolder
#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: #hasSingleLoadedClassSelectedHolder
#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: '-'
)
#(#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: '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: '-'
#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
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: recentlyVisitedMethods
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'!
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.
]
!
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)"
|searchBlock|
searchBlock := [
|methods|
methods := IdentitySet new.
Smalltalk allClassesDo:[:eachClass |
eachClass instAndClassSelectorsAndMethodsDo:[:sel :mthd |
mthd isWrapped ifTrue:[
methods add:mthd.
]
].
].
methods asOrderedCollection
].
self spawnMethodBrowserForSearch:searchBlock 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 fileBox
dir 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
].
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:fileName.
dir := FileSelectionBox lastFileSelectionDirectory.
dir isNil ifTrue:[
"
this test allows a smalltalk to be built without Projects/ChangeSets
"
Project notNil ifTrue:[
dir := Project currentProjectDirectory asFilename
]
].
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.
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
!
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|
currentClass := self theSingleSelectedClass.
currentClass isLoaded ifFalse:[
self warn:'Cannot copy unloaded classes.'.
^ self
].
currentClass := currentClass theNonMetaclass.
currentClassName := currentClass name.
currentClass nameSpace == Smalltalk ifTrue:[
newClassName := 'CopyOf' , currentClassName.
] ifFalse:[
newClassName := currentClass 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 selectedClassesWithWaitCursorDo:[:eachClass |
CodeGeneratorTool createAcceptVisitorMethodIn:eachClass theNonMetaclass
]
"Modified: / 11.10.2001 / 22:19:09 / cg"
"Created: / 11.10.2001 / 22:26:08 / cg"
!
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 selectedClassesWithWaitCursorDo:[:eachClass |
|names|
names := self variableFilter value.
names size == 0 ifTrue:[
names := eachClass instVarNames
].
CodeGeneratorTool
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 selectedClassesWithWaitCursorDo:[:eachClass |
CodeGeneratorTool 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 withWaitCursorDo:[
CodeGeneratorTool createClassTypeTestMethodsIn:cls forClasses:subclasses
].
!
classMenuGenerateDocumentationMethodFromComment
"create documentation method from comment"
self selectedClassesWithWaitCursorDo:[:eachClass |
|cls|
cls := eachClass theMetaclass.
(cls implements:#documentation) ifFalse:[
CodeGeneratorTool createDocumentationMethodFor:cls.
(cls implements:#documentation) ifTrue:[
cls theNonMetaclass comment:nil
].
].
]
!
classMenuGenerateDocumentationStubs
"create documentation methods"
self selectedClassesWithWaitCursorDo:[:eachClass |
|metaClass|
metaClass := eachClass theMetaclass.
CodeGeneratorTool createDocumentationMethodsFor:metaClass.
"/ add examples method containing examples template
"/ but only if not already present.
CodeGeneratorTool createExamplesMethodFor:metaClass.
]
"Modified: / 18.8.1997 / 15:44:10 / cg"
"Created: / 7.8.1998 / 18:17:18 / cg"
!
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 selectedClassesWithWaitCursorDo:[:eachClass |
CodeGeneratorTool 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 selectedClassesWithWaitCursorDo:[:eachClass |
CodeGeneratorTool createStandardInitializationMethodsIn:eachClass theNonMetaclass
]
!
classMenuGenerateUpdateMethod
"create a standard update method template"
self selectedClassesWithWaitCursorDo:[:eachClass |
CodeGeneratorTool createUpdateMethodIn:eachClass theNonMetaclass
]
"Modified: / 11.10.2001 / 22:19:09 / cg"
!
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 selectedClassesWithWaitCursorDo:[:eachClass |
CodeGeneratorTool 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')
form:(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:metaClassUsedOrNil
"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 notNil ifTrue:[
^ metaClassUsedOrNil
classTemplateFor:aSuperClass
in:categoryString
asNamespace:asNameSpace
private:isPrivateWanted
].
currentClass := self currentClass.
isPrivate := isPrivateWanted.
isPrivate ifTrue:[
ownerClass := currentClass.
ownerClass notNil ifTrue:[
ownerClass := ownerClass theNonMetaclass.
].
].
aSuperClass isPrivate ifTrue:[
isPrivate := true.
ownerClass := aSuperClass theNonMetaclass owningClass
].
(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 dir stillAsking cancelAll cancelAllButton suffix|
suffix := self fileSuffixForFormat:formatSymbolOrNil.
formatSymbolOrNil notNil ifTrue:[
saveName := aClass theNonMetaclass name , '.' , suffix.
].
stillAsking := doAsk.
[stillAsking] whileTrue:[
fileBox := FileSelectionBox
title:(resources string:'FileOut ''%1'' as:' with:aClass name allBold)
okText:(resources string:'FileOut')
abortText:(resources string:'Cancel')
action:[:fileName | saveName := fileName].
withCancelAll ifTrue:[
cancelAllButton := Button label:(resources string:'Cancel All').
fileBox addButton:cancelAllButton before:fileBox cancelButton.
cancelAllButton action:[
cancelAll := true.
fileBox doAccept.
fileBox okPressed.
].
].
fileBox initialText:((Smalltalk fileNameForClass:aClass) , '.' , suffix).
dir := FileSelectionBox lastFileSelectionDirectory.
dir notNil ifTrue:[
fileBox directory:dir.
].
fileBox showAtPointer.
fileBox destroy.
fileBox accepted ifFalse:[
^ self
].
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
!
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
"add a class variable"
|refactoring cls|
(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
].
].
refactoring := AddClassVariableRefactoring variable:newName class:aClass.
self performRefactoring:refactoring.
!
codeMenuAddInstanceVariable:newName inClass:aClass
"add an instance variable"
|refactoring cls|
(cls := aClass whichClassDefinesInstVar:newName) notNil ifTrue:[
Dialog warn:(resources string:'Attention: a variable named ''%1'' is already defined in ''%2''.\\Proceed ?'
with:newName 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).
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|
(self askIfModified) ifFalse:[
^ self
].
cls := aClass theNonMetaclass whichClassDefinesClassVar:oldName.
self performRefactoring:(RemoveClassVariableRefactoring variable:oldName class:cls).
!
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 := 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 := 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 execute].
"/ rslt ifTrue:[
"/ self halt.
"/ ] ifFalse:[
"/ self halt.
"/ ].
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-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].
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].
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')
form:(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; use both from fileOutMethod-list and
fileOut-selected methods."
|fileBox saveName dir stillAsking suffix
fileName aStream defaultName mgr|
suffix := self fileSuffixForFormat:formatSymbolOrNil.
defaultName := (nameOrNil ? 'some_methods') , '.' , suffix.
stillAsking := true.
[stillAsking] whileTrue:[
fileBox := FileSelectionBox
title:(resources string:(boxTitleOrNil ? 'FileOut methods as:'))
okText:(resources string:'FileOut')
abortText:(resources string:'Cancel')
action:[:fileName | saveName := fileName].
fileBox initialText:defaultName.
dir := FileSelectionBox lastFileSelectionDirectory.
dir notNil ifTrue:[
fileBox directory:dir.
].
fileBox showAtPointer.
fileBox destroy.
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...'.
formatSymbolOrNil == #sif ifTrue:[
mgr := SmalltalkInterchangeFileManager newForFileOut.
mgr fileName: saveName.
aCollectionOfMethods do:[:eachMethod |
mgr addMethodNamed:eachMethod selector ofClass:eachMethod mclass.
].
mgr fileOut.
self normalLabel.
^ self.
].
Class fileOutErrorSignal handle:[:ex |
self warn:'cannot fileOut\(%2)' with:ex description.
self normalLabel.
ex return.
] do:[
fileName := saveName 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)
].
aCollectionOfMethods do:[:aMethod |
formatSymbolOrNil == #xml ifTrue:[
aMethod mclass fileOutXMLMethod:aMethod on:aStream.
] ifFalse:[
formatSymbolOrNil == #binary ifTrue:[
self halt:'unimplemented'.
"/ aClass binaryFileOutOn:(saveName asFilename writeStream binary)
] ifFalse:[
aMethod mclass fileOutMethod:aMethod on:aStream.
]
].
].
aStream close
].
self normalLabel.
!
fileOutMethods:aCollectionOfMethods format:formatSymbolOrNil toFile:aFilename
"fileOut a bunch of methods; use both from fileOutMethod-list and
fileOut-selected methods."
|aStream fileName|
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)
].
aCollectionOfMethods do:[:aMethod |
formatSymbolOrNil == #xml ifTrue:[
aMethod mclass fileOutXMLMethod:aMethod on:aStream.
] ifFalse:[
formatSymbolOrNil == #binary ifTrue:[
self halt:'unimplemented'.
"/ aClass binaryFileOutOn:(saveName asFilename writeStream binary)
] ifFalse:[
aMethod mclass fileOutMethod:aMethod on:aStream.
]
].
].
aStream close
]
].
self normalLabel.
!
fileOutMethods:aCollectionOfMethods format:formatSymbolOrNil toFile:aFilename withPackage:withPackage
"fileOut a bunch of methods; use 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)
].
aCollectionOfMethods do:[:aMethod |
formatSymbolOrNil == #xml ifTrue:[
aMethod mclass fileOutXMLMethod:aMethod on:aStream
] ifFalse:[
formatSymbolOrNil == #binary ifTrue:[
self halt:'unimplemented'
"/ 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|
self theSingleSelectedClass isJavaScriptClass ifTrue:[
s := TextStream on:''.
s nextPutAll:'function name ( arg1 , ... ) {
// comment stating purpose of this method
var temp1, ... ;
statement;
statement;
}
'.
s nextPutAll:'
// change the above template into real code.
// 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 selectedMethodsDo:[:eachMethod |
|selector mclass|
selector := eachMethod selector.
mclass := eachMethod mclass.
CodeGeneratorTool
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 selectedMethodsDo:[: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 evera subclass for each subclassResponsibility method"
self selectedMethodsDo:[: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.
CodeGeneratorTool
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')
form:(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-selector 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"
!
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-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)
!
variablesMenuAdd:asClassVariableBoolean
"add a new variable."
|variableToAdd initial|
"/ (self askIfModified) ~~ true ifTrue:[ ^ self ].
initial := self selectionInCodeView ? ''.
variableToAdd := Dialog request:(asClassVariableBoolean ifTrue:[
'Name of new class variable:'
] ifFalse:[
self meta value ifTrue:[
'Name of new class instance variable:'
] ifFalse:[
'Name of new instance variable:'
]
])
title:'Add Variable'
initialAnswer:initial.
variableToAdd size == 0 ifTrue:[^ self].
asClassVariableBoolean ifTrue:[
self codeMenuAddClassVariable:variableToAdd inClass:(self theSingleSelectedClass theNonMetaclass)
] ifFalse:[
self codeMenuAddInstanceVariable:variableToAdd inClass:(self theSingleSelectedClass)
]
!
variablesMenuAddClassVariable
"add a new variable."
^ self variablesMenuAdd:true
!
variablesMenuAddInstanceVariable
"add a new variable."
^ self variablesMenuAdd:false
!
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
!
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 selectedClassesWithWaitCursorDo:[:eachClass |
|names|
names := self variableFilter value.
names size > 0 ifTrue:[
CodeGeneratorTool
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'
form:(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 do:[: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 ?'
form:(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 theNonMetaclass
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 notNil ifTrue:[
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 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 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|
s := contents withoutLeadingSeparators.
what := self navigationState environment methodProtocolCompletion:s.
box contents:what first.
(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')
form:(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|
aClassName isNil ifTrue:[^ nil].
class := Smalltalk classNamed:aClassName.
class isNil ifTrue:[
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
!
fileSuffixForFormat:formatSymbolOrNil
|suffix|
suffix := 'st'.
formatSymbolOrNil notNil ifTrue:[
formatSymbolOrNil == #sif ifTrue:[
suffix := 'sif'.
] ifFalse:[
formatSymbolOrNil == #xml ifTrue:[
suffix := 'xml'.
] ifFalse:[
formatSymbolOrNil == #binary ifTrue:[
suffix := 'cls'
]
].
].
].
^ suffix
!
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:(NewSystemBrowser::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:(NewSystemBrowser::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
]
].
codeView := self codeView.
dontDoIt ifTrue:[
syntaxColoringProcess notNil ifTrue:[
self stopSyntaxHighlightProcess
].
^ self
].
"/ 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:50.
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')
form:(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:'* all *'.
].
className := Dialog
request:'Accept code for which class ?'
initialAnswer:initial
list:classNameList.
className size == 0 ifTrue:[
^ nil
].
className = '* all *' 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'
form:(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::NavigatorModel class methodsFor:'defaults'!
nameListEntryForALL
^ AllEntry ? '* all *'
"Created: / 24.2.2000 / 13:39:10 / cg"
"Modified: / 25.2.2000 / 21:18:30 / cg"
!
nameListEntryForNILCategory
^ '* no category *'
!
nameListEntryForNonStatic
^ '* instance *'
!
nameListEntryForStatic
^ '* static *'
! !
!NewSystemBrowser::NavigatorModel class methodsFor:'initialization'!
initialize
AllEntry := '* all *'
"Created: / 24.2.2000 / 13:41:29 / cg"
! !
!NewSystemBrowser::NavigatorModel class methodsFor:'interface specs'!
metaSpec
"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::NavigatorModel andSelector:#metaSpec
NewSystemBrowser::NavigatorModel new openInterface:#metaSpec
"
<resource: #canvas>
^
#(#FullSpec
#name: #metaSpec
#window:
#(#WindowSpec
#label: 'MetaToggles'
#name: 'MetaToggles'
#min: #(#Point 0 0)
#max: #(#Point 1024 721)
#bounds: #(#Rectangle 16 46 316 74)
)
#component:
#(#SpecCollection
#collection: #(
#(#RadioButtonSpec
#label: 'Instance'
#name: 'InstanceToggle'
#layout: #(#LayoutFrame 0 0.0 0 0.0 0 0.5 25 0)
#translateLabel: true
#tabable: true
#model: #notMetaToggle
#isTriggerOnDown: true
#select: true
#isToggle: true
)
#(#RadioButtonSpec
#label: 'Class'
#name: 'ClassToggle'
#layout: #(#LayoutFrame 0 0.5 0 0 0 1.0 25 0)
#translateLabel: true
#labelChannel: #metaToggleLabelHolder
#tabable: true
#model: #metaToggle
#isTriggerOnDown: true
#select: true
#isToggle: true
)
)
)
)
! !
!NewSystemBrowser::NavigatorModel class methodsFor:'misc'!
classResources
^ NewSystemBrowser classResources
! !
!NewSystemBrowser::NavigatorModel methodsFor:'misc'!
resources
|m|
(m := self masterApplication) notNil ifTrue:[
^ m resources
].
^ super resources
! !
!NewSystemBrowser::BrowserList class methodsFor:'image specs'!
nameSpaceIcon
^ SystemBrowser nameSpaceIcon
!
packageIcon
^ SystemBrowser packageIcon
!
padLockBlueMiniIcon
^ SystemBrowser padLockBlueMiniIcon
!
padLockGrayMiniIcon
^ SystemBrowser padLockGrayMiniIcon
!
padLockGreenMiniIcon
^ SystemBrowser padLockGreenMiniIcon
!
padLockRedMiniIcon
^ SystemBrowser padLockRedMiniIcon
!
programImageIcon
^ SystemBrowser programImageIcon
!
protectedMethod
^ self padLockRedMiniIcon
!
redLockIcon
^ SystemBrowser redLockIcon
! !
!NewSystemBrowser::BrowserList methodsFor:'aspects'!
defaultSlaveModeValue
^ nil.
"Created: / 25.2.2000 / 22:36:40 / cg"
!
doubleClickChannel
doubleClickChannel isNil ifTrue:[
doubleClickChannel := TriggerValue new.
].
^ doubleClickChannel.
"Modified: / 31.1.2000 / 00:42:44 / cg"
"Created: / 5.2.2000 / 22:38:32 / cg"
!
doubleClickChannel:aChannel
doubleClickChannel := aChannel
!
filter:aValueHolder
filter notNil ifTrue:[
filter removeDependent:self
].
filter := aValueHolder.
filter notNil ifTrue:[
filter addDependent:self
].
"Modified: / 4.2.2000 / 23:29:30 / cg"
"Created: / 5.2.2000 / 13:42:12 / cg"
!
forceGeneratorTrigger
forceGeneratorTrigger isNil ifTrue:[
forceGeneratorTrigger := TriggerValue new.
forceGeneratorTrigger addDependent:self.
].
^ forceGeneratorTrigger.
"Modified: / 18.2.2000 / 02:02:52 / cg"
"Created: / 18.2.2000 / 02:46:40 / cg"
!
forceGeneratorTrigger:aTriggerValue
forceGeneratorTrigger notNil ifTrue:[
forceGeneratorTrigger removeDependent:self
].
forceGeneratorTrigger := aTriggerValue.
forceGeneratorTrigger notNil ifTrue:[
forceGeneratorTrigger addDependent:self
].
"Modified: / 4.2.2000 / 23:29:30 / cg"
"Created: / 18.2.2000 / 02:46:52 / cg"
!
hideUnloadedClasses
hideUnloadedClasses isNil ifTrue:[
hideUnloadedClasses := false asValue.
hideUnloadedClasses addDependent:self.
].
^ hideUnloadedClasses.
"Modified: / 18.2.2000 / 02:02:52 / cg"
"Created: / 18.2.2000 / 17:36:30 / cg"
!
hideUnloadedClasses:aValueHolder
hideUnloadedClasses notNil ifTrue:[
hideUnloadedClasses removeDependent:self
].
hideUnloadedClasses := aValueHolder.
hideUnloadedClasses notNil ifTrue:[
hideUnloadedClasses addDependent:self
].
"Modified: / 4.2.2000 / 23:29:30 / cg"
"Created: / 18.2.2000 / 17:46:36 / cg"
!
menuHolder
^ menuHolder
"Created: / 5.2.2000 / 13:42:06 / cg"
!
menuHolder:aValueHolder
menuHolder := aValueHolder.
"Created: / 5.2.2000 / 13:42:06 / cg"
!
nameSpaceFilter
nameSpaceFilter isNil ifTrue:[
nameSpaceFilter := ValueHolder new.
nameSpaceFilter addDependent:self.
].
^ nameSpaceFilter.
"Modified: / 24.2.2000 / 23:57:13 / cg"
"Created: / 18.8.2000 / 14:18:56 / cg"
!
nameSpaceFilter:aValueHolder
nameSpaceFilter notNil ifTrue:[
nameSpaceFilter removeDependent:self
].
nameSpaceFilter := aValueHolder.
nameSpaceFilter notNil ifTrue:[
nameSpaceFilter addDependent:self
].
"Modified: / 24.2.2000 / 23:56:22 / cg"
"Created: / 18.8.2000 / 14:19:06 / cg"
!
organizerMode
organizerMode isNil ifTrue:[
organizerMode := #category asValue.
organizerMode addDependent:self.
].
^ organizerMode
"Modified: / 31.1.2000 / 00:51:06 / cg"
"Created: / 25.2.2000 / 22:36:15 / cg"
!
organizerMode:aValueHolder
organizerMode notNil ifTrue:[
organizerMode removeDependent:self
].
organizerMode := aValueHolder.
organizerMode notNil ifTrue:[
organizerMode addDependent:self
].
"Modified: / 4.2.2000 / 23:34:28 / cg"
"Created: / 25.2.2000 / 22:36:28 / cg"
!
packageFilter
packageFilter isNil ifTrue:[
packageFilter := ValueHolder new.
packageFilter addDependent:self.
"/ debug-check only
"/ packageFilter onChangeEvaluate:[packageFilter value isValueModel ifTrue:[self halt:'debug halt']].
].
^ packageFilter.
"Modified: / 18.8.2000 / 19:26:36 / cg"
!
packageFilter:aValueHolder
packageFilter notNil ifTrue:[
packageFilter removeDependent:self
].
packageFilter := aValueHolder.
packageFilter notNil ifTrue:[
packageFilter addDependent:self.
"/ debug-check only
"/ packageFilter onChangeEvaluate:[packageFilter value isValueModel ifTrue:[self halt:'debug halt']].
].
"Modified: / 18.8.2000 / 19:26:40 / cg"
!
pseudoListLabelHolder
pseudoListLabelHolder isNil ifTrue:[
pseudoListLabelHolder := '' asValue.
].
^ pseudoListLabelHolder
!
selectionChangeCondition:aBlockOrValueHolder
selectionChangeCondition := aBlockOrValueHolder
!
selectionHolder
selectionHolder isNil ifTrue:[
selectionHolder := ValueHolder new.
selectionHolder addDependent:self
].
^ selectionHolder.
!
selectionHolder:aValueHolder
|prevSelection|
prevSelection := selectionHolder value ? #().
selectionHolder notNil ifTrue:[
selectionHolder removeDependent:self
].
selectionHolder := aValueHolder.
selectionHolder notNil ifTrue:[
selectionHolder addDependent:self
].
(selectionHolder value ? #()) ~= prevSelection ifTrue:[
"/ update
self update:#value with:nil from:selectionHolder
].
!
showClassPackages
showClassPackages isNil ifTrue:[
showClassPackages := false asValue.
showClassPackages addDependent:self.
].
^ showClassPackages.
"Modified: / 18.2.2000 / 02:02:52 / cg"
"Created: / 18.2.2000 / 17:36:30 / cg"
!
showClassPackages:aValueHolder
showClassPackages notNil ifTrue:[
showClassPackages removeDependent:self
].
showClassPackages := aValueHolder.
showClassPackages notNil ifTrue:[
showClassPackages addDependent:self
].
!
slaveMode
slaveMode isNil ifTrue:[
slaveMode := self defaultSlaveModeValue asValue.
slaveMode addDependent:self.
].
^ slaveMode.
"Created: / 25.2.2000 / 22:36:40 / cg"
!
slaveMode:aValueHolder
|prev|
slaveMode notNil ifTrue:[
slaveMode removeDependent:self.
prev := slaveMode value.
].
slaveMode := aValueHolder.
slaveMode notNil ifTrue:[
slaveMode addDependent:self
].
prev ~~ slaveMode value ifTrue:[
(prev isNil and:[slaveMode value]) ifFalse:[
self update:#value with:nil from:slaveMode.
]
].
!
sortBy
sortBy isNil ifTrue:[
sortBy := nil asValue.
sortBy addDependent:self.
].
^ sortBy.
"Created: / 25.2.2000 / 22:36:40 / cg"
!
sortBy:aValueHolder
|prev|
prev := sortBy value.
sortBy notNil ifTrue:[
sortBy removeDependent:self
].
sortBy := aValueHolder.
sortBy notNil ifTrue:[
sortBy addDependent:self
].
prev ~~ sortBy value ifTrue:[
self update:#value with:nil from:sortBy.
].
"Modified: / 4.2.2000 / 23:29:30 / cg"
"Created: / 5.2.2000 / 13:42:12 / cg"
!
updateTrigger
updateTrigger isNil ifTrue:[
updateTrigger := TriggerValue new.
updateTrigger addDependent:self.
].
^ updateTrigger.
"Created: / 18.2.2000 / 01:59:58 / cg"
"Modified: / 18.2.2000 / 02:02:52 / cg"
!
updateTrigger:aTriggerValue
updateTrigger notNil ifTrue:[
updateTrigger removeDependent:self
].
updateTrigger := aTriggerValue.
updateTrigger notNil ifTrue:[
updateTrigger addDependent:self
].
"Modified: / 4.2.2000 / 23:29:30 / cg"
"Created: / 18.2.2000 / 02:03:15 / cg"
! !
!NewSystemBrowser::BrowserList methodsFor:'change & update'!
delayedUpdate:something with:aParameter from:changedObject
"/ if any of my subclasses want those, they should look for them.
changedObject == Smalltalk ifTrue:[
(something == #Language or:[something == #LanguageTerritory]) ifTrue:[
^ self
].
something == #organization ifTrue:[
^ self
].
something == #classDefinition ifTrue:[
^ self
].
something == #classVariables ifTrue:[
^ self
].
something == #methodTrap ifTrue:[
^ self
].
something == #methodInClassRemoved ifTrue:[
^ self.
].
something == #methodDictionary ifTrue:[
^ self
].
something == #newClass ifTrue:[
^ self
].
].
changedObject == slaveMode ifTrue:[
slaveMode value ~~ true ifTrue:[
listValid ~~ true ifTrue:[
self updateList.
].
self updateOutputGenerator.
].
^ self.
].
changedObject == selectionHolder ifTrue:[
listValid ifFalse:[
self updateList.
].
^ self selectionChanged
].
changedObject == forceGeneratorTrigger ifTrue:[
self updateOutputGenerator.
^ self.
].
changedObject == hideUnloadedClasses ifTrue:[
self invalidateList.
slaveMode value ~~ true ifTrue:[
self updateOutputGenerator.
].
^ self.
].
changedObject == updateTrigger ifTrue:[
self enqueueDelayedUpdateList.
^ self
].
changedObject == inGeneratorHolder ifTrue:[
self invalidateList.
^ self
].
"/ changedObject == outGeneratorHolder ifTrue:[
"/ self enqueueDelayedUpdateList.
"/ ^ self
"/ ].
changedObject == packageFilter ifTrue:[
self invalidateList.
^ self
].
changedObject == nameSpaceFilter ifTrue:[
self invalidateList.
^ self
].
changedObject == organizerMode ifTrue:[
^ self
].
self invalidateList.
^ self
"Created: / 5.2.2000 / 13:42:06 / cg"
"Modified: / 18.8.2000 / 14:19:24 / cg"
!
enqueueDelayedUpdate:something with:aParameter from:changedObject
"support for delayed updates - to be invoked from a concrete classes
#update:with:from: method.
This will enqueue a delayed update, and resend #delayedUpdate:with:from:
whenever the receiver is handling events.
Especially useful, if many updates arrive at high frequency, to avoid
multiple redraws."
^ self
enqueueMessage:#delayedUpdate:with:from:
for:self
arguments:(Array
with:something
with:aParameter
with:changedObject).
!
enqueueDelayedUpdateList
(NewSystemBrowser synchronousUpdate == true
or:[ immediateUpdate value == true ])
ifTrue:[
self updateList.
^ self.
].
self enqueueMessage:#updateList for:self arguments:#()
!
enqueueDelayedUpdateOutputGenerator
slaveMode value == true ifTrue:[
self halt:'should not be invoked'
].
(NewSystemBrowser synchronousUpdate == true
or:[ immediateUpdate value == true ])
ifTrue:[
self updateOutputGenerator.
^ self.
].
listValid := false.
self enqueueMessage:#updateOutputGenerator for:self arguments:#()
!
forceReselect
|selectionHolder prevSelection|
selectionHolder := self selectionHolder.
prevSelection := selectionHolder value.
selectionHolder setValue:nil.
selectionHolder value:prevSelection.
!
forceSelectionClear
self selectionHolder setValue:nil
!
forceUpdateList
|listView|
listView := builder componentAt:#List.
listView notNil ifTrue:[
listView list:#()
].
self updateList
!
immediateUpdate:aBooleanOrBooleanHolder
immediateUpdate := aBooleanOrBooleanHolder
"Created: / 13.2.2000 / 22:26:06 / cg"
"Modified: / 13.2.2000 / 22:28:09 / cg"
!
prioDelayedUpdate:something with:aParameter from:changedObject
Processor activeProcess withPriority:7 do:[
self delayedUpdate:something with:aParameter from:changedObject
]
!
selectionChangeAllowed
selectionChangeCondition isNil ifTrue:[^ true].
selectionChangeCondition isBlock ifTrue:[
selectionChangeCondition numArgs == 1 ifTrue:[
^ selectionChangeCondition value:self
]
].
^ selectionChangeCondition value
!
selectionChanged
slaveMode value ~~ true ifTrue:[
self enqueueDelayedUpdateOutputGenerator
"/ self updateOutputGenerator.
]
"Modified: / 4.2.2000 / 15:49:23 / cg"
"Created: / 5.2.2000 / 13:42:07 / cg"
!
selectionChangedByClick
"Created: / 25.2.2000 / 21:19:25 / cg"
!
syncDelayedUpdateList
|sensor|
sensor := self window sensor.
sensor isNil ifTrue:[
^ self
].
"/
"/ if an update is in the queue, process it.
"/
(sensor
hasEvent:#updateList
for:self
withArguments:#()
) ifTrue:[
sensor flushEventsFor:self withType:#updateList.
self updateList.
^ self
].
!
update:something with:aParameter from:changedObject
(NewSystemBrowser synchronousUpdate == true
or:[ immediateUpdate value == true ])
ifTrue:[
self delayedUpdate:something with:aParameter from:changedObject.
^ self.
].
"/ (changedObject == ChangeSet)
"/ ifTrue:[
"/ self delayedUpdate:something with:aParameter from:changedObject.
"/ ^ self.
"/ ].
"/ changedObject == selectionHolder ifTrue:[
"/ listValid ifFalse:[
"/ self slaveMode value ifTrue:[
"/ ^ self
"/ ]
"/ ]
"/ ].
changedObject == inGeneratorHolder ifTrue:[
listValid := false.
].
self enqueueDelayedUpdate:something with:aParameter from:changedObject.
"Created: / 5.2.2000 / 13:42:07 / cg"
"Modified: / 13.11.2001 / 11:30:19 / cg"
! !
!NewSystemBrowser::BrowserList methodsFor:'generators'!
inGeneratorHolder
^ inGeneratorHolder
"Created: / 5.2.2000 / 13:42:07 / cg"
!
inGeneratorHolder:aConditionBlockHolder
|prevHolder|
(prevHolder := inGeneratorHolder) notNil ifTrue:[
inGeneratorHolder removeDependent:self
].
inGeneratorHolder := aConditionBlockHolder.
inGeneratorHolder notNil ifTrue:[
inGeneratorHolder addDependent:self
].
(prevHolder isNil and:[inGeneratorHolder isNil]) ifFalse:[
(prevHolder value isNil
and:[
(inGeneratorHolder value isNil
or:[inGeneratorHolder value isArray
and:[inGeneratorHolder value size == 0]])])
ifFalse:[
self update:#value with:nil from:inGeneratorHolder
].
].
!
makeGenerator
self subclassResponsibility
"Created: / 5.2.2000 / 13:42:07 / cg"
!
outGeneratorHolder
outGeneratorHolder isNil ifTrue:[
outGeneratorHolder := ValueHolder new
].
^ outGeneratorHolder
"Modified: / 4.2.2000 / 17:17:16 / cg"
"Created: / 5.2.2000 / 13:42:07 / cg"
!
outGeneratorHolder:aConditionBlockHolder
outGeneratorHolder := aConditionBlockHolder.
"Created: / 5.2.2000 / 13:42:08 / cg"
!
updateOutputGenerator
"create a generator which enumerates my elements,
and place it into the outputGenerator holder"
self outGeneratorHolder value: self makeGenerator.
"Modified: / 4.2.2000 / 17:16:34 / cg"
"Created: / 5.2.2000 / 13:42:08 / cg"
! !
!NewSystemBrowser::BrowserList methodsFor:'icons'!
abstractMethodIcon
"answer an icon to mark abstract methods"
^ self fetchIcon:#abstractMethod selector:#abstractMethodIcon
!
canvasIcon
"answer an icon to mark canvas spec methods"
^ self fetchIcon:#canvas selector:#canvasIcon
!
fetchIcon:name selector:fetchSelector
"answer an icon to mark breakPointed methods"
icons isNil ifTrue:[icons := IdentityDictionary new].
Icons isNil ifTrue:[Icons := IdentityDictionary new].
^ icons at:name ifAbsentPut:[
|fh icn h|
(icn := Icons at:name ifAbsent:nil) isNil ifTrue: [
Icons at:name put:(icn := (SystemBrowser perform:fetchSelector) onDevice:Display).
icn clearMaskedPixels.
].
h := icn height.
h > (fh := SelectionInListView defaultFont heightOn:device) ifTrue:[
icn := icn magnifiedBy:(fh / h)
].
icn onDevice:device
]
"
Icons := nil
Icon flushCachedIcons
"
!
fileImageIcon
"answer an icon to mark file-image spec methods"
^ self fetchIcon:#fileImage selector:#fileImageIcon
!
helpIcon
"answer an icon to mark help spec methods"
^ self fetchIcon:#help selector:#helpIcon
!
hierarchicalListIcon
"answer an icon to mark hierarchicalList spec methods"
^ self fetchIcon:#hierarchicalList selector:#hierarchicalListIcon
!
imageIcon
"answer an icon to mark image spec methods"
^ self fetchIcon:#image selector:#imageIcon
!
menuIcon
"answer an icon to mark menu spec methods"
^ self fetchIcon:#menu selector:#menuIcon
!
methodEmptyInheritedIcon
^ self fetchIcon:#methodEmptyInherited selector:#methodEmptyInheritedIcon
!
methodInheritedFromAboveAndRedefinedBelowIcon
^ self fetchIcon:#methodInheritedFromAboveAndRedefinedBelow selector:#methodInheritedFromAboveAndRedefinedBelowIcon
!
methodInheritedFromAboveIcon
^ self fetchIcon:#methodInheritedFromAbove selector:#methodInheritedFromAboveIcon
!
methodRedefinedBelowIcon
^ self fetchIcon:#methodRedefinedBelow selector:#methodRedefinedBelowIcon
!
privateMethodIcon
"answer an icon to mark private methods"
^ self fetchIcon:#privateMethod selector:#privateMethodIcon
!
programImageIcon
"answer an icon to mark image spec methods"
^ self fetchIcon:#programImage selector:#programImageIcon
!
programMenuIcon
"answer an icon to mark program generated menu methods"
^ self fetchIcon:#programMenu selector:#programMenuIcon
!
protectedMethodIcon
"answer an icon to mark protected methods"
^ self fetchIcon:#protectedMethod selector:#protectedMethodIcon
!
stopIcon
"answer an icon to mark breakPointed methods"
^ self fetchIcon:#stop selector:#stopIcon
!
tabListIcon
"answer an icon to mark tabList spec methods"
^ self fetchIcon:#tabList selector:#tabListIcon
!
tableColumnsIcon
"answer an icon to mark tableColumns spec methods"
^ self fetchIcon:#tableColumns selector:#tableColumnsIcon
!
timeIcon
"answer an icon to mark timed methods"
^ self fetchIcon:#time selector:#timeIcon
!
traceIcon
"answer an icon to mark traced methods"
"/ ^ self fetchIcon:#watch selector:#watchIcon
^ self fetchIcon:#trace selector:#traceIcon
! !
!NewSystemBrowser::BrowserList methodsFor:'misc'!
invalidateList
listValid := false.
slaveMode value ~~ true ifTrue:[
self enqueueDelayedUpdateList.
]
!
resources
|master|
(master := self masterApplication) notNil ifTrue:[^ master resources].
^ super resources
! !
!NewSystemBrowser::BrowserList methodsFor:'private'!
browserNameList
self subclassResponsibility
!
classesToProcessForClasses:classes withVisibility:visibility
|classesToProcess classesToProcessInOrder|
visibility isNil ifTrue:[^classes].
visibility == #class ifTrue:[^classes].
classesToProcess := IdentitySet new.
classesToProcessInOrder := OrderedCollection new.
classes notNil ifTrue:[
classes do:[:eachClass |
|withAllSupers|
withAllSupers := eachClass withAllSuperclasses.
visibility == #allButObject ifTrue:[
eachClass isMeta ifTrue:[
withAllSupers removeAllFoundIn:(Object class withAllSuperclasses)
] ifFalse:[
withAllSupers remove:Object ifAbsent:nil
]
].
withAllSupers do:[:each |
(classesToProcess includes:each) ifFalse:[
classesToProcess add:each.
classesToProcessInOrder add:each.
]
]
].
].
^ classesToProcessInOrder
!
colorizeForChangedCode:someString
^ someString asText emphasisAllAdd:(UserPreferences current emphasisForChangedCode)
"Created: / 31.10.2001 / 10:17:56 / cg"
!
colorizeForDifferentPackage:someString
^ someString asText emphasisAllAdd:(UserPreferences current emphasisForDifferentPackage)
!
colorizeGrey:someString
^ someString asText emphasisAllAdd:(#color->Color darkGrey)
!
emphasizeForChangedCode:someString
^ self colorizeForChangedCode:someString
"Modified: / 31.10.2001 / 10:18:57 / cg"
!
emphasizeForDifferentPackage:someString
^ self colorizeForDifferentPackage:(' [' , (' ' , someString , ' ') allItalic , ']')
"Modified: / 31.10.2001 / 10:13:35 / cg"
!
inSlaveModeOrInvisible
(self slaveMode value == true) ifTrue:[^ true].
"/ self slaveMode value isNil ifTrue:[
"/ self window shown ifFalse:[
"/ ^ true
"/ ].
"/ ].
^ false
!
isClass:aClass shownWithNameSpaceFilter:nameSpaceFilter
|nsName|
nameSpaceFilter isNil ifTrue:[^ true].
nsName := aClass topNameSpace name.
(nameSpaceFilter includes:nsName) ifTrue:[^ true].
(nameSpaceFilter contains:[:ns | nsName startsWith:(ns , '::')]) ifTrue:[^ true].
^ false
!
isClass:aClass shownWithPackageFilter:packageFilter
packageFilter isNil ifTrue:[^ true].
(packageFilter includes:aClass package) ifTrue:[^ true].
aClass instAndClassSelectorsAndMethodsDo:[:sel :mthd |
(packageFilter includes:mthd package) ifTrue:[^ true].
].
^ false
!
makeDependent
self subclassResponsibility
"Created: / 5.2.2000 / 13:42:08 / cg"
!
makeIndependent
self subclassResponsibility
"Created: / 5.2.2000 / 13:42:08 / cg"
!
release
self makeIndependent.
super release.
filter removeDependent:self.
forceGeneratorTrigger removeDependent:self.
hideUnloadedClasses removeDependent:self.
inGeneratorHolder removeDependent:self.
nameSpaceFilter removeDependent:self.
organizerMode removeDependent:self.
packageFilter removeDependent:self.
selectionHolder removeDependent:self.
showClassPackages removeDependent:self.
slaveMode removeDependent:self.
sortBy removeDependent:self.
updateTrigger removeDependent:self.
"Created: / 5.2.2000 / 13:42:09 / cg"
"Modified: / 13.2.2000 / 23:32:23 / cg"
!
releaseAsSubCanvas
self makeIndependent.
super releaseAsSubCanvas.
"Created: / 13.2.2000 / 23:11:29 / cg"
"Modified: / 13.2.2000 / 23:32:29 / cg"
!
updateList
self subclassResponsibility.
!
updateListFor:newList
"update the browsers list in a way which avoids scrolls
and flicker; returns true, if the newList is the same."
|"oldListSize newListSize" sameContents sameStrings oldEntry browserNameList
"firstDifferentFromBeginning firstDifferentFromEnd" listView prevMode sav|
browserNameList := self browserNameList value.
sameContents := sameStrings := (newList size == browserNameList size).
sameContents ifTrue:[
newList with:browserNameList do:[:newLine :oldLine |
sameStrings ifTrue:[
sameStrings := ((newLine ? '') = (oldLine ? '')).
].
sameContents ifTrue:[
((newLine ? '') sameStringAndEmphasisAs:(oldLine ? '')) ifFalse:[
sameContents := false
]
].
]
].
listView := builder componentAt:#List.
listView isNil ifTrue:[
"/ called early during setup ...
browserNameList contents:newList.
^ sameContents.
].
sameContents ifTrue:[
^ sameContents
].
sameStrings ifTrue:[
newList keysAndValuesDo:[:lineNr :line |
oldEntry := browserNameList at:lineNr.
(oldEntry sameStringAndEmphasisAs:line) ifFalse:[
browserNameList at:lineNr put:line.
]
].
^ sameContents
].
listView := listView scrolledView.
listView isNil ifTrue:[self halt. ^ self].
prevMode := listView scrollWhenUpdating.
listView scrollWhenUpdating:nil.
[
"/ dont want to be called if selection is changed by selListView
sav := listView action.
listView action:nil.
browserNameList contents:newList.
] ensure:[
listView action:sav.
].
listView scrollWhenUpdating:prevMode.
^ sameContents.
"/ oldListSize := browserNameList size.
"/ newListSize := newList size.
"/ newListSize == 0 ifTrue:[
"/ oldListSize == 0 ifTrue:[
"/ ^ true "/ same
"/ ].
"/ browserNameList removeAll.
"/ ^ false "/ not same
"/ ].
"/
"/ oldListSize == 0 ifTrue:[
"/ browserNameList contents:newList.
"/ ^ false. "/ not same
"/ ].
"/
"/ (newListSize between:(oldListSize-1) and:(oldListSize+1)) ifTrue:[
"/ "/ individually exchange changed lines, to avoid flicker.
"/ "/ the old code was: self browserNameList value:newList
"/ "/ but if only a single method is changed (or an instrumentation icon changes),
"/ "/ this results in avoidable flicker.
"/
"/ newListSize > oldListSize ifTrue:[
"/ "/ an entry seems to be added
"/ "/ try to find it.
"/ firstDifferentFromBeginning := 1.
"/
"/ [firstDifferentFromBeginning <= oldListSize
"/ and:[(newList at:firstDifferentFromBeginning) sameStringAndEmphasisAs: (browserNameList at:firstDifferentFromBeginning)]]
"/ whileTrue:[
"/ firstDifferentFromBeginning := firstDifferentFromBeginning + 1.
"/ ].
"/ firstDifferentFromEnd := newListSize.
"/ [firstDifferentFromEnd >= 1
"/ and:[(newList at:firstDifferentFromEnd) sameStringAndEmphasisAs: (browserNameList at:firstDifferentFromEnd-1)]]
"/ whileTrue:[
"/ firstDifferentFromEnd := firstDifferentFromEnd - 1.
"/ ].
"/ (firstDifferentFromEnd - firstDifferentFromBeginning) > (newList size // 10) ifTrue:[
"/ "/ too many differences - exchange the list en-bloque
"/ browserNameList contents:newList.
"/ ^ false. "/ not same
"/ ].
"/ "/ entries from firstDifferentFromBeginning to firstDifferentFromEnd in newList are different
"/
"/ (firstDifferentFromEnd - firstDifferentFromBeginning + 1 "number of different items") == (newListSize - oldListSize) ifTrue:[
"/ "/ for now, only handle single-added-item case
"/ firstDifferentFromEnd ~~ firstDifferentFromBeginning ifTrue:[
"/ self halt
"/ ].
"/
"/ "/ item at firstDifferentFromBeginning has been inserted.
"/ browserNameList add:(newList at:firstDifferentFromBeginning) beforeIndex:firstDifferentFromEnd.
"/ ^ false "/ not the same
"/ ].
"/ ] ifFalse:[
"/ newListSize < oldListSize ifTrue:[
"/ "/ an entry seems to be removed
"/ "/ try to find it.
"/ firstDifferentFromBeginning := 1.
"/
"/ [firstDifferentFromBeginning <= newListSize
"/ and:[(newList at:firstDifferentFromBeginning) sameStringAndEmphasisAs: (browserNameList at:firstDifferentFromBeginning)]]
"/ whileTrue:[
"/ firstDifferentFromBeginning := firstDifferentFromBeginning + 1.
"/ ].
"/ firstDifferentFromEnd := newListSize.
"/ [firstDifferentFromEnd >= 1
"/ and:[(newList at:firstDifferentFromEnd) sameStringAndEmphasisAs: (browserNameList at:firstDifferentFromEnd+1)]]
"/ whileTrue:[
"/ firstDifferentFromEnd := firstDifferentFromEnd - 1.
"/ ].
"/ (firstDifferentFromEnd - firstDifferentFromBeginning) > (newList size // 10) ifTrue:[
"/ "/ too many differences - exchange the list en-bloque
"/ browserNameList contents:newList.
"/ ^ false. "/ not same
"/ ].
"/ "/ entries from firstDifferentFromBeginning to firstDifferentFromEnd in newList are different
"/
"/ (firstDifferentFromBeginning - firstDifferentFromEnd) == (oldListSize - newListSize) ifTrue:[
"/ "/ for now, only handle single-removed-item case
"/ firstDifferentFromEnd ~~ (firstDifferentFromBeginning-1) ifTrue:[self halt].
"/
"/ "/ item at firstDifferentFromBeginning has been removed.
"/ browserNameList removeFromIndex:firstDifferentFromBeginning toIndex:firstDifferentFromBeginning.
"/ ^ false "/ not the same
"/ ].
"/ ]
"/ ].
"/
"/ sameContents := true.
"/ newList keysAndValuesDo:[:lineNr :line |
"/ lineNr > browserNameList size ifTrue:[
"/ browserNameList add:line.
"/ sameContents := false.
"/ ] ifFalse:[
"/ oldEntry := browserNameList at:lineNr.
"/ (oldEntry ~= line
"/ or:[(oldEntry sameStringAndEmphasisAs:line) not]) ifTrue:[
"/ browserNameList at:lineNr put:line.
"/ sameContents := false.
"/ ]
"/ ]
"/ ].
"/ newList size < browserNameList size ifTrue:[
"/ browserNameList removeFromIndex:(newList size + 1) toIndex:(browserNameList size).
"/ sameContents := false.
"/ ].
"/ ^ sameContents
"/ ].
"/
"/ browserNameList contents:newList.
"/ ^ false "/ not the same
! !
!NewSystemBrowser::BrowserList methodsFor:'setup'!
commonPostBuildWith:aBuilder
|list|
self slaveMode value == true ifFalse:[
self updateList.
] ifTrue:[
self invalidateList
].
self makeDependent.
list := aBuilder componentAt:#List.
list notNil ifTrue:[
list selectConditionBlock:[:item | self selectionChangeAllowed].
list ignoreReselect:false.
].
"Modified: / 13.11.2001 / 10:27:49 / cg"
!
postBuildAsSubcanvasWith:aBuilder
self commonPostBuildWith:aBuilder.
super postBuildAsSubcanvasWith:aBuilder.
!
postBuildWith:aBuilder
self commonPostBuildWith:aBuilder.
super postBuildWith:aBuilder.
"Modified: / 4.2.2000 / 22:59:45 / cg"
"Created: / 5.2.2000 / 13:42:09 / cg"
! !
!NewSystemBrowser::ClassChecker class methodsFor:'queries'!
individualChecks
"return a list of supported checks"
|checks|
checks := OrderedCollection new.
self methodDictionary keysAndValuesDo:[:sel :mthd |
(mthd category startsWith:'checks') ifTrue:[checks add:sel]
].
checks sort.
^ checks
"
self individualChecks
"
"Created: / 18.8.2000 / 22:30:46 / cg"
"Modified: / 18.8.2000 / 22:31:02 / cg"
! !
!NewSystemBrowser::ClassChecker methodsFor:'accessing'!
badClassInfo
^ badClassInfo
!
badMethodInfo
^ badMethodInfo
!
checkedClass
"return the value of the instance variable 'checkedClass' (automatically generated)"
^ checkedClass
!
checkedClass:something
"set the value of the instance variable 'checkedClass' (automatically generated)"
checkedClass := something.
checksPerformed := nil.
! !
!NewSystemBrowser::ClassChecker methodsFor:'checking'!
allChecks
self errorChecks.
self warningChecks.
self styleChecks.
!
doCheck:whichCheck
checksPerformed isNil ifTrue:[
checksPerformed := Set new.
].
(checksPerformed includes:whichCheck) ifFalse:[
checksPerformed add:whichCheck.
self perform:whichCheck
]
!
errorChecks
self doCheck:#subclassResponsibilityNotDefined.
self doCheck:#sentNotImplemented.
self doCheck:#definesEqualButNotHash.
self doCheck:#instanceVariablesNeverWritten.
!
styleChecks
self doCheck:#checkProtocols.
!
warningChecks
self doCheck:#messageNeverSentAndNotUsedAsSymbol.
self doCheck:#sendsObsoleteMessages.
self doCheck:#instanceVariablesNeverUsed.
self doCheck:#instanceVariablesNeverWritten.
self doCheck:#classVariablesNeverUsed.
self doCheck:#classVariablesNeverWritten.
self doCheck:#classInstanceVariablesNeverUsed.
self doCheck:#classInstanceVariablesNeverWritten.
! !
!NewSystemBrowser::ClassChecker methodsFor:'checks-individual'!
checkProtocols
checkedClass instAndClassSelectorsAndMethodsDo:[:mSelector :method |
self checkProtocolOf:method
]
!
checkVariableNameConventions
|badInstVars badClassVars|
badInstVars := checkedClass instanceVariableNames select:[:varName | varName first isUppercase].
badClassVars := checkedClass classVarNames select:[:varName | varName first isLowercase].
badInstVars notEmpty ifTrue:[
badInstVars := (badInstVars collect:[:v | '''' , v , '''']) asStringWith:$, .
self
rememberBadClass:checkedClass
info:('instVars ' , badInstVars , ' should be lowercase (#checkNameConventions)').
].
badClassVars notEmpty ifTrue:[
badClassVars := (badClassVars collect:[:v | '''' , v , '''']) asStringWith:$, .
self
rememberBadClass:checkedClass
info:('classVars ' , badClassVars , ' should be uppercase (#checkNameConventions)').
].
!
classInstanceVariablesNeverUsed
self instanceVariablesNeverUsedIn:checkedClass theMetaclass.
!
classInstanceVariablesNeverWritten
self instanceVariablesNeverWrittenIn:checkedClass theMetaclass.
!
classVariablesNeverUsed
|cls notUsedHere notUsedAnyWhere anySubclass|
cls := checkedClass theNonMetaclass.
notUsedHere := cls classVarNames asSet.
notUsedHere isEmpty ifTrue:[^ self].
self removeUsedClassVariablesIn:cls from:notUsedHere.
self removeUsedClassVariablesIn:cls class from:notUsedHere.
notUsedHere notEmpty ifTrue:[
notUsedAnyWhere := notUsedHere copy.
anySubclass := false.
cls allSubclassesDo:[:eachSubclass |
anySubclass := true.
notUsedAnyWhere notEmpty ifTrue:[
self removeUsedClassVariablesIn:eachSubclass from:notUsedAnyWhere.
self removeUsedClassVariablesIn:eachSubclass class from:notUsedAnyWhere.
]
].
notUsedHere do:[:eachVariable |
|className|
className := checkedClass name allBold.
self
rememberBadClass:cls
info:('classVar ' , eachVariable allBold , ' is unused in ' , className , ' (#classVariablesNeverUsed)').
(notUsedAnyWhere includes:eachVariable) ifTrue:[
self
rememberBadClass:cls
info:('classVar ' , eachVariable allBold , ' is not even used in subclasses of ' , className , ' (#classVariablesNeverUsed)')
]
].
]
!
classVariablesNeverWritten
|cls notWrittenHere notWrittenAnyWhere anySubclass|
cls := checkedClass theNonMetaclass.
notWrittenHere := cls classVarNames asSet.
notWrittenHere isEmpty ifTrue:[^ self].
self removeWrittenClassVariablesIn:cls from:notWrittenHere.
self removeWrittenClassVariablesIn:cls class from:notWrittenHere.
notWrittenHere notEmpty ifTrue:[
notWrittenAnyWhere := notWrittenHere copy.
anySubclass := false.
cls allSubclassesDo:[:eachSubclass |
anySubclass := true.
notWrittenAnyWhere notEmpty ifTrue:[
self removeWrittenClassVariablesIn:eachSubclass from:notWrittenAnyWhere.
self removeWrittenClassVariablesIn:eachSubclass class from:notWrittenAnyWhere.
]
].
notWrittenHere do:[:eachVariable |
|className|
className := cls name allBold.
self
rememberBadClass:cls
info:('classVar ' , eachVariable allBold , ' is not set in ' , className , ' (#classVariablesNeverWritten)').
(notWrittenAnyWhere includes:eachVariable) ifTrue:[
self
rememberBadClass:cls
info:('classVar ' , eachVariable allBold , ' is not even set in subclasses of ' , className , ' (#classVariablesNeverWritten)')
]
].
]
!
definesEqualButNotHash
(checkedClass includesSelector:#=) ifTrue:[
(checkedClass includesSelector:#hash) ifFalse:[
self
rememberBadClass:checkedClass
info:(checkedClass name allBold, ' redefines #=, but not #hash (#definesEqualButNotHash)').
]
]
!
instanceVariablesNeverUsed
self instanceVariablesNeverUsedIn:checkedClass theNonMetaclass.
!
instanceVariablesNeverWritten
self instanceVariablesNeverWrittenIn:checkedClass theNonMetaclass.
!
messageNeverSent
"/ old code: (slow)
"/ checkedClass instAndClassSelectorsAndMethodsDo:[:mSelector :method |
"/ (self anySendsOf:mSelector) ifFalse:[
"/ self
"/ rememberBadMethod:method
"/ info:('#' , mSelector , ' is nowhere sent (#messageNeverSent)')
"/ ].
"/ ].
|selectorsOfInterest|
selectorsOfInterest := IdentitySet new.
checkedClass instAndClassSelectorsAndMethodsDo:[:mSelector :method | selectorsOfInterest add:mSelector].
(self messagesNeverSentIn:selectorsOfInterest) do:[:eachNeverSent |
self
rememberBadMethod:(checkedClass compiledMethodAt:eachNeverSent)
key:#messageNeverSent
info:('#' , eachNeverSent allBold, ' is nowhere sent (#messageNeverSent)')
].
"Modified: / 18.8.2000 / 22:54:45 / cg"
!
messageNeverSentAndNotUsedAsSymbol
|selectorsOfInterest|
selectorsOfInterest := IdentitySet new.
checkedClass instAndClassSelectorsAndMethodsDo:[:mSelector :method | selectorsOfInterest add:mSelector].
(self messagesNeverSentAndNotUsedAsSymbolIn:selectorsOfInterest) do:[:eachNeverSent |
self
rememberBadMethod:(checkedClass compiledMethodAt:eachNeverSent)
key:#messageNeverSentAndNotUsedAsSymbol
info:('#' , eachNeverSent allBold, ' is nowhere sent and selector-symbol not used in any method (#messageNeverSentAndNotUsedAsSymbol)')
].
"Modified: / 18.8.2000 / 23:10:56 / cg"
!
sendsObsoleteMessages
obsoleteWarners isNil ifTrue:[
obsoleteWarners := Object selectors select:[:each | each startsWith:'obsoleteMethodWarning'].
].
allObsoleteMethods isNil ifTrue:[
allObsoleteMethods := IdentitySet new.
Method allSubInstancesDo:[:eachMethod | |lits|
((lits := eachMethod literals) notNil
and:[lits includesAny:obsoleteWarners]) ifTrue:[
(eachMethod messagesSent includesAny:obsoleteWarners) ifTrue:[
allObsoleteMethods add:(eachMethod selector).
].
].
].
"/ manually patchup; there are some which should not be considered as bad ...
allObsoleteMethods removeAllFoundIn:#( #',' #'at:' #'at:put:' #'raise').
allObsoleteMethods removeAllFoundIn:#( #'asText').
allObsoleteMethods removeAllFoundIn:obsoleteWarners.
].
checkedClass instAndClassSelectorsAndMethodsDo:[:sel :mthd |
|lits sentMessages whichOnes pT searcher nodes|
((lits := mthd literals) notNil
and:[lits includesAny:allObsoleteMethods]) ifTrue:[
sentMessages := mthd messagesSent.
(sentMessages includesAny:allObsoleteMethods) ifTrue:[
whichOnes := sentMessages select:[:each | allObsoleteMethods includes:each].
(RBParser notNil
and:[RBParser isLoaded]) ifTrue:[
"/ lets look at this a bit more detailed;
"/ parse it and see if we can filter out any messages
"/ (i.e. look if we can figure out the receiver type)
"/ pT := RBParser
"/ parseMethod: (mthd source)
"/ onError: [:aString :pos | nil].
"/ pT notNil ifTrue:[
"/ searcher := ParseTreeSearcher
"/ allMessageSendsMatchingAny:whichOnes ignoreCase:false.
"/ nodes := searcher executeTree:pT initialAnswer:(OrderedCollection new).
"/ nodes := nodes
"/ select:
"/ [:aSendNode |
"/ self halt.
"/ ].
"/ whichOnes := nodes collect:[:aSendNode | aSendNode selector].
"/ ].
].
whichOnes asOrderedCollection sort do:[:eachObsoleteMessage |
self
rememberBadMethod:mthd
key:#sendsObsoleteMessages
info:('possibly sends an obsolete message: ' , eachObsoleteMessage , ' (#sendsObsoleteMessages)')
].
].
]
]
!
sentNotImplemented
|alreadyChecked alreadyCheckedSelf alreadyCheckedSuper|
alreadyChecked := IdentitySet new.
alreadyCheckedSelf := IdentitySet new.
alreadyCheckedSuper := IdentitySet new.
checkedClass methodDictionary keysAndValuesDo:[:mSelector :method |
|sentSelectors selfSelectors superSelectors selectorsNoWhereImplemented|
selectorsNoWhereImplemented := IdentitySet new.
sentSelectors := method messagesSent.
sentSelectors do:[:eachSelector |
(alreadyChecked includes:eachSelector) ifFalse:[
(self anyImplementationOf:eachSelector) ifTrue:[
alreadyChecked add:eachSelector
] ifFalse:[
selectorsNoWhereImplemented add:eachSelector.
self
rememberBadMethod:method
key:#sentNotImplemented
info:('#' , eachSelector allBold, ' is nowhere implemented (#sentNotImplemented)')
]
]
].
selfSelectors := method messagesSentToSelf.
selfSelectors do:[:eachSelector |
(selectorsNoWhereImplemented includes:eachSelector) ifFalse:[
(alreadyCheckedSelf includes:eachSelector) ifFalse:[
(self anyImplementationOf:eachSelector inOrAbove:checkedClass) ifTrue:[
alreadyCheckedSelf add:eachSelector
] ifFalse:[
self
rememberBadMethod:method
key:#sentNotImplemented
info:('#' , eachSelector allBold, ' is not implemented in the class (#sentNotImplemented)')
]
]
]
].
superSelectors := method messagesSentToSuper.
superSelectors do:[:eachSelector |
(selectorsNoWhereImplemented includes:eachSelector) ifFalse:[
(alreadyCheckedSuper includes:eachSelector) ifFalse:[
(self anyImplementationOf:eachSelector inOrAbove:(checkedClass superclass)) ifTrue:[
alreadyCheckedSuper add:eachSelector
] ifFalse:[
self
rememberBadMethod:method
key:#sentNotImplemented
info:('#' , eachSelector allBold, ' is not implemented in any superclass (#sentNotImplemented)')
]
]
]
].
].
!
subclassResponsibilityNotDefined
|classesInBetween|
checkedClass allSuperclasses do:[:eachSuperClass |
eachSuperClass methodDictionary keysAndValuesDo:[:mSelector :method |
(method referencesLiteral:#subclassResponsibility) ifTrue:[
"/ parse it to see if it really does ...
(method sends:#subclassResponsibility) ifTrue:[
"/ ok, got one;
"/ now, see if it is defined below this superClass
classesInBetween := checkedClass withAllSuperclasses copy.
classesInBetween removeAll:(eachSuperClass withAllSuperclasses).
(self anyImplementationOf:mSelector in:classesInBetween) ifFalse:[
(self methodShouldBeIgnoredInSubclassResponsibilityNotDefined:method)
ifFalse:[
self
rememberBadMethod:method
key:#subclassResponsibilityNotDefined
info:(checkedClass name allBold , ' should redefine the #' , mSelector allBold , ' method (#subclassResponsibilityNotDefined)').
].
].
]
]
]
].
! !
!NewSystemBrowser::ClassChecker methodsFor:'helpers'!
anyImplementationOf:aSelector
Smalltalk allClassesDo:[:eachClass |
(eachClass theNonMetaclass includesSelector:aSelector) ifTrue:[^ true].
(eachClass theMetaclass includesSelector:aSelector) ifTrue:[^ true].
].
^ false
!
anyImplementationOf:aSelector in:aCollectionOfClasses
aCollectionOfClasses do:[:eachClass |
(eachClass includesSelector:aSelector) ifTrue:[^ true].
].
^ false
!
anyImplementationOf:aSelector inOrAbove:aClass
aClass withAllSuperclassesDo:[:eachClass |
(eachClass includesSelector:aSelector) ifTrue:[^ true].
].
^ false
!
anySendsOf:aSelector
Smalltalk allClassesDo:[:eachClass |
eachClass instAndClassSelectorsAndMethodsDo:[:mSelector :mthd |
(mthd sends:aSelector) ifTrue:[^ true].
].
].
^ false
!
checkProtocolOf:aMethod
|mClass mSelector protocol superClass implClass superProtocol|
mClass := aMethod mclass.
mSelector := aMethod selector.
protocol := aMethod category.
protocol isNil ifTrue: [^true].
superClass := mClass superclass.
superClass isNil ifTrue: [^true].
implClass := superClass whichClassIncludesSelector:mSelector.
implClass isNil ifTrue: [^true].
superProtocol := (implClass compiledMethodAt:mSelector) category.
superProtocol = protocol ifTrue: [^true].
superProtocol isNil ifTrue: [^true].
self
rememberBadMethod:aMethod
key:#checkProtocols
info:('#' , mSelector allBold , ' is classified under "' , protocol allBold , '" in '
, mClass name , ' and under "' , superProtocol allBold , '" in ' , implClass name
, ' (#checkProtocols)')
"Modified: / 18.8.2000 / 23:13:53 / cg"
!
checkUnusedVariables:aMethod rememberReadInstVarsIn:readInstVars writtenInstVarsIn:writtenInstVars readClassVarsIn:readClassVars writtenClassVarsIn:writtenClassVars
|p mClass sourceString|
sourceString := aMethod source.
mClass := aMethod mclass.
p := Parser parseMethodSilent:sourceString in:mClass.
readInstVars addAll:(p readInstVars).
writtenInstVars addAll:(p modifiedInstVars).
readClassVars addAll:(p readClassVars).
writtenClassVars addAll:(p modifiedClassVars).
!
instanceVariablesNeverUsedIn:aClass
|notUsedHere notUsedAnyWhere anySubclass|
notUsedHere := aClass instVarNames asSet.
notUsedHere isEmpty ifTrue:[^ self].
self removeUsedInstanceVariablesIn:aClass from:notUsedHere.
notUsedHere notEmpty ifTrue:[
notUsedAnyWhere := notUsedHere copy.
anySubclass := false.
aClass allSubclassesDo:[:eachSubclass |
anySubclass := true.
notUsedAnyWhere notEmpty ifTrue:[
self removeUsedInstanceVariablesIn:eachSubclass from:notUsedAnyWhere.
]
].
notUsedHere do:[:eachVariable |
|className|
className := aClass name allBold.
self
rememberBadClass:aClass
info:('instVar ' , eachVariable allBold , ' is unused in ' , className , ' (#instanceVariablesNeverUsed)').
anySubclass ifTrue:[
(notUsedAnyWhere includes:eachVariable) ifTrue:[
self
rememberBadClass:aClass
info:('instVar ' , eachVariable allBold , ' is not even used in subclasses of ' , className , ' (#instanceVariablesNeverUsed)')
]
]
].
]
!
instanceVariablesNeverWrittenIn:aClass
|notWrittenHere notWrittenAnyWhere anySubclass|
notWrittenHere := aClass instVarNames asSet.
notWrittenHere isEmpty ifTrue:[^ self].
self removeWrittenInstanceVariablesIn:aClass from:notWrittenHere.
notWrittenHere notEmpty ifTrue:[
notWrittenAnyWhere := notWrittenHere copy.
anySubclass := false.
aClass allSubclassesDo:[:eachSubclass |
anySubclass := true.
notWrittenAnyWhere notEmpty ifTrue:[
self removeWrittenInstanceVariablesIn:eachSubclass from:notWrittenAnyWhere.
]
].
notWrittenHere do:[:eachVariable |
|className|
className := aClass name allBold.
self
rememberBadClass:aClass
info:('instVar ' , eachVariable allBold , ' is nowhere set in ' , className , ' (#instanceVariablesNeverWritten)').
anySubclass ifTrue:[
(notWrittenAnyWhere includes:eachVariable) ifTrue:[
self
rememberBadClass:aClass
info:('instVar ' , eachVariable allBold , ' is not even set in subclasses of ' , className , ' (#instanceVariablesNeverWritten)')
]
]
].
]
!
messagesNeverSentAndNotUsedAsSymbolIn:selectorsOfInterest
|remaining toRemove checkBlock|
remaining := selectorsOfInterest copy asIdentitySet.
toRemove := IdentitySet new.
checkBlock := [:eachClass |
eachClass instAndClassSelectorsAndMethodsDo:[:mSel :mthd | |lits|
lits := mthd literals.
lits notNil ifTrue:[
lits traverse:[:eachLiteral |
eachLiteral isSymbol ifTrue:[
remaining remove:eachLiteral ifAbsent:nil.
]
].
remaining isEmpty ifTrue:[^ remaining].
]
].
].
"/ start searching in the checkedClass - chances are high, we find some here
checkBlock value:checkedClass.
checkedClass superclass notNil ifTrue:[checkBlock value:checkedClass superclass].
Smalltalk allClassesDo:checkBlock.
^ remaining
"Modified: / 18.8.2000 / 23:05:53 / cg"
"Created: / 18.8.2000 / 23:06:55 / cg"
!
messagesNeverSentIn:selectorsOfInterest
|remaining|
remaining := selectorsOfInterest copy.
Smalltalk allClassesDo:[:eachClass |
eachClass instAndClassSelectorsAndMethodsDo:[:mSelector :mthd | |lits|
lits := mthd literals.
lits notNil ifTrue:[
(lits includesAny:remaining) ifTrue:[
remaining removeAllFoundIn:(mthd messagesSent).
remaining isEmpty ifTrue:[^ remaining].
]
]
].
].
^ remaining
"Created: / 18.8.2000 / 22:53:38 / cg"
"Modified: / 18.8.2000 / 22:56:59 / cg"
!
methodShouldBeIgnoredInSubclassResponsibilityNotDefined:aMethod
"a kludge for now - would like to have a pragma, resource or other
way to mark such a method"
aMethod == (Object compiledMethodAt:#implementedBySubclass) ifTrue:[^ true].
aMethod == (Object compiledMethodAt:#readBinaryContentsFromData:manager:) ifTrue:[^ true].
^ false.
!
rememberBadClass:class info:whatIsWrong
|entry|
badClasses isNil ifTrue:[
badClasses := IdentitySet new.
].
badClasses add:class.
badClassInfo isNil ifTrue:[
badClassInfo := IdentityDictionary new.
].
entry := badClassInfo at:class ifAbsentPut:[ OrderedCollection new ].
entry add:whatIsWrong.
!
rememberBadMethod:method key:key info:whatIsWrong
|entry|
badMethods isNil ifTrue:[
badMethods := Set new.
].
(badMethods includes:(method -> key)) ifTrue:[^ self].
badMethods add:(method -> key).
badMethodInfo isNil ifTrue:[
badMethodInfo := IdentityDictionary new.
].
entry := badMethodInfo at:method ifAbsentPut:[ OrderedCollection new ].
entry add:whatIsWrong.
!
rememberBadMethods:methods key:key info:whatIsWrong
methods do:[:eachMethod |
self rememberBadMethod:eachMethod key:key info:whatIsWrong
].
!
removeUsedClassVariablesIn:aClass from:aCollectionOfVariablenames
aClass selectorsAndMethodsDo:[:mSelector :method |
|src usedVars parser|
src := method source.
src notNil ifTrue:[
parser := Parser
parseMethod:src
in:aClass
ignoreErrors:true
ignoreWarnings:true.
(parser notNil and:[parser ~~ #Error]) ifTrue:[
aCollectionOfVariablenames removeAllFoundIn:(parser usedClassVars).
aCollectionOfVariablenames isEmpty ifTrue:[^ self].
]
].
].
!
removeUsedInstanceVariablesIn:aClass from:aCollectionOfVariablenames
aClass selectorsAndMethodsDo:[:mSelector :method |
|src usedVars parser|
src := method source.
src notNil ifTrue:[
parser := Parser
parseMethod:src
in:aClass
ignoreErrors:true
ignoreWarnings:true.
(parser notNil and:[parser ~~ #Error]) ifTrue:[
aCollectionOfVariablenames removeAllFoundIn:(parser usedInstVars).
aCollectionOfVariablenames isEmpty ifTrue:[^ self].
]
].
].
!
removeWrittenClassVariablesIn:aClass from:aCollectionOfVariablenames
aClass selectorsAndMethodsDo:[:mSelector :method |
|src usedVars parser|
src := method source.
src notNil ifTrue:[
parser := Parser
parseMethod:src
in:aClass
ignoreErrors:true
ignoreWarnings:true.
(parser notNil and:[parser ~~ #Error]) ifTrue:[
aCollectionOfVariablenames removeAllFoundIn:(parser modifiedClassVars).
aCollectionOfVariablenames isEmpty ifTrue:[^ self].
]
].
].
!
removeWrittenInstanceVariablesIn:aClass from:aCollectionOfVariablenames
aClass selectorsAndMethodsDo:[:mSelector :method |
|src usedVars parser|
src := method source.
src notNil ifTrue:[
parser := Parser
parseMethod:src
in:aClass
ignoreErrors:true
ignoreWarnings:true.
(parser notNil and:[parser ~~ #Error]) ifTrue:[
aCollectionOfVariablenames removeAllFoundIn:(parser modifiedInstVars).
aCollectionOfVariablenames isEmpty ifTrue:[^ self].
]
].
].
! !
!NewSystemBrowser::ClassGeneratorList class methodsFor:'interface specs'!
windowSpec
"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::ClassGeneratorList andSelector:#windowSpec
NewSystemBrowser::ClassGeneratorList new openInterface:#windowSpec
NewSystemBrowser::ClassGeneratorList open
"
<resource: #canvas>
^
#(#FullSpec
#name: #windowSpec
#window:
#(#WindowSpec
#label: 'OrganizerList'
#name: 'OrganizerList'
#min: #(#Point 0 0)
#max: #(#Point 1024 721)
#bounds: #(#Rectangle 12 22 312 322)
)
#component:
#(#SpecCollection
#collection: #(
#(#SequenceViewSpec
#name: 'List'
#layout: #(#LayoutFrame 0 0.0 0 0.0 0 1.0 0 1.0)
#tabable: true
#model: #organizerSelection
#menu: #menuHolder
#hasHorizontalScrollBar: true
#hasVerticalScrollBar: true
#miniScrollerHorizontal: true
#isMultiSelect: true
#valueChangeSelector: #selectionChangedByClick
#useIndex: true
#sequenceList: #organizerList
#doubleClickChannel: #doubleClickChannel
)
)
)
)
"Modified: / 18.8.2000 / 20:12:20 / cg"
! !
!NewSystemBrowser::ClassGeneratorList methodsFor:'aspects'!
categoryList
categoryList isNil ifTrue:[
categoryList := ValueHolder new.
].
^ categoryList
!
nameSpaceList
namespaceList isNil ifTrue:[
namespaceList := ValueHolder new
].
^ namespaceList
"Created: / 18.2.2000 / 00:59:01 / cg"
!
projectList
projectList isNil ifTrue:[
projectList := ValueHolder new
].
^ projectList
"Created: / 17.2.2000 / 23:39:32 / cg"
!
selectedCategories
selectedCategories isNil ifTrue:[
selectedCategories := ValueHolder new.
selectedCategories addDependent:self
].
^ selectedCategories.
!
selectedCategories:aValueHolder
|prevSelection|
prevSelection := selectedCategories value ? #().
selectedCategories notNil ifTrue:[
selectedCategories removeDependent:self
].
selectedCategories := aValueHolder.
selectedCategories notNil ifTrue:[
selectedCategories addDependent:self
].
(selectedCategories value ? #()) ~= prevSelection ifTrue:[
"/ update
self update:#value with:nil from:selectedCategories
].
!
selectedClasses
selectedClasses isNil ifTrue:[
selectedClasses := ValueHolder new.
].
^ selectedClasses.
!
selectedClasses:aValueHolder
"/ selectedClasses notNil ifTrue:[
"/ selectedClasses removeDependent:self
"/ ].
selectedClasses := aValueHolder.
"/ selectedClasses notNil ifTrue:[
"/ selectedClasses addDependent:self
"/ ].
!
selectedNamespaces
selectedNamespaces isNil ifTrue:[
selectedNamespaces := ValueHolder new.
selectedNamespaces addDependent:self
].
^ selectedNamespaces.
!
selectedNamespaces:aValueHolder
|prevSelection|
prevSelection := selectedNamespaces value ? #().
selectedNamespaces notNil ifTrue:[
selectedNamespaces removeDependent:self
].
selectedNamespaces := aValueHolder.
selectedNamespaces notNil ifTrue:[
selectedNamespaces addDependent:self
].
(selectedNamespaces value ? #()) ~= prevSelection ifTrue:[
"/ update
self update:#value with:nil from:selectedNamespaces
].
!
selectedProjects
selectedProjects isNil ifTrue:[
selectedProjects := ValueHolder new.
selectedProjects addDependent:self
].
^ selectedProjects.
!
selectedProjects:aValueHolder
|prevSelection|
prevSelection := selectedProjects value ? #().
selectedProjects notNil ifTrue:[
selectedProjects removeDependent:self
].
selectedProjects := aValueHolder.
selectedProjects notNil ifTrue:[
selectedProjects addDependent:self
].
(selectedProjects value ? #()) ~= prevSelection ifTrue:[
"/ update
self update:#value with:nil from:selectedProjects
].
! !
!NewSystemBrowser::ClassGeneratorList methodsFor:'aspects-private'!
organizerList
organizerList isNil ifTrue:[
organizerList := ValueHolder new.
].
^ organizerList
! !
!NewSystemBrowser::ClassGeneratorList methodsFor:'change & update'!
delayedUpdate:something with:aParameter from:changedObject
|cls sel pkg mthd|
changedObject == Smalltalk ifTrue:[
organizerMode value == #category ifTrue:[
something == #organization ifTrue:[
self updateList.
^ self
].
something == #newClass ifTrue:[
self updateList.
^ self
].
something == #methodInClass ifTrue:[ ^ self ].
"/ self halt:'debug halt'.
^ self.
].
organizerMode value == #namespace ifTrue:[
something == #newClass ifTrue:[
aParameter isNameSpace ifTrue:[
self updateList
].
^ self
].
something == #classRemove ifTrue:[
aParameter isNameSpace ifTrue:[
self updateList
].
^ self
].
"/ self halt:'debug halt'.
^ self
].
organizerMode value == #project ifTrue:[
something == #projectOrganization ifTrue:[
self updateList.
^ self
].
something == #methodInClass ifTrue:[
cls := aParameter at:1.
sel := aParameter at:2.
mthd := cls compiledMethodAt:sel.
pkg := mthd package.
(projectList value includes:pkg) ifFalse:[
self halt:'debug-halt. remove when known to work'.
self updateList.
^ self
].
^ self
].
(something == #classDefinition
or:[something == #newClass]) ifTrue:[
cls := aParameter.
pkg := cls package.
(projectList value includes:pkg) ifFalse:[
self halt:'debug-halt. remove when known to work'.
self updateList.
^ self
].
^ self
].
"/ self halt.
^ self
].
^ self
].
super delayedUpdate:something with:aParameter from:changedObject
"Created: / 25.2.2000 / 21:32:03 / cg"
"Modified: / 25.2.2000 / 21:35:23 / cg"
! !
!NewSystemBrowser::ClassGeneratorList methodsFor:'private'!
listFromInGenerator
|generator theList|
theList := Set new.
generator := inGeneratorHolder value.
generator isNil ifTrue:[^ #() ].
generator do:[:prj | theList add:prj].
theList := theList asOrderedCollection sort.
theList addFirst:(self class nameListEntryForALL).
^ theList
"Created: / 25.2.2000 / 21:24:26 / cg"
!
listOfCategories
|categories hideUnloadedClasses|
inGeneratorHolder notNil ifTrue:[
^ self listFromInGenerator
].
hideUnloadedClasses := self hideUnloadedClasses value.
categories := Set new.
Smalltalk allClassesDo:[:cls |
(hideUnloadedClasses not or:[cls isLoaded])
ifTrue:[
categories add:cls category.
]
].
"/ those are simulated - in ST/X, empty categories do not
"/ really exist; however, during browsing, it makes sense.
AdditionalEmptyCategories size > 0 ifTrue:[
"/ remove those that are present ...
AdditionalEmptyCategories := AdditionalEmptyCategories select:[:cat | (categories includes:cat) not].
categories addAll:AdditionalEmptyCategories.
].
categories := categories asOrderedCollection.
categories sort.
categories addFirst:(self class nameListEntryForALL).
^ categories
"Created: / 5.2.2000 / 13:42:12 / cg"
"Modified: / 25.2.2000 / 21:26:04 / cg"
!
listOfNamespaces
|allNamespaces showAllNamespaces|
inGeneratorHolder notNil ifTrue:[
^ self listFromInGenerator
].
showAllNamespaces := true.
allNamespaces := IdentitySet new.
(self hideUnloadedClasses value) ifTrue:[
Smalltalk allClassesDo:[:eachClass |
eachClass isLoaded ifTrue:[
allNamespaces add:(eachClass theNonMetaclass topNameSpace)
].
]
] ifFalse:[
allNamespaces := NameSpace allNamespaces.
].
showAllNamespaces ifFalse:[
"/ only topLevel namespaces are shown
"/ i.e. ignore subspaces
allNamespaces := allNamespaces select:[:ns | ns isTopLevelNameSpace].
].
allNamespaces := allNamespaces collect:[:ns | ns name].
allNamespaces := allNamespaces asOrderedCollection.
allNamespaces sort.
allNamespaces addFirst:(self class nameListEntryForALL).
^ allNamespaces
"Created: / 25.2.2000 / 21:21:14 / cg"
"Modified: / 25.2.2000 / 21:26:41 / cg"
!
listOfProjects
|allProjects|
inGeneratorHolder notNil ifTrue:[
^ self listFromInGenerator
].
allProjects := IdentitySet new.
(self hideUnloadedClasses value) ifTrue:[
Smalltalk allClassesDo:[:eachClass |
|cls pkg|
eachClass isLoaded ifTrue:[
cls := eachClass theNonMetaclass.
cls isPrivate ifTrue:[
cls := cls topOwningClass
].
pkg := cls package.
pkg withoutSeparators size > 0 ifTrue:[
allProjects add:pkg asSymbol.
] ifFalse:[
"/ for now, nameSpaces are not in any package;
"/ this might change. Then, 0-sized packages are
"/ illegal, abd the following should be enabled.
"/ self halt
].
cls methodDictionary do:[:mthd |
allProjects add:mthd package asSymbol.
].
].
].
allProjects := allProjects asOrderedCollection.
] ifFalse:[
allProjects := NewSystemBrowser allProjectsIDs.
].
"/ those are simulated - in ST/X, empty projects do not
"/ really exist; however, during browsing, it makes sense.
AdditionalEmptyProjects size > 0 ifTrue:[
"/ remove those that are present ...
AdditionalEmptyProjects := AdditionalEmptyProjects select:[:pkg | (allProjects includes:pkg) not].
allProjects addAll:AdditionalEmptyProjects.
].
allProjects sort.
allProjects addFirst:(self class nameListEntryForALL).
^ allProjects
"Created: / 25.2.2000 / 21:22:06 / cg"
"Modified: / 25.2.2000 / 21:27:27 / cg"
!
makeDependent
Smalltalk addDependent:self
!
makeIndependent
Smalltalk removeDependent:self.
!
release
super release.
selectedCategories removeDependent:self.
selectedNamespaces removeDependent:self.
selectedProjects removeDependent:self.
!
updateCategoryList
|newList|
newList := self listOfCategories.
newList ~= self categoryList value ifTrue:[
categoryList value:newList.
self organizerList value:newList.
].
"Created: / 25.2.2000 / 21:12:32 / cg"
!
updateList
|orgMode|
orgMode := self organizerMode value.
orgMode == #category ifTrue:[
self updateCategoryList.
^ self
].
orgMode == #project ifTrue:[
self updateProjectList.
^ self
].
orgMode == #namespace ifTrue:[
self updateNamespaceList.
^ self
].
self halt:'unexpected value'.
"Created: / 5.2.2000 / 13:42:13 / cg"
"Modified: / 25.2.2000 / 21:14:19 / cg"
!
updateNamespaceList
|newList|
newList := self listOfNamespaces.
newList ~= self nameSpaceList value ifTrue:[
namespaceList value:newList.
self organizerList value:newList.
].
"Created: / 25.2.2000 / 21:13:16 / cg"
!
updateProjectList
|newList|
newList := self listOfProjects.
newList ~= self projectList value ifTrue:[
projectList value:newList.
self organizerList value:newList.
].
"Created: / 25.2.2000 / 21:12:57 / cg"
! !
!NewSystemBrowser::ClassList class methodsFor:'documentation'!
documentation
"
embeddable application displaying the classes as listed by
the inputGenerator.
Provides an outputGenerator, which enumerates the classes and
their protocols (method-categories) in the selected classes.
[author:]
Claus Gittinger (cg@exept.de)
"
! !
!NewSystemBrowser::ClassList class methodsFor:'interface specs'!
singleClassWindowSpec
"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::ClassList andSelector:#singleClassWindowSpec
NewSystemBrowser::ClassList new openInterface:#singleClassWindowSpec
"
<resource: #canvas>
^
#(#FullSpec
#name: #windowSpec
#window:
#(#WindowSpec
#label: 'ClassList'
#name: 'ClassList'
#min: #(#Point 0 0)
#max: #(#Point 1024 721)
#bounds: #(#Rectangle 12 22 312 322)
)
#component:
#(#SpecCollection
#collection: #(
#(#LabelSpec
#label: 'ClassName'
#name: 'ClassLabel'
#layout: #(#LayoutFrame 0 0.0 0 0 0 1.0 25 0)
#translateLabel: true
#labelChannel: #classLabelHolder
#menu: #menuHolder
)
"/ #(#UISubSpecification
"/ #name: 'MetaToggleSpec'
"/ #layout: #(#LayoutFrame 0 0.0 -25 1.0 0 1.0 0 1.0)
"/ #minorKey: #metaSpec
"/ )
)
)
)
!
windowSpec
"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::ClassList andSelector:#windowSpec
NewSystemBrowser::ClassList new openInterface:#windowSpec
NewSystemBrowser::ClassList open
"
<resource: #canvas>
^
#(#FullSpec
#name: #windowSpec
#window:
#(#WindowSpec
#label: 'ClassList'
#name: 'ClassList'
#min: #(#Point 0 0)
#max: #(#Point 1024 721)
#bounds: #(#Rectangle 16 46 316 346)
)
#component:
#(#SpecCollection
#collection: #(
#(#SequenceViewSpec
#name: 'List'
#layout: #(#LayoutFrame 0 0.0 0 0.0 0 1.0 0 1.0)
#tabable: true
#model: #selectedClassNameIndices
#menu: #menuHolder
#hasHorizontalScrollBar: true
#hasVerticalScrollBar: true
#miniScrollerHorizontal: true
#isMultiSelect: true
#valueChangeSelector: #selectionChangedByClick
#useIndex: true
#sequenceList: #classNameList
#doubleClickChannel: #doubleClickChannel
#properties:
#(#PropertyListDictionary
#dragArgument: nil
#dropArgument: nil
#canDropSelector: #canDrop:
#dropSelector: #doDrop:
)
)
)
)
)
! !
!NewSystemBrowser::ClassList class methodsFor:'plugIn spec'!
aspectSelectors
"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."
"Return a description of exported aspects;
these can be connected to aspects of an embedding application
(if this app is embedded in a subCanvas)."
^ #(
#currentNamespace
#(#doubleClickChannel #action )
#forceGeneratorTrigger
#hidePrivateClasses
#hideUnloadedClasses
#immediateUpdate
#inGeneratorHolder
#menuHolder
#meta
#organizerMode
#outGeneratorHolder
#packageFilter
#nameSpaceFilter
#selectedClasses
#selectionChangeCondition
#showClassPackages
#slaveMode
#updateTrigger
#markApplicationsHolder
).
"Modified: / 18.8.2000 / 18:49:08 / cg"
! !
!NewSystemBrowser::ClassList methodsFor:'accessing'!
markApplications
"return the value of the instance variable 'markApplications' (automatically generated)"
^ self markApplicationsHolder value
"Created: / 3.11.2001 / 14:06:19 / cg"
!
markApplications:something
"set the value of the instance variable 'markApplications' (automatically generated)"
self markApplicationsHolder value:something.
"Created: / 3.11.2001 / 14:06:25 / cg"
!
unloadedClassesColor
"return the value of the instance variable 'unloadedClassesColor' (automatically generated)"
^ unloadedClassesColor
!
unloadedClassesColor:something
"set the value of the instance variable 'unloadedClassesColor' (automatically generated)"
unloadedClassesColor := something.
! !
!NewSystemBrowser::ClassList methodsFor:'aspects'!
classLabelHolder
^ self pseudoListLabelHolder
!
classList
classList isNil ifTrue:[
classList := ValueHolder new.
].
^ classList
"Created: / 5.2.2000 / 13:42:16 / cg"
"Modified: / 25.2.2000 / 02:21:07 / cg"
!
classNameList
classNameList isNil ifTrue:[
classNameList := ValueHolder new
].
^ classNameList
!
currentNamespace:aValueHolder
currentNamespace notNil ifTrue:[
currentNamespace removeDependent:self
].
currentNamespace := aValueHolder.
currentNamespace notNil ifTrue:[
currentNamespace isBehavior ifTrue:[self halt:'should not happen'].
currentNamespace addDependent:self
].
"Modified: / 4.2.2000 / 23:34:28 / cg"
"Created: / 5.2.2000 / 21:37:57 / cg"
!
doubleClick
self halt:'should not happen'.
!
hidePrivateClasses
hidePrivateClasses isNil ifTrue:[
hidePrivateClasses := false asValue.
hidePrivateClasses addDependent:self.
].
^ hidePrivateClasses.
"Created: / 24.2.2000 / 15:06:44 / cg"
!
hidePrivateClasses:aValueHolder
hidePrivateClasses notNil ifTrue:[
hidePrivateClasses removeDependent:self
].
hidePrivateClasses := aValueHolder.
hidePrivateClasses notNil ifTrue:[
hidePrivateClasses addDependent:self
].
"Created: / 24.2.2000 / 15:06:46 / cg"
!
markApplicationsHolder
markApplicationsHolder isNil ifTrue:[
markApplicationsHolder := true asValue.
markApplicationsHolder addDependent:self.
].
^ markApplicationsHolder.
!
markApplicationsHolder:aValueHolder
markApplicationsHolder notNil ifTrue:[
markApplicationsHolder removeDependent:self
].
markApplicationsHolder := aValueHolder.
markApplicationsHolder notNil ifTrue:[
markApplicationsHolder addDependent:self
].
"Created: / 24.2.2000 / 15:06:46 / cg"
!
meta
meta isNil ifTrue:[
meta := false asValue.
meta addDependent:self
].
^ meta
"Modified: / 31.1.2000 / 01:19:59 / cg"
"Created: / 5.2.2000 / 13:42:16 / cg"
!
meta:aValueHolder
"/ (aValueHolder == true or:[aValueHolder == false]) ifTrue:[self halt].
meta notNil ifTrue:[
meta removeDependent:self
].
meta := aValueHolder.
meta notNil ifTrue:[
meta addDependent:self
].
!
selectedClassNameIndices
selectedClassNameIndices isNil ifTrue:[
selectedClassNameIndices := #() asValue.
selectedClassNameIndices addDependent:self
].
^ selectedClassNameIndices.
"Created: / 5.2.2000 / 21:31:48 / cg"
"Modified: / 5.2.2000 / 21:43:02 / cg"
!
selectedClasses
^ self selectionHolder
!
selectedClasses:aValueHolder
^ self selectionHolder:aValueHolder
!
showClassPackages
showClassPackages isNil ifTrue:[
showClassPackages := false asValue.
showClassPackages addDependent:self.
].
^ showClassPackages.
"Created: / 24.2.2000 / 15:06:44 / cg"
!
showClassPackages:aValueHolder
showClassPackages notNil ifTrue:[
showClassPackages removeDependent:self
].
showClassPackages := aValueHolder.
showClassPackages notNil ifTrue:[
showClassPackages addDependent:self
].
! !
!NewSystemBrowser::ClassList methodsFor:'change & update'!
classDefinitionChanged:aClassOrNil
listValid ifFalse:[^ self].
slaveMode value == true ifTrue:[
self invalidateList.
^ self.
].
self slaveMode value isNil ifTrue:[
self window shown ifFalse:[
self invalidateList.
^ self
].
].
aClassOrNil isNil ifTrue:[
self halt:'should not happen'.
].
"/ if that class is in my list ...
((self classList value ? #()) contains:[:cls | cls notNil and:[cls theNonMetaclass name = aClassOrNil theNonMetaclass name]])
ifTrue:[
self updateClassListFor:aClassOrNil.
"/ force update
self selectedClassNameIndices value:(self selectedClassNameIndices value).
((self selectedClasses value ? #()) contains:[:cls | cls notNil ifTrue:[cls theNonMetaclass name = aClassOrNil theNonMetaclass name] ifFalse:[false]])
ifTrue:[
self updateOutputGenerator
].
] ifFalse:[
self invalidateList
]
"Modified: / 29.2.2000 / 00:15:23 / cg"
!
classRemoved:aClass
|list|
list := self classList value.
list notNil ifTrue:[
(list includesIdentical:aClass) ifTrue:[
self invalidateList.
]
]
"Modified: / 25.2.2000 / 23:53:51 / cg"
!
delayedUpdate:something with:aParameter from:changedObject
|cls classes chgClass wg|
classes := self classList value ? #().
self inSlaveModeOrInvisible ifTrue:[
self invalidateList.
^ self.
].
"/ (self slaveMode value == true) ifTrue:[^ self].
"/ self slaveMode value isNil ifTrue:[
"/ self window shown ifFalse:[
"/ self invalidateList.
"/ ^ self
"/ ].
"/ ].
changedObject == slaveMode ifTrue:[
listValid ~~ true ifTrue:[
self enqueueDelayedUpdateList.
].
self enqueueDelayedClassSelectionChanged.
^ self
].
changedObject == Smalltalk ifTrue:[
something == #methodInClass ifTrue:[
^ self "no interest"
].
something == #methodInClassRemoved ifTrue:[
"/ must update the list, if the methods package is different from
"/ the classes package (to undo any has-exension highlighting)
cls := aParameter first.
self updateClassListFor:cls.
^ self
].
something == #organization ifTrue:[^ self "no interest" ].
(something == #classDefinition
or:[something == #classVariables
or:[something == #newClass]]) ifTrue:[
"/ update that class in my classList and the selection
listValid ifTrue:[
self classDefinitionChanged:aParameter.
].
^ self.
].
(something == #lastTestRunResult) ifTrue:[
"/ update that class in my classList and the selection
listValid ifTrue:[
self updateClassListFor:aParameter.
"/ self classDefinitionChanged:aParameter.
].
^ self.
].
something == #classRemove ifTrue:[
"/ update my classList and the selection
self classRemoved:aParameter.
^ self.
].
something == #classRename ifTrue:[
"/ update that class in my classList and the selection
listValid ifTrue:[
aParameter isArray ifTrue:[
cls := aParameter at:1.
self classDefinitionChanged:cls.
]
].
^ self.
].
something == #projectOrganization ifTrue:[
aParameter isNil ifTrue:[
self invalidateList.
organizerMode value == #project ifTrue:[
self enqueueDelayedUpdateOutputGenerator.
].
^ self
].
cls := aParameter at:1.
cls notNil ifTrue:[ "/ should not happen (but does occasionally)
((classes includes:cls theMetaclass)
or:[(classes includes:cls theNonMetaclass)]) ifTrue:[
self invalidateList.
organizerMode value == #project ifTrue:[
self enqueueDelayedUpdateOutputGenerator.
]
].
].
^ self
].
^ self.
].
(something == #lastTestRunResult) ifTrue:[
^ self
].
changedObject == ChangeSet ifTrue:[
wg := self windowGroup.
wg isNil ifTrue:[
changedObject removeDependent:self.
] ifFalse:[
"/ react on changes of the changeSet to recolorize items
something == #addChange: ifTrue:[
chgClass := aParameter changeClass.
chgClass notNil ifTrue:[
((classes includes:chgClass theNonMetaclass)
or:[classes includes:chgClass theMetaclass]) ifTrue:[
"/ remove all other addChange notifications ...
wg sensor
flushEventsFor:self
where:[:ev | ev isMessageSendEvent
and:[ev selector == #delayedUpdate:with:from:
and:[(ev arguments at:3) == ChangeSet]]].
self reconstructNameList.
]
]
] ifFalse:[
"/ remove all other ChangeSet notifications ...
wg sensor
flushEventsFor:self
where:[:ev | ev isMessageSendEvent
and:[ev selector == #delayedUpdate:with:from:
and:[(ev arguments at:3) == ChangeSet]]].
self reconstructNameList.
].
].
^ self
].
changedObject == self selectedClasses ifTrue:[
slaveMode value ~~ true ifTrue:[
listValid == true ifFalse:[
self updateList
].
self selectedClassesChanged.
self updateOutputGenerator.
] ifFalse:[
listValid := false.
].
^ self
].
(changedObject == meta
or:[changedObject == selectedClassNameIndices]) ifTrue:[
self selectionChanged.
^ self
].
changedObject == showClassPackages ifTrue:[
self classNameList value:nil.
self invalidateList.
^ self
].
(changedObject == hideUnloadedClasses
or:[changedObject == hidePrivateClasses
or:[changedObject == nameSpaceFilter
or:[changedObject == packageFilter]]]) ifTrue:[
self invalidateList.
^ self
].
super delayedUpdate:something with:aParameter from:changedObject
"Modified: / 13.11.2001 / 11:32:10 / cg"
!
enqueueDelayedClassSelectionChanged
(NewSystemBrowser synchronousUpdate == true
or:[ immediateUpdate value == true ])
ifTrue:[
self selectedClassesChanged.
^ self.
].
self enqueueMessage:#selectedClassesChanged for:self arguments:#()
!
getSelectedClassIndicesFromClasses
"the class selection has changed;
return a collection of selection-indices"
|classes selectedClasses numSelected|
classes := self classList value.
selectedClasses := self selectedClasses value.
numSelected := selectedClasses size.
numSelected == 0 ifTrue:[
^ #()
].
numSelected == classes size ifTrue:[
"/ all selected - easy
^ (1 to:numSelected) asOrderedCollection
].
meta value ifTrue:[
classes := classes collect:[:eachClass | eachClass theMetaclass].
].
classes := selectedClasses collect:[:aSelectedClass | classes identityIndexOf:aSelectedClass.].
classes := classes select:[:idx | idx ~= 0].
^ classes
"Created: / 24.2.2000 / 19:47:52 / cg"
!
getSelectedClassesFromIndices
"the selection-index collection has changed;
return a collection of corresponding classes"
|selected classes allEntrySelected isMeta anyLost selectedClassNameIndices|
allEntrySelected := false.
classes := classList value.
isMeta := meta value.
anyLost := false.
selectedClassNameIndices := self selectedClassNameIndices value.
selectedClassNameIndices size == classes size ifTrue:[
selectedClassNameIndices size == 0 ifTrue:[^ #()].
isMeta ifTrue:[
^ classes collect:[:eachClass | eachClass theMetaclass].
].
^ classes collect:[:eachClass | eachClass theNonMetaclass].
].
selected := selectedClassNameIndices
collect:[:idx |
|cls|
cls := classes at:idx.
cls == (self class nameListEntryForALL) ifTrue:[
allEntrySelected := true.
] ifFalse:[
cls notNil ifTrue:[
isMeta ifTrue:[
cls := cls theMetaclass
] ifFalse:[
cls := cls theNonMetaclass
].
] ifFalse:[
anyLost := true
].
].
cls
].
anyLost ifTrue:[
selected := selected select:[:each | each notNil].
].
"/ allEntrySelected ifTrue:[
"/ selected := classList value select:[:cls | cls ~~ AllEntry].
"/ meta value ifTrue:[
"/ selected := selected collect:[:cls | cls theMetaclass].
"/ ] ifFalse:[
"/ selected := selected collect:[:cls | cls theNonMetaclass].
"/ ].
"/ ].
^ selected.
"Created: / 24.2.2000 / 19:43:37 / cg"
!
selectedClassesChanged
|indices selectedClassNameIndicesHolder|
self classList value size == 0 ifTrue:[
"/ this may happen during early startup,
"/ when invoked with a preset classSelection,
"/ and the classGenerator has not yet been setup
"/ to not clobber the selection, defer the update
"/ until the classList arrives ...
^ self
].
"/ lastSelectedClasses := self selectedClasses value copy.
indices := self getSelectedClassIndicesFromClasses.
selectedClassNameIndicesHolder := self selectedClassNameIndices.
selectedClassNameIndicesHolder value ~= indices ifTrue:[
"/ in slaveMode, do not update selectedClasses from indices
true "slaveMode value" ifTrue:[
selectedClassNameIndicesHolder value:indices withoutNotifying:self
] ifFalse:[
selectedClassNameIndicesHolder value:indices.
]
]
"Created: / 13.2.2000 / 22:18:10 / cg"
"Modified: / 24.2.2000 / 19:48:56 / cg"
!
selectionChanged
"the lists selection has changed. Since the list uses indices,
update the corresponding selectedClasses collection"
|selected prevSelection selectedClassesHolder|
selectedClassesHolder := self selectedClasses.
"/ lastSelectedClasses := selectedClassesHolder value copy.
selected := self getSelectedClassesFromIndices.
prevSelection := selectedClassesHolder value ? #().
"/ to allow reselect, change my valueHolder, even if the same collection
prevSelection ~= selected ifTrue:[
selectedClassesHolder value:selected.
"/ ] ifFalse:[
"/ selectedClassesHolder value:selected withoutNotifying:self
].
"/ (selectedClassesHolder value = lastSelectedClasses
"/ and:[lastSelectedClasses size == 1]) ifTrue:[
"/ "/ thats a kludge - we want to turn off the protocol selection,
"/ "/ when a class is reselected.
"/
"/ (masterApplication notNil
"/ and:[(mm := masterApplication masterApplication) notNil
"/ and:[mm respondsTo:#selectedProtocols]]) ifTrue:[
"/ mm selectedProtocols value:#()
"/ ].
"/ ].
!
selectionChangedByClick
"we are not interested in that - get another notification
via the changed valueHolder"
|selected master|
selected := self getSelectedClassesFromIndices.
(selected = lastSelectedClasses and:[selected size == 1])
ifTrue:[
"/ thats a kludge - we want to turn off the protocol selection,
"/ when a class is reselected.
masterApplication notNil ifTrue:[
master := masterApplication.
masterApplication masterApplication notNil ifTrue:[
master := masterApplication masterApplication.
].
(master respondsTo:#classReselected) ifTrue:[
master classReselected.
].
]
] ifFalse:[
lastSelectedClasses := selected copy.
]
!
update:something with:aParameter from:changedObject
|cls newMethod oldMethod idx classListValue|
self slaveMode value == true ifTrue:[
something == #methodInClass ifTrue:[ ^ self ].
something == #addChange: ifTrue:[ self invalidateList. ^ self ].
].
"/ self window sensor isNil ifTrue:[
"/ "/ not visible ...
"/ self invalidateList.
"/ ^ self
"/ ].
classListValue := classList value.
changedObject == Smalltalk ifTrue:[
something == #classComment ifTrue:[
^ self.
].
something == #methodDictionary ifTrue:[
^ self
].
something == #methodTrap ifTrue:[
^ self
].
something == #methodInClassRemoved ifTrue:[
cls := aParameter at:1.
cls notNil ifTrue:[
classListValue size > 0 ifTrue:[
((classListValue includesIdentical:cls theNonMetaclass)
or:[(classListValue includesIdentical:cls theMetaclass)]) ifTrue:[
self enqueueDelayedUpdateList
]
]
].
^ self
].
something == #methodInClass ifTrue:[
cls := aParameter at:1.
cls notNil ifTrue:[
classListValue size > 0 ifTrue:[
((classListValue includesIdentical:cls theNonMetaclass)
or:[(classListValue includesIdentical:cls theMetaclass)]) ifTrue:[
newMethod := cls compiledMethodAt:(aParameter at:2).
oldMethod := aParameter at:3.
((oldMethod isNil
and:[newMethod package ~= cls package])
or:[oldMethod notNil
and:[newMethod package ~= oldMethod package]])
ifTrue:[
"/ must update the list (for the package-info)
self enqueueDelayedUpdateList
]
]
]
].
^ self
].
"/ kludge: must be careful if my inGenerator is a constant list.
"/ in that case, I have to update it
"/ (sigh - all a consequence of not #becoming the new class)
something == #classDefinition ifTrue:[
inGeneratorHolder value isOrderedCollection ifTrue:[
idx := inGeneratorHolder value findFirst:[:eachClass | eachClass name = aParameter theNonMetaclass name].
idx ~~ 0 ifTrue:[
inGeneratorHolder value at:idx put:aParameter.
self updateClassListFor:aParameter.
"/ self enqueueDelayedUpdateList.
]
] ifFalse:[
classListValue size > 0 ifTrue:[
idx := classListValue findFirst:[:eachClass | eachClass name = aParameter theNonMetaclass name].
idx ~~ 0 ifTrue:[
listValid ifTrue:[
self classDefinitionChanged:aParameter.
^ self.
]
]
].
].
].
].
super update:something with:aParameter from:changedObject
"Modified: / 20.11.2001 / 21:54:56 / cg"
! !
!NewSystemBrowser::ClassList methodsFor:'drag & drop'!
canDrop:aDropContext
|methods cls|
methods := aDropContext dropObjects collect:[:obj | obj theObject].
(methods contains:[:aMethod | aMethod isMethod not]) ifTrue:[^ false].
cls := self classAtTargetPointOf:aDropContext.
(methods contains:[:aMethod | aMethod mclass ~= cls]) ifFalse:[^ false].
^ true
!
classAtTargetPointOf:aDropContext
|p classListView lineNr cls|
p := aDropContext targetPoint.
classListView := aDropContext targetWidget.
lineNr := classListView lineAtY:p y.
lineNr isNil ifTrue:[^ nil].
cls := classList value at:lineNr.
^ cls
!
doDrop:aDropContext
|cls methods|
methods := aDropContext dropObjects collect:[:aDropObject | aDropObject theObject].
(methods contains:[:something | something isMethod not]) ifTrue:[^ self].
cls := self classAtTargetPointOf:aDropContext.
methods first mclass isMeta ifTrue:[
cls := cls theMetaclass
].
cls notNil ifTrue:[
self masterApplication moveMethods:methods toClass:cls.
].
! !
!NewSystemBrowser::ClassList methodsFor:'generators'!
makeGenerator
"return a generator which enumerates the method categories from the selected class;
that generator generates 2-element elements (includes the class), in order
to make the consumers only depend on one input (i.e. no need for another
classHolder in the methodList)."
^ Iterator on:[:whatToDo |
|allEntry classes cls already anyMethod packages classIsInPackage|
allEntry := self class nameListEntryForALL.
classes := self selectedClasses value ? #().
packages := packageFilter value value.
(packages notNil and:[packages includes:allEntry]) ifTrue:[packages := nil].
classes do:[:cls |
(cls notNil and:[cls ~~ allEntry]) ifTrue:[
anyMethod := false.
classIsInPackage := packages isNil or:[packages includes:cls package].
cls theNonMetaclass isJavaClass ifTrue:[
cls isMeta ifTrue:[
whatToDo value:cls theNonMetaclass value:(self class nameListEntryForStatic).
] ifFalse:[
whatToDo value:cls value:(self class nameListEntryForNonStatic).
]
] ifFalse:[
cls supportsMethodCategories ifTrue:[
already := Set new.
cls methodDictionary keysAndValuesDo:[:sel :mthd |
|cat|
cat := mthd category.
(already includes:cat) ifFalse:[
(classIsInPackage
or:[packages isNil
or:[packages includes:mthd package]])
ifTrue:[
already add:cat.
whatToDo value:cls value:cat.
]
]
].
] ifFalse:[
whatToDo value:cls value:(self class nameListEntryForNILCategory).
].
].
anyMethod ifFalse:[
"/ tell the one below, which classes are seen here,
"/ (even if no method is present)
"/ to allow him to decide if the className is to be shown in the list
whatToDo value:cls value:nil.
].
].
].
]
"Modified: / 24.2.2000 / 23:18:26 / cg"
! !
!NewSystemBrowser::ClassList methodsFor:'private'!
listOfClasses
|classesAlready classesOrdered generator nameSpaceFilter packageFilter allName hidePrivate
privateClassesPerClass|
allName := self class nameListEntryForALL.
nameSpaceFilter := self nameSpaceFilter value.
nameSpaceFilter notNil ifTrue:[
(nameSpaceFilter includes:allName) ifTrue:[nameSpaceFilter := nil].
].
packageFilter := self packageFilter value.
packageFilter notNil ifTrue:[
(packageFilter includes:allName) ifTrue:[packageFilter := nil].
].
inGeneratorHolder isNil ifTrue:[
"/ for standAlone testing
generator := Smalltalk allClasses.
(self hideUnloadedClasses value) ifTrue:[
generator := generator select:[:cls | cls isLoaded]
].
] ifFalse:[
generator := inGeneratorHolder value.
generator isNil ifTrue:[^ #() ].
].
classesAlready := IdentitySet new.
classesOrdered := OrderedCollection new.
hidePrivate := self hidePrivateClasses value.
privateClassesPerClass := IdentityDictionary new.
generator do:[:cls |
|owner bucket|
(hidePrivate not or:[cls isPrivate not])
ifTrue:[
(nameSpaceFilter isNil
or:[self isClass:cls shownWithNameSpaceFilter:nameSpaceFilter]) ifTrue:[
(packageFilter isNil
or:[self isClass:cls shownWithPackageFilter:packageFilter]) ifTrue:[
(classesAlready includes:cls) ifFalse:[
classesAlready add:cls.
(owner := cls owningClass) notNil ifTrue:[
bucket := privateClassesPerClass at:owner ifAbsentPut:[SortedCollection new sortBlock:[:a :b | a name < b name] ].
bucket add:cls.
] ifFalse:[
classesOrdered add:cls.
]
]
]
]
]
].
classesOrdered size == 1 ifTrue:[
self classLabelHolder value:(classesOrdered first name)
] ifFalse:[
"/ self classLabelHolder value:(classes size printString , ' classes').
sortBy value ~~ #doNotSort ifTrue:[
classesOrdered sort:[:a :b | a name < b name].
]
].
privateClassesPerClass notEmpty ifTrue:[
|stream action|
stream := WriteStream on:(Array new).
action := [:eachClass |
|bucket|
stream nextPut:eachClass.
bucket := privateClassesPerClass at:eachClass ifAbsent:nil.
bucket notNil ifTrue:[
bucket do:action.
]
].
classesOrdered do:action.
classesOrdered := stream contents.
].
"/
"/ does not work (yet)
"/ classes addFirst:AllEntry.
^ classesOrdered
"Modified: / 18.8.2000 / 20:34:10 / cg"
!
makeDependent
Smalltalk addDependent:self.
ChangeSet addDependent:self.
"Created: / 5.2.2000 / 13:42:17 / cg"
!
makeIndependent
Smalltalk removeDependent:self.
ChangeSet removeDependent:self.
!
nameListEntryFor:aClass withNameSpace:useFullName
|nm indent index owner orgMode indentString javaPackage|
aClass == (self class nameListEntryForALL) ifTrue:[ ^ aClass ].
nm := aClass nameInBrowser.
aClass isLoaded ifFalse:[
unloadedClassesColor notNil ifTrue:[
nm := nm asText emphasizeAllWith:(#color->unloadedClassesColor)
]
].
orgMode := organizerMode value.
orgMode == #hierarchy ifTrue:[
"/ always show the full name
^ nm
].
orgMode == #classHierarchy ifTrue:[
"/ always show the full name
^ nm
].
aClass isJavaClass ifTrue:[
"/ only show the last name, unless multiple packages are shown in the list
javaPackage := aClass package.
(self classList value contains:[:cls | cls package ~= javaPackage]) ifTrue:[
^ nm
].
^ aClass lastName
].
useFullName ifFalse:[
aClass isPrivate ifFalse:[
^ aClass nameWithoutNameSpacePrefix
]
].
"/ full name required if owner is not in the list
owner := aClass owningClass.
(owner isNil
or:[(self classList value includesIdentical:owner) not]) ifTrue:[
^ nm
].
"/ namespace
indent := 0.
index := 1.
[(index := nm indexOf:$: startingAt:index) ~~ 0] whileTrue:[
indent := indent + 1.
index := index + 2.
].
indent == 0 ifFalse:[
indent <= 5 ifTrue:[
indentString := #(
''
' '
' '
' '
' '
' '
) at:indent+1.
] ifFalse:[
indentString := String new:indent*2 withAll:Character space.
].
nm := indentString , '::' , aClass nameWithoutPrefix
].
^ nm
"Modified: / 24.2.2000 / 17:52:28 / cg"
!
nameListForClasses:aClassList
"only reconstruct the names - class list & selection remains
unschanged. Invoked when the organizerMode mode changes"
|orgMode namespaces showNamespaces fullNameList nameList
filteredPackages filteredNameSpaces classesInCangeSet|
showNamespaces := false.
filteredNameSpaces := nameSpaceFilter value.
(filteredNameSpaces isNil
and:[self organizerMode value ~~ #namespace]) ifTrue:[
showNamespaces := true. "/ if no filter, always show the namespace.
] ifFalse:[
(filteredNameSpaces size > 1
or:[(filteredNameSpaces size > 0)
and:[filteredNameSpaces includes:(self class nameListEntryForALL)]]) ifTrue:[
showNamespaces := true
] ifFalse:[
"/ if there are classes from multiple namespaces,
"/ show the full name
namespaces := IdentitySet new.
fullNameList := OrderedCollection new.
aClassList
do:[:cls | |nm|
nm := cls nameInBrowser.
fullNameList add:nm.
namespaces add:cls topNameSpace.
].
showNamespaces := namespaces size > 1
].
].
orgMode := organizerMode value.
filteredPackages := packageFilter value value.
classesInCangeSet := ChangeSet current changedClasses.
classesInCangeSet := classesInCangeSet collect:[:each | each theNonMetaclass].
nameList := aClassList
collect:[:cls |
|nm pkg emPkg hasExtensions isInChangeSet icon|
isInChangeSet := classesInCangeSet includes:cls theNonMetaclass.
nm := self nameListEntryFor:cls withNameSpace:showNamespaces.
isInChangeSet ifTrue:[
nm := self emphasizeForChangedCode:nm
].
pkg := cls package.
hasExtensions := cls hasExtensions.
hasExtensions ifTrue:[
emPkg := self emphasizeForDifferentPackage:'+'. "/ self emphasizeForDifferentPackage:pkg.
].
orgMode == #project ifTrue:[
(filteredPackages notNil
and:[(filteredPackages includes:cls package) not]) ifTrue:[
"/ class is in another packae;
"/ however, class is listed due to methods
"/ in the filtered package
hasExtensions ifTrue:[
nm := nm , emPkg.
] ifFalse:[
nm := nm , ' [ ' , pkg, ' ]'.
].
] ifFalse:[
"/ any methods from other packages in this class ?
hasExtensions ifTrue:[
nm := nm , (self emphasizeForDifferentPackage:'+').
].
].
] ifFalse:[
showClassPackages value == true ifTrue:[
"/ add the package;
hasExtensions ifTrue:[
nm := nm , (self emphasizeForDifferentPackage:pkg , '+').
isInChangeSet ifFalse:[
nm := self colorizeForDifferentPackage:nm
].
] ifFalse:[
nm := nm , (self colorizeGrey:(' [ ' , pkg, ' ]')).
].
] ifFalse:[
hasExtensions ifTrue:[
nm := nm , emPkg.
isInChangeSet ifFalse:[
nm := self colorizeForDifferentPackage:nm
]
].
]
].
"/ cls isVisualStartable ifTrue:[
"/ nm := LabelAndIcon icon:((SystemBrowser visualStartableClassIcon)
"/ onDevice:self window device)
"/ string:nm
"/ ].
markApplicationsHolder value== true ifTrue:[
icon := self nameListIconForClass:cls.
icon isNil ifTrue:[
icon := SystemBrowser emptyIcon
].
nm := LabelAndIcon icon:icon string:nm
].
nm
].
^ nameList
"Modified: / 5.11.2001 / 09:50:27 / cg"
!
nameListIconForClass:cls
|c|
cls isVisualStartable ifTrue:[
^ SystemBrowser startableVisualAppIcon
].
cls isStartableWithMain ifTrue:[
^ SystemBrowser startableClassIcon
].
cls isLoaded ifFalse:[
^ SystemBrowser autoloadedClassIcon
].
c := cls.
[c notNil] whileTrue:[
c == Warning ifTrue:[
^ SystemBrowser warningClassIcon
].
c == Query ifTrue:[
^ SystemBrowser queryClassIcon
].
c == Notification ifTrue:[
^ SystemBrowser notificationClassIcon
].
c == Error ifTrue:[
^ SystemBrowser errorClassIcon
].
c == GenericException ifTrue:[
^ SystemBrowser exceptionClassIcon
].
c == SimpleView ifTrue:[
^ SystemBrowser windowClassIcon
].
c == Collection ifTrue:[
^ SystemBrowser containerClassIcon
].
(c == TestCase and:[cls isAbstract not "cls ~~ TestCase"]) ifTrue:[
^ SystemBrowser testCaseClassIconFor:cls
].
c := c superclass
].
^ nil
!
reconstructNameList
"only reconstruct the names - class list & selection remains
unschanged. Invoked when the organizerMode mode changes"
|prevMode listView oldNameList newNameList sav|
self classList value isNil ifTrue:[
self updateList
].
newNameList := self nameListForClasses:(classList value ? #()).
oldNameList := self classNameList value ? #().
(newNameList sameContentsAs: oldNameList whenComparedWith:[:a :b | a sameStringAndEmphasisAs: b])
ifTrue:[
"/ no need to update
] ifFalse:[
listView := builder componentAt:#List.
(listView isNil or:[listView scrolledView isNil]) ifTrue:[
"/ invoked very early during setup
self classNameList value:newNameList
] ifFalse:[
"/ avoid flicker and useless redraws
prevMode := listView scrollWhenUpdating.
listView scrollWhenUpdating:nil.
"/ this will lead to a selectionIndex change (done by the selListView);
"/ however, we dont want this here, since it recurses into
"/ a selectionChange. Therefore, temporarily disconnect the selectionIndexHolder...
[
self selectedClassNameIndices removeDependent:self.
"/ also, dont want a callback (selectionChangedByClick)
sav := listView action.
listView action:nil.
self classNameList value:newNameList.
] ensure:[
listView action:sav.
self selectedClassNameIndices addDependent:self.
listView scrollWhenUpdating:prevMode.
].
]
].
"Modified: / 31.10.2001 / 11:33:21 / cg"
!
release
super release.
currentNamespace removeDependent:self.
hidePrivateClasses removeDependent:self.
markApplicationsHolder removeDependent:self.
meta removeDependent:self.
selectedClassNameIndices removeDependent:self.
showClassPackages removeDependent:self.
"Created: / 5.2.2000 / 13:42:18 / cg"
!
updateClassListFor:aClass
|classes found foundInSelection|
found := foundInSelection := false.
"/ update for a changed class in the classList
(classes := classList value) size > 0 ifTrue:[
(self updateClassesIn:classes) ifTrue:[
found := true
].
(classes includes:nil) ifTrue:[
self halt:'should not happen'.
classList value:(classes := classes select:[:each | each notNil]).
].
].
"/ possibly in the generator
((classes := inGeneratorHolder value) isOrderedCollection
and:[classes size > 0]) ifTrue:[
(self updateClassesIn:classes) ifTrue:[
found := true
].
(classes includes:nil) ifTrue:[
self halt:'should not happen'.
inGeneratorHolder value:(classes select:[:each | each notNil]).
]
].
"/ and in the selection
(classes := self selectedClasses value) size > 0 ifTrue:[
(self updateClassesIn:classes) ifTrue:[
found := true.
foundInSelection := true.
].
(classes includes:nil) ifTrue:[
self halt:'should not happen'.
self selectedClasses value:(classes select:[:each | each notNil]).
]
].
"/ and in the last selection
(classes := lastSelectedClasses) size > 0 ifTrue:[
(self updateClassesIn:classes) ifTrue:[
found := true
].
(classes includes:nil) ifTrue:[
self halt:'should not happen'.
lastSelectedClasses := (classes select:[:each | each notNil]).
]
].
found ifFalse:[
"/ could be a new class.
listValid ifTrue:[
self enqueueDelayedUpdateList.
].
listValid := false.
].
foundInSelection ifTrue:[
"/ force update of output generator
self selectedClasses
removeDependent:self;
changed;
addDependent:self.
].
"Modified: / 25.2.2000 / 23:54:19 / cg"
!
updateClassesIn:aCollection
"replace any obsolete class in aCollection;
return true, if any was found"
|found meta classes|
found := false.
aCollection isSequenceable ifFalse:[
classes := aCollection copy.
aCollection removeAll.
classes do:[:cls |
|newClass|
meta := cls isMeta.
newClass := Smalltalk at:(cls theNonMetaclass name).
newClass isNil ifTrue:[
newClass := cls
] ifFalse:[
meta ifTrue:[
newClass := newClass class
]
].
found := cls ~~ newClass.
aCollection add:newClass.
].
] ifTrue:[
aCollection keysAndValuesDo:[:idx :cls |
|newClass|
cls notNil ifTrue:[
meta := cls isMeta.
newClass := Smalltalk at:(cls theNonMetaclass name).
newClass isNil ifTrue:[
newClass := cls
] ifFalse:[
meta ifTrue:[
newClass := newClass class
]
].
found := cls ~~ newClass.
aCollection at:idx put:newClass.
]
].
].
^ found
!
updateList
|prevSelection oldList newList newSelectionIndices
forceSelectionChange selectedClassNameIndicesHolder classList|
newList := self listOfClasses.
classList := self classList.
oldList := classList value ? #().
(newList ~= oldList
or:[self classNameList value isNil and:[newList size > 0]]) ifTrue:[
prevSelection := lastSelectedClasses ? #().
prevSelection := prevSelection select:[:each | each notNil].
(newList collect:[:each | each name]) = (oldList collect:[:each | each name]) ifTrue:[
"/ no need to tell anybody
classList setValue:newList.
] ifFalse:[
classList value:newList.
].
self reconstructNameList.
(prevSelection size == 0
and:[self selectedClasses value size ~~ 0]) ifTrue:[
"/ this happens during early startup time,
"/ when the selection is already (pre-)set,
"/ and the classList is generated the first time
"/ (i.e. when opened with preset selection)
"/ do not clobber the selection in this case.
prevSelection := self selectedClasses value.
"/ simulate a change, to force selection update in listView
forceSelectionChange := true.
].
newSelectionIndices := prevSelection
collect:[:item | |cls|
cls := Smalltalk at:item theNonMetaclass name.
newList identityIndexOf:cls]
thenSelect:[:index | index ~~ 0].
selectedClassNameIndicesHolder := self selectedClassNameIndices.
((selectedClassNameIndicesHolder value size ~~ self selectedClasses value size)
or:[newSelectionIndices ~= selectedClassNameIndicesHolder value])
ifTrue:[
newSelectionIndices notEmpty ifTrue:[
"/ force change (for dependents)
"/ selectedClassNameIndicesHolder value:newSelectionIndices.
] ifFalse:[
prevSelection := self selectedClasses value.
newSelectionIndices := #().
].
selectedClassNameIndicesHolder value:newSelectionIndices.
prevSelection notNil ifTrue:[
lastSelectedClasses := prevSelection.
].
self updateOutputGenerator.
].
] ifFalse:[
"/ same classes - but name(s) could be differnet
newList size > 0 ifTrue:[
self reconstructNameList
]
].
listValid := true.
"Created: / 5.2.2000 / 13:42:18 / cg"
"Modified: / 31.10.2001 / 11:35:39 / cg"
! !
!NewSystemBrowser::ClassList methodsFor:'setup'!
postBuildWith:aBuilder
|classListView|
super postBuildWith:aBuilder.
classListView := aBuilder componentAt:'List'.
classListView notNil ifTrue:[
classListView allowDrag:true.
classListView dragObjectConverter:[:obj |
|nm class idx|
nm := obj theObject asString.
idx := classNameList value indexOf:nm.
idx == 0 ifTrue:[
idx := classNameList value indexOf:nm string.
].
class := classList value at:idx.
DropObject newClass:class.
].
]
! !
!NewSystemBrowser::MethodCategoryList class methodsFor:'interface specs'!
singleProtocolWindowSpec
"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::MethodCategoryList andSelector:#singleProtocolWindowSpec
NewSystemBrowser::MethodCategoryList new openInterface:#singleProtocolWindowSpec
"
<resource: #canvas>
^
#(#FullSpec
#name: #singleProtocolWindowSpec
#window:
#(#WindowSpec
#label: 'ProtocolList'
#name: 'ProtocolList'
#min: #(#Point 0 0)
#max: #(#Point 1024 721)
#bounds: #(#Rectangle 12 22 312 322)
)
#component:
#(#SpecCollection
#collection: #(
#(#LabelSpec
#label: 'ProtocolName'
#name: 'ProtocolLabel'
#layout: #(#LayoutFrame 0 0.0 0 0 0 1.0 25 0)
#translateLabel: true
#labelChannel: #protocolLabelHolder
#menu: #menuHolder
)
)
)
)
!
windowSpec
"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::MethodCategoryList andSelector:#windowSpec
NewSystemBrowser::MethodCategoryList new openInterface:#windowSpec
NewSystemBrowser::MethodCategoryList open
"
<resource: #canvas>
^
#(#FullSpec
#name: #windowSpec
#window:
#(#WindowSpec
#label: 'ProtocolList'
#name: 'ProtocolList'
#min: #(#Point 0 0)
#max: #(#Point 1024 721)
#bounds: #(#Rectangle 16 46 316 346)
)
#component:
#(#SpecCollection
#collection: #(
#(#SequenceViewSpec
#name: 'List'
#layout: #(#LayoutFrame 0 0.0 0 0.0 0 1.0 0 1.0)
#tabable: true
#model: #selectedProtocolIndices
#menu: #menuHolder
#hasHorizontalScrollBar: true
#hasVerticalScrollBar: true
#miniScrollerHorizontal: true
#isMultiSelect: true
#valueChangeSelector: #selectionChangedByClick
#useIndex: true
#sequenceList: #protocolList
#doubleClickChannel: #doubleClickChannel
#properties:
#(#PropertyListDictionary
#dragArgument: nil
#dropArgument: nil
#canDropSelector: #canDrop:
#dropSelector: #doDrop:
)
)
)
)
)
! !
!NewSystemBrowser::MethodCategoryList class methodsFor:'plugIn spec'!
aspectSelectors
"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."
"Return a description of exported aspects;
these can be connected to aspects of an embedding application
(if this app is embedded in a subCanvas)."
^ #(
#(#doubleClickChannel #action )
#filterClassVars
#forceGeneratorTrigger
#immediateUpdate
#inGeneratorHolder
#menuHolder
#noAllItem
#outGeneratorHolder
#packageFilter
#packageFilterOnInput
#selectedProtocols
#selectionChangeCondition
#updateTrigger
#variableFilter
#methodVisibilityHolder
).
! !
!NewSystemBrowser::MethodCategoryList methodsFor:'aspects'!
browserNameList
^ self protocolList
!
defaultSlaveModeValue
^ false.
!
filterClassVars
filterClassVars isNil ifTrue:[
filterClassVars := false asValue.
filterClassVars addDependent:self
].
^ filterClassVars
"Modified: / 31.1.2000 / 00:56:31 / cg"
"Created: / 5.2.2000 / 13:42:10 / cg"
!
filterClassVars:aValueHolder
filterClassVars notNil ifTrue:[
filterClassVars removeDependent:self
].
filterClassVars := aValueHolder.
filterClassVars notNil ifTrue:[
filterClassVars addDependent:self
].
"Modified: / 31.1.2000 / 00:56:31 / cg"
"Created: / 5.2.2000 / 13:42:10 / cg"
!
methodVisibilityHolder
methodVisibilityHolder isNil ifTrue:[
methodVisibilityHolder := false asValue.
methodVisibilityHolder addDependent:self
].
^ methodVisibilityHolder
!
methodVisibilityHolder:aValueHolder
methodVisibilityHolder notNil ifTrue:[
methodVisibilityHolder removeDependent:self
].
methodVisibilityHolder := aValueHolder.
methodVisibilityHolder notNil ifTrue:[
methodVisibilityHolder addDependent:self
].
"Modified: / 31.1.2000 / 00:56:31 / cg"
"Created: / 5.2.2000 / 13:42:10 / cg"
!
noAllItem
noAllItem isNil ifTrue:[
noAllItem := false asValue.
noAllItem addDependent:self
].
^ noAllItem
!
noAllItem:aValueHolder
noAllItem notNil ifTrue:[
noAllItem removeDependent:self
].
noAllItem := aValueHolder.
noAllItem notNil ifTrue:[
noAllItem addDependent:self
].
!
packageFilterOnInput
packageFilterOnInput isNil ifTrue:[
packageFilterOnInput := nil asValue.
packageFilterOnInput addDependent:self
].
^ packageFilterOnInput
!
packageFilterOnInput:aValueHolder
|prevFilter|
prevFilter := packageFilterOnInput value.
packageFilterOnInput notNil ifTrue:[
packageFilterOnInput removeDependent:self
].
packageFilterOnInput := aValueHolder.
packageFilterOnInput notNil ifTrue:[
packageFilterOnInput addDependent:self
].
prevFilter ~= packageFilterOnInput value ifTrue:[
self enqueueDelayedUpdateList
].
!
protocolLabelHolder
^ self pseudoListLabelHolder
!
protocolList
protocolList isNil ifTrue:[
protocolList := List new. "/ ValueHolder new
].
^ protocolList
"Modified: / 31.1.2000 / 00:56:31 / cg"
"Created: / 5.2.2000 / 13:42:10 / cg"
!
rawProtocolList
rawProtocolList isNil ifTrue:[
rawProtocolList := List new.
].
^ rawProtocolList
!
selectedProtocolIndices
selectedProtocolIndices isNil ifTrue:[
selectedProtocolIndices := ValueHolder new.
selectedProtocolIndices addDependent:self
].
^ selectedProtocolIndices.
!
selectedProtocols
^ self selectionHolder
!
selectedProtocols:aValueHolder
^ self selectionHolder:aValueHolder
!
variableFilter
variableFilter isNil ifTrue:[
variableFilter := false asValue.
variableFilter addDependent:self
].
^ variableFilter
"Modified: / 31.1.2000 / 00:56:31 / cg"
"Created: / 5.2.2000 / 13:42:10 / cg"
!
variableFilter:aValueHolder
variableFilter notNil ifTrue:[
variableFilter removeDependent:self
].
variableFilter := aValueHolder.
variableFilter notNil ifTrue:[
variableFilter addDependent:self
].
"Modified: / 31.1.2000 / 00:56:31 / cg"
"Created: / 5.2.2000 / 13:42:10 / cg"
! !
!NewSystemBrowser::MethodCategoryList methodsFor:'change & update'!
classDefinitionChanged:aClass
|refetch anyChange|
anyChange := false.
refetch := [:oldClass |
|nm cls newClass|
nm := oldClass theNonMetaclass name.
oldClass isMeta ifTrue:[
newClass := Smalltalk at:nm.
newClass isNil ifTrue:[
Transcript showCR:'oops - browser lost class ' , nm.
newClass := oldClass
] ifFalse:[
newClass := newClass theMetaclass
]
] ifFalse:[
newClass := Smalltalk at:nm
].
newClass ~~ oldClass ifTrue:[
anyChange := true.
].
newClass
].
classes := classes collect:refetch.
leafClasses := leafClasses collect:refetch.
anyChange ifTrue:[
self updateOutputGenerator
].
!
delayedUpdate:something with:aParameter from:changedObject
|sel oldMethod newMethod mthd selectedCategories selectedProtocolsHolder oldProtocol newProtocol
rawProtocolListHolder rawProtocolList oldSelectedProtocols newSelectedProtocols newIndices idx cls listView|
selectedProtocolsHolder := self selectedProtocols.
rawProtocolListHolder := self rawProtocolList.
changedObject == Smalltalk ifTrue:[
classes notNil ifTrue:[
something == #methodCategory ifTrue:[
cls := aParameter at:1.
(cls notNil and:[classes includesIdentical:cls]) ifTrue:[
mthd := aParameter at:2.
newProtocol := mthd category.
oldProtocol := aParameter at:3.
self invalidateList.
selectedCategories := selectedProtocolsHolder value.
selectedCategories size > 0 ifTrue:[
selectedCategories := selectedCategories collect:[:each | each ifNil:[self class nameListEntryForNILCategory]].
selectedCategories := selectedCategories collect:[:each | each string].
((selectedCategories includes:oldProtocol)
or:[ (selectedCategories includes:newProtocol)
or:[ selectedCategories includes:(self class nameListEntryForALL) ]])
ifTrue:[
self updateOutputGenerator.
].
].
].
^ self
].
something == #methodInClass ifTrue:[
"/ a method has been added/removed/changed
cls := aParameter at:1.
(classes includesIdentical:cls) ifTrue:[
sel := aParameter at:2.
oldMethod := aParameter at:3.
newMethod := cls compiledMethodAt:sel.
oldMethod notNil ifTrue:[
variableFilter value size > 0 ifTrue:[
"/ sigh - must invalidate
self invalidateList.
].
^ self.
].
"/ method was added - update the methodList
"/ Q: is this needed (methodCategoryList should send me a new inGenerator)
self invalidateList.
"/ if its category is selected, updateOutputGenerator
selectedCategories := selectedProtocolsHolder value.
selectedCategories size > 0 ifTrue:[
selectedCategories := selectedCategories collect:[:each | each ifNil:[self class nameListEntryForNILCategory]].
selectedCategories := selectedCategories collect:[:each | each string].
((oldMethod notNil and:[selectedCategories includes:(oldMethod category)])
or:[ (newMethod notNil and:[selectedCategories includes:(newMethod category)])])
ifTrue:[
self updateOutputGenerator.
].
].
].
^ self.
].
something == #methodInClassRemoved ifTrue:[
cls := aParameter at:1.
(classes includesIdentical:cls) ifTrue:[
sel := aParameter at:2.
"/ method was removed - update the list and output generator
self invalidateList.
"/ self updateOutputGenerator.
self slaveMode value == true ifFalse:[
self enqueueDelayedUpdateOutputGenerator.
]
].
^ self.
].
something == #classOrganization ifTrue:[
cls := aParameter.
(classes includesIdentical:cls) ifTrue:[
self invalidateList.
] ifFalse:[
(classes contains:[:aClass | aClass name = cls name]) ifTrue:[
self error:'obsolete class: should not happen'.
]
].
^ self.
].
something == #projectOrganization ifTrue:[
aParameter notNil ifTrue:[
cls := aParameter at:1.
cls notNil ifTrue:[
((classes includes:cls theMetaclass)
or:[(classes includes:cls theNonMetaclass)]) ifTrue:[
self invalidateList.
self slaveMode value == true ifFalse:[
self enqueueDelayedUpdateOutputGenerator.
]
].
].
] ifFalse:[
self invalidateList.
].
^ self
].
(something == #classDefinition or:[something == #classVariables])
ifTrue:[
self classDefinitionChanged:aParameter.
^ self
].
"/ everything else is ignored
"/ self halt.
].
^ self
].
changedObject == self selectedProtocolIndices ifTrue:[
oldSelectedProtocols := selectedProtocolsHolder value ? #().
oldSelectedProtocols := oldSelectedProtocols collect:[:each | each ifNil:[self class nameListEntryForNILCategory]].
oldSelectedProtocols := oldSelectedProtocols collect:[:each | each string].
newSelectedProtocols := self getSelectedProtocolsFromIndices.
oldSelectedProtocols ~= newSelectedProtocols ifTrue:[
selectedProtocolsHolder value:newSelectedProtocols.
].
newSelectedProtocols size > 1 ifTrue:[
(newSelectedProtocols includes:(self class nameListEntryForALL)) ifTrue:[
rawProtocolList := rawProtocolListHolder value.
idx := rawProtocolList indexOf: (newSelectedProtocols copy remove:(self class nameListEntryForALL); yourself) first.
idx ~~ 0 ifTrue:[
(listView := self builder componentAt:#List) notNil ifTrue:[
listView makeLineVisible:idx.
]
]
]
].
^ self
].
changedObject == selectedProtocolsHolder ifTrue:[
rawProtocolList := rawProtocolListHolder value.
rawProtocolList size == 0 ifTrue:[
self updateList.
rawProtocolList := rawProtocolListHolder value.
].
rawProtocolList notNil ifTrue:[
selectedCategories := selectedProtocolsHolder value ? #().
selectedCategories := selectedCategories collect:[:each | each ifNil:[self class nameListEntryForNILCategory]].
newIndices := selectedCategories
collect:[:each | rawProtocolList findFirst:[:p | p string = each string]].
newIndices := newIndices select:[:each | each ~~ 0].
newIndices ~= self selectedProtocolIndices value ifTrue:[
self selectedProtocolIndices setValue:nil. "/ to force update
self selectedProtocolIndices value:newIndices
].
(lastGeneratedProtocols notNil
and:[(lastGeneratedProtocols includes:self class nameListEntryForALL)
and:[(selectedProtocolsHolder value ? #()) includes:self class nameListEntryForALL]])
ifTrue:[
"/ no need to update generator
] ifFalse:[
self updateOutputGenerator.
]
].
^ self
].
(changedObject == variableFilter
or:[changedObject == filterClassVars
or:[changedObject == packageFilterOnInput]]) ifTrue:[
self invalidateList.
^ self
].
changedObject == methodVisibilityHolder ifTrue:[
self invalidateList.
self updateOutputGenerator.
^ self
].
lastGeneratedProtocols := nil.
changedObject == inGeneratorHolder ifTrue:[
selectedCategories := selectedProtocolsHolder value.
selectedCategories size > 0 ifTrue:[
oldSelectedProtocols := selectedCategories ? #().
oldSelectedProtocols := oldSelectedProtocols collect:[:each | each ifNil:[self class nameListEntryForNILCategory]].
oldSelectedProtocols := oldSelectedProtocols collect:[:each | each string].
self updateList.
rawProtocolList := rawProtocolListHolder value.
newSelectedProtocols := oldSelectedProtocols select:[:each | rawProtocolList includes:each].
"/ selectedProtocolsHolder setValue:nil. "/ to force update
selectedProtocolsHolder value:newSelectedProtocols.
^ self
].
].
super delayedUpdate:something with:aParameter from:changedObject
"Created: / 5.2.2000 / 13:42:10 / cg"
"Modified: / 29.2.2000 / 11:11:39 / cg"
!
getSelectedProtocolsFromIndices
|l|
l := self rawProtocolList value.
^ self selectedProtocolIndices value collect:[:idx | l at:idx].
!
selectionChanged
|newSelectedCategories allEntry|
newSelectedCategories := self selectedProtocols value.
"/ the outputGenerator is only to be updated, if the output would really
"/ change ...
allEntry := self class nameListEntryForALL.
(lastSelectedProtocols notNil
and:[newSelectedCategories notNil
and:[(lastSelectedProtocols includes:(allEntry))
and:[newSelectedCategories includes:(allEntry)]]]) ifTrue:[
"/ no change ...
^ self
].
super selectionChanged.
"Created: / 5.2.2000 / 13:42:10 / cg"
"Modified: / 24.2.2000 / 14:12:12 / cg"
!
selectionChangedByClick
"we are not interested in that - get another notification
via the changed valueHolder"
lastSelectedProtocols := self getSelectedProtocolsFromIndices
!
update:something with:aParameter from:changedObject
"/ some can be ignored immediately
changedObject == Smalltalk ifTrue:[
something isNil ifTrue:[
"/ self halt "/ huh - Smalltalk changed - so what ?
^ self.
].
"/ something == #classDefinition ifTrue:[
"/ ^ self.
"/ ].
something == #newClass ifTrue:[
^ self.
].
something == #classRemove ifTrue:[
^ self.
].
something == #classRename ifTrue:[
^ self.
].
"/ something == #classVariables ifTrue:[
"/ ^ self.
"/ ].
something == #classComment ifTrue:[
^ self.
].
something == #organization ifTrue:[
^ self.
].
something == #methodTrap ifTrue:[
^ self
].
].
super update:something with:aParameter from:changedObject.
! !
!NewSystemBrowser::MethodCategoryList methodsFor:'drag & drop'!
canDrop:aDropContext
|cat methods|
methods := aDropContext dropObjects collect:[:obj | obj theObject].
(methods contains:[:aMethod | aMethod isMethod not]) ifTrue:[^ false].
cat := self categoryAtTargetPointOf:aDropContext.
(methods contains:[:aMethod | aMethod category ~= cat]) ifFalse:[^ false].
^ cat notNil
!
categoryAtTargetPointOf:aDropContext
|p methodListView lineNr cat|
p := aDropContext targetPoint.
methodListView := aDropContext targetWidget.
lineNr := methodListView lineAtY:p y.
lineNr isNil ifTrue:[^ nil].
cat := rawProtocolList at:lineNr.
cat := cat string.
cat = self class nameListEntryForALL ifTrue:[^ nil].
^ cat
!
doDrop:aDropContext
|cat methods|
methods := aDropContext dropObjects collect:[:aDropObject | aDropObject theObject].
(methods contains:[:something | something isMethod not]) ifTrue:[^ self].
cat := self categoryAtTargetPointOf:aDropContext.
cat notNil ifTrue:[
self masterApplication moveMethods:methods toProtocol:cat.
].
! !
!NewSystemBrowser::MethodCategoryList methodsFor:'generators'!
makeGenerator
"return a generator which enumerates the methods from the selected protocol;
that generator generates 4-element elements (includes the class and protocol),
in order to make the consumers only depend on one input
(i.e. to pass multiple-class and multiple-protocol info
without a need for another classHolder/protocolHolder in the methodList)."
^ Iterator on:[:whatToDo |
|protocols allProtocols noCat static notStatic classSelectorPairsAlreadyDone
packages remainingClasses remainingCategories classesAlreadyDone|
noCat := (self class nameListEntryForNILCategory).
static := (self class nameListEntryForStatic).
notStatic := (self class nameListEntryForNonStatic).
protocols := self selectedProtocols value ? #().
protocols := protocols collect:[:each | (each ifNil:[noCat]) string].
lastGeneratedProtocols := protocols.
protocols := protocols asSet.
(leafClasses size > 0
and:[protocols size > 0]) ifTrue:[
allProtocols := protocols includes:(self class nameListEntryForALL).
packages := packageFilter value value.
(packages notNil and:[packages includes:(self class nameListEntryForALL)]) ifTrue:[
packages := nil.
].
remainingClasses := leafClasses copy asIdentitySet.
remainingCategories := protocols copy asSet.
classesAlreadyDone := IdentitySet new.
classSelectorPairsAlreadyDone := Set new.
leafClasses do:[:aLeafClass |
(self classesToProcessForClasses:(Array with:aLeafClass)) do:[:aClass |
|supportsMethodCategories isJavaClass anyInThisClass|
(classesAlreadyDone includes:aClass) ifFalse:[
classesAlreadyDone add:aClass.
supportsMethodCategories := aClass supportsMethodCategories.
isJavaClass := aClass isJavaClass.
anyInThisClass := false.
aClass methodDictionary keysAndValuesDo:[:sel :mthd |
|cat|
supportsMethodCategories ifTrue:[
cat := mthd category.
] ifFalse:[
isJavaClass ifTrue:[
cat := mthd isStatic ifTrue:[static] ifFalse:[notStatic]
] ifFalse:[
cat := noCat.
]
].
(allProtocols or:[protocols includes:cat]) ifTrue:[
(packages isNil or:[packages includes:mthd package])
ifTrue:[
(methodVisibilityHolder value == #class) ifTrue:[
whatToDo value:aClass value:cat value:sel value:mthd.
] ifFalse:[
(classSelectorPairsAlreadyDone includes:(aLeafClass->sel)) ifFalse:[
classSelectorPairsAlreadyDone add:(aLeafClass->sel).
whatToDo value:aClass value:cat value:sel value:mthd.
].
].
anyInThisClass := true.
remainingCategories remove:cat ifAbsent:nil.
]
]
].
anyInThisClass ifTrue:[ remainingClasses remove:aClass ifAbsent:nil. ].
].
].
].
remainingClasses do:[:aClass |
whatToDo value:aClass value:nil value:nil value:nil.
].
remainingCategories do:[:cat |
whatToDo value:nil value:cat value:nil value:nil.
]
]
]
"Created: / 5.2.2000 / 13:42:10 / cg"
"Modified: / 25.2.2000 / 22:21:52 / cg"
! !
!NewSystemBrowser::MethodCategoryList methodsFor:'private'!
class:cls protocol:cat includesMethodsInAnyPackage:packageFilter
cls methodDictionary keysAndValuesDo:[:sel :mthd |
mthd category == cat ifTrue:[
(packageFilter includes:mthd package) ifTrue:[
^ true
]
]
].
^ false
!
class:cls protocol:cat includesModsOfClassVariable:variablesToHighLight
^ self class:cls protocol:cat includesRefsToVariable:variablesToHighLight askParserWith:#modifiedClassVars
!
class:cls protocol:cat includesModsOfInstanceVariable:variablesToHighLight
^ self class:cls protocol:cat includesRefsToVariable:variablesToHighLight askParserWith:#modifiedInstVars
!
class:cls protocol:cat includesRefsToClassVariable:variablesToHighLight
^ self class:cls protocol:cat includesRefsToVariable:variablesToHighLight askParserWith:#usedClassVars
!
class:cls protocol:cat includesRefsToInstanceVariable:variablesToHighLight
^ self class:cls protocol:cat includesRefsToVariable:variablesToHighLight askParserWith:#usedInstVars
!
class:cls protocol:cat includesRefsToVariable:variablesToHighLight askParserWith:querySelector
|anyVarNameAccessable|
anyVarNameAccessable := cls allInstVarNames includesAny:variablesToHighLight.
anyVarNameAccessable ifFalse:[
anyVarNameAccessable := cls theNonMetaclass allClassVarNames includesAny:variablesToHighLight.
].
anyVarNameAccessable ifFalse:[
"/ no need to parse
^ false
].
cls selectorsAndMethodsDo:[:sel :mthd |
|src parser usedVars|
mthd category = cat ifTrue:[
src := mthd source.
src notNil ifTrue:[
"
before doing a slow parse, quickly scan the
methods source for the variables name ...
"
(variablesToHighLight contains:[:varName | (src findString:varName) ~~ 0]) ifTrue:[
parser := Parser
parseMethod:src
in:cls
ignoreErrors:true
ignoreWarnings:true.
(parser notNil and:[parser ~~ #Error]) ifTrue:[
usedVars := parser perform:querySelector.
(usedVars includesAny:variablesToHighLight)
ifTrue:[
^ true
]
]
]
] ifFalse:[
Transcript showCR:'Oops - cannot access methods source'.
]
]
].
^ false
!
classesToProcessForClasses:classes
^ self classesToProcessForClasses:classes withVisibility:methodVisibilityHolder value.
!
listOfMethodCategories
|categoryList plainCategories classesProcessed leafClassesProcessed
generator nm variablesToHighlight classVarsToHighLight
itemsWithVarRefs itemsWithVarMods itemsWithExtensions itemsWithSuppressedExtensions
itemsInChangeSet
item packageFilterOnInput packageFilter nameListEntryForALL emp|
generator := inGeneratorHolder value.
generator isNil ifTrue:[ ^ #() ].
nameListEntryForALL := self class nameListEntryForALL.
packageFilterOnInput := self packageFilterOnInput value.
(packageFilterOnInput notNil and:[packageFilterOnInput includes:nameListEntryForALL]) ifTrue:[
packageFilterOnInput := nil
].
packageFilter := self packageFilter value.
(packageFilter notNil and:[packageFilter includes:nameListEntryForALL]) ifTrue:[
packageFilter := nil
].
categoryList := Set new.
itemsWithVarRefs := Set new.
itemsWithVarMods := Set new.
itemsWithExtensions := Set new.
itemsWithSuppressedExtensions := Set new.
itemsInChangeSet := Set new.
plainCategories := Set new.
classesProcessed := IdentitySet new.
leafClassesProcessed := IdentitySet new.
variablesToHighlight := variableFilter value.
classVarsToHighLight := filterClassVars value.
generator do:[:clsIn :catIn |
|emptyProtocols clsName doHighLight doHighLightRed suppress|
leafClassesProcessed add:clsIn.
(self classesToProcessForClasses:(Array with:clsIn)) do:[:cls |
|cats|
classesProcessed add:cls.
cls ~~ clsIn ifTrue:[
cats := cls categories
] ifFalse:[
cats := Array with:catIn.
].
cats do:[:cat |
cat notNil ifTrue:[
suppress := packageFilterOnInput notNil
and:[ (self class:cls protocol:cat includesMethodsInAnyPackage:packageFilterOnInput) not ].
suppress ifFalse:[
variablesToHighlight size > 0 ifTrue:[
(itemsWithVarRefs includes:cat) ifFalse:[
classVarsToHighLight ifTrue:[
doHighLight := self class:cls protocol:cat includesRefsToClassVariable:variablesToHighlight.
doHighLight ifTrue:[
doHighLightRed := self class:cls protocol:cat includesModsOfClassVariable:variablesToHighlight.
].
] ifFalse:[
doHighLight := self class:cls protocol:cat includesRefsToInstanceVariable:variablesToHighlight.
doHighLight ifTrue:[
doHighLightRed := self class:cls protocol:cat includesModsOfInstanceVariable:variablesToHighlight.
].
].
doHighLight ifTrue:[
itemsWithVarRefs add:cat.
doHighLightRed ifTrue:[
itemsWithVarMods add:cat.
].
]
]
].
categoryList add:cat.
AdditionalEmptyCategoriesPerClassName size > 0 ifTrue:[
clsName := cls name.
emptyProtocols := AdditionalEmptyCategoriesPerClassName at:clsName ifAbsent:nil.
emptyProtocols size > 0 ifTrue:[
emptyProtocols remove:cat ifAbsent:nil.
].
emptyProtocols size == 0 ifTrue:[
AdditionalEmptyCategoriesPerClassName removeKey:clsName ifAbsent:nil
].
].
]
]
]
]
].
classesProcessed do:[:eachClass |
|classPackage|
classPackage := eachClass package.
eachClass methodDictionary keysAndValuesDo:[:sel :mthd |
|mPackage mCategory|
mPackage := mthd package.
mCategory := mthd category.
#fixme.
mPackage = classPackage ifTrue:[
mPackage ~~ classPackage ifTrue:[
mthd setPackage:(mPackage := mPackage string asSymbol).
]
].
mPackage ~~ classPackage ifTrue:[
itemsWithExtensions add:mCategory.
(packageFilter notNil
and:[ (packageFilter includes:mPackage) not])
ifTrue:[
itemsWithSuppressedExtensions add:mCategory.
].
].
(ChangeSet current changedClasses includes:eachClass) ifTrue:[
(ChangeSet current includesChangeForClass:eachClass selector:mthd selector) ifTrue:[
itemsInChangeSet add:mCategory.
]
]
]
].
categoryList := categoryList asOrderedCollection.
self rawProtocolList removeAll.
rawProtocolList addAll:categoryList.
itemsWithExtensions do:[:cat |
(categoryList includes:cat) ifTrue:[
(itemsWithVarRefs includes:cat) ifFalse:[
categoryList remove:cat.
rawProtocolList remove:cat.
(itemsWithSuppressedExtensions includes:cat) ifTrue:[
item := cat , (self colorizeForDifferentPackage:' [ + ]').
] ifFalse:[
item := self colorizeForDifferentPackage:cat.
].
categoryList add:item.
rawProtocolList add:cat.
]
]
].
itemsInChangeSet do:[:cat |
(categoryList includes:cat) ifTrue:[
categoryList remove:cat.
rawProtocolList remove:cat.
item := self colorizeForChangedCode:cat.
categoryList add:item.
rawProtocolList add:cat.
]
].
categoryList removeAll:itemsWithVarRefs.
rawProtocolList removeAll:itemsWithVarRefs.
itemsWithVarRefs do:[:cat |
item := cat allBold.
(itemsWithVarMods includes:cat) ifTrue:[
emp := (UserPreferences current emphasisForWrittenVariable).
] ifFalse:[
emp := (UserPreferences current emphasisForReadVariable).
].
item emphasisAllAdd:emp.
categoryList add:item.
rawProtocolList add:cat.
].
classesProcessed size > 0 ifTrue:[
"/ those are simulated - in ST/X, empty categories do not
"/ really exist; however, during browsing, it makes sense.
AdditionalEmptyCategoriesPerClassName size > 0 ifTrue:[
AdditionalEmptyCategoriesPerClassName keysAndValuesDo:[:clsName :protocols |
(classesProcessed contains:[:cls | cls name = clsName]) ifTrue:[
categoryList addAll:protocols.
rawProtocolList addAll:protocols.
]
]
].
].
self makeIndependent.
classes := classesProcessed.
leafClasses := leafClassesProcessed.
self makeDependent.
"/ itemsWithExtensions size > 0 ifTrue:[
"/ categoryList := categoryList collect:[:eachCat | (itemsWithExtensions includes:eachCat)
"/ ifTrue:[
"/ eachCat , ' [ + ]'
"/ ] ifFalse:[
"/ eachCat
"/ ]
"/ ].
"/ ].
"/
rawProtocolList sortWith:categoryList.
categoryList size == 1 ifTrue:[
nm := categoryList first string.
classes size == 1 ifTrue:[
nm := classes first name , '-' , nm
].
self protocolLabelHolder value:nm
].
categoryList notEmpty ifTrue:[
noAllItem value ~~ true ifTrue:[
categoryList addFirst:nameListEntryForALL.
rawProtocolList addFirst:nameListEntryForALL.
]
].
^ categoryList
"Created: / 5.2.2000 / 13:42:11 / cg"
"Modified: / 5.11.2001 / 13:59:19 / cg"
!
makeDependent
Smalltalk addDependent:self
!
makeIndependent
Smalltalk removeDependent:self.
!
release
super release.
filterClassVars removeDependent:self.
methodVisibilityHolder removeDependent:self.
noAllItem removeDependent:self.
packageFilterOnInput removeDependent:self.
selectedProtocolIndices removeDependent:self.
variableFilter removeDependent:self.
!
updateList
|prevClasses prevSelection newSelection newList oldList sameContents selectedProtocolsHolder rawList|
selectedProtocolsHolder := self selectedProtocols.
prevClasses := classes ifNil:[ #() ] ifNotNil:[ classes copy ].
oldList := self protocolList value copy.
newList := self listOfMethodCategories.
"/ oldListSize := self browserNameList size.
"/ newListSize := newList size.
self selectedProtocolIndices removeDependent:self.
sameContents := self updateListFor:newList.
self selectedProtocolIndices addDependent:self.
sameContents ifFalse:[
prevSelection := lastSelectedProtocols ? (selectedProtocolsHolder value) ? #().
"/ prevSelection := selectedProtocolsHolder value ? lastSelectedProtocols ? #().
rawList := self rawProtocolList value.
newSelection := prevSelection select:[:item | rawList includes:item string].
newSelection size > 0 ifTrue:[
"/ force change (for dependents)
"/ selectedProtocolsHolder value:nil.
"/ selectedProtocolsHolder value:newSelection.
selectedProtocolsHolder setValue:newSelection.
selectedProtocolsHolder changed:#value.
] ifFalse:[
prevSelection := selectedProtocolsHolder value.
selectedProtocolsHolder value:nil.
].
(prevSelection size > 0 or:[newSelection size > 0]) ifTrue:[
self enqueueDelayedUpdateOutputGenerator.
"/ self updateOutputGenerator.
].
"/ prevSelection notNil ifTrue:[
"/ lastSelectedProtocols := prevSelection.
"/ ].
] ifTrue:[
"/ same list - but classes might have changed
"/ that is the case, if the class selection has been changed,
"/ to another class which has the same categories.
(prevClasses size ~= classes size
or:[prevClasses asOrderedCollection ~= (classes ? #()) asOrderedCollection ]) ifTrue:[
(newList size > 0 or:[oldList size > 0]) ifTrue:[
self updateOutputGenerator
]
] ifFalse:[
"/ self protocolList value:newList.
]
].
listValid := true.
"Created: / 5.2.2000 / 13:42:11 / cg"
"Modified: / 29.2.2000 / 11:08:55 / cg"
! !
!NewSystemBrowser::MethodCategoryList methodsFor:'special'!
addAdditionalProtocol:aProtocol forClass:aClass
|categories|
"/ those are simulated - in ST/X, empty categories do not
"/ really exist; however, during browsing, it makes sense.
AdditionalEmptyCategoriesPerClassName isNil ifTrue:[
AdditionalEmptyCategoriesPerClassName := Dictionary new.
].
categories := AdditionalEmptyCategoriesPerClassName at:aClass name ifAbsent:nil.
categories isNil ifTrue:[
categories := Set new.
AdditionalEmptyCategoriesPerClassName at:aClass name put:categories.
].
categories add:aProtocol.
aClass changed:#organization. "/ not really ... to force update
Smalltalk changed:#classOrganization with:aClass. "/ not really ... to force update
!
additionalProtocolForClass:aClass
"/ those are simulated - in ST/X, empty categories do not
"/ really exist; however, during browsing, it makes sense.
AdditionalEmptyCategoriesPerClassName isNil ifTrue:[ ^ #() ].
^ AdditionalEmptyCategoriesPerClassName at:aClass name ifAbsent:[ #() ].
!
clearLastSelectedProtocol
lastSelectedProtocols := nil
!
removeAdditionalProtocol:aListOfProtocols forClass:aClass
|categories|
"/ those are simulated - in ST/X, empty categories do not
"/ really exist; however, during browsing, it makes sense.
AdditionalEmptyCategoriesPerClassName isNil ifTrue:[^ self].
categories := AdditionalEmptyCategoriesPerClassName at:aClass name ifAbsent:nil.
categories isNil ifTrue:[^ self].
categories removeAllFoundIn:aListOfProtocols.
categories isEmpty ifTrue:[
AdditionalEmptyCategoriesPerClassName removeKey:aClass name.
].
aClass changed:#organization. "/ not really ... to force update
Smalltalk changed:#classOrganization with:aClass. "/ not really ... to force update
!
removeAllAdditionalProtocol
"/ those are simulated - in ST/X, empty categories do not
"/ really exist; however, during browsing, it makes sense.
AdditionalEmptyCategoriesPerClassName := nil
!
removeAllAdditionalProtocolForClass:aClass
"/ those are simulated - in ST/X, empty categories do not
"/ really exist; however, during browsing, it makes sense.
AdditionalEmptyCategoriesPerClassName notNil ifTrue:[
AdditionalEmptyCategoriesPerClassName removeKey:aClass name ifAbsent:nil
].
!
renameAdditionalProtocol:oldName to:newName forClass:aClass
|categories|
"/ those are simulated - in ST/X, empty categories do not
"/ really exist; however, during browsing, it makes sense.
AdditionalEmptyCategoriesPerClassName isNil ifTrue:[^ self].
categories := AdditionalEmptyCategoriesPerClassName at:aClass name ifAbsent:nil.
categories isNil ifTrue:[^ self].
categories remove:oldName ifAbsent:nil.
categories add:newName.
aClass changed:#organization. "/ not really ... to force update
Smalltalk changed:#classOrganization with:aClass. "/ not really ... to force update
! !
!NewSystemBrowser::ClassCategoryList class methodsFor:'documentation'!
documentation
"
embeddable application displaying the class-categories.
Provides an outputGenerator, which enumerates the classes in
the selected categories.
[author:]
Claus Gittinger (cg@exept.de)
"
! !
!NewSystemBrowser::ClassCategoryList class methodsFor:'interface specs'!
singleCategoryWindowSpec
"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::ClassCategoryList andSelector:#singleCategoryWindowSpec
NewSystemBrowser::ClassCategoryList new openInterface:#singleCategoryWindowSpec
"
<resource: #canvas>
^
#(#FullSpec
#name: #singleCategoryWindowSpec
#window:
#(#WindowSpec
#label: 'ClassCategoryList'
#name: 'ClassCategoryList'
#min: #(#Point 0 0)
#max: #(#Point 1024 721)
#bounds: #(#Rectangle 218 175 518 475)
)
#component:
#(#SpecCollection
#collection: #(
#(#LabelSpec
#label: 'ClassCategoryName'
#name: 'ClassCategoryLabel'
#layout: #(#LayoutFrame 0 0.0 0 0 0 1.0 25 0)
#translateLabel: true
#labelChannel: #classCategoryLabelHolder
#menu: #menuHolder
)
)
)
)
!
windowSpec
"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::ClassCategoryList andSelector:#windowSpec
NewSystemBrowser::ClassCategoryList new openInterface:#windowSpec
NewSystemBrowser::ClassCategoryList open
"
<resource: #canvas>
^
#(#FullSpec
#name: #windowSpec
#window:
#(#WindowSpec
#label: 'ClassCategoryList'
#name: 'ClassCategoryList'
#min: #(#Point 0 0)
#max: #(#Point 1024 721)
#bounds: #(#Rectangle 13 23 313 323)
)
#component:
#(#SpecCollection
#collection: #(
#(#SequenceViewSpec
#name: 'List'
#layout: #(#LayoutFrame 0 0.0 0 0.0 0 1.0 0 1.0)
#tabable: true
#model: #selectedCategories
#menu: #menuHolder
#hasHorizontalScrollBar: true
#hasVerticalScrollBar: true
#miniScrollerHorizontal: true
#isMultiSelect: true
#valueChangeSelector: #selectionChangedByClick
#useIndex: false
#sequenceList: #categoryList
#doubleClickChannel: #doubleClickChannel
#properties:
#(#PropertyListDictionary
#dragArgument: nil
#dropArgument: nil
#canDropSelector: #canDrop:
#dropSelector: #doDrop:
)
)
)
)
)
"Created: / 5.2.2000 / 13:42:11 / cg"
"Modified: / 18.8.2000 / 20:11:49 / cg"
! !
!NewSystemBrowser::ClassCategoryList class methodsFor:'plugIn spec'!
aspectSelectors
"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."
"Return a description of exported aspects;
these can be connected to aspects of an embedding application
(if this app is embedded in a subCanvas)."
^ #(
#(#doubleClickChannel #action )
#forceGeneratorTrigger
#hideUnloadedClasses
#immediateUpdate
#inGeneratorHolder
#menuHolder
#nameSpaceFilter
#organizerMode
#outGeneratorHolder
#packageFilter
#selectedCategories
#selectionChangeCondition
#slaveMode
#updateTrigger
).
! !
!NewSystemBrowser::ClassCategoryList methodsFor:'aspects'!
categoryList
categoryList isNil ifTrue:[
categoryList := ValueHolder new.
].
^ categoryList
"Created: / 25.2.2000 / 02:23:08 / cg"
!
categoryList:aValueHolder
categoryList notNil ifTrue:[
categoryList removeDependent:self
].
categoryList := aValueHolder.
categoryList notNil ifTrue:[
categoryList addDependent:self
].
"Created: / 18.8.2000 / 15:21:42 / cg"
!
classCategoryLabelHolder
^ self pseudoListLabelHolder
!
selectedCategories
^ self selectionHolder
!
selectedCategories:aValueHolder
^ self selectionHolder:aValueHolder
! !
!NewSystemBrowser::ClassCategoryList methodsFor:'change & update'!
delayedUpdate:something with:aParameter from:changedObject
|selectedCategoriesHolder selectedCategories allSelectedBefore
nameListEntryForALL categoryOfClass wg|
selectedCategories := self selectedCategoriesStrings.
changedObject == Smalltalk ifTrue:[
((something == #classVariables)
or:[something == #classDefinition]) ifTrue:[
listValid == true ifTrue:[
categoryOfClass := aParameter category.
(categoryList value includes:categoryOfClass) ifFalse:[
self invalidateList.
].
slaveMode value ~~ true ifTrue:[
(selectedCategories includes:categoryOfClass) ifTrue:[
"/ a selected class has changed
"/ in order to give others a chance to update their list before,
"/ this one is always enqueued for delayed update (even if immediateUpdate is true)
"/ self enqueueDelayedUpdateOutputGenerator
self enqueueMessage:#updateOutputGenerator for:self arguments:#()
].
].
].
^ self
].
something == #newClass ifTrue:[
categoryOfClass := aParameter category.
"/ listValid == true ifTrue:[
(categoryList value includes:categoryOfClass) ifFalse:[
self invalidateList.
].
"/ ].
slaveMode value ~~ true ifTrue:[
(selectedCategories includes:categoryOfClass) ifTrue:[
self enqueueDelayedUpdateOutputGenerator
].
].
^ self
].
self invalidateList.
(something == #classRemove
or:[something == #projectOrganization
or:[something == #organization]]) ifTrue:[
slaveMode value ~~ true ifTrue:[
"/ sorry: cannot filter on category (already changed to #removed)
self enqueueDelayedUpdateOutputGenerator
].
].
^ self
].
changedObject == ChangeSet ifTrue:[
"/ remove all other change notifications from the eventQueue
wg := self windowGroup.
wg isNil ifTrue:[
"/ oops - should no longer be dependent...
changedObject removeDependent:self.
] ifFalse:[
wg sensor
flushEventsFor:self
where:[:ev | ev isMessageSendEvent
and:[ev selector == #delayedUpdate:with:from:
and:[(ev arguments at:3) == ChangeSet]]].
].
something == #addChange: ifTrue:[
"/ only need to invalidate, if that change changes my emphasis
"/ (i.e. if its a new methodChange)
"/ self invalidateList.
aParameter isMethodChange ifTrue:[
(ChangeSet current
count:[:chg | chg notNil and:[chg isMethodChange
and:[ chg className = aParameter className ]]])
== 1 ifTrue:[
"/ that methodChange is the first for this method.
aParameter changeClass ifNotNil:[
self colorizeCategoryAsChanged:(aParameter changeClass category).
]
]
].
^ self
].
self invalidateList.
^ self
].
changedObject == nameSpaceFilter ifTrue:[
"/ all might be more or less than before ...
allSelected := false.
].
changedObject == packageFilter ifTrue:[
"/ all might be more or less than before ...
allSelected := false.
].
selectedCategoriesHolder := self selectedCategories.
changedObject == selectedCategoriesHolder ifTrue:[
categoryList isNil ifTrue:[
"/ oops - hurry up
self invalidateList.
].
nameListEntryForALL := self class nameListEntryForALL.
selectedCategories size > 1 ifTrue:[
(selectedCategories includes:nameListEntryForALL) ifTrue:[
self makeSelectionOtherThanAllVisible.
]
].
"/ if all selected before AND allSelected after, no need to update the output generator
allSelectedBefore := allSelected ? false.
allSelected := selectedCategories includes:nameListEntryForALL.
(allSelectedBefore and:[allSelected]) ifTrue:[
^ self
].
].
super delayedUpdate:something with:aParameter from:changedObject
"Created: / 5.2.2000 / 13:42:12 / cg"
"Modified: / 12.11.2001 / 19:36:16 / cg"
!
forceUpdateList
self categoryList setValue:#().
self updateList.
self categoryList changed.
!
selectionChangedByClick
"we are not interested in that - get another notification
via the changed valueHolder"
"Created: / 11.2.2000 / 11:39:48 / cg"
!
update:something with:aParameter from:changedObject
|categoryOfClass|
changedObject == Smalltalk ifTrue:[
something == #methodDictionary ifTrue:[
^ self
].
something == #classComment ifTrue:[
^ self.
].
(something == #classVariables
or:[something == #classDefinition]) ifTrue:[
categoryOfClass := aParameter category.
((self selectedCategories value ? #()) includes:categoryOfClass) ifTrue:[
"/ self halt.
self updateOutputGenerator.
].
].
something == #methodTrap ifTrue:[
^ self
].
something == #methodInClass ifTrue:[
^ self
].
something == #methodInClassRemoved ifTrue:[
^ self
].
].
"/ changedObject == ChangeSet ifTrue:[
"/ something == #addChange: ifTrue:[
"/ ^ self
"/ ]
"/ ].
super update:something with:aParameter from:changedObject
"Modified: / 5.11.2001 / 14:31:18 / cg"
! !
!NewSystemBrowser::ClassCategoryList methodsFor:'drag & drop'!
canDrop:aDropContext
|cat classes|
classes := aDropContext dropObjects collect:[:obj | obj theObject].
(classes contains:[:aClass | aClass isClass not]) ifTrue:[^ false].
(classes contains:[:aClass | aClass isPrivate not]) ifFalse:[^ false].
cat := self categoryAtTargetPointOf:aDropContext.
cat isNil ifTrue:[
^ false
].
cat = '* obsolete *' ifTrue:[
^ false
].
(classes contains:[:aClass | aClass category ~= cat]) ifFalse:[^ false].
^ true.
!
categoryAtTargetPointOf:aDropContext
|p categoryListView lineNr cat|
p := aDropContext targetPoint.
categoryListView := aDropContext targetWidget.
lineNr := categoryListView lineAtY:p y.
lineNr isNil ifTrue:[^ nil].
cat := categoryList value at:lineNr.
cat := cat string.
cat = self class nameListEntryForALL ifTrue:[^ nil].
^ cat
!
doDrop:aDropContext
|cat classes|
classes := aDropContext dropObjects collect:[:aDropObject | aDropObject theObject].
(classes contains:[:something | something isClass not]) ifTrue:[^ self].
cat := self categoryAtTargetPointOf:aDropContext.
cat notNil ifTrue:[
self masterApplication moveClasses:classes toCategory:cat.
].
! !
!NewSystemBrowser::ClassCategoryList methodsFor:'generators'!
makeGenerator
"return a generator which enumerates the classes from the selected category."
|cats hideUnloadedClasses allName nameSpaceFilter packageFilter|
cats := self selectedCategories value.
cats size == 0 ifTrue:[
^ #()
].
cats := cats collect:[:each | each string].
allName := self class nameListEntryForALL.
hideUnloadedClasses := self hideUnloadedClasses value ? false.
nameSpaceFilter := self nameSpaceFilter value.
nameSpaceFilter notNil ifTrue:[
(nameSpaceFilter includes:allName) ifTrue:[nameSpaceFilter := nil].
].
packageFilter := self packageFilter value.
packageFilter notNil ifTrue:[
(packageFilter includes:allName) ifTrue:[packageFilter := nil].
].
(cats includes:allName) ifTrue:[
hideUnloadedClasses ifTrue:[
^ Iterator on:[:whatToDo |
Smalltalk allClassesDo:[:cls |
cls isLoaded ifTrue:[
(cls isNameSpace not or:[cls == Smalltalk]) ifTrue:[
(nameSpaceFilter isNil
or:[self isClass:cls shownWithNameSpaceFilter:nameSpaceFilter]) ifTrue:[
(packageFilter isNil
or:[self isClass:cls shownWithPackageFilter:packageFilter]) ifTrue:[
whatToDo value:cls
]
]
]
]
]
]
].
^ Iterator on:[:whatToDo |
Smalltalk allClassesDo:[:cls |
(cls isNameSpace not or:[cls == Smalltalk]) ifTrue:[
(nameSpaceFilter isNil
or:[self isClass:cls shownWithNameSpaceFilter:nameSpaceFilter]) ifTrue:[
(packageFilter isNil
or:[self isClass:cls shownWithPackageFilter:packageFilter]) ifTrue:[
whatToDo value:cls
]
]
]
]
]
].
^ Iterator on:[:whatToDo |
Smalltalk allClassesDo:[:cls |
(hideUnloadedClasses not or:[cls isLoaded])
ifTrue:[
(cls isNameSpace not or:[cls == Smalltalk]) ifTrue:[
(cats includes:cls category) ifTrue:[
(nameSpaceFilter isNil
or:[self isClass:cls shownWithNameSpaceFilter:nameSpaceFilter]) ifTrue:[
(packageFilter isNil
or:[self isClass:cls shownWithPackageFilter:packageFilter]) ifTrue:[
whatToDo value:cls
]
]
]
]
]
]
]
"Created: / 5.2.2000 / 13:42:12 / cg"
"Modified: / 18.8.2000 / 15:52:41 / cg"
! !
!NewSystemBrowser::ClassCategoryList methodsFor:'private'!
colorizeCategoryAsChanged:category
|colorizedCategoryItem categoryList idx|
colorizedCategoryItem := self colorizeForChangedCode:category copy asText.
categoryList := self categoryList value.
idx := categoryList indexOf:category.
idx ~~ 0 ifTrue:[
((categoryList at:idx) sameStringAndEmphasisAs:colorizedCategoryItem) ifFalse:[
categoryList at:idx put:colorizedCategoryItem.
self categoryList changed.
]
].
!
listOfCategories
|categories hideUnloadedClasses generator nameSpaceFilter packageFilter allName
categoriesWithExtensions categoriesWithChangedCode classesInCangeSet|
allName := self class nameListEntryForALL.
hideUnloadedClasses := self hideUnloadedClasses value.
nameSpaceFilter := self nameSpaceFilter value.
nameSpaceFilter notNil ifTrue:[
(nameSpaceFilter includes:allName) ifTrue:[nameSpaceFilter := nil].
].
packageFilter := self packageFilter value.
packageFilter notNil ifTrue:[
(packageFilter includes:allName) ifTrue:[packageFilter := nil].
].
categories := Set new.
categoriesWithExtensions := Set new.
categoriesWithChangedCode := Set new.
classesInCangeSet := ChangeSet current changedClasses.
classesInCangeSet := classesInCangeSet collect:[:eachClass | eachClass theNonMetaclass].
classes := IdentitySet new.
inGeneratorHolder isNil ifTrue:[
Smalltalk allClassesDo:[:cls |
|cat|
(hideUnloadedClasses not or:[cls isLoaded])
ifTrue:[
(cls isNameSpace not
or:[cls == Smalltalk]) ifTrue:[
(nameSpaceFilter isNil
or:[self isClass:cls shownWithNameSpaceFilter:nameSpaceFilter]) ifTrue:[
(packageFilter isNil
or:[self isClass:cls shownWithPackageFilter:packageFilter]) ifTrue:[
cat := cls category.
cat isString ifFalse:[self halt:'oops - strange category'].
categories add:cat.
classes add:cls.
(classesInCangeSet includes:cls theNonMetaclass) ifTrue:[
categoriesWithChangedCode add:cat
] ifFalse:[
cls hasExtensions ifTrue:[
categoriesWithExtensions add:cat
]
].
]
]
]
]
].
"/ those are simulated - in ST/X, empty categories do not
"/ really exist; however, during browsing, it makes sense.
AdditionalEmptyCategories size > 0 ifTrue:[
"/ remove those that are present ...
AdditionalEmptyCategories := AdditionalEmptyCategories select:[:cat | (categories includes:cat) not].
categories addAll:AdditionalEmptyCategories.
].
] ifFalse:[
generator := inGeneratorHolder value.
generator isNil ifTrue:[^ #() ].
generator do:[:cat | categories add:cat].
].
categories := categories asOrderedCollection.
categories sort.
categories := categories collect:[:cat |
(categoriesWithChangedCode includes:cat) ifTrue:[
(self colorizeForChangedCode:cat copy asText).
"/ cannot add a + here - need separate list for presentation and filter
] ifFalse:[
(categoriesWithExtensions includes:cat) ifTrue:[
(self colorizeForDifferentPackage:cat copy asText)
"/ cannot add a + here - need separate list for presentation and filter
] ifFalse:[
cat
]
]
].
categories size == 1 ifTrue:[
self classCategoryLabelHolder value:(categories first)
].
categories size == 0 ifFalse:[
categories addFirst:(self class nameListEntryForALL).
].
^ categories
"Created: / 5.2.2000 / 13:42:12 / cg"
"Modified: / 13.11.2001 / 11:32:36 / cg"
!
listView
^ self builder componentAt:#List
!
makeDependent
Smalltalk addDependent:self.
ChangeSet addDependent:self.
"Created: / 5.2.2000 / 13:42:13 / cg"
!
makeIndependent
Smalltalk removeDependent:self.
ChangeSet removeDependent:self.
"Created: / 5.2.2000 / 13:42:13 / cg"
!
makeItemVisible:item
|idx listView|
idx := categoryList value indexOf:item.
idx ~~ 0 ifTrue:[
(listView := self listView) notNil ifTrue:[
listView makeLineVisible:idx.
]
]
!
makeSelectionOtherThanAllVisible
|selectedCategories item|
selectedCategories := self selectedCategoriesStrings.
"/ the first item after the *all* item
item := (selectedCategories copy remove:self class nameListEntryForALL; yourself) first.
self makeItemVisible:item.
!
release
super release.
categoryList removeDependent:self.
!
selectedCategoriesStrings
|selectedCategoriesHolder selectedCategories|
selectedCategoriesHolder := self selectedCategories.
selectedCategories := selectedCategoriesHolder value ? #().
selectedCategories := selectedCategories collect:[:each | each string].
^ selectedCategories
!
updateList
|oldList newList oldSelection newSelection prevClasses
selectedCategoriesHolder|
selectedCategoriesHolder := self selectedCategories.
oldSelection := selectedCategoriesHolder value ? #().
prevClasses := classes copy.
newList := self listOfCategories.
oldList := (self categoryList value) ? #().
(newList sameContentsAs:oldList whenComparedWith:[:a :b | a sameStringAndEmphasisAs: b])
ifFalse:[
oldSelection size > 0 ifTrue:[
selectedCategoriesHolder removeDependent:self.
selectedCategoriesHolder value:#().
selectedCategoriesHolder addDependent:self.
].
categoryList value:newList.
oldSelection size > 0 ifTrue:[
newSelection := oldSelection select:[:cat | newList includes:cat].
selectedCategoriesHolder value:newSelection.
]
] ifTrue:[
"/ in case the same categories are present, but classes have changed ...
(prevClasses isNil or:[(classes identicalContentsAs:prevClasses) not]) ifTrue:[
self updateOutputGenerator.
]
].
listValid := true.
"Created: / 5.2.2000 / 13:42:13 / cg"
"Modified: / 18.8.2000 / 15:52:22 / cg"
! !
!NewSystemBrowser::ClassCategoryList methodsFor:'setup'!
commonPostBuildWith:aBuilder
|listView|
listView := self listView.
listView notNil ifTrue:[
listView scrollWhenUpdating:nil
].
super commonPostBuildWith:aBuilder
! !
!NewSystemBrowser::ClassCategoryList methodsFor:'special'!
addAdditionalCategory:aCategory
"/ those are simulated - in ST/X, empty categories do not
"/ really exist; however, during browsing, it makes sense.
AdditionalEmptyCategories isNil ifTrue:[
AdditionalEmptyCategories := Set new.
].
AdditionalEmptyCategories add:aCategory.
Smalltalk changed:#organization "/ not really ... to force update
!
removeAdditionalCategories:aListOfCategories
"/ those are simulated - in ST/X, empty categories do not
"/ really exist; however, during browsing, it makes sense.
AdditionalEmptyCategories isNil ifTrue:[^ self].
aListOfCategories do:[:eachCategory |
AdditionalEmptyCategories remove:eachCategory ifAbsent:nil.
].
Smalltalk changed:#organization "/ not really ... to force update
!
removeAllAdditionalCategories
"/ those are simulated - in ST/X, empty categories do not
"/ really exist; however, during browsing, it makes sense.
AdditionalEmptyCategories := nil
! !
!NewSystemBrowser::HierarchicalClassList class methodsFor:'documentation'!
documentation
"
Like a ClassList, but shows classes hierarchical.
If topClassHolders value is non-nil, only that classes hierarchy
is shown.
embeddable application displaying the classes as listed by
the inputGenerator.
Provides an outputGenerator, which enumerates the classes and
their protocols (method-categories) in the selected classes.
[author:]
Claus Gittinger (cg@exept.de)
"
! !
!NewSystemBrowser::HierarchicalClassList class methodsFor:'initialization'!
initialize
InheritedEntry := '* inheritance *'
"Created: / 24.2.2000 / 20:19:19 / cg"
! !
!NewSystemBrowser::HierarchicalClassList class methodsFor:'queries-plugin'!
aspectSelectors
^ super aspectSelectors ,
#(
topClassHolder
)
! !
!NewSystemBrowser::HierarchicalClassList methodsFor:'aspects'!
topClassHolder
topClassHolder isNil ifTrue:[
topClassHolder := ValueHolder new.
topClassHolder addDependent:self
].
^ topClassHolder
!
topClassHolder:aTriggerValue
topClassHolder notNil ifTrue:[
topClassHolder removeDependent:self
].
topClassHolder := aTriggerValue.
topClassHolder notNil ifTrue:[
topClassHolder isBehavior ifTrue:[self halt:'should not happen'].
topClassHolder addDependent:self
].
! !
!NewSystemBrowser::HierarchicalClassList methodsFor:'change & update'!
classDefinitionChanged:aClass
|prevTop prevSelection newSelection selectedClassesHolder|
listValid ifFalse:[^ self].
slaveMode value == true ifTrue:[
self invalidateList.
^ self.
].
selectedClassesHolder := self selectedClasses.
prevSelection := selectedClassesHolder value copy.
prevTop := self topClassHolder value.
prevTop notNil ifTrue:[
(prevTop name = aClass name) ifTrue:[
"/ forced update
topClassHolder value:aClass.
] ifFalse:[
(prevTop name = aClass class name) ifTrue:[
"/ forced update
topClassHolder value:aClass class.
]
]
].
"/ must update the list (notice, that the hierarchy might have changed..)
self updateList.
selectedClassesHolder value ~= prevSelection ifTrue:[
newSelection := prevSelection collect:[:eachOldClass | Smalltalk classNamed:(eachOldClass name)].
selectedClassesHolder value:newSelection.
]
"Modified: / 26.2.2000 / 01:17:01 / cg"
!
classRemoved:aClass
|prevTop newTop prevSel nPrevSelected selectedClassesHolder newSelection wasMeta|
prevTop := self topClassHolder value.
prevTop notNil ifTrue:[
wasMeta := prevTop isMeta.
newTop := prevTop theNonMetaclass.
[newTop notNil and:[(Smalltalk at:newTop name) ~= newTop]] whileTrue:[
newTop := newTop superclass.
].
wasMeta ifTrue:[
newTop := newTop theMetaclass
].
newTop ~~ prevTop ifTrue:[
self topClassHolder value:newTop.
].
].
selectedClassesHolder := self selectedClasses.
"/ if there is a single selection,
"/ which is the old top, replace it.
prevSel := selectedClassesHolder value.
nPrevSelected := prevSel size.
nPrevSelected > 0 ifTrue:[
nPrevSelected == 1 ifTrue:[
prevSel first == aClass ifTrue:[
newTop notNil ifTrue:[
newSelection := Array with:newTop.
] ifFalse:[
newSelection := #().
]
].
] ifFalse:[
nPrevSelected ~~ 0 ifTrue:[
"/ clear the selection
newSelection := #().
]
].
newSelection notNil ifTrue:[
selectedClassesHolder value:newSelection
].
].
super classRemoved:aClass.
! !
!NewSystemBrowser::HierarchicalClassList methodsFor:'private'!
addTo:aList whereSuperclassIs:aSuperclass
|theClasses|
aSuperclass isNil ifTrue:[
theClasses := Smalltalk allClasses select:[:cls | cls superclass isNil]
] ifFalse:[
theClasses := aSuperclass subclasses.
].
(self hideUnloadedClasses value) ifTrue:[
theClasses := theClasses select:[:cls | cls isLoaded].
].
theClasses := theClasses asOrderedCollection sort:[:a :b | (a name ? '??') < (b name ? '??')].
theClasses do:[:aClass |
aList add:aClass.
self addTo:aList whereSuperclassIs:aClass
].
!
defaultSlaveModeValue
self organizerMode value == #category ifTrue:[^ true].
^ false
!
listOfClasses
|classes top|
classes := OrderedCollection new.
(top := self topClassHolder value) notNil ifTrue:[
top := top theNonMetaclass.
classes addAll:(top withAllSuperclasses copy reverse).
].
self addTo:classes whereSuperclassIs:top.
^ classes
"Modified: / 24.2.2000 / 13:27:43 / cg"
!
nameListEntryFor:aClass withNameSpace:useFullName
|indent superClass nm|
aClass == (self class nameListEntryForALL) ifTrue:[ ^ aClass ].
aClass == InheritedEntry ifTrue:[ ^ aClass ].
nm := aClass name.
indent := 0.
superClass := aClass superclass.
[superClass notNil] whileTrue:[
indent := indent + 1.
superClass := superClass superclass.
].
indent == 0 ifTrue:[
^ nm
].
indent <= 5 ifTrue:[
indent := #(
''
' '
' '
' '
' '
' '
) at:indent+1.
] ifFalse:[
indent := String new:indent*4 withAll:Character space.
].
^ indent , nm
"Modified: / 24.2.2000 / 20:19:47 / cg"
!
release
super release.
topClassHolder removeDependent:self.
! !
!NewSystemBrowser::ProjectList class methodsFor:'interface specs'!
singleProjectWindowSpec
"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::ClassCategoryList andSelector:#singleCategoryWindowSpec
NewSystemBrowser::ClassCategoryList new openInterface:#singleCategoryWindowSpec
"
<resource: #canvas>
^
#(#FullSpec
#name: #singleProjectWindowSpec
#window:
#(#WindowSpec
#label: 'ProjectList'
#name: 'ProjectList'
#min: #(#Point 0 0)
#max: #(#Point 1024 721)
#bounds: #(#Rectangle 218 175 518 475)
)
#component:
#(#SpecCollection
#collection: #(
#(#LabelSpec
#label: 'ProjectName'
#name: 'ProjectLabel'
#layout: #(#LayoutFrame 0 0.0 0 0 0 1.0 25 0)
#translateLabel: true
#labelChannel: #projectLabelHolder
#menu: #menuHolder
)
)
)
)
!
windowSpec
"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::ProjectList andSelector:#windowSpec
NewSystemBrowser::ProjectList new openInterface:#windowSpec
NewSystemBrowser::ProjectList open
"
<resource: #canvas>
^
#(#FullSpec
#name: #windowSpec
#window:
#(#WindowSpec
#label: 'ProjectList'
#name: 'ProjectList'
#min: #(#Point 0 0)
#max: #(#Point 1024 721)
#bounds: #(#Rectangle 13 23 313 323)
)
#component:
#(#SpecCollection
#collection: #(
#(#SequenceViewSpec
#name: 'List'
#layout: #(#LayoutFrame 0 0.0 0 0.0 0 1.0 0 1.0)
#tabable: true
#model: #selectedProjects
#menu: #menuHolder
#hasHorizontalScrollBar: true
#hasVerticalScrollBar: true
#miniScrollerHorizontal: true
#isMultiSelect: true
#valueChangeSelector: #selectionChangedByClick
#useIndex: false
#sequenceList: #projectList
#doubleClickChannel: #doubleClickChannel
#properties:
#(#PropertyListDictionary
#dragArgument: nil
#dropArgument: nil
#canDropSelector: #canDrop:
#dropSelector: #doDrop:
)
)
)
)
)
"Created: / 17.2.2000 / 23:45:47 / cg"
"Modified: / 17.2.2000 / 23:47:53 / cg"
! !
!NewSystemBrowser::ProjectList class methodsFor:'queries-plugin'!
aspectSelectors
^ #(
#(#doubleClickChannel #action )
immediateUpdate
selectedProjects
menuHolder
outGeneratorHolder
inGeneratorHolder
selectionChangeCondition
updateTrigger
forceGeneratorTrigger
hideUnloadedClasses
organizerMode
slaveMode
)
"Created: / 17.2.2000 / 23:46:18 / cg"
"Modified: / 25.2.2000 / 22:32:10 / cg"
! !
!NewSystemBrowser::ProjectList methodsFor:'aspects'!
projectLabelHolder
^ self pseudoListLabelHolder
!
projectList
projectList isNil ifTrue:[
projectList := ValueHolder new.
projectList addDependent:self.
].
^ projectList
"Created: / 17.2.2000 / 23:39:32 / cg"
!
selectedProjects
^ self selectionHolder
"Created: / 17.2.2000 / 23:39:57 / cg"
!
selectedProjects:aValueHolder
^ self selectionHolder:aValueHolder
! !
!NewSystemBrowser::ProjectList methodsFor:'change & update'!
delayedUpdate:something with:aParameter from:changedObject
|cls sel pkg mthd|
self inSlaveModeOrInvisible
"/ (self slaveMode value == true)
ifTrue:[
changedObject == Smalltalk ifTrue:[ listValid := false].
something == #projectOrganization ifTrue:[ listValid := false].
^ self
].
changedObject == slaveMode ifTrue:[
listValid ~~ true ifTrue:[
self enqueueDelayedUpdateList
].
"/ self invalidateList.
^ self
].
changedObject == Smalltalk ifTrue:[
something == #projectOrganization ifTrue:[
self invalidateList.
self enqueueDelayedUpdateOutputGenerator.
^ self.
].
something == #methodInClass ifTrue:[
listValid == true ifTrue:[
cls := aParameter at:1.
sel := aParameter at:2.
mthd := cls compiledMethodAt:sel.
mthd notNil ifTrue:[
pkg := mthd package.
(projectList value includes:pkg) ifFalse:[
self invalidateList.
]
].
].
^ self
].
(something == #classDefinition
or:[something == #newClass]) ifTrue:[
listValid == true ifTrue:[
cls := aParameter.
pkg := cls package.
(projectList value includes:pkg) ifFalse:[
self invalidateList.
] ifTrue:[
self enqueueDelayedUpdateOutputGenerator
].
] ifFalse:[
self invalidateList
].
^ self
].
(something == #classRemove) ifTrue:[
listValid == true ifTrue:[
cls := aParameter.
pkg := cls package.
].
].
^ self
].
"/ something == #projectOrganization ifTrue:[
"/ aParameter isSymbol ifTrue:[
"/ "/ a single method has changed
"/"/ sel := aParameter.
"/"/ mthd := changedObject compiledMethodAt:sel.
"/ self enqueueDelayedUpdateOutputGenerator.
"/ ].
"/ ^ self
"/ ].
(organizerMode notNil
and:[organizerMode value ~~ #project]) ifTrue:[
self invalidateList.
^ self
].
super delayedUpdate:something with:aParameter from:changedObject
"Created: / 17.2.2000 / 23:41:02 / cg"
"Modified: / 26.2.2000 / 01:21:49 / cg"
!
selectionChangedByClick
"we are not interested in that - get another notification
via the changed valueHolder"
"Created: / 17.2.2000 / 23:41:17 / cg"
!
update:something with:aParameter from:changedObject
changedObject == Smalltalk ifTrue:[
something == #methodDictionary ifTrue:[
^ self
].
something == #methodTrap ifTrue:[
^ self
].
something == #methodInClass ifTrue:[
^ self
].
something == #classVariables ifTrue:[
^ self
].
something == #classComment ifTrue:[
^ self.
].
something == #methodInClassRemoved ifTrue:[
^ self.
].
].
super update:something with:aParameter from:changedObject
! !
!NewSystemBrowser::ProjectList methodsFor:'drag & drop'!
canDrop:aDropContext
|methodsOrClasses package|
methodsOrClasses := aDropContext dropObjects collect:[:obj | obj theObject].
(methodsOrClasses contains:[:aMethodOrClass | (aMethodOrClass isMethod or:[aMethodOrClass isClass]) not]) ifTrue:[^ false].
package := self packageAtTargetPointOf:aDropContext.
package isNil ifTrue:[^ false].
(methodsOrClasses contains:[:aMethodOrClass | aMethodOrClass package ~= package]) ifFalse:[^ false].
^ true
!
doDrop:aDropContext
|package methodsOrClasses methods classes|
methodsOrClasses := aDropContext dropObjects collect:[:aDropObject | aDropObject theObject].
(methodsOrClasses contains:[:something | (something isMethod or:[something isClass]) not]) ifTrue:[^ self].
methods := methodsOrClasses select:[:something | something isMethod].
classes := methodsOrClasses select:[:something | something isClass].
package := self packageAtTargetPointOf:aDropContext.
package notNil ifTrue:[
methods notEmpty ifTrue:[
self masterApplication moveMethods:methods toProject:package.
].
classes notEmpty ifTrue:[
self masterApplication moveClasses:classes toProject:package.
]
].
!
packageAtTargetPointOf:aDropContext
|p packageListView lineNr item package dropInfo now
overItem timeOverItem|
p := aDropContext targetPoint.
packageListView := aDropContext targetWidget.
dropInfo := aDropContext dropInfo.
lineNr := packageListView yVisibleToLineNr:p y.
lineNr isNil ifTrue:[^ nil].
item := packageListView list value at:lineNr.
item isNil ifTrue:[^ nil].
item canExpand ifTrue:[
now := AbsoluteTime now.
overItem := dropInfo at:#overItem ifAbsentPut:[item].
timeOverItem := dropInfo at:#timeOverItem ifAbsentPut:[now].
overItem ~~ item ifTrue:[
dropInfo at:#timeOverItem put:now.
dropInfo at:#overItem put:item.
aDropContext passiveAction:[ self packageAtTargetPointOf:aDropContext ].
] ifFalse:[
(now millisecondDeltaFrom:timeOverItem) >= (UserPreferences current timeToAutoExpandItemsWhenDraggingOver) ifTrue:[
aDropContext saveDraw:[ item expand. packageListView repairDamage ].
dropInfo removeKey:#timeOverItem.
dropInfo removeKey:#overItem.
] ifFalse:[
aDropContext passiveAction:[ self packageAtTargetPointOf:aDropContext ].
]
].
].
package := item package.
package = self class nameListEntryForALL ifTrue:[^ nil].
^ package.
! !
!NewSystemBrowser::ProjectList methodsFor:'generators'!
makeGenerator
"return a generator which enumerates the classes from the selected project(s)."
|selectedPackages thePackage hideUnloadedClasses|
selectedPackages := self selectedProjects value.
selectedPackages size == 0 ifTrue:[
^ #()
].
hideUnloadedClasses := self hideUnloadedClasses value.
(selectedPackages includes:(self class nameListEntryForALL)) ifTrue:[
hideUnloadedClasses ifTrue:[
^ Iterator on:[:whatToDo |
Smalltalk allClassesDo:[:cls |
cls isLoaded ifTrue:[
(cls isNameSpace not or:[cls == Smalltalk]) ifTrue:[
whatToDo value:cls
]
]
]
]
].
^ Iterator on:[:whatToDo |
Smalltalk allClassesDo:[:cls |
(cls isNameSpace not or:[cls == Smalltalk]) ifTrue:[
whatToDo value:cls
]
]
]
].
selectedPackages size == 1 ifTrue:[
"/ faster common case
thePackage := selectedPackages first.
^ Iterator on:[:whatToDo | |doInclude|
Smalltalk allClassesDo:[:cls |
(hideUnloadedClasses not or:[cls isLoaded])
ifTrue:[
(cls isNameSpace not or:[cls == Smalltalk]) ifTrue:[
doInclude := (thePackage = cls package).
doInclude ifFalse:[
cls isJavaClass ifFalse:[
doInclude := (cls methodDictionary contains:[:mthd | thePackage = mthd package])
or:[ cls class methodDictionary contains:[:mthd | thePackage = mthd package]].
]
].
doInclude ifTrue:[
whatToDo value:cls
]
]
]
]
]
].
^ Iterator on:[:whatToDo | |doInclude|
Smalltalk allClassesDo:[:cls |
(hideUnloadedClasses not or:[cls isLoaded])
ifTrue:[
(cls isNameSpace not or:[cls == Smalltalk]) ifTrue:[
doInclude := (selectedPackages includes:cls package).
doInclude ifFalse:[
cls isJavaClass ifFalse:[
doInclude := (cls methodDictionary contains:[:mthd | thePackage = mthd package])
or:[ cls class methodDictionary contains:[:mthd | thePackage = mthd package]].
]
].
doInclude ifTrue:[
whatToDo value:cls
]
]
]
]
]
"Created: / 17.2.2000 / 23:49:37 / cg"
"Modified: / 24.2.2000 / 22:53:46 / cg"
! !
!NewSystemBrowser::ProjectList methodsFor:'private'!
defaultSlaveModeValue
|org|
(org := self topApplication initialOrganizerMode) == #project ifTrue:[^ false].
org isNil ifTrue:[^ false].
^ true
!
initialOrganizerMode
^ #project
!
listOfProjects
|allProjects generator|
allProjects := IdentitySet new.
inGeneratorHolder isNil ifTrue:[
(self hideUnloadedClasses value) ifTrue:[
Smalltalk allClassesDo:[:eachClass |
|cls pkg|
eachClass isLoaded ifTrue:[
cls := eachClass theNonMetaclass.
cls isPrivate ifTrue:[
cls := cls topOwningClass
].
pkg := cls package.
pkg withoutSeparators size > 0 ifTrue:[
allProjects add:pkg asSymbol.
] 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.
] ifFalse:[
allProjects := NewSystemBrowser allProjectsIDs.
].
"/ those are simulated - in ST/X, empty projects do not
"/ really exist; however, during browsing, it makes sense.
AdditionalEmptyProjects size > 0 ifTrue:[
"/ remove those that are present ...
AdditionalEmptyProjects := AdditionalEmptyProjects select:[:pkg | (allProjects includes:pkg) not].
allProjects addAll:AdditionalEmptyProjects.
].
] ifFalse:[
generator := inGeneratorHolder value.
generator isNil ifTrue:[^ #() ].
generator do:[:prj | allProjects add:prj].
allProjects := allProjects asOrderedCollection.
].
allProjects sort.
allProjects size == 1 ifTrue:[
"/ self projectLabelHolder value:(allProjects first , ' [Project]').
self projectLabelHolder value:(LabelAndIcon icon:(self class packageIcon) string:allProjects first).
].
allProjects size > 1 ifTrue:[
allProjects addFirst:(self class nameListEntryForALL).
].
^ allProjects
"Created: / 17.2.2000 / 23:43:05 / cg"
"Modified: / 18.8.2000 / 20:26:04 / cg"
!
makeDependent
Smalltalk addDependent:self
"Created: / 17.2.2000 / 23:43:13 / cg"
!
makeIndependent
Smalltalk removeDependent:self.
!
release
super release.
projectList removeDependent:self.
!
updateList
|newList oldSelection newSelection selectedProjectsHolder|
selectedProjectsHolder := self selectedProjects.
oldSelection := selectedProjectsHolder value.
newList := self listOfProjects.
newList ~= projectList value ifTrue:[
"/ oldSelection size > 0 ifTrue:[
"/ selectedProjectsHolder removeDependent:self.
"/ selectedProjectsHolder value:#().
"/ selectedProjectsHolder addDependent:self.
"/ ].
self projectList value:newList.
oldSelection size > 0 ifTrue:[
newSelection := oldSelection select:[:prj | newList includes:prj].
selectedProjectsHolder value:newSelection.
]
].
listValid := true.
"Modified: / 25.2.2000 / 23:10:01 / cg"
! !
!NewSystemBrowser::ProjectList methodsFor:'special'!
addAdditionalProject:aProject
"/ those are simulated - in ST/X, empty categories do not
"/ really exist; however, during browsing, it makes sense.
AdditionalEmptyProjects isNil ifTrue:[
AdditionalEmptyProjects := Set new.
].
AdditionalEmptyProjects add:aProject.
Smalltalk changed:#projectOrganization "/ not really ... to force update
"Created: / 17.2.2000 / 23:44:27 / cg"
!
removeAdditionalProjects:aListOfProjects
"/ those are simulated - in ST/X, empty categories do not
"/ really exist; however, during browsing, it makes sense.
AdditionalEmptyProjects notNil ifTrue:[
aListOfProjects do:[:eachProject |
AdditionalEmptyProjects remove:eachProject ifAbsent:nil.
].
].
Smalltalk changed:#projectOrganization "/ not really ... to force update
"Created: / 17.2.2000 / 23:45:24 / cg"
! !
!NewSystemBrowser::MethodList class methodsFor:'interface specs'!
singleMethodWindowSpec
"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::MethodList andSelector:#singleMethodWindowSpec
NewSystemBrowser::MethodList new openInterface:#singleMethodWindowSpec
"
<resource: #canvas>
^
#(#FullSpec
#name: #singleMethodWindowSpec
#window:
#(#WindowSpec
#label: 'SingleSelectorList'
#name: 'SingleSelectorList'
#min: #(#Point 0 0)
#max: #(#Point 1024 721)
#bounds: #(#Rectangle 12 22 312 322)
)
#component:
#(#SpecCollection
#collection: #(
#(#LabelSpec
#label: 'MethodName'
#name: 'MethodLabel'
#layout: #(#LayoutFrame 0 0.0 0 0 0 1.0 25 0)
#translateLabel: true
#labelChannel: #methodLabelHolder
#menu: #menuHolder
)
)
)
)
"Modified: / 1.3.2000 / 20:50:15 / cg"
!
windowSpec
"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::MethodList andSelector:#windowSpec
NewSystemBrowser::MethodList new openInterface:#windowSpec
NewSystemBrowser::MethodList open
"
<resource: #canvas>
^
#(#FullSpec
#name: #windowSpec
#window:
#(#WindowSpec
#label: 'SelectorList'
#name: 'SelectorList'
#min: #(#Point 0 0)
#max: #(#Point 1024 721)
#bounds: #(#Rectangle 12 22 312 322)
)
#component:
#(#SpecCollection
#collection: #(
#(#SequenceViewSpec
#name: 'List'
#layout: #(#LayoutFrame 0 0.0 0 0.0 0 1.0 0 1.0)
#tabable: true
#model: #selectedMethodNameIndices
#menu: #menuHolder
#hasHorizontalScrollBar: true
#hasVerticalScrollBar: true
#miniScrollerHorizontal: true
#isMultiSelect: true
#valueChangeSelector: #selectionChangedByClick
#useIndex: true
#sequenceList: #browserNameList
#doubleClickChannel: #doubleClickChannel
)
)
)
)
! !
!NewSystemBrowser::MethodList class methodsFor:'plugIn spec'!
aspectSelectors
"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."
"Return a description of exported aspects;
these can be connected to aspects of an embedding application
(if this app is embedded in a subCanvas)."
^ #(
#classHolder
#(#doubleClickChannel #action )
#forceGeneratorTrigger
#immediateUpdate
#inGeneratorHolder
#menuHolder
#methodCategoryHolder
#packageFilter
#selectedMethods
#selectionChangeCondition
#updateTrigger
#variableFilter
#filterClassVars
#showMethodInheritance
#sortBy
).
! !
!NewSystemBrowser::MethodList methodsFor:'aspects'!
browserNameList
browserNameList isNil ifTrue:[
browserNameList := List new.
].
^ browserNameList.
"Modified: / 31.1.2000 / 00:42:44 / cg"
"Created: / 5.2.2000 / 22:38:32 / cg"
!
defaultSlaveModeValue
^ false.
!
filterClassVars
filterClassVars isNil ifTrue:[
filterClassVars := false asValue.
filterClassVars addDependent:self
].
^ filterClassVars
!
filterClassVars:aValueHolder
filterClassVars notNil ifTrue:[
filterClassVars removeDependent:self
].
filterClassVars := aValueHolder.
filterClassVars notNil ifTrue:[
filterClassVars addDependent:self
].
!
methodLabelHolder
^ self pseudoListLabelHolder
"Created: / 1.3.2000 / 20:50:07 / cg"
!
methodList
^ methodList
!
selectedMethodNameIndices
selectedMethodNameIndices isNil ifTrue:[
selectedMethodNameIndices := ValueHolder new.
selectedMethodNameIndices addDependent:self
].
^ selectedMethodNameIndices.
"Modified: / 5.2.2000 / 00:31:48 / cg"
"Created: / 5.2.2000 / 22:59:31 / cg"
!
selectedMethods
^ self selectionHolder
!
selectedMethods:aValueHolder
^ self selectionHolder:aValueHolder
!
showMethodInheritance
showMethodInheritance isNil ifTrue:[
showMethodInheritance := false asValue.
showMethodInheritance addDependent:self
].
^ showMethodInheritance
!
showMethodInheritance:aValueHolder
showMethodInheritance notNil ifTrue:[
showMethodInheritance removeDependent:self
].
showMethodInheritance := aValueHolder.
showMethodInheritance notNil ifTrue:[
showMethodInheritance addDependent:self
].
!
variableFilter
variableFilter isNil ifTrue:[
variableFilter := nil asValue.
variableFilter addDependent:self
].
^ variableFilter
!
variableFilter:aValueHolder
variableFilter notNil ifTrue:[
variableFilter removeDependent:self
].
variableFilter := aValueHolder.
variableFilter notNil ifTrue:[
variableFilter addDependent:self
].
! !
!NewSystemBrowser::MethodList methodsFor:'change & update'!
delayedUpdate:something with:aParameter from:changedObject
|cls sel oldMethod newMethod methods newSelection
selectionHolder selection needSelectionChange|
selectionHolder := self selectedMethods.
selection := selectionHolder value.
changedObject == Smalltalk ifTrue:[
classes notNil ifTrue:[
something == #methodCategory ifTrue:[
"/ ignore here - methodCategoryList will tell me if required
^ self
].
something == #classOrganization ifTrue:[
"/ ignore here - methodCategoryList will tell me if required
^ self
].
something == #methodInClass ifTrue:[
"/ a method has been added/changed
cls := aParameter at:1.
(classes includesIdentical:cls) ifTrue:[
sel := aParameter at:2.
oldMethod := aParameter at:3.
newMethod := cls compiledMethodAt:sel.
(oldMethod notNil and:[newMethod notNil]) ifTrue:[
"a method was changed & acccepted;
No need for a rescan of the methodDictionary;
however, ensure that the refs to the old method are updated
"
methods := selection.
methods size > 0 ifTrue:[
(methods includesIdentical:oldMethod) ifTrue:[
needSelectionChange := true.
]
].
methodList replaceAllIdentical:oldMethod with:newMethod.
lastSelectedMethods notNil ifTrue:[
lastSelectedMethods replaceAllIdentical:oldMethod with:newMethod
].
methods size > 0 ifTrue:[
methods := methods asOrderedCollection.
methods replaceAllIdentical:oldMethod with:newMethod.
].
needSelectionChange == true ifTrue:[
selectionHolder setValue:methods.
selectionHolder changed.
].
(variableFilter value size > 0
or:[oldMethod package ~= newMethod package
or:[oldMethod resources ~= newMethod resources]]) ifTrue:[
"/ only update that methods entry
self updateListEntryFor:newMethod.
"/ sigh - must invalidate
"/ self invalidateList.
].
^ self.
].
"/ method was added - update the methodList
"/ Q: is this needed (methodCategoryList should send me a new inGenerator)
self invalidateList.
].
^ self.
].
something == #methodInClassRemoved ifTrue:[
cls := aParameter at:1.
(classes includesIdentical:cls) ifTrue:[
sel := aParameter at:2.
"/ method was removed - update the methodList
"/ Q: is this needed (methodCategoryList should send me a new inGenerator)
self invalidateList.
].
^ self.
].
something == #methodTrap ifTrue:[
cls := aParameter at:1.
sel := aParameter at:2.
(classes includesIdentical:cls) ifTrue:[
newMethod := cls compiledMethodAt:sel.
newMethod isNil ifTrue:[
self invalidateList.
^ self
].
newMethod isWrapped ifTrue:[
oldMethod := newMethod originalMethod
] ifFalse:[
selection size > 0 ifTrue:[
oldMethod := selection detect:[:each | each isWrapped and:[each originalMethod == newMethod]] ifNone:nil.
]
].
selection size > 0 ifTrue:[
(selection includesIdentical:oldMethod) ifTrue:[
needSelectionChange := true.
]
].
methodList replaceAllIdentical:oldMethod with:newMethod.
lastSelectedMethods notNil ifTrue:[
lastSelectedMethods replaceAllIdentical:oldMethod with:newMethod
].
selection size > 0 ifTrue:[
selection := selection asOrderedCollection.
selection replaceAllIdentical:oldMethod with:newMethod.
].
needSelectionChange == true ifTrue:[
selectionHolder changed.
].
"/ actually, could just change that single item ...
"/ ... might be cheaper, if list is huge.
"/ only update that methods entry
self updateListEntryFor:newMethod.
"/ self invalidateList.
].
^ self
].
something == #projectOrganization ifTrue:[
aParameter notNil ifTrue:[
cls := aParameter at:1.
cls notNil ifTrue:[
((classes includesIdentical:cls theNonMetaclass)
or:[(classes includesIdentical:cls theMetaclass)]) ifTrue:[
self invalidateList.
].
].
] ifFalse:[
self invalidateList.
].
^ self
].
"/ everything else is ignored
"/ self halt.
].
^ self
].
"/ something == #organization ifTrue:[
"/self halt:'no longer'.
"/^ self.
"/ "/ a methods cateory has changed
"/ (classes includesIdentical:changedObject) ifTrue:[
"/ aParameter isSymbol ifTrue:[
"/ "/ a method with a new category
"/ (self methodList includesIdentical:(changedObject compiledMethodAt:aParameter)) ifTrue:[
"/ self invalidateList.
"/ ].
"/ ^ self.
"/ ].
"/ "/ a new category (no method yet)
"/ self invalidateList
"/ ].
"/ ^ self
"/ ].
"/ something == #methodDictionary ifTrue:[
"/self halt:'no longer'.
"/^ self.
"/ "/ a method has been added/removed
"/ (classes includesIdentical:changedObject) ifTrue:[
"/ aParameter isArray ifTrue:[
"/ sel := aParameter at:1.
"/ oldMethod := aParameter at:2.
"/ newMethod := changedObject compiledMethodAt:sel.
"/ oldMethod notNil ifTrue:[
"/ "a method was changed & acccepted;
"/ No need for a rescan of the methodDictionary;
"/ however, ensure that the refs to the old method are updated
"/ "
"/ methods := selection.
"/ methods size > 0 ifTrue:[
"/ (methods includesIdentical:oldMethod) ifTrue:[
"/ needSelectionChange := true.
"/ ]
"/ ].
"/ methodList replaceAllIdentical:oldMethod with:newMethod.
"/ lastSelectedMethods notNil ifTrue:[
"/ lastSelectedMethods replaceAllIdentical:oldMethod with:newMethod
"/ ].
"/ methods size > 0 ifTrue:[
"/ methods := methods asOrderedCollection.
"/ methods replaceAllIdentical:oldMethod with:newMethod.
"/ ].
"/ needSelectionChange == true ifTrue:[
"/ selectionHolder setValue:methods.
"/ selectionHolder changed.
"/ ].
"/ ^ self.
"/ ]
"/ ].
"/ "/ class has changed must update the methodList
"/ self invalidateList.
"/ ].
"/ ^ self.
"/ ].
"/ something == #projectOrganization ifTrue:[
"/ ((classes includesIdentical:changedObject theNonMetaclass)
"/ or:[(classes includesIdentical:changedObject theMetaclass)]) ifTrue:[
"/ self invalidateList.
"/ ].
"/ ^ self
"/ ].
changedObject == sortBy ifTrue:[
listValid ~~ true ifTrue:[ "/ could be nil
inGeneratorHolder value isNil ifTrue:[
"/ ok, no need to react on that one
"/ (will invalidate anyway, once I have more info at hand)
^ self
].
].
self invalidateList.
^ self
].
(changedObject == variableFilter
or:[changedObject == filterClassVars
or:[changedObject == showMethodInheritance]]) ifTrue:[
self invalidateList.
^ self
].
changedObject == selectedMethodNameIndices ifTrue:[
newSelection := self selectedMethodNameIndices value collect:[:idx | methodList at:idx].
newSelection ~= selection ifTrue:[
selectionHolder value:newSelection.
lastSelectedMethods := newSelection.
lastSelectedMethods notNil ifTrue:[
lastSelectedMethods := lastSelectedMethods asOrderedCollection
].
] ifFalse:[
"/ a reselect - force update
"/ selection size == 1 ifTrue:[
selectionHolder setValue:newSelection.
selectionHolder changed:#value.
"/ ].
].
^ self
].
changedObject == selectionHolder ifTrue:[
self selectedMethodsChanged.
lastSelectedMethods := selectionHolder value.
lastSelectedMethods notNil ifTrue:[
lastSelectedMethods := lastSelectedMethods asOrderedCollection
].
^ self
].
"/ something == #methodTrap ifTrue:[
"/self halt:'no longer'.
"/^ self.
"/ (classes includesIdentical:changedObject) ifTrue:[
"/ newMethod := changedObject compiledMethodAt:aParameter.
"/ newMethod isNil ifTrue:[
"/ self invalidateList.
"/ ^ self
"/ ].
"/ newMethod isWrapped ifTrue:[
"/ oldMethod := newMethod originalMethod
"/ ] ifFalse:[
"/ selection size > 0 ifTrue:[
"/ oldMethod := selection detect:[:each | each isWrapped and:[each originalMethod == newMethod]] ifNone:nil.
"/ ]
"/ ].
"/
"/ selection size > 0 ifTrue:[
"/ (selection includesIdentical:oldMethod) ifTrue:[
"/ needSelectionChange := true.
"/ ]
"/ ].
"/"/ methodList replaceAllIdentical:oldMethod with:newMethod.
"/ lastSelectedMethods notNil ifTrue:[
"/ lastSelectedMethods replaceAllIdentical:oldMethod with:newMethod
"/ ].
"/ selection size > 0 ifTrue:[
"/ selection := selection asOrderedCollection.
"/ selection replaceAllIdentical:oldMethod with:newMethod.
"/ ].
"/ needSelectionChange == true ifTrue:[
"/ selectionHolder changed.
"/ ].
"/ self invalidateList.
"/ ^ self
"/ ].
"/ ^ self
"/ ].
super delayedUpdate:something with:aParameter from:changedObject
"Created: / 5.2.2000 / 13:42:14 / cg"
"Modified: / 6.2.2000 / 00:05:26 / cg"
!
selectedMethodsChanged
"the set of selected methods has changed;
update the selection-index collection (for the selectionInListView)"
|indices methods reverseMap
selectedMethodsHolder selectedMethods selectedMethodNameIndicesHolder|
methods := methodList ? #().
methods size == 0 ifTrue:[
"/ this may happen during early startup,
"/ when invoked with a preset methodSelection,
"/ and the methodGenerator has not yet been setup
"/ to not clobber the selection, defer the update
"/ until the methodList arrives ...
^ self
].
selectedMethodsHolder := self selectedMethods.
selectedMethods := selectedMethodsHolder value.
"/ check if all is selected (likely)
((selectedMethods size == methodList size)
and:[selectedMethods = methodList]) ifTrue:[
indices := (1 to:selectedMethods size)
] ifFalse:[
selectedMethods size > 100 ifTrue:[
"/ check if all is selected (likely)
((selectedMethods size == methodList size)
and:[selectedMethods = methodList]) ifTrue:[
indices := (1 to:selectedMethods size)
] ifFalse:[
"/ for big collections, generate a reverse map
reverseMap := IdentityDictionary new.
methods keysAndValuesDo:[:idx :mthd | reverseMap at:mthd put:idx].
indices := selectedMethods collect:[:eachSelectedMethod |
reverseMap at:eachSelectedMethod ifAbsent:0
]
]
] ifFalse:[
indices := (selectedMethods ? #()) collect:[:eachSelectedMethod |
methods identityIndexOf:eachSelectedMethod.
]
].
indices := indices select:[:idx | idx ~= 0].
].
selectedMethodNameIndicesHolder := self selectedMethodNameIndices.
selectedMethodNameIndicesHolder value ~= indices ifTrue:[
selectedMethodNameIndicesHolder value:indices.
]
!
selectionChanged
|methods|
methods := ((self selectedMethodNameIndices value) ? #()) collect:[:idx | methodList at:idx].
methods notEmpty ifTrue:[
lastSelectedMethods := methods asOrderedCollection.
].
"/ to allow reselect, change my valueHolder, even if the same collection
"/ self selectedMethods value ~= methods ifTrue:[
self selectedMethods value:methods
"/ ]
"Created: / 5.2.2000 / 13:42:14 / cg"
"Modified: / 5.2.2000 / 23:32:20 / cg"
!
selectionChangedByClick
"we are not interested in that - get another notification
via the changed valueHolder"
!
update:something with:aParameter from:changedObject
|cls|
"/ some can be ignored immediately
changedObject == Smalltalk ifTrue:[
classes isNil ifTrue:[
^ self.
].
something isNil ifTrue:[
"/ self halt "/ huh - Smalltalk changed - so what ?
^ self.
].
something == #classComment ifTrue:[
^ self.
].
something == #classVariables ifTrue:[
^ self.
].
something == #organization ifTrue:[
^ self.
].
something == #methodCategory ifTrue:[
"/ ignore here - methodCategoryList will tell me if required
^ self
].
something == #classOrganization ifTrue:[
"/ ignore here - methodCategoryList will tell me if required
^ self
].
something == #methodTrap ifTrue:[
cls := aParameter at:1.
(classes includesIdentical:cls) ifFalse:[
^ self
].
].
classAndSelectorsRedefinedBySubclassesOfClass := nil.
something == #classDefinition ifTrue:[
cls := aParameter.
(classes contains:[:aClass | aClass name == cls name]) ifFalse:[
^ self "/ I dont care for that class
].
classes := classes collect:[:eachClass | eachClass isMeta ifTrue:[
(Smalltalk at:eachClass theNonMetaclass name) class
] ifFalse:[
Smalltalk at:eachClass name
]
].
self updateList.
^ self.
].
something == #newClass ifTrue:[
^ self.
].
something == #classRemove ifTrue:[
^ self.
].
something == #classRename ifTrue:[
^ self.
].
].
"/ these must lead to immediate update of the selectedMethods collection
"/ (otherwise, that collection might be updated too late, leading to
"/ an obsolete methods code being shown by the codeView.
something == #methodInClass ifTrue:[
classAndSelectorsRedefinedBySubclassesOfClass := nil.
cls := aParameter at:1.
(classes includesIdentical:cls) ifFalse:[
^ self "/ I dont care for that class
].
self enqueueDelayedUpdate:something with:aParameter from:changedObject.
^ self
].
something == #methodInClassRemoved ifTrue:[
cls := aParameter at:1.
(classes includesIdentical:cls) ifFalse:[
^ self "/ I dont care for that class
].
].
something == #methodTrap ifTrue:[
self window shown ifFalse:[
changedObject removeDependent:self. "/ ?????
^ self
].
cls := aParameter at:1.
(classes includesIdentical:cls) ifFalse:[
^ self "/ I dont care for that class
].
].
super update:something with:aParameter from:changedObject
! !
!NewSystemBrowser::MethodList methodsFor:'private'!
listEntryForMethod:aMethod selector:selector class:cls showClass:showClass showCategory:showCategory classFirst:showClassFirst
"answer a method list entry
gimmics:
adding a little image to breakPointed methods,
inheritance indicators,
highlight accessors of variable"
|clsName s icn variablesToHighlight classVarsToHighLight
doHighLight doHighLightRed emp cat l redefIcon|
aMethod isAssociation ifTrue:[
self halt:'should not happen'.
].
s := aMethod printStringForBrowserWithSelector:selector inClass:cls.
showClassFirst ifTrue:[
clsName := cls nameInBrowser.
s := clsName , ' ' , s allBold
].
"/
"/ wrap icons (i.e. break- or trace points)
"/ have higher prio ...
"/
aMethod isWrapped ifTrue:[
(s endsWith:' !!') ifTrue:[
s := s copyWithoutLast:2
].
aMethod isBreakpointed ifTrue:[
icn := self stopIcon
] ifFalse:[
aMethod isTimed ifTrue:[
icn := self timeIcon
] ifFalse:[
icn := self traceIcon
]
].
].
icn isNil ifTrue:[
icn := self resourceIconForMethod:aMethod.
icn isNil ifTrue:[
aMethod isProtected ifTrue:[
icn := self protectedMethodIcon
] ifFalse:[
aMethod isPrivate ifTrue:[
icn := self privateMethodIcon
] ifFalse:[
(aMethod isJavaMethod and:[aMethod isAbstract]) ifTrue:[
icn := self abstractMethodIcon
]
]
].
].
].
icn isNil ifTrue:[
(selector startsWith:'test') ifTrue:[
((cls isSubclassOf:TestCase)
and:[cls isAbstract not]) ifTrue:[
cls lastTestRunResultOrNil == false ifTrue:[
(cls testSelectorFailed:selector) ifTrue:[
icn := SystemBrowser testCaseFailedIcon
] ifFalse:[
"/ icn := SystemBrowser testCasePassedIcon
].
]
].
]
].
showClass ifTrue:[
showClassFirst ifFalse:[
s := s , ' [' , cls name allBold , ']'.
]
].
showCategory ifTrue:[
cat := aMethod category.
cat notNil ifTrue:[
s := s , ' {' , cat "asText allItalic" , '}'
]
].
variablesToHighlight := variableFilter value.
variablesToHighlight size > 0 ifTrue:[
classVarsToHighLight := filterClassVars value.
classVarsToHighLight ifTrue:[
doHighLight := self method:aMethod includesRefsToClassVariable:variablesToHighlight.
doHighLight ifTrue:[
doHighLightRed := self method:aMethod includesModsOfClassVariable:variablesToHighlight.
].
] ifFalse:[
doHighLight := self method:aMethod includesRefsToInstanceVariable:variablesToHighlight.
doHighLight ifTrue:[
doHighLightRed := self method:aMethod includesModsOfInstanceVariable:variablesToHighlight
]
].
doHighLight ifTrue:[
s := s allBold.
doHighLightRed ifTrue:[
emp := (UserPreferences current emphasisForWrittenVariable)
] ifFalse:[
emp := (UserPreferences current emphasisForReadVariable)
].
s := s emphasisAllAdd:emp
]
].
showMethodInheritance value ~~ false ifTrue:[
redefIcon := self redefinedOrInheritedIconFor:aMethod.
].
(icn notNil or:[redefIcon notNil]) ifTrue:[
l := LabelAndIcon icon:redefIcon string:s.
l image:icn.
l gap:2.
^ l
].
^ s
"Created: / 22.10.1996 / 19:51:00 / cg"
"Modified: / 31.10.2001 / 10:46:50 / cg"
!
listOfMethodNames
|methods entries selectorBag newNameList
allClasses newClasses allCategories "allSelectors" generator
doShowClass doShowClassFirst doShowCategory
enforceClassAndProtocolInList theMethod sortByClass anyMethodToWatch mclass|
generator := inGeneratorHolder value.
generator isNil ifTrue:[^ #() ].
allClasses := IdentitySet new.
allCategories := IdentitySet new. "/ not needed - all I need to know is if there is more than 1 category
"/ allSelectors := Set new.
newClasses := IdentitySet new.
selectorBag := Bag new.
entries := OrderedCollection new.
enforceClassAndProtocolInList := false.
anyMethodToWatch := false.
"/ generator generates nil-selector entries
"/ to pass multiple-class and multiple-protocol info
generator do:[:cls :cat :sel :mthd |
(cls isNil and:[cat isNil and:[sel isNil]])
ifTrue:[
enforceClassAndProtocolInList := true
] ifFalse:[
cls notNil ifTrue:[
allClasses add:cls.
].
cat notNil ifTrue:[
allCategories add:cat.
].
sel notNil ifTrue:[
entries add:(Array with:cls with:sel with:mthd).
selectorBag add:sel.
newClasses add:cls.
"/ allSelectors add:sel.
]
].
(mthd notNil and:[mthd isWrapped]) ifTrue:[
(mthd isTiming
or:[mthd isCounting
or:[mthd isCountingMemoryUsage]])
ifTrue:[
anyMethodToWatch := true
]
].
].
showMethodInheritance value ~~ false ifTrue:[
"/ collect redefinition information once (big speedup for #methodIsRedefinedbelow)
classAndSelectorsRedefinedBySubclassesOfClass isNil ifTrue:[
classAndSelectorsRedefinedBySubclassesOfClass := IdentityDictionary new.
].
allClasses do:[:cls | |d|
d := classAndSelectorsRedefinedBySubclassesOfClass.
(d notNil and:[ (d includesKey:cls) not ]) ifTrue:[
d at:cls put:(self setOfAllSelectorsImplementedBelow:cls)
]
].
].
"/ multiple classes must: add the className for some
doShowClass := enforceClassAndProtocolInList or:[allClasses size > 1].
"/ multiple categories: must add the categorie for some
doShowCategory := enforceClassAndProtocolInList or:[allCategories size > 1].
doShowClassFirst := doShowClass. "/ (doShowClass and:[allSelectors size == 1]).
doShowClassFirst := doShowClass and:[ sortBy value == #class ].
sortBy value == false ifTrue:[
"/ do not sort
] ifFalse:[
(doShowClass not and:[ sortBy value == #class ]) ifTrue:[
"/ multiple classes must add the className for some
"/ check, if doShowClass must be enforced
entries do:[:entry |
|cls sel mthd s needClass|
cls := entry at:1.
sel := entry at:2.
mthd := entry at:3.
doShowClass ifFalse:[
doShowClass := (selectorBag occurrencesOf:sel) > 1
].
].
].
sortByClass := doShowClass and:[ sortBy value == #class ].
sortByClass ifTrue:[
entries sort:[:a :b | |nmA nmB clsNmA clsNmB|
clsNmA := (a at:1) name.
clsNmB := (b at:1) name.
clsNmA = clsNmB ifTrue:[
nmA := (a at:2).
nmB := (b at:2).
nmA < nmB
] ifFalse:[
clsNmA < clsNmB
]
].
] ifFalse:[
entries sort:[:a :b | |nmA nmB clsNmA clsNmB|
nmA := (a at:2).
nmB := (b at:2).
nmA = nmB ifTrue:[
clsNmA := (a at:1) name.
clsNmB := (b at:1) name.
clsNmA < clsNmB
] ifFalse:[
nmA < nmB
]
].
].
].
methods := OrderedCollection new:(entries size).
"/ first generate the new methodList, and see if it is different ...
entries do:[:entry |
|sel mthd|
mthd := entry at:3.
methods add:mthd.
].
false "methodList = methods" "does not care for changed icons" ifTrue:[
"/ same list
newNameList := self browserNameList.
] ifFalse:[
newNameList := OrderedCollection new:(entries size).
"/ multiple classes must add the className for some
entries do:[:entry |
|cls sel mthd s needClass|
cls := entry at:1.
sel := entry at:2.
mthd := entry at:3.
needClass := doShowClass.
"/ needClass ifFalse:[
"/ needClass := (selectorBag occurrencesOf:sel) > 1
"/ ].
s := self
listEntryForMethod:mthd
selector:sel
class:cls
showClass:needClass
showCategory:doShowCategory
classFirst:doShowClassFirst.
"/ s := mthd printStringForBrowserWithSelector:sel inClass:cls.
"/ needClass ifTrue:[
"/ s := s , ' [' , cls name , ']'.
"/ ].
"/ doShowCategory ifTrue:[
"/ s := s , ' {' , mthd category "asText allItalic" , '}'
"/ ].
newNameList add:s.
].
].
self makeIndependent.
classes := newClasses.
self makeDependent.
methodList := methods.
methods size == 1 ifTrue:[
theMethod := methods first.
mclass := theMethod mclass.
mclass isNil ifTrue:[
theMethod isWrapped ifTrue:[
theMethod := theMethod originalMethod.
mclass := theMethod mclass.
].
].
mclass isNil ifTrue:[
self methodLabelHolder value:('???' , ' ' , '???').
] ifFalse:[
self methodLabelHolder value:(mclass name , ' ' , theMethod selector).
]
].
anyMethodToWatch ifTrue:[
self startWatchProcess.
] ifFalse:[
self stopWatchProcess.
].
"/ remember these, in case of an incremental (single method only)
"/ update in the future.
lastShowClass := doShowClass.
lastShowClassFirst := doShowClassFirst.
lastShowCategory := doShowCategory.
^ newNameList.
"Created: / 5.2.2000 / 22:43:40 / cg"
"Modified: / 1.3.2000 / 21:00:26 / cg"
!
makeDependent
Smalltalk addDependent:self.
!
makeIndependent
Smalltalk removeDependent:self.
!
method:mthd includesModsOfClassVariable:variablesToHighLight
^ self method:mthd includesRefsToVariable:variablesToHighLight askParserWith:#modifiedClassVars
!
method:mthd includesModsOfInstanceVariable:variablesToHighLight
^ self method:mthd includesRefsToVariable:variablesToHighLight askParserWith:#modifiedInstVars
!
method:mthd includesRefsToClassVariable:variablesToHighLight
^ self method:mthd includesRefsToVariable:variablesToHighLight askParserWith:#usedClassVars
!
method:mthd includesRefsToInstanceVariable:variablesToHighLight
^ self method:mthd includesRefsToVariable:variablesToHighLight askParserWith:#usedInstVars
!
method:mthd includesRefsToVariable:variablesToHighLight askParserWith:querySelector
|cls src parser usedVars anyVarNameAccessable|
cls := mthd mclass.
anyVarNameAccessable := cls allInstVarNames includesAny:variablesToHighLight.
anyVarNameAccessable ifFalse:[
anyVarNameAccessable := cls theNonMetaclass allClassVarNames includesAny:variablesToHighLight.
].
anyVarNameAccessable ifFalse:[
"/ no need to parse
^ false
].
src := mthd source.
src notNil ifTrue:[
"
before doing a slow parse, quickly scan the
methods source for the variables name ...
"
(variablesToHighLight contains:[:varName | (src findString:varName) ~~ 0]) ifTrue:[
parser := Parser
parseMethod:src
in:cls
ignoreErrors:true
ignoreWarnings:true.
(parser notNil and:[parser ~~ #Error]) ifTrue:[
usedVars := parser perform:querySelector.
(usedVars includesAny:variablesToHighLight)
ifTrue:[
^ true
]
]
]
].
^ false
!
methodIsInheritedFromAbove:aMethod
|mClass|
mClass := aMethod mclass.
(mClass notNil and:[mClass superclass notNil]) ifTrue:[
^ (mClass superclass whichClassImplements:aMethod selector) notNil.
].
^ false
!
methodIsRedefinedBelow:aMethod
|mclass subClasses setOfRedefinedSelectors|
mclass := aMethod mclass.
mclass isNil ifTrue:[^ false].
"/ if possible, make use of info prepared by listOfMethodNames
classAndSelectorsRedefinedBySubclassesOfClass notNil
ifTrue:[
setOfRedefinedSelectors := classAndSelectorsRedefinedBySubclassesOfClass at:mclass ifAbsent:nil.
setOfRedefinedSelectors notNil ifTrue:[
^ setOfRedefinedSelectors includes:aMethod selector
]
].
lastMethodClass == mclass ifTrue:[
subClasses := lastMethodClassesSubclasses
] ifFalse:[
subClasses := aMethod mclass allSubclasses.
lastMethodClassesSubclasses := subClasses.
lastMethodClass := mclass.
].
^ subClasses contains:[:cls | cls implements:aMethod selector].
!
redefinedOrInheritedIconFor:aMethod
|inherited redefined|
inherited := self methodIsInheritedFromAbove:aMethod.
redefined := self methodIsRedefinedBelow:aMethod.
inherited ifTrue:[
redefined ifTrue:[
^ self methodInheritedFromAboveAndRedefinedBelowIcon.
].
^ self methodInheritedFromAboveIcon.
].
redefined ifTrue:[
^ self methodRedefinedBelowIcon.
].
^ self methodEmptyInheritedIcon
!
release
super release.
filterClassVars removeDependent:self.
selectedMethodNameIndices removeDependent:self.
showMethodInheritance removeDependent:self.
variableFilter removeDependent:self.
!
resourceIconForMethod:aMethod
|resources|
(resources := aMethod resources) notNil ifTrue:[
(resources includesKey:#canvas) ifTrue:[
^ self canvasIcon
].
(resources includesKey:#menu) ifTrue:[
^ self menuIcon
].
(resources includesKey:#image) ifTrue:[
^ self imageIcon
].
(resources includesKey:#fileImage) ifTrue:[
^ self fileImageIcon
].
(resources includesKey:#programImage) ifTrue:[
^ self programImageIcon
].
(resources includesKey:#help) ifTrue:[
^ self helpIcon
].
(resources includesKey:#programMenu) ifTrue:[
^ self programMenuIcon
].
(resources includesKey:#tableColumns) ifTrue:[
^ self tableColumnsIcon
].
(resources includesKey:#tabList) ifTrue:[
^ self tabListIcon
].
(resources includesKey:#hierarchicalList) ifTrue:[
^ self hierarchicalListIcon
].
(resources includesKey:#programImage) ifTrue:[
^ self programImageIcon
]
].
^ nil
!
setOfAllSelectorsImplementedBelow:aClass
|set|
set := IdentitySet new.
aClass allSubclassesDo:[:eachSubclass |
set addAll:(eachSubclass methodDictionary keys).
].
^ set
!
updateList
|prevSelection newList newSelection newSelIdx reverseMap sameContents newListSize oldListSize
prevClasses methodSet selectedMethodsHolder|
selectedMethodsHolder := self selectedMethods.
prevSelection := selectedMethodsHolder value ? #().
prevClasses := classes ifNil:[ #() ] ifNotNil:[ classes copy ].
oldListSize := self browserNameList size.
"/ self topApplication withWaitCursorDo:[
newList := self listOfMethodNames.
newListSize := newList size.
sameContents := self updateListFor:newList.
sameContents ifFalse:[
"/ self browserNameList value:newList.
(prevSelection size == 0
and:[selectedMethodsHolder value size ~~ 0]) ifTrue:[
"/ this happens during early startup time,
"/ when the selection is already (pre-)set,
"/ and the methodList is generated the first time
"/ (i.e. when opened with preset selection
"/ do not clobber the selection in this case.
prevSelection := selectedMethodsHolder value.
].
(methodList size == 0 or:[prevSelection size == 0]) ifTrue:[
newSelection := #()
] ifFalse:[
methodSet := methodList.
"/ inclusion test is much faster with sets, if the number of items is large
methodList size > 30 ifTrue:[
"/ however, only if its worth building the set ...
prevSelection size > 5 ifTrue:[
methodSet := methodSet asIdentitySet.
]
].
newSelection := prevSelection select:[:item | methodSet includesIdentical:item].
].
newSelection size > 0 ifTrue:[
newSelection size > 100 ifTrue:[
"/ need selection indices - might be expensive if done straight forward...
reverseMap := IdentityDictionary new.
methodList keysAndValuesDo:[:idx :mthd | reverseMap at:mthd put:idx].
newSelIdx := newSelection collect:[:mthd | reverseMap at:mthd].
] ifFalse:[
newSelIdx := newSelection collect:[:mthd | methodList identityIndexOf:mthd]
].
"/ self halt.
"/ force change (for dependents)
selectedMethodNameIndices value:newSelIdx.
] ifFalse:[
lastSelectedMethods := selectedMethodsHolder value.
lastSelectedMethods notNil ifTrue:[
lastSelectedMethods := lastSelectedMethods asOrderedCollection
].
selectedMethodNameIndices value size > 0 ifTrue:[
selectedMethodNameIndices value:#().
]
].
newSelection ~= prevSelection ifTrue:[
self selectionChanged.
]
] ifTrue:[
"/ same list - but classes might have changed
"/ that is the case, if the class selection has been changed,
"/ to another class which has the same categories.
(prevClasses size ~= classes size
or:[prevClasses asOrderedCollection ~= (classes ? #()) asOrderedCollection ]) ifTrue:[
(newListSize > 0 or:[oldListSize > 0]) ifTrue:[
self selectionChanged.
]
]
]
"/ ].
"Modified: / 18.8.2000 / 19:47:22 / cg"
!
updateListEntryFor:aMethod
"update my list for a single method.
(used when a single methods package, code or whatever changes, and a full udpate
would be too slow)"
|s idx|
s := self
listEntryForMethod:aMethod
selector:aMethod selector
class:aMethod mclass
showClass:lastShowClass
showCategory:lastShowCategory
classFirst:lastShowClassFirst.
idx := methodList identityIndexOf:aMethod.
idx == 0 ifTrue:[
aMethod isWrapped ifTrue:[
idx := methodList identityIndexOf:aMethod originalMethod.
] ifFalse:[
]
].
idx == 0 ifTrue:[
self invalidateList
] ifFalse:[
self browserNameList at:idx put:s.
]
! !
!NewSystemBrowser::MethodList methodsFor:'private-watching'!
startWatchProcess
updateProcess notNil ifTrue:[
^ self
].
updateProcess := [
[true] whileTrue:[
Delay waitForSeconds:1.
self enqueueDelayedUpdateList
]
] fork.
!
stopWatchProcess
|p|
(p := updateProcess) notNil ifTrue:[
updateProcess := nil.
p terminate
].
! !
!NewSystemBrowser::MethodList methodsFor:'setup'!
postBuildWith:aBuilder
|methodListView|
super postBuildWith:aBuilder.
methodListView := aBuilder componentAt:'List'.
methodListView notNil ifTrue:[
methodListView allowDrag:true.
methodListView dragObjectConverter:[:obj |
|nm method idx|
nm := obj theObject asString.
idx := browserNameList value indexOf:nm string.
method := methodList value at:idx.
DropObject newMethod:method.
].
]
! !
!NewSystemBrowser::ImplementingMethodList class methodsFor:'plugIn spec'!
aspectSelectors
"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."
"Return a description of exported aspects;
these can be connected to aspects of an embedding application
(if this app is embedded in a subCanvas)."
^ #(
#classHolder
#(#doubleClickChannel #action )
#forceGeneratorTrigger
#immediateUpdate
#inGeneratorHolder
#outGeneratorHolder
#menuHolder
#methodCategoryHolder
#packageFilter
#selectedMethods
#selectionChangeCondition
#updateTrigger
).
! !
!NewSystemBrowser::ImplementingMethodList methodsFor:'aspects'!
selectedSelectors
selectedSelectors isNil ifTrue:[
selectedSelectors := ValueHolder new.
selectedSelectors addDependent:self
].
^ selectedSelectors.
! !
!NewSystemBrowser::ImplementingMethodList methodsFor:'change & update'!
delayedUpdate:something with:aParameter from:changedObject
changedObject == selectedMethodNameIndices ifTrue:[
"/ self selectedMethods value:(self selectedMethodNameIndices value collect:[:idx | methodList at:idx]).
"/ lastSelectedMethods := self selectedMethods value.
self selectedSelectors value:(self selectedMethodNameIndices value collect:[:idx | selectorList at:idx]).
"/ lastSelectedSelectors := self selectedSelectors value.
^ self
].
changedObject == selectedSelectors ifTrue:[
self updateOutputGenerator.
^ self
].
super delayedUpdate:something with:aParameter from:changedObject
"Created: / 5.2.2000 / 13:42:14 / cg"
"Modified: / 6.2.2000 / 00:05:26 / cg"
!
selectedMethodsChanged
self updateOutputGenerator
!
selectionChanged
self halt:'should not happen'
! !
!NewSystemBrowser::ImplementingMethodList methodsFor:'generators'!
makeGenerator
"return a generator which enumerates the methods from the selected protocol;
that generator generates 4-element elements (includes the class and protocol),
in order to make the consumers only depend on one input
(i.e. to pass multiple-class and multiple-protocol info
without a need for another classHolder/protocolHolder in the methodList)."
^ Iterator on:[:whatToDo |
|selectors items packages|
items := OrderedCollection new.
selectors := self selectedSelectors value ? #().
selectors size > 0 ifTrue:[
packages := packageFilter value value.
selectors do:[:eachSelector |
classes do:[:eachClass | |mthd|
mthd := eachClass compiledMethodAt:eachSelector.
mthd notNil ifTrue:[
(packages isNil
or:[packages includes:mthd package]) ifTrue:[
items add:(Array with:eachClass with:mthd category with:eachSelector with:mthd)
]
]
]
]
].
items sort:[:a :b |
|nm1 nm2 sel1 sel2|
nm1 := (a at:1) name.
nm2 := (b at:1) name.
nm1 < nm2 ifTrue:[ true ]
ifFalse:[
nm1 = nm2 ifFalse:[ false ]
ifTrue:[
sel1 := a at:3.
sel2 := b at:3.
sel1 < sel2
]
]
].
items do:[:eachItem | whatToDo valueWithArguments:eachItem].
]
! !
!NewSystemBrowser::ImplementingMethodList methodsFor:'private'!
listOfMethodNames
|entries selectorsAlready newNameList
newClasses allCategories allSelectors generator
"showCategory" categoryOrCountPerSelector|
generator := inGeneratorHolder value.
generator isNil ifTrue:[^ #() ].
newClasses := IdentitySet new.
selectorsAlready := IdentitySet new.
entries := OrderedCollection new.
allCategories := Set new.
allSelectors := Bag identityNew.
categoryOrCountPerSelector := IdentityDictionary new.
"/ generator generates nil-selector entries
"/ to pass multiple-class and multiple-protocol info
generator do:[:cls :cat :sel :mthd |
|catsAlready|
sel notNil ifTrue:[
(selectorsAlready includes:sel) ifFalse:[
entries add:(Array with:cls with:sel with:mthd).
selectorsAlready add:sel
].
newClasses add:cls.
allCategories add:cat.
allSelectors add:sel.
catsAlready := categoryOrCountPerSelector at:sel ifAbsent:nil.
catsAlready isNil ifTrue:[
categoryOrCountPerSelector at:sel put:cat.
] ifFalse:[
catsAlready isInteger ifTrue:[
categoryOrCountPerSelector at:sel put:(catsAlready + 1).
] ifFalse:[
catsAlready ~= cat ifTrue:[
categoryOrCountPerSelector at:sel put:2.
]
]
]
]
].
entries sort:[:a :b | |nmA nmB clsNmA clsNmB|
nmA := (a at:2).
nmB := (b at:2).
nmA = nmB ifTrue:[
clsNmA := (a at:1) name.
clsNmB := (b at:1) name.
clsNmA < clsNmB
] ifFalse:[
nmA < nmB
]
].
newNameList := OrderedCollection new.
selectorList := OrderedCollection new.
"/ showCategory := allCategories size > 1.
entries do:[:entry |
|cls sel mthd s catOrCounts|
cls := entry at:1.
sel := entry at:2.
mthd := entry at:3.
"/ s := self
"/ listEntryForMethod:mthd
"/ selector:sel
"/ class:cls
"/ showClass:false
"/ showCategory:showCategory
"/ classFirst:false.
"/ newNameList add:s.
selectorList add:sel.
s := sel.
catOrCounts := categoryOrCountPerSelector at:sel.
catOrCounts isInteger ifTrue:[
s := s , ' { ... }' "/ in multiple categories
] ifFalse:[
allCategories size > 1 ifTrue:[
s := s , ' {' , catOrCounts , '}'
]
].
newNameList add:s.
].
classes := newClasses.
^ newNameList.
"Created: / 5.2.2000 / 22:43:40 / cg"
"Modified: / 1.3.2000 / 21:00:26 / cg"
!
release
super release.
selectedSelectors removeDependent:self.
! !
!NewSystemBrowser::InheritanceClassList class methodsFor:'documentation'!
documentation
"
Like a HierarchicalClassList, but shows class inheritance.
For non-meta classes, this is the same as would be shown in
the hierarchy list;
For metaclasses, the tree is extented through the class-behavior
hierarchy.
embeddable application displaying the classes as listed by
the inputGenerator.
Provides an outputGenerator, which enumerates the classes and
their protocols (method-categories) in the selected classes.
[author:]
Claus Gittinger (cg@exept.de)
"
! !
!NewSystemBrowser::InheritanceClassList methodsFor:'change & update'!
delayedUpdate:something with:aParameter from:changedObject
|top oldSelection newSelection showMeta|
self inSlaveModeOrInvisible ifTrue:[^ self].
"/ (self slaveMode value == true) ifTrue:[^ self].
changedObject == slaveMode ifTrue:[
listValid ~~ true ifTrue:[
self enqueueDelayedUpdateList
].
"/ self invalidateList.
^ self
].
changedObject == meta ifTrue:[
oldSelection := self selectedClasses value ? #().
showMeta := meta value.
newSelection := oldSelection collect:[:cls | showMeta ifTrue:[cls theMetaclass] ifFalse:[cls theNonMetaclass]].
newSelection := newSelection asOrderedCollection.
top := self topClassHolder value.
top notNil ifTrue:[
top := showMeta ifTrue:[top theMetaclass] ifFalse:[top theNonMetaclass].
self topClassHolder value:top.
].
self invalidateList.
(newSelection includes:nil) ifTrue:[self halt:'should not happen'].
self selectedClasses value:newSelection.
^ self.
].
super delayedUpdate:something with:aParameter from:changedObject
"Modified: / 24.2.2000 / 15:29:21 / cg"
!
getSelectedClassIndicesFromClasses
|classes selectedClasses selectedIndices|
selectedClasses := self selectedClasses value.
selectedClasses size == 0 ifTrue:[^ #() ].
classes := self classList value.
selectedIndices := selectedClasses
collect:[:aSelectedClass |
classes identityIndexOf:aSelectedClass.
].
selectedIndices := selectedIndices select:[:idx | idx ~~ 0].
selectedIndices size == 0 ifTrue:[
"/ meta value == true ifTrue:[
"/self halt.
"/ ] ifFalse:[
"/self halt.
"/ ]
].
^ selectedIndices
"Created: / 24.2.2000 / 19:48:05 / cg"
"Modified: / 24.2.2000 / 23:30:22 / cg"
!
getSelectedClassesFromIndices
|selected classes allSelected|
allSelected := false.
classes := classList value.
selected := self selectedClassNameIndices value collect:[:idx |
|cls|
cls := classes at:idx.
"/ cls == AllEntry ifTrue:[
"/ allSelected := true.
"/ cls.
"/ ] ifFalse:[
"/ cls notNil ifTrue:[
"/ meta value ifTrue:[
"/ cls := cls theMetaclass
"/ ] ifFalse:[
"/ cls := cls theNonMetaclass
"/ ].
"/ ].
"/ cls
"/ ]
].
"/ allSelected ifTrue:[
"/ selected := classList value select:[:cls | cls ~~ AllEntry].
"/ ].
selected := selected select:[:cls | cls notNil].
^selected.
"Created: / 24.2.2000 / 19:45:04 / cg"
! !
!NewSystemBrowser::InheritanceClassList methodsFor:'private'!
defaultSlaveModeValue
self organizerMode value == #category ifTrue:[^ true].
^ false
!
listOfClasses
|top classes|
(top := self topClassHolder value) isNil ifTrue:[
^ super listOfClasses
].
classes := top withAllSuperclasses copy reverse.
"/ classes addFirst:InheritedEntry.
^ classes
"Modified: / 26.2.2000 / 00:38:48 / cg"
! !
!NewSystemBrowser::FullMethodCategoryList methodsFor:'generators'!
makeGenerator
"return a generator which enumerates the methods from the selected protocol;
that generator generates 4-element elements (includes the class and protocol),
in order to make the consumers only depend on one input
(i.e. to pass multiple-class and multiple-protocol info
without a need for another classHolder/protocolHolder in the methodList)."
^ Iterator on:[:whatToDo |
|protocols all packages theProtocol|
protocols := self selectedProtocols value ? #().
all := protocols includes:(self class nameListEntryForALL).
packages := packageFilter value value.
protocols size > 0 ifTrue:[
protocols size == 1 ifTrue:[
theProtocol := protocols first.
Smalltalk allClassesDo:[:eachClass |
eachClass instAndClassSelectorsAndMethodsDo:[:sel :eachMethod |
|cat|
cat := eachMethod category.
(all
or:[theProtocol = cat]) ifTrue:[
(packages isNil
or:[packages includes:eachMethod package])
ifTrue:[
whatToDo value:eachMethod mclass value:cat value:sel value:eachMethod.
].
].
].
]
] ifFalse:[
Smalltalk allClassesDo:[:eachClass |
eachClass instAndClassSelectorsAndMethodsDo:[:sel :eachMethod |
|cat|
cat := eachMethod category.
(all
or:[protocols includes:cat]) ifTrue:[
(packages isNil
or:[packages includes:eachMethod package])
ifTrue:[
whatToDo value:eachMethod mclass value:cat value:sel value:eachMethod.
].
].
].
]
]
]
]
! !
!NewSystemBrowser::FullMethodCategoryList methodsFor:'private'!
listOfMethodCategories
|categories|
categories := Set new.
"return all existing categories"
Method allInstancesDo:[:eachMethod |
categories add:eachMethod category
].
categories := categories asOrderedCollection sort.
categories addFirst:(self class nameListEntryForALL).
^ categories
! !
!NewSystemBrowser::ImplementingClassList methodsFor:'private'!
listOfMethodNames
|methods entries newNameList
allCategories classUses allSelectors generator
"theMethod"|
generator := inGeneratorHolder value.
generator isNil ifTrue:[^ #() ].
classUses := Bag identityNew.
allSelectors := IdentitySet new.
allCategories := Set new.
entries := OrderedCollection new.
"/ generator generates nil-selector entries
"/ to pass multiple-class and multiple-protocol info
generator do:[:cls :cat :sel :mthd |
sel notNil ifTrue:[
entries add:(Array with:cls with:sel with:mthd).
classUses add:cls.
allSelectors add:sel.
allCategories add:mthd category.
]
].
entries sort:[:a :b | |clsNmA clsNmB|
clsNmA := (a at:1) name.
clsNmB := (b at:1) name.
clsNmA < clsNmB
].
newNameList := entries collect:[:entry |
|class nm|
class := (entry at:1).
nm := class name.
((allSelectors size > 1)
or:[(classUses occurrencesOf:class) > 1]) ifTrue:[
nm := nm , ' ' , (entry at:2)
].
allCategories size > 1 ifTrue:[
nm := nm , ' {' , (entry at:3) category , '}'
].
"/ class name , ' ' , (entry at:2)
nm
].
methods := entries collect:[:entry | (entry at:3)].
methodList := methods.
"/ methods size == 1 ifTrue:[
"/ theMethod := methods first.
"/ self methodLabelHolder value:(theMethod mclass name , ' ' , theMethod selector).
"/ ].
^ newNameList.
"Created: / 5.2.2000 / 22:43:40 / cg"
"Modified: / 1.3.2000 / 21:00:26 / cg"
! !
!NewSystemBrowser::NamespaceList class methodsFor:'interface specs'!
singleNameSpaceWindowSpec
"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::ClassCategoryList andSelector:#singleCategoryWindowSpec
NewSystemBrowser::ClassCategoryList new openInterface:#singleCategoryWindowSpec
"
<resource: #canvas>
^
#(#FullSpec
#name: #singleNameSpaceWindowSpec
#window:
#(#WindowSpec
#label: 'NameSpaceList'
#name: 'NameSpaceList'
#min: #(#Point 0 0)
#max: #(#Point 1024 721)
#bounds: #(#Rectangle 218 175 518 475)
)
#component:
#(#SpecCollection
#collection: #(
#(#LabelSpec
#label: 'NameSpaceName'
#name: 'NameSpaceLabel'
#layout: #(#LayoutFrame 0 0.0 0 0 0 1.0 25 0)
#translateLabel: true
#labelChannel: #nameSpaceLabelHolder
#menu: #menuHolder
)
)
)
)
!
singleNamespaceWindowSpec
"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::ClassCategoryList andSelector:#singleCategoryWindowSpec
NewSystemBrowser::ClassCategoryList new openInterface:#singleCategoryWindowSpec
"
<resource: #canvas>
^
#(#FullSpec
#name: #singleNamespaceWindowSpec
#window:
#(#WindowSpec
#label: 'NamespaceList'
#name: 'NamespaceList'
#min: #(#Point 0 0)
#max: #(#Point 1024 721)
#bounds: #(#Rectangle 218 175 518 475)
)
#component:
#(#SpecCollection
#collection: #(
#(#LabelSpec
#label: 'NamespaceName'
#name: 'NamespaceLabel'
#layout: #(#LayoutFrame 0 0.0 0 0 0 1.0 25 0)
#translateLabel: true
#labelChannel: #nameSpaceLabelHolder
#menu: #menuHolder
)
)
)
)
!
windowSpec
"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::ProjectList andSelector:#windowSpec
NewSystemBrowser::ProjectList new openInterface:#windowSpec
NewSystemBrowser::ProjectList open
"
<resource: #canvas>
^
#(#FullSpec
#name: #windowSpec
#window:
#(#WindowSpec
#label: 'NamespaceList'
#name: 'NamespaceList'
#min: #(#Point 0 0)
#max: #(#Point 1024 721)
#bounds: #(#Rectangle 13 23 313 323)
)
#component:
#(#SpecCollection
#collection: #(
#(#SequenceViewSpec
#name: 'List'
#layout: #(#LayoutFrame 0 0.0 0 0.0 0 1.0 0 1.0)
#tabable: true
#model: #selectedNamespaces
#menu: #menuHolder
#hasHorizontalScrollBar: true
#hasVerticalScrollBar: true
#miniScrollerHorizontal: true
#isMultiSelect: true
#valueChangeSelector: #selectionChangedByClick
#useIndex: false
#sequenceList: #nameSpaceList
#doubleClickChannel: #doubleClickChannel
)
)
)
)
"Created: / 18.2.2000 / 01:06:05 / cg"
"Modified: / 18.2.2000 / 01:24:50 / cg"
! !
!NewSystemBrowser::NamespaceList class methodsFor:'queries-plugin'!
aspectSelectors
^ #(
#(#doubleClickChannel #action )
immediateUpdate
selectedNamespaces
menuHolder
inGeneratorHolder
outGeneratorHolder
selectionChangeCondition
updateTrigger
forceGeneratorTrigger
hideUnloadedClasses
organizerMode
slaveMode
)
"Created: / 18.2.2000 / 01:06:27 / cg"
"Modified: / 25.2.2000 / 22:32:20 / cg"
! !
!NewSystemBrowser::NamespaceList methodsFor:'aspects'!
nameSpaceLabelHolder
^ self pseudoListLabelHolder
!
nameSpaceList
namespaceList isNil ifTrue:[
namespaceList := ValueHolder new
].
^ namespaceList
"Created: / 18.2.2000 / 00:59:01 / cg"
!
selectedNamespaces
^ self selectionHolder
!
selectedNamespaces:aValueHolder
^ self selectionHolder:aValueHolder
! !
!NewSystemBrowser::NamespaceList methodsFor:'change & update'!
delayedUpdate:something with:aParameter from:changedObject
self inSlaveModeOrInvisible
ifTrue:[
changedObject == Smalltalk ifTrue:[
something == #classComment ifTrue:[^ self].
].
self invalidateList.
^ self
].
changedObject == slaveMode ifTrue:[
listValid ~~ true ifTrue:[
self enqueueDelayedUpdateList
].
"/ self invalidateList.
^ self
].
changedObject == Smalltalk ifTrue:[
something == #newClass ifTrue:[
listValid == true ifTrue:[
aParameter isNameSpace ifTrue:[
(namespaceList value includes:aParameter name) ifFalse:[
self invalidateList.
]
].
].
^ self
].
something == #classRemove ifTrue:[
listValid == true ifTrue:[
aParameter isNameSpace ifTrue:[
self invalidateList.
].
].
^ self
].
^ self
].
super delayedUpdate:something with:aParameter from:changedObject
"Created: / 18.2.2000 / 01:00:07 / cg"
"Modified: / 26.2.2000 / 01:10:46 / cg"
!
selectionChangedByClick
"we are not interested in that - get another notification
via the changed valueHolder"
"Created: / 18.2.2000 / 01:00:14 / cg"
!
update:something with:aParameter from:changedObject
changedObject == Smalltalk ifTrue:[
something == #methodDictionary ifTrue:[
^ self
].
something == #methodTrap ifTrue:[
^ self
].
something == #methodInClass ifTrue:[
^ self
].
something == #classVariables ifTrue:[
^ self
].
something == #classComment ifTrue:[
^ self.
].
something == #methodInClassRemoved ifTrue:[
^ self.
].
].
super update:something with:aParameter from:changedObject
! !
!NewSystemBrowser::NamespaceList methodsFor:'generators'!
makeGenerator
"return a generator which enumerates the classes from the selected namespace(s)."
|spaceNames hideUnloadedClasses|
spaceNames := self selectedNamespaces value.
spaceNames size == 0 ifTrue:[
^ #()
].
hideUnloadedClasses := self hideUnloadedClasses value.
(spaceNames includes:(self class nameListEntryForALL)) ifTrue:[
hideUnloadedClasses ifTrue:[
^ Iterator on:[:whatToDo |
Smalltalk allClassesDo:[:cls |
cls isLoaded ifTrue:[
cls isNameSpace ifFalse:[
whatToDo value:cls
]
]
]
]
].
^ Iterator on:[:whatToDo |
Smalltalk allClassesDo:whatToDo
]
].
(spaceNames size == 1
and:[spaceNames first = 'Smalltalk']) ifTrue:[
"/ somewhat tuned - quick look if classes name
"/ includes colons ...
^ Iterator on:[:whatToDo |
Smalltalk allClassesDo:[:cls |
|includeIt|
includeIt := (cls name includes:$:) not.
includeIt := includeIt
or:[(cls isPrivate not
and:[(cls nameSpace == Smalltalk)])].
includeIt := includeIt
or:[(cls isPrivate
and:[(cls topOwningClass nameSpace == Smalltalk)])].
includeIt := includeIt
and:[hideUnloadedClasses not
or:[cls isLoaded]].
includeIt ifTrue:[
cls isNameSpace ifFalse:[
whatToDo value:cls
]
]
]
]
].
^ Iterator on:[:whatToDo |
Smalltalk allClassesDo:[:cls |
|spaceOfClass spaceNameOfClass includeIt|
spaceOfClass := cls isPrivate ifTrue:[cls topOwningClass nameSpace] ifFalse:[cls nameSpace].
spaceNameOfClass := spaceOfClass name.
includeIt := spaceNames contains:[:nm | nm = spaceNameOfClass
or:[spaceNameOfClass startsWith:(nm , '::')]].
hideUnloadedClasses ifTrue:[
includeIt := includeIt and:[cls isLoaded].
].
includeIt ifTrue:[
cls isNameSpace ifFalse:[
whatToDo value:cls
]
]
]
]
"Created: / 18.2.2000 / 01:01:58 / cg"
"Modified: / 24.2.2000 / 13:42:58 / cg"
! !
!NewSystemBrowser::NamespaceList methodsFor:'private'!
defaultSlaveModeValue
self topApplication initialOrganizerMode == #namespace ifTrue:[^ false].
"/ self organizerMode value == #category ifTrue:[^ true].
"/ ^ false
^ true
!
initialOrganizerMode
^ #namespace
!
listOfNamespaces
|allNamespaces showAllNamespaces generator|
showAllNamespaces := false.
allNamespaces := IdentitySet new.
inGeneratorHolder isNil ifTrue:[
(self hideUnloadedClasses value) ifTrue:[
Smalltalk allClassesDo:[:eachClass |
eachClass isLoaded ifTrue:[
allNamespaces add:(eachClass theNonMetaclass topNameSpace)
].
]
] ifFalse:[
allNamespaces := NameSpace allNamespaces.
].
showAllNamespaces ifFalse:[
"/ only topLevel namespaces are shown
"/ i.e. ignore subspaces
allNamespaces := allNamespaces select:[:ns | ns isTopLevelNameSpace].
].
allNamespaces := allNamespaces collect:[:ns | ns name].
] ifFalse:[
generator := inGeneratorHolder value.
generator isNil ifTrue:[^ #() ].
generator do:[:ns | allNamespaces add:ns].
].
allNamespaces := allNamespaces asOrderedCollection.
allNamespaces sort.
allNamespaces size == 1 ifTrue:[
self nameSpaceLabelHolder value:(LabelAndIcon icon:(self class nameSpaceIcon) string:allNamespaces first).
].
allNamespaces addFirst:(self class nameListEntryForALL).
^ allNamespaces
"Created: / 18.2.2000 / 01:04:27 / cg"
"Modified: / 25.2.2000 / 22:11:29 / cg"
!
makeDependent
Smalltalk addDependent:self
"Created: / 18.2.2000 / 01:04:36 / cg"
!
makeIndependent
Smalltalk removeDependent:self.
"Created: / 18.2.2000 / 01:04:42 / cg"
!
updateList
|newList oldSelection newSelection selectedNamespacesHolder|
selectedNamespacesHolder := self selectedNamespaces.
oldSelection := selectedNamespacesHolder value.
newList := self listOfNamespaces.
newList ~= namespaceList value ifTrue:[
"/ oldSelection size > 0 ifTrue:[
"/ selectedNamespacesHolder removeDependent:self.
"/ selectedNamespacesHolder value:#().
"/ selectedNamespacesHolder addDependent:self.
"/ ].
self nameSpaceList value:newList.
oldSelection size > 0 ifTrue:[
newSelection := oldSelection select:[:nm |
(nm = self class nameListEntryForALL)
or:[ (Smalltalk at:nm asSymbol) isNameSpace]
].
newSelection ~= oldSelection ifTrue:[
selectedNamespacesHolder value:newSelection.
]
]
].
listValid := true.
! !
!NewSystemBrowser::NavigationState methodsFor:'accessing'!
autoSearchAction
^ autoSearchAction
!
autoSearchAction:something
autoSearchAction := something.
!
autoSearchIgnoreCase
"return true if the autSearch is to be case-insensitive"
^ autoSearchIgnoreCase
!
autoSearchIgnoreCase:aBoolean
"change the autSearches case-insensitivenes"
autoSearchIgnoreCase := aBoolean
!
autoSearchPattern
"return the automatic search pattern"
^ autoSearchPattern
!
autoSearchPattern:aPattern
"change the automatic search pattern"
autoSearchPattern := aPattern.
!
browserLabel
"return the assigned state-label (to be shown in the tab)."
^ browserLabel
!
browserLabel:aString
"set the assigned state-label (to be shown in the tab)."
browserLabel := aString
!
canvas
"return the value of the instance variable 'canvas' (automatically generated)"
^ canvas
!
canvas:something
"set the value of the instance variable 'canvas' (automatically generated)"
canvas := something.
canvasType isNil ifTrue:[
canvasType := something spec
].
!
canvasType
"return the type of canvas"
^ canvasType
!
canvasType:aSpecSymbol
"set the type of canvas"
canvasType notNil ifTrue:[
canvasType ~~ aSpecSymbol ifTrue:[
self halt:'cannot be changed, once set'.
]
].
canvasType := aSpecSymbol
!
codeAspect
"return the codeAspect; a symbol describing what is shown in the codeView"
^ codeAspect
"Created: / 11.2.2000 / 12:43:29 / cg"
!
codeAspect:aSymbolOrNil
"set the codeAspect; a symbol describing what is shown in the codeView"
codeAspect := aSymbolOrNil
"Created: / 11.2.2000 / 12:43:45 / cg"
!
codeView
|builder v|
canvas notNil ifTrue:[
builder := canvas builder.
builder notNil ifTrue:[
v := builder componentAt:#CodeView.
v notNil ifTrue:[
^ v scrolledView
].
]
].
^ nil
"Created: / 11.2.2000 / 13:28:25 / cg"
!
environment
^ Smalltalk
!
modified
"check for modified code by asking the editTextView;
this one returns true if ever modified - even if
the modifiecations where undone in the editor
(i.e. not really modified).
Use #reallyModified if the contents should be compared
against the original contents"
|codeView|
realModifiedState == true ifTrue:[^ true].
^ (codeView := self codeView) notNil
and:[codeView modified]
!
modified:aBoolean
|codeView|
(codeView := self codeView) notNil ifTrue:[
codeView modified:aBoolean
].
!
realModifiedState
^ realModifiedState
!
realModifiedState:aBoolean
realModifiedState := aBoolean
! !
!NewSystemBrowser::NavigationState methodsFor:'accessing-selection'!
theSingleSelectedClass
"if only one class is selected, return it.
Otherwise, return nil"
|classes|
classes := self selectedClasses value.
classes size == 1 ifTrue:[
^ classes first
].
^ nil
!
theSingleSelectedMethod
"if only one method is selected, return it.
Otherwise, return nil"
|methods|
methods := self selectedMethods value.
methods size == 1 ifTrue:[
^ methods first
].
^ nil
! !
!NewSystemBrowser::NavigationState methodsFor:'accessing-subApps'!
applicationOfComponent:aComponentName
^ self applicationOfComponent:aComponentName or:nil
!
applicationOfComponent:aComponentName or:anotherComponentName
|builder view|
builder := canvas builder.
view := builder findComponentAt:aComponentName.
(view isNil and:[anotherComponentName notNil]) ifTrue:[
view := builder findComponentAt:anotherComponentName.
].
view notNil ifTrue:[
^ view application
].
^ nil
!
classCategoryListApplication
^ self applicationOfComponent:#ClassCategoryList
!
classListApplication
^ self applicationOfComponent:#ClassList
!
metaToggleComponent
^ canvas builder findComponentAt:#ClassToggle.
!
methodCategoryListApplication
^ self applicationOfComponent:#MethodCategoryList
!
methodListApplication
^ self applicationOfComponent:#MethodList
!
nameSpaceListApplication
^ self applicationOfComponent:#NamespaceList or:#PseudoNamespaceList
!
projectListApplication
^ self applicationOfComponent:#ProjectList or:#PseudoProjectList
!
variableListApplication
^ self applicationOfComponent:#VariableList
!
versionDiffApplication
^ versionDiffApplication
!
versionDiffApplication:anApplication
versionDiffApplication := anApplication
! !
!NewSystemBrowser::NavigationState methodsFor:'aspects'!
categoryList
categoryList isNil ifTrue:[
categoryList := nil asValue.
].
^ categoryList
"Modified: / 25.2.2000 / 01:35:42 / cg"
"Created: / 25.2.2000 / 01:57:45 / cg"
!
categoryListGenerator
categoryListGenerator isNil ifTrue:[
categoryListGenerator := nil asValue.
].
^ categoryListGenerator
"Created: / 25.2.2000 / 01:34:30 / cg"
"Modified: / 25.2.2000 / 01:35:42 / cg"
!
classDocumentationHolder
classDocumentationHolder isNil ifTrue:[
classDocumentationHolder := nil asValue.
].
^ classDocumentationHolder
!
classHierarchyTopClass
classHierarchyTopClass isNil ifTrue:[
classHierarchyTopClass := nil asValue.
].
^ classHierarchyTopClass
!
classList
classList isNil ifTrue:[
classList := nil asValue.
].
^ classList
"Created: / 25.2.2000 / 01:57:28 / cg"
!
classListGenerator
classListGenerator isNil ifTrue:[
classListGenerator := nil asValue.
].
^ classListGenerator
!
classListPerNameSpaceGenerator
classListPerNameSpaceGenerator isNil ifTrue:[
classListPerNameSpaceGenerator := nil asValue.
].
^ classListPerNameSpaceGenerator
"Created: / 18.8.2000 / 14:15:34 / cg"
!
codeHolder
codeHolder isNil ifTrue:[
codeHolder := nil asValue.
].
^ codeHolder
!
codeModifiedHolder
codeModifiedHolder isNil ifTrue:[
codeModifiedHolder := false asValue.
].
^ codeModifiedHolder
!
cursorColLabelHolder
cursorColLabelHolder isNil ifTrue:[
cursorColLabelHolder := BlockValue
with:[:v | v printString]
argument:self codeView cursorColHolder.
].
^ cursorColLabelHolder
!
cursorLineLabelHolder
cursorLineLabelHolder isNil ifTrue:[
cursorLineLabelHolder := BlockValue
with:[:v | v printString]
argument:self codeView cursorLineHolder.
].
^ cursorLineLabelHolder
!
filterClassVars
filterClassVars isNil ifTrue:[
filterClassVars := false asValue.
].
^ filterClassVars
"Created: / 24.2.2000 / 23:45:28 / cg"
!
hidePrivateClasses
hidePrivateClasses isNil ifTrue:[
hidePrivateClasses := false asValue.
].
^ hidePrivateClasses
"Created: / 24.2.2000 / 16:17:02 / cg"
!
infoLabelHolder
infoLabelHolder isNil ifTrue:[
infoLabelHolder := '' asValue.
].
^ infoLabelHolder
!
meta
meta isNil ifTrue:[
meta := false asValue.
].
^ meta
!
metaToggleLabelHolder
metaToggleLabel isNil ifTrue:[
metaToggleLabel := 'Class' asValue.
].
^ metaToggleLabel
!
methodInfo
methodInfo isNil ifTrue:[
methodInfo := nil asValue.
].
^ methodInfo
!
methodList
|methodListApplication|
methodListApplication := self methodListApplication.
methodListApplication isNil ifTrue:[^ nil].
^ methodListApplication methodList
!
modeLabelHolder
modeLabelHolder isNil ifTrue:[
modeLabelHolder := self codeView modeLabelHolder.
].
^ modeLabelHolder
!
nameSpaceFilter
nameSpaceFilter isNil ifTrue:[
nameSpaceFilter := nil asValue.
].
^ nameSpaceFilter
"Created: / 18.8.2000 / 14:25:24 / cg"
!
nameSpaceListGenerator
nameSpaceListGenerator isNil ifTrue:[
nameSpaceListGenerator := nil asValue.
].
^ nameSpaceListGenerator
"Created: / 18.8.2000 / 14:26:19 / cg"
"Modified: / 18.8.2000 / 14:27:59 / cg"
!
noAllItem
noAllItem isNil ifTrue:[
noAllItem := nil asValue.
].
^ noAllItem
!
organizerMode
"return the organizerMode holder;
holding a symbol describing how things are organized
(#category, #hierarchy, #project or #namespace)"
organizerMode isNil ifTrue:[
organizerMode := #category asValue.
].
^ organizerMode
"Created: / 18.2.2000 / 13:33:55 / cg"
"Modified: / 18.8.2000 / 18:37:22 / cg"
!
packageFilter
packageFilter isNil ifTrue:[
packageFilter := nil asValue.
].
^ packageFilter
"Created: / 24.2.2000 / 23:45:28 / cg"
!
packageLabelHolder
packageLabelHolder isNil ifTrue:[
packageLabelHolder := '' asValue.
].
^ packageLabelHolder
!
projectListGenerator
projectListGenerator isNil ifTrue:[
projectListGenerator := nil asValue.
].
^ projectListGenerator
"Modified: / 25.2.2000 / 01:35:42 / cg"
"Created: / 25.2.2000 / 02:43:26 / cg"
!
protocolListGenerator
protocolListGenerator isNil ifTrue:[
protocolListGenerator := nil asValue.
].
^ protocolListGenerator
!
selectedCategories
selectedCategories isNil ifTrue:[
selectedCategories := nil asValue.
].
^ selectedCategories
!
selectedClasses
selectedClasses isNil ifTrue:[
selectedClasses := "SpecialValueHolder with:nil." nil asValue.
].
^ selectedClasses
!
selectedMethods
selectedMethods isNil ifTrue:[
selectedMethods := nil asValue.
].
^ selectedMethods
!
selectedMethodsArrayAt:index
|holder|
selectedMethodsArray isNil ifTrue:[
selectedMethodsArray := OrderedCollection new
].
index > selectedMethodsArray size ifTrue:[
selectedMethodsArray grow:index
].
holder := selectedMethodsArray at:index.
holder isNil ifTrue:[
selectedMethodsArray at:index put:(holder := ValueHolder new)
].
^ holder.
!
selectedNamespaces
selectedNamespaces isNil ifTrue:[
selectedNamespaces := nil asValue.
].
^ selectedNamespaces
!
selectedProjects
selectedProjects isNil ifTrue:[
selectedProjects := nil asValue.
].
^ selectedProjects
!
selectedProtocols
selectedProtocols isNil ifTrue:[
selectedProtocols := nil asValue.
].
^ selectedProtocols
!
selectorListGenerator
selectorListGenerator isNil ifTrue:[
selectorListGenerator := nil asValue.
].
^ selectorListGenerator
!
selectorListGeneratorArray
self halt:'should not be invoked'.
!
selectorListGeneratorArrayAt:index
|holder|
selectorListGeneratorArray isNil ifTrue:[
selectorListGeneratorArray := OrderedCollection new
].
index > selectorListGeneratorArray size ifTrue:[
selectorListGeneratorArray grow:index
].
holder := selectorListGeneratorArray at:index.
holder isNil ifTrue:[
selectorListGeneratorArray at:index put:(holder := ValueHolder new)
].
^ holder.
!
sortBy
sortBy isNil ifTrue:[
sortBy := nil asValue.
].
^ sortBy
!
variableFilter
variableFilter isNil ifTrue:[
variableFilter := nil asValue.
].
^ variableFilter
"Created: / 24.2.2000 / 23:45:28 / cg"
! !
!NewSystemBrowser::NavigationState methodsFor:'aspects-kludges'!
metaToggle
metaToggle isNil ifTrue:[
metaToggle := PluggableAdaptor on:(self meta).
metaToggle
getBlock:[:m | m value == true]
putBlock:[:m :newValue | m value:(newValue ? false)]
updateBlock:[:m :aspect :param | true].
].
^ metaToggle
!
notMetaToggle
notMetaToggle isNil ifTrue:[
notMetaToggle := PluggableAdaptor on:(self meta).
notMetaToggle
getBlock:[:m | m value == false]
putBlock:[:m :newValue | m value:(newValue ? false) not]
updateBlock:[:m :aspect :param | true].
].
^ notMetaToggle
! !
!NewSystemBrowser::NavigationState methodsFor:'printing & storing'!
colorizeForModifiedBuffer:someString
^ someString asText emphasisAllAdd:(UserPreferences current emphasisForModifiedBuffer)
!
nameString
"a descriptive string of what this state shows"
|s|
s := self rawNameStringOrNil ? 'nothing selected'.
(realModifiedState == true) ifTrue:[
^ self colorizeForModifiedBuffer:s string
].
^ s
!
nameStringOrNil
"a descriptive string of what this state shows"
|s "codeView"|
s := self rawNameStringOrNil.
s notNil ifTrue:[
realModifiedState == true
"/ ((codeView := self codeView) notNil
"/ and:[codeView modified])
ifTrue:[
^ self colorizeForModifiedBuffer:s string
].
].
^ s
!
rawNameStringForCategory
|categories theCategory|
categories := self selectedCategories value.
categories size == 1 ifTrue:[
theCategory := categories first.
theCategory notNil ifTrue:[
^ theCategory string, ' [Category]'
].
].
^ nil
"Created: / 18.8.2000 / 19:42:42 / cg"
!
rawNameStringForNameSpace
|namespaces theNamespace nsName s|
namespaces := self selectedNamespaces value.
namespaces size == 1 ifTrue:[
theNamespace := namespaces first
].
theNamespace notNil ifTrue:[
theNamespace isNameSpace ifTrue:[
nsName := theNamespace name
] ifFalse:[
nsName := theNamespace
].
s := nsName , ' [NameSpace]'.
(self isNameSpaceBrowser or:[self isNameSpaceFullBrowser]) ifTrue:[
^ LabelAndIcon icon:(NewSystemBrowser nameSpaceIcon) string:s.
].
^ s
].
^ nil
"Created: / 18.8.2000 / 20:15:02 / cg"
!
rawNameStringForProject
|projects theProject s|
projects := self selectedProjects value.
projects size == 1 ifTrue:[
theProject := projects first
].
theProject notNil ifTrue:[
s := theProject , ' [Project]'.
(self isProjectBrowser or:[self isProjectFullBrowser]) ifTrue:[
^ LabelAndIcon icon:(NewSystemBrowser packageIcon) string:s.
].
^ s
].
^ nil
"Created: / 18.8.2000 / 20:18:34 / cg"
!
rawNameStringOrNil
"a descriptive string of what this state shows; nil, if nothing is selected"
^ self rawNameStringOrNilWantShort:false
!
rawNameStringOrNilWantShort:shortName
"a descriptive string of what this state shows; nil, if nothing is selected"
|lbl nr numClasses numMethods numCategories cats classes theClass
"protocols theProtocol"
methods theSingleMethod projects theProject longName nm methodName suffix cls|
browserLabel notNil ifTrue:[
"/ add the number of selected methods
((canvasType == #singleFullProtocolBrowserSpec)
or:[canvasType == #methodListBrowserSpec]) ifTrue:[
nr := self selectedMethods value size.
nr > 5 ifTrue:[
^ browserLabel string , ' - ' , nr printString , ' methods'
].
].
^ browserLabel
].
suffix := ''.
self isProtocolOrFullProtocolBrowser ifTrue:[
lbl := self rawNameStringForProject.
lbl notNil ifTrue:[^ lbl].
suffix := ' [Protocol]'.
].
self isCategoryBrowser ifTrue:[
lbl := self rawNameStringForCategory.
lbl notNil ifTrue:[^ lbl].
suffix := ' [Category]'.
].
self isNameSpaceBrowser ifTrue:[
lbl := self rawNameStringForNameSpace.
lbl notNil ifTrue:[^ lbl].
suffix := ' [NameSpace]'.
].
self isProjectBrowser ifTrue:[
projects := self selectedProjects value.
projects size == 1 ifTrue:[
theProject := projects first
].
suffix := ' [Project]'.
theProject notNil ifTrue:[
^ theProject , suffix
]
].
classes := self selectedClasses value.
classes size == 1 ifTrue:[
theClass := classes first.
theClass notNil ifTrue:[
theClass := theClass theNonMetaclass
]
].
self isClassBrowser ifTrue:[
suffix := ' [Class]'.
theClass notNil ifTrue:[
^ theClass name , suffix
]
].
"/ protocols := self selectedProtocols value.
"/ protocols size == 1 ifTrue:[
"/ theProtocol := protocols first
"/ ].
methods := self selectedMethods value.
methods size == 1 ifTrue:[
theSingleMethod := methods first
].
theSingleMethod notNil ifTrue:[
methodName := theSingleMethod selector.
theSingleMethod isJavaMethod ifTrue:[
methodName := theSingleMethod printStringForBrowserWithSelector:methodName.
].
].
self isMethodBrowser ifTrue:[
suffix := ' [Selector]'.
theSingleMethod notNil ifTrue:[
theSingleMethod mclass isNil ifTrue:[
^ '???'
].
^ theSingleMethod mclass name , ' ' , methodName , suffix
]
].
self isCategoryBrowser ifTrue:[
suffix := ' [Category]'.
] ifFalse:[
self isFullClassSourceBrowser ifTrue:[
suffix := ' [Full]'.
] ifFalse:[
self isClassDocumentationBrowser ifTrue:[
suffix := ' [Doc]'.
] ifFalse:[
self isProjectBrowser ifTrue:[
suffix := ' [Project]'.
]
]
]
].
nm := nil.
(numClasses := classes size) > 0 ifTrue:[
numClasses > 1 ifTrue:[
methods size > 0 ifTrue:[
theSingleMethod notNil ifTrue:[
cls := theSingleMethod mclass.
cls isNil ifTrue:[
"/ oops - unbound
nm := '???'
] ifFalse:[
longName := nm := cls nameInBrowser.
shortName ifTrue:[
nm := cls nameWithoutPrefix.
cls isPrivate ifTrue:[
nm := ':' , nm
]
].
].
nm := nm , ' ', (methodName ? '???')
] ifFalse:[
nm := methods size printString , ' methods'.
numClasses := (methods collect:[:each | each mclass]) asIdentitySet size.
numClasses > 1 ifTrue:[
nm := nm , ' in ' , numClasses printString , ' classes'.
].
].
^ nm , suffix.
].
nm := numClasses printString , ' classes in '.
"/ cats := self selectedCategories value
cats := (classes collect:[:each | each category]) asSet.
(numCategories := cats size) == 1 ifTrue:[
nm := nm , cats first
] ifFalse:[
nm := nm , numCategories printString , ' categories'
]
] ifFalse:[
cls := theClass theNonMetaclass.
longName := nm := cls nameInBrowser.
shortName ifTrue:[
nm := cls nameWithoutPrefix.
cls isPrivate ifTrue:[
nm := ':' , nm
]
].
methods := self selectedMethods value.
(numMethods := methods size) > 0 ifTrue:[
numMethods == 1 ifTrue:[
theSingleMethod := methods first.
nm := nm , ' ', (methodName ? '???')
] ifFalse:[
nm := numMethods printString , ' methods in ' , nm
]
]
]
] ifFalse:[
(self isNameSpaceBrowser
or:[self isNameSpaceFullBrowser
or:[organizerMode value == #namespace]]) ifTrue:[
lbl := self rawNameStringForNameSpace.
lbl notNil ifTrue:[^ lbl].
suffix := ' [NameSpace]'.
] ifFalse:[
(self isProjectBrowser
or:[self isProjectFullBrowser
or:[organizerMode value == #project]]) ifTrue:[
lbl := self rawNameStringForProject.
lbl notNil ifTrue:[^ lbl].
suffix := ' [Project]'.
] ifFalse:[
cats := self selectedCategories value.
cats size == 1 ifTrue:[
nm := cats first string
]
]
].
].
nm isNil ifTrue:[ ^ nil ].
^ nm , suffix.
"Created: / 11.2.2000 / 13:32:16 / cg"
"Modified: / 18.8.2000 / 21:06:35 / cg"
!
shortNameString
"a descriptive string of what this state shows"
|s|
s := (self rawNameStringOrNilWantShort:true) ? 'nothing selected'.
(realModifiedState == true) ifTrue:[
^ self colorizeForModifiedBuffer:s string
].
^ s
! !
!NewSystemBrowser::NavigationState methodsFor:'queries'!
isCategoryBrowser
^ canvasType == #categoryBrowserSpec
or:[ canvasType == #singleCategoryBrowserSpec
or:[ canvasType == #multipleCategoryBrowserSpec ]]
"Modified: / 25.2.2000 / 01:17:02 / cg"
!
isChainBrowser
^ canvasType == #chainBrowserSpec
!
isCheckOutputBrowser
^ canvasType == #multipleClassWithInfoAndMethodWithInfoBrowserSpec
or:[canvasType == #multipleMethodWithInfoBrowserSpec
or:[canvasType == #multipleClassWithInfoBrowserSpec]]
!
isClassBrowser
^ canvasType == #classBrowserSpec
or:[ canvasType == #singleClassBrowserSpec
or:[ canvasType == #multipleClassBrowserSpec ]]
"Modified: / 25.2.2000 / 00:38:07 / cg"
!
isClassDocumentationBrowser
^ canvasType == #classDocumentationBrowserSpec
"Created: / 24.2.2000 / 14:54:40 / cg"
!
isFullBrowser
^ canvasType == #fullBrowserSpec
!
isFullClassSourceBrowser
^ canvasType == #fullClassSourceBrowserSpec
"Created: / 24.2.2000 / 14:54:40 / cg"
!
isFullProtocolBrowser
^ canvasType == #singleFullProtocolBrowserSpec
or:[ canvasType == #multipleFullProtocolBrowserSpec ]
"Created: / 24.2.2000 / 21:32:09 / cg"
"Modified: / 25.2.2000 / 03:11:00 / cg"
!
isMethodBrowser
^ canvasType == #methodListBrowserSpec
or:[ canvasType == #singleMethodBrowserSpec
or:[ canvasType == #multipleMethodBrowserSpec
or:[ canvasType == #multipleMethodWithInfoBrowserSpec ]]]
"Modified: / 1.3.2000 / 13:35:12 / cg"
!
isMethodListBrowser
^ canvasType == #methodListBrowserSpec
or:[canvasType == #multipleMethodBrowserSpec]
!
isNameSpaceBrowser
^ canvasType == #singleNameSpaceBrowserSpec
or:[ canvasType == #multipleNameSpaceBrowserSpec]
"Modified: / 18.8.2000 / 16:12:34 / cg"
!
isNameSpaceFullBrowser
^ canvasType == #singleNameSpaceFullBrowserSpec
or:[ canvasType == #multipleNameSpaceFullBrowserSpec ]
"Created: / 18.8.2000 / 14:58:36 / cg"
!
isProjectBrowser
^ canvasType == #singleProjectBrowserSpec
or:[ canvasType == #multipleProjectBrowserSpec ]
"Created: / 24.2.2000 / 21:32:09 / cg"
"Modified: / 25.2.2000 / 03:11:00 / cg"
!
isProjectFullBrowser
^ canvasType == #singleProjectFullBrowserSpec
or:[ canvasType == #multipleProjectFullBrowserSpec ]
"Created: / 18.8.2000 / 19:02:49 / cg"
!
isProtocolBrowser
^ canvasType == #singleProtocolBrowserSpec
or:[ canvasType == #multipleProtocolBrowserSpec ]
"Created: / 24.2.2000 / 21:32:09 / cg"
"Modified: / 25.2.2000 / 03:11:00 / cg"
!
isProtocolOrFullProtocolBrowser
^ self isProtocolBrowser
or:[ self isFullProtocolBrowser ]
!
isSingleCategoryBrowser
^ canvasType == #singleCategoryBrowserSpec
!
isSingleClassBrowser
^ canvasType == #singleClassBrowserSpec
!
isSingleFullProtocolBrowser
^ canvasType == #singleFullProtocolBrowserSpec
!
isSingleMethodBrowser
^ canvasType == #singleMethodBrowserSpec
"Created: / 1.3.2000 / 13:35:52 / cg"
!
isSingleNamespaceBrowser
^ canvasType == #singleNameSpaceBrowserSpec
!
isSingleNamespaceFullBrowser
^ canvasType == #singleNameSpaceFullBrowserSpec
!
isSingleProjectBrowser
^ canvasType == #singleProjectBrowserSpec
"Created: / 24.2.2000 / 21:32:09 / cg"
"Modified: / 25.2.2000 / 03:11:00 / cg"
!
isSingleProjectFullBrowser
^ canvasType == #singleProjectFullBrowserSpec
"Created: / 24.2.2000 / 21:32:09 / cg"
"Modified: / 25.2.2000 / 03:11:00 / cg"
!
isSingleProtocolBrowser
^ canvasType == #singleProtocolBrowserSpec
!
isVersionDiffBrowser
^ canvasType == #multipleClassRepositoryDiffBrowserSpec
! !
!NewSystemBrowser::NavigatorCanvas class methodsFor:'interface specs'!
categoryAndClassOnlySpec
"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::NavigatorCanvas andSelector:#categoryAndClassOnlySpec
NewSystemBrowser::NavigatorCanvas new openInterface:#categoryAndClassOnlySpec
"
<resource: #canvas>
^
#(#FullSpec
#name: #fullClassSourceBrowserSpec
#window:
#(#WindowSpec
#label: 'Full Class Browser'
#name: 'Full Class Browser'
#min: #(#Point 0 0)
#bounds: #(#Rectangle 18 51 480 351)
)
#component:
#(#SpecCollection
#collection: #(
#(#SubCanvasSpec
#name: 'Organizer'
#layout: #(#LayoutFrame 0 0.0 0 0.0 0 1.0 0 1.0)
#majorKey: #'NewSystemBrowser::OrganizerCanvas'
#minorKey: #windowSpecWithoutMetaToggles
#subAspectHolders:
#(#Array
#(#SubChannelInfoSpec
#subAspect: #classCategoryListMenuHolder
#aspect: #categoryPopUpMenu
)
#(#SubChannelInfoSpec
#subAspect: #classCategoryDoubleClickChannel
#callBack: #classCategoryDoubleClicked
)
#(#SubChannelInfoSpec
#subAspect: #classDoubleClickChannel
#callBack: #classDoubleClicked
)
#(#SubChannelInfoSpec
#subAspect: #nameSpaceDoubleClickChannel
#callBack: #nameSpaceDoubleClicked
)
#(#SubChannelInfoSpec
#subAspect: #projectDoubleClickChannel
#callBack: #projectDoubleClicked
)
#(#SubChannelInfoSpec
#subAspect: #variableDoubleClickChannel
#callBack: #variableDoubleClicked
)
#(#SubChannelInfoSpec
#subAspect: #classHierarchyListMenuHolder
#aspect: #hierarchyPopUpMenu
)
#(#SubChannelInfoSpec
#subAspect: #classHierarchyTopClass
#aspect: #classHierarchyTopClass
)
#(#SubChannelInfoSpec
#subAspect: #classListMenuHolder
#aspect: #classPopUpMenu
)
#(#SubChannelInfoSpec
#subAspect: #hidePrivateClasses
#aspect: #hidePrivateClasses
)
#(#SubChannelInfoSpec
#subAspect: #hideUnloadedClasses
#aspect: #hideUnloadedClasses
)
#(#SubChannelInfoSpec
#subAspect: #markApplicationsHolder
#aspect: #markApplicationsHolder
)
#(#SubChannelInfoSpec
#subAspect: #showClassPackages
#aspect: #showClassPackages
)
#(#SubChannelInfoSpec
#subAspect: #showMethodInheritance
#aspect: #showMethodInheritance
)
#(#SubChannelInfoSpec
#subAspect: #methodVisibilityHolder
#aspect: #methodVisibilityHolder
)
#(#SubChannelInfoSpec
#subAspect: #immediateUpdate
#aspect: #immediateUpdate
)
#(#SubChannelInfoSpec
#subAspect: #meta
#aspect: #meta
)
#(#SubChannelInfoSpec
#subAspect: #metaToggleLabelHolder
#aspect: #metaToggleLabelHolder
)
#(#SubChannelInfoSpec
#subAspect: #nameSpaceListMenuHolder
#aspect: #nameSpacePopUpMenu
)
#(#SubChannelInfoSpec
#subAspect: #organizerMode
#aspect: #organizerMode
)
#(#SubChannelInfoSpec
#subAspect: #outGeneratorHolder
#aspect: #protocolListGenerator
)
#(#SubChannelInfoSpec
#subAspect: #packageFilter
#aspect: #packageFilter
)
#(#SubChannelInfoSpec
#subAspect: #projectListMenuHolder
#aspect: #projectPopUpMenu
)
#(#SubChannelInfoSpec
#subAspect: #selectedCategories
#aspect: #selectedCategories
#callBack: #categorySelectionChanged
)
#(#SubChannelInfoSpec
#subAspect: #selectedClasses
#aspect: #selectedClasses
#callBack: #classSelectionChanged
)
#(#SubChannelInfoSpec
#subAspect: #selectedNamespaces
#aspect: #selectedNamespaces
)
#(#SubChannelInfoSpec
#subAspect: #selectedProjects
#aspect: #selectedProjects
)
#(#SubChannelInfoSpec
#subAspect: #selectionChangeCondition
#aspect: #selectionChangeConditionHolder
)
)
#createNewApplication: true
#createNewBuilder: true
)
)
)
)
"Modified: / 18.8.2000 / 20:00:27 / cg"
!
categoryAndSingleClassOnlySpec
"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::NavigatorCanvas andSelector:#categoryAndSingleClassOnlySpec
NewSystemBrowser::NavigatorCanvas new openInterface:#categoryAndSingleClassOnlySpec
"
<resource: #canvas>
^
#(#FullSpec
#name: #categoryAndSingleClassOnlySpec
#window:
#(#WindowSpec
#label: 'Full Class Browser'
#name: 'Full Class Browser'
#min: #(#Point 0 0)
#bounds: #(#Rectangle 12 22 474 322)
)
#component:
#(#SpecCollection
#collection: #(
#(#SubCanvasSpec
#name: 'Organizer'
#layout: #(#LayoutFrame 0 0.0 0 0.0 0 1.0 0 1.0)
#majorKey: #'NewSystemBrowser::OrganizerCanvas'
#minorKey: #windowSpecWithoutMetaToggles
#subAspectHolders:
#(#Array
#(#SubChannelInfoSpec
#subAspect: #classCategoryListMenuHolder
#aspect: #categoryPopUpMenu
)
#(#SubChannelInfoSpec
#subAspect: #classCategoryDoubleClickChannel
#callBack: #classCategoryDoubleClicked
)
#(#SubChannelInfoSpec
#subAspect: #classDoubleClickChannel
#callBack: #classDoubleClicked
)
#(#SubChannelInfoSpec
#subAspect: #nameSpaceDoubleClickChannel
#callBack: #nameSpaceDoubleClicked
)
#(#SubChannelInfoSpec
#subAspect: #projectDoubleClickChannel
#callBack: #projectDoubleClicked
)
#(#SubChannelInfoSpec
#subAspect: #variableDoubleClickChannel
#callBack: #variableDoubleClicked
)
#(#SubChannelInfoSpec
#subAspect: #classHierarchyListMenuHolder
#aspect: #hierarchyPopUpMenu
)
#(#SubChannelInfoSpec
#subAspect: #classHierarchyTopClass
#aspect: #classHierarchyTopClass
)
#(#SubChannelInfoSpec
#subAspect: #classListMenuHolder
#aspect: #classPopUpMenu
)
#(#SubChannelInfoSpec
#subAspect: #hidePrivateClasses
#aspect: #hidePrivateClasses
)
#(#SubChannelInfoSpec
#subAspect: #hideUnloadedClasses
#aspect: #hideUnloadedClasses
)
#(#SubChannelInfoSpec
#subAspect: #markApplicationsHolder
#aspect: #markApplicationsHolder
)
#(#SubChannelInfoSpec
#subAspect: #showClassPackages
#aspect: #showClassPackages
)
#(#SubChannelInfoSpec
#subAspect: #showMethodInheritance
#aspect: #showMethodInheritance
)
#(#SubChannelInfoSpec
#subAspect: #methodVisibilityHolder
#aspect: #methodVisibilityHolder
)
#(#SubChannelInfoSpec
#subAspect: #immediateUpdate
#aspect: #immediateUpdate
)
#(#SubChannelInfoSpec
#subAspect: #meta
#aspect: #meta
)
#(#SubChannelInfoSpec
#subAspect: #nameSpaceListMenuHolder
#aspect: #nameSpacePopUpMenu
)
#(#SubChannelInfoSpec
#subAspect: #organizerMode
#aspect: #organizerMode
)
#(#SubChannelInfoSpec
#subAspect: #outGeneratorHolder
#aspect: #protocolListGenerator
)
#(#SubChannelInfoSpec
#subAspect: #packageFilter
#aspect: #packageFilter
)
#(#SubChannelInfoSpec
#subAspect: #projectListMenuHolder
#aspect: #projectPopUpMenu
)
#(#SubChannelInfoSpec
#subAspect: #selectedCategories
#aspect: #selectedCategories
#callBack: #categorySelectionChanged
)
#(#SubChannelInfoSpec
#subAspect: #selectedClasses
#aspect: #selectedClasses
#callBack: #classSelectionChanged
)
#(#SubChannelInfoSpec
#subAspect: #selectedNamespaces
#aspect: #selectedNamespaces
)
#(#SubChannelInfoSpec
#subAspect: #selectedProjects
#aspect: #selectedProjects
)
#(#SubChannelInfoSpec
#subAspect: #selectionChangeCondition
#aspect: #selectionChangeConditionHolder
)
)
#createNewApplication: true
#createNewBuilder: true
)
)
)
)
"Modified: / 18.8.2000 / 20:00:34 / cg"
!
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::NavigatorCanvas andSelector:#fullBrowserSpec
NewSystemBrowser::NavigatorCanvas new openInterface:#fullBrowserSpec
"
<resource: #canvas>
^
#(#FullSpec
#name: #fullBrowserSpec
#window:
#(#WindowSpec
#label: 'SystemBrowser'
#name: 'SystemBrowser'
#min: #(#Point 0 0)
#bounds: #(#Rectangle 18 51 480 351)
#icon: #defaultIcon
)
#component:
#(#SpecCollection
#collection: #(
#(#VariableHorizontalPanelSpec
#name: 'VariableHorizontalPanel1'
#layout: #(#LayoutFrame 0 0.0 0 0.0 0 1.0 0 1.0)
#barWidth: 2
#showHandle: false
#component:
#(#SpecCollection
#collection: #(
#(#SubCanvasSpec
#name: 'Organizer'
#majorKey: #'NewSystemBrowser::OrganizerCanvas'
#subAspectHolders:
#(#Array
#(#SubChannelInfoSpec
#subAspect: #classCategoryListMenuHolder
#aspect: #categoryPopUpMenu
)
#(#SubChannelInfoSpec
#subAspect: #classCategoryDoubleClickChannel
#callBack: #classCategoryDoubleClicked
)
#(#SubChannelInfoSpec
#subAspect: #classDoubleClickChannel
#callBack: #classDoubleClicked
)
#(#SubChannelInfoSpec
#subAspect: #nameSpaceDoubleClickChannel
#callBack: #nameSpaceDoubleClicked
)
#(#SubChannelInfoSpec
#subAspect: #projectDoubleClickChannel
#callBack: #projectDoubleClicked
)
#(#SubChannelInfoSpec
#subAspect: #variableDoubleClickChannel
#callBack: #variableDoubleClicked
)
#(#SubChannelInfoSpec
#subAspect: #classHierarchyListMenuHolder
#aspect: #hierarchyPopUpMenu
)
#(#SubChannelInfoSpec
#subAspect: #classHierarchyTopClass
#aspect: #classHierarchyTopClass
)
#(#SubChannelInfoSpec
#subAspect: #classListMenuHolder
#aspect: #classPopUpMenu
)
#(#SubChannelInfoSpec
#subAspect: #hideUnloadedClasses
#aspect: #hideUnloadedClasses
)
#(#SubChannelInfoSpec
#subAspect: #markApplicationsHolder
#aspect: #markApplicationsHolder
)
#(#SubChannelInfoSpec
#subAspect: #showClassPackages
#aspect: #showClassPackages
)
#(#SubChannelInfoSpec
#subAspect: #immediateUpdate
#aspect: #immediateUpdate
)
#(#SubChannelInfoSpec
#subAspect: #meta
#aspect: #meta
)
#(#SubChannelInfoSpec
#subAspect: #metaToggleLabelHolder
#aspect: #metaToggleLabelHolder
)
#(#SubChannelInfoSpec
#subAspect: #nameSpaceListMenuHolder
#aspect: #nameSpacePopUpMenu
)
#(#SubChannelInfoSpec
#subAspect: #organizerMode
#aspect: #organizerMode
)
#(#SubChannelInfoSpec
#subAspect: #outGeneratorHolder
#aspect: #protocolListGenerator
)
#(#SubChannelInfoSpec
#subAspect: #packageFilter
#aspect: #packageFilter
)
#(#SubChannelInfoSpec
#subAspect: #projectListMenuHolder
#aspect: #projectPopUpMenu
)
#(#SubChannelInfoSpec
#subAspect: #selectedCategories
#aspect: #selectedCategories
#callBack: #categorySelectionChanged
)
#(#SubChannelInfoSpec
#subAspect: #selectedClasses
#aspect: #selectedClasses
#callBack: #classSelectionChanged
)
#(#SubChannelInfoSpec
#subAspect: #selectedNamespaces
#aspect: #selectedNamespaces
#callBack: #nameSpaceSelectionChanged
)
#(#SubChannelInfoSpec
#subAspect: #selectedProjects
#aspect: #selectedProjects
#callBack: #projectSelectionChanged
)
#(#SubChannelInfoSpec
#subAspect: #selectionChangeCondition
#aspect: #selectionChangeConditionHolder
)
#(#SubChannelInfoSpec
#subAspect: #nameSpaceFilter
#aspect: #nameSpaceFilter
)
#(#SubChannelInfoSpec
#subAspect: #variableFilter
#aspect: #variableFilter
#callBack: #variableSelectionChanged
)
#(#SubChannelInfoSpec
#subAspect: #filterClassVars
#aspect: #filterClassVars
)
#(#SubChannelInfoSpec
#subAspect: #variablesMenuHolder
#aspect: #variablesPopUpMenu
)
)
#createNewApplication: true
#createNewBuilder: true
)
#(#SubCanvasSpec
#name: 'MethodCategoryList'
#majorKey: #'NewSystemBrowser::MethodCategoryList'
#subAspectHolders:
#(#Array
#(#SubChannelInfoSpec
#subAspect: #immediateUpdate
#aspect: #immediateUpdate
)
#(#SubChannelInfoSpec
#subAspect: #inGeneratorHolder
#aspect: #protocolListGenerator
)
#(#SubChannelInfoSpec
#subAspect: #doubleClickChannel
#callBack: #protocolDoubleClicked
)
#(#SubChannelInfoSpec
#subAspect: #menuHolder
#aspect: #protocolMenu
)
#(#SubChannelInfoSpec
#subAspect: #outGeneratorHolder
#aspect: #selectorListGenerator
)
#(#SubChannelInfoSpec
#subAspect: #packageFilter
#aspect: #packageFilter
)
#(#SubChannelInfoSpec
#subAspect: #selectedProtocols
#aspect: #selectedProtocols
#callBack: #protocolSelectionChanged
)
#(#SubChannelInfoSpec
#subAspect: #selectionChangeCondition
#aspect: #selectionChangeConditionHolder
)
#(#SubChannelInfoSpec
#subAspect: #variableFilter
#aspect: #variableFilter
#callBack: #variableSelectionChanged
)
#(#SubChannelInfoSpec
#subAspect: #filterClassVars
#aspect: #filterClassVars
)
#(#SubChannelInfoSpec
#subAspect: #methodVisibilityHolder
#aspect: #methodVisibilityHolder
)
)
#createNewApplication: true
#createNewBuilder: true
)
#(#SubCanvasSpec
#name: 'MethodList'
#majorKey: #'NewSystemBrowser::MethodList'
#subAspectHolders:
#(#Array
#(#SubChannelInfoSpec
#subAspect: #doubleClickChannel
#callBack: #methodDoubleClicked
)
#(#SubChannelInfoSpec
#subAspect: #immediateUpdate
#aspect: #immediateUpdate
)
#(#SubChannelInfoSpec
#subAspect: #inGeneratorHolder
#aspect: #selectorListGenerator
)
#(#SubChannelInfoSpec
#subAspect: #menuHolder
#aspect: #selectorPopUpMenu
)
#(#SubChannelInfoSpec
#subAspect: #packageFilter
#aspect: #packageFilter
)
#(#SubChannelInfoSpec
#subAspect: #selectedMethods
#aspect: #selectedMethods
#callBack: #methodsSelectionChanged
)
#(#SubChannelInfoSpec
#subAspect: #selectionChangeCondition
#aspect: #selectionChangeConditionHolder
)
#(#SubChannelInfoSpec
#subAspect: #variableFilter
#aspect: #variableFilter
#callBack: #variableSelectionChanged
)
#(#SubChannelInfoSpec
#subAspect: #showMethodInheritance
#aspect: #showMethodInheritance
)
#(#SubChannelInfoSpec
#subAspect: #filterClassVars
#aspect: #filterClassVars
)
)
#createNewApplication: true
#createNewBuilder: true
)
)
)
#handles: #(#Any 0.5 0.75 1.0)
)
)
)
)
"Modified: / 18.8.2000 / 20:00:47 / 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::NavigatorCanvas andSelector:#multipleCategoryBrowserSpec
NewSystemBrowser::NavigatorCanvas new openInterface:#multipleCategoryBrowserSpec
"
<resource: #canvas>
^
#(#FullSpec
#name: #multipleCategoryBrowserSpec
#window:
#(#WindowSpec
#label: 'CategoryBrowser'
#name: 'CategoryBrowser'
#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)
#barWidth: 2
#showHandle: false
#component:
#(#SpecCollection
#collection: #(
#(#VariableHorizontalPanelSpec
#name: 'VariableHorizontalPanel1'
#barWidth: 2
#showHandle: false
#component:
#(#SpecCollection
#collection: #(
#(#SubCanvasSpec
#name: 'CategoryList'
#majorKey: #'NewSystemBrowser::ClassCategoryList'
#subAspectHolders:
#(#Array
#(#SubChannelInfoSpec
#subAspect: #hideUnloadedClasses
#aspect: #hideUnloadedClasses
)
#(#SubChannelInfoSpec
#subAspect: #showClassPackages
#aspect: #showClassPackages
)
#(#SubChannelInfoSpec
#subAspect: #doubleClickChannel
#callBack: #classCategoryDoubleClicked
)
#(#SubChannelInfoSpec
#subAspect: #immediateUpdate
#aspect: #immediateUpdate
)
#(#SubChannelInfoSpec
#subAspect: #inGeneratorHolder
#aspect: #categoryListGenerator
)
#(#SubChannelInfoSpec
#subAspect: #menuHolder
#aspect: #categoryPopUpMenu
)
#(#SubChannelInfoSpec
#subAspect: #outGeneratorHolder
#aspect: #classListGenerator
)
#(#SubChannelInfoSpec
#subAspect: #selectedCategories
#aspect: #selectedCategories
#callBack: #categorySelectionChanged
)
#(#SubChannelInfoSpec
#subAspect: #selectionChangeCondition
#aspect: #selectionChangeConditionHolder
)
)
#createNewApplication: true
#createNewBuilder: true
)
#(#ViewSpec
#name: 'Box1'
#component:
#(#SpecCollection
#collection: #(
#(#VariableVerticalPanelSpec
#name: 'VariableVerticalPanel2'
#layout: #(#LayoutFrame 0 0.0 0 0.0 0 1.0 -25 1.0)
#showHandle: false
#handlePosition: #left
#snapMode: #both
#component:
#(#SpecCollection
#collection: #(
#(#SubCanvasSpec
#name: 'ClassList'
#majorKey: #'NewSystemBrowser::ClassList'
#subAspectHolders:
#(#Array
#(#SubChannelInfoSpec
#subAspect: #doubleClickChannel
#callBack: #classDoubleClicked
)
#(#SubChannelInfoSpec
#subAspect: #hideUnloadedClasses
#aspect: #hideUnloadedClasses
)
#(#SubChannelInfoSpec
#subAspect: #markApplicationsHolder
#aspect: #markApplicationsHolder
)
#(#SubChannelInfoSpec
#subAspect: #immediateUpdate
#aspect: #immediateUpdate
)
#(#SubChannelInfoSpec
#subAspect: #inGeneratorHolder
#aspect: #classListGenerator
)
#(#SubChannelInfoSpec
#subAspect: #menuHolder
#aspect: #classPopUpMenu
)
#(#SubChannelInfoSpec
#subAspect: #meta
#aspect: #meta
)
#(#SubChannelInfoSpec
#subAspect: #organizerMode
#aspect: #organizerMode
)
#(#SubChannelInfoSpec
#subAspect: #outGeneratorHolder
#aspect: #protocolListGenerator
)
#(#SubChannelInfoSpec
#subAspect: #packageFilter
#aspect: #packageFilter
)
#(#SubChannelInfoSpec
#subAspect: #selectedClasses
#aspect: #selectedClasses
#callBack: #classSelectionChanged
)
#(#SubChannelInfoSpec
#subAspect: #selectionChangeCondition
#aspect: #selectionChangeConditionHolder
)
)
#createNewApplication: true
#createNewBuilder: true
)
#(#SubCanvasSpec
#name: 'VariableList'
#majorKey: #'NewSystemBrowser::VariableList'
#subAspectHolders:
#(#Array
#(#SubChannelInfoSpec
#subAspect: #classHolder
#aspect: #selectedClasses
)
#(#SubChannelInfoSpec
#subAspect: #doubleClickChannel
#callBack: #variableDoubleClicked
)
#(#SubChannelInfoSpec
#subAspect: #menuHolder
#aspect: #variablesPopUpMenu
)
#(#SubChannelInfoSpec
#subAspect: #selectedVariables
#aspect: #variableFilter
)
#(#SubChannelInfoSpec
#subAspect: #showClassVarsInVariableList
#aspect: #filterClassVars
)
#(#SubChannelInfoSpec
#subAspect: #sortVariablesByName
#aspect: #variableListSortByName
)
)
#createNewApplication: true
#createNewBuilder: true
)
)
)
#handles: #(#Any 0.5 1.0)
)
#(#UISubSpecification
#name: 'MetaToggles'
#layout: #(#LayoutFrame 0 0 -25 1 0 1 0 1)
#majorKey: #'NewSystemBrowser::NavigatorModel'
#minorKey: #metaSpec
)
)
)
)
#(#SubCanvasSpec
#name: 'MethodCategoryList'
#majorKey: #'NewSystemBrowser::MethodCategoryList'
#subAspectHolders:
#(#Array
#(#SubChannelInfoSpec
#subAspect: #immediateUpdate
#aspect: #immediateUpdate
)
#(#SubChannelInfoSpec
#subAspect: #inGeneratorHolder
#aspect: #protocolListGenerator
)
#(#SubChannelInfoSpec
#subAspect: #doubleClickChannel
#callBack: #protocolDoubleClicked
)
#(#SubChannelInfoSpec
#subAspect: #menuHolder
#aspect: #protocolMenu
)
#(#SubChannelInfoSpec
#subAspect: #outGeneratorHolder
#aspect: #selectorListGenerator
)
#(#SubChannelInfoSpec
#subAspect: #packageFilter
#aspect: #packageFilter
)
#(#SubChannelInfoSpec
#subAspect: #selectedProtocols
#aspect: #selectedProtocols
#callBack: #protocolSelectionChanged
)
#(#SubChannelInfoSpec
#subAspect: #selectionChangeCondition
#aspect: #selectionChangeConditionHolder
)
#(#SubChannelInfoSpec
#subAspect: #variableFilter
#aspect: #variableFilter
)
#(#SubChannelInfoSpec
#subAspect: #filterClassVars
#aspect: #filterClassVars
)
#(#SubChannelInfoSpec
#subAspect: #methodVisibilityHolder
#aspect: #methodVisibilityHolder
)
)
#createNewApplication: true
#createNewBuilder: true
)
#(#SubCanvasSpec
#name: 'MethodList'
#majorKey: #'NewSystemBrowser::MethodList'
#subAspectHolders:
#(#Array
#(#SubChannelInfoSpec
#subAspect: #doubleClickChannel
#callBack: #methodDoubleClicked
)
#(#SubChannelInfoSpec
#subAspect: #immediateUpdate
#aspect: #immediateUpdate
)
#(#SubChannelInfoSpec
#subAspect: #inGeneratorHolder
#aspect: #selectorListGenerator
)
#(#SubChannelInfoSpec
#subAspect: #menuHolder
#aspect: #selectorPopUpMenu
)
#(#SubChannelInfoSpec
#subAspect: #packageFilter
#aspect: #packageFilter
)
#(#SubChannelInfoSpec
#subAspect: #variableFilter
#aspect: #variableFilter
)
#(#SubChannelInfoSpec
#subAspect: #filterClassVars
#aspect: #filterClassVars
)
#(#SubChannelInfoSpec
#subAspect: #showMethodInheritance
#aspect: #showMethodInheritance
)
#(#SubChannelInfoSpec
#subAspect: #selectedMethods
#aspect: #selectedMethods
#callBack: #methodsSelectionChanged
)
#(#SubChannelInfoSpec
#subAspect: #selectionChangeCondition
#aspect: #selectionChangeConditionHolder
)
)
#createNewApplication: true
#createNewBuilder: true
)
)
)
#handles: #(#Any 0.25 0.5 0.75 1.0)
)
)
)
#handles: #(#Any 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::NavigatorCanvas andSelector:#multipleClassBrowserSpec
NewSystemBrowser::NavigatorCanvas new openInterface:#multipleClassBrowserSpec
"
<resource: #canvas>
^
#(#FullSpec
#name: #multipleClassBrowserSpec
#window:
#(#WindowSpec
#label: 'ClassBrowser'
#name: 'ClassBrowser'
#min: #(#Point 0 0)
#bounds: #(#Rectangle 18 51 480 351)
)
#component:
#(#SpecCollection
#collection: #(
#(#VariableHorizontalPanelSpec
#name: 'VariableHorizontalPanel1'
#layout: #(#LayoutFrame 0 0.0 0 0.0 0 1.0 0 1.0)
#barWidth: 2
#showHandle: false
#component:
#(#SpecCollection
#collection: #(
#(#ViewSpec
#name: 'Box1'
#component:
#(#SpecCollection
#collection: #(
#(#VariableVerticalPanelSpec
#name: 'VariableVerticalPanel1'
#layout: #(#LayoutFrame 0 0.0 0 0.0 0 1.0 -25 1.0)
#component:
#(#SpecCollection
#collection: #(
#(#SubCanvasSpec
#name: 'ClassList'
#majorKey: #'NewSystemBrowser::ClassList'
#subAspectHolders:
#(#Array
#(#SubChannelInfoSpec
#subAspect: #doubleClickChannel
#callBack: #classDoubleClicked
)
#(#SubChannelInfoSpec
#subAspect: #hideUnloadedClasses
#aspect: #hideUnloadedClasses
)
#(#SubChannelInfoSpec
#subAspect: #markApplicationsHolder
#aspect: #markApplicationsHolder
)
#(#SubChannelInfoSpec
#subAspect: #showClassPackages
#aspect: #showClassPackages
)
#(#SubChannelInfoSpec
#subAspect: #immediateUpdate
#aspect: #immediateUpdate
)
#(#SubChannelInfoSpec
#subAspect: #inGeneratorHolder
#aspect: #classListGenerator
)
#(#SubChannelInfoSpec
#subAspect: #menuHolder
#aspect: #classPopUpMenu
)
#(#SubChannelInfoSpec
#subAspect: #sortBy
#aspect: #sortBy
)
#(#SubChannelInfoSpec
#subAspect: #meta
#aspect: #meta
)
#(#SubChannelInfoSpec
#subAspect: #organizerMode
#aspect: #organizerMode
)
#(#SubChannelInfoSpec
#subAspect: #outGeneratorHolder
#aspect: #protocolListGenerator
)
#(#SubChannelInfoSpec
#subAspect: #packageFilter
#aspect: #packageFilter
)
#(#SubChannelInfoSpec
#subAspect: #selectedClasses
#aspect: #selectedClasses
#callBack: #classSelectionChanged
)
#(#SubChannelInfoSpec
#subAspect: #selectionChangeCondition
#aspect: #selectionChangeConditionHolder
)
)
#createNewApplication: true
#createNewBuilder: true
)
#(#SubCanvasSpec
#name: 'VariableList'
#majorKey: #'NewSystemBrowser::VariableList'
#subAspectHolders:
#(#Array
#(#SubChannelInfoSpec
#subAspect: #doubleClickChannel
#callBack: #variableDoubleClicked
)
#(#SubChannelInfoSpec
#subAspect: #classHolder
#aspect: #selectedClasses
)
#(#SubChannelInfoSpec
#subAspect: #menuHolder
#aspect: #variablesPopUpMenu
)
#(#SubChannelInfoSpec
#subAspect: #selectedVariables
#aspect: #variableFilter
)
#(#SubChannelInfoSpec
#subAspect: #showClassVarsInVariableList
#aspect: #variableFilter
)
#(#SubChannelInfoSpec
#subAspect: #sortVariablesByName
#aspect: #variableListSortByName
)
)
#createNewApplication: true
#createNewBuilder: true
)
)
)
#showHandle: false
#handlePosition: #left
#snapMode: #both
#handles: #(#Any 0.5 1.0)
)
#(#UISubSpecification
#name: 'MetaToggles'
#layout: #(#LayoutFrame 0 0 -25 1 0 1 0 1)
#majorKey: #'NewSystemBrowser::NavigatorModel'
#minorKey: #metaSpec
)
)
)
)
#(#SubCanvasSpec
#name: 'MethodCategoryList'
#majorKey: #'NewSystemBrowser::MethodCategoryList'
#subAspectHolders:
#(#Array
#(#SubChannelInfoSpec
#subAspect: #doubleClickChannel
#callBack: #protocolDoubleClicked
)
#(#SubChannelInfoSpec
#subAspect: #immediateUpdate
#aspect: #immediateUpdate
)
#(#SubChannelInfoSpec
#subAspect: #inGeneratorHolder
#aspect: #protocolListGenerator
)
#(#SubChannelInfoSpec
#subAspect: #menuHolder
#aspect: #protocolMenu
)
#(#SubChannelInfoSpec
#subAspect: #outGeneratorHolder
#aspect: #selectorListGenerator
)
#(#SubChannelInfoSpec
#subAspect: #variableFilter
#aspect: #variableFilter
)
#(#SubChannelInfoSpec
#subAspect: #filterClassVars
#aspect: #filterClassVars
)
#(#SubChannelInfoSpec
#subAspect: #packageFilter
#aspect: #packageFilter
)
#(#SubChannelInfoSpec
#subAspect: #selectedProtocols
#aspect: #selectedProtocols
#callBack: #protocolSelectionChanged
)
#(#SubChannelInfoSpec
#subAspect: #methodVisibilityHolder
#aspect: #methodVisibilityHolder
)
#(#SubChannelInfoSpec
#subAspect: #selectionChangeCondition
#aspect: #selectionChangeConditionHolder
)
)
#createNewApplication: true
#createNewBuilder: true
)
#(#SubCanvasSpec
#name: 'MethodList'
#majorKey: #'NewSystemBrowser::MethodList'
#subAspectHolders:
#(#Array
#(#SubChannelInfoSpec
#subAspect: #doubleClickChannel
#callBack: #methodDoubleClicked
)
#(#SubChannelInfoSpec
#subAspect: #immediateUpdate
#aspect: #immediateUpdate
)
#(#SubChannelInfoSpec
#subAspect: #inGeneratorHolder
#aspect: #selectorListGenerator
)
#(#SubChannelInfoSpec
#subAspect: #menuHolder
#aspect: #selectorPopUpMenu
)
#(#SubChannelInfoSpec
#subAspect: #variableFilter
#aspect: #variableFilter
)
#(#SubChannelInfoSpec
#subAspect: #filterClassVars
#aspect: #filterClassVars
)
#(#SubChannelInfoSpec
#subAspect: #packageFilter
#aspect: #packageFilter
)
#(#SubChannelInfoSpec
#subAspect: #selectedMethods
#aspect: #selectedMethods
#callBack: #methodsSelectionChanged
)
#(#SubChannelInfoSpec
#subAspect: #showMethodInheritance
#aspect: #showMethodInheritance
)
#(#SubChannelInfoSpec
#subAspect: #selectionChangeCondition
#aspect: #selectionChangeConditionHolder
)
)
#createNewApplication: true
#createNewBuilder: true
)
)
)
#handles: #(#Any 0.333333 0.666667 1.0)
)
)
)
)
!
multipleClassDiffBrowserSpec
"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::NavigatorCanvas andSelector:#multipleClassDiffBrowserSpec
NewSystemBrowser::NavigatorCanvas new openInterface:#multipleClassDiffBrowserSpec
"
<resource: #canvas>
^
#(#FullSpec
#name: #multipleClassDiffBrowserSpec
#window:
#(#WindowSpec
#label: 'ClassBrowser'
#name: 'ClassBrowser'
#min: #(#Point 0 0)
#bounds: #(#Rectangle 12 22 474 322)
)
#component:
#(#SpecCollection
#collection: #(
#(#SubCanvasSpec
#name: 'ClassList'
#layout: #(#LayoutFrame 0 0.0 0 0.0 0 1.0 -30 1.0)
#majorKey: #'NewSystemBrowser::ClassList'
#subAspectHolders:
#(#Array
#(#SubChannelInfoSpec
#subAspect: #doubleClickChannel
#callBack: #classDoubleClicked
)
#(#SubChannelInfoSpec
#subAspect: #hideUnloadedClasses
#aspect: #hideUnloadedClasses
)
#(#SubChannelInfoSpec
#subAspect: #markApplicationsHolder
#aspect: #markApplicationsHolder
)
#(#SubChannelInfoSpec
#subAspect: #showClassPackages
#aspect: #showClassPackages
)
#(#SubChannelInfoSpec
#subAspect: #immediateUpdate
#aspect: #immediateUpdate
)
#(#SubChannelInfoSpec
#subAspect: #inGeneratorHolder
#aspect: #classListGenerator
)
#(#SubChannelInfoSpec
#subAspect: #menuHolder
#aspect: #classPopUpMenu
)
#(#SubChannelInfoSpec
#subAspect: #sortBy
#aspect: #sortBy
)
#(#SubChannelInfoSpec
#subAspect: #meta
#aspect: #meta
)
#(#SubChannelInfoSpec
#subAspect: #organizerMode
#aspect: #organizerMode
)
#(#SubChannelInfoSpec
#subAspect: #outGeneratorHolder
#aspect: #protocolListGenerator
)
#(#SubChannelInfoSpec
#subAspect: #packageFilter
#aspect: #packageFilter
)
#(#SubChannelInfoSpec
#subAspect: #selectedClasses
#aspect: #selectedClasses
#callBack: #classSelectionChanged
)
#(#SubChannelInfoSpec
#subAspect: #selectionChangeCondition
#aspect: #selectionChangeConditionHolder
)
)
#createNewApplication: true
#createNewBuilder: true
)
#(#LabelSpec
#label: 'projectInfo'
#name: 'Label1'
#layout: #(#LayoutFrame 0 0 -30 1 0 1 0 1)
#level: -1
#labelChannel: #classesProjectInfoHolder
#adjust: #left
)
)
)
)
!
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::NavigatorCanvas andSelector:#multipleClassExtensionBrowserSpec
NewSystemBrowser::NavigatorCanvas new openInterface:#multipleClassExtensionBrowserSpec
"
<resource: #canvas>
^
#(#FullSpec
#name: #multipleClassExtensionBrowserSpec
#window:
#(#WindowSpec
#label: 'ClassBrowser'
#name: 'ClassBrowser'
#min: #(#Point 0 0)
#bounds: #(#Rectangle 16 46 478 346)
)
#component:
#(#SpecCollection
#collection: #(
#(#VariableHorizontalPanelSpec
#name: 'VariableHorizontalPanel1'
#layout: #(#LayoutFrame 0 0.0 0 0.0 0 1.0 0 1.0)
#barWidth: 2
#showHandle: false
#component:
#(#SpecCollection
#collection: #(
#(#ViewSpec
#name: 'Box1'
#component:
#(#SpecCollection
#collection: #(
#(#VariableVerticalPanelSpec
#name: 'VariableVerticalPanel1'
#layout: #(#LayoutFrame 0 0.0 0 0.0 0 1.0 -25 1.0)
#component:
#(#SpecCollection
#collection: #(
#(#SubCanvasSpec
#name: 'ClassList'
#majorKey: #'NewSystemBrowser::ClassList'
#subAspectHolders:
#(#Array
#(#SubChannelInfoSpec
#subAspect: #doubleClickChannel
#callBack: #classDoubleClicked
)
#(#SubChannelInfoSpec
#subAspect: #hideUnloadedClasses
#aspect: #hideUnloadedClasses
)
#(#SubChannelInfoSpec
#subAspect: #markApplicationsHolder
#aspect: #markApplicationsHolder
)
#(#SubChannelInfoSpec
#subAspect: #showClassPackages
#aspect: #showClassPackages
)
#(#SubChannelInfoSpec
#subAspect: #immediateUpdate
#aspect: #immediateUpdate
)
#(#SubChannelInfoSpec
#subAspect: #inGeneratorHolder
#aspect: #classListGenerator
)
#(#SubChannelInfoSpec
#subAspect: #menuHolder
#aspect: #classPopUpMenu
)
#(#SubChannelInfoSpec
#subAspect: #sortBy
#aspect: #sortBy
)
#(#SubChannelInfoSpec
#subAspect: #meta
#aspect: #meta
)
#(#SubChannelInfoSpec
#subAspect: #organizerMode
#aspect: #organizerMode
)
#(#SubChannelInfoSpec
#subAspect: #outGeneratorHolder
#aspect: #protocolListGenerator
)
#(#SubChannelInfoSpec
#subAspect: #selectedClasses
#aspect: #selectedClasses
#callBack: #classSelectionChanged
)
#(#SubChannelInfoSpec
#subAspect: #selectionChangeCondition
#aspect: #selectionChangeConditionHolder
)
)
#createNewApplication: true
#createNewBuilder: true
)
#(#SubCanvasSpec
#name: 'ProjectList'
#majorKey: #'NewSystemBrowser::ProjectList'
#subAspectHolders:
#(#Array
#(#SubChannelInfoSpec
#subAspect: #immediateUpdate
#aspect: #immediateUpdate
)
#(#SubChannelInfoSpec
#subAspect: #inGeneratorHolder
#aspect: #projectListGenerator
)
#(#SubChannelInfoSpec
#subAspect: #selectedProjects
#aspect: #selectedProjects
#callBack: #projectSelectionChangedForFilter
)
#(#SubChannelInfoSpec
#subAspect: #selectionChangeCondition
#aspect: #selectionChangeConditionHolder
)
#(#SubChannelInfoSpec
#subAspect: #menuHolder
#aspect: #projectPopUpMenu
)
)
#createNewApplication: true
#createNewBuilder: true
)
#(#SubCanvasSpec
#name: 'VariableList'
#majorKey: #'NewSystemBrowser::VariableList'
#subAspectHolders:
#(#Array
#(#SubChannelInfoSpec
#subAspect: #doubleClickChannel
#callBack: #variableDoubleClicked
)
#(#SubChannelInfoSpec
#subAspect: #classHolder
#aspect: #selectedClasses
)
#(#SubChannelInfoSpec
#subAspect: #menuHolder
#aspect: #variablesPopUpMenu
)
#(#SubChannelInfoSpec
#subAspect: #selectedVariables
#aspect: #variableFilter
)
#(#SubChannelInfoSpec
#subAspect: #showClassVarsInVariableList
#aspect: #filterClassVars "/variableFilter
)
#(#SubChannelInfoSpec
#subAspect: #sortVariablesByName
#aspect: #variableListSortByName
)
)
#createNewApplication: true
#createNewBuilder: true
)
)
)
"/ #handles: #(#Any 0.333333 0.666667 1.0)
#handles: #(#Any 0.7 1.0 1.0)
)
#(#UISubSpecification
#name: 'MetaToggles'
#layout: #(#LayoutFrame 0 0 -25 1 0 1 0 1)
#majorKey: #'NewSystemBrowser::NavigatorModel'
#minorKey: #metaSpec
)
)
)
)
#(#SubCanvasSpec
#name: 'MethodCategoryList'
#majorKey: #'NewSystemBrowser::MethodCategoryList'
#subAspectHolders:
#(#Array
#(#SubChannelInfoSpec
#subAspect: #doubleClickChannel
#callBack: #protocolDoubleClicked
)
#(#SubChannelInfoSpec
#subAspect: #immediateUpdate
#aspect: #immediateUpdate
)
#(#SubChannelInfoSpec
#subAspect: #inGeneratorHolder
#aspect: #protocolListGenerator
)
#(#SubChannelInfoSpec
#subAspect: #menuHolder
#aspect: #protocolMenu
)
#(#SubChannelInfoSpec
#subAspect: #outGeneratorHolder
#aspect: #selectorListGenerator
)
#(#SubChannelInfoSpec
#subAspect: #variableFilter
#aspect: #variableFilter
#callBack: #variableSelectionChanged
)
#(#SubChannelInfoSpec
#subAspect: #filterClassVars
#aspect: #filterClassVars
)
#(#SubChannelInfoSpec
#subAspect: #packageFilter
#aspect: #packageFilter
)
#(#SubChannelInfoSpec
#subAspect: #packageFilterOnInput
#aspect: #packageFilter
)
#(#SubChannelInfoSpec
#subAspect: #methodVisibilityHolder
#aspect: #methodVisibilityHolder
)
#(#SubChannelInfoSpec
#subAspect: #selectedProtocols
#aspect: #selectedProtocols
#callBack: #protocolSelectionChanged
)
#(#SubChannelInfoSpec
#subAspect: #selectionChangeCondition
#aspect: #selectionChangeConditionHolder
)
)
#createNewApplication: true
#createNewBuilder: true
)
#(#SubCanvasSpec
#name: 'MethodList'
#majorKey: #'NewSystemBrowser::MethodList'
#subAspectHolders:
#(#Array
#(#SubChannelInfoSpec
#subAspect: #doubleClickChannel
#callBack: #methodDoubleClicked
)
#(#SubChannelInfoSpec
#subAspect: #immediateUpdate
#aspect: #immediateUpdate
)
#(#SubChannelInfoSpec
#subAspect: #inGeneratorHolder
#aspect: #selectorListGenerator
)
#(#SubChannelInfoSpec
#subAspect: #menuHolder
#aspect: #selectorPopUpMenu
)
#(#SubChannelInfoSpec
#subAspect: #variableFilter
#aspect: #variableFilter
#callBack: #variableSelectionChanged
)
#(#SubChannelInfoSpec
#subAspect: #filterClassVars
#aspect: #filterClassVars
)
#(#SubChannelInfoSpec
#subAspect: #packageFilter
#aspect: #packageFilter
)
#(#SubChannelInfoSpec
#subAspect: #selectedMethods
#aspect: #selectedMethods
#callBack: #methodsSelectionChanged
)
#(#SubChannelInfoSpec
#subAspect: #showMethodInheritance
#aspect: #showMethodInheritance
)
#(#SubChannelInfoSpec
#subAspect: #selectionChangeCondition
#aspect: #selectionChangeConditionHolder
)
)
#createNewApplication: true
#createNewBuilder: true
)
)
)
#handles: #(#Any 0.333333 0.666667 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::NavigatorCanvas andSelector:#multipleFullProtocolBrowserSpec
NewSystemBrowser::NavigatorCanvas new openInterface:#multipleFullProtocolBrowserSpec
"
<resource: #canvas>
^
#(#FullSpec
#name: #multipleFullProtocolBrowserSpec
#window:
#(#WindowSpec
#label: 'ProtocolBrowser'
#name: 'ProtocolBrowser'
#min: #(#Point 0 0)
#bounds: #(#Rectangle 12 22 474 322)
)
#component:
#(#SpecCollection
#collection: #(
#(#VariableHorizontalPanelSpec
#name: 'VariableHorizontalPanel1'
#layout: #(#LayoutFrame 0 0.0 0 0.0 0 1.0 0 1.0)
#component:
#(#SpecCollection
#collection: #(
#(#SubCanvasSpec
#name: 'MethodCategoryList'
#majorKey: #'NewSystemBrowser::MethodCategoryList'
#subAspectHolders:
#(#Array
#(#SubChannelInfoSpec
#subAspect: #doubleClickChannel
#callBack: #protocolDoubleClicked
)
#(#SubChannelInfoSpec
#subAspect: #immediateUpdate
#aspect: #immediateUpdate
)
#(#SubChannelInfoSpec
#subAspect: #inGeneratorHolder
#aspect: #protocolListGenerator
)
#(#SubChannelInfoSpec
#subAspect: #menuHolder
#aspect: #protocolMenu
)
#(#SubChannelInfoSpec
#subAspect: #outGeneratorHolder
#aspect: #selectorListGenerator
)
#(#SubChannelInfoSpec
#subAspect: #packageFilter
#aspect: #packageFilter
)
#(#SubChannelInfoSpec
#subAspect: #selectedProtocols
#aspect: #selectedProtocols
)
#(#SubChannelInfoSpec
#subAspect: #selectionChangeCondition
#aspect: #selectionChangeConditionHolder
)
#(#SubChannelInfoSpec
#subAspect: #noAllItem
#aspect: #noAllItem
)
)
#createNewApplication: true
#createNewBuilder: true
)
#(#SubCanvasSpec
#name: 'MethodList'
#majorKey: #'NewSystemBrowser::MethodList'
#subAspectHolders:
#(#Array
#(#SubChannelInfoSpec
#subAspect: #doubleClickChannel
#callBack: #methodDoubleClicked
)
#(#SubChannelInfoSpec
#subAspect: #immediateUpdate
#aspect: #immediateUpdate
)
#(#SubChannelInfoSpec
#subAspect: #inGeneratorHolder
#aspect: #selectorListGenerator
)
#(#SubChannelInfoSpec
#subAspect: #menuHolder
#aspect: #selectorPopUpMenu
)
#(#SubChannelInfoSpec
#subAspect: #packageFilter
#aspect: #packageFilter
)
#(#SubChannelInfoSpec
#subAspect: #sortBy
#aspect: #sortBy
)
#(#SubChannelInfoSpec
#subAspect: #selectedMethods
#aspect: #selectedMethods
#callBack: #methodsSelectionChanged
)
#(#SubChannelInfoSpec
#subAspect: #selectionChangeCondition
#aspect: #selectionChangeConditionHolder
)
)
#createNewApplication: true
#createNewBuilder: true
)
)
)
#handles: #(#Any 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::NavigatorCanvas andSelector:#multipleNameSpaceBrowserSpec
NewSystemBrowser::NavigatorCanvas new openInterface:#multipleNameSpaceBrowserSpec
"
<resource: #canvas>
^
#(#FullSpec
#name: #multipleNameSpaceBrowserSpec
#window:
#(#WindowSpec
#label: 'NameSpaceBrowser'
#name: 'NameSpaceBrowser'
#min: #(#Point 0 0)
#bounds: #(#Rectangle 18 51 480 351)
)
#component:
#(#SpecCollection
#collection: #(
#(#VariableHorizontalPanelSpec
#name: 'VariableHorizontalPanel1'
#layout: #(#LayoutFrame 0 0.0 0 0.0 0 1.0 0 1.0)
#barWidth: 2
#showHandle: false
#component:
#(#SpecCollection
#collection: #(
#(#SubCanvasSpec
#name: 'NameSpaceList'
#majorKey: #'NewSystemBrowser::NameSpaceList'
#subAspectHolders:
#(#Array
#(#SubChannelInfoSpec
#subAspect: #menuHolder
#aspect: #nameSpacePopUpMenu
)
#(#SubChannelInfoSpec
#subAspect: #hideUnloadedClasses
#aspect: #hideUnloadedClasses
)
#(#SubChannelInfoSpec
#subAspect: #showClassPackages
#aspect: #showClassPackages
)
#(#SubChannelInfoSpec
#subAspect: #doubleClickChannel
#callBack: #nameSpaceDoubleClicked
)
#(#SubChannelInfoSpec
#subAspect: #immediateUpdate
#aspect: #immediateUpdate
)
#(#SubChannelInfoSpec
#subAspect: #inGeneratorHolder
#aspect: #nameSpaceListGenerator
)
#(#SubChannelInfoSpec
#subAspect: #outGeneratorHolder
#aspect: #classListGenerator
)
#(#SubChannelInfoSpec
#subAspect: #selectedNamespaces
#aspect: #selectedNamespaces
#callBack: #nameSpaceSelectionChanged
)
#(#SubChannelInfoSpec
#subAspect: #selectionChangeCondition
#aspect: #selectionChangeConditionHolder
)
)
#createNewApplication: true
#createNewBuilder: true
)
#(#ViewSpec
#name: 'Box1'
#component:
#(#SpecCollection
#collection: #(
#(#VariableVerticalPanelSpec
#name: 'VariableVerticalPanel1'
#layout: #(#LayoutFrame 0 0.0 0 0.0 0 1.0 -25 1.0)
#showHandle: false
#handlePosition: #left
#snapMode: #both
#component:
#(#SpecCollection
#collection: #(
#(#SubCanvasSpec
#name: 'ClassList'
#majorKey: #'NewSystemBrowser::ClassList'
#subAspectHolders:
#(#Array
#(#SubChannelInfoSpec
#subAspect: #doubleClickChannel
#callBack: #classDoubleClicked
)
#(#SubChannelInfoSpec
#subAspect: #hideUnloadedClasses
#aspect: #hideUnloadedClasses
)
#(#SubChannelInfoSpec
#subAspect: #markApplicationsHolder
#aspect: #markApplicationsHolder
)
#(#SubChannelInfoSpec
#subAspect: #immediateUpdate
#aspect: #immediateUpdate
)
#(#SubChannelInfoSpec
#subAspect: #inGeneratorHolder
#aspect: #classListGenerator
)
#(#SubChannelInfoSpec
#subAspect: #meta
#aspect: #meta
)
#(#SubChannelInfoSpec
#subAspect: #organizerMode
#aspect: #organizerMode
)
#(#SubChannelInfoSpec
#subAspect: #outGeneratorHolder
#aspect: #protocolListGenerator
)
#(#SubChannelInfoSpec
#subAspect: #packageFilter
#aspect: #packageFilter
)
#(#SubChannelInfoSpec
#subAspect: #nameSpaceFilter
#aspect: #selectedNamespaces
)
#(#SubChannelInfoSpec
#subAspect: #selectedClasses
#aspect: #selectedClasses
#callBack: #classSelectionChanged
)
#(#SubChannelInfoSpec
#subAspect: #selectionChangeCondition
#aspect: #selectionChangeConditionHolder
)
)
#createNewApplication: true
#createNewBuilder: true
)
#(#SubCanvasSpec
#name: 'VariableList'
#majorKey: #'NewSystemBrowser::VariableList'
#subAspectHolders:
#(#Array
#(#SubChannelInfoSpec
#subAspect: #doubleClickChannel
#callBack: #variableDoubleClicked
)
#(#SubChannelInfoSpec
#subAspect: #classHolder
#aspect: #selectedClasses
)
#(#SubChannelInfoSpec
#subAspect: #menuHolder
#aspect: #variablesPopUpMenu
)
#(#SubChannelInfoSpec
#subAspect: #selectedVariables
#aspect: #variableFilter
)
#(#SubChannelInfoSpec
#subAspect: #showClassVarsInVariableList
#aspect: #filterClassVars
)
#(#SubChannelInfoSpec
#subAspect: #sortVariablesByName
#aspect: #variableListSortByName
)
)
#createNewApplication: true
#createNewBuilder: true
)
)
)
#handles: #(#Any 0.5 1.0)
)
#(#UISubSpecification
#name: 'MetaToggles'
#layout: #(#LayoutFrame 0 0 -25 1 0 1 0 1)
#majorKey: #'NewSystemBrowser::NavigatorModel'
#minorKey: #metaSpec
)
)
)
)
#(#SubCanvasSpec
#name: 'MethodCategoryList'
#majorKey: #'NewSystemBrowser::MethodCategoryList'
#subAspectHolders:
#(#Array
#(#SubChannelInfoSpec
#subAspect: #immediateUpdate
#aspect: #immediateUpdate
)
#(#SubChannelInfoSpec
#subAspect: #inGeneratorHolder
#aspect: #protocolListGenerator
)
#(#SubChannelInfoSpec
#subAspect: #doubleClickChannel
#callBack: #protocolDoubleClicked
)
#(#SubChannelInfoSpec
#subAspect: #menuHolder
#aspect: #protocolMenu
)
#(#SubChannelInfoSpec
#subAspect: #outGeneratorHolder
#aspect: #selectorListGenerator
)
#(#SubChannelInfoSpec
#subAspect: #variableFilter
#aspect: #variableFilter
)
#(#SubChannelInfoSpec
#subAspect: #filterClassVars
#aspect: #filterClassVars
)
#(#SubChannelInfoSpec
#subAspect: #packageFilter
#aspect: #packageFilter
)
#(#SubChannelInfoSpec
#subAspect: #selectedProtocols
#aspect: #selectedProtocols
#callBack: #protocolSelectionChanged
)
#(#SubChannelInfoSpec
#subAspect: #methodVisibilityHolder
#aspect: #methodVisibilityHolder
)
#(#SubChannelInfoSpec
#subAspect: #selectionChangeCondition
#aspect: #selectionChangeConditionHolder
)
)
#createNewApplication: true
#createNewBuilder: true
)
#(#SubCanvasSpec
#name: 'MethodList'
#majorKey: #'NewSystemBrowser::MethodList'
#subAspectHolders:
#(#Array
#(#SubChannelInfoSpec
#subAspect: #doubleClickChannel
#callBack: #methodDoubleClicked
)
#(#SubChannelInfoSpec
#subAspect: #immediateUpdate
#aspect: #immediateUpdate
)
#(#SubChannelInfoSpec
#subAspect: #inGeneratorHolder
#aspect: #selectorListGenerator
)
#(#SubChannelInfoSpec
#subAspect: #menuHolder
#aspect: #selectorPopUpMenu
)
#(#SubChannelInfoSpec
#subAspect: #variableFilter
#aspect: #variableFilter
)
#(#SubChannelInfoSpec
#subAspect: #filterClassVars
#aspect: #filterClassVars
)
#(#SubChannelInfoSpec
#subAspect: #packageFilter
#aspect: #packageFilter
)
#(#SubChannelInfoSpec
#subAspect: #selectedMethods
#aspect: #selectedMethods
#callBack: #methodsSelectionChanged
)
#(#SubChannelInfoSpec
#subAspect: #showMethodInheritance
#aspect: #showMethodInheritance
)
#(#SubChannelInfoSpec
#subAspect: #selectionChangeCondition
#aspect: #selectionChangeConditionHolder
)
)
#createNewApplication: true
#createNewBuilder: true
)
)
)
#handles: #(#Any 0.25 0.5 0.75 1.0)
)
)
)
)
"Modified: / 18.8.2000 / 14:50:21 / 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::NavigatorCanvas andSelector:#multipleNameSpaceFullBrowserSpec
NewSystemBrowser::NavigatorCanvas new openInterface:#multipleNameSpaceFullBrowserSpec
"
<resource: #canvas>
^
#(#FullSpec
#name: #multipleNameSpaceFullBrowserSpec
#window:
#(#WindowSpec
#label: 'NameSpaceBrowser'
#name: 'NameSpaceBrowser'
#min: #(#Point 0 0)
#bounds: #(#Rectangle 127 62 589 362)
)
#component:
#(#SpecCollection
#collection: #(
#(#VariableHorizontalPanelSpec
#name: 'VariableHorizontalPanel1'
#layout: #(#LayoutFrame 0 0.0 0 0.0 0 1.0 0 1.0)
#barWidth: 2
#showHandle: false
#component:
#(#SpecCollection
#collection: #(
#(#VariableVerticalPanelSpec
#name: 'VariableVerticalPanel2'
#component:
#(#SpecCollection
#collection: #(
#(#SubCanvasSpec
#name: 'NameSpaceList'
#majorKey: #'NewSystemBrowser::NamespaceList'
#subAspectHolders:
#(#Array
#(#SubChannelInfoSpec
#subAspect: #menuHolder
#aspect: #nameSpacePopUpMenu
)
#(#SubChannelInfoSpec
#subAspect: #hideUnloadedClasses
#aspect: #hideUnloadedClasses
)
#(#SubChannelInfoSpec
#subAspect: #showClassPackages
#aspect: #showClassPackages
)
#(#SubChannelInfoSpec
#subAspect: #doubleClickChannel
#callBack: #nameSpaceDoubleClicked
)
#(#SubChannelInfoSpec
#subAspect: #immediateUpdate
#aspect: #immediateUpdate
)
#(#SubChannelInfoSpec
#subAspect: #inGeneratorHolder
#aspect: #nameSpaceListGenerator
)
"/ #(#SubChannelInfoSpec
"/ #subAspect: #outGeneratorHolder
"/ #aspect: #classListGenerator
"/ )
#(#SubChannelInfoSpec
#subAspect: #selectedNamespaces
#aspect: #selectedNamespaces
#callBack: #nameSpaceSelectionChanged
)
#(#SubChannelInfoSpec
#subAspect: #selectionChangeCondition
#aspect: #selectionChangeConditionHolder
)
)
#createNewApplication: true
#createNewBuilder: true
)
#(#SubCanvasSpec
#name: 'ClassCategoryList'
#layout: #(#LayoutFrame 0 0.0 0 0.0 0 1.0 0 1.0)
#majorKey: #'NewSystemBrowser::ClassCategoryList'
#subAspectHolders:
#(#Array
#(#SubChannelInfoSpec
#subAspect: #nameSpaceFilter
#aspect: #selectedNamespaces
)
#(#SubChannelInfoSpec
#subAspect: #doubleClickChannel
#callBack: #classCategoryDoubleClicked
)
#(#SubChannelInfoSpec
#subAspect: #forceGeneratorTrigger
#aspect: #forceClassCategoryGeneratorTrigger
)
#(#SubChannelInfoSpec
#subAspect: #hideUnloadedClasses
#aspect: #hideUnloadedClasses
)
#(#SubChannelInfoSpec
#subAspect: #immediateUpdate
#aspect: #immediateUpdate
)
#(#SubChannelInfoSpec
#subAspect: #menuHolder
#aspect: #categoryPopUpMenu
)
#(#SubChannelInfoSpec
#subAspect: #organizerMode
#aspect: #organizerMode
)
#(#SubChannelInfoSpec
#subAspect: #outGeneratorHolder
#aspect: #classListGenerator
)
#(#SubChannelInfoSpec
#subAspect: #selectedCategories
#aspect: #selectedCategories
)
#(#SubChannelInfoSpec
#subAspect: #selectionChangeCondition
#aspect: #selectionChangeCondition
)
#(#SubChannelInfoSpec
#subAspect: #slaveMode
#aspect: #categoryListSlaveMode
)
#(#SubChannelInfoSpec
#subAspect: #updateTrigger
#aspect: #classCategoryListUpdateTrigger
)
)
#createNewApplication: true
#createNewBuilder: true
)
)
)
#handles: #(#Any 0.5 1.0)
)
#(#ViewSpec
#name: 'Box1'
#component:
#(#SpecCollection
#collection: #(
#(#VariableVerticalPanelSpec
#name: 'VariableVerticalPanel1'
#layout: #(#LayoutFrame 0 0.0 0 0.0 0 1.0 -25 1.0)
#showHandle: false
#handlePosition: #left
#snapMode: #both
#component:
#(#SpecCollection
#collection: #(
#(#SubCanvasSpec
#name: 'ClassList'
#majorKey: #'NewSystemBrowser::ClassList'
#subAspectHolders:
#(#Array
#(#SubChannelInfoSpec
#subAspect: #menuHolder
#aspect: #classPopUpMenu
)
#(#SubChannelInfoSpec
#subAspect: #nameSpaceFilter
#aspect: #selectedNamespaces
)
#(#SubChannelInfoSpec
#subAspect: #doubleClickChannel
#callBack: #classDoubleClicked
)
#(#SubChannelInfoSpec
#subAspect: #hideUnloadedClasses
#aspect: #hideUnloadedClasses
)
#(#SubChannelInfoSpec
#subAspect: #markApplicationsHolder
#aspect: #markApplicationsHolder
)
#(#SubChannelInfoSpec
#subAspect: #immediateUpdate
#aspect: #immediateUpdate
)
#(#SubChannelInfoSpec
#subAspect: #inGeneratorHolder
#aspect: #classListGenerator
)
#(#SubChannelInfoSpec
#subAspect: #meta
#aspect: #meta
)
#(#SubChannelInfoSpec
#subAspect: #organizerMode
#aspect: #organizerMode
)
#(#SubChannelInfoSpec
#subAspect: #outGeneratorHolder
#aspect: #protocolListGenerator
)
#(#SubChannelInfoSpec
#subAspect: #packageFilter
#aspect: #packageFilter
)
#(#SubChannelInfoSpec
#subAspect: #selectedClasses
#aspect: #selectedClasses
#callBack: #classSelectionChanged
)
#(#SubChannelInfoSpec
#subAspect: #selectionChangeCondition
#aspect: #selectionChangeConditionHolder
)
)
#createNewApplication: true
#createNewBuilder: true
)
#(#SubCanvasSpec
#name: 'VariableList'
#majorKey: #'NewSystemBrowser::VariableList'
#subAspectHolders:
#(#Array
#(#SubChannelInfoSpec
#subAspect: #doubleClickChannel
#callBack: #variableDoubleClicked
)
#(#SubChannelInfoSpec
#subAspect: #classHolder
#aspect: #selectedClasses
)
#(#SubChannelInfoSpec
#subAspect: #menuHolder
#aspect: #variablesPopUpMenu
)
#(#SubChannelInfoSpec
#subAspect: #selectedVariables
#aspect: #variableFilter
)
#(#SubChannelInfoSpec
#subAspect: #showClassVarsInVariableList
#aspect: #filterClassVars
)
#(#SubChannelInfoSpec
#subAspect: #sortVariablesByName
#aspect: #variableListSortByName
)
)
#createNewApplication: true
#createNewBuilder: true
)
)
)
#handles: #(#Any 0.5 1.0)
)
#(#UISubSpecification
#name: 'MetaToggles'
#layout: #(#LayoutFrame 0 0 -25 1 0 1 0 1)
#majorKey: #'NewSystemBrowser::NavigatorModel'
#minorKey: #metaSpec
)
)
)
)
#(#SubCanvasSpec
#name: 'MethodCategoryList'
#majorKey: #'NewSystemBrowser::MethodCategoryList'
#subAspectHolders:
#(#Array
#(#SubChannelInfoSpec
#subAspect: #immediateUpdate
#aspect: #immediateUpdate
)
#(#SubChannelInfoSpec
#subAspect: #inGeneratorHolder
#aspect: #protocolListGenerator
)
#(#SubChannelInfoSpec
#subAspect: #doubleClickChannel
#callBack: #protocolDoubleClicked
)
#(#SubChannelInfoSpec
#subAspect: #menuHolder
#aspect: #protocolMenu
)
#(#SubChannelInfoSpec
#subAspect: #outGeneratorHolder
#aspect: #selectorListGenerator
)
#(#SubChannelInfoSpec
#subAspect: #variableFilter
#aspect: #variableFilter
)
#(#SubChannelInfoSpec
#subAspect: #filterClassVars
#aspect: #filterClassVars
)
#(#SubChannelInfoSpec
#subAspect: #packageFilter
#aspect: #packageFilter
)
#(#SubChannelInfoSpec
#subAspect: #methodVisibilityHolder
#aspect: #methodVisibilityHolder
)
#(#SubChannelInfoSpec
#subAspect: #selectedProtocols
#aspect: #selectedProtocols
#callBack: #protocolSelectionChanged
)
#(#SubChannelInfoSpec
#subAspect: #selectionChangeCondition
#aspect: #selectionChangeConditionHolder
)
)
#createNewApplication: true
#createNewBuilder: true
)
#(#SubCanvasSpec
#name: 'MethodList'
#majorKey: #'NewSystemBrowser::MethodList'
#subAspectHolders:
#(#Array
#(#SubChannelInfoSpec
#subAspect: #doubleClickChannel
#callBack: #methodDoubleClicked
)
#(#SubChannelInfoSpec
#subAspect: #immediateUpdate
#aspect: #immediateUpdate
)
#(#SubChannelInfoSpec
#subAspect: #inGeneratorHolder
#aspect: #selectorListGenerator
)
#(#SubChannelInfoSpec
#subAspect: #menuHolder
#aspect: #selectorPopUpMenu
)
#(#SubChannelInfoSpec
#subAspect: #variableFilter
#aspect: #variableFilter
)
#(#SubChannelInfoSpec
#subAspect: #filterClassVars
#aspect: #filterClassVars
)
#(#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
)
)
)
#handles: #(#Any 0.25 0.5 0.75 1.0)
)
)
)
)
"Modified: / 18.8.2000 / 20:01:39 / 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::NavigatorCanvas andSelector:#multipleProjectBrowserSpec
NewSystemBrowser::NavigatorCanvas new openInterface:#multipleProjectBrowserSpec
"
<resource: #canvas>
^
#(#FullSpec
#name: #multipleProjectBrowserSpec
#window:
#(#WindowSpec
#label: 'ProjectBrowser'
#name: 'ProjectBrowser'
#min: #(#Point 0 0)
#bounds: #(#Rectangle 18 51 480 351)
)
#component:
#(#SpecCollection
#collection: #(
#(#VariableHorizontalPanelSpec
#name: 'VariableHorizontalPanel1'
#layout: #(#LayoutFrame 0 0.0 0 0.0 0 1.0 0 1.0)
#barWidth: 2
#showHandle: false
#component:
#(#SpecCollection
#collection: #(
#(#SubCanvasSpec
#name: 'ProjectList'
#majorKey: #'NewSystemBrowser::ProjectList'
#subAspectHolders:
#(#Array
#(#SubChannelInfoSpec
#subAspect: #menuHolder
#aspect: #projectPopUpMenu
)
#(#SubChannelInfoSpec
#subAspect: #hideUnloadedClasses
#aspect: #hideUnloadedClasses
)
#(#SubChannelInfoSpec
#subAspect: #doubleClickChannel
#callBack: #projectDoubleClicked
)
#(#SubChannelInfoSpec
#subAspect: #showClassPackages
#aspect: #showClassPackages
)
#(#SubChannelInfoSpec
#subAspect: #immediateUpdate
#aspect: #immediateUpdate
)
#(#SubChannelInfoSpec
#subAspect: #inGeneratorHolder
#aspect: #projectListGenerator
)
#(#SubChannelInfoSpec
#subAspect: #outGeneratorHolder
#aspect: #classListGenerator
)
#(#SubChannelInfoSpec
#subAspect: #selectedProjects
#aspect: #selectedProjects
#callBack: #projectSelectionChanged
)
#(#SubChannelInfoSpec
#subAspect: #selectionChangeCondition
#aspect: #selectionChangeConditionHolder
)
)
#createNewApplication: true
#createNewBuilder: true
)
#(#ViewSpec
#name: 'Box1'
#component:
#(#SpecCollection
#collection: #(
#(#VariableVerticalPanelSpec
#name: 'VariableVerticalPanel1'
#layout: #(#LayoutFrame 0 0.0 0 0.0 0 1.0 -25 1.0)
#showHandle: false
#handlePosition: #left
#snapMode: #both
#component:
#(#SpecCollection
#collection: #(
#(#SubCanvasSpec
#name: 'ClassList'
#majorKey: #'NewSystemBrowser::ClassList'
#subAspectHolders:
#(#Array
#(#SubChannelInfoSpec
#subAspect: #doubleClickChannel
#callBack: #classDoubleClicked
)
#(#SubChannelInfoSpec
#subAspect: #hideUnloadedClasses
#aspect: #hideUnloadedClasses
)
#(#SubChannelInfoSpec
#subAspect: #markApplicationsHolder
#aspect: #markApplicationsHolder
)
#(#SubChannelInfoSpec
#subAspect: #immediateUpdate
#aspect: #immediateUpdate
)
#(#SubChannelInfoSpec
#subAspect: #inGeneratorHolder
#aspect: #classListGenerator
)
#(#SubChannelInfoSpec
#subAspect: #meta
#aspect: #meta
)
#(#SubChannelInfoSpec
#subAspect: #organizerMode
#aspect: #organizerMode
)
#(#SubChannelInfoSpec
#subAspect: #outGeneratorHolder
#aspect: #protocolListGenerator
)
#(#SubChannelInfoSpec
#subAspect: #packageFilter
#aspect: #packageFilter
)
#(#SubChannelInfoSpec
#subAspect: #selectedClasses
#aspect: #selectedClasses
#callBack: #classSelectionChanged
)
#(#SubChannelInfoSpec
#subAspect: #selectionChangeCondition
#aspect: #selectionChangeConditionHolder
)
)
#createNewApplication: true
#createNewBuilder: true
)
#(#SubCanvasSpec
#name: 'VariableList'
#majorKey: #'NewSystemBrowser::VariableList'
#subAspectHolders:
#(#Array
#(#SubChannelInfoSpec
#subAspect: #doubleClickChannel
#callBack: #variableDoubleClicked
)
#(#SubChannelInfoSpec
#subAspect: #classHolder
#aspect: #selectedClasses
)
#(#SubChannelInfoSpec
#subAspect: #menuHolder
#aspect: #variablesPopUpMenu
)
#(#SubChannelInfoSpec
#subAspect: #selectedVariables
#aspect: #variableFilter
)
#(#SubChannelInfoSpec
#subAspect: #showClassVarsInVariableList
#aspect: #filterClassVars
)
#(#SubChannelInfoSpec
#subAspect: #sortVariablesByName
#aspect: #variableListSortByName
)
)
#createNewApplication: true
#createNewBuilder: true
)
)
)
#handles: #(#Any 0.5 1.0)
)
#(#UISubSpecification
#name: 'MetaToggles'
#layout: #(#LayoutFrame 0 0 -25 1 0 1 0 1)
#majorKey: #'NewSystemBrowser::NavigatorModel'
#minorKey: #metaSpec
)
)
)
)
#(#SubCanvasSpec
#name: 'MethodCategoryList'
#majorKey: #'NewSystemBrowser::MethodCategoryList'
#subAspectHolders:
#(#Array
#(#SubChannelInfoSpec
#subAspect: #doubleClickChannel
#callBack: #protocolDoubleClicked
)
#(#SubChannelInfoSpec
#subAspect: #immediateUpdate
#aspect: #immediateUpdate
)
#(#SubChannelInfoSpec
#subAspect: #inGeneratorHolder
#aspect: #protocolListGenerator
)
#(#SubChannelInfoSpec
#subAspect: #menuHolder
#aspect: #protocolMenu
)
#(#SubChannelInfoSpec
#subAspect: #outGeneratorHolder
#aspect: #selectorListGenerator
)
#(#SubChannelInfoSpec
#subAspect: #variableFilter
#aspect: #variableFilter
#callBack: #variableSelectionChanged
)
#(#SubChannelInfoSpec
#subAspect: #filterClassVars
#aspect: #filterClassVars
)
#(#SubChannelInfoSpec
#subAspect: #packageFilter
#aspect: #packageFilter
)
#(#SubChannelInfoSpec
#subAspect: #selectedProtocols
#aspect: #selectedProtocols
#callBack: #protocolSelectionChanged
)
#(#SubChannelInfoSpec
#subAspect: #methodVisibilityHolder
#aspect: #methodVisibilityHolder
)
#(#SubChannelInfoSpec
#subAspect: #selectionChangeCondition
#aspect: #selectionChangeConditionHolder
)
)
#createNewApplication: true
#createNewBuilder: true
)
#(#SubCanvasSpec
#name: 'MethodList'
#majorKey: #'NewSystemBrowser::MethodList'
#subAspectHolders:
#(#Array
#(#SubChannelInfoSpec
#subAspect: #doubleClickChannel
#callBack: #methodDoubleClicked
)
#(#SubChannelInfoSpec
#subAspect: #immediateUpdate
#aspect: #immediateUpdate
)
#(#SubChannelInfoSpec
#subAspect: #inGeneratorHolder
#aspect: #selectorListGenerator
)
#(#SubChannelInfoSpec
#subAspect: #menuHolder
#aspect: #selectorPopUpMenu
)
#(#SubChannelInfoSpec
#subAspect: #variableFilter
#aspect: #variableFilter
#callBack: #variableSelectionChanged
)
#(#SubChannelInfoSpec
#subAspect: #filterClassVars
#aspect: #filterClassVars
)
#(#SubChannelInfoSpec
#subAspect: #packageFilter
#aspect: #packageFilter
)
#(#SubChannelInfoSpec
#subAspect: #selectedMethods
#aspect: #selectedMethods
#callBack: #methodsSelectionChanged
)
#(#SubChannelInfoSpec
#subAspect: #showMethodInheritance
#aspect: #showMethodInheritance
)
#(#SubChannelInfoSpec
#subAspect: #selectionChangeCondition
#aspect: #selectionChangeConditionHolder
)
)
#createNewApplication: true
#createNewBuilder: true
)
)
)
#handles: #(#Any 0.25 0.5 0.75 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::NavigatorCanvas andSelector:#multipleProjectFullBrowserSpec
NewSystemBrowser::NavigatorCanvas new openInterface:#multipleProjectFullBrowserSpec
"
<resource: #canvas>
^
#(#FullSpec
#name: #multipleProjectFullBrowserSpec
#window:
#(#WindowSpec
#label: 'ProjectBrowser'
#name: 'ProjectBrowser'
#min: #(#Point 0 0)
#bounds: #(#Rectangle 23 111 485 411)
)
#component:
#(#SpecCollection
#collection: #(
#(#VariableHorizontalPanelSpec
#name: 'VariableHorizontalPanel1'
#layout: #(#LayoutFrame 0 0.0 0 0.0 0 1.0 0 1.0)
#barWidth: 2
#showHandle: false
#component:
#(#SpecCollection
#collection: #(
#(#VariableVerticalPanelSpec
#name: 'VariableVerticalPanel2'
#component:
#(#SpecCollection
#collection: #(
#(#SubCanvasSpec
#name: 'ProjectList'
#majorKey: #'NewSystemBrowser::ProjectList'
#subAspectHolders:
#(#Array
#(#SubChannelInfoSpec
#subAspect: #menuHolder
#aspect: #projectPopUpMenu
)
#(#SubChannelInfoSpec
#subAspect: #hideUnloadedClasses
#aspect: #hideUnloadedClasses
)
#(#SubChannelInfoSpec
#subAspect: #doubleClickChannel
#callBack: #projectDoubleClicked
)
#(#SubChannelInfoSpec
#subAspect: #showClassPackages
#aspect: #showClassPackages
)
#(#SubChannelInfoSpec
#subAspect: #immediateUpdate
#aspect: #immediateUpdate
)
#(#SubChannelInfoSpec
#subAspect: #inGeneratorHolder
#aspect: #projectListGenerator
)
"/ #(#SubChannelInfoSpec
"/ #subAspect: #outGeneratorHolder
"/ #aspect: #classListGenerator
"/ )
#(#SubChannelInfoSpec
#subAspect: #selectedProjects
#aspect: #selectedProjects
#callBack: #projectSelectionChanged
)
#(#SubChannelInfoSpec
#subAspect: #selectionChangeCondition
#aspect: #selectionChangeConditionHolder
)
)
#createNewApplication: true
#createNewBuilder: true
)
#(#SubCanvasSpec
#name: 'ClassCategoryList'
#layout: #(#LayoutFrame 0 0.0 0 0.0 0 1.0 0 1.0)
#majorKey: #'NewSystemBrowser::ClassCategoryList'
#subAspectHolders:
#(#Array
#(#SubChannelInfoSpec
#subAspect: #packageFilter
#aspect: #selectedProjects
)
#(#SubChannelInfoSpec
#subAspect: #doubleClickChannel
#callBack: #classCategoryDoubleClicked
)
#(#SubChannelInfoSpec
#subAspect: #forceGeneratorTrigger
#aspect: #forceClassCategoryGeneratorTrigger
)
#(#SubChannelInfoSpec
#subAspect: #hideUnloadedClasses
#aspect: #hideUnloadedClasses
)
#(#SubChannelInfoSpec
#subAspect: #immediateUpdate
#aspect: #immediateUpdate
)
#(#SubChannelInfoSpec
#subAspect: #menuHolder
#aspect: #categoryPopUpMenu
)
#(#SubChannelInfoSpec
#subAspect: #organizerMode
#aspect: #organizerMode
)
#(#SubChannelInfoSpec
#subAspect: #outGeneratorHolder
#aspect: #classListGenerator
)
#(#SubChannelInfoSpec
#subAspect: #selectedCategories
#aspect: #selectedCategories
)
#(#SubChannelInfoSpec
#subAspect: #selectionChangeCondition
#aspect: #selectionChangeCondition
)
#(#SubChannelInfoSpec
#subAspect: #slaveMode
#aspect: #categoryListSlaveMode
)
#(#SubChannelInfoSpec
#subAspect: #updateTrigger
#aspect: #classCategoryListUpdateTrigger
)
)
#createNewApplication: true
#createNewBuilder: true
)
)
)
#handles: #(#Any 0.5 1.0)
)
#(#ViewSpec
#name: 'Box1'
#component:
#(#SpecCollection
#collection: #(
#(#VariableVerticalPanelSpec
#name: 'VariableVerticalPanel1'
#layout: #(#LayoutFrame 0 0.0 0 0.0 0 1.0 -25 1.0)
#showHandle: false
#handlePosition: #left
#snapMode: #both
#component:
#(#SpecCollection
#collection: #(
#(#SubCanvasSpec
#name: 'ClassList'
#majorKey: #'NewSystemBrowser::ClassList'
#subAspectHolders:
#(#Array
#(#SubChannelInfoSpec
#subAspect: #menuHolder
#aspect: #classPopUpMenu
)
#(#SubChannelInfoSpec
#subAspect: #packageFilter
#aspect: #selectedProjects
)
#(#SubChannelInfoSpec
#subAspect: #doubleClickChannel
#callBack: #classDoubleClicked
)
#(#SubChannelInfoSpec
#subAspect: #hideUnloadedClasses
#aspect: #hideUnloadedClasses
)
#(#SubChannelInfoSpec
#subAspect: #markApplicationsHolder
#aspect: #markApplicationsHolder
)
#(#SubChannelInfoSpec
#subAspect: #immediateUpdate
#aspect: #immediateUpdate
)
#(#SubChannelInfoSpec
#subAspect: #inGeneratorHolder
#aspect: #classListGenerator
)
#(#SubChannelInfoSpec
#subAspect: #meta
#aspect: #meta
)
#(#SubChannelInfoSpec
#subAspect: #organizerMode
#aspect: #organizerMode
)
#(#SubChannelInfoSpec
#subAspect: #outGeneratorHolder
#aspect: #protocolListGenerator
)
#(#SubChannelInfoSpec
#subAspect: #selectedClasses
#aspect: #selectedClasses
#callBack: #classSelectionChanged
)
#(#SubChannelInfoSpec
#subAspect: #selectionChangeCondition
#aspect: #selectionChangeConditionHolder
)
)
#createNewApplication: true
#createNewBuilder: true
)
#(#SubCanvasSpec
#name: 'VariableList'
#majorKey: #'NewSystemBrowser::VariableList'
#subAspectHolders:
#(#Array
#(#SubChannelInfoSpec
#subAspect: #doubleClickChannel
#callBack: #variableDoubleClicked
)
#(#SubChannelInfoSpec
#subAspect: #classHolder
#aspect: #selectedClasses
)
#(#SubChannelInfoSpec
#subAspect: #menuHolder
#aspect: #variablesPopUpMenu
)
#(#SubChannelInfoSpec
#subAspect: #selectedVariables
#aspect: #variableFilter
)
#(#SubChannelInfoSpec
#subAspect: #showClassVarsInVariableList
#aspect: #filterClassVars
)
#(#SubChannelInfoSpec
#subAspect: #sortVariablesByName
#aspect: #variableListSortByName
)
)
#createNewApplication: true
#createNewBuilder: true
)
)
)
#handles: #(#Any 0.5 1.0)
)
#(#UISubSpecification
#name: 'MetaToggles'
#layout: #(#LayoutFrame 0 0 -25 1 0 1 0 1)
#majorKey: #'NewSystemBrowser::NavigatorModel'
#minorKey: #metaSpec
)
)
)
)
#(#SubCanvasSpec
#name: 'MethodCategoryList'
#majorKey: #'NewSystemBrowser::MethodCategoryList'
#subAspectHolders:
#(#Array
#(#SubChannelInfoSpec
#subAspect: #doubleClickChannel
#callBack: #protocolDoubleClicked
)
#(#SubChannelInfoSpec
#subAspect: #immediateUpdate
#aspect: #immediateUpdate
)
#(#SubChannelInfoSpec
#subAspect: #inGeneratorHolder
#aspect: #protocolListGenerator
)
#(#SubChannelInfoSpec
#subAspect: #menuHolder
#aspect: #protocolMenu
)
#(#SubChannelInfoSpec
#subAspect: #outGeneratorHolder
#aspect: #selectorListGenerator
)
#(#SubChannelInfoSpec
#subAspect: #variableFilter
#aspect: #variableFilter
#callBack: #variableSelectionChanged
)
#(#SubChannelInfoSpec
#subAspect: #filterClassVars
#aspect: #filterClassVars
)
#(#SubChannelInfoSpec
#subAspect: #packageFilter
#aspect: #packageFilter
)
#(#SubChannelInfoSpec
#subAspect: #methodVisibilityHolder
#aspect: #methodVisibilityHolder
)
#(#SubChannelInfoSpec
#subAspect: #selectedProtocols
#aspect: #selectedProtocols
#callBack: #protocolSelectionChanged
)
#(#SubChannelInfoSpec
#subAspect: #selectionChangeCondition
#aspect: #selectionChangeConditionHolder
)
)
#createNewApplication: true
#createNewBuilder: true
)
#(#SubCanvasSpec
#name: 'MethodList'
#majorKey: #'NewSystemBrowser::MethodList'
#subAspectHolders:
#(#Array
#(#SubChannelInfoSpec
#subAspect: #doubleClickChannel
#callBack: #methodDoubleClicked
)
#(#SubChannelInfoSpec
#subAspect: #immediateUpdate
#aspect: #immediateUpdate
)
#(#SubChannelInfoSpec
#subAspect: #inGeneratorHolder
#aspect: #selectorListGenerator
)
#(#SubChannelInfoSpec
#subAspect: #menuHolder
#aspect: #selectorPopUpMenu
)
#(#SubChannelInfoSpec
#subAspect: #variableFilter
#aspect: #variableFilter
#callBack: #variableSelectionChanged
)
#(#SubChannelInfoSpec
#subAspect: #filterClassVars
#aspect: #filterClassVars
)
#(#SubChannelInfoSpec
#subAspect: #packageFilter
#aspect: #packageFilter
)
#(#SubChannelInfoSpec
#subAspect: #selectedMethods
#aspect: #selectedMethods
#callBack: #methodsSelectionChanged
)
#(#SubChannelInfoSpec
#subAspect: #showMethodInheritance
#aspect: #showMethodInheritance
)
#(#SubChannelInfoSpec
#subAspect: #selectionChangeCondition
#aspect: #selectionChangeConditionHolder
)
)
#createNewApplication: true
#createNewBuilder: true
)
)
)
#handles: #(#Any 0.25 0.5 0.75 1.0)
)
)
)
)
"Modified: / 18.8.2000 / 20:01:55 / 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::NavigatorCanvas andSelector:#multipleProtocolBrowserSpec
NewSystemBrowser::NavigatorCanvas new openInterface:#multipleProtocolBrowserSpec
"
<resource: #canvas>
^
#(#FullSpec
#name: #multipleProtocolBrowserSpec
#window:
#(#WindowSpec
#label: 'ProtocolBrowser'
#name: 'ProtocolBrowser'
#min: #(#Point 0 0)
#bounds: #(#Rectangle 12 22 474 322)
)
#component:
#(#SpecCollection
#collection: #(
#(#VariableHorizontalPanelSpec
#name: 'VariableHorizontalPanel1'
#layout: #(#LayoutFrame 0 0.0 0 0.0 0 1.0 0 1.0)
#component:
#(#SpecCollection
#collection: #(
#(#SubCanvasSpec
#name: 'MethodCategoryList'
#majorKey: #'NewSystemBrowser::MethodCategoryList'
#subAspectHolders:
#(#Array
#(#SubChannelInfoSpec
#subAspect: #doubleClickChannel
#callBack: #protocolDoubleClicked
)
#(#SubChannelInfoSpec
#subAspect: #immediateUpdate
#aspect: #immediateUpdate
)
#(#SubChannelInfoSpec
#subAspect: #inGeneratorHolder
#aspect: #protocolListGenerator
)
#(#SubChannelInfoSpec
#subAspect: #menuHolder
#aspect: #protocolMenu
)
#(#SubChannelInfoSpec
#subAspect: #outGeneratorHolder
#aspect: #selectorListGenerator
)
#(#SubChannelInfoSpec
#subAspect: #packageFilter
#aspect: #packageFilter
)
#(#SubChannelInfoSpec
#subAspect: #selectedProtocols
#aspect: #selectedProtocols
)
#(#SubChannelInfoSpec
#subAspect: #selectionChangeCondition
#aspect: #selectionChangeConditionHolder
)
#(#SubChannelInfoSpec
#subAspect: #noAllItem
#aspect: #noAllItem
)
)
#createNewApplication: true
#createNewBuilder: true
)
#(#SubCanvasSpec
#name: 'MethodList'
#majorKey: #'NewSystemBrowser::MethodList'
#subAspectHolders:
#(#Array
#(#SubChannelInfoSpec
#subAspect: #doubleClickChannel
#callBack: #methodDoubleClicked
)
#(#SubChannelInfoSpec
#subAspect: #immediateUpdate
#aspect: #immediateUpdate
)
#(#SubChannelInfoSpec
#subAspect: #inGeneratorHolder
#aspect: #selectorListGenerator
)
#(#SubChannelInfoSpec
#subAspect: #menuHolder
#aspect: #selectorPopUpMenu
)
#(#SubChannelInfoSpec
#subAspect: #packageFilter
#aspect: #packageFilter
)
#(#SubChannelInfoSpec
#subAspect: #sortBy
#aspect: #sortBy
)
#(#SubChannelInfoSpec
#subAspect: #selectedMethods
#aspect: #selectedMethods
#callBack: #methodsSelectionChanged
)
#(#SubChannelInfoSpec
#subAspect: #selectionChangeCondition
#aspect: #selectionChangeConditionHolder
)
)
#createNewApplication: true
#createNewBuilder: true
)
)
)
#handles: #(#Any 0.5 1.0)
)
)
)
)
!
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::NavigatorCanvas andSelector:#selectorBrowserSpec
NewSystemBrowser::NavigatorCanvas new openInterface:#selectorBrowserSpec
"
<resource: #canvas>
^
#(#FullSpec
#name: #selectorBrowserSpec
#window:
#(#WindowSpec
#label: 'SelectorBrowser'
#name: 'SelectorBrowser'
#min: #(#Point 0 0)
#bounds: #(#Rectangle 12 22 474 322)
)
#component:
#(#SpecCollection
#collection: #(
#(#VariableHorizontalPanelSpec
#name: 'VariableHorizontalPanel1'
#layout: #(#LayoutFrame 0 0.0 0 0.0 0 1.0 0 1.0)
#barWidth: 2
#showHandle: false
#component:
#(#SpecCollection
#collection: #(
#(#SubCanvasSpec
#name: 'AllMethodCategoryList'
#majorKey: #'NewSystemBrowser::FullMethodCategoryList'
#subAspectHolders:
#(#Array
#(#SubChannelInfoSpec
#subAspect: #doubleClickChannel
#callBack: #protocolDoubleClicked
)
#(#SubChannelInfoSpec
#subAspect: #immediateUpdate
#aspect: #immediateUpdate
)
#(#SubChannelInfoSpec
#subAspect: #inGeneratorHolder
#aspect: #protocolListGenerator
)
#(#SubChannelInfoSpec
#subAspect: #menuHolder
#aspect: #protocolMenu
)
#(#SubChannelInfoSpec
#subAspect: #outGeneratorHolder
#aspect: #selectorListGenerator
)
#(#SubChannelInfoSpec
#subAspect: #packageFilter
#aspect: #packageFilter
)
#(#SubChannelInfoSpec
#subAspect: #selectedProtocols
#aspect: #selectedProtocols
#callBack: #protocolSelectionChanged
)
#(#SubChannelInfoSpec
#subAspect: #selectionChangeCondition
#aspect: #selectionChangeConditionHolder
)
)
#createNewApplication: true
#createNewBuilder: true
)
#(#SubCanvasSpec
#name: 'ImplementedMethodList'
#majorKey: #'NewSystemBrowser::ImplementingMethodList'
#subAspectHolders:
#(#Array
#(#SubChannelInfoSpec
#subAspect: #doubleClickChannel
#callBack: #xxxDoubleClicked
)
#(#SubChannelInfoSpec
#subAspect: #immediateUpdate
#aspect: #immediateUpdate
)
#(#SubChannelInfoSpec
#subAspect: #inGeneratorHolder
#aspect: #selectorListGenerator
)
#(#SubChannelInfoSpec
#subAspect: #menuHolder
#aspect: #selectorPopUpMenu
)
#(#SubChannelInfoSpec
#subAspect: #outGeneratorHolder
#aspect: #implementingClassListGenerator
)
#(#SubChannelInfoSpec
#subAspect: #packageFilter
#aspect: #packageFilter
)
#(#SubChannelInfoSpec
#subAspect: #selectionChangeCondition
#aspect: #selectionChangeConditionHolder
)
)
#createNewApplication: true
#createNewBuilder: true
)
#(#SubCanvasSpec
#name: 'ImplementingClassList'
#majorKey: #'NewSystemBrowser::ImplementingClassList'
#minorKey: #windowSpec
#subAspectHolders:
#(#Array
#(#SubChannelInfoSpec
#subAspect: #doubleClickChannel
#callBack: #methodDoubleClicked
)
#(#SubChannelInfoSpec
#subAspect: #immediateUpdate
#aspect: #immediateUpdate
)
#(#SubChannelInfoSpec
#subAspect: #inGeneratorHolder
#aspect: #implementingClassListGenerator
)
#(#SubChannelInfoSpec
#subAspect: #selectedMethods
#aspect: #selectedMethods
#callBack: #methodsSelectionChanged
)
#(#SubChannelInfoSpec
#subAspect: #selectionChangeCondition
#aspect: #selectionChangeConditionHolder
)
)
#createNewApplication: true
#createNewBuilder: true
)
)
)
#handles: #(#Any 0.333333 0.666667 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::NavigatorCanvas andSelector:#singleCategoryBrowserSpec
NewSystemBrowser::NavigatorCanvas new openInterface:#singleCategoryBrowserSpec
"
<resource: #canvas>
^
#(#FullSpec
#name: #singleCategoryBrowserSpec
#window:
#(#WindowSpec
#label: 'CategoryBrowser'
#name: 'CategoryBrowser'
#min: #(#Point 0 0)
#bounds: #(#Rectangle 18 51 480 351)
)
#component:
#(#SpecCollection
#collection: #(
#(#VariableHorizontalPanelSpec
#name: 'VariableHorizontalPanel1'
#layout: #(#LayoutFrame 0 0.0 0 0.0 0 1.0 0 1.0)
#barWidth: 2
#showHandle: false
#component:
#(#SpecCollection
#collection: #(
#(#ViewSpec
#name: 'Box1'
#component:
#(#SpecCollection
#collection: #(
#(#SubCanvasSpec
#name: 'PseudoCategoryList'
#layout: #(#LayoutFrame 0 0.0 0 0 0 1.0 25 0)
#majorKey: #'NewSystemBrowser::ClassCategoryList'
#minorKey: #singleCategoryWindowSpec
#subAspectHolders:
#(#Array
#(#SubChannelInfoSpec
#subAspect: #menuHolder
#aspect: #categoryPopUpMenu
)
#(#SubChannelInfoSpec
#subAspect: #immediateUpdate
#aspect: #immediateUpdate
)
#(#SubChannelInfoSpec
#subAspect: #hideUnloadedClasses
#aspect: #hideUnloadedClasses
)
#(#SubChannelInfoSpec
#subAspect: #showClassPackages
#aspect: #showClassPackages
)
#(#SubChannelInfoSpec
#subAspect: #inGeneratorHolder
#aspect: #categoryListGenerator
)
#(#SubChannelInfoSpec
#subAspect: #outGeneratorHolder
#aspect: #classListGenerator
)
#(#SubChannelInfoSpec
#subAspect: #selectedCategories
#aspect: #selectedCategories
)
)
#createNewApplication: true
#createNewBuilder: true
)
#(#VariableVerticalPanelSpec
#name: 'VariableVerticalPanel1'
#layout: #(#LayoutFrame 0 0.0 25 0.0 0 1.0 -25 1.0)
#showHandle: false
#handlePosition: #left
#snapMode: #both
#component:
#(#SpecCollection
#collection: #(
#(#SubCanvasSpec
#name: 'ClassList'
#majorKey: #'NewSystemBrowser::ClassList'
#subAspectHolders:
#(#Array
#(#SubChannelInfoSpec
#subAspect: #doubleClickChannel
#callBack: #classDoubleClicked
)
#(#SubChannelInfoSpec
#subAspect: #hideUnloadedClasses
#aspect: #hideUnloadedClasses
)
#(#SubChannelInfoSpec
#subAspect: #markApplicationsHolder
#aspect: #markApplicationsHolder
)
#(#SubChannelInfoSpec
#subAspect: #immediateUpdate
#aspect: #immediateUpdate
)
#(#SubChannelInfoSpec
#subAspect: #inGeneratorHolder
#aspect: #classListGenerator
)
#(#SubChannelInfoSpec
#subAspect: #menuHolder
#aspect: #classPopUpMenu
)
#(#SubChannelInfoSpec
#subAspect: #meta
#aspect: #meta
)
#(#SubChannelInfoSpec
#subAspect: #organizerMode
#aspect: #organizerMode
)
#(#SubChannelInfoSpec
#subAspect: #outGeneratorHolder
#aspect: #protocolListGenerator
)
#(#SubChannelInfoSpec
#subAspect: #packageFilter
#aspect: #packageFilter
)
#(#SubChannelInfoSpec
#subAspect: #selectedClasses
#aspect: #selectedClasses
#callBack: #classSelectionChanged
)
#(#SubChannelInfoSpec
#subAspect: #selectionChangeCondition
#aspect: #selectionChangeConditionHolder
)
)
#createNewApplication: true
#createNewBuilder: true
)
#(#SubCanvasSpec
#name: 'VariableList'
#majorKey: #'NewSystemBrowser::VariableList'
#subAspectHolders:
#(#Array
#(#SubChannelInfoSpec
#subAspect: #doubleClickChannel
#callBack: #variableDoubleClicked
)
#(#SubChannelInfoSpec
#subAspect: #classHolder
#aspect: #selectedClasses
)
#(#SubChannelInfoSpec
#subAspect: #menuHolder
#aspect: #variablesMenuHolder
)
#(#SubChannelInfoSpec
#subAspect: #menuHolder
#aspect: #variablesPopUpMenu
)
#(#SubChannelInfoSpec
#subAspect: #selectedVariables
#aspect: #variableFilter
)
#(#SubChannelInfoSpec
#subAspect: #showClassVarsInVariableList
#aspect: #filterClassVars
)
#(#SubChannelInfoSpec
#subAspect: #sortVariablesByName
#aspect: #variableListSortByName
)
)
#createNewApplication: true
#createNewBuilder: true
)
)
)
#handles: #(#Any 0.5 1.0)
)
#(#UISubSpecification
#name: 'MetaToggles'
#layout: #(#LayoutFrame 0 0 -25 1 0 1 0 1)
#majorKey: #'NewSystemBrowser::NavigatorModel'
#minorKey: #metaSpec
)
)
)
)
#(#SubCanvasSpec
#name: 'MethodCategoryList'
#majorKey: #'NewSystemBrowser::MethodCategoryList'
#subAspectHolders:
#(#Array
#(#SubChannelInfoSpec
#subAspect: #doubleClickChannel
#callBack: #protocolDoubleClicked
)
#(#SubChannelInfoSpec
#subAspect: #immediateUpdate
#aspect: #immediateUpdate
)
#(#SubChannelInfoSpec
#subAspect: #inGeneratorHolder
#aspect: #protocolListGenerator
)
#(#SubChannelInfoSpec
#subAspect: #menuHolder
#aspect: #protocolMenu
)
#(#SubChannelInfoSpec
#subAspect: #outGeneratorHolder
#aspect: #selectorListGenerator
)
#(#SubChannelInfoSpec
#subAspect: #variableFilter
#aspect: #variableFilter
)
#(#SubChannelInfoSpec
#subAspect: #filterClassVars
#aspect: #filterClassVars
)
#(#SubChannelInfoSpec
#subAspect: #packageFilter
#aspect: #packageFilter
)
#(#SubChannelInfoSpec
#subAspect: #selectedProtocols
#aspect: #selectedProtocols
#callBack: #protocolSelectionChanged
)
#(#SubChannelInfoSpec
#subAspect: #methodVisibilityHolder
#aspect: #methodVisibilityHolder
)
#(#SubChannelInfoSpec
#subAspect: #selectionChangeCondition
#aspect: #selectionChangeConditionHolder
)
)
#createNewApplication: true
#createNewBuilder: true
)
#(#SubCanvasSpec
#name: 'MethodList'
#majorKey: #'NewSystemBrowser::MethodList'
#subAspectHolders:
#(#Array
#(#SubChannelInfoSpec
#subAspect: #doubleClickChannel
#callBack: #methodDoubleClicked
)
#(#SubChannelInfoSpec
#subAspect: #immediateUpdate
#aspect: #immediateUpdate
)
#(#SubChannelInfoSpec
#subAspect: #inGeneratorHolder
#aspect: #selectorListGenerator
)
#(#SubChannelInfoSpec
#subAspect: #menuHolder
#aspect: #selectorPopUpMenu
)
#(#SubChannelInfoSpec
#subAspect: #variableFilter
#aspect: #variableFilter
)
#(#SubChannelInfoSpec
#subAspect: #filterClassVars
#aspect: #filterClassVars
)
#(#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
)
)
)
#handles: #(#Any 0.333333 0.666667 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::NavigatorCanvas andSelector:#singleClassBrowserSpec
NewSystemBrowser::NavigatorCanvas new openInterface:#singleClassBrowserSpec
"
<resource: #canvas>
^
#(#FullSpec
#name: #singleClassBrowserSpec
#window:
#(#WindowSpec
#label: 'ClassBrowser'
#name: 'ClassBrowser'
#min: #(#Point 0 0)
#bounds: #(#Rectangle 16 46 478 346)
)
#component:
#(#SpecCollection
#collection: #(
#(#VariableHorizontalPanelSpec
#name: 'VariableHorizontalPanel1'
#layout: #(#LayoutFrame 0 0.0 0 0.0 0 1.0 0 1.0)
#barWidth: 2
#showHandle: false
#component:
#(#SpecCollection
#collection: #(
#(#ViewSpec
#name: 'Box1'
#component:
#(#SpecCollection
#collection: #(
#(#SubCanvasSpec
#name: 'PseudoClassList'
#layout: #(#LayoutFrame 0 0.0 0 0 0 1.0 25 0)
#majorKey: #'NewSystemBrowser::ClassList'
#minorKey: #singleClassWindowSpec
#subAspectHolders:
#(#Array
#(#SubChannelInfoSpec
#subAspect: #hideUnloadedClasses
#aspect: #hideUnloadedClasses
)
#(#SubChannelInfoSpec
#subAspect: #showClassPackages
#aspect: #showClassPackages
)
#(#SubChannelInfoSpec
#subAspect: #inGeneratorHolder
#aspect: #classListGenerator
)
#(#SubChannelInfoSpec
#subAspect: #immediateUpdate
#aspect: #immediateUpdate
)
#(#SubChannelInfoSpec
#subAspect: #meta
#aspect: #meta
)
#(#SubChannelInfoSpec
#subAspect: #outGeneratorHolder
#aspect: #protocolListGenerator
)
#(#SubChannelInfoSpec
#subAspect: #selectedClasses
#aspect: #selectedClasses
)
#(#SubChannelInfoSpec
#subAspect: #menuHolder
#aspect: #classPopUpMenu
)
)
#createNewApplication: true
#createNewBuilder: true
)
#(#VariableVerticalPanelSpec
#name: 'VariableVerticalPanel1'
#layout: #(#LayoutFrame 0 0.0 25 0.0 0 1.0 -25 1.0)
#showHandle: false
#snapMode: #both
#handlePosition: #left
#component:
#(#SpecCollection
#collection: #(
#(#SubCanvasSpec
#name: 'MethodCategoryList'
#majorKey: #'NewSystemBrowser::MethodCategoryList'
#subAspectHolders:
#(#Array
#(#SubChannelInfoSpec
#subAspect: #immediateUpdate
#aspect: #immediateUpdate
)
#(#SubChannelInfoSpec
#subAspect: #inGeneratorHolder
#aspect: #protocolListGenerator
)
#(#SubChannelInfoSpec
#subAspect: #doubleClickChannel
#callBack: #protocolDoubleClicked
)
#(#SubChannelInfoSpec
#subAspect: #menuHolder
#aspect: #protocolMenu
)
#(#SubChannelInfoSpec
#subAspect: #outGeneratorHolder
#aspect: #selectorListGenerator
)
#(#SubChannelInfoSpec
#subAspect: #variableFilter
#aspect: #variableFilter
)
#(#SubChannelInfoSpec
#subAspect: #filterClassVars
#aspect: #filterClassVars
)
#(#SubChannelInfoSpec
#subAspect: #packageFilter
#aspect: #packageFilter
)
#(#SubChannelInfoSpec
#subAspect: #selectedProtocols
#aspect: #selectedProtocols
#callBack: #protocolSelectionChanged
)
#(#SubChannelInfoSpec
#subAspect: #selectionChangeCondition
#aspect: #selectionChangeConditionHolder
)
)
#createNewApplication: true
#createNewBuilder: true
)
#(#SubCanvasSpec
#name: 'VariableList'
#majorKey: #'NewSystemBrowser::VariableList'
#subAspectHolders:
#(#Array
#(#SubChannelInfoSpec
#subAspect: #doubleClickChannel
#callBack: #variableDoubleClicked
)
#(#SubChannelInfoSpec
#subAspect: #classHolder
#aspect: #selectedClasses
)
#(#SubChannelInfoSpec
#subAspect: #menuHolder
#aspect: #variablesPopUpMenu
)
#(#SubChannelInfoSpec
#subAspect: #selectedVariables
#aspect: #variableFilter
)
#(#SubChannelInfoSpec
#subAspect: #showClassVarsInVariableList
#aspect: #filterClassVars
)
#(#SubChannelInfoSpec
#subAspect: #sortVariablesByName
#aspect: #variableListSortByName
)
)
#createNewApplication: true
#createNewBuilder: true
)
)
)
#handles: #(#Any 0.5 1.0)
)
#(#UISubSpecification
#name: 'MetaToggles'
#layout: #(#LayoutFrame 0 0 -25 1 0 1 0 1)
#majorKey: #'NewSystemBrowser::NavigatorModel'
#minorKey: #metaSpec
)
)
)
)
#(#SubCanvasSpec
#name: 'MethodList'
#majorKey: #'NewSystemBrowser::MethodList'
#subAspectHolders:
#(#Array
#(#SubChannelInfoSpec
#subAspect: #doubleClickChannel
#callBack: #methodDoubleClicked
)
#(#SubChannelInfoSpec
#subAspect: #immediateUpdate
#aspect: #immediateUpdate
)
#(#SubChannelInfoSpec
#subAspect: #inGeneratorHolder
#aspect: #selectorListGenerator
)
#(#SubChannelInfoSpec
#subAspect: #menuHolder
#aspect: #selectorPopUpMenu
)
#(#SubChannelInfoSpec
#subAspect: #variableFilter
#aspect: #variableFilter
)
#(#SubChannelInfoSpec
#subAspect: #filterClassVars
#aspect: #filterClassVars
)
#(#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
)
)
)
#handles: #(#Any 0.5 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::NavigatorCanvas andSelector:#singleFullProtocolBrowserSpec
NewSystemBrowser::NavigatorCanvas new openInterface:#singleFullProtocolBrowserSpec
"
<resource: #canvas>
^
#(#FullSpec
#name: #singleFullProtocolBrowserSpec
#window:
#(#WindowSpec
#label: 'ProtocolBrowser'
#name: 'ProtocolBrowser'
#min: #(#Point 0 0)
#bounds: #(#Rectangle 12 22 474 322)
)
#component:
#(#SpecCollection
#collection: #(
#(#ViewSpec
#name: 'Box1'
#layout: #(#LayoutFrame 0 0.0 0 0.0 0 1.0 0 1.0)
#component:
#(#SpecCollection
#collection: #(
#(#SubCanvasSpec
#name: 'PseudoProtocolList'
#layout: #(#LayoutFrame 0 0.0 0 0 0 1.0 25 0)
#majorKey: #'NewSystemBrowser::MethodCategoryList'
#minorKey: #singleProtocolWindowSpec
#subAspectHolders:
#(#Array
#(#SubChannelInfoSpec
#subAspect: #immediateUpdate
#aspect: #immediateUpdate
)
#(#SubChannelInfoSpec
#subAspect: #inGeneratorHolder
#aspect: #protocolListGenerator
)
#(#SubChannelInfoSpec
#subAspect: #outGeneratorHolder
#aspect: #selectorListGenerator
)
#(#SubChannelInfoSpec
#subAspect: #packageFilter
#aspect: #packageFilter
)
#(#SubChannelInfoSpec
#subAspect: #selectedProtocols
#aspect: #selectedProtocols
)
#(#SubChannelInfoSpec
#subAspect: #menuHolder
#aspect: #protocolMenu
)
)
#createNewApplication: true
#createNewBuilder: true
)
#(#SubCanvasSpec
#name: 'MethodList'
#layout: #(#LayoutFrame 0 0.0 25 0.0 0 1.0 0 1.0)
#majorKey: #'NewSystemBrowser::MethodList'
#subAspectHolders:
#(#Array
#(#SubChannelInfoSpec
#subAspect: #doubleClickChannel
#callBack: #methodDoubleClicked
)
#(#SubChannelInfoSpec
#subAspect: #immediateUpdate
#aspect: #immediateUpdate
)
#(#SubChannelInfoSpec
#subAspect: #inGeneratorHolder
#aspect: #selectorListGenerator
)
#(#SubChannelInfoSpec
#subAspect: #menuHolder
#aspect: #selectorPopUpMenu
)
#(#SubChannelInfoSpec
#subAspect: #packageFilter
#aspect: #packageFilter
)
#(#SubChannelInfoSpec
#subAspect: #sortBy
#aspect: #sortBy
)
#(#SubChannelInfoSpec
#subAspect: #selectedMethods
#aspect: #selectedMethods
#callBack: #methodsSelectionChanged
)
#(#SubChannelInfoSpec
#subAspect: #selectionChangeCondition
#aspect: #selectionChangeConditionHolder
)
)
#createNewApplication: true
#createNewBuilder: true
)
)
)
)
)
)
)
!
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::NavigatorCanvas andSelector:#singleNameSpaceBrowserSpec
NewSystemBrowser::NavigatorCanvas new openInterface:#singleNameSpaceBrowserSpec
"
<resource: #canvas>
^
#(#FullSpec
#name: #singleNameSpaceBrowserSpec
#window:
#(#WindowSpec
#label: 'NameSpaceBrowser'
#name: 'NameSpaceBrowser'
#min: #(#Point 0 0)
#bounds: #(#Rectangle 18 51 480 351)
)
#component:
#(#SpecCollection
#collection: #(
#(#VariableHorizontalPanelSpec
#name: 'VariableHorizontalPanel1'
#layout: #(#LayoutFrame 0 0.0 0 0.0 0 1.0 0 1.0)
#barWidth: 2
#showHandle: false
#component:
#(#SpecCollection
#collection: #(
#(#ViewSpec
#name: 'Box1'
#component:
#(#SpecCollection
#collection: #(
#(#SubCanvasSpec
#name: 'PseudoNameSpaceList'
#layout: #(#LayoutFrame 0 0.0 0 0 0 1.0 25 0)
#majorKey: #'NewSystemBrowser::NamespaceList'
#minorKey: #singleNameSpaceWindowSpec
#subAspectHolders:
#(#Array
#(#SubChannelInfoSpec
#subAspect: #immediateUpdate
#aspect: #immediateUpdate
)
#(#SubChannelInfoSpec
#subAspect: #hideUnloadedClasses
#aspect: #hideUnloadedClasses
)
#(#SubChannelInfoSpec
#subAspect: #showClassPackages
#aspect: #showClassPackages
)
#(#SubChannelInfoSpec
#subAspect: #inGeneratorHolder
#aspect: #nameSpaceListGenerator
)
#(#SubChannelInfoSpec
#subAspect: #outGeneratorHolder
#aspect: #classListGenerator
)
#(#SubChannelInfoSpec
#subAspect: #selectedNamespaces
#aspect: #selectedNamespaces
)
)
#createNewApplication: true
#createNewBuilder: true
)
#(#VariableVerticalPanelSpec
#name: 'VariableVerticalPanel1'
#layout: #(#LayoutFrame 0 0.0 25 0.0 0 1.0 -25 1.0)
#showHandle: false
#handlePosition: #left
#snapMode: #both
#component:
#(#SpecCollection
#collection: #(
#(#SubCanvasSpec
#name: 'ClassList'
#majorKey: #'NewSystemBrowser::ClassList'
#subAspectHolders:
#(#Array
#(#SubChannelInfoSpec
#subAspect: #doubleClickChannel
#callBack: #classDoubleClicked
)
#(#SubChannelInfoSpec
#subAspect: #hideUnloadedClasses
#aspect: #hideUnloadedClasses
)
#(#SubChannelInfoSpec
#subAspect: #markApplicationsHolder
#aspect: #markApplicationsHolder
)
#(#SubChannelInfoSpec
#subAspect: #immediateUpdate
#aspect: #immediateUpdate
)
#(#SubChannelInfoSpec
#subAspect: #inGeneratorHolder
#aspect: #classListGenerator
)
#(#SubChannelInfoSpec
#subAspect: #menuHolder
#aspect: #classPopUpMenu
)
#(#SubChannelInfoSpec
#subAspect: #meta
#aspect: #meta
)
#(#SubChannelInfoSpec
#subAspect: #organizerMode
#aspect: #organizerMode
)
#(#SubChannelInfoSpec
#subAspect: #outGeneratorHolder
#aspect: #protocolListGenerator
)
#(#SubChannelInfoSpec
#subAspect: #packageFilter
#callBack: #packageFilter
)
#(#SubChannelInfoSpec
#subAspect: #selectedClasses
#aspect: #selectedClasses
#callBack: #classSelectionChanged
)
#(#SubChannelInfoSpec
#subAspect: #selectionChangeCondition
#aspect: #selectionChangeConditionHolder
)
)
#createNewApplication: true
#createNewBuilder: true
)
#(#SubCanvasSpec
#name: 'VariableList'
#majorKey: #'NewSystemBrowser::VariableList'
#subAspectHolders:
#(#Array
#(#SubChannelInfoSpec
#subAspect: #doubleClickChannel
#callBack: #variableDoubleClicked
)
#(#SubChannelInfoSpec
#subAspect: #classHolder
#aspect: #selectedClasses
)
#(#SubChannelInfoSpec
#subAspect: #menuHolder
#aspect: #variablesPopUpMenu
)
#(#SubChannelInfoSpec
#subAspect: #selectedVariables
#aspect: #variableFilter
)
#(#SubChannelInfoSpec
#subAspect: #showClassVarsInVariableList
#aspect: #filterClassVars
)
#(#SubChannelInfoSpec
#subAspect: #sortVariablesByName
#aspect: #variableListSortByName
)
)
#createNewApplication: true
#createNewBuilder: true
)
)
)
#handles: #(#Any 0.5 1.0)
)
#(#UISubSpecification
#name: 'MetaToggles'
#layout: #(#LayoutFrame 0 0 -25 1 0 1 0 1)
#majorKey: #'NewSystemBrowser::NavigatorModel'
#minorKey: #metaSpec
)
)
)
)
#(#SubCanvasSpec
#name: 'MethodCategoryList'
#majorKey: #'NewSystemBrowser::MethodCategoryList'
#subAspectHolders:
#(#Array
#(#SubChannelInfoSpec
#subAspect: #doubleClickChannel
#callBack: #protocolDoubleClicked
)
#(#SubChannelInfoSpec
#subAspect: #immediateUpdate
#aspect: #immediateUpdate
)
#(#SubChannelInfoSpec
#subAspect: #inGeneratorHolder
#aspect: #protocolListGenerator
)
#(#SubChannelInfoSpec
#subAspect: #menuHolder
#aspect: #protocolMenu
)
#(#SubChannelInfoSpec
#subAspect: #outGeneratorHolder
#aspect: #selectorListGenerator
)
#(#SubChannelInfoSpec
#subAspect: #variableFilter
#aspect: #variableFilter
)
#(#SubChannelInfoSpec
#subAspect: #filterClassVars
#aspect: #filterClassVars
)
#(#SubChannelInfoSpec
#subAspect: #packageFilter
#aspect: #packageFilter
)
#(#SubChannelInfoSpec
#subAspect: #selectedProtocols
#aspect: #selectedProtocols
#callBack: #protocolSelectionChanged
)
#(#SubChannelInfoSpec
#subAspect: #methodVisibilityHolder
#aspect: #methodVisibilityHolder
)
#(#SubChannelInfoSpec
#subAspect: #selectionChangeCondition
#aspect: #selectionChangeConditionHolder
)
)
#createNewApplication: true
#createNewBuilder: true
)
#(#SubCanvasSpec
#name: 'MethodList'
#majorKey: #'NewSystemBrowser::MethodList'
#subAspectHolders:
#(#Array
#(#SubChannelInfoSpec
#subAspect: #doubleClickChannel
#callBack: #methodDoubleClicked
)
#(#SubChannelInfoSpec
#subAspect: #immediateUpdate
#aspect: #immediateUpdate
)
#(#SubChannelInfoSpec
#subAspect: #inGeneratorHolder
#aspect: #selectorListGenerator
)
#(#SubChannelInfoSpec
#subAspect: #menuHolder
#aspect: #selectorPopUpMenu
)
#(#SubChannelInfoSpec
#subAspect: #variableFilter
#aspect: #variableFilter
)
#(#SubChannelInfoSpec
#subAspect: #filterClassVars
#aspect: #filterClassVars
)
#(#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
)
)
)
#handles: #(#Any 0.333333 0.666667 1.0)
)
)
)
)
"Modified: / 18.8.2000 / 14:50:53 / 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::NavigatorCanvas andSelector:#singleNameSpaceFullBrowserSpec
NewSystemBrowser::NavigatorCanvas new openInterface:#singleNameSpaceFullBrowserSpec
"
<resource: #canvas>
^
#(#FullSpec
#name: #singleNameSpaceFullBrowserSpec
#window:
#(#WindowSpec
#label: 'NameSpaceBrowser'
#name: 'NameSpaceBrowser'
#min: #(#Point 0 0)
#bounds: #(#Rectangle 102 220 564 520)
)
#component:
#(#SpecCollection
#collection: #(
#(#VariableHorizontalPanelSpec
#name: 'VariableHorizontalPanel1'
#layout: #(#LayoutFrame 0 0.0 0 0.0 0 1.0 0 1.0)
#barWidth: 2
#showHandle: false
#component:
#(#SpecCollection
#collection: #(
#(#ViewSpec
#name: 'Box1'
#component:
#(#SpecCollection
#collection: #(
#(#SubCanvasSpec
#name: 'PseudoNameSpaceList'
#layout: #(#LayoutFrame 0 0.0 0 0 0 1.0 25 0)
#majorKey: #'NewSystemBrowser::NamespaceList'
#minorKey: #singleNameSpaceWindowSpec
#subAspectHolders:
#(#Array
#(#SubChannelInfoSpec
#subAspect: #immediateUpdate
#aspect: #immediateUpdate
)
#(#SubChannelInfoSpec
#subAspect: #hideUnloadedClasses
#aspect: #hideUnloadedClasses
)
#(#SubChannelInfoSpec
#subAspect: #showClassPackages
#aspect: #showClassPackages
)
#(#SubChannelInfoSpec
#subAspect: #inGeneratorHolder
#aspect: #nameSpaceListGenerator
)
#(#SubChannelInfoSpec
#subAspect: #outGeneratorHolder
#aspect: #classListPerNameSpaceGenerator
)
#(#SubChannelInfoSpec
#subAspect: #selectedNamespaces
#aspect: #selectedNamespaces
)
)
#createNewApplication: true
#createNewBuilder: true
)
#(#SubCanvasSpec
#name: 'ClassCategoryList'
#layout: #(#LayoutFrame 0 0.0 25 0.0 0 1.0 0 1.0)
#majorKey: #'NewSystemBrowser::ClassCategoryList'
#subAspectHolders:
#(#Array
#(#SubChannelInfoSpec
#subAspect: #doubleClickChannel
#callBack: #classCategoryDoubleClicked
)
#(#SubChannelInfoSpec
#subAspect: #forceGeneratorTrigger
#aspect: #forceClassCategoryGeneratorTrigger
)
#(#SubChannelInfoSpec
#subAspect: #nameSpaceFilter
#aspect: #selectedNamespaces
)
#(#SubChannelInfoSpec
#subAspect: #hideUnloadedClasses
#aspect: #hideUnloadedClasses
)
#(#SubChannelInfoSpec
#subAspect: #immediateUpdate
#aspect: #immediateUpdate
)
#(#SubChannelInfoSpec
#subAspect: #menuHolder
#aspect: #categoryPopUpMenu
)
#(#SubChannelInfoSpec
#subAspect: #organizerMode
#aspect: #organizerMode
)
#(#SubChannelInfoSpec
#subAspect: #outGeneratorHolder
#aspect: #classListGenerator
)
#(#SubChannelInfoSpec
#subAspect: #selectedCategories
#aspect: #selectedCategories
)
#(#SubChannelInfoSpec
#subAspect: #selectionChangeCondition
#aspect: #selectionChangeCondition
)
#(#SubChannelInfoSpec
#subAspect: #slaveMode
#aspect: #categoryListSlaveMode
)
#(#SubChannelInfoSpec
#subAspect: #updateTrigger
#aspect: #classCategoryListUpdateTrigger
)
)
#createNewApplication: true
#createNewBuilder: true
)
)
)
)
#(#ViewSpec
#name: 'Box2'
#component:
#(#SpecCollection
#collection: #(
#(#VariableVerticalPanelSpec
#name: 'VariableVerticalPanel2'
#layout: #(#LayoutFrame 0 0.0 0 0.0 0 1.0 -25 1.0)
#showHandle: false
#handlePosition: #left
#snapMode: #both
#component:
#(#SpecCollection
#collection: #(
#(#SubCanvasSpec
#name: 'ClassList'
#majorKey: #'NewSystemBrowser::ClassList'
#subAspectHolders:
#(#Array
#(#SubChannelInfoSpec
#subAspect: #nameSpaceFilter
#aspect: #selectedNamespaces
)
#(#SubChannelInfoSpec
#subAspect: #doubleClickChannel
#callBack: #classDoubleClicked
)
#(#SubChannelInfoSpec
#subAspect: #hideUnloadedClasses
#aspect: #hideUnloadedClasses
)
#(#SubChannelInfoSpec
#subAspect: #markApplicationsHolder
#aspect: #markApplicationsHolder
)
#(#SubChannelInfoSpec
#subAspect: #immediateUpdate
#aspect: #immediateUpdate
)
#(#SubChannelInfoSpec
#subAspect: #inGeneratorHolder
#aspect: #classListGenerator
)
#(#SubChannelInfoSpec
#subAspect: #menuHolder
#aspect: #classPopUpMenu
)
#(#SubChannelInfoSpec
#subAspect: #meta
#aspect: #meta
)
#(#SubChannelInfoSpec
#subAspect: #organizerMode
#aspect: #organizerMode
)
#(#SubChannelInfoSpec
#subAspect: #outGeneratorHolder
#aspect: #protocolListGenerator
)
#(#SubChannelInfoSpec
#subAspect: #packageFilter
#callBack: #packageFilter
)
#(#SubChannelInfoSpec
#subAspect: #selectedClasses
#aspect: #selectedClasses
#callBack: #classSelectionChanged
)
#(#SubChannelInfoSpec
#subAspect: #selectionChangeCondition
#aspect: #selectionChangeConditionHolder
)
)
#createNewApplication: true
#createNewBuilder: true
)
#(#SubCanvasSpec
#name: 'VariableList'
#majorKey: #'NewSystemBrowser::VariableList'
#subAspectHolders:
#(#Array
#(#SubChannelInfoSpec
#subAspect: #doubleClickChannel
#callBack: #variableDoubleClicked
)
#(#SubChannelInfoSpec
#subAspect: #classHolder
#aspect: #selectedClasses
)
#(#SubChannelInfoSpec
#subAspect: #menuHolder
#aspect: #variablesPopUpMenu
)
#(#SubChannelInfoSpec
#subAspect: #selectedVariables
#aspect: #variableFilter
)
#(#SubChannelInfoSpec
#subAspect: #showClassVarsInVariableList
#aspect: #filterClassVars
)
#(#SubChannelInfoSpec
#subAspect: #sortVariablesByName
#aspect: #variableListSortByName
)
)
#createNewApplication: true
#createNewBuilder: true
)
)
)
#handles: #(#Any 0.5 1.0)
)
#(#UISubSpecification
#name: 'MetaToggles'
#layout: #(#LayoutFrame 0 0 -25 1 0 1 0 1)
#majorKey: #'NewSystemBrowser::NavigatorModel'
#minorKey: #metaSpec
)
)
)
)
#(#SubCanvasSpec
#name: 'MethodCategoryList'
#majorKey: #'NewSystemBrowser::MethodCategoryList'
#subAspectHolders:
#(#Array
#(#SubChannelInfoSpec
#subAspect: #doubleClickChannel
#callBack: #protocolDoubleClicked
)
#(#SubChannelInfoSpec
#subAspect: #immediateUpdate
#aspect: #immediateUpdate
)
#(#SubChannelInfoSpec
#subAspect: #inGeneratorHolder
#aspect: #protocolListGenerator
)
#(#SubChannelInfoSpec
#subAspect: #menuHolder
#aspect: #protocolMenu
)
#(#SubChannelInfoSpec
#subAspect: #outGeneratorHolder
#aspect: #selectorListGenerator
)
#(#SubChannelInfoSpec
#subAspect: #variableFilter
#aspect: #variableFilter
)
#(#SubChannelInfoSpec
#subAspect: #filterClassVars
#aspect: #filterClassVars
)
#(#SubChannelInfoSpec
#subAspect: #packageFilter
#aspect: #packageFilter
)
#(#SubChannelInfoSpec
#subAspect: #methodVisibilityHolder
#aspect: #methodVisibilityHolder
)
#(#SubChannelInfoSpec
#subAspect: #selectedProtocols
#aspect: #selectedProtocols
#callBack: #protocolSelectionChanged
)
#(#SubChannelInfoSpec
#subAspect: #selectionChangeCondition
#aspect: #selectionChangeConditionHolder
)
)
#createNewApplication: true
#createNewBuilder: true
)
#(#SubCanvasSpec
#name: 'MethodList'
#majorKey: #'NewSystemBrowser::MethodList'
#subAspectHolders:
#(#Array
#(#SubChannelInfoSpec
#subAspect: #doubleClickChannel
#callBack: #methodDoubleClicked
)
#(#SubChannelInfoSpec
#subAspect: #immediateUpdate
#aspect: #immediateUpdate
)
#(#SubChannelInfoSpec
#subAspect: #inGeneratorHolder
#aspect: #selectorListGenerator
)
#(#SubChannelInfoSpec
#subAspect: #menuHolder
#aspect: #selectorPopUpMenu
)
#(#SubChannelInfoSpec
#subAspect: #variableFilter
#aspect: #variableFilter
)
#(#SubChannelInfoSpec
#subAspect: #filterClassVars
#aspect: #filterClassVars
)
#(#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
)
)
)
#handles: #(#Any 0.25 0.5 0.75 1.0)
)
)
)
)
"Modified: / 18.8.2000 / 20:02:28 / 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::NavigatorCanvas andSelector:#singleProjectBrowserSpec
NewSystemBrowser::NavigatorCanvas new openInterface:#singleProjectBrowserSpec
"
<resource: #canvas>
^
#(#FullSpec
#name: #singleProjectBrowserSpec
#window:
#(#WindowSpec
#label: 'ProjectBrowser'
#name: 'ProjectBrowser'
#min: #(#Point 0 0)
#bounds: #(#Rectangle 18 51 480 351)
)
#component:
#(#SpecCollection
#collection: #(
#(#VariableHorizontalPanelSpec
#name: 'VariableHorizontalPanel1'
#layout: #(#LayoutFrame 0 0.0 0 0.0 0 1.0 0 1.0)
#barWidth: 2
#showHandle: false
#component:
#(#SpecCollection
#collection: #(
#(#ViewSpec
#name: 'Box1'
#component:
#(#SpecCollection
#collection: #(
#(#SubCanvasSpec
#name: 'PseudoProjectList'
#layout: #(#LayoutFrame 0 0.0 0 0 0 1.0 25 0)
#majorKey: #'NewSystemBrowser::ProjectList'
#minorKey: #singleProjectWindowSpec
#subAspectHolders:
#(#Array
#(#SubChannelInfoSpec
#subAspect: #menuHolder
#aspect: #projectPopUpMenu
)
#(#SubChannelInfoSpec
#subAspect: #hideUnloadedClasses
#aspect: #hideUnloadedClasses
)
#(#SubChannelInfoSpec
#subAspect: #showClassPackages
#aspect: #showClassPackages
)
#(#SubChannelInfoSpec
#subAspect: #inGeneratorHolder
#aspect: #projectListGenerator
)
#(#SubChannelInfoSpec
#subAspect: #outGeneratorHolder
#aspect: #classListGenerator
)
#(#SubChannelInfoSpec
#subAspect: #selectedProjects
#aspect: #selectedProjects
)
#(#SubChannelInfoSpec
#subAspect: #immediateUpdate
#aspect: #immediateUpdate
)
)
#createNewApplication: true
#createNewBuilder: true
)
#(#VariableVerticalPanelSpec
#name: 'VariableVerticalPanel1'
#layout: #(#LayoutFrame 0 0.0 25 0.0 0 1.0 -25 1.0)
#showHandle: false
#handlePosition: #left
#snapMode: #both
#component:
#(#SpecCollection
#collection: #(
#(#SubCanvasSpec
#name: 'ClassList'
#majorKey: #'NewSystemBrowser::ClassList'
#subAspectHolders:
#(#Array
#(#SubChannelInfoSpec
#subAspect: #doubleClickChannel
#callBack: #classDoubleClicked
)
#(#SubChannelInfoSpec
#subAspect: #hideUnloadedClasses
#aspect: #hideUnloadedClasses
)
#(#SubChannelInfoSpec
#subAspect: #markApplicationsHolder
#aspect: #markApplicationsHolder
)
#(#SubChannelInfoSpec
#subAspect: #immediateUpdate
#aspect: #immediateUpdate
)
#(#SubChannelInfoSpec
#subAspect: #inGeneratorHolder
#aspect: #classListGenerator
)
#(#SubChannelInfoSpec
#subAspect: #menuHolder
#aspect: #classPopUpMenu
)
#(#SubChannelInfoSpec
#subAspect: #meta
#aspect: #meta
)
#(#SubChannelInfoSpec
#subAspect: #organizerMode
#aspect: #organizerMode
)
#(#SubChannelInfoSpec
#subAspect: #outGeneratorHolder
#aspect: #protocolListGenerator
)
#(#SubChannelInfoSpec
#subAspect: #packageFilter
#aspect: #packageFilter
)
#(#SubChannelInfoSpec
#subAspect: #selectedClasses
#aspect: #selectedClasses
#callBack: #classSelectionChanged
)
#(#SubChannelInfoSpec
#subAspect: #selectionChangeCondition
#aspect: #selectionChangeConditionHolder
)
)
#createNewApplication: true
#createNewBuilder: true
)
#(#SubCanvasSpec
#name: 'VariableList'
#majorKey: #'NewSystemBrowser::VariableList'
#subAspectHolders:
#(#Array
#(#SubChannelInfoSpec
#subAspect: #doubleClickChannel
#callBack: #variableDoubleClicked
)
#(#SubChannelInfoSpec
#subAspect: #classHolder
#aspect: #selectedClasses
)
#(#SubChannelInfoSpec
#subAspect: #menuHolder
#aspect: #variablesPopUpMenu
)
#(#SubChannelInfoSpec
#subAspect: #selectedVariables
#aspect: #variableFilter
)
#(#SubChannelInfoSpec
#subAspect: #showClassVarsInVariableList
#aspect: #filterClassVars
)
#(#SubChannelInfoSpec
#subAspect: #sortVariablesByName
#aspect: #variableListSortByName
)
)
#createNewApplication: true
#createNewBuilder: true
)
)
)
#handles: #(#Any 0.5 1.0)
)
#(#UISubSpecification
#name: 'MetaToggles'
#layout: #(#LayoutFrame 0 0 -25 1 0 1 0 1)
#majorKey: #'NewSystemBrowser::NavigatorModel'
#minorKey: #metaSpec
)
)
)
)
#(#SubCanvasSpec
#name: 'MethodCategoryList'
#majorKey: #'NewSystemBrowser::MethodCategoryList'
#subAspectHolders:
#(#Array
#(#SubChannelInfoSpec
#subAspect: #immediateUpdate
#aspect: #immediateUpdate
)
#(#SubChannelInfoSpec
#subAspect: #inGeneratorHolder
#aspect: #protocolListGenerator
)
#(#SubChannelInfoSpec
#subAspect: #doubleClickChannel
#callBack: #protocolDoubleClicked
)
#(#SubChannelInfoSpec
#subAspect: #menuHolder
#aspect: #protocolMenu
)
#(#SubChannelInfoSpec
#subAspect: #outGeneratorHolder
#aspect: #selectorListGenerator
)
#(#SubChannelInfoSpec
#subAspect: #variableFilter
#aspect: #variableFilter
)
#(#SubChannelInfoSpec
#subAspect: #filterClassVars
#aspect: #filterClassVars
)
#(#SubChannelInfoSpec
#subAspect: #packageFilter
#aspect: #packageFilter
)
#(#SubChannelInfoSpec
#subAspect: #selectedProtocols
#aspect: #selectedProtocols
#callBack: #protocolSelectionChanged
)
#(#SubChannelInfoSpec
#subAspect: #methodVisibilityHolder
#aspect: #methodVisibilityHolder
)
#(#SubChannelInfoSpec
#subAspect: #selectionChangeCondition
#aspect: #selectionChangeConditionHolder
)
)
#createNewApplication: true
#createNewBuilder: true
)
#(#SubCanvasSpec
#name: 'MethodList'
#majorKey: #'NewSystemBrowser::MethodList'
#subAspectHolders:
#(#Array
#(#SubChannelInfoSpec
#subAspect: #doubleClickChannel
#callBack: #methodDoubleClicked
)
#(#SubChannelInfoSpec
#subAspect: #immediateUpdate
#aspect: #immediateUpdate
)
#(#SubChannelInfoSpec
#subAspect: #inGeneratorHolder
#aspect: #selectorListGenerator
)
#(#SubChannelInfoSpec
#subAspect: #menuHolder
#aspect: #selectorPopUpMenu
)
#(#SubChannelInfoSpec
#subAspect: #variableFilter
#aspect: #variableFilter
)
#(#SubChannelInfoSpec
#subAspect: #filterClassVars
#aspect: #filterClassVars
)
#(#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
)
)
)
#handles: #(#Any 0.333333 0.666667 1.0)
)
)
)
)
!
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::NavigatorCanvas andSelector:#singleProjectFullBrowserSpec
NewSystemBrowser::NavigatorCanvas new openInterface:#singleProjectFullBrowserSpec
"
<resource: #canvas>
^
#(#FullSpec
#name: #singleProjectFullBrowserSpec
#window:
#(#WindowSpec
#label: 'ProjectBrowser'
#name: 'ProjectBrowser'
#min: #(#Point 0 0)
#bounds: #(#Rectangle 30 74 492 374)
)
#component:
#(#SpecCollection
#collection: #(
#(#VariableHorizontalPanelSpec
#name: 'VariableHorizontalPanel1'
#layout: #(#LayoutFrame 0 0.0 0 0.0 0 1.0 0 1.0)
#barWidth: 2
#showHandle: false
#component:
#(#SpecCollection
#collection: #(
#(#ViewSpec
#name: 'Box1'
#component:
#(#SpecCollection
#collection: #(
#(#SubCanvasSpec
#name: 'PseudoProjectList'
#layout: #(#LayoutFrame 0 0.0 0 0 0 1.0 25 0)
#majorKey: #'NewSystemBrowser::ProjectList'
#minorKey: #singleProjectWindowSpec
#subAspectHolders:
#(#Array
#(#SubChannelInfoSpec
#subAspect: #menuHolder
#aspect: #projectPopUpMenu
)
#(#SubChannelInfoSpec
#subAspect: #hideUnloadedClasses
#aspect: #hideUnloadedClasses
)
#(#SubChannelInfoSpec
#subAspect: #showClassPackages
#aspect: #showClassPackages
)
#(#SubChannelInfoSpec
#subAspect: #inGeneratorHolder
#aspect: #projectListGenerator
)
#(#SubChannelInfoSpec
#subAspect: #outGeneratorHolder
#aspect: #classListGenerator
)
#(#SubChannelInfoSpec
#subAspect: #selectedProjects
#aspect: #selectedProjects
)
#(#SubChannelInfoSpec
#subAspect: #immediateUpdate
#aspect: #immediateUpdate
)
)
#createNewApplication: true
#createNewBuilder: true
)
#(#SubCanvasSpec
#name: 'ClassCategoryList'
#layout: #(#LayoutFrame 0 0.0 25 0.0 0 1.0 0 1.0)
#majorKey: #'NewSystemBrowser::ClassCategoryList'
#subAspectHolders:
#(#Array
#(#SubChannelInfoSpec
#subAspect: #doubleClickChannel
#callBack: #classCategoryDoubleClicked
)
#(#SubChannelInfoSpec
#subAspect: #forceGeneratorTrigger
#aspect: #forceClassCategoryGeneratorTrigger
)
#(#SubChannelInfoSpec
#subAspect: #packageFilter
#aspect: #selectedProjects
)
#(#SubChannelInfoSpec
#subAspect: #hideUnloadedClasses
#aspect: #hideUnloadedClasses
)
#(#SubChannelInfoSpec
#subAspect: #immediateUpdate
#aspect: #immediateUpdate
)
#(#SubChannelInfoSpec
#subAspect: #menuHolder
#aspect: #categoryPopUpMenu
)
#(#SubChannelInfoSpec
#subAspect: #organizerMode
#aspect: #organizerMode
)
#(#SubChannelInfoSpec
#subAspect: #outGeneratorHolder
#aspect: #classListGenerator
)
#(#SubChannelInfoSpec
#subAspect: #selectedCategories
#aspect: #selectedCategories
)
#(#SubChannelInfoSpec
#subAspect: #selectionChangeCondition
#aspect: #selectionChangeCondition
)
#(#SubChannelInfoSpec
#subAspect: #slaveMode
#aspect: #categoryListSlaveMode
)
#(#SubChannelInfoSpec
#subAspect: #updateTrigger
#aspect: #classCategoryListUpdateTrigger
)
)
#createNewApplication: true
#createNewBuilder: true
)
)
)
)
#(#ViewSpec
#name: 'Box2'
#component:
#(#SpecCollection
#collection: #(
#(#VariableVerticalPanelSpec
#name: 'VariableVerticalPanel2'
#layout: #(#LayoutFrame 0 0.0 0 0.0 0 1.0 -25 1.0)
#showHandle: false
#handlePosition: #left
#snapMode: #both
#component:
#(#SpecCollection
#collection: #(
#(#SubCanvasSpec
#name: 'SubCanvas2'
#majorKey: #'NewSystemBrowser::ClassList'
#subAspectHolders:
#(#Array
#(#SubChannelInfoSpec
#subAspect: #doubleClickChannel
#callBack: #classDoubleClicked
)
#(#SubChannelInfoSpec
#subAspect: #hideUnloadedClasses
#aspect: #hideUnloadedClasses
)
#(#SubChannelInfoSpec
#subAspect: #markApplicationsHolder
#aspect: #markApplicationsHolder
)
#(#SubChannelInfoSpec
#subAspect: #immediateUpdate
#aspect: #immediateUpdate
)
#(#SubChannelInfoSpec
#subAspect: #inGeneratorHolder
#aspect: #classListGenerator
)
#(#SubChannelInfoSpec
#subAspect: #menuHolder
#aspect: #classPopUpMenu
)
#(#SubChannelInfoSpec
#subAspect: #meta
#aspect: #meta
)
#(#SubChannelInfoSpec
#subAspect: #organizerMode
#aspect: #organizerMode
)
#(#SubChannelInfoSpec
#subAspect: #outGeneratorHolder
#aspect: #protocolListGenerator
)
#(#SubChannelInfoSpec
#subAspect: #packageFilter
#aspect: #selectedProjects
)
#(#SubChannelInfoSpec
#subAspect: #selectedClasses
#aspect: #selectedClasses
#callBack: #classSelectionChanged
)
#(#SubChannelInfoSpec
#subAspect: #selectionChangeCondition
#aspect: #selectionChangeConditionHolder
)
)
#createNewApplication: true
#createNewBuilder: true
)
#(#SubCanvasSpec
#name: 'SubCanvas3'
#majorKey: #'NewSystemBrowser::VariableList'
#subAspectHolders:
#(#Array
#(#SubChannelInfoSpec
#subAspect: #doubleClickChannel
#callBack: #variableDoubleClicked
)
#(#SubChannelInfoSpec
#subAspect: #classHolder
#aspect: #selectedClasses
)
#(#SubChannelInfoSpec
#subAspect: #menuHolder
#aspect: #variablesPopUpMenu
)
#(#SubChannelInfoSpec
#subAspect: #selectedVariables
#aspect: #variableFilter
)
#(#SubChannelInfoSpec
#subAspect: #showClassVarsInVariableList
#aspect: #filterClassVars
)
#(#SubChannelInfoSpec
#subAspect: #sortVariablesByName
#aspect: #variableListSortByName
)
)
#createNewApplication: true
#createNewBuilder: true
)
)
)
#handles: #(#Any 0.5 1.0)
)
#(#UISubSpecification
#name: 'SubSpecification1'
#layout: #(#LayoutFrame 0 0 -25 1 0 1 0 1)
#majorKey: #'NewSystemBrowser::NavigatorModel'
#minorKey: #metaSpec
)
)
)
)
#(#SubCanvasSpec
#name: 'MethodCategoryList'
#majorKey: #'NewSystemBrowser::MethodCategoryList'
#subAspectHolders:
#(#Array
#(#SubChannelInfoSpec
#subAspect: #immediateUpdate
#aspect: #immediateUpdate
)
#(#SubChannelInfoSpec
#subAspect: #inGeneratorHolder
#aspect: #protocolListGenerator
)
#(#SubChannelInfoSpec
#subAspect: #doubleClickChannel
#callBack: #protocolDoubleClicked
)
#(#SubChannelInfoSpec
#subAspect: #menuHolder
#aspect: #protocolMenu
)
#(#SubChannelInfoSpec
#subAspect: #outGeneratorHolder
#aspect: #selectorListGenerator
)
#(#SubChannelInfoSpec
#subAspect: #variableFilter
#aspect: #variableFilter
)
#(#SubChannelInfoSpec
#subAspect: #filterClassVars
#aspect: #filterClassVars
)
#(#SubChannelInfoSpec
#subAspect: #packageFilter
#aspect: #packageFilter
)
#(#SubChannelInfoSpec
#subAspect: #methodVisibilityHolder
#aspect: #methodVisibilityHolder
)
#(#SubChannelInfoSpec
#subAspect: #selectedProtocols
#aspect: #selectedProtocols
#callBack: #protocolSelectionChanged
)
#(#SubChannelInfoSpec
#subAspect: #selectionChangeCondition
#aspect: #selectionChangeConditionHolder
)
)
#createNewApplication: true
#createNewBuilder: true
)
#(#SubCanvasSpec
#name: 'MethodList'
#majorKey: #'NewSystemBrowser::MethodList'
#subAspectHolders:
#(#Array
#(#SubChannelInfoSpec
#subAspect: #doubleClickChannel
#callBack: #methodDoubleClicked
)
#(#SubChannelInfoSpec
#subAspect: #immediateUpdate
#aspect: #immediateUpdate
)
#(#SubChannelInfoSpec
#subAspect: #inGeneratorHolder
#aspect: #selectorListGenerator
)
#(#SubChannelInfoSpec
#subAspect: #menuHolder
#aspect: #selectorPopUpMenu
)
#(#SubChannelInfoSpec
#subAspect: #variableFilter
#aspect: #variableFilter
)
#(#SubChannelInfoSpec
#subAspect: #filterClassVars
#aspect: #filterClassVars
)
#(#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
)
)
)
#handles: #(#Any 0.25 0.5 0.75 1.0)
)
)
)
)
"Modified: / 18.8.2000 / 20:02:36 / 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::NavigatorCanvas andSelector:#singleProtocolBrowserSpec
NewSystemBrowser::NavigatorCanvas new openInterface:#singleProtocolBrowserSpec
"
<resource: #canvas>
^
#(#FullSpec
#name: #singleProtocolBrowserSpec
#window:
#(#WindowSpec
#label: 'ProtocolBrowser'
#name: 'ProtocolBrowser'
#min: #(#Point 0 0)
#bounds: #(#Rectangle 12 22 474 322)
)
#component:
#(#SpecCollection
#collection: #(
#(#ViewSpec
#name: 'Box1'
#layout: #(#LayoutFrame 0 0.0 0 0.0 0 1.0 0 1.0)
#component:
#(#SpecCollection
#collection: #(
#(#SubCanvasSpec
#name: 'PseudoProtocolList'
#layout: #(#LayoutFrame 0 0.0 0 0 0 1.0 25 0)
#majorKey: #'NewSystemBrowser::MethodCategoryList'
#minorKey: #singleProtocolWindowSpec
#subAspectHolders:
#(#Array
#(#SubChannelInfoSpec
#subAspect: #immediateUpdate
#aspect: #immediateUpdate
)
#(#SubChannelInfoSpec
#subAspect: #inGeneratorHolder
#aspect: #protocolListGenerator
)
#(#SubChannelInfoSpec
#subAspect: #outGeneratorHolder
#aspect: #selectorListGenerator
)
#(#SubChannelInfoSpec
#subAspect: #packageFilter
#aspect: #packageFilter
)
#(#SubChannelInfoSpec
#subAspect: #selectedProtocols
#aspect: #selectedProtocols
)
#(#SubChannelInfoSpec
#subAspect: #menuHolder
#aspect: #protocolMenu
)
)
#createNewApplication: true
#createNewBuilder: true
)
#(#SubCanvasSpec
#name: 'MethodList'
#layout: #(#LayoutFrame 0 0.0 25 0.0 0 1.0 0 1.0)
#majorKey: #'NewSystemBrowser::MethodList'
#subAspectHolders:
#(#Array
#(#SubChannelInfoSpec
#subAspect: #doubleClickChannel
#callBack: #methodDoubleClicked
)
#(#SubChannelInfoSpec
#subAspect: #immediateUpdate
#aspect: #immediateUpdate
)
#(#SubChannelInfoSpec
#subAspect: #inGeneratorHolder
#aspect: #selectorListGenerator
)
#(#SubChannelInfoSpec
#subAspect: #menuHolder
#aspect: #selectorPopUpMenu
)
#(#SubChannelInfoSpec
#subAspect: #packageFilter
#aspect: #packageFilter
)
#(#SubChannelInfoSpec
#subAspect: #sortBy
#aspect: #sortBy
)
#(#SubChannelInfoSpec
#subAspect: #selectedMethods
#aspect: #selectedMethods
#callBack: #methodsSelectionChanged
)
#(#SubChannelInfoSpec
#subAspect: #selectionChangeCondition
#aspect: #selectionChangeConditionHolder
)
)
#createNewApplication: true
#createNewBuilder: true
)
)
)
)
)
)
)
!
windowSpec
^ self fullBrowserSpec
! !
!NewSystemBrowser::NavigatorCanvas class methodsFor:'misc'!
classResources
^ NewSystemBrowser classResources
! !
!NewSystemBrowser::NavigatorCanvas methodsFor:'misc'!
resources
|m|
(m := self masterApplication) notNil ifTrue:[
^ m resources
].
^ super resources
! !
!NewSystemBrowser::HierarchicalClassCategoryList class methodsFor:'interface specs'!
windowSpec
"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::HierarchicalClassCategoryList andSelector:#windowSpec
NewSystemBrowser::HierarchicalClassCategoryList new openInterface:#windowSpec
NewSystemBrowser::HierarchicalClassCategoryList open
"
<resource: #canvas>
^
#(#FullSpec
#name: #windowSpec
#window:
#(#WindowSpec
#label: 'ClassCategoryList'
#name: 'ClassCategoryList'
#min: #(#Point 0 0)
#max: #(#Point 1024 721)
#bounds: #(#Rectangle 16 46 316 346)
)
#component:
#(#SpecCollection
#collection: #(
#(#HierarchicalListViewSpec
#name: 'List'
#layout: #(#LayoutFrame 0 0.0 0 0.0 0 1.0 0 1.0)
#tabable: true
#model: #hierarchicalCategorySelection
#menu: #menuHolder
#hasHorizontalScrollBar: true
#hasVerticalScrollBar: true
#miniScrollerHorizontal: true
#listModel: #hierarchicalCategoryList
#multipleSelectOk: true
#highlightMode: #line
#doubleClickSelector: #doubleClicked:
#showLines: false
#indicatorSelector: #indicatorPressed:
#useDefaultIcons: false
#properties:
#(#PropertyListDictionary
#dragArgument: nil
#dropArgument: nil
#canDropSelector: #canDrop:
#dropSelector: #doDrop:
)
)
)
)
)
! !
!NewSystemBrowser::HierarchicalClassCategoryList class methodsFor:'plugIn spec'!
aspectSelectors
"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."
"Return a description of exported aspects;
these can be connected to aspects of an embedding application
(if this app is embedded in a subCanvas)."
^ #(
#(#doubleClickChannel #action )
#forceGeneratorTrigger
#hideUnloadedClasses
#immediateUpdate
#inGeneratorHolder
#menuHolder
#nameSpaceFilter
#organizerMode
#outGeneratorHolder
#packageFilter
#selectedCategories
#selectionChangeCondition
#slaveMode
#updateTrigger
).
! !
!NewSystemBrowser::HierarchicalClassCategoryList methodsFor:'aspects'!
addCategory:category
|item path parentPath parentCategory parentItem|
item:= categoryToItemDictionary at:category ifAbsent:nil.
item isNil ifTrue:[
path := category asCollectionOfSubstringsSeparatedBy:$-.
item := ClassCategoryItem new.
item category:category.
item label:(path last).
categoryToItemDictionary at:category put:item.
category size > 0 ifTrue:[
"/ find the parent ...
parentPath := path copyWithoutLast:1.
parentCategory := parentPath asStringWith:$-.
parentItem := self addCategory:parentCategory .
parentItem add:item sortBlock:[:i1 :i2 | i1 category asLowercase < i2 category asLowercase].
]
].
^ item
!
generateHierarchicalCategoryTree
|anchor|
self categoryList value isNil ifTrue:[
self updateList.
self categoryList value isNil ifTrue:[
^ nil.
]
].
anchor := ClassCategoryItem new.
anchor category:nil.
anchor label:nil.
categoryToItemDictionary := Dictionary new.
categoryToItemDictionary at:'' asSymbol put:anchor.
self categoryList value do:[:eachCategory |
(categoryToItemDictionary includesKey:eachCategory) ifFalse:[
self addCategory:eachCategory
].
].
anchor recursiveSortChildren:[:i1 :i2 | i1 category asLowercase < i2 category asLowercase].
anchor expand.
^ anchor
!
hierarchicalCategoryList
|anchor |
hierarchicalCategoryList isNil ifTrue:[
hierarchicalCategoryList := HierarchicalList new.
hierarchicalCategoryList showRoot:false.
(self slaveMode value ~~ true) ifTrue:[
anchor := self generateHierarchicalCategoryTree.
hierarchicalCategoryList root:anchor.
listValid := true
] ifFalse:[
listValid := false
]
].
^ hierarchicalCategoryList
!
hierarchicalCategorySelection
hierarchicalCategorySelection isNil ifTrue:[
hierarchicalCategorySelection := #() asValue.
hierarchicalCategorySelection addDependent:self.
].
^ hierarchicalCategorySelection.
! !
!NewSystemBrowser::HierarchicalClassCategoryList methodsFor:'change & update'!
delayedUpdate:something with:aParameter from:changedObject
|cls sel oldMethod newMethod newPackage|
self inSlaveModeOrInvisible ifTrue:[
super delayedUpdate:something with:aParameter from:changedObject.
^ self.
].
changedObject == updateTrigger ifTrue:[
hierarchicalCategoryTree := nil.
self hierarchicalCategoryList.
self updateTreeSelectionFromList.
^ self
].
changedObject == slaveMode ifTrue:[
listValid ~~ true ifTrue:[
self enqueueDelayedUpdateList
].
"/ self invalidateList.
^ self
].
changedObject == hierarchicalCategorySelection ifTrue:[
self updateSelectionFromTree.
^ self
].
changedObject == self selectedCategories ifTrue:[
"/ update the trees selection as appropriate
"/ self updateTreeSelection.
self updateTreeSelectionFromList.
].
changedObject == categoryList ifTrue:[
"/ update the tree
self hierarchicalCategoryList root:(self generateHierarchicalCategoryTree).
^ self.
].
super delayedUpdate:something with:aParameter from:changedObject
"Created: / 17.2.2000 / 23:41:02 / cg"
"Modified: / 26.2.2000 / 01:21:49 / cg"
!
updateSelectionFromTree
|treeSelection|
treeSelection := hierarchicalCategorySelection value
collect:[:eachIndex | |item|
item := hierarchicalCategoryList at:eachIndex ifAbsent:nil.
item category
].
treeSelection asSet ~= (self selectedCategories value ? #()) asSet ifTrue:[
self selectedCategories value:treeSelection.
]
!
updateTreeSelectionFromList
|listSelection selectedTreeItems treeSelection|
listSelection := self selectedCategories value.
selectedTreeItems := listSelection collect:[:itemString | self treeItemForString:itemString string].
treeSelection := selectedTreeItems collect:[:eachItem | hierarchicalCategoryList identityIndexOf:eachItem].
treeSelection := treeSelection asOrderedCollection.
"/hierarchicalCategorySelection value
"/ collect:[:eachIndex | |item|
"/ item := hierarchicalCategoryList at:eachIndex ifAbsent:nil.
"/ item category
"/ ].
"/
"/ treeSelection asSet ~= (self selectedCategories value ? #()) asSet ifTrue:[
"/ self selectedCategories value:treeSelection.
"/ ]
self hierarchicalCategorySelection value:treeSelection
! !
!NewSystemBrowser::HierarchicalClassCategoryList methodsFor:'private'!
makeItemVisible:itemString
|treeItem idx listView|
treeItem := self treeItemForString:itemString.
idx := hierarchicalCategoryList identityIndexOf:treeItem.
idx ~~ 0 ifTrue:[
(listView := self listView) notNil ifTrue:[
listView makeLineVisible:idx.
]
]
!
release
super release.
hierarchicalCategorySelection removeDependent:self.
!
treeItemForString:itemString
|itemPath treeItem|
itemPath := itemString string asCollectionOfSubstringsSeparatedBy:$-.
treeItem := hierarchicalCategoryList root.
[itemPath notEmpty] whileTrue:[
treeItem expand.
treeItem := treeItem detect:[:childItem | childItem label string = itemPath first] ifNone:nil.
itemPath := itemPath copyFrom:2.
].
^ treeItem
! !
!NewSystemBrowser::HierarchicalClassCategoryList methodsFor:'user actions'!
doubleClicked:anIndex
|item|
item := hierarchicalCategoryList at:anIndex ifAbsent:nil.
item isNil ifTrue:[
^ self
].
(item canExpand not or:[item isExpanded]) ifTrue:[
doubleClickChannel notNil ifTrue:[
doubleClickChannel value:anIndex.
] ifFalse:[
item collapse.
].
^ self
].
item expand.
!
indicatorPressed:anIndex
|item sensor|
item := hierarchicalCategoryList at:anIndex ifAbsent:nil.
item isNil ifTrue:[
^ self
].
sensor := self window sensor.
(sensor ctrlDown or:[sensor shiftDown]) ifTrue:[
item recursiveToggleExpand
] ifFalse:[
item toggleExpand
].
! !
!NewSystemBrowser::HierarchicalClassCategoryList::ClassCategoryItem methodsFor:'accessing'!
category
"return the value of the instance variable 'category' (automatically generated)"
^ category
!
category:something
"set the value of the instance variable 'category' (automatically generated)"
category := something.
!
icon
^ nil "/ SystemBrowser packageIcon
!
label
^ label
!
label:something
label := something.
! !
!NewSystemBrowser::OrganizerCanvas class methodsFor:'interface specs'!
embeddedNameSpaceListSpec
"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::OrganizerCanvas andSelector:#embeddedNameSpaceListSpec
NewSystemBrowser::OrganizerCanvas new openInterface:#embeddedNameSpaceListSpec
"
<resource: #canvas>
^
#(#FullSpec
#name: #embeddedNameSpaceListSpec
#window:
#(#WindowSpec
#label: 'Organizer'
#name: 'Organizer'
#min: #(#Point 0 0)
#max: #(#Point 1024 721)
#bounds: #(#Rectangle 218 175 518 475)
)
#component:
#(#SpecCollection
#collection: #(
#(#SubCanvasSpec
#name: 'NamespaceList2'
#layout: #(#LayoutFrame 0 0.0 0 0.0 0 1.0 0 1.0)
#level: 1
#majorKey: #'NewSystemBrowser::NamespaceList'
#subAspectHolders:
#(#Array
#(#SubChannelInfoSpec
#subAspect: #doubleClickChannel
#aspect: #nameSpaceFilterDoubleClickChannel
)
#(#SubChannelInfoSpec
#subAspect: #forceGeneratorTrigger
#aspect: #forceNamespaceGeneratorTrigger
)
#(#SubChannelInfoSpec
#subAspect: #hideUnloadedClasses
#aspect: #hideUnloadedClasses
)
#(#SubChannelInfoSpec
#subAspect: #immediateUpdate
#aspect: #immediateUpdate
)
#(#SubChannelInfoSpec
#subAspect: #menuHolder
#aspect: #nameSpaceListMenuHolder
)
#(#SubChannelInfoSpec
#subAspect: #organizerMode
#aspect: #organizerMode
)
#(#SubChannelInfoSpec
#subAspect: #outGeneratorHolder
#aspect: #classGeneratorHolder
)
#(#SubChannelInfoSpec
#subAspect: #selectedNamespaces
#aspect: #nameSpaceFilterSelection
)
#(#SubChannelInfoSpec
#subAspect: #selectionChangeCondition
#aspect: #selectionChangeCondition
)
#(#SubChannelInfoSpec
#subAspect: #slaveMode
#aspect: #popUpNameSpaceListSlaveMode
)
#(#SubChannelInfoSpec
#subAspect: #updateTrigger
#aspect: #nameSpaceListUpdateTrigger
)
)
#createNewApplication: true
#createNewBuilder: true
#postBuildCallback: #nameSpaceListWidgetWasBuilt:
)
)
)
)
!
windowSpec
^ self windowSpecNonHierarchical
"/ ^ self windowSpecHierarchical
!
windowSpecHierarchical
"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::OrganizerCanvas andSelector:#windowSpec
NewSystemBrowser::OrganizerCanvas new openInterface:#windowSpec
NewSystemBrowser::OrganizerCanvas open
"
<resource: #canvas>
^
#(#FullSpec
#name: #windowSpec
#window:
#(#WindowSpec
#label: 'Organizer'
#name: 'Organizer'
#min: #(#Point 0 0)
#max: #(#Point 1024 721)
#bounds: #(#Rectangle 16 46 316 346)
)
#component:
#(#SpecCollection
#collection: #(
#(#VariableHorizontalPanelSpec
#name: 'CategoryNameSpaceAndProjectPanel'
#layout: #(#LayoutFrame 0 0.0 0 0.0 0 1.0 0 1.0)
#visibilityChannel: #classHierarchyOrInheritanceNotShown
#barWidth: 2
#showHandle: false
#component:
#(#SpecCollection
#collection: #(
#(#ViewSpec
#name: 'LeftBox'
#component:
#(#SpecCollection
#collection: #(
#(#ViewSpec
#name: 'ClassCategoryAndNamespaceFilterBox'
#layout: #(#LayoutFrame 0 0 0 0 0 1 0 1)
#visibilityChannel: #categoryListShown
#component:
#(#SpecCollection
#collection: #(
#(#SubCanvasSpec
#name: 'ClassCategoryList'
#layout: #(#LayoutFrame 0 0.0 0 0.0 0 1.0 -25 1.0)
"/ #majorKey: #'NewSystemBrowser::ClassCategoryList'
#majorKey: #'NewSystemBrowser::HierarchicalClassCategoryList'
#subAspectHolders:
#(#Array
#(#SubChannelInfoSpec
#subAspect: #doubleClickChannel
#aspect: #classCategoryDoubleClickChannel
)
#(#SubChannelInfoSpec
#subAspect: #forceGeneratorTrigger
#aspect: #forceClassCategoryGeneratorTrigger
)
#(#SubChannelInfoSpec
#subAspect: #hideUnloadedClasses
#aspect: #hideUnloadedClasses
)
#(#SubChannelInfoSpec
#subAspect: #immediateUpdate
#aspect: #immediateUpdate
)
#(#SubChannelInfoSpec
#subAspect: #menuHolder
#aspect: #classCategoryListMenuHolder
)
#(#SubChannelInfoSpec
#subAspect: #organizerMode
#aspect: #organizerMode
)
#(#SubChannelInfoSpec
#subAspect: #outGeneratorHolder
#aspect: #classGeneratorHolder
)
#(#SubChannelInfoSpec
#subAspect: #selectedCategories
#aspect: #selectedCategories
)
#(#SubChannelInfoSpec
#subAspect: #selectionChangeCondition
#aspect: #selectionChangeCondition
)
#(#SubChannelInfoSpec
#subAspect: #slaveMode
#aspect: #categoryListSlaveMode
)
#(#SubChannelInfoSpec
#subAspect: #updateTrigger
#aspect: #classCategoryListUpdateTrigger
)
#(#SubChannelInfoSpec
#subAspect: #nameSpaceFilter
#aspect: #nameSpaceFilterSelection
)
)
#createNewApplication: true
#createNewBuilder: true
)
#(#ExtendedComboBoxSpec
#name: 'NameSpaceFilterComboBox'
#layout: #(#LayoutFrame 0 0 -25 1 0 1 0 1)
#tabable: true
#model: #nameSpaceFilterSelectedNameSpace
#menuWidgetHolder: #nameSpaceListWidgetHolder
#miniScrollerHorizontal: true
#menuSelector: #nameSpaceFilterPopUpMenu
)
)
)
)
#(#SubCanvasSpec
#name: 'NamespaceList'
#layout: #(#LayoutFrame 0 0.0 0 0.0 0 1.0 0 1.0)
#initiallyInvisible: true
#visibilityChannel: #nameSpaceListShown
#majorKey: #'NewSystemBrowser::NamespaceList'
#subAspectHolders:
#(#Array
#(#SubChannelInfoSpec
#subAspect: #doubleClickChannel
#aspect: #nameSpaceDoubleClickChannel
)
#(#SubChannelInfoSpec
#subAspect: #forceGeneratorTrigger
#aspect: #forceNamespaceGeneratorTrigger
)
#(#SubChannelInfoSpec
#subAspect: #hideUnloadedClasses
#aspect: #hideUnloadedClasses
)
#(#SubChannelInfoSpec
#subAspect: #immediateUpdate
#aspect: #immediateUpdate
)
#(#SubChannelInfoSpec
#subAspect: #menuHolder
#aspect: #nameSpaceListMenuHolder
)
#(#SubChannelInfoSpec
#subAspect: #organizerMode
#aspect: #organizerMode
)
#(#SubChannelInfoSpec
#subAspect: #outGeneratorHolder
#aspect: #classGeneratorHolder
)
#(#SubChannelInfoSpec
#subAspect: #selectedNamespaces
#aspect: #selectedNamespaces
)
#(#SubChannelInfoSpec
#subAspect: #selectionChangeCondition
#aspect: #selectionChangeCondition
)
#(#SubChannelInfoSpec
#subAspect: #slaveMode
#aspect: #nameSpaceListSlaveMode
)
#(#SubChannelInfoSpec
#subAspect: #updateTrigger
#aspect: #nameSpaceListUpdateTrigger
)
)
#createNewApplication: true
#createNewBuilder: true
)
#(#SubCanvasSpec
#name: 'ProjectList'
#layout: #(#LayoutFrame 0 0.0 0 0.0 0 1.0 0 1.0)
#initiallyInvisible: true
#visibilityChannel: #projectListShown
#majorKey: #'NewSystemBrowser::HierarchicalProjectList'
#subAspectHolders:
#(#Array
#(#SubChannelInfoSpec
#subAspect: #doubleClickChannel
#aspect: #projectDoubleClickChannel
)
#(#SubChannelInfoSpec
#subAspect: #forceGeneratorTrigger
#aspect: #forceProjectGeneratorTrigger
)
#(#SubChannelInfoSpec
#subAspect: #hideUnloadedClasses
#aspect: #hideUnloadedClasses
)
#(#SubChannelInfoSpec
#subAspect: #immediateUpdate
#aspect: #immediateUpdate
)
#(#SubChannelInfoSpec
#subAspect: #menuHolder
#aspect: #projectListMenuHolder
)
#(#SubChannelInfoSpec
#subAspect: #organizerMode
#aspect: #organizerMode
)
#(#SubChannelInfoSpec
#subAspect: #outGeneratorHolder
#aspect: #classGeneratorHolder
)
#(#SubChannelInfoSpec
#subAspect: #selectedProjects
#aspect: #selectedProjects
)
#(#SubChannelInfoSpec
#subAspect: #selectionChangeCondition
#aspect: #selectionChangeCondition
)
#(#SubChannelInfoSpec
#subAspect: #slaveMode
#aspect: #projectListSlaveMode
)
#(#SubChannelInfoSpec
#subAspect: #updateTrigger
#aspect: #projectListUpdateTrigger
)
)
#createNewApplication: true
#createNewBuilder: true
)
)
)
)
#(#ViewSpec
#name: 'RightBox'
#component:
#(#SpecCollection
#collection: #(
#(#VariableVerticalPanelSpec
#name: 'ClassAndVariablesPanel'
#layout: #(#LayoutFrame 0 0 0 0 0 1 -25 1)
#showHandle: false
#snapMode: #both
#handlePosition: #left
#component:
#(#SpecCollection
#collection: #(
#(#SubCanvasSpec
#name: 'ClassList'
#majorKey: #'NewSystemBrowser::ClassList'
#minorKey: #windowSpec
#subAspectHolders:
#(#Array
#(#SubChannelInfoSpec
#subAspect: #doubleClickChannel
#aspect: #classDoubleClickChannel
)
#(#SubChannelInfoSpec
#subAspect: #markApplicationsHolder
#aspect: #markApplicationsHolder
)
#(#SubChannelInfoSpec
#subAspect: #immediateUpdate
#aspect: #immediateUpdate
)
#(#SubChannelInfoSpec
#subAspect: #showClassPackages
#aspect: #showClassPackages
)
#(#SubChannelInfoSpec
#subAspect: #inGeneratorHolder
#aspect: #classGeneratorHolder
)
#(#SubChannelInfoSpec
#subAspect: #menuHolder
#aspect: #classListMenuHolder
)
#(#SubChannelInfoSpec
#subAspect: #meta
#aspect: #meta
)
#(#SubChannelInfoSpec
#subAspect: #organizerMode
#aspect: #organizerMode
)
#(#SubChannelInfoSpec
#subAspect: #outGeneratorHolder
#aspect: #outGeneratorHolder
)
#(#SubChannelInfoSpec
#subAspect: #packageFilter
#aspect: #packageFilter
)
#(#SubChannelInfoSpec
#subAspect: #nameSpaceFilter
#aspect: #nameSpaceFilter
)
#(#SubChannelInfoSpec
#subAspect: #selectedClasses
#aspect: #selectedClasses
)
#(#SubChannelInfoSpec
#subAspect: #selectionChangeCondition
#aspect: #selectionChangeCondition
)
#(#SubChannelInfoSpec
#subAspect: #slaveMode
#aspect: #classListSlaveMode
)
#(#SubChannelInfoSpec
#subAspect: #updateTrigger
#aspect: #classListUpdateTrigger
)
)
#createNewApplication: true
#createNewBuilder: true
)
#(#SubCanvasSpec
#name: 'VariableList'
#majorKey: #'NewSystemBrowser::VariableList'
#subAspectHolders:
#(#Array
#(#SubChannelInfoSpec
#subAspect: #doubleClickChannel
#aspect: #variableDoubleClickChannel
)
#(#SubChannelInfoSpec
#subAspect: #classHolder
#aspect: #selectedClasses
)
#(#SubChannelInfoSpec
#subAspect: #menuHolder
#aspect: #variablesMenuHolder
)
#(#SubChannelInfoSpec
#subAspect: #selectedVariables
#aspect: #variableFilter
)
#(#SubChannelInfoSpec
#subAspect: #showClassVarsInVariableList
#aspect: #filterClassVars
)
#(#SubChannelInfoSpec
#subAspect: #sortVariablesByName
#aspect: #variableListSortByName
)
)
#createNewApplication: true
#createNewBuilder: true
)
)
)
#handles: #(#Any 0.5 1.0)
)
#(#UISubSpecification
#name: 'MetaToggleSpec2'
#layout: #(#LayoutFrame 0 0 -25 1 0 1 0 1)
#minorKey: #metaSpec
)
)
)
)
)
)
#handles: #(#Any 0.5 1.0)
)
#(#ViewSpec
#name: 'ClassHierarchyOrInheritanceBox'
#layout: #(#LayoutFrame 0 0.0 0 0.0 0 1.0 0 1.0)
#initiallyInvisible: true
#visibilityChannel: #classHierarchyOrInheritanceShown
#component:
#(#SpecCollection
#collection: #(
#(#VariableVerticalPanelSpec
#name: 'VariableVerticalPanel2'
#layout: #(#LayoutFrame 0 0.0 0 0.0 0 1.0 -25 1.0)
#showHandle: false
#snapMode: #both
#handlePosition: #left
#component:
#(#SpecCollection
#collection: #(
#(#ViewSpec
#name: 'HierarchyOrInheritanceBox'
#component:
#(#SpecCollection
#collection: #(
#(#SubCanvasSpec
#name: 'ClassHierarchyList'
#layout: #(#LayoutFrame 0 0.0 0 0.0 0 1.0 0 1.0)
#visibilityChannel: #classHierarchyShown
#majorKey: #'NewSystemBrowser::HierarchicalClassList'
#subAspectHolders:
#(#Array
#(#SubChannelInfoSpec
#subAspect: #doubleClickChannel
#aspect: #classDoubleClickChannel
)
#(#SubChannelInfoSpec
#subAspect: #forceGeneratorTrigger
#aspect: #forceClassInheritanceGeneratorTrigger
)
#(#SubChannelInfoSpec
#subAspect: #hideUnloadedClasses
#aspect: #hideUnloadedClasses
)
#(#SubChannelInfoSpec
#subAspect: #markApplicationsHolder
#aspect: #markApplicationsHolder
)
#(#SubChannelInfoSpec
#subAspect: #showClassPackages
#aspect: #showClassPackages
)
#(#SubChannelInfoSpec
#subAspect: #immediateUpdate
#aspect: #immediateUpdate
)
#(#SubChannelInfoSpec
#subAspect: #menuHolder
#aspect: #classInheritanceListMenuHolder
)
#(#SubChannelInfoSpec
#subAspect: #meta
#aspect: #meta
)
#(#SubChannelInfoSpec
#subAspect: #organizerMode
#aspect: #organizerMode
)
#(#SubChannelInfoSpec
#subAspect: #outGeneratorHolder
#aspect: #outGeneratorHolder
)
#(#SubChannelInfoSpec
#subAspect: #packageFilter
#aspect: #packageFilter
)
#(#SubChannelInfoSpec
#subAspect: #nameSpaceFilter
#aspect: #nameSpaceFilter
)
#(#SubChannelInfoSpec
#subAspect: #selectedClasses
#aspect: #selectedClasses
)
#(#SubChannelInfoSpec
#subAspect: #selectionChangeCondition
#aspect: #selectionChangeCondition
)
#(#SubChannelInfoSpec
#subAspect: #slaveMode
#aspect: #classHierarchyListSlaveMode
)
#(#SubChannelInfoSpec
#subAspect: #topClassHolder
#aspect: #classHierarchyTopClass
)
#(#SubChannelInfoSpec
#subAspect: #updateTrigger
#aspect: #classHierarchyUpdateTrigger
)
)
#createNewApplication: true
#createNewBuilder: true
)
#(#SubCanvasSpec
#name: 'ClassInheritanceList'
#layout: #(#LayoutFrame 0 0.0 0 0.0 0 1.0 0 1.0)
#visibilityChannel: #classInheritanceShown
#majorKey: #'NewSystemBrowser::InheritanceClassList'
#subAspectHolders:
#(#Array
#(#SubChannelInfoSpec
#subAspect: #doubleClickChannel
#aspect: #classDoubleClickChannel
)
#(#SubChannelInfoSpec
#subAspect: #forceGeneratorTrigger
#aspect: #forceClassInheritanceGeneratorTrigger
)
#(#SubChannelInfoSpec
#subAspect: #hideUnloadedClasses
#aspect: #hideUnloadedClasses
)
#(#SubChannelInfoSpec
#subAspect: #markApplicationsHolder
#aspect: #markApplicationsHolder
)
#(#SubChannelInfoSpec
#subAspect: #showClassPackages
#aspect: #showClassPackages
)
#(#SubChannelInfoSpec
#subAspect: #immediateUpdate
#aspect: #immediateUpdate
)
#(#SubChannelInfoSpec
#subAspect: #menuHolder
#aspect: #classInheritanceListMenuHolder
)
#(#SubChannelInfoSpec
#subAspect: #meta
#aspect: #meta
)
#(#SubChannelInfoSpec
#subAspect: #organizerMode
#aspect: #organizerMode
)
#(#SubChannelInfoSpec
#subAspect: #outGeneratorHolder
#aspect: #outGeneratorHolder
)
#(#SubChannelInfoSpec
#subAspect: #packageFilter
#aspect: #packageFilter
)
#(#SubChannelInfoSpec
#subAspect: #nameSpaceFilter
#aspect: #nameSpaceFilter
)
#(#SubChannelInfoSpec
#subAspect: #selectedClasses
#aspect: #selectedClasses
)
#(#SubChannelInfoSpec
#subAspect: #selectionChangeCondition
#aspect: #selectionChangeCondition
)
#(#SubChannelInfoSpec
#subAspect: #slaveMode
#aspect: #classInheritanceListSlaveMode
)
#(#SubChannelInfoSpec
#subAspect: #topClassHolder
#aspect: #classHierarchyTopClass
)
#(#SubChannelInfoSpec
#subAspect: #updateTrigger
#aspect: #classHierarchyUpdateTrigger
)
)
#createNewApplication: true
#createNewBuilder: true
)
)
)
)
#(#SubCanvasSpec
#name: 'VariableList2'
#majorKey: #'NewSystemBrowser::VariableList'
#subAspectHolders:
#(#Array
#(#SubChannelInfoSpec
#subAspect: #doubleClickChannel
#aspect: #variableDoubleClickChannel
)
#(#SubChannelInfoSpec
#subAspect: #classHolder
#aspect: #selectedClasses
)
#(#SubChannelInfoSpec
#subAspect: #menuHolder
#aspect: #variablesMenuHolder
)
#(#SubChannelInfoSpec
#subAspect: #slaveMode
#aspect: #classHierarchyListSlaveMode
)
#(#SubChannelInfoSpec
#subAspect: #selectedVariables
#aspect: #variableFilter
)
#(#SubChannelInfoSpec
#subAspect: #showClassVarsInVariableList
#aspect: #filterClassVars
)
)
#createNewApplication: true
#createNewBuilder: true
)
)
)
#handles: #(#Any 0.5 1.0)
)
#(#SubCanvasSpec
#name: 'MetaToggles1'
#layout: #(#LayoutFrame 0 0.0 -25 1 0 1.0 0 1)
#hasHorizontalScrollBar: false
#hasVerticalScrollBar: false
#minorKey: #metaSpec
)
)
)
)
)
)
)
!
windowSpecNonHierarchical
"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::OrganizerCanvas andSelector:#windowSpec
NewSystemBrowser::OrganizerCanvas new openInterface:#windowSpec
NewSystemBrowser::OrganizerCanvas open
"
<resource: #canvas>
^
#(#FullSpec
#name: #windowSpec
#window:
#(#WindowSpec
#label: 'Organizer'
#name: 'Organizer'
#min: #(#Point 0 0)
#max: #(#Point 1024 721)
#bounds: #(#Rectangle 16 46 316 346)
)
#component:
#(#SpecCollection
#collection: #(
#(#VariableHorizontalPanelSpec
#name: 'CategoryNameSpaceAndProjectPanel'
#layout: #(#LayoutFrame 0 0.0 0 0.0 0 1.0 0 1.0)
#visibilityChannel: #classHierarchyOrInheritanceNotShown
#barWidth: 2
#showHandle: false
#component:
#(#SpecCollection
#collection: #(
#(#ViewSpec
#name: 'LeftBox'
#component:
#(#SpecCollection
#collection: #(
#(#ViewSpec
#name: 'ClassCategoryAndNamespaceFilterBox'
#layout: #(#LayoutFrame 0 0 0 0 0 1 0 1)
#visibilityChannel: #categoryListShown
#component:
#(#SpecCollection
#collection: #(
#(#SubCanvasSpec
#name: 'ClassCategoryList'
#layout: #(#LayoutFrame 0 0.0 0 0.0 0 1.0 -25 1.0)
#majorKey: #'NewSystemBrowser::ClassCategoryList'
#subAspectHolders:
#(#Array
#(#SubChannelInfoSpec
#subAspect: #doubleClickChannel
#aspect: #classCategoryDoubleClickChannel
)
#(#SubChannelInfoSpec
#subAspect: #forceGeneratorTrigger
#aspect: #forceClassCategoryGeneratorTrigger
)
#(#SubChannelInfoSpec
#subAspect: #hideUnloadedClasses
#aspect: #hideUnloadedClasses
)
#(#SubChannelInfoSpec
#subAspect: #immediateUpdate
#aspect: #immediateUpdate
)
#(#SubChannelInfoSpec
#subAspect: #menuHolder
#aspect: #classCategoryListMenuHolder
)
#(#SubChannelInfoSpec
#subAspect: #organizerMode
#aspect: #organizerMode
)
#(#SubChannelInfoSpec
#subAspect: #outGeneratorHolder
#aspect: #classGeneratorHolder
)
#(#SubChannelInfoSpec
#subAspect: #selectedCategories
#aspect: #selectedCategories
)
#(#SubChannelInfoSpec
#subAspect: #selectionChangeCondition
#aspect: #selectionChangeCondition
)
#(#SubChannelInfoSpec
#subAspect: #slaveMode
#aspect: #categoryListSlaveMode
)
#(#SubChannelInfoSpec
#subAspect: #updateTrigger
#aspect: #classCategoryListUpdateTrigger
)
#(#SubChannelInfoSpec
#subAspect: #nameSpaceFilter
#aspect: #nameSpaceFilterSelection
)
)
#createNewApplication: true
#createNewBuilder: true
)
#(#ExtendedComboBoxSpec
#name: 'NameSpaceFilterComboBox'
#layout: #(#LayoutFrame 0 0 -25 1 0 1 0 1)
#tabable: true
#model: #nameSpaceFilterSelectedNameSpace
#menuWidgetHolder: #nameSpaceListWidgetHolder
#miniScrollerHorizontal: true
#menuSelector: #nameSpaceFilterPopUpMenu
)
)
)
)
#(#SubCanvasSpec
#name: 'NamespaceList'
#layout: #(#LayoutFrame 0 0.0 0 0.0 0 1.0 0 1.0)
#initiallyInvisible: true
#visibilityChannel: #nameSpaceListShown
#majorKey: #'NewSystemBrowser::NamespaceList'
#subAspectHolders:
#(#Array
#(#SubChannelInfoSpec
#subAspect: #doubleClickChannel
#aspect: #nameSpaceDoubleClickChannel
)
#(#SubChannelInfoSpec
#subAspect: #forceGeneratorTrigger
#aspect: #forceNamespaceGeneratorTrigger
)
#(#SubChannelInfoSpec
#subAspect: #hideUnloadedClasses
#aspect: #hideUnloadedClasses
)
#(#SubChannelInfoSpec
#subAspect: #immediateUpdate
#aspect: #immediateUpdate
)
#(#SubChannelInfoSpec
#subAspect: #menuHolder
#aspect: #nameSpaceListMenuHolder
)
#(#SubChannelInfoSpec
#subAspect: #organizerMode
#aspect: #organizerMode
)
#(#SubChannelInfoSpec
#subAspect: #outGeneratorHolder
#aspect: #classGeneratorHolder
)
#(#SubChannelInfoSpec
#subAspect: #selectedNamespaces
#aspect: #selectedNamespaces
)
#(#SubChannelInfoSpec
#subAspect: #selectionChangeCondition
#aspect: #selectionChangeCondition
)
#(#SubChannelInfoSpec
#subAspect: #slaveMode
#aspect: #nameSpaceListSlaveMode
)
#(#SubChannelInfoSpec
#subAspect: #updateTrigger
#aspect: #nameSpaceListUpdateTrigger
)
)
#createNewApplication: true
#createNewBuilder: true
)
#(#SubCanvasSpec
#name: 'ProjectList'
#layout: #(#LayoutFrame 0 0.0 0 0.0 0 1.0 0 1.0)
#initiallyInvisible: true
#visibilityChannel: #projectListShown
#majorKey: #'NewSystemBrowser::HierarchicalProjectList'
#subAspectHolders:
#(#Array
#(#SubChannelInfoSpec
#subAspect: #doubleClickChannel
#aspect: #projectDoubleClickChannel
)
#(#SubChannelInfoSpec
#subAspect: #forceGeneratorTrigger
#aspect: #forceProjectGeneratorTrigger
)
#(#SubChannelInfoSpec
#subAspect: #hideUnloadedClasses
#aspect: #hideUnloadedClasses
)
#(#SubChannelInfoSpec
#subAspect: #immediateUpdate
#aspect: #immediateUpdate
)
#(#SubChannelInfoSpec
#subAspect: #menuHolder
#aspect: #projectListMenuHolder
)
#(#SubChannelInfoSpec
#subAspect: #organizerMode
#aspect: #organizerMode
)
#(#SubChannelInfoSpec
#subAspect: #outGeneratorHolder
#aspect: #classGeneratorHolder
)
#(#SubChannelInfoSpec
#subAspect: #selectedProjects
#aspect: #selectedProjects
)
#(#SubChannelInfoSpec
#subAspect: #selectionChangeCondition
#aspect: #selectionChangeCondition
)
#(#SubChannelInfoSpec
#subAspect: #slaveMode
#aspect: #projectListSlaveMode
)
#(#SubChannelInfoSpec
#subAspect: #updateTrigger
#aspect: #projectListUpdateTrigger
)
)
#createNewApplication: true
#createNewBuilder: true
)
)
)
)
#(#ViewSpec
#name: 'RightBox'
#component:
#(#SpecCollection
#collection: #(
#(#VariableVerticalPanelSpec
#name: 'ClassAndVariablesPanel'
#layout: #(#LayoutFrame 0 0 0 0 0 1 -25 1)
#showHandle: false
#snapMode: #both
#handlePosition: #left
#component:
#(#SpecCollection
#collection: #(
#(#SubCanvasSpec
#name: 'ClassList'
#majorKey: #'NewSystemBrowser::ClassList'
#minorKey: #windowSpec
#subAspectHolders:
#(#Array
#(#SubChannelInfoSpec
#subAspect: #doubleClickChannel
#aspect: #classDoubleClickChannel
)
#(#SubChannelInfoSpec
#subAspect: #markApplicationsHolder
#aspect: #markApplicationsHolder
)
#(#SubChannelInfoSpec
#subAspect: #immediateUpdate
#aspect: #immediateUpdate
)
#(#SubChannelInfoSpec
#subAspect: #showClassPackages
#aspect: #showClassPackages
)
#(#SubChannelInfoSpec
#subAspect: #inGeneratorHolder
#aspect: #classGeneratorHolder
)
#(#SubChannelInfoSpec
#subAspect: #menuHolder
#aspect: #classListMenuHolder
)
#(#SubChannelInfoSpec
#subAspect: #meta
#aspect: #meta
)
#(#SubChannelInfoSpec
#subAspect: #organizerMode
#aspect: #organizerMode
)
#(#SubChannelInfoSpec
#subAspect: #outGeneratorHolder
#aspect: #outGeneratorHolder
)
#(#SubChannelInfoSpec
#subAspect: #packageFilter
#aspect: #packageFilter
)
#(#SubChannelInfoSpec
#subAspect: #nameSpaceFilter
#aspect: #nameSpaceFilter
)
#(#SubChannelInfoSpec
#subAspect: #selectedClasses
#aspect: #selectedClasses
)
#(#SubChannelInfoSpec
#subAspect: #selectionChangeCondition
#aspect: #selectionChangeCondition
)
#(#SubChannelInfoSpec
#subAspect: #slaveMode
#aspect: #classListSlaveMode
)
#(#SubChannelInfoSpec
#subAspect: #updateTrigger
#aspect: #classListUpdateTrigger
)
)
#createNewApplication: true
#createNewBuilder: true
)
#(#SubCanvasSpec
#name: 'VariableList'
#majorKey: #'NewSystemBrowser::VariableList'
#subAspectHolders:
#(#Array
#(#SubChannelInfoSpec
#subAspect: #doubleClickChannel
#aspect: #variableDoubleClickChannel
)
#(#SubChannelInfoSpec
#subAspect: #classHolder
#aspect: #selectedClasses
)
#(#SubChannelInfoSpec
#subAspect: #menuHolder
#aspect: #variablesMenuHolder
)
#(#SubChannelInfoSpec
#subAspect: #selectedVariables
#aspect: #variableFilter
)
#(#SubChannelInfoSpec
#subAspect: #showClassVarsInVariableList
#aspect: #filterClassVars
)
#(#SubChannelInfoSpec
#subAspect: #sortVariablesByName
#aspect: #variableListSortByName
)
)
#createNewApplication: true
#createNewBuilder: true
)
)
)
#handles: #(#Any 0.5 1.0)
)
#(#UISubSpecification
#name: 'MetaToggleSpec2'
#layout: #(#LayoutFrame 0 0 -25 1 0 1 0 1)
#minorKey: #metaSpec
)
)
)
)
)
)
#handles: #(#Any 0.5 1.0)
)
#(#ViewSpec
#name: 'ClassHierarchyOrInheritanceBox'
#layout: #(#LayoutFrame 0 0.0 0 0.0 0 1.0 0 1.0)
#initiallyInvisible: true
#visibilityChannel: #classHierarchyOrInheritanceShown
#component:
#(#SpecCollection
#collection: #(
#(#VariableVerticalPanelSpec
#name: 'VariableVerticalPanel2'
#layout: #(#LayoutFrame 0 0.0 0 0.0 0 1.0 -25 1.0)
#showHandle: false
#snapMode: #both
#handlePosition: #left
#component:
#(#SpecCollection
#collection: #(
#(#ViewSpec
#name: 'HierarchyOrInheritanceBox'
#component:
#(#SpecCollection
#collection: #(
#(#SubCanvasSpec
#name: 'ClassHierarchyList'
#layout: #(#LayoutFrame 0 0.0 0 0.0 0 1.0 0 1.0)
#visibilityChannel: #classHierarchyShown
#majorKey: #'NewSystemBrowser::HierarchicalClassList'
#subAspectHolders:
#(#Array
#(#SubChannelInfoSpec
#subAspect: #doubleClickChannel
#aspect: #classDoubleClickChannel
)
#(#SubChannelInfoSpec
#subAspect: #forceGeneratorTrigger
#aspect: #forceClassInheritanceGeneratorTrigger
)
#(#SubChannelInfoSpec
#subAspect: #hideUnloadedClasses
#aspect: #hideUnloadedClasses
)
#(#SubChannelInfoSpec
#subAspect: #markApplicationsHolder
#aspect: #markApplicationsHolder
)
#(#SubChannelInfoSpec
#subAspect: #showClassPackages
#aspect: #showClassPackages
)
#(#SubChannelInfoSpec
#subAspect: #immediateUpdate
#aspect: #immediateUpdate
)
#(#SubChannelInfoSpec
#subAspect: #menuHolder
#aspect: #classInheritanceListMenuHolder
)
#(#SubChannelInfoSpec
#subAspect: #meta
#aspect: #meta
)
#(#SubChannelInfoSpec
#subAspect: #organizerMode
#aspect: #organizerMode
)
#(#SubChannelInfoSpec
#subAspect: #outGeneratorHolder
#aspect: #outGeneratorHolder
)
#(#SubChannelInfoSpec
#subAspect: #packageFilter
#aspect: #packageFilter
)
#(#SubChannelInfoSpec
#subAspect: #nameSpaceFilter
#aspect: #nameSpaceFilter
)
#(#SubChannelInfoSpec
#subAspect: #selectedClasses
#aspect: #selectedClasses
)
#(#SubChannelInfoSpec
#subAspect: #selectionChangeCondition
#aspect: #selectionChangeCondition
)
#(#SubChannelInfoSpec
#subAspect: #slaveMode
#aspect: #classHierarchyListSlaveMode
)
#(#SubChannelInfoSpec
#subAspect: #topClassHolder
#aspect: #classHierarchyTopClass
)
#(#SubChannelInfoSpec
#subAspect: #updateTrigger
#aspect: #classHierarchyUpdateTrigger
)
)
#createNewApplication: true
#createNewBuilder: true
)
#(#SubCanvasSpec
#name: 'ClassInheritanceList'
#layout: #(#LayoutFrame 0 0.0 0 0.0 0 1.0 0 1.0)
#visibilityChannel: #classInheritanceShown
#majorKey: #'NewSystemBrowser::InheritanceClassList'
#subAspectHolders:
#(#Array
#(#SubChannelInfoSpec
#subAspect: #doubleClickChannel
#aspect: #classDoubleClickChannel
)
#(#SubChannelInfoSpec
#subAspect: #forceGeneratorTrigger
#aspect: #forceClassInheritanceGeneratorTrigger
)
#(#SubChannelInfoSpec
#subAspect: #hideUnloadedClasses
#aspect: #hideUnloadedClasses
)
#(#SubChannelInfoSpec
#subAspect: #markApplicationsHolder
#aspect: #markApplicationsHolder
)
#(#SubChannelInfoSpec
#subAspect: #showClassPackages
#aspect: #showClassPackages
)
#(#SubChannelInfoSpec
#subAspect: #immediateUpdate
#aspect: #immediateUpdate
)
#(#SubChannelInfoSpec
#subAspect: #menuHolder
#aspect: #classInheritanceListMenuHolder
)
#(#SubChannelInfoSpec
#subAspect: #meta
#aspect: #meta
)
#(#SubChannelInfoSpec
#subAspect: #organizerMode
#aspect: #organizerMode
)
#(#SubChannelInfoSpec
#subAspect: #outGeneratorHolder
#aspect: #outGeneratorHolder
)
#(#SubChannelInfoSpec
#subAspect: #packageFilter
#aspect: #packageFilter
)
#(#SubChannelInfoSpec
#subAspect: #nameSpaceFilter
#aspect: #nameSpaceFilter
)
#(#SubChannelInfoSpec
#subAspect: #selectedClasses
#aspect: #selectedClasses
)
#(#SubChannelInfoSpec
#subAspect: #selectionChangeCondition
#aspect: #selectionChangeCondition
)
#(#SubChannelInfoSpec
#subAspect: #slaveMode
#aspect: #classInheritanceListSlaveMode
)
#(#SubChannelInfoSpec
#subAspect: #topClassHolder
#aspect: #classHierarchyTopClass
)
#(#SubChannelInfoSpec
#subAspect: #updateTrigger
#aspect: #classHierarchyUpdateTrigger
)
)
#createNewApplication: true
#createNewBuilder: true
)
)
)
)
#(#SubCanvasSpec
#name: 'VariableList2'
#majorKey: #'NewSystemBrowser::VariableList'
#subAspectHolders:
#(#Array
#(#SubChannelInfoSpec
#subAspect: #doubleClickChannel
#aspect: #variableDoubleClickChannel
)
#(#SubChannelInfoSpec
#subAspect: #classHolder
#aspect: #selectedClasses
)
#(#SubChannelInfoSpec
#subAspect: #menuHolder
#aspect: #variablesMenuHolder
)
#(#SubChannelInfoSpec
#subAspect: #slaveMode
#aspect: #classHierarchyListSlaveMode
)
#(#SubChannelInfoSpec
#subAspect: #selectedVariables
#aspect: #variableFilter
)
#(#SubChannelInfoSpec
#subAspect: #showClassVarsInVariableList
#aspect: #filterClassVars
)
)
#createNewApplication: true
#createNewBuilder: true
)
)
)
#handles: #(#Any 0.5 1.0)
)
#(#SubCanvasSpec
#name: 'MetaToggles1'
#layout: #(#LayoutFrame 0 0.0 -25 1 0 1.0 0 1)
#hasHorizontalScrollBar: false
#hasVerticalScrollBar: false
#minorKey: #metaSpec
)
)
)
)
)
)
)
!
windowSpecWithoutMetaToggles
"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::OrganizerCanvas andSelector:#windowSpecWithoutMetaToggles
NewSystemBrowser::OrganizerCanvas new openInterface:#windowSpecWithoutMetaToggles
"
<resource: #canvas>
^
#(#FullSpec
#name: #windowSpecWithoutMetaToggles
#window:
#(#WindowSpec
#label: 'Organizer'
#name: 'Organizer'
#min: #(#Point 0 0)
#max: #(#Point 1024 721)
#bounds: #(#Rectangle 13 23 313 323)
)
#component:
#(#SpecCollection
#collection: #(
#(#SubCanvasSpec
#name: 'ClassHierarchyList'
#layout: #(#LayoutFrame 0 0.0 0 0.0 0 1.0 0 1.0)
#visibilityChannel: #classHierarchyShown
#majorKey: #'NewSystemBrowser::HierarchicalClassList'
#minorKey: #windowSpec
#subAspectHolders:
#(#Array
#(#SubChannelInfoSpec
#subAspect: #doubleClickChannel
#aspect: #classDoubleClickChannel
)
#(#SubChannelInfoSpec
#subAspect: #forceGeneratorTrigger
#aspect: #forceClassInheritanceGeneratorTrigger
)
#(#SubChannelInfoSpec
#subAspect: #hideUnloadedClasses
#aspect: #hideUnloadedClasses
)
#(#SubChannelInfoSpec
#subAspect: #markApplicationsHolder
#aspect: #markApplicationsHolder
)
#(#SubChannelInfoSpec
#subAspect: #showClassPackages
#aspect: #showClassPackages
)
#(#SubChannelInfoSpec
#subAspect: #showMethodInheritance
#aspect: #showMethodInheritance
)
#(#SubChannelInfoSpec
#subAspect: #methodVisibilityHolder
#aspect: #methodVisibilityHolder
)
#(#SubChannelInfoSpec
#subAspect: #immediateUpdate
#aspect: #immediateUpdate
)
#(#SubChannelInfoSpec
#subAspect: #menuHolder
#aspect: #classInheritanceListMenuHolder
)
#(#SubChannelInfoSpec
#subAspect: #meta
#aspect: #meta
)
#(#SubChannelInfoSpec
#subAspect: #organizerMode
#aspect: #organizerMode
)
#(#SubChannelInfoSpec
#subAspect: #outGeneratorHolder
#aspect: #outGeneratorHolder
)
#(#SubChannelInfoSpec
#subAspect: #packageFilter
#aspect: #packageFilter
)
#(#SubChannelInfoSpec
#subAspect: #nameSpaceFilter
#aspect: #nameSpaceFilter
)
#(#SubChannelInfoSpec
#subAspect: #selectedClasses
#aspect: #selectedClasses
)
#(#SubChannelInfoSpec
#subAspect: #selectionChangeCondition
#aspect: #selectionChangeCondition
)
#(#SubChannelInfoSpec
#subAspect: #slaveMode
#aspect: #classInheritanceListSlaveMode
)
#(#SubChannelInfoSpec
#subAspect: #topClassHolder
#aspect: #classHierarchyTopClass
)
#(#SubChannelInfoSpec
#subAspect: #updateTrigger
#aspect: #classHierarchyUpdateTrigger
)
)
#createNewApplication: true
#createNewBuilder: true
)
#(#SubCanvasSpec
#name: 'ClassInheritanceList'
#layout: #(#LayoutFrame 0 0.0 0 0.0 0 1.0 0 1.0)
#visibilityChannel: #classInheritanceShown
#majorKey: #'NewSystemBrowser::InheritanceClassList'
#minorKey: #windowSpec
#subAspectHolders:
#(#Array
#(#SubChannelInfoSpec
#subAspect: #doubleClickChannel
#aspect: #classDoubleClickChannel
)
#(#SubChannelInfoSpec
#subAspect: #forceGeneratorTrigger
#aspect: #forceClassInheritanceGeneratorTrigger
)
#(#SubChannelInfoSpec
#subAspect: #hideUnloadedClasses
#aspect: #hideUnloadedClasses
)
#(#SubChannelInfoSpec
#subAspect: #markApplicationsHolder
#aspect: #markApplicationsHolder
)
#(#SubChannelInfoSpec
#subAspect: #immediateUpdate
#aspect: #immediateUpdate
)
#(#SubChannelInfoSpec
#subAspect: #menuHolder
#aspect: #classInheritanceListMenuHolder
)
#(#SubChannelInfoSpec
#subAspect: #meta
#aspect: #meta
)
#(#SubChannelInfoSpec
#subAspect: #organizerMode
#aspect: #organizerMode
)
#(#SubChannelInfoSpec
#subAspect: #outGeneratorHolder
#aspect: #outGeneratorHolder
)
#(#SubChannelInfoSpec
#subAspect: #packageFilter
#aspect: #packageFilter
)
#(#SubChannelInfoSpec
#subAspect: #nameSpaceFilter
#aspect: #nameSpaceFilter
)
#(#SubChannelInfoSpec
#subAspect: #selectedClasses
#aspect: #selectedClasses
)
#(#SubChannelInfoSpec
#subAspect: #selectionChangeCondition
#aspect: #selectionChangeCondition
)
#(#SubChannelInfoSpec
#subAspect: #slaveMode
#aspect: #classInheritanceListSlaveMode
)
#(#SubChannelInfoSpec
#subAspect: #topClassHolder
#aspect: #classHierarchyTopClass
)
#(#SubChannelInfoSpec
#subAspect: #updateTrigger
#aspect: #classHierarchyUpdateTrigger
)
)
#createNewApplication: true
#createNewBuilder: true
)
#(#VariableHorizontalPanelSpec
#name: 'VariableHorizontalPanel1'
#layout: #(#LayoutFrame 0 0.0 0 0.0 0 1.0 0 1.0)
#visibilityChannel: #classHierarchyNotShown
#barWidth: 2
#showHandle: false
#component:
#(#SpecCollection
#collection: #(
#(#ViewSpec
#name: 'Box1'
#component:
#(#SpecCollection
#collection: #(
#(#SubCanvasSpec
#name: 'ClassCategoryList'
#layout: #(#LayoutFrame 0 0.0 0 0.0 0 1.0 0 1.0)
#visibilityChannel: #categoryListShown
#majorKey: #'NewSystemBrowser::ClassCategoryList'
#subAspectHolders:
#(#Array
#(#SubChannelInfoSpec
#subAspect: #doubleClickChannel
#aspect: #classCategoryDoubleClickChannel
)
#(#SubChannelInfoSpec
#subAspect: #forceGeneratorTrigger
#aspect: #forceClassCategoryGeneratorTrigger
)
#(#SubChannelInfoSpec
#subAspect: #hideUnloadedClasses
#aspect: #hideUnloadedClasses
)
#(#SubChannelInfoSpec
#subAspect: #immediateUpdate
#aspect: #immediateUpdate
)
#(#SubChannelInfoSpec
#subAspect: #menuHolder
#aspect: #classCategoryListMenuHolder
)
#(#SubChannelInfoSpec
#subAspect: #organizerMode
#aspect: #organizerMode
)
#(#SubChannelInfoSpec
#subAspect: #outGeneratorHolder
#aspect: #classGeneratorHolder
)
#(#SubChannelInfoSpec
#subAspect: #selectedCategories
#aspect: #selectedCategories
)
#(#SubChannelInfoSpec
#subAspect: #selectionChangeCondition
#aspect: #selectionChangeCondition
)
#(#SubChannelInfoSpec
#subAspect: #updateTrigger
#aspect: #classCategoryListUpdateTrigger
)
)
#createNewApplication: true
#createNewBuilder: true
)
#(#SubCanvasSpec
#name: 'NamespaceList'
#layout: #(#LayoutFrame 0 0.0 0 0.0 0 1.0 0 1.0)
#visibilityChannel: #nameSpaceListShown
#majorKey: #'NewSystemBrowser::NamespaceList'
#subAspectHolders:
#(#Array
#(#SubChannelInfoSpec
#subAspect: #doubleClickChannel
#aspect: #nameSpaceDoubleClickChannel
)
#(#SubChannelInfoSpec
#subAspect: #forceGeneratorTrigger
#aspect: #forceNamespaceGeneratorTrigger
)
#(#SubChannelInfoSpec
#subAspect: #hideUnloadedClasses
#aspect: #hideUnloadedClasses
)
#(#SubChannelInfoSpec
#subAspect: #immediateUpdate
#aspect: #immediateUpdate
)
#(#SubChannelInfoSpec
#subAspect: #menuHolder
#aspect: #nameSpaceListMenuHolder
)
#(#SubChannelInfoSpec
#subAspect: #organizerMode
#aspect: #organizerMode
)
#(#SubChannelInfoSpec
#subAspect: #outGeneratorHolder
#aspect: #classGeneratorHolder
)
#(#SubChannelInfoSpec
#subAspect: #selectedNamespaces
#aspect: #selectedNamespaces
)
#(#SubChannelInfoSpec
#subAspect: #selectionChangeCondition
#aspect: #selectionChangeCondition
)
#(#SubChannelInfoSpec
#subAspect: #updateTrigger
#aspect: #nameSpaceListUpdateTrigger
)
)
#createNewApplication: true
#createNewBuilder: true
)
#(#SubCanvasSpec
#name: 'ProjectList'
#layout: #(#LayoutFrame 0 0.0 0 0.0 0 1.0 0 1.0)
#visibilityChannel: #projectListShown
#majorKey: #'NewSystemBrowser::ProjectList'
#subAspectHolders:
#(#Array
#(#SubChannelInfoSpec
#subAspect: #doubleClickChannel
#aspect: #projectDoubleClickChannel
)
#(#SubChannelInfoSpec
#subAspect: #forceGeneratorTrigger
#aspect: #forceProjectGeneratorTrigger
)
#(#SubChannelInfoSpec
#subAspect: #hideUnloadedClasses
#aspect: #hideUnloadedClasses
)
#(#SubChannelInfoSpec
#subAspect: #immediateUpdate
#aspect: #immediateUpdate
)
#(#SubChannelInfoSpec
#subAspect: #menuHolder
#aspect: #projectListMenuHolder
)
#(#SubChannelInfoSpec
#subAspect: #organizerMode
#aspect: #organizerMode
)
#(#SubChannelInfoSpec
#subAspect: #outGeneratorHolder
#aspect: #classGeneratorHolder
)
#(#SubChannelInfoSpec
#subAspect: #selectedProjects
#aspect: #selectedProjects
)
#(#SubChannelInfoSpec
#subAspect: #selectionChangeCondition
#aspect: #selectionChangeCondition
)
#(#SubChannelInfoSpec
#subAspect: #updateTrigger
#aspect: #projectListUpdateTrigger
)
)
#createNewApplication: true
#createNewBuilder: true
)
)
)
)
#(#SubCanvasSpec
#name: 'ClassList'
#majorKey: #'NewSystemBrowser::ClassList'
#minorKey: #windowSpec
#subAspectHolders:
#(#Array
#(#SubChannelInfoSpec
#subAspect: #doubleClickChannel
#aspect: #classDoubleClickChannel
)
#(#SubChannelInfoSpec
#subAspect: #hidePrivateClasses
#aspect: #hidePrivateClasses
)
#(#SubChannelInfoSpec
#subAspect: #hideUnloadedClasses
#aspect: #hideUnloadedClasses
)
#(#SubChannelInfoSpec
#subAspect: #markApplicationsHolder
#aspect: #markApplicationsHolder
)
#(#SubChannelInfoSpec
#subAspect: #immediateUpdate
#aspect: #immediateUpdate
)
#(#SubChannelInfoSpec
#subAspect: #inGeneratorHolder
#aspect: #classGeneratorHolder
)
#(#SubChannelInfoSpec
#subAspect: #menuHolder
#aspect: #classListMenuHolder
)
#(#SubChannelInfoSpec
#subAspect: #meta
#aspect: #meta
)
#(#SubChannelInfoSpec
#subAspect: #organizerMode
#aspect: #organizerMode
)
#(#SubChannelInfoSpec
#subAspect: #outGeneratorHolder
#aspect: #outGeneratorHolder
)
#(#SubChannelInfoSpec
#subAspect: #selectedClasses
#aspect: #selectedClasses
)
#(#SubChannelInfoSpec
#subAspect: #selectionChangeCondition
#aspect: #selectionChangeCondition
)
#(#SubChannelInfoSpec
#subAspect: #slaveMode
#aspect: #classListSlaveMode
)
#(#SubChannelInfoSpec
#subAspect: #updateTrigger
#aspect: #classListUpdateTrigger
)
)
#createNewApplication: true
#createNewBuilder: true
)
)
)
#handles: #(#Any 0.5 1.0)
)
)
)
)
"Modified: / 25.2.2000 / 22:39:54 / cg"
! !
!NewSystemBrowser::OrganizerCanvas class methodsFor:'plugIn spec'!
aspectSelectors
"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."
"Return a description of exported aspects;
these can be connected to aspects of an embedding application
(if this app is embedded in a subCanvas)."
^ #(
#(#classCategoryDoubleClickChannel #action )
#classCategoryListMenuHolder
#(#classDoubleClickChannel #action )
#classHierarchyListMenuHolder
#classHierarchyTopClass
#classListMenuHolder
#filterClassVars
#hidePrivateClasses
#hideUnloadedClasses
#immediateUpdate
#meta
#metaToggleLabelHolder
#(#nameSpaceDoubleClickChannel #action )
#nameSpaceFilter
#nameSpaceListMenuHolder
#organizerMode
#outGeneratorHolder
#packageFilter
#(#projectDoubleClickChannel #action )
#projectListMenuHolder
#selectedCategories
#selectedClasses
#selectedNamespaces
#selectedProjects
#selectedProtocols
#selectionChangeCondition
#showClassPackages
#(#variableDoubleClickChannel #action )
#variableFilter
#variablesMenuHolder
#markApplicationsHolder
).
! !
!NewSystemBrowser::OrganizerCanvas methodsFor:'aspects'!
classCategoryDoubleClickChannel
"automatically generated by UIPainter ..."
"*** the code below creates a default model when invoked."
"*** (which may not be the one you wanted)"
"*** Please change as required and accept it in the browser."
classCategoryDoubleClickChannel isNil ifTrue:[
classCategoryDoubleClickChannel := TriggerValue new.
"/ classCategoryDoubleClickChannel addDependent:self.
].
^ classCategoryDoubleClickChannel.
!
classCategoryListMenuHolder
"automatically generated by UIPainter ..."
"*** the code below creates a default model when invoked."
"*** (which may not be the one you wanted)"
"*** Please change as required and accept it in the browser."
classCategoryListMenuHolder isNil ifTrue:[
classCategoryListMenuHolder := ValueHolder new.
"/ classCategoryListMenuHolder addDependent:self.
].
^ classCategoryListMenuHolder.
"Created: / 18.2.2000 / 11:52:55 / cg"
!
classDoubleClickChannel
"automatically generated by UIPainter ..."
"*** the code below creates a default model when invoked."
"*** (which may not be the one you wanted)"
"*** Please change as required and accept it in the browser."
classDoubleClickChannel isNil ifTrue:[
classDoubleClickChannel := TriggerValue new.
"/ classDoubleClickChannel addDependent:self.
].
^ classDoubleClickChannel.
!
classGeneratorHolder
"automatically generated by UIPainter ..."
"*** the code below creates a default model when invoked."
"*** (which may not be the one you wanted)"
"*** Please change as required and accept it in the browser."
classGeneratorHolder isNil ifTrue:[
classGeneratorHolder := ValueHolder new.
"/ classGeneratorHolder addDependent:self.
].
^ classGeneratorHolder.
"Created: / 18.2.2000 / 00:56:50 / cg"
!
classGeneratorHolderFromClassCategory
"automatically generated by UIPainter ..."
"*** the code below creates a default model when invoked."
"*** (which may not be the one you wanted)"
"*** Please change as required and accept it in the browser."
classGeneratorHolderFromClassCategory isNil ifTrue:[
classGeneratorHolderFromClassCategory := ValueHolder new.
"/ classGeneratorHolderFromClassCategory addDependent:self.
].
^ classGeneratorHolderFromClassCategory.
"Created: / 18.2.2000 / 02:21:55 / cg"
!
classGeneratorHolderFromClassHierarchy
"automatically generated by UIPainter ..."
"*** the code below creates a default model when invoked."
"*** (which may not be the one you wanted)"
"*** Please change as required and accept it in the browser."
classGeneratorHolderFromClassHierarchy isNil ifTrue:[
classGeneratorHolderFromClassHierarchy := ValueHolder new.
"/ classGeneratorHolderFromClassHierarchy addDependent:self.
].
^ classGeneratorHolderFromClassHierarchy.
"Created: / 18.2.2000 / 02:21:55 / cg"
!
classGeneratorHolderFromNamespace
"automatically generated by UIPainter ..."
"*** the code below creates a default model when invoked."
"*** (which may not be the one you wanted)"
"*** Please change as required and accept it in the browser."
classGeneratorHolderFromNamespace isNil ifTrue:[
classGeneratorHolderFromNamespace := ValueHolder new.
"/ classGeneratorHolderFromNamespace addDependent:self.
].
^ classGeneratorHolderFromNamespace.
"Created: / 18.2.2000 / 02:21:55 / cg"
!
classGeneratorHolderFromProject
"automatically generated by UIPainter ..."
"*** the code below creates a default model when invoked."
"*** (which may not be the one you wanted)"
"*** Please change as required and accept it in the browser."
classGeneratorHolderFromProject isNil ifTrue:[
classGeneratorHolderFromProject := ValueHolder new.
"/ classGeneratorHolderFromProject addDependent:self.
].
^ classGeneratorHolderFromProject.
"Created: / 18.2.2000 / 02:21:55 / cg"
!
classHierarchyListMenuHolder
"automatically generated by UIPainter ..."
"*** the code below creates a default model when invoked."
"*** (which may not be the one you wanted)"
"*** Please change as required and accept it in the browser."
classHierarchyListMenuHolder isNil ifTrue:[
classHierarchyListMenuHolder := ValueHolder new.
"/ classHierarchyListMenuHolder addDependent:self.
].
^ classHierarchyListMenuHolder.
"Created: / 18.2.2000 / 11:52:55 / cg"
!
classHierarchyTopClass
"automatically generated by UIPainter ..."
"*** the code below creates a default model when invoked."
"*** (which may not be the one you wanted)"
"*** Please change as required and accept it in the browser."
|holder|
(holder := builder bindingAt:#classHierarchyTopClass) isNil ifTrue:[
holder := ValueHolder new.
builder aspectAt:#classHierarchyTopClass put:holder.
"/ holder addDependent:self.
].
^ holder.
!
classInheritanceListMenuHolder
^ self classHierarchyListMenuHolder
!
classList
"automatically generated by UIPainter ..."
"*** the code below creates a default model when invoked."
"*** (which may not be the one you wanted)"
"*** Please change as required and accept it in the browser."
classList isNil ifTrue:[
classList := ValueHolder new.
"/ classList addDependent:self.
].
^ classList.
"Created: / 18.2.2000 / 00:23:43 / cg"
!
classListMenuHolder
"automatically generated by UIPainter ..."
"*** the code below creates a default model when invoked."
"*** (which may not be the one you wanted)"
"*** Please change as required and accept it in the browser."
classListMenuHolder isNil ifTrue:[
classListMenuHolder := ValueHolder new.
"/ classListMenuHolder addDependent:self.
].
^ classListMenuHolder.
"Created: / 18.2.2000 / 11:57:22 / cg"
!
filterClassVars
"automatically generated by UIPainter ..."
"*** the code below creates a default model when invoked."
"*** (which may not be the one you wanted)"
"*** Please change as required and accept it in the browser."
filterClassVars isNil ifTrue:[
filterClassVars := ValueHolder new.
"/ filterClassVars addDependent:self.
].
^ filterClassVars.
"Created: / 24.2.2000 / 23:29:52 / cg"
!
hidePrivateClasses
"automatically generated by UIPainter ..."
"*** the code below creates a default model when invoked."
"*** (which may not be the one you wanted)"
"*** Please change as required and accept it in the browser."
hidePrivateClasses isNil ifTrue:[
hidePrivateClasses := false asValue.
"/ hidePrivateClasses addDependent:self.
].
^ hidePrivateClasses.
"Created: / 24.2.2000 / 16:18:45 / cg"
!
hideUnloadedClasses
"automatically generated by UIPainter ..."
"*** the code below creates a default model when invoked."
"*** (which may not be the one you wanted)"
"*** Please change as required and accept it in the browser."
hideUnloadedClasses isNil ifTrue:[
hideUnloadedClasses := false asValue.
"/ hideUnloadedClasses addDependent:self.
].
^ hideUnloadedClasses.
"Created: / 18.2.2000 / 17:54:57 / cg"
!
immediateUpdate
"automatically generated by UIPainter ..."
"*** the code below creates a default model when invoked."
"*** (which may not be the one you wanted)"
"*** Please change as required and accept it in the browser."
immediateUpdate isNil ifTrue:[
immediateUpdate := false asValue.
"/ immediateUpdate addDependent:self.
].
^ immediateUpdate.
"Created: / 18.2.2000 / 00:23:43 / cg"
!
markApplicationsHolder
markApplicationsHolder isNil ifTrue:[
markApplicationsHolder := false asValue.
].
^ markApplicationsHolder.
!
meta
"automatically generated by UIPainter ..."
"*** the code below creates a default model when invoked."
"*** (which may not be the one you wanted)"
"*** Please change as required and accept it in the browser."
meta isNil ifTrue:[
meta := false asValue.
"/ meta addDependent:self.
].
^ meta.
"Created: / 18.2.2000 / 00:23:43 / cg"
"Modified: / 18.2.2000 / 00:42:23 / cg"
!
metaToggle
metaToggle isNil ifTrue:[
metaToggle := PluggableAdaptor on:(self meta).
metaToggle
getBlock:[:m | m value == true]
putBlock:[:m :newValue | m value:(newValue ? false)]
updateBlock:[:m :aspect :param | true].
].
^ metaToggle
!
metaToggleLabelHolder
"automatically generated by UIPainter ..."
"*** the code below creates a default model when invoked."
"*** (which may not be the one you wanted)"
"*** Please change as required and accept it in the browser."
metaToggleLabelHolder isNil ifTrue:[
metaToggleLabelHolder := (resources string:'Class') asValue.
"/ metaToggleLabelHolder addDependent:self.
].
^ metaToggleLabelHolder.
"Created: / 18.2.2000 / 11:52:55 / cg"
!
nameSpaceDoubleClickChannel
"automatically generated by UIPainter ..."
"*** the code below creates a default model when invoked."
"*** (which may not be the one you wanted)"
"*** Please change as required and accept it in the browser."
|holder|
(holder := builder bindingAt:#nameSpaceDoubleClickChannel) isNil ifTrue:[
holder := TriggerValue new.
builder aspectAt:#nameSpaceDoubleClickChannel put:holder.
"/ holder addDependent:self.
].
^ holder.
!
nameSpaceFilter
"automatically generated by UIPainter ..."
nameSpaceFilter isNil ifTrue:[
nameSpaceFilter := ValueHolder new.
self halt.
nameSpaceFilter onChangeEvaluate:[
self halt.
nameSpaceFilter value ~= nameSpaceFilterSelection value ifTrue:[
self halt
].
"/ self nameSpaceFilter value: nameSpaceFilterSelection value.
]
].
^ nameSpaceFilter.
"Created: / 24.2.2000 / 23:29:52 / cg"
!
nameSpaceFilterDoubleClickChannel
"automatically generated by UIPainter ..."
"*** the code below creates a default model when invoked."
"*** (which may not be the one you wanted)"
"*** Please change as required and accept it in the browser."
|holder|
(holder := builder bindingAt:#nameSpaceFilterDoubleClickChannel) isNil ifTrue:[
holder := TriggerValue new.
builder aspectAt:#nameSpaceFilterDoubleClickChannel put:holder.
holder onChangeEvaluate:[
(builder componentAt:#NameSpaceFilterComboBox) closeMenu.
"/ self nameSpaceDoubleClickChannel value:true.
]
].
^ holder.
!
nameSpaceFilterPopUpMenu
^ self nameSpaceListMenuHolder.
!
nameSpaceFilterSelectedNameSpace
|holder|
(holder := builder bindingAt:#nameSpaceFilterSelectedNameSpace) isNil ifTrue:[
holder := self class nameListEntryForALL "'* all *'" asValue.
builder aspectAt:#nameSpaceFilterSelectedNameSpace put:holder.
holder onChangeEvaluate:[ self updateNameSpaceLabel. ].
].
^ holder.
"Created: / 18.2.2000 / 11:52:55 / cg"
!
nameSpaceFilterSelection
"automatically generated by UIPainter ..."
nameSpaceFilterSelection isNil ifTrue:[
nameSpaceFilterSelection := (OrderedCollection with:self class nameListEntryForALL) asValue.
nameSpaceFilterSelection addDependent:self.
].
^ nameSpaceFilterSelection.
!
nameSpaceListMenuHolder
"automatically generated by UIPainter ..."
"*** the code below creates a default model when invoked."
"*** (which may not be the one you wanted)"
"*** Please change as required and accept it in the browser."
|holder|
(holder := builder bindingAt:#nameSpaceListMenuHolder) isNil ifTrue:[
holder := ValueHolder new.
builder aspectAt:#nameSpaceListMenuHolder put:holder.
"/ holder addDependent:self.
].
^ holder.
"Created: / 18.2.2000 / 11:52:55 / cg"
!
nameSpaceListWidget
|view|
view := SubCanvas new.
view client:self spec:#embeddedNameSpaceListSpec builder:nil. "/ (self builder).
(view builder findComponentAt:#List) autoHideHorizontalScrollBar:true.
^ view.
!
nameSpaceListWidgetHolder
"automatically generated by UIPainter ..."
"*** the code below creates a default model when invoked."
"*** (which may not be the one you wanted)"
"*** Please change as required and accept it in the browser."
|holder|
(holder := builder bindingAt:#nameSpaceListWidgetHolder) isNil ifTrue:[
holder := ValueHolder new.
builder aspectAt:#nameSpaceListWidgetHolder put:holder.
holder value:(self nameSpaceListWidget).
].
^ holder.
!
notMetaToggle
notMetaToggle isNil ifTrue:[
notMetaToggle := PluggableAdaptor on:(self meta).
notMetaToggle
getBlock:[:m | m value == false]
putBlock:[:m :newValue | m value:(newValue ? false) not]
updateBlock:[:m :aspect :param | true].
].
^ notMetaToggle
!
organizerMode
organizerMode isNil ifTrue:[
organizerMode := #category asValue.
organizerMode addDependent:self.
].
^ organizerMode
"Created: / 18.2.2000 / 00:30:44 / cg"
"Modified: / 18.2.2000 / 02:56:21 / cg"
!
outGeneratorHolder
"automatically generated by UIPainter ..."
"*** the code below creates a default model when invoked."
"*** (which may not be the one you wanted)"
"*** Please change as required and accept it in the browser."
|holder|
(holder := builder bindingAt:#outGeneratorHolder) isNil ifTrue:[
holder := ValueHolder new.
builder aspectAt:#outGeneratorHolder put:holder.
"/ holder addDependent:self.
].
^ holder.
"Created: / 18.2.2000 / 00:23:43 / cg"
!
packageFilter
"automatically generated by UIPainter ..."
packageFilter isNil ifTrue:[
packageFilter := ValueHolder new.
"/ packageFilter addDependent:self.
].
^ packageFilter.
"Created: / 24.2.2000 / 23:29:52 / cg"
!
popUpNameSpaceListSlaveMode
^ false
!
projectDoubleClickChannel
"automatically generated by UIPainter ..."
"*** the code below creates a default model when invoked."
"*** (which may not be the one you wanted)"
"*** Please change as required and accept it in the browser."
|holder|
(holder := builder bindingAt:#projectDoubleClickChannel) isNil ifTrue:[
holder := TriggerValue new.
builder aspectAt:#projectDoubleClickChannel put:holder.
"/ holder addDependent:self.
].
^ holder.
!
projectListMenuHolder
"automatically generated by UIPainter ..."
"*** the code below creates a default model when invoked."
"*** (which may not be the one you wanted)"
"*** Please change as required and accept it in the browser."
projectListMenuHolder isNil ifTrue:[
projectListMenuHolder := ValueHolder new.
"/ projectListMenuHolder addDependent:self.
].
^ projectListMenuHolder.
"Created: / 18.2.2000 / 11:52:55 / cg"
!
selectedCategories
"automatically generated by UIPainter ..."
"*** the code below creates a default model when invoked."
"*** (which may not be the one you wanted)"
"*** Please change as required and accept it in the browser."
selectedCategories isNil ifTrue:[
selectedCategories := ValueHolder new.
"/ selectedCategories addDependent:self.
].
^ selectedCategories.
"Created: / 18.2.2000 / 12:27:58 / cg"
!
selectedClasses
"automatically generated by UIPainter ..."
"*** the code below creates a default model when invoked."
"*** (which may not be the one you wanted)"
"*** Please change as required and accept it in the browser."
selectedClasses isNil ifTrue:[
selectedClasses := ValueHolder new.
selectedClasses addDependent:self.
].
^ selectedClasses.
"Created: / 18.2.2000 / 00:23:43 / cg"
!
selectedNamespaces
"automatically generated by UIPainter ..."
"*** the code below creates a default model when invoked."
"*** (which may not be the one you wanted)"
"*** Please change as required and accept it in the browser."
selectedNamespaces isNil ifTrue:[
selectedNamespaces := (OrderedCollection with:self class nameListEntryForALL) asValue.
].
^ selectedNamespaces.
"Created: / 18.2.2000 / 12:27:58 / cg"
!
selectedProjects
"automatically generated by UIPainter ..."
"*** the code below creates a default model when invoked."
"*** (which may not be the one you wanted)"
"*** Please change as required and accept it in the browser."
selectedProjects isNil ifTrue:[
selectedProjects := ValueHolder new.
"/ selectedProjects addDependent:self.
].
^ selectedProjects.
"Created: / 18.2.2000 / 12:16:01 / cg"
!
selectionChangeCondition
"automatically generated by UIPainter ..."
"*** the code below creates a default model when invoked."
"*** (which may not be the one you wanted)"
"*** Please change as required and accept it in the browser."
selectionChangeCondition isNil ifTrue:[
selectionChangeCondition := ValueHolder new.
"/ selectionChangeCondition addDependent:self.
].
^ selectionChangeCondition.
"Created: / 18.2.2000 / 00:23:43 / cg"
!
showClassPackages
"automatically generated by UIPainter ..."
"*** the code below creates a default model when invoked."
"*** (which may not be the one you wanted)"
"*** Please change as required and accept it in the browser."
showClassPackages isNil ifTrue:[
showClassPackages := false asValue.
"/ showClassPackages addDependent:self.
].
^ showClassPackages.
"Created: / 18.2.2000 / 17:54:57 / cg"
!
updateNameSpaceLabel
|box|
box := self builder componentAt:#NameSpaceFilterComboBox.
box notNil ifTrue:[
"/ new code: ExtComboBox uses always an EditField
box editor contents:nameSpaceFilterSelection value first.
"/ old code: readOnly ExtComboBox used a Label
"/ box menuField label:nameSpaceFilterSelection value first
]
!
variableDoubleClickChannel
"automatically generated by UIPainter ..."
"*** the code below creates a default model when invoked."
"*** (which may not be the one you wanted)"
"*** Please change as required and accept it in the browser."
|holder|
(holder := builder bindingAt:#variableDoubleClickChannel) isNil ifTrue:[
holder := TriggerValue new.
builder aspectAt:#variableDoubleClickChannel put:holder.
"/ holder addDependent:self.
].
^ holder.
!
variableFilter
"automatically generated by UIPainter ..."
"*** the code below creates a default model when invoked."
"*** (which may not be the one you wanted)"
"*** Please change as required and accept it in the browser."
variableFilter isNil ifTrue:[
variableFilter := ValueHolder new.
"/ variableFilter addDependent:self.
].
^ variableFilter.
"Created: / 24.2.2000 / 23:29:52 / cg"
!
variablesMenuHolder
"automatically generated by UIPainter ..."
"*** the code below creates a default model when invoked."
"*** (which may not be the one you wanted)"
"*** Please change as required and accept it in the browser."
variablesMenuHolder isNil ifTrue:[
variablesMenuHolder := ValueHolder new.
"/ variablesMenuHolder addDependent:self.
].
^ variablesMenuHolder.
"Created: / 24.2.2000 / 23:29:52 / cg"
! !
!NewSystemBrowser::OrganizerCanvas methodsFor:'aspects-exported'!
classCategoryDoubleClickChannel:something
"automatically generated by UIPainter ..."
"This method is used when I am embedded as subApplication,"
"and the mainApp wants to connect its aspects to mine."
"/ classCategoryDoubleClickChannel removeDependent:self.
classCategoryDoubleClickChannel := something.
"/ something notNil ifTrue:[
"/ something addDependent:self.
"/ ].
^ self.
"Created: / 18.8.2000 / 20:04:48 / cg"
!
classCategoryListMenuHolder:something
"automatically generated by UIPainter ..."
"This method is used when I am embedded as subApplication,"
"and the mainApp wants to connect its aspects to mine."
"/ classCategoryListMenuHolder removeDependent:self.
classCategoryListMenuHolder := something.
"/ something notNil ifTrue:[
"/ something addDependent:self.
"/ ].
^ self.
"Created: / 18.2.2000 / 11:53:31 / cg"
!
classCategoryListUpdateTrigger:something
"automatically generated by UIPainter ..."
"This method is used when I am embedded as subApplication,"
"and the mainApp wants to connect its aspects to mine."
"/ classCategoryListUpdateTrigger removeDependent:self.
classCategoryListUpdateTrigger := something.
"/ something notNil ifTrue:[
"/ something addDependent:self.
"/ ].
^ self.
"Created: / 18.2.2000 / 02:08:01 / cg"
!
classDoubleClickChannel:something
"automatically generated by UIPainter ..."
"This method is used when I am embedded as subApplication,"
"and the mainApp wants to connect its aspects to mine."
"/ classDoubleClickChannel removeDependent:self.
classDoubleClickChannel := something.
"/ something notNil ifTrue:[
"/ something addDependent:self.
"/ ].
^ self.
!
classHierarchyListMenuHolder:something
"automatically generated by UIPainter ..."
"This method is used when I am embedded as subApplication,"
"and the mainApp wants to connect its aspects to mine."
"/ classHierarchyListMenuHolder removeDependent:self.
classHierarchyListMenuHolder := something.
"/ something notNil ifTrue:[
"/ something addDependent:self.
"/ ].
^ self.
"Created: / 18.2.2000 / 11:53:31 / cg"
!
classHierarchyShown:something
"automatically generated by UIPainter ..."
"This method is used when I am embedded as subApplication,"
"and the mainApp wants to connect its aspects to mine."
"/ |holder|
"/ (holder := builder bindingAt:#classHierarchyShown) notNil ifTrue:[
"/ holder removeDependent:self.
"/ ].
builder aspectAt:#classHierarchyShown put:something.
"/ something notNil ifTrue:[
"/ something addDependent:self.
"/ ].
^ self.
"Created: / 18.2.2000 / 00:24:28 / cg"
!
classHierarchyTopClass:something
"automatically generated by UIPainter ..."
"This method is used when I am embedded as subApplication,"
"and the mainApp wants to connect its aspects to mine."
"/ |holder|
"/ (holder := builder bindingAt:#classHierarchyTopClass) notNil ifTrue:[
"/ holder removeDependent:self.
"/ ].
builder aspectAt:#classHierarchyTopClass put:something.
"/ something notNil ifTrue:[
"/ something addDependent:self.
"/ ].
^ self.
!
classHierarchyUpdateTrigger:something
"automatically generated by UIPainter ..."
"This method is used when I am embedded as subApplication,"
"and the mainApp wants to connect its aspects to mine."
"/ |holder|
"/ (holder := builder bindingAt:#classHierarchyUpdateTrigger) notNil ifTrue:[
"/ holder removeDependent:self.
"/ ].
builder aspectAt:#classHierarchyUpdateTrigger put:something.
"/ something notNil ifTrue:[
"/ something addDependent:self.
"/ ].
^ self.
"Created: / 18.2.2000 / 02:08:01 / cg"
!
classList:something
"automatically generated by UIPainter ..."
"This method is used when I am embedded as subApplication,"
"and the mainApp wants to connect its aspects to mine."
"/ classList notNil ifTrue:[
"/ classList removeDependent:self.
"/ ].
classList := something.
"/ something notNil ifTrue:[
"/ something addDependent:self.
"/ ].
^ self.
"Created: / 18.2.2000 / 00:24:28 / cg"
!
classListMenuHolder:something
"automatically generated by UIPainter ..."
"This method is used when I am embedded as subApplication,"
"and the mainApp wants to connect its aspects to mine."
"/ classListMenuHolder removeDependent:self.
classListMenuHolder := something.
"/ something notNil ifTrue:[
"/ something addDependent:self.
"/ ].
^ self.
"Created: / 18.2.2000 / 11:57:22 / cg"
!
classListUpdateTrigger:something
"automatically generated by UIPainter ..."
"This method is used when I am embedded as subApplication,"
"and the mainApp wants to connect its aspects to mine."
"/ classListUpdateTrigger removeDependent:self.
classListUpdateTrigger := something.
"/ something notNil ifTrue:[
"/ something addDependent:self.
"/ ].
^ self.
"Created: / 18.2.2000 / 02:08:01 / cg"
!
filterClassVars:something
"automatically generated by UIPainter ..."
"This method is used when I am embedded as subApplication,"
"and the mainApp wants to connect its aspects to mine."
"/ filterClassVars removeDependent:self.
filterClassVars := something.
"/ something notNil ifTrue:[
"/ something addDependent:self.
"/ ].
^ self.
"Created: / 24.2.2000 / 23:46:16 / cg"
!
hidePrivateClasses:something
"automatically generated by UIPainter ..."
"This method is used when I am embedded as subApplication,"
"and the mainApp wants to connect its aspects to mine."
"/ hidePrivateClasses removeDependent:self.
hidePrivateClasses := something.
"/ something notNil ifTrue:[
"/ something addDependent:self.
"/ ].
^ self.
"Created: / 24.2.2000 / 16:18:32 / cg"
!
hideUnloadedClasses:something
"automatically generated by UIPainter ..."
"This method is used when I am embedded as subApplication,"
"and the mainApp wants to connect its aspects to mine."
"/ hideUnloadedClasses removeDependent:self.
hideUnloadedClasses := something.
"/ something notNil ifTrue:[
"/ something addDependent:self.
"/ ].
^ self.
"Created: / 18.2.2000 / 17:54:57 / cg"
!
immediateUpdate:something
"automatically generated by UIPainter ..."
"This method is used when I am embedded as subApplication,"
"and the mainApp wants to connect its aspects to mine."
"/ immediateUpdate removeDependent:self.
immediateUpdate := something.
"/ something notNil ifTrue:[
"/ something addDependent:self.
"/ ].
^ self.
"Created: / 18.2.2000 / 00:24:29 / cg"
!
markApplicationsHolder:something
markApplicationsHolder := something.
!
meta:something
"automatically generated by UIPainter ..."
"This method is used when I am embedded as subApplication,"
"and the mainApp wants to connect its aspects to mine."
"/ meta notNil ifTrue:[
"/ meta removeDependent:self.
"/ ].
"/ (something == true or:[something == false]) ifTrue:[self halt].
meta := something.
"/ something notNil ifTrue:[
"/ something addDependent:self.
"/ ].
metaToggle notNil ifTrue:[
metaToggle model:something
].
notMetaToggle notNil ifTrue:[
notMetaToggle model:something
].
^ self.
"Created: / 18.2.2000 / 00:24:29 / cg"
!
metaToggleLabelHolder:something
|v|
"automatically generated by UIPainter ..."
"This method is used when I am embedded as subApplication,"
"and the mainApp wants to connect its aspects to mine."
"/ metaToggleLabelHolder removeDependent:self.
metaToggleLabelHolder := something.
"/ something notNil ifTrue:[
"/ something addDependent:self.
"/ ].
(v := builder componentAt:#ClassToggle) notNil ifTrue:[
v labelChannel:metaToggleLabelHolder.
].
^ self.
"Created: / 18.2.2000 / 11:53:31 / cg"
!
nameSpaceFilter:something
"automatically generated by UIPainter ..."
"This method is used when I am embedded as subApplication,"
"and the mainApp wants to connect its aspects to mine."
"/ packageFilter notNil ifTrue:[
"/ packageFilter removeDependent:self.
"/ ].
nameSpaceFilter := something.
"/ something notNil ifTrue:[
"/ something addDependent:self.
"/ ].
self nameSpaceFilterSelection value:something value.
^ self.
"Created: / 24.2.2000 / 23:46:16 / cg"
!
nameSpaceListMenuHolder:something
"automatically generated by UIPainter ..."
"This method is used when I am embedded as subApplication,"
"and the mainApp wants to connect its aspects to mine."
"/ |holder|
"/ (holder := builder bindingAt:#namespaceListMenuHolder) notNil ifTrue:[
"/ holder removeDependent:self.
"/ ].
builder aspectAt:#nameSpaceListMenuHolder put:something.
"/ something notNil ifTrue:[
"/ something addDependent:self.
"/ ].
^ self.
"Created: / 18.2.2000 / 11:53:31 / cg"
!
nameSpaceListUpdateTrigger:something
"automatically generated by UIPainter ..."
"This method is used when I am embedded as subApplication,"
"and the mainApp wants to connect its aspects to mine."
"/ |holder|
"/ (holder := builder bindingAt:#namespaceListUpdateTrigger) notNil ifTrue:[
"/ holder removeDependent:self.
"/ ].
builder aspectAt:#nameSpaceListUpdateTrigger put:something.
"/ something notNil ifTrue:[
"/ something addDependent:self.
"/ ].
^ self.
"Created: / 18.2.2000 / 02:08:01 / cg"
!
organizerMode:aValueHolder
organizerMode notNil ifTrue:[
organizerMode removeDependent:self.
].
organizerMode := aValueHolder.
organizerMode notNil ifTrue:[
organizerMode addDependent:self.
].
"Created: / 18.2.2000 / 10:21:41 / cg"
!
outGeneratorHolder:something
"automatically generated by UIPainter ..."
"This method is used when I am embedded as subApplication,"
"and the mainApp wants to connect its aspects to mine."
"/ |holder|
"/ (holder := builder bindingAt:#outGeneratorHolder) notNil ifTrue:[
"/ holder removeDependent:self.
"/ ].
builder aspectAt:#outGeneratorHolder put:something.
"/ something notNil ifTrue:[
"/ something addDependent:self.
"/ ].
^ self.
"Created: / 18.2.2000 / 00:24:29 / cg"
!
packageFilter:something
"automatically generated by UIPainter ..."
"This method is used when I am embedded as subApplication,"
"and the mainApp wants to connect its aspects to mine."
"/ packageFilter notNil ifTrue:[
"/ packageFilter removeDependent:self.
"/ ].
packageFilter := something.
"/ something notNil ifTrue:[
"/ something addDependent:self.
"/ ].
^ self.
"Created: / 24.2.2000 / 23:46:16 / cg"
!
projectDoubleClickChannel:something
"automatically generated by UIPainter ..."
"This method is used when I am embedded as subApplication,"
"and the mainApp wants to connect its aspects to mine."
"/ |holder|
"/ (holder := builder bindingAt:#projectDoubleClickChannel) notNil ifTrue:[
"/ holder removeDependent:self.
"/ ].
builder aspectAt:#projectDoubleClickChannel put:something.
"/ something notNil ifTrue:[
"/ something addDependent:self.
"/ ].
^ self.
!
projectListMenuHolder:something
"automatically generated by UIPainter ..."
"This method is used when I am embedded as subApplication,"
"and the mainApp wants to connect its aspects to mine."
projectListMenuHolder := something.
"Created: / 18.2.2000 / 11:53:31 / cg"
!
projectListUpdateTrigger:something
"automatically generated by UIPainter ..."
"This method is used when I am embedded as subApplication,"
"and the mainApp wants to connect its aspects to mine."
"/ |holder|
"/ (holder := builder bindingAt:#projectListUpdateTrigger) notNil ifTrue:[
"/ holder removeDependent:self.
"/ ].
builder aspectAt:#projectListUpdateTrigger put:something.
"/ something notNil ifTrue:[
"/ something addDependent:self.
"/ ].
^ self.
"Created: / 18.2.2000 / 02:08:01 / cg"
!
selectedCategories:something
"automatically generated by UIPainter ..."
"This method is used when I am embedded as subApplication,"
"and the mainApp wants to connect its aspects to mine."
selectedCategories := something.
^ self.
"Created: / 18.2.2000 / 14:04:36 / cg"
!
selectedClasses:something
"automatically generated by UIPainter ..."
"This method is used when I am embedded as subApplication,"
"and the mainApp wants to connect its aspects to mine."
selectedClasses removeDependent:self.
selectedClasses := something.
something notNil ifTrue:[
something addDependent:self.
].
^ self.
"Created: / 18.2.2000 / 00:24:29 / cg"
!
selectedNamespaces:something
"automatically generated by UIPainter ..."
"This method is used when I am embedded as subApplication,"
"and the mainApp wants to connect its aspects to mine."
selectedNamespaces := something.
selectedNamespaces onChangeEvaluate:[
nameSpaceFilterSelection value:selectedNamespaces value.
].
!
selectedProjects:something
"automatically generated by UIPainter ..."
"This method is used when I am embedded as subApplication,"
"and the mainApp wants to connect its aspects to mine."
selectedProjects := something.
!
selectionChangeCondition:something
"automatically generated by UIPainter ..."
"This method is used when I am embedded as subApplication,"
"and the mainApp wants to connect its aspects to mine."
selectionChangeCondition := something.
!
showClassPackages:something
"automatically generated by UIPainter ..."
"This method is used when I am embedded as subApplication,"
"and the mainApp wants to connect its aspects to mine."
showClassPackages := something.
!
variableDoubleClickChannel:something
"automatically generated by UIPainter ..."
"This method is used when I am embedded as subApplication,"
"and the mainApp wants to connect its aspects to mine."
"/ |holder|
"/ (holder := builder bindingAt:#variableDoubleClickChannel) notNil ifTrue:[
"/ holder removeDependent:self.
"/ ].
builder aspectAt:#variableDoubleClickChannel put:something.
"/ something notNil ifTrue:[
"/ something addDependent:self.
"/ ].
^ self.
!
variableFilter:something
"automatically generated by UIPainter ..."
"This method is used when I am embedded as subApplication,"
"and the mainApp wants to connect its aspects to mine."
variableFilter := something.
!
variablesMenuHolder:something
"automatically generated by UIPainter ..."
"This method is used when I am embedded as subApplication,"
"and the mainApp wants to connect its aspects to mine."
variablesMenuHolder := something.
! !
!NewSystemBrowser::OrganizerCanvas methodsFor:'aspects-private'!
categoryListSlaveMode
categoryListSlaveMode isNil ifTrue:[
categoryListSlaveMode := false asValue.
].
^ categoryListSlaveMode
"Created: / 18.2.2000 / 00:30:44 / cg"
"Modified: / 18.2.2000 / 02:56:21 / cg"
!
classHierarchyListSlaveMode
classHierarchyListSlaveMode isNil ifTrue:[
classHierarchyListSlaveMode := true asValue.
].
^ classHierarchyListSlaveMode
"Created: / 18.2.2000 / 00:30:44 / cg"
"Modified: / 18.2.2000 / 02:56:21 / cg"
!
classInheritanceListSlaveMode
classInheritanceListSlaveMode isNil ifTrue:[
classInheritanceListSlaveMode := true asValue.
].
^ classInheritanceListSlaveMode
"Modified: / 18.2.2000 / 02:56:21 / cg"
"Created: / 26.2.2000 / 00:09:18 / cg"
!
classListSlaveMode
classListSlaveMode isNil ifTrue:[
classListSlaveMode := false asValue.
].
^ classListSlaveMode
"Created: / 18.2.2000 / 00:30:44 / cg"
"Modified: / 18.2.2000 / 02:56:21 / cg"
!
nameSpaceListSlaveMode
namespaceListSlaveMode isNil ifTrue:[
namespaceListSlaveMode := true asValue.
].
^ namespaceListSlaveMode
"Created: / 18.2.2000 / 00:30:44 / cg"
"Modified: / 18.2.2000 / 02:56:21 / cg"
!
projectListSlaveMode
projectListSlaveMode isNil ifTrue:[
projectListSlaveMode := true asValue.
].
^ projectListSlaveMode
"Created: / 18.2.2000 / 00:30:44 / cg"
"Modified: / 18.2.2000 / 02:56:21 / cg"
! !
!NewSystemBrowser::OrganizerCanvas methodsFor:'aspects-trigger'!
classCategoryListUpdateTrigger
"automatically generated by UIPainter ..."
"*** the code below creates a default model when invoked."
"*** (which may not be the one you wanted)"
"*** Please change as required and accept it in the browser."
classCategoryListUpdateTrigger isNil ifTrue:[
classCategoryListUpdateTrigger := TriggerValue new.
"/ classCategoryListUpdateTrigger addDependent:self.
].
^ classCategoryListUpdateTrigger.
"Created: / 18.2.2000 / 02:05:14 / cg"
"Modified: / 18.2.2000 / 02:14:04 / cg"
!
classHierarchyUpdateTrigger
"automatically generated by UIPainter ..."
"*** the code below creates a default model when invoked."
"*** (which may not be the one you wanted)"
"*** Please change as required and accept it in the browser."
|holder|
(holder := builder bindingAt:#classHierarchyUpdateTrigger) isNil ifTrue:[
holder := TriggerValue new.
builder aspectAt:#classHierarchyUpdateTrigger put:holder.
"/ holder addDependent:self.
].
^ holder.
"Created: / 18.2.2000 / 02:05:14 / cg"
"Modified: / 18.2.2000 / 02:13:57 / cg"
!
classListUpdateTrigger
"automatically generated by UIPainter ..."
"*** the code below creates a default model when invoked."
"*** (which may not be the one you wanted)"
"*** Please change as required and accept it in the browser."
classListUpdateTrigger isNil ifTrue:[
classListUpdateTrigger := TriggerValue new.
"/ classListUpdateTrigger addDependent:self.
].
^ classListUpdateTrigger.
"Created: / 18.2.2000 / 02:05:14 / cg"
"Modified: / 18.2.2000 / 02:14:08 / cg"
!
forceClassCategoryGeneratorTrigger
"automatically generated by UIPainter ..."
"*** the code below creates a default model when invoked."
"*** (which may not be the one you wanted)"
"*** Please change as required and accept it in the browser."
|holder|
(holder := builder bindingAt:#forceClassCategoryGeneratorTrigger) isNil ifTrue:[
holder := TriggerValue new.
builder aspectAt:#forceClassCategoryGeneratorTrigger put:holder.
"/ holder addDependent:self.
].
^ holder.
"Created: / 18.2.2000 / 02:49:43 / cg"
"Modified: / 18.2.2000 / 02:52:30 / cg"
!
forceClassHierarchyGeneratorTrigger
"automatically generated by UIPainter ..."
"*** the code below creates a default model when invoked."
"*** (which may not be the one you wanted)"
"*** Please change as required and accept it in the browser."
|holder|
(holder := builder bindingAt:#forceClassHierarchyGeneratorTrigger) isNil ifTrue:[
holder := TriggerValue new.
builder aspectAt:#forceClassHierarchyGeneratorTrigger put:holder.
"/ holder addDependent:self.
].
^ holder.
"Created: / 18.2.2000 / 02:49:43 / cg"
"Modified: / 18.2.2000 / 02:52:32 / cg"
!
forceNamespaceGeneratorTrigger
"automatically generated by UIPainter ..."
"*** the code below creates a default model when invoked."
"*** (which may not be the one you wanted)"
"*** Please change as required and accept it in the browser."
|holder|
(holder := builder bindingAt:#forceNamespaceGeneratorTrigger) isNil ifTrue:[
holder := TriggerValue new.
builder aspectAt:#forceNamespaceGeneratorTrigger put:holder.
"/ holder addDependent:self.
].
^ holder.
"Created: / 18.2.2000 / 02:49:43 / cg"
"Modified: / 18.2.2000 / 02:52:35 / cg"
!
forceProjectGeneratorTrigger
"automatically generated by UIPainter ..."
"*** the code below creates a default model when invoked."
"*** (which may not be the one you wanted)"
"*** Please change as required and accept it in the browser."
|holder|
(holder := builder bindingAt:#forceProjectGeneratorTrigger) isNil ifTrue:[
holder := TriggerValue new.
builder aspectAt:#forceProjectGeneratorTrigger put:holder.
"/ holder addDependent:self.
].
^ holder.
"Created: / 18.2.2000 / 02:49:43 / cg"
"Modified: / 18.2.2000 / 02:52:38 / cg"
!
nameSpaceListUpdateTrigger
"automatically generated by UIPainter ..."
"*** the code below creates a default model when invoked."
"*** (which may not be the one you wanted)"
"*** Please change as required and accept it in the browser."
|holder|
(holder := builder bindingAt:#nameSpaceListUpdateTrigger) isNil ifTrue:[
holder := TriggerValue new.
builder aspectAt:#nameSpaceListUpdateTrigger put:holder.
"/ holder addDependent:self.
].
^ holder.
"Created: / 18.2.2000 / 02:05:14 / cg"
"Modified: / 18.2.2000 / 02:14:12 / cg"
!
projectListUpdateTrigger
"automatically generated by UIPainter ..."
"*** the code below creates a default model when invoked."
"*** (which may not be the one you wanted)"
"*** Please change as required and accept it in the browser."
|holder|
(holder := builder bindingAt:#projectListUpdateTrigger) isNil ifTrue:[
holder := TriggerValue new.
builder aspectAt:#projectListUpdateTrigger put:holder.
"/ holder addDependent:self.
].
^ holder.
"Created: / 18.2.2000 / 02:05:14 / cg"
"Modified: / 18.2.2000 / 02:14:15 / cg"
! !
!NewSystemBrowser::OrganizerCanvas methodsFor:'aspects-visibility'!
categoryListShown
categoryListShown isNil ifTrue:[
categoryListShown := BlockValue
with:[:v | v value == #category]
argument:(self organizerMode).
].
^ categoryListShown
"Modified: / 18.2.2000 / 02:11:00 / cg"
!
classHierarchyNotShown
|holder|
(holder := builder bindingAt:#classHierarchyNotShown) isNil ifTrue:[
holder := BlockValue
with:[:v | |org|
org := v value.
org ~~ #hierarchy
and:[org ~~ #classHierarchy
and:[org ~~ #classInheritance]]]
argument:(self organizerMode).
builder aspectAt:#classHierarchyNotShown put: holder
].
^ holder
"Created: / 18.2.2000 / 00:36:38 / cg"
"Modified: / 24.2.2000 / 13:22:43 / cg"
!
classHierarchyOrInheritanceNotShown
|holder|
(holder := builder bindingAt:#classHierarchyOrInheritanceNotShown) isNil ifTrue:[
holder := BlockValue
with:[:v1 :v2 | (v1 value or:[v2 value]) not]
argument:(self classHierarchyShown)
argument:(self classInheritanceShown).
builder aspectAt:#classHierarchyOrInheritanceNotShown put: holder
].
^ holder
!
classHierarchyOrInheritanceShown
|holder|
(holder := builder bindingAt:#classHierarchyOrInheritanceShown) isNil ifTrue:[
holder := BlockValue
with:[:v1 :v2 | v1 value or:[v2 value] ]
argument:(self classHierarchyShown)
argument:(self classInheritanceShown).
builder aspectAt:#classHierarchyOrInheritanceShown put: holder
].
^ holder
!
classHierarchyShown
|holder|
(holder := builder bindingAt:#classHierarchyShown) isNil ifTrue:[
holder := BlockValue
with:[:v | |org|
org := v value.
org == #hierarchy
or:[org == #classHierarchy]]
argument:(self organizerMode).
builder aspectAt:#classHierarchyShown put: holder
].
^ holder
"Modified: / 24.2.2000 / 13:23:33 / cg"
!
classInheritanceShown
|holder|
(holder := builder bindingAt:#classInheritanceShown) isNil ifTrue:[
holder := BlockValue
with:[:v | v value == #classInheritance]
argument:(self organizerMode).
builder aspectAt:#classInheritanceShown put: holder
].
^ holder
"Created: / 24.2.2000 / 13:23:01 / cg"
!
classListShown
|holder|
(holder := builder bindingAt:#classListShown) isNil ifTrue:[
holder := BlockValue
with:[:v | v value ~~ #hierarchy]
argument:(self organizerMode).
builder aspectAt:#classListShown put: holder
].
^ holder
"Modified: / 18.2.2000 / 00:32:48 / cg"
!
nameSpaceListShown
|holder|
(holder := builder bindingAt:#nameSpaceListShown) isNil ifTrue:[
holder := BlockValue
with:[:v | v value == #namespace]
argument:(self organizerMode).
builder aspectAt:#nameSpaceListShown put: holder
].
^ holder
"Created: / 18.2.2000 / 00:32:09 / cg"
"Modified: / 18.2.2000 / 01:48:35 / cg"
!
projectListShown
|holder|
(holder := builder bindingAt:#projectListShown) isNil ifTrue:[
holder := BlockValue
with:[:v | v value == #project]
argument:(self organizerMode).
builder aspectAt:#projectListShown put: holder
].
^ holder
"Modified: / 18.2.2000 / 00:31:19 / cg"
"Created: / 18.2.2000 / 00:32:09 / cg"
! !
!NewSystemBrowser::OrganizerCanvas methodsFor:'change & update'!
update:something with:aParameter from:changedObject
|orgMode trigger classes selectedClassesHolder selectionValue|
orgMode := organizerMode value.
selectedClassesHolder := self selectedClasses.
classes := selectedClassesHolder value copy.
changedObject == organizerMode ifTrue:[
self classHierarchyListSlaveMode value:true.
self classInheritanceListSlaveMode value:true.
self classListSlaveMode value:true.
self categoryListSlaveMode value:true.
self nameSpaceListSlaveMode value:true.
self projectListSlaveMode value:true.
self updateOrganizationFromChangedClass.
orgMode == #category ifTrue:[
"/ trigger := self forceClassCategoryGeneratorTrigger.
] ifFalse:[ orgMode == #hierarchy ifTrue:[
"/ trigger := self forceClassHierarchyGeneratorTrigger.
] ifFalse:[ orgMode == #namespace ifTrue:[
"/ trigger := self forceNamespaceGeneratorTrigger
] ifFalse:[ orgMode == #project ifTrue:[
trigger := self forceProjectGeneratorTrigger.
] ifFalse:[ ((orgMode == #classHierarchy) or:[orgMode == #classInheritance]) ifTrue:[
"/ trigger := self forceClassHierarchyGeneratorTrigger.
]]]]].
"/ must update the packageFilter
orgMode == #project ifTrue:[
packageFilter setValue:(self selectedProjects value)
] ifFalse:[
packageFilter value:nil
].
trigger notNil ifTrue:[
trigger value:true
].
"/ selectedClassesHolder value:classes.
(orgMode == #classHierarchy or:[orgMode == #hierarchy]) ifTrue:[
classHierarchyListSlaveMode value:false.
].
(orgMode == #classInheritance) ifTrue:[
classInheritanceListSlaveMode value:false.
].
(orgMode == #classInheritance
or:[orgMode == #classHierarchy
or:[orgMode == #hierarchy]])
ifFalse:[
classListSlaveMode value:false.
].
(orgMode == #category) ifTrue:[
categoryListSlaveMode value:false.
].
(orgMode == #namespace) ifTrue:[
namespaceListSlaveMode value:false.
].
(orgMode == #project) ifTrue:[
projectListSlaveMode value:false.
].
^ self
].
changedObject == selectedClasses ifTrue:[
selectedClasses value size ~~ 0 ifTrue:[
(orgMode ~~ #classHierarchy) ifTrue:[
self updateOrganizationFromChangedClass.
].
]
].
"/ changedObject == selectedNamespaces ifTrue:[
"/ self halt.
"/ ].
changedObject == nameSpaceFilterSelection ifTrue:[
selectionValue := nameSpaceFilterSelection value.
selectionValue size > 1 ifTrue:[
nameSpaceFilterSelection value:(OrderedCollection with:selectionValue first).
selectionValue := nameSpaceFilterSelection value.
].
self selectedNamespaces value:selectionValue.
selectionValue size > 0 ifTrue:[
self nameSpaceFilterSelectedNameSpace setValue:selectionValue first.
self updateNameSpaceLabel.
].
self nameSpaceFilter value: selectionValue.
].
super update:something with:aParameter from:changedObject
"Modified: / 26.2.2000 / 18:02:02 / cg"
!
updateCategorySelectionFromClasses
|allEntry oldSelectedCategories categories|
allEntry := self class nameListEntryForALL.
categories := Set new.
oldSelectedCategories := self selectedCategories value.
"/ category-selection feedBack;
"/ if '* all *' was in its selection, keep it (to avoid updating the classList)
(oldSelectedCategories size > 0
and:[oldSelectedCategories includes:allEntry]) ifTrue:[
categories add:allEntry
].
(self selectedClasses value ? #()) do:[:eachSelectedClass |
|cat cls|
cls := eachSelectedClass theNonMetaclass.
cls isPrivate ifTrue:[
cls := cls topOwningClass.
].
cat := cls category.
categories add:cat.
].
(categories conform:[:each | (self selectedCategories value ? #()) includes:each]) ifFalse:[
self selectedCategories value:categories.
].
"Modified: / 18.2.2000 / 13:17:36 / cg"
!
updateNamespaceSelectionFromClasses
"invoked when switching to the namespace-organization;
update selected namespaces from the set of selected classes"
|allEntry classes selectedNamespaces oldSelectedNamespaces|
allEntry := self class nameListEntryForALL.
classes := self selectedClasses value.
classes size > 0 ifTrue:[
selectedNamespaces := self selectedNamespaces value.
oldSelectedNamespaces := (selectedNamespaces ? #()) asSet.
selectedNamespaces := Set new.
"/ namespace-selection feedBack;
"/ if '* all *' was in its selection, keep it (to avoid updating the classList)
(oldSelectedNamespaces size > 0
and:[oldSelectedNamespaces includes:allEntry])
ifTrue:[
selectedNamespaces add:allEntry.
].
selectedNamespaces
addAll:(classes
collect:[:eachClass | eachClass theNonMetaclass topNameSpace name.]).
classes := classes copy.
"/ selectedNamespaces ~= oldSelectedNamespaces ifTrue:[
self selectedNamespaces value:selectedNamespaces.
"/ ].
classes ~= self selectedClasses value ifTrue:[self halt:'oops'].
].
!
updateOrganizationFromChangedClass
|orgMode selectedClassesHolder selectedClasses classHierarchyTopClassHolder commonSuperClass|
orgMode := organizerMode value.
selectedClassesHolder := self selectedClasses.
selectedClasses := selectedClassesHolder value.
classHierarchyTopClassHolder := self classHierarchyTopClass.
orgMode == #category ifTrue:[
self updateCategorySelectionFromClasses.
^ self.
].
orgMode == #namespace ifTrue:[
self updateNamespaceSelectionFromClasses.
^ self.
].
orgMode == #project ifTrue:[
self updateProjectSelectionFromClasses.
^ self.
].
orgMode == #hierarchy ifTrue:[
classHierarchyTopClassHolder value:nil.
^ self.
].
(orgMode == #classHierarchy) ifTrue:[
"/ (selectedClasses size == 1) ifTrue:[
"/ self classHierarchyTopClass value:selectedClasses first
"/ ].
"/ classHierarchyTopClassHolder value isNil ifTrue:[
selectedClasses size > 0 ifTrue:[
commonSuperClass := selectedClasses
inject:selectedClasses first
into:[:commonSuperClass :thisClass | commonSuperClass commonSuperclass:thisClass ].
classHierarchyTopClassHolder value:commonSuperClass "selectedClasses first".
].
"/ ].
^ self.
].
(orgMode == #classInheritance) ifTrue:[
classHierarchyTopClassHolder value:
((selectedClasses size == 1) ifTrue:[selectedClasses first] ifFalse:nil).
^ self.
].
!
updateProjectSelectionFromClasses
"invoked when switching to the projects-organization;
update selected projects from the set of selected classes"
|allEntry classes selectedProjects oldSelectedProjects|
^ self.
allEntry := self class nameListEntryForALL.
classes := self selectedClasses value.
classes size > 0 ifTrue:[
selectedProjects := self selectedProjects value.
oldSelectedProjects := (selectedProjects ? #()) asSet.
selectedProjects := Set new.
"/ project-selection feedBack;
"/ if '* all *' was in its selection, keep it (to avoid updating the classList)
(oldSelectedProjects size > 0
and:[oldSelectedProjects includes:allEntry])
ifTrue:[
selectedProjects add:allEntry.
].
classes do:[:eachClass |
selectedProjects add:(eachClass theNonMetaclass package).
eachClass allSelectorsAndMethodsDo:[:sel :mthd |
selectedProjects add:(mthd package).
]
].
selectedProjects ~= oldSelectedProjects ifTrue:[
self selectedProjects value:selectedProjects.
].
].
"Created: / 26.2.2000 / 01:09:13 / cg"
"Modified: / 26.2.2000 / 01:20:59 / cg"
! !
!NewSystemBrowser::OrganizerCanvas methodsFor:'forwarder operations'!
moveClasses:classes toCategory:cat
self masterApplication moveClasses:classes toCategory:cat
!
moveClasses:classes toProject:cat
self masterApplication moveClasses:classes toProject:cat
!
moveMethods:methods toClass:cls
self masterApplication moveMethods:methods toClass:cls.
!
moveMethods:methods toProject:package
self masterApplication moveMethods:methods toProject:package.
! !
!NewSystemBrowser::OrganizerCanvas methodsFor:'private'!
nameSpaceListWidgetWasBuilt:widget
|list|
"/ sigh - cannot do this in the nameSpaceListWidget method,
"/ because the GUI is build late (when the menu is popped up the first time)
widget application immediateUpdate:true.
list := widget builder componentAt:#List.
list autoHideHorizontalScrollBar:true.
!
postBuildWith:aBuilder
"/ |toggle|
"/
"/ (toggle := aBuilder componentAt:#InstanceToggle) notNil ifTrue:[
"/ toggle controller beToggle.
"/ ].
"/ (toggle := aBuilder componentAt:#ClassToggle) notNil ifTrue:[
"/ toggle controller beToggle.
"/ ].
super postBuildWith:aBuilder
!
release
super release.
nameSpaceFilterSelection removeDependent:self.
organizerMode removeDependent:self.
selectedClasses removeDependent:self.
! !
!NewSystemBrowser::HierarchicalProjectList class methodsFor:'interface specs'!
windowSpec
"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::HierarchicalProjectList andSelector:#windowSpec
NewSystemBrowser::HierarchicalProjectList new openInterface:#windowSpec
NewSystemBrowser::HierarchicalProjectList open
"
<resource: #canvas>
^
#(#FullSpec
#name: #windowSpec
#window:
#(#WindowSpec
#label: 'ProjectList'
#name: 'ProjectList'
#min: #(#Point 0 0)
#max: #(#Point 1024 721)
#bounds: #(#Rectangle 16 46 316 346)
)
#component:
#(#SpecCollection
#collection: #(
#(#HierarchicalListViewSpec
#name: 'HierarchicalListView1'
#layout: #(#LayoutFrame 0 0.0 0 0.0 0 1.0 0 1.0)
#tabable: true
#model: #hierarchicalProjectSelection
#menu: #menuHolder
#hasHorizontalScrollBar: true
#hasVerticalScrollBar: true
#miniScrollerHorizontal: true
#listModel: #hierarchicalProjectList
#multipleSelectOk: true
#highlightMode: #line
#doubleClickSelector: #doubleClicked:
#indicatorSelector: #indicatorPressed:
#properties:
#(#PropertyListDictionary
#dragArgument: nil
#dropArgument: nil
#canDropSelector: #canDrop:
#dropSelector: #doDrop:
)
)
)
)
)
!
xxwindowSpec
"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::HierarchicalProjectList andSelector:#windowSpec
NewSystemBrowser::HierarchicalProjectList new openInterface:#windowSpec
NewSystemBrowser::HierarchicalProjectList open
"
<resource: #canvas>
^
#(#FullSpec
#name: #windowSpec
#window:
#(#WindowSpec
#label: 'ProjectList'
#name: 'ProjectList'
#min: #(#Point 0 0)
#max: #(#Point 1024 721)
#bounds: #(#Rectangle 12 22 312 322)
)
#component:
#(#SpecCollection
#collection: #(
#(#SelectionInTreeViewSpec
#name: 'List'
#layout: #(#LayoutFrame 0 0.0 0 0.0 0 1.0 0 1.0)
#model: #selectedProjectItems
#menu: #menuHolder
#hasHorizontalScrollBar: true
#hasVerticalScrollBar: true
#miniScrollerHorizontal: true
#showRoot: false
#showDirectoryIndicator: true
#isMultiSelect: true
#valueChangeSelector: #selectionChangedByClick
#hierarchicalList: #hierarchicalProjectTree
#childrenSelector: #actionToRetrieveChildren
#highlightMode: #line
#doubleClickChannel: #doubleClickChannel
)
#(#HierarchicalListViewSpec
#name: 'HierarchicalListView1'
#layout: #(#LayoutFrame 0 0.0 0 0.0 0 1.0 0 1.0)
#tabable: true
#hasHorizontalScrollBar: true
#hasVerticalScrollBar: true
#miniScrollerHorizontal: true
#listModel: #hierarchicalProjectList
#multipleSelectOk: true
#highlightMode: #line
#doubleClickSelector: #doubleClicked:
#indicatorSelector: #indicatorPressed:
"/ #showLeftIndicators: false
)
)
)
)
! !
!NewSystemBrowser::HierarchicalProjectList class methodsFor:'plugIn spec'!
aspectSelectors
"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."
"Return a description of exported aspects;
these can be connected to aspects of an embedding application
(if this app is embedded in a subCanvas)."
^ #(
#(#doubleClickChannel #action )
#forceGeneratorTrigger
#hideUnloadedClasses
#immediateUpdate
#inGeneratorHolder
#menuHolder
#organizerMode
#outGeneratorHolder
#selectedProjects
#selectionChangeCondition
#slaveMode
#updateTrigger
).
! !
!NewSystemBrowser::HierarchicalProjectList methodsFor:'aspects'!
generateHierarchicalProjectTree
|anchor|
self projectList value isNil ifTrue:[
self updateList.
self projectList value isNil ifTrue:[
^ nil.
]
].
anchor := ProjectItem new.
anchor package:''.
anchor label:nil.
packageToItemDictionary := IdentityDictionary new.
packageToItemDictionary at:'' asSymbol put:anchor.
self projectList value do:[:eachPackageString |
|package|
package := eachPackageString asSymbol.
(packageToItemDictionary includesKey:package) ifFalse:[
self addPackage:package
].
].
"/ Smalltalk allClassesDo:[:eachClass |
"/ |package|
"/
"/ package := eachClass package asSymbol.
"/ (packageToItemDictionary includesKey:package) ifFalse:[
"/ self addPackage:package
"/ ].
"/ ].
anchor recursiveSortChildren:[:i1 :i2 | i1 label asLowercase < i2 label asLowercase].
anchor expand.
^ anchor
!
hierarchicalProjectList
|anchor |
hierarchicalProjectList isNil ifTrue:[
hierarchicalProjectList := HierarchicalList new.
hierarchicalProjectList showRoot:false.
(self slaveMode value ~~ true) ifTrue:[
anchor := self generateHierarchicalProjectTree.
hierarchicalProjectList root:anchor.
listValid := true
] ifFalse:[
listValid := false
]
].
^ hierarchicalProjectList
!
hierarchicalProjectSelection
hierarchicalProjectSelection isNil ifTrue:[
hierarchicalProjectSelection := #() asValue.
hierarchicalProjectSelection addDependent:self.
].
^ hierarchicalProjectSelection.
!
updateTreeSelection
"/ must expand items as required
|itemsToSelect oldSelection newSelection|
itemsToSelect := OrderedCollection new.
(self selectedProjects value ? #()) do:[:eachSelectedProject |
|item child|
item := hierarchicalProjectList root.
(eachSelectedProject asCollectionOfSubstringsSeparatedByAny:':/') do:[:part |
item expand.
child := item detect:[:child | child label = part] ifNone:nil.
child notNil ifTrue:[
item := child.
].
].
itemsToSelect add:child.
].
oldSelection := hierarchicalProjectSelection value.
newSelection := itemsToSelect collect:[:eachItem | hierarchicalProjectList identityIndexOf:eachItem].
oldSelection ~= newSelection ifTrue:[
hierarchicalProjectSelection value:newSelection.
].
! !
!NewSystemBrowser::HierarchicalProjectList methodsFor:'change & update'!
delayedUpdate:something with:aParameter from:changedObject
|cls sel oldMethod newMethod newPackage|
self inSlaveModeOrInvisible ifTrue:[
super delayedUpdate:something with:aParameter from:changedObject.
^ self.
].
"/ (self slaveMode value == true) ifTrue:[
"/ super delayedUpdate:something with:aParameter from:changedObject.
"/ ^ self
"/ ].
changedObject == updateTrigger ifTrue:[
hierarchicalProjectList := nil.
self hierarchicalProjectList.
self updateTreeSelection.
^ self
].
changedObject == slaveMode ifTrue:[
listValid ~~ true ifTrue:[
self enqueueDelayedUpdateList
].
"/ self invalidateList.
self updateTreeSelection.
^ self
].
changedObject == hierarchicalProjectSelection ifTrue:[
self updateSelectionFromTree.
^ self
].
"/ changedObject == self selectedProjects ifTrue:[
"/ "/ update the trees selection as appropriate
"/ self updateTreeSelection.
"/ ].
changedObject == projectList ifTrue:[
"/ update the tree
self hierarchicalProjectList root:(self generateHierarchicalProjectTree).
^ self.
].
super delayedUpdate:something with:aParameter from:changedObject
"Created: / 17.2.2000 / 23:41:02 / cg"
"Modified: / 26.2.2000 / 01:21:49 / cg"
!
enqueueDelayedAddPackage:package
NewSystemBrowser synchronousUpdate == true ifTrue:[
self addPackage:package.
^ self
].
^ self
enqueueMessage:#addPackage:
for:self
arguments:(Array with:package)
!
update:something with:aParameter from:changedObject
something == #methodTrap ifTrue:[
"/ dont care for that.
^ self.
].
changedObject == organizerMode ifTrue:[
"/ dont care for that.
^ self.
].
super update:something with:aParameter from:changedObject
!
updateSelectionFromTree
|treeSelection|
treeSelection := hierarchicalProjectSelection value
collect:[:eachIndex | |item|
item := hierarchicalProjectList at:eachIndex ifAbsent:nil.
item package
].
treeSelection asSet ~= (self selectedProjects value ? #()) asSet ifTrue:[
self selectedProjects value:treeSelection.
]
! !
!NewSystemBrowser::HierarchicalProjectList methodsFor:'private'!
addPackage:package
|i p pp l parentPackage parentItem idx|
i:= packageToItemDictionary at:package asSymbol ifAbsent:nil.
i isNil ifTrue:[
i := ProjectItem new.
i package:package.
packageToItemDictionary at:package asSymbol put:i.
package size > 0 ifTrue:[
"/ find the parent ...
p := package asCollectionOfSubstringsSeparatedByAny:':/.'.
pp := p copyWithoutLast:1.
l := (pp asStringWith:$/) size.
parentPackage := package copyTo:l.
parentItem := self addPackage:parentPackage asSymbol .
parentPackage size == 0 ifTrue:[
idx := 1.
] ifFalse:[
idx := parentPackage size + 2
].
i label:(package copyFrom:idx).
parentItem add:i sortBlock:[:i1 :i2 | i1 label asLowercase < i2 label asLowercase].
"/ TODO: special items for classes, resources etc.
]
].
^ i
!
release
super release.
hierarchicalProjectSelection removeDependent:self.
! !
!NewSystemBrowser::HierarchicalProjectList methodsFor:'user actions'!
doubleClicked:anIndex
|item|
item := hierarchicalProjectList at:anIndex ifAbsent:nil.
item isNil ifTrue:[
^ self
].
(item canExpand not or:[item isExpanded]) ifTrue:[
doubleClickChannel notNil ifTrue:[
doubleClickChannel value:anIndex.
].
^ self
].
item expand.
!
indicatorPressed:anIndex
|item sensor|
item := hierarchicalProjectList at:anIndex ifAbsent:nil.
item isNil ifTrue:[
^ self
].
sensor := self window sensor.
(sensor ctrlDown or:[sensor shiftDown]) ifTrue:[
item recursiveToggleExpand
] ifFalse:[
item toggleExpand
].
! !
!NewSystemBrowser::HierarchicalProjectList::ProjectItem methodsFor:'accessing'!
children
children isNil ifTrue:[
children := #()
].
^ children
!
icon
^ SystemBrowser packageIcon
!
label
^ label
!
label:aString
label ~= aString ifTrue:[
label := aString.
self changed:#label
].
!
package
^ packageID
!
package:prefixOrPackageID
packageID := prefixOrPackageID
! !
!NewSystemBrowser::SearchDialog methodsFor:'private'!
showHelpOnCodePatterns
HTMLDocumentView openFullOnHelpFile:'Browser/RBSearchPatterns.html'
! !
!NewSystemBrowser::SearchDialog methodsFor:'public'!
askThenDo:aBlock
|where code sel|
self open.
self accepted ifFalse:[
^ self.
].
openHow isNil ifTrue:[
openHow := defaultOpenHow.
].
where := whereRadioGroup value.
withTextEntry ifTrue:[
isSelector == #code ifTrue:[
code := codeField contentsAsString.
LastCodeSearched := code.
] ifFalse:[
sel := selectorHolder value.
sel isEmpty ifTrue:[
browser warn:(isSelector
ifTrue:[ 'No selector entered for search'. ]
ifFalse:[ 'Nothing entered for search'. ]).
^ self.
].
sel := sel string.
browser rememberSearchPattern:sel.
isSelector == #globalName ifTrue:[
LastGlobalSearched := sel.
].
].
].
where isNil ifTrue:[
browser warn:'No class(es) for search'.
^ self.
].
self getClassesAndMethodsFor:where.
(#(#classesWithPrivateClasses #classHierarchiesWithPrivateClasses #ownersWithPrivateClasses #ownersHierarchiesWithPrivateClasses)
includes:where)
ifTrue:[
|toSearch|
toSearch := IdentitySet withAll:classes.
classes := IdentitySet withAll:toSearch.
[ toSearch notEmpty. ] whileTrue:[
|cls|
cls := toSearch removeFirst.
classes addAll:cls allPrivateClasses.
].
].
classes size == 0 ifTrue:[
classes := nil.
methods size == 0 ifTrue:[
browser warn:'No class(es) given for search.'.
^ self.
].
] ifFalse:[
classes := classes asOrderedCollection.
methods size ~~ 0 ifTrue:[
browser warn:'oops'.
methods := nil.
].
].
aBlock
value:classes
value:(sel ? code)
value:(caseHolder value ? false)
value:openHow
value:(matchHolder value ? false)
value:methods
value:(isMethodHolder value ? false).
!
setupToAskForMethodSearchTitle:title forBrowser:brwsrArg isSelector:isSelectorArg searchArea:whereDefault withCaseIgnore:withCaseIgnore withMatch:withMatch
withMethodList:withMethodList allowFind:allowFindArg allowBuffer:allowBufferArg allowBrowser:allowBrowserArg withTextEntry:withTextEntryArg
| where ns methodNameSpaces|
allowFind := allowFindArg.
allowBuffer := allowBufferArg.
allowBrowser := allowBrowserArg.
isSelector := isSelectorArg.
withTextEntry := withTextEntryArg.
browser := brwsrArg.
resources := browser resources.
(self addTextLabel:(resources string:title) withCRs) adjust:#left.
selectedClasses := browser selectedClasses value.
selectedCategories := browser selectedCategoriesValue.
selectedMethods := browser selectedMethods value.
currentClass := browser theSingleSelectedClass.
currentClassCategory := browser theSingleSelectedCategory.
currentClass isNil ifTrue:[
browser hasMethodSelected ifTrue:[
currentClass := selectedMethods first mclass.
selectedClasses := (selectedMethods collect:[ :each | each mclass ])
asIdentitySet.
selectedClasses := selectedClasses select:[ :each | each notNil ].
].
].
currentClass notNil ifTrue:[
currentClass := currentClass theNonMetaclass.
].
withTextEntry ifTrue:[
isSelector == #code ifTrue:[
self addTextEntryFieldForCode.
] ifFalse:[
self addInputFieldForSelectorOrNameOrString.
withCaseIgnore ifTrue:[
self addCheckBox:(resources string:'Ignore case')
on:(caseHolder := false asValue).
].
withMatch ifTrue:[
self addCheckBox:(resources string:'Match')
on:(matchHolder := true asValue).
"/ (isSelector and:[ sel notNil. ]) ifTrue:[
"/ sel includesMatchCharacters ifTrue:[
"/ matchHolder value:false.
"/ ].
"/ ].
].
].
].
searchAreas := OrderedCollection new.
verticalPanel := VerticalPanelView new.
verticalPanel horizontalLayout:#fitSpace.
self addHorizontalLine.
self addVerticalSpace.
(self addTextLabel:(resources string:'Search in:')) adjust:#left.
whereRadioGroup := RadioButtonGroup new.
(selectedCategories size > 0 or:[ selectedClasses size > 0 ]) ifTrue:[
self addCheckBoxForEverywhere.
"/ classMethodListView notNil ifTrue:[
"/ b := CheckBox label:(resources string:'Shown Methods').
"/ panel add:b. whereChannel add:b value:#currentMethodList.
"/ areas add:#currentMethodList.
"/ self makeTabable:b.
"/ ].
browser isMethodListBrowser ifTrue:[
methodNameSpaces := (browser selectedMethods value ? #())
collect:[ :eachMethod | eachMethod mclass topNameSpace ].
].
methodNameSpaces size == 1 ifTrue:[
currentNamespace := methodNameSpaces first.
] ifFalse:[
currentNamespace := browser currentNamespace.
].
(currentNamespace notNil
and:[ currentNamespace ~= (browser nameListEntryForALL) ])
ifTrue:[ self addCheckBoxForCurrentNamespace ]
ifFalse:[
(currentClass notNil
and:[ (ns := currentClass nameSpace) notNil and:[ ns ~~ Smalltalk ] ])
ifTrue:[ self addCheckBoxForClassesNamespace:ns ].
].
selectedCategories size > 0 ifTrue:[
self addCheckBoxForSelectedClassCategory.
].
(selectedClasses size > 0 or:[ selectedMethods size > 0 ]) ifTrue:[
self addCheckBoxForSelectedClass.
self addCheckBoxForSelectedClassAndSuperclasses.
self addCheckBoxForSelectedClassAndSubclasses.
self addCheckBoxForSelectedClassAndPrivateClasses.
self addCheckBoxForSelectedClassAndSubclassesAndPrivateClasses.
self addCheckBoxForOwnerAndItsPrivateClasses.
self addCheckBoxForOwnerAndItsSubclassesAndItsPrivateClasses.
].
] ifFalse:[
browser currentNamespace ~~ Smalltalk ifTrue:[
self addCheckBoxForEverywhere.
currentNamespace := browser currentNamespace.
currentNamespace ~= (browser nameListEntryForALL) ifTrue:[
self addCheckBoxForCurrentNamespace.
] ifFalse:[
(currentClass notNil
and:[ (ns := currentClass nameSpace) notNil and:[ ns ~~ Smalltalk ] ])
ifTrue:[ self addCheckBoxForClassesNamespace:ns ].
].
].
].
(withMethodList and:[ browser isMethodListBrowser ]) ifTrue:[
searchAreas size == 0 ifTrue:[
self addCheckBoxForEverywhere.
].
self addCheckBoxForMethodList.
browser selectedMethods value size > 1 ifTrue:[
self addCheckBoxForSelectedMethods.
].
].
searchAreas size == 0 ifTrue:[
whereRadioGroup := #everywhere asValue.
self addDummyCheckBoxForEverywhere.
] ifFalse:[
whereDefault notNil ifTrue:[
(searchAreas includes:whereDefault) ifTrue:[
where := whereDefault asSymbol.
] ifFalse:[
where := searchAreas first.
].
] ifFalse:[
where := #everywhere.
].
whereRadioGroup value:where.
].
self addComponent:verticalPanel indent:0.
"/ panel has its own idea of indenting
self addVerticalSpace.
self addHorizontalLine.
self addButtons.
self label:(resources string:'Search').
! !
!NewSystemBrowser::SearchDialog methodsFor:'setup'!
addCheckBox:b forSearchArea:area
verticalPanel add:b.
whereRadioGroup add:b value:area.
searchAreas add:area.
self makeTabable:b.
!
addCheckBoxForClassesNamespace:ns
|b|
b := CheckBox
label:(resources string:'Classes nameSpace (''%1'')' with:ns name).
self addCheckBox:b forSearchArea:#currentClassesNameSpace.
^ b.
!
addCheckBoxForCurrentNamespace
|b|
b := CheckBox label:(resources string:'Current nameSpace (''%1'')'
with:currentNamespace name).
self addCheckBox:b forSearchArea:#currentNameSpace.
^ b.
!
addCheckBoxForEverywhere
|b|
b := CheckBox label:(resources string:'Everywhere').
self addCheckBox:b forSearchArea:#everywhere.
^ b.
!
addCheckBoxForMethodList
|b|
b := CheckBox label:(resources string:'Methodlist').
self addCheckBox:b forSearchArea:#listOfMethods.
^ b.
!
addCheckBoxForOwnerAndItsPrivateClasses
|b lbl|
(currentClass notNil and:[ currentClass isPrivate. ]) ifTrue:[
lbl := resources string:'Owner (%1) & all its private classes'
with:currentClass owningClass name.
] ifFalse:[
lbl := resources string:'Owners & all their private classes'.
].
b := CheckBox label:lbl.
self addCheckBox:b forSearchArea:#ownersWithPrivateClasses.
(selectedClasses contains:[ :cls | cls isPrivate. ]) ifFalse:[
b disable.
].
^ b.
!
addCheckBoxForOwnerAndItsSubclassesAndItsPrivateClasses
|b lbl|
(currentClass notNil and:[ currentClass isPrivate. ]) ifTrue:[
lbl := resources
string:'Owner (%1) & its subclasses & all its private classes'
with:currentClass owningClass name.
] ifFalse:[
lbl := resources
string:'Owners & their subclasses & all their private classes'.
].
b := CheckBox label:lbl.
self addCheckBox:b forSearchArea:#ownersHierarchiesWithPrivateClasses.
(selectedClasses contains:[ :cls | cls isPrivate. ]) ifFalse:[
b disable.
].
^ b.
!
addCheckBoxForSelectedClass
|b lbl|
(browser isMethodListBrowser or:[ currentClass isNil. ]) ifTrue:[
selectedClasses size == 1 ifTrue:[
lbl := resources string:'Selected class (''%1'')'
with:selectedClasses first theNonMetaclass name.
] ifFalse:[
lbl := resources string:'Selected classes (%1)' with:selectedClasses size.
].
] ifFalse:[
lbl := resources string:'Class (''%1'')' with:currentClass name.
].
b := CheckBox label:lbl.
self addCheckBox:b forSearchArea:#classes.
^ b.
!
addCheckBoxForSelectedClassAndPrivateClasses
|b lbl|
(browser isMethodListBrowser or:[ currentClass isNil. ]) ifTrue:[
lbl := 'Selected classes & all private classes'.
] ifFalse:[
lbl := 'Class & private classes'.
].
b := CheckBox label:(resources string:lbl).
self addCheckBox:b forSearchArea:#classesWithPrivateClasses.
(selectedClasses
contains:[ :cls | cls theNonMetaclass privateClasses size > 0. ])
ifFalse:[ b disable. ].
^ b.
!
addCheckBoxForSelectedClassAndSubclasses
|b lbl|
(browser isMethodListBrowser or:[ currentClass isNil. ]) ifTrue:[
lbl := 'Selected classes & all subclasses'.
] ifFalse:[
lbl := 'Class & subclasses'.
].
b := CheckBox label:(resources string:lbl).
self addCheckBox:b forSearchArea:#classHierarchies.
(selectedClasses
contains:[ :cls | cls theNonMetaclass subclasses size > 0. ])
ifFalse:[ b disable. ].
^ b.
!
addCheckBoxForSelectedClassAndSubclassesAndPrivateClasses
|b lbl|
(browser isMethodListBrowser or:[ currentClass isNil. ]) ifTrue:[
lbl := 'Selected classes & all subclasses & all private classes'.
] ifFalse:[
lbl := 'Class & subclasses & all private classes'.
].
b := CheckBox label:(resources string:lbl).
self addCheckBox:b forSearchArea:#classHierarchiesWithPrivateClasses.
(selectedClasses
contains:[ :cls | cls theNonMetaclass privateClasses size > 0. ])
ifFalse:[ b disable. ].
^ b.
!
addCheckBoxForSelectedClassAndSuperclasses
|b lbl|
(browser isMethodListBrowser or:[ currentClass isNil. ]) ifTrue:[
lbl := 'Selected classes & all superclasses'.
] ifFalse:[
lbl := 'Class & superclasses'.
].
b := CheckBox label:(resources string:lbl).
self addCheckBox:b forSearchArea:#classesAndSuperclasses.
(selectedClasses
contains:[ :cls | cls theNonMetaclass superclass notNil. ])
ifFalse:[ b disable. ].
^ b.
!
addCheckBoxForSelectedClassCategory
|b lbl|
currentClassCategory notNil ifTrue:[
lbl := resources string:'Class category (''%1'')'
with:currentClassCategory.
] ifFalse:[
lbl := resources string:'Selected classes categories (%1)'
with:selectedCategories size.
].
b := CheckBox label:lbl.
self addCheckBox:b forSearchArea:#classCategories.
^ b.
!
addCheckBoxForSelectedMethods
|b|
b := CheckBox label:(resources string:'Selected methods (%1)'
with:browser selectedMethods value size).
self addCheckBox:b forSearchArea:#listOfSelectedMethods.
^ b.
!
addDummyCheckBoxForEverywhere
|b|
b := CheckBox label:(resources string:'Everywhere').
b turnOn.
b disable.
verticalPanel add:b.
!
addInputFieldForSelectorOrNameOrString
|sel inputField lastSearchPatterns|
isSelector == true ifTrue:[
sel := browser selectorToSearchFor.
] ifFalse:[
isSelector == #globalName ifTrue:[
sel := browser globalNameToSearchFor ? LastGlobalSearched.
] ifFalse:[
sel := browser stringToSearchFor.
].
].
sel size == 0 ifTrue:[
"/ use last searchString
lastSearchPatterns := browser lastSearchPatterns.
lastSearchPatterns size > 0 ifTrue:[
sel := lastSearchPatterns first.
].
].
selectorHolder := sel asValue.
inputField := self addComboBoxOn:selectorHolder tabable:true.
inputField list:lastSearchPatterns .
inputField selectAll.
inputField
entryCompletionBlock:[ :contents |
|s what|
s := contents withoutSpaces.
self topView
withWaitCursorDo:[
isSelector == #globalName ifFalse:[
what := Smalltalk selectorCompletion:s.
] ifTrue:[
what := Smalltalk globalnameCompletion:s.
].
inputField contents:what first.
(what at:2) size ~~ 1 ifTrue:[
browser window beep.
].
].
].
!
addTextEntryFieldForCode
|initial box infoLabel helpButton errMessageField checkCodeAction|
box := View new.
box extent:(500 @ 200).
codeField := CodeView in:box.
codeField origin:0.0@0.0 corner:(0.75@1.0).
infoLabel := Label in:box.
infoLabel origin:0.75@0.0 corner:(1.0@1.0).
infoLabel font:(codeField font).
infoLabel label:'MetaPatterns:
' , '`' allBold , ' = meta
' , '@' allBold , ' = list/any
' , '.' allBold , ' = statement
' , '`' allBold , ' = recurse
' , '`#n' allBold , ' any lit
' , '`v' allBold , ' any var
' , '`@e' allBold , ' any expr
'.
helpButton := Button label:'Pattern Help' in:box.
helpButton layout:((LayoutOrigin fractionalFromPoint:0.75@1.0)
leftOffset:2
topOffset:helpButton preferredExtent y negated).
helpButton topInset:0.75@1.0.
helpButton action:[self showHelpOnCodePatterns].
self addComponent:box tabable:true.
errMessageField := (self addTextLabel:'') adjust:#left.
errMessageField level:-1.
self addCheckBox:(resources string:'Method') on:self isMethodHolder.
checkCodeAction := [ self checkCodeIn:codeField notifying:errMessageField. ].
codeField modifiedChannel onChangeEvaluate:checkCodeAction.
initial := browser selectionInCodeView.
initial isEmptyOrNil ifTrue:[
initial := LastCodeSearched ? ''
].
codeField contents:initial.
checkCodeAction value.
!
checkCodeIn:codeField notifying:errMessageField
|codeString tree errAction|
codeString := codeField contents asString string.
errAction := [:str :pos |
|line col badLine|
line := codeField lineOfCharacterPosition:pos.
col := (codeField colOfCharacterPosition:pos) max:1.
badLine := (codeField listAt:line) ? ''
. col <= badLine size size ifTrue:[
codeField
listAt:line
put:(badLine asText
emphasisAt:col
put:(UserPreferences current unknownIdentifierEmphasis)).
"/ codeField selectFromCharacterPosition:pos to:pos.
].
errMessageField label:('[',line printString,'] ',str).
codeField requestFocus.
nil.
].
isMethodHolder value ifTrue:[
tree := RBParser parseRewriteMethod:codeString onError: errAction.
] ifFalse:[
tree := RBParser parseRewriteExpression:codeString onError: errAction.
].
tree notNil ifTrue:[ errMessageField label:nil ].
codeField modifiedChannel setValue:false.
!
getClassesAndMethodsFor:where
where == #everywhere ifTrue:[
classes := Smalltalk allClasses.
^ self.
].
where == #currentNameSpace ifTrue:[
classes := currentNamespace allClassesWithAllPrivateClasses.
^ self.
].
where == #currentClassesNameSpace ifTrue:[
currentClass isPrivate ifTrue:[
classes := currentClass topOwningClass nameSpace
allClassesWithAllPrivateClasses.
] ifFalse:[
classes := currentClass nameSpace allClassesWithAllPrivateClasses.
].
^ self.
].
where == #classCategories ifTrue:[
classes := Smalltalk allClasses
select:[ :cls | selectedCategories includes:cls category. ].
classes := classes collect:[ :each | each theNonMetaclass. ].
^ self.
].
(where == #classes or:[ where == #classesWithPrivateClasses. ]) ifTrue:[
classes := selectedClasses collect:[ :each | each theNonMetaclass. ].
^ self.
].
(where == #classHierarchies
or:[ where == #classHierarchiesWithPrivateClasses. ])
ifTrue:[
classes := IdentitySet new.
selectedClasses do:[ :cls |
classes addAll:cls theNonMetaclass withAllSubclasses.
].
^ self.
].
where == #ownersWithPrivateClasses ifTrue:[
classes := IdentitySet new.
selectedClasses do:[ :cls |
|c|
c := cls theNonMetaclass.
classes add:(c owningClass ? c).
].
^ self.
].
where == #ownersHierarchiesWithPrivateClasses ifTrue:[
classes := IdentitySet new.
selectedClasses do:[ :cls |
|c|
c := cls theNonMetaclass.
classes addAll:(c owningClass ? c) withAllSubclasses.
].
^ self.
].
(where == #classesAndSuperclasses) ifTrue:[
classes := IdentitySet new.
selectedClasses do:[ :cls |
classes addAll:cls theNonMetaclass withAllSuperclasses.
].
^ self.
].
(where == #listOfMethods) ifTrue:[
classes := nil.
methods := browser methodListApp methodList value.
^ self.
].
(where == #listOfSelectedMethods) ifTrue:[
classes := nil.
methods := browser selectedMethods value.
^ self.
].
!
isMethodHolder
isMethodHolder isNil ifTrue:[isMethodHolder := (LastCodeSearchWasMethod ? false) asValue].
^ isMethodHolder
! !
!NewSystemBrowser::SearchDialog methodsFor:'setup-buttons'!
addBrowseButton
|b|
b := Button label:(resources string:'Browse').
(DialogBox defaultOKButtonAtLeft) ifTrue:[
self addButton:b before:nil.
] ifFalse:[
self addButton:b after:nil.
].
b
action:[
openHow := #newBrowser.
self doAccept.
self okPressed.
].
^ b.
!
addBufferButton
|b|
b := Button label:(resources string:'Add Buffer').
(DialogBox defaultOKButtonAtLeft) ifTrue:[
self addButton:b before:nil.
] ifFalse:[
self addButton:b after:nil.
].
b
action:[
openHow := #newBuffer.
self doAccept.
self okPressed.
].
^ b.
!
addButtons
|prevButton|
allowFind ifTrue:[
defaultOpenHow := #showHere.
prevButton := self addFindButton.
].
allowBrowser ifTrue:[
defaultOpenHow := #newBrowser.
prevButton := self addBrowseButton.
].
allowBuffer ifTrue:[
defaultOpenHow := #newBuffer.
prevButton := self addBufferButton.
].
prevButton notNil ifTrue:[
prevButton isReturnButton:true.
].
self addAbortButton.
!
addFindButton
|b|
b := Button label:(resources string:'Find').
(DialogBox defaultOKButtonAtLeft) ifTrue:[
self addButton:b before:nil.
] ifFalse:[
self addButton:b after:nil.
].
b
action:[
openHow := #showHere.
self doAccept.
self okPressed.
].
^ b.
! !
!NewSystemBrowser::SpecialCodeView class methodsFor:'interface specs'!
windowSpec
"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::SpecialCodeView andSelector:#windowSpec
NewSystemBrowser::SpecialCodeView new openInterface:#windowSpec
NewSystemBrowser::SpecialCodeView open
"
<resource: #canvas>
^
#(#FullSpec
#name: #windowSpec
#window:
#(#WindowSpec
#label: 'SpecialCodeView'
#name: 'SpecialCodeView'
#min: #(#Point 10 10)
#max: #(#Point 1280 1024)
#bounds: #(#Rectangle 12 22 312 322)
)
#component:
#(#SpecCollection
#collection: #()
)
)
! !
!NewSystemBrowser::VariableList class methodsFor:'interface specs'!
windowSpec
"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::VariableList andSelector:#windowSpec
NewSystemBrowser::VariableList new openInterface:#windowSpec
NewSystemBrowser::VariableList open
"
<resource: #canvas>
^
#(#FullSpec
#name: #windowSpec
#window:
#(#WindowSpec
#label: 'VariableList'
#name: 'VariableList'
#min: #(#Point 0 0)
#max: #(#Point 1024 721)
#bounds: #(#Rectangle 16 46 316 346)
)
#component:
#(#SpecCollection
#collection: #(
#(#SequenceViewSpec
#name: 'List'
#layout: #(#LayoutFrame 0 0.0 0 0.0 0 1.0 0 1.0)
#tabable: true
#model: #selectedVariables
#menu: #menuHolder
#hasHorizontalScrollBar: true
#hasVerticalScrollBar: true
#miniScrollerHorizontal: true
#isMultiSelect: true
#valueChangeSelector: #selectionChangedByClick
#useIndex: false
#sequenceList: #variableList
#doubleClickChannel: #doubleClickChannel
)
)
)
)
! !
!NewSystemBrowser::VariableList class methodsFor:'plugIn spec'!
aspectSelectors
"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."
"Return a description of exported aspects;
these can be connected to aspects of an embedding application
(if this app is embedded in a subCanvas)."
^ #(
#(#doubleClickChannel #action )
#classHolder
#forceGeneratorTrigger
#immediateUpdate
#inGeneratorHolder
#menuHolder
#outGeneratorHolder
#packageFilter
#selectedVariables
#selectionChangeCondition
#updateTrigger
#showClassVarsInVariableList
#slaveMode
#sortVariablesBy
).
! !
!NewSystemBrowser::VariableList methodsFor:'aspects'!
classHolder
classHolder isNil ifTrue:[
classHolder := #() asValue.
classHolder addDependent:self
].
^ classHolder
!
classHolder:aValueHolder
classHolder notNil ifTrue:[
classHolder removeDependent:self
].
classHolder := aValueHolder.
classHolder notNil ifTrue:[
classHolder isBehavior ifTrue:[self halt:'should not happen'].
classHolder addDependent:self
].
!
defaultSlaveModeValue
^ false.
!
selectedVariables
^ self selectionHolder
!
selectedVariables:aValueHolder
^ self selectionHolder:aValueHolder
!
showClassVarsInVariableList
showClassVars isNil ifTrue:[
showClassVars := false asValue.
showClassVars addDependent:self
].
^ showClassVars
!
showClassVarsInVariableList:aValueHolder
showClassVars notNil ifTrue:[
showClassVars removeDependent:self
].
showClassVars := aValueHolder.
showClassVars notNil ifTrue:[
showClassVars addDependent:self
].
!
showingInheritedClassVars
^ false
"/ ^ true
!
sortVariablesByName
sortVariablesByName isNil ifTrue:[
sortVariablesByName := false asValue.
sortVariablesByName addDependent:self
].
^ sortVariablesByName
!
sortVariablesByName:aValueHolder
sortVariablesByName notNil ifTrue:[
sortVariablesByName removeDependent:self
].
sortVariablesByName := aValueHolder.
sortVariablesByName notNil ifTrue:[
sortVariablesByName addDependent:self
].
!
variableList
variableList isNil ifTrue:[
variableList := ValueHolder new
].
^ variableList
! !
!NewSystemBrowser::VariableList methodsFor:'change & update'!
delayedUpdate:something with:aParameter from:changedObject
|selectedClasses changedClass anyChange|
self inSlaveModeOrInvisible ifTrue:[self invalidateList. ^ self].
"/ slaveMode value == true ifTrue:[^ self].
changedObject == slaveMode ifTrue:[
listValid ~~ true ifTrue:[
self enqueueDelayedUpdateList
].
"/ self invalidateList.
^ self
].
changedObject == classHolder ifTrue:[
self invalidateList.
^ self
].
changedObject == showClassVars ifTrue:[
self invalidateList.
^ self.
].
changedObject == sortVariablesByName ifTrue:[
self invalidateList.
^ self.
].
changedObject == Smalltalk ifTrue:[
(something == #classDefinition
or:[something == #classVariables and:[showClassVars value == true]])
ifTrue:[
changedClass := aParameter.
selectedClasses := classHolder value.
selectedClasses notNil ifTrue:[
selectedClasses isSequenceable ifFalse:[
selectedClasses := selectedClasses asOrderedCollection
].
selectedClasses keysAndValuesDo:[:idx :cls | |nm|
cls notNil ifTrue:[
cls isObsolete ifTrue:[
cls isMeta ifTrue:[
nm := cls theNonMetaclass name.
selectedClasses at:idx put:(Smalltalk at:nm) class.
] ifFalse:[
nm := cls name.
selectedClasses at:idx put:(Smalltalk at:nm).
].
anyChange := true.
] ifFalse:[
(cls == aParameter
or:[something == #classVariables
and:[showClassVars value == true
and:[cls theNonMetaclass == aParameter theNonMetaclass]]]) ifTrue:[
anyChange := true.
]
]
]
].
(selectedClasses includes:nil) ifTrue:[
"/ can happen, if a selected class is removed...
"/ self halt:'should this happen ?'.
"/ fix it ...
selectedClasses := selectedClasses select:[:each | each notNil].
classHolder value:selectedClasses.
anyChange := true.
].
anyChange == true ifTrue:[
self invalidateList.
^ self
].
].
^ self
].
] ifFalse:[
changedObject isBehavior ifTrue:[
anyChange := false.
selectedClasses := classHolder value.
selectedClasses notNil ifTrue:[
selectedClasses keysAndValuesDo:[:idx :cls | |nm|
cls isObsolete ifTrue:[
nm := cls name.
selectedClasses at:idx put:(Smalltalk at:nm).
anyChange := true.
]
].
anyChange == true ifTrue:[
self invalidateList.
^ self
].
(selectedClasses includesIdentical:something) ifTrue:[
self invalidateList.
^ self
].
].
^ self
].
].
super delayedUpdate:something with:aParameter from:changedObject
!
makeDependent
Smalltalk addDependent:self
!
makeIndependent
Smalltalk removeDependent:self
!
selectionChangedByClick
"we are not interested in that - get another notification
via the changed valueHolder"
!
update:something with:aParameter from:changedObject
"/ ^ self delayedUpdate:something with:aParameter from:changedObject.
changedObject == Smalltalk ifTrue:[
something == #methodDictionary ifTrue:[
^ self
].
something == #methodTrap ifTrue:[
^ self
].
something == #methodInClass ifTrue:[
^ self
].
something == #methodInClassRemoved ifTrue:[
^ self
].
something == #classComment ifTrue:[
^ self.
].
].
"/ self window sensor isNil ifTrue:[
"/ "/ I am not visible ...
"/ self invalidateList.
"/ ^ self
"/ ].
super update:something with:aParameter from:changedObject
"Modified: / 20.11.2001 / 21:55:22 / cg"
! !
!NewSystemBrowser::VariableList methodsFor:'generators'!
makeGenerator
! !
!NewSystemBrowser::VariableList methodsFor:'private'!
commonPostBuildWith:aBuilder
|list|
super commonPostBuildWith:aBuilder.
list := aBuilder componentAt:#List.
list notNil ifTrue:[
list selectConditionBlock:[:item | self selectionChangeAllowed:item].
list ignoreReselect:false.
].
!
commonSubClassIn:classes
"return true if there is a common subclass"
|theCommonSubClass "classesByInheritance"|
theCommonSubClass := nil.
classes do:[:eachClass |
theCommonSubClass isNil ifTrue:[
theCommonSubClass := eachClass
] ifFalse:[
(eachClass isSubclassOf:theCommonSubClass) ifTrue:[
theCommonSubClass := eachClass
] ifFalse:[
(theCommonSubClass isSubclassOf:eachClass) ifFalse:[
^ nil
]
]
]
].
^ theCommonSubClass.
"/ classesByInheritance := classes topologicalSort:[:a :b | a isSubclassOf:b].
"/ classesByInheritance keysAndValuesDo:[:index :eachClass |
"/ "/ all classes after that one must be superclasses ...
"/ classesByInheritance from:index+1 to:classesByInheritance size do:[:otherClass |
"/ (eachClass isSubclassOf:otherClass) ifFalse:[
"/ ^ nil.
"/ ]
"/ ].
"/ ].
"/ ^ classesByInheritance first
!
listOfVariables
|nameList numClasses classes class commonSubclass showingClassVars
sortByName|
classHolder isNil ifTrue:[
"/ testing
^ #()
].
showingClassVars := showClassVars value == true.
sortByName := sortVariablesByName value.
classes := classHolder value.
(numClasses := classes size) == 0 ifTrue:[^ #() ].
numClasses > 1 ifTrue:[
"/ multiple classes - see if there is a common subclass ...
commonSubclass := self commonSubClassIn:classes.
commonSubclass notNil ifTrue:[
"/ yes - treat like a single class
classes := Array with:(commonSubclass).
numClasses := 1.
].
].
numClasses > 1 ifTrue:[
"/ multiple classes - sort alphabetically ...
"/ unless there is a common subclass ...
nameList := Set new.
classes do:[:class |
showingClassVars ifTrue:[
self showingInheritedClassVars ifTrue:[
class theNonMetaclass withAllSuperclassesDo:[:cls|
nameList addAll:(cls classVarNames)
]
] ifFalse:[
nameList addAll:(class classVarNames)
]
] ifFalse:[
class withAllSuperclassesDo:[:cls|
nameList addAll:(cls instVarNames)
]
]
].
nameList := nameList asOrderedCollection.
] ifFalse:[
"/ only a single class - sort by inheritance
class := classes first.
nameList := OrderedCollection new.
class notNil ifTrue:[
showingClassVars ifTrue:[
class := class theNonMetaclass
].
class withAllSuperclassesDo:[:cls|
|varNames|
varNames := showingClassVars ifTrue:[ cls classVarNames ] ifFalse:[ cls instVarNames ].
varNames copy reverse do:[:varName|
nameList addFirst:varName.
].
sortByName ifFalse:[
nameList addFirst:'----- ' , cls nameInBrowser , ' -----'.
]
].
].
].
(numClasses > 1 or:[sortByName]) ifTrue:[
nameList sort.
].
^ nameList
"Created: / 5.2.2000 / 13:42:11 / cg"
"Modified: / 26.2.2000 / 01:05:36 / cg"
!
postBuildWith:aBuilder
|listView|
(listView := aBuilder componentAt:#List) notNil ifTrue:[
listView scrollWhenUpdating:#end
].
super postBuildWith:aBuilder
!
release
super release.
classHolder removeDependent:self.
showClassVars removeDependent:self.
!
selectionChangeAllowed:index
^ ((variableList value at:index) startsWith:'---') not.
!
updateList
| prevSelection newSelection newList oldList selectedVariablesHolder|
oldList := self variableList value copy.
newList := self listOfVariables.
newList ~= variableList value ifTrue:[
selectedVariablesHolder := self selectedVariables.
prevSelection := (selectedVariablesHolder value copy) ? #().
variableList value:newList.
newSelection := prevSelection select:[:item | newList includes:item].
newSelection size > 0 ifTrue:[
"/ force change (for dependents)
selectedVariablesHolder value:nil.
selectedVariablesHolder value:newSelection.
] ifFalse:[
prevSelection := selectedVariablesHolder value.
selectedVariablesHolder value:nil.
].
(prevSelection size > 0 or:[newSelection size > 0]) ifTrue:[
self updateOutputGenerator.
].
].
listValid := true.
! !
!NewSystemBrowser class methodsFor:'documentation'!
version
^ '$Header: /cvs/stx/stx/libtool/Attic/NewSystemBrowser.st,v 1.709 2004-02-18 12:49:10 cg Exp $'
! !
NewSystemBrowser initialize!
NewSystemBrowser::NavigatorModel initialize!
NewSystemBrowser::HierarchicalClassList initialize!