`TestRunner2`: do not use `#keysAndValuesCollect:`
...as semantics differ among smalltalk dialects. This is normally not a
problem until we use code that adds this as a "compatibility" method.
So to stay on a safe side, avoid using this method.
"
COPYRIGHT (c) 2000 by eXept Software AG
COPYRIGHT (c) 2015-2018 Jan Vrany
COPYRIGHT (c) 2020-2023 LabWare
COPYRIGHT (c) 2021 Patrik Svestka
All Rights Reserved
This software is furnished under a license and may be used
only in accordance with the terms of that license and with the
inclusion of the above copyright notice. This software may not
be provided or otherwise made available to, or used by, any
other person. No title to or ownership of the software is
hereby transferred.
"
"{ Package: 'stx:libtool' }"
"{ NameSpace: Tools }"
SystemBrowser subclass:#NewSystemBrowser
instanceVariableNames:'environmentHolder environment navigationState bufferNameList
selectedBuffer buffers bufferUsageOrder browserCanvas
immediateUpdate showClassPackages lastMethodCategory
lastMethodMoveClass browserCanvasType
syntaxColoringProcessRunning syntaxColoringProcess
methodInfoProcess browsletShowHideLabelHolder browserPageCanvas
isEmbedded hasNonEmptyEnvironmentSelectedHolder
smalllintRulesOrAllHolder smalllintRulesOrDefaultHolder
explainProcess'
classVariableNames:'CachedMethodsImplemented CachedTagToRevisionMapping
DefaultAutoFormat DefaultCodeInfoVisible
DefaultEmphasizeUnloadedClasses DefaultHideUnloadedClasses
DefaultImmediateExplaining DefaultImmediateSyntaxColoring
DefaultMarkApplications
DefaultShortAllClassesInNameSpaceOrganisation
DefaultShortNameInTabs DefaultShowCoverage
DefaultShowMethodComplexity DefaultShowMethodInheritance
DefaultShowMethodTypeIcon DefaultShowMultitabMode
DefaultShowPseudoProtocols DefaultShowSpecialResourceEditors
DefaultShowSyntheticMethods DefaultSyntaxColoring
DefaultToolBarVisible DoubleClickIsOpenBrowser FindHistory
LastAcceptPackage LastBaseVersionTag
LastBreakPointConditionString LastCategoryRenameNew
LastCategoryRenameOld LastCategoryRenames LastClassDocDirectory
LastClassFilterBlockString LastClassProcessingBlockString
LastClassSearchBoxShowedFullName LastClassSearchBoxShowedJavaOnly
LastComparedClassName LastCypressDirectory LastImportedPackage
LastIndividualChecks LastLintRulesHolder LastLintedPackage
LastLiteralReplacementNewName LastLiteralReplacementOldLiteral
LastLiteralReplacementType LastLoadedPackages
LastMethodFilterBlockString LastMethodMoveOrCopyTargetClass
LastMethodProcessingBlockString LastNameSpaceMove
LastNewProjectType LastNewProtocols LastProjectMoves
LastProtocolRenames LastRemoteRepository LastRenamedNew
LastRenamedOld LastSearchedImplementors LastSearchedSenders
LastTag LastTemporaryVariableName LastTonelDirectories
LastVariableRenames LastVisitorClassName NewNavigationHistory
RecentlyClosedList SharedMethodCategoryCache
ShowMethodTemplateWhenProtocolIsSelected SynchronousUpdate'
poolDictionaries:''
category:'Interface-Browsers-New'
!
ListEntry subclass:#OwnershipGraph
instanceVariableNames:'ownershipInfo cachedForm'
classVariableNames:''
poolDictionaries:''
privateIn:NewSystemBrowser
!
Object subclass:#RevisionOwnershipInfo
instanceVariableNames:'revision author date lineOwnership'
classVariableNames:''
poolDictionaries:''
privateIn:NewSystemBrowser::OwnershipGraph
!
!NewSystemBrowser class methodsFor:'documentation'!
aboutThisApplicationText
^ super aboutThisApplicationText ,
'\\Written by Claus Gittinger, eXept Software AG\Thanks to John Brant & Dan Roberts for their Refactory Code.' withCRs
!
copyright
"
COPYRIGHT (c) 2000 by eXept Software AG
COPYRIGHT (c) 2015-2018 Jan Vrany
COPYRIGHT (c) 2020-2023 LabWare
COPYRIGHT (c) 2021 Patrik Svestka
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.
!
loadRefactoryBrowser
"/ try to load the refactoryBrowser package ...
Smalltalk loadPackage:'stx:goodies/refactoryBrowser' asAutoloaded:true.
"/ could be autoloaded
RefactoryChangeManager notNil ifTrue:[
RefactoryChangeManager autoload.
]
!
postAutoload
"/ try to load the refactoryBrowser package ...
self loadRefactoryBrowser.
"
self postAutoload
Transcript application removeUserTool:#newSystemBrowser
"
"Modified: / 23.8.2001 / 12:32:34 / cg"
! !
!NewSystemBrowser class methodsFor:'accessing-history'!
addToBookMarks:aClass selector:aSelectorOrNil
|newEntry|
(newEntry := self bookmarkForClass:aClass selector:aSelectorOrNil) notNil ifTrue:[
(self bookmarks includes:newEntry) ifFalse:[
self bookmarks add:newEntry
]
].
"Modified: / 02-06-2011 / 12:01:57 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
bookmarkForClass:aClass selector:aSelectorOrNil
^aSelectorOrNil isNil
ifTrue:[Bookmark forClass: aClass ]
ifFalse:[Bookmark forClass: aClass selector: aSelectorOrNil ]
"Created: / 05-05-2011 / 23:36:24 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 02-05-2014 / 17:34:42 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
bookmarks
^BookmarkList forSystemBrowser
"Created: / 23-05-2011 / 10:13:08 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 02-06-2011 / 11:36:15 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
classHistory
NewNavigationHistory isNil ifTrue:[
NewNavigationHistory := NavigationHistory new.
NewNavigationHistory beGlobalHistory.
].
^ NewNavigationHistory
"Created: / 03-07-2011 / 13:21:53 / cg"
!
updateHistory:historyOrNil forClass:class selector:selector
|newEntry history historyToRemove |
newEntry := self historyEntryForClass:class selector:selector.
newEntry isNil ifTrue:[^ historyOrNil].
(history := historyOrNil) isNil ifTrue:[
history := OrderedCollection new.
].
historyToRemove := history
reject:[:entry |
entry className ~= newEntry className
or:[entry selector ~= newEntry selector
or:[entry meta ~= newEntry meta]]
].
history removeAll: historyToRemove.
history addFirst:newEntry.
history size > 30 ifTrue:[
history removeLast.
].
^ history
"Created: / 08-09-2012 / 21:09:19 / cg"
"Modified: / 02-05-2014 / 17:45:58 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!NewSystemBrowser class methodsFor:'defaults'!
synchronousUpdate
^ SynchronousUpdate ? false
"
SynchronousUpdate := true
SynchronousUpdate := false
"
"Modified (comment): / 24-08-2011 / 15:33:27 / cg"
! !
!NewSystemBrowser class methodsFor:'help specs'!
flyByHelpSpec
<resource: #help>
|spec manager|
spec := super flyByHelpSpec addPairsFrom:#(
#runLintOnClasses
'Run static code analysis (lint) on the selected classes/protocols/methods'
#bookmarks
'Manage bookmarks'
#goBack
'Go back in local visited history.\This remembers the locally visited methods'
#goBackInGlobalHistory
'Go back in global visited history.\This remembers the last visited method on a per class base'
#goForward
'Go forward in local visited history.\This remembers the locally visited methods'
#recentChanges
'Recent changes'
#recentClassChanges
'Recently changed classes'
#recentlyVisitedMethods
'Recently changed methods'
#columnLabel
'The text-cursor''s column number'
#lineLabel
'The text-cursor''s line number. Double-click to change'
#modeLabel
'The editing mode ("Insert" vs. "Overwrite"). Right-click to change'
#packageInfoLabel
'Package and revision info (for class or method).\Colorized if manager is different from default manager'
#addBreakPoint
'Add breakpoint on method'
#createBuffer
'Add buffer'
#removeBreakPoint
'Remove breakpoint'
#recentlyChangedMethods
'Recently changed methods'
#recentlyChangedClasses
'Recently changed classes'
#recentChanges
'Recently changed methods'
#recentVisits
'Recently visited'
#recentlyVisitedMethods
'Recently visited methods'
#recentlyVisitedMethods
'Visited methods'
#executeSelectedClassMethod
'Execute the selected class method. Show execution time and answer on the Transcript'
#initializeSharedPool
'Initialize the selected SharedPool (by calling its "initialize"-method)'
#launchSelectedApplication
'Launch the selected application'
#packageSelectedApplication
'Package the selected application or library for deployment'
#runTestCases
'Run selected testCase(s)'
#runTestCasesWithDebug
'Run selected testCase(s) with debugging enabled'
#showCategories
'Show Class Categories'
#showClassHierarchy
'Show class inheritance'
#showInheritedMethods
'Show inherited methods (except Object''s)'
#doNotShowInheritedMethods
'Do not show inherited methods'
#searchClass
'Search class'
#gotoClassEntryField
'Goto class (uppercase) or method which implements this selector (lowercase).\Use "*foo" to search for names ending with "foo",\"foo*" for names beginning with foo.\Otherwise, names which contain "foo" are listed.'
"/#gotoClassEntryField
"/'Goto Class'
#formatCode
'Format code (PrettyPrint)'
#showCodeCoverage
'Show code coverage (red=uncovered; green=covered; orange=partially covered).\Enabled after a recompile with instrumentation'
#hideToolBar
'Hide toolbar. Show again via the "View"-Menu'
#hideBookmarkBar
'Hide the bookmark-bar. Show again via the "View"-menu'
#infoLabelHelp
'This label shows info on the just selected method, the clicked on code-fragment or the current activity'
#redoOperation
'Redo undone operation'
#undoOperation
'Undo operation'
).
(RefactoryChangeManager notNil and:[ RefactoryChangeManager isLoaded ]) ifTrue:[
manager := RefactoryChangeManager instance.
manager hasUndoableOperations
ifTrue:[
spec at:#undoOperation put:(self resources string:'Undo (%1)' with:manager undoChange name).
].
manager hasRedoableOperations
ifTrue:[
spec at:#redoOperation put:(self resources string:'Redo (%1)' with:manager redoChange name).
].
].
^ spec.
"Modified: / 18-11-2016 / 11:00:42 / cg"
! !
!NewSystemBrowser class methodsFor:'image specs'!
defaultIcon
<resource: #programImage>
^ ToolbarIconLibrary startNewSystemBrowserIcon
"Modified: / 08-08-2011 / 08:27:05 / cg"
!
defaultIcon1
<resource: #image>
"This resource specification was automatically generated
by the ImageEditor of ST/X."
"Do not manually edit this!! If it is corrupted,
the ImageEditor may not be able to read the specification."
"
self defaultIcon1 inspect
ImageEditor openOnClass:self andSelector:#defaultIcon1
Icon flushCachedIcons"
^ Icon constantNamed:#'Tools::NewSystemBrowser class defaultIcon1'
ifAbsentPut:[
(Depth4Image new)
width:28;
height:28;
photometric:(#palette);
bitsPerSample:(#( 4 ));
samplesPerPixel:(1);
bits:(ByteArray
fromPackedString:'
@@@@@@@@@@@@@@@@@@@FY&Y&Y&X0@@@@@FY @@YDQDQDQB@@@@@FXFX@A$QDQDQDH@@@@FY Y&@CH"H"H"H @@@@X@@@X@@@@@@@@@@@@@A&XFY @@@@H@@@
@@@@@@Y Y @@@@@ @@@@@@@@@FY @@@@@B@@@@@@@@@@@@@@@@@@H@@@@@@@@@@@@@@@@@@@@@@@A&Y&Y&Y#@@@@@F@"H"HFDQDQDQH@@@@@@@@@@@L"H"H"
H @@@@@ @@@@@@@@@@@@@@@@@B@@@@@@@@@@@@@@@@@@H@@@@@@@@@@@@@@@@@@@@@@@A&Y&Y&Y#@@@@@F@"H"HFUUUUUUH@@@@@@@@@@@L"H"H"H @@@@@@
@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@H@@@@B@B@ @B@@@@@ @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
@@@@@@@@@@@@@@@@@@@@@@@@H@@@@ @@@@H@@ @@@@Hb');
colorMapFromArray:#[ 0 0 0 0 255 0 127 127 127 170 170 170 255 0 0 255 255 0 255 255 255 ];
mask:((ImageMask new)
width:28;
height:28;
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
<resource: #image>
"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"
^ Icon
constantNamed:#'Tools::NewSystemBrowser class doNotShowInheritedMethodsIcon'
ifAbsentPut:[
(Depth2Image new)
width:16;
height:16;
photometric:(#palette);
bitsPerSample:(#( 2 ));
samplesPerPixel:(1);
bits:(ByteArray
fromPackedString:'UUUUUUUUUUU@@@@EUDP@AT@@@@AT@@@EP@Q@AUUUUTU@@@@APUQDDTP@@@E@@@@EUUU@AUUUUPUT@@@UU@@EUP@a');
colorMapFromArray:#[ 0 0 0 255 255 255 255 255 127 127 127 127 ];
mask:((ImageMask new)
width:16;
height:16;
bits:(ByteArray
fromPackedString:'
@@@@@@@@G0@@@@@@A<@@@@@@@_@@@@@@@G0@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@a');
yourself);
yourself
]
!
hideToolBarIcon
<resource: #programImage>
^ ToolbarIconLibrary hideToolBarIcon
"Created: / 10-12-2001 / 20:45:12 / cg"
"Modified: / 18-02-2007 / 14:52:45 / cg"
!
initializeClass20x20Icon
<resource: #image>
"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 initializeClass20x20Icon inspect
ImageEditor openOnClass:self andSelector:#initializeClass20x20Icon
Icon flushCachedIcons"
^ Icon
constantNamed:'Tools::NewSystemBrowser class initializeClass20x20Icon'
ifAbsentPut:[
(Depth8Image new)
width:20;
height:20;
photometric:(#palette);
bitsPerSample:(#[ 8 ]);
samplesPerPixel:(1);
bits:(ByteArray
fromPackedString:'
@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@BP$@@@@@@@@@@@@@@@@@@@@@@@$HB@$@@@@@@@@@@@@@@@@@@@@@BP HBP@@@@@@@@@@@@@@@@@@
@@$HB@ HBP@@@@@@@@@@@@@@@@@@BP HB@ I@@@@@@@DA@PDA@PDA@PIB@ HB@$C@@@@@@PA@PDA@PDA@P$HB@ HBPD@@@@@A@DA@PDA@PDABP HB@ I@P@@
@@@D@PDA@PDA@PDABP HBPDA@@@@@@PA@PDA@PDA@PDABP$A@PD@@@@@A@DA@PDA@PDA@P$HB@$A@P@@@@@D@PDA@PDA@PDABP HBPDA@@@@@@LB@ HB@ HB
@ HBBP$B@ H@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@a');
colorMapFromArray:#[ 0 0 0 32 223 32 127 127 127 170 170 170 255 255 255 0 0 0 248 252 128 208 220 0 255 251 176 226 167 74 ];
mask:((ImageMask new)
width:20;
height:20;
bits:(ByteArray
fromPackedString:'
@@@@@@X@@@<@@@<@@A>@_?? _?? _?? _?? _?? _?? _?? _?? _?? _?? @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@a');
yourself);
yourself
]
!
initializeSharedPool20x20Icon
^ self initializeSharedPool20x20Icon2
"Modified: / 01-06-2012 / 15:53:25 / cg"
!
initializeSharedPool20x20Icon1
<resource: #image>
"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 initializeSharedPool20x20Icon inspect
ImageEditor openOnClass:self andSelector:#initializeSharedPool20x20Icon
Icon flushCachedIcons"
^ Icon
constantNamed:'Tools::NewSystemBrowser class initializeSharedPool20x20Icon'
ifAbsentPut:[
(Depth8Image new)
width:20;
height:20;
photometric:(#palette);
bitsPerSample:(#[ 8 ]);
samplesPerPixel:(1);
bits:(ByteArray
fromPackedString:'
@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@BP$@@@@@@@@@@@@@@@@@@@@@@@$HB@$@@@@@@@@@@@@@@@@@@@@@BP HBP@@@@@@@@@@@@@@@@@@
@@$HB@ HBP@@@@@@@@@@@@@@@@@@BP HB@ I@@@@@@@DA@PDA@PDA@PIB@ HB@$C@@@@@@PA@PDA@PDA@P$HB@ HBPD@@@@@A@DA@PDA@PDABP HB@ I@P@@
@@@D@PDA@PDA@PDABP HBPDA@@@@@@PA@PDA@PDA@PDABP$A@PD@@@@@A@DA@PDA@PDA@P$HB@$A@P@@@@@D@PDA@PDA@PDABP HBPDA@@@@@@LB@ HB@ HB
@ HBBP$B@ H@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@a');
colorMapFromArray:#[ 0 0 0 0 127 255 127 127 127 170 170 170 255 255 255 0 0 0 248 252 128 208 220 0 255 251 176 226 167 74 ];
mask:((ImageMask new)
width:20;
height:20;
bits:(ByteArray
fromPackedString:'
@@@@@@X@@@<@@@<@@A>@_?? _?? _?? _?? _?? _?? _?? _?? _?? _?? @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@a');
yourself);
yourself
]
"Created: / 01-06-2012 / 15:53:14 / cg"
!
initializeSharedPool20x20Icon2
<resource: #image>
"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 initializeSharedPool20x20Icon2 inspect
ImageEditor openOnClass:self andSelector:#initializeSharedPool20x20Icon2
Icon flushCachedIcons"
^ Icon
constantNamed:'Tools::NewSystemBrowser initializeSharedPool20x20Icon2'
ifAbsentPut:[
(Depth8Image new)
width:20;
height:20;
photometric:(#palette);
bitsPerSample:(#[ 8 ]);
samplesPerPixel:(1);
bits:(ByteArray
fromPackedString:'
@@@@@@@@@@@@@@@@@@@M@@@@@@@@@@@@@@@@@@@@@@@@CP8M@@@@@@@@@@@@@@@@@@@MCP@MC04@CP4@@@@@@@@@@@@@CQ@QCQDRDP4QD@4@@@@@@@@@@@@@
CQLTEQXUEALM@@@@@@@@@@@@@@@@CQDVB1XQCP@@@@@DA@PDA@PDA@PMDQXKE!!DM@@@@@@PA@PDA@PDACQLTEQXUEALM@@@@A@DA@PDA@P4PDP4QD!!DMDQ@M
@@@D@PDA@PDA@P4M@P4OCPDMCP@@@@PA@PDA@PDA@PDACP8M@PD@@@@@A@DA@PDA@PDA@PDACPDA@P@@@@@D@PDA@PDA@PDA@PDA@PDA@@@@@@LB@ HB@ HB
@ HB@ HB@ H@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@a');
colorMapFromArray:#[ 0 0 0 0 127 255 127 127 127 170 170 170 255 255 255 0 0 0 248 252 128 208 220 0 255 251 176 226 167 74 87 87 87 255 248 248 240 240 240 240 144 24 255 248 48 255 248 96 255 248 24 240 208 24 255 248 152 255 248 88 255 248 136 255 248 176 255 248 200 ];
mask:((ImageMask new)
width:20;
height:20;
bits:(ByteArray
fromPackedString:'
@@H@@@\@@C] @G?0@C? _?? _?? _?? _??0_?? _?? _?? _?? _?? _?? @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@a');
yourself);
yourself
]
!
showCategoriesIcon
<resource: #image>
"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"
^ Icon constantNamed:#'Tools::NewSystemBrowser class showCategoriesIcon'
ifAbsentPut:[
(Depth1Image new)
width:16;
height:16;
photometric:(#palette);
bitsPerSample:(#( 1 ));
samplesPerPixel:(1);
bits:(ByteArray
fromPackedString:'?????8@C??.@@N@C @O?>8@A''?6 @X@C??/?<>@G8C<b');
colorMapFromArray:#[ 0 0 0 255 255 255 ];
mask:((ImageMask new)
width:16;
height:16;
bits:(ByteArray
fromPackedString:'
@@@@@A?8@@@@@A?8@@@@@A?8@@@@@A?8@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@a');
yourself);
yourself
]
!
showClassHierarchyIcon
<resource: #image>
"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"
^ Icon
constantNamed:#'Tools::NewSystemBrowser class showClassHierarchyIcon'
ifAbsentPut:[
(Depth1Image new)
width:16;
height:16;
photometric:(#palette);
bitsPerSample:(#( 1 ));
samplesPerPixel:(1);
bits:(ByteArray
fromPackedString:'?????8@C O.@@N@C @O?>8@A&@6 @X@C? O?<>@G8C<b');
colorMapFromArray:#[ 0 0 0 255 255 255 ];
mask:((ImageMask new)
width:16;
height:16;
bits:(ByteArray
fromPackedString:'
@@@@@@@@O0@@@@@@C<@@@@@@@?@@@@@@@O0@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@a');
yourself);
yourself
]
!
showInheritedMethodsIcon
<resource: #image>
"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"
^ Icon
constantNamed:#'Tools::NewSystemBrowser class showInheritedMethodsIcon'
ifAbsentPut:[
(Depth2Image new)
width:16;
height:16;
photometric:(#palette);
bitsPerSample:(#( 2 ));
samplesPerPixel:(1);
bits:(ByteArray
fromPackedString:'UUUQUUUUTWU@@@CMT@A@HT@@@2MT@@B(P@@@@EUUUTU@@@@APU@@@TP@@@E@@@@EUUP@AUUUUPUT@@@UU@@EUP@a');
colorMapFromArray:#[ 0 0 0 255 255 255 255 255 127 127 127 127 ];
mask:((ImageMask new)
width:16;
height:16;
bits:(ByteArray
fromPackedString:'
@@@@A@@NO08@G0@_C9<@@@@@@>@@@@@@@O @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@a');
yourself);
yourself
]
!
startNewSystemBrowserIcon
<resource: #programImage>
^ ToolbarIconLibrary startNewSystemBrowserIcon
! !
!NewSystemBrowser class methodsFor:'interface specs'!
browserPageSpec
"This resource specification was automatically generated
by the UIPainter of ST/X."
"Do not manually edit this!! If it is corrupted,
the UIPainter may not be able to read the specification."
"
UIPainter new openOnClass:Tools::NewSystemBrowser andSelector:#browserPageSpec
Tools::NewSystemBrowser new openInterface:#browserPageSpec
"
<resource: #canvas>
^
#(FullSpec
name: browserPageSpec
window:
(WindowSpec
label: 'NewSystemBrowser'
name: 'NewSystemBrowser'
min: (Point 0 0)
bounds: (Rectangle 0 0 800 700)
menu: mainMenu
icon: defaultIcon
)
component:
(SpecCollection
collection: (
(NoteBookViewSpec
name: 'BrowserPageContents'
layout: (LayoutFrame 0 0 0 0 0 1 0 1)
canvas: browserCanvas
keepCanvasAlive: true
translateLabel: false
)
(ViewSpec
name: 'ToolBar'
layout: (LayoutFrame 0 0 0 0 0 1 40 0)
level: 0
visibilityChannel: toolBarVisibleHolder
component:
(SpecCollection
collection: (
(ActionButtonSpec
label: 'hideToolBarIcon'
name: 'HideToolBarButton'
layout: (LayoutFrame 0 0 0 0 13 0 0 1)
activeHelpKey: hideToolBar
level: 0
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)
level: 0
visibilityChannel: toolBarVisibleHolder
menu: toolBarMenu
textDefault: true
)
(UISubSpecification
name: 'SubSpecification1'
layout: (LayoutFrame -250 1 0 0 0 1 0 1)
level: 0
minorKey: #'searchSpec_live_level0'
)
)
)
)
(ViewSpec
name: 'BookmarkBar'
layout: (LayoutFrame 0 0 40 0 0 1 67 0)
visibilityChannel: bookmarkBarVisibleHolder
component:
(SpecCollection
collection: (
(ActionButtonSpec
label: 'hideToolBarIcon'
name: 'Button1'
layout: (LayoutFrame 0 0 0 0 13 0 0 1)
activeHelpKey: hideToolBar
level: 0
hasCharacterOrientedLabel: false
translateLabel: true
model: hideBookmarkBar
postBuildCallback: hideToolBarButtonCreated:
)
(SubCanvasSpec
name: 'Bookmarks'
layout: (LayoutFrame 13 0 2 0 0 1 -1 1)
level: 0
hasHorizontalScrollBar: false
hasVerticalScrollBar: false
miniScrollerHorizontal: false
majorKey: BookmarkBar
subAspectHolders:
(Array
(SubChannelInfoSpec
subAspect: bookmarkHolder
aspect: bookmarkHolder
)
(SubChannelInfoSpec
subAspect: bookmarksHolder
aspect: bookmarkListHolder
)
)
createNewApplication: true
createNewBuilder: true
)
)
)
)
)
)
)
!
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:Tools::NewSystemBrowser andSelector:#chainBrowserSpec
Tools::NewSystemBrowser new openInterface:#chainBrowserSpec
"
<resource: #canvas>
^
#(FullSpec
name: chainBrowserSpec
window:
(WindowSpec
label: 'MethodBrowser'
name: 'MethodBrowser'
min: (Point 0 0)
bounds: (Rectangle 0 0 462 300)
)
component:
(SpecCollection
collection: (
(SubCanvasSpec
name: 'MessagePane'
layout: (LayoutFrame 0 0 0 0 0 1 40 0)
initiallyInvisible: true
hasHorizontalScrollBar: false
hasVerticalScrollBar: false
clientKey: inlineMessageApp
createNewBuilder: false
postBuildCallback: postBuildMessagePane:
)
(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'
barWidth: 2
showHandle: false
component:
(SpecCollection
collection: (
(SubCanvasSpec
name: 'MethodList1'
majorKey: MethodList
subAspectHolders:
(Array
(SubChannelInfoSpec
subAspect: doubleClickChannel
callBack: methodDoubleClicked1
)
(SubChannelInfoSpec
subAspect: environmentHolder
aspect: environmentHolder
)
(SubChannelInfoSpec
subAspect: immediateUpdate
aspect: immediateUpdate
)
(SubChannelInfoSpec
subAspect: inGeneratorHolder
aspect: selectorListGenerator1
)
(SubChannelInfoSpec
subAspect: menuHolder
aspect: selectorPopUpMenu
)
(SubChannelInfoSpec
subAspect: packageFilter
aspect: packageFilter
)
(SubChannelInfoSpec
subAspect: selectedMethods
aspect: selectedMethods1
callBack: methodsSelectionChanged1
)
(SubChannelInfoSpec
subAspect: selectionChangeCondition
aspect: selectionChangeConditionHolder
)
(SubChannelInfoSpec
subAspect: showCoverageInformation
aspect: showCoverageInformation
)
(SubChannelInfoSpec
subAspect: showMethodComplexity
aspect: showMethodComplexity
)
(SubChannelInfoSpec
subAspect: showMethodInheritance
aspect: showMethodInheritance
)
(SubChannelInfoSpec
subAspect: showMethodTypeIcon
aspect: showMethodTypeIcon
)
(SubChannelInfoSpec
subAspect: showSyntheticMethods
aspect: showSyntheticMethods
)
(SubChannelInfoSpec
subAspect: sortBy
aspect: sortBy
)
)
createNewApplication: true
createNewBuilder: true
)
(SubCanvasSpec
name: 'MethodList2'
majorKey: MethodList
subAspectHolders:
(Array
(SubChannelInfoSpec
subAspect: doubleClickChannel
callBack: methodDoubleClicked2
)
(SubChannelInfoSpec
subAspect: environmentHolder
aspect: environmentHolder
)
(SubChannelInfoSpec
subAspect: immediateUpdate
aspect: immediateUpdate
)
(SubChannelInfoSpec
subAspect: inGeneratorHolder
aspect: selectorListGenerator2
)
(SubChannelInfoSpec
subAspect: menuHolder
aspect: selectorPopUpMenu
)
(SubChannelInfoSpec
subAspect: packageFilter
aspect: packageFilter
)
(SubChannelInfoSpec
subAspect: selectedMethods
aspect: selectedMethods2
callBack: methodsSelectionChanged2
)
(SubChannelInfoSpec
subAspect: selectionChangeCondition
aspect: selectionChangeConditionHolder
)
(SubChannelInfoSpec
subAspect: showCoverageInformation
aspect: showCoverageInformation
)
(SubChannelInfoSpec
subAspect: showMethodComplexity
aspect: showMethodComplexity
)
(SubChannelInfoSpec
subAspect: showMethodInheritance
aspect: showMethodInheritance
)
(SubChannelInfoSpec
subAspect: showMethodTypeIcon
aspect: showMethodTypeIcon
)
(SubChannelInfoSpec
subAspect: showSyntheticMethods
aspect: showSyntheticMethods
)
(SubChannelInfoSpec
subAspect: sortBy
aspect: sortBy
)
)
createNewApplication: true
createNewBuilder: true
)
(SubCanvasSpec
name: 'MethodList3'
majorKey: MethodList
subAspectHolders:
(Array
(SubChannelInfoSpec
subAspect: doubleClickChannel
callBack: methodDoubleClicked3
)
(SubChannelInfoSpec
subAspect: environmentHolder
aspect: environmentHolder
)
(SubChannelInfoSpec
subAspect: immediateUpdate
aspect: immediateUpdate
)
(SubChannelInfoSpec
subAspect: inGeneratorHolder
aspect: selectorListGenerator3
)
(SubChannelInfoSpec
subAspect: menuHolder
aspect: selectorPopUpMenu
)
(SubChannelInfoSpec
subAspect: packageFilter
aspect: packageFilter
)
(SubChannelInfoSpec
subAspect: selectedMethods
aspect: selectedMethods3
callBack: methodsSelectionChanged3
)
(SubChannelInfoSpec
subAspect: selectionChangeCondition
aspect: selectionChangeConditionHolder
)
(SubChannelInfoSpec
subAspect: showCoverageInformation
aspect: showCoverageInformation
)
(SubChannelInfoSpec
subAspect: showMethodComplexity
aspect: showMethodComplexity
)
(SubChannelInfoSpec
subAspect: showMethodInheritance
aspect: showMethodInheritance
)
(SubChannelInfoSpec
subAspect: showMethodTypeIcon
aspect: showMethodTypeIcon
)
(SubChannelInfoSpec
subAspect: showSyntheticMethods
aspect: showSyntheticMethods
)
(SubChannelInfoSpec
subAspect: sortBy
aspect: sortBy
)
)
createNewApplication: true
createNewBuilder: true
)
(SubCanvasSpec
name: 'MethodList4'
majorKey: MethodList
subAspectHolders:
(Array
(SubChannelInfoSpec
subAspect: doubleClickChannel
callBack: methodDoubleClicked4
)
(SubChannelInfoSpec
subAspect: environmentHolder
aspect: environmentHolder
)
(SubChannelInfoSpec
subAspect: immediateUpdate
aspect: immediateUpdate
)
(SubChannelInfoSpec
subAspect: inGeneratorHolder
aspect: selectorListGenerator4
)
(SubChannelInfoSpec
subAspect: menuHolder
aspect: selectorPopUpMenu
)
(SubChannelInfoSpec
subAspect: packageFilter
aspect: packageFilter
)
(SubChannelInfoSpec
subAspect: selectedMethods
aspect: selectedMethods4
callBack: methodsSelectionChanged4
)
(SubChannelInfoSpec
subAspect: selectionChangeCondition
aspect: selectionChangeConditionHolder
)
(SubChannelInfoSpec
subAspect: showCoverageInformation
aspect: showCoverageInformation
)
(SubChannelInfoSpec
subAspect: showMethodComplexity
aspect: showMethodComplexity
)
(SubChannelInfoSpec
subAspect: showMethodInheritance
aspect: showMethodInheritance
)
(SubChannelInfoSpec
subAspect: showMethodTypeIcon
aspect: showMethodTypeIcon
)
(SubChannelInfoSpec
subAspect: showSyntheticMethods
aspect: showSyntheticMethods
)
(SubChannelInfoSpec
subAspect: sortBy
aspect: sortBy
)
)
createNewApplication: true
createNewBuilder: true
)
)
)
handles: (Any 0.25 0.5 0.75 1.0)
)
(SubCanvasSpec
name: 'CodePane'
autoHideScrollBars: false
majorKey: NewSystemBrowser
minorKey: codePaneSpec
createNewBuilder: false
)
)
)
handles: (Any 0.5 1.0)
postBuildCallback: postBuildTabContentView:
)
)
)
)
"Modified: / 25-03-2014 / 18:00:56 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
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:Tools::NewSystemBrowser andSelector:#classDocumentationBrowserSpec
Tools::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 0 0 462 300)
)
component:
(SpecCollection
collection: (
(VariableVerticalPanelSpec
name: 'VariableVerticalPanel1'
layout: (LayoutFrame 0 0.0 0 0.0 0 1.0 0 1.0)
showHandle: false
snapMode: both
handlePosition: left
component:
(SpecCollection
collection: (
(SubCanvasSpec
name: 'Navigator'
majorKey: NavigatorCanvas
minorKey: categoryAndSingleClassOnlySpec
subAspectHolders:
(Array
(SubChannelInfoSpec
subAspect: environmentHolder
aspect: environmentHolder
)
)
createNewBuilder: false
)
(HTMLViewSpec
name: 'HTMLBrowser1'
hasHorizontalScrollBar: true
hasVerticalScrollBar: true
htmlText: classDocumentationHolder
)
)
)
handles: (Any 0.5 1.0)
)
)
)
)
!
codePaneSpec
"This resource specification was automatically generated
by the UIPainter of ST/X."
"Do not manually edit this!! If it is corrupted,
the UIPainter may not be able to read the specification."
"
UIPainter new openOnClass:Tools::NewSystemBrowser andSelector:#codePaneSpec
Tools::NewSystemBrowser new openInterface:#codePaneSpec
"
<resource: #canvas>
^
#(FullSpec
name: codePaneSpec
window:
(WindowSpec
label: 'SystemBrowser'
name: 'SystemBrowser'
min: (Point 0 0)
bounds: (Rectangle 0 0 998 535)
icon: defaultIcon
)
component:
(SpecCollection
collection: (
(VariableHorizontalPanelSpec
name: 'EditorAndBrowsletBox'
layout: (LayoutFrame 0 0 0 0 0 1 0 1)
component:
(SpecCollection
collection: (
(ViewSpec
name: 'EditorBox'
component:
(SpecCollection
collection: (
(NoteBookViewSpec
name: 'EditorNoteBook'
layout: (LayoutFrame 0 0 0 0 0 1 -26 1)
level: 0
model: selectedEditorNoteBookTabIndexHolder
menu: editorNoteBookListHolder
useIndex: true
translateLabel: false
canvas: editorNoteBookCanvasHolder
keepCanvasAlive: true
postBuildCallback: postBuildEditorNoteBook:
)
(SubCanvasSpec
name: 'StringSearchToolCanvas'
layout: (LayoutFrame 0 0 -24 1 0 1 0 1)
visibilityChannel: stringSearchToolVisibleHolder
hasHorizontalScrollBar: false
hasVerticalScrollBar: false
majorKey: StringSearchToolForTextView
createNewApplication: true
createNewBuilder: false
postBuildCallback: postBuildStringSearchTool:
)
)
)
)
)
)
handles: (Any 1.0)
postBuildCallback: postBuildCodePaneAndPluginView:
)
(ViewSpec
name: 'InfoBox'
layout: (LayoutFrame 0 0 -24 1 -16 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: (
(LinkButtonSpec
label: 'Info'
name: 'InfoLabel'
activeHelpKey: infoLabelHelp
level: -1
translateLabel: true
labelChannel: infoLabelHolder
adjust: left
)
(HorizontalPanelViewSpec
name: 'PackageInfoPanel'
activeHelpKey: packageInfoLabel
level: -1
horizontalLayout: rightSpaceFit
verticalLayout: fitSpace
horizontalSpace: 0
verticalSpace: 0
elementsChangeSize: true
component:
(SpecCollection
collection: (
(LabelSpec
label: 'Package'
name: 'PackageLabel'
activeHelpKey: packageInfoLabel
level: 0
backgroundChannel: packageInfoBackgroundColorHolder
translateLabel: true
labelChannel: packageLabelHolder
adjust: left
useDefaultExtent: true
)
(ActionButtonSpec
label: 'Info'
name: 'PackageInfoButton'
level: 0
initiallyInvisible: true
backgroundChannel: packageInfoBackgroundColorHolder
foregroundColor: (Color 0.0 0.0 100.0)
translateLabel: true
resizeForLabel: true
extent: (Point 36 23)
postBuildCallback: postBuildPackageInfoButton:
)
)
)
)
)
)
handles: (Any 0.5 1.0)
)
(LabelSpec
name: 'ModeLabel'
layout: (LayoutFrame -60 1 0 0.0 -50 1 0 1.0)
activeHelpKey: modeLabel
level: -1
translateLabel: true
labelChannel: modeLabelHolder
postBuildCallback: postBuildEditModeInfoLabel:
)
(LabelSpec
name: 'CursorLineAndColumnLabel'
layout: (LayoutFrame -50 1 0 0.0 0 1 0 1.0)
activeHelpKey: lineAndColumnLabel
level: -1
translateLabel: false
labelChannel: cursorLineAndColumnLabelHolder
adjust: left
)
)
)
keepSpaceForOSXResizeHandleH: true
)
)
)
)
!
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:Tools::NewSystemBrowser andSelector:#fullBrowserSpec
Tools::NewSystemBrowser new openInterface:#fullBrowserSpec
"
<resource: #canvas>
^
#(FullSpec
name: fullBrowserSpec
window:
(WindowSpec
label: 'SystemBrowser'
name: 'SystemBrowser'
min: (Point 0 0)
bounds: (Rectangle 0 0 462 300)
icon: defaultIcon
)
component:
(SpecCollection
collection: (
(SubCanvasSpec
name: 'MessagePane'
layout: (LayoutFrame 0 0 0 0 0 1 40 0)
initiallyInvisible: true
hasHorizontalScrollBar: false
hasVerticalScrollBar: false
clientKey: inlineMessageApp
createNewBuilder: false
postBuildCallback: postBuildMessagePane:
)
(VariableVerticalPanelSpec
name: 'VariableVerticalPanel1'
layout: (LayoutFrame 0 0.0 0 0.0 0 1.0 0 1.0)
barWidth: 2
showHandle: false
snapMode: both
handlePosition: left
component:
(SpecCollection
collection: (
(SubCanvasSpec
name: 'Navigator'
autoHideScrollBars: false
majorKey: NavigatorCanvas
minorKey: windowSpec
subAspectHolders:
(Array
(SubChannelInfoSpec
subAspect: environmentHolder
aspect: environmentHolder
)
)
createNewBuilder: false
)
(SubCanvasSpec
name: 'CodePane'
autoHideScrollBars: false
majorKey: NewSystemBrowser
minorKey: codePaneSpec
createNewBuilder: false
)
)
)
handles: (Any 0.5 1.0)
postBuildCallback: postBuildTabContentView:
)
)
)
)
"Modified: / 25-03-2014 / 18:01:05 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
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:Tools::NewSystemBrowser andSelector:#fullClassSourceBrowserSpec
Tools::NewSystemBrowser new openInterface:#fullClassSourceBrowserSpec
"
<resource: #canvas>
^
#(FullSpec
name: fullClassSourceBrowserSpec
window:
(WindowSpec
label: 'Full Class Browser'
name: 'Full Class Browser'
min: (Point 0 0)
bounds: (Rectangle 0 0 462 300)
)
component:
(SpecCollection
collection: (
(SubCanvasSpec
name: 'MessagePane'
layout: (LayoutFrame 0 0 0 0 0 1 40 0)
initiallyInvisible: true
hasHorizontalScrollBar: false
hasVerticalScrollBar: false
clientKey: inlineMessageApp
createNewBuilder: false
postBuildCallback: postBuildMessagePane:
)
(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'
majorKey: NavigatorCanvas
minorKey: categoryAndSingleClassOnlySpec
subAspectHolders:
(Array
(SubChannelInfoSpec
subAspect: environmentHolder
aspect: environmentHolder
)
)
createNewBuilder: false
)
(SubCanvasSpec
name: 'CodePane'
autoHideScrollBars: false
majorKey: NewSystemBrowser
minorKey: codePaneSpec
createNewBuilder: false
)
)
)
handles: (Any 0.3 1.0)
postBuildCallback: postBuildTabContentView:
)
)
)
)
"Modified: / 25-03-2014 / 18:01:20 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
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:Tools::NewSystemBrowser andSelector:#methodListBrowserSpec
Tools::NewSystemBrowser new openInterface:#methodListBrowserSpec
"
<resource: #canvas>
^
#(FullSpec
name: methodListBrowserSpec
window:
(WindowSpec
label: 'MethodListBrowser'
name: 'MethodListBrowser'
min: (Point 0 0)
bounds: (Rectangle 0 0 462 300)
)
component:
(SpecCollection
collection: (
(SubCanvasSpec
name: 'MessagePane'
layout: (LayoutFrame 0 0 0 0 0 1 40 0)
initiallyInvisible: true
hasHorizontalScrollBar: false
hasVerticalScrollBar: false
clientKey: inlineMessageApp
createNewBuilder: false
postBuildCallback: postBuildMessagePane:
)
(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: (
(VerticalPanelViewSpec
name: 'VerticalPanel1'
horizontalLayout: fit
verticalLayout: bottomFit
horizontalSpace: 3
verticalSpace: 3
component:
(SpecCollection
collection: (
(SubCanvasSpec
name: 'MethodList'
majorKey: MethodList
subAspectHolders:
(Array
(SubChannelInfoSpec
subAspect: doubleClickChannel
callBack: methodDoubleClicked
)
(SubChannelInfoSpec
subAspect: environmentHolder
aspect: environmentHolder
)
(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
)
(SubChannelInfoSpec
subAspect: showCoverageInformation
aspect: showCoverageInformation
)
(SubChannelInfoSpec
subAspect: showMethodComplexity
aspect: showMethodComplexity
)
(SubChannelInfoSpec
subAspect: showSyntheticMethods
aspect: showSyntheticMethods
)
(SubChannelInfoSpec
subAspect: showMethodInheritance
aspect: showMethodInheritance
)
(SubChannelInfoSpec
subAspect: showMethodTypeIcon
aspect: showMethodTypeIcon
)
(SubChannelInfoSpec
subAspect: sortBy
aspect: sortBy
)
)
createNewApplication: true
createNewBuilder: true
extent: (Point 462 93)
)
(SubCanvasSpec
name: 'TestRunnerEmbedded'
initiallyInvisible: true
visibilityChannel: testRunnerVisibleHolder
hasHorizontalScrollBar: false
hasVerticalScrollBar: false
majorKey: #'Tools::TestRunnerEmbedded'
subAspectHolders:
(Array
(SubChannelInfoSpec
subAspect: infoHolder
aspect: infoLabelHolder
)
(SubChannelInfoSpec
subAspect: methodGeneratorHolder
aspect: selectorListGenerator
)
(SubChannelInfoSpec
subAspect: selectedClassesHolder
aspect: selectedClasses
)
(SubChannelInfoSpec
subAspect: selectedMethodsHolder
aspect: selectedMethods
)
(SubChannelInfoSpec
subAspect: selectedProtocolsHolder
aspect: selectedProtocols
)
)
createNewApplication: true
createNewBuilder: true
extent: (Point 462 50)
)
)
)
)
(SubCanvasSpec
name: 'CodePane'
autoHideScrollBars: false
majorKey: NewSystemBrowser
minorKey: codePaneSpec
createNewBuilder: false
)
)
)
handles: (Any 0.5 1.0)
postBuildCallback: postBuildTabContentView:
)
)
)
)
!
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:Tools::NewSystemBrowser andSelector:#multipleCategoryBrowserSpec
Tools::NewSystemBrowser new openInterface:#multipleCategoryBrowserSpec
"
<resource: #canvas>
^
#(FullSpec
name: multipleCategoryBrowserSpec
window:
(WindowSpec
label: 'CategoryBrowser'
name: 'CategoryBrowser'
min: (Point 0 0)
bounds: (Rectangle 0 0 462 300)
)
component:
(SpecCollection
collection: (
(SubCanvasSpec
name: 'MessagePane'
layout: (LayoutFrame 0 0 0 0 0 1 40 0)
initiallyInvisible: true
hasHorizontalScrollBar: false
hasVerticalScrollBar: false
clientKey: inlineMessageApp
createNewBuilder: false
postBuildCallback: postBuildMessagePane:
)
(VariableVerticalPanelSpec
name: 'VariableVerticalPanel1'
layout: (LayoutFrame 0 0.0 0 0.0 0 1.0 0 1.0)
showHandle: false
snapMode: both
handlePosition: left
component:
(SpecCollection
collection: (
(SubCanvasSpec
name: 'Navigator'
autoHideScrollBars: false
majorKey: NavigatorCanvas
minorKey: multipleCategoryBrowserSpec
subAspectHolders:
(Array
(SubChannelInfoSpec
subAspect: environmentHolder
aspect: environmentHolder
)
)
createNewBuilder: false
)
(SubCanvasSpec
name: 'CodePane'
autoHideScrollBars: false
majorKey: NewSystemBrowser
minorKey: codePaneSpec
createNewBuilder: false
)
)
)
handles: (Any 0.3 1.0)
postBuildCallback: postBuildTabContentView:
)
)
)
)
"Modified: / 25-03-2014 / 18:01:33 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
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:Tools::NewSystemBrowser andSelector:#multipleClassBrowserSpec
Tools::NewSystemBrowser new openInterface:#multipleClassBrowserSpec
"
<resource: #canvas>
^
#(FullSpec
name: multipleClassBrowserSpec
window:
(WindowSpec
label: 'ClassBrowser'
name: 'ClassBrowser'
min: (Point 0 0)
bounds: (Rectangle 0 0 462 300)
)
component:
(SpecCollection
collection: (
(SubCanvasSpec
name: 'MessagePane'
layout: (LayoutFrame 0 0 0 0 0 1 40 0)
initiallyInvisible: true
hasHorizontalScrollBar: false
hasVerticalScrollBar: false
clientKey: inlineMessageApp
createNewBuilder: false
postBuildCallback: postBuildMessagePane:
)
(VariableVerticalPanelSpec
name: 'VariableVerticalPanel1'
layout: (LayoutFrame 0 0.0 0 0.0 0 1.0 0 1.0)
showHandle: false
snapMode: both
handlePosition: left
component:
(SpecCollection
collection: (
(SubCanvasSpec
name: 'Navigator'
autoHideScrollBars: false
majorKey: NavigatorCanvas
minorKey: multipleClassBrowserSpec
subAspectHolders:
(Array
(SubChannelInfoSpec
subAspect: environmentHolder
aspect: environmentHolder
)
)
createNewBuilder: false
)
(SubCanvasSpec
name: 'CodePane'
autoHideScrollBars: false
majorKey: NewSystemBrowser
minorKey: codePaneSpec
createNewBuilder: false
)
)
)
handles: (Any 0.5 1.0)
postBuildCallback: postBuildTabContentView:
)
)
)
)
"Modified: / 25-03-2014 / 18:01:39 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
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:Tools::NewSystemBrowser andSelector:#multipleClassExtensionBrowserSpec
Tools::NewSystemBrowser new openInterface:#multipleClassExtensionBrowserSpec
"
<resource: #canvas>
^
#(FullSpec
name: multipleClassExtensionBrowserSpec
window:
(WindowSpec
label: 'ClassExtensionBrowser'
name: 'ClassExtensionBrowser'
min: (Point 0 0)
bounds: (Rectangle 0 0 462 300)
)
component:
(SpecCollection
collection: (
(SubCanvasSpec
name: 'MessagePane'
layout: (LayoutFrame 0 0 0 0 0 1 40 0)
initiallyInvisible: true
hasHorizontalScrollBar: false
hasVerticalScrollBar: false
clientKey: inlineMessageApp
createNewBuilder: false
postBuildCallback: postBuildMessagePane:
)
(VariableVerticalPanelSpec
name: 'VariableVerticalPanel1'
layout: (LayoutFrame 0 0.0 0 0.0 0 1.0 0 1.0)
showHandle: false
snapMode: both
handlePosition: left
component:
(SpecCollection
collection: (
(SubCanvasSpec
name: 'Navigator'
autoHideScrollBars: false
majorKey: NavigatorCanvas
minorKey: multipleClassExtensionBrowserSpec
subAspectHolders:
(Array
(SubChannelInfoSpec
subAspect: environmentHolder
aspect: environmentHolder
)
)
createNewBuilder: false
)
(SubCanvasSpec
name: 'CodePane'
autoHideScrollBars: false
majorKey: NewSystemBrowser
minorKey: codePaneSpec
createNewBuilder: false
)
)
)
handles: (Any 0.3 1.0)
postBuildCallback: postBuildTabContentView:
)
)
)
)
"Modified: / 25-03-2014 / 18:01:46 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
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:Tools::NewSystemBrowser andSelector:#multipleClassRepositoryDiffBrowserSpec
Tools::NewSystemBrowser new openInterface:#multipleClassRepositoryDiffBrowserSpec
"
<resource: #canvas>
^
#(FullSpec
name: multipleClassRepositoryDiffBrowserSpec
window:
(WindowSpec
label: 'ClassBrowser'
name: 'ClassBrowser'
min: (Point 0 0)
bounds: (Rectangle 0 0 462 300)
)
component:
(SpecCollection
collection: (
(VariableVerticalPanelSpec
name: 'VariableVerticalPanel1'
layout: (LayoutFrame 0 0.0 0 0.0 0 1.0 0 1.0)
showHandle: false
snapMode: both
handlePosition: left
component:
(SpecCollection
collection: (
(SubCanvasSpec
name: 'Navigator'
autoHideScrollBars: false
majorKey: NavigatorCanvas
minorKey: multipleClassDiffBrowserSpec
subAspectHolders:
(Array
(SubChannelInfoSpec
subAspect: environmentHolder
aspect: environmentHolder
)
)
createNewBuilder: false
)
(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:Tools::NewSystemBrowser andSelector:#multipleClassWithInfoAndMethodWithInfoBrowserSpec
Tools::NewSystemBrowser new openInterface:#multipleClassWithInfoAndMethodWithInfoBrowserSpec
"
<resource: #canvas>
^
#(FullSpec
name: multipleClassWithInfoAndMethodWithInfoBrowserSpec
window:
(WindowSpec
label: 'MethodBrowser'
name: 'MethodBrowser'
min: (Point 0 0)
bounds: (Rectangle 0 0 462 300)
)
component:
(SpecCollection
collection: (
(SubCanvasSpec
name: 'MessagePane'
layout: (LayoutFrame 0 0 0 0 0 1 40 0)
initiallyInvisible: true
hasHorizontalScrollBar: false
hasVerticalScrollBar: false
clientKey: inlineMessageApp
createNewBuilder: false
postBuildCallback: postBuildMessagePane:
)
(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: 'ClassList'
majorKey: ClassList
subAspectHolders:
(Array
(SubChannelInfoSpec
subAspect: doubleClickChannel
callBack: classDoubleClicked
)
(SubChannelInfoSpec
subAspect: environmentHolder
aspect: environmentHolder
)
(SubChannelInfoSpec
subAspect: immediateUpdate
aspect: immediateUpdate
)
(SubChannelInfoSpec
subAspect: inGeneratorHolder
aspect: classListGenerator
)
(SubChannelInfoSpec
subAspect: menuHolder
aspect: classMenu
)
(SubChannelInfoSpec
subAspect: meta
aspect: meta
)
(SubChannelInfoSpec
subAspect: selectedClasses
aspect: selectedClasses
callBack: classSelectionChanged
)
(SubChannelInfoSpec
subAspect: selectionChangeCondition
aspect: selectionChangeConditionHolder
)
(SubChannelInfoSpec
subAspect: showCoverageInformation
aspect: showCoverageInformation
)
)
createNewApplication: true
createNewBuilder: true
)
(SubCanvasSpec
name: 'MethodList'
majorKey: MethodList
subAspectHolders:
(Array
(SubChannelInfoSpec
subAspect: doubleClickChannel
callBack: methodDoubleClicked
)
(SubChannelInfoSpec
subAspect: environmentHolder
aspect: environmentHolder
)
(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
)
(SubChannelInfoSpec
subAspect: showSyntheticMethods
aspect: showSyntheticMethods
)
(SubChannelInfoSpec
subAspect: showCoverageInformation
aspect: showCoverageInformation
)
)
createNewApplication: true
createNewBuilder: true
)
(TextEditorSpec
name: 'MethodInfoView'
model: methodInfo
hasHorizontalScrollBar: true
hasVerticalScrollBar: true
autoHideScrollBars: true
isReadOnly: true
hasKeyboardFocusInitially: false
)
(SubCanvasSpec
name: 'CodePane'
autoHideScrollBars: false
majorKey: NewSystemBrowser
minorKey: codePaneSpec
createNewBuilder: false
)
)
)
handles: (Any 0.1 0.25 0.5 1.0)
postBuildCallback: postBuildTabContentView:
)
)
)
)
"Modified: / 25-03-2014 / 18:01:53 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
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:Tools::NewSystemBrowser andSelector:#multipleClassWithInfoBrowserSpec
Tools::NewSystemBrowser new openInterface:#multipleClassWithInfoBrowserSpec
"
<resource: #canvas>
^
#(FullSpec
name: multipleClassWithInfoBrowserSpec
window:
(WindowSpec
label: 'MethodBrowser'
name: 'MethodBrowser'
min: (Point 0 0)
bounds: (Rectangle 0 0 462 300)
)
component:
(SpecCollection
collection: (
(SubCanvasSpec
name: 'MessagePane'
layout: (LayoutFrame 0 0 0 0 0 1 40 0)
initiallyInvisible: true
hasHorizontalScrollBar: false
hasVerticalScrollBar: false
clientKey: inlineMessageApp
createNewBuilder: false
postBuildCallback: postBuildMessagePane:
)
(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: 'ClassList'
majorKey: ClassList
subAspectHolders:
(Array
(SubChannelInfoSpec
subAspect: doubleClickChannel
callBack: classDoubleClicked
)
(SubChannelInfoSpec
subAspect: environmentHolder
aspect: environmentHolder
)
(SubChannelInfoSpec
subAspect: immediateUpdate
aspect: immediateUpdate
)
(SubChannelInfoSpec
subAspect: inGeneratorHolder
aspect: classListGenerator
)
(SubChannelInfoSpec
subAspect: menuHolder
aspect: classMenu
)
(SubChannelInfoSpec
subAspect: meta
aspect: meta
)
(SubChannelInfoSpec
subAspect: selectedClasses
aspect: selectedClasses
callBack: classSelectionChanged
)
(SubChannelInfoSpec
subAspect: selectionChangeCondition
aspect: selectionChangeConditionHolder
)
)
createNewApplication: true
createNewBuilder: true
)
(TextEditorSpec
name: 'MethodInfoView'
model: methodInfo
hasHorizontalScrollBar: true
hasVerticalScrollBar: true
autoHideScrollBars: true
isReadOnly: true
hasKeyboardFocusInitially: false
)
(SubCanvasSpec
name: 'CodePane'
autoHideScrollBars: false
majorKey: NewSystemBrowser
minorKey: codePaneSpec
createNewBuilder: false
)
)
)
handles: (Any 0.25 0.5 1.0)
postBuildCallback: postBuildTabContentView:
)
)
)
)
"Modified: / 25-03-2014 / 18:02:00 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
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:Tools::NewSystemBrowser andSelector:#multipleFullProtocolBrowserSpec
Tools::NewSystemBrowser new openInterface:#multipleFullProtocolBrowserSpec
"
<resource: #canvas>
^
#(FullSpec
name: multipleFullProtocolBrowserSpec
window:
(WindowSpec
label: 'ProtocolBrowser'
name: 'ProtocolBrowser'
min: (Point 0 0)
bounds: (Rectangle 0 0 462 300)
)
component:
(SpecCollection
collection: (
(SubCanvasSpec
name: 'MessagePane'
layout: (LayoutFrame 0 0 0 0 0 1 40 0)
initiallyInvisible: true
hasHorizontalScrollBar: false
hasVerticalScrollBar: false
clientKey: inlineMessageApp
createNewBuilder: false
postBuildCallback: postBuildMessagePane:
)
(VariableVerticalPanelSpec
name: 'VariableVerticalPanel1'
layout: (LayoutFrame 0 0.0 0 0.0 0 1.0 0 1.0)
showHandle: false
snapMode: both
handlePosition: left
component:
(SpecCollection
collection: (
(SubCanvasSpec
name: 'Navigator'
autoHideScrollBars: false
majorKey: NavigatorCanvas
minorKey: multipleFullProtocolBrowserSpec
subAspectHolders:
(Array
(SubChannelInfoSpec
subAspect: environmentHolder
aspect: environmentHolder
)
)
createNewBuilder: false
)
(SubCanvasSpec
name: 'CodePane'
autoHideScrollBars: false
majorKey: NewSystemBrowser
minorKey: codePaneSpec
createNewBuilder: false
)
)
)
handles: (Any 0.3 1.0)
postBuildCallback: postBuildTabContentView:
)
)
)
)
"Modified: / 25-03-2014 / 18:02:05 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
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:Tools::NewSystemBrowser andSelector:#multipleMethodBrowserSpec
Tools::NewSystemBrowser new openInterface:#multipleMethodBrowserSpec
"
<resource: #canvas>
^
#(FullSpec
name: multipleMethodBrowserSpec
window:
(WindowSpec
label: 'MethodBrowser'
name: 'MethodBrowser'
min: (Point 0 0)
bounds: (Rectangle 0 0 462 300)
)
component:
(SpecCollection
collection: (
(SubCanvasSpec
name: 'MessagePane'
layout: (LayoutFrame 0 0 0 0 0 1 40 0)
initiallyInvisible: true
hasHorizontalScrollBar: false
hasVerticalScrollBar: false
clientKey: inlineMessageApp
createNewBuilder: false
postBuildCallback: postBuildMessagePane:
)
(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: (
(VerticalPanelViewSpec
name: 'VerticalPanel1'
horizontalLayout: fit
verticalLayout: bottomFit
horizontalSpace: 3
verticalSpace: 3
component:
(SpecCollection
collection: (
(SubCanvasSpec
name: 'MethodList'
majorKey: MethodList
subAspectHolders:
(Array
(SubChannelInfoSpec
subAspect: doubleClickChannel
callBack: methodDoubleClicked
)
(SubChannelInfoSpec
subAspect: environmentHolder
aspect: environmentHolder
)
(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: showCoverageInformation
aspect: showCoverageInformation
)
(SubChannelInfoSpec
subAspect: showMethodComplexity
aspect: showMethodComplexity
)
(SubChannelInfoSpec
subAspect: showMethodInheritance
aspect: showMethodInheritance
)
(SubChannelInfoSpec
subAspect: showMethodTypeIcon
aspect: showMethodTypeIcon
)
(SubChannelInfoSpec
subAspect: showSyntheticMethods
aspect: showSyntheticMethods
)
(SubChannelInfoSpec
subAspect: sortBy
aspect: sortBy
)
(SubChannelInfoSpec
subAspect: variableFilter
aspect: variableFilter
)
)
createNewApplication: true
createNewBuilder: true
extent: (Point 462 93)
)
(SubCanvasSpec
name: 'TestRunnerEmbedded'
initiallyInvisible: true
visibilityChannel: testRunnerVisibleHolder
hasHorizontalScrollBar: false
hasVerticalScrollBar: false
majorKey: #'Tools::TestRunnerEmbedded'
subAspectHolders:
(Array
(SubChannelInfoSpec
subAspect: infoHolder
aspect: infoLabelHolder
)
(SubChannelInfoSpec
subAspect: methodGeneratorHolder
aspect: selectorListGenerator
)
(SubChannelInfoSpec
subAspect: selectedClassesHolder
aspect: selectedClasses
)
(SubChannelInfoSpec
subAspect: selectedMethodsHolder
aspect: selectedMethods
)
(SubChannelInfoSpec
subAspect: selectedProtocolsHolder
aspect: selectedProtocols
)
)
createNewApplication: true
createNewBuilder: true
extent: (Point 462 50)
)
)
)
)
(SubCanvasSpec
name: 'CodePane'
autoHideScrollBars: false
majorKey: NewSystemBrowser
minorKey: codePaneSpec
createNewBuilder: false
)
)
)
handles: (Any 0.5 1.0)
postBuildCallback: postBuildTabContentView:
)
)
)
)
!
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:Tools::NewSystemBrowser andSelector:#multipleMethodWithInfoBrowserSpec
Tools::NewSystemBrowser new openInterface:#multipleMethodWithInfoBrowserSpec
"
<resource: #canvas>
^
#(FullSpec
name: multipleMethodWithInfoBrowserSpec
window:
(WindowSpec
label: 'MethodBrowser'
name: 'MethodBrowser'
min: (Point 0 0)
bounds: (Rectangle 0 0 462 300)
)
component:
(SpecCollection
collection: (
(SubCanvasSpec
name: 'MessagePane'
layout: (LayoutFrame 0 0 0 0 0 1 40 0)
initiallyInvisible: true
hasHorizontalScrollBar: false
hasVerticalScrollBar: false
clientKey: inlineMessageApp
createNewBuilder: false
postBuildCallback: postBuildMessagePane:
)
(VariableVerticalPanelSpec
name: 'VariableVerticalPanel1'
layout: (LayoutFrame 0 0.0 0 0.0 0 1.0 0 1.0)
showHandle: false
snapMode: both
handlePosition: left
component:
(SpecCollection
collection: (
(SubCanvasSpec
name: 'MethodList'
majorKey: MethodList
subAspectHolders:
(Array
(SubChannelInfoSpec
subAspect: doubleClickChannel
callBack: methodDoubleClicked
)
(SubChannelInfoSpec
subAspect: environmentHolder
aspect: environmentHolder
)
(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
)
(SubChannelInfoSpec
subAspect: showCoverageInformation
aspect: showCoverageInformation
)
(SubChannelInfoSpec
subAspect: showMethodComplexity
aspect: showMethodComplexity
)
(SubChannelInfoSpec
subAspect: showSyntheticMethods
aspect: showSyntheticMethods
)
(SubChannelInfoSpec
subAspect: showMethodInheritance
aspect: showMethodInheritance
)
(SubChannelInfoSpec
subAspect: showMethodTypeIcon
aspect: showMethodTypeIcon
)
)
createNewApplication: true
createNewBuilder: true
)
(TextEditorSpec
name: 'MethodInfoView'
model: methodInfo
hasHorizontalScrollBar: true
hasVerticalScrollBar: true
autoHideScrollBars: true
isReadOnly: true
hasKeyboardFocusInitially: false
)
(SubCanvasSpec
name: 'CodePane'
autoHideScrollBars: false
majorKey: NewSystemBrowser
minorKey: codePaneSpec
createNewBuilder: false
)
)
)
handles: (Any 0.25 0.5 1.0)
postBuildCallback: postBuildTabContentView:
)
)
)
)
"Modified: / 25-03-2014 / 18:02:25 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
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:Tools::NewSystemBrowser andSelector:#multipleNameSpaceBrowserSpec
Tools::NewSystemBrowser new openInterface:#multipleNameSpaceBrowserSpec
"
<resource: #canvas>
^
#(FullSpec
name: multipleNameSpaceBrowserSpec
window:
(WindowSpec
label: 'NameSpaceBrowser'
name: 'NameSpaceBrowser'
min: (Point 0 0)
bounds: (Rectangle 0 0 462 300)
)
component:
(SpecCollection
collection: (
(SubCanvasSpec
name: 'MessagePane'
layout: (LayoutFrame 0 0 0 0 0 1 40 0)
initiallyInvisible: true
hasHorizontalScrollBar: false
hasVerticalScrollBar: false
clientKey: inlineMessageApp
createNewBuilder: false
postBuildCallback: postBuildMessagePane:
)
(VariableVerticalPanelSpec
name: 'VariableVerticalPanel1'
layout: (LayoutFrame 0 0.0 0 0.0 0 1.0 0 1.0)
showHandle: false
snapMode: both
handlePosition: left
component:
(SpecCollection
collection: (
(SubCanvasSpec
name: 'Navigator'
autoHideScrollBars: false
majorKey: NavigatorCanvas
minorKey: multipleNameSpaceBrowserSpec
subAspectHolders:
(Array
(SubChannelInfoSpec
subAspect: environmentHolder
aspect: environmentHolder
)
)
createNewBuilder: false
)
(SubCanvasSpec
name: 'CodePane'
autoHideScrollBars: false
majorKey: NewSystemBrowser
minorKey: codePaneSpec
createNewBuilder: false
)
)
)
handles: (Any 0.3 1.0)
postBuildCallback: postBuildTabContentView:
)
)
)
)
"Modified: / 25-03-2014 / 18:02:31 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
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:Tools::NewSystemBrowser andSelector:#multipleNameSpaceFullBrowserSpec
Tools::NewSystemBrowser new openInterface:#multipleNameSpaceFullBrowserSpec
"
<resource: #canvas>
^
#(FullSpec
name: multipleNameSpaceFullBrowserSpec
window:
(WindowSpec
label: 'NameSpaceBrowser'
name: 'NameSpaceBrowser'
min: (Point 0 0)
bounds: (Rectangle 0 0 462 300)
)
component:
(SpecCollection
collection: (
(SubCanvasSpec
name: 'MessagePane'
layout: (LayoutFrame 0 0 0 0 0 1 40 0)
initiallyInvisible: true
hasHorizontalScrollBar: false
hasVerticalScrollBar: false
clientKey: inlineMessageApp
createNewBuilder: false
postBuildCallback: postBuildMessagePane:
)
(VariableVerticalPanelSpec
name: 'VariableVerticalPanel1'
layout: (LayoutFrame 0 0.0 0 0.0 0 1.0 0 1.0)
showHandle: false
snapMode: both
handlePosition: left
component:
(SpecCollection
collection: (
(SubCanvasSpec
name: 'Navigator'
autoHideScrollBars: false
majorKey: NavigatorCanvas
minorKey: multipleNameSpaceFullBrowserSpec
subAspectHolders:
(Array
(SubChannelInfoSpec
subAspect: environmentHolder
aspect: environmentHolder
)
)
createNewBuilder: false
)
(SubCanvasSpec
name: 'CodePane'
autoHideScrollBars: false
majorKey: NewSystemBrowser
minorKey: codePaneSpec
createNewBuilder: false
)
)
)
handles: (Any 0.3 1.0)
postBuildCallback: postBuildTabContentView:
)
)
)
)
"Modified: / 25-03-2014 / 18:02:38 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
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:Tools::NewSystemBrowser andSelector:#multipleProjectBrowserSpec
Tools::NewSystemBrowser new openInterface:#multipleProjectBrowserSpec
"
<resource: #canvas>
^
#(FullSpec
name: multipleProjectBrowserSpec
window:
(WindowSpec
label: 'ProjectBrowser'
name: 'ProjectBrowser'
min: (Point 0 0)
bounds: (Rectangle 0 0 462 300)
)
component:
(SpecCollection
collection: (
(SubCanvasSpec
name: 'MessagePane'
layout: (LayoutFrame 0 0 0 0 0 1 40 0)
initiallyInvisible: true
hasHorizontalScrollBar: false
hasVerticalScrollBar: false
clientKey: inlineMessageApp
createNewBuilder: false
postBuildCallback: postBuildMessagePane:
)
(VariableVerticalPanelSpec
name: 'VariableVerticalPanel1'
layout: (LayoutFrame 0 0.0 0 0.0 0 1.0 0 1.0)
showHandle: false
snapMode: both
handlePosition: left
component:
(SpecCollection
collection: (
(SubCanvasSpec
name: 'Navigator'
autoHideScrollBars: false
majorKey: NavigatorCanvas
minorKey: multipleProjectBrowserSpec
subAspectHolders:
(Array
(SubChannelInfoSpec
subAspect: environmentHolder
aspect: environmentHolder
)
)
createNewBuilder: false
)
(SubCanvasSpec
name: 'CodePane'
autoHideScrollBars: false
majorKey: NewSystemBrowser
minorKey: codePaneSpec
createNewBuilder: false
)
)
)
handles: (Any 0.3 1.0)
postBuildCallback: postBuildTabContentView:
)
)
)
)
"Modified: / 25-03-2014 / 18:02:44 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
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:Tools::NewSystemBrowser andSelector:#multipleProjectFullBrowserSpec
Tools::NewSystemBrowser new openInterface:#multipleProjectFullBrowserSpec
"
<resource: #canvas>
^
#(FullSpec
name: multipleProjectFullBrowserSpec
window:
(WindowSpec
label: 'ProjectBrowser'
name: 'ProjectBrowser'
min: (Point 0 0)
bounds: (Rectangle 0 0 462 300)
)
component:
(SpecCollection
collection: (
(SubCanvasSpec
name: 'MessagePane'
layout: (LayoutFrame 0 0 0 0 0 1 40 0)
initiallyInvisible: true
hasHorizontalScrollBar: false
hasVerticalScrollBar: false
clientKey: inlineMessageApp
createNewBuilder: false
postBuildCallback: postBuildMessagePane:
)
(VariableVerticalPanelSpec
name: 'VariableVerticalPanel1'
layout: (LayoutFrame 0 0.0 0 0.0 0 1.0 0 1.0)
showHandle: false
snapMode: both
handlePosition: left
component:
(SpecCollection
collection: (
(SubCanvasSpec
name: 'Navigator'
autoHideScrollBars: false
majorKey: NavigatorCanvas
minorKey: multipleProjectFullBrowserSpec
subAspectHolders:
(Array
(SubChannelInfoSpec
subAspect: environmentHolder
aspect: environmentHolder
)
)
createNewBuilder: false
)
(SubCanvasSpec
name: 'CodePane'
autoHideScrollBars: false
majorKey: NewSystemBrowser
minorKey: codePaneSpec
createNewBuilder: false
)
)
)
handles: (Any 0.3 1.0)
postBuildCallback: postBuildTabContentView:
)
)
)
)
"Modified: / 25-03-2014 / 18:02:51 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
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:Tools::NewSystemBrowser andSelector:#multipleProtocolBrowserSpec
Tools::NewSystemBrowser new openInterface:#multipleProtocolBrowserSpec
"
<resource: #canvas>
^
#(FullSpec
name: multipleProtocolBrowserSpec
window:
(WindowSpec
label: 'ProtocolBrowser'
name: 'ProtocolBrowser'
min: (Point 0 0)
bounds: (Rectangle 0 0 462 300)
)
component:
(SpecCollection
collection: (
(SubCanvasSpec
name: 'MessagePane'
layout: (LayoutFrame 0 0 0 0 0 1 40 0)
initiallyInvisible: true
hasHorizontalScrollBar: false
hasVerticalScrollBar: false
clientKey: inlineMessageApp
createNewBuilder: false
postBuildCallback: postBuildMessagePane:
)
(VariableVerticalPanelSpec
name: 'VariableVerticalPanel1'
layout: (LayoutFrame 0 0.0 0 0.0 0 1.0 0 1.0)
showHandle: false
snapMode: both
handlePosition: left
component:
(SpecCollection
collection: (
(SubCanvasSpec
name: 'Navigator'
autoHideScrollBars: false
majorKey: NavigatorCanvas
minorKey: multipleProtocolBrowserSpec
subAspectHolders:
(Array
(SubChannelInfoSpec
subAspect: environmentHolder
aspect: environmentHolder
)
)
createNewBuilder: false
)
(SubCanvasSpec
name: 'CodePane'
autoHideScrollBars: false
majorKey: NewSystemBrowser
minorKey: codePaneSpec
createNewBuilder: false
)
)
)
handles: (Any 0.3 1.0)
postBuildCallback: postBuildTabContentView:
)
)
)
)
"Modified: / 25-03-2014 / 18:02:57 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
noteBookWindowSpec
"This resource specification was automatically generated
by the UIPainter of ST/X."
"Do not manually edit this!! If it is corrupted,
the UIPainter may not be able to read the specification."
"
UIPainter new openOnClass:Tools::NewSystemBrowser andSelector:#noteBookWindowSpec
Tools::NewSystemBrowser new openInterface:#noteBookWindowSpec
"
<resource: #canvas>
^
#(FullSpec
name: noteBookWindowSpec
window:
(WindowSpec
label: 'NewSystemBrowser'
name: 'NewSystemBrowser'
min: (Point 0 0)
bounds: (Rectangle 0 0 800 700)
menu: mainMenu
icon: defaultIcon
)
component:
(SpecCollection
collection: (
(NoteBookViewSpec
name: 'NoteBook'
layout: (LayoutFrame 0 0.0 0 0.0 0 1.0 0 1.0)
level: 0
model: selectedBuffer
menu: bufferNameList
useIndex: true
valueChangeSelector: bufferSelectionChanged
accessTabMenuAction: tabMenu:
translateLabel: false
hasScrollButtons: true
destroyTabAction: destroyTab:
"/ addTabAction: createBuffer
canvas: browserCanvas
canvasInset: 0
keepCanvasAlive: true
tabLevel: 1
)
(ViewSpec
name: 'ToolBar'
layout: (LayoutFrame 0 0 0 0 0 1 40 0)
visibilityChannel: toolBarVisibleHolder
component:
(SpecCollection
collection: (
(ActionButtonSpec
label: 'hideToolBarIcon'
name: 'HideToolBarButton'
layout: (LayoutFrame 0 0 0 0 13 0 0 1)
activeHelpKey: hideToolBar
hasCharacterOrientedLabel: false
translateLabel: true
model: hideToolbar
postBuildCallback: hideToolBarButtonCreated:
)
(MenuPanelSpec
name: 'ToolBarMenu'
layout: (LayoutFrame 13 0.0 0 0.0 -250 1.0 0 1.0)
visibilityChannel: toolBarVisibleHolder
menu: toolBarMenu
textDefault: true
)
(UISubSpecification
name: 'SubSpecification1'
layout: (LayoutFrame -250 1 0 0 0 1 0 1)
minorKey: searchSpec
)
)
)
)
(ViewSpec
name: 'BookmarkBar'
layout: (LayoutFrame 0 0 40 0 0 1 67 0)
visibilityChannel: bookmarkBarVisibleHolder
component:
(SpecCollection
collection: (
(ActionButtonSpec
label: 'hideToolBarIcon'
name: 'Button1'
layout: (LayoutFrame 0 0 0 0 13 0 0 1)
activeHelpKey: hideBookmarkBar
hasCharacterOrientedLabel: false
translateLabel: true
model: hideBookmarkBar
postBuildCallback: hideToolBarButtonCreated:
)
(SubCanvasSpec
name: 'Bookmarks'
layout: (LayoutFrame 13 0 2 0 0 1 -1 1)
level: 0
hasHorizontalScrollBar: false
hasVerticalScrollBar: false
miniScrollerHorizontal: false
majorKey: BookmarkBar
subAspectHolders:
(Array
(SubChannelInfoSpec
subAspect: bookmarkHolder
aspect: bookmarkHolder
)
(SubChannelInfoSpec
subAspect: bookmarksHolder
aspect: bookmarkListHolder
)
)
createNewApplication: true
createNewBuilder: true
)
)
)
)
)
)
)
!
pagedWindowSpec
"This resource specification was automatically generated
by the UIPainter of ST/X."
"Do not manually edit this!! If it is corrupted,
the UIPainter may not be able to read the specification."
"
UIPainter new openOnClass:Tools::NewSystemBrowser andSelector:#pagedWindowSpec
Tools::NewSystemBrowser new openInterface:#pagedWindowSpec
"
<resource: #canvas>
^
#(FullSpec
name: pagedWindowSpec
window:
(WindowSpec
label: 'NewSystemBrowser'
name: 'NewSystemBrowser'
min: (Point 0 0)
bounds: (Rectangle 0 0 800 700)
menu: mainMenu
icon: defaultIcon
)
component:
(SpecCollection
collection: (
(NoteBookViewSpec
name: 'NoteBook'
layout: (LayoutFrame 0 0.0 0 0.0 0 1.0 0 1.0)
level: 0
model: selectedBuffer
menu: bufferNameList
useIndex: true
valueChangeSelector: bufferSelectionChanged
accessTabMenuAction: tabMenu:
translateLabel: false
hasScrollButtons: true
destroyTabAction: destroyTab:
"/ addTabAction: createBuffer
canvas: browserPageCanvas
canvasInset: 0
keepCanvasAlive: true
tabLevel: 1
)
)
)
)
!
protocolAndMethodListSpec_Both
"This resource specification was automatically generated
by the UIPainter of ST/X."
"Do not manually edit this!! If it is corrupted,
the UIPainter may not be able to read the specification."
"
UIPainter new openOnClass:Tools::NewSystemBrowser andSelector:#protocolAndMethodListSpec_Both
Tools::NewSystemBrowser new openInterface:#protocolAndMethodListSpec_Both
"
<resource: #canvas>
^
#(FullSpec
name: #'protocolAndMethodListSpec_Both'
window:
(WindowSpec
label: 'Protocol and Method List'
name: 'Protocol and Method List'
min: (Point 0 0)
bounds: (Rectangle 0 0 498 456)
icon: defaultIcon
)
component:
(SpecCollection
collection: (
(VariableHorizontalPanelSpec
name: 'Lists'
layout: (LayoutFrame 0 0 0 0 0 1 0 1)
barWidth: 2
showHandle: false
component:
(SpecCollection
collection: (
(SubCanvasSpec
name: 'MethodCategoryList'
majorKey: MethodCategoryList
subAspectHolders:
(Array
(SubChannelInfoSpec
subAspect: doubleClickChannel
callBack: protocolDoubleClicked
)
(SubChannelInfoSpec
subAspect: environmentHolder
aspect: environmentHolder
)
(SubChannelInfoSpec
subAspect: filterClassVars
aspect: filterClassVars
)
(SubChannelInfoSpec
subAspect: immediateUpdate
aspect: immediateUpdate
)
(SubChannelInfoSpec
subAspect: inGeneratorHolder
aspect: protocolListGenerator
)
(SubChannelInfoSpec
subAspect: menuHolder
aspect: protocolMenu
)
(SubChannelInfoSpec
subAspect: methodVisibilityHolder
aspect: methodVisibilityHolder
)
(SubChannelInfoSpec
subAspect: outGeneratorHolder
aspect: selectorListGenerator
)
(SubChannelInfoSpec
subAspect: packageFilter
aspect: packageFilter
)
(SubChannelInfoSpec
subAspect: selectedProtocols
aspect: selectedProtocols
callBack: protocolSelectionChanged
)
(SubChannelInfoSpec
subAspect: selectionChangeCondition
aspect: selectionChangeConditionHolder
)
(SubChannelInfoSpec
subAspect: showCoverageInformation
aspect: showCoverageInformation
)
(SubChannelInfoSpec
subAspect: showSyntheticMethods
aspect: showSyntheticMethods
)
(SubChannelInfoSpec
subAspect: showPseudoProtocols
aspect: showPseudoProtocols
)
(SubChannelInfoSpec
subAspect: variableFilter
aspect: variableFilter
callBack: variableSelectionChanged
)
)
createNewApplication: true
createNewBuilder: true
postBuildCallback: methodCategoryList:
)
(SubCanvasSpec
name: 'MethodList'
majorKey: MethodList
subAspectHolders:
(Array
(SubChannelInfoSpec
subAspect: doubleClickChannel
callBack: methodDoubleClicked
)
(SubChannelInfoSpec
subAspect: environmentHolder
aspect: environmentHolder
)
(SubChannelInfoSpec
subAspect: filterClassVars
aspect: filterClassVars
)
(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: showCoverageInformation
aspect: showCoverageInformation
)
(SubChannelInfoSpec
subAspect: showMethodComplexity
aspect: showMethodComplexity
)
(SubChannelInfoSpec
subAspect: showMethodInheritance
aspect: showMethodInheritance
)
(SubChannelInfoSpec
subAspect: showMethodTypeIcon
aspect: showMethodTypeIcon
)
(SubChannelInfoSpec
subAspect: showSyntheticMethods
aspect: showSyntheticMethods
)
(SubChannelInfoSpec
subAspect: variableFilter
aspect: variableFilter
callBack: variableSelectionChanged
)
)
createNewApplication: true
createNewBuilder: true
postBuildCallback: methodList:
)
)
)
handles: (Any 0.5 1.0)
)
)
)
)
!
protocolAndMethodListSpec_JustMethodList
"This resource specification was automatically generated
by the UIPainter of ST/X."
"Do not manually edit this!! If it is corrupted,
the UIPainter may not be able to read the specification."
"
UIPainter new openOnClass:Tools::NewSystemBrowser andSelector:#protocolAndMethodListSpec_JustMethodList
Tools::NewSystemBrowser new openInterface:#protocolAndMethodListSpec_JustMethodList
"
<resource: #canvas>
^
#(FullSpec
name: #'protocolAndMethodListSpec_JustMethodList'
window:
(WindowSpec
label: 'Protocol and Method List'
name: 'Protocol and Method List'
min: (Point 0 0)
bounds: (Rectangle 0 0 498 456)
icon: defaultIcon
)
component:
(SpecCollection
collection: (
(SubCanvasSpec
name: 'MethodList'
layout: (LayoutFrame 0 0 0 0 0 1 0 1)
majorKey: MethodList
subAspectHolders:
(Array
(SubChannelInfoSpec
subAspect: doubleClickChannel
callBack: methodDoubleClicked
)
(SubChannelInfoSpec
subAspect: environmentHolder
aspect: environmentHolder
)
(SubChannelInfoSpec
subAspect: filterClassVars
aspect: filterClassVars
)
(SubChannelInfoSpec
subAspect: immediateUpdate
aspect: immediateUpdate
)
(SubChannelInfoSpec
subAspect: inGeneratorHolder
aspect: selectorListGenerator5
)
(SubChannelInfoSpec
subAspect: menuHolder
aspect: selectorPopUpMenu
)
(SubChannelInfoSpec
subAspect: packageFilter
aspect: packageFilter
)
(SubChannelInfoSpec
subAspect: selectedMethods
aspect: selectedMethods
callBack: methodsSelectionChanged
)
(SubChannelInfoSpec
subAspect: selectionChangeCondition
aspect: selectionChangeConditionHolder
)
(SubChannelInfoSpec
subAspect: showCoverageInformation
aspect: showCoverageInformation
)
(SubChannelInfoSpec
subAspect: showMethodComplexity
aspect: showMethodComplexity
)
(SubChannelInfoSpec
subAspect: showMethodInheritance
aspect: showMethodInheritance
)
(SubChannelInfoSpec
subAspect: showMethodTypeIcon
aspect: showMethodTypeIcon
)
(SubChannelInfoSpec
subAspect: showSyntheticMethods
aspect: showSyntheticMethods
)
(SubChannelInfoSpec
subAspect: variableFilter
aspect: variableFilter
callBack: variableSelectionChanged
)
)
createNewApplication: true
createNewBuilder: true
postBuildCallback: methodList:
)
)
)
)
!
searchSpec
^self searchSpec_live
"Created: / 09-02-2010 / 21:28:37 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
searchSpec_classic
"This resource specification was automatically generated
by the UIPainter of ST/X."
"Do not manually edit this!! If it is corrupted,
the UIPainter may not be able to read the specification."
"
UIPainter new openOnClass:Tools::NewSystemBrowser andSelector:#searchSpec_classic
Tools::NewSystemBrowser new openInterface:#searchSpec_classic
"
<resource: #canvas>
^
#(FullSpec
name: #'searchSpec_classic'
window:
(WindowSpec
label: 'Search Spec (classic)'
name: 'Search Spec (classic)'
min: (Point 10 10)
bounds: (Rectangle 0 0 300 40)
)
component:
(SpecCollection
collection: (
(HorizontalPanelViewSpec
name: 'HorizontalPanel1'
layout: (LayoutFrame 0 0 0 0 0 1 0 1)
level: 1
horizontalLayout: fitSpace
verticalLayout: center
horizontalSpace: 2
verticalSpace: 2
component:
(SpecCollection
collection: (
(ComboBoxSpec
name: 'SearchedClassNameComboBox'
activeHelpKey: gotoClassEntryField
model: searchedClassNameOrSelectorHolder
acceptOnLeave: false
acceptOnReturn: true
acceptOnPointerLeave: false
acceptIfUnchanged: true
comboList: visitedClassesHistory
extent: (Point 294 24)
postBuildCallback: searchFieldCreated:
)
)
)
postBuildCallback: searchFieldPanelCreated:
)
)
)
)
!
searchSpec_live
"This resource specification was automatically generated
by the UIPainter of ST/X."
"Do not manually edit this!! If it is corrupted,
the UIPainter may not be able to read the specification."
"
UIPainter new openOnClass:Tools::NewSystemBrowser andSelector:#searchSpec_live
Tools::NewSystemBrowser new openInterface:#searchSpec_live
"
<resource: #canvas>
^
#(FullSpec
name: #'searchSpec_live'
window:
(WindowSpec
label: 'Search Spec (live)'
name: 'Search Spec (live)'
min: (Point 10 10)
bounds: (Rectangle 0 0 300 40)
)
component:
(SpecCollection
collection: (
(HorizontalPanelViewSpec
name: 'HorizontalPanel1'
layout: (LayoutFrame 0 0 0 0 0 1 0 1)
level: 1
horizontalLayout: fit
verticalLayout: center
horizontalSpace: 2
verticalSpace: 2
component:
(SpecCollection
collection: (
(EditFieldWithCompletionSpec
name: 'SearchedClassNameComboBox'
activeHelpKey: gotoClassEntryField
model: searchedClassNameOrSelectorHolder
acceptOnLeave: false
acceptOnReturn: true
acceptOnLostFocus: false
acceptOnPointerLeave: false
acceptIfUnchanged: true
entryCompletionBlock: searchCompletionBlock
extent: (Point 296 24)
postBuildCallback: searchFieldCreated:
)
)
)
postBuildCallback: searchFieldPanelCreated:
)
)
)
)
!
searchSpec_live_level0
"This resource specification was automatically generated
by the UIPainter of ST/X."
"Do not manually edit this!! If it is corrupted,
the UIPainter may not be able to read the specification."
"
UIPainter new openOnClass:Tools::NewSystemBrowser andSelector:#searchSpec_live_level0
Tools::NewSystemBrowser new openInterface:#searchSpec_live_level0
"
<resource: #canvas>
^
#(FullSpec
name: #'searchSpec_live_level0'
window:
(WindowSpec
label: 'Search Spec (live)'
name: 'Search Spec (live)'
min: (Point 10 10)
bounds: (Rectangle 0 0 300 40)
)
component:
(SpecCollection
collection: (
(HorizontalPanelViewSpec
name: 'HorizontalPanel1'
layout: (LayoutFrame 0 0 0 0 0 1 0 1)
level: 0
horizontalLayout: fitSpace
verticalLayout: center
horizontalSpace: 2
verticalSpace: 2
component:
(SpecCollection
collection: (
(EditFieldWithCompletionSpec
name: 'SearchedClassNameComboBox'
activeHelpKey: gotoClassEntryField
level: -1
model: searchedClassNameOrSelectorHolder
acceptOnLeave: false
acceptOnReturn: true
acceptOnLostFocus: false
acceptOnPointerLeave: false
acceptIfUnchanged: true
entryCompletionBlock: searchCompletionBlock
extent: (Point 294 24)
postBuildCallback: searchFieldCreated:
)
)
)
postBuildCallback: searchFieldPanelCreated:
)
)
)
)
!
selectorBrowserSpec
"This resource specification was automatically generated
by the UIPainter of ST/X."
"Do not manually edit this!! If it is corrupted,
the UIPainter may not be able to read the specification."
"
UIPainter new openOnClass:Tools::NewSystemBrowser andSelector:#selectorBrowserSpec
Tools::NewSystemBrowser new openInterface:#selectorBrowserSpec
"
<resource: #canvas>
^
#(FullSpec
name: selectorBrowserSpec
window:
(WindowSpec
label: 'SelectorBrowser'
name: 'SelectorBrowser'
min: (Point 0 0)
bounds: (Rectangle 0 0 462 300)
)
component:
(SpecCollection
collection: (
(SubCanvasSpec
name: 'MessagePane'
layout: (LayoutFrame 0 0 0 0 0 1 40 0)
initiallyInvisible: true
hasHorizontalScrollBar: false
hasVerticalScrollBar: false
clientKey: inlineMessageApp
createNewBuilder: false
postBuildCallback: postBuildMessagePane:
)
(VariableVerticalPanelSpec
name: 'VariableVerticalPanel1'
layout: (LayoutFrame 0 0.0 0 0.0 0 1.0 0 1.0)
showHandle: false
snapMode: both
handlePosition: left
component:
(SpecCollection
collection: (
(SubCanvasSpec
name: 'Navigator'
autoHideScrollBars: false
majorKey: NavigatorCanvas
minorKey: selectorBrowserSpec
subAspectHolders:
(Array
(SubChannelInfoSpec
subAspect: environmentHolder
aspect: environmentHolder
)
)
createNewBuilder: false
)
(SubCanvasSpec
name: 'CodePane'
autoHideScrollBars: false
majorKey: NewSystemBrowser
minorKey: codePaneSpec
createNewBuilder: false
)
)
)
handles: (Any 0.3 1.0)
postBuildCallback: postBuildTabContentView:
)
)
)
)
"Modified: / 25-03-2014 / 18:03:02 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
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:Tools::NewSystemBrowser andSelector:#senderChainBrowserSpec
Tools::NewSystemBrowser new openInterface:#senderChainBrowserSpec
"
<resource: #canvas>
^
#(FullSpec
name: senderChainBrowserSpec
window:
(WindowSpec
label: 'MethodBrowser'
name: 'MethodBrowser'
min: (Point 0 0)
bounds: (Rectangle 0 0 462 300)
)
component:
(SpecCollection
collection: (
(SubCanvasSpec
name: 'MessagePane'
layout: (LayoutFrame 0 0 0 0 0 1 40 0)
initiallyInvisible: true
hasHorizontalScrollBar: false
hasVerticalScrollBar: false
clientKey: inlineMessageApp
createNewBuilder: false
postBuildCallback: postBuildMessagePane:
)
(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'
barWidth: 2
showHandle: false
component:
(SpecCollection
collection: (
(SubCanvasSpec
name: 'MethodList1'
majorKey: MethodList
subAspectHolders:
(Array
(SubChannelInfoSpec
subAspect: doubleClickChannel
callBack: methodDoubleClicked1
)
(SubChannelInfoSpec
subAspect: environmentHolder
aspect: environmentHolder
)
(SubChannelInfoSpec
subAspect: immediateUpdate
aspect: immediateUpdate
)
(SubChannelInfoSpec
subAspect: inGeneratorHolder
aspect: selectorListGenerator1
)
(SubChannelInfoSpec
subAspect: menuHolder
aspect: selectorPopUpMenu
)
(SubChannelInfoSpec
subAspect: packageFilter
aspect: packageFilter
)
(SubChannelInfoSpec
subAspect: selectedMethods
aspect: selectedMethods1
callBack: methodsSelectionChanged1
)
(SubChannelInfoSpec
subAspect: selectionChangeCondition
aspect: selectionChangeConditionHolder
)
(SubChannelInfoSpec
subAspect: showCoverageInformation
aspect: showCoverageInformation
)
(SubChannelInfoSpec
subAspect: showMethodComplexity
aspect: showMethodComplexity
)
(SubChannelInfoSpec
subAspect: showSyntheticMethods
aspect: showSyntheticMethods
)
(SubChannelInfoSpec
subAspect: showMethodInheritance
aspect: showMethodInheritance
)
(SubChannelInfoSpec
subAspect: showMethodTypeIcon
aspect: showMethodTypeIcon
)
)
createNewApplication: true
createNewBuilder: true
)
(SubCanvasSpec
name: 'MethodList2'
majorKey: MethodList
subAspectHolders:
(Array
(SubChannelInfoSpec
subAspect: doubleClickChannel
callBack: methodDoubleClicked2
)
(SubChannelInfoSpec
subAspect: environmentHolder
aspect: environmentHolder
)
(SubChannelInfoSpec
subAspect: immediateUpdate
aspect: immediateUpdate
)
(SubChannelInfoSpec
subAspect: inGeneratorHolder
aspect: selectorListGenerator2
)
(SubChannelInfoSpec
subAspect: menuHolder
aspect: selectorPopUpMenu
)
(SubChannelInfoSpec
subAspect: packageFilter
aspect: packageFilter
)
(SubChannelInfoSpec
subAspect: selectedMethods
aspect: selectedMethods2
callBack: methodsSelectionChanged2
)
(SubChannelInfoSpec
subAspect: selectionChangeCondition
aspect: selectionChangeConditionHolder
)
(SubChannelInfoSpec
subAspect: showCoverageInformation
aspect: showCoverageInformation
)
(SubChannelInfoSpec
subAspect: showMethodComplexity
aspect: showMethodComplexity
)
(SubChannelInfoSpec
subAspect: showSyntheticMethods
aspect: showSyntheticMethods
)
(SubChannelInfoSpec
subAspect: showMethodInheritance
aspect: showMethodInheritance
)
(SubChannelInfoSpec
subAspect: showMethodTypeIcon
aspect: showMethodTypeIcon
)
)
createNewApplication: true
createNewBuilder: true
)
(SubCanvasSpec
name: 'MethodList3'
majorKey: MethodList
subAspectHolders:
(Array
(SubChannelInfoSpec
subAspect: doubleClickChannel
callBack: methodDoubleClicked3
)
(SubChannelInfoSpec
subAspect: environmentHolder
aspect: environmentHolder
)
(SubChannelInfoSpec
subAspect: immediateUpdate
aspect: immediateUpdate
)
(SubChannelInfoSpec
subAspect: inGeneratorHolder
aspect: selectorListGenerator3
)
(SubChannelInfoSpec
subAspect: menuHolder
aspect: selectorPopUpMenu
)
(SubChannelInfoSpec
subAspect: packageFilter
aspect: packageFilter
)
(SubChannelInfoSpec
subAspect: selectedMethods
aspect: selectedMethods3
callBack: methodsSelectionChanged3
)
(SubChannelInfoSpec
subAspect: selectionChangeCondition
aspect: selectionChangeConditionHolder
)
(SubChannelInfoSpec
subAspect: showCoverageInformation
aspect: showCoverageInformation
)
(SubChannelInfoSpec
subAspect: showMethodComplexity
aspect: showMethodComplexity
)
(SubChannelInfoSpec
subAspect: showSyntheticMethods
aspect: showSyntheticMethods
)
(SubChannelInfoSpec
subAspect: showMethodInheritance
aspect: showMethodInheritance
)
(SubChannelInfoSpec
subAspect: showMethodTypeIcon
aspect: showMethodTypeIcon
)
)
createNewApplication: true
createNewBuilder: true
)
(SubCanvasSpec
name: 'MethodList4'
majorKey: MethodList
subAspectHolders:
(Array
(SubChannelInfoSpec
subAspect: doubleClickChannel
callBack: methodDoubleClicked4
)
(SubChannelInfoSpec
subAspect: environmentHolder
aspect: environmentHolder
)
(SubChannelInfoSpec
subAspect: immediateUpdate
aspect: immediateUpdate
)
(SubChannelInfoSpec
subAspect: inGeneratorHolder
aspect: selectorListGenerator4
)
(SubChannelInfoSpec
subAspect: menuHolder
aspect: selectorPopUpMenu
)
(SubChannelInfoSpec
subAspect: packageFilter
aspect: packageFilter
)
(SubChannelInfoSpec
subAspect: selectedMethods
aspect: selectedMethods4
callBack: methodsSelectionChanged4
)
(SubChannelInfoSpec
subAspect: selectionChangeCondition
aspect: selectionChangeConditionHolder
)
(SubChannelInfoSpec
subAspect: showCoverageInformation
aspect: showCoverageInformation
)
(SubChannelInfoSpec
subAspect: showMethodComplexity
aspect: showMethodComplexity
)
(SubChannelInfoSpec
subAspect: showSyntheticMethods
aspect: showSyntheticMethods
)
(SubChannelInfoSpec
subAspect: showMethodInheritance
aspect: showMethodInheritance
)
(SubChannelInfoSpec
subAspect: showMethodTypeIcon
aspect: showMethodTypeIcon
)
)
createNewApplication: true
createNewBuilder: true
)
)
)
handles: (Any 0.25 0.5 0.75 1.0)
)
(SubCanvasSpec
name: 'CodePane'
autoHideScrollBars: false
majorKey: NewSystemBrowser
minorKey: codePaneSpec
createNewBuilder: false
)
)
)
handles: (Any 0.5 1.0)
postBuildCallback: postBuildTabContentView:
)
)
)
)
"Modified: / 25-03-2014 / 18:03:10 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
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:Tools::NewSystemBrowser andSelector:#singleCategoryBrowserSpec
Tools::NewSystemBrowser new openInterface:#singleCategoryBrowserSpec
"
<resource: #canvas>
^
#(FullSpec
name: singleCategoryBrowserSpec
window:
(WindowSpec
label: 'CategoryBrowser'
name: 'CategoryBrowser'
min: (Point 0 0)
bounds: (Rectangle 0 0 462 300)
)
component:
(SpecCollection
collection: (
(SubCanvasSpec
name: 'MessagePane'
layout: (LayoutFrame 0 0 0 0 0 1 40 0)
initiallyInvisible: true
hasHorizontalScrollBar: false
hasVerticalScrollBar: false
clientKey: inlineMessageApp
createNewBuilder: false
postBuildCallback: postBuildMessagePane:
)
(VariableVerticalPanelSpec
name: 'VariableVerticalPanel1'
layout: (LayoutFrame 0 0.0 0 0.0 0 1.0 0 1.0)
showHandle: false
snapMode: both
handlePosition: left
component:
(SpecCollection
collection: (
(SubCanvasSpec
name: 'Navigator'
autoHideScrollBars: false
majorKey: NavigatorCanvas
minorKey: singleCategoryBrowserSpec
subAspectHolders:
(Array
(SubChannelInfoSpec
subAspect: environmentHolder
aspect: environmentHolder
)
)
createNewBuilder: false
)
(SubCanvasSpec
name: 'CodePane'
autoHideScrollBars: false
majorKey: NewSystemBrowser
minorKey: codePaneSpec
createNewBuilder: false
)
)
)
handles: (Any 0.3 1.0)
postBuildCallback: postBuildTabContentView:
)
)
)
)
"Modified: / 25-03-2014 / 18:03:18 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
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:Tools::NewSystemBrowser andSelector:#singleClassBrowserSpec
Tools::NewSystemBrowser new openInterface:#singleClassBrowserSpec
"
<resource: #canvas>
^
#(FullSpec
name: singleClassBrowserSpec
window:
(WindowSpec
label: 'ClassBrowser'
name: 'ClassBrowser'
min: (Point 0 0)
bounds: (Rectangle 0 0 462 300)
)
component:
(SpecCollection
collection: (
(SubCanvasSpec
name: 'MessagePane'
layout: (LayoutFrame 0 0 0 0 0 1 40 0)
initiallyInvisible: true
hasHorizontalScrollBar: false
hasVerticalScrollBar: false
clientKey: inlineMessageApp
createNewBuilder: false
postBuildCallback: postBuildMessagePane:
)
(VariableVerticalPanelSpec
name: 'VariableVerticalPanel1'
layout: (LayoutFrame 0 0.0 0 0.0 0 1.0 0 1.0)
showHandle: false
snapMode: both
handlePosition: left
component:
(SpecCollection
collection: (
(SubCanvasSpec
name: 'Navigator'
autoHideScrollBars: false
majorKey: NavigatorCanvas
minorKey: singleClassBrowserSpec
subAspectHolders:
(Array
(SubChannelInfoSpec
subAspect: environmentHolder
aspect: environmentHolder
)
)
createNewBuilder: false
)
(SubCanvasSpec
name: 'CodePane'
autoHideScrollBars: false
majorKey: NewSystemBrowser
minorKey: codePaneSpec
createNewBuilder: false
)
)
)
handles: (Any 0.4 1.0)
postBuildCallback: postBuildTabContentView:
)
)
)
)
"Modified: / 25-03-2014 / 18:03:23 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
singleClassWithoutVariableListBrowserSpec
"This resource specification was automatically generated
by the UIPainter of ST/X."
"Do not manually edit this!! If it is corrupted,
the UIPainter may not be able to read the specification."
"
UIPainter new openOnClass:Tools::NewSystemBrowser andSelector:#singleClassBrowserSpec
Tools::NewSystemBrowser new openInterface:#singleClassBrowserSpec
"
<resource: #canvas>
^
#(FullSpec
name: singleClassWithoutVariableListBrowserSpec
window:
(WindowSpec
label: 'ClassBrowser'
name: 'ClassBrowser'
min: (Point 0 0)
bounds: (Rectangle 0 0 462 300)
)
component:
(SpecCollection
collection: (
(SubCanvasSpec
name: 'MessagePane'
layout: (LayoutFrame 0 0 0 0 0 1 40 0)
initiallyInvisible: true
hasHorizontalScrollBar: false
hasVerticalScrollBar: false
clientKey: inlineMessageApp
createNewBuilder: false
postBuildCallback: postBuildMessagePane:
)
(VariableVerticalPanelSpec
name: 'VariableVerticalPanel1'
layout: (LayoutFrame 0 0.0 0 0.0 0 1.0 0 1.0)
showHandle: false
snapMode: both
handlePosition: left
component:
(SpecCollection
collection: (
(SubCanvasSpec
name: 'Navigator'
autoHideScrollBars: false
majorKey: NavigatorCanvas
minorKey: singleClassWithoutVariableListBrowserSpec
subAspectHolders:
(Array
(SubChannelInfoSpec
subAspect: environmentHolder
aspect: environmentHolder
)
)
createNewBuilder: false
)
(SubCanvasSpec
name: 'CodePane'
autoHideScrollBars: false
majorKey: NewSystemBrowser
minorKey: codePaneSpec
createNewBuilder: false
)
)
)
handles: (Any 0.4 1.0)
postBuildCallback: postBuildTabContentView:
)
)
)
)
"Modified: / 25-03-2014 / 18:03:23 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
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:Tools::NewSystemBrowser andSelector:#singleFullProtocolBrowserSpec
Tools::NewSystemBrowser new openInterface:#singleFullProtocolBrowserSpec
"
<resource: #canvas>
^
#(FullSpec
name: singleFullProtocolBrowserSpec
window:
(WindowSpec
label: 'ProtocolBrowser'
name: 'ProtocolBrowser'
min: (Point 0 0)
bounds: (Rectangle 0 0 462 300)
)
component:
(SpecCollection
collection: (
(SubCanvasSpec
name: 'MessagePane'
layout: (LayoutFrame 0 0 0 0 0 1 40 0)
initiallyInvisible: true
hasHorizontalScrollBar: false
hasVerticalScrollBar: false
clientKey: inlineMessageApp
createNewBuilder: false
postBuildCallback: postBuildMessagePane:
)
(VariableVerticalPanelSpec
name: 'VariableVerticalPanel1'
layout: (LayoutFrame 0 0.0 0 0.0 0 1.0 0 1.0)
showHandle: false
snapMode: both
handlePosition: left
component:
(SpecCollection
collection: (
(SubCanvasSpec
name: 'Navigator'
autoHideScrollBars: false
majorKey: NavigatorCanvas
minorKey: singleFullProtocolBrowserSpec
subAspectHolders:
(Array
(SubChannelInfoSpec
subAspect: environmentHolder
aspect: environmentHolder
)
)
createNewBuilder: false
)
(SubCanvasSpec
name: 'CodePane'
autoHideScrollBars: false
majorKey: NewSystemBrowser
minorKey: codePaneSpec
createNewBuilder: false
)
)
)
handles: (Any 0.3 1.0)
postBuildCallback: postBuildTabContentView:
)
)
)
)
"Modified: / 25-03-2014 / 18:03:32 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
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:Tools::NewSystemBrowser andSelector:#singleMethodBrowserSpec
Tools::NewSystemBrowser new openInterface:#singleMethodBrowserSpec
"
<resource: #canvas>
^
#(FullSpec
name: singleMethodBrowserSpec
window:
(WindowSpec
label: 'MethodBrowser'
name: 'MethodBrowser'
min: (Point 0 0)
bounds: (Rectangle 0 0 462 300)
)
component:
(SpecCollection
collection: (
(SubCanvasSpec
name: 'MessagePane'
layout: (LayoutFrame 0 0 0 0 0 1 40 0)
initiallyInvisible: true
hasHorizontalScrollBar: false
hasVerticalScrollBar: false
clientKey: inlineMessageApp
createNewBuilder: false
postBuildCallback: postBuildMessagePane:
)
(TransparentBoxSpec
name: 'Box1'
layout: (LayoutFrame 0 0 0 0 0 1 0 1)
component:
(SpecCollection
collection: (
(SubCanvasSpec
name: 'PseudoMethodList'
layout: (LayoutFrame 0 0.0 0 0 0 1.0 25 0)
majorKey: MethodList
minorKey: singleMethodWindowSpec
subAspectHolders:
(Array
(SubChannelInfoSpec
subAspect: environmentHolder
aspect: environmentHolder
)
(SubChannelInfoSpec
subAspect: immediateUpdate
aspect: immediateUpdate
)
(SubChannelInfoSpec
subAspect: inGeneratorHolder
aspect: selectorListGenerator
)
(SubChannelInfoSpec
subAspect: menuHolder
aspect: selectorPopUpMenu
)
(SubChannelInfoSpec
subAspect: packageFilter
aspect: packageFilter
)
(SubChannelInfoSpec
subAspect: selectedMethods
aspect: selectedProtocolMethods
)
)
createNewApplication: true
createNewBuilder: true
)
(SubCanvasSpec
name: 'CodePane'
layout: (LayoutFrame 0 0.0 25 0.0 0 1.0 0 1.0)
autoHideScrollBars: false
majorKey: NewSystemBrowser
minorKey: codePaneSpec
createNewBuilder: false
)
)
)
postBuildCallback: postBuildTabContentView:
)
)
)
)
"Modified: / 25-03-2014 / 18:03:40 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
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:Tools::NewSystemBrowser andSelector:#singleMethodWithInfoBrowserSpec
Tools::NewSystemBrowser new openInterface:#singleMethodWithInfoBrowserSpec
"
<resource: #canvas>
^
#(FullSpec
name: singleMethodWithInfoBrowserSpec
window:
(WindowSpec
label: 'MethodBrowser'
name: 'MethodBrowser'
min: (Point 0 0)
bounds: (Rectangle 0 0 462 300)
)
component:
(SpecCollection
collection: (
(SubCanvasSpec
name: 'MessagePane'
layout: (LayoutFrame 0 0 0 0 0 1 40 0)
initiallyInvisible: true
hasHorizontalScrollBar: false
hasVerticalScrollBar: false
clientKey: inlineMessageApp
createNewBuilder: false
postBuildCallback: postBuildMessagePane:
)
(TransparentBoxSpec
name: 'Box'
layout: (LayoutFrame 0 0 0 0 0 1 0 1)
component:
(SpecCollection
collection: (
(SubCanvasSpec
name: 'SubCanvas1'
layout: (LayoutFrame 0 0.0 0 0 0 1.0 25 0)
majorKey: MethodList
minorKey: singleMethodWindowSpec
subAspectHolders:
(Array
(SubChannelInfoSpec
subAspect: environmentHolder
aspect: environmentHolder
)
(SubChannelInfoSpec
subAspect: immediateUpdate
aspect: immediateUpdate
)
(SubChannelInfoSpec
subAspect: inGeneratorHolder
aspect: selectorListGenerator
)
(SubChannelInfoSpec
subAspect: menuHolder
aspect: methodListPopUpMenu
)
(SubChannelInfoSpec
subAspect: packageFilter
aspect: packageFilter
)
(SubChannelInfoSpec
subAspect: selectedMethods
aspect: selectedProtocolMethods
)
)
createNewApplication: true
createNewBuilder: true
)
(VariableVerticalPanelSpec
name: 'VariableVerticalPanel2'
layout: (LayoutFrame 0 0.0 25 0 0 1.0 0 1.0)
showHandle: false
snapMode: both
handlePosition: left
component:
(SpecCollection
collection: (
(TextEditorSpec
name: 'TextEditor1'
model: methodInfo
hasHorizontalScrollBar: true
hasVerticalScrollBar: true
autoHideScrollBars: true
isReadOnly: true
hasKeyboardFocusInitially: false
)
(SubCanvasSpec
name: 'SubCanvas2'
autoHideScrollBars: false
majorKey: NewSystemBrowser
minorKey: codePaneSpec
createNewBuilder: false
)
)
)
handles: (Any 0.5 1.0)
)
)
)
postBuildCallback: postBuildTabContentView:
)
)
)
)
"Modified: / 25-03-2014 / 18:03:49 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
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:Tools::NewSystemBrowser andSelector:#singleNameSpaceBrowserSpec
Tools::NewSystemBrowser new openInterface:#singleNameSpaceBrowserSpec
"
<resource: #canvas>
^
#(FullSpec
name: singleNameSpaceBrowserSpec
window:
(WindowSpec
label: 'NameSpaceBrowser'
name: 'NameSpaceBrowser'
min: (Point 0 0)
bounds: (Rectangle 0 0 687 641)
)
component:
(SpecCollection
collection: (
(SubCanvasSpec
name: 'MessagePane'
layout: (LayoutFrame 0 0 0 0 0 1 40 0)
initiallyInvisible: true
hasHorizontalScrollBar: false
hasVerticalScrollBar: false
clientKey: inlineMessageApp
createNewBuilder: false
postBuildCallback: postBuildMessagePane:
)
(VariableVerticalPanelSpec
name: 'VariableVerticalPanel1'
layout: (LayoutFrame 0 0.0 0 0.0 0 1.0 0 1.0)
showHandle: false
snapMode: both
handlePosition: left
component:
(SpecCollection
collection: (
(SubCanvasSpec
name: 'Navigator'
autoHideScrollBars: false
majorKey: NavigatorCanvas
minorKey: singleNameSpaceBrowserSpec
subAspectHolders:
(Array
(SubChannelInfoSpec
subAspect: environmentHolder
aspect: environmentHolder
)
)
createNewBuilder: false
)
(SubCanvasSpec
name: 'CodePane'
autoHideScrollBars: false
majorKey: NewSystemBrowser
minorKey: codePaneSpec
createNewBuilder: false
)
)
)
handles: (Any 0.3 1.0)
postBuildCallback: postBuildTabContentView:
)
)
)
)
"Modified: / 25-03-2014 / 18:03:57 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
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:Tools::NewSystemBrowser andSelector:#singleNameSpaceFullBrowserSpec
Tools::NewSystemBrowser new openInterface:#singleNameSpaceFullBrowserSpec
"
<resource: #canvas>
^
#(FullSpec
name: singleNameSpaceFullBrowserSpec
window:
(WindowSpec
label: 'NameSpaceBrowser'
name: 'NameSpaceBrowser'
min: (Point 0 0)
bounds: (Rectangle 0 0 687 641)
)
component:
(SpecCollection
collection: (
(SubCanvasSpec
name: 'MessagePane'
layout: (LayoutFrame 0 0 0 0 0 1 40 0)
initiallyInvisible: true
hasHorizontalScrollBar: false
hasVerticalScrollBar: false
clientKey: inlineMessageApp
createNewBuilder: false
postBuildCallback: postBuildMessagePane:
)
(VariableVerticalPanelSpec
name: 'VariableVerticalPanel1'
layout: (LayoutFrame 0 0.0 0 0.0 0 1.0 0 1.0)
showHandle: false
snapMode: both
handlePosition: left
component:
(SpecCollection
collection: (
(SubCanvasSpec
name: 'Navigator'
autoHideScrollBars: false
majorKey: NavigatorCanvas
minorKey: singleNameSpaceFullBrowserSpec
subAspectHolders:
(Array
(SubChannelInfoSpec
subAspect: environmentHolder
aspect: environmentHolder
)
)
createNewBuilder: false
)
(SubCanvasSpec
name: 'CodePane'
autoHideScrollBars: false
majorKey: NewSystemBrowser
minorKey: codePaneSpec
createNewBuilder: false
)
)
)
handles: (Any 0.3 1.0)
postBuildCallback: postBuildTabContentView:
)
)
)
)
"Modified: / 25-03-2014 / 18:04:02 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
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:Tools::NewSystemBrowser andSelector:#singleProjectBrowserSpec
Tools::NewSystemBrowser new openInterface:#singleProjectBrowserSpec
"
<resource: #canvas>
^
#(FullSpec
name: singleProjectBrowserSpec
window:
(WindowSpec
label: 'ProjectBrowser'
name: 'ProjectBrowser'
min: (Point 0 0)
bounds: (Rectangle 0 0 462 300)
)
component:
(SpecCollection
collection: (
(SubCanvasSpec
name: 'MessagePane'
layout: (LayoutFrame 0 0 0 0 0 1 40 0)
initiallyInvisible: true
hasHorizontalScrollBar: false
hasVerticalScrollBar: false
clientKey: inlineMessageApp
createNewBuilder: false
postBuildCallback: postBuildMessagePane:
)
(VariableVerticalPanelSpec
name: 'VariableVerticalPanel1'
layout: (LayoutFrame 0 0.0 0 0.0 0 1.0 0 1.0)
showHandle: false
snapMode: both
handlePosition: left
component:
(SpecCollection
collection: (
(SubCanvasSpec
name: 'Navigator'
autoHideScrollBars: false
majorKey: NavigatorCanvas
minorKey: singleProjectBrowserSpec
subAspectHolders:
(Array
(SubChannelInfoSpec
subAspect: environmentHolder
aspect: environmentHolder
)
)
createNewBuilder: false
)
(SubCanvasSpec
name: 'CodePane'
autoHideScrollBars: false
majorKey: NewSystemBrowser
minorKey: codePaneSpec
createNewBuilder: false
)
)
)
handles: (Any 0.3 1.0)
postBuildCallback: postBuildTabContentView:
)
)
)
)
"Modified: / 25-03-2014 / 18:04:08 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
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:Tools::NewSystemBrowser andSelector:#singleProjectFullBrowserSpec
Tools::NewSystemBrowser new openInterface:#singleProjectFullBrowserSpec
"
<resource: #canvas>
^
#(FullSpec
name: singleProjectFullBrowserSpec
window:
(WindowSpec
label: 'ProjectBrowser'
name: 'ProjectBrowser'
min: (Point 0 0)
bounds: (Rectangle 0 0 462 300)
)
component:
(SpecCollection
collection: (
(SubCanvasSpec
name: 'MessagePane'
layout: (LayoutFrame 0 0 0 0 0 1 40 0)
initiallyInvisible: true
hasHorizontalScrollBar: false
hasVerticalScrollBar: false
clientKey: inlineMessageApp
createNewBuilder: false
postBuildCallback: postBuildMessagePane:
)
(VariableVerticalPanelSpec
name: 'VariableVerticalPanel1'
layout: (LayoutFrame 0 0.0 0 0.0 0 1.0 0 1.0)
showHandle: false
snapMode: both
handlePosition: left
component:
(SpecCollection
collection: (
(SubCanvasSpec
name: 'Navigator'
autoHideScrollBars: false
majorKey: NavigatorCanvas
minorKey: singleProjectFullBrowserSpec
subAspectHolders:
(Array
(SubChannelInfoSpec
subAspect: environmentHolder
aspect: environmentHolder
)
)
createNewBuilder: false
)
(SubCanvasSpec
name: 'CodePane'
autoHideScrollBars: false
majorKey: NewSystemBrowser
minorKey: codePaneSpec
createNewBuilder: false
)
)
)
handles: (Any 0.3 1.0)
postBuildCallback: postBuildTabContentView:
)
)
)
)
"Modified: / 25-03-2014 / 18:04:15 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
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:Tools::NewSystemBrowser andSelector:#singleProtocolBrowserSpec
Tools::NewSystemBrowser new openInterface:#singleProtocolBrowserSpec
"
<resource: #canvas>
^
#(FullSpec
name: singleProtocolBrowserSpec
window:
(WindowSpec
label: 'ProtocolBrowser'
name: 'ProtocolBrowser'
min: (Point 0 0)
bounds: (Rectangle 0 0 462 300)
)
component:
(SpecCollection
collection: (
(SubCanvasSpec
name: 'MessagePane'
layout: (LayoutFrame 0 0 0 0 0 1 40 0)
initiallyInvisible: true
hasHorizontalScrollBar: false
hasVerticalScrollBar: false
clientKey: inlineMessageApp
createNewBuilder: false
postBuildCallback: postBuildMessagePane:
)
(VariableVerticalPanelSpec
name: 'VariableVerticalPanel1'
layout: (LayoutFrame 0 0.0 0 0.0 0 1.0 0 1.0)
showHandle: false
snapMode: both
handlePosition: left
component:
(SpecCollection
collection: (
(SubCanvasSpec
name: 'Navigator'
autoHideScrollBars: false
majorKey: NavigatorCanvas
minorKey: singleProtocolBrowserSpec
subAspectHolders:
(Array
(SubChannelInfoSpec
subAspect: environmentHolder
aspect: environmentHolder
)
)
createNewBuilder: false
)
(SubCanvasSpec
name: 'CodePane'
autoHideScrollBars: false
majorKey: NewSystemBrowser
minorKey: codePaneSpec
createNewBuilder: false
)
)
)
handles: (Any 0.3 1.0)
postBuildCallback: postBuildTabContentView:
)
)
)
)
"Modified: / 25-03-2014 / 18:04:20 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
smallLintByRuleResultBrowserSpec
"This resource specification was automatically generated
by the UIPainter of ST/X."
"Do not manually edit this!! If it is corrupted,
the UIPainter may not be able to read the specification."
"
UIPainter new openOnClass:Tools::NewSystemBrowser andSelector:#smallLintByRuleResultBrowserSpec
Tools::NewSystemBrowser new openInterface:#smallLintByRuleResultBrowserSpec
"
<resource: #canvas>
^
#(FullSpec
name: smallLintByRuleResultBrowserSpec
window:
(WindowSpec
label: 'SmallLintByClassResultBrowser'
name: 'SmallLintByClassResultBrowser'
min: (Point 0 0)
bounds: (Rectangle 0 0 775 579)
)
component:
(SpecCollection
collection: (
(SubCanvasSpec
name: 'MessagePane'
layout: (LayoutFrame 0 0 0 0 0 1 40 0)
initiallyInvisible: true
hasHorizontalScrollBar: false
hasVerticalScrollBar: false
clientKey: inlineMessageApp
createNewBuilder: false
postBuildCallback: postBuildMessagePane:
)
(VariableVerticalPanelSpec
name: 'NavigatorAndCodePane'
layout: (LayoutFrame 0 0.0 0 0.0 0 1.0 0 1.0)
showHandle: false
snapMode: both
handlePosition: left
component:
(SpecCollection
collection: (
(ViewSpec
name: 'NavigatorAndDetail'
component:
(SpecCollection
collection: (
(VariableHorizontalPanelSpec
name: 'Lists'
layout: (LayoutFrame 0 0 0 0 0 1 0 1)
component:
(SpecCollection
collection: (
(VariableVerticalPanelSpec
name: 'RuleListPanel'
component:
(SpecCollection
collection: (
(SubCanvasSpec
name: 'RuleList'
majorKey: #'Tools::LintRuleList'
subAspectHolders:
(Array
(SubChannelInfoSpec
subAspect: environmentHolder
aspect: environmentHolder
)
(SubChannelInfoSpec
subAspect: inGeneratorHolder
aspect: lintRuleListGenerator
)
(SubChannelInfoSpec
subAspect: outGeneratorHolder
aspect: classListGenerator
)
(SubChannelInfoSpec
subAspect: selectionHolder
aspect: selectedLintRules
)
)
createNewApplication: true
createNewBuilder: true
)
)
)
handles: (Any 1.0)
)
(TransparentBoxSpec
name: 'ClassListBox'
component:
(SpecCollection
collection: (
(SubCanvasSpec
name: 'ClassList'
layout: (LayoutFrame 0 0 0 0 0 1 -25 1)
majorKey: ClassList
subAspectHolders:
(Array
(SubChannelInfoSpec
subAspect: doubleClickChannel
callBack: classDoubleClicked
)
(SubChannelInfoSpec
subAspect: environmentHolder
aspect: environmentHolder
)
(SubChannelInfoSpec
subAspect: immediateUpdate
aspect: immediateUpdate
)
(SubChannelInfoSpec
subAspect: inGeneratorHolder
aspect: classListGenerator
)
(SubChannelInfoSpec
subAspect: menuHolder
aspect: classMenuForSmallLint
)
(SubChannelInfoSpec
subAspect: meta
aspect: meta
)
(SubChannelInfoSpec
subAspect: selectedClasses
aspect: selectedClasses
callBack: classSelectionChanged
)
(SubChannelInfoSpec
subAspect: selectionChangeCondition
aspect: selectionChangeConditionHolder
)
)
createNewApplication: true
createNewBuilder: true
)
(SubCanvasSpec
name: 'MetaToggles'
layout: (LayoutFrame 5 0 -25 1 -5 1 0 1)
hasHorizontalScrollBar: false
hasVerticalScrollBar: false
majorKey: #'Tools::ClassList'
minorKey: metaSpec
createNewBuilder: false
)
)
)
)
(SubCanvasSpec
name: 'MethodList'
majorKey: MethodList
subAspectHolders:
(Array
(SubChannelInfoSpec
subAspect: doubleClickChannel
callBack: methodDoubleClicked
)
(SubChannelInfoSpec
subAspect: environmentHolder
aspect: environmentHolder
)
(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
)
)
)
handles: (Any 0.33000000000000007 0.67000000000000015 1.0)
)
)
)
)
(SubCanvasSpec
name: 'RuleDesc'
hasHorizontalScrollBar: false
hasVerticalScrollBar: false
majorKey: #'Tools::LintRuleDetail'
subAspectHolders:
(Array
(SubChannelInfoSpec
subAspect: ruleHolder
aspect: theSingleSelectedLintRuleHolder
)
(SubChannelInfoSpec
subAspect: selectedMethodsHolder
aspect: selectedMethods
)
(SubChannelInfoSpec
subAspect: selectedClassesHolder
aspect: selectedClasses
)
)
createNewApplication: true
createNewBuilder: true
)
(SubCanvasSpec
name: 'CodePane'
autoHideScrollBars: false
majorKey: NewSystemBrowser
minorKey: codePaneSpec
createNewBuilder: false
)
)
)
handles: (Any 0.33333333333333304 0.45595854922279805 1.0)
postBuildCallback: postBuildTabContentView:
)
)
)
)
!
visualProfilerSpec
"This resource specification was automatically generated
by the UIPainter of ST/X."
"Do not manually edit this!! If it is corrupted,
the UIPainter may not be able to read the specification."
"
UIPainter new openOnClass:Tools::NewSystemBrowser andSelector:#visualProfilerSpec
Tools::NewSystemBrowser new openInterface:#visualProfilerSpec
"
<resource: #canvas>
^
#(FullSpec
name: visualProfilerSpec
window:
(WindowSpec
label: 'SystemBrowser'
name: 'SystemBrowser'
min: (Point 0 0)
bounds: (Rectangle 0 0 462 300)
icon: defaultIcon
)
component:
(SpecCollection
collection: (
(SubCanvasSpec
name: 'MessagePane'
layout: (LayoutFrame 0 0 0 0 0 1 40 0)
initiallyInvisible: true
hasHorizontalScrollBar: false
hasVerticalScrollBar: false
clientKey: inlineMessageApp
createNewBuilder: false
postBuildCallback: postBuildMessagePane:
)
(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: 'VisualProfiler'
autoHideScrollBars: false
majorKey: #'Tools::VisualProfilerCanvas'
minorKey: windowSpec
subAspectHolders:
(Array
(SubChannelInfoSpec
subAspect: environmentHolder
aspect: environmentHolder
)
(SubChannelInfoSpec
subAspect: packageFilter
aspect: packageFilter
)
(SubChannelInfoSpec
subAspect: profilerStatistics
aspect: profilerStatistics
)
(SubChannelInfoSpec
subAspect: selectedMethods
aspect: selectedMethods
)
)
createNewApplication: true
createNewBuilder: true
)
(SubCanvasSpec
name: 'CodePane'
autoHideScrollBars: false
majorKey: NewSystemBrowser
minorKey: codePaneSpec
createNewBuilder: false
)
)
)
handles: (Any 0.5 1.0)
postBuildCallback: postBuildTabContentView:
)
)
)
)
"Modified: / 25-03-2014 / 18:04:34 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
windowSpec
"/ ^ self browserWindowSpec
^ UserPreferences current webBrowserLikeLayout
ifTrue:[ self pagedWindowSpec ]
ifFalse:[ self noteBookWindowSpec ]
"Modified: / 05-02-2000 / 12:23:55 / cg"
"Modified: / 07-06-2011 / 14:39:04 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!NewSystemBrowser class methodsFor:'interface specs-dialogs'!
repositoryConsistencyDialogSpec
"This resource specification was automatically generated
by the UIPainter of ST/X."
"Do not manually edit this!! If it is corrupted,
the UIPainter may not be able to read the specification."
"
UIPainter new openOnClass:NewSystemBrowser andSelector:#repositoryConsistencyDialogSpec
NewSystemBrowser new openInterface:#repositoryConsistencyDialogSpec
"
<resource: #canvas>
^
#(#FullSpec
#name: #repositoryConsistencyDialogSpec
#window:
#(#WindowSpec
#label: 'Repository Consistency Check'
#name: 'Repository Consistency Check'
#min: #(#Point 10 10)
#max: #(#Point 1280 1024)
#bounds: #(#Rectangle 16 46 316 492)
)
#component:
#(#SpecCollection
#collection: #(
#(#LabelSpec
#label: 'Repository Consistency Check Report:'
#name: 'Label1'
#layout: #(#LayoutFrame 0 0 0 0 0 1 33 0)
#translateLabel: true
)
#(#VerticalPanelViewSpec
#name: 'VerticalPanel1'
#layout: #(#LayoutFrame 0 0.0 34 0.0 0 1.0 -31 1.0)
#horizontalLayout: #fit
#verticalLayout: #fit
#horizontalSpace: 3
#verticalSpace: 3
#component:
#(#SpecCollection
#collection: #(
#(#ViewSpec
#name: 'Box1'
#visibilityChannel: #classesWithoutContainerBoxVisible
#component:
#(#SpecCollection
#collection: #(
#(#DividerSpec
#name: 'Separator1'
#layout: #(#LayoutFrame 0 0.0 0 0 0 1.0 4 0)
)
#(#LabelSpec
#label: 'Classes without Repository Container:'
#name: 'Label2'
#layout: #(#LayoutFrame 0 0.0 5 0 0 1.0 27 0)
#translateLabel: true
#adjust: #left
#menu: #classesWithMissingContainerPopupMenu
#performer: #dialogMenuPerformer
)
#(#SequenceViewSpec
#name: 'List1'
#layout: #(#LayoutFrame 0 0.0 28 0 0 1.0 0 1)
#model: #selectedClassesWithMissingContainer
#menu: #classesWithMissingContainerPopupMenu
#performer: #dialogMenuPerformer
#hasHorizontalScrollBar: true
#hasVerticalScrollBar: true
#isMultiSelect: true
#useIndex: true
#sequenceList: #listOfClassesWithMissingContainer
)
)
)
#extent: #(#Point 300 74)
)
#(#ViewSpec
#name: 'Box2'
#visibilityChannel: #classesWithInvalidInfoBoxVisible
#component:
#(#SpecCollection
#collection: #(
#(#DividerSpec
#name: 'Separator2'
#layout: #(#LayoutFrame 0 0.0 0 0 0 1.0 4 0)
)
#(#LabelSpec
#label: 'Classes with Invalid Repository Info:'
#name: 'Label3'
#layout: #(#LayoutFrame 0 0.0 5 0 0 1.0 27 0)
#translateLabel: true
#adjust: #left
#menu: #classesWithInvalidInfoPopupMenu
#performer: #dialogMenuPerformer
)
#(#SequenceViewSpec
#name: 'List2'
#layout: #(#LayoutFrame 0 0.0 28 0 0 1.0 0 1)
#model: #selectedClassesWithRepositoryMismatches
#menu: #classesWithInvalidInfoPopupMenu
#performer: #dialogMenuPerformer
#hasHorizontalScrollBar: true
#hasVerticalScrollBar: true
#isMultiSelect: true
#useIndex: true
#sequenceList: #listOfClassesWithRepositoryMismatches
)
)
)
#extent: #(#Point 300 74)
)
#(#ViewSpec
#name: 'Box3'
#visibilityChannel: #obsoleteContainersBoxVisible
#component:
#(#SpecCollection
#collection: #(
#(#DividerSpec
#name: 'Separator3'
#layout: #(#LayoutFrame 0 0.0 0 0 0 1.0 4 0)
)
#(#LabelSpec
#label: 'Containers without class: (need checkOut ?)'
#name: 'Label4'
#layout: #(#LayoutFrame 0 0.0 5 0 0 1.0 27 0)
#translateLabel: true
#adjust: #left
#menu: #obsoleteContainersPopupMenu
#performer: #dialogMenuPerformer
)
#(#SequenceViewSpec
#name: 'List3'
#layout: #(#LayoutFrame 0 0.0 28 0 0 1.0 0 1)
#model: #selectedObsoleteContainers
#menu: #obsoleteContainersPopupMenu
#performer: #dialogMenuPerformer
#hasHorizontalScrollBar: true
#hasVerticalScrollBar: true
#isMultiSelect: true
#useIndex: true
#sequenceList: #listOfObsoleteContainers
)
)
)
#extent: #(#Point 300 73)
)
#(#ViewSpec
#name: 'Box4'
#visibilityChannel: #classesWhichHaveBeenModifiedBoxVisible
#component:
#(#SpecCollection
#collection: #(
#(#DividerSpec
#name: 'Separator4'
#layout: #(#LayoutFrame 0 0.0 0 0 0 1.0 4 0)
)
#(#LabelSpec
#label: 'Modified Classes (need checkIn ?):'
#name: 'Label5'
#layout: #(#LayoutFrame 0 0.0 5 0 0 1.0 27 0)
#translateLabel: true
#adjust: #left
#menu: #classesWhichHaveBeenModifiedPopupMenu
#performer: #dialogMenuPerformer
)
#(#SequenceViewSpec
#name: 'List4'
#layout: #(#LayoutFrame 0 0.0 28 0 0 1.0 0 1)
#model: #selectedClassesWhichHaveBeenModified
#menu: #classesWhichHaveBeenModifiedPopupMenu
#performer: #dialogMenuPerformer
#hasHorizontalScrollBar: true
#hasVerticalScrollBar: true
#isMultiSelect: true
#useIndex: true
#sequenceList: #listOfClassesWhichHaveBeenModified
)
)
)
#extent: #(#Point 300 74)
)
#(#ViewSpec
#name: 'Box5'
#visibilityChannel: #classesWithNewerVersionInRepositoryBoxVisible
#component:
#(#SpecCollection
#collection: #(
#(#DividerSpec
#name: 'Separator5'
#layout: #(#LayoutFrame 0 0.0 0 0 0 1.0 4 0)
)
#(#LabelSpec
#label: 'New Version in Repository (need checkOut ?):'
#name: 'Label6'
#layout: #(#LayoutFrame 0 0.0 5 0 0 1.0 27 0)
#translateLabel: true
#adjust: #left
#menu: #classesWithNewerVersionInRepositoryPopupMenu
#performer: #dialogMenuPerformer
)
#(#SequenceViewSpec
#name: 'List5'
#layout: #(#LayoutFrame 0 0.0 28 0 0 1.0 0 1)
#model: #selectedClassesWithNewerVersionInRepository
#menu: #classesWithNewerVersionInRepositoryPopupMenu
#performer: #dialogMenuPerformer
#hasHorizontalScrollBar: true
#hasVerticalScrollBar: true
#isMultiSelect: true
#useIndex: true
#sequenceList: #listOfClassesWithNewerVersionInRepository
)
)
)
#extent: #(#Point 300 74)
)
)
)
)
#(#HorizontalPanelViewSpec
#name: 'HorizontalPanel1'
#layout: #(#LayoutFrame 0 0 -30 1 0 1 0 1)
#horizontalLayout: #center
#verticalLayout: #center
#horizontalSpace: 3
#verticalSpace: 3
#component:
#(#SpecCollection
#collection: #(
#(#ActionButtonSpec
#label: 'Close'
#name: 'Button1'
#translateLabel: true
#model: #closeRequest
#extent: #(#Point 125 22)
)
)
)
)
)
)
)
! !
!NewSystemBrowser class methodsFor:'menu specs'!
browseMenu
"This resource specification was automatically generated
by the MenuEditor of ST/X."
"Do not manually edit this!! If it is corrupted,
the MenuEditor may not be able to read the specification."
"
MenuEditor new openOnClass:Tools::NewSystemBrowser andSelector:#browseMenu
(Menu new fromLiteralArrayEncoding:(Tools::NewSystemBrowser browseMenu)) startUp
"
<resource: #menu>
^
#(Menu
(
(MenuItem
label: 'Clone'
itemValue: browseMenuClone
isVisible: shiftNotPressedHolder
shortcutKey: Ctrln
)
(MenuItem
label: 'Old SystemBrowser on Class'
itemValue: browseMenuClone
isVisible: shiftPressedHolder
)
(MenuItem
label: 'Other Browsers'
submenuChannel: otherBrowsersMenu
)
(MenuItem
label: '-'
isVisible: false
)
(MenuItem
label: 'Class...'
itemValue: browseMenuOpenInClass
shortcutKey: Find
ignoreShortcutKeys: true
)
(MenuItem
label: 'Classes'
submenu:
(Menu
(
(MenuItem
label: 'With Name Matching...'
itemValue: browseMenuClassesWithNameMatching
showBusyCursorWhilePerforming: true
)
(MenuItem
label: '-'
)
(MenuItem
label: 'In Current ChangeSet'
itemValue: browseMenuClassesInCurrentChangeSet
showBusyCursorWhilePerforming: true
)
(MenuItem
label: 'In all ChangeSets'
itemValue: browseMenuClassesInAllChangeSets
showBusyCursorWhilePerforming: true
)
(MenuItem
label: 'Which were Autoloaded'
itemValue: browseMenuAutoloadedClasses
showBusyCursorWhilePerforming: true
)
(MenuItem
label: 'With Extensions'
itemValue: browseMenuClassExtensionsBuffer
showBusyCursorWhilePerforming: true
)
(MenuItem
label: 'With Shadowed Methods (Package Conflicts)'
itemValue: browseMenuClassesWithShadowedMethods
showBusyCursorWhilePerforming: true
)
(MenuItem
label: 'Recently Opened Applications'
itemValue: browseMenuClassesOfRecentlyOpenedApplications
)
(MenuItem
label: 'With Instrumentation'
itemValue: browseMenuClassesWithInstrumentation
)
(MenuItem
label: '-'
)
(MenuItem
label: 'All Subclasses of...'
itemValue: browseMenuAllSubclassesOf
showBusyCursorWhilePerforming: true
)
(MenuItem
label: 'All Applications'
itemValue: browseMenuApplicationClasses
showBusyCursorWhilePerforming: true
)
(MenuItem
label: 'All Web Services'
itemValue: browseMenuHTTPServiceClasses
showBusyCursorWhilePerforming: true
)
(MenuItem
label: 'All TestCases'
itemValue: browseMenuTestCaseClasses
showBusyCursorWhilePerforming: true
)
(MenuItem
label: 'All Shared Pools'
itemValue: browseMenuSharedPoolClasses
showBusyCursorWhilePerforming: true
)
(MenuItem
label: '-'
)
(MenuItem
label: 'Without Documentation'
itemValue: browseMenuClassesWithoutDocumentation
showBusyCursorWhilePerforming: true
)
(MenuItem
label: 'With Documentation to be Added'
itemValue: browseMenuClassesWithDocumentationToBeAdded
showBusyCursorWhilePerforming: true
)
(MenuItem
label: 'Without Copyright'
itemValue: browseMenuClassesWithoutCopyright
showBusyCursorWhilePerforming: true
)
(MenuItem
label: 'Without Valid Copyright'
itemValue: browseMenuClassesWithInvalidCopyright
showBusyCursorWhilePerforming: true
)
(MenuItem
label: 'Without Examples'
itemValue: browseMenuClassesWithoutExamples
showBusyCursorWhilePerforming: true
)
(MenuItem
label: 'Without CVS Repository Container'
itemValue: browseMenuClassesWithoutCVSRepositoryContainer
showBusyCursorWhilePerforming: true
)
(MenuItem
label: 'Without SVN Repository Container'
itemValue: browseMenuClassesWithoutSVNRepositoryContainer
isVisible: hasSubversionSupport
showBusyCursorWhilePerforming: true
)
(MenuItem
label: '-'
)
(MenuItem
label: 'Defining Variable...'
itemValue: browseMenuClassesDefiningVariable
showBusyCursorWhilePerforming: true
)
(MenuItem
label: 'Referring to Pool...'
itemValue: browseMenuClassesReferringToPool
showBusyCursorWhilePerforming: true
)
(MenuItem
label: 'With String in Comment/Documentation...'
itemValue: browseMenuClassesWithStringInCommentOrDocumentation
showBusyCursorWhilePerforming: true
)
(MenuItem
label: 'With External Function Calls (FFI)'
itemValue: browseMenuClassesWithExternalFunctionCalls
isVisible: false
showBusyCursorWhilePerforming: true
)
(MenuItem
label: 'With Primitive Code'
itemValue: browseMenuClassesWithPrimitiveCode
isVisible: false
showBusyCursorWhilePerforming: true
)
(MenuItem
label: '-'
)
(MenuItem
label: 'For which...'
itemValue: browseMenuClassesWithUserFilter
showBusyCursorWhilePerforming: true
)
(MenuItem
label: '-'
)
(MenuItem
label: 'Pick a View, Browse its Application Class'
itemValue: pickViewAndBrowseApplicationClass
)
(MenuItem
label: 'Pick a View, Browse Widget''s Class'
itemValue: pickViewAndBrowseViewClass
)
(MenuItem
label: '-'
)
(MenuItem
label: 'Special'
submenuChannel: specialBrowseMenu
)
)
nil
nil
)
)
(MenuItem
label: '-'
)
(MenuItem
label: 'Implementors of...'
itemValue: browseMenuImplementorsOf
showBusyCursorWhilePerforming: true
)
(MenuItem
label: 'Senders of...'
itemValue: browseSendersOf
showBusyCursorWhilePerforming: true
)
(MenuItem
label: '-'
)
(MenuItem
label: 'References to Class or Global...'
itemValue: browseMenuReferencesToGlobal
showBusyCursorWhilePerforming: true
)
(MenuItem
label: 'References to Symbol...'
itemValue: browseMenuReferencesToSymbol
showBusyCursorWhilePerforming: true
)
(MenuItem
label: 'Writes to Global...'
itemValue: browseMenuWritesToGlobal
showBusyCursorWhilePerforming: true
)
(MenuItem
label: '-'
)
(MenuItem
label: 'Recently Changed Methods'
itemValue: browseMenuRecentChanges
showBusyCursorWhilePerforming: true
)
(MenuItem
label: 'Class Extensions'
itemValue: browseMenuClassExtensionsBuffer
showBusyCursorWhilePerforming: true
)
(MenuItem
label: 'Methods'
submenu:
(Menu
(
(MenuItem
label: 'Changed Methods'
itemValue: browseMenuMethodsInCurrentChangeSet
showBusyCursorWhilePerforming: true
)
(MenuItem
label: 'Unassigned Extensions'
itemValue: browseMenuUnassignedMethods:
argument: newBuffer
showBusyCursorWhilePerforming: true
)
(MenuItem
label: 'Overwritten Methods (Package Conflicts)'
itemValue: browseMenuOverwrittenMethods:
argument: newBuffer
showBusyCursorWhilePerforming: true
)
(MenuItem
label: 'With Break- or Tracepoint'
itemValue: browseMenuMethodsWithWrap
showBusyCursorWhilePerforming: true
)
(MenuItem
label: 'With Instrumentation'
itemValue: browseMenuMethodsWithInstrumentation
showBusyCursorWhilePerforming: true
)
(MenuItem
label: '-'
)
(MenuItem
label: 'With String...'
itemValue: browseMenuMethodsWithString
showBusyCursorWhilePerforming: true
)
(MenuItem
label: 'With String in Help Spec...'
itemValue: browseMenuMethodsWithStringInHelpSpec
showBusyCursorWhilePerforming: true
)
(MenuItem
label: 'With String in Menu Spec...'
itemValue: browseMenuMethodsWithStringInMenuSpec
showBusyCursorWhilePerforming: true
)
(MenuItem
label: 'With String-Literal Matching...'
itemValue: browseMenuMethodsWithStringLiteral
showBusyCursorWhilePerforming: true
)
(MenuItem
label: '-'
)
(MenuItem
label: 'With Window Spec...'
itemValue: browseMenuMethodsWithWindowSpec
showBusyCursorWhilePerforming: true
)
(MenuItem
label: 'With Menu Spec...'
itemValue: browseMenuMethodsWithMenuSpec
showBusyCursorWhilePerforming: true
)
(MenuItem
label: 'With Image Spec...'
itemValue: browseMenuMethodsWithImageSpec
showBusyCursorWhilePerforming: true
)
(MenuItem
label: 'With Table Spec...'
itemValue: browseMenuMethodsWithTableSpec
showBusyCursorWhilePerforming: true
)
(MenuItem
label: 'With Help Spec...'
itemValue: browseMenuMethodsWithHelpSpec
showBusyCursorWhilePerforming: true
)
(MenuItem
label: 'With any Resource...'
itemValue: browseMenuMethodsWithResource
showBusyCursorWhilePerforming: true
)
(MenuItem
label: 'With Annotation...'
itemValue: browseMenuMethodsWithAnnotation
showBusyCursorWhilePerforming: true
)
(MenuItem
label: '-'
)
(MenuItem
label: 'Without Comment...'
itemValue: browseMenuMethodsWithoutComment
showBusyCursorWhilePerforming: true
)
(MenuItem
label: 'With Ugly Coding Style...'
itemValue: browseMenuMethodsWithUglyCodingStyle
showBusyCursorWhilePerforming: true
)
(MenuItem
label: 'With Possible Leftover Debug Code...'
itemValue: browseMenuMethodsWithLeftoverDebugCode
showBusyCursorWhilePerforming: true
)
(MenuItem
label: 'Deprecated'
itemValue: browseMenuDeprecatedMethods
showBusyCursorWhilePerforming: true
)
(MenuItem
label: '-'
)
(MenuItem
label: 'With Exception Handlers'
itemValue: browseMenuMethodsWithExceptionHandlers
showBusyCursorWhilePerforming: true
)
(MenuItem
label: 'With Exception Raisers'
itemValue: browseMenuMethodsWithExceptionRaisers
showBusyCursorWhilePerforming: true
)
(MenuItem
label: 'With Primitive Code'
itemValue: browseMenuMethodsWithPrimitiveCode
showBusyCursorWhilePerforming: true
)
(MenuItem
label: 'With External Function Call (FFI)'
itemValue: browseMenuMethodsWithExternalFunctionCalls
showBusyCursorWhilePerforming: true
)
(MenuItem
label: '-'
)
(MenuItem
label: 'For which...'
itemValue: browseMenuMethodsWithUserFilter
showBusyCursorWhilePerforming: true
)
)
nil
nil
)
)
)
nil
nil
)
!
bufferBaseMenu
"This resource specification was automatically generated
by the MenuEditor of ST/X."
"Do not manually edit this!! If it is corrupted,
the MenuEditor may not be able to read the specification."
"
MenuEditor new openOnClass:Tools::NewSystemBrowser andSelector:#bufferBaseMenu
(Menu new fromLiteralArrayEncoding:(Tools::NewSystemBrowser bufferBaseMenu)) startUp
"
<resource: #menu>
^
#(Menu (
(MenuItem
label: 'Add Page'
itemValue: bufferMenuCreateBuffer
nameKey: CreateBuffer
isVisible: true
shortcutKey: AddTab
)
(MenuItem
label: 'Remove Page'
itemValue: bufferMenuRemoveCurrentBuffer
nameKey: RemoveBuffer
isVisible: true
shortcutKey: CloseTab
)
) nil
nil
)
!
categoryCheckMenu
"This resource specification was automatically generated
by the MenuEditor of ST/X."
"Do not manually edit this!! If it is corrupted,
the MenuEditor may not be able to read the specification."
"
MenuEditor new openOnClass:Tools::NewSystemBrowser andSelector:#categoryCheckMenu
(Menu new fromLiteralArrayEncoding:(Tools::NewSystemBrowser categoryCheckMenu)) startUp
"
<resource: #menu>
^
#(Menu
(
(MenuItem
label: 'SmallLint Menu'
submenuChannel: smalllintCheckMenuForCategory
isMenuSlice: true
)
)
nil
nil
)
"Modified: / 05-05-2012 / 10:18:13 / cg"
"Modified: / 27-11-2014 / 06:56:59 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
categoryDebugMenu
"This resource specification was automatically generated
by the MenuEditor of ST/X."
"Do not manually edit this!! If it is corrupted,
the MenuEditor may not be able to read the specification."
"
MenuEditor new openOnClass:Tools::NewSystemBrowser andSelector:#categoryMenuWithoutFind
(Menu new fromLiteralArrayEncoding:(Tools::NewSystemBrowser categoryMenuWithoutFind)) startUp
"
<resource: #menu>
^
#(Menu
(
(MenuItem
enabled: hasCategorySelectedAndInstrumentingCompilerExistsHolder
label: 'Recompile all Classes (without Instrumentation)'
itemValue: categoryMenuRecompile
showBusyCursorWhilePerforming: true
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasCategorySelectedAndInstrumentingCompilerExistsHolder
label: 'Recompile all Classes with Instrumentation'
itemValue: categoryMenuRecompileInstrumented
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasAnyClassWithCoverageInfoSelected
label: 'Clear Coverage Info (Categorywide)'
itemValue: categoryMenuClearCoverageInfo
)
)
nil
nil
)
!
categoryMenu
^ self categoryMenuWithoutFind
"Modified: / 31-05-2012 / 09:19:08 / cg"
!
categoryMenuDocumentationSlice
"This resource specification was automatically generated
by the MenuEditor of ST/X."
"Do not manually edit this!! If it is corrupted,
the MenuEditor may not be able to read the specification."
"
MenuEditor new openOnClass:Tools::NewSystemBrowser andSelector:#categoryMenuDocumentationSlice
(Menu new fromLiteralArrayEncoding:(Tools::NewSystemBrowser categoryMenuDocumentationSlice)) startUp
"
<resource: #menu>
^
#(Menu
(
(MenuItem
enabled: hasCategorySelectedHolder
label: 'Documentation'
translateLabel: true
submenu:
(Menu
(
(MenuItem
enabled: hasCategorySelectedHolder
label: 'PrintOut'
itemValue: categoryMenuPrintOut
translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasCategorySelectedHolder
label: 'PrintOut Protocol'
itemValue: categoryMenuPrintOutProtocol
translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasCategorySelectedHolder
label: 'Save HTML Documentation In...'
itemValue: categoryMenuSaveDocumentationIn
translateLabel: true
showBusyCursorWhilePerforming: true
)
)
nil
nil
)
)
)
nil
nil
)
!
categoryMenuFileOutAndRepositorySlice
"This resource specification was automatically generated
by the MenuEditor of ST/X."
"Do not manually edit this!! If it is corrupted,
the MenuEditor may not be able to read the specification."
"
MenuEditor new openOnClass:Tools::NewSystemBrowser andSelector:#categoryMenuFileOutAndRepositorySlice
(Menu new fromLiteralArrayEncoding:(Tools::NewSystemBrowser categoryMenuFileOutAndRepositorySlice)) startUp
"
<resource: #menu>
^
#(Menu
(
(MenuItem
enabled: hasCategorySelectedHolder
label: 'FileOut'
submenu:
(Menu
(
(MenuItem
enabled: hasCategorySelectedHolder
label: 'As...'
itemValue: categoryMenuFileOutAs
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasCategorySelectedHolder
label: 'Each in...'
itemValue: categoryMenuFileOutEachIn
showBusyCursorWhilePerforming: true
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasCategorySelectedHolder
label: 'Special Formats'
submenu:
(Menu
(
(MenuItem
enabled: hasCategorySelectedAndCanFileOutXMLHolder
label: 'XML as...'
itemValue: categoryMenuFileOutXMLAs
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasCategorySelectedAndCanFileOutXMLHolder
label: 'XML each in...'
itemValue: categoryMenuFileOutEachXMLIn
showBusyCursorWhilePerforming: true
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasCategorySelectedAndCanFileOutSIFHolder
label: 'SIF as...'
itemValue: categoryMenuFileOutSIFAs
)
(MenuItem
enabled: hasCategorySelectedAndCanFileOutSIFHolder
label: 'SIF each in...'
itemValue: categoryMenuFileOutEachSIFIn
showBusyCursorWhilePerforming: true
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasCategorySelectedAndCanFileOutVSEHolder
label: 'VSE Fileout Format as...'
itemValue: categoryMenuFileOutVSEAs
)
(MenuItem
enabled: hasCategorySelectedAndCanFileOutVSEHolder
label: 'VSE Fileout Format each in...'
itemValue: categoryMenuFileOutEachVSEIn
showBusyCursorWhilePerforming: true
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasCategorySelectedAndCanFileOutCypressHolder
label: 'Cypress as...'
itemValue: categoryMenuFileOutCypressAs
showBusyCursorWhilePerforming: true
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasCategorySelectedHolder
label: 'Binary each in...'
itemValue: categoryMenuFileOutEachBinaryIn
showBusyCursorWhilePerforming: true
)
)
nil
nil
)
)
)
nil
nil
)
)
(MenuItem
label: 'Repository'
submenuChannel: categoryMenuSCMSlice
isMenuSlice: true
isVisible: anyRepositoryMenusAreShown
)
)
nil
nil
)
!
categoryMenuNewAndRenameSlice
"This resource specification was automatically generated
by the MenuEditor of ST/X."
"Do not manually edit this!! If it is corrupted,
the MenuEditor may not be able to read the specification."
"
MenuEditor new openOnClass:Tools::NewSystemBrowser andSelector:#categoryMenuNewAndRenameSlice
(Menu new fromLiteralArrayEncoding:(Tools::NewSystemBrowser categoryMenuNewAndRenameSlice)) startUp
"
<resource: #menu>
^
#(Menu
(
(MenuItem
label: 'New...'
itemValue: categoryMenuNewCategory
translateLabel: true
)
(MenuItem
enabled: hasCategorySelectedHolder
label: 'Rename...'
itemValue: categoryMenuRename
translateLabel: true
shortcutKey: Rename
ignoreShortcutKeys: true
)
(MenuItem
enabled: hasCategorySelectedHolder
label: 'Remove...'
itemValue: categoryMenuRemove
translateLabel: true
labelImage: (ResourceRetriever ToolbarIconLibrary erase16x16Icon 'Remove...')
)
)
nil
nil
)
!
categoryMenuSpawnSlice
"This resource specification was automatically generated
by the MenuEditor of ST/X."
"Do not manually edit this!! If it is corrupted,
the MenuEditor may not be able to read the specification."
"
MenuEditor new openOnClass:Tools::NewSystemBrowser andSelector:#categoryMenuSpawnSlice
(Menu new fromLiteralArrayEncoding:(Tools::NewSystemBrowser categoryMenuSpawnSlice)) startUp
"
<resource: #menu>
^
#(Menu
(
(MenuItem
enabled: hasCategorySelectedHolder
label: 'Spawn'
translateLabel: true
submenu:
(Menu
(
(MenuItem
enabled: hasCategorySelectedHolder
label: 'Buffer'
itemValue: categoryMenuSpawnBuffer
translateLabel: true
)
(MenuItem
label: 'Buffer with Categories Matching...'
itemValue: categoryMenuSpawnMatchingCategoriesBuffer
translateLabel: true
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasCategorySelectedHolder
label: 'Browser'
itemValue: categoryMenuSpawnBrowser
translateLabel: true
)
(MenuItem
label: 'Browser on Categories Matching...'
itemValue: categoryMenuSpawnMatchingCategoriesBrowser
translateLabel: true
)
)
nil
nil
)
)
)
nil
nil
)
!
categoryMenuWithFind
"This resource specification was automatically generated
by the MenuEditor of ST/X."
"Do not manually edit this!! If it is corrupted,
the MenuEditor may not be able to read the specification."
"
MenuEditor new openOnClass:Tools::NewSystemBrowser andSelector:#categoryMenuWithFind
(Menu new fromLiteralArrayEncoding:(Tools::NewSystemBrowser categoryMenuWithFind)) startUp
"
<resource: #menu>
^
#(Menu
(
(MenuItem
label: 'FileOutAndRepositorySlice'
submenuChannel: categoryMenuFileOutAndRepositorySlice
isMenuSlice: true
)
(MenuItem
label: '-'
)
(MenuItem
label: 'DocumentationSlice'
submenuChannel: categoryMenuDocumentationSlice
isMenuSlice: true
)
(MenuItem
label: '-'
)
(MenuItem
label: 'SpawnSlice'
submenuChannel: categoryMenuSpawnSlice
isMenuSlice: true
)
(MenuItem
label: 'Find'
submenuChannel: searchMenu
)
(MenuItem
label: '-'
)
(MenuItem
label: 'NewAndRenameSlice'
submenuChannel: categoryMenuNewAndRenameSlice
isMenuSlice: true
)
(MenuItem
label: '-'
)
(MenuItem
label: 'Static Analysis (Lint)'
submenuChannel: categoryCheckMenu
labelImage: (ResourceRetriever ToolbarIconLibrary lint16x16Icon 'Static Analysis (Lint)')
)
(MenuItem
label: 'Debug'
submenuChannel: categoryDebugMenu
)
(MenuItem
label: 'Special'
submenuChannel: categorySpecialMenu
)
(MenuItem
label: '-'
)
(MenuItem
label: 'Update'
itemValue: categoryMenuUpdate
)
)
nil
nil
)
!
categoryMenuWithoutFind
"This resource specification was automatically generated
by the MenuEditor of ST/X."
"Do not manually edit this!! If it is corrupted,
the MenuEditor may not be able to read the specification."
"
MenuEditor new openOnClass:Tools::NewSystemBrowser andSelector:#categoryMenuWithoutFind
(Menu new fromLiteralArrayEncoding:(Tools::NewSystemBrowser categoryMenuWithoutFind)) startUp
"
<resource: #menu>
^
#(Menu
(
(MenuItem
label: 'FileOutAndRepositorySlice'
submenuChannel: categoryMenuFileOutAndRepositorySlice
isMenuSlice: true
)
(MenuItem
label: '-'
)
(MenuItem
label: 'DocumentationSlice'
submenuChannel: categoryMenuDocumentationSlice
isMenuSlice: true
)
(MenuItem
label: '-'
)
(MenuItem
label: 'SpawnSlice'
submenuChannel: categoryMenuSpawnSlice
isMenuSlice: true
)
(MenuItem
label: '-'
)
(MenuItem
label: 'NewAndRenameSlice'
nameKey: NewAndRenameSlice
submenuChannel: categoryMenuNewAndRenameSlice
isMenuSlice: true
)
(MenuItem
label: '-'
)
(MenuItem
label: 'Static Analysis (Lint)'
submenuChannel: categoryCheckMenu
labelImage: (ResourceRetriever ToolbarIconLibrary lint16x16Icon 'Static Analysis (Lint)')
)
(MenuItem
label: 'Debug'
submenuChannel: categoryDebugMenu
)
(MenuItem
label: 'Special'
submenuChannel: categorySpecialMenu
)
(MenuItem
label: '-'
)
(MenuItem
label: 'Update'
itemValue: categoryMenuUpdate
)
)
nil
nil
)
!
categorySpecialMenu
"This resource specification was automatically generated
by the MenuEditor of ST/X."
"Do not manually edit this!! If it is corrupted,
the MenuEditor may not be able to read the specification."
"
MenuEditor new openOnClass:Tools::NewSystemBrowser andSelector:#categorySpecialMenu
(Menu new fromLiteralArrayEncoding:(Tools::NewSystemBrowser categorySpecialMenu)) startUp
"
<resource: #menu>
^
#(Menu
(
(MenuItem
enabled: hasCategorySelectedHolder
label: 'Remove all from ChangeSet'
itemValue: categoryMenuCleanUpChangeSet
translateLabel: true
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasAnyCategoryWithAnyUnLoadedClassSelectedHolder
label: 'Load'
itemValue: categoryMenuLoad
translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasAnyCategoryWithAnyAutoLoadedClassSelectedHolder
label: 'Unload'
itemValue: categoryMenuUnload
translateLabel: true
showBusyCursorWhilePerforming: true
)
)
nil
nil
)
"Modified: / 31-01-2011 / 11:11:18 / cg"
!
checkMenu
<resource: #obsolete>
"This resource specification was automatically generated
by the MenuEditor of ST/X."
"Do not manually edit this!! If it is corrupted,
the MenuEditor may not be able to read the specification."
"
MenuEditor new openOnClass:Tools::NewSystemBrowser andSelector:#checkMenu
(Menu new fromLiteralArrayEncoding:(Tools::NewSystemBrowser checkMenu)) startUp
"
<resource: #menu>
^
#(Menu
(
(MenuItem
label: 'Lint'
translateLabel: true
submenuChannel: lintMenu
keepLinkedMenu: true
)
(MenuItem
label: '-'
isVisible: false
)
(MenuItem
enabled: hasClassSelectedAndInstrumentingCompilerExistsHolder
label: 'Recompile all Methods with Instrumentation'
itemValue: classMenuRecompileInstrumented
translateLabel: true
showBusyCursorWhilePerforming: true
isVisible: false
)
)
nil
nil
)
!
classCheckMenu
"This resource specification was automatically generated
by the MenuEditor of ST/X."
"Do not manually edit this!! If it is corrupted,
the MenuEditor may not be able to read the specification."
"
MenuEditor new openOnClass:Tools::NewSystemBrowser andSelector:#classCheckMenu
(Menu new fromLiteralArrayEncoding:(Tools::NewSystemBrowser classCheckMenu)) startUp
"
<resource: #menu>
^
#(Menu
(
(MenuItem
label: 'SmallLint Menu'
submenuChannel: smalllintCheckMenuForClass
isMenuSlice: true
)
(MenuItem
enabled: hasRBLintRuleClassSelected
label: 'Run this Rule On...'
itemValue: debugMenuRunLintRuleOn
showBusyCursorWhilePerforming: true
)
(MenuItem
label: '-'
)
(MenuItem
label: 'Smalltalk/X Checks'
translateLabel: true
submenuChannel: lintMenu
keepLinkedMenu: true
)
(MenuItem
enabled: hasClassSelectedHolder
label: 'Check Compilability'
itemValue: classMenuCheckCompilability
translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasClassSelectedAndInstrumentingCompilerExistsHolder
label: 'Recompile all Methods with Instrumentation'
itemValue: classMenuRecompileInstrumented
translateLabel: true
showBusyCursorWhilePerforming: true
isVisible: false
)
)
nil
nil
)
"Modified: / 27-11-2014 / 06:57:24 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
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: '-'
)
(MenuItem
enabled: hasClassVariableSelectedHolder
label: 'Clear (Set ClassVariable(s) to nil)'
itemValue: variablesMenuClear
)
"/ #(#MenuItem
"/ #label: 'Type info...'
"/ #translateLabel: true
"/ #value: #variablesMenuClassVariableTypeInfo
"/ #enabled: #hasSingleVariableSelectedHolder
"/ #showBusyCursorWhilePerforming: true
"/ )
)
nil
nil
)
!
classDebugMenu
"This resource specification was automatically generated
by the MenuEditor of ST/X."
"Do not manually edit this!! If it is corrupted,
the MenuEditor may not be able to read the specification."
"
MenuEditor new openOnClass:Tools::NewSystemBrowser andSelector:#classDebugMenu
(Menu new fromLiteralArrayEncoding:(Tools::NewSystemBrowser classDebugMenu)) startUp
"
<resource: #menu>
^
#(Menu
(
(MenuItem
enabled: hasClassSelectedHolder
label: 'Inspect Class'
itemValue: classMenuInspectClass
isVisible: hasNotMultipleClassesSelectedHolder
)
(MenuItem
enabled: hasClassSelectedHolder
label: 'Inspect Classes'
itemValue: classMenuInspectClass
isVisible: hasMultipleClassesSelectedHolder
)
(MenuItem
enabled: hasClassSelectedHolder
label: 'Inspect Subclasses'
itemValue: classMenuInspectSubclasses
isVisible: hasNotMultipleClassesSelectedHolder
)
(MenuItem
enabled: hasClassSelectedHolder
label: 'Inspect Instances'
itemValue: classMenuInspectInstances
)
(MenuItem
enabled: hasClassSelectedHolder
label: 'Inspect Derived Instances'
itemValue: classMenuInspectDerivedInstances
)
(MenuItem
enabled: hasClassSelectedHolder
label: 'Inspect References to Instances'
itemValue: classMenuInspectReferencesToInstances
)
(MenuItem
enabled: hasClassSelectedHolder
label: 'Inspect a New Instance'
itemValue: classMenuInspectNewInstance
)
(MenuItem
label: '-'
)
(MenuItem
label: 'Lint'
isVisible: false
submenuChannel: lintMenu
keepLinkedMenu: true
)
(MenuItem
enabled: hasClassSelectedHolder
label: 'Recompile all Methods (without Instrumentation)'
itemValue: classMenuRecompile
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasClassSelectedHolder
label: 'Recompile all Methods here and in Subclasses (without Instrumentation)'
itemValue: classMenuRecompileAll
showBusyCursorWhilePerforming: true
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasClassSelectedAndInstrumentingCompilerExistsHolder
label: 'Recompile all Methods with Instrumentation'
itemValue: classMenuRecompileInstrumented
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasClassWithInstrumentedMethodsSelected
label: 'Clear Coverage Info (Classwide)'
itemValue: classMenuClearCoverageInfo
)
(MenuItem
enabled: hasClassSelectedAndInstrumentingCompilerExistsAndOOMPackageLoadedHolder
label: 'Call Graph'
itemValue: debugMenuOpenCallGraphForClasses
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasRBLintRuleClassSelected
label: 'Run this Rule On...'
itemValue: debugMenuRunLintRuleOn
showBusyCursorWhilePerforming: true
isVisible: false
)
)
nil
nil
)
!
classDocumentationMenu
"This resource specification was automatically generated
by the MenuEditor of ST/X."
"Do not manually edit this!! If it is corrupted,
the MenuEditor may not be able to read the specification."
"
MenuEditor new openOnClass:Tools::NewSystemBrowser andSelector:#classMenu
(Menu new fromLiteralArrayEncoding:(Tools::NewSystemBrowser classMenu)) startUp
"
<resource: #menu>
^
#(Menu
(
(MenuItem
enabled: hasClassSelectedHolder
label: 'PrintOut'
itemValue: classMenuPrintOut
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasClassSelectedHolder
label: 'PrintOut Protocol'
itemValue: classMenuPrintOutProtocol
showBusyCursorWhilePerforming: true
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasClassSelectedHolder
label: 'HTML Documentation'
itemValue: classMenuDocumentation
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasClassSelectedHolder
label: 'Save HTML Documentation As...'
itemValue: classMenuSaveDocumentationAs
showBusyCursorWhilePerforming: true
)
(MenuItem
label: '-'
)
(MenuItem
label: 'Show Definition'
itemValue: classMenuDefinition
)
(MenuItem
label: 'Show Comment'
itemValue: classMenuComment
)
(MenuItem
label: 'Show Hierarchy'
itemValue: classMenuHierarchy
)
(MenuItem
label: 'Show Repository Summary'
itemValue: classMenuRepositorySummary
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasOOMPackageLoadedHolder
label: 'Metrics Report'
itemValue: classMenuMetrics
)
(MenuItem
label: 'Development Ownership Graph'
itemValue: classMenuOwnershipGraph
)
)
nil
nil
)
!
classGenerateMenu
"This resource specification was automatically generated
by the MenuEditor of ST/X."
"Do not manually edit this!! If it is corrupted,
the MenuEditor may not be able to read the specification."
"
MenuEditor new openOnClass:Tools::NewSystemBrowser andSelector:#classGenerateMenu
(Menu new fromLiteralArrayEncoding:(Tools::NewSystemBrowser classGenerateMenu)) startUp
"
<resource: #menu>
^
#(Menu
(
(MenuItem
label: 'AccessMethodsSlice'
translateLabel: true
submenuChannel: classGenerateMenuAccessMethodsSlice
isMenuSlice: true
)
(MenuItem
label: 'CommonInstMethodsSlice'
translateLabel: true
submenuChannel: classGenerateMenuCommonInstMethodsSlice
isMenuSlice: true
)
(MenuItem
enabled: hasLoadedClassSelectedHolder
label: 'Documentation Stubs'
itemValue: classMenuGenerateDocumentationStubs
translateLabel: true
)
(MenuItem
enabled: hasSingleLoadedClassWithCommentSelectedHolder
label: 'Documentation Method from Comment'
itemValue: classMenuGenerateDocumentationMethodFromComment
translateLabel: true
)
(MenuItem
enabled: hasLoadedClassSelectedHolder
label: 'Copyright Method'
itemValue: classMenuGenerateCopyrightMethod
translateLabel: true
)
(MenuItem
label: '-'
isVisible: hasClassSelectedHolder
)
(MenuItem
label: 'Project Definitions'
itemValue: classMenuGenerateProjectDefinitions
translateLabel: true
isVisible: hasProjectDefinitionSelectedHolder
)
(MenuItem
label: 'Update Project Contents Definitions'
itemValue: classMenuUpdateProjectContentsDefinitions
translateLabel: true
isVisible: hasProjectDefinitionSelectedHolder
)
(MenuItem
label: 'Regenerate Project Contents Definitions'
itemValue: classMenuRegenerateProjectContentsDefinitions
translateLabel: true
isVisible: hasProjectDefinitionSelectedHolder
)
(MenuItem
enabled: hasSingleLoadedClassSelectedHolder
label: 'Initialized Instance Creation'
itemValue: classMenuGenerateInitializedInstanceCreationMethods
translateLabel: true
isVisible: hasNonProjectDefinitionSelectedHolder
)
(MenuItem
enabled: hasSingleLoadedClassSelectedHolder
label: 'Parametrized Instance Creation'
itemValue: classMenuGenerateParametrizedInstanceCreationMethods
translateLabel: true
isVisible: hasNonProjectDefinitionSelectedHolder
)
(MenuItem
enabled: hasSingleLoadedClassSelectedHolder
label: 'Redefined Instance Creation'
itemValue: classMenuGenerateRedefinedInstanceCreationMethods
translateLabel: true
isVisible: hasNonProjectDefinitionSelectedHolder
)
(MenuItem
enabled: hasLoadedClassSelectedHolder
label: 'Singleton Pattern'
itemValue: classMenuGenerateSingletonPatternInstanceCreationMethods
translateLabel: true
isVisible: hasNonProjectDefinitionSelectedHolder
)
(MenuItem
enabled: hasLoadedClassSelectedHolder
label: 'Make Abstract'
itemValue: classMenuGenerateIsAbstractMethod
translateLabel: true
isVisible: hasNonProjectDefinitionSelectedHolder
)
(MenuItem
enabled: hasEnumTypeClassSelectedHolder
label: 'EnumType Code'
itemValue: classMenuGenerateEnumTypeCode
translateLabel: true
isVisible: hasNonProjectDefinitionSelectedHolder
)
(MenuItem
enabled: hasSharedPoolSelectedHolder
label: 'SharedPool Initialization Code'
itemValue: classMenuGeneratePoolInitializationCode
translateLabel: true
isVisible: hasNonProjectDefinitionSelectedHolder
)
(MenuItem
label: '-'
isVisible: hasNonProjectDefinitionSelectedHolder
)
(MenuItem
enabled: hasApplicationOrHTTPServiceClassSelectedHolder
label: 'Application Code'
itemValue: classMenuGenerateApplicationCode
translateLabel: true
isVisible: hasNonProjectDefinitionSelectedHolder
)
(MenuItem
enabled: hasLoadedClassSelectedHolder
label: 'Class Initialization Code'
itemValue: classMenuGenerateClassInitializationCode
translateLabel: true
isVisible: hasNonProjectDefinitionSelectedHolder
)
(MenuItem
enabled: hasLoadedClassSelectedHolder
label: 'Required Protocol'
itemValue: classMenuGenerateRequiredProtocol
translateLabel: true
isVisible: hasNonProjectDefinitionSelectedHolder
)
)
nil
nil
)
!
classGenerateMenuAccessMethodsSlice
"This resource specification was automatically generated
by the MenuEditor of ST/X."
"Do not manually edit this!! If it is corrupted,
the MenuEditor may not be able to read the specification."
"
MenuEditor new openOnClass:Tools::NewSystemBrowser andSelector:#classGenerateMenu
(Menu new fromLiteralArrayEncoding:(Tools::NewSystemBrowser classGenerateMenu)) startUp
"
<resource: #menu>
^
#(Menu
(
(MenuItem
enabled: hasSingleLoadedClassSelectedHolder
label: 'Access Methods'
itemValue: classMenuGenerateAccessMethods
translateLabel: true
)
(MenuItem
enabled: hasSingleLoadedClassSelectedHolder
label: 'Getter Method(s)'
itemValue: classMenuGenerateGetterMethods
translateLabel: true
)
(MenuItem
enabled: hasSingleLoadedClassSelectedHolder
label: 'Setter Method(s)'
itemValue: classMenuGenerateSetterMethods
translateLabel: true
)
(MenuItem
enabled: hasSingleLoadedClassSelectedAndMultipleVariablesSelectedHolder
label: 'Multi-Setter Method'
itemValue: classMenuGenerateMultiSetterMethod
translateLabel: true
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasSingleLoadedClassSelectedHolder
label: 'Access Methods with Lazy Initialization in Getter'
itemValue: classMenuGenerateAccessMethodsWithLazyInitialization
translateLabel: true
isVisible: hasNonMetaSelectedHolder
)
(MenuItem
enabled: hasSingleLoadedClassSelectedHolder
label: 'Access Methods with Change Notification'
itemValue: classMenuGenerateAccessMethodsWithChange
translateLabel: true
isVisible: hasNonMetaSelectedHolder
)
(MenuItem
enabled: hasSingleLoadedClassSelectedHolder
label: 'Access Methods for ValueHolder'
itemValue: classMenuGenerateAccessMethodsForValueHolder
translateLabel: true
isVisible: hasNonMetaSelectedHolder
)
(MenuItem
enabled: hasSingleLoadedClassSelectedHolder
label: 'Access Methods for ValueHolder with Change Notification'
itemValue: classMenuGenerateAccessMethodsForValueHolderWithChange
translateLabel: true
isVisible: hasNonMetaSelectedHolder
)
(MenuItem
label: '-'
isVisible: hasNonMetaSelectedHolder
)
)
nil
nil
)
"Created: / 10-08-2006 / 16:11:12 / cg"
!
classGenerateMenuCommonInstMethodsSlice
"This resource specification was automatically generated
by the MenuEditor of ST/X."
"Do not manually edit this!! If it is corrupted,
the MenuEditor may not be able to read the specification."
"
MenuEditor new openOnClass:Tools::NewSystemBrowser andSelector:#classGenerateMenuCommonInstMethodsSlice
(Menu new fromLiteralArrayEncoding:(Tools::NewSystemBrowser classGenerateMenuCommonInstMethodsSlice)) startUp
"
<resource: #menu>
^
#(Menu
(
(MenuItem
enabled: hasClassSelectedHolder
label: '"initialize"-Method'
itemValue: classMenuGenerateInitializationMethod
translateLabel: true
isVisible: hasNonMetaSelectedHolder
sendToOriginator: true
)
(MenuItem
enabled: hasClassSelectedHolder
label: '"printOn:"-Method'
itemValue: classMenuGenerateStandardPrintOnMethod
translateLabel: true
isVisible: hasNonMetaSelectedHolder
sendToOriginator: true
)
(MenuItem
enabled: hasClassSelectedHolder
label: 'Update Method Template'
itemValue: classMenuGenerateUpdateMethod
translateLabel: true
isVisible: hasNonMetaSelectedHolder
)
(MenuItem
enabled: hasClassSelectedHolder
label: 'Visitor Method'
itemValue: classMenuGenerateAcceptVisitor
translateLabel: true
isVisible: hasNonMetaSelectedHolder
)
(MenuItem
enabled: hasClassSelectedHolder
label: 'Visitor and Visited Methods'
itemValue: classMenuGenerateVisitorMethods
translateLabel: true
isVisible: hasNonMetaSelectedHolder
)
(MenuItem
enabled: hasClassSelectedHolder
label: 'Visitor and Visited Methods (with visitSuper:)'
itemValue: classMenuGenerateVisitorMethods2
translateLabel: true
isVisible: hasNonMetaSelectedHolder
)
(MenuItem
enabled: hasClassSelectedHolder
label: 'Classtype Test Methods for this Class (isXXX)'
itemValue: classMenuGenerateClassTypeTestMethodsForThisClass
translateLabel: true
isVisible: hasNonMetaSelectedHolder
)
(MenuItem
enabled: hasClassSelectedHolder
label: 'Classtype Test Methods for all Subclass(es) (isXXX)'
itemValue: classMenuGenerateClassTypeTestMethods
translateLabel: true
isVisible: hasNonMetaSelectedHolder
)
(MenuItem
label: '-'
isVisible: hasNonMetaSelectedHolder
)
)
nil
nil
)
"Modified: / 23-03-2012 / 11:58:16 / cg"
!
classHierarchyMenu
"This resource specification was automatically generated
by the MenuEditor of ST/X."
"Do not manually edit this!! If it is corrupted,
the MenuEditor may not be able to read the specification."
"
MenuEditor new openOnClass:NewSystemBrowser andSelector:#categoryMenu
(Menu new fromLiteralArrayEncoding:(NewSystemBrowser categoryMenu)) startUp
"
<resource: #menu>
^
#(#Menu
#(
#(#MenuItem
#label: 'Select Class with Superclasses'
#translateLabel: true
#value: #classHierarchyMenuSelectWithSuperclasses
#enabled: #hasAtMostOneClassesSelectedHolder
)
#(#MenuItem
#label: 'Select Class with Subclasses'
#translateLabel: true
#value: #classHierarchyMenuSelectWithSubclasses
#enabled: #hasAtMostOneClassesSelectedHolder
)
#(#MenuItem
#label: 'Select Class with all Subclasses'
#translateLabel: true
#value: #classHierarchyMenuSelectWithAllSubclasses
#enabled: #hasAtMostOneClassesSelectedHolder
)
#(#MenuItem
#label: '-'
)
#(#MenuItem
#label: 'Update'
#translateLabel: true
#value: #classHierarchyMenuUpdate
#enabled: #hasSingleClassSelected
)
)
nil
nil
)
!
classInstanceVariablesMenu
"This resource specification was automatically generated
by the MenuEditor of ST/X."
"Do not manually edit this!! If it is corrupted,
the MenuEditor may not be able to read the specification."
"
MenuEditor new openOnClass:NewSystemBrowser andSelector:#classInstanceVariablesMenu
(Menu new fromLiteralArrayEncoding:(NewSystemBrowser classInstanceVariablesMenu)) startUp
"
<resource: #menu>
^
#(#Menu
#(
#(#MenuItem
#label: 'References...'
#translateLabel: true
#value: #variablesMenuBrowseAllInstVarOrClassInstVarRefs
#enabled: #hasClassSelectedHolder
#showBusyCursorWhilePerforming: true
)
#(#MenuItem
#label: 'Readers...'
#translateLabel: true
#value: #variablesMenuBrowseAllInstVarOrClassInstVarReads
#enabled: #hasClassSelectedHolder
#showBusyCursorWhilePerforming: true
)
#(#MenuItem
#label: 'Writers...'
#translateLabel: true
#value: #variablesMenuBrowseAllInstVarOrClassInstVarMods
#enabled: #hasClassSelectedHolder
#showBusyCursorWhilePerforming: true
)
#(#MenuItem
#label: '-'
)
#(#MenuItem
#label: 'Add...'
#translateLabel: true
#value: #variablesMenuAddInstanceVariable
#enabled: #hasSingleClassSelectedAndCanUseRefactoringSupportHolder
#showBusyCursorWhilePerforming: true
)
#(#MenuItem
#label: 'Rename...'
#translateLabel: true
#value: #variablesMenuRenameInstanceVariable
#enabled: #hasSingleClassAndSingleVariableSelectedAndCanUseRefactoringSupportHolder
#showBusyCursorWhilePerforming: true
)
#(#MenuItem
#label: 'Remove'
#translateLabel: true
#value: #variablesMenuRemoveInstanceVariable
#enabled: #hasSingleClassAndSingleVariableSelectedAndCanUseRefactoringSupportHolder
#showBusyCursorWhilePerforming: true
)
#(#MenuItem
#label: '-'
)
#(#MenuItem
#label: 'Pull Up'
#translateLabel: true
#value: #codeMenuPullUpInstanceVariable
#enabled: #hasInstanceVariableSelectedInCodeViewOrVariableListAndCanUseRefactoringSupportHolder
#showBusyCursorWhilePerforming: true
)
#(#MenuItem
#label: 'Push Down'
#translateLabel: true
#value: #codeMenuPushDownInstanceVariable
#enabled: #hasInstanceVariableSelectedInCodeViewOrVariableListAndCanUseRefactoringSupportHolder
#showBusyCursorWhilePerforming: true
)
#(#MenuItem
#label: '-'
)
#(#MenuItem
#label: 'Convert to ValueHolder'
#translateLabel: true
#value: #codeMenuConvertToValueHolder
#enabled: #hasInstanceVariableSelectedInCodeViewOrVariableListAndCanUseRefactoringSupportHolder
#showBusyCursorWhilePerforming: true
)
#(#MenuItem
#label: 'Make Abstract (Access only via Getters/Setters)'
#translateLabel: true
#value: #codeMenuMakeAbstractVariable
#enabled: #hasSingleVariableSelectedInCodeViewOrVariableListHolder
#showBusyCursorWhilePerforming: true
)
#(#MenuItem
#label: 'Make Concrete (Protect from Access via Getters/Setters)'
#translateLabel: true
#value: #codeMenuProtectInstanceVariable
#enabled: #hasSingleVariableSelectedInCodeViewOrVariableListHolder
#showBusyCursorWhilePerforming: true
)
"/ #(#MenuItem
"/ #label: 'Type info...'
"/ #translateLabel: true
"/ #value: #variablesMenuInstanceVariableTypeInfo
"/ #enabled: #hasSingleVariableSelectedHolder
"/ #showBusyCursorWhilePerforming: true
"/ )
)
nil
nil
)
!
classMenu
"This resource specification was automatically generated
by the MenuEditor of ST/X."
"Do not manually edit this!! If it is corrupted,
the MenuEditor may not be able to read the specification."
"
MenuEditor new openOnClass:Tools::NewSystemBrowser andSelector:#classMenu
(Menu new fromLiteralArrayEncoding:(Tools::NewSystemBrowser classMenu)) startUp
"
<resource: #menu>
^
#(Menu
(
(MenuItem
enabled: hasClassSelectedHolder
label: 'FileOut'
submenu:
(Menu
(
(MenuItem
enabled: hasClassSelectedHolder
label: 'As...'
itemValue: classMenuFileOutAs
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasClassSelectedHolder
label: 'Each in...'
itemValue: classMenuFileOutEachIn
isVisible: hasMultipleClassesSelectedHolder
showBusyCursorWhilePerforming: true
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasClassSelectedHolder
label: 'Special Formats'
submenu:
(Menu
(
(MenuItem
enabled: hasClassSelectedAndCanFileOutXMLHolder
label: 'XML as...'
itemValue: classMenuFileOutXMLAs
isVisible: hasSingleClassSelectedHolder
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasClassSelectedAndCanFileOutXMLHolder
label: 'XML each in...'
itemValue: classMenuFileOutEachXMLIn
isVisible: hasMultipleClassesSelectedHolder
showBusyCursorWhilePerforming: true
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasClassSelectedAndCanFileOutSIFHolder
label: 'SIF as...'
itemValue: classMenuFileOutSIFAs
isVisible: hasSingleClassSelectedHolder
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasClassSelectedAndCanFileOutSIFHolder
label: 'SIF each in...'
itemValue: classMenuFileOutEachSIFIn
isVisible: hasMultipleClassesSelectedHolder
showBusyCursorWhilePerforming: true
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasClassSelectedAndCanFileOutVSEHolder
label: 'VSE Fileout Format as...'
itemValue: classMenuFileOutVSEAs
isVisible: hasSingleClassSelectedHolder
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasClassSelectedAndCanFileOutVSEHolder
label: 'VSE Fileout Format each in...'
itemValue: classMenuFileOutEachVSEIn
isVisible: hasMultipleClassesSelectedHolder
showBusyCursorWhilePerforming: true
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasClassSelectedAndCanFileOutBeeHolder
label: 'Bee Fileout Format as...'
itemValue: classMenuFileOutBeeAs
isVisible: hasSingleClassSelectedHolder
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasClassSelectedAndCanFileOutBeeHolder
label: 'Bee Fileout Format each in...'
itemValue: classMenuFileOutEachBeeIn
isVisible: hasMultipleClassesSelectedHolder
showBusyCursorWhilePerforming: true
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasClassSelectedAndCanFileOutBinaryHolder
label: 'Binary as...'
itemValue: classMenuFileOutBinaryAs
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasClassSelectedHolder
label: 'Binary each in...'
itemValue: classMenuFileOutEachBinaryIn
isVisible: hasMultipleClassesSelectedHolder
showBusyCursorWhilePerforming: true
)
)
nil
nil
)
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasProjectDefinitionSelectedHolder
label: 'Build Support Files in...'
itemValue: classMenuFileOutBuildSupportFiles
showBusyCursorWhilePerforming: true
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasClassSelectedAndCanSendMailHolder
label: 'Mail To...'
itemValue: classMenuMailTo
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasClassSelectedHolder
label: 'Copy Source to Clipboard'
itemValue: classMenuCopySourceToClipboard
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasClassSelectedHolder
label: 'Copy Selected Class Names to Clipboard'
itemValue: classMenuCopyClassNamesToClipboard
)
)
nil
nil
)
)
(MenuItem
label: 'Repository Slice'
submenuChannel: classMenuSCMSlice
isMenuSlice: true
isVisible: anyRepositoryMenusAreShown
)
(MenuItem
label: '-'
isVisible: anyRepositoryMenusAreShown
)
(MenuItem
enabled: hasClassSelectedHolder
label: 'Documentation'
submenuChannel: classDocumentationMenu
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasClassSelectedHolder
label: 'Spawn'
submenu:
(Menu
(
(MenuItem
enabled: hasClassSelectedHolder
label: 'Buffer with Class(es)'
itemValue: classMenuSpawnClassesBuffer
isVisible: #'isLintResultBrowserHolder_and_isNotEmbeddedBrowserHolder'
)
(MenuItem
enabled: hasClassSelectedHolder
label: 'Buffer with References to Class'
itemValue: classMenuSpawnBufferWithClassReferences
isVisible: isNotEmbeddedBrowserHolder
)
(MenuItem
enabled: hasClassSelectedHolder
label: 'Buffer with References to Class or Subclass'
itemValue: classMenuSpawnBufferWithClassOrSubclassReferences
isVisible: isNotEmbeddedBrowserHolder
)
(MenuItem
enabled: hasSharedPoolSelectedHolder
label: 'Buffer with References to Pool Variable'
itemValue: classMenuSpawnBufferWithPoolVariableReferences
isVisible: #'hasSharedPoolSelectedHolder_and_isNotEmbeddedBrowserHolder'
)
(MenuItem
enabled: hasProjectDefinitionSelectedHolder
label: 'Buffer with References to Package'
itemValue: classMenuSpawnBufferWithProjectReferences
isVisible: #'hasProjectDefinitionSelectedHolder_and_isNotEmbeddedBrowserHolder'
)
(MenuItem
enabled: hasClassSelectedHolder
label: 'Buffer with Subclasses'
itemValue: classMenuSpawnBufferWithAllSubclasses
isVisible: isNotEmbeddedBrowserHolder
)
(MenuItem
enabled: hasClassSelectedHolder
label: 'Buffer with Superclasses'
itemValue: classMenuSpawnBufferWithAllSuperclasses
isVisible: isNotEmbeddedBrowserHolder
)
(MenuItem
enabled: hasMultipleClassesSelectedHolder
label: 'Buffer with Common Superclass'
itemValue: classMenuSpawnBufferWithCommonSuperclass
isVisible: isNotEmbeddedBrowserHolder
)
(MenuItem
enabled: hasTestCaseClassesSelectedHolder
label: 'Buffer with Classes Covered by Testcase'
itemValue: classMenuSpawnBufferWithClassesCoveredByTestcase
isVisible: isNotEmbeddedBrowserHolder
)
(MenuItem
enabled: hasClassSelectedHolder
label: 'Buffer with Project(s)'
itemValue: classMenuSpawnBufferWithClassProjects
isVisible: isNotEmbeddedBrowserHolder
)
(MenuItem
enabled: hasClassSelectedHolder
label: 'Buffer'
itemValue: classMenuSpawnClassBuffer
isVisible: false
)
(MenuItem
label: '-'
isVisible: isNotEmbeddedBrowserHolder
)
(MenuItem
enabled: hasClassSelectedHolder
label: 'Browser on Class(es)'
itemValue: classMenuSpawnClassesBuffer
isVisible: isLintResultBrowserHolder
)
(MenuItem
enabled: hasClassSelectedHolder
label: 'Browser on References to Class'
itemValue: classMenuSpawnClassReferences
)
(MenuItem
enabled: hasClassSelectedHolder
label: 'Browser on References to Class or Subclass'
itemValue: classMenuSpawnClassOrSubclassReferences
)
(MenuItem
enabled: hasSharedPoolSelectedHolder
label: 'Browser with References to Pool Variable'
itemValue: classMenuSpawnPoolVariableReferences
isVisible: hasSharedPoolSelectedHolder
)
(MenuItem
enabled: hasProjectDefinitionSelectedHolder
label: 'Browser with References to Package'
itemValue: classMenuSpawnProjectReferences
isVisible: hasProjectDefinitionSelectedHolder
)
(MenuItem
enabled: hasClassSelectedHolder
label: 'Browser on Subclasses'
itemValue: classMenuSpawnWithAllSubclasses
)
(MenuItem
enabled: hasClassSelectedHolder
label: 'Browser on Superclasses'
itemValue: classMenuSpawnWithAllSuperclasses
)
(MenuItem
enabled: hasMultipleClassesSelectedHolder
label: 'Browser on Common Superclass'
itemValue: classMenuSpawnWithCommonSuperclass
)
(MenuItem
enabled: hasTestCaseClassesSelectedHolder
label: 'Browser on Classes Covered by Testcase'
itemValue: classMenuSpawnWithClassesCoveredByTestcase
)
(MenuItem
enabled: hasClassSelectedHolder
label: 'Browser on Project(s)'
itemValue: classMenuSpawnClassProjects
)
(MenuItem
enabled: hasClassSelectedHolder
label: 'Browser'
itemValue: classMenuSpawnClass
isVisible: false
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasTestCaseClassesSelected
label: 'SUnit Test Runner'
itemValue: classMenuOpenTestRunner
)
(MenuItem
enabled: hasSingleClassSelectedHolder
label: 'Browse Classes Package Directory'
itemValue: classMenuBrowseClassesPackageDirectory
)
(MenuItem
enabled: hasSingleClassSelectedHolder
label: 'Browse Class Package''s Resource Directory'
itemValue: classMenuBrowseClassPackagesResourceDirectory
)
)
nil
nil
)
)
(MenuItem
enabled: hasClassSelectedHolder
label: 'Find'
isVisible: false
submenu:
(Menu
(
(MenuItem
enabled: hasClassSelectedHolder
label: 'String...'
itemValue: classMenuFindString
)
)
nil
nil
)
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasClassSelectedHolder
label: 'Instance Variables'
isVisible: hasNonMetaSelectedHolder
submenuChannel: classInstanceVariablesMenu
)
(MenuItem
enabled: hasClassSelectedHolder
label: 'Class Instance Variables'
isVisible: hasMetaSelectedHolder
submenuChannel: classInstanceVariablesMenu
)
(MenuItem
enabled: hasClassSelectedHolder
label: 'Class Variables'
submenuChannel: classClassVariablesMenu
)
(MenuItem
enabled: hasSharedPoolSelectedHolder
label: 'Pool Variables'
submenuChannel: classPoolVariablesMenu
)
(MenuItem
label: '-'
)
(MenuItem
label: 'New'
isVisible: isNotEmbeddedBrowserHolder
submenu:
(Menu
(
(MenuItem
label: 'classNewSlice'
submenuChannel: classNewSlice
isMenuSlice: true
)
)
nil
nil
)
)
(MenuItem
enabled: hasSingleClassSelectedHolder
label: 'Copy...'
itemValue: classMenuCopyAs
isVisible: isNotEmbeddedBrowserHolder
)
(MenuItem
enabled: hasClassSelectedHolder
label: 'Move'
isVisible: isNotEmbeddedBrowserHolder
submenu:
(Menu
(
(MenuItem
enabled: hasNonPrivateClassSelected
label: 'To Category...'
itemValue: classMenuMoveToCategory
)
(MenuItem
enabled: hasNonPrivateClassSelected
label: 'To Namespace...'
itemValue: classMenuMoveToNamespace
)
(MenuItem
enabled: hasNonPrivateClassSelected
label: 'To Package...'
itemValue: classMenuMoveToProject
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasClassSelectedHolder
label: 'Make Private in...'
itemValue: classMenuMakePrivateIn
)
(MenuItem
enabled: canMakePublicClass
label: 'Make Public'
itemValue: classMenuMakePublic
)
(MenuItem
enabled: canMakePublicClass
label: 'Make Public in...'
itemValue: classMenuMakePublicIn
)
(MenuItem
label: '-'
)
(MenuItem
enabled: canConvertToSiblingsHolder
label: 'New Common Superclass with Children (Convert to Siblings)...'
itemValue: classMenuChildrenToSiblings
nameKey: convertToSibling
)
(MenuItem
enabled: canInsertSuperclassHolder
label: 'New Common Superclass (Insert Superclass)...'
itemValue: classMenuInsertNewSuperclass
nameKey: insertSuperclass
)
)
nil
nil
)
)
(MenuItem
enabled: hasSingleClassSelectedHolder
label: 'Rename...'
itemValue: classMenuRename
isVisible: isNotEmbeddedBrowserHolder
shortcutKey: Rename
ignoreShortcutKeys: true
)
(MenuItem
enabled: hasClassSelectedHolder
label: 'Safe Remove...'
itemValue: classMenuSaveRemove
isVisible: isNotEmbeddedBrowserHolder
)
(MenuItem
enabled: hasClassSelectedHolder
label: 'Remove...'
itemValue: classMenuRemove
isVisible: isNotEmbeddedBrowserHolder
shortcutKey: Delete
labelImage: (ResourceRetriever ToolbarIconLibrary erase16x16Icon 'Remove...')
ignoreShortcutKeys: true
)
(MenuItem
label: '-'
isVisible: isNotEmbeddedBrowserHolder
)
(MenuItem
enabled: hasClassSelectedHolder
label: 'Compare'
submenu:
(Menu
(
(MenuItem
enabled: hasClassSelectedAndSourceCodeManagerHolder
label: 'With Newest in Repository...'
itemValue: classMenuCompareAgainstNewestInRepository
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasSingleClassSelectedAndSourceCodeManagerHolder
label: 'With Original in Repository...'
itemValue: classMenuCompareAgainstOriginalInRepository
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasSingleClassSelectedAndSourceCodeManagerHolder
label: 'With Repository...'
itemValue: classMenuCompareWithRepository
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasSingleClassSelected
label: 'With File...'
itemValue: classMenuCompareWithFile
showBusyCursorWhilePerforming: true
)
(MenuItem
label: '-'
isVisible: smallTeamAvailable
)
(MenuItem
label: 'With SmallTeam Version on Host'
isVisible: smallTeamAvailable
submenuChannel: compareClassWithSmallTeamVersionMenu
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasSingleClassSelectedHolder
label: 'With Class...'
itemValue: classMenuCompareWithClass
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasExactlyTwoClassesSelectedHolder
label: 'With each other'
itemValue: classMenuCompareTwoSelectedClasses
showBusyCursorWhilePerforming: true
)
)
nil
nil
)
)
(MenuItem
label: 'Generate'
submenuChannel: classGenerateMenu
keepLinkedMenu: true
)
(MenuItem
label: 'Static Analysis (Lint)'
submenuChannel: classCheckMenu
labelImage: (ResourceRetriever ToolbarIconLibrary lint16x16Icon 'Static Analysis (Lint)')
)
(MenuItem
label: 'Debug'
submenuChannel: classDebugMenu
keepLinkedMenu: true
)
(MenuItem
label: 'Special'
submenuChannel: classSpecialMenu
keepLinkedMenu: true
)
(MenuItem
label: '-'
)
(MenuItem
label: 'Search && Rewrite...'
itemValue: classMenuRewrite
)
(MenuItem
label: '-'
isVisible: false
)
(MenuItem
label: 'Update'
itemValue: classMenuUpdate
isVisible: false
)
)
nil
nil
)
"Modified: / 25-11-2016 / 13:42:45 / cg"
!
classNewGroovyClassSlice
"This resource specification was automatically generated
by the MenuEditor of ST/X."
"Do not manually edit this!! If it is corrupted,
the MenuEditor may not be able to read the specification."
"
MenuEditor new openOnClass:Tools::NewSystemBrowser andSelector:#classNewGroovytClassSlice
(Menu new fromLiteralArrayEncoding:(Tools::NewSystemBrowser classNewGroovytClassSlice)) startUp
"
<resource: #menu>
^
#(Menu
(
(MenuItem
label: '-'
isVisible: hasGroovySupport
)
(MenuItem
label: 'Groovy Class'
itemValue: classMenuNewGroovyClass
translateLabel: true
isVisible: hasGroovySupport
)
)
nil
nil
)
"Created: / 18-02-2012 / 17:01:13 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
classNewHaskellClassSlice
"This resource specification was automatically generated
by the MenuEditor of ST/X."
"Do not manually edit this!! If it is corrupted,
the MenuEditor may not be able to read the specification."
"
MenuEditor new openOnClass:Tools::NewSystemBrowser andSelector:#classNewHaskellClassSlice
(Menu new fromLiteralArrayEncoding:(Tools::NewSystemBrowser classNewHaskellClassSlice)) startUp
"
<resource: #menu>
^
#(Menu
(
(MenuItem
label: '-'
isVisible: isHaskellModulePresent
)
(MenuItem
enabled: isHaskellModulePresent
label: 'Haskell Module'
itemValue: classMenuNewHaskellModule
translateLabel: true
isVisible: isHaskellModulePresent
)
)
nil
nil
)
!
classNewJavaScriptClassSlice
"This resource specification was automatically generated
by the MenuEditor of ST/X."
"Do not manually edit this!! If it is corrupted,
the MenuEditor may not be able to read the specification."
"
MenuEditor new openOnClass:Tools::NewSystemBrowser andSelector:#classNewJavaScriptClassSlice
(Menu new fromLiteralArrayEncoding:(Tools::NewSystemBrowser classNewJavaScriptClassSlice)) startUp
"
<resource: #menu>
^
#(Menu
(
(MenuItem
label: '-'
isVisible: isJavaScriptMetaclassPresent
)
(MenuItem
enabled: isJavaScriptMetaclassPresent
label: 'JavaScript Class'
itemValue: classMenuNewJavaScriptClass
translateLabel: true
)
)
nil
nil
)
!
classNewLispClassSlice
"This resource specification was automatically generated
by the MenuEditor of ST/X."
"Do not manually edit this!! If it is corrupted,
the MenuEditor may not be able to read the specification."
"
MenuEditor new openOnClass:Tools::NewSystemBrowser andSelector:#classNewLispClassSlice
(Menu new fromLiteralArrayEncoding:(Tools::NewSystemBrowser classNewLispClassSlice)) startUp
"
<resource: #menu>
^
#(Menu
(
(MenuItem
label: '-'
isVisible: isLispMetaclassPresent
)
(MenuItem
label: 'Scheme Namespace'
itemValue: classMenuNewLispNamespace
isVisible: isLispMetaclassPresent
translateLabel: true
)
(MenuItem
label: 'Scheme Class'
itemValue: classMenuNewLispClass
isVisible: isLispMetaclassPresent
translateLabel: true
)
)
nil
nil
)
"Created: / 13-05-2012 / 12:51:10 / cg"
!
classNewPLSQLClassSlice
"This resource specification was automatically generated
by the MenuEditor of ST/X."
"Do not manually edit this!! If it is corrupted,
the MenuEditor may not be able to read the specification."
"
MenuEditor new openOnClass:Tools::NewSystemBrowser andSelector:#classNewSlice
(Menu new fromLiteralArrayEncoding:(Tools::NewSystemBrowser classNewSlice)) startUp
"
<resource: #menu>
^
#(Menu
(
(MenuItem
label: 'PLSQL ObjectType'
itemValue: classMenuNewPLSQLObjectType
translateLabel: true
isVisible: isPlsqlMetaclassPresent
)
)
nil
nil
)
!
classNewRubyClassSlice
"This resource specification was automatically generated
by the MenuEditor of ST/X."
"Do not manually edit this!! If it is corrupted,
the MenuEditor may not be able to read the specification."
"
MenuEditor new openOnClass:Tools::NewSystemBrowser andSelector:#classNewRubyClassSlice
(Menu new fromLiteralArrayEncoding:(Tools::NewSystemBrowser classNewRubyClassSlice)) startUp
"
<resource: #menu>
^
#(Menu
(
(MenuItem
label: '-'
isVisible: isRubyMetaclassPresent
)
(MenuItem
label: 'Ruby class'
itemValue: classMenuNewRubyClass
translateLabel: true
isVisible: isRubyMetaclassPresent
labelImage: (ResourceRetriever ToolbarIconLibrary rubyClassBrowserIcon 'Ruby class')
)
(MenuItem
label: 'Ruby...'
translateLabel: true
isVisible: isRubyMetaclassPresent
submenu:
(Menu
(
(MenuItem
label: 'Module'
itemValue: classMenuNewRubyModule
translateLabel: true
isVisible: isRubyMetaclassPresent
)
)
nil
nil
)
)
)
nil
nil
)
!
classNewSlice
"This resource specification was automatically generated
by the MenuEditor of ST/X."
"Do not manually edit this!! If it is corrupted,
the MenuEditor may not be able to read the specification."
"
MenuEditor new openOnClass:Tools::NewSystemBrowser andSelector:#classNewSlice
(Menu new fromLiteralArrayEncoding:(Tools::NewSystemBrowser classNewSlice)) startUp
"
<resource: #menu>
^
#(Menu
(
(MenuItem
label: 'Class'
itemValue: classMenuNewClass
)
(MenuItem
enabled: hasSingleClassSelectedHolder
label: 'Subclass'
itemValue: classMenuNewSubclass
)
(MenuItem
label: 'GUI Application'
itemValue: classMenuNewApplication
)
(MenuItem
label: 'TestCase'
itemValue: classMenuNewTestCase
)
(MenuItem
label: '-'
)
(MenuItem
label: 'Smalltalk Class Slice'
nameKey: classNewSmalltalkSlice
submenuChannel: classNewSmalltalkSlice
isMenuSlice: true
)
(MenuItem
label: 'Ruby Class Slice'
nameKey: classNewRubyClassSlice
submenuChannel: classNewRubyClassSlice
isMenuSlice: true
)
(MenuItem
label: 'JavaScript Class Slice'
nameKey: classNewJavaScriptClassSlice
submenuChannel: classNewJavaScriptClassSlice
isMenuSlice: true
)
(MenuItem
label: 'Lisp Class Slice'
nameKey: classNewLispClassSlice
submenuChannel: classNewLispClassSlice
isMenuSlice: true
)
(MenuItem
label: 'Haskell Class Slice'
nameKey: classNewHaskellClassSlice
submenuChannel: classNewHaskellClassSlice
isMenuSlice: true
)
(MenuItem
label: 'PLSQL Class Slice'
nameKey: classNewPLSQLClassSlice
submenuChannel: classNewPLSQLClassSlice
isMenuSlice: true
)
(MenuItem
label: 'Other New Class Slice'
nameKey: classOtherClassNewSlice
submenuChannel: classOtherClassNewSlice
isMenuSlice: true
)
(MenuItem
label: '-'
)
(MenuItem
label: 'Class Wizard...'
itemValue: classMenuOpenClassCreationWizard
labelImage: (ResourceRetriever ToolbarIconLibrary newClassWizardIcon 'Class Wizard...')
)
)
nil
nil
)
!
classNewSmalltalkSlice
"This resource specification was automatically generated
by the MenuEditor of ST/X."
"Do not manually edit this!! If it is corrupted,
the MenuEditor may not be able to read the specification."
"
MenuEditor new openOnClass:Tools::NewSystemBrowser andSelector:#classNewSmalltalkSlice
(Menu new fromLiteralArrayEncoding:(Tools::NewSystemBrowser classNewSmalltalkSlice)) startUp
"
<resource: #menu>
^
#(Menu
(
(MenuItem
label: 'Smalltalk Class'
itemValue: classMenuNewSmalltalkClass
)
(MenuItem
label: 'Smalltalk...'
submenu:
(Menu
(
(MenuItem
enabled: hasSingleLoadedNonJavascriptClassSelectedHolder
label: 'Private Class'
itemValue: classMenuNewPrivateClass
)
(MenuItem
label: '-'
)
(MenuItem
label: 'Dialog'
itemValue: classMenuNewDialog
)
(MenuItem
label: 'Widget (View)'
itemValue: classMenuNewWidgetClass
)
(MenuItem
label: 'WebService'
itemValue: classMenuNewWebService
)
(MenuItem
label: '-'
)
(MenuItem
label: 'WebApplication'
itemValue: classMenuNewWebApplication
isVisible: false
)
(MenuItem
label: 'Console Application'
itemValue: classMenuNewConsoleApplication
isVisible: false
)
(MenuItem
label: 'Standalone Startup'
itemValue: classMenuNewStandaloneStartupClass
)
(MenuItem
label: '-'
)
(MenuItem
label: 'Error'
itemValue: classMenuNewError
)
(MenuItem
label: 'Notification'
itemValue: classMenuNewNotification
)
(MenuItem
label: 'Shared Pool'
itemValue: classMenuNewSharedPool
)
)
nil
nil
)
)
)
nil
nil
)
!
classPoolVariablesMenu
"This resource specification was automatically generated
by the MenuEditor of ST/X."
"Do not manually edit this!! If it is corrupted,
the MenuEditor may not be able to read the specification."
"
MenuEditor new openOnClass:Tools::NewSystemBrowser andSelector:#classPoolVariablesMenu
(Menu new fromLiteralArrayEncoding:(Tools::NewSystemBrowser classPoolVariablesMenu)) startUp
"
<resource: #menu>
^
#(Menu
(
(MenuItem
enabled: hasSharedPoolSelectedHolder
label: 'References...'
itemValue: variablesMenuBrowseAllPoolVarRefs
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasSharedPoolSelectedHolder
label: 'Readers...'
itemValue: variablesMenuBrowseAllPoolVarReads
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasSharedPoolSelectedHolder
label: 'Writers...'
itemValue: variablesMenuBrowseAllPoolVarMods
showBusyCursorWhilePerforming: true
)
)
nil
nil
)
!
classSmallTeamMenu
"This resource specification was automatically generated
by the MenuEditor of ST/X."
"Do not manually edit this!! If it is corrupted,
the MenuEditor may not be able to read the specification."
"
MenuEditor new openOnClass:Tools::NewSystemBrowser andSelector:#classSmallTeamMenu
(Menu new fromLiteralArrayEncoding:(Tools::NewSystemBrowser classSmallTeamMenu)) startUp
"
<resource: #menu>
^
#(Menu
(
(MenuItem
label: 'Compare with Version On Host'
translateLabel: true
submenuChannel: compareClassWithSmallTeamVersionMenu
keepLinkedMenu: true
)
)
nil
nil
)
!
classSpecialMenu
"This resource specification was automatically generated
by the MenuEditor of ST/X."
"Do not manually edit this!! If it is corrupted,
the MenuEditor may not be able to read the specification."
"
MenuEditor new openOnClass:Tools::NewSystemBrowser andSelector:#classSpecialMenu
(Menu new fromLiteralArrayEncoding:(Tools::NewSystemBrowser classSpecialMenu)) startUp
"
<resource: #menu>
^
#(Menu (
(MenuItem
enabled: hasClassSelectedHolder
label: 'Remove from ChangeSet'
itemValue: classMenuCleanUpChangeSet
isVisible: true
)
(MenuItem
enabled: hasClassSelectedHolder
label: 'Entries in ChangeSet'
itemValue: classMenuShowEntriesInChangeSet
isVisible: true
)
(MenuItem
label: '-'
isVisible: true
)
(MenuItem
enabled: hasAnyUnloadedClassSelectedHolder
label: 'Load'
itemValue: classMenuLoad
isVisible: true
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasProjectDefinitionWithAnyUnloadedClassSelectedHolder
label: 'Load Project'
itemValue: classMenuLoadProject
isVisible: true
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasClassSelectedHolder
label: 'Unload'
itemValue: classMenuUnload
isVisible: true
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasClassSelectedHolder
label: 'Initialize Class(es) '
itemValue: classMenuInitialize
isVisible: true
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasClassSelectedHolder
label: 'Initialize Class(es) and All Subclasses'
itemValue: classMenuInitializeWithAllSubclasses
isVisible: true
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasClassSelectedHolder
label: 'Compile Lazy Methods'
itemValue: classMenuCompileLazyMethods
isVisible: false
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasClassSelectedHolder
label: 'Load Sources'
itemValue: classMenuLoadSources
isVisible: true
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasClassSelectedHolder
label: 'Reload'
itemValue: classMenuReload
isVisible: true
showBusyCursorWhilePerforming: true
)
(MenuItem
label: '-'
isVisible: true
)
(MenuItem
enabled: hasClassSelectedWhichCanBeIncludedInProjectHolder
label: 'Include in Project as Compiled Class'
itemValue: classMenuIncludeInProject
isVisible: true
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasClassSelectedWhichCanBeMadeAutoloadedInProject
label: 'Include in Project as Autoloaded Class'
itemValue: classMenuMakeAutoloadedInProject
isVisible: true
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasClassSelectedWhichCanBeExcludedFromProject
label: 'Exclude from Project'
itemValue: classMenuExcludeFromProject
isVisible: true
showBusyCursorWhilePerforming: true
)
(MenuItem
label: '-'
isVisible: true
)
(MenuItem
enabled: hasSingleLoadedClassSelectedHolder
label: 'Primitive Definitions'
itemValue: classMenuPrimitiveDefinitions
isVisible: true
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasSingleLoadedClassSelectedHolder
label: 'Primitive Functions'
itemValue: classMenuPrimitiveFunctions
isVisible: true
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasSingleLoadedClassSelectedHolder
label: 'Primitive Variables'
itemValue: classMenuPrimitiveVariables
isVisible: true
showBusyCursorWhilePerforming: true
)
(MenuItem
label: '-'
isVisible: true
)
(MenuItem
enabled: hasSingleLoadedClassSelectedHolderAndCanEditComment
label: 'Comment'
itemValue: classMenuComment
isVisible: true
showBusyCursorWhilePerforming: true
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasSingleLoadedClassSelectedHolder
label: 'Edit Resource File(s)...'
itemValue: classMenuEditResourceFiles
isVisible: true
)
(MenuItem
label: '-'
isVisible: true
)
(MenuItem
enabled: hasClassSelectedHolder
label: 'Do...'
itemValue: classMenuDoUserProvidedAction
isVisible: true
)
(MenuItem
label: 'Special ClassOPS'
isVisible: true
submenuChannel: classOperationsMenu
isMenuSlice: true
)
) 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:Tools::NewSystemBrowser andSelector:#codeMenu
(Menu new fromLiteralArrayEncoding:(Tools::NewSystemBrowser codeMenu)) startUp
"
<resource: #menu>
^
#(Menu
(
(MenuItem
enabled: canUseRefactoringSupport
label: 'Variables'
translateLabel: true
submenu:
(Menu
(
(MenuItem
enabled: hasTemporaryVariableSelectedInCodeViewHolder
label: 'Rename Local Variable...'
itemValue: codeMenuRenameTemporary
translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasTemporaryVariableSelectedInCodeViewHolder
label: 'Move to Inner Scope...'
itemValue: codeMenuMoveVariableToInnerScope
translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasTemporaryVariableSelectedInCodeViewHolder
label: 'Make Instance Variable'
itemValue: codeMenuMakeInstanceVariable
translateLabel: true
isVisible: hasNotMultipleTemporaryVariablesSelectedInCodeViewHolder
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasMultipleTemporaryVariablesSelectedInCodeViewHolder
label: 'Make Instance Variables'
itemValue: codeMenuMakeInstanceVariable
translateLabel: true
isVisible: hasMultipleTemporaryVariablesSelectedInCodeViewHolder
showBusyCursorWhilePerforming: true
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasUndefinedUppercaseIdentifierSelectedInCodeViewHolder
label: 'Declare as Class Variable'
itemValue: codeMenuDeclareSelectionAsClassVariable
translateLabel: true
)
)
nil
nil
)
)
(MenuItem
enabled: hasLiteralConstantSelectedInCodeViewHolder
label: 'Eliminate Constant...'
itemValue: codeMenuEliminateConstant
translateLabel: true
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasSingleMethodSelectedAndSelectionInCodeViewAndCanUseRefactoringSupportHolder
label: 'Inline Message'
itemValue: codeMenuInlineMessage
translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasSingleMethodSelectedAndSelectionInCodeViewAndCanUseRefactoringSupportHolder
label: 'Extract Selection to Temporary...'
itemValue: codeMenuExtractSelectionToTemporary
translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasSingleMethodSelectedAndSelectionInCodeViewAndCanUseRefactoringSupportHolder
label: 'Extract Method...'
itemValue: codeMenuExtractMethod
translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasSingleMethodSelectedAndSelectionInCodeViewAndCanUseRefactoringSupportHolder
label: 'Extract Method to Component...'
itemValue: codeMenuExtractMethodToComponent
translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasSingleMethodSelectedAndCanUseRefactoringSupportHolder
label: 'Add Parameter to Method...'
itemValue: codeMenuAddParameter
translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasSingleMethodSelectedAndSelectionInCodeViewAndSingleSelectedMethodHasParameterAndCanUseRefactoringSupportHolder
label: 'Inline Parameter of Method'
itemValue: codeMenuInlineParameter
translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasSingleMethodSelectedAndSelectionInCodeViewAndSingleSelectedMethodHasParameterAndCanUseRefactoringSupportHolder
label: 'Remove Parameter from Method'
itemValue: codeMenuRemoveParameter
translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasSingleMethodSelectedAndCanUseRefactoringSupportHolder
label: 'Format'
itemValue: codeMenuFormat
translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
label: 'Search && Rewrite...'
itemValue: selectorMenuRewrite
translateLabel: true
)
(MenuItem
label: '-'
isVisible: false
)
(MenuItem
label: 'Remember a Code Smell'
submenuChannel: smellsMenu
isVisible: false
)
(MenuItem
label: '-'
isVisible: canLoadRefactoringSupport
)
(MenuItem
label: 'Load Refactoring and Undo Features'
itemValue: doLoadRefactoringSupport
translateLabel: true
isVisible: canLoadRefactoringSupport
showBusyCursorWhilePerforming: true
)
)
nil
nil
)
"Modified: / 04-07-2011 / 17:51:17 / cg"
!
compareBuildSupportFileMenu
"This resource specification was automatically generated
by the MenuEditor of ST/X."
"Do not manually edit this!! If it is corrupted,
the MenuEditor may not be able to read the specification."
"
MenuEditor new openOnClass:Tools::NewSystemBrowser andSelector:#compareBuildSupportFileMenu
(Menu new fromLiteralArrayEncoding:(Tools::NewSystemBrowser compareBuildSupportFileMenu)) startUp
"
<resource: #menu>
^
#(Menu
(
(MenuItem
enabled: hasSingleProjectOrProjectDefinitionSelected
label: 'bc.mak'
itemValue: projectMenuShowGeneratedBuildFile:
translateLabel: false
argument: 'bc.mak'
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasSingleProjectOrProjectDefinitionSelected
label: 'Make.proto'
itemValue: projectMenuShowGeneratedBuildFile:
translateLabel: false
argument: 'Make.proto'
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasSingleProjectOrProjectDefinitionSelected
label: 'Make.spec'
itemValue: projectMenuShowGeneratedBuildFile:
translateLabel: false
argument: 'Make.spec'
showBusyCursorWhilePerforming: true
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasSingleProjectOrProjectDefinitionSelected
label: 'app.nsi'
itemValue: projectMenuShowGeneratedBuildFile:
translateLabel: false
argument: 'app.nsi'
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasSingleProjectOrProjectDefinitionSelected
label: 'abbrev.stc'
itemValue: projectMenuShowGeneratedBuildFile:
translateLabel: false
argument: 'abbrev.stc'
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasSingleProjectOrProjectDefinitionSelected
label: 'libInit.cc'
itemValue: projectMenuShowGeneratedBuildFile:
translateLabel: false
argument: 'libInit.cc'
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasSingleProjectOrProjectDefinitionSelected
label: 'lib.rc / app.rc'
itemValue: projectMenuShowGeneratedBuildFile:
translateLabel: false
argument: 'lib.rc'
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasSingleProjectOrProjectDefinitionSelected
label: 'loadAll'
itemValue: projectMenuShowGeneratedBuildFile:
translateLabel: false
argument: 'loadAll'
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasSingleProjectOrProjectDefinitionSelected
label: 'modules.stx'
itemValue: projectMenuShowGeneratedBuildFile:
translateLabel: false
argument: 'modules.stx'
showBusyCursorWhilePerforming: true
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasSingleProjectOrProjectDefinitionSelected
label: 'bmake.bat'
itemValue: projectMenuShowGeneratedBuildFile:
translateLabel: false
argument: 'bmake.bat'
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasSingleProjectOrProjectDefinitionSelected
label: 'tccmake.bat'
itemValue: projectMenuShowGeneratedBuildFile:
translateLabel: false
isVisible: false
argument: 'tccmake.bat'
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasSingleProjectOrProjectDefinitionSelected
label: 'vcmake.bat'
itemValue: projectMenuShowGeneratedBuildFile:
translateLabel: false
argument: 'vcmake.bat'
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasSingleProjectOrProjectDefinitionSelected
label: 'mingwmake.bat'
itemValue: projectMenuShowGeneratedBuildFile:
translateLabel: false
argument: 'mingwmake.bat'
showBusyCursorWhilePerforming: true
)
)
nil
nil
)
!
editModeInfoLabelMenu
"This resource specification was automatically generated
by the MenuEditor of ST/X."
"Do not manually edit this!! If it is corrupted,
the MenuEditor may not be able to read the specification."
"
MenuEditor new openOnClass:Tools::NewSystemBrowser andSelector:#editModeInfoLabelMenu
(Menu new fromLiteralArrayEncoding:(Tools::NewSystemBrowser editModeInfoLabelMenu)) startUp
"
<resource: #menu>
^
#(Menu
(
(MenuItem
label: 'Insert'
itemValue: editModeInsert
translateLabel: true
)
(MenuItem
label: 'Overwrite'
itemValue: editModeOverwrite
translateLabel: true
)
(MenuItem
label: 'Insert Selecting'
itemValue: editModeInsertAndSelect
translateLabel: true
)
(MenuItem
label: '-'
)
(MenuItem
label: 'Learn Macro'
itemValue: toggleLearnMode
translateLabel: true
)
)
nil
nil
)
!
inheritanceViewMenu
"This resource specification was automatically generated
by the MenuEditor of ST/X."
"Do not manually edit this!! If it is corrupted,
the MenuEditor may not be able to read the specification."
"
MenuEditor new openOnClass:Tools::NewSystemBrowser andSelector:#inheritanceViewMenu
(Menu new fromLiteralArrayEncoding:(Tools::NewSystemBrowser inheritanceViewMenu)) startUp
"
<resource: #menu>
^
#(Menu
(
(MenuItem
label: 'Navigate to Selected Class'
itemValue: inheritanceMenuNavigateToClass
translateLabel: true
)
(MenuItem
label: '-'
)
(MenuItem
label: 'Update'
itemValue: inheritanceMenuUpdate
translateLabel: true
)
)
nil
nil
)
!
lintMenu
"This resource specification was automatically generated
by the MenuEditor of ST/X."
"Do not manually edit this!! If it is corrupted,
the MenuEditor may not be able to read the specification."
"
MenuEditor new openOnClass:Tools::NewSystemBrowser andSelector:#lintMenu
(Menu new fromLiteralArrayEncoding:(Tools::NewSystemBrowser lintMenu)) startUp
"
<resource: #menu>
^
#(Menu
(
(MenuItem
label: 'All'
itemValue: classMenuCheckAll
translateLabel: true
)
(MenuItem
label: '-'
)
(MenuItem
label: 'Errors'
itemValue: classMenuCheckErrors
translateLabel: true
)
(MenuItem
label: 'Possible Errors'
itemValue: classMenuCheckWarnings
translateLabel: true
)
(MenuItem
label: 'Style'
itemValue: classMenuCheckStyle
translateLabel: true
)
(MenuItem
label: '-'
)
(MenuItem
label: 'Individual Checks...'
itemValue: classMenuCheckIndividual
translateLabel: true
)
)
nil
nil
)
!
mainMenu
"This resource specification was automatically generated
by the MenuEditor of ST/X."
"Do not manually edit this!! If it is corrupted,
the MenuEditor may not be able to read the specification."
"
MenuEditor new openOnClass:Tools::NewSystemBrowser andSelector:#mainMenu
(Menu new fromLiteralArrayEncoding:(Tools::NewSystemBrowser mainMenu)) startUp
"
<resource: #menu>
^
#(Menu
(
(MenuItem
label: 'B&uffers'
submenuChannel: bufferMenu
)
(MenuItem
label: 'Browse'
submenuChannel: browseMenu
)
(MenuItem
label: 'Find'
isVisible: searchMenuVisible
submenuChannel: searchMenu
)
(MenuItem
label: 'Find'
isVisible: searchMenuInMethodListVisible
submenuChannel: searchMenuInMethodList
)
(MenuItem
label: 'View'
isVisible: viewMenuVisible
submenuChannel: viewMenu
keepLinkedMenu: true
)
(MenuItem
label: 'View'
isVisible: viewMenuForMethodListVisible
submenuChannel: viewMenuForMethodList
keepLinkedMenu: true
)
(MenuItem
label: 'Package'
isVisible: projectMenuVisible
submenuChannel: projectMenu
)
(MenuItem
label: 'Namespace'
isVisible: nameSpaceMenuVisible
submenuChannel: nameSpaceMenu
)
(MenuItem
label: 'Category'
isVisible: categoryMenuVisible
submenuChannel: categoryMenu
)
(MenuItem
label: 'Hierarchy'
isVisible: classHierarchyMenuVisible
submenuChannel: classHierarchyMenu
)
(MenuItem
label: 'Class'
isVisible: classMenuVisible
submenuChannel: classMenu
)
(MenuItem
label: 'Variable'
isVisible: variablesMenuVisible
submenuChannel: variablesMenu
)
(MenuItem
label: 'Protocol'
isVisible: protocolMenuVisible
submenuChannel: protocolMenu
)
(MenuItem
label: 'Selector'
isVisible: selectorMenuVisible
submenuChannel: selectorMenu
)
(MenuItem
label: 'Code'
isVisible: codeMenuVisible
submenuChannel: codeMenu
)
(MenuItem
label: 'Debug'
isVisible: selectorMenuVisible
submenuChannel: methodDebugMenu
)
(MenuItem
label: 'Operations'
submenuChannel: operationsMenu
)
(MenuItem
label: 'MENU_Help'
startGroup: conditionalRight
submenu:
(Menu
(
(MenuItem
label: 'Browser Documentation'
itemValue: openDocumentation
)
(MenuItem
label: 'Refactorings'
itemValue: openRefactoringDocumentation
)
(MenuItem
label: '-'
)
(MenuItem
label: 'Class Documentation'
itemValue: openClassDocumentation
)
(MenuItem
label: 'ST/X Documentation'
itemValue: openSTXDocumentation
)
(MenuItem
label: 'Keyword Index'
itemValue: openKeywordIndexDocumentation
)
(MenuItem
label: '-'
)
(MenuItem
label: 'About SystemBrowser...'
itemValue: openAboutThisApplication
)
)
nil
nil
)
)
)
nil
nil
)
!
methodDebugMenu
"This resource specification was automatically generated
by the MenuEditor of ST/X."
"Do not manually edit this!! If it is corrupted,
the MenuEditor may not be able to read the specification."
"
MenuEditor new openOnClass:Tools::NewSystemBrowser andSelector:#methodDebugMenu
(Menu new fromLiteralArrayEncoding:(Tools::NewSystemBrowser methodDebugMenu)) startUp
"
<resource: #menu>
^
#(Menu
(
(MenuItem
enabled: hasMethodWithWrapSelectedHolder
label: 'Remove Break/Trace'
itemValue: debugMenuRemoveBreakOrTrace
isVisible: hasNoMethodOrMixedWrapsSelectedHolder
)
(MenuItem
enabled: hasMethodWithBreakPointSelectedHolder
label: 'Remove Break'
itemValue: debugMenuRemoveBreakOrTrace
isVisible: hasOnlyMethodsWithBreakPointSelected
)
(MenuItem
enabled: hasMethodWithTracePointSelectedHolder
label: 'Remove Trace'
itemValue: debugMenuRemoveBreakOrTrace
isVisible: hasOnlyMethodsWithTracePointSelected
)
(MenuItem
enabled: anyBreakOrTracePointsAreSetHolder
label: 'Remove all Break- && Tracepoints'
itemValue: debugMenuRemoveAllBreakpoints
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasMethodSelectedHolder
label: 'Breakpoint'
itemValue: debugMenuBreakPoint
)
(MenuItem
enabled: hasMethodSelectedHolder
label: 'Breakpoint in Process...'
itemValue: debugMenuBreakPointIn
)
(MenuItem
enabled: hasMethodSelectedHolder
label: 'Breakpoint for Instances Of...'
itemValue: debugMenuBreakPointFor
)
(MenuItem
enabled: hasMethodSelectedHolder
label: 'Breakpoint After...'
itemValue: debugMenuBreakPointAfter
)
(MenuItem
enabled: hasMethodSelectedHolder
label: 'Breakpoint If...'
itemValue: debugMenuBreakPointIf
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasMethodSelectedHolder
label: 'Trace'
itemValue: debugMenuTrace
)
(MenuItem
enabled: hasMethodSelectedHolder
label: 'Trace Sender'
itemValue: debugMenuTraceSender
)
(MenuItem
enabled: hasMethodSelectedHolder
label: 'Trace Full Walkback'
itemValue: debugMenuTraceFullWalkback
)
(MenuItem
enabled: hasUpdateMethodSelectedHolder
label: 'Trace Change->Update Reason'
itemValue: debugMenuTraceChangeUpdate
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasMethodSelectedHolder
label: 'Tracelog'
itemValue: debugMenuTracelog
)
(MenuItem
enabled: hasMethodSelectedHolder
label: 'Tracelog Sender'
itemValue: debugMenuTracelogSender
)
(MenuItem
enabled: hasMethodSelectedHolder
label: 'Tracelog Full Walkback'
itemValue: debugMenuTracelogFullWalkback
)
(MenuItem
enabled: hasUpdateMethodSelectedHolder
label: 'Tracelog Change->Update Reason'
itemValue: debugMenuTracelogChangeUpdate
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasMethodSelectedHolder
label: 'Start Message Tally'
itemValue: debugMenuStartMessageTally
isVisible: false
)
(MenuItem
label: '-'
isVisible: false
)
(MenuItem
enabled: hasMethodSelectedHolder
label: 'Start Timing'
itemValue: debugMenuStartTiming
)
(MenuItem
enabled: hasMethodSelectedHolder
label: 'Start Counting'
itemValue: debugMenuStartCounting
)
(MenuItem
enabled: hasMethodSelectedHolder
label: 'Start Memory Usage'
itemValue: debugMenuStartMemoryUsage
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasAnyTestCaseSelectedHolder
label: 'Run Tests'
itemValue: runTestCases
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasAnyTestCaseSelectedHolder
label: 'Debug Tests'
itemValue: runTestCasesWithDebug
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasAnyTestCaseSelectedHolder
label: 'Run Tests for Coverage'
itemValue: runTestCasesForCoverage
showBusyCursorWhilePerforming: true
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasMethodSelectedAndInstrumentingCompilerExistsHolder
label: 'Recompile Method(s) without Instrumentation'
itemValue: selectorMenuRecompile
showBusyCursorWhilePerforming: true
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasMethodSelectedAndInstrumentingCompilerExistsHolder
label: 'Recompile Method(s) with Instrumentation'
itemValue: debugMenuRecompileMethodsInstrumented
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasClassSelectedAndInstrumentingCompilerExistsHolder
label: 'Recompile Class(es) with Instrumentation'
itemValue: classMenuRecompileInstrumented
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasProjectSelectedAndInstrumentingCompilerExistsHolder
label: 'Recompile Project(s) with Instrumentation'
itemValue: projectMenuRecompileInstrumented
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasMethodSelectedAndInstrumentingCompilerExistsAndOOMPackageLoadedHolder
label: 'Call Graph'
itemValue: debugMenuOpenCallGraphForMethods
showBusyCursorWhilePerforming: true
)
(MenuItem
label: 'Clear all Coverage Info (Systemwide)'
itemValue: debugMenuClearCoverageInfo
)
(MenuItem
label: 'Enable Global Coverage Recording (in all Processes)'
itemValue: debugMenuEnableGlobalCoverageRecording
isVisible: globalCoverageRecordingIsDisabled
)
(MenuItem
label: 'Disable Global Coverage Recording (in all Processes)'
itemValue: debugMenuDisableGlobalCoverageRecording
isVisible: globalCoverageRecordingIsEnabled
)
)
nil
nil
)
!
methodListMenu
"This resource specification was automatically generated
by the MenuEditor of ST/X."
"Do not manually edit this!! If it is corrupted,
the MenuEditor may not be able to read the specification."
"
MenuEditor new openOnClass:Tools::NewSystemBrowser andSelector:#methodListMenu
(Menu new fromLiteralArrayEncoding:(Tools::NewSystemBrowser methodListMenu)) startUp
"
<resource: #menu>
^
#(Menu
(
(MenuItem
label: 'FileOutPrintOutSlice'
translateLabel: true
submenuChannel: selectorMenuFileOutPrintOutSlice
isMenuSlice: true
)
(MenuItem
label: '-'
)
(MenuItem
label: 'SpawnSlice'
translateLabel: true
submenuChannel: selectorMenuSpawnSlice
isMenuSlice: true
)
(MenuItem
label: '-'
)
(MenuItem
label: 'SearchSlice'
translateLabel: true
submenuChannel: selectorMenuSearchSlice
isMenuSlice: true
)
(MenuItem
label: '-'
)
(MenuItem
label: 'CopyMoveRemoveSlice'
translateLabel: true
submenuChannel: selectorMenuCopyMoveRemoveSlice
isMenuSlice: true
)
(MenuItem
label: '-'
)
(MenuItem
label: 'CompareGenerateDebugSlice'
translateLabel: true
submenuChannel: selectorMenuCompareGenerateDebugSlice
isMenuSlice: true
)
(MenuItem
label: '-'
)
(MenuItem
label: 'Update'
itemValue: methodListMenuUpdate
translateLabel: true
)
)
nil
nil
)
!
methodRefactorMenu
"This resource specification was automatically generated
by the MenuEditor of ST/X."
"Do not manually edit this!! If it is corrupted,
the MenuEditor may not be able to read the specification."
"
MenuEditor new openOnClass:NewSystemBrowser andSelector:#methodDebugMenu
(Menu new fromLiteralArrayEncoding:(NewSystemBrowser methodDebugMenu)) startUp
"
<resource: #menu>
^
#(#Menu
#(
#(#MenuItem
#label: 'Add Parameter to Method...'
#enabled: #hasSingleMethodSelectedAndCanUseRefactoringSupportHolder
#translateLabel: true
#value: #selectorMenuAddParameter
showBusyCursorWhilePerforming: true
)
(MenuItem
label: 'Inline Parameter of Method...'
enabled: hasSingleMethodSelectedAndSingleSelectedMethodHasParameterAndCanUseRefactoringSupportHolder
itemValue: selectorMenuInlineParameter
translateLabel: true
showBusyCursorWhilePerforming: true
)
#(#MenuItem
label: 'Remove Parameter from Method...'
enabled: hasSingleMethodSelectedAndSingleSelectedMethodHasParameterAndCanUseRefactoringSupportHolder
translateLabel: true
value: #selectorMenuRemoveParameter
showBusyCursorWhilePerforming: true
)
#(#MenuItem
#label: '-'
)
#(#MenuItem
#label: 'Inline all self-Sends'
#translateLabel: true
#value: #selectorMenuInlineSelfSends
#enabled: #hasSingleMethodSelectedAndCanUseRefactoringSupportHolder
)
(MenuItem
label: '-'
)
(MenuItem
label: 'Search && Rewrite...'
itemValue: selectorMenuRewrite
translateLabel: true
)
)
nil
nil
)
"Created: / 11-09-2007 / 11:43:37 / cg"
!
nameSpaceMenu
"This resource specification was automatically generated
by the MenuEditor of ST/X."
"Do not manually edit this!! If it is corrupted,
the MenuEditor may not be able to read the specification."
"
MenuEditor new openOnClass:Tools::NewSystemBrowser andSelector:#nameSpaceMenu
(Menu new fromLiteralArrayEncoding:(Tools::NewSystemBrowser nameSpaceMenu)) startUp
"
<resource: #menu>
^
#(Menu
(
(MenuItem
enabled: hasNameSpaceSelectedAndSourceCodeManagerHolder
label: 'CVS'
translateLabel: true
submenu:
(Menu
(
(MenuItem
enabled: hasNameSpaceSelectedAndSourceCodeManagerHolder
label: 'CheckIn All...'
itemValue: nameSpaceMenuCheckInAll
translateLabel: true
labelImage: (ResourceRetriever ToolbarIconLibrary repositoryCheckIn 'CheckIn All...')
showBusyCursorWhilePerforming: true
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasNameSpaceSelectedAndSourceCodeManagerHolder
label: 'CheckOut Newest All'
itemValue: nameSpaceMenuCheckOutNewest
translateLabel: true
labelImage: (ResourceRetriever ToolbarIconLibrary repositoryCheckOut 'CheckOut Newest All')
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasNameSpaceSelectedAndSourceCodeManagerHolder
label: 'CheckOut Previous Version All...'
itemValue: nameSpaceMenuCheckOut
translateLabel: true
showBusyCursorWhilePerforming: true
)
)
nil
nil
)
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasNameSpaceSelectedHolder
label: 'Spawn'
translateLabel: true
submenu:
(Menu
(
(MenuItem
enabled: hasNameSpaceSelectedHolder
label: 'Buffer'
itemValue: nameSpaceMenuSpawnBuffer
translateLabel: true
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasNameSpaceSelectedHolder
label: 'Browser'
itemValue: nameSpaceMenuSpawn
translateLabel: true
)
)
nil
nil
)
)
(MenuItem
label: 'Find'
translateLabel: true
submenuChannel: searchMenu
)
(MenuItem
label: '-'
)
(MenuItem
label: 'New...'
itemValue: nameSpaceMenuNew
translateLabel: true
)
(MenuItem
label: '-'
)
(MenuItem
enabled: canRenameNameSpaceHolder
label: 'Rename'
itemValue: nameSpaceMenuRename
translateLabel: true
)
(MenuItem
enabled: canRemoveNameSpaceHolder
label: 'Remove'
itemValue: nameSpaceMenuRemove
translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
label: '-'
)
(MenuItem
label: 'Update'
itemValue: nameSpaceMenuUpdate
translateLabel: true
showBusyCursorWhilePerforming: true
)
)
nil
nil
)
!
projectCheckMenu
"This resource specification was automatically generated
by the MenuEditor of ST/X."
"Do not manually edit this!! If it is corrupted,
the MenuEditor may not be able to read the specification."
"
MenuEditor new openOnClass:Tools::NewSystemBrowser andSelector:#categoryCheckMenu
(Menu new fromLiteralArrayEncoding:(Tools::NewSystemBrowser categoryCheckMenu)) startUp
"
<resource: #menu>
^
#(Menu
(
(MenuItem
label: 'SmallLint Menu'
submenuChannel: smalllintCheckMenuForPackage
isMenuSlice: true
)
)
nil
nil
)
"Created: / 05-05-2012 / 10:22:19 / cg"
"Modified: / 27-11-2014 / 06:58:23 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
projectDebugMenu
"This resource specification was automatically generated
by the MenuEditor of ST/X."
"Do not manually edit this!! If it is corrupted,
the MenuEditor may not be able to read the specification."
"
MenuEditor new openOnClass:Tools::NewSystemBrowser andSelector:#projectDebugMenu
(Menu new fromLiteralArrayEncoding:(Tools::NewSystemBrowser projectDebugMenu)) startUp
"
<resource: #menu>
^
#(Menu
(
(MenuItem
enabled: hasProjectSelectedHolder
label: 'Recompile all Classes (without Instrumentation)'
itemValue: projectMenuRecompile
showBusyCursorWhilePerforming: true
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasProjectSelectedAndInstrumentingCompilerExistsHolder
label: 'Recompile all Classes with Instrumentation'
itemValue: projectMenuRecompileInstrumented
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasProjectSelectedAndInstrumentingCompilerExistsAndOOMPackageLoadedHolder
label: 'Call Graph'
itemValue: debugMenuOpenCallGraphForProjects
showBusyCursorWhilePerforming: true
)
)
nil
nil
)
!
projectMenu
"This resource specification was automatically generated
by the MenuEditor of ST/X."
"Do not manually edit this!! If it is corrupted,
the MenuEditor may not be able to read the specification."
"
MenuEditor new openOnClass:Tools::NewSystemBrowser andSelector:#projectMenu
(Menu new fromLiteralArrayEncoding:(Tools::NewSystemBrowser projectMenu)) startUp
"
<resource: #menu>
^
#(Menu (
(MenuItem
enabled: hasProjectSelectedHolder
label: 'File out'
isVisible: true
submenu:
(Menu (
(MenuItem
enabled: hasProjectSelectedHolder
label: 'As...'
itemValue: projectMenuFileOutAs
isVisible: true
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasProjectSelectedHolder
label: 'Each in...'
itemValue: projectMenuFileOutEachIn
isVisible: true
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasSingleProjectSelectedHolder
label: 'Extensions in...'
itemValue: projectMenuFileOutExtensionsIn
isVisible: true
showBusyCursorWhilePerforming: true
)
(MenuItem
label: '-'
isVisible: true
)
(MenuItem
enabled: hasProjectSelectedHolder
label: 'Special Formats'
isVisible: true
submenu:
(Menu (
(MenuItem
enabled: hasProjectSelectedAndCanFileOutXMLHolder
label: 'XML as...'
itemValue: projectMenuFileOutXMLAs
isVisible: true
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasProjectSelectedAndCanFileOutXMLHolder
label: 'XML each in...'
itemValue: projectMenuFileOutEachXMLIn
isVisible: true
showBusyCursorWhilePerforming: true
)
(MenuItem
label: '-'
isVisible: true
)
(MenuItem
enabled: hasProjectSelectedAndCanFileOutSIFHolder
label: 'SIF as...'
itemValue: projectMenuFileOutSIFAs
isVisible: true
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasProjectSelectedAndCanFileOutSIFHolder
label: 'SIF each in...'
itemValue: projectMenuFileOutEachSIFIn
isVisible: true
showBusyCursorWhilePerforming: true
)
(MenuItem
label: '-'
isVisible: true
)
(MenuItem
enabled: hasSingleProjectSelectedAndCanFileOutVSEHolder
label: 'VSE Package as...'
itemValue: projectMenuFileOutVSEPackageFormatAs
isVisible: true
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasProjectSelectedAndCanFileOutVSEHolder
label: 'VSE Fileout Format as...'
itemValue: projectMenuFileOutVSEFormatAs
isVisible: true
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasProjectSelectedAndCanFileOutVSEHolder
label: 'VSE Fileout Format each in...'
itemValue: projectMenuFileOutEachVSEIn
isVisible: false
showBusyCursorWhilePerforming: true
)
(MenuItem
label: '-'
isVisible: true
)
(MenuItem
enabled: hasProjectSelectedAndCanFileOutBeeHolder
label: 'Bee Project Source as...'
itemValue: projectMenuFileOutBeeProjectSourceAs
isVisible: true
showBusyCursorWhilePerforming: true
)
(MenuItem
label: '-'
isVisible: true
)
(MenuItem
enabled: hasProjectSelectedAndCanFileOutCypressHolder
label: 'Cypress as...'
itemValue: projectMenuFileOutCypressAs
isVisible: true
showBusyCursorWhilePerforming: true
)
(MenuItem
label: '-'
isVisible: true
)
(MenuItem
enabled: hasProjectSelectedAndCanFileOutTonelHolder
label: 'Tonel as...'
itemValue: projectMenuFileOutTonelAs
isVisible: true
showBusyCursorWhilePerforming: true
)
(MenuItem
label: '-'
isVisible: true
)
(MenuItem
enabled: hasProjectSelectedHolder
label: 'Binary each in...'
itemValue: projectMenuFileOutEachBinaryIn
isVisible: true
showBusyCursorWhilePerforming: true
)
) nil
nil
)
)
(MenuItem
label: '-'
isVisible: true
)
(MenuItem
enabled: hasProjectSelectedHolder
label: 'Build Support File in...'
itemValue: projectMenuFileOutBuildSupportFiles
isVisible: true
showBusyCursorWhilePerforming: true
)
(MenuItem
label: '-'
isVisible: true
)
(MenuItem
enabled: hasProjectSelectedHolder
label: 'Mail To...'
itemValue: projectMenuMailTo
isVisible: true
showBusyCursorWhilePerforming: true
)
) nil
nil
)
)
(MenuItem
label: 'Repository'
isVisible: true
submenuChannel: projectMenuSCMSlice
isMenuSlice: true
)
(MenuItem
label: '-'
isVisible: true
)
(MenuItem
label: 'Documentation'
isVisible: true
submenu:
(Menu (
(MenuItem
enabled: hasSingleRealProjectSelectedHolder
label: 'Generate Project Documentation In...'
itemValue: projectMenuDocumentation
isVisible: true
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasSingleRealProjectSelectedHolder
label: 'Generate Project Documentation for JavaScript In...'
itemValue: projectMenuDocumentationForJavaScript
isVisible: true
showBusyCursorWhilePerforming: true
)
(MenuItem
label: '-'
isVisible: true
)
(MenuItem
enabled: hasOOMPackageLoadedAndSingleRealProjectSelectedHolder
label: 'Metrics Summary Report'
itemValue: projectMenuMetricsSummary
isVisible: true
)
) nil
nil
)
)
(MenuItem
label: '-'
isVisible: true
)
(MenuItem
enabled: hasProjectSelectedHolder
label: 'Spawn'
isVisible: true
submenu:
(Menu (
(MenuItem
enabled: hasProjectSelectedHolder
label: 'Buffer'
itemValue: projectMenuSpawnBuffer
isVisible: true
)
(MenuItem
enabled: hasProjectSelectedHolder
label: 'Buffer with Extensions'
itemValue: projectMenuSpawnExtensionsBuffer
isVisible: true
)
(MenuItem
enabled: hasProjectSelectedHolder
label: 'Buffer with Packages Requiring this Package (as prerequisite)'
itemValue: projectMenuSpawnPreRequirerBuffer
isVisible: true
)
(MenuItem
enabled: hasProjectSelectedHolder
label: 'Buffer with Packages Referring to this Package'
itemValue: projectMenuSpawnReferencesBuffer
isVisible: true
)
(MenuItem
enabled: hasProjectSelectedHolder
label: 'Buffer with Packages Required by this Package (prerequisites)'
itemValue: projectMenuSpawnAllPrerequisitesBuffer
isVisible: true
)
(MenuItem
label: '-'
isVisible: true
)
(MenuItem
enabled: hasProjectSelectedHolder
label: 'Browser'
itemValue: projectMenuSpawn
isVisible: true
)
(MenuItem
enabled: hasProjectSelectedHolder
label: 'Browser on Extensions'
itemValue: projectMenuSpawnExtensionsBrowser
isVisible: true
)
(MenuItem
enabled: hasProjectSelectedHolder
label: 'Browser on Packages Requiring this Package (as prerequisite)'
itemValue: projectMenuSpawnPreRequirerBrowser
isVisible: true
)
(MenuItem
enabled: hasProjectSelectedHolder
label: 'Browser on Packages Referring to this Package'
itemValue: projectMenuSpawnReferencesBrowser
isVisible: true
)
(MenuItem
enabled: hasProjectSelectedHolder
label: 'Buffer with Packages Required by this Package (prerequisites)'
itemValue: projectMenuSpawnAllPrerequisitesBrowser
isVisible: true
)
(MenuItem
label: '-'
isVisible: true
)
(MenuItem
enabled: hasSingleProjectSelectedHolder
label: 'Browse Package Directory'
itemValue: projectMenuBrowsePackageDirectory
isVisible: true
)
) nil
nil
)
)
(MenuItem
enabled: hasProjectSelectedHolder
label: 'Find'
isVisible: true
submenuChannel: searchMenu
)
(MenuItem
label: '-'
isVisible: true
)
(MenuItem
label: 'New...'
itemValue: projectMenuNew
isVisible: true
)
(MenuItem
label: 'Load...'
itemValue: projectMenuLoad
isVisible: hasNoProjectSelectedHolder
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasUnloadedProjectSelectedHolder
label: 'Load'
itemValue: projectMenuLoad
isVisible: hasProjectSelectedHolder
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasRenamableProjectSelectedHolder
label: 'Rename...'
itemValue: projectMenuRename
isVisible: true
)
(MenuItem
enabled: hasProjectSelectedHolder
label: 'Remove...'
itemValue: projectMenuRemove
isVisible: true
)
(MenuItem
label: '-'
isVisible: true
)
(MenuItem
label: 'Build'
isVisible: true
submenu:
(Menu (
(MenuItem
label: 'Build with Interactive Application Packager...'
itemValue: projectMenuBuildWithApplicationPackager
isVisible: true
)
(MenuItem
enabled: hasSingleRealProjectSelectedHolder
label: 'Build Package for Deployment'
itemValue: projectMenuBuild
isVisible: true
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasSingleRealProjectSelectedHolder
label: 'Build Binaries for Execution'
itemValue: projectMenuBuildExeOnly
isVisible: true
showBusyCursorWhilePerforming: true
)
(MenuItem
label: '-'
isVisible: true
)
(MenuItem
enabled: hasProjectSelectedHolder
label: 'Generate Build Support Files in...'
itemValue: projectMenuGenerateBuildSupportFiles
isVisible: true
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasProjectSelectedHolder
label: 'Patch-Set...'
itemValue: projectMenuGeneratePatchSet
isVisible: true
showBusyCursorWhilePerforming: true
)
) nil
nil
)
)
(MenuItem
enabled: hasProjectSelectedHolder
label: 'Generate'
isVisible: true
submenu:
(Menu (
(MenuItem
enabled: hasSingleRealProjectSelectedHolder
label: 'Generate Project Definition Methods'
itemValue: projectMenuGenerateProjectDefinitions
isVisible: true
)
(MenuItem
enabled: hasSingleRealProjectSelectedHolder
label: 'Update Project Contents Definition Methods'
itemValue: projectMenuUpdateProjectContentsDefinitions
isVisible: true
)
(MenuItem
enabled: hasSingleRealProjectSelectedHolder
label: 'Regenerate Project Contents Definition Methods'
itemValue: projectMenuRegenerateProjectContentsDefinitions
isVisible: true
)
) nil
nil
)
)
(MenuItem
enabled: hasProjectSelectedAndSourceCodeManagerHolder
label: 'Package Integrity Check...'
itemValue: projectMenuCheckPackageIntegrity
isVisible: true
)
(MenuItem
label: 'Static Analysis (Lint)'
isVisible: true
submenuChannel: projectCheckMenu
labelImage: (ResourceRetriever ToolbarIconLibrary lint16x16Icon 'Static Analysis (Lint)')
)
(MenuItem
label: 'Debug'
isVisible: true
submenuChannel: projectDebugMenu
keepLinkedMenu: true
)
(MenuItem
label: 'Special'
isVisible: true
submenu:
(Menu (
(MenuItem
enabled: hasSingleRealProjectSelectedHolder
label: 'Remove from ChangeSet'
itemValue: projectMenuCleanUpChangeSet
isVisible: true
)
(MenuItem
enabled: hasPseudoProjectChangedSelectedHolder
label: 'Move Unassigned Methods to their Class''s Project'
itemValue: projectMenuMoveUnassignedMethodsToClassProject
isVisible: true
)
(MenuItem
label: '-'
isVisible: false
)
(MenuItem
enabled: hasSingleRealProjectSelectedHolder
label: 'Make Current Project'
itemValue: projectMenuMakeCurrentProject
isVisible: false
)
) nil
nil
)
)
(MenuItem
label: '-'
isVisible: true
)
(MenuItem
label: 'Search && Rewrite...'
itemValue: projectMenuRewrite
isVisible: true
)
(MenuItem
label: '-'
isVisible: true
)
(MenuItem
enabled: hasSingleRealProjectSelectedHolder
label: 'Properties...'
itemValue: projectMenuProperties
isVisible: true
)
(MenuItem
label: '-'
isVisible: true
)
(MenuItem
label: 'Update'
itemValue: projectMenuUpdate
isVisible: true
)
) nil
nil
)
!
protocolCheckMenu
"This resource specification was automatically generated
by the MenuEditor of ST/X."
"Do not manually edit this!! If it is corrupted,
the MenuEditor may not be able to read the specification."
"
MenuEditor new openOnClass:Tools::NewSystemBrowser andSelector:#protocolCheckMenu
(Menu new fromLiteralArrayEncoding:(Tools::NewSystemBrowser protocolCheckMenu)) startUp
"
<resource: #menu>
^
#(Menu
(
(MenuItem
label: 'SmallLint Menu'
submenuChannel: smalllintCheckMenuForProtocol
isMenuSlice: true
)
)
nil
nil
)
"Modified: / 27-11-2014 / 06:58:48 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
protocolMenu
"This resource specification was automatically generated
by the MenuEditor of ST/X."
"Do not manually edit this!! If it is corrupted,
the MenuEditor may not be able to read the specification."
"
MenuEditor new openOnClass:Tools::NewSystemBrowser andSelector:#protocolMenu
(Menu new fromLiteralArrayEncoding:(Tools::NewSystemBrowser protocolMenu)) startUp
"
<resource: #menu>
^
#(Menu
(
(MenuItem
enabled: hasProtocolSelectedHolder
label: 'FileOut'
submenu:
(Menu
(
(MenuItem
enabled: hasProtocolSelectedHolder
label: 'As...'
itemValue: protocolMenuFileOutAs
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasProtocolSelectedHolder
label: 'Special Formats'
isVisible: false
submenu:
(Menu
(
(MenuItem
enabled: hasProtocolSelectedAndCanFileOutXMLHolder
label: 'XML as...'
itemValue: protocolMenuFileOutXMLAs
showBusyCursorWhilePerforming: true
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasProtocolSelectedAndCanFileOutSIFHolder
label: 'SIF as...'
itemValue: protocolMenuFileOutSIFAs
showBusyCursorWhilePerforming: true
)
)
nil
nil
)
)
)
nil
nil
)
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasProtocolSelectedHolder
label: 'Documentation'
isVisible: false
submenu:
(Menu
(
(MenuItem
enabled: hasProtocolSelectedHolder
label: 'PrintOut'
itemValue: protocolMenuPrintOut
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasProtocolSelectedHolder
label: 'PrintOut Protocol'
itemValue: protocolMenuPrintOutProtocol
isVisible: false
showBusyCursorWhilePerforming: true
)
)
nil
nil
)
)
(MenuItem
enabled: hasProtocolSelectedHolder
label: 'PrintOut'
itemValue: protocolMenuPrintOut
showBusyCursorWhilePerforming: true
)
(MenuItem
label: '-'
)
(MenuItem
label: 'Spawn'
submenu:
(Menu
(
(MenuItem
enabled: hasProtocolSelectedHolder
label: 'Buffer'
itemValue: protocolMenuSpawnBuffer
)
(MenuItem
enabled: hasProtocolSelectedHolder
label: 'Buffer with Full Protocol'
itemValue: protocolMenuSpawnFullCategoryBuffer
)
(MenuItem
label: 'Buffer with Full Protocols Matching...'
itemValue: protocolMenuSpawnMatchingFullCategoryBuffer
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasProtocolSelectedHolder
label: 'Browser'
itemValue: protocolMenuSpawn
)
(MenuItem
enabled: hasProtocolSelectedHolder
label: 'Browser on Full Protocol'
itemValue: protocolMenuSpawnFullCategory
)
(MenuItem
label: 'Browser on Full Protocols Matching...'
itemValue: protocolMenuSpawnMatchingFullCategoryBrowser
)
)
nil
nil
)
)
(MenuItem
enabled: hasProtocolSelectedHolder
label: 'Find'
isVisible: false
submenu:
(Menu
(
(MenuItem
enabled: hasProtocolSelectedHolder
label: 'String...'
itemValue: protocolMenuFindString
)
)
nil
nil
)
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasClassSelectedHolder
label: 'New...'
itemValue: protocolMenuNew
)
(MenuItem
enabled: hasProtocolSelectedHolder
label: 'Copy...'
itemValue: protocolMenuCopyToClass
)
(MenuItem
enabled: hasProtocolSelectedHolder
label: 'Move'
submenu:
(Menu
(
(MenuItem
enabled: hasProtocolSelectedHolder
label: 'To Class...'
itemValue: protocolMenuMoveToClass
)
(MenuItem
enabled: hasProtocolSelectedHolder
label: 'To Project...'
itemValue: protocolMenuMoveToProject
)
)
nil
nil
)
)
(MenuItem
enabled: hasSingleRealProtocolSelectedHolder
label: 'Rename...'
itemValue: protocolMenuRename
shortcutKey: Rename
ignoreShortcutKeys: true
)
(MenuItem
enabled: hasProtocolSelectedHolder
label: 'Remove...'
itemValue: protocolMenuRemove
labelImage: (ResourceRetriever ToolbarIconLibrary erase16x16Icon 'Remove...')
)
(MenuItem
label: '-'
)
(MenuItem
label: 'Generate'
submenu:
(Menu
(
(MenuItem
label: 'Common Categories'
itemValue: protocolMenuGenerateCommonProtocols
)
(MenuItem
label: 'Documentation Method'
itemValue: protocolMenuGenerateDocumentationMethod
)
)
nil
nil
)
)
(MenuItem
label: 'Static Analysis (Lint)'
submenuChannel: protocolCheckMenu
labelImage: (ResourceRetriever ToolbarIconLibrary lint16x16Icon 'Static Analysis (Lint)')
)
(MenuItem
label: 'Update'
itemValue: protocolMenuUpdate
isVisible: false
)
)
nil
nil
)
!
refactoringMenu
"get here via codeViewMenu (holder in codeView)"
"
MenuEditor new openOnClass:Tools::NewSystemBrowser andSelector:#refactoringMenu
(Menu new fromLiteralArrayEncoding:(Tools::NewSystemBrowser refactoringMenu)) startUp
"
<resource: #menu>
^
#(Menu
(
(MenuItem
enabled: hasClassNameSelectedInCodeView
label: 'Goto Class'
itemValue: codeMenuGotoClass
translateLabel: true
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasTemporaryVariableSelectedInCodeViewHolder
label: 'Rename Local Variable...'
itemValue: codeMenuRenameTemporary
translateLabel: true
shortcutKey: Rename
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasTemporaryVariableSelectedInCodeViewHolder
label: 'Make Instance Variable'
itemValue: codeMenuMakeInstanceVariable
translateLabel: true
isVisible: hasNotMultipleTemporaryVariablesSelectedInCodeViewHolder
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasMultipleTemporaryVariablesSelectedInCodeViewHolder
label: 'Make Instance Variables'
itemValue: codeMenuMakeInstanceVariable
translateLabel: true
isVisible: hasMultipleTemporaryVariablesSelectedInCodeViewHolder
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasUndefinedUppercaseIdentifierSelectedInCodeViewHolder
label: 'Define as Class Variable'
itemValue: codeMenuDeclareSelectionAsClassVariable
translateLabel: true
)
(MenuItem
enabled: hasClassVariableSelectedInCodeViewOrVariableList
label: 'Make Pool Variable...'
itemValue: codeMenuDeclareSelectionAsPoolVariable
translateLabel: true
isVisible: false
)
(MenuItem
enabled: hasLiteralConstantSelectedInCodeViewHolder
label: 'Eliminate Constant...'
itemValue: codeMenuEliminateConstant
translateLabel: true
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasSingleMethodSelectedAndSelectionInCodeViewAndCanUseRefactoringSupportHolder
label: 'Inline Message'
itemValue: codeMenuInlineMessage
translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasSingleMethodSelectedAndSelectionInCodeViewAndCanUseRefactoringSupportHolder
label: 'Extract Selection to Temporary...'
itemValue: codeMenuExtractSelectionToTemporary
translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasSingleMethodSelectedAndSelectionInCodeViewAndCanUseRefactoringSupportHolder
label: 'Extract Method...'
itemValue: codeMenuExtractMethod
translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasSingleMethodSelectedAndSelectionInCodeViewAndSingleSelectedMethodHasParameterAndCanUseRefactoringSupportHolder
label: 'Inline Parameter of Method'
itemValue: codeMenuInlineParameter
translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasSingleMethodSelectedAndSelectionInCodeViewAndSingleSelectedMethodHasParameterAndCanUseRefactoringSupportHolder
label: 'Remove Parameter from Method'
itemValue: codeMenuRemoveParameter
translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasSingleMethodSelectedAndCanUseRefactoringSupportHolder
label: 'Format'
itemValue: codeMenuFormat
translateLabel: true
showBusyCursorWhilePerforming: true
)
)
nil
nil
)
"Modified: / 24-07-2011 / 12:34:17 / cg"
!
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:Tools::NewSystemBrowser andSelector:#searchMenu
(Menu new fromLiteralArrayEncoding:(Tools::NewSystemBrowser searchMenu)) startUp
"
<resource: #menu>
^
#(Menu
(
(MenuItem
label: 'Class...'
itemValue: searchMenuFindClass
shortcutKey: Find
ignoreShortcutKeys: true
)
(MenuItem
enabled: hasVisitedClassesHolder
label: 'Visited Classes'
submenuChannel: visitedClassesMenu
)
(MenuItem
enabled: hasChangedClassesHolder
label: 'Changed Classes'
submenuChannel: changedClassesMenu
)
(MenuItem
enabled: hasSelectedClassWithSuperclassHolder
label: 'Class Hierarchy'
submenuChannel: selectedClassesHierarchyMenu
)
(MenuItem
label: '-'
)
(MenuItem
label: 'Method...'
itemValue: searchMenuFindMethod
)
(MenuItem
enabled: hasFindHistoryClassesHolder
label: 'Visited Methods'
submenuChannel: findHistoryMenu
)
(MenuItem
enabled: hasChangedMethodsHolder
label: 'Changed Methods'
submenuChannel: changedMethodsMenu
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasSingleClassOrMethodSelectedHolder
label: 'Response to...'
itemValue: searchMenuFindResponseTo
)
(MenuItem
label: 'Response to'
isVisible: hasSingleMethodSelectedHolder
submenuChannel: sentMessagesResponseMenu
)
(MenuItem
label: '-'
)
(MenuItem
label: 'References to Class or Global...'
itemValue: browseMenuReferencesToGlobal
)
(MenuItem
label: '-'
)
(MenuItem
label: 'Bookmarks'
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
)
!
selectorCheckMenu
"This resource specification was automatically generated
by the MenuEditor of ST/X."
"Do not manually edit this!! If it is corrupted,
the MenuEditor may not be able to read the specification."
"
MenuEditor new openOnClass:Tools::NewSystemBrowser andSelector:#categoryCheckMenu
(Menu new fromLiteralArrayEncoding:(Tools::NewSystemBrowser categoryCheckMenu)) startUp
"
<resource: #menu>
^
#(Menu
(
(MenuItem
label: 'SmallLint Menu'
submenuChannel: smalllintCheckMenuForSelector
isMenuSlice: true
)
)
nil
nil
)
"Created: / 17-04-2010 / 10:48:06 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 27-11-2014 / 06:59:08 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
selectorMenu
"This resource specification was automatically generated
by the MenuEditor of ST/X."
"Do not manually edit this!! If it is corrupted,
the MenuEditor may not be able to read the specification."
"
MenuEditor new openOnClass:Tools::NewSystemBrowser andSelector:#selectorMenu
(Menu new fromLiteralArrayEncoding:(Tools::NewSystemBrowser selectorMenu)) startUp
"
<resource: #menu>
^
#(Menu
(
(MenuItem
label: 'FileOutPrintOutSlice'
translateLabel: true
submenuChannel: selectorMenuFileOutPrintOutSlice
isMenuSlice: true
)
(MenuItem
label: '-'
)
(MenuItem
label: 'SpawnSlice'
translateLabel: true
submenuChannel: selectorMenuSpawnSlice
isMenuSlice: true
)
(MenuItem
label: '-'
)
(MenuItem
label: 'SearchSlice'
translateLabel: true
submenuChannel: selectorMenuSearchSlice
isMenuSlice: true
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasClassSelectedHolder
label: 'New'
translateLabel: true
submenu:
(Menu
(
(MenuItem
enabled: hasClassSelectedHolder
label: 'Method'
itemValue: selectorMenuNewMethod
translateLabel: true
)
(MenuItem
label: '-'
)
(MenuItem
label: 'Smalltak/Ruby/... Method'
translateLabel: true
submenuChannel: selectorMenuNewSlice
isMenuSlice: true
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasClassSelectedHolder
label: 'Window Spec'
itemValue: selectorMenuNewWindowSpec
translateLabel: true
)
(MenuItem
enabled: hasClassSelectedHolder
label: 'Menu Spec'
itemValue: selectorMenuNewMenuSpec
translateLabel: true
)
(MenuItem
enabled: hasClassSelectedHolder
label: 'Image Spec'
itemValue: selectorMenuNewImageSpec
translateLabel: true
)
(MenuItem
enabled: hasClassSelectedHolder
label: 'Table-Column Spec'
itemValue: selectorMenuNewTableColumnSpec
translateLabel: true
)
)
nil
nil
)
)
(MenuItem
label: 'CopyMoveRemoveSlice'
translateLabel: true
submenuChannel: selectorMenuCopyMoveRemoveSlice
isMenuSlice: true
)
(MenuItem
label: '-'
)
(MenuItem
label: 'CompareGenerateDebugSlice'
translateLabel: true
submenuChannel: selectorMenuCompareGenerateDebugSlice
isMenuSlice: true
)
)
nil
nil
)
"Modified: / 05-07-2011 / 14:46:40 / cg"
!
selectorMenuCompareGenerateDebugSlice
"This resource specification was automatically generated
by the MenuEditor of ST/X."
"Do not manually edit this!! If it is corrupted,
the MenuEditor may not be able to read the specification."
"
MenuEditor new openOnClass:Tools::NewSystemBrowser andSelector:#selectorMenuCompareGenerateDebugSlice
(Menu new fromLiteralArrayEncoding:(Tools::NewSystemBrowser selectorMenuCompareGenerateDebugSlice)) startUp
"
<resource: #menu>
^
#(Menu
(
(MenuItem
enabled: hasMethodSelectedHolder
label: 'Compare'
submenu:
(Menu
(
(MenuItem
enabled: methodRedefinesSuperclassVersionHolder
label: 'With Inherited Method'
itemValue: selectorMenuCompareWithInherited
)
(MenuItem
enabled: methodHasPreviousVersionHolder
label: 'With Previous Version'
itemValue: selectorMenuCompareWithPreviousVersion
)
(MenuItem
enabled: methodIsShadowedHolder
label: 'With Shadowed Method'
itemValue: selectorMenuCompareWithShadowedMethod
)
(MenuItem
enabled: hasSingleMethodSelectedAndCodeModifiedHolder
label: 'With Method''s Actual Source'
itemValue: selectorMenuCompareWithMethod
)
(MenuItem
enabled: hasExactlyTwoMethodsSelectedHolder
label: 'With Each Other'
itemValue: selectorMenuCompareTwoSelectedMethods
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasMethodSelectedAndSourceCodeManagerHolder
label: 'With Newest in CVS Repository...'
itemValue: selectorMenuCompareAgainstNewestInRepositoryUsingManagerNamed:
argument: CVSSourceCodeManager
)
(MenuItem
enabled: smallTeamAvailable
label: 'With SmallTeam Version on Host'
submenuChannel: compareMethodWithSmallTeamVersionMenu
)
)
nil
nil
)
)
(MenuItem
label: 'Refactor'
submenuChannel: methodRefactorMenu
)
(MenuItem
label: 'Generate'
submenu:
(Menu
(
(MenuItem
enabled: methodNotImplementedInSuperclass
label: 'SubclassResponsibility in SuperClass'
itemValue: selectorMenuGenerateSubclassResponsibilityInSuperclass
)
(MenuItem
enabled: methodNotImplementedInClass
label: 'SubclassResponsibility here'
itemValue: selectorMenuGenerateSubclassResponsibilityHere
)
(MenuItem
enabled: methodIsTestAndNotImplementedInSuperclass
label: 'False-returning isXXX-Test in SuperClass'
itemValue: selectorMenuGenerateFalseReturnInSuperclass
)
(MenuItem
label: 'Redefinition in Subclass...'
itemValue: selectorMenuGenerateRedefinitionInSubclass
)
(MenuItem
label: 'SubclassResponsibility in direct Subclasses'
itemValue: selectorMenuGenerateTemplateInSubclasses
)
(MenuItem
label: 'SubclassResponsibility in all Subclasses'
itemValue: selectorMenuGenerateTemplateInAllSubclasses
)
(MenuItem
label: '-'
)
(MenuItem
enabled: canGenerateAspectMethodHolder
label: 'Aspect Method...'
itemValue: selectorMenuGenerateAspectMethod
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasInstanceMethodsSelectedHolder
label: 'Corresponding Instance Creation in Class'
itemValue: selectorMenuGenerateCorrespondingInstanceCreationInClass
)
(MenuItem
enabled: hasClassMethodsSelectedHolder
label: 'Forwarding Method in Instance Protocol'
itemValue: selectorMenuGenerateForwardingMethodForInstances
)
)
nil
nil
)
)
(MenuItem
label: 'Static Analysis (Lint)'
submenuChannel: selectorCheckMenu
labelImage: (ResourceRetriever ToolbarIconLibrary lint16x16Icon 'Static Analysis (Lint)')
)
(MenuItem
label: 'Debug'
submenuChannel: methodDebugMenu
shortcutKey: Ctrl
)
(MenuItem
label: 'Special'
submenu:
(Menu
(
(MenuItem
enabled: hasMethodSelectedHolder
label: 'Remove from ChangeSet'
itemValue: selectorMenuCleanUpChangeSet
)
(MenuItem
enabled: hasMethodSelectedHolder
label: 'Remove Class from ChangeSet'
itemValue: selectorMenuCleanUpChangeSetForClass
)
(MenuItem
label: '-'
)
(MenuItem
label: 'Select'
isVisible: false
submenu:
(Menu
(
(MenuItem
label: 'Methods with String...'
itemValue: selectorMenuSelectMethodsWithString
)
(MenuItem
label: 'Methods Sending...'
itemValue: selectorMenuSelectMethodsSending
)
(MenuItem
label: 'Methods Refering to Global...'
itemValue: selectorMenuSelectMethodsReferingToGlobal
)
)
nil
nil
)
)
(MenuItem
label: '-'
isVisible: false
)
(MenuItem
enabled: methodHasPreviousVersionHolder
label: 'Back to Previous Version'
itemValue: selectorMenuBackToPrevious
)
(MenuItem
enabled: methodHasPreviousVersionHolder
label: 'Previous Versions'
itemValue: selectorMenuBrowsePreviousVersions
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasSingleMethodSelectedHolder
label: 'Inspect Method'
itemValue: selectorMenuInspect
)
(MenuItem
enabled: hasSingleResourceMethodSelectedHolder
label: 'Edit Resource'
itemValue: selectorMenuEdit
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasMethodSelectedHolder
label: 'Compile with stc'
itemValue: selectorMenuCompileWithSTC
)
(MenuItem
enabled: hasSingleMethodWithBytecodeSelectedHolder
label: 'Decompile'
itemValue: selectorMenuDecompile
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasMethodSelectedHolder
label: 'Process...'
itemValue: selectorMenuProcess
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasMethodSelected
label: 'Copy Message Representation to Clipboard'
itemValue: selectorMenuCopyMessageRepresentation
)
(MenuItem
enabled: hasMethodsInList
label: 'Copy List to Clipboard'
itemValue: methodListMenuCopyList
)
(MenuItem
enabled: hasMethodsInList
label: 'Copy List of Classes to Clipboard'
itemValue: methodListMenuCopyListOfClasses
)
)
nil
nil
)
)
)
nil
nil
)
!
selectorMenuCopyMoveRemoveSlice
"This resource specification was automatically generated
by the MenuEditor of ST/X."
"Do not manually edit this!! If it is corrupted,
the MenuEditor may not be able to read the specification."
"
MenuEditor new openOnClass:Tools::NewSystemBrowser andSelector:#selectorMenuCopyMoveRemoveSlice
(Menu new fromLiteralArrayEncoding:(Tools::NewSystemBrowser selectorMenuCopyMoveRemoveSlice)) startUp
"
<resource: #menu>
^
#(Menu
(
(MenuItem
enabled: hasMethodSelectedHolder
label: 'Copy...'
itemValue: selectorMenuCopy
translateLabel: true
)
(MenuItem
enabled: hasMethodSelectedHolder
label: 'Move'
translateLabel: true
submenu:
(Menu
(
(MenuItem
enabled: hasMethodSelectedHolder
label: 'To Protocol...'
itemValue: selectorMenuMoveToProtocol
translateLabel: true
)
(MenuItem
enabled: hasMethodSelectedHolder
label: 'To Class...'
itemValue: selectorMenuMoveToClass
translateLabel: true
)
(MenuItem
enabled: hasClassMethodsOrMethodsNotReferringToSelfSelectedHolder
label: 'To Class with Forwarding...'
itemValue: selectorMenuMoveToClassWithForwarding
translateLabel: true
)
(MenuItem
enabled: hasMethodSelectedHolder
label: 'To Package...'
itemValue: selectorMenuMoveToProject
translateLabel: true
)
(MenuItem
enabled: hasExtensionMethodSelectedHolder
label: 'To Classes Package'
itemValue: selectorMenuMoveToClassProject
translateLabel: true
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasInstanceMethodsSelectedHolder
label: 'To Class Protocol (Make Class Method)'
itemValue: selectorMenuMakeClassMethod
translateLabel: true
)
(MenuItem
enabled: hasInstanceMethodsSelectedHolder
label: 'To Class Protocol (Make Class Method) with Forwarding'
itemValue: selectorMenuMakeClassMethodWithForwarding
translateLabel: true
)
(MenuItem
enabled: hasClassMethodsSelectedHolder
label: 'To Instance Protocol (Make Instance Method)'
itemValue: selectorMenuMakeInstanceMethod
translateLabel: true
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasMethodSelectedAndCanUseRefactoringSupportHolder
label: 'Push Up'
itemValue: selectorMenuPushUpMethod
translateLabel: true
)
(MenuItem
enabled: hasMethodSelectedAndCanUseRefactoringSupportHolder
label: 'Push Down'
itemValue: selectorMenuPushDownMethod
translateLabel: true
)
)
nil
nil
)
)
(MenuItem
enabled: hasMethodSelectedHolder
label: 'Visibility'
translateLabel: true
submenu:
(Menu
(
(MenuItem
enabled: hasAnyNonPublicMethodSelectedHolder
label: 'Public'
itemValue: selectorMenuMakePublic
translateLabel: true
)
(MenuItem
enabled: hasAnyNonProtectedMethodSelectedHolder
label: 'Protected'
itemValue: selectorMenuMakeProtected
translateLabel: true
labelImage: (ResourceRetriever SystemBrowser protectedMethodIcon 'Protected')
)
(MenuItem
enabled: hasAnyNonPrivateMethodSelectedHolder
label: 'Private'
itemValue: selectorMenuMakePrivate
translateLabel: true
labelImage: (ResourceRetriever SystemBrowser privateMethodIcon 'Private')
)
(MenuItem
enabled: hasAnyNonIgnoredMethodSelectedHolder
label: 'Ignored'
itemValue: selectorMenuMakeIgnored
translateLabel: true
labelImage: (ResourceRetriever SystemBrowser ignoredMethodIcon 'Ignored')
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasMethodSelectedHolder
label: 'Mark as Obsolete'
itemValue: selectorMenuMarkAsObsolete
translateLabel: true
)
)
nil
nil
)
)
(MenuItem
enabled: hasMethodSelectedAndCanUseRefactoringSupportHolder
label: 'Rename...'
itemValue: selectorMenuRename
translateLabel: true
shortcutKey: Rename
ignoreShortcutKeys: true
)
(MenuItem
enabled: hasMethodSelectedAndCanUseRefactoringSupportHolder
label: 'Safe Remove...'
itemValue: selectorMenuSaveRemove
translateLabel: true
)
(MenuItem
enabled: hasMethodSelectedHolder
label: 'Remove...'
itemValue: selectorMenuRemove
translateLabel: true
shortcutKey: Delete
labelImage: (ResourceRetriever ToolbarIconLibrary erase16x16Icon 'Remove...')
ignoreShortcutKeys: true
)
)
nil
nil
)
!
selectorMenuFileOutPrintOutSlice
"This resource specification was automatically generated
by the MenuEditor of ST/X."
"Do not manually edit this!! If it is corrupted,
the MenuEditor may not be able to read the specification."
"
MenuEditor new openOnClass:Tools::NewSystemBrowser andSelector:#selectorMenuFileOutPrintOutSlice
(Menu new fromLiteralArrayEncoding:(Tools::NewSystemBrowser selectorMenuFileOutPrintOutSlice)) startUp
"
<resource: #menu>
^
#(Menu
(
(MenuItem
enabled: hasMethodSelectedHolder
label: 'FileOut'
submenu:
(Menu
(
(MenuItem
enabled: hasMethodSelectedHolder
label: 'As...'
itemValue: selectorMenuFileOutAs
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasMethodSelectedHolder
label: 'Special Formats'
submenu:
(Menu
(
(MenuItem
enabled: hasMethodSelectedAndCanFileOutXMLHolder
label: 'XML as...'
itemValue: selectorMenuFileOutXMLAs
showBusyCursorWhilePerforming: true
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasMethodSelectedAndCanFileOutSIFHolder
label: 'SIF as...'
itemValue: selectorMenuFileOutSIFAs
showBusyCursorWhilePerforming: true
)
)
nil
nil
)
)
)
nil
nil
)
)
(MenuItem
label: 'Repository'
submenuChannel: selectorMenuSCMSlice
isMenuSlice: true
isVisible: anyRepositoryMenusAreShown
)
(MenuItem
label: 'SmallTeam'
isVisible: smallTeamAvailable
submenuChannel: selectorSmallTeamMenu
keepLinkedMenu: true
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasMethodSelectedHolder
label: 'PrintOut'
itemValue: selectorMenuPrintOut
showBusyCursorWhilePerforming: true
)
)
nil
nil
)
!
selectorMenuSearchSlice
"This resource specification was automatically generated
by the MenuEditor of ST/X."
"Do not manually edit this!! If it is corrupted,
the MenuEditor may not be able to read the specification."
"
MenuEditor new openOnClass:Tools::NewSystemBrowser andSelector:#selectorMenuSearchSlice
(Menu new fromLiteralArrayEncoding:(Tools::NewSystemBrowser selectorMenuSearchSlice)) startUp
"
<resource: #menu>
^
#(Menu
(
(MenuItem
label: 'Senders...'
itemValue: browseSendersOf
)
(MenuItem
label: 'Senders of Any...'
itemValue: browseSendersOfAny
isVisible: hasMultipleMethodsSelectedHolder
)
(MenuItem
label: 'Senders'
isVisible: hasSingleMethodSelectedHolder
submenuChannel: sentMessagesMenu
)
(MenuItem
label: 'Implementors...'
itemValue: browseMenuImplementorsOf
shortcutKey: Cmdi
ignoreShortcutKeys: true
)
(MenuItem
label: 'Implementors of Any...'
itemValue: browseMenuImplementorsOfAny
isVisible: hasMultipleMethodsSelectedHolder
)
(MenuItem
label: 'Implementors'
translateLabel: true
"/ isVisible: hasSingleMethodSelectedHolder
submenuChannel: implementedMessagesMenu
)
(MenuItem
label: 'Follow Implementation'
submenuChannel: followImplementorMessagesMenu
enabled: hasMethodWithSelfSendSelected
)
(MenuItem
label: 'Globals'
submenuChannel: globalReferencesMenu
)
(MenuItem
label: 'String Search...'
itemValue: browseMenuMethodsWithString
shortcutKey: Cmdt
ignoreShortcutKeys: true
)
(MenuItem
label: 'Code Search...'
itemValue: browseMenuMethodsWithCode
)
)
nil
nil
)
!
selectorMenuSpawnSlice
"This resource specification was automatically generated
by the MenuEditor of ST/X."
"Do not manually edit this!! If it is corrupted,
the MenuEditor may not be able to read the specification."
"
MenuEditor new openOnClass:Tools::NewSystemBrowser andSelector:#selectorMenuSpawnSlice
(Menu new fromLiteralArrayEncoding:(Tools::NewSystemBrowser selectorMenuSpawnSlice)) startUp
"
<resource: #menu>
^
#(Menu
(
(MenuItem
enabled: hasMethodSelectedHolder
label: 'Spawn'
translateLabel: true
submenu:
(Menu
(
(MenuItem
enabled: hasMethodSelectedHolder
label: 'Buffer with Full Class(es)'
itemValue: classMenuSpawnFullBrowserIn:
argument: #newBuffer
translateLabel: true
"/ isVisible: isMethodListBrowserOrHasMultipleClassesSelectedHolder
)
(MenuItem
enabled: hasMethodSelectedHolder
label: 'Buffer with Class(es)'
itemValue: methodListMenuSpawnClassesBuffer
translateLabel: true
isVisible: isMethodListBrowserOrHasMultipleClassesSelectedHolder
)
(MenuItem
enabled: hasMethodSelectedHolder
label: 'Buffer with References to Class'
itemValue: methodListMenuSpawnBufferWithClassReferences
translateLabel: true
)
(MenuItem
enabled: hasMethodSelectedHolder
label: 'Buffer with References to Class or Subclass'
itemValue: methodListMenuSpawnBufferWithClassOrSubclassReferences
translateLabel: true
)
(MenuItem
enabled: hasMultipleMethodsSelectedHolder
label: 'Buffer with Common Superclass'
itemValue: methodListMenuSpawnBufferWithCommonSuperclass
translateLabel: true
)
(MenuItem
enabled: hasMethodSelectedHolder
label: 'Buffer'
itemValue: selectorMenuSpawnMethodBuffer
translateLabel: true
)
(MenuItem
enabled: hasMethodSelectedHolder
label: 'Buffer with Implementors'
itemValue: selectorMenuSpawnImplementorsBuffer
translateLabel: true
isVisible: false
)
(MenuItem
enabled: hasMethodSelectedHolder
label: 'Buffer with Senders'
itemValue: selectorMenuSpawnSendersBuffer
translateLabel: true
isVisible: false
)
(MenuItem
enabled: hasRealExtensionMethodSelectedHolder
label: 'Buffer with Extensions for Project'
itemValue: selectorMenuSpawnProjectExtensionsBuffer
translateLabel: true
isVisible: hasExtensionMethodSelectedHolder
)
(MenuItem
enabled: hasRealExtensionMethodSelectedHolder
label: 'Buffer with Extension''s Project'
itemValue: selectorMenuSpawnExtensionsProjectBuffer
translateLabel: true
isVisible: hasExtensionMethodSelectedHolder
)
(MenuItem
enabled: hasUnassignedExtensionMethodSelectedHolder
label: 'Buffer with Unassigned Extensions'
itemValue: selectorMenuSpawnProjectExtensionsBuffer
translateLabel: true
isVisible: hasExtensionMethodSelectedHolder
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasMethodSelectedHolder
label: 'Browser on Full Class(es)'
itemValue: classMenuSpawnFullBrowserIn:
argument: #newBrowser
translateLabel: true
"/ isVisible: isMethodListBrowserOrHasMultipleClassesSelectedHolder
)
(MenuItem
enabled: hasMethodSelectedHolder
label: 'Browser on Class(es)'
itemValue: methodListMenuSpawnClasses
translateLabel: true
isVisible: isMethodListBrowserOrHasMultipleClassesSelectedHolder
)
(MenuItem
enabled: hasMethodSelectedHolder
label: 'Browser on References to Class'
itemValue: methodListMenuSpawnClassReferences
translateLabel: true
)
(MenuItem
enabled: hasMethodSelectedHolder
label: 'Browser on References to Class or Subclass'
itemValue: methodListMenuSpawnClassOrSubclassReferences
translateLabel: true
)
(MenuItem
enabled: hasMultipleMethodsSelectedHolder
label: 'Browser on Common Superclass'
itemValue: methodListMenuSpawnCommonSuperclass
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: hasRealExtensionMethodSelectedHolder
label: 'Browser on Extension''s Project'
itemValue: selectorMenuSpawnExtensionsProject
translateLabel: true
isVisible: hasExtensionMethodSelectedHolder
)
(MenuItem
enabled: hasUnassignedExtensionMethodSelectedHolder
label: 'Browser on Unassigned Extensions'
itemValue: selectorMenuSpawnProjectExtensions
translateLabel: true
isVisible: hasExtensionMethodSelectedHolder
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasMethodSelectedHolder
label: 'Browse Classes Package Directory'
itemValue: methodListMenuBrowseClassesPackageDirectory
)
(MenuItem
enabled: hasMethodSelectedHolder
label: 'Browse Class Package''s Resource Directory'
itemValue: methodListMenuBrowseClassPackagesResourceDirectory
)
)
nil
nil
)
)
(MenuItem
enabled: hasMethodSelectedHolder
label: 'Inheritance'
itemValue: selectorMenuSpawnInheritanceBuffer
translateLabel: true
)
)
nil
nil
)
"Modified: / 25-11-2016 / 15:08:57 / cg"
!
selectorSmallTeamMenu
"This resource specification was automatically generated
by the MenuEditor of ST/X."
"Do not manually edit this!! If it is corrupted,
the MenuEditor may not be able to read the specification."
"
MenuEditor new openOnClass:Tools::NewSystemBrowser andSelector:#selectorSmallTeamMenu
(Menu new fromLiteralArrayEncoding:(Tools::NewSystemBrowser selectorSmallTeamMenu)) startUp
"
<resource: #menu>
^
#(Menu
(
(MenuItem
enabled: hasMethodSelected
label: 'Load Version from Host'
translateLabel: true
submenuChannel: loadMethodFromSmallTeamHostMenu
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasMethodSelected
label: 'Compare with Version On Host'
translateLabel: true
submenuChannel: compareMethodWithSmallTeamVersionMenu
keepLinkedMenu: true
)
)
nil
nil
)
!
smellsMenu
<resource: #menu>
^
#(Menu
(
(MenuItem
enabled: hasMethodSelectedHolder
label: 'Code Duplication...'
itemValue: codeMenuSmellsLikeCodeDuplication
translateLabel: true
)
)
nil
nil
)
"Modified: / 24-07-2011 / 12:34:17 / cg"
!
specialBrowseMenu
"This resource specification was automatically generated
by the MenuEditor of ST/X."
"Do not manually edit this!! If it is corrupted,
the MenuEditor may not be able to read the specification."
"
MenuEditor new openOnClass:NewSystemBrowser andSelector:#specialBrowseMenu
(Menu new fromLiteralArrayEncoding:(NewSystemBrowser specialBrowseMenu)) startUp
"
<resource: #menu>
^
#(#Menu
#(
#(#MenuItem
#enabled: #hasCVSSourceCodeManagerHolder
#label: 'CVS Repository Diffs'
#translateLabel: true
#submenu:
#(#Menu
#(
#(#MenuItem
#label: 'Buffer'
#itemValue: #browseMenuSpawnRepositoryDiffsInBuffer
#translateLabel: true
)
#(#MenuItem
#label: '-'
)
#(#MenuItem
#label: 'Browser'
#itemValue: #browseMenuSpawnRepositoryDiffs
#translateLabel: true
)
)
nil
nil
)
)
#(#MenuItem
#label: 'Full Class Source'
#translateLabel: true
#submenu:
#(#Menu
#(
#(#MenuItem
#label: 'Buffer'
#itemValue: #browseMenuSpawnFullClassSourceInBuffer
#translateLabel: true
)
#(#MenuItem
#label: '-'
)
#(#MenuItem
#label: 'Browser'
#itemValue: #browseMenuSpawnFullClassSource
#translateLabel: true
)
)
nil
nil
)
)
#(#MenuItem
#label: 'Class Documentation'
#translateLabel: true
#submenu:
#(#Menu
#(
#(#MenuItem
#label: 'Buffer'
#itemValue: #spawnClassDocumentationBrowserIn:
#translateLabel: true
#argument: #newBuffer
)
#(#MenuItem
#label: '-'
)
#(#MenuItem
#label: 'Browser'
#itemValue: #spawnClassDocumentationBrowserIn:
#translateLabel: true
#argument: #newBrowser
)
)
nil
nil
)
)
)
nil
nil
)
!
variablesMenu
"This resource specification was automatically generated
by the MenuEditor of ST/X."
"Do not manually edit this!! If it is corrupted,
the MenuEditor may not be able to read the specification."
"
MenuEditor new openOnClass:Tools::NewSystemBrowser andSelector:#variablesMenu
(Menu new fromLiteralArrayEncoding:(Tools::NewSystemBrowser variablesMenu)) startUp
"
<resource: #menu>
^
#(Menu
(
(MenuItem
enabled: hasSingleClassSelectedAndCanUseRefactoringSupportHolder
label: 'Add...'
itemValue: variablesMenuAdd
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasSingleClassSelectedAndCanUseRefactoringSupportHolder
label: 'Add ValueHolder...'
itemValue: variablesMenuAddValueHolder
showBusyCursorWhilePerforming: true
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasNonMetaSelectedAndClassSelectedHolder
label: 'Instance Variables'
submenu:
(Menu
(
(MenuItem
enabled: hasClassSelectedHolder
label: 'All References...'
itemValue: variablesMenuBrowseAllInstVarRefs
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasClassSelectedHolder
label: 'All Readers...'
itemValue: variablesMenuBrowseAllInstVarReads
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasClassSelectedHolder
label: 'All Writers...'
itemValue: variablesMenuBrowseAllInstVarMods
showBusyCursorWhilePerforming: true
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasClassSelectedHolder
label: 'Local References...'
itemValue: variablesMenuBrowseInstVarRefs
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasClassSelectedHolder
label: 'Local Readers...'
itemValue: variablesMenuBrowseInstVarReads
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasClassSelectedHolder
label: 'Local Writers...'
itemValue: variablesMenuBrowseInstVarMods
showBusyCursorWhilePerforming: true
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasInstanceVariableSelectedInCodeViewOrVariableListAndCanUseRefactoringSupportHolder
label: 'Pull Up'
itemValue: variablesMenuPullUp
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasInstanceVariableSelectedInCodeViewOrVariableListAndCanUseRefactoringSupportHolder
label: 'Push Down'
itemValue: variablesMenuPushDown
showBusyCursorWhilePerforming: true
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasInstanceVariableSelectedInCodeViewOrVariableListAndCanUseRefactoringSupportHolder
label: 'Convert to ValueHolder'
itemValue: codeMenuConvertToValueHolder
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasSingleVariableSelectedInCodeViewOrVariableListHolder
label: 'Make Abstract (Access only via Getters/Setters)'
itemValue: codeMenuMakeAbstractVariable
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasSingleVariableSelectedInCodeViewOrVariableListHolder
label: 'Make Concrete (Protect from Access via Getters/Setters)'
itemValue: codeMenuProtectInstanceVariable
showBusyCursorWhilePerforming: true
)
)
nil
nil
)
)
(MenuItem
enabled: hasMetaSelectedAndClassSelectedHolder
label: 'Class Instance Variables'
submenu:
(Menu
(
(MenuItem
enabled: hasClassSelectedHolder
label: 'All References...'
itemValue: variablesMenuBrowseAllClassInstVarRefs
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasClassSelectedHolder
label: 'All Readers...'
itemValue: variablesMenuBrowseAllClassInstVarReads
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasClassSelectedHolder
label: 'All Writers...'
itemValue: variablesMenuBrowseAllClassInstVarMods
showBusyCursorWhilePerforming: true
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasClassSelectedHolder
label: 'Local References...'
itemValue: variablesMenuBrowseClassInstVarRefs
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasClassSelectedHolder
label: 'Local Readers...'
itemValue: variablesMenuBrowseClassInstVarReads
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasClassSelectedHolder
label: 'Local Writers...'
itemValue: variablesMenuBrowseClassInstVarMods
showBusyCursorWhilePerforming: true
)
)
nil
nil
)
)
(MenuItem
enabled: hasClassSelectedHolder
label: 'Class Variables'
submenu:
(Menu
(
(MenuItem
enabled: hasClassSelectedHolder
label: 'All References...'
itemValue: variablesMenuBrowseAllClassVarRefs
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasClassSelectedHolder
label: 'All Readers...'
itemValue: variablesMenuBrowseAllClassVarReads
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasClassSelectedHolder
label: 'All Writers...'
itemValue: variablesMenuBrowseAllClassVarMods
showBusyCursorWhilePerforming: true
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasClassSelectedHolder
label: 'Local References...'
itemValue: variablesMenuBrowseClassVarRefs
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasClassSelectedHolder
label: 'Local Readers...'
itemValue: variablesMenuBrowseClassVarReads
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasClassSelectedHolder
label: 'Writers...'
itemValue: variablesMenuBrowseClassVarMods
showBusyCursorWhilePerforming: true
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasClassVariableSelectedInCodeViewOrVariableListAndCanUseRefactoringSupportHolder
label: 'Pull Up'
itemValue: variablesMenuPullUp
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasClassVariableSelectedInCodeViewOrVariableListAndCanUseRefactoringSupportHolder
label: 'Push Down'
itemValue: variablesMenuPushDown
showBusyCursorWhilePerforming: true
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasClassVariableSelectedInCodeViewOrVariableListAndCanUseRefactoringSupportHolder
label: 'Make Abstract (Access only via Getters/Setters)'
itemValue: codeMenuMakeAbstractVariable
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasClassVariableSelectedInCodeViewOrVariableListAndCanUseRefactoringSupportHolder
label: 'Make Concrete (Protect from Access via Getters/Setters)'
itemValue: codeMenuProtectClassVariable
showBusyCursorWhilePerforming: true
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasClassVariableSelectedHolder
label: 'Clear (Set ClassVariable(s) to nil)'
itemValue: variablesMenuClear
)
)
nil
nil
)
)
(MenuItem
enabled: hasSharedPoolSelectedHolder
label: 'Pool Variables'
submenuChannel: classPoolVariablesMenu
)
(MenuItem
label: '-'
)
(MenuItem
label: 'Move'
submenu:
(Menu
(
(MenuItem
enabled: hasVariablesFromSingleClassSelectedAndCanUseRefactoringSupportHolder
label: 'Pull Up'
itemValue: variablesMenuPullUp
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasVariablesFromSingleClassSelectedAndCanUseRefactoringSupportHolder
label: 'Push Down'
itemValue: variablesMenuPushDown
showBusyCursorWhilePerforming: true
)
)
nil
nil
)
)
(MenuItem
enabled: hasSingleClassAndSingleVariableSelectedAndCanUseRefactoringSupportHolder
label: 'Rename...'
itemValue: variablesMenuRename
shortcutKey: Rename
showBusyCursorWhilePerforming: true
ignoreShortcutKeys: true
)
(MenuItem
enabled: hasClassesWithCommonSuperclassAndVariableSelectedAndCanUseRefactoringSupportHolder
label: 'Remove'
itemValue: variablesMenuRemove
labelImage: (ResourceRetriever ToolbarIconLibrary erase16x16Icon 'Remove')
showBusyCursorWhilePerforming: true
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasVariableSelected
label: 'Copy Selected Name'
itemValue: variablesMenuCopySelectedName
)
(MenuItem
label: '-'
isVisible: false
)
(MenuItem
enabled: hasVariableSelected
label: 'Find Variable'
itemValue: doFindVariable
isVisible: false
)
(MenuItem
label: '-'
)
(MenuItem
label: 'Show ClassVars (Statics)'
hideMenuOnActivated: false
indication: showClassVarsInVariableList
)
(MenuItem
label: 'Sort by Name'
hideMenuOnActivated: false
indication: sortVariablesByName
)
(MenuItem
label: 'Group by Inheritance'
hideMenuOnActivated: false
indication: groupVariablesByInheritance
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasClassSelectedHolder
label: 'Generate'
submenu:
(Menu
(
(MenuItem
enabled: canGenerateAccessMethodsHolder
label: 'Access Methods'
itemValue: variablesMenuGenerateAccessMethods
isVisible: hasVariableSelected
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: canGenerateAccessMethodsForAllHolder
label: 'Access Methods for All'
itemValue: variablesMenuGenerateAccessMethodsForAll
isVisible: hasNoVariableSelected
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: canGenerateAccessMethodsHolder
label: 'Getter Method(s)'
itemValue: variablesMenuGenerateGetterMethods
isVisible: hasVariableSelected
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: canGenerateAccessMethodsForAllHolder
label: 'Getter Method(s) for All'
itemValue: variablesMenuGenerateGetterMethodsForAll
isVisible: hasNoVariableSelected
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: canGenerateAccessMethodsHolder
label: 'Setter Method(s)'
itemValue: variablesMenuGenerateSetterMethods
isVisible: hasVariableSelected
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: canGenerateAccessMethodsForAllHolder
label: 'Setter Method(s) for All'
itemValue: variablesMenuGenerateSetterMethodsForAll
isVisible: hasNoVariableSelected
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: canGenerateMultiSetterMethodHolder
label: 'Multi-Setter Method'
itemValue: variablesMenuGenerateMultiSetterMethod
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: canGenerateMultiSetterInstanceCreationMethodHolder
label: 'Multi-Setter Instance Creation Method'
itemValue: variablesMenuGenerateMultiSetterInstanceCreationMethod
showBusyCursorWhilePerforming: true
)
(MenuItem
label: '-'
isVisible: hasNonMetaSelectedHolder
)
(MenuItem
enabled: canGenerateAccessMethodsHolder
label: 'Access Methods with Lazy Initialization in Getter'
itemValue: variablesMenuGenerateAccessMethodsWithLazyInitialization
isVisible: hasNonMetaSelectedHolder
)
(MenuItem
enabled: canGenerateAccessMethodsHolder
label: 'Access Methods with Change Notification'
itemValue: variablesMenuGenerateAccessMethodsWithChange
isVisible: hasNonMetaSelectedHolder
)
(MenuItem
enabled: canGenerateAccessMethodsHolder
label: 'Access Methods for ValueHolder'
itemValue: variablesMenuGenerateAccessMethodsForValueHolder
isVisible: hasNonMetaSelectedHolder
)
(MenuItem
enabled: canGenerateAccessMethodsHolder
label: 'Access Methods for ValueHolder with Change Notification'
itemValue: variablesMenuGenerateAccessMethodsForValueHolderWithChange
isVisible: hasNonMetaSelectedHolder
)
(MenuItem
enabled: canGenerateAccessMethodsHolder
label: 'Collection Access Methods'
itemValue: variablesMenuGenerateCollectionAccessMethods
isVisible: hasNonMetaSelectedHolder
)
)
nil
nil
)
)
(MenuItem
label: 'Debug'
submenu:
(Menu
(
(MenuItem
enabled: hasClassVariableSelectedHolder
label: 'Inspect...'
itemValue: variablesMenuInspect
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasSingleVariableSelectedHolder
label: 'Show Type(s)...'
itemValue: variablesMenuTypeInfo
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasSingleVariableSelectedHolder
label: 'Browse Type(s)'
itemValue: variablesMenuTypeBrowe
showBusyCursorWhilePerforming: true
)
)
nil
nil
)
)
)
nil
nil
)
!
viewMenu
"This resource specification was automatically generated
by the MenuEditor of ST/X."
"Do not manually edit this!! If it is corrupted,
the MenuEditor may not be able to read the specification."
"
MenuEditor new openOnClass:Tools::NewSystemBrowser andSelector:#viewMenu
(Menu new fromLiteralArrayEncoding:(Tools::NewSystemBrowser viewMenu)) startUp
"
<resource: #menu>
^
#(Menu
(
(MenuItem
label: 'Category'
translateLabel: true
isVisible: viewMenuOrganizerItemsVisible
hideMenuOnActivated: false
choice: organizerModeForMenu
choiceValue: category
)
(MenuItem
enabled: hasSingleClassSelected
label: 'Class Hierarchy'
translateLabel: true
isVisible: viewMenuOrganizerItemsVisible
hideMenuOnActivated: false
choice: organizerModeForMenu
choiceValue: classHierarchy
)
(MenuItem
enabled: hasSingleClassSelected
label: 'Class Inheritance'
translateLabel: true
isVisible: classInheritanceMenuItemVisible
hideMenuOnActivated: false
choice: organizerModeForMenu
choiceValue: classInheritance
)
(MenuItem
label: 'Hierarchy'
translateLabel: true
isVisible: viewMenuOrganizerItemsVisible
hideMenuOnActivated: false
choice: organizerModeForMenu
choiceValue: hierarchy
)
(MenuItem
label: 'Namespace'
translateLabel: true
isVisible: viewMenuOrganizerItemsVisible
hideMenuOnActivated: false
choice: organizerModeForMenu
choiceValue: namespace
)
(MenuItem
label: 'Package'
translateLabel: true
isVisible: viewMenuOrganizerItemsVisible
hideMenuOnActivated: false
choice: organizerModeForMenu
choiceValue: project
)
(MenuItem
label: 'Package Diagram'
translateLabel: true
isVisible: packageDiagramMenuItemVisible
hideMenuOnActivated: false
choice: organizerModeForMenu
choiceValue: packageDiagram
)
(MenuItem
label: '-'
isVisible: viewMenuOrganizerItemsVisible
)
(MenuItem
label: 'viewMenuCommonSlice'
translateLabel: true
submenuChannel: viewMenuCommonSlice
isMenuSlice: true
)
)
nil
nil
)
!
viewMenuCommonSlice
"This resource specification was automatically generated
by the MenuEditor of ST/X."
"Do not manually edit this!! If it is corrupted,
the MenuEditor may not be able to read the specification."
"
MenuEditor new openOnClass:Tools::NewSystemBrowser andSelector:#viewMenuCommonSlice
(Menu new fromLiteralArrayEncoding:(Tools::NewSystemBrowser viewMenuCommonSlice)) startUp
"
<resource: #menu>
^
#(Menu
(
(MenuItem
label: 'Toolbar'
translateLabel: true
hideMenuOnActivated: false
indication: toolBarVisibleHolder
)
(MenuItem
label: 'Bookmarks'
translateLabel: true
hideMenuOnActivated: false
indication: bookmarkBarVisibleHolder
)
(MenuItem
label: 'Searchbar'
translateLabel: true
hideMenuOnActivated: false
indication: stringSearchToolVisibleHolder
)
(MenuItem
label: 'Info'
translateLabel: true
hideMenuOnActivated: false
indication: codeInfoVisible
)
(MenuItem
label: '-'
)
(MenuItem
label: 'Multitab Mode'
translateLabel: true
hideMenuOnActivated: false
indication: showMultitabMode
)
(MenuItem
label: 'Enable Embedded Resource Editors'
translateLabel: true
hideMenuOnActivated: false
indication: showSpecialResourceEditors
)
(MenuItem
label: 'Coverage Info'
translateLabel: true
hideMenuOnActivated: false
indication: showCoverageInformation
)
(MenuItem
label: 'Browslet'
itemValue: showPlugin:
translateLabel: true
isVisible: false
hideMenuOnActivated: false
indication: showPlugin
)
(MenuItem
label: '-'
)
(MenuItem
label: 'Class'
translateLabel: true
submenu:
(Menu
(
(MenuItem
label: 'Hide Unloaded Classes'
translateLabel: true
hideMenuOnActivated: false
indication: hideUnloadedClasses
)
(MenuItem
label: 'Show all Classes in NameSpace View'
translateLabel: true
hideMenuOnActivated: false
indication: showAllClassesInNameSpaceOrganisation
)
(MenuItem
label: '-'
)
(MenuItem
enabled: showUnloadedClasses
label: 'Emphasize Unloaded Classes'
translateLabel: true
hideMenuOnActivated: false
indication: emphasizeUnloadedClasses
)
(MenuItem
label: 'Show Class Type Indicator'
translateLabel: true
hideMenuOnActivated: false
indication: markApplicationsHolder
)
(MenuItem
label: 'Short Class Names in Tabs'
translateLabel: true
hideMenuOnActivated: false
indication: shortNamesInTabs
)
(MenuItem
label: 'Show Class-Packages'
translateLabel: true
hideMenuOnActivated: false
indication: showClassPackages
)
(MenuItem
label: '-'
)
(MenuItem
label: 'Sort and Indent by Inheritance'
translateLabel: true
hideMenuOnActivated: false
indication: sortByNameAndInheritance
)
)
nil
nil
)
)
(MenuItem
label: 'Protocol'
translateLabel: true
submenu:
(Menu
(
(MenuItem
label: 'Show Pseudo Protocols'
translateLabel: true
hideMenuOnActivated: false
indication: showPseudoProtocols
)
)
nil
nil
)
)
(MenuItem
label: 'Selector'
translateLabel: true
submenu:
(Menu
(
(MenuItem
label: 'Show Inherited Methods'
translateLabel: true
hideMenuOnActivated: false
choice: methodVisibilityHolder
choiceValue: all
)
(MenuItem
label: 'Show Inherited Methods except Object''s'
translateLabel: true
hideMenuOnActivated: false
choice: methodVisibilityHolder
choiceValue: allButObject
)
(MenuItem
label: 'Do not Show Inherited Methods'
translateLabel: true
hideMenuOnActivated: false
choice: methodVisibilityHolder
choiceValue: class
)
(MenuItem
label: '-'
)
(MenuItem
label: 'Show Synthetic Methods'
translateLabel: true
hideMenuOnActivated: false
indication: showSyntheticMethods
)
(MenuItem
label: '-'
)
(MenuItem
label: 'Show Method Inheritance Indicator'
translateLabel: true
hideMenuOnActivated: false
indication: showMethodInheritance
)
(MenuItem
label: 'Show Method Type Indicator'
translateLabel: true
hideMenuOnActivated: false
indication: showMethodTypeIcon
)
(MenuItem
enabled: hasOOMPackageLoadedHolder
label: 'Show Method-Complexity'
translateLabel: true
hideMenuOnActivated: false
indication: showMethodComplexity
)
)
nil
nil
)
)
(MenuItem
label: 'Code'
translateLabel: true
submenu:
(Menu
(
(MenuItem
label: 'Syntax Coloring'
translateLabel: true
hideMenuOnActivated: false
indication: doSyntaxColoring
)
(MenuItem
enabled: doSyntaxColoring
label: 'Immediate Syntax Coloring'
translateLabel: true
hideMenuOnActivated: false
indication: doImmediateSyntaxColoring
)
(MenuItem
label: 'Immediate Explaining'
translateLabel: true
hideMenuOnActivated: false
indication: doImmediateExplaining
)
(MenuItem
label: 'Auto-Format Code'
translateLabel: true
hideMenuOnActivated: false
indication: doAutoFormat
)
(MenuItem
label: 'Show MethodTemplate for New Methods'
translateLabel: true
hideMenuOnActivated: false
indication: showMethodTemplate
)
)
nil
nil
)
)
(MenuItem
label: '-'
)
(MenuItem
label: 'Settings...'
itemValue: openSettingsDialog
translateLabel: true
)
)
nil
nil
)
!
viewMenuForChainBrowser
"This resource specification was automatically generated
by the MenuEditor of ST/X."
"Do not manually edit this!! If it is corrupted,
the MenuEditor may not be able to read the specification."
"
MenuEditor new openOnClass:Tools::NewSystemBrowser andSelector:#viewMenuForChainBrowser
(Menu new fromLiteralArrayEncoding:(Tools::NewSystemBrowser viewMenuForChainBrowser)) startUp
"
<resource: #menu>
^
#(Menu
(
(MenuItem
label: 'Original Order'
translateLabel: true
hideMenuOnActivated: false
choice: sortBy
choiceValue: false
)
(MenuItem
label: 'Sort by Class'
translateLabel: true
hideMenuOnActivated: false
choice: sortBy
choiceValue: class
)
(MenuItem
label: 'Sort by Selector'
translateLabel: true
hideMenuOnActivated: false
choice: sortBy
choiceValue: selector
)
(MenuItem
label: '-'
)
(MenuItem
label: 'Menu Slice'
translateLabel: true
submenuChannel: viewMenuCommonSlice
isMenuSlice: true
)
"/ (MenuItem
"/ label: '-'
"/ )
"/ (MenuItem
"/ label: 'Hide Unloaded Classes'
"/ translateLabel: true
"/ isVisible: false
"/ hideMenuOnActivated: false
"/ indication: hideUnloadedClasses
"/ )
"/ (MenuItem
"/ label: 'Short Class Names in Tabs'
"/ translateLabel: true
"/ isVisible: false
"/ hideMenuOnActivated: false
"/ indication: shortNamesInTabs
"/ )
"/ (MenuItem
"/ enabled: showUnloadedClasses
"/ label: 'Emphasize Unloaded Classes'
"/ translateLabel: true
"/ isVisible: false
"/ hideMenuOnActivated: false
"/ indication: emphasizeUnloadedClasses
"/ )
"/ (MenuItem
"/ label: '-'
"/ isVisible: false
"/ )
"/ (MenuItem
"/ label: 'Indicators'
"/ translateLabel: true
"/ submenu:
"/ (Menu
"/ (
"/ (MenuItem
"/ label: 'Show Class-Packages'
"/ translateLabel: true
"/ hideMenuOnActivated: false
"/ indication: showClassPackages
"/ )
"/ (MenuItem
"/ label: 'Show Inheritance Indicator'
"/ translateLabel: true
"/ hideMenuOnActivated: false
"/ indication: showMethodInheritance
"/ )
"/ (MenuItem
"/ label: 'Show Type Indicator'
"/ translateLabel: true
"/ hideMenuOnActivated: false
"/ indication: showMethodTypeIcon
"/ )
"/ (MenuItem
"/ enabled: hasOOMPackageLoadedHolder
"/ label: 'Show Complexity'
"/ translateLabel: true
"/ hideMenuOnActivated: false
"/ indication: showMethodComplexity
"/ )
"/ )
"/ nil
"/ nil
"/ )
"/ )
)
nil
nil
)
!
viewMenuForMethodList
"This resource specification was automatically generated
by the MenuEditor of ST/X."
"Do not manually edit this!! If it is corrupted,
the MenuEditor may not be able to read the specification."
"
MenuEditor new openOnClass:Tools::NewSystemBrowser andSelector:#viewMenuForMethodList
(Menu new fromLiteralArrayEncoding:(Tools::NewSystemBrowser viewMenuForMethodList)) startUp
"
<resource: #menu>
^
#(Menu
(
(MenuItem
label: 'Original Order'
translateLabel: true
hideMenuOnActivated: false
choice: sortBy
choiceValue: false
)
(MenuItem
label: 'Sort by Class'
translateLabel: true
hideMenuOnActivated: false
choice: sortBy
choiceValue: class
)
(MenuItem
label: 'Sort by Selector'
translateLabel: true
hideMenuOnActivated: false
choice: sortBy
choiceValue: selector
)
(MenuItem
label: 'Sort by Category'
translateLabel: true
hideMenuOnActivated: false
choice: sortBy
choiceValue: category
)
(MenuItem
label: '-'
)
(MenuItem
label: 'Menu Slice'
translateLabel: true
submenuChannel: viewMenuCommonSlice
isMenuSlice: true
)
"/ (MenuItem
"/ label: 'Toolbar'
"/ translateLabel: true
"/ hideMenuOnActivated: false
"/ indication: toolBarVisibleHolder
"/ )
"/ (MenuItem
"/ label: 'Searchbar'
"/ translateLabel: true
"/ hideMenuOnActivated: false
"/ indication: stringSearchToolVisibleHolder
"/ )
"/ (MenuItem
"/ label: 'Info'
"/ translateLabel: true
"/ hideMenuOnActivated: false
"/ indication: codeInfoVisible
"/ )
"/ (MenuItem
"/ label: '-'
"/ )
"/ (MenuItem
"/ label: 'Hide Unloaded Classes'
"/ translateLabel: true
"/ isVisible: false
"/ hideMenuOnActivated: false
"/ indication: hideUnloadedClasses
"/ )
"/ (MenuItem
"/ label: 'Short Class Names in Tabs'
"/ translateLabel: true
"/ isVisible: false
"/ hideMenuOnActivated: false
"/ indication: shortNamesInTabs
"/ )
"/ (MenuItem
"/ enabled: showUnloadedClasses
"/ label: 'Emphasize Unloaded Classes'
"/ translateLabel: true
"/ isVisible: false
"/ hideMenuOnActivated: false
"/ indication: emphasizeUnloadedClasses
"/ )
"/ (MenuItem
"/ label: '-'
"/ isVisible: false
"/ )
"/ (MenuItem
"/ label: 'Indicators'
"/ translateLabel: true
"/ submenu:
"/ (Menu
"/ (
"/ (MenuItem
"/ label: 'Show Class-Packages'
"/ translateLabel: true
"/ hideMenuOnActivated: false
"/ indication: showClassPackages
"/ )
"/ (MenuItem
"/ label: 'Show Inheritance Indicator'
"/ translateLabel: true
"/ hideMenuOnActivated: false
"/ indication: showMethodInheritance
"/ )
"/ (MenuItem
"/ label: 'Show Type Indicator'
"/ translateLabel: true
"/ hideMenuOnActivated: false
"/ indication: showMethodTypeIcon
"/ )
"/ (MenuItem
"/ enabled: hasOOMPackageLoadedHolder
"/ label: 'Show Complexity'
"/ translateLabel: true
"/ hideMenuOnActivated: false
"/ indication: showMethodComplexity
"/ )
"/ )
"/ nil
"/ nil
"/ )
"/ )
)
nil
nil
)
! !
!NewSystemBrowser class methodsFor:'menu specs-SCM-category'!
categoryMenuSCMCommon
"This resource specification was automatically generated
by the MenuEditor of ST/X."
"Do not manually edit this!! If it is corrupted,
the MenuEditor may not be able to read the specification."
"
MenuEditor new openOnClass:Tools::NewSystemBrowser andSelector:#categoryMenuSCMSlice_old
(Menu new fromLiteralArrayEncoding:(Tools::NewSystemBrowser categoryMenuSCMSlice_old)) startUp
"
<resource: #menu>
^
#(Menu
(
(MenuItem
enabled: hasCategorySelectedAndSourceCodeManagerHolder
label: 'CheckIn all...'
itemValue: categoryMenuCheckInEachUsingManager:
translateLabel: true
argument: SourceCodeManagerPlaceholder
labelImage: (ResourceRetriever ToolbarIconLibrary repositoryCheckIn 'CheckIn all...')
showBusyCursorWhilePerforming: true
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasCategorySelectedAndSourceCodeManagerHolder
label: 'CheckOut Newest All'
itemValue: categoryMenuCheckOutNewestUsingManager:
translateLabel: true
argument: SourceCodeManagerPlaceholder
labelImage: (ResourceRetriever ToolbarIconLibrary repositoryCheckOut 'CheckOut Newest All')
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasCategorySelectedAndSourceCodeManagerHolder
label: 'CheckOut Previous Versions All...'
itemValue: categoryMenuCheckOutUsingManager:
translateLabel: true
argument: SourceCodeManagerPlaceholder
showBusyCursorWhilePerforming: true
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasSourceCodeManagerHolder
label: 'Repository History...'
itemValue: categoryMenuRepositoryHistoryUsingManager:
translateLabel: true
argument: SourceCodeManagerPlaceholder
labelImage: (ResourceRetriever ToolbarIconLibrary repositoryLog 'Repository History...')
showBusyCursorWhilePerforming: true
)
)
nil
nil
)
"Created: / 15-10-2011 / 12:22:55 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 23-07-2012 / 15:13:51 / cg"
!
categoryMenuSCMSlice
"This resource specification was automatically generated
by the MenuEditor of ST/X."
"Do not manually edit this!! If it is corrupted,
the MenuEditor may not be able to read the specification."
"
MenuEditor new openOnClass:Tools::NewSystemBrowser andSelector:#categoryMenuSCMSlice
(Menu new fromLiteralArrayEncoding:(Tools::NewSystemBrowser categoryMenuSCMSlice)) startUp
"
<resource: #menu>
^
#(Menu
(
(MenuItem
label: 'CVS'
translateLabel: true
submenu:
(Menu
(
(MenuItem
enabled: hasCategorySelectedAndCVSSourceCodeManagerHolder
label: 'CheckIn all...'
itemValue: categoryMenuCheckInEachUsingManager:
translateLabel: true
argument: SourceCodeManagerNamePlaceholder
labelImage: (ResourceRetriever ToolbarIconLibrary repositoryCheckIn 'CheckIn all...')
showBusyCursorWhilePerforming: true
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasCategorySelectedAndCVSSourceCodeManagerHolder
label: 'CheckOut Newest All'
itemValue: categoryMenuCheckOutNewestUsingManager:
argument: SourceCodeManagerNamePlaceholder
translateLabel: true
labelImage: (ResourceRetriever ToolbarIconLibrary repositoryCheckOut 'CheckOut Newest All')
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasCategorySelectedAndCVSSourceCodeManagerHolder
label: 'CheckOut Previous Versions All...'
itemValue: categoryMenuCheckOutUsingManager:
argument: SourceCodeManagerNamePlaceholder
translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasCVSSourceCodeManagerHolder
label: 'Repository History...'
itemValue: categoryMenuRepositoryHistory
translateLabel: true
labelImage: (ResourceRetriever ToolbarIconLibrary repositoryLog 'Repository History...')
showBusyCursorWhilePerforming: true
)
)
nil
nil
)
labelImage: (ResourceRetriever ToolbarIconLibrary repositoryCVSIcon 'CVS')
)
)
nil
nil
)
"Modified: / 01-12-2011 / 21:16:05 / cg"
!
categoryMenuSCMSliceAll
"This resource specification was automatically generated
by the MenuEditor of ST/X."
"Do not manually edit this!! If it is corrupted,
the MenuEditor may not be able to read the specification."
"
MenuEditor new openOnClass:Tools::NewSystemBrowser andSelector:#categoryMenuSCMSliceAll
(Menu new fromLiteralArrayEncoding:(Tools::NewSystemBrowser categoryMenuSCMSliceAll)) startUp
"
<resource: #menu>
^
#(Menu
(
(MenuItem
enabled: hasCategorySelectedAndCVSSourceCodeManagerHolder
label: 'CVS'
translateLabel: true
submenuChannel: categoryMenuSCMFor:
labelImage: (ResourceRetriever ToolbarIconLibrary repositoryCVSIcon 'CVS')
argument: CVSSourceCodeManager
keepLinkedMenu: true
)
(MenuItem
enabled: hasClassesSelectedAndSubversionRepositoryExistsHolder
label: 'SubVersion'
translateLabel: true
isVisible: hasSubversionSupport
submenuChannel: categoryMenuSCMFor:
labelImage: (ResourceRetriever ToolbarIconLibrary repositorySVNIcon 'SubVersion')
argument: SVNSourceCodeManager
)
(MenuItem
enabled: hasProjectSelectedAndSourceCodeManagerHolder
label: 'Mercurial+'
isVisible: hgRepositoryMenusAreShown
submenuChannel: projectMenuSCMFor:
labelImage: (ResourceRetriever ToolbarIconLibrary repositoryP4Icon 'Mercurial+')
argument: HGSourceCodeManager
)
(MenuItem
enabled: hasClassSelectedAndSourceCodeManagerHolder
label: 'Perforce'
translateLabel: true
isVisible: hasPerforceSupport
submenuChannel: categoryMenuSCMFor:
labelImage: (ResourceRetriever ToolbarIconLibrary repositorySVNIcon 'Perforce')
argument: PerforceSourceCodeManager
)
(MenuItem
enabled: hasClassSelectedAndSourceCodeManagerHolder
label: 'Git+'
isVisible: git2RepositoryMenusAreShown
submenuChannel: categoryMenuSCMFor:
labelImage: (ResourceRetriever ToolbarIconLibrary repositorySVNIcon 'Git+')
argument: GitSourceCodeManager2
)
)
nil
nil
)
!
categoryMenuSCMSlice_compact
"This resource specification was automatically generated
by the MenuEditor of ST/X."
"Do not manually edit this!! If it is corrupted,
the MenuEditor may not be able to read the specification."
"
MenuEditor new openOnClass:Tools::NewSystemBrowser andSelector:#classMenuSCMSlice_compact
(Menu new fromLiteralArrayEncoding:(Tools::NewSystemBrowser classMenuSCMSlice_compact)) startUp
"
<resource: #menu>
^
#(Menu
(
(MenuItem
label: 'Repository'
nameKey: SCM
translateLabel: true
submenu:
(Menu
(
(MenuItem
label: 'Common Slice'
nameKey: CommonSlice
translateLabel: true
submenuChannel: categoryMenuSCMFor:
argument: SourceCodeManagerNamePlaceholder
isMenuSlice: true
)
(MenuItem
label: '-'
)
(MenuItem
label: 'All Slice'
translateLabel: true
submenuChannel: categoryMenuSCMSliceAll
isMenuSlice: true
)
(MenuItem
label: '-'
)
(MenuItem
label: 'Repository Settings'
itemValue: openSettingsDialogAndSelectSourceCodeManagement
translateLabel: true
)
)
nil
nil
)
)
)
nil
nil
)
"Created: / 15-10-2011 / 12:21:39 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 23-07-2012 / 15:14:32 / cg"
!
categoryMenuSCMSlice_inline
"This resource specification was automatically generated
by the MenuEditor of ST/X."
"Do not manually edit this!! If it is corrupted,
the MenuEditor may not be able to read the specification."
"
MenuEditor new openOnClass:Tools::NewSystemBrowser andSelector:#classMenuSCMSlice_inline
(Menu new fromLiteralArrayEncoding:(Tools::NewSystemBrowser classMenuSCMSlice_inline)) startUp
"
<resource: #menu>
^
#(Menu
(
(MenuItem
label: '-'
)
(MenuItem
label: 'All Slice'
translateLabel: true
submenuChannel: categoryMenuSCMSliceAll
isMenuSlice: true
)
)
nil
nil
)
"Created: / 15-10-2011 / 12:21:58 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
categoryMenuSCMSlice_old
"This resource specification was automatically generated
by the MenuEditor of ST/X."
"Do not manually edit this!! If it is corrupted,
the MenuEditor may not be able to read the specification."
"
MenuEditor new openOnClass:Tools::NewSystemBrowser andSelector:#categoryMenuSCMSlice_old
(Menu new fromLiteralArrayEncoding:(Tools::NewSystemBrowser categoryMenuSCMSlice_old)) startUp
"
<resource: #menu>
^
#(Menu
(
(MenuItem
label: 'CVS'
translateLabel: true
submenu:
(Menu
(
(MenuItem
enabled: hasCategorySelectedAndCVSSourceCodeManagerHolder
label: 'CheckIn all...'
itemValue: categoryMenuCheckInEachUsingManager:
argument: SourceCodeManagerPlaceholder
translateLabel: true
labelImage: (ResourceRetriever ToolbarIconLibrary repositoryCheckIn 'CheckIn all...')
showBusyCursorWhilePerforming: true
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasCategorySelectedAndCVSSourceCodeManagerHolder
label: 'CheckOut Newest All'
itemValue: categoryMenuCheckOutNewestUsingManager:
translateLabel: true
argument: SourceCodeManagerPlaceholder
labelImage: (ResourceRetriever ToolbarIconLibrary repositoryCheckOut 'CheckOut Newest All')
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasCategorySelectedAndCVSSourceCodeManagerHolder
label: 'CheckOut Previous Versions All...'
itemValue: categoryMenuCheckOutUsingManager:
argument: SourceCodeManagerPlaceholder
translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasCVSSourceCodeManagerHolder
label: 'Repository History...'
itemValue: categoryMenuRepositoryHistory
translateLabel: true
labelImage: (ResourceRetriever ToolbarIconLibrary repositoryLog 'Repository History...')
showBusyCursorWhilePerforming: true
)
)
nil
nil
)
labelImage: (ResourceRetriever ToolbarIconLibrary repositoryCVSIcon 'CVS')
)
)
nil
nil
)
! !
!NewSystemBrowser class methodsFor:'menu specs-SCM-class'!
classCVSMenu
"This resource specification was automatically generated
by the MenuEditor of ST/X."
"Do not manually edit this!! If it is corrupted,
the MenuEditor may not be able to read the specification."
"
MenuEditor new openOnClass:Tools::NewSystemBrowser andSelector:#classCVSMenu
(Menu new fromLiteralArrayEncoding:(Tools::NewSystemBrowser classCVSMenu)) startUp
"
<resource: #menu>
^
#(Menu
(
(MenuItem
label: '** No SourceCodeManager - See Settings in the Launcher **'
isVisible: hasNoSourceCodeManagerHolder
)
(MenuItem
label: '-'
isVisible: hasNoSourceCodeManagerHolder
)
(MenuItem
enabled: hasClassSelectedAndSourceCodeManagerHolder
label: 'CheckIn...'
itemValue: classMenuCheckInUsingManagerNamed:
labelImage: (ResourceRetriever ToolbarIconLibrary repositoryCheckIn 'CheckIn...')
argument: CVSSourceCodeManager
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasClassWithExtensionsSelectedHolder
label: 'CheckIn Extensions For'
submenuChannel: browseClassExtensionsMenu
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: changeSetContainsChangedClassesAndSourceCodeManagerHolder
label: 'CheckIn all Changed Classes'
itemValue: classMenuCheckInAllChangedClasses
showBusyCursorWhilePerforming: true
)
(MenuItem
label: 'Quick CheckIn...'
itemValue: classMenuQuickCheckIn
isVisible: hasClassSelectedAndControlKeyDownHolder
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasProjectDefinitionSelectedAndSourceCodeManagerHolder
label: 'CheckIn Build Support Files...'
itemValue: classMenuCheckInBuildSupportFiles
showBusyCursorWhilePerforming: true
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasNonPrivateClassSelectedAndSourceCodeManagerHolder
label: 'CheckOut Newest'
itemValue: classMenuCheckOutNewest
labelImage: (ResourceRetriever ToolbarIconLibrary repositoryCheckOut 'CheckOut Newest')
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasNonPrivateClassSelectedAndSourceCodeManagerHolder
label: 'CheckOut Previous Version...'
itemValue: classMenuCheckOut
showBusyCursorWhilePerforming: true
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasSingleClassSelectedAndSourceCodeManagerHolder
label: 'Browse and Compare all Versions in Repository'
itemValue: classMenuBrowseAllVersionsInRepository
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasClassSelectedAndSourceCodeManagerHolder
label: 'Compare with Newest in Repository'
itemValue: classMenuCompareAgainstNewestInRepository
labelImage: (ResourceRetriever ToolbarIconLibrary repositoryVersions 'Compare with Newest in Repository')
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasSingleClassSelectedAndSourceCodeManagerHolder
label: 'Compare with Original in Repository'
itemValue: classMenuCompareAgainstOriginalInRepository
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasSingleClassSelectedAndSourceCodeManagerHolder
label: 'Compare with Stable Version in Repository'
itemValue: classMenuCompareAgainstStableInRepository
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasSingleClassSelectedAndSourceCodeManagerHolder
label: 'Compare with Repository...'
itemValue: classMenuCompareWithRepository
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasSingleClassSelectedAndSourceCodeManagerHolder
label: 'Compare two Repository Versions...'
itemValue: classMenuCompareTwoRepositoryVersions
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasProjectDefinitionOrClassWithExtensionsSelectedAndSourceCodeManagerHolder
label: 'Compare Extensions with Repository...'
itemValue: classMenuCompareExtensionsWithRepository
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasProjectDefinitionSelectedAndSourceCodeManagerHolder
label: 'Compare Build Support File'
submenuChannel: compareBuildSupportFileMenu
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasSingleClassSelectedAndSourceCodeManagerHolder
label: 'Edit Version in Repository...'
itemValue: classMenuEditVersionInRepository
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasSingleClassSelectedAndSourceCodeManagerHolder
label: 'Create PatchFile against Version...'
itemValue: classMenuCreatePatchFileAgainstVersionFromRepository
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasNonPrivateClassSelectedAndSourceCodeManagerHolder
label: 'Set Tag...'
itemValue: classMenuSetTag
labelImage: (ResourceRetriever ToolbarIconLibrary repositoryTag 'Set Tag...')
showBusyCursorWhilePerforming: true
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasNonPrivateClassSelectedAndSourceCodeManagerHolder
label: 'Revision Log (Recent Changes)'
itemValue: classMenuShortRevisionLog
labelImage: (ResourceRetriever ToolbarIconLibrary repositoryLog 'Revision Log (Recent Changes)')
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasNonPrivateClassSelectedAndSourceCodeManagerHolder
label: 'Revision Log (Full)'
itemValue: classMenuRevisionLog
showBusyCursorWhilePerforming: true
)
)
nil
nil
)
!
classDataBaseRepositoryMenu
"This resource specification was automatically generated
by the MenuEditor of ST/X."
"Do not manually edit this!! If it is corrupted,
the MenuEditor may not be able to read the specification."
"
MenuEditor new openOnClass:Tools::NewSystemBrowser andSelector:#classDataBaseRepositoryMenu
(Menu new fromLiteralArrayEncoding:(Tools::NewSystemBrowser classDataBaseRepositoryMenu)) startUp
"
<resource: #menu>
^
#(Menu
(
(MenuItem
enabled: hasClassSelectedAndSourceCodeManagerHolder
label: 'CheckIn...'
itemValue: classMenuCheckInUsingManagerNamed:
translateLabel: true
labelImage: (ResourceRetriever ToolbarIconLibrary repositoryCheckIn 'CheckIn...')
argument: DataBaseSourceCodeManager
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasClassWithExtensionsSelectedHolder
label: 'CheckIn Extensions For'
translateLabel: true
submenuChannel: browseClassExtensionsMenuUsingManagerNamed:
argument: DataBaseSourceCodeManager
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: changeSetContainsChangedClassesAndSourceCodeManagerHolder
label: 'CheckIn all Changed Classes'
itemValue: classMenuCheckInAllChangedClassesUsingManagerNamed:
translateLabel: true
argument: DataBaseSourceCodeManager
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasProjectDefinitionSelectedAndSourceCodeManagerHolder
label: 'CheckIn Build Support Files...'
itemValue: classMenuCheckInBuildSupportFilesUsingManagerNamed:
translateLabel: true
argument: DataBaseSourceCodeManager
showBusyCursorWhilePerforming: true
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasNonPrivateClassSelectedAndSourceCodeManagerHolder
label: 'CheckOut Newest'
itemValue: classMenuCheckOutNewestUsingManagerNamed:
translateLabel: true
labelImage: (ResourceRetriever ToolbarIconLibrary repositoryCheckOut 'CheckOut Newest')
argument: DataBaseSourceCodeManager
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasNonPrivateClassSelectedAndSourceCodeManagerHolder
label: 'CheckOut Previous Version...'
itemValue: classMenuCheckOutUsingManagerNamed:
translateLabel: true
argument: DataBaseSourceCodeManager
showBusyCursorWhilePerforming: true
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasSingleClassSelectedAndSourceCodeManagerHolder
label: 'Browse and Compare all Versions in Repository'
itemValue: classMenuBrowseAllVersionsInRepository
translateLabel: true
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasClassSelectedAndSourceCodeManagerHolder
label: 'Compare with Newest in Repository'
itemValue: classMenuCompareAgainstNewestInRepositoryUsingManagerNamed:
translateLabel: true
labelImage: (ResourceRetriever ToolbarIconLibrary repositoryVersions 'Compare with Newest in Repository...')
argument: DataBaseSourceCodeManager
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasSingleClassSelectedAndSourceCodeManagerHolder
label: 'Compare with Original in Repository'
itemValue: classMenuCompareAgainstOriginalInRepositoryUsingManagerNamed:
translateLabel: true
argument: DataBaseSourceCodeManager
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasSingleClassSelectedAndSourceCodeManagerHolder
label: 'Compare with Stable Version in Repository'
itemValue: classMenuCompareAgainstStableInRepositoryUsingManagerNamed:
translateLabel: true
argument: DataBaseSourceCodeManager
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasSingleClassSelectedAndSourceCodeManagerHolder
label: 'Compare with Repository...'
itemValue: classMenuCompareWithRepositoryUsingManagerNamed:
translateLabel: true
argument: DataBaseSourceCodeManager
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasSingleClassSelectedAndSourceCodeManagerHolder
label: 'Compare two Repository Versions...'
itemValue: classMenuCompareTwoRepositoryVersionsUsingManagerNamed:
translateLabel: true
argument: DataBaseSourceCodeManager
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasProjectDefinitionOrClassWithExtensionsSelectedAndSourceCodeManagerHolder
label: 'Compare Extensions with Repository...'
itemValue: classMenuCompareExtensionsWithRepositoryUsingManagerNamed:
translateLabel: true
argument: DataBaseSourceCodeManager
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasProjectDefinitionSelectedAndSourceCodeManagerHolder
label: 'Compare Build Support File'
translateLabel: true
submenuChannel: compareBuildSupportFileMenuUsingManagerNamed:
argument: DataBaseSourceCodeManager
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasNonPrivateClassSelectedAndSourceCodeManagerHolder
label: 'Revision Log (Recent Changes)'
itemValue: classMenuShortRevisionLogUsingManagerNamed:
translateLabel: true
labelImage: (ResourceRetriever ToolbarIconLibrary repositoryLog 'Revision Log (Recent Changes)')
argument: DataBaseSourceCodeManager
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasNonPrivateClassSelectedAndSourceCodeManagerHolder
label: 'Revision Log (Full)'
itemValue: classMenuRevisionLogUsingManagerNamed:
translateLabel: true
argument: DataBaseSourceCodeManager
showBusyCursorWhilePerforming: true
)
)
nil
nil
)
"Modified: / 28-10-2012 / 11:58:35 / cg"
!
classFileBasedRepositoryMenu
"This resource specification was automatically generated
by the MenuEditor of ST/X."
"Do not manually edit this!! If it is corrupted,
the MenuEditor may not be able to read the specification."
"
MenuEditor new openOnClass:Tools::NewSystemBrowser andSelector:#classFileBasedRepositoryMenu
(Menu new fromLiteralArrayEncoding:(Tools::NewSystemBrowser classFileBasedRepositoryMenu)) startUp
"
<resource: #menu>
^
#(Menu
(
(MenuItem
enabled: hasClassSelectedAndSourceCodeManagerHolder
label: 'CheckIn...'
itemValue: classMenuCheckInUsingManagerNamed:
translateLabel: true
labelImage: (ResourceRetriever ToolbarIconLibrary repositoryCheckIn 'CheckIn...')
argument: FileBasedSourceCodeManager
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasClassWithExtensionsSelectedHolder
label: 'CheckIn Extensions For'
translateLabel: true
submenuChannel: browseClassExtensionsMenuUsingManagerNamed:
argument: FileBasedSourceCodeManager
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: changeSetContainsChangedClassesAndSourceCodeManagerHolder
label: 'CheckIn all Changed Classes'
itemValue: classMenuCheckInAllChangedClassesUsingManagerNamed:
translateLabel: true
argument: FileBasedSourceCodeManager
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasProjectDefinitionSelectedAndSourceCodeManagerHolder
label: 'CheckIn Build Support Files...'
itemValue: classMenuCheckInBuildSupportFilesUsingManagerNamed:
translateLabel: true
argument: FileBasedSourceCodeManager
showBusyCursorWhilePerforming: true
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasNonPrivateClassSelectedAndSourceCodeManagerHolder
label: 'CheckOut Newest'
itemValue: classMenuCheckOutNewestUsingManagerNamed:
translateLabel: true
labelImage: (ResourceRetriever ToolbarIconLibrary repositoryCheckOut 'CheckOut Newest')
argument: FileBasedSourceCodeManager
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasNonPrivateClassSelectedAndSourceCodeManagerHolder
label: 'CheckOut Previous Version...'
itemValue: classMenuCheckOutUsingManagerNamed:
translateLabel: true
argument: FileBasedSourceCodeManager
showBusyCursorWhilePerforming: true
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasSingleClassSelectedAndSourceCodeManagerHolder
label: 'Browse and Compare all Versions in Repository'
itemValue: classMenuBrowseAllVersionsInRepository
translateLabel: true
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasClassSelectedAndSourceCodeManagerHolder
label: 'Compare with Newest in Repository'
itemValue: classMenuCompareAgainstNewestInRepositoryUsingManagerNamed:
translateLabel: true
labelImage: (ResourceRetriever ToolbarIconLibrary repositoryVersions 'Compare with Newest in Repository...')
argument: FileBasedSourceCodeManager
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasSingleClassSelectedAndSourceCodeManagerHolder
label: 'Compare with Original in Repository'
itemValue: classMenuCompareAgainstOriginalInRepositoryUsingManagerNamed:
translateLabel: true
argument: FileBasedSourceCodeManager
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasSingleClassSelectedAndSourceCodeManagerHolder
label: 'Compare with Repository...'
itemValue: classMenuCompareWithRepositoryUsingManagerNamed:
translateLabel: true
argument: FileBasedSourceCodeManager
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasSingleClassSelectedAndSourceCodeManagerHolder
label: 'Compare two Repository Versions...'
itemValue: classMenuCompareTwoRepositoryVersionsUsingManagerNamed:
translateLabel: true
argument: FileBasedSourceCodeManager
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasProjectDefinitionOrClassWithExtensionsSelectedAndSourceCodeManagerHolder
label: 'Compare Extensions with Repository...'
itemValue: classMenuCompareExtensionsWithRepositoryUsingManagerNamed:
translateLabel: true
argument: FileBasedSourceCodeManager
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasProjectDefinitionSelectedAndSourceCodeManagerHolder
label: 'Compare Build Support File'
translateLabel: true
submenuChannel: compareBuildSupportFileMenuUsingManagerNamed:
argument: FileBasedSourceCodeManager
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasNonPrivateClassSelectedAndSourceCodeManagerHolder
label: 'Revision Log (Recent Changes)'
itemValue: classMenuShortRevisionLogUsingManagerNamed:
translateLabel: true
labelImage: (ResourceRetriever ToolbarIconLibrary repositoryLog 'Revision Log (Recent Changes)')
argument: FileBasedSourceCodeManager
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasNonPrivateClassSelectedAndSourceCodeManagerHolder
label: 'Revision Log (Full)'
itemValue: classMenuRevisionLogUsingManagerNamed:
translateLabel: true
argument: FileBasedSourceCodeManager
showBusyCursorWhilePerforming: true
)
)
nil
nil
)
"Modified: / 28-10-2012 / 11:58:48 / cg"
!
classGitMenu
"This resource specification was automatically generated
by the MenuEditor of ST/X."
"Do not manually edit this!! If it is corrupted,
the MenuEditor may not be able to read the specification."
"
MenuEditor new openOnClass:Tools::NewSystemBrowser andSelector:#classGitMenu
(Menu new fromLiteralArrayEncoding:(Tools::NewSystemBrowser classGitMenu)) startUp
"
<resource: #menu>
^
#(Menu
(
(MenuItem
label: '** No SourceCodeManager - See Settings in the Launcher **'
translateLabel: true
isVisible: hasNoSourceCodeManagerHolder
)
(MenuItem
label: '-'
isVisible: hasNoSourceCodeManagerHolder
)
(MenuItem
enabled: hasClassSelectedAndSourceCodeManagerHolder
label: 'CheckIn...'
itemValue: classMenuCheckInUsingManagerNamed:
translateLabel: true
isVisible: false
labelImage: (ResourceRetriever ToolbarIconLibrary repositoryCheckIn 'CheckIn...')
argument: GitSourceCodeManager
showBusyCursorWhilePerforming: true
)
(MenuItem
label: '-'
isVisible: false
)
(MenuItem
enabled: hasNonPrivateClassSelectedAndSourceCodeManagerHolder
label: 'CheckOut Newest'
itemValue: classMenuCheckOutNewestUsingManagerNamed:
translateLabel: true
isVisible: false
labelImage: (ResourceRetriever ToolbarIconLibrary repositoryCheckOut 'CheckOut Newest')
argument: GitSourceCodeManager
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasNonPrivateClassSelectedAndSourceCodeManagerHolder
label: 'CheckOut Previous Version...'
itemValue: classMenuCheckOutUsingManagerNamed:
translateLabel: true
isVisible: false
argument: GitSourceCodeManager
showBusyCursorWhilePerforming: true
)
(MenuItem
label: '-'
isVisible: false
)
(MenuItem
enabled: hasClassSelectedAndSourceCodeManagerHolder
label: 'Compare with Newest in Repository'
itemValue: classMenuCompareAgainstNewestInRepositoryUsingManagerNamed:
translateLabel: true
labelImage: (ResourceRetriever ToolbarIconLibrary repositoryVersions 'Compare with Newest in Repository...')
argument: GitSourceCodeManager
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasSingleClassSelectedAndSourceCodeManagerHolder
label: 'Compare with Original in Repository'
itemValue: classMenuCompareAgainstOriginalInRepositoryUsingManagerNamed:
translateLabel: true
argument: GitSourceCodeManager
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasSingleClassSelectedAndSourceCodeManagerHolder
label: 'Compare with Stable Version in Repository'
itemValue: classMenuCompareAgainstStableInRepositoryUsingManagerNamed:
translateLabel: true
argument: GitSourceCodeManager
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasSingleClassSelectedAndSourceCodeManagerHolder
label: 'Compare with Repository...'
itemValue: classMenuCompareWithRepositoryUsingManagerNamed:
translateLabel: true
argument: GitSourceCodeManager
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasSingleClassSelectedAndSourceCodeManagerHolder
label: 'Compare two Repository Versions...'
itemValue: classMenuCompareTwoRepositoryVersionsUsingManagerNamed:
translateLabel: true
argument: GitSourceCodeManager
showBusyCursorWhilePerforming: true
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasNonPrivateClassSelectedAndSourceCodeManagerHolder
label: 'Set Tag...'
itemValue: classMenuSetTagUsingManagerNamed:
translateLabel: true
isVisible: false
labelImage: (ResourceRetriever ToolbarIconLibrary repositoryTag 'Set Tag...')
argument: GitSourceCodeManager
showBusyCursorWhilePerforming: true
)
(MenuItem
label: '-'
isVisible: false
)
(MenuItem
enabled: hasNonPrivateClassSelectedAndSourceCodeManagerHolder
label: 'Revision Log (Recent Changes)'
itemValue: classMenuShortRevisionLogUsingManagerNamed:
translateLabel: true
labelImage: (ResourceRetriever ToolbarIconLibrary repositoryLog 'Revision Log (Recent Changes)')
argument: GitSourceCodeManager
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasNonPrivateClassSelectedAndSourceCodeManagerHolder
label: 'Revision Log (Full)'
itemValue: classMenuRevisionLogUsingManagerNamed:
translateLabel: true
argument: GitSourceCodeManager
showBusyCursorWhilePerforming: true
)
)
nil
nil
)
"Modified: / 28-10-2012 / 11:59:05 / cg"
!
classMenuSCMCommon
"This resource specification was automatically generated
by the MenuEditor of ST/X."
"Do not manually edit this!! If it is corrupted,
the MenuEditor may not be able to read the specification."
"
MenuEditor new openOnClass:Tools::NewSystemBrowser andSelector:#classMenuSCMCommon
(Menu new fromLiteralArrayEncoding:(Tools::NewSystemBrowser classMenuSCMCommon)) startUp
"
<resource: #menu>
^
#(Menu
(
(MenuItem
enabled: hasClassSelectedAndSourceCodeManagerHolder
label: 'CheckIn...'
itemValue: classMenuCheckInUsingManagerNamed:
translateLabel: true
labelImage: (ResourceRetriever ToolbarIconLibrary repositoryCheckIn 'CheckIn...')
argument: SourceCodeManagerNamePlaceholder
showBusyCursorWhilePerforming: true
)
(MenuItem
label: 'CheckIn (Quick)...'
itemValue: classMenuQuickCheckInUsingManagerNamed:
translateLabel: true
isVisible: hasClassSelectedAndControlKeyDownHolder
argument: SourceCodeManagerNamePlaceholder
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasClassWithExtensionsSelectedHolder
label: 'CheckIn Extensions For'
translateLabel: true
argument: SourceCodeManagerNamePlaceholder
submenuChannel: browseClassExtensionsMenuUsingManagerNamed:
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: changeSetContainsChangedClassesAndSourceCodeManagerHolder
label: 'CheckIn all Changed Classes'
itemValue: classMenuCheckInAllChangedClassesUsingManagerNamed:
translateLabel: true
argument: SourceCodeManagerNamePlaceholder
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasProjectDefinitionSelectedAndSourceCodeManagerHolder
label: 'CheckIn Build Support Files...'
itemValue: classMenuCheckInBuildSupportFilesUsingManagerNamed:
translateLabel: true
argument: SourceCodeManagerNamePlaceholder
showBusyCursorWhilePerforming: true
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasNonPrivateClassSelectedAndSourceCodeManagerHolder
label: 'CheckOut Newest'
itemValue: classMenuCheckOutNewestUsingManagerNamed:
translateLabel: true
labelImage: (ResourceRetriever ToolbarIconLibrary repositoryCheckOut 'CheckOut Newest')
argument: SourceCodeManagerNamePlaceholder
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasNonPrivateClassSelectedAndSourceCodeManagerHolder
label: 'CheckOut Previous Version...'
itemValue: classMenuCheckOutUsingManagerNamed:
translateLabel: true
argument: SourceCodeManagerNamePlaceholder
showBusyCursorWhilePerforming: true
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasNonPrivateClassSelectedAndSourceCodeManagerHolder
label: 'Revision Log (Recent Changes)'
itemValue: classMenuShortRevisionLogUsingManagerNamed:
translateLabel: true
labelImage: (ResourceRetriever ToolbarIconLibrary repositoryLog 'Revision Log (Recent Changes)')
argument: SourceCodeManagerNamePlaceholder
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasNonPrivateClassSelectedAndSourceCodeManagerHolder
label: 'Revision Log (Full)'
itemValue: classMenuRevisionLogUsingManagerNamed:
translateLabel: true
argument: SourceCodeManagerNamePlaceholder
showBusyCursorWhilePerforming: true
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasSingleClassSelectedAndSourceCodeManagerHolder
label: 'Browse and Compare all Versions in Repository'
itemValue: classMenuBrowseAllVersionsInRepository
translateLabel: true
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasClassSelectedAndSourceCodeManagerHolder
label: 'Compare with Newest in Repository'
itemValue: classMenuCompareAgainstNewestInRepositoryUsingManagerNamed:
translateLabel: true
labelImage: (ResourceRetriever ToolbarIconLibrary repositoryVersions 'Compare with Newest in Repository...')
argument: SourceCodeManagerNamePlaceholder
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasSingleClassSelectedAndSourceCodeManagerHolder
label: 'Compare with Original in Repository'
itemValue: classMenuCompareAgainstOriginalInRepositoryUsingManagerNamed:
translateLabel: true
argument: SourceCodeManagerNamePlaceholder
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasSingleClassSelectedAndSourceCodeManagerHolder
label: 'Compare with Stable Version in Repository'
itemValue: classMenuCompareAgainstStableInRepositoryUsingManagerNamed:
translateLabel: true
argument: SourceCodeManagerNamePlaceholder
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasSingleClassSelectedAndSourceCodeManagerHolder
label: 'Compare with Repository...'
itemValue: classMenuCompareWithRepositoryUsingManagerNamed:
translateLabel: true
argument: SourceCodeManagerNamePlaceholder
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasSingleClassSelectedAndSourceCodeManagerHolder
label: 'Compare two Repository Versions...'
itemValue: classMenuCompareTwoRepositoryVersionsUsingManagerNamed:
translateLabel: true
argument: SourceCodeManagerNamePlaceholder
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasProjectDefinitionOrClassWithExtensionsSelectedAndSourceCodeManagerHolder
label: 'Compare Extensions with Repository...'
itemValue: classMenuCompareExtensionsWithRepositoryUsingManagerNamed:
translateLabel: true
argument: SourceCodeManagerNamePlaceholder
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasProjectDefinitionSelectedAndSourceCodeManagerHolder
label: 'Compare Build Support File'
translateLabel: true
argument: SourceCodeManagerNamePlaceholder
submenuChannel: projectMenuSCMCompareBuildSupportFileForManagerNamed:
argument: Default
)
(MenuItem
label: 'Extras'
translateLabel: true
submenuChannel: classMenuSCMExtraForManagerNamed:
argument: SourceCodeManagerNamePlaceholder
isMenuSlice: true
)
)
nil
nil
)
"Modified: / 12-10-2011 / 20:24:01 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 28-10-2012 / 11:59:42 / cg"
!
classMenuSCMExtra_CVS
"This resource specification was automatically generated
by the MenuEditor of ST/X."
"Do not manually edit this!! If it is corrupted,
the MenuEditor may not be able to read the specification."
"
MenuEditor new openOnClass:Tools::NewSystemBrowser andSelector:#classMenuSCMExtra_CVS
(Menu new fromLiteralArrayEncoding:(Tools::NewSystemBrowser classMenuSCMExtra_CVS)) startUp
"
<resource: #menu>
^
#(Menu
(
(MenuItem
enabled: hasSingleClassSelectedAndSourceCodeManagerHolder
label: 'Edit Version in Repository (Create Branch) ...'
itemValue: classMenuEditVersionInRepository
translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasSingleClassSelectedAndSourceCodeManagerHolder
label: 'Create PatchFile against Version...'
itemValue: classMenuCreatePatchFileAgainstVersionFromRepository
translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasNonPrivateClassSelectedAndSourceCodeManagerHolder
label: 'Set Tag...'
itemValue: classMenuSetTag
translateLabel: true
labelImage: (ResourceRetriever ToolbarIconLibrary repositoryTag 'Set Tag...')
showBusyCursorWhilePerforming: true
)
)
nil
nil
)
!
classMenuSCMExtra_Git
"This resource specification was automatically generated
by the MenuEditor of ST/X."
"Do not manually edit this!! If it is corrupted,
the MenuEditor may not be able to read the specification."
"
MenuEditor new openOnClass:Tools::NewSystemBrowser andSelector:#classMenuSCMExtra_SVN
(Menu new fromLiteralArrayEncoding:(Tools::NewSystemBrowser classMenuSCMExtra_SVN)) startUp
"
<resource: #menu>
^
#(Menu
(
(MenuItem
enabled: hasClassesSelectedAndSubversionRepositoryExistsAndBranchSelectedHolder
label: 'Changeset'
translateLabel: true
submenuChannel: classSubversionChangesetMenu
)
(MenuItem
label: 'Branch'
translateLabel: true
submenuChannel: commonSubversionBranchMenu
)
(MenuItem
label: 'Browse working copy'
itemValue: commonMenuSubversionBrowseWorkingCopy
translateLabel: true
)
(MenuItem
label: 'More'
translateLabel: true
submenu:
(Menu
(
(MenuItem
label: 'Common Slice'
translateLabel: true
submenuChannel: commonSubversionMenuSlice
isMenuSlice: true
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasClassesSelectedAndSubversionRepositoryExistsAndBranchSelectedHolder
label: 'Compare'
translateLabel: true
submenuChannel: classSubversionCompareMenu
labelImage: (ResourceRetriever #'SVN::IconLibrary' compare 'Compare')
)
(MenuItem
enabled: hasClassesSelectedAndSubversionRepositoryExistsAndBranchSelectedHolder
label: 'Browse Revision log'
itemValue: classMenuSubversionShowRevisionLog
translateLabel: true
labelImage: (ResourceRetriever #'SVN::IconLibrary' log 'Browse Revision log')
)
)
nil
nil
)
)
)
nil
nil
)
"Created: / 23-07-2012 / 13:27:23 / cg"
!
classMenuSCMExtra_Mercurial
"This resource specification was automatically generated
by the MenuEditor of ST/X."
"Do not manually edit this!! If it is corrupted,
the MenuEditor may not be able to read the specification."
"
MenuEditor new openOnClass:Tools::NewSystemBrowser andSelector:#classMenuSCMExtra_SVN
(Menu new fromLiteralArrayEncoding:(Tools::NewSystemBrowser classMenuSCMExtra_SVN)) startUp
"
<resource: #menu>
^
#(Menu
(
(MenuItem
enabled: hasClassesSelectedAndSubversionRepositoryExistsAndBranchSelectedHolder
label: 'Changeset'
translateLabel: true
submenuChannel: classSubversionChangesetMenu
)
(MenuItem
label: 'Branch'
translateLabel: true
submenuChannel: commonSubversionBranchMenu
)
(MenuItem
label: 'Browse working copy'
itemValue: commonMenuSubversionBrowseWorkingCopy
translateLabel: true
)
(MenuItem
label: 'More'
translateLabel: true
submenu:
(Menu
(
(MenuItem
label: 'Common Slice'
translateLabel: true
submenuChannel: commonSubversionMenuSlice
isMenuSlice: true
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasClassesSelectedAndSubversionRepositoryExistsAndBranchSelectedHolder
label: 'Compare'
translateLabel: true
submenuChannel: classSubversionCompareMenu
labelImage: (ResourceRetriever #'SVN::IconLibrary' compare 'Compare')
)
(MenuItem
enabled: hasClassesSelectedAndSubversionRepositoryExistsAndBranchSelectedHolder
label: 'Browse Revision log'
itemValue: classMenuSubversionShowRevisionLog
translateLabel: true
labelImage: (ResourceRetriever #'SVN::IconLibrary' log 'Browse Revision log')
)
)
nil
nil
)
)
)
nil
nil
)
"Created: / 15-01-2012 / 14:35:48 / cg"
!
classMenuSCMExtra_SVN
"This resource specification was automatically generated
by the MenuEditor of ST/X."
"Do not manually edit this!! If it is corrupted,
the MenuEditor may not be able to read the specification."
"
MenuEditor new openOnClass:Tools::NewSystemBrowser andSelector:#classMenuSCMExtra_SVN
(Menu new fromLiteralArrayEncoding:(Tools::NewSystemBrowser classMenuSCMExtra_SVN)) startUp
"
<resource: #menu>
^
#(Menu
(
(MenuItem
enabled: hasClassesSelectedAndSubversionRepositoryExistsAndBranchSelectedHolder
label: 'Changeset'
translateLabel: true
submenuChannel: classSubversionChangesetMenu
)
(MenuItem
label: 'Branch'
translateLabel: true
submenuChannel: commonSubversionBranchMenu
)
(MenuItem
label: 'Browse working copy'
itemValue: commonMenuSubversionBrowseWorkingCopy
translateLabel: true
)
(MenuItem
label: 'More'
translateLabel: true
submenu:
(Menu
(
(MenuItem
label: 'Common Slice'
translateLabel: true
submenuChannel: commonSubversionMenuSlice
isMenuSlice: true
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasClassesSelectedAndSubversionRepositoryExistsAndBranchSelectedHolder
label: 'Compare'
translateLabel: true
submenuChannel: classSubversionCompareMenu
labelImage: (ResourceRetriever #'SVN::IconLibrary' compare 'Compare')
)
(MenuItem
enabled: hasClassesSelectedAndSubversionRepositoryExistsAndBranchSelectedHolder
label: 'Browse Revision log'
itemValue: classMenuSubversionShowRevisionLog
translateLabel: true
labelImage: (ResourceRetriever #'SVN::IconLibrary' log 'Browse Revision log')
)
)
nil
nil
)
)
)
nil
nil
)
!
classMenuSCMSlice
"This resource specification was automatically generated
by the MenuEditor of ST/X."
"Do not manually edit this!! If it is corrupted,
the MenuEditor may not be able to read the specification."
"
MenuEditor new openOnClass:Tools::NewSystemBrowser andSelector:#classMenuSCMSlice
(Menu new fromLiteralArrayEncoding:(Tools::NewSystemBrowser classMenuSCMSlice)) startUp
"
<resource: #menu>
^
#(Menu
(
(MenuItem
enabled: hasClassSelectedAndCVSSourceCodeManagerHolder
label: 'CVS'
isVisible: cvsRepositoryMenusAreShown
submenuChannel: classCVSMenu
labelImage: (ResourceRetriever ToolbarIconLibrary repositoryCVSIcon 'CVS')
argument: 'CVS'
keepLinkedMenu: true
)
(MenuItem
enabled: hasClassesSelectedAndSubversionRepositoryExistsHolder
label: 'SubVersion'
isVisible: svnRepositoryMenusAreShown
submenuChannel: classSubversionMenu
labelImage: (ResourceRetriever ToolbarIconLibrary repositorySVNIcon 'SubVersion')
)
(MenuItem
enabled: hasClassesSelectedAndFileBasedRepositoryExistsHolder
label: 'File Repository'
isVisible: fileBasedRepositoryMenusAreShown
submenuChannel: classFileBasedRepositoryMenu
labelImage: (ResourceRetriever ToolbarIconLibrary repositoryIcon 'File Repository')
)
(MenuItem
enabled: hasClassesSelectedAndDataBaseRepositoryExistsHolder
label: 'Database Repository'
isVisible: dataBaseRepositoryMenusAreShown
submenuChannel: classDataBaseRepositoryMenu
labelImage: (ResourceRetriever ToolbarIconLibrary repositoryIcon 'Database Repository')
)
(MenuItem
enabled: hasClassesSelectedAndMercurialRepositoryExistsHolder
label: 'Mercurial'
isVisible: mercurialRepositoryMenusAreShown
submenuChannel: classMercurialMenu
labelImage: (ResourceRetriever ToolbarIconLibrary repositoryHGIcon 'Mercurial')
)
)
nil
nil
)
!
classMenuSCMSliceAll
"This resource specification was automatically generated
by the MenuEditor of ST/X."
"Do not manually edit this!! If it is corrupted,
the MenuEditor may not be able to read the specification."
"
MenuEditor new openOnClass:Tools::NewSystemBrowser andSelector:#classMenuSCMSliceAll
(Menu new fromLiteralArrayEncoding:(Tools::NewSystemBrowser classMenuSCMSliceAll)) startUp
"
<resource: #menu>
^
#(Menu
(
(MenuItem
enabled: hasClassSelectedAndCVSSourceCodeManagerHolder
isVisible: cvsRepositoryMenusAreShown
label: 'CVS'
translateLabel: true
submenuChannel: classMenuSCMFor:
labelImage: (ResourceRetriever ToolbarIconLibrary repositoryCVSIcon 'CVS')
argument: CVSSourceCodeManager
keepLinkedMenu: true
)
(MenuItem
enabled: hasClassesSelectedAndDataBaseRepositoryExistsHolder
isVisible: dataBaseRepositoryMenusAreShown
label: 'Database Repository'
translateLabel: true
submenuChannel: classMenuSCMFor:
labelImage: (ResourceRetriever ToolbarIconLibrary repositoryIcon 'Database Repository')
argument: DataBaseSourceCodeManager
)
(MenuItem
enabled: hasClassesSelectedAndFileBasedRepositoryExistsHolder
label: 'File Repository'
isVisible: fileBasedRepositoryMenusAreShown
translateLabel: true
submenuChannel: classMenuSCMFor:
labelImage: (ResourceRetriever ToolbarIconLibrary repositoryIcon 'File Repository')
argument: FileBasedSourceCodeManager
)
(MenuItem
enabled: hasClassesSelectedAndSubversionRepositoryExistsHolder
isVisible: svnRepositoryMenusAreShown
label: 'SubVersion'
translateLabel: true
submenuChannel: classMenuSCMFor:
labelImage: (ResourceRetriever ToolbarIconLibrary repositorySVNIcon 'SubVersion')
argument: SVNSourceCodeManager
)
(MenuItem
enabled: hasClassSelectedAndSourceCodeManagerHolder
label: 'Mercurial+'
isVisible: hgRepositoryMenusAreShown
submenuChannel: classMenuSCMFor:
labelImage: (ResourceRetriever ToolbarIconLibrary repositoryHGIcon 'Mercurial+')
argument: HGSourceCodeManager
)
(MenuItem
enabled: hasClassSelectedAndSourceCodeManagerHolder
label: 'Git+'
isVisible: git2RepositoryMenusAreShown
submenuChannel: classMenuSCMFor:
labelImage: (ResourceRetriever ToolbarIconLibrary repositorySVNIcon 'Git+')
argument: GitSourceCodeManager2
)
(MenuItem
enabled: hasClassSelectedAndSourceCodeManagerHolder
label: 'Mercurial'
isVisible: mercurialRepositoryMenusAreShown
translateLabel: true
submenuChannel: classMenuSCMFor:
labelImage: (ResourceRetriever ToolbarIconLibrary repositoryHGIcon 'Mercurial')
argument: MercurialSourceCodeManager
)
(MenuItem
enabled: hasClassSelectedAndSourceCodeManagerHolder
isVisible: perforceRepositoryMenusAreShown
label: 'Perforce'
translateLabel: true
submenuChannel: classMenuSCMFor:
labelImage: (ResourceRetriever ToolbarIconLibrary repositorySVNIcon 'Perforce')
argument: PerforceSourceCodeManager
)
)
nil
nil
)
!
classMenuSCMSlice_compact
"This resource specification was automatically generated
by the MenuEditor of ST/X."
"Do not manually edit this!! If it is corrupted,
the MenuEditor may not be able to read the specification."
"
MenuEditor new openOnClass:Tools::NewSystemBrowser andSelector:#classMenuSCMSlice_compact
(Menu new fromLiteralArrayEncoding:(Tools::NewSystemBrowser classMenuSCMSlice_compact)) startUp
"
<resource: #menu>
^
#(Menu
(
(MenuItem
label: 'Repository'
nameKey: SCM
translateLabel: true
submenu:
(Menu
(
(MenuItem
label: 'Common Slice'
nameKey: CommonSlice
translateLabel: true
submenuChannel: classMenuSCMFor:
argument: SourceCodeManagerNamePlaceholder
isMenuSlice: true
)
(MenuItem
label: '-'
)
(MenuItem
label: 'All Slice'
translateLabel: true
submenuChannel: classMenuSCMSliceAll
isMenuSlice: true
)
(MenuItem
label: '-'
)
(MenuItem
label: 'Repository Settings'
itemValue: openSettingsDialogAndSelectSourceCodeManagement
translateLabel: true
)
)
nil
nil
)
)
)
nil
nil
)
"Modified: / 15-10-2011 / 12:04:06 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 23-07-2012 / 15:15:37 / cg"
!
classMenuSCMSlice_inline
"This resource specification was automatically generated
by the MenuEditor of ST/X."
"Do not manually edit this!! If it is corrupted,
the MenuEditor may not be able to read the specification."
"
MenuEditor new openOnClass:Tools::NewSystemBrowser andSelector:#classMenuSCMSlice_inline
(Menu new fromLiteralArrayEncoding:(Tools::NewSystemBrowser classMenuSCMSlice_inline)) startUp
"
<resource: #menu>
^
#(Menu
(
(MenuItem
label: '-'
)
(MenuItem
label: 'All Slice'
translateLabel: true
submenuChannel: classMenuSCMSliceAll
isMenuSlice: true
)
)
nil
nil
)
!
classMenuSCMSlice_old
"This resource specification was automatically generated
by the MenuEditor of ST/X."
"Do not manually edit this!! If it is corrupted,
the MenuEditor may not be able to read the specification."
"
MenuEditor new openOnClass:Tools::NewSystemBrowser andSelector:#classMenuSCMSlice_old
(Menu new fromLiteralArrayEncoding:(Tools::NewSystemBrowser classMenuSCMSlice_old)) startUp
"
<resource: #menu>
^
#(Menu
(
(MenuItem
enabled: hasClassSelectedAndCVSSourceCodeManagerHolder
label: 'CVS'
isVisible: cvsRepositoryMenusAreShown
translateLabel: true
submenuChannel: classCVSMenu
labelImage: (ResourceRetriever ToolbarIconLibrary repositoryCVSIcon 'CVS')
argument: 'CVS'
keepLinkedMenu: true
)
(MenuItem
enabled: hasClassesSelectedAndDataBaseRepositoryExistsHolder
isVisible: dataBaseRepositoryMenusAreShown
label: 'Database Repository'
translateLabel: true
submenuChannel: classDataBaseRepositoryMenu
labelImage: (ResourceRetriever ToolbarIconLibrary repositoryIcon 'Database Repository')
)
(MenuItem
enabled: hasClassesSelectedAndFileBasedRepositoryExistsHolder
label: 'File Repository'
isVisible: fileBasedRepositoryMenusAreShown
translateLabel: true
submenuChannel: classFileBasedRepositoryMenu
labelImage: (ResourceRetriever ToolbarIconLibrary repositoryIcon 'File Repository')
)
(MenuItem
enabled: hasClassesSelectedAndGitRepositoryExistsHolder
isVisible: gitRepositoryClassMenusAreShown
label: 'Git'
translateLabel: true
submenuChannel: classGitMenu
labelImage: (ResourceRetriever ToolbarIconLibrary repositoryGitIcon 'Git')
)
(MenuItem
enabled: hasClassesSelectedAndMercurialRepositoryExistsHolder
isVisible: mercurialRepositoryMenusAreShown
label: 'Mercurial'
translateLabel: true
submenuChannel: classMercurialMenu
labelImage: (ResourceRetriever ToolbarIconLibrary repositoryHGIcon 'Mercurial')
)
(MenuItem
enabled: hasClassesSelectedAndPerforceRepositoryExistsHolder
isVisible: perforceRepositoryMenusAreShown
label: 'Perforce'
translateLabel: true
submenuChannel: classPerforceMenu
labelImage: (ResourceRetriever ToolbarIconLibrary repositoryP4Icon 'Perforce')
)
(MenuItem
enabled: hasClassesSelectedAndSubversionRepositoryExistsHolder
isVisible: svnRepositoryMenusAreShown
label: 'SubVersion'
translateLabel: true
submenuChannel: classSubversionMenu
labelImage: (ResourceRetriever ToolbarIconLibrary repositorySVNIcon 'SubVersion')
)
)
nil
nil
)
"Modified: / 24-07-2012 / 17:41:18 / cg"
!
classMercurialMenu
"This resource specification was automatically generated
by the MenuEditor of ST/X."
"Do not manually edit this!! If it is corrupted,
the MenuEditor may not be able to read the specification."
"
MenuEditor new openOnClass:Tools::NewSystemBrowser andSelector:#classMercurialMenu
(Menu new fromLiteralArrayEncoding:(Tools::NewSystemBrowser classMercurialMenu)) startUp
"
<resource: #menu>
^
#(Menu
(
(MenuItem
label: '** No SourceCodeManager - See Settings in the Launcher **'
translateLabel: true
isVisible: hasNoSourceCodeManagerHolder
)
(MenuItem
label: '-'
isVisible: hasNoSourceCodeManagerHolder
)
(MenuItem
enabled: hasClassSelectedAndSourceCodeManagerHolder
label: 'CheckIn...'
itemValue: classMenuCheckInUsingManagerNamed:
translateLabel: true
isVisible: false
labelImage: (ResourceRetriever ToolbarIconLibrary repositoryCheckIn 'CheckIn...')
argument: MercurialSourceCodeManager
showBusyCursorWhilePerforming: true
)
(MenuItem
label: '-'
isVisible: false
)
(MenuItem
enabled: hasNonPrivateClassSelectedAndSourceCodeManagerHolder
label: 'CheckOut Newest'
itemValue: classMenuCheckOutNewestUsingManagerNamed:
translateLabel: true
isVisible: false
labelImage: (ResourceRetriever ToolbarIconLibrary repositoryCheckOut 'CheckOut Newest')
argument: MercurialSourceCodeManager
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasNonPrivateClassSelectedAndSourceCodeManagerHolder
label: 'CheckOut Previous Version...'
itemValue: classMenuCheckOutUsingManagerNamed:
translateLabel: true
isVisible: false
argument: MercurialSourceCodeManager
showBusyCursorWhilePerforming: true
)
(MenuItem
label: '-'
isVisible: false
)
(MenuItem
enabled: hasSingleClassSelectedAndSourceCodeManagerHolder
label: 'Edit Version in Repository...'
itemValue: classMenuEditVersionInRepositoryUsingManagerNamed:
translateLabel: true
isVisible: false
argument: MercurialSourceCodeManager
showBusyCursorWhilePerforming: true
)
(MenuItem
label: '-'
isVisible: false
)
(MenuItem
enabled: hasClassSelectedAndSourceCodeManagerHolder
label: 'Compare with Newest in Repository'
itemValue: classMenuCompareAgainstNewestInRepositoryUsingManagerNamed:
translateLabel: true
labelImage: (ResourceRetriever ToolbarIconLibrary repositoryVersions 'Compare with Newest in Repository...')
argument: MercurialSourceCodeManager
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasSingleClassSelectedAndSourceCodeManagerHolder
label: 'Compare with Original in Repository'
itemValue: classMenuCompareAgainstOriginalInRepositoryUsingManagerNamed:
translateLabel: true
argument: MercurialSourceCodeManager
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasSingleClassSelectedAndSourceCodeManagerHolder
label: 'Compare with Stable Version in Repository'
itemValue: classMenuCompareAgainstStableInRepositoryUsingManagerNamed:
translateLabel: true
argument: MercurialSourceCodeManager
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasSingleClassSelectedAndSourceCodeManagerHolder
label: 'Compare with Repository...'
itemValue: classMenuCompareWithRepositoryUsingManagerNamed:
translateLabel: true
argument: MercurialSourceCodeManager
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasSingleClassSelectedAndSourceCodeManagerHolder
label: 'Compare two Repository Versions...'
itemValue: classMenuCompareTwoRepositoryVersionsUsingManagerNamed:
translateLabel: true
argument: MercurialSourceCodeManager
showBusyCursorWhilePerforming: true
)
(MenuItem
label: '-'
isVisible: false
)
(MenuItem
enabled: hasNonPrivateClassSelectedAndSourceCodeManagerHolder
label: 'Set Tag...'
itemValue: classMenuSetTagUsingManagerNamed:
translateLabel: true
isVisible: false
labelImage: (ResourceRetriever ToolbarIconLibrary repositoryTag 'Set Tag...')
argument: MercurialSourceCodeManager
showBusyCursorWhilePerforming: true
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasNonPrivateClassSelectedAndSourceCodeManagerHolder
label: 'Revision Log (Recent Changes)'
itemValue: classMenuShortRevisionLogUsingManagerNamed:
translateLabel: true
labelImage: (ResourceRetriever ToolbarIconLibrary repositoryLog 'Revision Log (Recent Changes)')
argument: MercurialSourceCodeManager
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasNonPrivateClassSelectedAndSourceCodeManagerHolder
label: 'Revision Log (Full)'
itemValue: classMenuRevisionLogUsingManagerNamed:
translateLabel: true
argument: MercurialSourceCodeManager
showBusyCursorWhilePerforming: true
)
)
nil
nil
)
"Modified: / 06-11-2013 / 20:31:19 / cg"
!
classPerforceMenu
"This resource specification was automatically generated
by the MenuEditor of ST/X."
"Do not manually edit this!! If it is corrupted,
the MenuEditor may not be able to read the specification."
"
MenuEditor new openOnClass:Tools::NewSystemBrowser andSelector:#classPerforceMenu
(Menu new fromLiteralArrayEncoding:(Tools::NewSystemBrowser classPerforceMenu)) startUp
"
<resource: #menu>
^
#(Menu
(
(MenuItem
label: '** No SourceCodeManager - See Settings in the Launcher **'
translateLabel: true
isVisible: hasNoSourceCodeManagerHolder
)
(MenuItem
label: '-'
isVisible: hasNoSourceCodeManagerHolder
)
(MenuItem
enabled: hasClassSelectedAndSourceCodeManagerHolder
label: 'CheckIn...'
itemValue: classMenuCheckInP4
translateLabel: true
labelImage: (ResourceRetriever ToolbarIconLibrary repositoryCheckIn 'CheckIn...')
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasClassWithExtensionsSelectedHolder
label: 'CheckIn Extensions For'
translateLabel: true
submenuChannel: browseClassExtensionsMenu
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: changeSetContainsChangedClassesAndSourceCodeManagerHolder
label: 'CheckIn all Changed Classes'
itemValue: classMenuCheckInAllChangedClasses
translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
label: 'Quick CheckIn...'
itemValue: classMenuQuickCheckIn
translateLabel: true
isVisible: hasClassSelectedAndControlKeyDownHolder
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasProjectDefinitionSelectedAndSourceCodeManagerHolder
label: 'CheckIn Build Support Files...'
itemValue: classMenuCheckInBuildSupportFiles
translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasClassSelectedAndSourceCodeManagerHolder
label: 'Submit...'
itemValue: classMenuPerforceSubmit
translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasNonPrivateClassSelectedAndSourceCodeManagerHolder
label: 'CheckOut Newest'
itemValue: classMenuCheckOutNewest
translateLabel: true
labelImage: (ResourceRetriever ToolbarIconLibrary repositoryCheckOut 'CheckOut Newest')
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasNonPrivateClassSelectedAndSourceCodeManagerHolder
label: 'CheckOut Previous Version...'
itemValue: classMenuCheckOut
translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasSingleClassSelectedAndSourceCodeManagerHolder
label: 'Edit Version in Repository...'
itemValue: classMenuEditVersionInRepository
translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasSingleClassSelectedAndSourceCodeManagerHolder
label: 'Browse and Compare all Versions in Repository'
itemValue: classMenuBrowseAllVersionsInRepository
translateLabel: true
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasClassSelectedAndSourceCodeManagerHolder
label: 'Compare with Newest in Repository'
itemValue: classMenuCompareAgainstNewestInRepository
translateLabel: true
labelImage: (ResourceRetriever ToolbarIconLibrary repositoryVersions 'Compare with Newest in Repository...')
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasSingleClassSelectedAndSourceCodeManagerHolder
label: 'Compare with Original in Repository'
itemValue: classMenuCompareAgainstOriginalInRepository
translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasSingleClassSelectedAndSourceCodeManagerHolder
label: 'Compare with Repository...'
itemValue: classMenuCompareWithRepository
translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasSingleClassSelectedAndSourceCodeManagerHolder
label: 'Compare two Repository Versions...'
itemValue: classMenuCompareTwoRepositoryVersions
translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasProjectDefinitionOrClassWithExtensionsSelectedAndSourceCodeManagerHolder
label: 'Compare Extensions with Repository...'
itemValue: classMenuCompareExtensionsWithRepository
translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasProjectDefinitionSelectedAndSourceCodeManagerHolder
label: 'Compare Build Support File'
translateLabel: true
submenuChannel: compareBuildSupportFileMenu
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasNonPrivateClassSelectedAndSourceCodeManagerHolder
label: 'Set Tag...'
itemValue: classMenuSetTag
translateLabel: true
labelImage: (ResourceRetriever ToolbarIconLibrary repositoryTag 'Set Tag...')
showBusyCursorWhilePerforming: true
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasNonPrivateClassSelectedAndSourceCodeManagerHolder
label: 'Revision Log (Recent Changes)'
itemValue: classMenuShortRevisionLog
translateLabel: true
labelImage: (ResourceRetriever ToolbarIconLibrary repositoryLog 'Revision Log (Recent Changes)')
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasNonPrivateClassSelectedAndSourceCodeManagerHolder
label: 'Revision Log (Full)'
itemValue: classMenuRevisionLog
translateLabel: true
showBusyCursorWhilePerforming: true
)
)
nil
nil
)
"Modified: / 28-10-2012 / 12:00:23 / cg"
!
classSCMMenu
"This resource specification was automatically generated
by the MenuEditor of ST/X."
"Do not manually edit this!! If it is corrupted,
the MenuEditor may not be able to read the specification."
"
MenuEditor new openOnClass:Tools::NewSystemBrowser andSelector:#classSCMMenu
(Menu new fromLiteralArrayEncoding:(Tools::NewSystemBrowser classSCMMenu)) startUp
"
<resource: #menu>
^
#(Menu
(
(MenuItem
label: '** No SourceCodeManager - See Settings in the Launcher **'
translateLabel: true
isVisible: hasNoSourceCodeManagerHolder
)
(MenuItem
label: '-'
isVisible: hasNoSourceCodeManagerHolder
)
(MenuItem
enabled: hasClassSelectedAndSourceCodeManagerHolder
label: 'CheckIn...'
itemValue: classMenuCheckIn
translateLabel: true
labelImage: (ResourceRetriever ToolbarIconLibrary repositoryCheckIn 'CheckIn...')
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasClassWithExtensionsSelectedHolder
label: 'CheckIn Extensions For'
translateLabel: true
submenuChannel: browseClassExtensionsMenu
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: changeSetContainsChangedClassesAndSourceCodeManagerHolder
label: 'CheckIn all Changed Classes'
itemValue: classMenuCheckInAllChangedClasses
translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
label: 'Quick CheckIn...'
itemValue: classMenuQuickCheckIn
translateLabel: true
isVisible: hasClassSelectedAndControlKeyDownHolder
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasProjectDefinitionSelectedAndSourceCodeManagerHolder
label: 'CheckIn Build Support Files...'
itemValue: classMenuCheckInBuildSupportFiles
translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasNonPrivateClassSelectedAndSourceCodeManagerHolder
label: 'Set Tag...'
itemValue: classMenuSetTag
translateLabel: true
labelImage: (ResourceRetriever ToolbarIconLibrary repositoryTag 'Set Tag...')
showBusyCursorWhilePerforming: true
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasNonPrivateClassSelectedAndSourceCodeManagerHolder
label: 'CheckOut Newest'
itemValue: classMenuCheckOutNewest
translateLabel: true
labelImage: (ResourceRetriever ToolbarIconLibrary repositoryCheckOut 'CheckOut Newest')
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasNonPrivateClassSelectedAndSourceCodeManagerHolder
label: 'CheckOut Previous Version...'
itemValue: classMenuCheckOut
translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasNonPrivateClassSelectedAndSourceCodeManagerHolder
label: 'Revision Log (Recent Changes)'
itemValue: classMenuShortRevisionLog
translateLabel: true
labelImage: (ResourceRetriever ToolbarIconLibrary repositoryLog 'Revision Log (Recent Changes)')
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasNonPrivateClassSelectedAndSourceCodeManagerHolder
label: 'Revision Log (Full)'
itemValue: classMenuRevisionLog
translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasSingleClassSelectedAndSourceCodeManagerHolder
label: 'Edit Version in Repository...'
itemValue: classMenuEditVersionInRepository
translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasSingleClassSelectedAndSourceCodeManagerHolder
label: 'Browse and Compare all Versions in Repository'
itemValue: classMenuBrowseAllVersionsInRepository
translateLabel: true
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasClassSelectedAndSourceCodeManagerHolder
label: 'Compare with Newest in Repository'
itemValue: classMenuCompareAgainstNewestInRepository
translateLabel: true
labelImage: (ResourceRetriever ToolbarIconLibrary repositoryVersions 'Compare with Newest in Repository...')
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasSingleClassSelectedAndSourceCodeManagerHolder
label: 'Compare with Original in Repository'
itemValue: classMenuCompareAgainstOriginalInRepository
translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasSingleClassSelectedAndSourceCodeManagerHolder
label: 'Compare with Stable Version in Repository'
itemValue: classMenuCompareAgainstStableInRepository
translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasSingleClassSelectedAndSourceCodeManagerHolder
label: 'Compare with Repository...'
itemValue: classMenuCompareWithRepository
translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasSingleClassSelectedAndSourceCodeManagerHolder
label: 'Compare two Repository Versions...'
itemValue: classMenuCompareTwoRepositoryVersions
translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasProjectDefinitionSelectedAndSourceCodeManagerHolder
label: 'Compare Extensions with Repository...'
itemValue: classMenuCompareExtensionsWithRepository
translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasProjectDefinitionSelectedAndSourceCodeManagerHolder
label: 'Compare Build Support File'
translateLabel: true
submenuChannel: compareBuildSupportFileMenu
)
)
nil
nil
)
"Modified: / 28-10-2012 / 11:54:14 / cg"
! !
!NewSystemBrowser class methodsFor:'menu specs-SCM-project'!
projectCVSMenu
"This resource specification was automatically generated
by the MenuEditor of ST/X."
"Do not manually edit this!! If it is corrupted,
the MenuEditor may not be able to read the specification."
"
MenuEditor new openOnClass:Tools::NewSystemBrowser andSelector:#projectCVSMenu
(Menu new fromLiteralArrayEncoding:(Tools::NewSystemBrowser projectCVSMenu)) startUp
"
<resource: #menu>
^
#(Menu
(
(MenuItem
enabled: hasProjectSelectedAndSourceCodeManagerHolder
label: 'CheckIn...'
itemValue: projectMenuCheckInAllUsingManagerNamed:
labelImage: (ResourceRetriever ToolbarIconLibrary repositoryCheckIn 'CheckIn...')
argument: CVSSourceCodeManager
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasProjectSelectedAndSourceCodeManagerHolder
label: 'CheckIn Classes Only...'
itemValue: projectMenuCheckInClassesUsingManagerNamed:
argument: CVSSourceCodeManager
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasProjectSelectedAndSourceCodeManagerHolder
label: 'CheckIn Extensions Only...'
itemValue: projectMenuCheckInExtensionsUsingManagerNamed:
argument: CVSSourceCodeManager
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasProjectSelectedAndSourceCodeManagerHolder
label: 'CheckIn Build Support Files Only...'
itemValue: projectMenuCheckInBuildSupportFilesUsingManagerNamed:
argument: CVSSourceCodeManager
showBusyCursorWhilePerforming: true
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasProjectSelectedAndSourceCodeManagerHolder
label: 'CheckOut Newest'
itemValue: projectMenuCheckOutNewest
labelImage: (ResourceRetriever ToolbarIconLibrary repositoryCheckOut 'CheckOut Newest')
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasProjectSelectedAndSourceCodeManagerHolder
label: 'CheckOut Previous Version...'
itemValue: projectMenuCheckOut
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasProjectSelectedAndSourceCodeManagerHolder
label: 'CheckOut Extensions Only...'
itemValue: projectMenuCheckOutExtensions
showBusyCursorWhilePerforming: true
)
(MenuItem
label: '-'
)
(MenuItem
label: 'Import Structure...'
itemValue: projectMenuImportUsingManagerNamed:
showBusyCursorWhilePerforming: true
argument: CVSSourceCodeManager
)
(MenuItem
label: 'Import...'
itemValue: projectMenuImportAndLoadClassesUsingManagerNamed:
showBusyCursorWhilePerforming: true
argument: CVSSourceCodeManager
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasProjectSelectedAndSourceCodeManagerHolder
label: 'Compare with Newest in Repository'
itemValue: projectMenuCompareAgainstNewestInRepositoryUsingManagerNamed:
argument: CVSSourceCodeManager
)
(MenuItem
enabled: hasProjectSelectedAndSourceCodeManagerHolder
label: 'Compare with Stable Version in Repository'
itemValue: projectMenuCompareAgainstStableInRepository
)
(MenuItem
enabled: hasProjectSelectedAndSourceCodeManagerHolder
label: 'Compare with Repository at Date or Tag...'
itemValue: projectMenuCompareAgainstRepository
)
(MenuItem
label: 'Compare Build Support File'
submenuChannel: compareBuildSupportFileMenu
)
(MenuItem
enabled: hasProjectSelectedAndSourceCodeManagerHolder
label: 'Browse Classes ...'
itemValue: projectMenuCheckRepositoryConsistency
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasProjectSelectedAndSourceCodeManagerHolder
label: 'Set Tag (Release As)...'
itemValue: projectMenuSetTagUsingManagerNamed:
argument: CVSSourceCodeManager
labelImage: (ResourceRetriever ToolbarIconLibrary repositoryTag 'Set Tag (Release As)...')
)
(MenuItem
enabled: hasProjectSelectedAndSourceCodeManagerHolder
label: 'Set Tag of Build Support Files...'
itemValue: projectMenuSetTagOfBuildSupportFilesUsingManagerNamed:
argument: CVSSourceCodeManager
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasProjectSelectedAndSourceCodeManagerHolder
label: 'Repository History...'
itemValue: projectMenuRepositoryHistoryUsingManagerNamed:
argument: CVSSourceCodeManager
showBusyCursorWhilePerforming: true
)
(MenuItem
label: 'Package Dependencies...'
itemValue: projectPackageDependencyBrowser
isVisible: false
)
(MenuItem
enabled: hasProjectSelectedAndSourceCodeManagerHolder
label: 'Find Classes NOT Tagged as "stable"'
itemValue: projectMenuFindNotStableClasses
)
(MenuItem
enabled: hasProjectSelectedAndSourceCodeManagerHolder
label: 'Find Classes NOT Tagged as...'
itemValue: projectMenuFindNotTaggedClasses
)
(MenuItem
label: '-'
isVisible: false
)
(MenuItem
enabled: hasProjectSelectedHolder
label: 'Resource Files...'
itemValue: projectMenuResources
isVisible: false
)
(MenuItem
enabled: hasProjectSelectedHolder
label: 'Bitmap Files...'
itemValue: projectMenuBitmapFiles
isVisible: false
)
)
nil
nil
)
"Modified: / 29-07-2013 / 09:49:12 / cg"
!
projectGitMenu
"This resource specification was automatically generated
by the MenuEditor of ST/X."
"Do not manually edit this!! If it is corrupted,
the MenuEditor may not be able to read the specification."
"
MenuEditor new openOnClass:Tools::NewSystemBrowser andSelector:#projectGitMenu
(Menu new fromLiteralArrayEncoding:(Tools::NewSystemBrowser projectGitMenu)) startUp
"
<resource: #menu>
^
#(Menu
(
(MenuItem
enabled: hasProjectSelectedAndSourceCodeManagerHolder
label: 'Commit (CheckIn)...'
itemValue: projectMenuCheckInAllUsingManagerNamed:
labelImage: (ResourceRetriever ToolbarIconLibrary repositoryCheckIn 'Commit (CheckIn)...')
argument: GitSourceCodeManager
showBusyCursorWhilePerforming: true
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasProjectSelectedAndSourceCodeManagerHolder
label: 'CheckOut Newest'
itemValue: projectMenuCheckOutNewestUsingManagerNamed:
labelImage: (ResourceRetriever ToolbarIconLibrary repositoryCheckOut 'CheckOut Newest')
argument: GitSourceCodeManager
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasProjectSelectedAndSourceCodeManagerHolder
label: 'CheckOut Previous Version...'
itemValue: projectMenuCheckOutUsingManagerNamed:
argument: GitSourceCodeManager
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasProjectSelectedAndSourceCodeManagerHolder
label: 'CheckOut Extensions Only...'
itemValue: projectMenuCheckOutExtensionsUsingManagerNamed:
argument: GitSourceCodeManager
showBusyCursorWhilePerforming: true
)
(MenuItem
label: '-'
)
(MenuItem
label: 'Import Structure...'
itemValue: projectMenuImportUsingManagerNamed:
argument: GitSourceCodeManager
showBusyCursorWhilePerforming: true
)
(MenuItem
label: 'Import...'
itemValue: projectMenuImportAndLoadClassesUsingManagerNamed:
argument: GitSourceCodeManager
showBusyCursorWhilePerforming: true
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasProjectSelectedAndSourceCodeManagerHolder
label: 'Compare with Newest in Repository'
itemValue: projectMenuCompareAgainstNewestInRepositoryUsingManagerNamed:
argument: GitSourceCodeManager
)
(MenuItem
enabled: hasProjectSelectedAndSourceCodeManagerHolder
label: 'Compare with Repository at Date or Tag...'
itemValue: projectMenuCompareAgainstRepositoryUsingManagerNamed:
argument: GitSourceCodeManager
)
(MenuItem
label: 'Compare Build Support File'
submenuChannel: compareBuildSupportFileMenuUsingManagerNamed:
argument: GitSourceCodeManager
)
(MenuItem
enabled: hasProjectSelectedAndSourceCodeManagerHolder
label: 'Consistency Check...'
itemValue: projectMenuCheckRepositoryConsistencyUsingManagerNamed:
argument: GitSourceCodeManager
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasProjectSelectedAndSourceCodeManagerHolder
label: 'Set Tag (Release As)...'
itemValue: projectMenuSetTagUsingManagerNamed:
labelImage: (ResourceRetriever ToolbarIconLibrary repositoryTag 'Set Tag (Release As)...')
argument: GitSourceCodeManager
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasProjectSelectedAndSourceCodeManagerHolder
label: 'Repository History...'
itemValue: projectMenuRepositoryHistoryUsingManagerNamed:
argument: GitSourceCodeManager
showBusyCursorWhilePerforming: true
)
(MenuItem
label: '-'
isVisible: false
)
(MenuItem
enabled: hasProjectSelectedHolder
label: 'Resource Files...'
itemValue: projectMenuResources
isVisible: false
)
(MenuItem
enabled: hasProjectSelectedHolder
label: 'Bitmap Files...'
itemValue: projectMenuBitmapFiles
isVisible: false
)
)
nil
nil
)
!
projectMenuSCMCommon
"This resource specification was automatically generated
by the MenuEditor of ST/X."
"Do not manually edit this!! If it is corrupted,
the MenuEditor may not be able to read the specification."
"
MenuEditor new openOnClass:Tools::NewSystemBrowser andSelector:#projectMenuSCMCommon
(Menu new fromLiteralArrayEncoding:(Tools::NewSystemBrowser projectMenuSCMCommon)) startUp
"
<resource: #menu>
^
#(Menu
(
(MenuItem
enabled: hasProjectSelectedAndSourceCodeManagerHolder
label: 'CheckIn...'
itemValue: projectMenuCheckInAllUsingManagerNamed:
translateLabel: true
labelImage: (ResourceRetriever ToolbarIconLibrary repositoryCheckIn 'CheckIn...')
argument: SourceCodeManagerNamePlaceholder
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasProjectSelectedAndSourceCodeManagerHolder
label: 'CheckIn Classes Only...'
itemValue: projectMenuCheckInClassesUsingManagerNamed:
translateLabel: true
argument: SourceCodeManagerNamePlaceholder
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasProjectSelectedAndSourceCodeManagerHolder
label: 'CheckIn Extensions Only...'
itemValue: projectMenuCheckInExtensionsUsingManagerNamed:
translateLabel: true
argument: SourceCodeManagerNamePlaceholder
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasProjectSelectedAndSourceCodeManagerHolder
label: 'CheckIn Build Support Files Only...'
itemValue: projectMenuCheckInBuildSupportFilesUsingManagerNamed:
translateLabel: true
argument: SourceCodeManagerNamePlaceholder
showBusyCursorWhilePerforming: true
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasProjectSelectedAndSourceCodeManagerHolder
label: 'CheckOut Newest'
itemValue: projectMenuCheckOutNewestUsingManagerNamed:
translateLabel: true
labelImage: (ResourceRetriever ToolbarIconLibrary repositoryCheckOut 'CheckOut Newest')
argument: SourceCodeManagerNamePlaceholder
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasProjectSelectedAndSourceCodeManagerHolder
label: 'CheckOut Previous Version...'
itemValue: projectMenuCheckOutUsingManagerNamed:
translateLabel: true
argument: SourceCodeManagerNamePlaceholder
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasProjectSelectedAndSourceCodeManagerHolder
label: 'CheckOut Extensions Only...'
itemValue: projectMenuCheckOutExtensionsUsingManagerNamed:
translateLabel: true
argument: SourceCodeManagerNamePlaceholder
showBusyCursorWhilePerforming: true
)
(MenuItem
label: '-'
)
(MenuItem
label: 'Import Structure...'
itemValue: projectMenuImportUsingManagerNamed:
translateLabel: true
argument: SourceCodeManagerNamePlaceholder
showBusyCursorWhilePerforming: true
)
(MenuItem
label: 'Import...'
itemValue: projectMenuImportAndLoadClassesUsingManagerNamed:
translateLabel: true
argument: SourceCodeManagerNamePlaceholder
showBusyCursorWhilePerforming: true
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasProjectSelectedAndSourceCodeManagerHolder
label: 'Compare with Newest in Repository'
itemValue: projectMenuCompareAgainstNewestInRepositoryUsingManagerNamed:
translateLabel: true
argument: SourceCodeManagerNamePlaceholder
)
(MenuItem
enabled: hasProjectSelectedAndSourceCodeManagerHolder
label: 'Compare with Stable Version in Repository'
itemValue: projectMenuCompareAgainstStableInRepositoryUsingManager:
translateLabel: true
argument: SourceCodeManagerPlaceholder
isVisible: false
)
(MenuItem
enabled: hasProjectSelectedAndSourceCodeManagerHolder
label: 'Compare with Repository at Date or Tag...'
itemValue: projectMenuCompareAgainstRepositoryUsingManager:
translateLabel: true
argument: SourceCodeManagerPlaceholder
)
(MenuItem
label: 'Compare Build Support File'
translateLabel: true
submenuChannel: projectMenuSCMCompareBuildSupportFileForManagerNamed:
argument: SourceCodeManagerNamePlaceholder
)
(MenuItem
enabled: hasProjectSelectedAndSourceCodeManagerHolder
label: 'Consistency Check...'
itemValue: projectMenuCheckRepositoryConsistencyUsingManager:
translateLabel: true
argument: SourceCodeManagerPlaceholder
)
(MenuItem
enabled: hasProjectSelectedAndSourceCodeManagerHolder
label: 'Package Integrity Check...'
itemValue: projectMenuCheckPackageIntegrity
translateLabel: true
)
(MenuItem
label: '-'
isVisible: false
)
(MenuItem
enabled: hasProjectSelectedHolder
label: 'Resource Files...'
itemValue: projectMenuResourcesUsingManager:
translateLabel: true
isVisible: false
argument: SourceCodeManagerPlaceholder
)
(MenuItem
enabled: hasProjectSelectedHolder
label: 'Bitmap Files...'
itemValue: projectMenuBitmapFilesUsingManager:
translateLabel: true
isVisible: false
argument: SourceCodeManagerPlaceholder
)
(MenuItem
label: 'Extras'
translateLabel: true
submenuChannel: projectMenuSCMExtraFor:
argument: SourceCodeManagerNamePlaceholder
isMenuSlice: true
)
)
nil
nil
)
"Modified: / 26-07-2012 / 12:29:37 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 28-10-2012 / 12:02:19 / cg"
!
projectMenuSCMCompareBuildSupportFile
"This resource specification was automatically generated
by the MenuEditor of ST/X."
"Do not manually edit this!! If it is corrupted,
the MenuEditor may not be able to read the specification."
"
MenuEditor new openOnClass:Tools::NewSystemBrowser andSelector:#projectMenuSCMCompareBuildSupportFile
(Menu new fromLiteralArrayEncoding:(Tools::NewSystemBrowser projectMenuSCMCompareBuildSupportFile)) startUp
"
<resource: #menu>
^
#(Menu
(
(MenuItem
enabled: hasSingleProjectOrProjectDefinitionSelected
label: 'Make.spec'
itemValue: projectMenuShowGeneratedBuildFile:usingManager:
translateLabel: false
argument: 'Make.spec'
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasSingleProjectOrProjectDefinitionSelected
label: 'Make.proto'
itemValue: projectMenuShowGeneratedBuildFile:usingManager:
translateLabel: false
argument: 'Make.proto'
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasSingleProjectOrProjectDefinitionSelected
label: 'bc.mak'
itemValue: projectMenuShowGeneratedBuildFile:usingManager:
translateLabel: false
argument: 'bc.mak'
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasSingleProjectOrProjectDefinitionSelected
label: 'libInit.cc'
itemValue: projectMenuShowGeneratedBuildFile:usingManager:
translateLabel: false
argument: 'libInit.cc'
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasSingleProjectOrProjectDefinitionSelected
label: 'modules.stx'
itemValue: projectMenuShowGeneratedBuildFile:usingManager:
translateLabel: false
argument: 'modules.stx'
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasSingleProjectOrProjectDefinitionSelected
label: 'lib.rc / app.rc'
itemValue: projectMenuShowGeneratedBuildFile:usingManager:
translateLabel: false
argument: 'lib.rc'
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasSingleProjectOrProjectDefinitionSelected
label: 'app.nsi'
itemValue: projectMenuShowGeneratedBuildFile:usingManager:
translateLabel: false
argument: 'app.nsi'
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasSingleProjectOrProjectDefinitionSelected
label: 'abbrev.stc'
itemValue: projectMenuShowGeneratedBuildFile:usingManager:
translateLabel: false
argument: 'abbrev.stc'
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasSingleProjectOrProjectDefinitionSelected
label: 'loadAll'
itemValue: projectMenuShowGeneratedBuildFile:usingManager:
translateLabel: false
argument: 'loadAll'
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasSingleProjectOrProjectDefinitionSelected
label: 'bmake.bat'
itemValue: projectMenuShowGeneratedBuildFile:usingManager:
translateLabel: false
argument: 'bmake.bat'
showBusyCursorWhilePerforming: true
)
)
nil
nil
)
!
projectMenuSCMExtra_CVS
"This resource specification was automatically generated
by the MenuEditor of ST/X."
"Do not manually edit this!! If it is corrupted,
the MenuEditor may not be able to read the specification."
"
MenuEditor new openOnClass:Tools::NewSystemBrowser andSelector:#projectMenuSCMExtra_CVS
(Menu new fromLiteralArrayEncoding:(Tools::NewSystemBrowser projectMenuSCMExtra_CVS)) startUp
"
<resource: #menu>
^
#(Menu
(
(MenuItem
enabled: hasProjectSelectedAndSourceCodeManagerHolder
label: 'Repository History...'
itemValue: projectMenuRepositoryHistoryUsingManagerNamed:
argument: CVSSourceCodeManager
translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasProjectSelectedAndSourceCodeManagerHolder
label: 'Set Tag (Release As)...'
itemValue: projectMenuSetTagUsingManagerNamed:
argument: CVSSourceCodeManager
translateLabel: true
labelImage: (ResourceRetriever ToolbarIconLibrary repositoryTag 'Set Tag (Release As)...')
)
(MenuItem
enabled: hasProjectSelectedAndSourceCodeManagerHolder
label: 'Set Tag of Build Support Files...'
itemValue: projectMenuSetTagOfBuildSupportFilesUsingManagerNamed:
argument: CVSSourceCodeManager
)
)
nil
nil
)
"Modified: / 29-07-2013 / 09:49:26 / cg"
!
projectMenuSCMExtra_SVN
"This resource specification was automatically generated
by the MenuEditor of ST/X."
"Do not manually edit this!! If it is corrupted,
the MenuEditor may not be able to read the specification."
"
MenuEditor new openOnClass:Tools::NewSystemBrowser andSelector:#projectMenuSCMExtra_SVN
(Menu new fromLiteralArrayEncoding:(Tools::NewSystemBrowser projectMenuSCMExtra_SVN)) startUp
"
<resource: #menu>
^
#(Menu
(
(MenuItem
enabled: hasProjectSelectedSubversionRepositoryExistsAndBranchSelectedHolder
label: 'Changeset'
translateLabel: true
submenuChannel: projectSubversionChangesetMenu
)
(MenuItem
label: 'Branch'
translateLabel: true
submenuChannel: commonSubversionBranchMenu
)
(MenuItem
label: 'Browse Working Copy'
itemValue: commonMenuSubversionBrowseWorkingCopy
translateLabel: true
)
(MenuItem
enabled: hasProjectSelectedAndSourceCodeManagerHolder
label: 'Set Tag (Release As)...'
itemValue: projectMenuSetTagUsingManagerNamed:
translateLabel: true
labelImage: (ResourceRetriever ToolbarIconLibrary repositoryTag 'Set Tag (Release As)...')
argument: SourceCodeManagerNamePlaceholder
)
(MenuItem
label: 'More'
translateLabel: true
submenu:
(Menu
(
(MenuItem
label: 'Remove Working Copy'
itemValue: projectMenuSubversionRemoveWorkingCopy
translateLabel: true
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasProjectSelectedSubversionRepositoryExistsAndBranchSelectedHolder
label: 'Fast Commit'
translateLabel: true
choice: projectMenuSubversionCommitMode
choiceValue: fast
)
(MenuItem
enabled: hasProjectSelectedSubversionRepositoryExistsAndBranchSelectedHolder
label: 'Full Commit'
translateLabel: true
choice: projectMenuSubversionCommitMode
choiceValue: full
)
(MenuItem
label: '-'
)
(MenuItem
label: 'Common Slice'
translateLabel: true
submenuChannel: commonSubversionMenuSlice
isMenuSlice: true
)
)
nil
nil
)
)
)
nil
nil
)
"Modified: / 23-07-2012 / 15:16:29 / cg"
!
projectMenuSCMSlice
<resource: #menu>
^self
perform: ('projectMenuSCMSlice_' , UserPreferences current sourceCodeManagementMenuLayout) asSymbol
ifNotUnderstood: [self projectMenuSCMSlice_old].
"Created: / 07-10-2011 / 14:50:10 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
projectMenuSCMSliceAll
"This resource specification was automatically generated
by the MenuEditor of ST/X."
"Do not manually edit this!! If it is corrupted,
the MenuEditor may not be able to read the specification."
"
MenuEditor new openOnClass:Tools::NewSystemBrowser andSelector:#projectMenuSCMSliceAll
(Menu new fromLiteralArrayEncoding:(Tools::NewSystemBrowser projectMenuSCMSliceAll)) startUp
"
<resource: #menu>
^
#(Menu
(
(MenuItem
enabled: hasProjectSelectedAndSourceCodeManagerHolder
isVisible: cvsRepositoryMenusAreShown
label: 'CVS'
submenuChannel: projectMenuSCMFor:
labelImage: (ResourceRetriever ToolbarIconLibrary repositoryCVSIcon 'CVS')
argument: CVSSourceCodeManager
keepLinkedMenu: true
)
(MenuItem
enabled: hasProjectSelectedAndSourceCodeManagerHolder
isVisible: dataBaseRepositoryMenusAreShown
label: 'Database Repository'
translateLabel: true
submenuChannel: projectMenuSCMFor:
argument: DataBaseSourceCodeManager
labelImage: (ResourceRetriever ToolbarIconLibrary repositoryIcon 'Database Repository')
)
(MenuItem
enabled: hasProjectSelectedAndSourceCodeManagerHolder
label: 'SubVersion'
isVisible: hasSubversionSupport
submenuChannel: projectMenuSCMFor:
labelImage: (ResourceRetriever ToolbarIconLibrary repositorySVNIcon 'SubVersion')
argument: SVNSourceCodeManager
)
(MenuItem
enabled: hasProjectSelectedAndSourceCodeManagerHolder
label: 'Mercurial+'
isVisible: hgRepositoryMenusAreShown
submenuChannel: projectMenuSCMFor:
labelImage: (ResourceRetriever ToolbarIconLibrary repositoryP4Icon 'Mercurial+')
argument: HGSourceCodeManager
)
(MenuItem
enabled: hasProjectSelectedAndSourceCodeManagerHolder
label: 'Git+'
isVisible: git2RepositoryMenusAreShown
submenuChannel: projectMenuSCMFor:
labelImage: (ResourceRetriever ToolbarIconLibrary repositoryP4Icon 'Git+')
argument: GitSourceCodeManager2
)
(MenuItem
enabled: hasProjectSelectedAndSourceCodeManagerHolder
label: 'Perforce'
isVisible: hasPerforceSupport
submenuChannel: projectMenuSCMFor:
labelImage: (ResourceRetriever ToolbarIconLibrary repositoryP4Icon 'Perforce')
argument: PerforceSourceCodeManager
)
(MenuItem
enabled: hasProjectSelectedAndSourceCodeManagerHolder
label: 'Monticello'
isVisible: hasMonticelloSupport
submenuChannel: projectMonticelloMenu
labelImage: (ResourceRetriever ToolbarIconLibrary repositoryMCIcon 'Monticello')
)
)
nil
nil
)
!
projectMenuSCMSlice_compact
"This resource specification was automatically generated
by the MenuEditor of ST/X."
"Do not manually edit this!! If it is corrupted,
the MenuEditor may not be able to read the specification."
"
MenuEditor new openOnClass:Tools::NewSystemBrowser andSelector:#classMenuSCMSlice_compact
(Menu new fromLiteralArrayEncoding:(Tools::NewSystemBrowser classMenuSCMSlice_compact)) startUp
"
<resource: #menu>
^
#(Menu
(
(MenuItem
label: 'Repository'
nameKey: SCM
translateLabel: true
submenu:
(Menu
(
(MenuItem
label: 'Common Slice'
nameKey: CommonSlice
translateLabel: true
submenuChannel: projectMenuSCMFor:
argument: SourceCodeManagerNamePlaceholder
isMenuSlice: true
)
(MenuItem
label: '-'
)
(MenuItem
label: 'All Slice'
translateLabel: true
submenuChannel: projectMenuSCMSliceAll
isMenuSlice: true
)
(MenuItem
label: '-'
)
(MenuItem
label: 'Repository Settings'
itemValue: openSettingsDialogAndSelectSourceCodeManagement
translateLabel: true
)
)
nil
nil
)
)
)
nil
nil
)
"Created: / 12-10-2011 / 20:36:25 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 23-07-2012 / 15:16:38 / cg"
!
projectMenuSCMSlice_inline
"This resource specification was automatically generated
by the MenuEditor of ST/X."
"Do not manually edit this!! If it is corrupted,
the MenuEditor may not be able to read the specification."
"
MenuEditor new openOnClass:Tools::NewSystemBrowser andSelector:#projectMenuSCMSlice_inline
(Menu new fromLiteralArrayEncoding:(Tools::NewSystemBrowser projectMenuSCMSlice_inline)) startUp
"
<resource: #menu>
^
#(Menu
(
(MenuItem
label: '-'
)
(MenuItem
label: 'All Slice'
translateLabel: true
submenuChannel: projectMenuSCMSliceAll
isMenuSlice: true
)
)
nil
nil
)
!
projectMenuSCMSlice_old
"This resource specification was automatically generated
by the MenuEditor of ST/X."
"Do not manually edit this!! If it is corrupted,
the MenuEditor may not be able to read the specification."
"
MenuEditor new openOnClass:Tools::NewSystemBrowser andSelector:#projectMenuSCMSlice_old
(Menu new fromLiteralArrayEncoding:(Tools::NewSystemBrowser projectMenuSCMSlice_old)) startUp
"
<resource: #menu>
^
#(Menu
(
(MenuItem
label: 'CVS'
isVisible: cvsRepositoryMenusAreShown
translateLabel: true
submenuChannel: projectCVSMenu
labelImage: (ResourceRetriever ToolbarIconLibrary repositoryCVSIcon 'CVS')
)
(MenuItem
isVisible: dataBaseRepositoryMenusAreShown
label: 'Database Repository'
translateLabel: true
submenuChannel: projectDataBaseRepositoryMenu
labelImage: (ResourceRetriever ToolbarIconLibrary repositoryIcon 'Database Repository')
)
(MenuItem
enabled: hasProjectSelectedAndGitRepositoryExistsHolder
isVisible: gitRepositoryMenusAreShown
label: 'Git'
translateLabel: true
submenuChannel: projectGitMenu
labelImage: (ResourceRetriever ToolbarIconLibrary repositoryGitIcon 'Git')
)
(MenuItem
enabled: hasProjectSelectedAndMonticelloRepositoryExistsHolder
label: 'Monticello'
translateLabel: true
isVisible: hasMonticelloSupport
submenuChannel: projectMonticelloMenu
labelImage: (ResourceRetriever ToolbarIconLibrary repositoryMCIcon 'Monticello')
)
(MenuItem
enabled: hasProjectSelectedAndSubversionRepositoryExistsHolder
label: 'SubVersion'
translateLabel: true
isVisible: hasSubversionSupport
submenuChannel: projectSubversionMenu
labelImage: (ResourceRetriever ToolbarIconLibrary repositorySVNIcon 'SubVersion')
)
)
nil
nil
)
"Modified: / 24-07-2012 / 17:40:34 / cg"
! !
!NewSystemBrowser class methodsFor:'menu specs-SCM-selector'!
selectorMenuCVS
"This resource specification was automatically generated
by the MenuEditor of ST/X."
"Do not manually edit this!! If it is corrupted,
the MenuEditor may not be able to read the specification."
"
MenuEditor new openOnClass:Tools::NewSystemBrowser andSelector:#selectorMenuFileOutPrintOutSlice
(Menu new fromLiteralArrayEncoding:(Tools::NewSystemBrowser selectorMenuFileOutPrintOutSlice)) startUp
"
<resource: #menu>
^
#(Menu
(
(MenuItem
enabled: hasMethodSelected
label: 'CheckIn Class(es)...'
itemValue: methodListMenuCheckInClassUsingManagerNamed:
argument: CVSSourceCodeManager
translateLabel: true
labelImage: (ResourceRetriever ToolbarIconLibrary repositoryCheckIn 'CheckIn Class(es)...')
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasRealExtensionMethodSelectedHolder
label: 'CheckIn Extensions for Project...'
itemValue: selectorMenuCheckInProjectExtensions
translateLabel: true
isVisible: hasExtensionMethodSelectedHolder
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasMethodSelectedAndSourceCodeManagerHolder
label: 'Compare with Newest in Repository'
itemValue: selectorMenuCompareAgainstNewestInRepositoryUsingManagerNamed:
argument: CVSSourceCodeManager
translateLabel: true
labelImage: (ResourceRetriever ToolbarIconLibrary repositoryVersions 'Compare with Newest in Repository...')
)
(MenuItem
enabled: hasMethodSelectedAndSourceCodeManagerHolder
label: 'Compare Class with Newest in Repository'
itemValue: selectorMenuCompareClassAgainstNewestInRepositoryUsingManagerNamed:
argument: CVSSourceCodeManager
translateLabel: true
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasSingleMethodSelected
label: 'Browse Repository Versions...'
itemValue: selectorMenuBrowseRepositoryVersionsUsingManagerNamed:
argument: CVSSourceCodeManager
translateLabel: true
)
)
nil
nil
)
"Modified: / 28-10-2012 / 12:02:36 / cg"
!
selectorMenuSCMCommon
"This resource specification was automatically generated
by the MenuEditor of ST/X."
"Do not manually edit this!! If it is corrupted,
the MenuEditor may not be able to read the specification."
"
MenuEditor new openOnClass:Tools::NewSystemBrowser andSelector:#selectorMenuSCMCommon
(Menu new fromLiteralArrayEncoding:(Tools::NewSystemBrowser selectorMenuSCMCommon)) startUp
"
<resource: #menu>
^
#(Menu
(
(MenuItem
enabled: hasMethodSelected
label: 'CheckIn Class(es)...'
itemValue: methodListMenuCheckInClassUsingManagerNamed:
argument: SourceCodeManagerNamePlaceholder
translateLabel: true
labelImage: (ResourceRetriever ToolbarIconLibrary repositoryCheckIn 'CheckIn Class(es)...')
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasRealExtensionMethodSelectedHolder
label: 'CheckIn Extensions for Project...'
itemValue: selectorMenuCheckInProjectExtensionsUsingManager:
argument: SourceCodeManagerPlaceholder
translateLabel: true
isVisible: hasExtensionMethodSelectedHolder
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasMethodSelectedAndSourceCodeManagerHolder
label: 'Compare with Newest in Repository'
itemValue: selectorMenuCompareAgainstNewestInRepositoryUsingManagerNamed:
argument: SourceCodeManagerNamePlaceholder
translateLabel: true
labelImage: (ResourceRetriever ToolbarIconLibrary repositoryVersions 'Compare with Newest in Repository...')
)
(MenuItem
enabled: hasMethodSelectedAndSourceCodeManagerHolder
label: 'Compare Class with Newest in Repository'
itemValue: selectorMenuCompareClassAgainstNewestInRepositoryUsingManagerNamed:
argument: SourceCodeManagerNamePlaceholder
translateLabel: true
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasSingleMethodSelected
label: 'Browse Repository Versions...'
itemValue: selectorMenuBrowseRepositoryVersionsUsingManagerNamed:
argument: SourceCodeManagerNamePlaceholder
translateLabel: true
)
)
nil
nil
)
"Modified: / 11-01-2012 / 14:05:07 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 28-10-2012 / 12:02:47 / cg"
!
selectorMenuSCMSlice
"This resource specification was automatically generated
by the MenuEditor of ST/X."
"Do not manually edit this!! If it is corrupted,
the MenuEditor may not be able to read the specification."
"
MenuEditor new openOnClass:Tools::NewSystemBrowser andSelector:#selectorMenuSCMSlice
(Menu new fromLiteralArrayEncoding:(Tools::NewSystemBrowser selectorMenuSCMSlice)) startUp
"
<resource: #menu>
^
#(Menu
(
(MenuItem
label: '-'
)
(MenuItem
label: 'All Slice'
translateLabel: true
submenuChannel: selectorMenuSCMSliceAll
isMenuSlice: true
)
)
nil
nil
)
!
selectorMenuSCMSliceAll
"This resource specification was automatically generated
by the MenuEditor of ST/X."
"Do not manually edit this!! If it is corrupted,
the MenuEditor may not be able to read the specification."
"
MenuEditor new openOnClass:Tools::NewSystemBrowser andSelector:#selectorMenuSCMSliceAll
(Menu new fromLiteralArrayEncoding:(Tools::NewSystemBrowser selectorMenuSCMSliceAll)) startUp
"
<resource: #menu>
^
#(Menu
(
(MenuItem
enabled: hasMethodSelectedAndSourceCodeManagerHolder
label: 'CVS'
translateLabel: true
submenuChannel: selectorMenuSCMFor:
labelImage: (ResourceRetriever ToolbarIconLibrary repositoryCVSIcon 'CVS')
argument: CVSSourceCodeManager
keepLinkedMenu: true
)
(MenuItem
enabled: hasMethodSelectedAndSourceCodeManagerHolder
label: 'SubVersion'
translateLabel: true
isVisible: hasSubversionSupport
submenuChannel: selectorMenuSCMFor:
labelImage: (ResourceRetriever ToolbarIconLibrary repositorySVNIcon 'SubVersion')
argument: SVNSourceCodeManager
)
(MenuItem
enabled: hasMethodSelectedAndSourceCodeManagerHolder
label: 'Mercurial+'
isVisible: hgRepositoryMenusAreShown
submenuChannel: selectorMenuSCMFor:
labelImage: (ResourceRetriever ToolbarIconLibrary repositoryP4Icon 'Mercurial+')
argument: HGSourceCodeManager
)
(MenuItem
enabled: hasMethodSelectedAndSourceCodeManagerHolder
label: 'Git+'
isVisible: perforceRepositoryMenusAreShown
submenuChannel: selectorMenuSCMFor:
labelImage: (ResourceRetriever ToolbarIconLibrary repositoryP4Icon 'Git+')
argument: HGSourceCodeManager2
)
(MenuItem
enabled: hasMethodSelectedAndSourceCodeManagerHolder
label: 'Perforce'
translateLabel: true
isVisible: hasPerforceSupport
submenuChannel: selectorMenuSCMFor:
labelImage: (ResourceRetriever ToolbarIconLibrary repositoryP4Icon 'Perforce')
argument: PerforceSourceCodeManager
)
)
nil
nil
)
!
selectorMenuSCMSlice_compact
"This resource specification was automatically generated
by the MenuEditor of ST/X."
"Do not manually edit this!! If it is corrupted,
the MenuEditor may not be able to read the specification."
"
MenuEditor new openOnClass:Tools::NewSystemBrowser andSelector:#classMenuSCMSlice_compact
(Menu new fromLiteralArrayEncoding:(Tools::NewSystemBrowser classMenuSCMSlice_compact)) startUp
"
<resource: #menu>
^
#(Menu
(
(MenuItem
label: 'Repository'
nameKey: SCM
translateLabel: true
submenu:
(Menu
(
(MenuItem
label: 'Common Slice'
nameKey: CommonSlice
translateLabel: true
submenuChannel: selectorMenuSCMFor:
argument: SourceCodeManagerNamePlaceholder
isMenuSlice: true
)
(MenuItem
label: '-'
)
(MenuItem
label: 'All Slice'
translateLabel: true
submenuChannel: selectorMenuSCMSliceAll
isMenuSlice: true
)
(MenuItem
label: '-'
)
(MenuItem
label: 'Repository Settings'
itemValue: openSettingsDialogAndSelectSourceCodeManagement
translateLabel: true
)
)
nil
nil
)
)
)
nil
nil
)
"Created: / 12-10-2011 / 20:45:50 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 23-07-2012 / 15:16:53 / cg"
!
selectorMenuSCMSlice_inline
"This resource specification was automatically generated
by the MenuEditor of ST/X."
"Do not manually edit this!! If it is corrupted,
the MenuEditor may not be able to read the specification."
"
MenuEditor new openOnClass:Tools::NewSystemBrowser andSelector:#selectorMenuSCMSlice_inline
(Menu new fromLiteralArrayEncoding:(Tools::NewSystemBrowser selectorMenuSCMSlice_inline)) startUp
"
<resource: #menu>
^
#(Menu
(
(MenuItem
label: '-'
)
(MenuItem
label: 'All Slice'
translateLabel: true
submenuChannel: selectorMenuSCMSliceAll
isMenuSlice: true
)
)
nil
nil
)
!
selectorMenuSCMSlice_old
"This resource specification was automatically generated
by the MenuEditor of ST/X."
"Do not manually edit this!! If it is corrupted,
the MenuEditor may not be able to read the specification."
"
MenuEditor new openOnClass:Tools::NewSystemBrowser andSelector:#selectorMenuSCMSlice_old
(Menu new fromLiteralArrayEncoding:(Tools::NewSystemBrowser selectorMenuSCMSlice_old)) startUp
"
<resource: #menu>
^
#(Menu
(
(MenuItem
enabled: hasMethodSelected
label: 'CVS'
translateLabel: true
submenuChannel: selectorMenuCVS
labelImage: (ResourceRetriever ToolbarIconLibrary repositoryCVSIcon 'CVS')
)
)
nil
nil
)
! !
!NewSystemBrowser class methodsFor:'menu specs-dialogs'!
classesWhichHaveBeenModifiedPopupMenu
"This resource specification was automatically generated
by the MenuEditor of ST/X."
"Do not manually edit this!! If it is corrupted,
the MenuEditor may not be able to read the specification."
"
MenuEditor new openOnClass:NewSystemBrowser andSelector:#classesWithMissingContainerPopupMenu
(Menu new fromLiteralArrayEncoding:(NewSystemBrowser classesWithMissingContainerPopupMenu)) startUp
"
<resource: #menu>
^
#(#Menu
#(
#(#MenuItem
#label: 'File out as...'
#translateLabel: true
#value: #classMenu3FileOutAs
#showBusyCursorWhilePerforming: true
)
#(#MenuItem
#label: 'Check Into Repository...'
#translateLabel: true
#value: #classMenu3CheckIn
#showBusyCursorWhilePerforming: true
)
#(#MenuItem
#label: '-'
)
#(#MenuItem
#label: 'Spawn'
#translateLabel: true
#value: #classMenu3SpawnClass
)
#(#MenuItem
#label: '-'
)
#(#MenuItem
#label: 'Compare With Newest in Repository...'
#translateLabel: true
#value: #classMenu3CompareAgainstNewestInRepository
#showBusyCursorWhilePerforming: true
)
)
nil
nil
)
!
classesWithMissingContainerPopupMenu
"This resource specification was automatically generated
by the MenuEditor of ST/X."
"Do not manually edit this!! If it is corrupted,
the MenuEditor may not be able to read the specification."
"
MenuEditor new openOnClass:NewSystemBrowser andSelector:#classesWithMissingContainerPopupMenu
(Menu new fromLiteralArrayEncoding:(NewSystemBrowser classesWithMissingContainerPopupMenu)) startUp
"
<resource: #menu>
^
#(#Menu
#(
#(#MenuItem
#label: 'File out as...'
#translateLabel: true
#value: #classMenuFileOutAs
#showBusyCursorWhilePerforming: true
)
#(#MenuItem
#label: 'Check Into Repository...'
#translateLabel: true
#value: #classMenuCheckIn
#showBusyCursorWhilePerforming: true
)
#(#MenuItem
#label: '-'
)
#(#MenuItem
#label: 'Spawn'
#translateLabel: true
#value: #classMenuSpawnClass
)
#(#MenuItem
#label: '-'
)
#(#MenuItem
#label: 'Remove...'
#translateLabel: true
#value: #classMenuRemove
)
)
nil
nil
)
!
classesWithNewerVersionInRepositoryPopupMenu
"This resource specification was automatically generated
by the MenuEditor of ST/X."
"Do not manually edit this!! If it is corrupted,
the MenuEditor may not be able to read the specification."
"
MenuEditor new openOnClass:NewSystemBrowser andSelector:#classesWithMissingContainerPopupMenu
(Menu new fromLiteralArrayEncoding:(NewSystemBrowser classesWithMissingContainerPopupMenu)) startUp
"
<resource: #menu>
^
#(#Menu
#(
#(#MenuItem
#label: 'CheckOut Newest...'
#translateLabel: true
#value: #classMenu2CheckOutNewest
#showBusyCursorWhilePerforming: true
)
#(#MenuItem
#label: '-'
)
#(#MenuItem
#label: 'Spawn'
#translateLabel: true
#value: #classMenu2SpawnClass
)
#(#MenuItem
#label: '-'
)
#(#MenuItem
#label: 'Compare With Newest in Repository...'
#translateLabel: true
#value: #classMenu2CompareAgainstNewestInRepository
#showBusyCursorWhilePerforming: true
)
)
nil
nil
)
"Modified: / 29-09-2006 / 16:10:31 / cg"
!
obsoleteContainersPopupMenu
"This resource specification was automatically generated
by the MenuEditor of ST/X."
"Do not manually edit this!! If it is corrupted,
the MenuEditor may not be able to read the specification."
"
MenuEditor new openOnClass:NewSystemBrowser andSelector:#classesWithMissingContainerPopupMenu
(Menu new fromLiteralArrayEncoding:(NewSystemBrowser classesWithMissingContainerPopupMenu)) startUp
"
<resource: #menu>
^
#(#Menu
#(
#(#MenuItem
#label: 'CheckOut...'
#translateLabel: true
#value: #classMenu4CheckOut
#showBusyCursorWhilePerforming: true
)
#(#MenuItem
#label: '-'
)
#(#MenuItem
#label: 'Remove Container'
#translateLabel: true
#value: #classMenu4RemoveContainer
)
)
nil
nil
)
"Modified: / 29-09-2006 / 16:11:08 / cg"
! !
!NewSystemBrowser class methodsFor:'menu specs-monticello'!
projectMonticelloMenu
"This resource specification was automatically generated
by the MenuEditor of ST/X."
"Do not manually edit this!! If it is corrupted,
the MenuEditor may not be able to read the specification."
"
MenuEditor new openOnClass:Tools::NewSystemBrowser andSelector:#projectMonticelloMenu
(Menu new fromLiteralArrayEncoding:(Tools::NewSystemBrowser projectMonticelloMenu)) startUp
"
<resource: #menu>
^
#(Menu
(
(MenuItem
label: 'Commit or Generate mcz File...'
itemValue: projectMenuMonticelloCommit
)
(MenuItem
label: '-'
)
(MenuItem
enabled: false
label: 'Not yet finished...'
)
)
nil
nil
)
! !
!NewSystemBrowser class methodsFor:'menu specs-popup'!
categoryPopUpMenu
"return the popUpMenu for the class-category-list view"
<resource: #programMenu>
^ self categoryMenuWithFind
"Created: / 18.2.2000 / 11:58:25 / cg"
!
classPopUpMenu
"return the popUpMenu for the regular class-list view"
<resource: #programMenu>
^ self classMenu
"Created: / 18.2.2000 / 11:58:25 / cg"
!
hierarchyPopUpMenu
"return the popUpMenu for the class-hierarchy-list view"
<resource: #programMenu>
^ self classPopUpMenu
"Created: / 18.2.2000 / 11:58:25 / cg"
!
nameSpacePopUpMenu
<resource: #programMenu>
^ self nameSpaceMenu
"Created: / 18.2.2000 / 11:58:25 / cg"
!
projectPopUpMenu
"return the popUpMenu for the project-list view"
<resource: #programMenu>
^ self projectMenu
"Created: / 18.2.2000 / 11:58:25 / cg"
!
shiftedCodeViewPopUpMenu
"return the Shift-popUpMenu for the code-view.
get here via codeViewMenu (holder in codeView)"
<resource: #programMenu>
^ self menuFor: #refactoringMenu
"Modified: / 26-08-2014 / 22:37:40 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
tabMenuWithRemove
"This resource specification was automatically generated
by the MenuEditor of ST/X."
"Do not manually edit this!! If it is corrupted,
the MenuEditor may not be able to read the specification."
"
MenuEditor new openOnClass:Tools::NewSystemBrowser andSelector:#tabMenuWithRemove
(Menu new fromLiteralArrayEncoding:(Tools::NewSystemBrowser tabMenuWithRemove)) startUp
"
<resource: #menu>
^
#(Menu
(
(MenuItem
label: 'Add Page'
itemValue: bufferMenuCreateBuffer
nameKey: CreateBuffer
translateLabel: true
)
(MenuItem
label: '-'
)
(MenuItem
label: 'Remove Page'
itemValue: bufferMenuRemoveBuffer:
nameKey: RemoveBuffer
translateLabel: true
argument: 0
)
(MenuItem
label: 'Remove all other Pages'
itemValue: bufferMenuRemoveAllButBuffer:
nameKey: RemoveAllButBuffer
translateLabel: true
argument: 0
)
)
nil
nil
)
!
tabMenuWithoutRemove
"This resource specification was automatically generated
by the MenuEditor of ST/X."
"Do not manually edit this!! If it is corrupted,
the MenuEditor may not be able to read the specification."
"
MenuEditor new openOnClass:NewSystemBrowser andSelector:#tabMenu
(Menu new fromLiteralArrayEncoding:(NewSystemBrowser tabMenu)) startUp
"
<resource: #menu>
^
#(#Menu
#(
#(#MenuItem
#label: 'Add Tab'
#translateLabel: true
#nameKey: #CreateBuffer
#value: #bufferMenuCreateBuffer
)
)
nil
nil
)
!
variablesPopUpMenu
"return the popUpMenu for the variable-list view"
<resource: #programMenu>
^ self variablesMenu
"Created: / 18.2.2000 / 11:58:25 / cg"
! !
!NewSystemBrowser class methodsFor:'menu specs-subversion'!
classSubversionMenu
"This resource specification was automatically generated
by the MenuEditor of ST/X."
"Do not manually edit this!! If it is corrupted,
the MenuEditor may not be able to read the specification."
"
MenuEditor new openOnClass:Tools::NewSystemBrowser andSelector:#classSubversionMenu
(Menu new fromLiteralArrayEncoding:(Tools::NewSystemBrowser classSubversionMenu)) startUp
"
<resource: #menu>
^
#(Menu
(
(MenuItem
enabled: hasClassesSelectedAndSubversionRepositoryExistsAndBranchSelectedHolder
label: 'Commit'
itemValue: classMenuSubversionCommit
translateLabel: true
labelImage: (ResourceRetriever #'SVN::IconLibrary' commit 'Commit')
)
(MenuItem
enabled: hasClassesSelectedAndSubversionRepositoryExistsAndBranchSelectedHolder
label: 'Update'
itemValue: classMenuSubversionUpdate
translateLabel: true
labelImage: (ResourceRetriever #'SVN::IconLibrary' update 'Update')
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasClassesSelectedAndSubversionRepositoryExistsAndBranchSelectedHolder
label: 'Compare'
translateLabel: true
submenuChannel: classSubversionCompareMenu
labelImage: (ResourceRetriever #'SVN::IconLibrary' compare 'Compare')
)
(MenuItem
enabled: false
label: 'Merge'
translateLabel: true
submenuChannel: classSubversionMergeMenu
labelImage: (ResourceRetriever #'SVN::IconLibrary' merge 'Merge')
)
(MenuItem
enabled: hasClassesSelectedAndSubversionRepositoryExistsAndBranchSelectedHolder
label: 'Changeset'
translateLabel: true
submenuChannel: classSubversionChangesetMenu
)
(MenuItem
enabled: hasClassesSelectedAndSubversionRepositoryExistsAndBranchSelectedHolder
label: 'Revision log'
itemValue: classMenuSubversionShowRevisionLog
translateLabel: true
labelImage: (ResourceRetriever #'SVN::IconLibrary' log 'Revision log')
)
(MenuItem
label: '-'
)
(MenuItem
label: 'Branch'
translateLabel: true
submenuChannel: commonSubversionBranchMenu
)
(MenuItem
label: 'Browse working copy'
itemValue: commonMenuSubversionBrowseWorkingCopy
translateLabel: true
)
(MenuItem
label: 'More'
translateLabel: true
submenu:
(Menu
(
(MenuItem
label: 'Common Slice'
translateLabel: true
submenuChannel: commonSubversionMenuSlice
isMenuSlice: true
)
)
nil
nil
)
)
)
nil
nil
)
!
commonSubversionMenuSlice
"This resource specification was automatically generated
by the MenuEditor of ST/X."
"Do not manually edit this!! If it is corrupted,
the MenuEditor may not be able to read the specification."
"
MenuEditor new openOnClass:Tools::NewSystemBrowser andSelector:#commonSubversionMenuSlice
(Menu new fromLiteralArrayEncoding:(Tools::NewSystemBrowser commonSubversionMenuSlice)) startUp
"
<resource: #menu>
^
#(Menu
(
(MenuItem
label: 'Settings'
itemValue: commonMenuSubversionOpenSettings
translateLabel: true
)
(MenuItem
label: 'Flush caches'
itemValue: commonMenuSubversionFlushCaches
translateLabel: true
)
)
nil
nil
)
!
projectSubversionMenu
"This resource specification was automatically generated
by the MenuEditor of ST/X."
"Do not manually edit this!! If it is corrupted,
the MenuEditor may not be able to read the specification."
"
MenuEditor new openOnClass:Tools::NewSystemBrowser andSelector:#projectSubversionMenu
(Menu new fromLiteralArrayEncoding:(Tools::NewSystemBrowser projectSubversionMenu)) startUp
"
<resource: #menu>
^
#(Menu
(
(MenuItem
enabled: hasProjectSelectedSubversionRepositoryExistsAndBranchSelectedHolder
label: 'Commit'
itemValue: projectMenuSubversionCommit
translateLabel: true
labelImage: (ResourceRetriever #'SVN::IconLibrary' commit 'Commit')
)
(MenuItem
enabled: hasProjectSelectedSubversionRepositoryExistsAndBranchSelectedHolder
label: 'Update'
itemValue: projectMenuSubversionUpdate
translateLabel: true
labelImage: (ResourceRetriever #'SVN::IconLibrary' update 'Update')
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasProjectSelectedSubversionRepositoryExistsAndBranchSelectedHolder
label: 'Compare'
translateLabel: true
submenuChannel: projectSubversionCompareMenu
labelImage: (ResourceRetriever #'SVN::IconLibrary' compare 'Compare')
)
(MenuItem
enabled: hasProjectSelectedSubversionRepositoryExistsAndBranchSelectedHolder
label: 'Merge'
translateLabel: true
submenuChannel: projectSubversionMergeMenu
labelImage: (ResourceRetriever #'SVN::IconLibrary' merge 'Merge')
)
(MenuItem
enabled: hasProjectSelectedSubversionRepositoryExistsAndBranchSelectedHolder
label: 'Changeset'
translateLabel: true
submenuChannel: projectSubversionChangesetMenu
)
(MenuItem
enabled: hasProjectSelectedSubversionRepositoryExistsAndBranchSelectedHolder
label: 'Revision log'
itemValue: projectMenuSubversionShowRevisionLog
translateLabel: true
labelImage: (ResourceRetriever #'SVN::IconLibrary' log 'Revision log')
)
(MenuItem
label: '-'
)
(MenuItem
label: 'Branch'
translateLabel: true
submenuChannel: commonSubversionBranchMenu
)
(MenuItem
label: 'Browse working copy'
itemValue: commonMenuSubversionBrowseWorkingCopy
translateLabel: true
)
(MenuItem
label: 'More'
translateLabel: true
submenu:
(Menu
(
(MenuItem
enabled: hasProjectSelectedSubversionRepositoryExistsAndBranchSelectedHolder
label: 'Load revision...'
itemValue: projectMenuSubversionLoadRevision
translateLabel: true
)
(MenuItem
label: '-'
)
(MenuItem
label: 'Remove working copy'
itemValue: projectMenuSubversionRemoveWorkingCopy
translateLabel: true
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasProjectSelectedSubversionRepositoryExistsAndBranchSelectedHolder
label: 'Fast commit'
translateLabel: true
choice: projectMenuSubversionCommitMode
choiceValue: fast
)
(MenuItem
enabled: hasProjectSelectedSubversionRepositoryExistsAndBranchSelectedHolder
label: 'Full commit'
translateLabel: true
choice: projectMenuSubversionCommitMode
choiceValue: full
)
(MenuItem
label: '-'
)
(MenuItem
label: 'Common Slice'
translateLabel: true
submenuChannel: commonSubversionMenuSlice
isMenuSlice: true
)
)
nil
nil
)
)
)
nil
nil
)
! !
!NewSystemBrowser class methodsFor:'menu specs-toolbar'!
toolBarMenu
"This resource specification was automatically generated
by the MenuEditor of ST/X."
"Do not manually edit this!! If it is corrupted,
the MenuEditor may not be able to read the specification."
"
MenuEditor new openOnClass:Tools::NewSystemBrowser andSelector:#toolBarMenu
(Menu new fromLiteralArrayEncoding:(Tools::NewSystemBrowser toolBarMenu)) startUp
"
<resource: #menu>
^
#(Menu
(
(MenuItem
activeHelpKey: goBackInGlobalHistory
enabled: canGoBackInGlobalHistoryAspect
label: 'Back (Global History)'
itemValue: goBackInGlobalHistory
isButton: true
isVisible: showGlobalHistory
labelImage: (ResourceRetriever ToolbarIconLibrary historyBackInGlobalListIcon)
)
(MenuItem
activeHelpKey: goBack
enabled: canGoBackAspect
label: 'Back'
itemValue: goBack
isButton: true
isVisible: showLocalHistory
labelImage: (ResourceRetriever ToolbarIconLibrary historyBackIcon)
)
(MenuItem
activeHelpKey: goForward
enabled: canGoForwardAspect
label: 'Forward'
itemValue: goForward
isButton: true
isVisible: showLocalHistory
labelImage: (ResourceRetriever ToolbarIconLibrary historyForwardIcon)
)
(MenuItem
label: ''
)
(MenuItem
activeHelpKey: createBuffer
label: 'CreateBuffer'
itemValue: createBufferForCurrentClassOrSelectionInCodeView
isButton: true
labelImage: (ResourceRetriever ToolbarIconLibrary addBufferIcon)
)
(MenuItem
label: '-'
isVisible: organizerIsShowingClasses
)
(MenuItem
activeHelpKey: showCategories
label: 'ShowCategory'
itemValue: switchToCategoryView
isButton: true
isVisible: organizerIsShowingClassesAndIsNotShowingCategories
labelImage: (ResourceRetriever NewSystemBrowser showCategoriesIcon)
showBusyCursorWhilePerforming: true
)
(MenuItem
activeHelpKey: showClassHierarchy
label: 'ShowClassHierarchy'
itemValue: switchToClassHierarchyView
isButton: true
isVisible: organizerIsShowingClassesAndIsShowingCategories
labelImage: (ResourceRetriever NewSystemBrowser showClassHierarchyIcon)
showBusyCursorWhilePerforming: true
)
(MenuItem
label: '-'
)
(MenuItem
activeHelpKey: recentChanges
label: 'Recently Changed'
isButton: true
submenuChannel: changedMenu
labelImage: (ResourceRetriever ToolbarIconLibrary changesBrowserIcon)
showBusyCursorWhilePerforming: true
ignoreMnemonicKeys: true
ignoreShortcutKeys: true
)
(MenuItem
activeHelpKey: recentClassChanges
label: 'Recently Changed Classes'
isButton: true
isVisible: false
submenuChannel: changedClassesMenu
labelImage: (ResourceRetriever ToolbarIconLibrary empty1x20Icon)
showBusyCursorWhilePerforming: true
ignoreMnemonicKeys: true
ignoreShortcutKeys: true
)
(MenuItem
activeHelpKey: bookmarks
label: 'Bookmarks'
isVisible: false
submenuChannel: boockmarksMenu
labelImage: (ResourceRetriever ToolbarIconLibrary bookmarks14x14)
ignoreMnemonicKeys: true
ignoreShortcutKeys: true
)
(MenuItem
label: ''
isVisible: false
)
(MenuItem
activeHelpKey: undoOperation
enabled: hasUndoableOperations
label: 'Undo'
itemValue: operationsMenuUndo
isButton: true
isVisible: false
labelImage: (ResourceRetriever ToolbarIconLibrary undoIcon)
showBusyCursorWhilePerforming: true
)
(MenuItem
activeHelpKey: redoOperation
enabled: hasUndoableOperations
label: 'Redo'
itemValue: operationsMenuRedo
isButton: true
isVisible: false
labelImage: (ResourceRetriever ToolbarIconLibrary redoIcon)
showBusyCursorWhilePerforming: true
)
(MenuItem
label: '-'
isVisible: classWizardVisibleHolder
)
(MenuItem
label: 'Class Wizard'
itemValue: classMenuOpenClassCreationWizard
isButton: true
isVisible: classWizardVisibleHolder
labelImage: (ResourceRetriever ToolbarIconLibrary newClassWizardIcon)
)
(MenuItem
label: '-'
)
(MenuItem
activeHelpKey: runLintOnClasses
enabled: hasNonEmptyEnvironmentSelectedHolder
label: 'Run Static Analysis (Lint)'
itemValue: runLint
nameKey: RunLint
isButton: true
labelImage: (ResourceRetriever ToolbarIconLibrary lint24x24Icon)
)
(MenuItem
label: '-'
isVisible: hasClassSelectedHolder
)
(MenuItem
activeHelpKey: executeSelectedClassMethod
label: 'Execute Selected Class Method'
itemValue: executeSelectedClassMethod
isButton: true
isVisible: hasAnyExecutableClassMethodSelectedHolder
labelImage: (ResourceRetriever ToolbarIconLibrary executeMethod20x20Icon)
showBusyCursorWhilePerforming: true
)
(MenuItem
label: '-'
isVisible: hasAnyExecutableClassMethodSelectedHolder
)
(MenuItem
activeHelpKey: initializeSharedPool
label: 'Initialize Selected Pool'
itemValue: initializeSelectedPool
isButton: true
isVisible: hasSharedPoolSelectedHolder
labelImage: (ResourceRetriever #'Tools::NewSystemBrowser' initializeSharedPool20x20Icon)
showBusyCursorWhilePerforming: true
)
(MenuItem
label: '-'
isVisible: hasSharedPoolSelectedHolder
)
(MenuItem
activeHelpKey: launchSelectedApplication
label: 'Launch Selected Application'
itemValue: launchSelectedApplication
isButton: true
isVisible: hasStartableApplicationSelectedHolder
labelImage: (ResourceRetriever ToolbarIconLibrary start22x22Icon)
showBusyCursorWhilePerforming: true
)
(MenuItem
label: '-'
isVisible: hasStartableApplicationSelectedHolder
)
(MenuItem
activeHelpKey: packageSelectedApplication
label: 'Package Selected Application...'
itemValue: packageSelectedApplication
isButton: true
isVisible: hasPackagableApplicationSelectedHolder
labelImage: (ResourceRetriever ToolbarIconLibrary packageIn24x24Icon)
showBusyCursorWhilePerforming: true
)
(MenuItem
label: '-'
isVisible: hasPackagableApplicationSelectedHolder
)
(MenuItem
activeHelpKey: runTestCases
label: 'Run Tests'
itemValue: runTestCases
isButton: true
isVisible: hasAnyTestCaseSelectedAndEmbeddedRunnerIsDisabled
labelImage: (ResourceRetriever ToolbarIconLibrary sUnit24x24Icon)
showBusyCursorWhilePerforming: true
)
(MenuItem
activeHelpKey: runTestCasesWithDebug
label: 'Debug Tests'
itemValue: runTestCasesWithDebug
isButton: true
isVisible: hasAnyTestCaseSelectedAndEmbeddedRunnerIsDisabled
labelImage: (ResourceRetriever ToolbarIconLibrary sUnit24x24DebugIcon)
showBusyCursorWhilePerforming: true
)
(MenuItem
label: ''
)
(MenuItem
label: '-'
startGroup: right
)
(MenuItem
activeHelpKey: showInheritedMethods
label: 'ShowInheritedMethods'
itemValue: showInheritedMethods
isButton: true
startGroup: right
isVisible: notShowingInheritedMethods
labelImage: (ResourceRetriever NewSystemBrowser showInheritedMethodsIcon)
showBusyCursorWhilePerforming: true
)
(MenuItem
activeHelpKey: doNotShowInheritedMethods
label: 'DoNotShowInheritedMethods'
itemValue: doNotShowInheritedMethods
isButton: true
startGroup: right
isVisible: showingInheritedMethods
labelImage: (ResourceRetriever NewSystemBrowser doNotShowInheritedMethodsIcon)
showBusyCursorWhilePerforming: true
)
(MenuItem
activeHelpKey: formatCode
enabled: hasMethodSelectedHolder
label: 'Format'
itemValue: codeMenuFormat
isButton: true
startGroup: right
labelImage: (ResourceRetriever ToolbarIconLibrary formatCode16x16Icon)
showBusyCursorWhilePerforming: true
)
(MenuItem
activeHelpKey: showCodeCoverage
enabled: hasInstrumentedMethodSelectedHolder
label: 'ShowCoverage'
itemValue: codeMenuShowCoverage
isButton: true
startGroup: right
isVisible: false
labelImage: (ResourceRetriever ToolbarIconLibrary showCodeCoverage16x16Icon)
)
(MenuItem
activeHelpKey: addBreakPoint
enabled: hasMethodWithoutBreakPointSelectedHolder
label: 'Add BreakPoint'
itemValue: debugMenuBreakPoint
isButton: true
startGroup: right
labelImage: (ResourceRetriever nil addBreakPointIcon2)
)
(MenuItem
activeHelpKey: removeBreakPoint
enabled: hasMethodWithBreakPointSelectedHolder
label: 'Remove BreakPoint'
itemValue: debugMenuRemoveBreakOrTrace
isButton: true
labelImage: (ResourceRetriever nil removeBreakPointIcon2)
)
)
nil
nil
)
!
toolBarMenuLint
"This resource specification was automatically generated
by the MenuEditor of ST/X."
"Do not manually edit this!! If it is corrupted,
the MenuEditor may not be able to read the specification."
"
MenuEditor new openOnClass:Tools::NewSystemBrowser andSelector:#toolBarMenuLint
(Menu new fromLiteralArrayEncoding:(Tools::NewSystemBrowser toolBarMenuLint)) startUp
"
<resource: #menu>
^
#(Menu
(
(MenuItem
label: 'SmallLint Menu'
submenuChannel: smalllintCheckMenuForToolbar
isMenuSlice: true
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasClassSelectedAndInstrumentingCompilerExistsHolder
label: 'Recompile all Methods with Instrumentation'
itemValue: classMenuRecompileInstrumented
showBusyCursorWhilePerforming: true
)
)
nil
nil
)
"Modified: / 27-11-2014 / 06:48:37 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!NewSystemBrowser class methodsFor:'queries'!
hasSubversionSupport
^ ConfigurableFeatures includesFeature: #SubversionSupportEnabled
"Modified: / 07-09-2011 / 10:45:40 / cg"
"Modified: / 19-01-2012 / 10:46:05 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!NewSystemBrowser class methodsFor:'startup'!
browseClass:aClass
"launch a single class browser."
|browser|
browser := self basicNew spawnClassBrowserFor:(Array with:aClass theNonMetaclass) in:#newBrowser.
aClass isMeta ifTrue:[
browser switchToClass:aClass.
].
^ browser.
"
self browseClass:Array
"
"Modified: / 15-01-2011 / 14:07:36 / cg"
!
browseClasses:aCollectionOfClasses
"launch a multi class browser."
^ self browseClasses:aCollectionOfClasses label:nil
"
self browseClasses:(Array with:Array with:Number)
"
!
browseClasses:aCollectionOfClasses label:titleOrNil
"launch a multi class browser."
^ self openWithSelectedClasses:aCollectionOfClasses label:titleOrNil
"/ ^ self basicNew
"/ spawnClassBrowserFor:aCollectionOfClasses
"/ label:titleOrNil
"/ in:#newBrowser.
"
self browseClasses:(Array with:Array with:Number) label:'Some classes'
"
"Modified: / 06-07-2011 / 21:29:16 / cg"
!
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
"
!
browseProfilerStatistics: statistics
"launch browser on profiler statistics"
^ self basicNew spawnProfilerStatistics: statistics in:#newBrowser.
"
self browseClass:Array
"
"Created: / 09-10-2007 / 22:03:05 / janfrog"
!
browseSingleClass:aClass
"launch a single class browser."
| browser |
browser := self basicNew spawnSingleClassBrowserFor:aClass theNonMetaclass in:#newBrowser.
aClass isMeta ifTrue:[
browser switchToClass:aClass.
].
^ browser.
"
self browseSingleClass:Array
"
"Modified: / 15-01-2011 / 14:07:36 / cg"
"Created: / 22-07-2011 / 18:44:52 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
open
|lastClass classHistory|
classHistory := self classHistory.
classHistory notEmptyOrNil 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.
Returns the browser"
|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 new
browseMenuMethodsInCurrentChangeSetIn:#newBrowser
"
self openOnMethodsInChangeSet
"
!
openOnPackage:aPackage
"open a browser, showing all classes in the given package."
^ self basicNew
spawnProjectBrowserFor:(Array with:aPackage) in:#newBrowser
"
self openOnPackage:'stx:libbasic'
"
!
openWithSelectedClasses:aCollectionOfClasses label:titleOrNil
"launch a full browser with multiple classes initially selected.
(also selects the corresponding categories)"
|browser|
browser := self new.
browser allButOpen.
browser selectClasses:aCollectionOfClasses.
browser openWindow.
^ browser
"/ ^ self basicNew
"/ spawnClassBrowserFor:aCollectionOfClasses
"/ label:titleOrNil
"/ in:#newBrowser.
"/
"
self openWithSelectedClasses:(Array with:Array with:Number) label:'Some classes'
"
"Created: / 06-07-2011 / 18:27:53 / cg"
! !
!NewSystemBrowser class methodsFor:'utilities'!
askForClassToSearch:doWhatByDefault single:singleClass msgTail:msgTail resources:resourcesOrNil filter:filterOrNil forBrowser:aBrowserOrNil thenDo:aBlock
"utility common code for both opening a new browser on a class and
to search for a class in an existing browser.
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.
Moved from instance protocol for better reusability."
|box boxLabel title okText okText2 okText3 okText4 className canFind
button2 button3 button4 doWhat doWhat2 doWhat3 doWhat4 classNameHolder updateList updateClassAndNameList
reallyAllClasses allClasses allClassesByFullName classNamesInChangeSet classesInChangeSet
allNames allFullNames initialShortNames initialFullNames
colorizedFullNames colorizedShortNames
resources check showingWhatLabel
showFullNameHolder onlyShowJavaClassesHolder genShortNameListEntry navigationState|
resources := resourcesOrNil ? self classResources.
showFullNameHolder := (LastClassSearchBoxShowedFullName ? false) asValue.
onlyShowJavaClassesHolder := (LastClassSearchBoxShowedJavaOnly ? false) asValue.
aBrowserOrNil notNil ifTrue:[ navigationState := aBrowserOrNil navigationState].
doWhat := doWhatByDefault.
canFind := navigationState notNil and:[ navigationState isFullBrowser ].
(doWhat isNil or:[aBrowserOrNil isNil]) ifTrue:[
title := 'Select a class'.
boxLabel := (resources string:'Select a class').
okText := 'OK'.
okText2 := nil. doWhat2 := nil.
okText3 := nil. doWhat3 := nil.
okText4 := nil. doWhat4 := nil.
] ifFalse:[
title := (singleClass ifTrue:[ 'Class to browse' ] ifFalse:[ 'Class(es) to browse' ]).
boxLabel := (resources string:'Browse or Search').
(doWhat isNil and:[canFind not]) ifTrue:[
doWhat := #newBuffer.
].
doWhat == #newBrowser ifTrue:[
okText := 'Open'.
okText2 := 'Add Buffer'. doWhat2 := #newBuffer.
okText3 := 'Open All'. doWhat3 := #newBrowserForAll.
okText4 := 'Find'. doWhat4 := nil.
] ifFalse:[ doWhat == #newBuffer ifTrue:[
okText := 'Add Buffer'.
okText2 := 'Open New'. doWhat2 := #newBrowser.
okText3 := 'Open All'. doWhat3 := #newBrowserForAll.
okText4 := 'Find'. doWhat4 := nil.
] ifFalse:[
title := (singleClass ifTrue:[ 'Class to find' ] ifFalse:[ 'Class(es) to find' ]).
okText := 'Find'.
okText2 := 'Open New'. doWhat2 := #newBrowser.
okText3 := 'Open All'. doWhat3 := #newBrowserForAll.
okText4 := 'Add Buffer'. doWhat4 := #newBuffer.
]].
].
genShortNameListEntry :=
[:cls |
|ns|
cls isNil ifTrue:[
nil
] ifFalse:[
ns := cls topNameSpace name.
ns = 'Smalltalk'
ifTrue:[ ns := '' ]
ifFalse:[ns := ' (in ',ns,')'].
cls nameWithoutNameSpacePrefix,ns
].
].
classesInChangeSet := ChangeSet current changedClasses.
classNamesInChangeSet := classesInChangeSet
select: (filterOrNil ? [:cls | true])
thenCollect:[:each | each theNonMetaclass name].
initialFullNames := self visitedClassNamesHistory.
(filterOrNil notNil) ifTrue:[
initialFullNames := initialFullNames select:[:nm | (Smalltalk at:nm) notNil and:[filterOrNil value:(Smalltalk at:nm)]].
].
initialFullNames := initialFullNames select:[:nm | nm notNil].
initialShortNames := initialFullNames collect:[:nm |
|cls|
cls := Smalltalk classNamed:nm.
cls isNil ifTrue:[
"/ class no longer exists (removed?)
nm withColor:(Color gray)
] ifFalse:[
cls isJavaClass ifTrue:[
cls javaName
] ifFalse:[
genShortNameListEntry value:(Smalltalk classNamed:nm)
].
].
].
colorizedFullNames := initialFullNames collect:[:clsName |
(classNamesInChangeSet includes:clsName) ifTrue:[
clsName asText emphasisAllAdd:(SystemBrowser emphasisForChangedCode)
] ifFalse:[
clsName
].
].
colorizedShortNames := initialShortNames with:initialFullNames collect:[:shortName :clsName |
(classNamesInChangeSet includes:clsName) ifTrue:[
shortName asText emphasisAllAdd:(SystemBrowser emphasisForChangedCode)
] ifFalse:[
shortName
].
].
title := (resources string:title) , msgTail , '.\' , (resources string:'(TAB to complete; matchPattern allowed - "*" for all):').
box := self
enterBoxForClassWithCodeSelectionTitle:title withCRs
withList:(showFullNameHolder value ifTrue:[colorizedFullNames] ifFalse:[colorizedShortNames])
okText:okText
forBrowser:aBrowserOrNil.
box label:boxLabel.
doWhat notNil ifTrue:[
button2 := Button label:(resources string:okText2).
(navigationState notNil and:[navigationState isFullBrowser]) "singleClass" ifTrue:[
button3 := Button label:(resources string:okText3).
button4 := Button label:(resources string:okText4).
].
box addButton:button2 after:(box okButton).
button3 notNil ifTrue:[box addButton:button3 after:button2].
button4 notNil ifTrue:[box addButton:button4 after:button3].
button2
action:[
doWhat := doWhat2.
box doAccept; okPressed.
].
button3 notNil ifTrue:[
button3
action:[
doWhat := doWhat3.
box doAccept; okPressed.
].
].
button4 notNil ifTrue:[
button4
action:[
doWhat := doWhat4.
box doAccept; okPressed.
].
].
].
reallyAllClasses := Smalltalk allClasses copyAsOrderedCollection.
filterOrNil notNil ifTrue:[
reallyAllClasses := reallyAllClasses select: filterOrNil
].
allClasses := reallyAllClasses.
updateClassAndNameList :=
[
onlyShowJavaClassesHolder value ifTrue:[
allClasses := reallyAllClasses select:[:cls | cls isJavaClass].
].
allClassesByFullName := allClasses copy.
allNames := (allClasses
collect:[:cls |
|ns nm|
cls isJavaClass ifTrue:[
nm := cls javaName,' (in JAVA)'
] ifFalse:[
ns := cls topNameSpace name.
ns = 'Smalltalk'
ifTrue:[ ns := '' ]
ifFalse:[ns := ' (in ',ns,')'].
cls isNameSpace ifTrue:[
nm := cls nameWithoutNameSpacePrefix,ns,' (Namespace)'
] ifFalse:[
nm := cls nameWithoutNameSpacePrefix,ns
].
].
(classNamesInChangeSet includes:cls name) ifTrue:[
nm asText emphasisAllAdd:(UserPreferences current emphasisForChangedCode)
] ifFalse:[
nm
].
]) sortWith:allClasses; yourself.
allFullNames := (allClasses
collect:[:cls |
|nm|
nm := cls name.
(classNamesInChangeSet includes:cls name) ifTrue:[
nm asText emphasisAllAdd:(UserPreferences current emphasisForChangedCode)
] ifFalse:[
nm
].
]) sortWith:allClassesByFullName; yourself.
].
updateClassAndNameList value.
updateList := [
|nameToSearch list namesStarting namesIncluding lcName nameList classList|
(nameToSearch := classNameHolder value withoutSeparators) isEmpty ifTrue:[
showingWhatLabel label:(resources string:'Recently visited:').
list := (showFullNameHolder value ifTrue:[colorizedFullNames] ifFalse:[colorizedShortNames]).
] ifFalse:[
showingWhatLabel label:(resources string:'Matching classes:').
nameList := showFullNameHolder value ifTrue:[ allFullNames ] ifFalse:[ allNames ].
classList := showFullNameHolder value ifTrue:[ allClassesByFullName ] ifFalse:[ allClasses ].
lcName := nameToSearch asLowercase.
(lcName includesString:'::') ifTrue:[
list := OrderedCollection new.
allClasses doWithIndex:[:cls :idx |
|isIncluded|
(nameToSearch includesMatchCharacters) ifTrue:[
isIncluded := (lcName match:cls name asLowercase)
] ifFalse:[
isIncluded := (cls name includesString:lcName caseSensitive:false)
].
isIncluded ifTrue:[
list add:(nameList at:idx)
].
].
] ifFalse:[
(nameToSearch includesMatchCharacters) ifTrue:[
list := (1 to:nameList size)
select:[:idx |
|nm|
nm := nameList at:idx.
(lcName match:nm asLowercase)
or:[ lcName match:(classList at:idx) name caseSensitive:false]
] thenCollect:[:idx | nameList at:idx].
] ifFalse:[
namesIncluding := (1 to:nameList size)
select:[:idx |
|nm|
nm := nameList at:idx.
(nm asLowercase includesString:lcName caseSensitive:false)
or:[ (classList at:idx) name includesString:lcName caseSensitive:false]
] thenCollect:[:idx | nameList at:idx].
namesStarting := namesIncluding select:[:nm | nm asLowercase startsWith:lcName].
list := namesStarting , {nil} , (namesIncluding \ namesStarting).
]
]
].
box listView
list:list;
scrollToLine:((list findFirst:[:line | (line ? '') startsWith:lcName]) max:1)
].
classNameHolder := '' asValue.
box enterField
model:classNameHolder;
immediateAccept:true.
classNameHolder onChangeEvaluate:updateList.
box entryCompletionBlock:(DoWhatIMeanSupport classNameEntryCompletionBlock).
box
action:[:aString |
className := aString.
].
box panelView
addSubView:(showingWhatLabel := (Label label:(resources string:'Recently visited:')) adjust:#left) before:nil.
(JavaVM notNil and:[JavaVM isLoaded]) ifTrue:[
box panelView
addSubView:(check := CheckBox label:(resources string:'Only show Java Classes') model:onlyShowJavaClassesHolder) before:nil.
].
box panelView
addSubView:(check := CheckBox label:(resources string:'Show Full Name (do not strip off Namespace)') model:showFullNameHolder) before:nil.
showFullNameHolder onChangeEvaluate:updateList.
onlyShowJavaClassesHolder onChangeEvaluate:[ updateClassAndNameList value. updateList value].
box enterField
"/ onKey:#CursorDown leaveWith:[
"/ |listView|
"/
"/ listView := box listView.
"/ listView windowGroup focusView:listView byTab:true.
"/ listView hasSelection ifFalse:[
"/ listView selectFirst
"/ ] ifTrue:[
"/ listView selectNext
"/ ].
"/ ];
origin:(0 @ check corner y).
box listView origin:(0 @ check corner y).
box extent:(400 @ 550).
box open.
className isEmptyOrNil ifTrue:[^ nil "cancel"].
LastClassSearchBoxShowedFullName := showFullNameHolder value.
LastClassSearchBoxShowedJavaOnly := onlyShowJavaClassesHolder value.
(className endsWith:$) ) ifTrue:[
(className indexOfSubCollection:'(in ') == 0 ifTrue:[
"/ a namespace
className := (className copyTo:(className indexOfSubCollection:'(Name')-1) withoutSeparators
] ifFalse:[
className := ((className copyFrom:(className indexOfSubCollection:'(in ')+4)
copyButLast)
, '::' , className asCollectionOfWords first
].
((className startsWith:'JAVA::') and:[className includes:$.]) ifTrue:[
className := className copyReplaceString:'.' withString:'::'
].
].
(doWhat isNil or:[aBrowserOrNil isNil]) ifTrue:[
aBlock notNil ifTrue:[aBlock value:className optionalArgument:singleClass and:doWhat].
^ className
].
aBrowserOrNil withSearchCursorDo:[
aBlock value:className value:singleClass value:doWhat.
].
^ className
"Modified: / 29-08-2013 / 12:24:28 / cg"
"Modified: / 04-09-2013 / 17:48:16 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
enterBoxTitle:title okText:okText label:label
"convenient method: setup an enterBox"
|box rresources|
rresources := self classResources.
box := EnterBox new.
box label:(rresources string:label).
box
title:(rresources string:title)
okText:(rresources string:okText).
^ box
"Created: / 6.2.2000 / 01:07:11 / cg"
! !
!NewSystemBrowser methodsFor:'accessing'!
buffersDo:aBlock
buffers notNil ifTrue:[ buffers do:aBlock ]
!
environment
^ environment
"Created: / 03-09-2013 / 19:19:47 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
environment:env
environmentHolder notNil ifTrue:[
environmentHolder value: env.
] ifFalse:[
environment := env.
].
"Modified: / 26-04-2014 / 23:54:34 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
isEmbeddedBrowser
"allows the inspector to disable certain menu items (+ buffer)"
^ isEmbedded ? false
!
isEmbeddedBrowser:aBoolean
"allows the inspector to disable certain menu items (+ buffer)"
isEmbedded := aBoolean.
! !
!NewSystemBrowser methodsFor:'aspects'!
bookmarkHolder
^self navigationState bookmarkHolder
"Created: / 02-06-2011 / 22:46:22 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
bookmarkListHolder
^self class bookmarks
"Created: / 02-06-2011 / 22:36:22 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
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
!
cursorLineAndColumnLabelHolder
"the current buffers cursor position holder (info field)"
^ self navigationState cursorLineAndColumnLabelHolder
!
cursorLineLabelHolder
"the current buffers cursorLineumn Holder (info field)"
^ self navigationState cursorLineLabelHolder
!
doEnableRefactoringSupport
^ builder
valueAspectFor:#doEnableRefactoringSupport
computeInitialValueWith:[ self canUseRefactoringSupport ]
!
doLoadRefactoringSupport
RefactoryChangeManager autoload.
!
editModeHolder
"the current buffers editMode Holder (insert/overwrite/...)"
^ self navigationState editModeHolder
!
environmentHolder
"return/create the 'environmentHolder' value holder (automatically generated)"
environmentHolder isNil ifTrue:[
environmentHolder := ValueHolder with: environment.
environmentHolder addDependent:self.
].
^ environmentHolder
"Modified: / 24-02-2014 / 11:06:52 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
environmentHolder:aValueModel
"set the 'environmentHolder' value holder (automatically generated)"
|oldValue newValue|
environmentHolder notNil ifTrue:[
oldValue := environmentHolder value.
environmentHolder removeDependent:self.
].
environmentHolder := aValueModel.
environmentHolder notNil ifTrue:[
environmentHolder addDependent:self.
].
newValue := environmentHolder value.
oldValue ~~ newValue ifTrue:[
self update:#value with:newValue from:environmentHolder.
].
!
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 buffer's infoLabel (info field at the bottom)"
^ self navigationState infoLabelHolder
!
messageHolder
"the current buffers message (in message pane)"
^ self navigationState messageHolder
"Created: / 27-08-2010 / 22:08:38 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
messageSpecHolder
"the current buffers message (in message pane)"
^ self navigationState messageSpecHolder
"Created: / 28-08-2010 / 11:41:25 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
metaToggleLabelHolder
^ self navigationState metaToggleLabelHolder
!
methodInfo
^ self navigationState methodInfo
!
modeLabelHolder
"the current buffers mode label Holder (insert/learn info field)"
^ self navigationState modeLabelHolder
!
navigationState
|theCanvas theCanvasType|
navigationState isNil ifTrue:[
navigationState := NavigationState new.
"/ the kludge below is required to allow
"/ subSpecs to be opened in full-window (without a noteBook) as well
"/ (without that, we get trouble accessing the codeView later ...)
browserCanvas isNil ifTrue:[
"/ opened spec as top-spec (there is no canvas)
^ navigationState.
"/ theCanvas := self.
"/ bldr := self builder.
"/
"/ bldr notNil ifTrue:[
"/ theCanvasType := bldr spec name.
"/ ] ifFalse:[
"/ theCanvasType := self browserCanvasType.
"/ ]
] ifFalse:[
"/ opened spec in canvas
theCanvas := self browserCanvas value.
theCanvasType := self browserCanvasType.
].
self assert:theCanvas notNil.
navigationState canvas:theCanvas.
theCanvasType isNil ifTrue:[
theCanvasType := theCanvas spec.
].
navigationState canvasType:theCanvasType.
self updateNavigationHistory.
self updateBookmarkHolder.
].
^ navigationState
"Created: / 04-02-2000 / 16:00:10 / cg"
"Modified: / 18-02-2000 / 13:50:27 / cg"
"Modified: / 27-02-2008 / 08:50:55 / janfrog"
"Modified: / 02-06-2011 / 22:34:38 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
noAllItem
^ self navigationState noAllItem
!
packageInfoBackgroundColorHolder
"Current background color of package info bar"
^ self navigationState packageInfoBackgroundColorHolder
"Created: / 03-10-2011 / 13:56:42 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
packageLabelHolder
"the current buffers packageLabel (info field)"
^ self navigationState packageLabelHolder
!
progressHolder
"the current buffers message (in message pane)"
^ self navigationState progressHolder
"Created: / 28-08-2010 / 10:06:33 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
searchedClassNameHolder
|holder|
(holder := builder bindingAt:#searchedClassNameHolder) isNil ifTrue:[
holder := '' asValue.
builder aspectAt:#searchedClassNameHolder put:holder.
holder onChangeEvaluate:[
self switchToClassNameMatching: holder value].
].
^ holder
!
searchedClassNameOrSelectorHolder
|holder|
(holder := builder bindingAt:#searchedClassNameOrSelectorHolder) isNil ifTrue:[
holder := '' asValue.
builder aspectAt:#searchedClassNameOrSelectorHolder put:holder.
holder onChangeEvaluate:[ self switchToSearchItemMatching: holder value].
].
^ holder
"Modified: / 10-08-2006 / 18:10:46 / cg"
!
selectedBuffer
selectedBuffer isNil ifTrue:[
selectedBuffer := nil asValue.
selectedBuffer addDependent:self.
].
^ selectedBuffer
"Created: / 5.2.2000 / 04:21:11 / cg"
!
selectionChangeConditionFor:aSubApplication
|answer|
navigationState modified ifFalse:[^ true].
answer := self askIfModified:'Modifications have not been saved.\\Change selection anyway ?'.
answer ifTrue:[
navigationState modified:false.
navigationState realModifiedState:false.
(self codeAspect == SyntaxHighlighter codeAspectClassDefinition
and:[aSubApplication ~~ self classListApp]) ifTrue:[
self classListApp forceReselect
] ifFalse:[
aSubApplication forceSelectionClear.
]
].
^ answer
"Created: / 23-02-2000 / 12:14:38 / cg"
!
selectionChangeConditionHolder
^ [:whichSubApplication | self selectionChangeConditionFor:whichSubApplication ]
"Modified: / 23.2.2000 / 12:14:50 / cg"
!
sortBy
^ self navigationState sortBy
!
suppressChangeSetUpdate
^ (builder bindingAt:#suppressChangeSetUpdate) ? false
!
suppressChangeSetUpdate:aBoolean
builder aspectAt:#suppressChangeSetUpdate put:aBoolean
! !
!NewSystemBrowser methodsFor:'aspects-environment'!
selectedCategoriesAsEnvironment
"Return a refactory environment on all classes in selected
class categories. May return nil if refactory browser is not
available"
|subjects|
self canUseRefactoringSupport ifTrue:[
subjects := self selectedCategoriesValue.
^ (CategoryEnvironment new)
categories:subjects;
label:(subjects size = 1
ifTrue:[ 'class category ' , (subjects anyOne ? '')]
ifFalse:[ subjects size printString , ' class categories' ]);
yourself
].
^ self.
"Created: / 17-04-2010 / 10:29:37 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 06-03-2012 / 18:54:41 / cg"
"Modified: / 03-12-2014 / 11:04:41 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
selectedClassesAsEnvironment
"Return a refactory environment on all selected classes
May return nil if refactory browser is not available"
|subjects allSubjects|
self canUseRefactoringSupport ifTrue:[
subjects := self selectedClassesValue.
allSubjects := Set withAll:(subjects collect:[:cls | cls theNonMetaclass]).
allSubjects addAll:(subjects collect:[:cls | cls theMetaclass]).
^ (ClassEnvironment new)
classes:allSubjects;
label:(subjects size = 1
ifTrue:[ 'class ' , subjects anyOne fullName ]
ifFalse:[ subjects size printString , ' classes' ]);
yourself
].
^ nil
"Created: / 24-02-2009 / 11:08:35 / Jan Vrany <vranyj1@fel.cvut.cz>"
"Modified: / 06-03-2012 / 18:54:49 / cg"
"Modified: / 03-12-2014 / 11:11:34 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
selectedCodeComponentsAsEnvironment
"Returns a non-empty environment for the current selection.
Depends on the current navigation state and context.
May return nil if refactory browser is not available."
^ self selectedEnvironment
"Created: / 17-04-2010 / 10:09:16 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 03-08-2011 / 22:48:50 / cg"
"Modified: / 02-04-2014 / 12:08:37 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
selectedEnvironment
"Returns a non-empty environment for the current selection.
Depends on the current navigation state and context.
May return nil if refactory browser is not available."
^ self selectedNonEmptyEnvironment.
"Modified: / 03-08-2011 / 22:49:37 / cg"
"Modified (format): / 02-04-2014 / 12:06:28 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
selectedLintRuleClassesAsEnvironment
"Return a refactory environment on all classes reported by
selected rule checks. May return nil if refactory browser is not
available"
| classes |
self canUseRefactoringSupport ifTrue:[
classes := self selectedLintRuleClasses value.
^ (ClassEnvironment new)
classes:classes;
label:(classes size = 1
ifTrue:[ 'class ' , classes anyOne fullName ]
ifFalse:[ classes size printString , ' classes' ]);
yourself
].
^ nil.
"Created: / 07-10-2014 / 13:00:53 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 03-12-2014 / 11:14:27 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
selectedNamespacesAsEnvironment
"Return a refactory environment on all classes in selected
namespaces. May return nil if refactory browser is not
available"
|subjects|
self canUseRefactoringSupport ifTrue:[
subjects := self selectedNamespacesValue.
^ (NamespaceEnvironment new)
namespaceNames:subjects;
label:(subjects size = 1
ifTrue:[ 'namespace ' , subjects anyOne ]
ifFalse:[ subjects size printString , ' namespaces' ]);
yourself
].
^ nil
"Created: / 02-04-2014 / 11:49:42 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 03-12-2014 / 11:15:26 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
selectedNonEmptyEnvironment
"Returns a non-empty environment for the current selection.
Depends on the current navigation state and context.
May return nil if refactory browser is not available."
| type mode |
type := self navigationState canvasType.
type == #fullBrowserSpec ifTrue:[
mode := self navigationState organizerMode value.
mode == #category ifTrue:[
^ self selectedNonEmptyEnvironmentFrom: #(selectedSelectorsAsEnvironment selectedProtocolsAsEnvironment selectedClassesAsEnvironment selectedCategoriesAsEnvironment).
].
(mode == #classHierarchy or:[mode == #hierarchy]) ifTrue:[
^ self selectedNonEmptyEnvironmentFrom: #(selectedSelectorsAsEnvironment selectedProtocolsAsEnvironment selectedClassesAsEnvironment)
].
mode == #namespace ifTrue:[
^ self selectedNonEmptyEnvironmentFrom: #(selectedSelectorsAsEnvironment selectedProtocolsAsEnvironment selectedClassesAsEnvironment selectedNamespacesAsEnvironment)
].
mode == #project ifTrue:[
^ self selectedNonEmptyEnvironmentFrom: #(selectedSelectorsAsEnvironment selectedProtocolsAsEnvironment selectedClassesAsEnvironment selectedPackagesAsEnvironment)
].
].
type == #smallLintByRuleResultBrowserSpec ifTrue:[
^ self selectedCodeComponentsUsing: #(selectedSelectorsAsEnvironment selectedClassesAsEnvironment selectedLintRuleClassesAsEnvironment)
].
type == #methodListBrowserSpec ifTrue:[
^ self selectedCodeComponentsUsing: #(selectedSelectorsAsEnvironment)
].
type == #multipleMethodBrowserSpec ifTrue:[
^ self selectedCodeComponentsUsing: #(selectedSelectorsAsEnvironment)
].
type == #multipleClassBrowserSpec ifTrue:[
^ self selectedCodeComponentsUsing: #(selectedSelectorsAsEnvironment selectedProtocolsAsEnvironment selectedClassesAsEnvironment)
].
type == #visualProfilerSpec ifTrue:[
^ self selectedCodeComponentsUsing: #(selectedSelectorsAsEnvironment)
].
"Add more..."
self breakPoint: #jv.
"/Fallback
^ self selectedCodeComponentsUsing: #(selectedSelectorsAsEnvironment selectedProtocolsAsEnvironment selectedClassesAsEnvironment)
"Created: / 02-04-2014 / 11:38:59 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 22-02-2017 / 22:39:39 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
selectedNonEmptyEnvironmentFrom: environmentsOrSelectors
"Returns first non-empty environment from given list. If none if them is
non empty, return an empty environment. May return nil if refactory browser is
not available."
| env |
self canUseRefactoringSupport ifTrue:[
environmentsOrSelectors do:[:envOrSym |
env := envOrSym isSymbol ifTrue:[ self perform: envOrSym] ifFalse:[envOrSym].
env isEmpty ifFalse:[ ^ env ].
].
^ BrowserEnvironment empty
].
^ nil.
"Created: / 02-04-2014 / 11:20:21 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 03-12-2014 / 11:22:13 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
selectedPackagesAsEnvironment
"Return a refactory environment on all classes & methods in
selected packages . May return nil if refactory browser is
not available."
|subjects|
self canUseRefactoringSupport ifFalse:[^ nil].
"/ this is wrong - it returns the raw project name;
"/ subjects := self selectedProjectsValue.
"/ the following cares for pseudo protocols (* all *)
subjects := Array streamContents:[:s |
self selectedProjectsDo:[:prj |
(BrowserList isPseudoProject:prj) ifFalse:[
s nextPut:prj
]
]
].
subjects isEmpty ifTrue:[
^ BrowserEnvironment empty.
].
^ (PackageEnvironment new)
packageNames:subjects;
label:(subjects size = 1
ifTrue:[ 'package' , subjects anyOne ]
ifFalse:[ subjects size printString , ' packages' ]);
yourself
"Created: / 05-05-2012 / 10:21:37 / cg"
"Modified: / 03-12-2014 / 11:26:28 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
selectedProtocolsAsEnvironment
"Return a refactory environment on all methods in selected
method protocols. May return nil if refactory browser is not
available"
| classes protocols label |
self canUseRefactoringSupport ifTrue:[
classes := self selectedClassesValue.
classes isEmpty ifTrue:[
^ BrowserEnvironment empty.
].
classes size == 1 ifTrue:[
label := classes anElement name.
] ifFalse:[
classes size == 2 ifTrue:[
label := classes first name , ' and ' , classes second name
] ifFalse:[
label := classes size printString , ' classes'.
].
].
protocols := self selectedProtocolsValue.
^ ProtocolEnvironment new
classes: classes
protocols: protocols;
label:(protocols size = 1
ifTrue:[ 'protocol' , protocols anElement printString , ' in ' , label ]
ifFalse:[ protocols size printString , ' protocols in ' , label ]);
yourself
].
^ nil
"Created: / 17-04-2010 / 10:57:59 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 06-03-2012 / 18:55:00 / cg"
"Modified (format): / 21-08-2015 / 23:46:26 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
selectedSelectorsAsEnvironment
"Return a refactory environment on all selected methods
May return nil if refactory browser is not available"
| methods env |
self canUseRefactoringSupport ifTrue:[
methods := self selectedMethodsValue.
env := SelectorEnvironment onEnvironment: BrowserEnvironment new.
methods do:[:mthd|mthd mclass notNil ifTrue:[env addClass: mthd mclass selector: mthd selector]].
^ env
].
^ nil.
"Created: / 16-07-2010 / 09:25:04 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 28-02-2012 / 16:28:38 / cg"
"Modified: / 03-12-2014 / 11:26:13 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!NewSystemBrowser methodsFor:'aspects-kludges'!
metaToggle
^ self navigationState metaToggle
!
notMetaToggle
^ self navigationState notMetaToggle
! !
!NewSystemBrowser methodsFor:'aspects-menus'!
anyRepositoryMenusAreShown
^ self cvsRepositoryMenusAreShown value
or:[ self hgRepositoryMenusAreShown value
or:[ self mercurialRepositoryMenusAreShown value
or:[ self perforceRepositoryMenusAreShown value
or:[ self svnRepositoryMenusAreShown value]]]]
!
categoryMenu
"to avoid generation of an aspect method by GUI definer"
^ self class categoryMenu
"Created: / 18.2.2000 / 12:17:07 / cg"
!
classMenuForSmallLint
"somehow I need this indirection; otherwise,
aspects are fetched too early (with no class selected),
and the CVS menus are all disabled"
^ [ self classMenu ]
!
cvsRepositoryMenusAreShown
^ ConfigurableFeatures includesFeature: #CVSSupportEnabled
"Created: / 18-01-2012 / 10:50:13 / cg"
"Modified: / 19-01-2012 / 10:44:30 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
dataBaseRepositoryMenusAreShown
^ ConfigurableFeatures includesFeature: #DataBaseSourceCodeManagerSupportEnabled
"Created: / 10-01-2012 / 00:29:02 / cg"
"Modified: / 19-01-2012 / 10:44:36 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
fileBasedRepositoryMenusAreShown
^ ConfigurableFeatures includesFeature: #FileBasedSourceCodeManagerSupportEnabled
"Created: / 10-01-2012 / 00:29:12 / cg"
"Modified: / 19-01-2012 / 10:44:41 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
git2RepositoryMenusAreShown
| manager |
^(manager := Smalltalk at:#GitSourceCodeManager2) notNil
and:[manager shownInBrowserMenus]
"Modified: / 14-11-2012 / 19:33:10 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
gitRepositoryClassMenusAreShown
^ self gitRepositoryMenusAreShown
and:[ ConfigurableFeatures includesFeature: #GitSupportEnabled ]
"Created: / 24-07-2012 / 15:19:53 / cg"
!
gitRepositoryMenusAreShown
^ ConfigurableFeatures includesFeature: #GitSupportEnabled
"Created: / 23-07-2012 / 13:35:17 / cg"
!
hgRepositoryMenusAreShown
| manager |
^(manager := Smalltalk at:#HGSourceCodeManager) notNil
and:[manager shownInBrowserMenus]
"Modified: / 14-11-2012 / 19:33:25 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
mercurialRepositoryMenusAreShown
^ ConfigurableFeatures includesFeature: #MercurialSupportEnabled
"Created: / 15-01-2012 / 14:36:53 / cg"
"Modified: / 19-01-2012 / 10:40:44 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
methodListPopUpMenu
"to avoid generation of an aspect method by GUI definer"
<resource: #programMenu>
^ [
|m|
self window sensor ctrlDown ifTrue:[
m := self class methodDebugMenu
] ifFalse:[
m := self class methodListMenu
].
m := m decodeAsLiteralArray.
m findGuiResourcesIn:self.
]
"Modified: / 11-09-2007 / 11:44:04 / cg"
!
nameSpaceMenu
"to avoid generation of an aspect method by GUI definer"
^ self class nameSpaceMenu
"Created: / 18.2.2000 / 12:17:22 / cg"
!
perforceRepositoryMenusAreShown
^ ConfigurableFeatures includesFeature: #PerforceSupportEnabled
"Created: / 10-01-2012 / 00:29:46 / cg"
"Modified: / 19-01-2012 / 10:45:55 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
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-02-2000 / 12:17:49 / cg"
"Modified: / 05-09-2014 / 16:31:36 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
selectorMenuCompareGenerateDebugSlice
^ self menuFor: #selectorMenuCompareGenerateDebugSlice
"Created: / 05-09-2014 / 17:56:14 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
selectorPopUpMenu
"to avoid generation of an aspect method by GUI definer"
<resource: #programMenu>
^ [
|m|
self window sensor ctrlDown ifTrue:[
m := self menuFor:#methodDebugMenu
] ifFalse:[
m := self menuFor: #selectorMenu
].
m findGuiResourcesIn:self.
]
"Modified: / 11-09-2007 / 11:44:09 / cg"
"Modified: / 27-08-2014 / 00:28:22 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
svnRepositoryMenusAreShown
^ ConfigurableFeatures includesFeature: #SubversionSupportEnabled
"Created: / 15-01-2012 / 14:49:31 / cg"
"Modified: / 19-01-2012 / 10:46:01 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
tabMenu:index
<resource: #programMenu>
|m i|
m := self class tabMenuWithRemove.
m := m decodeAsLiteralArray.
i := m detectItem:[:item | item nameKey == #RemoveBuffer] ifNone:nil.
i notNil ifTrue:[
i label:(resources string:i label with:index printString).
i argument:index.
index ~~ self selectedBuffer value ifTrue:[
"/ for now: if that buffer is modified,
"/ do not allow removing.
"/ (must be brought to front, in order for check-for-modification to work)
(buffers at:index) modified ifTrue:[
i disable
].
].
].
i := m detectItem:[:item | item nameKey == #RemoveAllButBuffer] ifNone:nil.
i notNil ifTrue:[
i label:(resources string:i label with:index printString).
i argument:index.
].
m findGuiResourcesIn:self.
^ m
"/ index == self selectedBuffer value ifTrue:[
"/ ^ self class tabMenuWithRemove.
"/ ].
"/ ^ self class tabMenuWithoutRemove.
!
variablesPopUpMenu
"to avoid generation of an aspect method by GUI definer"
^ self menuFor: #variablesMenu
"Created: / 26-08-2014 / 10:24:04 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
visitedClassesHistory
|holder|
(holder := builder bindingAt:#visitedClassesHistory) isNil ifTrue:[
builder aspectAt:#visitedClassesHistory put:(holder := List new).
holder addAll:(self class visitedClassNamesHistory).
SystemBrowser addDependent:self.
].
^ holder
"Modified: / 20-11-2006 / 12:25:18 / cg"
! !
!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"
!
lintRuleListGenerator
^self navigationState lintRuleListGenerator
"Created: / 22-07-2009 / 15:28:39 / Jan Vrany <vranyj1@fel.cvut.cz>"
!
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"
!
navigationHistory
^self navigationState navigationHistory
"Created: / 22-02-2008 / 10:19:49 / janfrog"
!
packageFilter
^ self navigationState packageFilter
"Created: / 24.2.2000 / 23:28:06 / cg"
!
profilerStatistics
^self navigationState profilerStatistics
"Created: / 09-10-2007 / 21:57:15 / janfrog"
!
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
"bad name- it's a holder, baby"
^ self navigationState selectedClasses
!
selectedClassesValue
^ self selectedClasses value ? #()
!
selectedLintRuleClasses
"/ I don't understand it - just a q&d hack to make the debugger go away
self breakPoint:#cg.
^ self selectedClasses
"Created: / 04-08-2011 / 17:55:45 / cg"
!
selectedLintRules
^ self navigationState selectedLintRules
"Created: / 22-07-2009 / 15:28:56 / Jan Vrany <vranyj1@fel.cvut.cz>"
!
selectedMethods
^ self navigationState selectedMethods
!
selectedMethods1
^ self navigationState selectedMethodsArrayAt:1
!
selectedMethods2
^ self navigationState selectedMethodsArrayAt:2
!
selectedMethods3
^ self navigationState selectedMethodsArrayAt:3
!
selectedMethods4
^ self navigationState selectedMethodsArrayAt:4
!
selectedMethodsClasses
^ (self selectedMethodsValue
collect:[:m | m mclass] as:Set)
select:[:each| each notNil]
"Created: / 07-08-2006 / 12:13:37 / cg"
!
selectedMethodsValue
^ self selectedMethods value ? #()
"Created: / 28-02-2012 / 16:13:43 / cg"
!
selectedNamespaces
^ self navigationState selectedNamespaces
!
selectedNamespacesValue
^ self selectedNamespaces value ? #()
!
selectedProjects
^ self navigationState selectedProjects
!
selectedProjectsValue
^ self selectedProjects value ? #()
!
selectedProtocols
^ self navigationState selectedProtocols
!
selectedProtocolsValue
^ self selectedProtocols value ? #()
!
selectedVariables
^ self variableFilter
!
selectorListGenerator
^ self navigationState selectorListGenerator
!
selectorListGenerator1
"used for the sender-/implementor-chain's first methodlist"
^ self navigationState selectorListGeneratorArrayAt:1
!
selectorListGenerator2
"used for the sender-/implementor-chain's second methodlist"
^ self navigationState selectorListGeneratorArrayAt:2
!
selectorListGenerator3
"used for the sender-/implementor-chain's third methodlist"
^ self navigationState selectorListGeneratorArrayAt:3
!
selectorListGenerator4
"used for the sender-/implementor-chain's fourth methodlist"
^ self navigationState selectorListGeneratorArrayAt:4
!
selectorListGenerator5
"Used for all method's generator of ClassList. "
^ self navigationState selectorListGeneratorArrayAt:5
"Created: / 07-08-2011 / 19:06:20 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
variableFilter
^ self navigationState variableFilter
"Created: / 24.2.2000 / 23:28:06 / cg"
! !
!NewSystemBrowser methodsFor:'aspects-organization'!
categoryMenuVisible
|holder|
(holder := builder bindingAt:#categoryMenuVisible) isNil ifTrue:[
holder := BlockValue
with:[:v1 :v2 | |n|
n := self navigationState.
n isClassBrowser not
and:[n isProtocolOrFullProtocolBrowser not
and:[n isMethodBrowser not
and:[n isClassExtensionBrowser not
and:[n isChainBrowser not
and:[(n isNameSpaceFullBrowser or:[n isNameSpaceBrowser not])
and:[n isVersionDiffBrowser not
and:[(n isNameSpaceFullBrowser or:[v1 == OrganizerCanvas organizerModeCategory])]]]]]]]
]
argument:(self organizerModeForMenu)
argument:(self browserCanvas).
builder aspectAt:#categoryMenuVisible put: holder
].
^ holder
"Modified: / 08-03-2007 / 23:00:27 / cg"
!
classHierarchyMenuVisible
|holder|
(holder := builder bindingAt:#classHierarchyMenuVisible) isNil ifTrue:[
holder := BlockValue
with:[:orgMode :v2 |
(orgMode == OrganizerCanvas organizerModeClassHierarchy)
or:[orgMode == OrganizerCanvas organizerModeHierarchy]
]
argument:(self organizerModeForMenu)
argument:(self browserCanvas).
builder aspectAt:#classHierarchyMenuVisible put: holder
].
^ holder
"Created: / 17-02-2000 / 22:19:11 / cg"
"Modified: / 08-03-2007 / 23:00:34 / cg"
!
classInheritanceMenuItemVisible
^ false "^ self viewMenuOrganizerItemsVisible"
!
classMenuVisible
|holder|
(holder := builder bindingAt:#classMenuVisible) isNil ifTrue:[
holder := BlockValue
with:[:v | |n|
n := self navigationState.
n isProtocolOrFullProtocolBrowser not
and:[n isMethodBrowser not
and:[n isChainBrowser not]]
]
argument:(self browserCanvas).
builder aspectAt:#classMenuVisible put: holder
].
^ holder
!
codeMenuVisible
|holder|
(holder := builder bindingAt:#codeMenuVisible) isNil ifTrue:[
holder := BlockValue
with:[:v | |n|
n := self navigationState.
n isClassDocumentationBrowser not
and:[n isVersionDiffBrowser not
and:[n isFullClassSourceBrowser not]]
]
argument:(self browserCanvas).
builder aspectAt:#codeMenuVisible put: holder
].
^ holder
"Created: / 24.2.2000 / 14:57:52 / cg"
!
isNotFullProtocolBrowser
|holder|
(holder := builder bindingAt:#isNotFullProtocolBrowser) isNil ifTrue:[
holder := BlockValue
with:[:v | |n|
n := self navigationState.
n isFullProtocolBrowser not
]
argument:(self browserCanvas).
builder aspectAt:#isNotFullProtocolBrowser put: holder
].
^ holder
"Created: / 24.2.2000 / 14:57:52 / cg"
!
methodListMenuVisible
|holder|
(holder := builder bindingAt:#methodListMenuVisible) isNil ifTrue:[
holder := BlockValue
with:[:v | |n|
n := self navigationState.
n isMethodListBrowser
]
argument:(self browserCanvas).
builder aspectAt:#methodListMenuVisible put: holder
].
^ holder
!
nameSpaceMenuVisible
|holder|
(holder := builder bindingAt:#nameSpaceMenuVisible) isNil ifTrue:[
holder := BlockValue
with:[:orgMode :v2 |
orgMode == OrganizerCanvas organizerModeNamespace
or:[self navigationState isNameSpaceFullBrowser]
]
argument:(self organizerModeForMenu)
argument:(self browserCanvas).
builder aspectAt:#nameSpaceMenuVisible put: holder
].
^ holder
"Created: / 17-02-2000 / 22:19:11 / cg"
"Modified: / 08-03-2007 / 23:00:55 / cg"
!
notShowingInheritedMethods
|holder|
(holder := builder bindingAt:#notShowingInheritedMethods) isNil ifTrue:[
holder := BlockValue
with:[:h :o | self isMethodListBrowser not and:[h == #class] ]
argument:(self methodVisibilityHolder)
argument:(self organizerModeForMenu).
builder aspectAt:#notShowingInheritedMethods put: holder
].
^ holder
"Modified: / 08-03-2007 / 23:01:01 / cg"
!
operationsMenuEnabled
^ [
(self canUseRefactoringSupport)
]
!
operationsMenuVisible
^ [
(self canUseRefactoringSupport)
]
!
organizerIsNotShowingCategories
|holder|
(holder := builder bindingAt:#organizerIsNotShowingCategories) isNil ifTrue:[
holder := BlockValue
with:[:h | h ~~ OrganizerCanvas organizerModeCategory]
argument:(self organizerModeForMenu)
].
^ holder
"Modified: / 08-03-2007 / 23:01:05 / cg"
!
organizerIsShowingCategories
|holder|
(holder := builder bindingAt:#organizerIsShowingCategories) isNil ifTrue:[
holder := BlockValue
with:[:h | h == OrganizerCanvas organizerModeCategory]
argument:(self organizerModeForMenu)
].
^ holder
"Modified: / 08-03-2007 / 23:01:08 / cg"
!
organizerIsShowingClasses
|holder|
(holder := builder bindingAt:#organizerIsShowingClasses) isNil ifTrue:[
holder := BlockValue
with:[:h :b | navigationState isMethodListBrowser not]
arguments:(Array with:self organizerModeForMenu with:self selectedBuffer)
].
^ holder
!
organizerIsShowingClassesAndIsNotShowingCategories
|holder|
(holder := builder bindingAt:#organizerIsShowingClassesAndIsNotShowingCategories) isNil ifTrue:[
holder := BlockValue
with:[:h | navigationState isMethodListBrowser not and:[h ~~ OrganizerCanvas organizerModeCategory]]
argument:(self organizerModeForMenu)
].
^ holder
"Modified: / 08-03-2007 / 23:01:17 / cg"
!
organizerIsShowingClassesAndIsShowingCategories
|holder|
(holder := builder bindingAt:#organizerIsShowingClassesAndIsShowingCategories) isNil ifTrue:[
holder := BlockValue
with:[:h | navigationState isMethodListBrowser not and:[h == OrganizerCanvas organizerModeCategory]]
argument:(self organizerModeForMenu)
].
^ holder
"Modified: / 08-03-2007 / 23:01:20 / cg"
!
organizerMode
^ self navigationState organizerMode
"Modified: / 18.2.2000 / 18:36:40 / cg"
!
organizerModeForMenu
"need this, since the menu fetches the aspect only once during
creation - but that's 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"
!
organizerProtocolAndMethodListSpecHolder
|holder|
(holder := builder bindingAt:#organizerProtocolAndMethodListSpecHolder) isNil ifTrue:[
holder := BlockValue
with:[:classes :old |
| spec |
spec := old at:1.
classes notEmptyOrNil ifTrue:[
(classes anySatisfy:[:cls|cls supportsMethodCategories]) ifTrue:[
spec := #protocolAndMethodListSpec_Both.
] ifFalse:[
spec := #protocolAndMethodListSpec_JustMethodList
].
old at:1 put: spec.
].
spec.
]
argument:(self selectedClasses)
argument:(ValueHolder with: (Array with:#protocolAndMethodListSpec_Both))
].
^ holder
"Created: / 07-08-2011 / 16:40:20 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 01-06-2012 / 20:36:55 / cg"
!
projectMenuVisible
|holder|
(holder := builder bindingAt:#projectMenuVisible) isNil ifTrue:[
holder := BlockValue
with:[:orgMode :v2 |
orgMode == OrganizerCanvas organizerModeProject
or:[self navigationState isClassExtensionBrowser]
]
argument:(self organizerModeForMenu)
argument:(self browserCanvas).
builder aspectAt:#projectMenuVisible put: holder
].
^ holder
"Created: / 17-02-2000 / 22:19:11 / cg"
"Modified: / 08-03-2007 / 23:01:24 / cg"
!
protocolMenuVisible
|holder|
(holder := builder bindingAt:#protocolMenuVisible) isNil ifTrue:[
holder := BlockValue
with:[:v | |n|
n := self navigationState.
n isFullClassSourceBrowser not
and:[n isClassDocumentationBrowser not
and:[n isVersionDiffBrowser not
and:[n isMethodBrowser not
and:[n isChainBrowser not]]]]
]
argument:(self browserCanvas).
builder aspectAt:#protocolMenuVisible put: holder
].
^ holder
"Modified: / 24.2.2000 / 14:55:11 / cg"
!
searchMenuInMethodListVisible
|holder|
(holder := builder bindingAt:#searchMenuInMethodListVisible) isNil ifTrue:[
holder := BlockValue
with:[:v | |n|
n := self navigationState.
self searchMenuVisible value not
and:[n isMethodBrowser]
]
argument:(self browserCanvas).
builder aspectAt:#searchMenuInMethodListVisible put: holder
].
^ holder
!
searchMenuVisible
|holder|
(holder := builder bindingAt:#searchMenuVisible) isNil ifTrue:[
holder := BlockValue
with:[:v | |n|
n := self navigationState.
n isProtocolOrFullProtocolBrowser not
and:[n isChainBrowser not
and:[n isVersionDiffBrowser not
and:[n isCategoryBrowser not]]]
]
argument:(self browserCanvas).
builder aspectAt:#searchMenuVisible put: holder
].
^ holder
!
selectorMenuVisible
|holder|
(holder := builder bindingAt:#selectorMenuVisible) isNil ifTrue:[
holder := BlockValue
with:[:v | |n|
n := self navigationState.
n isClassDocumentationBrowser not
and:[n isVersionDiffBrowser not
and:[n isFullClassSourceBrowser not]]
]
argument:(self browserCanvas).
builder aspectAt:#selectorMenuVisible put: holder
].
^ holder
"Created: / 24.2.2000 / 14:55:44 / cg"
!
showingInheritedMethods
|holder|
(holder := builder bindingAt:#showingInheritedMethods) isNil ifTrue:[
holder := BlockValue
with:[:h :o | self isMethodListBrowser not and:[h ~~ #class] ]
argument:(self methodVisibilityHolder)
argument:(self organizerModeForMenu).
builder aspectAt:#showingInheritedMethods put: holder
].
^ holder
"Modified: / 08-03-2007 / 23:01:39 / cg"
!
testRunnerVisibleHolder
^ self hasTestCaseClassesSelectedHolder
!
variablesMenuVisible
|holder|
(holder := builder bindingAt:#variablesMenuVisible) 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:#variablesMenuVisible put: holder
].
^ holder
!
viewMenuForMethodListVisible
|holder|
(holder := builder bindingAt:#viewMenuForMethodListVisible) isNil ifTrue:[
holder := BlockValue
with:[:v | |n|
n := self navigationState.
n isMethodListBrowser or:[n isChainBrowser]
]
argument:(self browserCanvas).
builder aspectAt:#viewMenuForMethodListVisible put: holder
].
^ holder
!
viewMenuOrganizerItemsVisible
|holder|
(holder := builder bindingAt:#viewMenuOrganizerItemsVisible) isNil ifTrue:[
holder := BlockValue
with:[:v | |n|
n := self navigationState.
n isClassBrowser not
and:[n isProtocolOrFullProtocolBrowser not
and:[n isProjectFullBrowser not
and:[n isMethodBrowser not
and:[n isChainBrowser not
and:[n isCategoryBrowser not
and:[n isNameSpaceBrowser not
and:[n isNameSpaceFullBrowser not
and:[n isVersionDiffBrowser not
and:[n isProjectBrowser not]]]]]]]]]
]
argument:(self browserCanvas).
builder aspectAt:#viewMenuOrganizerItemsVisible put: holder
].
^ holder
"Modified: / 18.8.2000 / 19:03:48 / cg"
!
viewMenuVisible
|holder|
(holder := builder bindingAt:#viewMenuVisible) isNil ifTrue:[
holder := BlockValue
with:[:v | |n|
n := self navigationState.
true "n isClassBrowser not"
and:[true "n isProtocolOrFullProtocolBrowser not"
and:[true "n isProjectFullBrowser not"
and:[n isMethodBrowser not
and:[n isMethodListBrowser not
and:[n isChainBrowser not
and:[n isCategoryBrowser not
and:[n isNameSpaceBrowser not
and:[n isNameSpaceFullBrowser not
and:[n isVersionDiffBrowser not
and:[n isProjectBrowser not]]]]]]]]]]
]
argument:(self browserCanvas).
builder aspectAt:#viewMenuVisible put: holder
].
^ holder
"Modified: / 18.8.2000 / 19:03:48 / cg"
! !
!NewSystemBrowser methodsFor:'aspects-presentation'!
bookmarkBarVisibleHolder
|holder|
(holder := builder bindingAt:#bookmarkBarVisibleHolder) isNil ifTrue:[
holder := UserPreferences current showBookmarkBar asValue.
builder aspectAt:#bookmarkBarVisibleHolder put: holder.
holder addDependent:self.
].
^ holder
"Modified: / 31-10-2001 / 11:09:32 / cg"
"Created: / 18-05-2011 / 17:22:39 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
browsletShowHideLabelHolder
<resource: #uiAspect>
browsletShowHideLabelHolder isNil ifTrue:[
browsletShowHideLabelHolder := self class showBrowsletIcon asValue
].
^ browsletShowHideLabelHolder.
"Modified: / 22-09-2010 / 22:55:59 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
codeInfoVisible
|holder|
(holder := builder bindingAt:#codeInfoVisible) isNil ifTrue:[
holder := (DefaultCodeInfoVisible ? true "false") asValue.
builder aspectAt:#codeInfoVisible put: holder.
holder addDependent:self.
].
^ holder
"Modified: / 18.2.2000 / 17:34:18 / cg"
"Created: / 18.2.2000 / 17:44:17 / cg"
!
doAutoFormat
|holder|
(holder := builder bindingAt:#doAutoFormat) isNil ifTrue:[
holder := (DefaultAutoFormat ? UserPreferences current autoFormatting) asValue.
builder aspectAt:#doAutoFormat put:holder.
holder onChangeEvaluate:[ DefaultAutoFormat := holder value.
self enqueueDelayedUpdateCodeWithoutAutoSearch].
].
^ holder.
!
doImmediateExplaining
|holder|
(holder := builder bindingAt:#doImmediateExplaining) isNil ifTrue:[
holder := (DefaultImmediateExplaining ? true) asValue.
builder aspectAt:#doImmediateExplaining put:holder.
holder onChangeEvaluate:[ DefaultImmediateExplaining := holder value.
].
].
^ holder
!
doImmediateSyntaxColoring
|holder|
(holder := builder bindingAt:#doImmediateSyntaxColoring) isNil ifTrue:[
holder := (DefaultImmediateSyntaxColoring ? true) asValue.
builder aspectAt:#doImmediateSyntaxColoring put:holder.
holder onChangeEvaluate:[ DefaultImmediateSyntaxColoring := holder value.
self startSyntaxHighlightProcess
].
].
^ holder
!
doSyntaxColoring
|holder|
(holder := builder bindingAt:#doSyntaxColoring) isNil ifTrue:[
holder := (DefaultSyntaxColoring ? UserPreferences current syntaxColoring) asValue.
builder aspectAt:#doSyntaxColoring put:holder.
holder onChangeEvaluate:[ DefaultSyntaxColoring := holder value.
self enqueueDelayedUpdateCodeWithoutAutoSearch].
].
^ holder.
!
editorNoteBookCanvasHolder
^ navigationState editorNoteBookCanvasHolder
!
editorNoteBookListHolder
^ navigationState editorNoteBookListHolder
!
emphasizeUnloadedClasses
|holder|
(holder := builder bindingAt:#emphasizeUnloadedClasses) isNil ifTrue:[
holder := (DefaultEmphasizeUnloadedClasses ? false) asValue.
builder aspectAt:#emphasizeUnloadedClasses put: holder.
holder onChangeSend:#emphasizeUnloadedClassesChanged to:self.
].
^ holder
"Modified: / 18.2.2000 / 17:34:18 / cg"
"Created: / 18.2.2000 / 17:44:17 / cg"
!
emphasizeUnloadedClassesChanged
|classListApp clr e|
classListApp := self classListApp.
DefaultEmphasizeUnloadedClasses := e := self emphasizeUnloadedClasses value.
e ifTrue:[
clr := Color red:(classListApp window font boldness < 0.6
ifTrue:[20] ifFalse:[10]).
] ifFalse:[
clr := nil
].
classListApp unloadedClassesColor:clr.
"/ classListApp updateList.
classListApp invalidateList.
"Modified: / 31.10.2001 / 11:14:50 / cg"
!
groupVariablesByInheritance
^ builder valueAspectFor:#groupVariablesByInheritance initialValue:true
!
hidePrivateClasses
^ self navigationState hidePrivateClasses
"Modified: / 24.2.2000 / 16:17:38 / cg"
!
hideUnloadedClasses
|holder|
(holder := builder bindingAt:#hideUnloadedClasses) isNil ifTrue:[
holder := (DefaultHideUnloadedClasses ? false) asValue.
builder aspectAt:#hideUnloadedClasses put: holder.
holder onChangeEvaluate:[ DefaultHideUnloadedClasses := holder value ].
].
^ holder
"Modified: / 18.2.2000 / 17:34:18 / cg"
"Created: / 18.2.2000 / 17:44:17 / cg"
!
markApplicationsHolder
|holder|
(holder := builder bindingAt:#markApplicationsHolder) isNil ifTrue:[
holder := (DefaultMarkApplications ? true) asValue.
builder aspectAt:#markApplicationsHolder put: holder.
holder onChangeEvaluate:[ DefaultMarkApplications := holder value ].
].
^ holder
"Modified: / 18.2.2000 / 17:34:18 / cg"
"Created: / 18.2.2000 / 17:44:17 / cg"
!
methodVisibilityHolder
^ builder valueAspectFor:#methodVisibilityHolder initialValue:#class
!
packageDiagramMenuItemVisible
^ OOM::MetricVisualizer notNil and:[ self viewMenuOrganizerItemsVisible value ]
"Modified: / 25-04-2010 / 13:43:35 / cg"
!
selectedEditorNoteBookTabIndexHolder
|holder|
holder := navigationState selectedEditorNoteBookTabIndexHolder.
holder addDependent:self.
^ holder
!
shortNamesInTabs
|holder|
(holder := builder bindingAt:#shortNamesInTabs) isNil ifTrue:[
holder := (DefaultShortNameInTabs ? true) asValue.
builder aspectAt:#shortNamesInTabs put: holder.
holder onChangeEvaluate:[ DefaultShortNameInTabs := holder value ].
].
^ holder
!
showAllClassesInNameSpaceOrganisation
|holder|
(holder := builder bindingAt:#showAllClassesInNameSpaceOrganisation) isNil ifTrue:[
holder := (DefaultShortAllClassesInNameSpaceOrganisation ? false) asValue.
builder aspectAt:#showAllClassesInNameSpaceOrganisation put: holder.
holder onChangeEvaluate:[ DefaultShortAllClassesInNameSpaceOrganisation := holder value ].
].
^ holder
"Created: / 05-03-2007 / 16:30:29 / cg"
"Modified: / 06-03-2007 / 12:20:19 / cg"
!
showClassPackages
showClassPackages isNil ifTrue:[
showClassPackages := false asValue.
].
^ showClassPackages.
"/ ^ self navigationState showClassPackages
"Modified: / 24.2.2000 / 16:17:38 / cg"
!
showClassVarsInVariableList
^ builder valueAspectFor:#showClassVarsInVariableList initialValue:false
!
showCoverageInformation
|holder|
(holder := builder bindingAt:#showCoverageInformation) isNil ifTrue:[
holder := (DefaultShowCoverage ? true) asValue.
builder aspectAt:#showCoverageInformation put: holder.
holder addDependent:self.
].
^ holder
"Created: / 27-04-2010 / 16:02:49 / cg"
!
showGlobalHistory
|holder|
(holder := builder bindingAt:#showGlobalHistory) isNil ifTrue:[
holder := (AspectAdaptor forAspect: #showGlobalHistory)
subject: UserPreferences current.
builder aspectAt:#showGlobalHistory put: holder.
].
^ holder
"Created: / 18-02-2000 / 17:44:17 / cg"
"Modified: / 12-02-2010 / 12:08:05 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Created: / 07-07-2011 / 00:11:39 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
showLocalHistory
|holder|
(holder := builder bindingAt:#showLocalHistory) isNil ifTrue:[
holder := (AspectAdaptor forAspect: #showLocalHistory)
subject: UserPreferences current.
builder aspectAt:#showLocalHistory put: holder.
].
^ holder
"Created: / 07-07-2011 / 00:11:50 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
showMethodComplexity
|holder|
(holder := builder bindingAt:#showMethodComplexity) isNil ifTrue:[
holder := (DefaultShowMethodComplexity ? false) asValue.
builder aspectAt:#showMethodComplexity put: holder.
holder onChangeEvaluate:[ DefaultShowMethodComplexity := holder value ].
].
^ holder
!
showMethodInheritance
|holder|
(holder := builder bindingAt:#showMethodInheritance) isNil ifTrue:[
holder := (DefaultShowMethodInheritance ? true) asValue.
builder aspectAt:#showMethodInheritance put: holder.
holder onChangeEvaluate:[ DefaultShowMethodInheritance := holder value ].
].
^ holder
"Modified: / 18.2.2000 / 17:34:18 / cg"
"Created: / 18.2.2000 / 17:44:17 / cg"
!
showMethodTemplate
|holder|
(holder := builder bindingAt:#showMethodTemplate) isNil ifTrue:[
holder := (AspectAdaptor forAspect: #showMethodTemplate)
subject: UserPreferences current.
builder aspectAt:#showMethodTemplate put: holder.
].
^ holder
"Created: / 18-02-2000 / 17:44:17 / cg"
"Modified: / 12-02-2010 / 12:08:05 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
showMethodTypeIcon
|holder|
(holder := builder bindingAt:#showMethodTypeIcon) isNil ifTrue:[
holder := (DefaultShowMethodTypeIcon ? true) asValue.
builder aspectAt:#showMethodTypeIcon put: holder.
holder onChangeEvaluate:[ DefaultShowMethodTypeIcon := holder value ].
].
^ holder
!
showMultitabMode
|holder|
(holder := builder bindingAt:#showMultitabMode) isNil ifTrue:[
holder := (DefaultShowMultitabMode ? false) asValue.
builder aspectAt:#showMultitabMode put: holder.
holder onChangeEvaluate:[
self updateSpecialCodeEditorVisibility.
DefaultShowMultitabMode := holder value.
].
].
^ holder
!
showPlugin
^self navigationState pluginVisibleHolder value
"
|holder|
(holder := builder bindingAt:#showPlugin) isNil ifTrue:[
holder := false asValue.
builder aspectAt:#showPlugin put: holder.
].
^ holder
"
"Modified: / 04-10-2010 / 08:19:45 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
showPlugin: aBoolean
self navigationState pluginVisibleHolder value: aBoolean.
self updatePluginVisibility
"Created: / 03-10-2010 / 18:50:14 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
showPseudoProtocols
|holder|
(holder := builder bindingAt:#showPseudoProtocols) isNil ifTrue:[
holder := (DefaultShowPseudoProtocols ? true) asValue.
builder aspectAt:#showPseudoProtocols put: holder.
holder onChangeEvaluate:[ DefaultShowPseudoProtocols := holder value ].
].
^ holder
!
showSpecialResourceEditors
|holder|
(holder := builder bindingAt:#showSpecialResourceEditors) isNil ifTrue:[
holder := (DefaultShowSpecialResourceEditors ? false) asValue.
builder aspectAt:#showSpecialResourceEditors put: holder.
holder onChangeEvaluate:[
self updateSpecialCodeEditorVisibility.
DefaultShowSpecialResourceEditors := holder value
].
].
^ holder
!
showSyntheticMethods
|holder|
(holder := builder bindingAt:#showSyntheticMethods) isNil ifTrue:[
holder := (DefaultShowSyntheticMethods ? false) asValue.
builder aspectAt:#showSyntheticMethods put: holder.
holder onChangeEvaluate:[
DefaultShowSyntheticMethods := holder value
].
].
^ holder
"Created: / 13-04-2012 / 16:07:50 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
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"
!
sortByNameAndInheritance
|holder|
(holder := builder bindingAt:#sortByNameAndInheritance) isNil ifTrue:[
"now: I do not want that to be automatically forwarded to the prefs"
holder := (UserPreferences current sortAndIndentClassesByInheritance) asValue.
builder aspectAt:#sortByNameAndInheritance put: holder.
].
^ holder
"Created: / 04-07-2011 / 18:40:19 / cg"
"Modified: / 08-07-2011 / 10:01:56 / jv"
"Modified (format): / 27-04-2012 / 20:02:24 / cg"
!
sortVariablesByName
^ builder valueAspectFor:#sortVariablesByName initialValue:false
!
stringSearchToolVisibleHolder
|holder|
(holder := builder bindingAt:#stringSearchToolVisibleHolder) isNil ifTrue:[
holder := false asValue.
builder aspectAt:#stringSearchToolVisibleHolder put: holder.
holder addDependent:self.
].
^ holder
!
toolBarVisibleHolder
|holder|
(holder := builder bindingAt:#toolBarVisibleHolder) isNil ifTrue:[
holder := (DefaultToolBarVisible ? true "false") asValue.
builder aspectAt:#toolBarVisibleHolder put: holder.
holder addDependent:self.
].
^ holder
"Created: / 18.2.2000 / 17:44:17 / cg"
"Modified: / 31.10.2001 / 11:09:32 / cg"
!
useGlobalHistory
^ true
"Created: / 02-07-2011 / 18:27:29 / cg"
! !
!NewSystemBrowser methodsFor:'aspects-queries'!
anyBreakOrTracePointsAreSet
^ (MethodWithBreakpoints notNil
and:[ MethodWithBreakpoints allBreakpointedMethods notEmpty ])
or:[ MessageTracer notNil
and:[MessageTracer isLoaded
and:[MessageTracer areAnyMethodsWrapped]]]
!
anyBreakOrTracePointsAreSetHolder
^ [ self anyBreakOrTracePointsAreSet ]
!
canConvertToSiblings
|selected|
^ (selected := self theSingleSelectedClass) notNil
and:[ selected subclasses size > 0].
!
canConvertToSiblingsHolder
^ [ self canConvertToSiblings ]
!
canFileOutBinaryHolder
^ [ self canFileOutBinary ]
!
canFileOutSIFHolder
^ [ self canFileOutSIF ]
!
canFileOutXMLHolder
^ [ self canFileOutXML ]
!
canGenerateAccessMethodsForAllHolder
^ self hasClassAndNoVariableSelectedHolder
!
canGenerateAccessMethodsHolder
^ self hasClassAndVariableSelectedHolder
!
canGenerateAspectMethod
^ self hasApplicationClassSelected
!
canGenerateAspectMethodHolder
^ [ self canGenerateAspectMethod ]
!
canGenerateMultiSetterInstanceCreationMethodHolder
^ self hasSingleLoadedClassSelectedAndMultipleVariablesSelectedHolder
!
canGenerateMultiSetterMethodHolder
^ self hasSingleLoadedClassSelectedAndMultipleVariablesSelectedHolder
!
canGoBackAspect
|holder|
(holder := builder bindingAt:#canGoBackAspect) isNil ifTrue:[
holder := (AspectAdaptor forAspect:#canGoBack)
subjectChannel: self navigationHistory;
yourself.
builder aspectAt:#canGoBackAspect put:holder.
].
^ holder.
"/ | aspect |
"/ aspect := self objectAttributeAt: #canGoBackAspect.
"/ aspect ifNil:
"/ [aspect :=
"/ (AspectAdaptor forAspect:#canGoBack)
"/ subjectChannel: self navigationHistory;
"/ yourself.
"/ self objectAttributeAt: #canGoBackAspect put: aspect].
"/ ^aspect
"Modified: / 21-07-2009 / 22:39:57 / Jan Vrany <vranyj1@fel.cvut.cz>"
"Created: / 01-09-2009 / 22:38:33 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
canGoBackInGlobalHistoryAspect
|holder|
(holder := builder bindingAt:#canGoBackInGlobalHistoryAspect) isNil ifTrue:[
holder := (AspectAdaptor forAspect:#canGoBack)
subjectChannel: self class classHistory;
yourself.
builder aspectAt:#canGoBackInGlobalHistoryAspect put:holder.
].
^ holder.
"/ | aspect |
"/ aspect := self objectAttributeAt: #canGoBackAspect.
"/ aspect ifNil:
"/ [aspect :=
"/ (AspectAdaptor forAspect:#canGoBack)
"/ subjectChannel: self navigationHistory;
"/ yourself.
"/ self objectAttributeAt: #canGoBackAspect put: aspect].
"/ ^aspect
"Modified: / 21-07-2009 / 22:39:57 / Jan Vrany <vranyj1@fel.cvut.cz>"
"Created: / 01-09-2009 / 22:38:33 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
canGoForwardAspect
|holder|
(holder := builder bindingAt:#canGoForwardAspect) isNil ifTrue:[
holder := (AspectAdaptor forAspect:#canGoForward)
subjectChannel: self navigationHistory;
yourself.
builder aspectAt:#canGoForwardAspect put:holder.
].
^ holder.
"/ | aspect |
"/ aspect := self objectAttributeAt: #canGoForwardAspect.
"/ aspect ifNil:
"/ [aspect :=
"/ (AspectAdaptor forAspect:#canGoForward)
"/ subjectChannel: self navigationHistory;
"/ yourself.
"/ self objectAttributeAt: #canGoForwardAspect put: aspect].
"/ ^aspect
"Modified: / 21-07-2009 / 22:39:57 / Jan Vrany <vranyj1@fel.cvut.cz>"
"Created: / 01-09-2009 / 22:39:38 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
canInsertSuperclass
|selected|
^ (selected := self selectedClassesValue) size > 0
and:[(selected collect:[:each | each superclass] as:Set) size == 1].
"Modified: / 28-02-2012 / 16:45:12 / cg"
!
canInsertSuperclassHolder
^ [ self canInsertSuperclass ]
!
changeSetContainsChangedClasses
^ ChangeSet current changedClasses notEmptyOrNil
!
changeSetContainsChangedClassesAndSourceCodeManagerHolder
^ [ self changeSetContainsChangedClasses and:[ self hasSourceCodeManager]]
!
classOfSelectedMethodOrSelectedClass
| mthd mclass|
(mthd := self theSingleSelectedMethod) notNil ifTrue:[
mclass := mthd mclass.
] ifFalse:[
"/ self codeAspect value ~= #classDefinition ifTrue:[
"/ ^ nil
"/ ].
mclass := self theSingleSelectedClass.
].
^ mclass
!
classWizardVisibleHolder
^ true.
"/ ^ builder booleanValueAspectFor:#classWizardVisibleHolder
!
currentClass
"the current buffers single selected class;
nil if no selection or if multiple classes are selected"
^ self theSingleSelectedClass
!
currentNamespace
|nsSymbol cls|
(nsSymbol := self theSingleSelectedNamespace) notNil ifTrue:[
nsSymbol ~= BrowserList nameListEntryForALL ifTrue:[
^ NameSpace name:nsSymbol
]
].
(cls := self theSingleSelectedClass) notNil ifTrue:[
^ cls topNameSpace
].
^ Class nameSpaceQuerySignal query ? Smalltalk
!
currentProject
|prj projects|
(prj := self theSingleSelectedProject) notNil ifTrue:[
prj ~= BrowserList nameListEntryForALL ifTrue:[
^ prj
]
].
projects := self selectedClassesValue collect:[:cls | cls package] as:Set.
projects size == 1 ifTrue:[
^ projects first
].
projects := self selectedMethodsValue collect:[:m | m package] as:Set.
projects size == 1 ifTrue:[
^ projects first
].
^ nil
"Modified: / 28-02-2012 / 16:49:07 / cg"
!
globalCoverageRecordingIsDisabled
^ [ InstrumentationContext hasGlobalInstrumentationContext not ]
"Created: / 21-09-2011 / 19:16:17 / cg"
!
globalCoverageRecordingIsEnabled
^ [ InstrumentationContext hasGlobalInstrumentationContext ]
"Created: / 21-09-2011 / 19:16:08 / cg"
!
hasAnyAutoLoadedClassSelected
|selected|
^ (selected := self selectedNonMetaclasses) size > 0
and:[ selected contains:[:cls | cls wasAutoloaded ]].
"Modified: / 12-09-2006 / 13:46:56 / cg"
!
hasAnyAutoLoadedClassSelectedHolder
^ [ self hasAnyAutoLoadedClassSelected ]
!
hasAnyCategoryWithAnyAutoLoadedClassSelected
|selected|
^ (selected := self selectedCategoryClasses value) size > 0
and:[ selected contains:[:cls | cls theNonMetaclass wasAutoloaded ]].
!
hasAnyCategoryWithAnyAutoLoadedClassSelectedHolder
^ [ self hasAnyCategoryWithAnyAutoLoadedClassSelected ]
!
hasAnyCategoryWithAnyUnLoadedClassSelected
|selected|
^ (selected := self selectedCategoryClasses value) size > 0
and:[ selected contains:[:cls | cls theNonMetaclass isLoaded not ]].
!
hasAnyCategoryWithAnyUnLoadedClassSelectedHolder
^ [ self hasAnyCategoryWithAnyUnLoadedClassSelected ]
!
hasAnyClassSelectedForWhich:aBlock
|selectedClasses|
selectedClasses := self selectedClassesValue.
^ selectedClasses notNil and:[selectedClasses contains:aBlock].
"Created: / 28-02-2012 / 16:50:16 / cg"
!
hasAnyClassWithCoverageInfoSelected
|selected|
selected := self selectedClasses value.
selected isEmptyOrNil ifTrue:[
navigationState isProjectBrowser ifTrue:[
selected := self selectedProjectClasses
] ifFalse:[
selected := self selectedCategoryClasses
].
].
selected notEmptyOrNil ifTrue:[
selected do:[ :cls |
cls instAndClassMethodsDo:[:m | m isInstrumented ifTrue:[^ true]].
].
].
^ false.
"Created: / 27-04-2010 / 16:22:59 / cg"
!
hasAnyClassWithCoverageInfoSelectedHolder
^ [self hasAnyClassWithCoverageInfoSelected]
"Created: / 27-04-2010 / 16:23:13 / cg"
!
hasAnyExecutableClassMethodSelectedHolder
^ self hasNonTestCaseClassMethodWithoutArgsSelectedHolder
!
hasAnyLoadedClassSelected
^ self selectedNonMetaclasses contains:[:cls | cls isLoaded ].
"Modified: / 12-09-2006 / 13:45:27 / cg"
!
hasAnyLoadedClassSelectedHolder
^ [ self hasAnyLoadedClassSelected ]
!
hasAnyMethodSelectedForWhich:aBlock
|sel|
sel := self selectedMethodsValue copyWithout:nil.
^ (sel size > 0) and:[ sel contains:aBlock ]
"Created: / 28-02-2012 / 16:17:24 / cg"
!
hasAnyNonIgnoredMethodSelected
^ self hasAnyMethodSelectedForWhich:[:m | m isIgnored not]
"Modified: / 28-02-2012 / 16:17:56 / cg"
!
hasAnyNonIgnoredMethodSelectedHolder
^ [ self hasAnyNonIgnoredMethodSelected ]
!
hasAnyNonPrivateMethodSelected
^ self hasAnyMethodSelectedForWhich:[:m | m isPrivate not]
"Modified: / 28-02-2012 / 16:18:29 / cg"
!
hasAnyNonPrivateMethodSelectedHolder
^ [ self hasAnyNonPrivateMethodSelected ]
!
hasAnyNonProtectedMethodSelected
^ self hasAnyMethodSelectedForWhich:[:m | m isProtected not]
"Modified: / 28-02-2012 / 16:18:41 / cg"
!
hasAnyNonProtectedMethodSelectedHolder
^ [ self hasAnyNonProtectedMethodSelected ]
!
hasAnyNonPublicMethodSelected
^ self hasAnyMethodSelectedForWhich:[:m | m isPublic not]
"Modified: / 28-02-2012 / 16:18:54 / cg"
!
hasAnyNonPublicMethodSelectedHolder
^ [ self hasAnyNonPublicMethodSelected ]
!
hasAnyTestCaseOrExecutableClassMethodOrStartableApplicationSelectedHolder
^ BlockValue
forLogical:(self hasAnyExecutableClassMethodSelectedHolder)
or:(self hasAnyTestCaseSelectedHolder)
or:(self hasStartableApplicationSelectedHolder)
!
hasAnyTestCaseOrExecutableClassMethodSelectedHolder
^ BlockValue
forLogical:(self hasAnyExecutableClassMethodSelectedHolder)
or:(self hasAnyTestCaseSelectedHolder)
!
hasAnyTestCaseSelected
|selected|
selected := self selectedClassesValue.
selected isEmptyOrNil ifTrue:[
selected := self selectedCategoryClasses
].
^ selected notNil
and:[selected
contains:[:cls |
cls theNonMetaclass isTestCaseLike
and:[ cls theNonMetaclass isAbstract not ]
].
].
"Modified: / 28-02-2012 / 16:49:32 / cg"
!
hasAnyTestCaseSelectedAndEmbeddedRunnerIsDisabled
^ BlockValue
with:[:b | b and:[UserPreferences current showEmbeddedTestRunnerInBrowser not]]
argument:(self hasAnyTestCaseSelectedHolder)
!
hasAnyTestCaseSelectedHolder
|holder|
(holder := builder bindingAt:#hasAnyTestCaseSelectedHolder) isNil ifTrue:[
holder := ValueHolder with:false.
builder aspectAt:#hasAnyTestCaseSelectedHolder put: holder.
].
^ holder
"Modified: / 05-08-2006 / 13:22:29 / cg"
!
hasAnyUnloadedClassSelected
|selected|
^ (selected := self selectedNonMetaclasses) size > 0
and:[ selected contains:[:cls | cls isLoaded not ]].
"Modified: / 12-09-2006 / 13:46:31 / cg"
!
hasAnyUnloadedClassSelectedHolder
^ [ self hasAnyUnloadedClassSelected ]
!
hasApplicationClassSelected
^ self hasClassesSelectedWhichAreSubclassOf:ApplicationModel
"Modified: / 19-08-2011 / 02:27:40 / cg"
!
hasApplicationClassSelectedHolder
^ [ self hasApplicationClassSelected ]
"Created: / 4.2.2000 / 22:02:53 / cg"
!
hasApplicationOrHTTPServiceClassSelectedHolder
^ [
(self hasApplicationClassSelected
or:[ self hasWebApplicationClassSelected
or:[ self hasStandaloneStartupClassSelected ]])
]
"Created: / 04-02-2000 / 22:02:53 / cg"
!
hasAtMostOneClassesSelected
^ self selectedClassesValue size <= 1
"Modified: / 28-02-2012 / 16:49:36 / cg"
!
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 ]
!
hasCVSSourceCodeManager
^ CVSSourceCodeManager notNil
"Created: / 4.2.2000 / 22:11:34 / cg"
!
hasCVSSourceCodeManagerHolder
^ [ self hasCVSSourceCodeManager ]
"Created: / 4.2.2000 / 22:11:34 / cg"
!
hasCategorySelected
^ self selectedCategoriesValue size > 0
"Created: / 4.2.2000 / 22:03:45 / cg"
!
hasCategorySelectedAndCVSSourceCodeManager
^ self hasCategorySelected and:[self hasCVSSourceCodeManager]
"Created: / 4.2.2000 / 22:04:12 / cg"
!
hasCategorySelectedAndCVSSourceCodeManagerHolder
^ [ self hasCategorySelectedAndSourceCodeManager ]
"Created: / 4.2.2000 / 22:04:12 / cg"
!
hasCategorySelectedAndCanFileOutCypressHolder
^ [ self hasCategorySelected and:[self hasCypress] ]
"Modified: / 07-09-2012 / 19:23:19 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
hasCategorySelectedAndCanFileOutSIFHolder
^ [ self hasCategorySelected and:[self canFileOutSIF] ]
!
hasCategorySelectedAndCanFileOutVSEHolder
^ [ self hasCategorySelected and:[self canFileOutVSE] ]
!
hasCategorySelectedAndCanFileOutXMLHolder
^ [ self hasCategorySelected and:[self canFileOutXML] ]
!
hasCategorySelectedAndInstrumentingCompilerExistsHolder
^ [ self hasCategorySelected and:[ self instrumentingCompilerExists] ]
"Created: / 31-05-2012 / 09:20:44 / cg"
!
hasCategorySelectedAndSourceCodeManager
^ self hasCategorySelected and:[self hasSourceCodeManager]
"Created: / 4.2.2000 / 22:04:12 / cg"
!
hasCategorySelectedAndSourceCodeManagerHolder
^ [ self hasCategorySelectedAndSourceCodeManager ]
"Created: / 4.2.2000 / 22:04:12 / cg"
!
hasCategorySelectedHolder
^ [ self hasCategorySelected ]
"Created: / 4.2.2000 / 22:04:12 / cg"
!
hasChangedClasses
^ Project current changeSet contains:[:change | change isClassChange]
!
hasChangedClassesHolder
^ [ self hasChangedClasses ]
!
hasChangedMethods
^ Project current changeSet contains:[:change | change isMethodChange]
!
hasChangedMethodsHolder
^ [ self hasChangedMethods ]
!
hasClassAndNoVariableSelected
^ self hasClassSelected and:[self hasVariableSelected not ]
!
hasClassAndNoVariableSelectedHolder
^ [ self hasClassAndNoVariableSelected ]
"Created: / 4.2.2000 / 22:02:53 / cg"
!
hasClassAndSingleVariableSelected
^ self hasClassSelected and:[self hasSingleVariableSelected]
!
hasClassAndSingleVariableSelectedHolder
^ [ self hasClassAndSingleVariableSelected ]
"Created: / 4.2.2000 / 22:02:53 / cg"
!
hasClassAndVariableSelected
^ self hasClassSelected and:[self hasVariableSelected]
!
hasClassAndVariableSelectedHolder
^ [ self hasClassAndVariableSelected ]
"Created: / 4.2.2000 / 22:02:53 / cg"
!
hasClassMethodsOrMethodsNotReferringToSelfSelected
^ self hasOnlyMethodsSelectedForWhich:[:eachMethod |
eachMethod mclass isMeta
or:[ (self methodRefersToSelfOrInstanceVariable:eachMethod) not ]]
"Modified: / 28-02-2012 / 16:42:20 / cg"
!
hasClassMethodsOrMethodsNotReferringToSelfSelectedHolder
^ [ self hasClassMethodsOrMethodsNotReferringToSelfSelected ]
!
hasClassMethodsSelected
^ self hasOnlyMethodsSelectedForWhich:[:eachMethod | eachMethod mclass isMeta]
"Modified: / 28-02-2012 / 16:42:20 / cg"
!
hasClassMethodsSelectedHolder
^ [ self hasClassMethodsSelected ]
"Created: / 4.2.2000 / 22:23:39 / cg"
!
hasClassNameSelectedInCodeView
^ self selectedClassNameInCodeViewOrNil notNil
!
hasClassOrMethodSelected
^ self selectedClassesValue size > 0
or:[ self selectedMethodsValue size > 0 ]
!
hasClassOrMethodSelectedHolder
|holder|
(holder := builder bindingAt:#hasClassOrMethodSelectedHolder) isNil ifTrue:[
builder aspectAt:#hasClassOrMethodSelectedHolder put:(holder := false asValue).
].
^ holder.
!
hasClassSelected
^ self selectedClassesValue size > 0
"Created: / 04-02-2000 / 22:02:25 / cg"
"Modified: / 28-02-2012 / 16:49:39 / cg"
!
hasClassSelectedAndCVSSourceCodeManagerHolder
^ [ self hasClassSelected and:[ self hasCVSSourceCodeManager]]
"Created: / 4.2.2000 / 22:02:53 / cg"
!
hasClassSelectedAndCanFileOutBeeHolder
^ [ self hasClassSelected and:[self canFileOutBee]]
"Created: / 14-04-2015 / 12:48:22 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
hasClassSelectedAndCanFileOutBinaryHolder
^ [ self hasClassSelected and:[self canFileOutBinary]]
"Created: / 4.2.2000 / 22:02:53 / cg"
!
hasClassSelectedAndCanFileOutSIFHolder
^ [ self hasClassSelected and:[self canFileOutSIF]]
"Created: / 4.2.2000 / 22:02:53 / cg"
!
hasClassSelectedAndCanFileOutVSEHolder
^ [ self hasClassSelected and:[self canFileOutVSE]]
!
hasClassSelectedAndCanFileOutXMLHolder
^ [ self hasClassSelected and:[self canFileOutXML]]
"Created: / 4.2.2000 / 22:02:53 / cg"
!
hasClassSelectedAndCanSendMailHolder
^ [ self hasClassSelected and:[ SendMailTool notNil] ]
"Created: / 05-10-2010 / 12:26:23 / cg"
!
hasClassSelectedAndControlKeyDown
^ self hasClassSelected and:[self window sensor ctrlDown]
!
hasClassSelectedAndControlKeyDownHolder
^ [ self hasClassSelectedAndControlKeyDown ]
"Created: / 4.2.2000 / 22:02:53 / cg"
!
hasClassSelectedAndInstrumentingCompilerExistsAndOOMPackageLoadedHolder
^ [ self hasClassSelectedAndInstrumentingCompilerExistsHolder value
and:[ OOM::MetricVisualizer notNil ]
]
"Created: / 27-04-2010 / 12:33:41 / cg"
!
hasClassSelectedAndInstrumentingCompilerExistsHolder
^ [ self hasClassSelected and:[ self instrumentingCompilerExists] ]
"Created: / 4.2.2000 / 22:11:34 / cg"
!
hasClassSelectedAndSourceCodeManagerHolder
^ [ self hasClassSelected and:[ self hasSourceCodeManager]]
"Created: / 4.2.2000 / 22:02:53 / cg"
!
hasClassSelectedHolder
^ [ self hasClassSelected ]
"Created: / 4.2.2000 / 22:02:53 / cg"
!
hasClassSelectedHolderAndSourceCodeManagerHolder
"obsolete"
^ self hasClassSelectedAndSourceCodeManagerHolder
"Created: / 4.2.2000 / 22:11:34 / cg"
!
hasClassSelectedWhichCanBeExcludedFromProject
^ self hasAnyClassSelectedForWhich:
[:cls |
|def|
def := ProjectDefinition definitionClassForPackage:cls package.
def notNil
and:[ def isLoaded
and:[ (def allClassNames includes:cls name)
and:[ cls isProjectDefinition not ]]]
]
"Created: / 22-02-2007 / 13:55:03 / cg"
"Modified: / 28-02-2012 / 16:51:10 / cg"
!
hasClassSelectedWhichCanBeExcludedFromProjectHolder
^ [ self hasClassSelectedWhichCanBeExcludedFromProject ]
"Created: / 22-02-2007 / 13:55:09 / cg"
!
hasClassSelectedWhichCanBeIncludedInProject
^ self hasAnyClassSelectedForWhich:
[:cls |
|def|
def := ProjectDefinition definitionClassForPackage:cls package.
def notNil
and:[ def isLoaded
and:[ (def compiled_classNames includes:cls name) not
and:[ cls isProjectDefinition not ]]]
]
"Created: / 22-02-2007 / 13:54:16 / cg"
"Modified: / 28-02-2012 / 16:50:59 / cg"
!
hasClassSelectedWhichCanBeIncludedInProjectHolder
^ [ self hasClassSelectedWhichCanBeIncludedInProject ]
"Created: / 22-02-2007 / 13:54:23 / cg"
!
hasClassSelectedWhichCanBeMadeAutoloadedInProject
^ self hasAnyClassSelectedForWhich:
[:cls |
|def|
def := ProjectDefinition definitionClassForPackage:cls package.
def notNil
and:[ def isLoaded
and:[ (def autoloaded_classNames includes:cls name) not
and:[ cls isProjectDefinition not ]]]
]
"Created: / 30-08-2007 / 18:48:59 / cg"
!
hasClassSelectedWhichCanBeMadeAutoloadedInProjectHolder
^ [ self hasClassSelectedWhichCanBeMadeAutoloadedInProject ]
"Created: / 30-08-2007 / 18:49:11 / cg"
!
hasClassVariableSelected
^ self hasVariableSelected
"/ and:[ self showingClassVarsInVariableList ]
!
hasClassVariableSelectedHolder
^ [ self hasClassVariableSelected ]
"Created: / 4.2.2000 / 22:08:22 / cg"
!
hasClassVariableSelectedInCodeView
|mthd mclass selection|
(self hasSingleWordSelectedInCodeView) ifFalse:[^ false].
selection := self selectionInCodeView.
(mthd := self theSingleSelectedMethod) notNil ifTrue:[
mclass := mthd mclass.
].
mclass isNil ifTrue:[
mclass := self theSingleSelectedClass.
mclass isNil ifTrue:[^ false].
].
^ (mclass theNonMetaclass whichClassDefinesClassVar:selection) notNil.
"/ the following is too slow
"/ node := self findNode.
"/ (node isNil or:[node isVariable not]) ifTrue:[
"/ ^ false
"/ ].
"/ ^ true
"Modified: / 01-03-2007 / 20:54:01 / cg"
!
hasClassVariableSelectedInCodeViewHolder
^ [ self hasClassVariableSelectedInCodeView ]
!
hasClassVariableSelectedInCodeViewOrVariableList
(self hasClassVariableSelectedInCodeView) ifTrue:[^ true].
^ self hasClassVariableSelectedInVariableList
!
hasClassVariableSelectedInCodeViewOrVariableListAndCanUseRefactoringSupportHolder
^ [ self canUseRefactoringSupport
and:[self hasClassVariableSelectedInCodeViewOrVariableList] ]
!
hasClassVariableSelectedInCodeViewOrVariableListHolder
^ [ self hasClassVariableSelectedInCodeViewOrVariableList ]
!
hasClassVariableSelectedInVariableList
|var mclass|
var := self theSingleSelectedVariable.
var isNil ifTrue:[^ false].
mclass := self classOfSelectedMethodOrSelectedClass.
mclass isNil ifTrue:[^ false].
^ (mclass theNonMetaclass whichClassDefinesClassVar:var) notNil.
!
hasClassWithExtensionsSelected
^ self
hasAnyClassSelectedForWhich:[:cls |
cls theNonMetaclass isProjectDefinition
ifTrue:[ cls theNonMetaclass hasExtensionMethods ]
ifFalse:[ cls hasExtensions ]
].
"Modified: / 28-02-2012 / 16:54:34 / cg"
!
hasClassWithExtensionsSelectedHolder
^ [ self hasClassWithExtensionsSelected ]
"Created: / 4.2.2000 / 22:02:53 / cg"
!
hasClassWithInstrumentedMethodsSelected
self hasAnyClassSelectedForWhich:[:cls |
cls instAndClassMethodsDo:[:m |
m isInstrumented ifTrue:[^ true].
].
].
^ false
!
hasClassesSelectedAndDataBaseRepositoryExistsHolder
^ [
| classes |
classes := self selectedClassesValue.
classes isEmptyOrNil ifTrue:[
false
] ifFalse:[
ConfigurableFeatures includesFeature: #DataBaseSourceCodeManagerSupport
]
]
"Created: / 03-01-2012 / 15:48:46 / cg"
"Modified: / 19-01-2012 / 10:44:47 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 28-02-2012 / 16:54:43 / cg"
!
hasClassesSelectedAndFileBasedRepositoryExistsHolder
^ [
| classes |
classes := self selectedClassesValue.
classes isEmptyOrNil ifTrue:[
false
] ifFalse:[
ConfigurableFeatures includesFeature: #FileBasedSourceCodeManagerSupport
]
]
"Created: / 21-12-2011 / 17:05:28 / cg"
"Modified: / 19-01-2012 / 10:44:53 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 28-02-2012 / 16:54:49 / cg"
!
hasClassesSelectedAndGitRepositoryExistsHolder
^ [
| classes |
classes := self selectedClassesValue.
classes isEmptyOrNil ifTrue:[
false
] ifFalse:[
classes conform: [:cls | self hasGitRepositoryFor: cls theNonMetaclass package]
]
]
"Created: / 23-07-2012 / 13:33:07 / cg"
!
hasClassesSelectedAndMercurialRepositoryExistsHolder
^ [
| classes |
classes := self selectedClassesValue.
classes isEmptyOrNil ifTrue:[
false
] ifFalse:[
classes conform:[:cls | self hasMercurialRepositoryFor: cls theNonMetaclass package]
]
]
"Created: / 19-01-2012 / 16:14:57 / cg"
!
hasClassesSelectedAndPerforceRepositoryExistsHolder
^ [
| classes |
classes := self selectedClassesValue.
classes isEmptyOrNil ifTrue:[
false
] ifFalse:[
classes conform: [:cls | self hasPerforceRepositoryFor: cls theNonMetaclass package]
]
]
"Created: / 19-04-2011 / 14:13:52 / cg"
!
hasClassesSelectedAndSubversionRepositoryExists
| classes |
classes := self selectedClassesValue.
classes size = 0 ifTrue:[^false].
^ classes conform: [:cls | self hasSubversionRepositoryFor: cls theNonMetaclass package]
"Modified: / 28-02-2012 / 16:55:03 / cg"
!
hasClassesSelectedAndSubversionRepositoryExistsHolder
^ [
| classes |
classes := self selectedClassesValue.
classes isEmptyOrNil ifTrue:[
false
] ifFalse:[
classes conform: [:cls | self hasSubversionRepositoryFor: cls theNonMetaclass package]
]
]
"Modified: / 28-02-2012 / 16:55:12 / cg"
!
hasClassesSelectedWhichAreSubclassOf:aBaseClass
|selectedClasses|
selectedClasses := self selectedNonMetaclasses.
^ selectedClasses notEmptyOrNil and:[selectedClasses conform:[:each | each isSubclassOf:aBaseClass]].
"Modified: / 12-09-2006 / 13:46:13 / cg"
"Created: / 19-08-2011 / 02:27:22 / cg"
!
hasClassesWithCommonSuperclassAndVariableSelectedAndCanUseRefactoringSupportHolder
^ [ self canUseRefactoringSupport
and:[self hasClassesWithCommonSuperclassSelected
and:[self hasVariableSelectedInCodeViewOrVariableList]] ]
"Created: / 4.2.2000 / 22:02:53 / cg"
!
hasClassesWithCommonSuperclassSelected
|selectedClasses commonSuper|
selectedClasses := self selectedClassesValue.
selectedClasses isEmptyOrNil ifTrue:[^ false].
selectedClasses size == 1 ifTrue:[^ true].
commonSuper := Behavior commonSuperclassOf:(selectedClasses ? #()).
^ commonSuper notNil and:[ selectedClasses includes: commonSuper ].
"Modified: / 28-02-2012 / 16:55:19 / cg"
!
hasCypress
"Return true, if Cypress reader/writer is present"
^ConfigurableFeatures includesFeature: #Cypress
"Created: / 07-09-2012 / 19:15:38 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
hasDataBaseRepositoryFor: package
^ ConfigurableFeatures hasDatabaBaseSourceCodeManagerSupport
"/ use Smalltalk-at to trick the dependency/prerequisite generator
and:[(Smalltalk at:#'DatabaBaseSourceCodeManager') hasRepositoryForPackage: package]
"Created: / 03-01-2012 / 15:35:39 / cg"
!
hasDataBaseSourceCodeManagerSupport
^ ConfigurableFeatures includesFeature: #DataBaseSourceCodeManagerSupport
"Modified: / 07-09-2011 / 10:45:57 / cg"
"Created: / 03-01-2012 / 15:47:11 / cg"
"Modified: / 19-01-2012 / 10:44:58 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
hasEmptyNamespacesSelected
"return true, if only empty namespaces are selected"
|selectedNamespaces|
selectedNamespaces := self selectedNamespaces value.
selectedNamespaces size == 0 ifTrue:[^ false].
^ (selectedNamespaces
contains:[:nm |
|ns|
ns := environment at:nm asSymbol ifAbsent:nil.
ns notNil
and:[ns allClasses size ~~ 0]
]
) not
!
hasEmptyNamespacesSelectedHolder
"return true, if only empty namespaces are selected"
^ [ self hasEmptyNamespacesSelected ]
!
hasEnumTypeClassSelected
^ self hasAnyClassSelectedForWhich:[:cls |
cls isLoaded
and:[(cls theNonMetaclass askFor:#isAbstract) not
and:[ cls withAllSuperclasses contains:[:aSuperClass |
aSuperClass theNonMetaclass name includesString:'Enum']]] ]
"Modified: / 28-02-2012 / 16:56:28 / cg"
!
hasEnumTypeClassSelectedHolder
^ [ self hasEnumTypeClassSelected ]
"Created: / 4.2.2000 / 22:02:53 / cg"
!
hasExactlyTwoClassesSelected
^ self selectedClassesValue size == 2
"Modified: / 28-02-2012 / 16:56:33 / cg"
!
hasExactlyTwoClassesSelectedHolder
^ [ self hasExactlyTwoClassesSelected ]
"Created: / 4.2.2000 / 22:11:34 / cg"
!
hasExactlyTwoMethodsSelected
^ self selectedMethodsValue size == 2
"Modified: / 28-02-2012 / 16:20:11 / cg"
!
hasExactlyTwoMethodsSelectedHolder
^ [ self hasExactlyTwoMethodsSelected ]
"Created: / 4.2.2000 / 22:11:34 / cg"
!
hasExtensionMethodSelected
^ self hasAnyMethodSelectedForWhich:[:m | m containingClass isNil or:[ m isExtension ] ]
"Modified: / 28-02-2012 / 16:21:22 / cg"
!
hasExtensionMethodSelectedHolder
^ BlockValue
with:[:m | m and:[self hasExtensionMethodSelected]]
argument:(self hasMethodSelectedHolder)
"Modified: / 08-03-2007 / 23:00:43 / cg"
!
hasFileBasedRepositoryFor: package
"is there a subversion source repository for package?"
^ (ConfigurableFeatures includesFeature: #FileBasedSourceCodeManagerSupport)
"/ use Smalltalk-at to trick the dependency/prerequisite generator
and:[(Smalltalk at:#'FileBasedSourceCodeManager') hasRepositoryForPackage: package]
"Created: / 31-03-2008 / 15:08:13 / janfrog"
"Modified: / 22-08-2009 / 10:49:33 / Jan Vrany <vranyj1@fel.cvut.cz>"
"Modified: / 07-09-2011 / 10:43:21 / cg"
"Created: / 21-12-2011 / 17:08:01 / cg"
"Modified: / 19-01-2012 / 10:45:12 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
hasFileBasedSourceCodeManagerSupport
^ (ConfigurableFeatures includesFeature: #FileBasedSourceCodeManagerSupport)
"Modified: / 07-09-2011 / 10:45:57 / cg"
"Created: / 21-12-2011 / 17:08:53 / cg"
"Modified: / 19-01-2012 / 10:45:23 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
hasFindHistoryClassesHolder
^ [ FindHistory size > 0 ]
!
hasGitRepositoryFor: package
"is there a git source repository for package?"
^ self hasGitSupport
"/ use Smalltalk-at to trick the dependency/prerequisite generator
"/ and:[(Smalltalk at:#'GitSourceCodeManager') hasRepositoryForPackage: package]
"Created: / 23-07-2012 / 13:33:39 / cg"
!
hasGitSupport
"is there support for the git source code manager?"
^ self hasSCMSupportFor:#'GitSourceCodeManager'
"Created: / 23-07-2012 / 13:34:15 / cg"
!
hasGroovySupport
"Return true, if Groovy support is loaded"
^ConfigurableFeatures includesFeature: #GroovySupport
"Created: / 18-02-2012 / 16:59:47 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
hasInstanceMethodsSelected
^ self hasOnlyMethodsSelectedForWhich:[:m | m mclass isMeta not]
"Modified: / 28-02-2012 / 16:26:35 / cg"
!
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 ~= SyntaxHighlighter codeAspectClassDefinition 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
"Modified: / 27-07-2012 / 22:25:25 / cg"
!
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]
!
hasInstrumentedMethodSelected
^ self hasAnyMethodSelectedForWhich:[:m | m isInstrumented ]
"Modified: / 28-02-2012 / 16:23:11 / cg"
!
hasInstrumentedMethodSelectedHolder
^ builder booleanValueAspectFor:#hasInstrumentedMethodSelectedHolder.
!
hasLiteralConstantSelectedInCodeView
|s tree|
self codeView hasSelection ifFalse:[^ false].
s := self codeView selectionAsString.
tree := Parser parseExpression:s onError:[nil].
tree isNil ifTrue:[^ false].
tree isLiteral ifFalse:[^ false].
^ true
"Created: / 23-07-2011 / 12:28:46 / cg"
!
hasLiteralConstantSelectedInCodeViewHolder
^ [ self hasLiteralConstantSelectedInCodeView ]
"Created: / 23-07-2011 / 12:26:14 / cg"
!
hasLoadedClassSelected
^ self hasAnyClassSelectedForWhich:[:aClass | aClass isLoaded]
"Modified: / 28-02-2012 / 16:56:54 / cg"
!
hasLoadedClassSelectedHolder
^ [ self hasLoadedClassSelected ]
"Created: / 4.2.2000 / 22:02:53 / cg"
!
hasLocalSelectorSelectedInCodeView
|sel|
self hasSelectorSelectedInCodeView ifFalse:[^ false].
sel := self selectedSelectorInCodeViewOrNil.
sel isNil ifTrue:[^ false].
(self hasAnyClassSelectedForWhich:[:cls |
(cls canUnderstand:sel)]) ifTrue:[^ true].
^ false "true".
"Modified: / 28-02-2012 / 16:57:56 / cg"
!
hasLocalVariableSelectedInCodeView
|"node" selectionInCode|
self codeAspect value == SyntaxHighlighter codeAspectMethod 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
"Modified: / 27-07-2012 / 22:18:31 / cg"
!
hasLocalVariableSelectedInCodeViewHolder
^ [ self hasLocalVariableSelectedInCodeView ]
!
hasMercurialRepositoryFor: package
"is there a mercurial (hg) source repository for package?"
^ self hasMercurialSupport
"/ use Smalltalk-at to trick the dependency/prerequisite generator
"/ and:[(Smalltalk at:#'MercurialSourceCodeManager') hasRepositoryForPackage: package]
"Modified: / 22-08-2009 / 10:49:33 / Jan Vrany <vranyj1@fel.cvut.cz>"
"Created: / 15-01-2012 / 14:42:02 / cg"
!
hasMercurialSupport
"is there support for the mercurial (hg) source code manager?"
^ self hasSCMSupportFor:#'MercurialSourceCodeManager'
"Created: / 15-01-2012 / 14:42:30 / cg"
!
hasMetaMethodSelectedHolder
^ [ (self hasMethodSelected and:[self hasMetaSelected])
or:[self hasClassMethodsSelected ]]
!
hasMetaSelected
^ self meta value
!
hasMetaSelectedAndClassSelectedHolder
^ [ self meta value and:[ self hasClassSelected] ]
!
hasMetaSelectedHolder
^ self meta
!
hasMethodSelected
^ self selectedMethodsValue size > 0
"Created: / 04-02-2000 / 22:09:52 / cg"
"Modified: / 28-02-2012 / 16:37:12 / cg"
!
hasMethodSelectedAndCanFileOutSIFHolder
^ [ self hasMethodSelected and:[ self canFileOutSIF] ]
"Created: / 4.2.2000 / 22:23:39 / cg"
!
hasMethodSelectedAndCanFileOutXMLHolder
^ [ self hasMethodSelected and:[ self canFileOutXML] ]
"Created: / 4.2.2000 / 22:23:39 / cg"
!
hasMethodSelectedAndCanUseRefactoringSupportHolder
^ [ self canUseRefactoringSupport
and:[self hasMethodSelected] ]
"Created: / 4.2.2000 / 22:23:39 / cg"
!
hasMethodSelectedAndInstrumentingCompilerExistsAndOOMPackageLoadedHolder
^ [ self hasMethodSelectedAndInstrumentingCompilerExistsHolder value
and:[ OOM::MetricVisualizer notNil ]
]
"Created: / 10-08-2010 / 14:42:18 / cg"
!
hasMethodSelectedAndInstrumentingCompilerExistsHolder
^ [ self hasMethodSelected and:[ self instrumentingCompilerExists] ]
"Created: / 10-08-2010 / 14:42:38 / cg"
!
hasMethodSelectedAndIsMethodListBrowser
^ self hasMethodSelected
and:[navigationState isMethodListBrowser ]
"Created: / 4.2.2000 / 22:23:39 / cg"
!
hasMethodSelectedAndIsMethodListBrowserHolder
^ [ self hasMethodSelectedAndIsMethodListBrowser ]
"Created: / 4.2.2000 / 22:23:39 / cg"
!
hasMethodSelectedAndSourceCodeManagerHolder
^ [ self hasMethodSelected and:[ self hasSourceCodeManager]]
"Created: / 4.2.2000 / 22:23:39 / cg"
!
hasMethodSelectedHolder
^ builder booleanValueAspectFor:#hasMethodSelected
"/ ^ [ self hasMethodSelected ]
"Created: / 4.2.2000 / 22:23:39 / cg"
!
hasMethodWithBreakPointSelected
^ self hasAnyMethodSelectedForWhich:[:m |
m isBreakpointed "/ method breakpoint
or:[ m isMethodWithBreakpoints ]]
"Modified: / 28-02-2012 / 16:23:11 / cg"
!
hasMethodWithBreakPointSelectedHolder
^ builder booleanValueAspectFor:#hasMethodWithBreakPointSelectedHolder.
!
hasMethodWithSelfSendSelected
^ self hasAnyMethodSelectedForWhich:[:m |
m messagesSentToSelf notEmpty
or:[ m messagesSentToSuper notEmpty ]]
"Modified: / 28-02-2012 / 16:23:11 / cg"
!
hasMethodWithTracePointSelected
^ self hasAnyMethodSelectedForWhich:[:m | m isWrapped and:[m isBreakpointed not] ]
"Modified: / 28-02-2012 / 16:23:22 / cg"
!
hasMethodWithTracePointSelectedHolder
^ [ self hasMethodWithTracePointSelected ]
!
hasMethodWithWrapSelected
^ self hasAnyMethodSelectedForWhich:[:m | m isWrapped ]
"Modified: / 28-02-2012 / 16:23:39 / cg"
!
hasMethodWithWrapSelectedHolder
^ [ self hasMethodWithWrapSelected ]
!
hasMethodWithoutBreakPointSelected
^ self hasAnyMethodSelectedForWhich:[:m | m isBreakpointed not ]
"Modified: / 28-02-2012 / 16:23:53 / cg"
!
hasMethodWithoutBreakPointSelectedHolder
^ builder booleanValueAspectFor:#hasMethodWithoutBreakPointSelectedHolder.
!
hasMethodsInList
|app|
^ (app := self methodListApp) notNil
and:[ app methodList size > 0 ]
!
hasMonticelloSupport
^ (Smalltalk at: #MCSourceCodeManager) notNil
"Created: / 14-09-2010 / 22:34:51 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified (format): / 01-12-2011 / 21:21:12 / cg"
!
hasMultipleClassesSelected
^ self selectedClassesValue size > 1
"Modified: / 28-02-2012 / 16:58:02 / cg"
!
hasMultipleClassesSelectedHolder
^ [ self hasMultipleClassesSelected ]
"Created: / 4.2.2000 / 22:03:08 / cg"
!
hasMultipleMethodsSelected
^ self selectedMethodsValue size > 1
"Modified: / 28-02-2012 / 16:24:51 / cg"
!
hasMultipleMethodsSelectedHolder
^ [ self hasMultipleMethodsSelected ]
"Created: / 4.2.2000 / 22:03:08 / cg"
!
hasMultipleSelectorsSelected
^ (self selectedMethodsValue collect:[:eachMethod | eachMethod selector]) size > 1
"Modified: / 28-02-2012 / 16:24:58 / cg"
!
hasMultipleSelectorsSelectedHolder
^ [ self hasMultipleSelectorsSelected ]
!
hasMultipleTemporaryVariablesSelectedInCodeView
self codeAspect value ~~ SyntaxHighlighter codeAspectMethod ifTrue:[^ false].
(self hasMultipleWordsSelectedInCodeView) ifFalse:[^ false].
^ true
"Modified: / 27-07-2012 / 22:18:29 / cg"
!
hasMultipleTemporaryVariablesSelectedInCodeViewHolder
^ [ self hasMultipleTemporaryVariablesSelectedInCodeView ]
!
hasMultipleVariablesSelected
^ self selectedVariables value size > 1
!
hasMultipleWordsSelectedInCodeView
|codeView selectionInCode|
codeView := self codeView.
codeView isNil ifTrue:[^ false].
selectionInCode := self selectionInCodeView.
selectionInCode isEmptyOrNil ifTrue:[ ^ false ].
^ selectionInCode asCollectionOfWords size > 1.
!
hasNameSpaceSelected
^ self selectedNamespaces value size > 0
"Created: / 4.2.2000 / 22:03:45 / cg"
!
hasNameSpaceSelectedAndSourceCodeManager
^ self hasNameSpaceSelected and:[self hasSourceCodeManager]
"Created: / 4.2.2000 / 22:03:45 / cg"
!
hasNameSpaceSelectedAndSourceCodeManagerHolder
^ [ self hasNameSpaceSelectedAndSourceCodeManager ]
"Created: / 4.2.2000 / 22:04:12 / cg"
!
hasNameSpaceSelectedHolder
^ [ self hasNameSpaceSelected ]
"Created: / 4.2.2000 / 22:04:12 / cg"
!
hasNoClassSelected
^ [ self hasClassSelected not ]
!
hasNoMethodOrMixedWrapsSelectedHolder
^ [ self hasMethodSelected not
or:[ self hasBothMethodsWithBreakAndTraceSelected
or:[ self hasMethodWithWrapSelected not] ]]
!
hasNoProjectSelectedHolder
^ [ self hasProjectSelected not ]
"Created: / 14-09-2006 / 17:36:32 / cg"
!
hasNoSourceCodeManagerHolder
^ [ self hasSourceCodeManager not ]
"Created: / 19-03-2007 / 11:15:14 / cg"
!
hasNoVariableSelected
^ self selectedVariables value size == 0
!
hasNonEmptyEnvironmentSelected
"Return true if some code is selected (class or sole methods), false
otherwise. Note that false is also returned if refactory browser
support is not available"
^ self canUseRefactoringSupport and:[self selectedEnvironment isEmpty not]
"Created: / 02-04-2014 / 12:28:02 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 03-12-2014 / 11:33:37 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
hasNonEmptyEnvironmentSelectedHolder
hasNonEmptyEnvironmentSelectedHolder isNil ifTrue:[
hasNonEmptyEnvironmentSelectedHolder := false asValue
].
^ hasNonEmptyEnvironmentSelectedHolder
"Created: / 02-04-2014 / 12:25:24 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
hasNonMetaMethodSelectedHolder
^ [ self hasNonMetaSelected and:[self hasMethodSelected] ]
!
hasNonMetaSelected
^self meta value not
!
hasNonMetaSelectedAndClassSelectedHolder
^ [ self hasNonMetaSelected and:[ self hasClassSelected] ]
!
hasNonMetaSelectedHolder
^ [ self hasNonMetaSelected ]
!
hasNonPrivateClassSelected
^ self hasAnyClassSelectedForWhich:[:aClass | aClass owningClass isNil]
"Created: / 11-02-2000 / 11:07:54 / cg"
!
hasNonPrivateClassSelectedAndSourceCodeManagerHolder
^ [ self hasNonPrivateClassSelected and:[self hasSourceCodeManager] ]
"Created: / 19-03-2007 / 11:13:03 / cg"
!
hasNonPrivateClassSelectedHolder
^ [ self hasNonPrivateClassSelected ]
"Created: / 11.2.2000 / 11:08:03 / cg"
!
hasNonProjectDefinitionSelected
^ self selectedClassesValue
contains:[:cls | cls theNonMetaclass isProjectDefinition not]
"Created: / 10-08-2006 / 16:26:02 / cg"
"Modified: / 13-10-2006 / 11:54:45 / cg"
!
hasNonProjectDefinitionSelectedHolder
^ [ self hasNonProjectDefinitionSelected ]
"Created: / 10-08-2006 / 16:25:50 / cg"
!
hasNonTestCaseClassMethodWithoutArgsSelected
|m |
self hasAnyTestCaseSelected ifTrue:[^ false].
(m := self theSingleSelectedMethod) isNil ifTrue:[^ false].
"/ self hasMetaSelected ifFalse:[^ false].
^ m mclass isMeta
and:[ m numArgs == 0
and:[ m isDocumentationMethod not
and:[ m isVersionMethod not
and:[ m hasImageResource not
and:[ m hasMenuResource not
and:[ m hasCanvasResource not ]]]]]]
!
hasNonTestCaseClassMethodWithoutArgsSelectedHolder
|holder|
(holder := builder bindingAt:#hasNonTestCaseClassMethodWithoutArgsSelectedHolder) isNil ifTrue:[
holder := ValueHolder with:false.
builder aspectAt:#hasNonTestCaseClassMethodWithoutArgsSelectedHolder put: holder.
].
^ holder
"Modified: / 05-08-2006 / 13:22:29 / cg"
!
hasNotMultipleClassesSelected
^ self hasMultipleClassesSelected not
!
hasNotMultipleClassesSelectedHolder
^ [ self hasNotMultipleClassesSelected ]
!
hasNotMultipleTemporaryVariablesSelectedInCodeViewHolder
^ [ self hasMultipleTemporaryVariablesSelectedInCodeView not ]
!
hasOOMPackageLoaded
^ OOM::MethodMetrics notNil
!
hasOOMPackageLoadedAndSingleRealProjectSelectedHolder
^ [self hasOOMPackageLoaded and:[ self hasSingleRealProjectSelectedHolder value ]]
!
hasOOMPackageLoadedHolder
^ [ self hasOOMPackageLoaded ]
!
hasOnlyMethodsSelectedForWhich:aBlock
|sel|
sel := self selectedMethodsValue.
^ (sel size > 0) and:[ sel conform:aBlock ]
"Created: / 28-02-2012 / 16:26:17 / cg"
!
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]
!
hasPackagableApplicationSelected
|cls|
(cls := self theSingleSelectedClass) isNil ifTrue:[^ false].
cls := cls theNonMetaclass.
cls isProjectDefinition ifTrue:[
^ cls isFolderForProjectsDefinition not
].
(cls inheritsFrom:StandaloneStartup) ifTrue:[
^ cls isAbstract not
].
^ false.
!
hasPackagableApplicationSelectedHolder
|holder|
(holder := builder bindingAt:#hasPackagableApplicationSelectedHolder) isNil ifTrue:[
holder := ValueHolder with:false.
builder aspectAt:#hasPackagableApplicationSelectedHolder put: holder.
].
^ holder
!
hasPerforceRepositoryFor: package
"is there a perforce source repository for package?"
^ self hasPerforceSupport
"/ use Smalltalk-at to trick the dependency/prerequisite generator
"/ and:[(Smalltalk at:#'PerforceSourceCodeManager') hasRepositoryForPackage: package]
"Modified: / 22-08-2009 / 10:49:33 / Jan Vrany <vranyj1@fel.cvut.cz>"
"Created: / 19-04-2011 / 14:13:40 / cg"
!
hasPerforceSupport
"is there support for the perforce source code manager?"
^ self hasSCMSupportFor:#'PerforceSourceCodeManager'
"Created: / 19-04-2011 / 14:14:51 / cg"
!
hasProjectDefinitionOrClassWithExtensionsSelectedAndSourceCodeManagerHolder
^ [ self hasSourceCodeManager
and:[ self hasProjectDefinitionSelected or:[self hasClassWithExtensionsSelected]]]
"Created: / 12-09-2011 / 11:12:12 / cg"
!
hasProjectDefinitionSelected
^ self selectedClassesValue contains:[:cls | cls theNonMetaclass isProjectDefinition]
"Created: / 10-08-2006 / 16:25:38 / cg"
!
hasProjectDefinitionSelectedAndSourceCodeManagerHolder
^ [ self hasProjectDefinitionSelected and:[self hasSourceCodeManager] ]
"Created: / 4.2.2000 / 22:09:02 / cg"
!
hasProjectDefinitionSelectedHolder
^ [ self hasProjectDefinitionSelected ]
"Created: / 10-08-2006 / 16:26:17 / cg"
!
hasProjectDefinitionSelectedHolder_and_isNotEmbeddedBrowserHolder
^ [ self hasProjectDefinitionSelectedHolder value and:[self isEmbeddedBrowser not]]
!
hasProjectDefinitionWithAnyUnloadedClassSelected
(self selectedClassesValue) do:[:cls |
cls isLoaded ifFalse:[^ true].
cls isProjectDefinition ifTrue:[
cls hasAllExtensionsLoaded ifFalse:[^ true].
cls hasAllClassesLoaded ifFalse:[^ true].
].
].
^ true
"Created: / 17-08-2006 / 00:49:24 / cg"
"Modified: / 28-02-2012 / 16:58:59 / cg"
!
hasProjectDefinitionWithAnyUnloadedClassSelectedHolder
^ [ self hasProjectDefinitionWithAnyUnloadedClassSelected ]
"Created: / 17-08-2006 / 00:46:45 / cg"
!
hasProjectSelected
^ self selectedProjects value size > 0
!
hasProjectSelectedAndCanFileOutBeeHolder
^ [ self hasProjectSelected and:[(Smalltalk at: #BeeProjectWriter) notNil] ].
"Created: / 02-02-2021 / 08:10:06 / Jan Vrany <jan.vrany@labware.com>"
!
hasProjectSelectedAndCanFileOutCypressHolder
^ [ self hasProjectSelected and:[self hasCypress] ].
"Modified: / 07-09-2012 / 19:24:19 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
hasProjectSelectedAndCanFileOutSIFHolder
^ [ self hasProjectSelected and:[self canFileOutSIF] ]
"Created: / 4.2.2000 / 22:09:02 / cg"
!
hasProjectSelectedAndCanFileOutTonelHolder
^ [ self hasProjectSelected and:[self hasTonel] ].
"Created: / 09-07-2020 / 23:54:06 / Jan Vrany <jan.vrany@labware.com>"
!
hasProjectSelectedAndCanFileOutVSEHolder
^ [ self hasProjectSelected and:[self canFileOutBee] ]
"Modified: / 14-04-2015 / 14:05:16 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
hasProjectSelectedAndCanFileOutXMLHolder
^ [ self hasProjectSelected and:[self canFileOutXML] ]
"Created: / 4.2.2000 / 22:09:02 / cg"
!
hasProjectSelectedAndGitRepositoryExistsHolder
^[self hasProjectSelected and: [(Smalltalk at: #GitSourceCodeManager) notNil ]]
"Created: / 14-09-2010 / 22:37:59 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Created: / 24-07-2012 / 15:25:56 / cg"
!
hasProjectSelectedAndInstrumentingCompilerExistsAndOOMPackageLoadedHolder
^ [ self hasProjectSelected and:[ self instrumentingCompilerExists and:[OOM::MetricVisualizer notNil]] ]
!
hasProjectSelectedAndInstrumentingCompilerExistsHolder
^ [ self hasProjectSelected and:[ self instrumentingCompilerExists] ]
"Created: / 10-08-2010 / 14:42:38 / cg"
!
hasProjectSelectedAndMonticelloRepositoryExistsHolder
^[self hasProjectSelected and:
[(Smalltalk at: #MCRepositoryGroup) notNil and:
[(Smalltalk at: #MCRepositoryGroup) default repositories size > 0]]]
"Created: / 14-09-2010 / 22:37:59 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Created: / 24-07-2012 / 15:25:28 / cg"
!
hasProjectSelectedAndSourceCodeManagerHolder
^ [ self hasProjectSelected and:[self hasSourceCodeManager] ]
"Created: / 4.2.2000 / 22:09:02 / cg"
!
hasProjectSelectedAndSubversionRepositoryExistsHolder
^ [ self hasProjectSelected
and:[self selectedProjects value size = 1
and:[self hasSubversionRepositoryFor: self selectedProjects value anyOne]]]
"Created: / 31-03-2008 / 15:07:52 / janfrog"
"Created: / 24-07-2012 / 15:24:13 / cg"
!
hasProjectSelectedHolder
^ [ self hasProjectSelected ]
"Created: / 4.2.2000 / 22:09:02 / cg"
!
hasProtocolSelected
^ ((self selectedClasses value ? #()) anySatisfy:[:cls | cls supportsMethodCategories]) and:[
self selectedProtocols value size > 0]
"Created: / 04-02-2000 / 22:07:55 / cg"
"Modified: / 08-08-2013 / 00:16:58 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
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"
!
hasPseudoProjectChangedSelected
^ self selectedProjects value includes:(PackageId noProjectID)
!
hasPseudoProjectChangedSelectedHolder
^ [ self hasPseudoProjectChangedSelected ]
!
hasRBLintRuleClassSelected
RBLintRule isNil ifTrue:[
^ false.
].
^ self hasAnyClassSelectedForWhich:[:cls |
cls theNonMetaclass isSubclassOf:RBLintRule.
].
!
hasRealExtensionMethodSelected
^ self hasAnyMethodSelectedForWhich:[:aMethod |
|mPackage|
mPackage := aMethod package.
aMethod containingClass notNil
and:[mPackage ~= aMethod containingClass package
and:[mPackage ~= PackageId noProjectID]]
]
"Modified: / 28-02-2012 / 16:24:22 / cg"
!
hasRealExtensionMethodSelectedHolder
^ BlockValue
with:[:m | m and:[self hasRealExtensionMethodSelected]]
argument:(self hasMethodSelectedHolder)
"Modified: / 08-03-2007 / 23:00:45 / cg"
!
hasRealProtocolSelected
"true, if at least one real method protocol (i.e. not *all*) item is selected"
|selectedProtocols|
selectedProtocols := self selectedProtocols value.
^ selectedProtocols size > 0
and:[selectedProtocols contains:[:p | p ~= BrowserList nameListEntryForALL]]
!
hasRealProtocolSelectedHolder
^ [ self hasRealProtocolSelected ]
"Created: / 4.2.2000 / 22:09:02 / cg"
!
hasRedoableOperations
|manager|
manager := RefactoryChangeManager instance.
manager isNil ifTrue:[^ false].
^ manager hasRedoableOperations
!
hasRenamableProjectSelected
^ self selectedProjects value contains:[:p |
(p ~= PackageId noProjectID)
and:[ (BrowserList isPseudoProject:p) not ]]
!
hasRenamableProjectSelectedHolder
^ [ self hasRenamableProjectSelected ]
"Created: / 4.2.2000 / 22:09:02 / cg"
!
hasSCMSupportFor:aManagerClassName
"is there support for the perforce source code manager?"
|manager|
"/ use Smalltalk-at to trick the dependency/prerequisite generator
manager := Smalltalk at:aManagerClassName.
^ manager notNil
and:[ manager isLoaded
and:[ manager shownInBrowserMenus ]]
"Created: / 15-01-2012 / 14:45:11 / cg"
!
hasSelectedClassWithSuperclassHolder
^ [ self theSingleSelectedClass notNil
and:[self theSingleSelectedClass superclass notNil ]]
!
hasSelectionInCodeView
"/ ^ self codeView selectionAsString size > 0
^ self codeView hasSelection
!
hasSelectionInCodeViewAndCanUseRefactoringSupportHolder
^ [ self canUseRefactoringSupport
and:[self hasSelectionInCodeView]
]
!
hasSelectionInCodeViewHolder
^ [ self hasSelectionInCodeView ]
!
hasSelectorSelectedInCodeView
self hasSelectionInCodeView ifFalse:[^ false].
self canUseRefactoringSupport ifFalse:[^ false].
self selectedSelectorInCodeViewOrNil isNil ifTrue:[^ false].
^ true.
!
hasSharedPoolSelectedHolder
^ builder booleanValueAspectFor:#hasSharedPoolSelectedHolder.
"Modified: / 29-05-2012 / 10:20:15 / cg"
!
hasSharedPoolSelectedHolder_and_isNotEmbeddedBrowserHolder
^ [ self hasSharedPoolSelectedHolder value and:[self isEmbeddedBrowser not]]
!
hasSingleCategorySelected
^ self selectedCategoriesValue size == 1
"Created: / 4.2.2000 / 22:05:40 / cg"
!
hasSingleCategorySelectedHolder
^ [ self hasSingleCategorySelected ]
"Created: / 4.2.2000 / 22:05:52 / cg"
!
hasSingleClassAndClassVariableSelected
^ self hasSingleClassSelected
and:[self hasClassVariableSelectedInCodeViewOrVariableList]
!
hasSingleClassAndClassVariableSelectedAndCanUseRefactoringSupportHolder
^ [ self canUseRefactoringSupport
and:[self hasSingleClassAndClassVariableSelected] ]
"Created: / 4.2.2000 / 22:02:53 / cg"
!
hasSingleClassAndSingleClassVariableSelected
^ self hasSingleClassSelected
and:[self hasSingleClassVariableSelectedInCodeViewOrVariableList]
!
hasSingleClassAndSingleVariableSelected
^ self hasSingleClassSelected
and:[self hasSingleVariableSelectedInCodeViewOrVariableList]
!
hasSingleClassAndSingleVariableSelectedAndCanUseRefactoringSupportHolder
^ [ self canUseRefactoringSupport
and:[self hasSingleClassAndSingleVariableSelected] ]
"Created: / 4.2.2000 / 22:02:53 / cg"
!
hasSingleClassAndSingleVariableSelectedHolder
^ [ self hasSingleClassAndSingleVariableSelected ]
"Created: / 4.2.2000 / 22:02:53 / cg"
!
hasSingleClassAndVariableSelected
^ self hasSingleClassSelected
and:[self hasVariableSelectedInCodeViewOrVariableList]
!
hasSingleClassAndVariableSelectedAndCanUseRefactoringSupportHolder
^ [ self canUseRefactoringSupport
and:[self hasSingleClassSelected
and:[self hasVariableSelectedInCodeViewOrVariableList]] ]
"Created: / 4.2.2000 / 22:02:53 / cg"
!
hasSingleClassAndVariableSelectedHolder
^ [ self hasSingleClassAndVariableSelected ]
"Created: / 4.2.2000 / 22:02:53 / cg"
!
hasSingleClassOrMethodSelected
^ self hasSingleClassSelected or:[self hasSingleMethodSelected]
!
hasSingleClassOrMethodSelectedHolder
^ [ self hasSingleClassOrMethodSelected ]
"Created: / 4.2.2000 / 22:03:08 / cg"
!
hasSingleClassSelected
^ self selectedClassesValue size == 1
"Created: / 04-02-2000 / 22:03:24 / cg"
"Modified: / 28-02-2012 / 16:59:22 / cg"
!
hasSingleClassSelectedAndCanUseRefactoringSupportHolder
^ [ self canUseRefactoringSupport
and:[self hasSingleClassSelected] ]
"Created: / 4.2.2000 / 22:03:08 / cg"
!
hasSingleClassSelectedAndSourceCodeManagerHolder
^ [ self hasSingleClassSelected and:[self hasSourceCodeManager] ]
!
hasSingleClassSelectedHolder
^ [ self hasSingleClassSelected ]
"Created: / 4.2.2000 / 22:03:08 / cg"
!
hasSingleLoadedClassSelected
|cls|
^ (cls := self theSingleSelectedClass) notNil
and:[cls isLoaded]
"Created: / 17.2.2000 / 23:27:45 / cg"
!
hasSingleLoadedClassSelectedAndMultipleVariablesSelected
^ self hasSingleLoadedClassSelected
and:[ self hasMultipleVariablesSelected ]
!
hasSingleLoadedClassSelectedAndMultipleVariablesSelectedHolder
^ [ self hasSingleLoadedClassSelectedAndMultipleVariablesSelected ]
"Created: / 17.2.2000 / 23:28:03 / cg"
!
hasSingleLoadedClassSelectedHolder
^ [ self hasSingleLoadedClassSelected ]
"Created: / 17.2.2000 / 23:28:03 / cg"
!
hasSingleLoadedClassWithCommentSelected
|cls|
^ (cls := self theSingleSelectedClass) notNil
and:[cls isLoaded
and:[cls comment notEmptyOrNil]]
!
hasSingleLoadedClassWithCommentSelectedHolder
^ [ self hasSingleLoadedClassWithCommentSelected ]
!
hasSingleLoadedNonJavascriptClassSelected
|cls|
^ (cls := self theSingleSelectedClass) notNil
and:[cls isLoaded
and:[cls theMetaclass isJavaScriptMetaclass not ]]
"Created: / 17.2.2000 / 23:27:45 / cg"
!
hasSingleLoadedNonJavascriptClassSelectedHolder
^ [ self hasSingleLoadedNonJavascriptClassSelected ]
"Created: / 17.2.2000 / 23:28:03 / cg"
!
hasSingleLoadedNonMetaClassSelected
|cls|
^ (cls := self theSingleSelectedClass) notNil
and:[cls isLoaded
and:[cls isMeta not]]
!
hasSingleLoadedNonMetaClassSelectedHolder
^ [ self hasSingleLoadedNonMetaClassSelected ]
"Created: / 17.2.2000 / 23:28:03 / cg"
!
hasSingleMethodSelected
^ self selectedMethodsValue size == 1
"Created: / 04-02-2000 / 22:10:05 / cg"
"Modified: / 28-02-2012 / 16:25:03 / cg"
!
hasSingleMethodSelectedAndCanUseRefactoringSupportHolder
^ [ self canUseRefactoringSupport
and:[self hasSingleMethodSelected]
]
"Created: / 4.2.2000 / 22:11:34 / cg"
!
hasSingleMethodSelectedAndCodeModifiedHolder
^ [
self codeReallyModified
and:[self hasSingleMethodSelected]
]
"Created: / 4.2.2000 / 22:11:34 / cg"
!
hasSingleMethodSelectedAndSelectionInCodeView
^ self hasSelectionInCodeView
and:[self hasSingleMethodSelected]
!
hasSingleMethodSelectedAndSelectionInCodeViewAndCanUseRefactoringSupportHolder
^ [ self canUseRefactoringSupport
and:[self hasSingleMethodSelectedAndSelectionInCodeView ]
]
!
hasSingleMethodSelectedAndSelectionInCodeViewAndSingleSelectedMethodHasParameter
^ self hasSingleMethodSelectedAndSelectionInCodeView
and:[self theSingleSelectedMethod numArgs > 0]
!
hasSingleMethodSelectedAndSelectionInCodeViewAndSingleSelectedMethodHasParameterAndCanUseRefactoringSupportHolder
^ [ self canUseRefactoringSupport
and:[self hasSingleMethodSelectedAndSelectionInCodeViewAndSingleSelectedMethodHasParameter]
]
!
hasSingleMethodSelectedAndSelectionInCodeViewAndSingleSelectedMethodHasParameterHolder
^ [ self hasSingleMethodSelectedAndSelectionInCodeViewAndSingleSelectedMethodHasParameter ]
!
hasSingleMethodSelectedAndSelectionInCodeViewHolder
^ [ self hasSingleMethodSelectedAndSelectionInCodeView ]
!
hasSingleMethodSelectedAndSingleSelectedMethodHasParameter
^ self hasSingleMethodSelected
and:[self theSingleSelectedMethod numArgs > 0]
!
hasSingleMethodSelectedAndSingleSelectedMethodHasParameterAndCanUseRefactoringSupportHolder
^ [ self canUseRefactoringSupport
and:[self hasSingleMethodSelectedAndSingleSelectedMethodHasParameter]
]
!
hasSingleMethodSelectedHolder
^ [ self hasSingleMethodSelected ]
"Created: / 4.2.2000 / 22:11:34 / cg"
!
hasSingleMethodWithBytecodeSelected
|mthd|
mthd := self theSingleSelectedMethod.
^ mthd notNil and:[mthd byteCode notNil]
!
hasSingleMethodWithBytecodeSelectedHolder
^ [ self hasSingleMethodWithBytecodeSelected ]
"Created: / 4.2.2000 / 22:11:34 / cg"
!
hasSingleNameSpaceSelected
^ self selectedNamespaces value size == 1
"Created: / 4.2.2000 / 22:07:55 / cg"
!
hasSingleNonPrivateClassSelected
|selected|
^ (selected := self theSingleSelectedClass) notNil
and:[selected isPrivate not]
!
hasSingleNonPrivateClassSelectedAndSourceCodeManagerHolder
^ [ self hasSingleNonPrivateClassSelected and:[self hasSourceCodeManager] ]
"Created: / 4.2.2000 / 22:03:08 / cg"
!
hasSingleNonPrivateClassSelectedHolder
^ [ self hasSingleNonPrivateClassSelected ]
"Created: / 4.2.2000 / 22:03:08 / cg"
!
hasSinglePrivateClassSelected
|selected|
^ (selected := self theSingleSelectedClass) notNil
and:[selected isPrivate]
!
hasSinglePrivateClassSelectedHolder
^ [ self hasSinglePrivateClassSelected ]
!
hasSingleProjectOrProjectDefinitionSelected
^ self hasSingleProjectSelected
or:[ self hasProjectDefinitionSelected ]
!
hasSingleProjectSelected
^ self selectedProjects value size == 1
!
hasSingleProjectSelectedAndCanFileOutVSEHolder
^ [ self hasSingleProjectSelected and:[self canFileOutVSE] ]
!
hasSingleProjectSelectedHolder
^ [ self hasSingleProjectSelected ]
"Created: / 4.2.2000 / 22:09:02 / cg"
!
hasSingleProtocolSelected
"true if exactly one method protocol item is selected (could be *all*)"
^ self selectedProtocols value size == 1
"Created: / 4.2.2000 / 22:07:55 / cg"
!
hasSingleProtocolSelectedHolder
"holding true, if exactly one method protocol item is selected (could be *all*)"
^ [ self hasSingleProtocolSelected ]
"Created: / 4.2.2000 / 22:08:22 / cg"
!
hasSingleRealProjectSelectedHolder
^ [ self hasSingleProjectSelected
and:[ self theSingleSelectedProject notNil
and:[ self theSingleSelectedProject string asPackageId isModuleId not
or:[ (ProjectDefinition definitionClassForPackage: self theSingleSelectedProject string) notNil ]]]]
"Modified: / 26-11-2021 / 11:46:23 / Jan Vrany <jan.vrany@labware.com>"
!
hasSingleRealProtocolSelected
"true, if one real method protocol (i.e. not *all*) item is selected"
|p|
p := self theSingleSelectedProtocol.
^ p notNil and:[p ~= BrowserList nameListEntryForALL]
!
hasSingleRealProtocolSelectedHolder
"holding true, if one real method protocol (i.e. not *all*) item is selected"
^ [ self hasSingleRealProtocolSelected ]
"Created: / 4.2.2000 / 22:08:22 / cg"
!
hasSingleResourceMethodSelected
|currentMethod methodsResources|
currentMethod := self theSingleSelectedMethod.
^ currentMethod notNil
and:[(methodsResources := currentMethod resources) notNil
and:[(self class resourceEditorClassForResources:methodsResources) notNil]]
!
hasSingleResourceMethodSelectedHolder
^ builder
valueAspectFor:#hasSingleResourceMethodSelectedHolder
computeInitialValueWith:[ self hasSingleResourceMethodSelected ]
!
hasSingleVariableSelected
^ self selectedVariables value size == 1
!
hasSingleVariableSelectedHolder
^ [ self hasSingleVariableSelected ]
"Created: / 4.2.2000 / 22:08:22 / cg"
!
hasSingleVariableSelectedInCodeViewOrVariableList
self hasSingleVariableSelected ifTrue:[^ true].
(self hasClassVariableSelectedInCodeView) ifTrue:[^ true].
(self hasInstanceVariableSelectedInCodeView) ifTrue:[^ true].
^ false
!
hasSingleVariableSelectedInCodeViewOrVariableListHolder
^ [ self hasSingleVariableSelectedInCodeViewOrVariableList ]
!
hasSingleWordSelectedInCodeView
|codeView selectionInCode|
codeView := self codeView.
codeView isNil ifTrue:[^ false].
"/ first, see if more than a line is selected ...
codeView selectionStartLine == codeView selectionEndLine ifFalse:[^ false ].
selectionInCode := self selectionInCodeView.
selectionInCode isEmptyOrNil ifTrue:[ ^ false ].
^ selectionInCode asCollectionOfWords size == 1.
!
hasSourceCodeManager
^ SourceCodeManager notNil
"Created: / 4.2.2000 / 22:11:34 / cg"
!
hasSourceCodeManagerHolder
^ [ self hasSourceCodeManager ]
"Created: / 4.2.2000 / 22:11:34 / cg"
!
hasStandaloneStartupClassSelected
^ self hasClassesSelectedWhichAreSubclassOf:StandaloneStartup
"Created: / 19-08-2011 / 02:26:37 / cg"
!
hasStartableApplicationSelected
|cls|
^ (cls := self theSingleSelectedClass) notNil
and:[ (cls theNonMetaclass isVisualStartable)
or:[ cls isStartableWithMain
or:[ cls isStartableWithStart ]]]
!
hasStartableApplicationSelectedHolder
|holder|
(holder := builder bindingAt:#hasStartableApplicationSelectedHolder) isNil ifTrue:[
holder := ValueHolder with:false.
builder aspectAt:#hasStartableApplicationSelectedHolder put: holder.
].
^ holder
!
hasSubversionRepositoryFor: package
"is there a subversion source repository for package?"
^ self hasSubversionSupport
"/ use Smalltalk-at to trick the dependency/prerequisite generator
and:[(Smalltalk at:#'SVN::RepositoryManager') hasRepositoryForPackage: package]
"Created: / 31-03-2008 / 15:08:13 / janfrog"
"Modified: / 22-08-2009 / 10:49:33 / Jan Vrany <vranyj1@fel.cvut.cz>"
"Modified: / 15-01-2012 / 13:18:10 / cg"
!
hasSubversionSupport
^ ConfigurableFeatures includesFeature: #SubversionSupportEnabled
"Modified: / 07-09-2011 / 10:45:57 / cg"
"Modified: / 19-01-2012 / 10:45:50 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
hasTemporaryVariableSelectedInCodeView
"/ |node|
self codeAspect value ~~ SyntaxHighlighter codeAspectMethod ifTrue:[ ^ false].
(self hasSingleWordSelectedInCodeView) ifFalse:[ ^ false].
"/ the following is too slow
"/ node := self findNode.
"/ (node isNil or:[node isVariable not]) ifTrue:[
"/ ^ false
"/ ].
^ true
"Modified: / 27-07-2012 / 22:18:26 / cg"
!
hasTemporaryVariableSelectedInCodeViewHolder
^ [ self hasTemporaryVariableSelectedInCodeView ]
!
hasTestCaseClassesSelected
^ self selectedClassesValue contains:[:cls | cls theNonMetaclass isTestCaseLike and:[cls theNonMetaclass isAbstract not]].
!
hasTestCaseClassesSelectedHolder
^ BlockValue
with:[:classes :methods |
self hasTestCaseClassesSelected
or:[ self hasTestCaseMethodsSelected ].
]
argument:self selectedClasses
argument:self selectedMethods
"/ ^ [ self hasTestCaseClassesSelected ]
!
hasTestCaseMethodsSelected
^ self selectedMethodsValue contains:[:mthd | mthd mclass isTestCaseLike and:[mthd mclass isAbstract not]].
!
hasTonel
"Return true, if Tonel reader/writer is present"
^ConfigurableFeatures includesFeature: #Tonel
"Created: / 09-07-2020 / 23:54:29 / Jan Vrany <jan.vrany@labware.com>"
!
hasUnassignedExtensionMethodSelected
^ self hasAnyMethodSelectedForWhich:[:aMethod |
|mPackage mClass|
mPackage := aMethod package.
mClass := aMethod containingClass.
mClass isNil or:[
mPackage ~= aMethod containingClass package
and:[mPackage = PackageId noProjectID]]
]
"Modified: / 28-02-2012 / 16:24:32 / cg"
!
hasUnassignedExtensionMethodSelectedHolder
^ BlockValue
with:[:m | m and:[self hasUnassignedExtensionMethodSelected]]
argument:(self hasMethodSelectedHolder)
"Modified: / 08-03-2007 / 23:00:47 / cg"
!
hasUndefinedUppercaseIdentifierSelectedInCodeView
|codeView s selClass|
^ (codeView := self codeView) hasSelection
and:[ (s := codeView selectionAsString) isValidSmalltalkIdentifier
and:[ s isUppercaseFirst
and:[ (environment includesKey:s) not
and:[ (selClass := self theSingleSelectedClass) notNil
and:[ (selClass theNonMetaclass classVarNames includes:s) not ]]]]]
"Modified: / 23-07-2011 / 12:29:26 / cg"
!
hasUndefinedUppercaseIdentifierSelectedInCodeViewHolder
^ [ self hasUndefinedUppercaseIdentifierSelectedInCodeView ]
!
hasUndoableOperations
|manager|
RefactoryChangeManager isNil ifTrue:[^ false]. "/ returns false if the class is not present
manager := RefactoryChangeManager instance.
manager isNil ifTrue:[^ false].
^ manager hasUndoableOperations
!
hasUnloadedProjectSelected
^ self hasProjectSelected
and:[ self selectedProjects value
contains:[:p |
|defCls|
defCls := p asString string asPackageId projectDefinitionClass.
defCls isNil or:[defCls isFullyLoaded not]]]
!
hasUnloadedProjectSelectedHolder
^ [ self hasUnloadedProjectSelected ]
!
hasUpdateMethodSelected
^ self hasMethodSelected
and:[self hasOnlyMethodsSelectedForWhich:[:eachMethod | #(
#'update:'
#'update:with:'
#'update:with:from:'
) includes:eachMethod selector ]]
"Modified: / 28-02-2012 / 16:27:19 / cg"
!
hasUpdateMethodSelectedHolder
^ [ self hasUpdateMethodSelected ]
"Created: / 4.2.2000 / 22:23:39 / cg"
!
hasUppercaseIdentifierSelectedInCodeView
|s|
^ (self codeView hasSelection
and:[ (s := self codeView selectionAsString) isValidSmalltalkIdentifier
and:[ s isUppercaseFirst ]])
!
hasUppercaseIdentifierSelectedInCodeViewHolder
^ [ self hasUppercaseIdentifierSelectedInCodeView ]
!
hasVariableSelected
^ self selectedVariables value size > 0
!
hasVariableSelectedInCodeViewOrVariableList
self hasVariableSelected ifTrue:[^ true].
(self hasClassVariableSelectedInCodeView) ifTrue:[^ true].
(self hasInstanceVariableSelectedInCodeView) ifTrue:[^ true].
^ false
!
hasVariableSelectedInCodeViewOrVariableListAndCanUseRefactoringSupportHolder
^ [ self canUseRefactoringSupport
and:[self hasVariableSelectedInCodeViewOrVariableList] ]
!
hasVariableSelectedInCodeViewOrVariableListHolder
^ [ self hasVariableSelectedInCodeViewOrVariableList ]
!
hasVariablesFromSingleClassSelectedAndCanUseRefactoringSupportHolder
^ [ self canUseRefactoringSupport
and:[self hasSingleClassSelected
and:[self hasVariableSelected
and:[
|selClass classes|
selClass := self theSingleSelectedClass theNonMetaclass.
self showingClassVarsInVariableList ifFalse:[
classes := self selectedVariables value collect:[:nm | selClass whichClassDefinesInstVar:nm].
] ifTrue:[
classes := self selectedVariables value collect:[:nm | selClass whichClassDefinesClassVar:nm].
].
classes asSet size == 1
]]]
]
!
hasVisitedClasses
^ self class classHistory notEmpty
!
hasVisitedClassesHolder
^ [ self hasVisitedClasses ]
!
hasWebApplicationClassSelected
^ self hasClassesSelectedWhichAreSubclassOf:HTTPService
"Modified: / 19-08-2011 / 02:28:22 / cg"
!
instrumentingCompilerExists
"true, if instrumenting is possible
(now, always true, because InstrumentingCompiler is now in the libcomp package)"
^ InstrumentingCompiler notNil
"Modified (comment): / 30-09-2011 / 12:41:20 / cg"
!
isAnyOtherMetaclassPresent
^ self isJavaScriptMetaclassPresent
or:[ self isPlsqlMetaclassPresent
or:[ self isHaskellModulePresent ]]
!
isHaskellModulePresent
^ HaskellModule notNil and:[HaskellParser notNil]
!
isJavaScriptMetaclassPresent
^ JavaScriptMetaclass notNil and:[JavaScriptParser notNil]
!
isLintResultBrowserHolder
^ [navigationState notNil and:[navigationState isLintResultBrowser]]
"Modified: / 02-06-2016 / 20:58:31 / cg"
!
isLintResultBrowserHolder_and_isNotEmbeddedBrowserHolder
^ [navigationState isLintResultBrowser and:[self isEmbeddedBrowser not ]]
!
isLispEnvironmentPresent
^ LispEnvironment notNil
!
isLispMetaclassPresent
^ LispMetaclass notNil and:[LispMetaclass notNil]
"Created: / 13-05-2012 / 12:52:16 / cg"
!
isMethodListBrowser
^ navigationState notNil and:[navigationState isMethodListBrowser]
!
isMethodListBrowserHolder
^ [ navigationState isMethodListBrowser ]
"Created: / 4.2.2000 / 22:23:39 / cg"
!
isMethodListBrowserOrHasMultipleClassesSelectedHolder
^ [navigationState isMethodListBrowser
or:[self selectedClassesValue size > 1] ]
"Created: / 04-02-2000 / 22:23:39 / cg"
!
isNotEmbeddedBrowserHolder
^ [self isEmbeddedBrowser not]
!
isPlsqlMetaclassPresent
^ PLSQLObjectTypeMetaclass notNil
!
isRubyMetaclassPresent
|rubyMetaclass rubyParser|
rubyMetaclass := Smalltalk classNamed:#'Ruby::Metaclass'.
rubyParser := Smalltalk classNamed:#'Ruby::Parser'.
^ (rubyMetaclass notNil
and:[rubyMetaclass isLoaded
and:[rubyParser notNil
and:[rubyParser isLoaded]]])
"Created: / 11-08-2009 / 16:06:11 / Jan Vrany <vranyj1@fel.cvut.cz>"
!
javaScriptMetaclassPresent
^ JavaScriptMetaclass notNil and:[JavaScriptParser notNil]
!
methodHasPreviousVersion
^ self methodsPreviousVersionCode notNil
!
methodHasPreviousVersionHolder
^ [ self methodHasPreviousVersion ]
!
methodIsShadowed
^ self methodsShadowedMethod notNil
!
methodIsShadowedHolder
^ [ self methodIsShadowed ]
!
methodIsSubclassResponsibility
self selectedMethodsDo:[:eachMethod |
(eachMethod sendsSelector:#subclassResponsibility) ifTrue:[^ true].
].
^ false.
!
methodIsTestAndNotImplementedInSuperclass
self selectedMethodsDo:[:eachMethod |
(eachMethod mclass notNil and:[eachMethod selector startsWith:'is']) ifFalse:[^ false].
].
^ self methodNotImplementedInSuperclass
"Modified: / 16-10-2013 / 00:10:14 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
methodNotImplementedInClass
|selector|
selector := self selectionInCodeView.
selector isEmptyOrNil ifTrue:[^ false].
selector := selector asSymbol.
self selectedClassesDo:[:eachClass |
(eachClass includesSelector:selector) ifTrue:[^ false].
].
^ true.
!
methodNotImplementedInSuperclass
self selectedMethodsDo:[:eachMethod |
|selector category mclass|
selector := eachMethod selector.
category := eachMethod category.
mclass := eachMethod mclass.
mclass notNil ifTrue:[
mclass superclass notNil ifTrue:[
(mclass superclass includesSelector:selector) ifFalse:[^ true].
]
].
].
^ false.
!
methodRedefinesSuperclassVersion
|m cls selector superClass|
m := self theSingleSelectedMethod.
^ m notNil
and:[(cls := m mclass) notNil
and:[(selector := m selector) notNil
and:[(superClass := cls superclass) notNil
and:[(superClass lookupMethodFor:selector) notNil]]]]
"Modified: / 23.8.2001 / 12:31:12 / cg"
!
methodRedefinesSuperclassVersionHolder
^ [ self methodRedefinesSuperclassVersion ]
!
methodRefersToSelfOrInstanceVariable:aMethod
|parser|
parser := Parser parseMethod:aMethod source in:aMethod mclass ignoreErrors:true ignoreWarnings:true.
^ parser usedInstVars notEmptyOrNil
or:[ parser messagesSentToSelf notEmptyOrNil
or:[ parser messagesSentToSuper notEmptyOrNil]]
!
selectedClassNameInCodeViewOrNil
|cls selection|
(self hasSingleWordSelectedInCodeView) ifFalse:[^ nil].
selection := self selectionInCodeView.
selection := selection withoutSeparators.
cls := environment classNamed:selection.
^ cls
!
shiftNotPressedHolder
^ [ self window sensor shiftDown not ]
!
shiftPressedHolder
^ [ self window sensor shiftDown ]
!
singleSelectedMethodIsSubclassResponsibility
|m|
m := self theSingleSelectedMethod.
m isNil ifTrue:[^ false].
^ (m sendsSelector:#subclassResponsibility)
!
smallTeamAvailable
^ SmallTeam notNil
"Created: / 13-11-2006 / 13:08:32 / cg"
!
smallTeamConnected
^ SmallTeam notNil
"/ and:[ SmallTeam serverRunning ]
"Created: / 06-07-2011 / 18:51:25 / cg"
!
useSearchBarInBrowser
^ UserPreferences current useSearchBarInBrowser or:[self codeView searchBarActionBlock notNil]
! !
!NewSystemBrowser methodsFor:'binding access'!
menuFor:key
| menu |
menu := super menuFor: key.
thisContext isRecursive ifFalse:[
self menuExtendersFor: key do:[:each |
self perform: each with: menu
].
].
^ menu
"Modified: / 18-06-1998 / 20:33:56 / cg"
"Modified (comment): / 06-02-2018 / 20:35:40 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!NewSystemBrowser methodsFor:'change & update'!
categorySelectionChanged
"category selection changed by user interaction"
self enqueueDelayedUpdateBufferLabel.
self updateSpecialCodeEditorVisibility.
self normalLabel. "/ update my window label
self updateLintEnablement.
"Created: / 24-02-2000 / 22:01:46 / cg"
"Modified: / 02-04-2014 / 12:33:47 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
classReselected
self selectProtocols:nil.
"/ prevent the methodCategory from autoselecting
self clearAutoSelectOfLastSelectedProtocol.
!
classSelectionChanged
"class selection changed by user interaction"
|selectedClassesHolder selectedClasses theClassOrNil|
selectedClassesHolder := self selectedClasses.
selectedClasses := selectedClassesHolder value.
"/ self classWizardVisibleHolder value:(selectedClasses size == 0).
(navigationState isClassDocumentationBrowser) ifTrue:[
"/ kludge - docBrowser can only show one single class
selectedClasses size > 1 ifTrue:[
selectedClassesHolder value:(Array with:selectedClasses first).
self enqueueDelayedUpdateBufferLabel.
^ self.
]
].
"/ selectedClasses size == 1 ifTrue:[
"/ self selectedProtocols value:nil.
"/ ].
navigationState isVersionDiffBrowser ifFalse:[
theClassOrNil := self theSingleSelectedClass.
theClassOrNil notNil ifTrue:[
self class addToHistory:theClassOrNil 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).
self updateBufferLabel.
!
delayedClassSelectionChange
self isLintResultBrowserHolder value ifTrue:[
"/ clear those, so that the class definition is shown
self selectProtocols:nil.
self selectMethods:nil.
].
self normalLabel.
self enqueueDelayedUpdateCode.
self setDoitActionForClass.
self updateCategorySelectionForChangedClassSelection.
self updateMetaToggleForClassSelection.
self updateInfoForChangedClassSelection.
self updateTestRunnerVisibility.
self updateExecuteMethodVisibility.
self updateInitSharedPoolVisibility.
self updateLaunchApplicationVisibility.
self updatePackageApplicationVisibility.
self updateTextEditorBehavior.
"/ self delayedUpdateCode.
self updateLintEnablement.
"Modified: / 01-06-2012 / 23:01:52 / cg"
"Modified: / 02-04-2014 / 12:29:53 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
delayedExplainSelection
|codeView|
self synchronousUpdate == true ifFalse:[
self windowGroup sensor hasUserEvents ifTrue:[
"/ re-enqueue at the end to delay until all user input has been handled
"/ self
"/ enqueueMessage:#delayedExplainSelection
"/ for:self
"/ arguments:#().
^ self
].
].
self clearInfo.
codeView := self codeView.
self
explainInCode:(codeView contentsAsString string)
short:true
withTimeout:false
"Modified: / 12-11-2016 / 03:58:36 / cg"
!
delayedLabelUpdate
self normalLabel
!
delayedMethodTrapChanged
self hasMethodWithoutBreakPointSelectedHolder value:(self hasMethodWithoutBreakPointSelected).
self hasMethodWithBreakPointSelectedHolder value:(self hasMethodWithBreakPointSelected).
!
delayedMethodTrapChanged:methodTrapChangeInfo
|mthd codeView|
self hasMethodWithoutBreakPointSelectedHolder value:(self hasMethodWithoutBreakPointSelected).
self hasMethodWithBreakPointSelectedHolder value:(self hasMethodWithBreakPointSelected).
(codeView := self codeView) isCodeView2 ifTrue:[
mthd := self theSingleSelectedMethod.
mthd == codeView method ifTrue:[
mthd notNil ifTrue:[
"/ would not send an update notification
codeView updateGutter
]
] ifFalse:[
codeView method notNil ifTrue:[
"/ will send update notification to services
codeView method:mthd.
].
]
].
"Modified: / 22-07-2013 / 13:35:47 / cg"
!
delayedMethodsSelectionChanged
|codeAspect process|
self hasMethodSelectedHolder value:(self hasMethodSelected).
self hasMethodWithoutBreakPointSelectedHolder value:(self hasMethodWithoutBreakPointSelected).
self hasMethodWithBreakPointSelectedHolder value:(self hasMethodWithBreakPointSelected).
self hasInstrumentedMethodSelectedHolder value:(self hasInstrumentedMethodSelected).
"/ if showing history or log,
"/ don't update codeView, as long as no protocol is selected
((codeAspect := self codeAspect) == #repositoryLog
or:[codeAspect == #repositoryHistory]) ifTrue:[
self selectedMethodsValue size == 0 ifTrue:[
^ self
]
].
self enqueueDelayedUpdateCodeWithAutoSearch.
self hasSingleResourceMethodSelectedHolder value:(self hasSingleResourceMethodSelected).
self updateExecuteMethodVisibility.
self setDoitActionForClass.
"/ self showMethodInfo.
process := methodInfoProcess.
process notNil ifTrue:[
process terminate.
process := nil.
].
methodInfoProcess := [ self asyncShowMethodInfo. methodInfoProcess := nil. ] fork.
self updateLintEnablement.
"Modified: / 28-02-2012 / 16:15:54 / cg"
"Modified: / 02-04-2014 / 12:29:36 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
delayedProtocolSelectionChanged
(ShowMethodTemplateWhenProtocolIsSelected == true
or:[ self codeAspect ~~ SyntaxHighlighter codeAspectClassDefinition
or:[ navigationState methodList size == 0 ]])
ifTrue:[
self enqueueDelayedUpdateCode
].
self updateLintEnablement.
"Modified: / 27-07-2012 / 22:24:56 / cg"
"Modified: / 02-04-2014 / 12:30:09 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
delayedUpdateCode
self delayedUpdateCodeWithAutoSearch:false
!
delayedUpdateCodeWithAutoSearch:withAutoSearch
self delayedUpdateCodeWithAutoSearch:withAutoSearch checkModified:true
"Modified: / 29-08-2006 / 13:59:22 / cg"
!
delayedUpdateCodeWithAutoSearch:withAutoSearch checkModified:checkModified
|methods mthd selectedClass protocol package projectDef
codeView code filteredVariables
searchAction searchPattern doShowMethodTemplate|
navigationState isNil ifTrue:[^ self].
self enqueueDelayedUpdateBufferLabel.
navigationState isClassDocumentationBrowser ifTrue:[
"/ show classes documentation
self showClassDocumentation.
^ self.
].
navigationState isVersionDiffBrowser ifTrue:[
"/ show version differences
self showVersionDiff.
^ self.
].
codeView := self codeView.
checkModified ifTrue:[
((codeView notNil and:[codeView modified])
or:[navigationState modified])
ifTrue:[
"/ recheck against the code (could have been unedited)
(self reallyModified:navigationState) ifTrue:[
"/ do not overwrite the user's modifications;
"/ instead, flash and show the code all-red
"/ (to tell user, that she is possibly editing obsolete 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 selectedMethodsValue.
methods size == 1 ifTrue:[
mthd := methods first.
].
mthd notNil ifTrue:[
"/ show methods source - set accept action to compile that single method
self setAcceptActionForMethod.
self showMethodsCode:mthd.
"/ 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 setupToSearchVariables:filteredVariables readers:true writers:true asAutoSearch:false.
"/ codeView notNil ifTrue:[codeView searchFwd]
] ifFalse:[
self autoSearchPattern:nil
].
].
] ifFalse:[
self updatePackageInfoForMethod:nil.
protocol := self theSingleSelectedProtocol.
(protocol isNil or:[protocol = BrowserList nameListEntryForALL]) ifTrue:[
doShowMethodTemplate := false
] ifFalse:[
navigationState showMethodTemplate ifTrue:[
doShowMethodTemplate := self showMethodTemplate value
"/ and:[ShowMethodTemplateWhenProtocolIsSelected == true
"/ or:[ navigationState methodList size == 0 ]].
]
].
doShowMethodTemplate ifTrue:[
methods size > 1 ifTrue:[
code := nil.
] ifFalse:[
code := self methodTemplate.
].
self setAcceptActionForMethod.
self codeAspect:SyntaxHighlighter codeAspectMethod.
self showCode:code.
] ifFalse:[
self hasProtocolSelected ifTrue:[
self showCode:''.
self setAcceptActionForMethod.
self codeAspect:SyntaxHighlighter codeAspectMethod.
] ifFalse:[
selectedClass := self theSingleSelectedClass.
selectedClass notNil ifTrue:[
self showClassAspect:(self codeAspect) forClass:selectedClass.
] ifFalse:[
(package := self theSingleSelectedProject) notNil ifTrue:[
projectDef := package string asPackageId projectDefinitionClass.
projectDef notNil ifTrue:[
code := projectDef commentOrDocumentationString.
].
self showCode:code ? ''.
self codeAspect:nil.
"/ self setAcceptActionForProjectComment.
] ifFalse:[
"/ really nothing selected
self showCode:code ? ''.
self setAcceptActionForClass.
]
]
]
]
].
self updateSpecialCodeEditorVisibility.
codeView notNil ifTrue:[
"/ perform an auto-search, unless the user did some other search
"/ in the meanwhile (i.e. the codeViews searchPattern is different from the autoSearchPattern)
withAutoSearch ifTrue:[
codeView numberOfLines > 0 ifTrue:[
searchAction := navigationState autoSearchAction.
searchAction notNil ifTrue:[
true "codeView searchAction isNil" ifTrue:[
true "codeView searchPattern isNil" ifTrue:[
codeView
cursorHome;
searchAction:searchAction;
searchUsingSearchAction:#forward ifAbsent:nil.
"/ The searchAction is mantained until a cut/replace or a search with a user selection is done
"/ codeView clearSearchAction.
]
"/ ] ifFalse:[
"/ codeView
"/ cursorHome;
"/ searchUsingSearchAction:#forward ifAbsent:nil
].
] ifFalse:[
searchPattern := navigationState autoSearchPattern.
searchPattern notNil ifTrue:[
"/ check if user did some other search in the meantime
searchPattern = codeView searchPattern ifTrue:[
codeView
cursorHome;
"/ cursorRight; "/ to avoid finding the selector
searchFwd:searchPattern
ignoreCase:(navigationState autoSearchIgnoreCase)
match:(navigationState autoSearchIsMatch)
ifAbsent:[codeView cursorHome].
].
].
].
].
] ifFalse:[
codeView clearSearchAction.
].
].
navigationState modified:false.
navigationState realModifiedState:false.
self updateProtocolSelectionForChangedMethodSelection.
"Created: / 29-08-2006 / 13:59:06 / cg"
"Modified: / 23-07-2014 / 12:03:06 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 18-11-2016 / 01:41:27 / cg"
!
delayedVariableSelectionChanged
|var val mclass cls codeView|
navigationState isNil ifTrue:[^ self].
self filterClassVars value:(self showingClassVarsInVariableList).
var := self theSingleSelectedVariable.
(codeView := self codeView) isCodeView2 ifTrue:[
self showingClassVarsInVariableList ifTrue:[
codeView highlightClassVariable:var.
] ifFalse:[
codeView highlightInstanceVariable:var.
].
].
var isNil ifTrue:[
navigationState autoSearchAction:nil.
^ self
].
self showingClassVarsInVariableList ifTrue:[
self selectedNonMetaclassesDo:[:eachClass |
|cls|
cls := eachClass whichClassDefinesClassVar:var.
cls notNil ifTrue:[
val := cls classVarAt:var asSymbol.
self showClassVarInfoFor:var in:cls value:val.
^ self
].
].
mclass := self classOfSelectedMethodOrSelectedClass.
mclass isNil ifTrue:[^ self].
cls := mclass theNonMetaclass whichClassDefinesClassVar:var.
cls notNil ifTrue:[
val := cls classVarAt:var asSymbol.
self showClassVarInfoFor:var in:cls value:val.
]
].
"Modified: / 12-09-2006 / 13:56:20 / cg"
!
enqueueDelayedCheckReallyModified
^ self
enqueueMessage:#delayedCheckReallyModified
for:self
arguments:#()
"Modified: / 26.2.2000 / 18:01:49 / cg"
!
enqueueDelayedClassSelectionChange
^ self
enqueueMessage:#delayedClassSelectionChange
for:self
arguments:#()
"Modified: / 26.2.2000 / 18:01:49 / cg"
!
enqueueDelayedLabelUpdate
^ self
enqueueMessage:#delayedLabelUpdate
for:self
arguments:#()
"Modified: / 26.2.2000 / 18:01:49 / cg"
!
enqueueDelayedMethodTrapChanged
^ self
enqueueMessage:#delayedMethodTrapChanged
for:self
arguments:#()
!
enqueueDelayedMethodTrapChanged:aMethod
^ self
enqueueMessage:#delayedMethodTrapChanged:
for:self
arguments:(Array with:aMethod)
!
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: / 06-09-2006 / 19:07:15 / cg"
!
enqueueDelayedUpdateCodeWithAutoSearch
"/ ^ self delayedUpdateCodeWithAutoSearch:true.
^ self
enqueueMessage:#delayedUpdateCodeWithAutoSearch:
for:self
arguments:#( true )
"Modified: / 06-09-2006 / 19:07:10 / cg"
!
enqueueDelayedUpdateCodeWithoutAutoSearch
^ self delayedUpdateCodeWithAutoSearch:false.
^ self
enqueueMessage:#delayedUpdateCodeWithAutoSearch:
for:self
arguments:#( false )
"Modified: / 06-09-2006 / 19:07:00 / cg"
!
enqueueDelayedUpdateExecuteMethodVisibility
^ self
enqueueMessage:#updateExecuteMethodVisibility
for:self
arguments:#()
"Modified: / 26.2.2000 / 18:01:49 / cg"
!
enqueueDelayedUpdateInitSharedPoolVisibility
^ self
enqueueMessage:#updateInitSharedPoolVisibility
for:self
arguments:#()
"Modified: / 26-02-2000 / 18:01:49 / cg"
"Created: / 29-05-2012 / 10:26:41 / cg"
!
enqueueDelayedUpdatePackageInfo
self enqueueMessage:#updatePackageInfo
"Created: / 14-01-2019 / 18:08:56 / Claus Gittinger"
"Modified: / 16-03-2019 / 14:12:59 / Claus Gittinger"
!
enqueueDelayedUpdateTestRunnerVisibility
^ self
enqueueMessage:#updateTestRunnerVisibility
for:self
arguments:#()
"Modified: / 26.2.2000 / 18:01:49 / cg"
!
enqueueDelayedVariableSelectionChanged
^ self
enqueueMessage:#delayedVariableSelectionChanged
for:self
arguments:#()
!
enqueueMessage:selector for:someone arguments:argList
"/ Transcript show:'enqueue '; showCR:selector.
self synchronousUpdate == true ifTrue:[
someone perform:selector withArguments:argList.
^ self
].
^ super enqueueMessage:selector for:someone arguments:argList
!
environmentChanged
"My environment has changed. Update cached environment value.
Subclasses may need to override and invalidate it's contents."
| env |
env := environmentHolder value.
environment notNil ifTrue:[ environment removeDependent: self ].
environment := env.
environment notNil ifTrue:[ environment addDependent: self ].
self updateLintEnablement.
"Created: / 24-02-2014 / 10:18:01 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 02-04-2014 / 12:30:26 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
methodsSelectionChanged
(self theSingleSelectedMethod) notNil ifTrue:[
self rememberLocationInHistory
].
self enqueueDelayedMethodsSelectionChanged.
!
methodsSelectionChanged1
self methodsSelectionChangedAt:1
!
methodsSelectionChanged2
self methodsSelectionChangedAt:2
!
methodsSelectionChanged3
self methodsSelectionChangedAt:3
!
methodsSelectionChanged4
self methodsSelectionChangedAt:4
!
methodsSelectionChangedAt:index
"in the chain-browsers, a selection in one of the 4 columns has changed"
|mySearchBlock "/ must again be the first local (see kludge below)
generator selectedMethods myGenerator myGeneratorsHome |
selectedMethods := (navigationState selectedMethodsArrayAt:index) value ? #().
"/ filter those which are lost due to recompilation ...
selectedMethods := selectedMethods select:[:m | m selector notNil].
selectedMethods isEmpty ifTrue:[
generator := #().
selectedMethods := #().
] ifFalse:[
"/ fetch the searchBlock - what a tricky kludge (no, really this should be done different)
myGenerator := (navigationState selectorListGeneratorArrayAt:index) value.
myGeneratorsHome := myGenerator block methodHome.
mySearchBlock := myGeneratorsHome at:(myGeneratorsHome numArgs + 1).
mySearchBlock isBlock ifFalse:[
mySearchBlock := myGeneratorsHome at:(myGeneratorsHome numArgs + 2)
].
generator := Iterator on:[:whatToDo |
|theMethodList|
theMethodList := IdentitySet new.
self withWaitCursorDo:[
selectedMethods do:[:selectedMethod |
theMethodList addAll:(mySearchBlock value:selectedMethod).
]
].
theMethodList do:[:aMethod |
whatToDo
value:aMethod mclass
value:aMethod category
value:aMethod selector
value:aMethod.
].
"/ theMethodList size == 1 ifTrue:[
whatToDo
value:nil
value:nil
value:nil
value:nil.
"/ ].
].
].
"/ the selection used in the other code...
navigationState selectedMethods value:selectedMethods.
self methodsSelectionChanged.
index+1 to:4 do:[:i |
(navigationState selectorListGeneratorArrayAt:i) value:#().
].
(navigationState selectorListGeneratorArrayAt:(index+1)) value:generator.
!
nameSpaceSelectionChanged
"namespace selection changed by user interaction"
self enqueueDelayedUpdateBufferLabel.
self updateSpecialCodeEditorVisibility.
self normalLabel. "/ update my window label
self updateLintEnablement.
"Created: / 24-02-2000 / 22:02:01 / cg"
"Modified: / 02-04-2014 / 12:31:21 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
projectSelectionChanged
"project selection changed by user interaction"
self enqueueDelayedUpdateCode.
self normalLabel. "/ update my window label
self updateSpecialCodeEditorVisibility.
"/ force update for packageFilter
"/ (must do it, since packageFilter is a vHolder
"/ holding a vHolder - i.e. it did not change yet)
self packageFilter
setValue:(self selectedProjects value);
changed.
self updateLintEnablement.
"Created: / 24-02-2000 / 22:02:10 / cg"
"Modified: / 18-08-2000 / 19:27:50 / cg"
"Modified: / 02-04-2014 / 12:30:59 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
projectSelectionChangedForFilter
"project selection changed by user interaction (here: used as filter)"
navigationState packageFilter value:(self selectedProjects value).
!
protocolSelectionChanged
|codeAspect|
"/ if showing history or log,
"/ don't update codeView, as long as no protocol is selected
((codeAspect := self codeAspect) == #repositoryLog
or:[codeAspect == #repositoryHistory]) ifTrue:[
self hasProtocolSelected ifFalse:[
^ self
]
].
self enqueueDelayedProtocolSelectionChanged
!
selectedEditorNoteBookTabIndexChanged
|m|
((m := self theSingleSelectedMethod) notNil
and:[m mclass isNil]) ifTrue:[
"/ kludge: still showing old code, but a change should be on its
"/ way, coming from the MethodList.
"/ push back the event, to allow for the change event to be handled first.
self
enqueueMessage:#selectedEditorNoteBookTabIndexChanged2
for:self
arguments:#().
^ self.
].
self selectedEditorNoteBookTabIndexChanged2.
!
selectedEditorNoteBookTabIndexChanged2
self updateSpecialCodeEditorVisibility.
self updateExecuteMethodVisibility.
"Modified: / 17-08-2006 / 16:47:34 / cg"
!
update:something with:aParameter from:changedObject
|codeView mthd codeAspect isForAspect|
"/ (navigationState notNil
"/ and:[changedObject == navigationState codeModifiedHolder]) ifTrue:[
"/ self enqueueDelayedUpdateBufferLabel.
"/ ^ self.
"/ ].
changedObject == environmentHolder ifTrue:[
self environmentChanged.
^ self.
].
changedObject == self selectedClasses ifTrue:[
self assert:(changedObject value includes:nil) not.
].
changedObject == self codeInfoVisible ifTrue:[
self codeInfoVisibilityChanged.
^ self
].
changedObject == self toolBarVisibleHolder ifTrue:[
self toolBarVisibilityChanged.
^ self
].
changedObject == self bookmarkBarVisibleHolder ifTrue:[
self bookmarkBarVisibilityChanged.
^ self
].
changedObject == self stringSearchToolVisibleHolder ifTrue:[
self stringSearchToolVisibilityChanged.
^ self
].
((codeView := self codeView) notNil
and:[changedObject == codeView modifiedChannel]) ifTrue:[
self codeModified.
^ self.
].
changedObject == self selectedEditorNoteBookTabIndexHolder ifTrue:[
self selectedEditorNoteBookTabIndexChanged.
^ self
].
changedObject == selectedBuffer ifTrue:[
self enqueueDelayedLabelUpdate.
self organizerModeForMenu changed.
self enqueueDelayedUpdateTestRunnerVisibility.
self enqueueDelayedUpdateExecuteMethodVisibility.
self updateCodeInfoAndStringSearchToolVisibility.
self enqueueDelayedUpdateInitSharedPoolVisibility.
^ self.
].
changedObject == self organizerModeForMenu ifTrue:[
self enqueueDelayedUpdateBufferLabel.
^ self.
].
changedObject == self showCoverageInformation ifTrue:[
DefaultShowCoverage := changedObject value.
^ self
].
something == #visitedClassHistory ifTrue:[
self visitedClassesHistory contents:(self class visitedClassNamesHistory).
^ self.
].
changedObject == environment 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 selectedClassesValue) contains:[:cls | cls name = aParameter name]) ifTrue:[
self enqueueDelayedUpdateCode.
^ self.
]
].
something == #methodInClass ifTrue:[
codeAspect == SyntaxHighlighter codeAspectMethod ifTrue:[
mthd := self theSingleSelectedMethod.
(mthd notNil and:[aParameter third == mthd])
ifTrue:[
self enqueueDelayedMethodTrapChanged:nil.
mthd mclass notNil ifTrue:[
"/ mhmh - Smalltalk tells me that a method has changed,
"/ but my selectedMethod has not yet been updated
"/ (the methodList seems to be behind me in the dependency chain).
"/ simply ignore this update here (assuming that the methodList will trigger
"/ another change soon).
"/ self enqueueDelayedUpdateCodeWithoutAutoSearch.
] ifFalse:[
"/ self halt.
].
].
].
^ self
].
something == #methodTrap ifTrue:[
self enqueueDelayedMethodTrapChanged:aParameter.
^ self
].
something == #methodCoverageInfo ifTrue:[
self theSingleSelectedMethod == aParameter ifTrue:[
self enqueueDelayedUpdateCode.
].
^ self
].
something == #projectOrganization ifTrue:[
| method class |
method := self theSingleSelectedMethod.
method notNil ifTrue:[
class := method mclass.
] ifFalse:[
class := self theSingleSelectedClass.
].
(aParameter isNil or:[class notNil and:[class name = aParameter first name]]) ifTrue: [
self enqueueDelayedUpdatePackageInfo.
].
].
^ self
].
super update:something with:aParameter from:changedObject
"Modified: / 27-07-2012 / 22:17:08 / cg"
"Modified: / 24-02-2014 / 23:33:05 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 05-10-2022 / 11:54:34 / Jan Vrany <jan.vrany@labware.com>"
!
updateBookmarkHolder
| bookmarkBar |
bookmarkBar := self componentAt:#Bookmarks.
bookmarkBar ifNil:[^self].
bookmarkBar application bookmarkHolder: self navigationState bookmarkHolder.
"Created: / 02-06-2011 / 22:34:24 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
updateBufferLabel
"update the current buffer's 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
"Created: / 05-02-2000 / 04:25:54 / cg"
"Modified (comment): / 15-11-2016 / 17:01:16 / cg"
!
updateCategorySelectionForChangedClassSelection
|classes oldSelectedCategories selectedPseudoEntries newSelectedCategories|
navigationState isCategoryBrowser ifFalse:[^ self].
classes := self selectedClassesValue.
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)
oldSelectedCategories := self selectedCategoriesValue.
selectedPseudoEntries := (oldSelectedCategories select:[:entry | BrowserList isPseudoCategory:entry]).
newSelectedCategories := Set new.
(selectedPseudoEntries asSet = (Set with:(BrowserList nameListEntryForChanged)))
ifFalse:[
newSelectedCategories addAll:(classes collect:[:eachClass | eachClass category]).
].
"/ reselect any selected pseudoCategory
newSelectedCategories addAll:selectedPseudoEntries.
newSelectedCategories ~= oldSelectedCategories ifTrue:[
self selectedCategories value:newSelectedCategories.
].
].
"Created: / 24-02-2000 / 14:10:09 / cg"
"Modified: / 28-02-2012 / 16:51:33 / cg"
!
updateCodeInfoAndStringSearchToolVisibility
|stringSearchToolVisible codeInfoVisible cFrame cBottomOffset sFrame sTopOffset sBottomOffset|
stringSearchToolVisible := self stringSearchToolVisibleHolder value.
codeInfoVisible := self codeInfoVisible value.
cFrame := self noteBookView.
cFrame isNil ifTrue:[^ self].
cFrame notNil ifTrue:[
(stringSearchToolVisible not and:[codeInfoVisible not]) ifTrue:[
cBottomOffset := 0.
sTopOffset := 0.
sBottomOffset := 0.
].
(stringSearchToolVisible not and:[codeInfoVisible]) ifTrue:[
cBottomOffset := -25.
sTopOffset := 0.
sBottomOffset := 0.
].
(stringSearchToolVisible and:[codeInfoVisible not]) ifTrue:[
cBottomOffset := -25.
sTopOffset := -24.
sBottomOffset := 0.
].
(stringSearchToolVisible and:[codeInfoVisible]) ifTrue:[
cBottomOffset := -50.
sTopOffset := -49.
sBottomOffset := -25.
].
cFrame layout notNil ifTrue:[
cFrame layout bottomOffset:cBottomOffset.
].
cFrame container notNil ifTrue:[
cFrame containerChangedSize.
].
sFrame := self stringSearchToolView.
sFrame notNil ifTrue:[
sFrame layout notNil ifTrue:[
sTopOffset notNil ifTrue:[sFrame layout topOffset:sTopOffset].
sBottomOffset notNil ifTrue:[sFrame layout bottomOffset:sBottomOffset].
sFrame container notNil ifTrue:[
sFrame containerChangedSize.
].
].
].
].
!
updateExecuteMethodVisibility
self hasNonTestCaseClassMethodWithoutArgsSelectedHolder
value:(self hasNonTestCaseClassMethodWithoutArgsSelected)
"Modified: / 05-08-2006 / 13:22:53 / cg"
!
updateInfoForChangedClassSelection
|selectedClasses singleSelectedClass categories msg|
navigationState organizerMode value == OrganizerCanvas organizerModeCategory ifTrue:[
self selectedCategoriesValue size > 1 ifTrue:[
singleSelectedClass := self theSingleSelectedClass.
singleSelectedClass notNil ifTrue:[
msg := (resources string:'Category: %2'
with:singleSelectedClass name allBold
with:singleSelectedClass category allBold).
] ifFalse:[
selectedClasses := self selectedClassesValue.
categories := selectedClasses collect:[:cls | cls category] as:Set.
categories size == 1 ifTrue:[
msg := (resources string:'Category: %1'
with:categories anElement allBold).
].
].
].
].
msg isNil ifTrue:[
msg := self getClassInfo.
].
msg notNil ifTrue:[
self showInfo:msg.
^ self.
].
self clearInfo.
"Modified: / 28-02-2012 / 16:51:46 / cg"
!
updateInitSharedPoolVisibility
self hasSharedPoolSelectedHolder
value:(
(self selectedClasses value ? #()) contains:[:cls |
cls isLoaded
and:[(cls theNonMetaclass askFor:#isAbstract) not
and:[ cls theNonMetaclass inheritsFrom:SharedPool ]]])
"Created: / 29-05-2012 / 10:19:08 / cg"
!
updateLaunchApplicationVisibility
self hasStartableApplicationSelectedHolder
value:(self hasStartableApplicationSelected)
!
updateLintEnablement
"Enables/disables lint button in toolbar depending on current selection"
self hasNonEmptyEnvironmentSelectedHolder value: self hasNonEmptyEnvironmentSelected
"Created: / 02-04-2014 / 12:21:08 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
updateMetaToggleForClassSelection
|selectedClasses newMetaToggleLabel|
selectedClasses := self selectedNonMetaclasses.
(selectedClasses contains:[:eachClass | eachClass isJavaClass]) ifTrue:[
"/ selection contains at least on java class
(selectedClasses conform:[:eachClass | eachClass isJavaClass]) ifTrue:[
"/ only java classes selected
newMetaToggleLabel := 'Static'.
] ifFalse:[
"/ mixed ..
newMetaToggleLabel := 'Class / Static'.
]
] ifFalse:[
"/ only smalltalk classes selected
newMetaToggleLabel := 'Class'.
].
self navigationState metaToggleLabelHolder value:(resources string:newMetaToggleLabel)
"Modified: / 13-10-2006 / 11:56:44 / cg"
!
updateNavigationHistory
self canGoBackAspect subjectChannel: self navigationHistory.
self canGoForwardAspect subjectChannel: self navigationHistory
"Created: / 27-02-2008 / 08:42:56 / janfrog"
!
updatePackageApplicationVisibility
self hasPackagableApplicationSelectedHolder
value:(self hasPackagableApplicationSelected)
!
updatePackageInfo
| method class |
(method := self theSingleSelectedMethod) notNil ifTrue:[
self updatePackageInfoForMethod: method.
] ifFalse:[
(class := self theSingleSelectedClass) notNil ifTrue:[
self updatePackageInfoForClass:class.
]
].
"Created: / 14-01-2019 / 18:08:38 / Claus Gittinger"
!
updatePluginVisibility
|naviState pluginVisible frame pluginApp pluginView |
naviState := self navigationState.
pluginVisible := naviState pluginVisibleHolder value.
frame := naviState codePaneAndPluginView.
frame isNil ifTrue:[
^ self
].
self showPlugin value ifTrue:[
pluginApp := BrowsletCanvas new.
pluginApp masterApplication:self.
pluginView := ApplicationSubView new client:pluginApp.
frame addSubView:pluginView.
frame relativeCorners:naviState codePaneAndPluginViewRelativeCorners.
] ifFalse:[
naviState codePaneAndPluginViewRelativeCorners:frame relativeCorners.
pluginView := frame subViews second.
pluginView destroy.
].
frame resizeSubviews
"
stringSearchToolVisible := self stringSearchToolVisibleHolder value.
codeInfoVisible := false.
cFrame := self noteBookView.
cFrame isNil ifTrue:[^ self].
cFrame notNil ifTrue:[
(stringSearchToolVisible not and:[codeInfoVisible not]) ifTrue:[
cBottomOffset := 0.
sTopOffset := 0.
sBottomOffset := 0.
].
(stringSearchToolVisible not and:[codeInfoVisible]) ifTrue:[
cBottomOffset := -25.
sTopOffset := 0.
sBottomOffset := 0.
].
(stringSearchToolVisible and:[codeInfoVisible not]) ifTrue:[
cBottomOffset := -25.
sTopOffset := -24.
sBottomOffset := 0.
].
(stringSearchToolVisible and:[codeInfoVisible]) ifTrue:[
cBottomOffset := -50.
sTopOffset := -49.
sBottomOffset := -25.
].
cFrame layout notNil ifTrue:[
cFrame layout bottomOffset:cBottomOffset.
].
cFrame container notNil ifTrue:[
cFrame containerChangedSize.
].
sFrame := self stringSearchToolView.
sFrame notNil ifTrue:[
sFrame layout notNil ifTrue:[
sTopOffset notNil ifTrue:[sFrame layout topOffset:sTopOffset].
sBottomOffset notNil ifTrue:[sFrame layout bottomOffset:sBottomOffset].
sFrame container notNil ifTrue:[
sFrame containerChangedSize.
].
].
].
]."
"Created: / 03-10-2010 / 19:03:51 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 02-04-2014 / 12:19:41 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
updateProtocolSelectionForChangedMethodSelection
|methods selectedProtocolsHolder selectedProtocols oldSelectedProtocols|
methods := self selectedMethodsValue.
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.
].
].
].
"Modified: / 28-02-2012 / 16:36:38 / cg"
!
updateTestRunnerVisibility
self hasAnyTestCaseSelectedHolder value:(self hasAnyTestCaseSelected)
"Modified: / 05-08-2006 / 13:22:53 / cg"
!
updateTextEditorBehavior
|languages spec|
spec := TextView defaultParenthesisSpecification.
languages := Set new.
(self selectedMethodsValue ? #()) do:[:each |
languages add:(each programmingLanguage).
].
(self selectedClassesValue ? #()) do:[:each |
languages add:(each programmingLanguage).
].
languages size == 1 ifTrue:[
spec := languages first parenthesisSpecificationForEditor.
].
self codeView parenthesisSpecification:spec
"Created: / 01-06-2012 / 23:01:35 / cg"
!
updateToolBarButtonEnablement
self hasClassOrMethodSelectedHolder value:self hasClassOrMethodSelected.
self updateLintEnablement.
!
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:'drag & drop'!
canDropContext:aDropContext
|methods|
self halt.
aDropContext sourceWidget == aDropContext targetWidget ifTrue:[^ false].
methods := aDropContext dropObjects collect:[:obj | obj theObject].
(methods conform:[:aMethod | aMethod isMethod]) ifFalse:[^ false].
self masterApplication theSingleSelectedClass isNil ifTrue:[^ false].
^ true
"Modified: / 13-09-2006 / 11:43:54 / cg"
!
canDropObjects:aCollectionOfDropObjects in:aWidget
self halt.
! !
!NewSystemBrowser methodsFor:'help specs'!
flyByHelpSpec
|changeSet spec|
spec := super flyByHelpSpec.
changeSet := ChangeSet current.
"/ (changeSet contains:[:chg | chg isMethodChange and:[chg changeClass notNil]]) ifTrue:[
(changeSet findLast:[:chg | chg isMethodChange and:[chg changeClass notNil]]) ~~ 0 ifTrue:[
spec at:#recentChanges put:(spec at:#recentlyChangedMethods).
] ifFalse:[
"/ (changeSet contains:[:chg | chg isClassChange and:[chg changeClass notNil]]) ifTrue:[
"/ spec at:#recentChanges put:(spec at:#recentlyChangedClasses).
"/ ] ifFalse:[
spec at:#recentChanges put:'Recently Changed'.
"/ ]
].
^ spec.
"Modified: / 08-09-2011 / 05:05:06 / cg"
!
flyByHelpTextFor:aWidget at:aPoint
|action info label|
(navigationState notNil and:[navigationState canvas notNil]) ifTrue:[
aWidget = (navigationState canvas builder componentAt:'InfoLabel') ifTrue:[
action := aWidget actionAt:aPoint.
"/ Transcript show:'action under info label:'; showCR:action.
info := action perform:#info ifNotUnderstood:nil.
info notNil ifTrue:[
^ info value
].
(label := aWidget label) notNil ifTrue:[
label isStringCollection ifTrue:[
^ label
].
(label widthOn:aWidget) > aWidget width ifTrue:[
^ label
].
]
].
].
^ nil
"Modified: / 08-11-2016 / 21:46:26 / cg"
"Modified: / 17-01-2022 / 15:20:56 / Jan Vrany <jan.vrany@labware.com>"
! !
!NewSystemBrowser methodsFor:'history'!
addToFindHistory:class selector:selector
self class updateHistory:self findHistory forClass:class selector:selector
"Created: / 02-05-2014 / 17:32:11 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
addToHistory: class
self addToHistory: class selector: nil.
"Created: / 06-04-2012 / 10:56:34 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
addToHistory: class selector: selector
self class addToHistory: class selector: selector.
^ self navigationState addToHistory: class selector: selector
"Created: / 22-02-2008 / 09:00:56 / janfrog"
"Modified: / 25-10-2009 / 15:06:21 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 02-07-2011 / 18:33:22 / cg"
!
addToRecentlyClosedHistory:class selector:selector
self class updateHistory:self closeHistory forClass:class selector:selector
"Created: / 02-05-2014 / 17:32:41 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
closeHistory
RecentlyClosedList isNil ifTrue:[
RecentlyClosedList := OrderedCollection new.
].
^ RecentlyClosedList
"Created: / 02-05-2014 / 15:58:17 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 02-05-2014 / 17:30:59 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
findHistory
FindHistory isNil ifTrue:[
FindHistory := OrderedCollection new.
].
^ FindHistory
"Created: / 02-05-2014 / 17:29:28 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!NewSystemBrowser methodsFor:'initialization'!
initialize
super initialize.
environment := Smalltalk.
"Created: / 03-09-2013 / 19:13:40 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 24-02-2014 / 11:05:07 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!NewSystemBrowser methodsFor:'menu actions-browse'!
browseClassesReferringToAnyPool:poolsArg in:doWhat
"open a dialog asking for a poolname; search for classes importing that pool."
|pools poolNameString classes|
poolsArg isEmptyOrNil ifTrue:[
^ self
].
pools := poolsArg
collect:[:poolOrName |
|p|
poolOrName isSharedPool ifTrue:[
poolOrName
] ifFalse:[
p := environment classNamed:poolNameString.
(p notNil and:[p isSharedPool]) ifTrue:[
p
] ifFalse:[
nil
]
]
]
thenSelect:[:p | p notNil].
pools isEmptyOrNil ifTrue:[
^ self
].
classes := environment allClasses
select:[:cls |
cls isMeta not and:[(cls sharedPools includesAny:pools)]
].
classes size == 0 ifTrue:[
self information:'None found.'.
^ self
].
classes := classes asOrderedCollection sort:[:a :b | a name < b name].
(doWhat == #newBrowser or:[ doWhat == #newBuffer ]) ifTrue:[
pools size == 1 ifTrue:[
poolNameString := pools first name
] ifFalse:[
poolNameString := (resources string:'any of %1 pools' with:pools size)
].
self
spawnClassBrowserFor:classes
label:(resources string:'Classes Referring to %1' with:poolNameString)
in:doWhat select:false.
^ self
].
self selectClasses:classes.
!
browseImplementorsOf
"launch an enterBox for selector to search for"
^ self
askForMethodAndSpawnSearchTitle:((resources string:'Selector to browse implementors of:')
, '\'
, (resources string:'(TAB for completion; matchPattern allowed)'))
browserLabel:'Implementors of %1'
searchWith:#( #'findImplementors:in:ignoreCase:match:' #'findImplementors:inMethods:ignoreCase:match:' )
searchWhat:#selector
searchArea:#everywhere
withCaseIgnore:true
withTextEntry:true
withMatch:true
withMethodList:true
setSearchPattern:nil
"Modified: / 20-08-2012 / 14:25:48 / cg"
!
browseImplementorsOfAny
|selectors|
selectors := self selectedMethodsValue collect:[:each | each selector].
^ self
askForMethodAndSpawnSearchTitle:'Browse Implementors of (any in selected):'
browserLabel:('Implementors (any of %1 selectors)' bindWith:selectors size)
searchWith:[:ignoredString :classes :ignoredCase :match|
match ifTrue:[
self class
findImplementorsMatchingAny:selectors
in:classes ignoreCase:false
] ifFalse:[
self class
findImplementorsOfAny:selectors
in:classes ignoreCase:false
].
]
searchWhat:#selector
searchArea:#everywhere
withCaseIgnore:false
withTextEntry:false
withMethodList:false
setSearchPattern:nil
"Modified: / 28-02-2012 / 16:14:55 / cg"
!
browseInheritanceOf
"launch an enterBox for selector to search for"
|sel box b inputField selectorHolder openHow caseHolder|
sel := self selectorToSearchFor.
sel isEmptyOrNil ifTrue:[
"/ use last searchString
LastSearchPatterns size > 0 ifTrue:[
sel := LastSearchPatterns first.
].
].
selectorHolder := sel asValue.
box := Dialog new.
box addTextLabel:(resources string:'Selector to browse inheritance of:') adjust:#left.
inputField := box addComboBoxOn:selectorHolder tabable:true.
inputField list:LastSearchPatterns.
inputField selectAllInitially.
inputField entryCompletionBlock:[:contents |
|s what|
s := contents withoutSpaces.
box topView withWaitCursorDo:[
what := DoWhatIMeanSupport selectorCompletion:s inEnvironment:environment.
inputField contents:what first.
(what at:2) size ~~ 1 ifTrue:[
self window beep
]
]
].
box addCheckBox:(resources string:'Ignore case') on:(caseHolder := false asValue).
box addButton:(b := Button label:(resources string:'Add Buffer')).
b action:[
openHow := #newBuffer.
box doAccept; okPressed.
].
b := box addOkButtonLabelled:(resources string:'Browse').
b action:[
openHow := #newBrowser.
box doAccept; 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.
].
"Modified: / 04-09-2013 / 17:40:29 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
browseMenuAllSubclassesOf
"add a new buffer on all subclasses of an entered class"
self
askForClassToSearch:nil
single:true
msgTail:' subclass of'
thenDo:[:classNameArg :single :doWhat |
|className class searchBlock|
className := classNameArg.
className = 'nil' ifTrue:[
searchBlock := [ Behavior allSubInstances select:[:cls | cls superclass isNil] ].
] ifFalse:[
className includesMatchCharacters ifTrue:[
className := self askForClassNameMatching:className.
].
class := (environment classNamed:className) theNonMetaclass.
searchBlock := [ class allSubclasses ]
].
self
spawnClassBrowserForSearch:searchBlock
spec:#multipleClassBrowserSpec
sortBy:nil in:#newBuffer label:('All Subclasses of ' , className)
autoSelectIfOne:true
callBack:[:brwsr | ].
]
!
browseMenuApplicationClasses
"add a new buffer on all application classes"
self
browseMenuClassesForWhich:[:cls | cls isBrowserStartable]
label: 'Applications'
"Modified: / 18-04-2012 / 16:20:54 / cg"
!
browseMenuAutoloadedClasses
"add a new buffer on all classes that have been autoloaded"
|searchBlock|
searchBlock := [
(environment allClassesForWhich:[:someClass | someClass wasAutoloaded])
asOrderedCollection
].
self
spawnClassBrowserForSearch:searchBlock
sortBy:nil
in:#newBuffer
label:'Classes which were autoloaded'
!
browseMenuClassExtensions
"open a new browser on all methods extending a class
(i.e. methods where the packageID is different from their classes packageID)"
self browseMenuClassExtensionsOpenAs:#newBrowser
!
browseMenuClassExtensionsBuffer
"add a new buffer on all methods extending a class
(i.e. methods where the packageID is different from their classes packageID)"
self browseMenuClassExtensionsOpenAs:#newBuffer.
!
browseMenuClassExtensionsFor:aCollectionOfPackagesOrNil in:aCollectionOfClasses label:labelOrNil openAs:openHow
"open a browser / add a new buffer on all methods extending a class
(i.e. methods where the packageID is different from their classes packageID)"
self withSearchCursorDo:[
|newBrowser|
newBrowser := self
spawnClassExtensionBrowserForSearch:[
|classes|
classes := (aCollectionOfClasses
select:[:aClass |
|include|
aCollectionOfPackagesOrNil isNil ifTrue:[
include := aClass hasExtensions.
] ifFalse:[
include := aCollectionOfPackagesOrNil contains:[:eachPackage | aClass hasExtensionsFrom:eachPackage]
].
include
]) asOrderedCollection.
classes sort:[:a :b | a name < b name]
]
label:labelOrNil
in:openHow.
newBrowser navigationState selectedProjects value:aCollectionOfPackagesOrNil.
]
!
browseMenuClassExtensionsOpenAs:openHow
"open a browser / add a new buffer on all methods extending a class
(i.e. methods where the packageID is different from their classes packageID)"
^ self
browseMenuClassExtensionsFor:nil
in:environment allClasses
label:'All Class Extensions'
openAs:openHow
!
browseMenuClassesDefiningVariable
"open a dialog asking for a variable; search for classes defining
such a variable."
|box title okText okText2 okText3 varNameString varNamesToSearch checkFilterBlock
brwsr allInstVariables allClassInstVariables allClassVariables
list button2 button3 doWhat doWhat2 doWhat3 classes|
title := 'Browse/Search Class(es) which define Instance, Class or ClassInst Variables:\(MatchPattern Allowed; Separate multiple names/patterns by ";")\'.
okText2 := 'Open'. doWhat2 := #newBrowser.
okText := 'Add Buffer'. doWhat := #newBuffer.
navigationState isFullBrowser ifTrue:[
okText3 := 'Find'. doWhat3 := nil.
].
allInstVariables := Set new.
allClassVariables := Set new.
allClassInstVariables := Set new.
environment 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).
].
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 := DoWhatIMeanSupport selectorCompletion:s inEnvironment:environment .
box contents:what first.
(what at:2) size ~~ 1 ifTrue:[
self builder window beep
].
box listView list:(list select:[:entry | s match:entry]).
].
box action:[:aString | varNameString := aString].
box showAtPointer.
varNameString isEmptyOrNil ifTrue:[
^ self
].
varNamesToSearch := varNameString asCollectionOfSubstringsSeparatedBy:$; .
(varNamesToSearch contains:[:varNameToSearch | varNameToSearch includesMatchCharacters]) ifTrue:[
checkFilterBlock := [:v | varNamesToSearch contains:[:varNameToSearch | varNameToSearch match:v]]
] ifFalse:[
varNamesToSearch := varNamesToSearch asSet.
checkFilterBlock := [:v | varNamesToSearch includes:v]
].
classes := environment allClasses select:[:cls |
cls isMeta not
and:[(cls instVarNames contains:checkFilterBlock)
or:[(cls classVarNames contains:checkFilterBlock)
or:[cls class instVarNames contains:checkFilterBlock]]]
].
classes size == 0 ifTrue:[
self information:'None found.'.
^ self
].
classes := classes asOrderedCollection sort:[:a :b | a name < b name].
(doWhat == #newBrowser or:[ doWhat == #newBuffer ]) ifTrue:[
self spawnClassBrowserFor:classes in:doWhat.
^ self
].
brwsr := self.
doWhat == #newBuffer ifTrue:[
brwsr createBuffer.
].
brwsr selectClasses:classes.
"Created: / 01-03-2000 / 11:12:38 / cg"
"Modified: / 29-08-2013 / 12:23:08 / cg"
"Modified: / 04-09-2013 / 17:40:57 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
browseMenuClassesForWhich: aFilter label: label
"add a new buffer on all shared pools"
|searchBlock|
searchBlock := [
|classes|
classes := OrderedCollection new.
environment allClassesDo:[:eachClass |
(aFilter value: eachClass) ifTrue:[
classes add:eachClass
]
].
classes
].
self
spawnClassBrowserForSearch:searchBlock
spec:#multipleClassBrowserSpec
sortBy:nil in:#newBuffer label:label
autoSelectIfOne:true
callBack:[:brwsr | brwsr classListApp markApplications:true ].
"Modified: / 06-07-2011 / 14:05:37 / cg"
"Created: / 18-04-2012 / 16:15:09 / cg"
!
browseMenuClassesInAllChangeSets
"add a new buffer on all classes in the all changeSets
(i.e. that have been changed, but not yet checked into the source repository)"
^ self browseMenuClassesInAllChangeSetsOpenAs:#newBuffer
!
browseMenuClassesInAllChangeSetsOpenAs:openHow
"add a new buffer/open a new browser on all classes in all changeSets
(i.e. that have been changed, but not yet checked into the source repository)"
^ self
browseMenuClassesInChangeSets:(ChangeSet allInstances)
label:'Changed classes in any changeSet' openAs:openHow
!
browseMenuClassesInChangeSets:aSetOfChangeSets label:title openAs:openHow
"add a new buffer/open a new browser on all classes in the given changeSets
(i.e. that have been changed, but not yet checked into the source repository)"
|searchBlock|
searchBlock :=
[
|classes|
classes := IdentitySet new.
aSetOfChangeSets do:[:eachChangeSet |
eachChangeSet do:[:aChange |
|cls|
(aChange isMethodChange or:[aChange isClassChange]) ifTrue:[
(cls := aChange changeClass) notNil ifTrue:[
cls isRealNameSpace ifFalse:[
cls := cls theNonMetaclass.
classes add:cls.
cls isPrivate ifTrue:[
classes add:cls owningClass
].
].
]
].
].
].
classes asOrderedCollection
].
^ self spawnClassBrowserForSearch:searchBlock sortBy:nil in:openHow label:title
"Modified: / 10-11-2006 / 17:13:45 / cg"
!
browseMenuClassesInCurrentChangeSet
"add a new buffer on all classes in the current changeSet
(i.e. that have been changed, but not yet checked into the source repository)"
^ self browseMenuClassesInCurrentChangeSetOpenAs:#newBuffer
!
browseMenuClassesInCurrentChangeSetOpenAs:openHow
"add a new buffer/open a new browser on all classes in the changeSet
(i.e. that have been changed, but not yet checked into the source repository)"
^ self
browseMenuClassesInChangeSets:(Array with:ChangeSet current)
label:'Changed classes in current changeSet' openAs:openHow
!
browseMenuClassesOfRecentlyOpenedApplications
"add a new buffer on all classes for which an application has been opened recently"
^ self browseMenuClassesOfRecentlyOpenedApplications:#newBuffer
"Created: / 22-08-2011 / 08:03:25 / cg"
!
browseMenuClassesOfRecentlyOpenedApplications:openHow
"add a new buffer/open a new browser on all classes for which an app has been opened recently"
|searchBlock|
searchBlock :=
[
|appHistory|
appHistory := ApplicationModel recentlyOpenedApplications.
appHistory
collect:[:nm | environment classNamed:nm]
as:OrderedCollection
].
^ self spawnClassBrowserForSearch:searchBlock sortBy:nil in:openHow label:'Recently opened applications'
"Created: / 22-08-2011 / 08:04:17 / cg"
!
browseMenuClassesReferringToPool
"open a dialog asking for a poolname; search for classes importing that pool."
|box title okText okText2 okText3 poolNameString pool list button2 button3 doWhat doWhat2 doWhat3|
title := 'Browse/Search Class(es) which refer to a Pool:\'.
okText2 := 'Open'. doWhat2 := #newBrowser.
okText := 'Add Buffer'. doWhat := #newBuffer.
navigationState isFullBrowser ifTrue:[
okText3 := 'Find'. doWhat3 := nil.
].
list := (SharedPool allSubclasses collect:[:pool | pool name]) sort.
"/ using a comboBox...
box := self enterBoxForCodeSelectionTitle:title withCRs withList:list okText:okText.
box label:(resources string:'Browse or Search for Classes using Pool').
button2 := Button label:(resources string:okText2).
okText3 notNil ifTrue:[
button3 := Button label:(resources string:okText3).
].
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 := DoWhatIMeanSupport poolnameCompletion:s inEnvironment:environment.
box contents:what first.
(what at:2) size ~~ 1 ifTrue:[
self builder window beep
].
box listView list:(list select:[:entry | s match:entry]).
].
box action:[:aString | poolNameString := aString].
box showAtPointer.
poolNameString isEmptyOrNil ifTrue:[
^ self
].
pool := environment classNamed:poolNameString.
pool isNil ifTrue:[
Dialog warn:'No such pool: ', poolNameString.
^ self.
].
pool isSharedPool ifFalse:[
Dialog warn:'Not a sharedPool: ',poolNameString.
^ self.
].
self browseClassesReferringToAnyPool:(Array with:pool) in:doWhat
"Modified: / 29-08-2013 / 12:23:44 / cg"
!
browseMenuClassesWithDocumentationToBeAdded
"searches for classes with either no documentation method,
or where the documentation method includes the string 'documentation to be added'"
|searchBlock|
searchBlock := [
self findClassesForWhich:[:cls |
|m|
(m := cls theMetaclass compiledMethodAt:#documentation) notNil
and:[ (( m source ? '') includesString:'documentation to be added' caseSensitive:false)
and:[ "self halt." true ]]
].
].
self spawnClassBrowserForSearch:searchBlock sortBy:nil in:#newBuffer label:'Classes with documentation to be added'
!
browseMenuClassesWithFilter:aFilterBlock label:aLabelString
|searchBlock|
searchBlock := [ environment allClasses select:aFilterBlock ].
^ self
spawnClassBrowserForSearch:searchBlock
sortBy:nil
in:#newBuffer
label:aLabelString
!
browseMenuClassesWithInstrumentation
self
browseMenuClassesForWhich:[:cls |
|any|
any := false.
cls instAndClassMethods do:[:m | m isInstrumented ifTrue:[any := true]].
any
]
label: 'Classes with Instrumentation'
!
browseMenuClassesWithInvalidCopyright
|noCopyright copyrightOlder copyrightYounger invalid
oldest dateString ts copyright line yearFromCopyright yearFromCVS s|
noCopyright := OrderedCollection new.
copyrightOlder := OrderedCollection new.
copyrightYounger := OrderedCollection new.
invalid := OrderedCollection new.
Smalltalk allClassesDo:[:cls |
(cls theMetaclass includesSelector:#copyright) ifFalse:[
noCopyright add:cls.
] ifTrue:[
Transcript showCR:(' %1' bindWith:cls name).
copyright := ((cls theMetaclass sourceCodeAt:#copyright) ? '') asStringCollection.
line := copyright detect:[:l | (l includesString:'Copyright' caseSensitive:false)
and:[l includesAny:'0123456789']
]
ifNone:nil.
line isNil ifTrue:[
invalid add:cls
] ifFalse:[
s := line readStream.
s skipUntil:[:c | c isDigit].
yearFromCopyright := Integer readFrom:s.
oldest := CVSSourceCodeManager oldestRevisionLogEntryOf:cls.
dateString := oldest date.
ts := Timestamp readFrom:dateString.
yearFromCVS := ts year.
yearFromCopyright = yearFromCVS ifFalse:[
Transcript showCR:('%1 (CVS: %2 Copyright: %3)' bindWith:cls name with:yearFromCVS with:yearFromCopyright).
yearFromCopyright < yearFromCVS ifTrue:[
copyrightOlder add:cls.
] ifFalse:[
copyrightYounger add:cls.
].
].
].
].
].
self spawnClassBrowserFor:noCopyright label:'No copyright' in:#newBuffer.
self spawnClassBrowserFor:copyrightOlder label:'Older copyright' in:#newBuffer.
self spawnClassBrowserFor:copyrightYounger label:'Younger copyright' in:#newBuffer.
self spawnClassBrowserFor:invalid label:'Invalid copyright' in:#newBuffer.
"/ noCopyright inspect.
"/ wrongCopyright inspect.
"/ invalid inspect.
!
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.
!
browseMenuClassesWithShadowedMethods
"open a new browser on all package conflicts (methods shadowing existing one's from
another package)"
self browseMenuClassesWithShadowedMethodsOpenAs:#newBuffer
!
browseMenuClassesWithShadowedMethodsOpenAs:openHow
"open a browser / add a new buffer on all methods which shadow an
existing method from another package"
self withSearchCursorDo:[
|newBrowser|
newBrowser := self
spawnClassExtensionBrowserForSearch:[
|classes|
classes := environment allClassesForWhich:[:someClass |
|include|
include := false.
someClass hasExtensions ifTrue:[
someClass instAndClassMethodsDo:[:m | m isShadowingExtension ifTrue:[include := true]].
].
include
].
classes asOrderedCollection sort:[:a :b | a name < b name]
]
label:'Classes with Overwritten Methods (Package Conflicts)'
in:openHow.
"/ newBrowser navigationState selectedProjects value:nil.
]
!
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 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).
].
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 := environment 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) or:[doWhat == #newBuffer]) ifTrue:[
^ self spawnClassBrowserFor:classes in:doWhat
].
self selectClasses:classes.
"Created: / 01-03-2000 / 12:44:16 / cg"
"Modified: / 29-08-2013 / 12:24:01 / cg"
!
browseMenuClassesWithUserFilter
"launch an enterBox for area to search in"
|filterBlockString filterBlock dialog textHolder template|
template :=
'"/ general class search;
"/ the following block should evaluate to true for all classes
"/ you want to browse. Please change as required.
"/ Beginner warning: Smalltalk know-how is useful here.
[:class |
"/ any condition using class.
"/ Useful queries to the method are:
"/ - source to access its full sourceCode
"/ - package the classes package
"/ - name the classes name
"/ - category the classes category
"/ - nameSpace the classes namespace
"/ - superclass the classes superclass
"/ - hasExtension true if it has extensions (methods in other packages)
"/ - implements: true if it implements a particular message
"/ - isSubclassOf: true if it is a subclass of some other class
"/ - isSuperclassOf: true if it is a superclass of some other class
"/ - hasUnsavedChanges true if it has been changed but not saved in repository
"/
"/ example (search for classes which implement some message and are in the Smalltalk nameSpace)
(class nameSpace == Smalltalk
and:[ class implements:#at: ] )
"/ example (search for classes which do not implement a message)
"/ (class implements:#at:) not
"/ same, for class side
"/ (class theMetaclass implements:#version) not
]
'.
LastClassFilterBlockString isNil ifTrue:[
LastClassFilterBlockString := template.
].
textHolder := ValueHolder new.
dialog := Dialog
forRequestText:(resources string:'Enter filterBlock')
lines:25
columns:70
initialAnswer:LastClassFilterBlockString
model:textHolder.
dialog addButton:(Button label:'Template' action:[textHolder value:template. textHolder changed:#value.]).
dialog open.
dialog accepted ifFalse:[^ self].
filterBlockString := textHolder value.
LastClassFilterBlockString := filterBlockString.
filterBlock := Parser evaluate:filterBlockString.
self assert:filterBlock isBlock message:'bad input'.
self browseMenuClassesWithFilter:filterBlock label:'Class-Search result'
"Modified: / 29-09-2011 / 13:13:31 / cg"
!
browseMenuClassesWithoutCVSRepositoryContainer
|sourceCodeManager|
sourceCodeManager := Smalltalk at: #CVSSourceCodeManager.
sourceCodeManager isNil ifTrue: [
Dialog warn: 'CVS Source Code Manager is not available'.
^ self.
].
^ self browseMenuClassesWithoutRepositoryContainerFor:sourceCodeManager
"Modified: / 19-04-2011 / 11:51:57 / cg"
!
browseMenuClassesWithoutCopyright
|searchBlock|
searchBlock :=
[|classes|
classes := self findClassesWithoutClassMethod:#copyright.
classes := classes reject:[:each | each isPrivate].
classes].
self
spawnClassBrowserForSearch:searchBlock
sortBy:nil
in:#newBuffer
label:'Classes without copyright'
"Modified: / 11-07-2010 / 16:42:04 / cg"
!
browseMenuClassesWithoutDocumentation
|searchBlock|
searchBlock := [
self findClassesWithoutClassMethod:#documentation
].
self spawnClassBrowserForSearch:searchBlock sortBy:nil in:#newBuffer label:'Classes without documentation'
!
browseMenuClassesWithoutExamples
|searchBlock|
searchBlock := [ |classes|
classes := self findClassesWithoutClassMethod:#examples.
classes
select:[:each |
(each isPrivate not
or:[classes includes:each owningClass])
and:[ (each isSubclassOf:Exception) not ]
].
].
self spawnClassBrowserForSearch:searchBlock sortBy:nil in:#newBuffer label:'Classes without examples'
"Modified: / 11-07-2010 / 16:43:35 / cg"
!
browseMenuClassesWithoutRepositoryContainerFor:aSourceCodeManager
|searchBlock nameOfVersionMethodInClasses|
nameOfVersionMethodInClasses := aSourceCodeManager nameOfVersionMethodInClasses.
searchBlock := [
|classesWithVersion classesWithVersionSVN classesWithoutBoth|
classesWithVersion := self findClassesWithoutClassMethod:#version.
classesWithVersion := classesWithVersion reject:[:each | each isPrivate].
classesWithVersionSVN := self findClassesWithoutClassMethod: nameOfVersionMethodInClasses.
classesWithVersionSVN := classesWithVersionSVN select:[:each | each isPrivate not].
classesWithoutBoth := classesWithVersion asSet intersect: classesWithVersionSVN.
].
^ self
spawnClassBrowserForSearch:searchBlock
sortBy:nil
in:#newBuffer
label:(resources string:'Classes without %1 repository container' with:aSourceCodeManager managerTypeName)
"Created: / 19-04-2011 / 11:51:38 / cg"
!
browseMenuClassesWithoutSVNRepositoryContainer
|sourceCodeManager|
sourceCodeManager := Smalltalk at: #SVNSourceCodeManager.
sourceCodeManager isNil ifTrue: [
Dialog warn: 'SVN Source Code Manager is not available'.
^ self.
].
^ self browseMenuClassesWithoutRepositoryContainerFor:sourceCodeManager
"Modified: / 19-04-2011 / 11:52:12 / cg"
!
browseMenuClone
|browser categoryListApp|
self window sensor shiftDown ifTrue:[
"/ temporary: allow old browser to be used
SystemBrowser openInClass:(self theSingleSelectedClass) selector:(self theSingleSelectedSelector).
^ self
].
"/ do not use self class new here - to avoid using obsolete classes instances
"/ while working on the browser itself ...
browser := (Smalltalk at:self class name) new.
browser environment: self environment.
browser allButOpen.
browser setupNavigationStateFrom:navigationState.
browser window extent:(self window extent).
self currentNamespace ~~ Smalltalk ifTrue:[
(categoryListApp := browser categoryListApp) notNil ifTrue:[
categoryListApp nameSpaceFilter value:(self navigationState selectedNamespaces value copy)
].
].
browser openWindow.
^ browser.
"Modified: / 08-08-2010 / 15:19:13 / cg"
"Modified: / 27-04-2014 / 11:07:08 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
browseMenuDeprecatedMethods
^ self
askForMethodAndSpawnSearchTitle:'Search for Deprecated Methods in:'
browserLabel:(LabelAndIcon icon:(self class menuIcon) string:'Deprecated Methods')
searchWith:[:classes | self class findMethodsIn:classes where:[:c :m :sel | m isObsolete]]
searchArea:(self defaultSearchArea)
!
browseMenuHTTPServiceClasses
"add a new buffer on all web service classes"
self
browseMenuClassesForWhich:[:cls | cls isBrowserStartable
and:[cls inheritsFrom:HTTPService]]
label: 'Web Services'
"Created: / 20-07-2007 / 10:02:14 / cg"
!
browseMenuImplementorsOf
self browseImplementorsOf
!
browseMenuImplementorsOfAny
self browseImplementorsOfAny
!
browseMenuInheritanceOf
self browseInheritanceOf
!
browseMenuMethodsInChangeSets:aSetOfChangeSets openAs:openHow
"add a new buffer on all methods in all given changeSets
(i.e. that have been changed, but not yet checked into the source repository)"
|searchBlock|
searchBlock :=
[
|methods methodsInOrder|
aSetOfChangeSets do:[:eachChangeSet |
methods := IdentitySet new.
methodsInOrder := OrderedCollection new.
eachChangeSet reverseDo:[:aChange |
|cls selector method|
(aChange isMethodChange) ifTrue:[
(cls := aChange changeClass) notNil ifTrue:[
method := cls compiledMethodAt:aChange selector.
method notNil ifTrue:[
(methods includes:method) ifFalse:[
methods add:method.
methodsInOrder add:method.
]
]
]
].
].
].
methodsInOrder
].
^ self
spawnMethodBrowserForSearch:searchBlock
sortBy:"false" #class
in:openHow
label:'Changed methods'
!
browseMenuMethodsInCurrentChangeSet
"add a new buffer on all methods in the changeSet
(i.e. that have been changed, but not yet checked into the source repository)"
^ self browseMenuMethodsInCurrentChangeSetIn:#newBuffer
!
browseMenuMethodsInCurrentChangeSetIn:openHow
"add a new buffer on all methods in the changeSet
(i.e. that have been changed, but not yet checked into the source repository)"
^ self browseMenuMethodsInChangeSets:(Array with:ChangeSet current) openAs:openHow
!
browseMenuMethodsWithAnnotation
"launch an enterBox for area to search in"
^ self
askForMethodAndSpawnSearchTitle:'Search for Annotated Methods:'
browserLabel:'Annotated Methods'
searchWith:[:annotationOrEmpty :classes :ignoreCase :doMatch |
"/ self class findResource:resourceOrEmpty match:doMatch ignoreCase:ignoreCase in:classes.
self class
findMethodsIn:classes
where:[:c :m :sel |
m hasAnnotation
and:[ (m annotations contains:[:a | a isArray or:[ a isResource not ]] )
and:[ annotationOrEmpty isEmpty
or:[ annotationOrEmpty = '*'
or:[ m annotations contains:[:a |a printString matches:'*',annotationOrEmpty,'*']]]]]
]
]
searchWhat:#annotation
searchArea:(self defaultSearchArea)
withCaseIgnore:false
withTextEntry:true
withMatch:true
withMethodList:false
setSearchPattern:nil
"Created: / 18-07-2012 / 19:26:56 / cg"
!
browseMenuMethodsWithCode
"launch an enterBox for code to search for"
|whereDefault|
whereDefault := SearchDialog lastCodeSearchArea ? #everywhere.
"/ whereDefault := self defaultSearchArea.
"/ whereDefault == #classes ifTrue:[
"/ ((self selectedMethods value ? #()) contains:[:anyMethod | anyMethod mclass isPrivate]) ifTrue:[
"/ whereDefault := #ownersWithPrivateClasses
"/ ]
"/ ].
self
askForMethodAndSpawnSearchTitle:'Code to Search:'
browserLabel:'Methods containing code'
searchWith:#( #'findCode:in:isMethod:' #'findCode:inMethods:isMethod:' )
searchWhat:#code
searchArea:whereDefault
withCaseIgnore:false
withTextEntry:true
withMethodList:true
setSearchPattern:[:brwsr :codePattern :isMethodSearch :doMatch|
isMethodSearch ifFalse:[
brwsr autoSearchCodePattern:codePattern
]
]
!
browseMenuMethodsWithExceptionHandlers
"launch an enterBox for area to search for"
|whereDefault|
whereDefault := SearchDialog lastCodeSearchArea ? #everywhere.
self
askForMethodAndSpawnSearchTitle:'Search Exception Raisers:'
browserLabel:'Methods containing Exception Raisers'
searchWith:#( #'findExceptionHandlersIn:' #'findExceptionHandlersInMethods:' )
searchWhat:nil
searchArea:whereDefault
withCaseIgnore:false
withTextEntry:false
withMethodList:true
setSearchPattern:[:brwsr :codePattern :isMethodSearch :doMatch | ]
"Created: / 11-05-2010 / 14:19:27 / cg"
!
browseMenuMethodsWithExceptionRaisers
"launch an enterBox for area to search for"
|whereDefault|
whereDefault := SearchDialog lastCodeSearchArea ? #everywhere.
self
askForMethodAndSpawnSearchTitle:'Search Exception Raisers:'
browserLabel:'Methods containing Exception Raisers'
searchWith:#( #'findExceptionRaisersIn:' #'findExceptionRaisersInMethods:' )
searchWhat:nil
searchArea:whereDefault
withCaseIgnore:false
withTextEntry:false
withMethodList:true
setSearchPattern:[:brwsr :codePattern :isMethodSearch :doMatch | ]
"Created: / 11-05-2010 / 14:19:14 / cg"
!
browseMenuMethodsWithExternalFunctionCalls
|whereDefault|
whereDefault := self defaultSearchArea.
^ self
askForMethodAndSpawnSearchTitle:'Search for Methods with Library Calls (FFI):'
browserLabel:'Library Calls (FFI)'
searchWith:[:classes |
self class
findMethodsIn:classes
where:[:cls :mthd :sel |
mthd isExternalLibraryFunctionCall
]
]
searchArea:whereDefault
!
browseMenuMethodsWithHelpSpec
"launch an enterBox for area to search in"
^ self
askForMethodAndSpawnSearchTitle:'Search for help texts (helpSpec methods) in:'
browserLabel:(LabelAndIcon icon:(self class menuIcon) string:'Help')
searchWith:[:classes | self class findResource:#(help) in:classes]
searchArea:(self defaultSearchArea)
!
browseMenuMethodsWithImageSpec
"launch an enterBox for area to search in"
^ self
askForMethodAndSpawnSearchTitle:'Search for images (imageSpec methods) in:'
browserLabel:(LabelAndIcon icon:(self class imageIcon) string:'Images') " 'Images' "
searchWith:[:classes | self class findResource:#(image fileImage) in:classes]
searchArea:(self defaultSearchArea)
!
browseMenuMethodsWithInstrumentation
^ self
browseMethodsForWhich:[:mthd | mthd isInstrumented]
in:#newBuffer
label:'Instrumented Methods'
"/ |whereDefault|
"/
"/ whereDefault := self defaultSearchArea.
"/ ^ self
"/ askForMethodAndSpawnSearchTitle:'Search for Methods with Instrumentation:'
"/ browserLabel:'Instrumentated Methods'
"/ searchWith:[:classes |
"/ self class
"/ findMethodsIn:classes
"/ where:[:cls :mthd :sel |
"/ mthd isInstrumented
"/ ]
"/ ]
"/ searchArea:whereDefault
!
browseMenuMethodsWithLeftoverDebugCode
|whereDefault codeStrings matcher|
codeStrings :=
#(
'Transcript `@msg: `@args'
'`@any halt'
'true ifTrue: `@stuff'
'true ifFalse: `@stuff'
'false ifTrue: `@stuff'
'false ifFalse: `@stuff'
'`@any handle:[] do:`@anyBlock'
'`@any handle:[:ex | ] do:`@anyBlock'
'`@any needsWork'
'#needsWork'
'#todo'
).
matcher := ParseTreeSearcher new.
matcher matchesAnyOf: codeStrings do: [:aNode :answer | aNode].
whereDefault := self defaultSearchArea.
^ self
askForMethodAndSpawnSearchTitle:'Search for methods with possible leftOver debug code in:'
browserLabel:'Methods with leftOver debug code'
searchWith:[:classes |
self class
findMethodsIn:classes
where:[:cls :mthd :sel |
self method:mthd selector:sel inClass:cls matchesParseTreeMatcher:matcher
]
]
searchArea:whereDefault
!
browseMenuMethodsWithMenuSpec
"launch an enterBox for area to search in"
^ self
askForMethodAndSpawnSearchTitle:'Search for menus (menuSpec methods) in:'
browserLabel:(LabelAndIcon icon:(self class menuIcon) string:'Menus') "'Menus'"
searchWith:[:classes | self class findResource:#(menu programMenu) in:classes]
searchArea:(self defaultSearchArea)
!
browseMenuMethodsWithPrimitiveCode
|whereDefault|
whereDefault := self defaultSearchArea.
^ self
askForMethodAndSpawnSearchTitle:'Search for Methods with Primitive Code:'
browserLabel:'Primitive Code'
searchWith:[:classes |
self class
findMethodsIn:classes
where:[:cls :mthd :sel |
mthd hasPrimitiveCode
]
]
searchArea:whereDefault
!
browseMenuMethodsWithResource
"launch an enterBox for area to search in"
^ self
askForMethodAndSpawnSearchTitle:'Search for Resource Methods:\\Resource (empty for any; matchpattern allowed)'
browserLabel:'Resources'
searchWith:[:resourceOrEmpty :classes :ignoreCase :doMatch |
self class findResource:resourceOrEmpty match:doMatch ignoreCase:ignoreCase in:classes
]
searchWhat:#resource
searchArea:(self defaultSearchArea)
withCaseIgnore:true
withTextEntry:true
withMatch:true
withMethodList:false
setSearchPattern:nil
"/ ^ 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)
"Modified: / 06-07-2011 / 12:16:27 / cg"
!
browseMenuMethodsWithString
"launch an enterBox for string to search for"
|whereDefault|
self isMethodListBrowser ifTrue:[
whereDefault := SearchDialog constantForListOfMethodsArea.
] ifFalse:[
whereDefault := SearchDialog lastStringSearchArea ? self defaultSearchArea.
whereDefault == #classes ifTrue:[
(self hasAnyMethodSelectedForWhich:[:m | m mclass notNil and:[m mclass isPrivate]])
ifTrue:[
whereDefault := #ownersWithPrivateClasses
]
].
].
self
askForMethodAndSpawnSearchTitle:'String to Search for in Sources:'
browserLabel:'Methods containing "%1"'
searchWith:#( #'findString:in:ignoreCase:match:fullWordsOnly:' #'findString:inMethods:ignoreCase:match:'
#'findStringLiteral:in:ignoreCase:match:fullWordsOnly:' #'findStringLiteral:inMethods:ignoreCase:match:fullWordsOnly:' )
searchWhat:#string
searchArea:whereDefault
withCaseIgnore:true
withTextEntry:true
withMethodList:true
setSearchPattern:[:brwsr :string :ignoreCase :doMatch|
brwsr autoSearchPattern:string ignoreCase:ignoreCase match:doMatch.
]
"Modified: / 28-02-2012 / 16:40:11 / cg"
!
browseMenuMethodsWithStringInHelpSpec
"launch an enterBox for string to search for"
|whereDefault|
whereDefault := self defaultSearchArea.
whereDefault == #classes ifTrue:[
(self hasAnyMethodSelectedForWhich:[:m | m mclass isPrivate]) ifTrue:[
whereDefault := #ownersWithPrivateClasses
]
].
self
askForMethodAndSpawnSearchTitle:'String to search for in help spec methods:'
browserLabel:'HelpSpec Methods containing "%1"'
searchWith:#findHelpSpecMethodsWithString:in:ignoreCase:match:
searchWhat:#string
searchArea:whereDefault
withCaseIgnore:true
setSearchPattern:[:brwsr :string :ignoreCase :doMatch|
brwsr autoSearchPattern:string ignoreCase:ignoreCase match:doMatch.
]
"Modified: / 28-02-2012 / 16:40:37 / cg"
!
browseMenuMethodsWithStringInMenuSpec
"launch an enterBox for string to search for"
|whereDefault|
whereDefault := self defaultSearchArea.
whereDefault == #classes ifTrue:[
(self hasAnyMethodSelectedForWhich:[:m | m mclass isPrivate]) ifTrue:[
whereDefault := #ownersWithPrivateClasses
]
].
self
askForMethodAndSpawnSearchTitle:'String to search for in menu spec methods:'
browserLabel:'MenuSpec Methods containing "%1"'
searchWith:#'findMenuSpecMethodsWithString:in:ignoreCase:match:'
searchWhat:#string
searchArea:whereDefault
withCaseIgnore:true
setSearchPattern:[:brwsr :string :ignoreCase :doMatch|
brwsr autoSearchPattern:string ignoreCase:ignoreCase match:doMatch.
]
"Modified: / 28-02-2012 / 16:40:54 / cg"
!
browseMenuMethodsWithStringLiteral
"launch an enterBox for code to search for"
|whereDefault|
whereDefault := SearchDialog lastCodeSearchArea ? #everywhere.
"/ whereDefault := self defaultSearchArea.
"/ whereDefault == #classes ifTrue:[
"/ ((self selectedMethods value ? #()) contains:[:anyMethod | anyMethod mclass isPrivate]) ifTrue:[
"/ whereDefault := #ownersWithPrivateClasses
"/ ]
"/ ].
self
askForMethodAndSpawnSearchTitle:'Search Matchstring in Literal-Strings:'
browserLabel:'Methods with Literal-String Matching'
searchWith:#( #'findStringLiteral:in:ignoreCase:match:' #'findStringLiteral:inMethods:ignoreCase:match:' )
searchWhat:#string
searchArea:whereDefault
withCaseIgnore:true
withTextEntry:true
withMethodList:true
setSearchPattern:[:brwsr :string :ignoreCase :doMatch|
brwsr autoSearchPattern:string ignoreCase:ignoreCase match:doMatch.
]
!
browseMenuMethodsWithTableSpec
"launch an enterBox for area to search in"
^ self
askForMethodAndSpawnSearchTitle:'Search for tableSpec methods in:'
browserLabel:(LabelAndIcon icon:(self class menuIcon) string:'TableSpecs')
searchWith:[:classes | self class findResource:#(tableColumns) in:classes]
searchArea:(self defaultSearchArea)
!
browseMenuMethodsWithUglyCodingStyle
|whereDefault|
whereDefault := self defaultSearchArea.
^ self
askForMethodAndSpawnSearchTitle:'Search for methods with ugly coding style in:'
browserLabel:'Methods with ugly coding style'
searchWith:[:classes |
self class
findMethodsIn:classes
where:[:cls :mthd :sel |
|note|
note := self methodHasUglyCodingStyle:mthd selector:sel inClass:cls.
note notNil
]
]
searchArea:whereDefault
!
browseMenuMethodsWithUserFilter
"launch an enterBox for area to search in"
|whereDefault filterBlockString filterBlock dialog textHolder template dummyMethod|
template :=
'"/ general method search;
"/ the following block should evaluate to true for all methods
"/ you want to browse. Please change as required.
"/ Beginner warning: Smalltalk know-how is useful here ;-).
[:class :method :selector |
"/ any condition using class, method or selector.
"/ Useful queries to the method are:
"/ - package the methods packageID
"/ - source to access its sourceCode
"/ - messagesSent a collection of sent messages (all)
"/ - messagesSentToSuper a collection of super messages
"/ - sendsSelector: query a particular message
"/ - referencesLiteral: query for direct literal access
"/ - refersToLiteral: query for direct or indirect literal access
"/ - literals the methods literal-array
"/ - usedGlobals a collection of used global names
false
"/ "/
"/ "/ example: search for methods which contain a string AND send a particular message
"/ "/
"/ (method source includesString:''Useful'')
"/ and:[ method sendsSelector:#for: ]
"/ "/
"/ "/ example: search for methods which send #foo AND #bar
"/ "/
"/ |msgSet|
"/ msgSet := method messagesSent.
"/ (msgSet includes:#foo) and:[msgSet includes:#bar]
"/ "/
"/ "/ example: search for methods which send #foo OR #bar
"/ "/
"/ |msgSet|
"/ msgSet := method messagesSent.
"/ (msgSet includes:#foo) or:[msgSet includes:#bar]
"/ "/ the same, but faster
"/ "/ (messagesSent requires a source-parse in contrast,
"/ "/ in contrast, referencesLiteral accesses the literalArray)
"/ "/ thus, prefiltering helps a lot.
"/ ((method referencesLiteral:#foo) or:[method referencesLiteral:#bar])
"/ and:[
"/ |msgSet|
"/ msgSet := method messagesSent.
"/ (msgSet includes:#foo) or:[msgSet includes:#bar]
"/ ]
"/ "/
"/ "/ example: search for methods which contain a string constant
"/ "/ which contains some string-fragment
"/ "/ (i.e. which method generates a particular message-string)
"/ |lits|
"/ lits := method literals.
"/ (lits contains:[:aLit | aLit isString and:[aLit asLowercase includesString:''error'']])
]
'.
LastMethodFilterBlockString isNil ifTrue:[
LastMethodFilterBlockString := template.
].
textHolder := ValueHolder new.
dialog := Dialog
forRequestText:(resources string:'Enter filterBlock')
editViewClass:CodeView
lines:25
columns:70
initialAnswer:LastMethodFilterBlockString
model:textHolder.
dialog addButton:(Button label:'Template' action:[textHolder value:template. textHolder changed:#value.]).
dialog open.
dialog accepted ifFalse:[^ self].
filterBlockString := textHolder value.
LastMethodFilterBlockString := filterBlockString.
dummyMethod := Compiler
compile:('dummy ^' , filterBlockString)
forClass:UndefinedObject
inCategory:nil
notifying:nil
install:false.
"/ filterBlock := Parser evaluate:filterBlockString.
"/ filterBlock isBlock ifFalse:[
(dummyMethod isMethod not
or:[(filterBlock := dummyMethod valueWithReceiver:nil arguments:nil) isBlock not])
ifTrue:[
self error:'bad input'.
^ self
].
whereDefault := self defaultSearchArea.
self
askForMethodAndSpawnSearchTitle:'Search for methods in:'
browserLabel:'Method-Search'
searchWith:[:classes |
self class
findMethodsIn:classes
where:[:cls :mthd :sel | filterBlock value:cls value:mthd value:sel ]
]
searchArea:whereDefault.
"Created: / 18.8.2000 / 21:26:37 / cg"
"Modified: / 18.8.2000 / 21:58:31 / cg"
!
browseMenuMethodsWithWindowSpec
"launch an enterBox for area to search in"
|whereDefault|
whereDefault := self defaultSearchArea.
^ self
askForMethodAndSpawnSearchTitle:'Search for GUI specs (windowSpec methods) in:'
browserLabel:(LabelAndIcon icon:(self class canvasIcon) string:'UISpecs') "'UISpecs'"
searchWith:[:classes | self class findResource:#canvas in:classes]
searchArea:whereDefault
!
browseMenuMethodsWithWrap
"add a new buffer on all wrapped methods
(i.e. that have a break, trace or watchPoint)"
self
spawnMethodBrowserForSearch:[
environment allMethodsForWhich:[:m | m isWrapped or:[m isMethodWithBreakpoints]].
]
sortBy:#class in:#newBuffer
label:'BreakPointed Methods'
!
browseMenuMethodsWithoutComment
"launch an enterBox for area to search in"
|whereDefault|
whereDefault := self defaultSearchArea.
^ self
askForMethodAndSpawnSearchTitle:'Search for methods without comment in:'
browserLabel:'Methods without comment'
searchWith:[:classes |
self class
findMethodsIn:classes
where:[:cls :mthd :sel |
(cls isMeta not or:[(AbstractSourceCodeManager isVersionMethodSelector:sel) not])
and:[ mthd comment size == 0 ]
]
]
searchArea:whereDefault
!
browseMenuOpenInClass
self searchMenuFindClass:#newBuffer "/ open new
!
browseMenuOverwrittenMethods:openHow
"browses extension methods which override a previously existing method from another package"
^ self
browseMethodsForWhich:[:mthd |
|cls def|
mthd isShadowingExtension
"/ mthd isExtension
"/ and:[ (cls := mthd mclass) notNil
"/ and:[ (def := cls theNonMetaclass projectDefinitionClass) notNil
"/ and:[ (def savedOverwrittenMethodForClass:cls selector:mthd selector) notNil ]]]
]
in:openHow
label:'Overwritten Methods (Package Conflicts)'
!
browseMenuRecentChanges
"launch a changeSet browser"
"/ ChangeSetBrowser open
(UserPreferences current changeSetBrowserClass) open
"Created: / 09-11-2001 / 02:22:08 / cg"
!
browseMenuReferencesToGlobal
"launch an enterBox for global to search for"
|labelHolder alreadyAsked searchAllLabel|
labelHolder := 'Methods referring to global ''%1''' asValue.
self
askForMethodAndSpawnSearchTitle:'Global to search:\(TAB for completion; matchPattern allowed)'
browserLabel:labelHolder
searchWith:[:string :classes :dummyIgnoreCase :dummyMatch|
|globlNames globlNamesAndSymbols globlName sym baseName matchBlock realClasses val
keysReferringToValue otherKeysReferringToValue msg searchAll|
globlNames := string withoutSeparators asCollectionOfSubstringsSeparatedByAny:',;| '.
globlNames size > 1 ifTrue:[
globlNames := globlNames collect:[:nm | nm asSymbol].
matchBlock := [:cls :mthd :sel |
|mSource usedGlobals|
mthd isLazyMethod ifTrue:[
mSource := mthd source.
(mSource notNil
and:[(globlNames contains:[:nm |
(mSource includesString:nm)
and:[
usedGlobals isNil ifTrue:[ usedGlobals := mthd usedGlobals].
usedGlobals includes:nm
]])]).
] ifFalse:[
globlNames contains:[:nm |
(mthd referencesLiteral:nm)
and:[
usedGlobals isNil ifTrue:[ usedGlobals := mthd usedGlobals].
usedGlobals includes:nm
]].
]
]
] ifFalse:[
globlName := globlNames first.
globlName knownAsSymbol ifFalse:[
globlName includesMatchCharacters ifFalse:[
^ self warn:'No such global (''' , globlName , ''')'.
].
matchBlock := [:cls :mthd :sel |
(mthd literals contains:[:lit | globlName match:lit])
and:[mthd usedGlobals contains:[:lit | globlName match:lit] ]
]
] ifTrue:[
searchAll := false.
sym := globlName asSymbol.
val := globlName lastIndexOf:$:.
val ~~ 0 ifTrue:[
baseName := (globlName copyFrom:val+1) asSymbol.
] ifFalse:[
baseName := sym.
].
(val := environment at:sym) isBehavior ifTrue:[
otherKeysReferringToValue := OrderedCollection new.
environment keysAndValuesDo:[:k :v | v == val ifTrue:[
(k ~~ sym and:[k ~~ #'Parser:PrevClass']) ifTrue:[
otherKeysReferringToValue add:k
]
]
].
otherKeysReferringToValue size > 0 ifTrue:[
keysReferringToValue := otherKeysReferringToValue copyWith:sym.
otherKeysReferringToValue size == 1 ifTrue:[
msg := '''%1'' also refers to that value. Search these references too ?'.
searchAllLabel := 'Methods referring to ''%1'' or ''%2''' bindWithArguments:keysReferringToValue.
] ifFalse:[
searchAllLabel := 'Methods referring to the value of ''%1'''.
otherKeysReferringToValue size <= 3 ifTrue:[
msg := (otherKeysReferringToValue copyButLast) asStringWith:', '.
msg := msg , ' and ' , otherKeysReferringToValue last.
msg := msg , ' also refer to that value. Search those references too ?'.
] ifFalse:[
msg := 'There are %2 other globals referring to that value. Search those references too ?'.
]
].
alreadyAsked isNil ifTrue:[
searchAll := Dialog
confirmWithCancel:(msg bindWith:otherKeysReferringToValue first with:otherKeysReferringToValue size)
default:true.
searchAll isNil ifTrue:[^ self].
alreadyAsked := searchAll.
] ifFalse:[
searchAll := alreadyAsked.
].
]
].
searchAll ifTrue:[
labelHolder value:searchAllLabel.
matchBlock := [:cls :mthd :sel |
"/ kludge: Lazy methods do not include symbols in the literal array - sigh
mthd isLazyMethod ifTrue:[
(mthd usedGlobals includesAny:keysReferringToValue)
] ifFalse:[
(keysReferringToValue contains:[:globl | mthd refersToLiteral:globl])
and:[mthd usedGlobals includesAny:keysReferringToValue]
]
]
] ifFalse:[
matchBlock := [:cls :mthd :sel | |mSource|
"/ kludge: Lazy methods do not include symbols in the literal array - sigh
mthd isLazyMethod ifTrue:[
mSource := mthd source.
(mSource notNil
and:[(mSource includesString:baseName)
and:[mthd usedGlobals includes:sym]])
] ifFalse:[
(((mthd referencesLiteral:baseName) or:[baseName ~~ sym and:[mthd referencesLiteral:sym]])
and:[mthd usedGlobals includes:sym])
]
]
]
].
].
"/ recollect realClasses from names (in case of class-changes)
realClasses := classes collect:[:eachClass | environment at:eachClass theNonMetaclass name].
self class
findMethodsIn:realClasses
where:matchBlock
]
searchWhat:#globalName
searchArea:#everywhere
withCaseIgnore:false
setSearchPattern:[:brwsr :string :ignoreCase :doMatch|
|globlNames|
globlNames := string withoutSeparators asCollectionOfSubstringsSeparatedByAny:',;| '.
brwsr autoSearchVariables:globlNames.
"/ brwsr autoSearchPattern:string ignoreCase:ignoreCase.
]
"Modified: / 5.11.2001 / 14:19:22 / cg"
!
browseMenuReferencesToSymbol
"launch an enterBox for symbol to search for"
self
askForMethodAndSpawnSearchTitle:'Symbol to search:'
browserLabel:'Methods referring to #''%1'''
searchWith:[:string :classes :dummyIgnoreCase :dummyMatch|
|sym stringToSearch searchBlock|
stringToSearch := string.
(string startsWith:'#') ifTrue:[
stringToSearch := Symbol readFrom:string.
Dialog information:'Searching for ',stringToSearch
].
(sym := stringToSearch asSymbolIfInterned) notNil ifTrue:[
searchBlock := [:cls :mthd :sel | |mSource|
"/ kludge: stc does not include symbols in the literal array - sigh
"/ (also: Lazy methods)
mthd byteCode isNil ifTrue:[
mSource := mthd source.
(mSource notNil
and:[(mSource includesString:(sym upTo:$:))
and:[mthd usedSymbols includes:sym]])
] ifFalse:[
((mthd refersToLiteral:sym)
and:[mthd usedSymbols includes:sym])
]
].
] ifFalse:[
stringToSearch includesMatchCharacters ifFalse:[
^ self warn:'No such symbol'.
].
searchBlock := [:cls :mthd :sel | |mSource|
"/ kludge: stc does not include symbols in the literal array - sigh
"/ (also: Lazy methods)
mthd byteCode isNil ifTrue:[
mSource := mthd source.
(mSource notNil
and:[mthd usedSymbols contains:[:sym | stringToSearch match:sym]])
] ifFalse:[
mthd usedSymbols contains:[:sym | stringToSearch match:sym]
]
].
].
self class
findMethodsIn:classes
where:searchBlock
]
searchWhat:#selector
searchArea:(self defaultSearchArea)
withCaseIgnore:false
setSearchPattern:[:brwsr :string :ignoreCase :doMatch|
brwsr autoSearchPattern:string ignoreCase:ignoreCase match:doMatch.
]
"Modified: / 25-11-2010 / 11:41:10 / cg"
!
browseMenuSharedPoolClasses
"add a new buffer on all shared pools"
self browseMenuClassesForWhich:[:cls | cls isSharedPool] label: 'Shared Pools'
"Created: / 18-04-2012 / 16:14:18 / cg"
!
browseMenuSpawnFullClassSource
"open a browser showing full classes (file-like)"
self spawnFullClassSourceBrowserIn:#newBrowser
"Created: / 24.2.2000 / 14:37:51 / cg"
!
browseMenuSpawnFullClassSourceInBuffer
"add a buffer showing full classes (file-like)"
self spawnFullClassSourceBrowserIn:#newBuffer
"Created: / 24.2.2000 / 14:38:09 / cg"
!
browseMenuSpawnRepositoryDiffs
^ self browseMenuSpawnRepositoryDiffsIn:#newBrowser
!
browseMenuSpawnRepositoryDiffsIn:where
|searchBlock|
searchBlock := [
|changes classes|
changes := ChangeSet current.
classes := IdentitySet new.
changes do:[:aChange |
|cls|
(aChange isMethodChange or:[aChange isClassChange]) ifTrue:[
(cls := aChange changeClass) notNil ifTrue:[
cls := cls theNonMetaclass.
(classes includes:cls) ifFalse:[
classes add:cls.
]
]
].
].
classes asOrderedCollection
].
^ self
spawnClassBrowserForSearch:searchBlock spec:#multipleClassRepositoryDiffBrowserSpec
sortBy:nil in:where label:'Repository Diffs' autoSelectIfOne:false
!
browseMenuSpawnRepositoryDiffsInBuffer
^ self browseMenuSpawnRepositoryDiffsIn:#newBuffer
!
browseMenuTestCaseClasses
"add a new buffer on all testcases"
self browseMenuClassesForWhich:[:cls | cls isTestCaseLike] label: 'TestCases'
"Modified: / 18-04-2012 / 16:16:33 / cg"
!
browseMenuUnassignedMethods:openHow
^ self
browseMethodsForWhich:[:mthd | mthd package = PackageId noProjectID]
in:openHow
label:'Loose methods'
"/ |searchBlock|
"/
"/ searchBlock := [
"/ |defaultId methods methodsInOrder|
"/
"/ methods := OrderedCollection new.
"/ defaultId := PackageId noProjectID.
"/
"/ environment allMethodsDo:[:mthd |
"/ mthd package = defaultId ifTrue:[
"/ methods add:mthd.
"/ ].
"/ ].
"/ methods
"/ ].
"/
"/ ^ self
"/ spawnMethodBrowserForSearch:searchBlock
"/ sortBy:#class
"/ in:openHow
"/ label:'Loose methods'
"/
"Modified: / 12-10-2006 / 20:51:48 / cg"
!
browseMenuWritesToGlobal
"launch an enterBox for global to search for writers"
|labelHolder|
labelHolder := 'Methods writing to global ''%1''' asValue.
self
askForMethodAndSpawnSearchTitle:'Global to search:\(TAB for completion; matchPattern allowed)'
browserLabel:labelHolder
searchWith:[:string :classes :dummyIgnoreCase :dummyMatch|
|globlNames globlNamesAndSymbols globlName sym baseName matchBlock realClasses val
keysReferringToValue otherKeysReferringToValue msg searchAll|
globlNames := string withoutSeparators asCollectionOfSubstringsSeparatedByAny:',;| '.
"/ globlNames size > 1 ifTrue:[
"/ globlNames := globlNames collect:[:nm | nm asSymbol].
"/ matchBlock := [:cls :mthd :sel |
"/ |mSource usedGlobals usesGlobal|
"/
"/ usesGlobal := false.
"/ mthd isLazyMethod ifTrue:[
"/ mSource := mthd source.
"/
"/ (mSource notNil
"/ and:[(globlNames contains:[:nm |
"/ (mSource includesString:nm)
"/ and:[
"/ usedGlobals isNil ifTrue:[ usedGlobals := mthd usedGlobals].
"/ usesGlobal := usedGlobals includes:nm
"/ ]])]).
"/ ] ifFalse:[
"/ globlNames contains:[:nm |
"/ (mthd referencesLiteral:nm)
"/ and:[
"/ usedGlobals isNil ifTrue:[ usedGlobals := mthd usedGlobals].
"/ usesGlobal := usedGlobals includes:nm
"/ ]].
"/ ].
"/ usesGlobal ifTrue:[
"/ ].
"/ ]
"/ ] ifFalse:[
"/ globlName := globlNames first.
"/ globlName knownAsSymbol ifFalse:[
"/ globlName includesMatchCharacters ifFalse:[
"/ ^ self warn:'No such global (''' , globlName , ''')'.
"/ ].
"/ matchBlock := [:cls :mthd :sel |
"/ (mthd literals contains:[:lit | globlName match:lit])
"/ and:[mthd usedGlobals contains:[:lit | globlName match:lit] ]
"/ ]
"/ ] ifTrue:[
"/ searchAll := false.
"/ sym := globlName asSymbol.
"/
"/ val := globlName lastIndexOf:$:.
"/ val ~~ 0 ifTrue:[
"/ baseName := (globlName copyFrom:val+1) asSymbol.
"/ ] ifFalse:[
"/ baseName := sym.
"/ ].
"/ (val := environment at:sym) isBehavior ifTrue:[
"/ otherKeysReferringToValue := OrderedCollection new.
"/ environment keysAndValuesDo:[:k :v | v == val ifTrue:[
"/ k ~~ sym ifTrue:[
"/ otherKeysReferringToValue add:k
"/ ]
"/ ]
"/ ].
"/ otherKeysReferringToValue size > 0 ifTrue:[
"/ keysReferringToValue := otherKeysReferringToValue copyWith:sym.
"/ otherKeysReferringToValue size == 1 ifTrue:[
"/ msg := '''%1'' also refers to that value. Search these references too ?'.
"/ searchAllLabel := 'Methods referring to ''%1'' or ''%2''' bindWithArguments:keysReferringToValue.
"/ ] ifFalse:[
"/ searchAllLabel := 'Methods referring to the value of ''%1'''.
"/ otherKeysReferringToValue size <= 3 ifTrue:[
"/ msg := (otherKeysReferringToValue copyWithoutLast:1) asStringWith:', '.
"/ msg := msg , ' and ' , otherKeysReferringToValue last.
"/ msg := msg , ' also refer to that value. Search those references too ?'.
"/ ] ifFalse:[
"/ msg := 'There are %2 other globals referring to that value. Search those references too ?'.
"/ ]
"/ ].
"/ alreadyAsked isNil ifTrue:[
"/ searchAll := Dialog
"/ confirmWithCancel:(msg bindWith:otherKeysReferringToValue first with:otherKeysReferringToValue size)
"/ default:true.
"/ searchAll isNil ifTrue:[^ self].
"/ alreadyAsked := searchAll.
"/ ] ifFalse:[
"/ searchAll := alreadyAsked.
"/ ].
"/ ]
"/ ].
"/ searchAll ifTrue:[
"/ labelHolder value:searchAllLabel.
"/ matchBlock := [:cls :mthd :sel |
"/ "/ kludge: Lazy methods do not include symbols in the literal array - sigh
"/ mthd isLazyMethod ifTrue:[
"/ (mthd usedGlobals includesAny:keysReferringToValue)
"/ ] ifFalse:[
"/ (keysReferringToValue contains:[:globl | mthd refersToLiteral:globl])
"/ and:[mthd usedGlobals includesAny:keysReferringToValue]
"/ ]
"/ ]
"/ ] ifFalse:[
"/ matchBlock := [:cls :mthd :sel | |mSource|
"/ "/ kludge: Lazy methods do not include symbols in the literal array - sigh
"/ mthd isLazyMethod ifTrue:[
"/ mSource := mthd source.
"/ (mSource notNil
"/ and:[(mSource includesString:baseName)
"/ and:[mthd usedGlobals includes:sym]])
"/ ] ifFalse:[
"/ (((mthd referencesLiteral:baseName) or:[baseName ~~ sym and:[mthd referencesLiteral:sym]])
"/ and:[mthd usedGlobals includes:sym])
"/ ]
"/ ]
"/ ]
"/ ].
"/ ].
matchBlock := self class
filterToSearchRefsTo:string
instVars:false
classVars:false
globals:true
poolVars:false
access:#write.
"/ recollect realClasses from names (in case of class-changes)
realClasses := classes collect:[:eachClass | environment at:eachClass name].
self class
findMethodsIn:realClasses
where:matchBlock
]
searchWhat:#globalName
searchArea:#everywhere
withCaseIgnore:false
setSearchPattern:[:brwsr :string :ignoreCase :doMatch|
|globlNames|
globlNames := string withoutSeparators asCollectionOfSubstringsSeparatedByAny:',;| '.
brwsr autoSearchVariables:globlNames.
"/ brwsr autoSearchPattern:string ignoreCase:ignoreCase.
]
"Created: / 29-09-2011 / 10:40:16 / cg"
!
browseMethodsForWhich:checkBlock in:openHow label:aString
|searchBlock|
searchBlock := [ environment allMethodsForWhich:checkBlock ].
^ self
spawnMethodBrowserForSearch:searchBlock
sortBy:#class
in:openHow
label:aString
!
browseResponseToIt
|selector|
selector := self selectedSelectorInCodeViewOrNil.
selector isNil ifTrue:[^ self].
self findResponseTo:selector
!
browseSendersOf
"launch an enterBox for selector to search for"
^ self
askForMethodAndSpawnSearchTitle:(resources string:'Selector to browse senders of:')
, '\'
, (resources string:'(TAB for completion; matchPattern allowed)')
browserLabel:'Senders of %1'
searchWith:#( #'findSendersOf:in:ignoreCase:match:' #'findSendersOf:inMethods:ignoreCase:match:' )
searchWhat:#selector
searchArea:#everywhere
withCaseIgnore:true
withTextEntry:true
withMethodList:true
setSearchPattern:[:brwsr :selector :ignoreCase :doMatch|
brwsr setSearchSelector:selector ignoreCase:ignoreCase doMatch:doMatch.
]
"Modified: / 20-08-2012 / 14:28:30 / cg"
!
browseSendersOfAny
|selectors|
selectors := self selectedMethodsValue collect:[:each | each selector].
false ifTrue:[
self setSearchSelector:selectors ignoreCase:false doMatch:true.
].
^ self
askForMethodAndSpawnSearchTitle:'Browse Senders of (any in selected):'
browserLabel:('Senders (any of %1 selectors)' bindWith:selectors size)
searchWith:[:ignoredString :classes :ignoredCase :match|
self class
findSendersOfAny:selectors
in:classes
ignoreCase:false
]
searchWhat:#selector
searchArea:#everywhere
withCaseIgnore:false
withTextEntry:false
withMethodList:false
setSearchPattern:[:brwsr :string :ignoreCase :doMatch|
brwsr setSearchSelector:selectors ignoreCase:ignoreCase doMatch:doMatch.
]
"Modified: / 28-02-2012 / 16:15:36 / cg"
!
classMenuSpawnBufferWithPoolVariableReferences
"search for classes importing the selectred pool(s)"
|pools|
pools := self selectedClasses value select:[:cls | cls isSharedPool].
self browseClassesReferringToAnyPool:pools in:#newBuffer
!
classMenuSpawnPoolVariableReferences
"search for classes importing the selectred pool(s)"
|pools|
pools := self selectedClasses value select:[:cls | cls isSharedPool].
self browseClassesReferringToAnyPool:pools in:#newBrowser
"Modified: / 18-11-2016 / 04:47:20 / cg"
!
defaultSearchArea
"return a useful default seach area"
self hasClassSelected ifTrue:[
^ #classes.
].
(navigationState isCategoryBrowser
and:[self hasCategorySelected]) ifTrue:[
^ #classCategories.
].
(navigationState isNameSpaceBrowser
and:[self hasNameSpaceSelected]) ifTrue:[
^ #currentNameSpace.
].
((navigationState isProjectBrowser or:[navigationState isProjectFullBrowser])
and:[self hasProjectSelected]) ifTrue:[
^ #currentPackage.
].
^ nil
!
findClassesForWhich:aBlock
|classes|
classes := IdentitySet new.
environment allClassesDo:[:eachClass |
(aBlock value:eachClass) ifTrue:[
classes add:eachClass
].
].
^ classes asOrderedCollection
!
findClassesWithoutClassMethod:selector
^ self findClassesForWhich:
[:eachClass |
(eachClass isMeta not
and:[eachClass isLoaded
and:[eachClass isNameSpace not
and:[(eachClass class includesSelector:selector) not]]])
].
!
pickViewAndBrowseApplicationClass
"let user click on a view, then browse its appliction class"
|view app|
view := Screen current viewFromUser.
view isNil ifTrue:[^ self].
(app := view application) isNil ifTrue:[
(app := view topView application) isNil ifTrue:[
Dialog information:'Neither widget nor its topview have an application'.
^ self
].
].
self createBuffer.
self switchToClass:app class selector:nil updateHistory:false.
!
pickViewAndBrowseWidgetClass
"let user click on a view, then browse its class"
|view|
view := Screen current viewFromUser.
view isNil ifTrue:[^ self].
self createBuffer.
self switchToClass:view class selector:nil updateHistory:false.
!
spawnClassDocumentationBrowserIn:where
"browse documentation;
where is: #newBrowser - open a new browser
where is: #newBuffer - add a new buffer"
|selectedClasses selectedCategories|
selectedClasses := self selectedNonMetaclasses.
selectedCategories := self selectedCategoriesValue copy.
^ self
newBrowserOrBufferDependingOn:where
label:nil
forSpec:#classDocumentationBrowserSpec
setupWith:[:brwsr |
brwsr selectCategories:selectedCategories.
brwsr selectClasses:selectedClasses.
]
"Modified: / 12-09-2006 / 13:44:08 / cg"
!
spawnClassExtensionBrowserFor:classes in:where
"browse extensions on selected classes;
where is: #newBrowser - open a new browser showing the projects
where is: #newBuffer - add a new buffer showing the projects"
|spec classList "singleSelection"|
spec := #multipleClassExtensionBrowserSpec.
"/ (singleSelection := projects size == 1) ifTrue:[
"/ spec := #singleProjectBrowserSpec.
"/ spec := #singleProjectFullBrowserSpec.
"/ ] ifFalse:[
"/ spec := #multipleProjectBrowserSpec.
"/ ].
classList := classes copy.
^ self
newBrowserOrBufferDependingOn:where
label: 'Class Extensions'
forSpec:spec
setupWith:[:brwsr |
|packageListGeneratorBlock|
"/ setup for a constant list ...
"/ brwsr organizerMode value:#project.
brwsr showClassPackages value:true.
brwsr classListGenerator value:classList.
packageListGeneratorBlock := [
|packages|
packages := Set new.
(brwsr selectedClasses value ? #()) do:[:eachClass |
packages add:eachClass package.
eachClass instAndClassSelectorsAndMethodsDo:[:sel :mthd |
packages add:mthd package
].
].
packages asOrderedCollection sort.
].
brwsr projectListGenerator value:(packageListGeneratorBlock value).
brwsr selectedClasses onChangeEvaluate:[brwsr projectListGenerator value:(packageListGeneratorBlock value).].
brwsr packageFilter value:#().
"/ singleSelection ifTrue:[
"/ brwsr selectProjects:projectList.
"/ ].
"/ brwsr packageFilter value:projectList.
]
"Modified: / 18.8.2000 / 18:48:40 / cg"
!
spawnClassExtensionBrowserForSearch:searchBlock label:labelOrNil in:where
"browse extensions on a searchBlock;
where is: #newBrowser - open a new browser showing the projects
where is: #newBuffer - add a new buffer showing the projects"
^ self
newBrowserOrBufferDependingOn:where
label:(labelOrNil ? 'Class Extensions')
forSpec:#multipleClassExtensionBrowserSpec
setupWith:[:brwsr |
|classListGenerator packageListGeneratorBlock theClassList|
classListGenerator := Iterator on:[:whatToDo |
theClassList isNil ifTrue:[
theClassList := searchBlock value.
].
theClassList notNil ifTrue:[
theClassList do:[:aClass |
whatToDo value:aClass
].
theClassList := nil.
].
].
"/ brwsr organizerMode value:#project.
brwsr showClassPackages value:true.
brwsr classListGenerator value:classListGenerator.
packageListGeneratorBlock := [
|packages|
packages := Set new.
(brwsr selectedClasses value ? #()) do:[:eachClass |
packages add:eachClass package.
eachClass instAndClassSelectorsAndMethodsDo:[:sel :mthd |
packages add:mthd package
].
].
packages asOrderedCollection sort.
].
brwsr projectListGenerator value:(packageListGeneratorBlock value).
brwsr selectedClasses onChangeEvaluate:[brwsr projectListGenerator value:(packageListGeneratorBlock value).].
brwsr packageFilter value:nil. "/ #().
]
"Modified: / 18.8.2000 / 18:48:40 / cg"
!
spawnFullClassSourceBrowserIn:where
"browse full classes (file-like);
where is: #newBrowser - open a new browser
where is: #newBuffer - add a new buffer"
|selectedClasses selectedCategories|
selectedClasses := self selectedNonMetaclasses.
selectedCategories := self selectedCategoriesValue copy.
^ self
newBrowserOrBufferDependingOn:where
label:nil
forSpec:#fullClassSourceBrowserSpec
setupWith:[:brwsr |
brwsr meta value:false.
brwsr selectCategories:selectedCategories.
brwsr selectClasses:selectedClasses.
]
"Modified: / 12-09-2006 / 13:43:48 / cg"
!
viewMenuSelectAllClasses
<resource: #obsolete>
! !
!NewSystemBrowser methodsFor:'menu actions-buffers'!
bufferMenuCreateBuffer
"add a new buffer"
self createBufferForCurrentClassOrSelectionInCodeView.
!
bufferMenuRemoveAllButBuffer:bNrToLeaveOpen
"remove all other than the numbered buffer"
buffers size to:1 by:-1 do:[:bNrToClose |
bNrToClose ~~ bNrToLeaveOpen ifTrue:[
(self
askIfModified:'Code was modified.\\Remove buffer anyway ?'
in:(buffers at:bNrToClose))
ifTrue:[
self removeBuffer:bNrToClose.
].
].
].
"Modified: / 11.2.2000 / 10:55:02 / cg"
!
bufferMenuRemoveBuffer:nr
"remove the numbered buffer"
buffers size > 0 ifTrue:[
(self
askIfModified:'Code was modified.\\Remove buffer anyway ?'
in:(buffers at:nr)
)
ifTrue:[
self removeBuffer:nr.
].
]
"Modified: / 11.2.2000 / 10:55:02 / cg"
!
bufferMenuRemoveCurrentBuffer
"remove the current buffer"
self bufferMenuRemoveBuffer:(selectedBuffer value)
!
bufferSelectionChanged
"switch buffers"
|nr|
nr := selectedBuffer value.
(nr notNil and:[nr between:1 and:buffers size]) ifTrue:[
navigationState := buffers at:selectedBuffer value.
self hasMethodSelectedHolder value:(self hasMethodSelected).
self browserCanvas value:(navigationState canvas).
self updateNavigationHistory.
self updateBookmarkHolder.
].
"/ self updateTestRunnerVisibility.
self updateExecuteMethodVisibility.
self updateInitSharedPoolVisibility.
self updateLaunchApplicationVisibility.
self updatePackageApplicationVisibility.
self updateToolBarButtonEnablement.
"/ force update of the menus orgMode aspect
"/ required since the menu has a single orgMode aspect,
"/ (i.e. there is no per-canvas menu).
self organizerModeForMenu changed.
navigationState codeModifiedHolder addDependent:self.
bufferUsageOrder removeIdentical:navigationState ifAbsent:nil.
bufferUsageOrder addFirst:navigationState.
"Modified: / 24-02-2000 / 18:52:16 / cg"
"Modified: / 27-02-2008 / 08:43:39 / janfrog"
"Modified: / 02-06-2011 / 22:34:58 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
createBuffer
"create/add a new buffer (i.e. tab with its own browser)"
^ self createBufferWithSpec:#fullBrowserSpec
!
createBufferForCurrentClassOrSelectionInCodeView
|cls selector|
cls := self selectedClassNameInCodeViewOrNil.
cls isNil ifTrue:[
"no text selected in codeview, select currently selected class and method"
cls := self theSingleSelectedClass.
selector := self theSingleSelectedMethodName.
].
self createBuffer.
cls notNil ifTrue:[
self switchToClass:cls selector:selector updateHistory:selector isNil.
]
!
createBufferWithSpec:aSpec
"create/add a new buffer (i.e. tab with its own browser) with a particular spec"
^ self createBufferWithSpec:aSpec setupFromCurrentState:true
"Modified: / 27-02-2008 / 08:43:21 / janfrog"
"Modified: / 02-06-2011 / 22:34:46 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 28-02-2012 / 10:21:42 / cg"
!
createBufferWithSpec:aSpec setupFromCurrentState:doSetup
"create/add a new buffer (i.e. tab with its own browser) with a particular spec.
If doSetup is true, navigate to the current state's entity there"
|bNameList oldNavigationState|
bNameList := self bufferNameList. "/ for lazy setup
buffers size == 0 ifTrue:[
"the original (initial) buffer is created here (lazy)"
buffers := OrderedCollection new.
bufferUsageOrder := OrderedCollection new.
navigationState canvasType isNil ifTrue:[
navigationState canvas:self browserCanvas value.
navigationState canvasType:(self browserCanvasType ? navigationState canvasType).
].
buffers add:navigationState.
bNameList add:(self currentBufferLabel).
bufferUsageOrder add:navigationState.
].
oldNavigationState := navigationState.
navigationState := NavigationState new.
navigationState canvasType:aSpec.
doSetup ifTrue:[self setupNavigationStateFrom:oldNavigationState ].
navigationState canvas:(self newCanvasWithSpec:aSpec).
buffers add:navigationState.
bNameList add:'no class'.
bufferUsageOrder addFirst:navigationState.
self selectedBuffer value:(buffers size).
self updateNavigationHistory.
self updateBookmarkHolder.
^ navigationState.
"Modified: / 29-02-2000 / 10:40:04 / cg"
"Modified: / 27-02-2008 / 08:43:21 / janfrog"
"Modified: / 02-06-2011 / 22:34:46 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Created: / 28-02-2012 / 10:21:08 / cg"
!
destroyTab:tabIndex
"destroy a buffer (i.e. tab)"
self bufferMenuRemoveBuffer:tabIndex
!
spawnFullBrowserInClass:aClass selector:selector in:openHow
|brwsr|
openHow == #newBrowser ifTrue:[
brwsr := self class openInClass:aClass selector:selector
] ifFalse:[
brwsr := self.
"/ brwsr createBuffer.
brwsr createBufferWithSpec:#fullBrowserSpec setupFromCurrentState:false.
brwsr selectedCategories value:nil. "/ kludge workaround; classList needs a change to update.
brwsr switchToClass:aClass selector:selector.
].
^ brwsr
"Modified: / 28-02-2012 / 10:22:24 / cg"
! !
!NewSystemBrowser methodsFor:'menu actions-category'!
categoryMenuCheckInEach
"check all classes of all selected categories into the default source repository"
self categoryMenuCheckInEachUsing:SourceCodeManagerUtilities default
!
categoryMenuCheckInEachUsingManager:aSourceCodeManagerOrNil
"check all classes of all selected categories into the source repository"
|classes|
(self askIfModified:'Code was modified.\\CheckIn (without that modification) anyway ?')
ifFalse:[^ self].
classes := IdentitySet new.
self selectedCategoryClassesDo:[:aClass | classes add:aClass].
classes isEmpty ifTrue:[
self warn:'No classes matched (all private classes)'.
^ self.
].
classes := classes asSortedCollection:[:a :b | a name < b name].
self classMenuCheckIn:true classes:classes usingManager:aSourceCodeManagerOrNil
"/ aSourceCodeManager utilities 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 categoryMenuCheckOutUsingManager:nil
!
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."
self categoryMenuCheckOutNewestUsingManager:nil
!
categoryMenuCheckOutNewestUsingManager:aSourceCodeManagerOrNilForDefault
"check-out the newest version of all classes in the selected category
from the source repository.
Offer chance to either overwrite the current version,
or merge-in the repository version.
"
|classes |
classes := self selectedCategoryClasses.
classes := classes reject:[:each | each isPrivate].
self checkOutClasses:classes askForRevision:false usingManager:aSourceCodeManagerOrNilForDefault
"Modified: / 11-07-2010 / 16:43:59 / cg"
!
categoryMenuCheckOutUsingManager:aSOurceCodeManagerOrNil
"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 usingManager:aSOurceCodeManagerOrNil
!
categoryMenuCleanUpChangeSet
"remove all changes for the selected category-class(es) from the changeSet"
(self confirm:'This will remove all changes for all classes from the selected categories from the internal changeSet.\(They will still be in the change-file, in case of emergency.)\\Really cleanup ?' withCRs)
ifFalse:[ ^ self].
self withWaitCursorDo:[
self selectedCategoryClassesDo:[:eachClass |
ChangeSet current condenseChangesForClass:eachClass
].
]
"Created: / 31-01-2011 / 11:10:13 / cg"
!
categoryMenuFileOutAs
"fileOut selected categories - standard format"
^ self categoryMenuFileOutAsWithFormat:nil
!
categoryMenuFileOutAsWithFormat:aFormatSymbolOrNil
"fileOut selected categories - file format as specified by the argument:
nil - standard format
#xml - XML standard format
#sif - SIF (smalltalk interchange file) standard format
#binary - ST/X binary format
"
|currentClassCategory fileName suffix saveName aStream classesToInitialize classesToFileout mgr|
currentClassCategory := self theSingleSelectedCategory.
currentClassCategory notNil ifTrue:[
fileName := currentClassCategory asString.
fileName replaceAll:Character space with:$_.
] ifFalse:[
fileName := 'someCategories'
].
aFormatSymbolOrNil == #xml ifTrue:[
suffix := '.xml'
] ifFalse:[
aFormatSymbolOrNil == #sif ifTrue:[
suffix := '.sif'
] ifFalse:[
aFormatSymbolOrNil == #binary ifTrue:[
suffix := '.cls'
] ifFalse:[
suffix := '.st'
]
]
].
fileName := fileName , suffix.
aFormatSymbolOrNil == #binary ifTrue:[
self error:'binary must go into separate files'.
^ self
].
saveName := self
fileNameDialogForFileOut:(resources string:'FileOut %1 as:' with:(currentClassCategory ? 'selected categories'))
default:fileName.
saveName isNil ifTrue:[
^ self
].
saveName isEmpty ifTrue:[
self warn:'Bad name given'.
^ self
].
FileSelectionBox lastFileSelectionDirectory:(saveName asFilename directoryName).
fileName := saveName.
classesToInitialize := OrderedCollection new.
classesToFileout := OrderedCollection new.
self selectedCategoryClassesDo:[:eachClassInCategory |
|eachClass|
eachClass := eachClassInCategory theNonMetaclass.
eachClass isPrivate ifFalse:[
eachClass isLoaded ifFalse:[
self warn:'Cannot fileOut unloaded class: %1\\skipped.' with:eachClass name allBold.
] ifTrue:[
classesToFileout add:eachClass.
(eachClass class includesSelector:#initialize) ifTrue:[
classesToInitialize add:eachClass
].
]
]
].
"
if file exists, save original in a .sav file
"
fileName asFilename exists ifTrue:[
self busyLabel:'saving existing %1' with:fileName.
fileName asFilename copyTo:(fileName , '.sav')
].
classesToFileout topologicalSort:[:a :b | b isSubclassOf:a].
aFormatSymbolOrNil == #xml ifTrue:[
self warn:'Not yet implemented: XML saving'.
^ self
].
aFormatSymbolOrNil == #sif ifTrue:[
mgr := SmalltalkInterchangeFileManager newForFileOut.
mgr fileName: fileName.
classesToFileout do:[:eachClass |
mgr addClass: eachClass.
].
self busyLabel:'writing...'.
mgr fileOut.
] ifFalse:[
[
aStream := fileName asFilename newReadWriteStream.
classesToFileout do:[:eachClass |
self busyLabel:'writing: %1' with:eachClass name.
eachClass fileOutOn:aStream withTimeStamp:true withInitialize:false.
aStream cr.
].
"/ all class-inits at the end
"/ (this makes certain, that all classes have been loaded
"/ before possibly used/needed in an initializer
classesToInitialize do:[:aClass |
aClass printClassNameOn:aStream. aStream nextPutAll:' initialize'.
aStream nextPutChunkSeparator.
aStream cr
].
aStream close.
] on:FileStream openErrorSignal do:[
self warn:'Cannot create: %1' with:fileName allBold
].
].
self normalLabel.
!
categoryMenuFileOutCypressAs
"automatically generated by UIEditor ..."
"*** the code below performs no action"
"*** (except for some feedback on the Transcript)"
"*** Please change as required and accept in the browser."
"*** (and replace this comment by something more useful ;-)"
"action to be added ..."
Transcript showCR:self class name, ': action for #categoryMenuFileOutCypressAs ...'.
Dialog warn:'unimplemented function'.
!
categoryMenuFileOutEachBinaryIn
"fileOut selected categories as individual files - binary format"
self categoryMenuFileOutEachInWithFormat:#binary
!
categoryMenuFileOutEachIn
"fileOut selected categories as individual files - st-source format"
self categoryMenuFileOutEachInWithFormat:nil
!
categoryMenuFileOutEachInWithFormat:aFormatSymbolOrNil
"fileOut selected categories as individual files"
|currentCategory dirName|
currentCategory := self theSingleSelectedCategory ? 'selected categories'.
dirName := self
askForDirectoryToFileOut:(resources string:'FileOut %1 in:' with:currentCategory)
default:nil.
dirName isEmptyOrNil ifTrue:[^ self].
self
fileOutEachClassIn:(self selectedCategoryClasses)
in:dirName
withFormat:aFormatSymbolOrNil.
"Modified: / 23-08-2006 / 12:31:28 / cg"
!
categoryMenuFileOutEachSIFIn
"fileOut selected categories as individual files - sif format"
self categoryMenuFileOutEachInWithFormat:#sif
!
categoryMenuFileOutEachVSEIn
"fileOut selected categories as individual files - visual smalltalk enterprise format"
self categoryMenuFileOutEachInWithFormat:#vse
!
categoryMenuFileOutEachXMLIn
"fileOut selected categories as individual files - xml format"
self categoryMenuFileOutEachInWithFormat:#xml
!
categoryMenuFileOutSIFAs
"fileOut selected categories - sif format"
^ self categoryMenuFileOutAsWithFormat:#sif
!
categoryMenuFileOutVSEAs
"fileOut selected categories - visual smalltalk enterprise format"
^ self categoryMenuFileOutAsWithFormat:#vse
!
categoryMenuFileOutXMLAs
"fileOut selected categories - xml format"
^ self categoryMenuFileOutAsWithFormat:#xml
!
categoryMenuLoad
"load autoloaded classes in the selected categories.
Invoked on doubleClick on a class or via the menu"
self loadClasses:self selectedCategoryClasses value.
"/ to force update.
"/ (I guess, this is not needed)
self selectedCategories changed.
"/ self selectedCategories value:(self selectedCategories value copy).
!
categoryMenuNewCategory
|box newCategory allClassCategories|
allClassCategories := environment 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"
!
categoryMenuRecompile
self selectedCategoryClassesDo:[:eachClass |
self recompileClass:eachClass
].
"Created: / 31-05-2012 / 12:03:11 / cg"
!
categoryMenuRecompileInstrumented
self selectedCategoryClassesDo:[:eachClass |
self recompileClassWithInstrumentation:eachClass
].
self showInfo:nil.
self askForGlobalCoverageRecording.
"Created: / 31-05-2012 / 09:15:44 / cg"
!
categoryMenuRemove
|box txt answer selectedCategories classes count categories includesBuiltIn
affectedSubClasses classesToReallyRemove|
selectedCategories := self selectedCategoriesValue asSet.
classes := IdentitySet new.
categories := Set new.
includesBuiltIn := false.
self selectedCategoryClassesDo:[:aClass |
classes add:aClass.
categories add:aClass category.
aClass isBuiltInClass ifTrue:[includesBuiltIn := true].
].
classes size == 0 ifTrue:[
"/ removing an empty category
self selectedCategories value:#().
self categoryListApp removeAdditionalCategories:selectedCategories.
^ self
].
"/ count affected sub-classes
affectedSubClasses := IdentitySet new.
classes do:[:aClassToRemove |
affectedSubClasses addAll:(aClassToRemove allSubclasses).
].
affectedSubClasses := affectedSubClasses reject:[:eachClass | classes includes:eachClass ].
count := affectedSubClasses size.
classes size == 1 ifTrue:[
txt := 'Really remove %1'.
] ifFalse:[
txt := 'Really remove %2 classes'.
].
count ~~ 0 ifTrue:[
txt := txt , '\(with %3 subclass'.
count ~~ 1 ifTrue:[
txt := txt , 'es in other categories)'
] ifFalse:[
txt := txt , ' - ', affectedSubClasses first name , ' - in category ''' , affectedSubClasses first category, ''')'
]
].
categories size > 1 ifTrue:[
txt := txt , ' in %4 categories'.
] ifFalse:[
txt := txt , ' in %5'.
].
txt := txt , ' ?'.
txt := (resources
string:txt
with:classes first name allBold
with:classes size printString
with:count
with:categories size printString
with:categories first) withCRs.
box := YesNoBox
title:txt
yesText:(resources string:'Remove')
noText:(resources string:'Cancel').
box label:(resources string:'Remove Class(es)').
answer := box confirm.
box destroy.
(answer and:[includesBuiltIn]) ifTrue:[
"/ ask again - severe damage is to be expected ...
answer := Dialog confirm:('The set of classes to remove includes at least one systemClass,\without which ST/X will fail to work.\Be prepared for a crash, if you proceed.\\Really remove ?' withCRs)
].
answer ifTrue:[
self withWaitCursorDo:[
classesToReallyRemove := OrderedCollection new.
"after querying user - do really remove the classes
and all subclasses
"
classes do:[:aClassToRemove |
|doRemove didRemove|
didRemove := false.
doRemove := true.
aClassToRemove withAllSubclassesDo:[:eachClass |
eachClass hasExtensions ifTrue:[
doRemove := self confirm:(resources string:'''%1'' has extensions (methods in other packages) - remove anyway ?' with:eachClass name).
]
].
doRemove ifTrue:[
"
query ?
"
aClassToRemove allSubclassesDo:[:aSubClass |
(CheckForInstancesWhenRemovingClasses == false
or:[aSubClass hasInstances not
or:[self confirm:(resources string:'''%1'' has instances - remove anyway ?' with:aSubClass name)
]]) ifTrue:[
classesToReallyRemove add:aSubClass
]
].
(CheckForInstancesWhenRemovingClasses == false
or:[aClassToRemove hasInstances not
or:[self confirm:(resources string:'''%1'' has instances - remove anyway ?' with:aClassToRemove name)
]]) ifTrue:[
didRemove := true.
classesToReallyRemove add:aClassToRemove
].
].
].
"/ classesToReallyRemove do:[:each |
"/ each removeFromSystem.
"/ ].
classesToReallyRemove notEmpty ifTrue:[
self removeClasses:classesToReallyRemove pullUpSubclasses:false
]
].
]
"Modified: / 11-07-2010 / 16:44:24 / cg"
!
categoryMenuRename
|categoriesToRename allCategories newCategory box
cancelAll guess combosList change numClasses|
self canUseRefactoringSupport ifTrue:[
change := CompositeRefactoryChange named:'Rename categories'.
].
numClasses := 0.
self withWaitCursorDo:[
categoriesToRename := self selectedCategoriesValue copy.
categoriesToRename do:[:eachCategory |
guess := DoWhatIMeanSupport
goodRenameDefaultFor:eachCategory
lastOld:LastCategoryRenameOld
lastNew:LastCategoryRenameNew.
guess isNil ifTrue:[
guess := eachCategory string.
].
allCategories := environment allClassCategories asArray sort.
combosList := LastCategoryRenames.
(combosList size > 0 and:[combosList includes:eachCategory]) ifFalse:[
combosList size == 0 ifTrue:[
combosList := List with:eachCategory
] ifFalse:[
combosList := (List with:eachCategory with:'-') , combosList
]
].
box := ListSelectionBox new.
box title:(resources string:'Rename category ''%1'' to:' with:eachCategory allBold).
box useComboBoxWithList:combosList.
box list:allCategories.
box okAction:[:sel | newCategory := sel].
box initialText:guess.
cancelAll := false.
categoriesToRename size > 1 ifTrue:[
|cancelAllButton|
cancelAllButton := Button label:(resources string:'Cancel All').
box addButton:cancelAllButton before:box cancelButton.
cancelAllButton action:[
cancelAll := true.
box doAccept.
box okPressed.
].
].
box label:(resources string:'Rename ClassCategory').
box showAtPointer.
cancelAll ifTrue:[^ self].
newCategory notNil ifTrue:[
newCategory := newCategory withoutSeparators asSymbol.
LastCategoryRenames isNil ifTrue:[
LastCategoryRenames := OrderedCollection new
].
LastCategoryRenames addFirst:newCategory.
LastCategoryRenames size > 20 ifTrue:[
LastCategoryRenames removeLast
].
LastCategoryRenameOld := eachCategory.
LastCategoryRenameNew := newCategory.
(self selectedClassesInCategories:(Array with:eachCategory)) do:[:aClass |
"/ must be loaded ...
aClass autoload
].
(self selectedClassesInCategories:(Array with:eachCategory)) do:[:aClass |
aClass category ~= newCategory ifTrue:[
numClasses := numClasses + 1.
change notNil ifTrue:[
change changeClassCategoryOf:aClass to:newCategory
] ifFalse:[
aClass category:newCategory.
].
]
].
numClasses == 0 ifTrue:[
self categoryListApp addAdditionalCategory:newCategory.
].
self selectedCategories value:(Array with:newCategory).
].
].
].
change notNil ifTrue:[
numClasses > 0 ifTrue:[
change name:('Rename category of %1 classes' bindWith:numClasses).
RefactoryChangeManager performChange:change
]
].
"Modified: / 06-02-2007 / 10:31:45 / cg"
!
categoryMenuRepositoryHistory
"sorry, but this seems to be hardwired for CVS"
self repositoryHistoryForProjects:nil usingManager:CVSSourceCodeManager
"Modified: / 12-09-2006 / 15:03:50 / cg"
!
categoryMenuRepositoryHistoryUsingManager:aSourceCodeManager
self repositoryHistoryForProjects:nil usingManager:aSourceCodeManager
!
categoryMenuRewrite
| classes |
classes := self selectedClassesInCategories: self selectedCategoriesValue.
MethodRewriter new
classes: classes;
open
"Created: / 21-07-2007 / 07:06:53 / janfrog"
"Modified: / 28-02-2012 / 17:01:34 / cg"
!
categoryMenuSmalllintCheck: what
"perform all checks on the selected class(es)."
self smalllintRun:what onEnvironment:self selectedCategoriesAsEnvironment
"Modified: / 28-12-2008 / 14:42:01 / bazantj <enter your email here>"
"Modified: / 13-01-2009 / 13:20:48 / Jiri Bazant <bazanj2@fel.cvut.cz>"
"Created: / 17-04-2010 / 10:32:22 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Created: / 05-05-2012 / 10:17:41 / 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.
environment allClassesAndMetaclassesDo:[:eachClass |
|cat|
cat := eachClass category.
(pattern match:cat) ifTrue:[
matchingCategories add:cat.
]
].
^ self spawnCategoryBrowserFor:matchingCategories in:openHow
!
categoryMenuUnload
"load autoloaded classes in the selected categories.
Invoked on doubleClick on a class or via the menu"
self unloadClasses:self selectedCategoryClasses value.
"/ to force update.
"/ (I guess, this is not needed)
self selectedCategories changed.
"/ self selectedCategories value:(self selectedCategories value copy).
!
categoryMenuUpdate
self categoryListApp removeAllAdditionalCategories; forceUpdateList
!
fileNameDialogForFileOut:tite default:defaultFileName
^ self fileNameDialogForFileOut:tite default:defaultFileName withCancelAll:nil
!
fileNameDialogForFileOut:title default:defaultFileName withCancelAll:cancelAllActionOrNil
|currentClassCategory saveName fileBox
defaultDir cancelAllButton|
defaultDir := FileSelectionBox lastFileSelectionDirectory.
defaultDir isNil ifTrue:[
"
this test allows a smalltalk to be built without Projects/ChangeSets
"
Project notNil ifTrue:[
defaultDir := Project currentProjectDirectory asFilename
].
defaultDir isNil ifTrue:[
defaultDir := Filename currentDirectory
]
].
currentClassCategory := self theSingleSelectedCategory.
UserPreferences current useNewFileDialog ifTrue:[
saveName := Dialog
requestFileName:title
default:defaultFileName
ok:(resources string:'FileOut')
abort:(resources string:'Cancel')
pattern:nil
fromDirectory:defaultDir.
saveName isEmptyOrNil ifTrue:[
saveName := nil
].
] ifFalse:[
fileBox := FileSelectionBox
title:(resources string:'FileOut %1 as:' with:(currentClassCategory ? 'selected categories'))
okText:(resources string:'FileOut')
abortText:(resources string:'Cancel')
action:[:fileName | saveName := fileName.].
fileBox initialText:defaultFileName.
fileBox directory:defaultDir.
cancelAllActionOrNil notNil ifTrue:[
cancelAllButton := Button label:(resources string:'Cancel All').
fileBox addButton:cancelAllButton before:fileBox cancelButton.
cancelAllButton action:[
cancelAllActionOrNil value.
fileBox doAccept.
fileBox okPressed.
].
].
fileBox showAtPointer.
fileBox destroy.
fileBox := nil.
].
^ saveName
!
fileOutEachClassIn:aCollectionOfClasses in:aDirectory withFormat:aFormatSymbolOrNil
"fileOut a bunch of classes as individual files into some directory"
|savedClasses owningClasses unsavedOwners answer|
savedClasses := aCollectionOfClasses select:[:eachClass | eachClass isPrivate not] as:IdentitySet.
owningClasses := aCollectionOfClasses
select:[:eachClass | eachClass isPrivate]
thenCollect:[:eachPrivateClass | eachPrivateClass topOwningClass]
as:IdentitySet.
unsavedOwners := owningClasses \ 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 stringWithCRs:'Cannot fileOut: %1\(%2)\\skipped.'
with:(eachClass name allBold)
with:ex description)
yesLabel:'ok' noLabel:'cancel'.
answer == false ifTrue:[
^ self
].
self normalLabel.
ex return.
] do:[
fn := (Smalltalk fileNameForClass:eachClass) , '.st'.
eachClass fileOutAs:(aDirectory asFilename constructString:fn).
]
]
].
self normalLabel.
"Modified: / 05-09-2011 / 22:01:27 / cg"
!
spawnCategoryBrowserFor:categories in:where
"browse selected category(ies);
where is: #newBrowser - open a new browser showing the categories
where is: #newBuffer - add a new buffer showing the categories"
|spec categoryList selectedClasses selectedProtocols selectedMethods
singleSelection|
(singleSelection := categories size == 1) ifTrue:[
spec := #singleCategoryBrowserSpec.
] ifFalse:[
spec := #multipleCategoryBrowserSpec.
].
categoryList := categories copy.
selectedClasses := self selectedClassesValue copy.
selectedProtocols := self selectedProtocols value copy.
selectedMethods := self selectedMethodsValue copy.
self
newBrowserOrBufferDependingOn:where
label:nil
forSpec:spec
setupWith:[:brwsr |
|allMeta|
"/ setup for a constant list ...
brwsr immediateUpdate value:true.
brwsr categoryListGenerator value:categoryList.
brwsr selectCategories:categoryList.
selectedClasses notNil ifTrue:[
allMeta := selectedClasses conform:[:aClass | aClass isMeta].
allMeta ifTrue:[
brwsr meta value:true.
]
].
selectedClasses size > 0 ifTrue:[brwsr selectClasses:selectedClasses].
selectedProtocols size > 0 ifTrue:[brwsr selectProtocols:selectedProtocols].
selectedMethods size > 0 ifTrue:[brwsr selectMethods:selectedMethods].
brwsr immediateUpdate value:false.
]
"Modified: / 28-02-2012 / 16:52:32 / 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-lint'!
loadSmalllint
|pkg |
pkg := Smalltalk at:#'stx_goodies_refactoryBrowser_lint'.
(pkg isNil or:[ pkg isFullyLoaded not ]) ifTrue:[
Smalltalk loadPackage:#'stx:goodies/refactoryBrowser/lint'
].
"
Tools::NewSystemBrowser basicNew loadSmallLint
"
"Created: / 17-04-2010 / 09:40:55 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified (comment): / 07-03-2012 / 20:06:11 / cg"
!
runLint
"Run previously selected rules or default rules on
currently selected code (depends on navigation state)"
^ self smalllintRun:self smalllintRulesOrDefaultHolder value
onEnvironment:self selectedCodeComponentsAsEnvironment
"Modified: / 07-03-2012 / 17:39:34 / cg"
"Modified: / 27-11-2014 / 10:20:12 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
setupSmalllintBrowser:browser byRuleFor:result
"configure a just created smallLint browser"
|selectedClassesHolder selectedMethodHolder methodGenerator
ruleGenerator "prevSelectedClasses" "prevMeta"|
selectedClassesHolder := browser selectedClasses.
selectedMethodHolder := browser selectedMethods.
ruleGenerator :=
Iterator on:[:whatToDo|
result failedRules do:whatToDo
].
methodGenerator :=
Iterator on: [:whatToDo|
| selectedRules selectedClasses failedMethods |
selectedClasses := selectedClassesHolder value.
selectedClasses notEmptyOrNil ifTrue:[
selectedRules := browser selectedLintRules value.
failedMethods := OrderedCollection new.
selectedRules ? #() do:[:rule|
rule isClassScope ifTrue:[
"/ show all methods then
selectedClasses do:[:eachClass |
failedMethods addAll:(
self hasMetaSelected
ifTrue:[ eachClass theMetaclass methodDictionary values]
ifFalse:[ eachClass theNonMetaclass methodDictionary values]).
].
] ifFalse:[
failedMethods addAll:
(rule failedMethodsInAnyOf: selectedClasses meta: self hasMetaSelected)
].
].
failedMethods do:[:mth|
whatToDo
value:mth containingClass
value:mth category
value:mth selector
value:mth
]
]
].
browser lintRuleListGenerator value:ruleGenerator.
browser selectorListGenerator value:methodGenerator.
selectedClassesHolder onChangeEvaluate:[
"/ |selectedRules selectedClasses meta|
"/
"/ selectedRules := browser selectedLintRules value ? #().
"/ selectedClasses := selectedClassesHolder value ? #().
"/ meta := self hasMetaSelected.
"/
"/ "/ really a new class selection (in contrast to just toggling meta)
"/ ((prevSelectedClasses ~= selectedClasses)
"/ and:[ prevMeta = meta ]) ifTrue:[
"/ "/ only one?
"/ selectedClasses size == 1 ifTrue:[
"/ "/ hello!! anyone out there?
"/ (selectedRules
"/ contains:[:rule |
"/ (rule failedMethodsInAnyOf: selectedClasses meta: meta)]
"/ ) ifFalse:[
"/ "/ no - try opposite meta side
"/ (selectedRules
"/ contains:[:rule |
"/ (rule failedMethodsInAnyOf: (selectedClasses collect:[:c | meta ifTrue:[c theMetaclass] ifFalse:[c theNonMetaclass]])
"/ meta: meta not)]
"/ ) ifTrue:[
"/ "/ yes - toggle meta
"/ self halt.
"/ ]
"/ ].
"/ ].
"/ ].
"/
browser selectorListGenerator changed:#value.
].
browser selectedLintRules
onChangeSend: #changed to: browser selectorListGenerator.
browser meta
onChangeSend: #changed to: browser selectorListGenerator.
selectedMethodHolder onChangeEvaluate:[
"/ update the info, depending on the rule's information
"/ self halt.
].
"/ cg: does not work - why?
result failedRules size == 1 ifTrue:[
"/ autoselect the first one
browser selectedLintRules value: result failedRules.
].
"Modified: / 22-07-2009 / 15:51:56 / Jan Vrany <vranyj1@fel.cvut.cz>"
"Created: / 02-02-2010 / 20:05:45 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 25-08-2010 / 10:30:33 / Jan Vrany <enter your email here>"
"Modified: / 01-03-2012 / 19:52:57 / cg"
"Modified: / 27-11-2014 / 10:26:02 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
smalllintRulesOrDefault
"Return last run rules or default ruleset if no checks has been run so far"
|lastRules default|
(Smalltalk at:#RBBuiltinRuleSet) isNil ifTrue:[
self loadSmalllint
].
(LastLintRulesHolder notNil
and:[ (lastRules := LastLintRulesHolder value) notNil ]) ifTrue:[
^ lastRules
].
default := UserPreferences current smallLintRulesetDefault.
default notNil ifTrue:[
^ default
].
^ RBBuiltinRuleSet rulesetBuiltinDefaultForSTX
"Created: / 28-02-2013 / 22:42:52 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 16-10-2014 / 10:45:28 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified (comment): / 27-11-2014 / 11:41:43 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
smalllintRulesOrDefaultHolder
"Return a holder on last run rules or on default ruleset if no checks has been run so far"
smalllintRulesOrDefaultHolder isNil ifTrue:[
LastLintRulesHolder isNil ifTrue:[ LastLintRulesHolder := ValueHolder new ].
smalllintRulesOrDefaultHolder := PluggableAdaptor
on: LastLintRulesHolder
getter: [:ignored | self smalllintRulesOrDefault ]
].
^ smalllintRulesOrDefaultHolder
"Created: / 28-02-2013 / 22:43:09 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 07-10-2014 / 13:11:43 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified (comment): / 27-11-2014 / 11:42:10 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
smalllintRun
"Run previously selected rules or default rules on
the currently selected code (depends on navigation state).
i.e. creates either a selectorEnvironment or a classEnvironment,
depending on the browser's navigation state"
^ self smalllintRunOnEnvironment: (self selectedCodeComponentsAsEnvironment)
"Created: / 27-11-2014 / 11:43:59 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
smalllintRun:ruleSetOrNil onEnvironment:rbEnvironment
"Run given SmallLint rules on given browser environment.
If `ruleSetOrNil` is nil then ask for the set of rules.
As a side effect, remembers run rules so next time user
does 'Run Again', these rules we be run."
|rule runRules environmentUsed |
ruleSetOrNil isNil ifTrue:[
| dialog |
dialog := Tools::LintRuleSelectionDialog new.
dialog open.
dialog accepted ifFalse:[
^ self
].
rule := dialog selectionAsRule
] ifFalse:[
rule := ruleSetOrNil.
].
LastLintRulesHolder isNil ifTrue:[
LastLintRulesHolder := ValueHolder new.
].
LastLintRulesHolder value:rule.
rule isEmptyInTree ifTrue:[
(self inlineMessageApp)
reset;
beInformation;
message:((resources string:'Ruleset ''%1'' is empty!!' with:rule name)
,(resources stringWithCRs:'\(or only broken rules where selected)'));
addButtonOK;
show.
^ self.
].
(environmentUsed := rbEnvironment) isClassEnvironment ifFalse:[
"/ change the environment to a class-environment?
(rule isClassScope
or:[
rule isMixedScope
and:[
(Dialog confirm:(resources stringWithCRs:'The rule contains class checks and method checks, ok to check whole classes?\(method checks will be applied to all methods in the classes - not only to the selected)'))
]
]) ifTrue:[
environmentUsed := rbEnvironment asClassEnvironment.
].
].
runRules :=
[
|msg|
"/ Run on a copy of the rule, because running a rule has the sideeffect
"/ of modifying the rule (storing in its result)
rule := rule copy.
self smalllintRunRule:rule onEnvironment:environmentUsed.
[ rule notNil and:[ rule isEmpty ] ] whileTrue:[
msg := 'Nothing special found.\\Proceed to select more/different lint rules.'.
(rule isClassScope or:[rule isMixedScope]) ifTrue:[
environmentUsed isClassEnvironment ifFalse:[
msg := 'Nothing special found.\Notice that the rule contains class checks, but only individual methods were checked.\\Proceed to select more/different lint rules\or cancel and select whole classes to be checked.'.
].
].
(Dialog confirm:(resources stringWithCRs:msg)) ifTrue:[
| dialog |
dialog := Tools::LintRuleSelectionDialog new.
dialog open.
dialog accepted ifTrue:[
rule := dialog selectionAsRule.
rule notNil ifTrue:[
"/ Run on copy, because running rules has a sideeffect
"/ of modifying the rule (storing in its result)
rule := rule copy.
self smalllintRunRule:rule onEnvironment:environmentUsed.
].
] ifFalse:[
rule := nil.
].
] ifFalse:[
rule := nil
].
].
rule notNil ifTrue:[
|browserTitle|
"/ Do this asynchronously, this is called from backgdound worker thread!!
browserTitle := resources string:'SmallLint results for %1' with:environmentUsed label.
self enqueueMessage: #spawnSmalllintBrowserByRuleFor:in:label:
for: self
arguments:{rule . #newBuffer . browserTitle}
].
].
"background operation (Jan's pref) makes it difficult to stop and debug...)"
UserPreferences current runLintChecksInBackground ifTrue:[
self showMessage:'Checking code...' whileExecutingBackgroundAction:runRules.
] ifFalse:[
self withWaitCursorDo:runRules
].
"Modified: / 15-12-2008 / 18:51:43 / Josef Grega <gregaj1@fel.cvut.cz>"
"Modified: / 28-12-2008 / 14:40:01 / bazantj <enter your email here>"
"Created: / 24-02-2009 / 11:02:57 / Jan Vrany <vranyj1@fel.cvut.cz>"
"Modified: / 22-07-2009 / 14:38:30 / Jan Vrany <vranyj1@fel.cvut.cz>"
"Modified: / 15-05-2012 / 10:46:02 / cg"
"Modified: / 27-11-2014 / 11:35:58 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
smalllintRunOnEnvironment:aBrowserEnvironment
"Run previously selected rules or default rules on given environment"
^ self smalllintRun: self smalllintRulesOrDefaultHolder value onEnvironment: aBrowserEnvironment
"Created: / 27-11-2014 / 11:46:54 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
smalllintRunRule: anRBLintRule onEnvironment: aBrowserEnvironment
"Internal helper: Actually run the given rule on given environment.
This is called from a background worker - see smallLintRun:onEnvironment:
"
| rules checker numClassesOverAll numRules
count lastPercentage timeOfLastFeedback anyWarning anyError anyInfo|
"/ make sure that smallLint is loaded
(Smalltalk at:#RBBuiltinRuleSet) isNil ifTrue:[
self loadSmalllint
].
"/ avoid direct class reference (for project-dependencies).
"/ checker := SmalllintChecker.
checker := (Smalltalk at:#SmalllintChecker).
rules := anRBLintRule flattened.
aBrowserEnvironment cacheClasses.
numRules := rules size.
numClassesOverAll := aBrowserEnvironment numberClasses * 2 "tests class AND metaclass" * numRules.
count := 0.
lastPercentage := nil.
timeOfLastFeedback := Timestamp now.
anyWarning := anyError := anyInfo := false.
rules withIndexDo:[:rule :index|
|t ruleName ruleClassName|
ruleName := rule name.
ruleClassName := rule class name.
"/ ProgressNotification new
"/ messageText: ('Checking: %1 (%2)' bindWith:ruleName with:ruleClassName);
"/ parameter: (index-1) / rules size * 100;
"/ raiseRequest.
[
checker
runRule: rule
onEnvironment: aBrowserEnvironment
progressFeedBackInto:[:classBeingChecked |
|msg percentage percentageRounded now numFound|
count := count + 1.
percentage := ((count-1) / numClassesOverAll * 100).
percentageRounded := percentage rounded.
(lastPercentage isNil
or:[
(lastPercentage ~= percentageRounded)
and:[
now := Timestamp now.
(now - timeOfLastFeedback > 100 milliseconds)
]
]
) ifTrue:[
lastPercentage := percentageRounded.
msg := ('Checking: ' withColor:Color grey)
, ruleName
, ((' (',ruleClassName,')') withColor:Color grey).
"/ ((numClassesOverAll < 10) or:[numRules == 1]) ifTrue:[
"/ msg := msg , ' in ',classBeingChecked name.
"/ ].
numFound := rule problemCount.
numFound ~~ 0 ifTrue:[
msg := msg , ' (', numFound printString,' found in ',count printString,' classes)'.
].
anyError ifFalse:[
rule isEmpty ifFalse:[
anyError := (rule severity == RBLintRule severityWarning).
anyError ifFalse:[
anyWarning ifFalse:[
anyWarning := (rule severity == RBLintRule severityWarning).
anyWarning ifFalse:[
anyInfo := true
].
].
].
].
].
ProgressNotification new
statusInfo:(anyError
ifTrue:[#error]
ifFalse:[
anyWarning
ifTrue:[#warning]
ifFalse:[ anyInfo ifTrue:[#info] ifFalse:[nil]]]);
messageText: msg;
parameter: percentage;
raiseRequest.
timeOfLastFeedback := now ifNil:[Timestamp now].
].
].
]
"/ value
benchmark:(rule name,': ')
].
ProgressNotification new
messageText: ('Done');
parameter: 100;
raiseRequest.
aBrowserEnvironment forgetCachedClasses.
"Modified: / 15-12-2008 / 18:51:43 / Josef Grega <gregaj1@fel.cvut.cz>"
"Modified: / 28-12-2008 / 14:40:01 / bazantj <enter your email here>"
"Modified: / 22-07-2009 / 14:38:30 / Jan Vrany <vranyj1@fel.cvut.cz>"
"Created: / 28-08-2010 / 12:12:51 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 14-10-2014 / 18:01:37 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified (comment): / 27-11-2014 / 11:38:51 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 19-11-2016 / 20:16:53 / cg"
!
smalllintRunSelectedOnEnvironment:aBrowserEnvironment
"Ask user for rules and run them on given environment"
^ self smalllintRun: nil onEnvironment: aBrowserEnvironment
"Created: / 27-11-2014 / 11:49:36 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
spawnSmalllintBrowserByRuleFor: result in:where label:labelOrNil
^ self
newBrowserOrBufferDependingOn:where
label:labelOrNil
forSpec: #smallLintByRuleResultBrowserSpec
setupWith:[:browser |
self setupSmalllintBrowser:browser byRuleFor:result.
]
"Modified: / 22-07-2009 / 15:51:56 / Jan Vrany <vranyj1@fel.cvut.cz>"
"Created: / 02-02-2010 / 20:05:45 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 25-08-2010 / 10:30:33 / Jan Vrany <enter your email here>"
"Modified: / 01-03-2012 / 19:52:57 / cg"
"Modified: / 27-11-2014 / 10:26:02 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!NewSystemBrowser methodsFor:'menu actions-checks-old'!
classMenuCheck
"perform a bunch of checks on the selected class(es).
This uses the old (more or less to be obsoleted) classChecker,
not the new SmallLint tool."
self classMenuCheck:#allChecks
"Modified (comment): / 01-03-2012 / 14:10:06 / cg"
!
classMenuCheck:whichCheck
"perform an individual check on the selected class(es).
This uses the old (more or less to be obsoleted) classChecker,
not the new SmallLint tool."
self classMenuCheckEach:(Array with:whichCheck)
"Modified: / 18-08-2000 / 22:44:19 / cg"
"Modified (comment): / 01-03-2012 / 14:10:14 / cg"
!
classMenuCheckAll
"perform all checks on the selected class(es).
This uses the old (more or less to be obsoleted) classChecker,
not the new SmallLint tool."
self classMenuCheck:#allChecks
"Modified (comment): / 01-03-2012 / 14:10:19 / cg"
!
classMenuCheckEach:aCollectionOfCheckSymbols
"perform a bunch of checks on the selected class(es).
This uses the old (more or less to be obsoleted) classChecker,
not the new SmallLint tool."
|classes theSingleClass lbl badMethodsGenerator badMethodInfoHolder badClassInfoHolder|
classes := self selectedClassesValue.
classes isEmptyOrNil ifTrue:[^ self].
(theSingleClass := self theSingleSelectedClass) notNil ifTrue:[
lbl := 'Check results of ' , theSingleClass name
] ifFalse:[
lbl := 'Checker result'
].
badMethodInfoHolder := ValueHolder new.
badClassInfoHolder := ValueHolder new.
badMethodsGenerator := [
|checker badMethodInfo badClassInfo badMethods|
checker := ClassChecker new.
self withWaitCursorDo:[
classes do:[:eachClass |
|cls|
cls := eachClass theNonMetaclass.
cls isLoaded ifTrue:[
self activityNotification:('checking ' , cls name , '...').
checker checkedClass:cls.
aCollectionOfCheckSymbols do:[:eachCheck |
checker doCheck:eachCheck
]
]
].
].
badClassInfo := checker badClassInfo.
badMethodInfo := checker badMethodInfo.
(badMethodInfo isEmptyOrNil and:[ badClassInfo isEmptyOrNil ]) ifTrue:[
"/ self information:'Nothing special found'.
badClassInfoHolder value:nil.
badMethodInfoHolder value:nil.
#().
] ifFalse:[
badClassInfoHolder value:badClassInfo.
badMethodInfoHolder value:badMethodInfo.
badMethodInfo size > 0 ifTrue:[
badMethods := badMethodInfo keys.
] ifFalse:[
badMethods := #()
].
badMethods
].
].
self
spawnMethodBrowserFor:badMethodsGenerator
in:#newBuffer
label:lbl
perClassInfo:badClassInfoHolder
perMethodInfo:badMethodInfoHolder
sortBy:#class
"Created: / 18-08-2000 / 22:43:56 / cg"
"Modified: / 28-02-2012 / 16:45:37 / cg"
"Modified (comment): / 01-03-2012 / 14:09:59 / cg"
!
classMenuCheckErrors
"perform error-checks on the selected class(es).
This uses the old (more or less to be obsoleted) classChecker,
not the new SmallLint tool."
self classMenuCheck:#errorChecks
"Modified (comment): / 01-03-2012 / 14:10:26 / cg"
!
classMenuCheckIndividual
"allow individual checks to be selected and perform those on the selected class(es).
This uses the old (more or less to be obsoleted) classChecker,
not the new SmallLint tool."
|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 isEmptyOrNil ifTrue:[^ self].
LastIndividualChecks := selectedChecks.
self classMenuCheckEach:selectedChecks.
"Modified: / 18-08-2000 / 22:44:36 / cg"
"Modified (comment): / 01-03-2012 / 14:10:31 / cg"
!
classMenuCheckStyle
"perform style-checks on the selected class(es).
This uses the old (more or less to be obsoleted) classChecker,
not the new SmallLint tool."
self classMenuCheck:#styleChecks
"Modified (comment): / 01-03-2012 / 14:10:36 / cg"
!
classMenuCheckWarnings
"perform warning-checks on the selected class(es).
This uses the old (more or less to be obsoleted) classChecker,
not the new SmallLint tool."
self classMenuCheck:#warningChecks
"Modified (comment): / 01-03-2012 / 14:10:43 / cg"
! !
!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.
environment changed:#classDefinition with:aClass
].
^ self
]
].
countSubClasses := aClass allSubclasses size.
t := 'Remove Class ''%1'''.
countSubClasses ~~ 0 ifTrue:[
removingSubclasses ifTrue:[
t := t , '\(with %2 subclass'.
] ifFalse:[
t := t , '\(and pull up %2 subclass'.
].
countSubClasses ~~ 1 ifTrue:[
t := t , 'es'
]
].
countPrivateClasses := aClass allPrivateClasses size.
countPrivateClasses ~~ 0 ifTrue:[
removingSubclasses ifFalse:[
self warn:('%1 has private classes - please make them public; then try again' bindWith:aClass name allBold).
^ self
].
countSubClasses ~~ 0 ifTrue:[
t := t , ' and'
] ifFalse:[
t := t , '\(with'
].
t := t , ' %3 private class'.
countPrivateClasses ~~ 1 ifTrue:[
t := t , 'es'
]
].
(countSubClasses ~~ 0 or:[countPrivateClasses ~~ 0]) ifTrue:[
t := t , ')'
].
t := t , ' ?'.
t := (resources
string:t
with:aClass name allBold
with:countSubClasses
with:countPrivateClasses) withCRs.
YesToAllConfirmation query ifTrue:[
] ifFalse:[
(countSubClasses ~~ 0 or:[countPrivateClasses ~~ 0 or:[withConfirm]]) ifTrue:[
withCancel ifTrue:[
confirmed := OptionBox
request:t
label:(resources string:'Remove Class')
image:(YesNoBox iconBitmap)
buttonLabels:(resources array:#('Cancel' 'No' 'Yes' 'Yes to All'))
values:#(nil false true #yesToAll)
default:false
onCancel:false.
"/ confirmed := Dialog confirmWithCancel:t default:false
] ifFalse:[
confirmed := Dialog confirm:t
].
confirmed isNil ifTrue:[
"/ cancelled
AbortOperationRequest raise
].
confirmed == #yesToAll ifTrue:[
YesToAllConfirmation notify.
confirmed := true.
].
confirmed ifFalse:[
^ self
]
].
].
didRemove := false.
includesBuiltIn := aClass isBuiltInClass.
aClass allSubclassesDo:[:aSubClass |
includesBuiltIn := includesBuiltIn or:[aSubClass isBuiltInClass]
].
includesBuiltIn ifTrue:[
"/ ask again - severe damage is to be expected ...
confirmed := Dialog
confirmWithCancel:'The set of classes to remove includes at least one systemClass,\without which ST/X will fail to work.\Be prepared for a crash, if you proceed.\\Really remove ?'
withCRs
default:false.
confirmed isNil ifTrue:[
"/ cancelled
AbortSignal raise
].
confirmed ifFalse:[
^ self
]
].
"/ check if any of the classes to remove has a repository container - warn about this if so
aClass withAllSubclassesDo:[:eachClassToRemove |
eachClassToRemove isPrivate ifFalse:[
eachClassToRemove revision notNil ifTrue:[
(removingSubclasses or:[eachClassToRemove == aClass])
ifTrue:[
(SourceCodeManagerUtilities sourceCodeManagerFor:eachClassToRemove) isContainerBased 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.
] ifFalse:[
confirmed := false.
].
confirmed isNil ifTrue:[
"/ cancelled
AbortSignal raise
].
confirmed ifTrue:[
(SourceCodeManagerUtilities sourceCodeManagerFor:eachClassToRemove)
utilities
removeSourceContainerForClass:eachClassToRemove
confirm:true
warn:true
]
]
].
]
].
"/ check if any of the classes to be removed from the ProjectDefinition
aClass withAllSubclassesDo:[:eachClassToRemove |
eachClassToRemove isPrivate ifFalse:[
|def|
def := eachClassToRemove projectDefinitionClass.
def notNil and:[
(eachClassToRemove ~~ def
and:[ def allClassNames includes:eachClassToRemove name ]) ifTrue:[
(Dialog confirm:(resources string:'Remove %1 from its Package definition ?'
with:eachClassToRemove name))
ifTrue:[
self excludeClasses: (Array with: eachClassToRemove) fromProject:def using:Compiler.
].
]
]
]
].
toRemove := IdentitySet new.
toRemove addAll:classesToRemove.
removingSubclasses ifTrue:[
aClass allSubclassesDo:[:aSubClass |
(CheckForInstancesWhenRemovingClasses == false
or:[ aSubClass hasInstances not
or:[ self confirm:(resources string:'''%1'' has instances - remove anyway ?'
with:aSubClass name allBold)
]]) ifTrue:[
classesToRemove add:aSubClass.
toRemove add:aSubClass
]
].
].
(CheckForInstancesWhenRemovingClasses == false
or:[ aClass hasInstances not
or:[ self confirm:(resources string:'''%1'' has instances - remove anyway ?'
with:aClass name allBold)
]]) ifTrue:[
didRemove := true.
aClass allPrivateClassesDo:[:eachPrivate |
classesToRemove addFirst:eachPrivate.
toRemove add:eachPrivate
].
classesToRemove add:aClass.
toRemove add:aClass
].
stillSearchingForMore := true.
[stillSearchingForMore] whileTrue:[
stillSearchingForMore := false.
more := IdentitySet new.
classesToRemove do:[:eachClass |
eachClass allPrivateClassesDo:[:eachPrivate |
classesToRemove addFirst:eachPrivate.
(toRemove includes:eachPrivate) ifFalse:[
toRemove add:eachPrivate.
more := true
]
]
]
]
"Modified: / 21-12-2011 / 20:22:34 / cg"
"Modified: / 17-10-2013 / 00:57:26 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
askForGlobalCoverageRecording
self globalCoverageRecordingIsEnabled value ifFalse:[
(Dialog confirm:(resources stringWithCRs:'Coverage recording can be done either during a single test-run, or globally for every process.\Currently, global recording is disabled, which means that recording will only be done during a special recording test-run (in the Testrunner tool).\\Do you want to enable global coverage recording now?'))
ifTrue:[
self debugMenuEnableGlobalCoverageRecording
]
].
!
askForSuperclassToGenerateTestMethod:selector
|newClass newClassName sup initial m
supers list currentClass reqString okLabel title|
"/ provide a reasonable default in the pull-down-list
currentClass := self anySelectedClass.
currentClass isNil ifTrue:[
m := self anySelectedMethod.
currentClass := m mclass.
].
LastMethodMoveOrCopyTargetClass notNil ifTrue:[
initial := environment 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 reversed.
currentClass isMeta ifTrue:[
supers := supers select:[:each | each isSubclassOf:Class].
].
supers := supers collect:[:cls | cls name].
list := supers.
self selectedClassesValue size > 1 ifTrue:[
reqString := 'Generate isXXX methods in which superclass ?'.
title := 'Generate isXXX methods'.
] ifFalse:[
reqString := 'Generate %1 method in which superclass ?'.
title := 'Generate %1 method'.
].
okLabel := 'Generate'.
newClassName := Dialog
request:(resources stringWithCRs:reqString with:selector)
initialAnswer:(initial ? '')
okLabel:(resources string:okLabel)
title:(resources string:title with:selector)
onCancel:nil
list:list
entryCompletionBlock:(DoWhatIMeanSupport classNameEntryCompletionBlock).
newClassName isNil ifTrue:[^ nil].
(newClassName startsWith:'---- ') ifTrue:[^ nil].
newClass := self classIfValidNonMetaClassName:newClassName.
newClass isNil ifTrue:[
^ nil
].
LastMethodMoveOrCopyTargetClass := newClass theNonMetaclass name.
^ newClass.
"Modified: / 28-02-2012 / 16:45:08 / cg"
!
browseClassPackagesResourceDirectoryOf:aClass
"open a filebrowser in the class package's resource directory"
|fileBrowser dir fn|
fileBrowser := UserPreferences fileBrowserClass.
dir := aClass theNonMetaclass packageDirectory.
(dir asFilename exists and:[(fn := dir / 'resources') exists]) ifTrue:[
fileBrowser openIn:fn
] ifFalse:[
fileBrowser openIn:dir
]
"Created: / 25-11-2016 / 15:05:01 / cg"
!
browseClassesPackageDirectoryOf:aClass
"open a filebrowser in the classes package directory"
|fileBrowser dir fn|
aClass package == PackageId noProjectID ifTrue:[
Dialog warn:'No project directory (the class is not assigned to any package).'.
^ self.
].
fileBrowser := UserPreferences fileBrowserClass.
dir := aClass theNonMetaclass packageDirectory.
dir isNil ifTrue:[
dir := Smalltalk packageDirectoryForPackageId:aClass package.
dir isNil ifTrue:[
Dialog warn:'No project directory (the class is not assigned to any package).'.
^ self.
].
].
(dir asFilename exists and:[(fn := dir / aClass classFilename) exists]) ifTrue:[
fileBrowser openOn:fn
] ifFalse:[
fileBrowser openIn:dir
]
"Created: / 25-11-2016 / 15:06:05 / cg"
!
checkCompilabilityOf:aClass errorsOnly:errorsOnly notify:warningCollector reportFailedMethodsInto:aBlock
"check compilability of aClass; write warning and errormessages to outStream.
(meant for a human to read)"
aClass theNonMetaclass withAllPrivateClassesDo:[:eachClass |
eachClass instAndClassSelectorsAndMethodsDo:[:aSelector :aMethod |
Parser warningSignal
handle:[:ex | self halt. ex proceed ]
do:[
aMethod source isEmpty ifTrue:[
aBlock value:aMethod value:('No source for method: ',aMethod whoString).
] ifFalse:[
eachClass compilerClass new
compile:aMethod source
forClass:aMethod mclass
inCategory:'others'
notifying:warningCollector
install:false
skipIfSame:false
silent:false
foldConstants:true
ifFail:[
aBlock value:aMethod value:('not compilable: ',aMethod whoString).
]
]
]
].
].
"Created: / 13-06-2012 / 13:12:42 / cg"
!
checkCompilabilityOf:aClass withExtensions:withExtensions errorsOnly:errorsOnly notify:warningCollector reportFailedMethodsInto:aBlock
"check compilability of aClass; write warning and errormessages to outStream.
(meant for a human to read)"
aClass theNonMetaclass withAllPrivateClassesDo:[:eachClass |
eachClass instAndClassSelectorsAndMethodsDo:[:aSelector :aMethod |
(withExtensions
or:[ aMethod package = aClass package
or:[ aMethod isExtension == PackageId noProjectID ]]) ifTrue:[
(Parser parseWarningSignal , UndefinedVariableNotification)
handle:[:ex | ex proceed ]
do:[
aMethod source isEmptyOrNil ifTrue:[
aBlock value:aMethod value:('No source for method: ',aMethod whoString).
] ifFalse:[
eachClass compilerClass new
compile:aMethod source
forClass:aMethod mclass
inCategory:'others'
notifying:warningCollector
install:false
skipIfSame:false
silent:false
foldConstants:true
ifFail:[
aBlock value:aMethod value:('not compilable: ',aMethod whoString).
]
]
]
]
].
].
"Created: / 13-06-2012 / 13:12:42 / cg"
!
checkCompilabilityOf:aClass withExtensions:withExtensions errorsOnly:errorsOnly outputTo:outStream
"check compilability of aClass; write warning and errormessages to outStream.
(meant for a human to read).
Returns a collection of failed methods (for browsing)"
|warningCollector failedMethods|
warningCollector := TextCollectingCompilationErrorHandler new.
warningCollector collectingStream:outStream.
warningCollector errorsOnly:errorsOnly.
failedMethods := OrderedCollection new.
self
checkCompilabilityOf:aClass
withExtensions:withExtensions
errorsOnly:errorsOnly
notify:warningCollector
reportFailedMethodsInto:[:failedMethod :message |
failedMethods add:failedMethod.
outStream nextPutLine:message
].
^ failedMethods
"Created: / 02-11-2010 / 13:11:17 / cg"
"Modified: / 13-06-2012 / 13:37:18 / cg"
!
checkCompilabilityOfAll:aCollectionOfClasses withExtensions:withExtensions errorsOnly:errorsOnly
"check compilability of aClass; write warning and errormessages to outStream.
(meant for a human to read)"
|stream|
stream := WriteStream on:(Text new:100).
self checkCompilabilityOfAll:aCollectionOfClasses withExtensions:withExtensions errorsOnly:errorsOnly outputTo:stream.
^ stream contents.
"Created: / 02-11-2010 / 13:14:47 / cg"
!
checkCompilabilityOfAll:aCollectionOfClasses withExtensions:withExtensions errorsOnly:errorsOnly outputTo:outStream
"check compilability of aClass; write warning and errormessages to outStream.
(meant for a human to read)
Returns a collection of failed methods (for browsing)"
|failedMethods|
failedMethods := OrderedCollection new.
aCollectionOfClasses do:[:eachClass |
self showInfo:('Checking compilability of %1...' bindWith:eachClass name).
failedMethods addAll:(self checkCompilabilityOf:eachClass withExtensions:withExtensions errorsOnly:errorsOnly outputTo:outStream).
].
^ failedMethods.
"Created: / 02-11-2010 / 13:11:47 / cg"
!
classCheckMenuSmalllintCheck: what
"perform all checks on the selected class(es)."
ClassEnvironment isNil ifTrue:[
Dialog warn:'Missing refactoryBrowser/browser package'.
^ self.
].
self smalllintRun:what onEnvironment:self selectedClassesAsEnvironment
"Modified: / 28-12-2008 / 14:42:01 / bazantj <enter your email here>"
"Modified: / 13-01-2009 / 13:20:48 / Jiri Bazant <bazanj2@fel.cvut.cz>"
"Created: / 17-04-2010 / 10:40:40 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 05-07-2011 / 13:52:16 / cg"
!
classClassDefinitionTemplateFor:aClass in:cat asNamespace:isNameSpace private:isPrivate
"common helper for newClass and newSubclass
- show a template to define a subclass of aClass in category cat.
Also, set acceptaction to install the class."
^ self
classClassDefinitionTemplateFor:aClass in:cat
asNamespace:isNameSpace private:isPrivate metaClassUsed:nil
!
classClassDefinitionTemplateFor:aClass in:cat asNamespace:isNameSpace private:isPrivate metaClassUsed:metaClassUsedOrNil
"common helper for newClass and newSubclass
- show a template to define a subclass of aClass in category cat.
Also, set the accept-action to install the class."
|theSuperClass|
(self askIfModified) ifFalse:[^ self ].
(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.
metaClassUsedOrNil notNil ifTrue:[
self codeView isCodeView2 ifTrue:[
| language |
language := ProgrammingLanguage all detect:[:lang | lang metaClass == metaClassUsedOrNil ] ifNone:[ theSuperClass programmingLanguage ].
self codeView languageHolder value: language.
].
].
self showCode:(self
classTemplateFor:theSuperClass
in:cat
asNamespace:isNameSpace
private:isPrivate
metaClassUsed:metaClassUsedOrNil).
self setAcceptActionForMetaClassUsed:metaClassUsedOrNil.
self codeAspect: SyntaxHighlighter codeAspectClassDefinition.
self codeView modified:true
"Modified: / 09-04-2014 / 12:58:12 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 04-06-2014 / 18:12:01 / cg"
!
classListMenuAddClassToList
"for classLists only: allow adding another class to the shown list"
|className class classList|
classList := self classListGenerator value.
self assert:classList isOrderedCollection.
className := self searchMenuFindClassToAdd.
className isNil ifTrue:[^ self].
class := environment at:className asSymbol ifAbsent:nil.
class isNil ifTrue:[
^ self warn:'No such class'
].
classList add:class.
classList sort:[:a :b | a name < b name].
self classListGenerator changed.
!
classListMenuRemoveClassesFromList
"for classLists only: allow removing class(es) from the shown list"
|classList classesToHide|
classList := self classListGenerator value.
self assert:classList isOrderedCollection.
classesToHide := self selectedClassesValue copy.
classesToHide do:[:classToHide |
classList removeIdentical:classToHide
].
classList sort:[:a :b | a name < b name].
self classListGenerator changed.
"Modified: / 28-02-2012 / 16:45:26 / cg"
!
classMenuBrowseClassPackagesResourceDirectory
"open a filebrowser in the class package's resource directory"
self browseClassPackagesResourceDirectoryOf:(self theSingleSelectedClass theNonMetaclass)
"Created: / 25-11-2016 / 13:31:12 / cg"
"Modified: / 25-11-2016 / 15:05:28 / cg"
!
classMenuBrowseClassesPackageDirectory
"open a filebrowser in the classes package directory"
self browseClassesPackageDirectoryOf:(self theSingleSelectedClass theNonMetaclass).
"Modified: / 25-11-2016 / 15:06:31 / cg"
!
classMenuChangeAspect:aspect
"show a classes comment/hierarchy/definition/... <aspect>"
|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
].
aspect == #classOwnershipGraph ifTrue:[
self showClassOwnershipGraph:cls.
^ self
].
aspect == #classRepositorySummary ifTrue:[
self showClassRepositorySummary:cls.
^ self
].
self error:'unknown aspect: ', aspect printString.
"Created: / 8.11.2001 / 23:02:46 / cg"
"Modified: / 8.11.2001 / 23:17:33 / cg"
!
classMenuCheckCompilability
"check compilability of selected classes (kludge - for me)"
|stream allMessages badMethods|
stream := WriteStream on:(Text new:100).
badMethods := self checkCompilabilityOfAll:(self selectedClasses value) withExtensions:true errorsOnly:true outputTo:stream.
allMessages := stream contents.
(TextBox openOn:allMessages title:'Errors and Warnings' readOnly:true).
badMethods notEmpty ifTrue:[
self spawnMethodBrowserFor:badMethods in:#newBuffer label:'Uncompilable Methods'
].
"Created: / 16-11-2006 / 14:53:21 / cg"
"Modified: / 13-06-2012 / 13:26:16 / cg"
"Modified: / 11-04-2012 / 15:00:39 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
classMenuCheckInBuildSupportFiles
self selectedNonMetaclassesDo:[:eachClass |
eachClass isProjectDefinition ifTrue:[
self projectMenuCheckInBuildSupportFilesForProject:eachClass package usingManager:nil.
]
]
"Created: / 09-08-2006 / 19:04:52 / fm"
"Modified: / 12-09-2006 / 13:53:28 / cg"
!
classMenuCheckInBuildSupportFilesUsingManager:aManagerOrNil
self selectedNonMetaclassesDo:[:eachClass |
eachClass isProjectDefinition ifTrue:[
self projectMenuCheckInBuildSupportFilesForProject:eachClass package definition:eachClass usingManager:aManagerOrNil
]
]
"Modified: / 11-10-2011 / 23:16:48 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Created: / 21-12-2011 / 20:28:09 / cg"
!
classMenuCheckInBuildSupportFilesUsingManagerNamed:sourceCodeManagerClassName
self classMenuCheckInBuildSupportFilesUsingManager:(self sourceCodeManagerNamed:sourceCodeManagerClassName)
"Created: / 22-12-2011 / 14:04:45 / cg"
!
classMenuChildrenToSiblings
|currentClass name subclasses|
currentClass := self theSingleSelectedLoadedNonMetaclassOrNil.
currentClass isNil ifTrue:[
self warn:'Cannot copy unloaded classes.'.
^ self
].
name := Dialog request:(resources
string:'Enter name for new parent class of "%1" and its subclasses:'
with:currentClass name allBold).
name isEmpty ifTrue: [^self].
subclasses := self selectSubclassesOf:currentClass.
subclasses isEmptyOrNil ifTrue: [^self].
self performRefactoring:
(ChildrenToSiblingsRefactoring name: name
class: currentClass
subclasses: subclasses).
self switchToClassNamed:name.
"/ meta: self isMeta
"/ categories: self categories
"Modified: / 01-03-2007 / 20:48:59 / cg"
!
classMenuCleanUpChangeSet
"remove all changes for the selected class(es) from the changeSet"
UserPreferences current avoidConfirmationsForExperiencedUsers ifFalse:[
DialogBox
withOptoutOption:[ UserPreferences current avoidConfirmationsForExperiencedUsers:true]
labelled:(resources string:'Do not show this confirmation again')
do:[
(self confirm:(resources stringWithCRs:'This will remove all changes for the selected class(es) from the changeSet.\\Really cleanup ?'))
ifFalse:[ ^ self].
].
].
self withWaitCursorDo:[
self selectedClassesDo:[:eachClass |
ChangeSet current condenseChangesForClass:eachClass
].
]
"Modified: / 18-11-2016 / 11:28:12 / cg"
!
classMenuComment
"show a classes comment.
changes the aspect to automatically show the comment when another class is selected."
self classMenuChangeAspect:#classComment
"Modified: / 8.11.2001 / 23:05:41 / cg"
!
classMenuCompareTwoSelectedClasses
"open a diff-textView comparing the selected class
against some other class (useful when refactoring subclasses)."
|sel class1 class2|
sel := self selectedNonMetaclasses value.
sel size == 2 ifTrue:[
class1 := sel first.
class2 := sel second.
self doCompareClass:class1 withClass:class2
]
"Modified: / 12-09-2006 / 13:52:57 / cg"
!
classMenuCompareWithClass
"open a diff-textView comparing the selected class
against some other class (useful when refactoring subclasses)."
|currentClass supers subs list otherClassName otherClass|
currentClass := self theSingleSelectedLoadedNonMetaclassOrNil.
currentClass isNil ifTrue:[
self warn:'Cannot compare unloaded classes.'.
^ self.
].
supers := (currentClass allSuperclasses reversed 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
requestClassName:(resources string:'Compare this class against which class:')
list:list
okLabel:(resources string:'Compare')
initialAnswer:(LastComparedClassName ? '').
"/ Dialog requst :(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].
LastComparedClassName := otherClassName.
otherClass := environment classNamed:otherClassName.
otherClass isNil ifTrue:[
self warn:'no such class: ', otherClassName.
^ self
].
otherClass := otherClass theNonMetaclass.
self doCompareClass:currentClass withClass:otherClass
"Modified: / 01-03-2007 / 20:49:25 / cg"
!
classMenuCompileLazyMethods
"compile selected classes' lazy methods (kludge - for me)"
self selectedClassesDo:[:eachClass |
eachClass instAndClassSelectorsAndMethodsDo:[:sel :mthd |
mthd isLazyMethod ifTrue:[
mthd makeRealMethod
]
]
].
!
classMenuCopyAs
"create a copy of the selected class."
|currentClass currentClassName owningClass newClassName newOwnerClass ownerName idx
newClass|
currentClass := self theSingleSelectedLoadedNonMetaclassOrNil.
currentClass isNil ifTrue:[
self warn:'Cannot copy unloaded classes.'.
^ self
].
currentClassName := currentClass name.
newClassName := currentClassName.
"/ (nameSpace := currentClass nameSpace) == environment ifTrue:[
"/ newClassName := 'CopyOf' , currentClassName.
"/ ] ifFalse:[
"/ newClassName := nameSpace name , '::' , 'CopyOf' , currentClass nameWithoutPrefix.
"/ ].
newClassName := Dialog
request:(resources string:'Copy class %1 as:' with:currentClassName allBold)
initialAnswer:newClassName.
(newClassName isEmptyOrNil or:[newClassName withoutSeparators = currentClassName]) ifTrue:[
^ self
].
(environment 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 withoutPrefix:(owningClass name , '::').
newOwnerClass := owningClass.
] ifFalse:[
(newClassName includes:$:) ifTrue:[
idx := newClassName lastIndexOf:$:.
ownerName := newClassName copyTo:idx.
[ownerName endsWith:$:] whileTrue:[ownerName := ownerName copyButLast].
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:[
(environment classNamed:ownerName) isNil ifTrue:[
(Dialog confirm:(resources
stringWithCRs:'No class or nameSpace named: "%1"\\Create as Namespace ?' with:ownerName))
ifFalse:[
^ self
].
newOwnerClass := NameSpace fullName:ownerName.
].
newOwnerClass := environment 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:[
Class packageQuerySignal answer:self theSingleSelectedProject do:[
newClass := self doCopyClass:currentClass as:newClassName privateIn:newOwnerClass.
].
].
self selectClass:newClass.
"Modified: / 24-05-2012 / 15:49:14 / cg"
!
classMenuCopyClassNamesToClipboard
|stream|
stream := '' writeStream.
self selectedClassesValue do:[:cls |
stream nextPutLine:(cls theNonMetaclass name)
].
self window setClipboardText:stream contents
!
classMenuCopySourceToClipboard
|stream|
stream := '' writeStream.
self selectedClassesValue do:[:cls |
cls theNonMetaclass fileOutOn:stream.
].
self window setClipboardText:stream contents
"Modified: / 28-02-2012 / 16:46:11 / cg"
!
classMenuDefinition
"show a classes definition;
changes the aspect to automatically show the definition when another class is selected."
self classMenuChangeAspect:#classDefinition
"Modified: / 8.11.2001 / 23:06:09 / cg"
"Created: / 8.11.2001 / 23:17:00 / cg"
!
classMenuDoUserProvidedAction
"ask for a block and evaluate it for all selected classes"
|actionBlockString actionBlock dialog textHolder template|
template :=
'"/ general class processing;
"/ the following block will be evaluated for every selected class.
"/ You can perform bulk operations classes there...
"/ Beginner warning: Smalltalk know-how is useful here.
[:class |
|mth oldSrc newSrc|
"/ "/ example (compile a special method into it)
"/ class
"/ compile:
"/''foo
"/ Transcript showCR:''''hello world''''
"/''
"/ categorized:''foo methods''.
"/ "/ make a backup
"/ self doCopyClass:class as:(class name,''_saved'') privateIn:nil.
"/ "/ change a string in some method
"/ mth := class compiledMethodAt:#foo.
"/ oldSrc := mthd source.
"/ newSrc := oldSrc copyReplaceString:''foobar'' withString:''foobaz''.
"/ class compile:newSrc classified:(mthd category).
].'.
textHolder := ValueHolder new.
dialog := Dialog
forRequestText:(resources string:'Enter actionBlock')
lines:25
columns:70
initialAnswer:(LastClassProcessingBlockString ? template)
model:textHolder.
dialog addButton:(Button label:'Template' action:[textHolder value:template. textHolder changed:#value.]).
dialog open.
dialog accepted ifFalse:[^ self].
actionBlockString := textHolder value.
LastClassProcessingBlockString := actionBlockString.
actionBlock := Parser evaluate:actionBlockString.
self assert:actionBlock isBlock message:'bad input'.
self selectedClassesDo:[:eachClass |
actionBlock value:eachClass
].
"Created: / 05-06-2012 / 17:30:17 / cg"
!
classMenuDocumentation
"show classes documentation (i.e. open doc-View on it)"
self
selectedClassesNonMetaDo:
[:cls |
self openClassDocumentationFor:cls
]
ifUnloaded:
[:cls |
true
]
ifPrivate:
[:cls |
]
!
classMenuEditResourceFiles
"fetch the class' package resource file for editing"
|files filename rsources|
files := Set new.
self selectedClassesValue do:[:eachClass |
|defClass directory|
(defClass := eachClass theNonMetaclass projectDefinitionClass) notNil ifTrue:[
rsources := defClass classResources.
].
rsources notNil ifTrue:[
rsources := rsources projectPack.
rsources notNil ifTrue:[
filename := rsources packsFileName.
]
].
filename isNil ifTrue:[
directory := Smalltalk getPackageDirectoryForPackage:(eachClass package).
filename := directory asFilename / 'resources' / (Smalltalk language, '.rs').
].
filename notNil ifTrue:[
files add:filename.
].
].
files isEmpty ifTrue:[
self warn:'No resource files'.
].
files do:[:eachFile |
UserPreferences fileBrowserClass openOn:eachFile
].
"Modified: / 28-06-2016 / 07:52:17 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
classMenuExcludeFromProject
|projectDefinitionClasses|
projectDefinitionClasses := self selectedClassesValue collect:[:cls | cls projectDefinitionClass] as:Set.
projectDefinitionClasses do:[:eachDefinitionClass |
|toExcludeForThis|
toExcludeForThis := self selectedClassesValue select:[:cls | cls projectDefinitionClass == eachDefinitionClass].
self
generateUndoableChange:(resources string:'Exclude %1 class(es) from Project %2' with:toExcludeForThis size with:eachDefinitionClass name)
overClasses:(Array with: eachDefinitionClass)
via:[:generator :projectDefinition |
self excludeClasses:toExcludeForThis fromProject:projectDefinition using:generator
].
].
"Created: / 19-02-2007 / 17:29:12 / cg"
"Modified: / 28-02-2012 / 16:46:23 / cg"
!
classMenuFileOutAs
"fileOut selected classes - standard format"
^ self classMenuFileOutAsWithFormat:nil
!
classMenuFileOutAsWithFormat:aFormatSymbolOrNil
"fileOut selected classes - file format as specified by the argument:
nil - standard format
#xml - XML standard format
#sif - SIF (smalltalk interchange file) standard format
#binary - ST/X binary format
"
|mode|
aFormatSymbolOrNil == #binary ifTrue:[
mode := Dialog choose:(resources string:'Save including sources ?')
labels:(resources array:#('Cancel' 'Discard' 'By file reference' 'Include source'))
values:#(nil #discard #reference #keep)
default:#keep.
mode isNil ifTrue:[^ self]. "/ cancelled
].
self
selectedClassesNonMetaDo:
[:cls |
self
fileOutClass:cls
askForFile:true
withCancelAll:(self selectedClassesValue 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 selectedClassesValue includes:owner) ifFalse:[
self warn:'Cannot fileOut private class: %1\\Please fileOut the owning class (%2).'
with:cls nameWithoutPrefix allBold
with:owner name.
]
]
"Modified: / 28-02-2012 / 16:46:20 / cg"
!
classMenuFileOutBeeAs
"fileOut selected classes - visual smalltalk enterprise file format"
^ self classMenuFileOutAsWithFormat:#bee
"Created: / 14-04-2015 / 12:49:32 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
classMenuFileOutBinaryAs
"fileOut selected classes - binary file format"
^ self classMenuFileOutAsWithFormat:#binary
!
classMenuFileOutBuildSupportFiles
self selectedNonMetaclassesDo:[:eachClass |
eachClass isProjectDefinition ifTrue:[
self projectMenuFileOutBuildSupportFilesForProject:eachClass package
]
]
!
classMenuFileOutEachBeeIn
"fileOut selected classes as individual files - visual smalltalk enterprise format"
self classMenuFileOutEachInWithFormat:#bee
"Created: / 14-04-2015 / 12:51:32 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
classMenuFileOutEachBinaryIn
"fileOut selected classes as individual files - binary format"
self classMenuFileOutEachInWithFormat:#binary
!
classMenuFileOutEachIn
"fileOut selected classes as individual files - st-source format"
self classMenuFileOutEachInWithFormat:nil
!
classMenuFileOutEachInWithFormat:aFormatSymbolOrNil
"fileOut selected classes as individual files"
|classes dirName|
classes := self selectedNonMetaclasses.
dirName := self
askForDirectoryToFileOut:(resources string:'FileOut %1 classes in:' with:classes size)
default:nil.
dirName isNil ifTrue:[^ self].
self
fileOutEachClassIn:classes
in:dirName
withFormat:aFormatSymbolOrNil.
"Modified: / 11-07-2010 / 16:44:33 / cg"
!
classMenuFileOutEachSIFIn
"fileOut selected classes as individual files - sif format"
self classMenuFileOutEachInWithFormat:#sif
!
classMenuFileOutEachVSEIn
"fileOut selected classes as individual files - visual smalltalk enterprise format"
self classMenuFileOutEachInWithFormat:#vse
!
classMenuFileOutEachXMLIn
"fileOut selected classes as individual files - xml format"
self classMenuFileOutEachInWithFormat:#xml
!
classMenuFileOutIn
"fileOut selected classes - standard format"
^ self classMenuFileOutInWithFormat:nil
!
classMenuFileOutInWithFormat:aFormatSymbolOrNil
"fileOut selected classes - file format as specified by the argument:
nil - standard format
#xml - XML standard format
#sif - SIF (smalltalk interchange file) standard format
#binary - ST/X binary format
"
self fileOutClasses:(self selectedNonMetaclasses) withFormat:aFormatSymbolOrNil
"Modified: / 12-09-2006 / 13:52:17 / cg"
!
classMenuFileOutSIFAs
"fileOut selected classes - smalltalk interchange file format"
^ self classMenuFileOutAsWithFormat:#sif
!
classMenuFileOutVSEAs
"fileOut selected classes - visual smalltalk enterprise file format"
^ self classMenuFileOutAsWithFormat:#vse
!
classMenuFileOutXMLAs
"fileOut selected classes - XML file format"
^ self classMenuFileOutAsWithFormat:#xml
!
classMenuGenerateAcceptVisitor
"create a visitor acceptor method"
self
generateUndoableChange:'Generate Accept-Visitor Method for %(singleClassNameOrNumberOfClasses)'
overSelectedClassesVia:[:generator :eachClass |
generator createAcceptVisitorMethodIn:eachClass theNonMetaclass
].
"Modified: / 21-01-2012 / 10:22:31 / 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
generateUndoableChange:'Generate Access Methods in %(singleClassNameOrNumberOfClasses)'
overSelectedClassesVia:[:generator :eachClass |
|names|
names := self variableFilter value.
names size == 0 ifTrue:[
names := eachClass instVarNames
].
generator
createAccessMethodsFor:names
in:eachClass
withChange:aBoolean
asValueHolder:asValueHolder
readersOnly:readersOnly
writersOnly:writersOnly
lazyInitialization:lazyInitialization
]
"Created: / 07-08-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 classMenuGenerateApplicationCodeForClasses:(self selectedClassesValue)
"Modified: / 28-02-2012 / 16:46:34 / cg"
!
classMenuGenerateApplicationCodeFor:cls using:generator
"create application code methods"
(cls isSubclassOf:WebApplicationModel) ifTrue:[
generator createWebApplicationCodeFor:cls.
^ self.
].
(cls isSubclassOf:HTTPService) ifTrue:[
generator createWebServiceCodeFor:cls.
^ self.
].
(cls isSubclassOf:ApplicationModel) ifTrue:[
generator createApplicationCodeFor:cls.
^ self.
].
(cls isSubclassOf:StandaloneStartup) ifTrue:[
generator createStandaloneStartupCodeFor:cls.
^ self.
].
"Modified: / 19-08-2011 / 01:58:40 / cg"
!
classMenuGenerateApplicationCodeForClasses:classes
"create application code methods"
self
generateUndoableChange:'Generate ApplicationCode in %(singleClassNameOrNumberOfClasses)'
overClasses:classes
via:[:generator :eachClass |
generator confirmChanges:false.
self classMenuGenerateApplicationCodeFor:(eachClass theNonMetaclass) using:generator
]
"Created: / 21-01-2012 / 11:09:47 / cg"
!
classMenuGenerateClassInitializationCode
"create #initialize method on the class side"
self
generateUndoableChange:'Generate Class Initializer in %(singleClassNameOrNumberOfClasses)'
overSelectedClassesVia:[:generator :eachClass |
generator createClassInitializeMethodIn:eachClass theMetaclass.
]
"Modified: / 21-01-2012 / 10:22:58 / cg"
!
classMenuGenerateClassTypeTestMethods
"create isXXX test- methods here and in subclasses"
|cls subclasses|
(cls := self theSingleSelectedLoadedNonMetaclassOrNil) isNil ifTrue:[
self information:'You must select a single (abstract) superclass'.
^ self.
].
subclasses := cls subclasses.
subclasses isEmpty ifTrue:[
self information:'(Abstract) superclass ' , cls name , ' has no subclasses.'.
^ self.
].
self
generateUndoableChange:'Generate ClassType Testers'
overSelectedClassesVia:[:generator :eachClass |
generator createClassTypeTestMethodsIn:cls theNonMetaclass forClasses:subclasses
].
"Modified: / 21-01-2012 / 10:23:07 / cg"
!
classMenuGenerateClassTypeTestMethodsForThisClass
"create isXXX test- methods here and in a superclass"
|cls sel superclass|
(cls := self theSingleSelectedClass) notNil ifTrue:[
sel := 'is' , cls nameWithoutPrefix.
] ifFalse:[
sel := 'isXXX'.
].
superclass := self askForSuperclassToGenerateTestMethod:sel.
superclass isNil ifTrue:[^ self].
self
generateUndoableChange:'Generate ClassType Testers'
overSelectedClassesVia:[:generator :eachClass |
generator createClassTypeTestMethodsIn:(superclass theNonMetaclass) forClasses:(Array with:eachClass)
].
"Modified: / 21-01-2012 / 10:23:15 / cg"
!
classMenuGenerateCopyrightMethod
"create copyright methods"
|copyRightText template|
template := SmalltalkCodeGeneratorTool copyrightTemplate.
copyRightText := Dialog
requestText:'Copyright-Text:'
lines:20 columns:80
initialAnswer:template.
copyRightText isEmptyOrNil ifTrue:[^ self].
SmalltalkCodeGeneratorTool copyrightTemplate:copyRightText.
self
generateUndoableChange:'Generate Copyright Method in %(singleClassNameOrNumberOfClasses)'
overSelectedClassesVia:[:generator :eachClass |
|metaClass |
metaClass := eachClass theMetaclass.
generator createCopyrightMethodFor:copyRightText for:metaClass.
]
"Modified: / 21-01-2012 / 10:23:22 / cg"
!
classMenuGenerateDocumentationMethodFromComment
"create documentation method from comment"
self
generateUndoableChange:'Generate Documentation method in %(singleClassNameOrNumberOfClasses)'
overSelectedClassesVia:[:generator :eachClass |
|cls|
cls := eachClass theMetaclass.
(cls includesSelector:#documentation) ifFalse:[
generator createDocumentationMethodFor:cls.
(cls includesSelector:#documentation) ifTrue:[
cls theNonMetaclass comment:nil
].
].
]
"Modified: / 21-01-2012 / 10:23:31 / cg"
!
classMenuGenerateDocumentationStubs
"create documentation methods"
self
generateUndoableChange:'Generate Documentation in %(singleClassNameOrNumberOfClasses)'
overSelectedClassesVia:[:generator :eachClass |
|metaClass |
metaClass := eachClass theMetaclass.
generator createDocumentationMethodsFor:metaClass.
"/ add examples method containing examples template
"/ but only if not already present.
generator createExamplesMethodFor:metaClass.
]
"Modified: / 21-01-2012 / 10:23:38 / cg"
!
classMenuGenerateEnumTypeCode
"create an enumeration type"
self
generateUndoableChange:'Generate EnumTypeCode in %(singleClassNameOrNumberOfClasses)'
overSelectedClassesVia:[:generator :eachClass |
|cls|
cls := eachClass theNonMetaclass.
generator createEnumTypeCodeFor:cls
]
"Modified: / 21-01-2012 / 10:23:45 / 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
!
classMenuGenerateInitializationMethod
"create initialize method"
self
generateUndoableChange:'Initialization Code for %(singleClassNameOrNumberOfClasses)'
overSelectedClassesVia:[:generator :eachClass |
generator createInitializationMethodIn:eachClass theNonMetaclass
].
"Modified: / 21-01-2012 / 10:23:53 / cg"
!
classMenuGenerateInitializeMethod
"create the initialize method"
self
generateUndoableChange:'Initializer for %(singleClassNameOrNumberOfClasses)'
overSelectedClassesVia:[:generator :eachClass |
generator createInitializationMethodIn:eachClass theNonMetaclass
].
"Modified: / 21-01-2012 / 10:24:01 / cg"
!
classMenuGenerateInitializedInstanceCreationMethods
"create new and initialize methods"
self
generateUndoableChange:'Initialized Instance Creation Code for %(singleClassNameOrNumberOfClasses)'
overSelectedClassesVia:[:generator :eachClass |
generator createInitializedInstanceCreationMethodsIn:eachClass theNonMetaclass
].
"Modified: / 21-01-2012 / 10:24:07 / cg"
!
classMenuGenerateIsAbstractMethod
"create #isAbstract method"
self
generateUndoableChange:'Make %(singleClassNameOrNumberOfClasses) abstract'
overSelectedClassesVia:[:generator :eachClass |
generator createIsAbstractMethodIn:eachClass theMetaclass
].
!
classMenuGenerateMultiSetterInstanceCreationMethod
"create a multi setter instance creation method for selected instvars."
|cls vars|
cls := self theSingleSelectedClass.
vars := cls allInstVarNames
select:[:var | self selectedVariables value includes:var].
self
generateUndoableChange:'Generate multi-setter instance creator'
overClasses:(Array with:cls)
via:[:generator :eachClass |
generator createMultiSetterInstanceCreationMethodFor:vars in:cls
].
!
classMenuGenerateMultiSetterMethod
"create a multi setter method for selected instvars."
|cls vars|
cls := self theSingleSelectedClass.
vars := cls allInstVarNames
select:[:var | self selectedVariables value includes:var].
self
generateUndoableChange:'Generate multi-setter'
overClasses:(Array with:cls)
via:[:generator :eachClass |
generator createMultiSetterMethodFor:vars in:cls
].
!
classMenuGenerateParametrizedInstanceCreationMethods
"create for: instance creation and initialize methods"
|selector|
selector := Dialog
requestSelector:'Name of Instance Creation Method:'
initialAnswer:'for:'.
selector isEmptyOrNil ifTrue:[^ self].
selector := selector asSymbol.
self
generateUndoableChange:'Parametrized Instance Creation Code for %(singleClassNameOrNumberOfClasses)'
overSelectedClassesVia:[:generator :eachClass |
generator createParametrizedInstanceCreationMethodsNamed:selector in:eachClass theNonMetaclass
].
"Modified: / 21-01-2012 / 10:24:15 / cg"
!
classMenuGeneratePoolInitializationCode
"create a Pool initialization template method"
self
generateUndoableChange:'Generate Pool Initialization in %(singleClassNameOrNumberOfClasses)'
overSelectedClassesVia:[:generator :eachClass |
|cls|
cls := eachClass theNonMetaclass.
generator createPoolInitializationCodeFor:cls
]
"Created: / 25-10-2006 / 09:24:48 / cg"
!
classMenuGenerateProjectDefinitions
self generateProjectDefinitionsIn:(self selectedClassesValue)
"Modified: / 28-02-2012 / 16:46:49 / cg"
!
classMenuGenerateRedefinedInstanceCreationMethods
"create redefined new methods"
self
generateUndoableChange:'Redefined Instance Creation for %(singleClassNameOrNumberOfClasses)'
overSelectedClassesVia:[:generator :eachClass |
generator createRedefinedInstanceCreationMethodsIn:eachClass theNonMetaclass
].
"Modified: / 21-01-2012 / 10:24:28 / cg"
!
classMenuGenerateRequiredProtocol
"create required protocol (all inherited subclassResponsibility methods)"
self
generateUndoableChange:'Generate Required Protocol in %(singleClassNameOrNumberOfClasses)'
overSelectedClassesVia:[:generator :eachClass |
generator createClassResponsibleProtocolFor:eachClass
]
"Modified: / 21-01-2012 / 10:24:37 / cg"
!
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
!
classMenuGenerateSingletonPatternInstanceCreationMethods
"create instance creation methods for singleton"
|singletonVarName|
singletonVarName := nil.
self
generateUndoableChange:'Singleton Pattern for %(singleClassNameOrNumberOfClasses)'
overSelectedClassesVia:[:generator :eachClass |
|theClass vars defaultNameForSingleton singletonVar|
"/ if any of the selected classes is a subclass of one of the previously processed,
"/ and we have added a class-instvar in the previous loop cycle,
"/ we have top refetch, because the class is now obsolete (stupid consequence of not having a
"/ good become).
"/ refetch to get the present class (sigh)
theClass := Smalltalk at:(eachClass theNonMetaclass name).
vars := theClass theMetaclass allInstanceVariableNames asNewSet.
vars removeAll:(Class allInstanceVariableNames).
(singletonVarName notNil and:[vars includes:singletonVarName]) ifTrue:[
defaultNameForSingleton := singletonVarName
] ifFalse:[
defaultNameForSingleton := 'theOneAndOnlyInstance'.
"/ vars add:'theOneAndOnlyInstance'.
].
singletonVar := Dialog
request:'Class-Instvar to keep Singleton in?'
initialAnswer:defaultNameForSingleton
list:(vars asSortedCollection).
singletonVar isEmptyOrNil ifTrue:[^ self].
(theClass theMetaclass allInstanceVariableNames asSet includes:singletonVar) ifFalse:[
theClass theMetaclass addInstVarName:singletonVar.
theClass := environment at:(eachClass theNonMetaclass name).
].
generator createSingletonPatternInstanceCreationMethodsIn:theClass usingVariable:singletonVar
].
"Created: / 10-02-2011 / 16:28:36 / cg"
!
classMenuGenerateStandardPrintOnMethod
self
generateUndoableChange:'Generate PrintOn Method for %(singleClassNameOrNumberOfClasses)'
overSelectedClassesVia:[:generator :eachClass |
generator createStandardPrintOnMethodIn:eachClass theNonMetaclass
].
"Modified: / 21-01-2012 / 10:24:51 / cg"
!
classMenuGenerateUpdateMethod
"create a standard update method template"
self
generateUndoableChange:'Generate%(numClassesOrEmpty)Update Method%(sForPlural)%(forSingleClassOrEmpty)'
overSelectedClassesVia:[:generator :eachClass |
generator createUpdateMethodIn:eachClass theNonMetaclass
].
"Modified: / 21-01-2012 / 10:24:58 / 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:(DoWhatIMeanSupport classNameEntryCompletionBlock).
visitorClass := self classIfValidNonMetaClassName:visitorClassName.
visitorClass isNil ifTrue:[^ nil].
LastVisitorClassName := visitorClassName.
self
generateUndoableChange:'Generate Visitor Pattern'
overSelectedClassesVia:[:generator :eachClass |
generator createVisitorMethodsIn:eachClass theNonMetaclass andVisitorClass:visitorClass
].
"Created: / 11-10-2001 / 22:26:08 / cg"
!
classMenuGenerateVisitorMethods2
"create visitor and visited methods"
|visitorClassName visitorClass|
visitorClassName := Dialog
request:'Name of Visitor class'
initialAnswer:(LastVisitorClassName ? '')
okLabel:(resources string:'Create')
title:'Visitor class'
onCancel:nil
list:#()
entryCompletionBlock:(DoWhatIMeanSupport classNameEntryCompletionBlock).
visitorClass := self classIfValidNonMetaClassName:visitorClassName.
visitorClass isNil ifTrue:[^ nil].
LastVisitorClassName := visitorClassName.
self
generateUndoableChange:'Generate Visitor Pattern'
overSelectedClassesVia:[:generator :eachClass |
generator createVisitorMethodsIn:eachClass theNonMetaclass andVisitorClass2:visitorClass
].
"Created: / 07-07-2009 / 20:41:47 / Jan Vrany <vranyj1@fel.cvut.cz>"
"Modified: / 21-01-2012 / 10:25:37 / cg"
!
classMenuHierarchy
"show a classes hierarchy.
changes the aspect to automatically show the hierarchy when another class is selected."
self classMenuChangeAspect:#classHierarchy
"Modified: / 8.11.2001 / 23:06:09 / cg"
!
classMenuIncludeInProject
|projectDefinitionClasses|
projectDefinitionClasses := self selectedClassesValue collect:[:cls | cls theNonMetaclass projectDefinitionClass] as:Set.
projectDefinitionClasses do:[:eachDefinitionClass |
|toIncludeForThis|
toIncludeForThis := self selectedClassesValue select:[:cls | cls theNonMetaclass projectDefinitionClass == eachDefinitionClass].
self
generateUndoableChange:(resources string:'Include %1 class(es) in Project %2 (Make Compiled Class)' with:toIncludeForThis size with:eachDefinitionClass name)
overClasses:(Array with: eachDefinitionClass)
via:[:generator :projectDefinition |
self includeClasses:toIncludeForThis inProject:projectDefinition using:generator
].
].
"Created: / 19-02-2007 / 16:46:16 / cg"
"Modified: / 28-02-2012 / 16:47:12 / cg"
!
classMenuInitialize
"reinit selected classes (kludge - for me)"
self selectedNonMetaclassesDo:[:eachClass |
(eachClass class includesSelector:#initialize) ifTrue:[
eachClass initialize.
]
].
"Modified: / 12-09-2006 / 13:51:50 / cg"
!
classMenuInitializeWithAllSubclasses
"reinit selected classes and all their subclasses (kludge - for me)"
self selectedNonMetaclassesDo:[:eachClass |
eachClass withAllSubclassesDo:[:cls |
(true "cls class includesSelector:#initialize") ifTrue:[
cls initialize
].
].
].
!
classMenuInsertNewSuperclass
"initiate the well known refactoring"
|selectedClasses superClasses superClass name existingClass|
selectedClasses := self selectedClassesValue.
selectedClasses do:[:each | each autoload].
superClasses := selectedClasses collect:[:c | c superclass].
superClasses asSet size > 1 ifTrue:[
Dialog warn:'Classes must have a common superclass'.
^ self
].
superClass := superClasses anElement.
name := Dialog request:(resources
string:'Enter name for new parent class of the selected class(es):').
name isEmpty ifTrue: [^self].
existingClass := environment classNamed:name.
existingClass notNil ifTrue:[
(Dialog confirm:(resources
string:'A Class named "%1" already exists - make the selected class(es) a subclass of it ?'))
ifFalse:[
^ self
].
].
self performRefactoring:
(AddClassRefactoring
addClass:name
superclass:superClass
subclasses:selectedClasses
category:(selectedClasses first category) "dialog categoryName").
self switchToClassNamed:name.
"/ meta: self isMeta
"/ categories: self categories
"Modified: / 28-02-2012 / 16:47:15 / cg"
!
classMenuInspectClass
"open an inspector on the class (useful to look at class instvars)"
|classes toInspect|
(classes := self selectedNonMetaclasses) size > 0 ifTrue:[
classes size == 1 ifTrue:[
toInspect := classes first.
] ifFalse:[
toInspect := classes
].
toInspect inspect
].
"Modified: / 12-09-2006 / 13:51:26 / cg"
!
classMenuInspectDerivedInstances
"open an inspector on all derived instances of the selected class(es)"
|classes insts|
classes := self selectedNonMetaclasses.
insts := OrderedCollection new.
classes do:[:eachClass |
insts addAll:(eachClass allSubInstances).
].
insts size == 0 ifTrue:[
self information:(resources string:'No instances or subInstances.')
] ifFalse:[
insts size == 1 ifTrue:[
insts first inspect.
] ifFalse:[
insts inspect
]
]
"Modified: / 12-09-2006 / 13:51:09 / cg"
!
classMenuInspectInstances
"open an inspector on all instances of the selected class(es)"
|classes insts|
classes := self selectedNonMetaclasses.
insts := OrderedCollection new.
classes do:[:eachClass |
insts addAll:(eachClass allInstances).
].
insts size == 0 ifTrue:[
self information:'No instances.'
] ifFalse:[
insts size == 1 ifTrue:[
insts first inspect.
] ifFalse:[
insts inspect
]
]
"Modified: / 12-09-2006 / 13:51:02 / cg"
!
classMenuInspectNewInstance
"open an inspector on a new instance of the selected class(es)"
self selectedNonMetaclasses do:[:eachClass |
eachClass new inspect
].
!
classMenuInspectReferencesToInstances
"open an inspector on all objects which contain a reference to
an instance of the selected class(es)"
|classes insts|
classes := self selectedNonMetaclasses.
insts := OrderedCollection new.
ObjectMemory garbageCollect.
ObjectMemory allObjectsDo:[:obj |
(classes contains:[:cls | (obj referencesInstanceOf:cls)])
ifTrue:[
insts add:obj
].
].
insts remove:(insts instVarAt:1) ifAbsent:nil.
insts size == 0 ifTrue:[
self information:'Noone references any instance of the selected class(es).'
] ifFalse:[
insts size == 1 ifTrue:[
insts first inspect.
] ifFalse:[
insts inspect
]
]
"Modified: / 12-09-2006 / 13:50:54 / cg"
!
classMenuInspectSubclasses
"open an inspector on all subclasses. Useful to look at classInstvars"
|classes toInspect|
(classes := self selectedNonMetaclasses) size > 0 ifTrue:[
toInspect := classes collectAll:[:cls | cls allSubclasses].
toInspect inspect
].
!
classMenuLoad
"load selected classes"
self classLoad
!
classMenuLoadProject
"load all classes from the selected project definitions"
(self selectedNonMetaclasses copy) do:[:cls |
cls autoload.
cls isProjectDefinition ifTrue:[
self activityNotification:('Loading ', cls description , '..').
cls load
].
].
"Modified: / 12-09-2006 / 13:50:41 / cg"
!
classMenuLoadSources
"fetches the source for all methods and keeps them in the method as string
(i.e. replacing the file+position reference by a real in-image string).
Needed when you want to overwrite the source file, to which the source-reference points to"
self selectedClassesDo:[:eachClass |
eachClass instAndClassMethodsDo:[:mthd |
mthd source:(mthd source)
]
]
!
classMenuMailTo
"fileOut selected classes (chunk format) and eMail to someone"
self
mailClasses:self selectedClassesValue
subject:'Class Source from Browser'
"Modified: / 28-02-2012 / 16:47:18 / cg"
!
classMenuMakeAutoloadedInProject
|projectDefinitionClasses|
projectDefinitionClasses := self selectedClassesValue collect:[:cls | cls theNonMetaclass projectDefinitionClass] as:Set.
projectDefinitionClasses do:[:eachDefinitionClass |
|toMakeAutoloadedForThis|
toMakeAutoloadedForThis := self selectedClassesValue select:[:cls | cls theNonMetaclass projectDefinitionClass == eachDefinitionClass].
self
generateUndoableChange:(resources string:'Make %1 class(es) autoloaded in %2' with:toMakeAutoloadedForThis size with:eachDefinitionClass name)
overClasses:(Array with: eachDefinitionClass)
via:[:generator :projectDefinition |
self makeClassesAutoloaded:toMakeAutoloadedForThis inProject:projectDefinition using:generator
].
].
"Created: / 30-08-2007 / 18:51:35 / cg"
!
classMenuMakePrivateIn
"make the selected class(es) private in another class."
|list newOwnerName newOwner currentClass supers subs newName classes|
currentClass := self theSingleSelectedClass.
currentClass isNil ifTrue:[
currentClass := self selectedClassesValue first
].
currentClass := currentClass theNonMetaclass.
supers := (currentClass allSuperclasses reversed collect:[:cls | cls name]).
subs := (currentClass allSubclasses collect:[:cls | cls name]).
list := supers.
(supers notEmpty and:[subs notEmpty]) ifTrue:[
list := list , (Array with:'---- ' , currentClass name , ' ----')
].
list := list , subs.
newOwnerName := Dialog
request:(resources string:'Make private in which class:')
initialAnswer:''
okLabel:(resources string:'OK')
title:(resources string:'Make class private')
onCancel:nil
list:list
entryCompletionBlock:(DoWhatIMeanSupport classNameEntryCompletionBlock).
newOwnerName isNil ifTrue:[^ self].
(newOwnerName startsWith:'---- ') ifTrue:[^ self].
newOwner := environment classNamed:newOwnerName.
newOwner isNil ifTrue:[
(currentClass nameSpace notNil and:[currentClass nameSpace ~~ Smalltalk]) ifTrue:[
newOwner := currentClass nameSpace classNamed:newOwnerName
].
].
newOwner isNil ifTrue:[
self warn:'No such class: ', newOwnerName.
^ self
].
classes := self selectedNonMetaclasses.
classes do:[:eachClass |
eachClass autoload.
newName := newOwner name , '::' , eachClass nameWithoutPrefix.
(environment classNamed:newName) notNil ifTrue:[
(environment classNamed:newName) ~~ eachClass ifTrue:[
self warn:'A class named ' , newName , ' already exists.'.
^ self
].
].
(newOwner == eachClass) ifTrue:[
self warn:'A class cannot be its own owner.'.
^ self
].
(newOwner topOwningClass == eachClass) ifTrue:[
self warn:'Cannot create mutual (cyclic) ownership.'.
^ self
].
].
classes do:[:eachClass |
newName := newOwner name , '::' , eachClass nameWithoutPrefix.
Smalltalk renameClass:eachClass theNonMetaclass to:newName.
eachClass theMetaclass setOwningClass:newOwner.
].
"Modified: / 28-02-2012 / 16:47:28 / cg"
!
classMenuMakePublic
"change a class from private to public;
check if a public class with the same name exists,
before doing this."
|nsName ns baseName|
self selectedNonMetaclassesDo:[:eachClass |
baseName := eachClass nameWithoutPrefix.
(ns := eachClass topOwningClass nameSpace) ~~ Smalltalk ifTrue:[
nsName := Dialog confirmWithCancel:(resources string:'Make public in ''Smalltalk'' or in its nameSpace ''%1'' ?' with:ns name)
labels:(Array with:'Cancel' with:'In Smalltalk' with:'In ' , ns name)
values:(Array with:nil with:Smalltalk with:ns)
default:3.
nsName isEmptyOrNil ifTrue:[^ self].
nsName isNameSpace ifTrue:[
ns := nsName
] ifFalse:[
ns := environment at:nsName.
].
].
(ns classNamed:baseName) notNil ifTrue:[
self warn:(resources
string:'A public class named ''%1'' already exists in %2.\\Please remove/rename that one first,\or rename the private class ''%1'' here\and try again.'
with:baseName with:ns name) withCRs.
] ifFalse:[
eachClass makePublicIn:ns
]
]
"Modified: / 04-07-2006 / 18:48:23 / fm"
"Modified: / 10-10-2007 / 21:56:23 / cg"
!
classMenuMakePublicIn
"change a class from private to public;
check if a public class with the same name exists, before doing this."
|nsName ns baseName|
nsName := self
askForNameSpace:(resources string:'Make classes public in which Namespace ?')
title:(resources string:'Move to Namespace')
initialText:(LastNameSpaceMove ? '').
nsName isEmptyOrNil ifTrue:[^ self].
ns := environment at:nsName asSymbol.
LastNameSpaceMove := nsName.
self selectedNonMetaclassesDo:[:eachClass |
baseName := eachClass nameWithoutPrefix.
(ns classNamed:baseName) notNil ifTrue:[
self warn:(resources
string:'A public class named ''%1'' already exists in %2.\\Please remove/rename that one first,\or rename the private class ''%1'' here\and try again.'
with:baseName with:ns name) withCRs.
] ifFalse:[
eachClass makePublicIn:ns
]
]
"Created: / 04-07-2006 / 18:48:23 / fm"
"Modified: / 11-02-2011 / 11:26:52 / cg"
!
classMenuMetrics
"show the classes' metrics summary.
Requires the OOM (an exept internal package) to be loaded"
|codeView resultStream |
OOM::MetricsSummaryGenerator isNil ifTrue:[
Dialog warn:('The metrics package is not loaded').
^ self
].
(self askIfModified:'Code was modified.\\Show metrics anyway ?') ifFalse:[^ self].
codeView := self codeView.
codeView contents:nil.
codeView modified:false.
navigationState realModifiedState:false.
"/
"/TODO:
"/ Number of top-level classes.
"/ Cyclomatic complexity.
"/ Total cyclomatic complexity.
resultStream := WriteStream on:''.
self
selectedClassesDo:[:eachClass |
|moduleAndPackage text metrics|
self busyLabel:'Computing metrics for ' , eachClass name , '...'.
Transcript showCR:'Computing metrics for ' , eachClass name , '...'.
metrics := OOM::MetricsSummaryGenerator new.
metrics computeMetricsForClasses:(Array with:eachClass).
text := metrics generateSummaryReport.
resultStream nextPutLine:'Class: ', eachClass name.
resultStream cr.
resultStream nextPutLine:text.
].
codeView contents:(resultStream contents).
codeView modified:false.
navigationState realModifiedState:false.
!
classMenuMoveToCategory
|allCategories box|
allCategories := environment 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 := environment classCategoryCompletion:s.
box contents:what first.
(what at:2) size ~~ 1 ifTrue:[
self builder window beep
]
].
box label:(resources string:'Change Class-Category').
box showAtPointer
"Modified: / 17.11.2001 / 12:21:48 / cg"
!
classMenuMoveToNamespace
"change the package-id of the selected classes.
Will eventually update the Project-object"
|newNameSpace ns|
newNameSpace := self
askForNameSpace:'Move class(es) to which nameSpace:'
title:(resources string:'Move to Namespace')
initialText:(LastNameSpaceMove ? '').
newNameSpace size == 0 ifTrue:[^ self].
ns := environment at:newNameSpace asSymbol.
ns isNil ifTrue:[
(self confirm:(resources string:'No such nameSpace exists.\\Create "%1" ?' with:newNameSpace) withCRs) ifFalse:[
^ self
].
ns := NameSpace name:newNameSpace asSymbol
] ifFalse:[
ns isNameSpace ifFalse:[
self warn:(resources string:'Not a NameSpace: %1' with:newNameSpace).
^ self
]
].
LastNameSpaceMove := newNameSpace.
self withWaitCursorDo:[
self selectedNonMetaclassesDo:[:classToMove |
|className doMove oldSym oldBaseSym|
classToMove isPrivate ifTrue:[
self warn:'Cannot move a private class - please move the owner.'.
] ifFalse:[
classToMove nameSpace ~~ ns ifTrue:[
className := classToMove nameWithoutPrefix.
"/ check if the target already exists - confirm if so.
doMove := true.
(ns at:className asSymbol) notNil ifTrue:[
doMove := self confirmWithCancel:(resources string:'Attention: a class named ''%1'' already present (in ''%2'' category).\\Move over it ?'
with:className allBold
with:ns name allBold) withCRs.
doMove isNil ifTrue:[
^ self
]
].
doMove ifTrue:[
oldSym := classToMove name asSymbol.
oldBaseSym := classToMove nameWithoutPrefix asSymbol.
"/
"/ renaming is actually more complicated as one might
"/ think (care for classVariables, privateClasses etc.)
"/ Smalltalk knows all about that ...
ns == Smalltalk ifTrue:[
Smalltalk renameClass:classToMove to:className asSymbol.
] ifFalse:[
Smalltalk renameClass:classToMove to:(ns name , '::' , className) asSymbol.
ns changed.
].
Smalltalk changed.
Transcript showCR:('searching for users of ' , oldSym); endEntry.
SystemBrowser browseReferendsOf:oldSym warnIfNone:false.
oldBaseSym ~= oldSym ifTrue:[
Transcript showCR:('searching for users of ' , oldBaseSym); endEntry.
SystemBrowser browseReferendsOf:oldBaseSym warnIfNone:false
]
]
]
]
]
]
"Modified: / 12-09-2006 / 13:49:01 / cg"
!
classMenuMoveToProject
"change the package-id of the selected classes.
Will eventually update the Project-object"
|newProject packages msg|
packages := self selectedClassesValue 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-02-2000 / 22:50:07 / cg"
"Modified: / 28-02-2012 / 16:47:31 / 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 := JavaVM classForName:'java.lang.Object'
] ifFalse:[
theClass := Object.
].
].
(metaClassUsedOrNil notNil and:[metaClassUsedOrNil == JavaMetaclass or:[metaClassUsedOrNil == GroovyMetaclass]]) ifTrue:[
JavaVM booted ifFalse:[
JavaVM boot
].
theClass isJavaClass not ifTrue:[
theClass := JavaVM classForName:'java.lang.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"
"Modified: / 09-04-2014 / 12:37:57 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
classMenuNewConsoleApplication
"create a class-definition prototype for a console application"
self
classClassDefinitionTemplateFor:StandaloneStartupHeadless
in:(self theSingleSelectedCategory ? 'Console Applications')
asNamespace:false
private:false.
self codeAspect:#newConsoleApplication.
!
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
!
classMenuNewLispClass
"create a class-definition template in codeview"
self classMenuNewClass:LispMetaclass
"Created: / 13-05-2012 / 12:53:17 / cg"
!
classMenuNewLispNamespace
"create a class-definition template in codeview"
self classMenuNewClass:LispNameSpace
"Created: / 01-06-2012 / 14:36:28 / cg"
!
classMenuNewNotification
"create a class-definition prototype for an exception class"
self
classClassDefinitionTemplateFor:Notification
in:(self theSingleSelectedCategory ? 'Exceptions')
asNamespace:false
private:false.
self codeAspect:#newNotification.
!
classMenuNewPLSQLObjectType
self classMenuNewClass:PLSQLObjectTypeMetaclass
!
classMenuNewPrivateClass
"create a class-definition prototype for a dialog"
self
classClassDefinitionTemplateFor:Object
in:nil
asNamespace:false
private:true.
!
classMenuNewSharedPool
"create a class-definition prototype for a shared pool"
self
classClassDefinitionTemplateFor:SharedPool
in:(self theSingleSelectedCategory ? 'Pools')
asNamespace:false
private:false.
"/ self codeAspect:#newSharedPool.
!
classMenuNewSmalltalkClass
"create a class-definition template in codeview"
self classMenuNewClass: Metaclass
"Created: / 30-08-2009 / 20:14:17 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
classMenuNewStandaloneStartupClass
"create a class-definition prototype for a standalone startup class"
self
classClassDefinitionTemplateFor:StandaloneStartup
in:(self theSingleSelectedCategory ? 'startup')
asNamespace:false
private:false.
self codeAspect:#newStandaloneApplication.
"Created: / 08-08-2011 / 07:46:47 / cg"
!
classMenuNewSubclass
"create a class-definition template in codeview"
|theClass cat metaClassUsedOrNil|
(theClass := self theSingleSelectedClass) isNil ifTrue:[
self javaMode ifTrue:[
theClass := Java at:'java.lang.Object'
].
theClass isNil ifTrue:[
theClass := Object.
].
] ifFalse:[
theClass := theClass theNonMetaclass.
metaClassUsedOrNil := theClass theMetaclass class.
].
self hasCategorySelected ifTrue:[
cat := self selectedCategoriesValue first
] ifFalse:[
cat := theClass category.
].
self
classClassDefinitionTemplateFor:theClass
in:cat
asNamespace:false
private:false
metaClassUsed:metaClassUsedOrNil
"Created: / 17.2.2000 / 23:25:33 / cg"
!
classMenuNewTestCase
"create a class-definition prototype for a testCase"
TestCase isNil ifTrue:[ Smalltalk loadPackage:'stx:goodies/sunit' ].
TestCase autoload.
self
classClassDefinitionTemplateFor:TestCase
in:(self theSingleSelectedCategory ? 'TestCases')
asNamespace:false
private:false.
self codeAspect:#newTestCase.
"Modified: / 16-10-2006 / 12:24:31 / cg"
!
classMenuNewWebApplication
"create a class-definition prototype for a web page"
self
classClassDefinitionTemplateFor:WebApplicationModel
in:(self theSingleSelectedCategory ? 'WebServices')
asNamespace:false
private:false.
self codeAspect:#newWebApplication.
!
classMenuNewWebService
"create a class-definition prototype for a web application"
HTTPService isNil ifTrue:[ Smalltalk loadPackage:'stx:goodies/webServer' ].
HTTPService autoload.
self
classClassDefinitionTemplateFor:HTTPService
in:(self theSingleSelectedCategory ? 'WebServices')
asNamespace:false
private:false.
self codeAspect:#newWebService.
"Modified: / 09-04-2011 / 10:46:22 / cg"
!
classMenuNewWidgetClass
"create a class-definition prototype for a widget"
self
classClassDefinitionTemplateFor:View
in:(self theSingleSelectedCategory ? 'Views-Misc')
asNamespace:false
private:false.
self codeAspect:#newWidget.
!
classMenuOpenClassCreationWizard
|dialog newClassName superclassName superclass package namespace namespaceName
namespacePrefix createdClass category language|
dialog := NewClassWizardDialog new.
dialog masterApplication:self.
dialog categoryHolder value:(self theSingleSelectedCategory).
dialog packageHolder value:(self theSingleSelectedProject).
dialog openModal.
dialog accepted ifFalse:[^ self].
language := dialog language.
newClassName := dialog classNameHolder value withoutSeparators.
superclassName := dialog superclassNameHolder value withoutSeparators.
superclass := environment classNamed:superclassName.
package := (dialog packageHolder value ? '') withoutSeparators.
namespaceName := (dialog nameSpaceHolder value ? 'Smalltalk') withoutSeparators.
category := (dialog categoryHolder value ? '* as yet unspecified *') withoutSeparators.
(namespaceName = 'Smalltalk') ifTrue:[
namespacePrefix := ''
] ifFalse:[
namespacePrefix := namespaceName , '::'
].
namespace := NameSpace name:namespaceName.
Class packageQuerySignal answer:package
do:[
|builder|
builder := ClassBuilder new.
builder metaclass:(language metaClass).
builder
name:(namespacePrefix,newClassName) asSymbol
inEnvironment:namespace
subclassOf:superclass
instanceVariableNames:(dialog instVarNamesHolder value)
variable:false
words:false
pointers:false
classVariableNames:(dialog classVarNamesHolder value)
poolDictionaries:''
category:category
comment:nil
changed:true
classInstanceVariableNames:(dialog classInstVarNamesHolder value).
createdClass := builder buildClass.
].
createdClass isNil ifTrue:[^ self ].
self switchToClass:createdClass.
Class packageQuerySignal answer:package
do:[
self
generateUndoableChange:'Generate Code for %(singleClassNameOrNumberOfClasses)'
overClasses:(Array with:createdClass)
via:[:generator :cls |
|theNonMetaclass theMetaclass inheritedInitializeMethod|
theNonMetaclass := cls theNonMetaclass.
theMetaclass := cls theMetaclass.
dialog createAccessors ifTrue:[
generator
createAccessMethodsFor:(cls instVarNames)
in:cls
withChange:false
asValueHolder:false
readersOnly:false
writersOnly:false
lazyInitialization:false.
].
dialog createInitializer ifTrue:[
inheritedInitializeMethod := cls theMetaclass responseTo:#new.
(inheritedInitializeMethod isNil or:[ (inheritedInitializeMethod sendsSelector:#initialize) not ]) ifTrue:[
generator createInitializedInstanceCreationMethodsIn:theNonMetaclass
] ifFalse:[
generator createInitializationMethodIn:theNonMetaclass
].
generator createClassInitializeMethodIn:theMetaclass.
].
dialog createUpdateMethod ifTrue:[
generator createUpdateMethodIn:theNonMetaclass
].
dialog createRequiredMethods ifTrue:[
generator createClassResponsibleProtocolFor:theNonMetaclass
].
dialog createInitialGUICode ifTrue:[
self classMenuGenerateApplicationCodeFor:theNonMetaclass using:generator
].
].
].
"Modified: / 29-12-2011 / 13:48:54 / cg"
!
classMenuOpenTestRunner
"open a test runner on the selected class (you can also double click on a testCase class)"
|cls|
cls := self theSingleSelectedClass.
cls isNil ifTrue:[ ^ self ].
self classMenuOpenTestRunnerOn:cls
!
classMenuOpenTestRunnerOn:aClass
"open a test runner on aClass (you can also double click on a testCase class)"
|cls|
cls := aClass theNonMetaclass.
(cls isTestCaseLike and:[cls isAbstract not]) ifTrue:[
|testRunner|
testRunner := UserPreferences current testRunnerClass.
testRunner notNil ifTrue:[
testRunner openOnTestCase:cls.
]
].
!
classMenuOwnershipGraph
"show a classes ownership graph/trend.
changes the aspect to automatically show the ownership graph when another class is selected."
self classMenuChangeAspect:#classOwnershipGraph
!
classMenuPerforceSubmit
|utilities|
PerforceSourceCodeManager notNil ifTrue:[
utilities := PerforceSourceCodeManager utilities.
self withActivityNotificationsRedirectedToInfoLabelDo:[
utilities submit.
].
]
"Created: / 09-08-2006 / 19:04:52 / fm"
"Modified: / 12-09-2006 / 13:53:28 / cg"
!
classMenuPrimitiveCode:aspect
"show the classes primitiveFunction in the codeView.
Also, set accept action to change it."
(self askIfModified:'Code was modified.\\Show ' , aspect , ' anyway ?')
ifFalse:[^ self].
self selectedMethods value:nil.
self selectProtocols:nil.
self
showClassPrimitive:aspect
class:(self theSingleSelectedClass theNonMetaclass)
!
classMenuPrimitiveDefinitions
"show the classes primitiveDefinition in the codeView.
Also, set accept action to change it."
self classMenuPrimitiveCode:#primitiveDefinitions
!
classMenuPrimitiveFunctions
"show the classes primitiveFunction in the codeView.
Also, set accept action to change it."
self classMenuPrimitiveCode:#primitiveFunctions
!
classMenuPrimitiveVariables
"show the classes primitiveVariable in the codeView.
Also, set accept action to change it."
self classMenuPrimitiveCode:#primitiveVariables
!
classMenuPrintOut
self printOutClassesWithSelector:#printOutOn:
!
classMenuPrintOutFullProtocol
self printOutClassesWithSelector:#printOutFullProtocolOn:
!
classMenuPrintOutProtocol
self printOutClassesWithSelector:#printOutProtocolOn:
!
classMenuRecompile
"recompile selected classes (to turn off instrumentation, for example)"
self selectedClassesDo:[:eachClass |
self recompileClass:eachClass
].
"Modified: / 31-05-2012 / 12:01:57 / cg"
!
classMenuRecompileAll
"recompile selected classes incl. all subclasses (to turn off instrumentation, for example)"
|already|
already := Set new.
self selectedClassesDo:[:each |
each withAllSubclassesDo:[:eachClass |
(already includes:eachClass theNonMetaclass) ifFalse:[
already add:eachClass theNonMetaclass.
self recompileClass:eachClass
]
].
].
"Created: / 07-09-2011 / 21:23:01 / cg"
!
classMenuRecompileInstrumented
self selectedClassesDo:[:eachClass |
self recompileClassWithInstrumentation:eachClass
].
self showInfo:nil.
self askForGlobalCoverageRecording.
"Modified: / 10-08-2010 / 14:36:42 / cg"
!
classMenuRegenerateProjectContentsDefinitions
self updateProjectContentsDefinitionsIn:(self selectedClassesValue) regenerate:true
"Created: / 12-10-2006 / 16:53:30 / cg"
!
classMenuReload
"reload selected classes"
self classReload
"Created: / 04-07-2011 / 18:07:32 / cg"
!
classMenuRemove
"remove the selected classes (and all of its subclasses)"
self withWaitCursorDo:[
self classMenuRemoveAndPullUpSubclasses:false
]
"Modified: / 27-07-2006 / 09:33:35 / cg"
!
classMenuRemoveAndPullUpSubclasses:pullUpSubclasses
"remove the selected classes.
If pullUpSubclasses is true, the classes subclasses are pulled up;
otherwise, these are removed."
|offerCancel offerYesToAll classesToRemove|
classesToRemove := OrderedCollection new.
offerCancel := self selectedClassesValue size > 1.
offerYesToAll := self selectedClassesValue size > 1.
YesToAllConfirmation handleConfirmationIn:[
self
selectedClassesNonMetaDo:[:cls |
self
addClassesToRemoveForClass:cls
to:classesToRemove
removingSubclasses:pullUpSubclasses not
withCancel:offerCancel
]
ifUnloaded:[:cls |
|answer|
YesToAllConfirmation query ifTrue:[
answer := true
] ifFalse:[
offerYesToAll ifTrue:[
answer := OptionBox
request:(resources
string:'Class ''%1'' is autoloaded - remove anyway ?'
with:cls name allBold)
label:(resources string:'Confirm')
image:(YesNoBox iconBitmap)
buttonLabels:(resources array:#('Cancel' 'No' 'Yes' 'Yes to All'))
values:#(nil false true #yesToAll)
default:false
onCancel:false.
answer == #yesToAll ifTrue:[
YesToAllConfirmation notify.
answer := true
].
] ifFalse:[
answer := Dialog
confirmWithCancel:
(resources
string:'Class ''%1'' is autoloaded - remove anyway ?'
with:cls name allBold)
default:
false.
].
answer == nil ifTrue:[
^ self "/ cancelled
].
].
answer == true ifTrue:[
self
addClassesToRemoveForClass:cls
to:classesToRemove
removingSubclasses:pullUpSubclasses not
withCancel:offerCancel
withConfirm:false
].
false
]
ifPrivate:[:cls |
self
addClassesToRemoveForClass:cls
to:classesToRemove
removingSubclasses:pullUpSubclasses not
withCancel:offerCancel
].
].
classesToRemove notEmpty ifTrue:[
self removeClasses:classesToRemove pullUpSubclasses:pullUpSubclasses.
"/ Confirm only iff there was at least one Smalltalk class (for others, we do not have
"/ changes.
(classesToRemove anySatisfy:[:c|c programmingLanguage isSmalltalk]) ifTrue:[
(Dialog
confirm:(resources
stringWithCRs:'Cleanup the ChangeSet ?\\i.e. remove entries for removed class(es)')
yesLabel:(resources string:'Cleanup'))
ifTrue:[
classesToRemove do:[:eachClass |
ChangeSet current condenseChangesForClass:eachClass
].
].
]
]
"Modified: / 28-02-2012 / 16:47:47 / cg"
"Modified: / 17-04-2013 / 21:32:34 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
classMenuRename
"rename the selected class"
|currentClass box newNameString
oldSym oldBaseSym cls newOwnerOrNameSpacePath nsOrOwner s nextWord t hardRename
answer referingMethods browser askForNewContainer question|
currentClass := self theSingleSelectedClass.
currentClass isNil ifTrue:[^ nil].
currentClass := currentClass theNonMetaclass.
box := self
enterBoxTitle:(resources
string:'Rename ''%1'' to:'
with:currentClass name allBold)
okText:'Rename'
label:'Rename Class'.
box initialText:(currentClass name).
box action:[:aString | newNameString := aString].
box showAtPointer.
newNameString isNil ifTrue:[^ self].
newNameString = currentClass name ifTrue:[^ self].
"/ extract owner or namespace, to see if this implies a change
newOwnerOrNameSpacePath := OrderedCollection new.
nsOrOwner := environment.
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 := environment classNamed:newNameString) notNil ifTrue:[
(self confirm:(resources string:'Attention: a class named ''%1'' already present (in the ''%2'' category).\\Rename over it ?'
with:newNameString allBold
with:cls category allBold) withCRs)
ifFalse:[^ self]
].
oldSym := currentClass name asSymbol.
oldBaseSym := currentClass nameWithoutPrefix asSymbol.
"/ renaming is actually more complicated as one might
"/ think (care for classVariables, privateClasses etc.)
"/ Smalltalk knows all about that ...
askForNewContainer := false.
"/ check if the class has a repository container - warn about this if so
currentClass isPrivate ifFalse:[
| mgr |
mgr := SourceCodeManagerUtilities sourceCodeManagerFor:currentClass.
mgr isContainerBased ifTrue:[
currentClass revision notNil ifTrue:[
(Dialog
confirm:(resources string:'Remove the (old) source container for ''%1'' in the repository ?' with:oldSym allBold)
initialAnswer:false)
ifTrue:[
mgr utilities
removeSourceContainerForClass:currentClass
confirm:false
warn:true.
askForNewContainer := true.
].
].
].
].
self busyLabel:('Searching for references to ' , oldSym).
referingMethods := SystemBrowser
allMethodsIn:(environment allClasses)
where:(SystemBrowser searchBlockForReferendsOf:oldSym).
self normalLabel.
referingMethods isEmpty ifTrue:[
Smalltalk renameClass:currentClass to:newNameString.
] ifFalse:[
RenameClassRefactoring isNil ifTrue:[
Smalltalk renameClass:currentClass to:newNameString.
answer := OptionBox
request:(resources
stringWithCRs:'Browse %1 references to "%2" ?'
with:referingMethods size
with:oldSym allBold
with:newNameString allBold)
label:(resources string:'Renaming class "%1" to "%2"' with:oldSym with:newNameString)
buttonLabels:(resources array:#('Cancel' 'Browse' 'Rename'))
values:#(false #browse #rename)
default:#rename
onCancel:false.
] ifFalse:[
referingMethods size == 1 ifTrue:[
question := 'There is 1 reference to "%2"\from %4.\\Rename only or Rename and Rewrite to "%3" ?'
] ifFalse:[
question := 'There are %1 references to "%2".\\Rename only or Rename and Rewrite to "%3" ?'
].
answer := OptionBox
request:(resources
stringWithCRs:question
with:referingMethods size
with:oldSym allBold
with:newNameString allBold
with:(referingMethods first whoString))
label:(resources string:'Renaming class "%1" to "%2"' with:oldSym with:newNameString)
buttonLabels:(resources array:#('Cancel' 'Browse' 'Rename && Browse' 'Rename' 'Rename && Rewrite' ))
values:#(false #browse #renameAndBrowse #rename #renameAndRewrite )
default:#renameAndRewrite
onCancel:false.
].
(answer == #browse) ifTrue:[
browser := self
spawnMethodBrowserFor:referingMethods
in:#newBuffer
label:(resources string:'Methods referring to %1' with:oldSym)
].
(answer == #rename or:[answer == #renameAndBrowse]) ifTrue:[
Smalltalk renameClass:currentClass to:newNameString.
answer == #renameAndBrowse ifTrue:[
browser := self
spawnMethodBrowserFor:referingMethods
in:#newBuffer
label:(resources string:'Methods referring to %1 which was renamed to %2' with:oldSym with:newNameString)
].
].
answer == #renameAndRewrite ifTrue:[
self performRefactoring:(RenameClassRefactoring renameClassNamed:oldSym to:newNameString).
referingMethods := SystemBrowser
allMethodsIn:(environment allClasses)
where:(SystemBrowser searchBlockForReferendsOf:newNameString).
UserInformation ignoreIn:[
browser := self
spawnMethodBrowserFor:referingMethods
in:#newBuffer
label:(resources string:'Rewritten Methods now referring to %1' with:newNameString).
].
].
browser notNil ifTrue:[
browser autoSearchVariable:oldBaseSym.
].
].
askForNewContainer ifTrue:[
(self confirm:(resources string:'Create a new source container for ''%1'' ?' with:newNameString allBold))
ifTrue:[
currentClass setClassFilename:nil.
SourceCodeManagerUtilities default createSourceContainerForClass:(environment at:newNameString asSymbol)
]
].
"Modified: / 01-06-2012 / 10:30:08 / cg"
"Modified: / 12-08-2014 / 12:28:19 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
classMenuRepositorySummary
"show a classes repository summary info.
changes the aspect to automatically show the summary info when another class is selected."
self classMenuChangeAspect:#classRepositorySummary
!
classMenuRewrite
MethodRewriter new
classes: self selectedClassesValue;
open
"Created: / 05-07-2011 / 14:48:32 / cg"
!
classMenuSaveDocumentationAs
"write classes documentation to a file"
self
selectedClassesNonMetaDo:
[:cls |
self saveClassDocumentationFor:cls
]
ifUnloaded:
[:cls |
true
]
ifPrivate:
[:cls |
]
!
classMenuSaveRemove
"remove the selected classes and pull up their subclasses"
(self canUseRefactoringSupport) ifFalse:[
^ self warn:'Sorry - need refactoring support for this function'.
].
^ self classMenuRemoveAndPullUpSubclasses:true
"Modified: / 12-10-2006 / 14:09:02 / cg"
!
classMenuShowEntriesInChangeSet
"show all changes for the selected class(es) in the changeSet"
|classes changes|
self withWaitCursorDo:[
classes := self selectedClasses value collect:[:each | each theNonMetaclass].
changes := ChangeSet current selectForWhichIncludesChangeForClassOrMetaclassOrPrivateClassFrom:classes.
(UserPreferences current changeSetBrowserClass) openOn:changes
]
"Created: / 26-07-2012 / 11:50:52 / cg"
!
classMenuSpawnBufferWithAllSubclasses
"open a new browser showing the selected classes with all subclasses"
self spawnWithAllSubclassesIn:#newBuffer
!
classMenuSpawnBufferWithAllSuperclasses
"open a new browser showing the selected classes with all superclasses"
self spawnWithAllSuperclassesIn:#newBuffer
!
classMenuSpawnBufferWithClassOrSubclassReferences
"add a buffer showing references to any of the selected classes or any of its subclasses"
self spawnClassOrSubclassReferencesBrowserFor:(self selectedClassesValue) in:#newBuffer
"Modified: / 28-02-2012 / 16:48:06 / cg"
!
classMenuSpawnBufferWithClassProjects
"add a new buffer showing the selected classes' projects"
self spawnClassProjectsBrowserFor:(self selectedClassesValue) in:#newBuffer
"Created: / 18-08-2000 / 19:12:33 / cg"
!
classMenuSpawnBufferWithClassReferences
"add a buffer showing references to any of the selected classes"
self spawnClassReferencesBrowserFor:(self selectedClassesValue) in:#newBuffer
"Modified: / 28-02-2012 / 16:48:11 / cg"
!
classMenuSpawnBufferWithClassesCoveredByTestcase
self spawnWithClassesCoveredByTestcaseIn:#newBuffer
!
classMenuSpawnBufferWithCommonSuperclass
"open a new browser showing the selected classes' common superclass"
self spawnWithCommonSuperclassIn:#newBuffer
"Created: / 28-02-2012 / 08:58:56 / cg"
!
classMenuSpawnBufferWithProjectReferences
"add a new buffer showing preoject references to the selected project definitions"
|packages|
packages := self selectedClassesValue collect:[:each | each package] as:Set.
self spawnProjectReferencesBrowserFor:packages in:#newBuffer
!
classMenuSpawnClass
"open a new browser showing the selected classes only"
self spawnClassBrowserFor:(self selectedClassesValue) in:#newBrowser
"Modified: / 28-02-2012 / 16:48:14 / cg"
!
classMenuSpawnClassBuffer
"add a buffer showing the selected classes only"
self spawnClassBrowserFor:(self selectedClassesValue) in:#newBuffer
"Modified: / 28-02-2012 / 16:48:16 / cg"
!
classMenuSpawnClassOrSubclassReferences
"open a new browser showing references to the selected classes or any of its subclass"
self spawnClassOrSubclassReferencesBrowserFor:(self selectedClassesValue) in:#newBrowser
"Modified: / 28-02-2012 / 16:48:20 / cg"
!
classMenuSpawnClassProjects
"open a new browser showing the selected classes' projects"
self spawnClassProjectsBrowserFor:(self selectedClassesValue) in:#newBrowser
"Created: / 18-08-2000 / 19:12:14 / cg"
!
classMenuSpawnClassReferences
"open a new browser showing references to the selected classes "
self spawnClassReferencesBrowserFor:(self selectedClassesValue) in:#newBrowser
"Modified: / 28-02-2012 / 16:48:26 / cg"
!
classMenuSpawnClassesBuffer
"add a buffer showing the selected classes only"
self classMenuSpawnClassBuffer
!
classMenuSpawnFullBrowserIn:where
"add a buffer/open a browser showing the selected classes"
|classes brwsr anyMeta anyNonMeta methods|
methods := self selectedMethodsValue select:[:m | m mclass notNil].
methods notEmpty ifTrue:[
classes := methods collect:[:each | each mclass].
] ifFalse:[
classes := self selectedClassesValue 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] as:Set) 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.
] ifTrue:[
brwsr selectedClasses value:classes.
].
].
brwsr selectedProtocols value:(methods collect:[:m | m category]).
brwsr selectedMethods value:methods.
brwsr immediateUpdate value:false.
].
^ brwsr
!
classMenuSpawnFullClassBrowser
"add a new browser showing the selected classes only"
self
spawnFullBrowserInClass:(self selectedClassesValue first)
selector:nil
in:#newBrowser.
"Modified: / 28-02-2012 / 16:48:16 / cg"
!
classMenuSpawnFullClassBuffer
"add a buffer showing the selected classes only"
self
spawnFullBrowserInClass:(self selectedClassesValue first)
selector:nil
in:#newBuffer.
"Modified: / 28-02-2012 / 16:48:16 / cg"
!
classMenuSpawnProjectReferences
"open a new browser showing preoject references to the selected project definitions"
|packages|
packages := self selectedClassesValue collect:[:each | each package] as:Set.
self spawnProjectReferencesBrowserFor:packages 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
!
classMenuSpawnWithClassesCoveredByTestcase
self spawnWithClassesCoveredByTestcaseIn:#newBrowser
!
classMenuSpawnWithCommonSuperclass
"open a new browser showing the selected classes' common superclass"
self spawnWithCommonSuperclassIn:#newBrowser
"Created: / 28-02-2012 / 08:58:10 / cg"
!
classMenuUpdate
self classListApp forceUpdateList
!
classMenuUpdateProjectContentsDefinitions
self updateProjectContentsDefinitionsIn:(self selectedClassesValue) regenerate:false
"Created: / 10-10-2006 / 20:50:23 / cg"
!
classTemplateFor:aSuperClass in:categoryString asNamespace:asNameSpace private:isPrivateWanted metaClassUsed:metaClassUsedOrNilArg
"return a class definition template - be smart in what is offered initially"
|cat name nameProto namePrefix nameUsed i existingNames withNameSpaceDirective
className ownerName s currentNamespace currentClass nsTemplate
selectedNamespaces isPrivate ownerClass superclassesNamespace
metaClassUsedOrNil|
metaClassUsedOrNil := metaClassUsedOrNilArg.
currentClass := self currentClass.
isPrivate := isPrivateWanted.
isPrivate ifTrue:[
ownerClass := currentClass.
ownerClass notNil ifTrue:[
ownerClass := ownerClass theNonMetaclass.
].
].
aSuperClass isPrivate ifTrue:[
isPrivate := true.
ownerClass := aSuperClass theNonMetaclass owningClass
].
isPrivate ifTrue:[
metaClassUsedOrNil isNil ifTrue:[
metaClassUsedOrNil := ownerClass theMetaclass class
] ifFalse:[
]
].
(metaClassUsedOrNil notNil
and:[(metaClassUsedOrNil ~~ Metaclass)
and:[metaClassUsedOrNil ~~ PrivateMetaclass]
" and:[(metaClassUsedOrNil isSubclassOf:Metaclass) not] " ]) ifTrue:[
^ metaClassUsedOrNil
classTemplateFor:aSuperClass
in:categoryString
asNamespace:asNameSpace
private:isPrivate
].
(self javaMode
or:[aSuperClass notNil and:[aSuperClass isJavaClass]])
ifTrue:[
^ self javaClassTemplateFor:aSuperClass in:categoryString private:isPrivate
].
nsTemplate := ''.
self organizerMode value ~~ OrganizerCanvas organizerModeNamespace ifTrue:[
(aSuperClass notNil
and:[(superclassesNamespace := aSuperClass nameSpace) ~~ Smalltalk]) ifTrue:[
(superclassesNamespace isNameSpace
or:[superclassesNamespace ~~ ownerClass]) ifTrue:[
nsTemplate := superclassesNamespace name , '::'.
].
]
] ifFalse:[
(selectedNamespaces := self selectedNamespaces value) size > 0 ifTrue:[
selectedNamespaces size == 1 ifTrue:[
selectedNamespaces first ~= BrowserList nameListEntryForALL ifTrue:[
currentNamespace := environment at:selectedNamespaces first asSymbol.
]
]
]
].
s := TextStream on:''.
asNameSpace ifTrue:[
s nextPutLine:'NameSpace name:''' , nsTemplate , 'NewNameSpace'''.
s cr.
s emphasis:(UserPreferences current commentEmphasisAndColor).
s nextPutAll:'"
Replace ''NewNameSpace'' by the desired name.
Create the namespace by ''accepting'',
either via the menu or the keyboard (usually CMD-A).
"
'.
^ s contents.
].
currentNamespace isNil ifTrue:[
currentNamespace := self currentNamespace.
].
currentClass notNil ifTrue:[
currentClass := currentClass theNonMetaclass.
].
withNameSpaceDirective :=
currentNamespace notNil
and:[currentNamespace ~= (BrowserList nameListEntryForALL)
and:[currentNamespace ~= Smalltalk]].
withNameSpaceDirective ifTrue:[
s nextPutAll:('"{ NameSpace: ''' , currentNamespace name , ''' }"').
s cr; cr.
aSuperClass nameSpace = currentNamespace ifTrue:[
className := aSuperClass nameWithoutNameSpacePrefix.
] ifFalse:[
className := aSuperClass name.
].
] ifFalse:[
className := aSuperClass name.
].
nsTemplate := ''.
withNameSpaceDirective ifFalse:[
self organizerMode value ~~ OrganizerCanvas organizerModeNamespace ifTrue:[
(aSuperClass notNil
and:[(superclassesNamespace := aSuperClass nameSpace) ~~ Smalltalk]) ifTrue:[
(superclassesNamespace isNameSpace
or:[superclassesNamespace ~~ ownerClass]) ifTrue:[
nsTemplate := superclassesNamespace name , '::'.
].
]
].
].
cat := categoryString.
(cat isNil or:[cat startsWith:$*]) ifTrue:[
cat := Compiler defaultMethodCategory "/ '** As yet uncategorized **'
].
((aSuperClass == SimpleDialog) or:[aSuperClass isSubclassOf:SimpleDialog]) ifTrue:[
nameProto := 'NewDialog'.
] ifFalse:[
((aSuperClass == ApplicationModel) or:[aSuperClass isSubclassOf:ApplicationModel]) ifTrue:[
nameProto := 'NewApplication'.
] ifFalse:[
aSuperClass == TestCase ifTrue:[
nameProto := 'NewTestCase'.
] ifFalse:[ aSuperClass == Error ifTrue:[
nameProto := 'NewError'.
] ifFalse:[ aSuperClass == Exception ifTrue:[
nameProto := 'NewException'.
] ifFalse:[ aSuperClass == SharedPool ifTrue:[
nameProto := 'NewSharedPool'.
] ifFalse:[
nameProto := 'NewClass'.
]]]]
]
].
i := 1.
isPrivate ifTrue:[
namePrefix := ownerClass name , '::'.
existingNames := ownerClass privateClasses.
existingNames size > 0 ifTrue:[
existingNames := existingNames collect:[:cls | cls name].
]
] ifFalse:[
namePrefix := ''.
existingNames := environment keys
].
name := nsTemplate , nameProto , i printString.
existingNames notNil ifTrue:[
nameUsed := namePrefix , name.
[nameUsed knownAsSymbol and:[existingNames includes:nameUsed asSymbol]] whileTrue:[
i := i + 1.
name := nsTemplate , nameProto , i printString.
nameUsed := namePrefix , name
].
].
s emphasis:#bold.
s nextPutAll:className.
s emphasis:nil.
s nextPutAll:' subclass: '.
s emphasis:#bold.
s nextPutAll:name asSymbol storeString.
s emphasis:nil.
s cr.
s nextPutLine:' instanceVariableNames: '''''.
aSuperClass == SharedPool ifTrue:[
s nextPutLine:' classVariableNames: ''PoolVar1 PoolVar2...'''.
] ifFalse:[
s nextPutLine:' classVariableNames: '''''.
].
s nextPutLine:' poolDictionaries: '''''.
isPrivate ifTrue:[
withNameSpaceDirective ifTrue:[
ownerName := ownerClass nameWithoutNameSpacePrefix
] ifFalse:[
ownerName := ownerClass name
].
s nextPutAll:' privateIn: ' , ownerName
] ifFalse:[
s nextPutAll:' category: '''.
cat notNil ifTrue:[
cat printWithQuotesDoubledOn:s
].
s nextPutAll: ''''
].
s cr; cr.
s emphasis:(UserPreferences current commentEmphasisAndColor).
s nextPutAll:'
"
Replace ''' , className , ''', ''', name , ''' and
the empty string arguments by true values.
Install (or change) the class by ''accepting'',
either via the menu or the keyboard (usually CMD-A).
You can also change the category simply by editing
the categoryString and accepting.
To be nice to others (and yourself later), do not forget to
add some documentation; preferably under the classes documentation
protocol.
(see the `create documentation stubs'' item in the methodList menu;
switch from instance to class to find this menu item.)
Notice, that ST/X uses the convention to document the class using
comment-only class methods (however, ST80 comments are supported and
can be changed via the class-documentation menu).
"
'.
^ s contents
"Created: / 23-12-1996 / 12:46:31 / cg"
"Modified: / 11-08-2006 / 14:41:09 / cg"
!
debugMenuRecompileMethodsInstrumented
self selectedMethodsDo:[:eachMethod |
self recompileMethodWithInstrumentation:eachMethod
].
"Created: / 10-08-2010 / 14:36:33 / cg"
!
doCompareClass:class1 withClass:class2
"open a diff-textView comparing the two classes (useful when refactoring)."
|lbl1 lbl2|
(class1 isLoaded not or:[class2 isLoaded not]) ifTrue:[
self warn:'Cannot compare unloaded classes.'.
^ self.
].
self busyLabel:'comparing ...' with:nil.
lbl1 := class1 name.
lbl2 := class2 name.
(UserPreferences versionDiffViewerClass)
openOnClass:class1
labelA:lbl1
andClass:class2
labelB:lbl2
title:('comparing ' , lbl1 , ' against ' , lbl2)
ifSame:[ self information:'sources are identical' ].
self normalLabel.
!
doCopyClass:aClass as:newClassName privateIn:ownerOrNil
^ self
doCopyClass:aClass
as:newClassName
privateIn:ownerOrNil
ignore:(IdentitySet new)
"Modified: / 24-05-2012 / 15:49:49 / cg"
!
doCopyClass:aClass as:newClassName privateIn:ownerOrNil ignore:setOfClassesToIgnore
|newClass newMetaclass sel realNewClassName privateClassesBefore|
privateClassesBefore := aClass privateClasses.
ownerOrNil isNil ifTrue:[
sel := aClass definitionSelector.
realNewClassName := newClassName asSymbol.
] ifFalse:[
sel := aClass definitionSelectorPrivate.
realNewClassName := (ownerOrNil name , '::' , newClassName) asSymbol.
].
newClass := aClass superclass
perform:sel
with:newClassName asSymbol
with:aClass instanceVariableString
with:aClass classVariableString
with:aClass poolDictionaries
with:(ownerOrNil ifNil:[aClass category] ifNotNil:[ownerOrNil]). "/ category: or privateIn:
newClass isNil ifTrue:[
self error:'Internal class-definition error (should not happen)' mayProceed:true.
^ nil.
].
newMetaclass := newClass class.
newMetaclass instanceVariableNames:(aClass class instanceVariableString).
"/ sigh - must refetch in case of changed instVars.
newClass := environment at:realNewClassName.
newMetaclass := newClass class.
aClass methodDictionary
keysAndValuesDo:[:sel :mthd |
newClass compile:(mthd source) classified:(mthd category)
].
aClass class methodDictionary
keysAndValuesDo:[:sel :mthd |
"/ skip the version method (to avoid confusing the repository)
(AbstractSourceCodeManager isVersionMethodSelector:sel) ifFalse:[
newMetaclass compile:(mthd source) classified:(mthd category)
]
].
setOfClassesToIgnore add:newClass.
privateClassesBefore do:[:eachPrivateClass |
(setOfClassesToIgnore includes:eachPrivateClass) ifFalse:[
self
doCopyClass:eachPrivateClass
as:(eachPrivateClass nameWithoutPrefix)
privateIn:newClass
ignore:setOfClassesToIgnore.
].
].
(newMetaclass includesSelector:#initialize) ifTrue:[
newClass initialize.
].
newClass package:(Class packageQuerySignal query).
^ newClass
"Modified: / 24-05-2012 / 15:49:59 / cg"
!
doMoveMethodsOfClass:aClass fromProject:oldProject toProject:newProject
|movedInstMethods movedClassMethods|
movedInstMethods := OrderedCollection new.
movedClassMethods := OrderedCollection new.
aClass theNonMetaclass methodDictionary keysAndValuesDo:[:sel :mthd |
mthd package = oldProject ifTrue:[
"/ JV@2012-02-11
"/ this is required, because otherwise I would no longer be able to
"/ reconstruct my sourcecode (as the connection to the source-file is lost).
mthd makeLocalStringSource.
mthd setPackage:newProject.
movedInstMethods add:mthd.
].
].
aClass theMetaclass methodDictionary keysAndValuesDo:[:sel :mthd |
mthd package = oldProject ifTrue:[
"/ JV@2012-02-11
"/ this is required, because otherwise I would no longer be able to
"/ reconstruct my sourcecode (as the connection to the source-file is lost).
mthd makeLocalStringSource.
mthd setPackage:newProject.
movedClassMethods add:mthd.
].
].
movedInstMethods notEmpty ifTrue:[
aClass theNonMetaclass changed:#projectOrganization.
environment changed:#projectOrganization with:(Array with:aClass theNonMetaclass with:movedInstMethods).
].
movedClassMethods notEmpty ifTrue:[
aClass theMetaclass changed:#projectOrganization.
environment changed:#projectOrganization with:(Array with:aClass theMetaclass with:movedClassMethods).
]
"Modified: / 09-03-2012 / 23:41:58 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
doRemoveClass:aClass
^ self doRemoveClass:aClass withCancel:true
!
executeSelectedClassMethod
"run the selected method"
self withWaitCursorDo:[
|m cls sel retVal|
m := self theSingleSelectedMethod.
cls := (m mclass ? m getMclass) theNonMetaclass.
sel := m selector.
[
retVal := cls perform:sel.
] benchmark:'Exec. Time: '.
retVal isLiteral ifTrue:[
retVal := retVal storeString.
].
Transcript show:'Answer: '; showCR:retVal.
]
"Modified: / 19-11-2010 / 12:07:05 / cg"
!
fileOutClass:aClass askForFile:doAsk withCancelAll:withCancelAll
"fileOut a class."
^ self
fileOutClass:aClass
askForFile:doAsk
withCancelAll:withCancelAll
format:nil
sourceMode:nil
!
fileOutClass:aClass askForFile:doAsk withCancelAll:withCancelAll format:formatSymbolOrNil sourceMode:sourceMode
"fileOut a class."
|saveName stillAsking cancelAll suffix|
suffix := self fileSuffixForClass:aClass format:formatSymbolOrNil.
formatSymbolOrNil notNil ifTrue:[
saveName := aClass theNonMetaclass name , '.' , suffix.
].
stillAsking := doAsk.
[stillAsking] whileTrue:[
saveName := self
fileNameDialogForFileOut:(resources string:'FileOut ''%1'' as:' with:aClass name allBold)
default:((Smalltalk fileNameForClass:aClass) , '.' , suffix)
withCancelAll:(withCancelAll
ifTrue:[
cancelAll := true.
]
ifFalse:nil).
cancelAll == true ifTrue:[
AbortOperationRequest raise
].
saveName isNil ifTrue:[
^ self
].
saveName isEmpty ifTrue:[ "/ can no longer happen ...
(self confirm:'Bad name given - try again ?') ifFalse:[
^ self.
].
stillAsking := true.
] ifFalse:[
FileSelectionBox lastFileSelectionDirectory:(saveName asFilename directoryName).
stillAsking := false.
].
].
self busyLabel:'saving %1' with:aClass name.
self withWriteCursorDo:[
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 == #bee ifTrue:[
saveName asFilename writingFileDo:[:s| BeeSourceWriter fileOut: aClass on: s]
] 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: / 27-07-2012 / 09:45:02 / cg"
"Modified: / 14-04-2015 / 12:55:21 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
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
fileOutEachClassIn:aBunchOfClasses
in:dirName
withFormat:aFormatSymbolOrNil
!
generateUndoableChange:nameOfOperation overClasses:classes via:aBlock
"helper for code generators; collect changes generated by enumerating
classes with a generator into a user-provided block.
If classes is nil, the block is called once with a nil class argument."
|programmingLanguage generator count dict className codeGeneratorClass
packageOrNil|
packageOrNil := self theSingleSelectedProject.
classes notNil ifTrue:[
"/ remove this a.s.a.p
"/ check if all classes are either smalltalk or java-script
(classes
conform:[:cls |
|lang|
lang := cls programmingLanguage.
lang isSmalltalk or:[lang isSTXJavaScript]]
) ifFalse:[
Dialog warn:('Sorry.\\For now, this works only for Smalltalk classes.' withCRs).
^ self.
].
].
programmingLanguage := (classes isEmptyOrNil)
ifTrue:[ SmalltalkLanguage instance ]
ifFalse:[ classes first programmingLanguage ].
codeGeneratorClass := programmingLanguage codeGeneratorClass.
codeGeneratorClass isNil ifTrue:[
Dialog warn:('Sorry.\\For now, there seems to be no codeGeneratorClass defined for this language.' withCRs).
^ self.
].
generator := codeGeneratorClass new.
generator startCollectChanges.
count := 0.
self withWaitCursorDo:[
classes isNil ifTrue:[
aBlock value:generator value:nil.
] ifFalse:[
classes do:[:eachClass |
eachClass isLoaded ifFalse:[
Transcript showCR:'skipping unloaded class: ' , eachClass name.
] ifTrue:[
packageOrNil notNil ifTrue:[
Class packageQuerySignal answer:packageOrNil do:[
aBlock value:generator value:eachClass.
]
] ifFalse:[
aBlock value:generator value:eachClass.
].
count := count + 1.
]
].
].
dict := Dictionary new.
dict at:1 put:count.
dict at:#numClasses put:count.
count ~~ 1 ifTrue:[
dict at:#numClassesOrEmpty put:( ' ' , count printString, ' ').
dict at:#inSingleClassOrEmpty put:''.
dict at:#forSingleClassOrEmpty put:''.
dict at:#sForPlural put:'s'.
dict at:#singleClassNameOrNumberOfClasses put:(count printString , ' classes').
] ifFalse:[
className := classes first theNonMetaclass name.
dict at:#numClassesOrEmpty put:' '.
dict at:#inSingleClassOrEmpty put:' in ' , className.
dict at:#forSingleClassOrEmpty put:' for ' , className.
dict at:#sForPlural put:''.
dict at:#singleClassNameOrNumberOfClasses put:className.
].
UserInformation handle:[:ex |
self showInfo:(ex messageText).
] do:[
generator executeCollectedChangesNamed:(nameOfOperation expandPlaceholdersWith:dict)
]
]
"Modified: / 21-01-2012 / 11:11:24 / cg"
!
generateUndoableChange:nameOfOperation overSelectedClassesVia:aBlock
"helper for code generators"
self
generateUndoableChange:nameOfOperation
overClasses:(self selectedClassesValue)
via:aBlock
"Created: / 21-01-2012 / 10:22:19 / cg"
!
generateUndoableChangeOverSelectedClasses:nameOfOperation via:aBlock
"helper for code generators"
self
generateUndoableChange:nameOfOperation
overClasses:(self selectedClassesValue)
via:aBlock
"Modified: / 28-02-2012 / 16:49:22 / cg"
!
generateUndoableChangeOverSelectedMethods:nameOfOperation via:aBlock
"helper for code generators"
|selMethods generator count dict method methodName languageOfFirstMethod|
selMethods := self selectedMethodsValue.
languageOfFirstMethod := selMethods first mclass programmingLanguage.
(selMethods conform:[:mthd | (mthd mclass programmingLanguage) = languageOfFirstMethod]) ifFalse:[
Dialog warn:'All methods must be defined in the same programming language'.
^ self
].
generator := languageOfFirstMethod codeGeneratorClass new.
generator startCollectChanges.
count := 0.
self selectedMethodsDo:[:eachClass |
aBlock value:generator value:eachClass.
count := count + 1.
].
dict := Dictionary new.
dict at:1 put:count.
dict at:#numMethods put:count.
count ~~ 1 ifTrue:[
dict at:#numMethodsOrEmpty put:( ' ' , count printString allBold, ' ').
dict at:#inSingleMethodOrEmpty put:''.
dict at:#forSingleMethodOrEmpty put:''.
dict at:#sForPlural put:'s'.
dict at:#singleMethodNameOrNumberOfMethods put:(count printString allBold , ' methods').
] ifFalse:[
method := self selectedMethodsValue first.
methodName := method mclass nameWithoutPrefix , '>>' , method selector allBold.
dict at:#numMethodsOrEmpty put:' '.
dict at:#inSingleMethodOrEmpty put:' in ' , methodName.
dict at:#forSingleMethodOrEmpty put:' for ' , methodName.
dict at:#sForPlural put:''.
dict at:#singleMethodNameOrNumberOfMethods put:methodName.
].
generator executeCollectedChangesNamed:(nameOfOperation expandPlaceholdersWith:dict)
"Modified: / 06-12-2011 / 15:27:49 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 28-02-2012 / 16:16:27 / cg"
!
initializeSelectedPool
self selectedClassesValue do:[:cls |
cls theNonMetaclass initialize
]
"Created: / 28-05-2012 / 09:49:28 / cg"
!
javaClassTemplateFor: superclass in: category private: isPrivate
^ JavaLanguage instance classTemplateFor: superclass in: category asNamespace: false private: isPrivate
"Created: / 26-10-2013 / 14:02:16 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
launchSelectedApplication
|cls mthd|
cls := self theSingleSelectedClass.
cls isNil ifTrue:[
mthd := self theSingleSelectedMethod.
mthd notNil ifTrue:[
cls := mthd mclass
]
].
cls isNil ifTrue:[
Dialog warn:'Please select a class or method.'.
^ self.
].
self startApplication:cls.
"Modified: / 26-07-2012 / 20:12:18 / cg"
!
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:[
environment changeCategoryOf:cls to:newCategory.
]
].
LastCategoryRenames isNil ifTrue:[
LastCategoryRenames := OrderedCollection new.
].
LastCategoryRenames remove:newCategory ifAbsent:nil.
LastCategoryRenames addFirst:newCategory.
LastCategoryRenames size > 10 ifTrue:[
LastCategoryRenames removeLast.
].
"Modified: / 04-09-2013 / 17:45:07 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
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 classesNotYetInRepository classesAlreadyInRepository
sourceInfoPerClassOfClassesAlreadyInRepository oldPackagePerClass newProjectDefinition
thereWasASourceCodeManagerError|
(newProject = PackageId noProjectID) ifTrue:[
(Dialog confirm:(resources
stringWithCRs:'Do you really want to move those items to "%1"?\\(this will actually make them unassigned from any package)'
with:newProject))
ifFalse:[
^ self
].
].
classesNotYetInRepository := OrderedCollection new.
classesAlreadyInRepository := OrderedCollection new.
sourceInfoPerClassOfClassesAlreadyInRepository := Dictionary new.
oldPackagePerClass := Dictionary new.
thereWasASourceCodeManagerError := false.
classes do:[:eachClass |
|oldProject theClass mgr vsn|
theClass := eachClass theNonMetaclass.
mgr := theClass sourceCodeManager.
mgr notNil ifTrue:[
SourceCodeManagerError handle:[:ex |
thereWasASourceCodeManagerError := true
] do:[
vsn := mgr newestRevisionOf:theClass.
].
].
vsn isNil ifTrue:[
classesNotYetInRepository add:eachClass
] ifFalse:[
classesAlreadyInRepository add:eachClass.
sourceInfoPerClassOfClassesAlreadyInRepository at:eachClass put:(mgr sourceInfoOfClass:eachClass).
oldPackagePerClass at:eachClass put:(eachClass package).
].
].
anyClassMoved := false.
anyMethodMoved := false.
classes do:[:eachClass |
|oldProject theClass|
theClass := eachClass theNonMetaclass.
(oldProject := theClass package) ~= newProject ifTrue:[
theClass package:newProject.
self doMoveMethodsOfClass:theClass fromProject:oldProject toProject:newProject.
theClass allPrivateClassesDo:[:eachPrivateClass |
self doMoveMethodsOfClass:eachPrivateClass fromProject:oldProject toProject:newProject.
].
anyClassMoved := true.
].
(theClass hasUnassignedExtensions and:[newProject ~= PackageId noProjectID]) ifTrue:[
(self confirm:(resources string:'%1 has unassigned extensions - move those methods as well?' with:theClass name))
ifTrue:[
theClass instAndClassSelectorsAndMethodsDo:[:sel :eachMethod |
eachMethod package = PackageId noProjectID ifTrue:[
eachMethod package:newProject.
anyMethodMoved := true.
]
].
].
].
theClass hasExtensions ifTrue:[
(self confirm:(resources string:'%1 has extensions from other packages - move those methods as well?' with:theClass name))
ifTrue:[
theClass instAndClassSelectorsAndMethodsDo:[:sel :eachMethod |
(eachMethod package ~= newProject
and:[eachMethod package ~= PackageId noProjectID]) ifTrue:[
eachMethod package:newProject.
anyMethodMoved := true.
]
].
].
].
anyMethodMoved ifTrue:[
theClass changed:#projectOrganization.
theClass theMetaclass changed:#projectOrganization.
environment changed:#projectOrganization with:(Array with:theClass with:oldProject).
].
].
anyClassMoved ifTrue:[
environment changed:#projectOrganization.
].
(newProject = PackageId noProjectID) ifTrue:[^ self].
self rememberLastProjectMoveTo:newProject.
thereWasASourceCodeManagerError ifTrue:[
Dialog warn:(resources stringWithCRs:'There was a problem accessing the source code repository.\\Please check your settings and/or network connection').
^ self
].
"/ Only checkin classes managed by old (non-stx:libscm) based managers
"/ since stx:libscm care for this itself and makes this warning a little
"/ annoying...
(Smalltalk at: #SCMAbstractSourceCodeManager) notNil ifTrue:[
"/ stx:libscm present
((AbstractSourceCodeManager managerForPackage: newProject) isKindOf: (Smalltalk at: #SCMAbstractSourceCodeManager) class) ifTrue:[
^ self.
].
].
(Dialog confirm:(resources string:
(classesAlreadyInRepository notEmpty
ifTrue:['Move the classes in the repository now (recommended)?']
ifFalse:['Check the classes into the repository now?']))
) ifFalse:[ ^ self ].
"remove version methods"
classesAlreadyInRepository do:[:cls |
cls theMetaclass methodDictionary keys copy do:[:sel |
(AbstractSourceCodeManager isVersionMethodSelector: sel) ifTrue:[
cls theMetaclass removeSelector:sel.
cls setBinaryRevision:nil.
]
].
].
"now check them in"
SourceCodeManagerUtilities default
checkinClasses: (classesAlreadyInRepository , classesNotYetInRepository)
withInfo:'Classes moved to other package'.
"remove other containers"
sourceInfoPerClassOfClassesAlreadyInRepository keysAndValuesDo:[:class :info |
SourceCodeManagerUtilities default removeSourceContainerForClass:class usingSourceInfo:info confirm:true warn:true
].
(Dialog confirm:(resources string:'Update project definitions now (recommended)?')) ifFalse:[ ^ self ].
newProjectDefinition := newProject asPackageId projectDefinitionClass.
newProjectDefinition isNil ifTrue:[
newProjectDefinition := self projectDefinitionDialogFor:newProject.
newProjectDefinition isNil ifTrue:[
^ self
].
newProjectDefinition compileDescriptionMethods.
].
sourceInfoPerClassOfClassesAlreadyInRepository keysAndValuesDo:[:class :info |
|oldProjectDefinition|
oldProjectDefinition := (oldPackagePerClass at:class) asPackageId projectDefinitionClass.
oldProjectDefinition notNil ifTrue:[
oldProjectDefinition excludeClasses:{class} usingCompiler:nil.
].
].
newProjectDefinition includeClasses:(classesAlreadyInRepository , classesNotYetInRepository) usingCompiler:nil.
"Modified: / 02-08-2013 / 14:26:03 / cg"
"Modified: / 04-10-2015 / 08:59:24 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
moveSelectedClassesToCategory:newCategory
"change the class-category of the selected classes"
self moveClasses:(self selectedClassesValue) toCategory:newCategory
"Modified: / 28-02-2012 / 16:59:32 / cg"
!
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 selectedClassesValue collect:[:cls | cls theNonMetaclass]) toProject:newProject
"Modified: / 28-02-2012 / 16:59:35 / cg"
!
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).
]
]
!
packageSelectedApplication
"either projectDefiniton or
a subclass of standaloneStartup is selected"
|cls|
cls := self theSingleSelectedClass.
cls isNil ifTrue:[
Dialog warn:'Please select a project definition or startup class.'.
^ self.
].
Tools::ProjectBuilderAssistantApplication openOn:cls theNonMetaclass.
!
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
]
!
recompileClass:aClass
"recompile a class (to turn off instrumentation, for example)"
aClass theNonMetaclass recompile.
aClass theMetaclass recompile.
"Created: / 31-05-2012 / 12:01:28 / cg"
!
recompileClassWithInstrumentation:aClass
self recompileClassWithInstrumentation:aClass askForGlobalCoverage:false
"Created: / 10-08-2010 / 14:36:45 / cg"
"Modified: / 31-05-2012 / 10:36:42 / cg"
!
recompileClassWithInstrumentation:aClass askForGlobalCoverage:doAsk
|cls compile firstMethod|
"/ cannot compile stuff which the instrumenter itself needs
(aClass == IdentityDictionary) ifTrue:[^ self].
(aClass == SmallInteger) ifTrue:[^ self].
firstMethod := true.
compile :=
[:cls :sel :mthd |
(mthd sendsAnySelector:#( #subclassResponsibility #subclassResponsibility:)) ifFalse:[
mthd hasPrimitiveCode ifFalse:[
firstMethod ifTrue:[
self showInfo:('Instrumenting ',aClass name,'...').
firstMethod := false.
].
cls recompile:sel usingCompiler:InstrumentingCompiler new
]
]
].
(cls := aClass theNonMetaclass)
selectorsAndMethodsDo:[:aSelector :aMethod |
aMethod isInstrumented ifFalse:[
compile value:cls value:aSelector value:aMethod.
].
].
(cls := aClass theMetaclass)
selectorsAndMethodsDo:[:aSelector :aMethod |
aMethod category ~= 'documentation' ifTrue:[
aMethod isInstrumented ifFalse:[
compile value:cls value:aSelector value:aMethod.
]
]
].
self showCoverageInformation value ifFalse:[
true "(Dialog confirm:(resources string:'Turn on coverage display now ?'))" ifTrue:[
self showCoverageInformation value:true
].
].
doAsk ifTrue:[ self askForGlobalCoverageRecording ].
"Created: / 10-08-2010 / 14:36:45 / cg"
"Modified: / 31-05-2012 / 10:36:42 / cg"
!
recompileMethodWithInstrumentation:aMethod
(aMethod sendsSelector:#subclassResponsibility) ifFalse:[
aMethod hasPrimitiveCode ifFalse:[
aMethod mclass
recompile:aMethod selector
usingCompiler:InstrumentingCompiler new
]
]
"Created: / 10-08-2010 / 14:41:17 / cg"
!
removeClasses:classesToRemove pullUpSubclasses:pullUpSubclasses
"remove the selected classes (and all of its subclasses) without confirmation"
|numClasses change nm|
classesToRemove size == 0 ifTrue:[^ self].
self withWaitCursorDo:[
self canUseRefactoringSupport ifFalse:[
classesToRemove do:[:each |
each removeFromSystem.
].
^ self.
].
pullUpSubclasses ifTrue:[
classesToRemove do:[:eachClass |
self performRefactoring:(RemoveClassRefactoring className:eachClass name).
]
] ifFalse:[
numClasses := classesToRemove size.
numClasses > 1 ifTrue:[
numClasses == 2 ifTrue:[
nm := 'Remove ', classesToRemove first theNonMetaclass name , ' and ' , classesToRemove second theNonMetaclass name
] ifFalse:[
nm := 'Remove ', numClasses printString , ' classes'
]
] ifFalse:[
nm := 'Remove ', classesToRemove first theNonMetaclass name
].
change := CompositeRefactoryChange named:nm.
classesToRemove do:[:eachClass |
eachClass programmingLanguage isSmalltalk ifTrue:[
change removeClass:eachClass
] ifFalse:[
eachClass removeFromSystem.
]
].
RefactoryChangeManager performChange:change
]
]
"Modified: / 11-09-2013 / 04:38:41 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
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|
saveName := Dialog
requestFileName:(resources string:'save HTML doc of ''%1'' as:' with:aClass name)
default:((Smalltalk fileNameForClass:aClass) , '.html')
ok:'Save' abort:'Cancel'
pattern:'*.html'
fromDirectory:nil
forSave:true
whenBoxCreatedEvaluate:nil.
"/ 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 class's documentation to a file"
|text f|
text := HTMLDocGenerator htmlOfflineDocOf:aClass.
text notNil ifTrue:[
f := aFileName asFilename writeStream.
f nextPutAll:text asString.
f close.
]
!
spawnBrowserOnClass:cls
self spawnClassBrowserFor:(Array with:cls) in:#newBuffer
"Created: / 26-10-2011 / 18:28:21 / cg"
!
spawnClassBrowserFor:classes in:where
"browse selected class(es);
where is: #newBrowser - open a new browser showing the classes
where is: #newBuffer - add a new buffer showing the classes"
^ self spawnClassBrowserFor:classes label:nil in:where
!
spawnClassBrowserFor:classes in:where select:doSelect
"browse selected class(es);
where is: #newBrowser - open a new browser showing the classes
where is: #newBuffer - add a new buffer showing the classes"
^ self spawnClassBrowserFor:classes label:nil in:where select:doSelect
!
spawnClassBrowserFor:classes label:titleOrNil in:where
"browse selected class(es);
where is: #newBrowser - open a new browser showing the classes
where is: #newBuffer - add a new buffer showing the classes"
|allClasses|
allClasses := OrderedCollection new.
classes do:[:eachClass |
eachClass theNonMetaclass withAllPrivateClassesDo:[:everyClass |
allClasses add:everyClass
].
].
^ self spawnClassBrowserFor:allClasses label:titleOrNil in:where select:true
"Modified: / 19-10-2011 / 16:06:25 / cg"
!
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 singleClass doSelect|
doSelect := doSelectIn.
false "(singleSelection := (classes size == 1))" ifTrue:[
spec := #singleClassBrowserSpec.
singleClass := classes first.
meta := singleClass isMeta.
doSelect := true.
] ifFalse:[
spec := "#fullBrowserSpec. " #multipleClassBrowserSpec.
meta := self meta value ? false.
].
allClasses := classes collect:[:cls | cls theNonMetaclass].
doSelect ifTrue:[
selectedClasses := classes copy.
navigationState notNil ifTrue:[
selectedProtocols := self selectedProtocols value copy.
selectedMethods := self selectedMethodsValue copy.
(selectedMethods size > 0
and:[ selectedProtocols size == 0 ]) ifTrue:[
selectedProtocols := (selectedMethods collect:[:each | each category] as:Set) 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: / 26-07-2012 / 23:00:31 / 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"
|numClasses lbl classes|
(numClasses := aCollectionOfClasses size) == 1 ifTrue:[
lbl := 'References to %1 and its subclasses' bindWith:aCollectionOfClasses first theNonMetaclass.
] ifFalse:[
lbl := 'References to %1 classes and their subclasses' bindWith:numClasses
].
classes := Set new.
aCollectionOfClasses do:[:eachClassInQuestion |
classes addAll:(eachClassInQuestion theNonMetaclass withAllSubclasses)
].
^ self spawnClassReferencesBrowserFor:(classes asOrderedCollection) label:lbl in:openHow
!
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 numClasses|
(numClasses := aCollectionOfClasses size) == 1 ifTrue:[
lbl := 'References to ' , aCollectionOfClasses first name
] ifFalse:[
lbl := 'References to any of %1 classes' bindWith:numClasses
].
^ self spawnClassReferencesBrowserFor:aCollectionOfClasses label:lbl in:openHow
!
spawnClassReferencesBrowserFor:aCollectionOfClasses label:lbl in:openHow
"add a buffer/open a new browser showing references to selected classes"
|searchBlock brwsr patternsForCodeSearch|
searchBlock := [
|allRefs|
allRefs := IdentitySet new.
aCollectionOfClasses do:[:eachClassInQuestion |
|findRefs classesNameSpace eachNonMetaClassInQuestion symOutsideNamespace symInsideNamespace symInsideOwner refsHere|
"/ entries may becomeNil (when a class is removed from the system)
eachClassInQuestion notNil ifTrue:[
eachNonMetaClassInQuestion := eachClassInQuestion theNonMetaclass.
classesNameSpace := eachNonMetaClassInQuestion nameSpace.
findRefs :=
[:setOfClasses :sym :fullNameSym|
|localNS localNSSym localNameSym|
(fullNameSym includesString:'::') ifTrue:[
localNSSym := fullNameSym copyTo:(fullNameSym lastIndexOfSubCollection:'::')-1.
(localNSSym := localNSSym asSymbolIfInterned) notNil ifTrue:[
localNS := Smalltalk at:localNSSym.
localNameSym := fullNameSym copyFrom:(fullNameSym lastIndexOfSubCollection:'::')+2.
localNameSym := localNameSym asSymbolIfInterned
].
].
self class
findMethodsIn:setOfClasses
where:[:cls :mthdIn :sel |
|mthd mSource isCandidate isReference usedGlobals tryInLiterals|
mthd := mthdIn originalMethodIfWrapped.
"/ kludge: Lazy methods do not include symbols in the literal array - sigh
mthd isLazyMethod ifTrue:[
mSource := mthd source.
isCandidate := mSource notNil and:[ mSource includesString:sym].
] ifFalse:[
isCandidate := (mthd referencesLiteral:sym)
or:[(mthd referencesLiteral:fullNameSym)
or:[ localNameSym notNil
and:[(mthd referencesLiteral:localNameSym)
and:[ mthd nameSpace = localNS ]]]].
].
isReference := false.
isCandidate ifTrue:[
usedGlobals := mthd usedGlobals.
isReference := (usedGlobals includes:sym) or:[usedGlobals includes:fullNameSym].
isReference ifFalse:[
(mthd referencesLiteral:classesNameSpace name) ifTrue:[
isReference := mthd sendsAnySelector:#(#'at:' #'at:ifAbsent:' #'classNamed:')
].
isReference ifFalse:[
classesNameSpace ~= Smalltalk ifTrue:[
(mthd referencesLiteral:#Smalltalk) ifTrue:[
isReference := mthd sendsAnySelector:#(#'at:' #'at:ifAbsent:' #'classNamed:')
].
].
]
]
].
isReference ifFalse:[
"/ also search for class-refs in specs
tryInLiterals := mthd hasCanvasResource.
tryInLiterals ifFalse:[
tryInLiterals := mthd mclass isMeta
and:[ mthd mclass theNonMetaclass isProjectDefinition
and:[mthd selector == #classNamesAndAttributes]].
].
tryInLiterals ifTrue:[
isReference := (mthd refersToLiteral:sym)
or:[(mthd refersToLiteral:fullNameSym)
or:[ localNameSym notNil
and:[(mthd refersToLiteral:localNameSym)
and:[ mthd mclass nameSpace = localNS ]]]].
].
].
isReference
].
].
symOutsideNamespace := eachNonMetaClassInQuestion name.
refsHere := findRefs value:(environment allClasses) value:symOutsideNamespace value:symOutsideNamespace.
allRefs addAll:refsHere.
(eachNonMetaClassInQuestion nameSpace notNil
and:[ eachNonMetaClassInQuestion nameSpace ~~ Smalltalk ]) ifTrue:[
symInsideNamespace := eachNonMetaClassInQuestion nameWithoutNameSpacePrefix asSymbol.
refsHere := findRefs
value:(eachNonMetaClassInQuestion topNameSpace allClassesWithAllPrivateClasses)
value:symInsideNamespace
value:symOutsideNamespace.
allRefs addAll:refsHere.
].
(eachNonMetaClassInQuestion owningClass notNil) ifTrue:[
symInsideOwner := eachNonMetaClassInQuestion nameWithoutPrefix asSymbol.
refsHere := findRefs
value:(Array with:eachNonMetaClassInQuestion owningClass)
value:symInsideOwner
value:symOutsideNamespace.
allRefs addAll:refsHere.
].
].
"/ For Java classes, also search them using their Java binary nanes (i.e., "slashed" name)
"/ because in Java bytecode, classes are referenced using binary names rather than
"/ Smalltalk name (i.e., "quad-coloned" name such as JAVA::java::lang::Object)
eachNonMetaClassInQuestion isJavaClass ifTrue:[
refsHere := findRefs value:(environment allClasses) value:eachNonMetaClassInQuestion binaryName value:eachNonMetaClassInQuestion binaryName.
allRefs addAll:refsHere.
].
].
allRefs
].
brwsr := self spawnMethodBrowserForSearch:searchBlock sortBy:#class in:openHow label:lbl.
brwsr notNil ifTrue:[
"/ setup an autosearch action - when selected, the codeView automatically searches
"/ the refactory-searcher is not aware of namespaces (simply compares globals by name);
"/ therefore, we setup a multiple pattern search here (sigh)
patternsForCodeSearch := OrderedCollection new.
aCollectionOfClasses do:[:each |
|nonMeta nm nm2 nm3|
nonMeta := each theNonMetaclass.
nm := nonMeta name.
nm2 := nonMeta nameWithoutPrefix.
nm3 := nonMeta nameWithoutNameSpacePrefix.
patternsForCodeSearch add:nm.
nm2 ~= nm ifTrue:[ patternsForCodeSearch add:nm2 ].
nm3 ~= nm ifTrue:[ patternsForCodeSearch add:nm3 ].
].
brwsr autoSearchCodePatterns:patternsForCodeSearch "autoSearchPattern:singleClassName ignoreCase:false".
].
"Modified: / 16-11-2016 / 14:14:44 / cg"
"Modified: / 09-02-2017 / 09:26:47 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
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"
!
spawnSingleClassBrowserFor:classes in:where
"browse selected class(es) in a single class (classlist) browser
where is: #newBrowser - open a new browser showing the classes
where is: #newBuffer - add a new buffer showing the classes"
^ self spawnSingleClassBrowserFor:classes label:nil in:where
"Created: / 22-07-2011 / 18:41:43 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified (comment): / 28-02-2012 / 09:22:57 / cg"
!
spawnSingleClassBrowserFor:class label:titleOrNil in:where
"browse selected class(es) in a single class (classlist) browser
where is: #newBrowser - open a new browser showing the classes
where is: #newBuffer - add a new buffer showing the classes"
^ self spawnSingleClassBrowserFor:class label:titleOrNil in:where select:true
"Created: / 22-07-2011 / 18:42:33 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified (comment): / 28-02-2012 / 09:23:05 / cg"
!
spawnSingleClassBrowserFor:class label:labelOrNil in:where select:doSelectIn
"browse selected class(es);
where is: #newBrowser - open a new browser showing the class
where is: #newBuffer - add a new buffer showing the class"
|spec meta allClasses selectedClasses selectedProtocols selectedMethods singleClass doSelect|
doSelect := doSelectIn.
spec := #singleClassBrowserSpec.
singleClass := class.
meta := singleClass isMeta.
doSelect := true.
allClasses := Array with: singleClass theNonMetaclass.
doSelect ifTrue:[
selectedClasses := Array with: singleClass.
navigationState notNil ifTrue:[
selectedProtocols := self selectedProtocols value copy.
selectedMethods := self selectedMethodsValue copy.
(selectedMethods size > 0
and:[ selectedProtocols size == 0 ]) ifTrue:[
selectedProtocols := (selectedMethods collect:[:each | each category] as:Set) 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 ].
]
"Created: / 22-07-2011 / 18:37:32 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 28-02-2012 / 16:36:30 / cg"
!
spawnWithAllSubclassesIn:how
"open a new browser showing the selected classes with all subclasses"
|all allOrdered brwsr|
all := IdentitySet new.
allOrdered := OrderedCollection new.
self selectedNonMetaclassesDo:[:each |
each withAllSubclasses do:[:eachClass |
(all includesIdentical:eachClass) ifFalse:[
all add:eachClass.
allOrdered add:eachClass
]
].
"/ For Java interfaces, spawn browser on all classes / interfaces
"/ that implement that interface
(each isJavaClass and:[ each isInterface ]) ifTrue:[
self environment allClassesDo:[ :eachClass |
(eachClass isJavaClass and:[ eachClass interfaces includesIdentical: each ]) ifTrue:[
all add: eachClass.
allOrdered add: eachClass.
].
].
].
].
(all removeAllFoundIn:self selectedClassesValue; yourself) isEmpty ifTrue:[
self information:'No additional subclasses (same as selected).'.
^ self
].
brwsr := self spawnMultipleClassBrowserFor:allOrdered sortBy:#doNotSort in:how.
"Modified: / 28-02-2012 / 16:53:07 / cg"
"Modified: / 21-01-2015 / 19:20:40 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
spawnWithAllSuperclassesIn:how
"open a new browser showing the selected classes with all superclasses"
|all allOrdered brwsr|
all := IdentitySet new.
allOrdered := OrderedCollection new.
self selectedNonMetaclassesDo:[:each |
each withAllSuperclasses reverseDo:[:eachClass |
(all includesIdentical:eachClass) ifFalse:[
all add:eachClass.
allOrdered add:eachClass
]
]
].
(all removeAllFoundIn:(self selectedClassesValue); yourself) isEmpty ifTrue:[
self information:'No additional superclasses (same as selected).'.
^ self
].
brwsr := self spawnMultipleClassBrowserFor:allOrdered sortBy:#doNotSort in:how.
"Modified: / 28-02-2012 / 16:53:10 / cg"
!
spawnWithClassesCoveredByTestcaseIn:how
"open a new browser showing the classes which are covered
by the selected testcase classes"
|allCovered brwsr|
allCovered := IdentitySet new.
self selectedNonMetaclassesDo:[:each |
each isTestCaseLike ifTrue:[
allCovered addAll:each coveredClasses
]
].
allCovered := allCovered asOrderedCollection sort:[:a :b | a name < b name].
brwsr := self spawnMultipleClassBrowserFor:allCovered sortBy:nil in:how.
!
spawnWithCommonSuperclassIn:how
"open a new browser showing the selected classes' common superclass"
^ self spawnWithCommonSuperclassOf:(self selectedNonMetaclasses) in:how
"Created: / 28-02-2012 / 09:02:42 / cg"
!
spawnWithCommonSuperclassOf:classes in:how
"open a new browser showing the classes' common superclass"
|common|
common := Behavior commonSuperclassOf:classes.
"/ self spawnClassBrowserFor:{ common } label:'Common superclass' in:how.
self spawnFullBrowserInClass:common selector:nil in:how
"Created: / 28-02-2012 / 09:07:39 / cg"
!
variablesMenuGenerateMultiSetterInstanceCreationMethod
"create a multi setter instance creation method for selected instvars."
self classMenuGenerateMultiSetterInstanceCreationMethod
!
variablesMenuGenerateMultiSetterMethod
"create a multi setter method for selected instvars."
self classMenuGenerateMultiSetterMethod
! !
!NewSystemBrowser methodsFor:'menu actions-class hierarchy'!
classHierarchyMenuSelectWithAllSubclasses
|topClasses classes|
topClasses := self selectedClassHierarchyClasses.
classes := topClasses asSet collectAll:[:eachClass | eachClass withAllSubclasses].
self selectedClasses value:classes.
!
classHierarchyMenuSelectWithSubclasses
|topClasses classes|
topClasses := self selectedClassHierarchyClasses.
classes := topClasses asSet collectAll:[:eachClass | eachClass subclasses].
classes addAll: topClasses.
self selectedClasses value:classes.
!
classHierarchyMenuSelectWithSuperclasses
|topClasses classes|
topClasses := self selectedClassHierarchyClasses.
classes := topClasses asSet collectAll:[:eachClass | eachClass withAllSuperclasses].
self selectedClasses value:classes.
!
classHierarchyMenuUpdate
self classHierarchyTopClass value:(self theSingleSelectedClass).
!
selectedClassHierarchyClasses
|class|
class := self theSingleSelectedClass.
class isNil ifTrue:[
class := self classHierarchyTopClass value.
class notNil ifTrue:[
self meta value ifTrue:[
class := class theMetaclass.
] ifFalse:[
class := class theNonMetaclass.
]
].
].
class notNil ifTrue:[
^ Array with:class
].
^ self selectedClasses
! !
!NewSystemBrowser methodsFor:'menu actions-class packaging'!
excludeClasses: toExclude fromProject:aDefinitionClass using:generator
"exclude (remove from classList) a number of classes."
aDefinitionClass excludeClasses:toExclude usingCompiler:generator.
!
includeClassInProject:aClass usingManager:compiler
"include (add to classList) a class."
self
includeClasses:(Array with: aClass)
inProject:aClass projectDefinitionClass
usingManager:compiler
"Created: / 21-12-2011 / 20:17:48 / cg"
!
includeClasses: toInclude inProject:aDefinitionClass using:compiler
"include (add to classList) a number of classes."
aDefinitionClass includeClasses:toInclude usingCompiler:compiler.
!
makeClassesAutoloaded:toMakeAutoloaded inProject:aDefinitionClass using:generator
"include as autoloaded (add to classList) a number of classes."
aDefinitionClass makeClassesAutoloaded:toMakeAutoloaded usingCompiler:generator
! !
!NewSystemBrowser methodsFor:'menu actions-class repository'!
allKnownTagsInClasses:aCollectionOfClasses
|knownTags thisClassesTags|
knownTags := Set new.
aCollectionOfClasses do:[:eachClass |
thisClassesTags := eachClass sourceCodeManager knownTagsFor:eachClass.
knownTags addAll:thisClassesTags.
].
^ knownTags asSortedCollection.
"Created: / 08-02-2011 / 09:45:56 / cg"
!
askForRepositoryVersionOf:aClass withSourceDo:aTwoArgBlock
"helper for comapre class against version and compare method against version.
Ask for a version in the repository, fetch it and call ablock with
the source and revision info string as arguments.
Returns false, if no source could be fetched, true if the block was called"
|aStream comparedSource rev revInfoString mgr
nm msg rev2 newestRev
containerModule containerPackage containerFile rslt
pkg info mod dir versionsAreTheSame|
nm := aClass name.
mgr := SourceCodeManagerUtilities sourceCodeManagerFor:aClass.
mgr isNil ifTrue:[
^ false
].
rev := aClass binaryRevision.
rev2 := aClass revision.
rev isNil ifTrue:[
rev := rev2
].
rev isNil ifTrue:[
"/
"/ class not in repository - allow compare against any other containers newest contents
"/
self normalLabel.
pkg := aClass package.
(pkg notNil and:[pkg ~= PackageId noProjectID]) ifTrue:[
containerModule := pkg upTo:$:.
containerPackage := pkg copyFrom:(containerModule size + 2).
].
containerModule size == 0 ifTrue:[
containerModule := (SourceCodeManagerUtilities lastModule) ? Project current repositoryModule.
].
containerPackage size == 0 ifTrue:[
containerPackage := (SourceCodeManagerUtilities lastPackage) ? Project current package.
].
rslt := SourceCodeManagerUtilities default
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 nameWithoutPrefix , '.st')
forNewContainer:false.
rslt isNil ifTrue:[
"/ canel
^ false
].
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.
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 repository is %1.' with:newestRev)
].
self normalLabel.
rev := SourceCodeManagerUtilities default
askForExistingRevision:msg
title:'Compare with repository'
class:aClass
].
versionsAreTheSame := false.
(rev notNil or:[containerFile notNil]) ifFalse:[
self normalLabel.
^ false
].
rev notNil ifTrue:[
rev withoutSpaces isEmpty ifTrue:[
msg := 'extracting newest %1 (' , (newestRev ? '???') , ')'.
"/ aStream := mgr getMostRecentSourceStreamForClassNamed:nm.
rev := newestRev.
revInfoString := 'newest'.
] ifFalse:[
msg := 'extracting previous %1'.
revInfoString := rev
].
aStream := mgr getSourceStreamFor:aClass 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.
revInfoString := '???'
].
self busyLabel:msg with:nm.
aStream 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:revInfoString).
self normalLabel.
^ false
].
aStream class readErrorSignal handle:[:ex |
self warn:('read error while reading extracted source\\' , ex description) withCRs.
aStream close.
self normalLabel.
^ false
] do:[
comparedSource := aStream contents asString.
].
aStream close.
revInfoString = '(newest)' ifTrue:[
(rev := mgr newestRevisionOf:aClass) notNil ifTrue:[
revInfoString := '(newest is ' , rev , ')'
]
].
aTwoArgBlock value:comparedSource value:revInfoString.
self normalLabel.
^ true.
"Created: / 29-11-2011 / 13:10:05 / cg"
!
askForRepositoryVersionUsingManager:managerOrNil thenWithCurrentVersionDo:aFiveArgBlock
"helper for compare and patch file generation;
ask for version, get it, then call aBlock with
currentClass, source1, versionNr1, sourceCurrent, currentVersionNr"
^ self
askForRepositoryVersionUsingManager:managerOrNil
withExtensions:true
thenWithCurrentVersionDo:aFiveArgBlock
!
askForRepositoryVersionUsingManager:managerOrNil withExtensions:withExtensions thenWithCurrentVersionDo:aFiveArgBlock
"helper for compare and patch file generation;
ask for version, get it, then call aBlock with
currentClass, source1, versionNr1, sourceCurrent, currentVersionNr"
|currentClass
aStream comparedSource currentSource revInfo rev revString thisRevString mgr
nm msg rev2 newestRev
containerModule containerPackage containerFile rslt
pkg info mod dir versionsAreTheSame|
currentClass := self theSingleSelectedLoadedNonMetaclassOrNil.
currentClass isNil ifTrue:[
self warn:'Cannot compare unloaded classes.'.
^ false.
].
nm := currentClass name.
(mgr := managerOrNil) isNil ifTrue:[
mgr := currentClass sourceCodeManager.
mgr isNil ifTrue:[
^ false
].
].
"Use revision of manager"
rev := currentClass binaryRevision.
revInfo := currentClass revisionInfoOfManager: mgr.
revInfo notNil ifTrue:[
rev2 := revInfo revision.
].
rev2 notNil ifTrue:[
rev := rev2
].
rev isNil ifTrue:[
"/
"/ class not in repository - allow compare against any other containers newest contents
"/
self normalLabel.
pkg := currentClass package.
(pkg notNil and:[pkg ~= PackageId noProjectID]) ifTrue:[
containerModule := pkg upTo:$:.
containerPackage := pkg copyFrom:(containerModule size + 2).
].
containerModule size == 0 ifTrue:[
containerModule := (SourceCodeManagerUtilities lastModule) ? Project current repositoryModule.
].
containerPackage size == 0 ifTrue:[
containerPackage := (SourceCodeManagerUtilities lastPackage) ? Project current package.
].
rslt := mgr utilities
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:[
"/ cancel
^ false
].
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 repository is %1.' with:newestRev)
].
self normalLabel.
rev := mgr utilities
askForExistingRevision:msg
title:'Compare with repository'
class:currentClass
].
versionsAreTheSame := false.
(rev notNil or:[containerFile notNil]) ifFalse:[
self normalLabel.
^ false
].
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).
^ false
].
aStream class readErrorSignal handle:[:ex |
self warn:('read error while reading extracted source\\' , ex description) withCRs.
aStream close.
^ false
] do:[
comparedSource := aStream contents asString.
].
aStream close.
self busyLabel:'generating current source ...' with:nil.
aStream := '' writeStream.
Method flushSourceStreamCache.
"/ currentClass fileOutOn:aStream withTimeStamp:false.
"/ currentSource := aStream contents asString.
Class fileOutErrorSignal handle:[:ex |
ex proceed
] do:[
|numRealExtensionSkipped numUnassignedSkipped|
numRealExtensionSkipped := numUnassignedSkipped := 0.
currentSource := String streamContents:[:s |
currentClass
fileOutOn:s
withTimeStamp:true
withInitialize:true
withDefinition:true
methodFilter:[:m |
withExtensions ifTrue:[
true
] ifFalse:[
m isExtension ifTrue:[
m package == PackageId noProjectID
ifTrue:[ numUnassignedSkipped := numUnassignedSkipped + 1 ]
ifFalse:[ numRealExtensionSkipped := numRealExtensionSkipped + 1 ].
].
m isExtension not
]
]
].
(numRealExtensionSkipped + numUnassignedSkipped) > 0 ifTrue:[
Dialog warn:(resources
stringWithCRs:'The class contains %1 extensions (%2 real, %3 unassigned) - any changes there are NOT included in the patchFile!!\Please check this manually%4.'
with: (numRealExtensionSkipped + numUnassignedSkipped)
with: numRealExtensionSkipped
with: numUnassignedSkipped
with: ((numUnassignedSkipped > 0)
ifTrue:[ resources string:' (hint: move the unassigned extensions to their proper package)' ]
ifFalse:[''] )).
].
].
thisRevString := currentClass revision.
thisRevString isNil ifTrue:[
thisRevString := 'no revision'
].
aFiveArgBlock
value:currentClass
value:comparedSource
value:revString
value:currentSource
value:thisRevString.
self normalLabel.
^ true
"Created: / 26-09-2012 / 12:26:43 / cg"
!
askForTagForClasses:classesToFetchExistingTagsFrom
^ (self askForTagForClasses:classesToFetchExistingTagsFrom askForRevision:false) key.
!
askForTagForClasses:classesToFetchExistingTagsFrom askForRevision:askForRevisionBool
"open a dialog and ask for a tag name.
Fetch existing tag names from classesToFetchExistingTagsFrom.
If asskForRevisonBool is true, ask also for a revision number or tag.
Answer an association tag -> revision."
|classes tag knownTags allOwners tagValue revisionValue|
classes := classesToFetchExistingTagsFrom.
allOwners := Set new.
classes do:[:each |
each owningClass notNil ifTrue:[
allOwners add:each owningClass
].
].
classes := classes reject:[:cls | cls isPrivate].
classes := classes asSet.
classes addAll:allOwners.
classes := classes asOrderedCollection "sort:[:a :b | a name < b name]".
((classes size <= 10)
or:[ |answer|
answer := Dialog
confirmWithCancel:'Fetch known tags to choose from all classes?\(this may take some time)' withCRs
default:false.
answer isNil ifTrue:[^ self].
answer == true
]
) ifTrue:[
"/ fetch from all classes
knownTags := self allKnownTagsInClasses:classes.
] ifFalse:[
"/ only fetch from ProjectDefinitionClasses
knownTags := self allKnownTagsInClasses:(classes select:[:cls | cls isProjectDefinition]).
].
knownTags remove:'stable' ifAbsent:[].
knownTags := knownTags asOrderedCollection reversed.
knownTags notEmpty ifTrue:[
knownTags addFirst:nil.
].
knownTags addFirst:'stable'.
askForRevisionBool ifTrue:[
tagValue := CVSSourceCodeManager recentTag asValue.
revisionValue := '' asValue.
(Dialog new
addTextLabel:(resources string:'Tag (possibly multiple, separated by ";"):');
addComboBoxOn:tagValue list:knownTags tabable:true;
addVerticalSpace;
addTextLabel:(resources string:'Revision number or symbolic name to tag (empty if HEAD):');
addInputFieldOn:revisionValue;
addAbortButton;
addOkButton;
open
) accepted ifFalse:[
^ nil -> nil.
].
tag := tagValue value.
] ifFalse:[
tag := Dialog
request:(resources string:'Tag (possibly multiple, separated by ";"):')
initialAnswer:(CVSSourceCodeManager recentTag)
list:knownTags.
].
tag isEmptyOrNil ifTrue:[^ nil -> nil ].
CVSSourceCodeManager recentTag:tag.
^ tag -> revisionValue value
"Created: / 29-07-2013 / 00:56:30 / cg"
!
checkInClasses:aCollectionOfClasses withInfo:logInfoOrNil withCheck:doCheck
"check a bunch of classes into the source repository.
If logInfoOrNil isNil, ask for one."
self checkInClasses:aCollectionOfClasses withInfo:logInfoOrNil withCheck:doCheck usingManager:nil
"Modified: / 21-12-2011 / 18:23:10 / cg"
!
checkInClasses:aCollectionOfClasses withInfo:logInfoOrNil withCheck:doCheck usingManager:aManagerOrNil
"check a bunch of classes into the source repository.
If logInfoOrNil isNil, ask for one."
|classesNotInPackage utilities msg answer errors|
"JV@2012-04-11: Kludge for SVNSourceCodeManager that does the check itself using
new ProjectChecker and I don't want same message to appear twice. Anyway, there
is another check for bad selectors in SCM, sigh"
(aManagerOrNil isNil or:[aManagerOrNil performsCompilabilityChecks not]) ifTrue:[
errors := self checkCompilabilityOfAll:aCollectionOfClasses withExtensions: false "true" errorsOnly:true.
errors notEmptyOrNil ifTrue:[
(TextBox openOn:errors title:'Attention: about to check in class with errors' readOnly:true) isNil
ifTrue:[
AbortOperationRequest raise
].
].
].
utilities := aManagerOrNil isNil
ifTrue:[ SourceCodeManagerUtilities default ]
ifFalse:[ aManagerOrNil utilities ].
self withActivityNotificationsRedirectedToInfoLabelDo:[
utilities
checkinClasses:aCollectionOfClasses
withInfo:logInfoOrNil
withCheck:doCheck
usingManager:aManagerOrNil.
].
classesNotInPackage := aCollectionOfClasses select:[:cls |
|pkg def|
pkg := cls package.
pkg notNil ifTrue:[
def := ProjectDefinition definitionClassForPackage:pkg.
].
def notNil
and: [ cls isJavaClass not
and: [ (def allClassNames includes:cls name) not] ]
].
classesNotInPackage := classesNotInPackage collect:[:cls | cls theNonMetaclass].
classesNotInPackage notEmpty ifTrue:[
classesNotInPackage size > 1 ifTrue:[
msg := 'Add %2 classes to their Package definition (Make compiled or autoloaded) ?'
] ifFalse:[
msg := 'Add %1 to its Package definition (Make compiled or autoloaded) ?'
].
answer := Dialog
confirmWithCancel:((resources string:msg
with:classesNotInPackage first name
with:classesNotInPackage size)
, (resources
stringWithCRs:'\\(Notice: You have to "checkIn build support files" for the package\for the compilation to become effective)')
)
labels:(resources array:#('No' 'Autoloaded' 'Compiled')).
answer == nil ifTrue:[^ self ].
classesNotInPackage do:[:eachClass |
|defClass|
defClass := eachClass projectDefinitionClass.
answer == true ifTrue:[
defClass includeClasses:{ eachClass } usingCompiler:nil
] ifFalse:[
defClass makeClassesAutoloaded:{ eachClass } usingCompiler:nil
].
].
].
"Created: / 21-12-2011 / 18:22:58 / cg"
"Modified: / 11-06-2015 / 06:09:10 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
checkOutClass:aClass askForRevision:askForRevision
"check-out a single class from the source repository.
Offer a chance to either merge-in a version, or overload the current version.
If askForRevision is false, fetch the newest revision(s),
otherwise ask for the revision."
self
checkOutClass:aClass
askForRevision:askForRevision
usingManager:nil
"Modified: / 01-03-2007 / 17:47:32 / cg"
!
checkOutClass:aClass askForRevision:askForRevision usingManager: managerOrNil
"check-out a single class from the source repository.
Offer a chance to either merge-in a version, or overload the current version.
If askForRevision is false, fetch the newest revision(s),
otherwise ask for the revision."
self withActivityNotificationsRedirectedToInfoLabelDo:[
(managerOrNil isNil
ifTrue:[SourceCodeManagerUtilities]
ifFalse:[managerOrNil utilities])
checkoutClass:aClass askForRevision:askForRevision askForMerge:true.
"/ version id may have changed
self theSingleSelectedClass notNil ifTrue:[
self updatePackageInfoForClass:self theSingleSelectedClass
].
]
"Modified: / 01-03-2007 / 17:47:32 / cg"
"Created: / 11-10-2011 / 23:12:03 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Created: / 21-12-2011 / 20:26:27 / cg"
!
checkOutClasses:classes askForRevision:askForRevision
"check-out a bunch of classes from the source repository.
Offer chance to either overwrite the current version,
or merge-in the repository version.
If askForRevision is false, fetch the newest revision(s),
otherwise ask for the revision."
self checkOutClasses:classes askForRevision:askForRevision usingManager:nil
"Modified: / 22-12-2011 / 11:05:05 / cg"
!
checkOutClasses:classes askForRevision:askForRevision usingManager:aManagerOrNilForDefault
"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 utilities|
(self askIfModified:'Code was modified.\\CheckOut anyway ?')
ifFalse:[^ self].
utilities := (aManagerOrNilForDefault ? SourceCodeManager) utilities.
classes isEmpty ifTrue:[
Dialog warn:'No classes to checkout'.
"/ SourceCodeManagerUtilities
"/ checkoutClass:nil
"/ askForRevision:true
"/ askForMerge:false.
^ self
].
alreadyCheckedOut := IdentitySet new.
"abortAll is handled, and also asked for here!!"
AbortAllOperationRequest handleAndAnswerQueryIn:[
self
classes:classes
nonMetaDo:
[:cls |
UserInformation handle:[:ex |
classes size > 1 ifTrue:[
Transcript showCR:ex description.
] ifFalse:[
(Dialog confirm:ex description noLabel:'Cancel') ifFalse:[
AbortSignal raise
].
].
ex proceed.
] do:[
self withActivityNotificationsRedirectedToInfoLabelDo:[
utilities
checkoutClass:cls
askForRevision:askForRevision
askForMerge:true
askForConfirmation:false.
].
alreadyCheckedOut add:cls.
]
]
ifUnloaded:
[:cls | true]
ifPrivate:
[:cls | |owner answer|
owner := cls topOwningClass.
(alreadyCheckedOut includes:owner) ifFalse:[
((self selectedClassesValue ? #()) includes:owner) ifFalse:[
answer := Dialog
confirmWithCancel:(resources string:'Cannot checkOut private class: %1\\Shall the owner ''%2'' be checked out ?'
with:cls nameWithoutPrefix allBold
with:owner name) withCRs
default:true.
answer == nil ifTrue:[
AbortAllOperationRequest raise "/ cancel
].
answer == true ifTrue:[
self checkOutClass:owner askForRevision:askForRevision usingManager:aManagerOrNilForDefault.
alreadyCheckedOut add:owner.
].
]
]
].
].
"/ version id may have changed
self theSingleSelectedClass notNil ifTrue:[
self updatePackageInfoForClass:self theSingleSelectedClass
].
self normalLabel.
"Created: / 11-10-2011 / 23:11:25 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Created: / 21-12-2011 / 20:15:33 / cg"
!
classMenuBrowseAllVersionsInRepository
"open a diff-textView showing all versions in the repository."
|currentClass|
currentClass := self theSingleSelectedLoadedNonMetaclassOrNil.
currentClass isNil ifTrue:[
self warn:'Cannot compare unloaded classes.'.
^ self.
].
self withWaitCursorDo:[
VersionDiffBrowser openOnAllVersionsOfClass:currentClass
]
!
classMenuCheckIn
"check a class into the source repository (with checks)"
self classMenuCheckInUsingManager:nil
"Modified: / 21-12-2011 / 18:20:40 / cg"
!
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 usingManager:nil
"Modified: / 21-12-2011 / 18:21:44 / cg"
!
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.
"
self classMenuCheckIn:doCheck classes:classesSelected usingManager:nil
"Modified: / 21-12-2011 / 18:22:24 / cg"
!
classMenuCheckIn:doCheck classes:classesSelected usingManager:aManagerOrNil
"check a class into the source repository.
If doCheck is true, perform some checks (leftover halts etc.) on
the class (which may take some time with huge classes).
Otherwise, a no check is done, and the class is quickly checked in.
"
|classesToCheckIn|
(self askIfModified:'Code was modified.\\CheckIn (without that modification) anyway ?')
ifFalse:[^ self].
classesToCheckIn := IdentitySet new.
self
classes:classesSelected
nonMetaDo:
[:cls |
InformationSignal handle:[:ex |
Transcript showCR:ex description.
ex proceed.
] do:[
classesToCheckIn add:cls.
]
]
ifUnloaded:
[:cls |
(Dialog confirm:('Cannot checkin unloaded class: %1.' bindWith:cls name allBold)
title:'Cannot Checkin' yesLabel:'OK' noLabel:'Cancel' ) ifFalse:[^ self].
false.
]
ifPrivate:
[:cls | |owner answer|
owner := cls topOwningClass.
(classesToCheckIn includes:owner) ifFalse:[
(classesSelected "self selectedClasses value" includes:owner) ifFalse:[
UserPreferences current confirmCheckinOfPrivateClasses ifFalse:[
answer := true.
] ifTrue:[
Dialog
withOptoutOption:[ UserPreferences current confirmCheckinOfPrivateClasses: false ]
labelled:(SystemBrowser classResources string:'Do not show this dialog again')
do:[
answer := Dialog
confirmWithCancel:(resources string:'Cannot checkin private class: %1\\Shall the owner ''%2'' be checked in ?'
with:cls nameWithoutPrefix allBold
with:owner name allBold) withCRs
default:true.
].
].
answer == nil ifTrue:[
^ self
].
answer == true ifTrue:[
classesToCheckIn add:owner.
].
]
]
].
classesToCheckIn notEmpty ifTrue:[
self checkInClasses:classesToCheckIn withInfo:nil withCheck:doCheck usingManager:aManagerOrNil.
].
"/ version id may have changed
self theSingleSelectedClass notNil ifTrue:[
self updatePackageInfoForClass:self theSingleSelectedClass
].
self normalLabel.
"Created: / 21-12-2011 / 18:22:09 / cg"
!
classMenuCheckIn:doCheck usingManager:aManagerOrNil
"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 selectedClassesValue)
usingManager:aManagerOrNil
"Created: / 21-12-2011 / 18:21:30 / cg"
!
classMenuCheckInAllChangedClasses
"check in all changed classes into the source repository (with checks)"
^ self classMenuCheckInAllChangedClassesUsingManager:nil
"Modified: / 21-12-2011 / 19:52:29 / cg"
!
classMenuCheckInAllChangedClasses:doCheck
"check all changed classes into the source repository.
If doCheck is true, perform some checks (leftover halts etc.) on
the class (which may take some time with huge classes).
Otherwise, a no check is done, and the class is quickly checked in.
"
^ self classMenuCheckInAllChangedClasses:doCheck usingManager:nil
"Modified: / 21-12-2011 / 19:53:00 / cg"
!
classMenuCheckInAllChangedClasses:doCheck usingManager:aManagerOrNil
"check all changed classes into the source repository.
If doCheck is true, perform some checks (leftover halts etc.) on
the class (which may take some time with huge classes).
Otherwise, a no check is done, and the class is quickly checked in.
"
^ self
classMenuCheckIn:doCheck
classes:(ChangeSet current changedClasses)
usingManager:aManagerOrNil
"Created: / 21-12-2011 / 19:52:50 / cg"
!
classMenuCheckInAllChangedClassesUsingManager:aManagerOrNil
"check in all changed classes into the source repository (with checks)"
|doChecks|
doChecks := (UserPreferences current at:#checkClassesWhenCheckingIn ifAbsent:true).
^ self classMenuCheckInAllChangedClasses:doChecks usingManager:aManagerOrNil
"Created: / 21-12-2011 / 19:52:16 / cg"
!
classMenuCheckInAllChangedClassesUsingManagerNamed:sourceCodeManagerClassName
"check in all changed classes into the source repository (with checks)"
^ self classMenuCheckInAllChangedClassesUsingManager:(self sourceCodeManagerNamed:sourceCodeManagerClassName)
"Created: / 21-12-2011 / 20:04:27 / cg"
!
classMenuCheckInExtensions
"check a classes extensions into the source repository"
^ self classMenuCheckInExtensionsUsingManager:nil
!
classMenuCheckInExtensions:doCheck
"check a classes extensions into the source repository.
If doCheck is true, perform some checks (leftover halts etc.) on
the class (which may take some time with huge classes).
Otherwise, a no check is done, and the class is quickly checked in.
"
|projects|
(self askIfModified:'Code was modified.\\CheckIn (without that modification) anyway ?')
ifFalse:[^ self].
projects := Set new.
self selectedClassesDo:[:eachClass |
eachClass instAndClassSelectorsAndMethodsDo:[:sel :mthd | projects add:mthd package].
].
projects do:[:eachProject |
self
projectMenuCheckInProject:eachProject
classes:false
extensions:true
buildSupport:false
askForMethodsInOtherPackages:false
usingManager:nil.
].
!
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 withWaitCursorDo:[
self
projectMenuCheckInProject:aProjectID
classes:false
extensions:true
buildSupport:false
askForMethodsInOtherPackages:false
usingManager:nil.
]
"Modified: / 08-09-2011 / 04:07:58 / cg"
!
classMenuCheckInExtensionsFor:aProjectID usingManager:manager
"check some of a classes extensions into the source repository."
(self askIfModified:'Code was modified.\\CheckIn (without that modification) anyway ?')
ifFalse:[^ self].
self withWaitCursorDo:[
self
projectMenuCheckInProject:aProjectID
classes:false
extensions:true
buildSupport:false
askForMethodsInOtherPackages:false
usingManager:manager.
]
"Modified: / 08-09-2011 / 04:07:58 / cg"
!
classMenuCheckInExtensionsUsingManager:managerOrNil
"check a classes extensions into the source repository.
"
|projects|
(self askIfModified:'Code was modified.\\CheckIn (without that modification) anyway ?')
ifFalse:[^ self].
projects := Set new.
self selectedClassesDo:[:eachClass |
eachClass instAndClassSelectorsAndMethodsDo:[:sel :mthd | projects add:mthd package].
].
projects do:[:eachProject |
self
projectMenuCheckInProject:eachProject
classes:false
extensions:true
buildSupport:false
askForMethodsInOtherPackages:false
usingManager:managerOrNil.
].
!
classMenuCheckInP4
"check a class into the source repository (with checks)"
PerforceSourceCodeManager notNil ifTrue:[
self classMenuCheckInUsingManager:PerforceSourceCodeManager
].
"Modified: / 21-12-2011 / 18:20:40 / cg"
!
classMenuCheckInUsingManager:aManagerOrNil
"check a class into the source repository (with checks)"
|doChecks|
doChecks := (UserPreferences current at:#checkClassesWhenCheckingIn ifAbsent:true).
doChecks := doChecks asValue.
self classMenuCheckIn:doChecks usingManager:aManagerOrNil.
doChecks value ~~ (UserPreferences current at:#checkClassesWhenCheckingIn ifAbsent:true) ifTrue:[
UserPreferences current at:#checkClassesWhenCheckingIn put:doChecks value
].
"Created: / 21-12-2011 / 18:20:19 / cg"
!
classMenuCheckInUsingManagerNamed:sourceCodeManagerClassName
"check a class into the source repository (with checks)"
self classMenuCheckInUsingManager:(self sourceCodeManagerNamed:sourceCodeManagerClassName)
"Created: / 21-12-2011 / 20:03:01 / cg"
!
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 selectedClassesValue) askForRevision:true
"Modified: / 28-02-2012 / 16:45:43 / cg"
!
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 selectedClassesValue) askForRevision:false
"Modified: / 28-02-2012 / 16:45:46 / cg"
!
classMenuCheckOutNewestUsingManager: manager
"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 selectedClassesValue) askForRevision:false usingManager: manager
"Modified: / 11-10-2011 / 23:09:36 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Created: / 21-12-2011 / 20:16:21 / cg"
!
classMenuCheckOutNewestUsingManagerNamed: sourceCodeManagerClassName
"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 classMenuCheckOutNewestUsingManager:(self sourceCodeManagerNamed:sourceCodeManagerClassName)
!
classMenuCheckOutUsingManager: manager
"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 selectedClassesValue) askForRevision:true usingManager: manager
"Modified: / 11-10-2011 / 23:10:14 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Created: / 21-12-2011 / 20:16:41 / cg"
!
classMenuCheckOutUsingManagerNamed: sourceCodeManagerClassName
"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 classMenuCheckOutUsingManager: (self sourceCodeManagerNamed:sourceCodeManagerClassName)
!
classMenuCompareAgainstNewestInRepository
"open a diff-textView comparing the current (in-image) version
with the newest version found in the repository.
That is the most recent version."
self doCompareClassesWithRepository:(self selectedClassesValue).
"Modified: / 28-02-2012 / 16:45:55 / cg"
!
classMenuCompareAgainstNewestInRepositoryUsingManager:aManagerOrNil
"open a diff-textView comparing the current (in-image) version
with the newest version found in the repository.
That is the most recent version."
self doCompareClassesWithRepository:(self selectedClassesValue) usingManager:aManagerOrNil.
"Created: / 21-12-2011 / 19:55:56 / cg"
!
classMenuCompareAgainstNewestInRepositoryUsingManagerNamed:sourceCodeManagerClassName
"open a diff-textView comparing the current (in-image) version
with the newest version found in the repository.
That is the most recent version."
self classMenuCompareAgainstNewestInRepositoryUsingManager:(self sourceCodeManagerNamed:sourceCodeManagerClassName)
"Created: / 21-12-2011 / 20:35:43 / cg"
!
classMenuCompareAgainstOriginalInRepository
"open a diff-textView comparing the current (in-image) version
with the base version found in the repository.
That is the version on which the class was based upon, not the most recent one."
|currentClass mgr|
currentClass := self theSingleSelectedLoadedNonMetaclassOrNil.
currentClass isNil ifTrue:[
self warn:'Cannot compare unloaded classes.'.
^ self.
].
mgr := SourceCodeManagerUtilities sourceCodeManagerFor:currentClass.
self classMenuCompareAgainstOriginalInRepositoryUsingManager:mgr.
"Modified: / 21-12-2011 / 22:49:35 / cg"
!
classMenuCompareAgainstOriginalInRepositoryUsingManager: manager
"open a diff-textView comparing the current (in-image) version
with the base version found in the repository.
That is the version on which the class was based upon, not the most recent one."
|currentClass rev revInfo|
currentClass := self theSingleSelectedLoadedNonMetaclassOrNil.
currentClass isNil ifTrue:[
self warn:'Cannot compare unloaded classes.'.
^ self.
].
manager isNil ifTrue:[
self halt.
^ self
].
revInfo := currentClass revisionInfoOfManager: manager.
revInfo ifNil:[
self warn:('The class seems to have no repository information for %1.' bindWith: manager managerTypeName).
^ self
].
rev := revInfo revision.
rev isNil ifTrue:[
self warn:'The class seems to have no repository information.'.
^ self
].
"/ a hack - after a merge, the revision number is changed to xxxm.
"/ need a better solution for that in the long term
#fixme.
(manager == CVSSourceCodeManager and:[ rev endsWith:$m ]) ifTrue:[
rev := rev copyButLast.
].
self classMenuCompareAgainstVersionInRepository:rev usingManager: manager
!
classMenuCompareAgainstOriginalInRepositoryUsingManagerNamed:sourceCodeManagerClassName
"open a diff-textView comparing the current (in-image) version
with the base version found in the repository.
That is the version on which the class was based upon, not the most recent one."
self classMenuCompareAgainstOriginalInRepositoryUsingManager:(self sourceCodeManagerNamed:sourceCodeManagerClassName)
"Created: / 21-12-2011 / 22:50:51 / cg"
!
classMenuCompareAgainstStableInRepository
"open a diff-textView comparing the current (in-image) version
with the base version found in the repository.
That is the version on which the class was based upon, not the most recent one."
|currentClass mgr|
currentClass := self theSingleSelectedLoadedNonMetaclassOrNil.
currentClass isNil ifTrue:[
self warn:'Cannot compare unloaded classes.'.
^ self.
].
mgr := SourceCodeManagerUtilities sourceCodeManagerFor:currentClass.
self classMenuCompareAgainstStableInRepositoryUsingManager:mgr.
"Modified: / 21-12-2011 / 22:49:35 / cg"
!
classMenuCompareAgainstStableInRepositoryUsingManager: manager
"open a diff-textView comparing the current (in-image) version
with the stable version found in the repository."
|currentClass rev|
currentClass := self theSingleSelectedLoadedNonMetaclassOrNil.
currentClass isNil ifTrue:[
self warn:'Cannot compare unloaded classes.'.
^ self.
].
rev := manager revisionForTag:'stable' inClass:currentClass.
rev isNil ifTrue:[
Dialog information:'No revision is tagged as "stable" in the repository'.
^ self.
].
self classMenuCompareAgainstVersionInRepository:rev usingManager: manager
!
classMenuCompareAgainstStableInRepositoryUsingManagerNamed: sourceCodeManagerClassName
"open a diff-textView comparing the current (in-image) version
with the stable version found in the repository."
self classMenuCheckOutUsingManager: (self sourceCodeManagerNamed:sourceCodeManagerClassName)
!
classMenuCompareAgainstVersionInRepository:rev usingManager: manager
"open a diff-textView comparing the current (in-image) version
with a 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 revString thisRevString
nm msg brwsr|
currentClass := self theSingleSelectedLoadedNonMetaclassOrNil.
currentClass isNil ifTrue:[
self warn:'Cannot compare unloaded classes.'.
^ self.
].
nm := currentClass name.
msg := 'extracting revision %1'.
self busyLabel:msg with:rev.
self withActivityNotificationsRedirectedToInfoLabelDo:[
aStream := manager 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 := manager newestRevisionOf:currentClass) notNil ifTrue:[
"/ newestRev ~= rev ifTrue:[
"/ revString := rev , ' (newest is ' , newestRev , ')'
"/ ]
"/ ].
self busyLabel:'comparing ...' with:nil.
brwsr := (UserPreferences versionDiffViewerClass)
openOnClass:currentClass
labelA:('repository: ' , revString)
sourceA:comparedSource
labelB:('current: (based on: ' , rev , ')')
sourceB:currentSource
title:('comparing ' , currentClass name)
ifSame:[self normalLabel. self information:'Versions are identical.'. ^ self].
brwsr classChangeSet
classBeingCompared:currentClass;
versionA:rev;
versionB:rev , 'mod'.
].
self normalLabel.
"Modified: / 11-10-2011 / 14:37:07 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Created: / 21-12-2011 / 20:28:18 / cg"
!
classMenuCompareClassExtensionsWithRepository
"open a diff-textView comparing the current (in-image) extensions of the selected class
with the some extensions version found in the repository."
|currentClass extensionMethods extensionMethodChangesInImage extensionProjectDefinitions
extensionMethodChangesInRepository diffSet versionsAreTheSame|
currentClass := self theSingleSelectedLoadedNonMetaclassOrNil.
currentClass isNil ifTrue:[^ self].
extensionMethods := currentClass methodDictionary values select:[:mthd | mthd isExtension].
extensionProjectDefinitions := Set new.
ProjectDefinition allSubclasses do:[:eachProjectDefinition |
(eachProjectDefinition extensionClasses includes:currentClass) ifTrue:[
extensionProjectDefinitions add:eachProjectDefinition.
].
].
extensionMethodChangesInImage := ChangeSet forExistingClass:currentClass withExtensions:true extensionsOnly:true.
extensionMethodChangesInRepository := ChangeSet new.
extensionProjectDefinitions do:[:eachProjectDefinition |
|mgr revString info rev package changesHere changesHereForMe|
package := eachProjectDefinition package.
mgr := SourceCodeManagerUtilities sourceCodeManagerFor:eachProjectDefinition.
mgr isNil ifTrue:[
Dialog warn:(resources string:'No sourceCodeManager known for %1.' with:eachProjectDefinition package).
] ifFalse:[
rev := mgr
newestRevisionInFile:'extensions.st'
directory:(eachProjectDefinition directory)
module:(eachProjectDefinition module).
"/ revString := eachProjectDefinition perform:(mgr nameOfVersionMethodForExtensions) ifNotUnderstood:nil.
"/ revString isNil ifTrue:[
"/ Dialog warn:(resources string:'%1 seems to not have any extensions (loaded)' with:package).
"/] ifFalse:[
"/ info := mgr revisionInfoFromString:revString.
"/ rev := info revision.
"/
"/ ask for revision
"/
"/ newestRev := mgr
"/ newestRevisionInFile:'extensions.st'
"/ directory:(eachProjectDefinition directory)
"/ module:(eachProjectDefinition module).
changesHere := SourceCodeManagerUtilities default
changeSetForExtensionMethodsForPackage:package
revision:rev orAskForRevision:false
usingManager:mgr.
changesHereForMe := changesHere select:[:chg | chg isMethodChange
and:[chg changeClass == currentClass]].
extensionMethodChangesInRepository addAll:changesHereForMe.
"/ ].
].
].
versionsAreTheSame := false.
diffSet := extensionMethodChangesInImage diffSetsAgainst:extensionMethodChangesInRepository.
diffSet isEmpty ifTrue:[
self information:'Versions are identical.'.
^ self
].
(UserPreferences versionDiffViewerClass)
openOnDiffSet:diffSet
labelA:'Current (In Image)'
labelB:('Repository (%1 extension package(s))' bindWith:extensionProjectDefinitions size)
title:'Diffs'
ignoreExtensions:false.
self normalLabel.
"Created: / 12-09-2011 / 11:21:39 / cg"
!
classMenuCompareExtensionsWithRepository
"open a diff-textView comparing the current (in-image) extensions version
with the some extensions version found in the repository."
|currentClass projectDefinition projectsPackage rev revString mgr msg newestRev diffSet
info versionsAreTheSame changeSetForMethodsInRepository changeSetForMethodsInImage|
currentClass := self theSingleSelectedLoadedNonMetaclassOrNil.
currentClass isNil ifTrue:[^ self].
(projectDefinition := currentClass theNonMetaclass) isProjectDefinition ifFalse:[
self classMenuCompareClassExtensionsWithRepository.
^ self.
].
projectsPackage := projectDefinition package.
mgr := SourceCodeManagerUtilities sourceCodeManagerFor:projectDefinition.
mgr isNil ifTrue:[
^ self
].
revString := projectDefinition perform:(mgr nameOfVersionMethodForExtensions) ifNotUnderstood:nil.
revString isNil ifTrue:[
self warn:('%1 seems to not have any extensions (loaded)' bindWith:projectsPackage).
^ self.
].
info := mgr revisionInfoFromString:revString.
rev := info revision.
"/
"/ ask for revision
"/
newestRev := mgr
newestRevisionInFile:'extensions.st'
directory:(projectDefinition directory)
module:(projectDefinition module).
msg := resources string:'Compare to revision: (empty for newest)'.
rev notNil ifTrue:[
msg := msg , '\\' , (resources string:'Current extensions.st is based upon rev %1.'
with:rev).
].
newestRev notNil ifTrue:[
msg := msg , '\' , (resources string:'Newest in repository is %1.'
with:newestRev)
].
self normalLabel.
rev := SourceCodeManagerUtilities default
askForExistingRevision:msg
title:'Compare Extensions against Revision'
class:nil
manager:mgr
module:projectDefinition module package:projectDefinition directory
fileName:'extensions.st'.
versionsAreTheSame := false.
rev isNil ifTrue:[
self normalLabel.
^ self.
].
rev withoutSpaces isEmpty ifTrue:[
msg := 'extracting newest %1 (' , (newestRev ? '???') , ')'.
rev := newestRev.
revString := 'newest'.
] ifFalse:[
msg := 'extracting previous %1'.
revString := rev
].
changeSetForMethodsInRepository :=
SourceCodeManagerUtilities default
changeSetForExtensionMethodsForPackage:projectsPackage
revision:revString orAskForRevision:false
usingManager:mgr.
changeSetForMethodsInImage := ChangeSet forExistingMethods:(
Method allInstances
select:[:m | m package = projectsPackage
and:[ m mclass notNil and:[m isExtension]]]).
diffSet := changeSetForMethodsInImage diffSetsAgainst:changeSetForMethodsInRepository.
(UserPreferences versionDiffViewerClass)
openOnDiffSet:diffSet
labelA:'Current (In Image)'
labelB:'Repository (',rev,')'
title:'Diffs'
ignoreExtensions:false.
self normalLabel.
"Created: / 04-01-1997 / 15:48:20 / cg"
"Modified: / 21-12-2011 / 20:21:14 / cg"
!
classMenuCompareExtensionsWithRepositoryUsingManager: manager
|allExtendingPackages|
allExtendingPackages := Set new.
self selectedClassesDo:[:eachClass |
eachClass instAndClassSelectorsAndMethodsDo:[:sel :mthd |
mthd isExtension ifTrue:[
allExtendingPackages add:mthd package.
]
].
].
manager utilities comparePackages: allExtendingPackages askForRevision: false extensionsOnly:true.
!
classMenuCompareExtensionsWithRepositoryUsingManagerNamed: sourceCodeManagerClassName
self classMenuCompareExtensionsWithRepositoryUsingManager: (self sourceCodeManagerNamed:sourceCodeManagerClassName).
!
classMenuCompareTwoRepositoryVersions
"open a diff-textView comparing two versions found in the repository."
|currentClass mgr nm|
currentClass := self theSingleSelectedLoadedNonMetaclassOrNil.
currentClass isNil ifTrue:[
self warn:'Cannot compare unloaded classes.'.
^ self.
].
nm := currentClass name.
mgr := SourceCodeManagerUtilities sourceCodeManagerFor:currentClass.
mgr isNil ifTrue:[
^ self
].
self classMenuCompareTwoRepositoryVersionsUsingManager: mgr
"Modified (format): / 26-09-2012 / 12:17:45 / cg"
!
classMenuCompareTwoRepositoryVersionsUsingManager: manager
"open a diff-textView comparing two versions found in the repository."
|currentClass source1 source2 mgr
nm rev1 rev2 versionsAreTheSame|
currentClass := self theSingleSelectedLoadedNonMetaclassOrNil.
currentClass isNil ifTrue:[
self warn:'Cannot compare unloaded classes.'.
^ self.
].
nm := currentClass name.
mgr := manager.
mgr isNil ifTrue:[
^ self
].
self normalLabel.
rev1 := manager utilities
askForExistingRevision:(resources string:'Compare which revision:')
title:(resources string:'Compare which repository version')
class:currentClass.
rev1 isNil ifTrue:[^ self].
rev2 := manager utilities
askForExistingRevision:(resources string:'Against which revision:')
title:(resources string:'Against which repository version')
class:currentClass.
rev2 isNil ifTrue:[^ self].
source1 := self getClassSourceFor:currentClass revision:rev1 usingManager: manager.
source2 := self getClassSourceFor:currentClass revision:rev2 usingManager: manager.
self busyLabel:'comparing ...' with:nil.
versionsAreTheSame := (source1 = source2).
versionsAreTheSame ifFalse:[
self busyLabel:'comparing ...' with:nil.
(UserPreferences versionDiffViewerClass)
openOnClass:currentClass
labelA:(rev1)
sourceA:source1
labelB:(rev2)
sourceB:source2
title:('comparing ' , currentClass name)
ifSame:[versionsAreTheSame := true].
versionsAreTheSame ifTrue:[
self information:'Versions are identical.'.
].
].
self normalLabel.
"Modified: / 11-10-2011 / 23:07:07 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Created: / 21-12-2011 / 20:28:43 / cg"
!
classMenuCompareTwoRepositoryVersionsUsingManagerNamed:sourceCodeManagerClassName
"open a diff-textView comparing two versions found in the repository."
self classMenuCompareTwoRepositoryVersionsUsingManager:(self sourceCodeManagerNamed:sourceCodeManagerClassName)
"Created: / 21-12-2011 / 23:13:40 / cg"
!
classMenuCompareWithFile
"compare the class against a version in a file"
|collectionOfClasses current fileName fileVersion diffs allDiffs title|
collectionOfClasses := self selectedClassesValue.
collectionOfClasses do:[:eachClass |
|className metaclassName|
className := eachClass theNonMetaclass name.
metaclassName := eachClass theMetaclass name.
eachClass isLoaded ifFalse:[
Transcript showCR:('Cannot compare unloaded class: ' , className).
] ifTrue:[
fileName := Dialog requestFileName:('Compare against:', className) default:(eachClass theNonMetaclass classFilename).
fileName isEmptyOrNil ifTrue:[^ self].
self busyLabel:'comparing ...' with:nil.
current := ChangeSet forExistingClass:eachClass theNonMetaclass.
fileVersion := ChangeSet fromFile:fileName.
diffs := fileVersion diffSetsAgainst:current.
allDiffs isNil ifTrue:[
allDiffs := diffs.
] ifFalse:[
allDiffs changed addAll:(diffs changed).
allDiffs onlyInArg addAll:(diffs onlyInArg).
allDiffs onlyInReceiver addAll:(diffs onlyInReceiver).
].
].
].
allDiffs isEmpty ifTrue:[
self information:'The Versions are Equal.'.
] ifFalse:[
title := collectionOfClasses size == 1
ifTrue:['Differences of %1' bindWith:collectionOfClasses first name]
ifFalse:['Differences of %1 classes' bindWith:collectionOfClasses size].
VersionDiffBrowser
openOnDiffSet:allDiffs
labelA:'Version in File ',fileName
labelB:'Image'
title:title
ignoreExtensions:true.
].
self normalLabel.
"Created: / 29-08-2010 / 14:32:51 / cg"
!
classMenuCompareWithRepository
"open a diff-textView comparing the current (in-image) version
with the some version found in the repository."
self classMenuCompareWithRepositoryUsingManager:nil
!
classMenuCompareWithRepositoryUsingManager: manager
"open a diff-textView comparing the current (in-image) version
with the some version found in the repository."
self
askForRepositoryVersionUsingManager:manager
thenWithCurrentVersionDo:[:currentClass :comparedSource :revStringIn :currentSource :thisRevString |
|versionsAreTheSame revString rev|
self busyLabel:'comparing ...' with:nil.
revString := revStringIn.
versionsAreTheSame := (comparedSource = currentSource).
versionsAreTheSame ifFalse:[
revString = '(newest)' ifTrue:[
(rev := manager 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:[
self information:'Versions are identical.'.
].
].
"Modified: / 11-10-2011 / 16:25:31 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Created: / 21-12-2011 / 20:28:48 / cg"
!
classMenuCompareWithRepositoryUsingManagerNamed:sourceCodeManagerClassName
"open a diff-textView comparing the current (in-image) version
with the some version found in the repository."
self classMenuCompareWithRepositoryUsingManager:(self sourceCodeManagerNamed:sourceCodeManagerClassName)
"Created: / 21-12-2011 / 22:51:56 / cg"
!
classMenuCompareWithSmallTeamVersionOnHost:hostName
"compare the class against a version on another SmallTeam host"
|collectionOfClasses classes classesToUnload current remote diffs allDiffs
title|
collectionOfClasses := self selectedClassesValue.
classesToUnload := IdentitySet new.
classes :=
collectionOfClasses
collect:[:eachClass |
|loadedClass|
eachClass isLoaded ifFalse:[
loadedClass := eachClass autoload.
loadedClass notNil ifTrue:[classesToUnload add:loadedClass].
] ifTrue:[
loadedClass := eachClass
].
loadedClass isNil
ifTrue:nil
ifFalse:[loadedClass theNonMetaclass]]
thenSelect:[:cls | cls notNil].
classes do:[:eachClass |
|className metaclassName|
className := eachClass theNonMetaclass name.
metaclassName := eachClass theMetaclass name.
eachClass isLoaded ifFalse:[
Transcript showCR:('Cannot compare unloaded class: ' , eachClass name).
] ifTrue:[
self busyLabel:'comparing ...' with:nil.
current := ChangeSet forExistingClass:eachClass theNonMetaclass.
remote := (SmallTeam changesOnHost:hostName) select:[:ch | (ch className = className) or:[(ch className = metaclassName)] ].
diffs := remote diffSetsAgainst:current.
allDiffs isNil ifTrue:[
allDiffs := diffs.
] ifFalse:[
allDiffs changed addAll:(diffs changed).
allDiffs onlyInArg addAll:(diffs onlyInArg).
allDiffs onlyInReceiver addAll:(diffs onlyInReceiver).
].
].
].
allDiffs isEmpty ifTrue:[
self information:'The Versions are Equal.'.
] ifFalse:[
title := collectionOfClasses size == 1
ifTrue:['Differences of %1' bindWith:collectionOfClasses first name]
ifFalse:['Differences of %1 classes' bindWith:collectionOfClasses size].
VersionDiffBrowser
openOnDiffSet:allDiffs
labelA:'Version on Host ',hostName
labelB:'Image'
title:title
ignoreExtensions:false.
].
self normalLabel.
"Modified: / 18-10-2006 / 13:08:21 / User"
"Created: / 11-11-2006 / 15:36:43 / cg"
"Modified: / 28-02-2012 / 16:46:07 / cg"
!
classMenuCreatePatchFileAgainstVersionFromRepository
self classMenuCreatePatchFileAgainstVersionFromRepositoryUsingManager: nil
"Created: / 26-09-2012 / 13:09:39 / cg"
!
classMenuCreatePatchFileAgainstVersionFromRepositoryUsingManager: managerOrNil
self
askForRepositoryVersionUsingManager:managerOrNil
withExtensions:false
thenWithCurrentVersionDo:[:currentClass :comparedSource :revString :currentSource :thisRevString |
|versionsAreTheSame revString rev current old diffs|
self busyLabel:'comparing ...' with:nil.
versionsAreTheSame := (comparedSource = currentSource).
versionsAreTheSame ifTrue:[
Dialog information:'No patches (same version)'
] ifFalse:[
current := ChangeSet fromStream:(currentSource readStream).
old := ChangeSet fromStream:(comparedSource readStream).
diffs := old diffSetsAgainst:current.
(versionsAreTheSame := diffs isEmpty) ifFalse:[
self createPatchFileForDiffSet:diffs checkingForVersionBefore:thisRevString.
]
].
].
"Created: / 26-09-2012 / 13:10:04 / cg"
!
classMenuEditVersionInRepository
"open a changelist on a version in the repository.
Allow for changes to be made to this list, and the code be checked in as
a branch."
|currentClass mgr
nm rev source changeSet |
currentClass := self theSingleSelectedLoadedNonMetaclassOrNil.
currentClass isNil ifTrue:[
self warn:'Cannot load unloaded classes.'.
^ self.
].
nm := currentClass name.
mgr := SourceCodeManagerUtilities sourceCodeManagerFor:currentClass.
mgr isNil ifTrue:[
^ self
].
self normalLabel.
rev := SourceCodeManagerUtilities default
askForExistingRevision:(resources string:'Edit which revision:')
title:(resources string:'Edit which repository version')
class:currentClass.
rev isNil ifTrue:[^ self].
source := self getClassSourceFor:currentClass revision:rev.
changeSet := ChangeSet fromStream:source readStream.
(UserPreferences current changeSetBrowserClass) openOn:changeSet.
"Created: / 17-02-2011 / 10:29:59 / cg"
!
classMenuEditVersionInRepositoryUsingManager: aManager
^ Dialog warn: 'Not yet implemented'
"Created: / 21-12-2011 / 20:28:57 / cg"
!
classMenuQuickCheckIn
"check a class into the source repository (without checks)"
^ self classMenuCheckIn:false
!
classMenuQuickCheckInUsingManager: argument
^ Dialog warn: 'Not yet implemented'
"Created: / 21-12-2011 / 20:29:04 / cg"
!
classMenuRevisionLog
"show a classes revision log"
self classMenuRevisionLog:false
!
classMenuRevisionLog:shortOrNot
"show a classes revision log"
|codeView|
(self askIfModified:'Code was modified.\\Show log anyway ?')
ifFalse:[^ self].
self codeAspect:#repositoryLog.
self selectedMethods value:nil.
self selectProtocols:nil.
codeView := self codeView.
codeView contents:nil.
codeView modified:false.
navigationState realModifiedState:false.
self
selectedClassesNonMetaDo:
[:cls |
self
showRepositoryLogOf:cls short:shortOrNot
beforeLogDo:[:s |
self selectedClassesValue size > 1 ifTrue:[
s nextPutLine:'-----------------------------------------------------------'.
s nextPutLine:('%1 log for %2:'
bindWith:(shortOrNot ifTrue:['Short'] ifFalse:['Full'])
with:cls name).
s nextPutLine:'-----------------------------------------------------------'.
s cr.
]
]
]
ifUnloaded:
[:cls |
true.
]
ifPrivate:
[:cls |
|owner|
owner := cls owningClass.
(self selectedClassesValue 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.
"Modified: / 28-02-2012 / 16:47:53 / cg"
!
classMenuRevisionLog:shortOrNot usingManager: manager
"show a classes revision log"
|codeView|
(self askIfModified:'Code was modified.\\Show log anyway ?')
ifFalse:[^ self].
self codeAspect:#repositoryLog.
self selectedMethods value:nil.
self selectProtocols:nil.
codeView := self codeView.
codeView contents:nil.
codeView modified:false.
navigationState realModifiedState:false.
self
selectedClassesNonMetaDo:
[:cls |
self
showRepositoryLogOf:cls short:shortOrNot usingManager: manager
beforeLogDo:[:s |
self selectedClassesValue size > 1 ifTrue:[
s nextPutLine:'-----------------------------------------------------------'.
s nextPutLine:('%1 log for %2:'
bindWith:(shortOrNot ifTrue:['Short'] ifFalse:['Full'])
with:cls name).
s nextPutLine:'-----------------------------------------------------------'.
s cr.
]
]
]
ifUnloaded:
[:cls |
true.
]
ifPrivate:
[:cls |
|owner|
owner := cls owningClass.
(self selectedClassesValue 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.
"Created: / 11-10-2011 / 20:32:40 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Created: / 21-12-2011 / 20:26:08 / cg"
!
classMenuRevisionLogUsingManager: manager
"show a classes revision log"
self classMenuRevisionLog:false usingManager: manager
"Modified: / 11-10-2011 / 20:31:47 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Created: / 21-12-2011 / 20:17:12 / cg"
!
classMenuRevisionLogUsingManagerNamed:sourceCodeManagerClassName
"show a classes revision log"
self classMenuRevisionLog:false usingManager:(self sourceCodeManagerNamed:sourceCodeManagerClassName)
"Modified: / 11-10-2011 / 20:31:47 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Created: / 21-12-2011 / 23:02:10 / cg"
!
classMenuSetTag
|classes tag tags tagAndRevision revision|
classes := self selectedNonMetaclasses.
SourceCodeManagerError handle:[:ex |
Dialog warn:(resources
stringWithCRs:'Could not fetch tag information.\\Please check your sourcecode manager settings.\(and possibly the network for reachability of the repository)').
] do:[
tagAndRevision := self askForTagForClasses:classes askForRevision:(classes size = 1).
].
tag := tagAndRevision key.
tag isEmptyOrNil ifTrue:[^ self ].
revision := tagAndRevision value.
(revision notNil and:[revision withoutSeparators isEmpty]) ifTrue:[
revision := nil.
].
CVSSourceCodeManager recentTag:tag.
self withWaitCursorDo:[
tags := tag asCollectionOfSubstringsSeparatedByAny:',;'.
tags do:[:eachTag |
SourceCodeManagerUtilities default tagClasses:classes as:(eachTag withoutSeparators) revision:revision.
].
]
"Created: / 12-09-2006 / 13:36:59 / cg"
"Modified: / 29-07-2013 / 00:59:28 / cg"
!
classMenuSetTagUsingManager: aManager
^ Dialog warn: 'Not yet implemented'
"Created: / 21-12-2011 / 20:29:13 / cg"
!
classMenuShortRevisionLog
"show a short (last 20 entries) classes repository log"
self classMenuRevisionLog:true
!
classMenuShortRevisionLogUsingManager: manager
"show a short (last 20 entries) classes repository log"
self classMenuRevisionLog:true usingManager: manager
"Modified: / 11-10-2011 / 20:31:13 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Created: / 21-12-2011 / 20:17:24 / cg"
!
classMenuShortRevisionLogUsingManagerNamed:sourceCodeManagerClassName
"show a short (last 20 entries) classes repository log"
self classMenuShortRevisionLogUsingManager:(self sourceCodeManagerNamed:sourceCodeManagerClassName)
"Created: / 21-12-2011 / 23:12:15 / cg"
!
compareAgainstNewestInRepository:aClass
"open a diff-textView comparing the current (in-image) version
with the newest version found in the repository.
That is the most recent version."
self compareAgainstNewestInRepository:aClass usingManager:nil
"Modified: / 21-12-2011 / 20:13:47 / cg"
!
compareAgainstNewestInRepository:aClass usingManager:aManagerOrNil
"open a diff-textView comparing the current (in-image) version
with the newest version found in the repository.
That is the most recent version."
|utilities|
utilities := aManagerOrNil isNil
ifTrue:[(SourceCodeManagerUtilities sourceCodeManagerFor:aClass) utilities]
ifFalse:[aManagerOrNil utilities].
utilities compareClassWithRepository:aClass askForRevision:false.
self normalLabel.
"Created: / 11-10-2011 / 10:33:19 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Created: / 21-12-2011 / 20:13:31 / cg"
!
createPatchFileForDiffSet:diffSet checkingForVersionBefore:thisRevString
"for now, this works only for a diffSet containing only a single class"
|fileNamePrefix fileNameMiddle stxPatchesDir
changedClassesAndMetaclasses changedClasses
fileName changedOwningClasses generatedPatchFilename
tempStream changeSet labels values answer
keyFileGeneratorClass browseFile|
stxPatchesDir := 'stxPatches' asFilename.
stxPatchesDir exists ifFalse:[
stxPatchesDir recursiveMakeDirectory.
].
"/ find the highest numbered patchfile
fileNamePrefix := self nextPatchNumberIn:stxPatchesDir.
changedClassesAndMetaclasses := diffSet changedClasses.
changedClasses := changedClassesAndMetaclasses collect:[:clsOrMeta | clsOrMeta theNonMetaclass].
changedOwningClasses := changedClasses collect:[:each | each isPrivate
ifTrue:[ each owningClass ]
ifFalse:[ each ]] as:Set.
changedOwningClasses := changedOwningClasses asOrderedCollection.
changedOwningClasses size == 1 ifTrue:[
fileNameMiddle := changedOwningClasses first nameWithoutPrefix
] ifFalse:[
fileNameMiddle := 'patches'
].
fileNameMiddle := (fileNameMiddle asFilename makeLegalFilename withSuffix:'chg') name.
fileName := fileNamePrefix, '_', fileNameMiddle.
tempStream := FileStream newTemporaryIn:stxPatchesDir.
tempStream nextPutLine:('"/ patches to bring %1 to version %2' bindWith:changedClasses first name with:thisRevString).
tempStream nextPutLine:('"/').
tempStream nextPutLine:('"/ first, a guard, to ignore the patch if the library already contains an up-to-date class:').
tempStream nextPutLine:('"/').
changedOwningClasses do:[:eachClass |
tempStream nextPutLine:('(Smalltalk classNamed:''%2'') isNil ifTrue:[InvalidPatchError raiseErrorString:''patch is for non-existent class %2 (probably for a plugin that is not installed)''].
(''%1'' compareAsVersionNumberWith:%2 revision) < 0 ifTrue:[ InvalidPatchError raiseErrorString:''patch is for older version (%1) of class %2'' ].'
bindWith:eachClass revision
with:eachClass name).
].
tempStream nextPutChunkSeparator; cr; cr.
"do not add version methods to the patch file.
The version header will get new, invalid versions when checked into CVS"
changeSet := (ChangeSet fromDiffSet:diffSet) rejectAllVersionMethodChanges.
changeSet fileOutOn:tempStream.
tempStream syncData; close.
generatedPatchFilename := (stxPatchesDir construct:fileName).
tempStream fileName renameTo:generatedPatchFilename.
browseFile := false.
labels := #('OK' 'Show').
values := #(ok show).
"/ CG: this hard coded expecco stuff in here should be
"/ done by installing an extension method, whenever expecco is loaded,
"/ which adds the corresponding item to the browser's menu and adds another method
(keyFileGeneratorClass := Smalltalk at:#'Expecco::KeyFileGenerator') notNil ifTrue:[
"Can generate signed patches"
labels := labels , #( 'Generate Signed Patch' ).
values := values , #( sign ).
].
answer := Dialog
confirmWithCancel:('Created new patchFile as: "%1"' bindWith:generatedPatchFilename name)
labels:labels values:values default:1.
answer == #sign ifTrue:[
|pkcs7SignedData patchesDir expeccoVersionArray|
expeccoVersionArray := (Smalltalk at:#'Expecco::Expecco') versionArray.
patchesDir := (Smalltalk at:#exept_expecco) packageDirectory / 'patches'
/ ('%1.%2.%3' expandPlaceholdersWith:expeccoVersionArray).
patchesDir exists ifFalse:[
"Not an expecco development version - fall back"
patchesDir := (Smalltalk at:#'Expecco::Expecco') patchesDir.
patchesDir exists ifFalse:[
patchesDir recursiveMakeDirectory.
].
].
fileNamePrefix := self nextPatchNumberIn:patchesDir.
fileName := patchesDir / (fileNamePrefix, '_', fileNameMiddle).
generatedPatchFilename moveTo:fileName.
generatedPatchFilename := fileName.
pkcs7SignedData := keyFileGeneratorClass new signExpeccoCode:generatedPatchFilename contentsOfEntireFile.
(generatedPatchFilename withSuffix:'expeccoPatch') contents:pkcs7SignedData.
generatedPatchFilename := generatedPatchFilename withSuffix:'info'.
generatedPatchFilename writingFileDo:[:stream |
stream
nextPutAll:'Created by: ';
nextPutAll:OperatingSystem getFullUserName;
nextPutAll:' at: '.
Timestamp now printOn:stream.
stream cr; close.
].
browseFile := true.
].
answer == #show ifTrue:[
browseFile := true.
].
browseFile ifTrue:[
UserPreferences fileBrowserClass openOn:generatedPatchFilename
].
"Created: / 26-09-2012 / 15:13:07 / cg"
"Modified: / 17-01-2014 / 11:55:51 / sr"
!
doCompareClassesWithRepository:collectionOfClasses
self doCompareClassesWithRepository:collectionOfClasses usingManager:nil
"Created: / 04-01-1997 / 15:48:20 / cg"
"Modified: / 18-10-2006 / 13:08:21 / User"
"Modified: / 21-12-2011 / 20:12:26 / cg"
!
doCompareClassesWithRepository:collectionOfClasses usingManager:aManagerOrNil
|classes s
aStream comparedSource currentSource thisRevString
classesToUnload current repository diffs allDiffs
title|
collectionOfClasses size == 1 ifTrue:[
self compareAgainstNewestInRepository:(collectionOfClasses first theNonMetaclass) usingManager:aManagerOrNil.
^ self.
].
classesToUnload := IdentitySet new.
classes :=
collectionOfClasses
collect:[:eachClass |
|loadedClass|
eachClass isLoaded ifFalse:[
loadedClass := eachClass autoload.
loadedClass notNil ifTrue:[classesToUnload add:loadedClass].
] ifTrue:[
loadedClass := eachClass
].
loadedClass isNil
ifTrue:nil
ifFalse:[loadedClass theNonMetaclass]]
thenSelect:[:cls | cls notNil].
classes do:[:eachClass |
eachClass isLoaded ifFalse:[
Transcript showCR:('Cannot compare unloaded class: ' , eachClass name).
] ifTrue:[
aStream := self sourceStreamForRepositorySourceOfClass:eachClass usingManager:aManagerOrNil.
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 = ((aManagerOrNil ? eachClass sourceCodeManager) newestRevisionOf:eachClass))
and:[eachClass hasUnsavedChanges]) ifTrue:[
(self confirm:'Versions are identical.\\Remove entries from changeSet ?' withCRs) ifTrue:[
ChangeSet current condenseChangesForClass:eachClass.
].
] ifFalse:[
self information:'Versions are identical.'.
]
] ifFalse:[
thisRevString := eachClass revision.
thisRevString isNil ifTrue:[
thisRevString := 'no revision'
].
self busyLabel:'comparing ...' with:nil.
current := ChangeSet fromStream:(s := currentSource readStream). s close.
repository := ChangeSet fromStream:(s := comparedSource readStream). s close.
diffs := repository diffSetsAgainst:current.
allDiffs isNil ifTrue:[
allDiffs := diffs.
] ifFalse:[
allDiffs changed addAll:(diffs changed).
allDiffs onlyInArg addAll:(diffs onlyInArg).
allDiffs onlyInReceiver addAll:(diffs onlyInReceiver).
].
].
].
].
].
allDiffs isEmpty ifTrue:[
(classes contains:[:someClass |
(someClass hasUnsavedChanges)])
ifTrue:[
(self confirm:(resources
stringWithCRs:'The classes are up-to-date.\\Remove entries from changeSet ?'))
ifTrue:[
classes do:[:eachClass |
ChangeSet current condenseChangesForClass:eachClass.
]
].
] ifFalse:[
self information:'The classes are up-to-date.'.
ChangeSet current unrememberChangedClasses.
].
] ifFalse:[
title := collectionOfClasses size == 1
ifTrue:['Differences of %1' bindWith:collectionOfClasses first name]
ifFalse:['Differences of %1 classes' bindWith:collectionOfClasses size].
VersionDiffBrowser
openOnDiffSet:allDiffs
labelA:'Repository'
labelB:'Image'
title:title
ignoreExtensions:true.
].
self normalLabel.
"Modified: / 18-10-2006 / 13:08:21 / User"
"Modified: / 12-09-2011 / 11:54:42 / cg"
"Created: / 11-10-2011 / 10:32:39 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Created: / 21-12-2011 / 20:10:53 / cg"
"Modified (format): / 18-07-2012 / 10:16:02 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
generateDiffSetForClasses:collectionOfClasses newest:newest
|classes s
aStream comparedSource currentSource rev revString thisRevString mgr
nm msg newestRev
containerModule containerPackage containerFile rslt
pkg info mod dir classesToUnload current repository diffs allDiffs
title|
classesToUnload := IdentitySet new.
classes := collectionOfClasses collect:[:eachClass |
|loadedClass|
eachClass isLoaded ifFalse:[
loadedClass := eachClass autoload.
classesToUnload add:loadedClass.
] ifTrue:[
loadedClass := eachClass
].
loadedClass theNonMetaclass
].
classes do:[:currentClass |
nm := currentClass name.
mgr := SourceCodeManagerUtilities sourceCodeManagerFor:currentClass.
mgr isNil ifTrue:[
(Dialog
confirm:('No sourceCode manager defined for %1 - check settings.\\Skip this class ?' bindWith:currentClass name) withCRs)
ifFalse:[
^ self
].
].
rev := currentClass binaryRevision.
rev isNil ifTrue:[
rev := currentClass revision
].
rev isNil ifTrue:[
"/
"/ class not in repository - allow compare against any other containers newest contents
"/
self normalLabel.
pkg := currentClass package.
(pkg notNil and:[pkg ~= PackageId noProjectID]) ifTrue:[
containerModule := pkg upTo:$:.
containerPackage := pkg copyFrom:(containerModule size + 2).
].
containerModule size == 0 ifTrue:[
containerModule := (SourceCodeManagerUtilities lastModule) ? Project current repositoryModule.
].
containerPackage size == 0 ifTrue:[
containerPackage := (SourceCodeManagerUtilities lastPackage) ? Project current package.
].
rslt := SourceCodeManagerUtilities default
askForContainer:(resources string:'The class seems to have no repository information.\\Do you want to compare it against an existing containers contents ?')
title:'Container to compare' note:nil
initialModule:containerModule
initialPackage:containerPackage
initialFileName:(currentClass name , '.st')
forNewContainer:false.
rslt isNil ifTrue:[
"/ canel
^ self
].
containerModule := rslt at:#module.
containerPackage := rslt at:#package.
containerFile := rslt at:#fileName.
SourceCodeManagerUtilities lastModule:containerModule.
SourceCodeManagerUtilities lastPackage:containerPackage.
] ifFalse:[
"/
"/ class in repository - ask for revision
"/
newestRev := mgr newestRevisionOf:currentClass.
rev := newestRev.
].
(rev notNil or:[containerFile notNil]) ifTrue:[
rev notNil ifTrue:[
rev withoutSpaces isEmpty ifTrue:[
msg := 'extracting newest %1 (' , (newestRev ? '???') , ')'.
"/ aStream := mgr getMostRecentSourceStreamForClassNamed:nm.
aStream := mgr getSourceStreamFor:currentClass revision:newestRev.
revString := 'newest'.
] ifFalse:[
msg := 'extracting previous %1'.
aStream := mgr getSourceStreamFor:currentClass revision:rev.
revString := rev
].
] ifFalse:[
msg := 'extracting newest version from ' , containerModule , '/' , containerPackage, '/' , containerFile.
aStream := mgr streamForClass:nil fileName:containerFile revision:#newest directory:containerPackage module:containerModule cache:false.
revString := '???'
].
self busyLabel:msg with:nm.
aStream isNil ifTrue:[
info := mgr sourceInfoOfClass:currentClass.
info notNil ifTrue:[
mod := info at:#module ifAbsent:'??'.
dir := info at:#directory ifAbsent:'??'.
].
self warn:(resources
string:'Could not extract source from repository (for module: ''%1'' , directory: ''%2'' , revision: ''%3'')'
with:mod with:dir with:revString).
^ self
].
aStream class readErrorSignal handle:[:ex |
self warn:('read error while reading extracted source\\' , ex description) withCRs.
aStream close.
^ self
] do:[
comparedSource := aStream contents asString.
].
aStream close.
self busyLabel:'generating current source ...' with:nil.
aStream := '' writeStream.
Method flushSourceStreamCache.
"/ currentClass fileOutOn:aStream withTimeStamp:false.
"/ currentSource := aStream contents asString.
currentSource := currentClass source asString.
aStream close.
self busyLabel:'comparing ...' with:nil.
comparedSource = currentSource ifTrue:[
((currentClass revision = newestRev)
and:[currentClass hasUnsavedChanges]) ifTrue:[
(self confirm:'Versions are identical.\\Remove entries from changeSet ?' withCRs) ifTrue:[
ChangeSet current condenseChangesForClass:currentClass.
].
] ifFalse:[
self information:'Versions are identical.'.
]
] ifFalse:[
thisRevString := currentClass revision.
thisRevString isNil ifTrue:[
thisRevString := 'no revision'
].
revString = '(newest)' ifTrue:[
(rev := mgr newestRevisionOf:currentClass) notNil ifTrue:[
revString := '(newest is ' , rev , ')'
]
].
self busyLabel:'comparing ...' with:nil.
current := ChangeSet fromStream:(s := currentSource readStream). s close.
repository := ChangeSet fromStream:(s := comparedSource readStream). s close.
diffs := repository diffSetsAgainst:current.
allDiffs isNil ifTrue:[
allDiffs := diffs.
] ifFalse:[
allDiffs changed addAll:(diffs changed).
allDiffs onlyInArg addAll:(diffs onlyInArg).
allDiffs onlyInReceiver addAll:(diffs onlyInReceiver).
].
].
].
].
title := collectionOfClasses size == 1
ifTrue:['Differences of %1' bindWith:collectionOfClasses first name]
ifFalse:['Differences of %1 classes' bindWith:collectionOfClasses size].
VersionDiffBrowser
openOnDiffSet:allDiffs
labelA:'Repository'
labelB:'Image'
title:title
ignoreExtensions:true.
self normalLabel.
"Created: / 04-01-1997 / 15:48:20 / cg"
"Modified: / 29-09-2011 / 15:43:28 / cg"
!
getClassSourceFor:aClass revision:revision
"ask aClass's sourceCodeManager to retrieve a (possibly older or newer) version's source code"
^ self getClassSourceFor:aClass revision:revision usingManager:(aClass sourceCodeManager)
"Created: / 08-02-2011 / 10:24:50 / cg"
!
getClassSourceFor:aClass revision:revision usingManager: manager
"ask aClass's sourceCodeManager to retrieve a (possibly older or newer) version's source code"
|msg stream source|
msg := 'extracting previous %1'.
self busyLabel:msg with:revision.
stream := manager getSourceStreamFor:aClass revision:revision.
stream isNil ifTrue:[
self warn:(resources
string:'Could not extract source of rev %1 from repository'
with:revision).
^ nil
].
stream class readErrorSignal handle:[:ex |
self warn:('read error while reading extracted source\\' , ex description) withCRs.
stream close.
^ nil
] do:[
source := stream contents asString.
].
stream close.
^ source
"Created: / 11-10-2011 / 23:06:43 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Created: / 21-12-2011 / 20:25:39 / cg"
!
nextPatchNumberIn:aDirectory
"compute the next consecutive patch number in a directory.
Answer a String."
|highest highestString nrString nr fileNamePrefix|
"/ find the highest numbered patchfile
aDirectory directoryContentsDo:[:fn |
(fn includes:$_) ifTrue:[
nrString := fn upTo:$_.
nr := Integer readFrom:nrString onError:nil.
nr notNil ifTrue:[
nr > (highest ? -1) ifTrue:[
highest := nr.
highestString := nrString.
]
].
].
].
highest isNil ifTrue:[
fileNamePrefix := '0001'
] ifFalse:[
fileNamePrefix := (highest+1) printStringLeftPaddedTo:(highestString size) with:$0.
].
^ fileNamePrefix.
!
repositoryHistoryForProjects:projectListOrNil
"sorry, but this seems to be hardwired for CVS"
(self askIfModified:'Code was modified.\\Show history anyway ?')
ifFalse:[^ self].
self withWaitCursorDo:[
|timeGoal moduleFilter moduleFilterHolder repositoryFilter userFilter aStream box y component
timeGoalListPop moduleFilterPop userFilterPop dateList userList|
timeGoal := 'yesterday' asValue.
moduleFilterHolder := nil asValue.
userFilter := nil asValue.
box := Dialog new.
(box addTextLabel:(resources string:'Repository change report')) adjust:#left.
box addVerticalSpace:20.
y := box yPosition.
component := box addTextLabel:(resources string:'List changes since (yyyy-mm-dd):').
component width:0.5; adjust:#right; borderWidth:0.
box yPosition:y.
timeGoalListPop := box addComboBoxOn:timeGoal tabable:true.
timeGoalListPop width:0.5; left:0.5; immediateAccept:true; acceptOnLeave:false; cursorMovementWhenUpdating:#beginOfLine.
dateList := OrderedCollection new.
dateList add:(Timestamp now printStringFormat:'%(year)-%(month)-%(day)').
dateList add:((Timestamp now subtractHours:1) printStringFormat:'%(year)-%(month)-%(day) %h:%m').
dateList addAll:#('yesterday'
'1 hour ago'
'1 week ago'
'1 month ago'
'1 year ago'
'all'
).
timeGoalListPop list:dateList.
projectListOrNil notNil ifTrue:[
moduleFilter := projectListOrNil collect:[:prj | prj asPackageId module] as:Set.
moduleFilterHolder := nil.
] ifFalse:[
y := box yPosition.
component := box addTextLabel:(resources string:'For CVS repository (empty for all):').
component width:0.5; adjust:#right; borderWidth:0.
box yPosition:y.
moduleFilterPop := box addComboBoxOn:moduleFilterHolder tabable:true.
moduleFilterPop width:0.5; left:0.5; immediateAccept:true; acceptOnLeave:false; cursorMovementWhenUpdating:#beginOfLine.
moduleFilterPop list:(SourceCodeManager knownModules asOrderedCollection sort addFirst:'stx'; yourself).
].
y := box yPosition.
component := box addTextLabel:(resources string:'For user (empty for all):').
component width:0.5; adjust:#right; borderWidth:0.
box yPosition:y.
userFilterPop := box addComboBoxOn:userFilter tabable:true.
userFilterPop width:0.5; left:0.5; immediateAccept:true; acceptOnLeave:false; cursorMovementWhenUpdating:#beginOfLine.
"Fetch the list of konwn user names (which are possibly used when checking in):
- Try the repository names (smething like ':method:user@host:....')
- If nothing found, use the login name"
userList := Set new.
SourceCodeManager knownRepositories do:[:eachRepository|
|user idx|
(eachRepository includes:$@) ifTrue:[
user := eachRepository copyUpTo:$@.
idx := user lastIndexOf:$:.
idx ~~ 0 ifTrue:[
user := user copyFrom:idx+1.
].
userList add:user.
].
].
userList isEmpty ifTrue:[
userList add:OperatingSystem getLoginName.
].
userFilterPop list:userList asArray sort.
box addAbortAndOkButtons.
box open.
box accepted ifTrue:[
moduleFilterHolder notNil ifTrue:[
moduleFilter := moduleFilterHolder value.
moduleFilter size == 0
ifTrue:[moduleFilter := nil]
ifFalse:[moduleFilter := Set with:moduleFilter].
].
moduleFilter notNil ifTrue:[
repositoryFilter := moduleFilter
collect:[:eachModule|
SourceCodeManager getCVSROOTForModule:eachModule.
].
].
userFilter := userFilter value.
userFilter size == 0
ifTrue:[userFilter := nil]
ifFalse:[userFilter := Array with:userFilter].
timeGoal := timeGoal value.
self busyLabel:'extracting history ...' with:nil.
aStream := WriteStream on:(String new:200).
Processor activeProcess
withPriority:Processor activePriority-1 to:Processor activePriority
do:[
SourceCodeManager notNil ifTrue:[
SourceCodeManager
writeHistoryLogSince:timeGoal
filterSTSources:true
filterUser:userFilter
filterRepository:repositoryFilter
filterModules:moduleFilter
filterProjects:projectListOrNil
to:aStream.
] ifFalse:[
aStream nextPutLine:'no history available (no SourceCodeManagement installed)'
].
].
self codeView
contents:(aStream contents);
modified:false.
navigationState realModifiedState:false.
self codeAspect:#repositoryHistory.
self selectedMethods value:nil.
self selectProtocols:nil.
"/ self setNoAcceptAction.
"/ self clearExplainAction.
self normalLabel
].
]
"Created: / 12-09-2006 / 15:03:24 / cg"
!
repositoryHistoryForProjects:projectListOrNil usingManager:manager
"sorry, but this seems to be hardwired for CVS"
manager ~~ CVSSourceCodeManager ifTrue:[
self error:'Only supported for CVS'.
].
(self askIfModified:'Code was modified.\\Show history anyway ?')
ifFalse:[^ self].
self withWaitCursorDo:[
|timeGoal moduleFilter moduleFilterHolder repositoryFilter userFilter aStream box y component
timeGoalListPop moduleFilterPop userFilterPop dateList userList|
timeGoal := 'yesterday' asValue.
moduleFilterHolder := nil asValue.
userFilter := nil asValue.
box := Dialog new.
box addTextLabel:(resources string:'Repository change report') adjust:#left.
box addVerticalSpace:20.
y := box yPosition.
component := box addTextLabel:(resources string:'List changes since (yyyy-mm-dd):') adjust:#right.
component width:0.5; borderWidth:0.
box yPosition:y.
timeGoalListPop := box addComboBoxOn:timeGoal tabable:true.
timeGoalListPop width:0.5; left:0.5; immediateAccept:true; acceptOnLeave:false; cursorMovementWhenUpdating:#beginOfLine.
dateList := OrderedCollection new.
dateList add:(Timestamp now printStringFormat:'%(year)-%(month)-%(day)').
dateList add:((Timestamp now subtractHours:1) printStringFormat:'%(year)-%(month)-%(day) %h:%m').
dateList addAll:#('yesterday'
'1 hour ago'
'1 week ago'
'1 month ago'
'1 year ago'
'all'
).
timeGoalListPop list:dateList.
projectListOrNil notNil ifTrue:[
moduleFilter := projectListOrNil collect:[:prj | prj asPackageId module] as:Set.
moduleFilterHolder := nil.
] ifFalse:[
y := box yPosition.
component := box addTextLabel:(resources string:'For CVS repository (empty for all):') adjust:#right.
component width:0.5; borderWidth:0.
box yPosition:y.
moduleFilterPop := box addComboBoxOn:moduleFilterHolder tabable:true.
moduleFilterPop width:0.5; left:0.5; immediateAccept:true; acceptOnLeave:false; cursorMovementWhenUpdating:#beginOfLine.
moduleFilterPop list:(SourceCodeManager knownModules asOrderedCollection sort addFirst:'stx'; yourself).
].
y := box yPosition.
component := box addTextLabel:(resources string:'For user (empty for all):') adjust:#right.
component width:0.5; borderWidth:0.
box yPosition:y.
userFilterPop := box addComboBoxOn:userFilter tabable:true.
userFilterPop width:0.5; left:0.5; immediateAccept:true; acceptOnLeave:false; cursorMovementWhenUpdating:#beginOfLine.
"Fetch the list of konwn user names (which are possibly used when checking in):
- Try the repository names (smething like ':method:user@host:....')
- If nothing found, use the login name"
userList := Set new.
SourceCodeManager knownRepositories do:[:eachRepository|
|user idx|
(eachRepository includes:$@) ifTrue:[
user := eachRepository copyUpTo:$@.
idx := user lastIndexOf:$:.
idx ~~ 0 ifTrue:[
user := user copyFrom:idx+1.
].
userList add:user.
].
].
userList isEmpty ifTrue:[
userList add:OperatingSystem getLoginName.
].
userFilterPop list:userList asArray sort.
box addAbortAndOkButtons.
box open.
box accepted ifTrue:[
moduleFilterHolder notNil ifTrue:[
moduleFilter := moduleFilterHolder value.
moduleFilter size == 0
ifTrue:[moduleFilter := nil]
ifFalse:[moduleFilter := Set with:moduleFilter].
].
moduleFilter notNil ifTrue:[
repositoryFilter := moduleFilter
collect:[:eachModule|
SourceCodeManager getCVSROOTForModule:eachModule.
].
].
userFilter := userFilter value.
userFilter size == 0
ifTrue:[userFilter := nil]
ifFalse:[userFilter := Array with:userFilter].
timeGoal := timeGoal value.
self busyLabel:'extracting history ...' with:nil.
aStream := CharacterWriteStream new:200.
Processor activeProcess
withPriority:Processor activePriority-1 to:Processor activePriority
do:[
SourceCodeManager notNil ifTrue:[
SourceCodeManager
writeHistoryLogSince:timeGoal
filterSTSources:true
filterUser:userFilter
filterRepository:repositoryFilter
filterModules:moduleFilter
filterProjects:projectListOrNil
to:aStream.
] ifFalse:[
aStream nextPutLine:'no history available (no SourceCodeManagement installed)'
].
].
self codeView
contents:(aStream contents);
modified:false.
navigationState realModifiedState:false.
self codeAspect:#repositoryHistory.
self selectedMethods value:nil.
self selectProtocols:nil.
"/ self setNoAcceptAction.
"/ self clearExplainAction.
self normalLabel
].
]
"Created: / 12-09-2006 / 15:03:24 / cg"
!
showRepositoryLogOf:aClass
"show a classes repository log - append to codeView.
CAVEAT: that is almost the same code as found in SystemBrowser;
move to SourceCodeManagerUtilities"
self showRepositoryLogOf:aClass short:false
!
showRepositoryLogOf:aClass short:shortOrNot
"show a classes repository log - append to codeView."
self showRepositoryLogOf:aClass short:shortOrNot beforeLogDo:[:s | ].
!
showRepositoryLogOf:aClass short:shortOrNot beforeLogDo:aBlock
"show a classes repository log - append to codeView.
CAVEAT: that is almost the same code as found in SystemBrowser;
move to SourceCodeManagerUtilities."
^ self showRepositoryLogOf:aClass short:shortOrNot usingManager: (aClass sourceCodeManager) beforeLogDo:aBlock
"Modified: / 26-09-2012 / 13:06:30 / cg"
!
showRepositoryLogOf:aClass short:shortOrNot usingManager: managerOrNil beforeLogDo:aBlock
"show a classes repository log - append to codeView.
CAVEAT: that is almost the same code as found in SystemBrowser;
move to SourceCodeManagerUtilities."
|codeView aStream|
aStream := TextStream new:200. "/ CharacterWriteStream new:200.
Processor activeProcess
withPriority:Processor activePriority-1 to:Processor activePriority
do:[
|utils|
self busyLabel:'Extracting log of %1' with:aClass name.
aBlock value:aStream.
utils := managerOrNil isNil
ifTrue:[ SourceCodeManagerUtilities default ]
ifFalse:[ managerOrNil utilities ].
SourceCodeManagerError handle:[:ex |
Dialog warn:(resources
stringWithCRs:'Could not fetch revision log of "%1".\\Please check your sourcecode manager settings of %2 for package: "%3".\(and possibly the network for reachability of the repository)'
with:aClass name
with:aClass sourceCodeManager managerTypeName
with:aClass package).
^ self.
] do:[
utils repositoryLogOf:aClass short:shortOrNot onto:aStream
]
].
self codeAspect:#repositoryLog.
self selectedMethods value:nil.
self selectProtocols:nil.
codeView := self codeView.
codeView contents:(codeView contents ,
Character cr asString ,
Character cr asString ,
aStream contents).
codeView modified:false.
navigationState realModifiedState:false.
"/ self setNoAcceptAction.
"/ self clearExplainAction.
self normalLabel
"Created: / 11-10-2011 / 20:33:45 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Created: / 21-12-2011 / 20:24:55 / cg"
!
sourceCodeManagerNamed:sourceCodeManagerClassName
|mgr|
mgr := Smalltalk classNamed:sourceCodeManagerClassName.
self assert:(mgr notNil).
^ mgr
!
sourceStreamForRepositorySourceOfClass:aClass
"ask for a classes revision and return a stream on this revisions source; nil on error"
^ self sourceStreamForRepositorySourceOfClass:aClass usingManager:(aClass sourceCodeManager)
"Modified: / 21-12-2011 / 20:11:59 / cg"
!
sourceStreamForRepositorySourceOfClass:aClass usingManager: aManagerOrNil
"ask for a classes revision and return a stream on this revisions source; nil on error"
|mgr rev pkg containerModule containerPackage rslt containerFile newestRev msg sourceStream revString
info mod dir|
mgr := aManagerOrNil ? aClass sourceCodeManager.
rev := aClass binaryRevision.
rev isNil ifTrue:[
rev := aClass revision
].
rev isNil ifTrue:[
"/
"/ class not in repository - allow compare against any other containers newest contents
"/
self normalLabel.
pkg := aClass package.
(pkg notNil and:[pkg ~= PackageId noProjectID]) ifTrue:[
containerModule := pkg upTo:$:.
containerPackage := pkg copyFrom:(containerModule size + 2).
].
containerModule size == 0 ifTrue:[
containerModule := (SourceCodeManagerUtilities lastModule) ? Project current repositoryModule.
].
containerPackage size == 0 ifTrue:[
containerPackage := (SourceCodeManagerUtilities lastPackage) ? Project current package.
].
rslt := mgr utilities
askForContainer:(resources
stringWithCRs:'The "%1"-class seems to have no repository information.\\Do you want to compare it against an existing containers contents ?'
with:aClass name)
title:'Container to compare' note:nil
initialModule:containerModule
initialPackage:containerPackage
initialFileName:(aClass name , '.st')
forNewContainer:false.
rslt isNil ifTrue:[
"/ cancel
^ nil
].
containerModule := rslt at:#module.
containerPackage := rslt at:#package.
containerFile := rslt at:#fileName.
SourceCodeManagerUtilities lastModule:containerModule.
SourceCodeManagerUtilities lastPackage:containerPackage.
] ifFalse:[
"/
"/ class in repository - ask for revision
"/
newestRev := mgr newestRevisionOf:aClass.
rev := newestRev.
].
(rev isNil and:[containerFile isNil]) ifTrue:[
^ nil
].
rev notNil ifTrue:[
rev withoutSpaces isEmpty ifTrue:[
msg := 'extracting newest %1 (' , (newestRev ? '???') , ')'.
sourceStream := mgr getSourceStreamFor:aClass revision:newestRev.
revString := 'newest'.
] ifFalse:[
msg := 'extracting rev ',rev,' of %1'.
sourceStream := mgr getSourceStreamFor:aClass revision:rev.
revString := rev
].
] ifFalse:[
msg := 'extracting newest version from ' , containerModule , '/' , containerPackage, '/' , containerFile.
sourceStream := mgr streamForClass:nil fileName:containerFile revision:#newest directory:containerPackage module:containerModule cache:false.
revString := '???'
].
self busyLabel:msg with:(aClass name).
sourceStream isNil ifTrue:[
info := mgr sourceInfoOfClass:aClass.
info notNil ifTrue:[
mod := info at:#module ifAbsent:'??'.
dir := info at:#directory ifAbsent:'??'.
].
self warn:(resources
string:'Could not extract source from repository (for module: ''%1'' , directory: ''%2'' , revision: ''%3'')'
with:mod with:dir with:revString).
^ nil
].
^ sourceStream
"Modified: / 29-09-2011 / 15:43:08 / cg"
"Created: / 11-10-2011 / 10:34:57 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Created: / 21-12-2011 / 20:11:25 / cg"
! !
!NewSystemBrowser methodsFor:'menu actions-code'!
codeMenuAddClassVariable:newName inClass:aClass asValueHolder:asValueHolder
"add a class variable"
|refactoring cls nonMeta|
nonMeta := aClass theNonMetaclass.
(cls := nonMeta whichClassDefinesClassVar:newName) notNil ifTrue:[
cls == aClass ifTrue:[
Dialog information:(resources string:'A variable named ''%1'' is already defined in ''%2''.'
with:newName allBold
with:cls name allBold).
^ self
].
(Dialog confirm:(resources stringWithCRs:'Attention: a variable named ''%1'' is already defined in ''%2''.\\Proceed ?'
with:newName allBold
with:cls name allBold))
ifFalse:[
^ self
].
].
refactoring := AddClassVariableChange add:newName to:nonMeta.
"/ refactoring := AddClassVariableRefactoring variable:newName class:nonMeta.
self performRefactoring:refactoring.
"Modified: / 18-11-2006 / 16:15:49 / cg"
!
codeMenuAddInstanceVariable:newName inClass:aClass
"add an instance variable"
self codeMenuAddInstanceVariable:newName inClass:aClass asValueHolder:false
!
codeMenuAddInstanceVariable:newName inClass:aClass asValueHolder:asValueHolder
"add an instance variable"
|refactoring cls generator varName pseudoVarName|
asValueHolder ifTrue:[
varName := newName.
varName isUppercaseFirst ifTrue:[
varName := varName asLowercaseFirst.
].
(varName endsWith:'Holder') ifTrue:[
pseudoVarName := varName copyButLast:6.
] ifFalse:[
pseudoVarName := varName.
varName := pseudoVarName , 'Holder'.
].
] ifFalse:[
varName := newName
].
(cls := aClass whichClassDefinesInstVar:varName) notNil ifTrue:[
Dialog warn:(resources string:'An instance variable named ''%1'' is already defined in ''%2''.'
with:varName allBold
with:cls name allBold).
^ self
].
"/ refactoring := AddInstanceVariableRefactoring variable:newName class:aClass.
"/ refactoring model name:('Add instvar %1 to %2' bindWith:newName with:aClass name).
asValueHolder ifTrue:[
generator := SmalltalkCodeGeneratorTool new.
generator startCollectChanges.
generator addChange:(AddInstanceVariableChange add:varName to:aClass).
generator createValueHoldersFor:(Array with:varName) in:aClass lazyInitialization:false.
generator executeCollectedChangesNamed:'Add ValueHolder'
] ifFalse:[
refactoring := AddInstanceVariableChange add:varName to:aClass.
self performRefactoring:refactoring.
].
"Modified: / 31-01-2011 / 18:29:55 / cg"
!
codeMenuAddParameter
|currentMethod cls selector refactoring initializer newSelector l initialAnswer
senders nSenders tree args dialog|
(self askIfModified) ifFalse:[
^ self
].
currentMethod := self theSingleSelectedMethod.
cls := currentMethod mclass.
selector := currentMethod selector.
"/ how many senders are there ?
senders := SystemBrowser findSendersOf:selector in:(environment allClasses) ignoreCase:false match:false.
nSenders := senders size.
tree := cls parseTreeFor:selector.
tree isNil ifTrue:[
self warn: 'Could not parse the method'.
^ self
].
args := tree argumentNames.
args := args copyWith:('arg%1' bindWith:args size + 1).
selector numArgs == 0 ifTrue:[
initialAnswer := selector , ':'.
l := 'Enter new selector:'.
] ifFalse:[
initialAnswer := selector , 'xxxx:'.
l := 'Enter new selector (replace xxxx as desired):'.
].
dialog := MethodNameDialogForAddParameter methodNameFor: args initial:initialAnswer.
nSenders == 0 ifTrue:[
dialog askForDefaultValue:false.
].
dialog cancelAllVisible value:(AbortAllOperationWantedQuery query).
dialog renameOnlyVisible value:true.
dialog renameSelectedMethodsOnlyVisible value:true.
dialog rewriteLocalMethodsOnlyFlagHolder value:true.
dialog allButOpen.
dialog window label:(resources string:l).
dialog openWindow.
dialog accepted ifFalse: [^ self].
newSelector := dialog methodName.
initializer := dialog defaultValue.
"/ newSelector := Dialog request:(resources string:l) initialAnswer:initialAnswer.
newSelector isEmptyOrNil ifTrue:[
^ nil "/ cancelled
].
"/ nSenders > 0 ifTrue:[
"/ initializer := Dialog request:(resources string:'Enter default value for parameter (will be used in %1 sending methods):' with:nSenders printString) initialAnswer:'nil'.
"/ initializer isEmptyOrNil ifTrue:[
"/ ^ nil "/ cancelled
"/ ].
"/ ] ifFalse:[
"/ initializer := 'nil' "/ dummy - not used anyway
"/ ].
newSelector := newSelector asSymbol.
refactoring := AddParameterRefactoring
addParameterToMethod:selector
in:cls
newSelector:newSelector
initializer:initializer.
(self findSendersOf:selector in:(environment allClasses) andConfirmRefactoring:refactoring) ifTrue:[
self performRefactoring:refactoring.
self switchToSelector:newSelector
]
"Modified: / 09-02-2011 / 13:54:16 / cg"
!
codeMenuConvertToValueHolder
"replace all accesses to selected instvar by value-get/set method sends;
add aspects if not yet present."
|varName|
varName := self selectedInstanceVariableOrNil.
varName notNil ifTrue:[
self codeMenuConvertToValueHolder:varName
]
!
codeMenuConvertToValueHolder:aString
"replace all accesses to selected instvar by value-get/set method sends;
add aspects if not yet present."
|refactoring|
(self askIfModified) ifFalse:[
^ self
].
(self confirm:'About to rewrite methods...') ifFalse:[^ self].
refactoring := (ValueHolderRefactoring
variable: aString
class: (self theSingleSelectedClass whichClassDefinesInstVar: aString)).
self performRefactoring:refactoring.
!
codeMenuDeclareSelectionAsClassVariable
"add a class variable"
|varName cls refactoring|
varName := self codeView selectionAsString.
(varName isValidSmalltalkIdentifier
and:[ varName isUppercaseFirst
and:[ (environment includesKey:varName) not
and:[ (cls := self theSingleSelectedClass) notNil
and:[ (cls theNonMetaclass classVarNames includes:varName) not
]]]]) ifFalse:[
^ self.
].
refactoring := AddClassVariableChange add:varName to:cls theNonMetaclass.
self performRefactoring:refactoring.
!
codeMenuEliminateConstant
"a new refactoring:
given a literal constant as current text selection,
ask for either a class or inst variable name,
or the name of a class or instance getter-method
define it, assign it a value (in the initialize method)
and change the code to refer to that variable/getter instead.
Use this to refactor private magic constants.
Most of the code below should go into the RB-package as a new refactoring class, once
it is debugged and stable."
|literalString literalValue name selectedClass refactoring matchingMethods mthd
initialNewName radioModel box rb nameHolder changeHow targetClass
numMethodsAdded numMethodsRewritten confirmationQuestion informationMessage|
literalString := self codeView selectionAsString withoutSeparators.
literalValue := Parser evaluateFrom:literalString ifFail:nil.
literalValue isNil ifTrue:[^ self].
selectedClass := self theSingleSelectedClass.
selectedClass isNil ifTrue:[
mthd := self theSingleSelectedMethod.
mthd isNil ifTrue:[
Dialog information:'Please select a class or method'.
^ self
].
selectedClass := mthd mclass
].
selectedClass isMeta ifTrue:[
LastLiteralReplacementType == #instanceMethod ifTrue:[ LastLiteralReplacementType := #classMethod ].
LastLiteralReplacementType == #instanceVariable ifTrue:[ LastLiteralReplacementType := #classVariable ].
].
radioModel := RadioButtonGroup new value:(LastLiteralReplacementType ? #classMethod).
initialNewName :=
DoWhatIMeanSupport
goodRenameDefaultFor:literalString
lastOld:LastLiteralReplacementOldLiteral
lastNew:LastLiteralReplacementNewName.
initialNewName isEmptyOrNil ifTrue:[ initialNewName := literalString "(LastLiteralReplacementNewName ? '')" ].
initialNewName first isDigit ifTrue:[ initialNewName := 'const_',initialNewName ].
initialNewName first isLetter ifFalse:[ initialNewName := 'const_XXX_',literalValue className ].
nameHolder := initialNewName asValue.
box := DialogBox new.
box label:'Replacing Literal Constant'.
box addTextLabel:'Replace selected constant by:' adjust:#left.
box addVerticalSpace.
box addRadioButton:(resources string:'Class Method') on:radioModel value:#classMethod tabable:true.
box addRadioButton:(resources string:'Class Variable') on:radioModel value:#classVariable tabable:true.
rb := box addRadioButton:(resources string:'Instance Method') on:radioModel value:#instanceMethod tabable:true.
selectedClass isMeta ifTrue:[ rb disable ].
rb := box addRadioButton:(resources string:'Instance Variable') on:radioModel value:#instanceVariable tabable:true.
selectedClass isMeta ifTrue:[ rb disable ].
box addVerticalSpace.
box addLabelledInputField:'Named:' adjust:#left on:nameHolder tabable:true from:0 to:1 separateAtX:0.3.
box addVerticalSpace.
box addAbortAndOkButtons.
box open.
box accepted ifFalse:[^ self ].
name := nameHolder value.
name isEmptyOrNil ifTrue:[^ self].
changeHow := radioModel value.
LastLiteralReplacementOldLiteral := literalString.
LastLiteralReplacementNewName := name.
LastLiteralReplacementType := changeHow.
refactoring := CompositeRefactoryChange new.
refactoring name:'Eliminate Constant'.
numMethodsAdded := numMethodsRewritten := 0.
(changeHow == #instanceMethod or:[changeHow == #instanceVariable]) ifTrue:[
targetClass := selectedClass theNonMetaclass
] ifFalse:[
targetClass := selectedClass theMetaclass
].
(changeHow == #instanceMethod or:[changeHow == #classMethod]) ifTrue:[
(targetClass includesSelector:name asSymbol) ifFalse:[
refactoring compile:('%1\ ^ %2' withCRs bindWith:name with:literalString) in:targetClass classified:'constants'.
numMethodsAdded := numMethodsAdded + 1.
] ifTrue:[
"/ if the getter already exists, it must return the same literal
mthd := targetClass compiledMethodAt:name asSymbol.
((ParseTreeSearcher isJustReturningLiteralString:literalString)
executeTree:(mthd parseTree) initialAnswer:nil) notNil
ifFalse:[
Dialog information:(resources
stringWithCRs:'A method named "%1" already exists\with different semantics (does not return "%2")'
with:name
with:literalString).
^ self.
].
].
] ifFalse:[
changeHow == #instanceVariable ifTrue:[
(targetClass theNonMetaclass allInstVarNames includes:name) ifTrue:[
"/ already present
Dialog information:(resources
stringWithCRs:'An instance variable named "%1" already exists'
with:name).
^ self.
].
refactoring addInstanceVariable:name to:targetClass theNonMetaclass.
] ifFalse:[
"/ class variable
(targetClass theNonMetaclass allClassVarNames includes:name) ifTrue:[
"/ already present
Dialog information:(resources
stringWithCRs:'A class variable named "%1" already exists'
with:name).
^ self.
].
refactoring addClassVariable:name to:targetClass theNonMetaclass.
].
(targetClass includesSelector:#initialize) ifFalse:[
refactoring compile:('initialize\ %1 := %2.' withCRs bindWith:name with:literalString) in:targetClass classified:'initialization'.
numMethodsAdded := numMethodsAdded + 1.
] ifTrue:[
|setToThis setToOther rewriter newSource change|
setToThis := setToOther := false.
mthd := targetClass compiledMethodAt:#initialize.
"/ already a setting for that variable ?
"/ cannot happen now, as we only allow not-already-existing vars in the above code.
"/ if we ever support this, must check if the existing init-code is already correct for the new value
(ParseTreeSearcher new
answer:false;
matches:('%1 := ``@expr' bindWith:name) do:[:aNode :ans | self halt. false];
yourself)
executeTree:(mthd parseTree) initialAnswer:false.
setToOther ifTrue:[
Dialog information:(resources
stringWithCRs:'Variable named "%1" is already initialized to a different value'
with:name).
^ self.
].
setToThis ifFalse:[
"/ sigh - the source rewriter is very limited; it cannot append code yet...
rewriter := "ParseTreeSourceRewriter "ParseTreeRewriter new
replace: '| `@temps | ``@.stats. '
with:('| `@temps | ``@.stats.\ %1 := %2.' withCRs bindWith:name with:literalString).
rewriter executeTree: mthd parseTree.
newSource := rewriter tree formattedCode.
"/ newSource := rewriter executeReplacementsInSource:mthd source.
"/ rewriter forgetReplacements.
change := InteractiveAddMethodChange compile:newSource in:mthd mclass classified:mthd category.
refactoring addChange:change.
numMethodsRewritten := numMethodsRewritten + 1.
].
]
].
matchingMethods := OrderedCollection new.
targetClass theNonMetaclass methodDictionary keysAndValuesDo:[:selector :mth |
selector ~= name ifTrue:[
(ParseTreeSearcher new)
matches:literalString do:[:aNode :answer | matchingMethods add:mth ];
executeTree:mth parseTree.
].
].
(changeHow == #classVariable or:[changeHow == #classMethod]) ifTrue:[
targetClass theMetaclass methodDictionary keysAndValuesDo:[:selector :mth |
selector ~= name ifTrue:[
(ParseTreeSearcher new)
matches:literalString do:[:aNode :answer | matchingMethods add:mth ];
executeTree:mth parseTree.
].
].
].
matchingMethods do:[:mth |
|change replacementSource rewriter newSource|
(changeHow == #instanceVariable or:[changeHow == #classVariable]) ifTrue:[
replacementSource := name.
] ifFalse:[
(changeHow == #instanceMethod) ifTrue:[
replacementSource := ('self ',name).
] ifFalse:[
mth mclass isMeta ifTrue:[
replacementSource := ('self ',name).
] ifFalse:[
replacementSource := ('self class ',name).
].
].
].
rewriter := ParseTreeSourceRewriter "ParseTreeRewriter" new
replace: literalString
with: replacementSource.
"/ "/ with the original ParseTreeRewriter, you would
"/ "/ get a new tree, loose all formatting and some comments...
"/ newTree := rewriter
"/ executeTree: mth parseTree;
"/ tree.
"/ newSource := newTree formattedCode.
"/ so we use the new in-place ParseTreeSourceRewriter
rewriter executeTree: mth parseTree.
newSource := rewriter executeReplacementsInSource:mth source.
rewriter forgetReplacements.
change := InteractiveAddMethodChange compile:newSource in:mth mclass classified:mth category.
refactoring addChange:change.
numMethodsRewritten := numMethodsRewritten + 1.
].
(numMethodsRewritten+numMethodsAdded) > 1 ifTrue:[
informationMessage :=
numMethodsRewritten > 0
ifTrue:[
numMethodsAdded > 0
ifTrue:[ 'rewrite %1 and add %2 methods' ]
ifFalse:[ 'rewrite %1 methods' ] ]
ifFalse:[ 'add %2 methods' ].
confirmationQuestion := 'OK to ',informationMessage.
"/ (Dialog confirm:(resources string:confirmationQuestion with:numMethodsRewritten with:numMethodsAdded)) ifFalse:[^ self].
].
self performRefactoring:refactoring.
"/ set the class variable
(changeHow == #classVariable) ifTrue:[
targetClass classVarAt:name asSymbol put:literalValue
].
self showInfo:(resources string:informationMessage with:numMethodsRewritten with:numMethodsAdded).
"Created: / 24-07-2011 / 06:27:02 / cg"
!
codeMenuExtractMethod
self withCurrentMethodsClassAndSelectorDo:[:mClass :mSelector |
| refactoring |
refactoring := (ExtractMethodRefactoring
extract: (self selectedInterval)
from: mSelector
in: mClass).
refactoring source:self codeView contentsAsString.
self performRefactoring:refactoring.
]
!
codeMenuExtractMethodToComponent
self withCurrentMethodsClassAndSelectorDo:[:mClass :mSelector |
| refactoring |
refactoring := (ExtractMethodToComponentRefactoring
extract: (self selectedInterval)
from: mSelector
in: mClass).
refactoring source:self codeView contentsAsString.
self performRefactoring:refactoring.
]
!
codeMenuExtractSelectionToTemporary
|currentMethod cls selector refactoring newName node varName source codeTree |
RBParser isNil ifTrue:[^ self].
(self askIfModified:'Text was modified - please accept first' default:false) ~~ true
ifTrue:[
^ self
].
node := self findNode.
(node notNil and: [node isValue]) ifFalse: [
^ self warn: 'Could not find the node (please select the message expression to extract)'
].
(node isMessage and:[node isUnary]) ifTrue:[
varName := node selector
] ifFalse:[
varName := LastTemporaryVariableName ? 't'.
].
source := self codeView contentsAsString string.
codeTree := RBParser
parseMethod:source
onError: [:str :err ":nodesSoFar" | nil].
codeTree notNil ifTrue:[
(codeTree body temporaries contains:[:nd | nd name = varName]) ifTrue:[varName := nil].
].
newName := Dialog request: 'Enter name for Temporary:' initialAnswer:varName.
newName isEmpty ifTrue: [^self].
LastTemporaryVariableName := newName.
currentMethod := self theSingleSelectedMethod.
cls := currentMethod mclass.
selector := currentMethod selector.
(cls isNil or:[selector isNil]) ifTrue:[
self information:'Oops - no class/selector. Please reselect.'.
^ self.
].
refactoring := (ExtractToTemporaryRefactoring
extract: (node sourceInterval)
to: newName
from: selector
in: cls).
refactoring source:self codeView contentsAsString.
self performRefactoring:refactoring.
!
codeMenuFormat
"format (prettyPrint) the selected method(s) and accept"
|modifiedBefore|
self hasSingleMethodSelected ifTrue:[
modifiedBefore := navigationState modified.
self formatCode.
("autoAcceptFormattedCode" false or:[modifiedBefore not]) ifTrue:[
self codeView accept
].
] ifFalse:[
self information:'Bulk formatting is currently disabled, because the formatter
has still problems to layout comments in an acceptable way (although its much better
than it used to be...) Therefore, please have an eye on each formatted method.'.
^ self.
"/ self selectedMethodsDo:[:each |
"/ self formatMethod:each
"/ ].
].
!
codeMenuGotoClass
self switchToClass:(self selectedClassNameInCodeViewOrNil)
!
codeMenuInlineAllSelfSends
|currentMethod selector refactoring|
(self askIfModified) ifFalse:[
^ self
].
currentMethod := self theSingleSelectedMethod.
selector := currentMethod selector.
refactoring := InlineAllSelfSendersRefactoring
sendersOf: selector
in: currentMethod mclass.
refactoring setOption: #inlineExpression toUse: [:ref :string | true].
self performRefactoring: refactoring.
(self findSendersOf:selector andConfirmRefactoring:refactoring) ifTrue:[
self performRefactoring:refactoring.
]
!
codeMenuInlineMessage
|currentMethod node cls selector refactoring receiverNode inlinedSelector senders rslt|
(self askIfModified) ifFalse:[
^ self
].
currentMethod := self theSingleSelectedMethod.
cls := currentMethod mclass.
selector := currentMethod selector.
node := self findNode.
(node isNil or: [node isMessage not]) ifTrue: [
^ self warn: 'Could not find message send (please select the messageSelector or part of it)'
].
receiverNode := node receiver.
inlinedSelector := node selector.
(receiverNode isVariable
and: [#('self' 'super') includes: receiverNode name])
ifTrue:[
refactoring := (InlineMethodRefactoring
inline: node sourceInterval
inMethod: selector
forClass: cls)
] ifFalse:[
refactoring := (InlineMethodFromComponentRefactoring
inline: node sourceInterval
inMethod: selector
forClass: cls)
].
"/ refactoring model name:('inline %1 into %2' bindWith:inlinedSelector with:selector).
rslt := self performRefactoring:refactoring.
rslt isNil ifTrue:[^ self ].
senders := self class findSendersOf:inlinedSelector
in:environment allClasses
ignoreCase:false
match:false.
senders isEmpty ifTrue:[
(self confirm:('There seem to be no more senders of ', inlinedSelector , '.\\Remove the implementation in ' , cls name , ' ?') withCRs)
ifFalse:[^ self].
self doRemoveMethodsUnconfirmed:(Array with:(refactoring inlineClass realClass compiledMethodAt:inlinedSelector)).
].
"Modified: / 17-11-2006 / 13:51:06 / cg"
!
codeMenuInlineParameter
"inline the parameter which is selected in the codeView"
self codeMenuInlineParameter:(self selectionInCodeView).
!
codeMenuInlineParameter:parameterName
"inline the parameter named parameterName"
|currentMethod cls selector refactoring|
(self askIfModified) ifFalse:[
^ self
].
currentMethod := self theSingleSelectedMethod.
cls := currentMethod mclass.
selector := currentMethod selector.
"/ (self confirm:(resources string:'Inline parameter ''%1'' ?' with:parameterName allBold)) ifFalse:[^ self].
refactoring := InlineParameterRefactoring inlineParameter:parameterName in:cls selector:selector.
(self findSendersOf:selector andConfirmRefactoring:refactoring) ifTrue:[
self performRefactoring:refactoring.
self switchToSelector:refactoring newSelector.
]
!
codeMenuMakeAbstractClassVariable:aString
"replace all accesses to selected classvar by setter/getter method sends;
add accessors if not yet present."
|selectedClass definingClass cls|
(self askIfModified) ifFalse:[
^ self
].
selectedClass := self theSingleSelectedClass theNonMetaclass.
cls := definingClass := selectedClass whichClassDefinesClassVar:aString.
definingClass ~~ selectedClass ifTrue:[
cls := OptionBox
request:(resources string:'Rewrite methods below %1 (defining) or %2 (selected) ?'
with:definingClass name allBold
with:selectedClass name allBold)
label:'Rewrite which classes'
buttonLabels:(Array with:'Cancel' with:definingClass name with:selectedClass name)
values:(Array with:nil with:definingClass with:selectedClass).
cls isNil ifTrue:[^ self].
].
(self confirm:(resources string:'About to rewrite references to ''%1'' (in and below %2).'
with:aString allBold
with:cls name)) ifFalse:[^ self].
self performRefactoring:(AbstractClassVariableRefactoring variable:aString class:cls).
!
codeMenuMakeAbstractInstanceVariable:aString
"replace all accesses to selected instvar by setter/getter method sends;
add accessors if not yet present."
|selectedClass definingClass cls|
(self askIfModified) ifFalse:[
^ self
].
selectedClass := self theSingleSelectedClass.
cls := definingClass := selectedClass whichClassDefinesInstVar:aString.
definingClass ~~ selectedClass ifTrue:[
cls := OptionBox
request:(resources string:'Rewrite methods below %1 (defining) or %2 (selected) ?'
with:definingClass name allBold
with:selectedClass name allBold)
label:'Rewrite which classes'
buttonLabels:(Array with:'Cancel' with:definingClass name with:selectedClass name)
values:(Array with:nil with:definingClass with:selectedClass).
cls isNil ifTrue:[^ self].
].
(self confirm:(resources string:'About to rewrite references to ''%1'' (in and below %2).'
with:aString allBold
with:cls name)) ifFalse:[^ self].
self performRefactoring:(AbstractInstanceVariableRefactoring variable:aString class:cls).
!
codeMenuMakeAbstractVariable
"replace all accesses to selected instvar by setter/getter method sends;
add accessors if not yet present."
|varName|
varName := self selectedInstanceVariableOrNil.
varName notNil ifTrue:[
^ self codeMenuMakeAbstractInstanceVariable:varName.
].
varName := self selectedClassVariableOrNil.
varName notNil ifTrue:[
^ self codeMenuMakeAbstractClassVariable:varName
].
self warn:'Please select either an instance or a class variable (in the codeView or the variableList).'
!
codeMenuMakeInstanceVariable
"make selected local variable an instance variable."
|varNames|
varNames := self selectedTemporaryVariablesInCodeViewOrNil.
varNames isEmptyOrNil ifTrue:[
self warn:'Please select at least one temporary variable in the code.'.
^ self.
].
varNames do:[:varName |
self codeMenuMakeInstanceVariable:varName.
].
!
codeMenuMakeInstanceVariable:aString
"make selected local an instvar."
self withCurrentMethodsClassAndSelectorDo:[:mClass :mSelector |
|refactoring newClass newMethod|
refactoring := (TemporaryToInstanceVariableRefactoring
class: mClass
selector: mSelector
variable: aString).
(self confirm:'About to rewrite methods for ',aString,'...') ifFalse:[^ self].
"/ cannot delay the update class/method
"/ (otherwise, selectedMethod will be wrong for the second variable)
immediateUpdate value:true.
self performRefactoring:refactoring.
immediateUpdate value:false.
"/ must reselect manually here
newClass := environment classNamed:(mClass name).
newMethod := newClass compiledMethodAt:mSelector.
newClass ~~ self theSingleSelectedClass ifTrue:[
self selectClass:newClass.
].
newMethod ~~ self theSingleSelectedMethod ifTrue:[
self selectMethod:newMethod.
].
].
!
codeMenuMoveVariableToInnerScope
"move a temporary/local variable to the innermost possible scope"
|node varName definingNode |
node := self findNode.
(node isNil or:[node isVariable not]) ifTrue:[
^ self warn:'Please select a temporary variable in the code.'
].
varName := node name.
definingNode := node whoDefines:varName.
definingNode isNil ifTrue: [
self warn:varName , ' is not a temporary variable in the method'.
^ self
].
self withCurrentMethodsClassAndSelectorDo:[:mClass :mSelector |
|refactoring|
refactoring := MoveVariableDefinitionRefactoring
bindTight: (node sourceInterval)
in: mClass
selector: mSelector.
self performRefactoring: refactoring.
].
self switchToMethod:(self theSingleSelectedMethod).
!
codeMenuProtectInstanceVariable
"replace all accesses to selected instvar by setter/getter method sends;
add accessors if not yet present."
|varName|
varName := self selectedInstanceVariableOrNil.
varName notNil ifTrue:[
^ self codeMenuProtectInstanceVariable:varName.
].
varName := self selectedClassVariableOrNil.
varName notNil ifTrue:[
^ self warn:'Sorry: This Refactoring is (currently) only supported for instance variables.'.
].
self warn:'Please select an instance variable (in the codeView or the variableList).'
!
codeMenuProtectInstanceVariable:aString
"replace all indirect setter/getter references selected instvar by direct accesses,
then remove the setter/getter methods"
|selectedClass definingClass cls|
(self askIfModified) ifFalse:[
^ self
].
selectedClass := self theSingleSelectedClass.
cls := definingClass := selectedClass whichClassDefinesInstVar:aString.
definingClass ~~ selectedClass ifTrue:[
cls := OptionBox
request:(resources string:'Rewrite methods below %1 (defining) or %2 (selected) ?'
with:definingClass name allBold
with:selectedClass name allBold)
label:'Rewrite which classes'
buttonLabels:(Array with:'Cancel' with:definingClass name with:selectedClass name)
values:(Array with:nil with:definingClass with:selectedClass).
cls isNil ifTrue:[^ self].
].
(self confirm:(resources string:'About to rewrite references to ''%1'' (in and below %2).'
with:aString allBold
with:cls name)) ifFalse:[^ self].
self performRefactoring:(ProtectInstanceVariableRefactoring variable:aString class:cls).
!
codeMenuPullUpClassVariable
"pull a class variable up to its superclasses"
self withCurrentClassDo:[:cls |
|oldName node mthd nonMeta definingClass|
nonMeta := cls theNonMetaclass.
node := self findNode.
node isNil ifTrue:[
(self hasClassVariableSelectedInCodeView) ifFalse:[
oldName := self theSingleSelectedVariable.
oldName isNil ifTrue:[
^ self warn:'Please select a variable'
]
] ifTrue:[
oldName := self selectionInCodeView.
]
] ifFalse:[
node isVariable ifFalse:[
^ self warn:'Please select a variable'
].
oldName := node name.
].
definingClass := nonMeta whichClassDefinesClassVar:oldName.
definingClass isNil ifTrue:[
self warn:'Oops - could not find the defining class'.
^ self
].
definingClass ~~ nonMeta ifTrue:[
(self confirm:'Will pull in ' , definingClass name , ' - OK ?')
ifFalse:[
^ self
].
].
self codeMenuPullUpClassVariable:oldName inClass:definingClass.
mthd notNil ifTrue:[
"/ self switchToSelector:mthd selector.
self switchToMethod:mthd.
].
].
!
codeMenuPullUpClassVariable:oldName inClass:aClass
"pull a class variable up to its superclass"
|refactoring|
(self askIfModified) ifFalse:[
^ self
].
(Dialog
confirm:'About to rewrite methods...'
title:'About to rewrite methods...'
yesLabel:'proceed'
noLabel:'cancel')
ifFalse:[
^ self
].
refactoring := PullUpClassVariableRefactoring variable:oldName class:aClass superclass.
self performRefactoring:refactoring.
!
codeMenuPullUpInstanceVariable
"pull an instance variable up to its superclasses"
self withCurrentClassDo:[:cls |
|oldName node mthd definingClass|
cls isMeta ifTrue:[
^ self warn:'Please switch to the non-meta side.'
].
node := self findNode.
node isNil ifTrue:[
(self hasInstanceVariableSelectedInCodeView) ifFalse:[
oldName := self theSingleSelectedVariable.
oldName isNil ifTrue:[
^ self warn:'Please select a variable'
]
] ifTrue:[
oldName := self selectionInCodeView.
]
] ifFalse:[
node isVariable ifFalse:[
^ self warn:'Please select a variable'
].
oldName := node name.
].
definingClass := cls whichClassDefinesInstVar:oldName.
definingClass isNil ifTrue:[
self warn:'Oops - could not find the defining class'.
^ self
].
definingClass ~~ cls ifTrue:[
(self confirm:'Will pull in ' , definingClass name , ' - OK ?')
ifFalse:[
^ self
].
].
self codeMenuPullUpInstanceVariable:oldName inClass:definingClass.
mthd notNil ifTrue:[
"/ self switchToSelector:mthd selector.
self switchToMethod:mthd.
].
].
!
codeMenuPullUpInstanceVariable:varName inClass:aClass
"pull an instance variable up to its superclass"
|superClass refactoring|
(self askIfModified) ifFalse:[
^ self
].
superClass := aClass superclass.
superClass isNil ifTrue:[
^ self warn:'No superClass to pull variables into.'.
].
superClass == Object ifTrue:[
^ self warn:'Cannot pull variables into Object (may not have instVars).'.
].
"/ (Dialog
"/ confirm:('About to pull ''%1'' up into %2...'bindWith:varName allBold with:superClass name)
"/ title:('About to pullUp ''%1''...' bindWith:varName)
"/ yesLabel:'Proceed'
"/ noLabel:'Cancel')
"/ ifFalse:[
"/ ^ self
"/ ].
refactoring := PullUpInstanceVariableRefactoring variable:varName class:superClass.
self performRefactoring:refactoring.
!
codeMenuPullUpVariable
"pull a variable up to its superclasses"
|varName|
varName := self selectedInstanceVariableOrNil.
varName notNil ifTrue:[
^ self codeMenuPullUpInstanceVariable
].
varName := self selectedClassVariableOrNil.
varName notNil ifTrue:[
^ self codeMenuPullUpClassVariable
].
^ self warn:'Please select a variable and try again.'
!
codeMenuPushDownClassVariable
"push a class variable down to its subclasses"
self withCurrentClassDo:[:cls |
|oldName node mthd nonMeta definingClass|
nonMeta := cls theNonMetaclass.
node := self findNode.
node isNil ifTrue:[
(self hasClassVariableSelectedInCodeView) ifFalse:[
oldName := self theSingleSelectedVariable.
oldName isNil ifTrue:[
^ self warn:'Please select a variable'
]
] ifTrue:[
oldName := self selectionInCodeView.
]
] ifFalse:[
node isVariable ifFalse:[
^ self warn:'Please select a variable'
].
oldName := node name.
].
definingClass := nonMeta whichClassDefinesClassVar:oldName.
definingClass isNil ifTrue:[
self warn:'Oops - could not find the defining class'.
^ self
].
definingClass ~~ nonMeta ifTrue:[
(self confirm:'Will push in ' , definingClass name , ' - OK ?')
ifFalse:[
^ self
].
].
self codeMenuPushDownClassVariable:oldName inClass:definingClass.
mthd notNil ifTrue:[
"/ self switchToSelector:mthd selector.
self switchToMethod:mthd.
].
].
!
codeMenuPushDownClassVariable:oldName inClass:aClass
"push a class variable down to its subclasses"
|cls refactoring|
(self askIfModified) ifFalse:[
^ self
].
(Dialog
confirm:'About to rewrite methods...'
title:'About to rewrite methods...'
yesLabel:'proceed'
noLabel:'cancel')
ifFalse:[
^ self
].
cls := aClass whichClassDefinesClassVar:oldName.
refactoring := PushDownClassVariableRefactoring variable:oldName class:cls.
self performRefactoring:refactoring.
!
codeMenuPushDownInstanceVariable
"push an instance variable down to its subclasses"
self withCurrentClassDo:[:cls |
|oldName node mthd definingClass|
cls isMeta ifTrue:[
^ self warn:'Please switch to the non-meta side.'
].
node := self findNode.
node isNil ifTrue:[
(self hasInstanceVariableSelectedInCodeView) ifFalse:[
oldName := self theSingleSelectedVariable.
oldName isNil ifTrue:[
^ self warn:'Please select a variable'
]
] ifTrue:[
oldName := self selectionInCodeView.
]
] ifFalse:[
node isVariable ifFalse:[
^ self warn:'Please select a variable'
].
oldName := node name.
].
definingClass := cls whichClassDefinesInstVar:oldName.
definingClass isNil ifTrue:[
self warn:'Oops - could not find the defining class'.
^ self
].
definingClass ~~ cls ifTrue:[
(self confirm:'Will pull ''' , oldName , ''' from ' , definingClass name , ' - OK ?')
ifFalse:[
^ self
].
].
self codeMenuPushDownInstanceVariable:oldName inClass:definingClass.
mthd notNil ifTrue:[
"/ self switchToSelector:mthd selector.
self switchToMethod:mthd.
].
].
!
codeMenuPushDownInstanceVariable:varName inClass:aClass
"push an instance variable down to its subclasses"
|cls refactoring|
(self askIfModified) ifFalse:[
^ self
].
(Dialog
confirm:('About to push instance variable ''%1'' down to subclasses which use it...' bindWith:varName allBold)
title:('About to pushDown ''%1''...' bindWith:varName)
yesLabel:'Proceed'
noLabel:'Cancel')
ifFalse:[
^ self
].
cls := aClass whichClassDefinesInstVar:varName.
refactoring := PushDownInstanceVariableRefactoring variable:varName class:cls.
self performRefactoring:refactoring.
!
codeMenuPushDownVariable
"push a variable down to its subclasses"
|varName|
varName := self selectedInstanceVariableOrNil.
varName notNil ifTrue:[
^ self codeMenuPushDownInstanceVariable
].
varName := self selectedClassVariableOrNil.
varName notNil ifTrue:[
^ self codeMenuPushDownClassVariable
].
^ self warn:'Please select a variable and try again.'
!
codeMenuRemoveClassVariable:oldName inClass:aClass
"remove a class variable"
|cls change methods|
(self askIfModified) ifFalse:[
^ self
].
cls := aClass theNonMetaclass whichClassDefinesClassVar:oldName.
methods := self class
findClassRefsTo:oldName
under:cls access:#readOrWrite.
"/ methods addAll:(self class
"/ findClassRefsTo:oldName
"/ under:cls theMetaclass access:#readOrWrite).
methods notEmpty ifTrue:[
(Dialog confirm:(resources
stringWithCRs:'"%1" is still referenced by %2 method(s).\\Remove anyway ?'
with:oldName
with:methods size)) ifFalse:[^ self].
].
change := RemoveClassVariableChange remove:oldName from:cls.
self performRefactoring:change.
!
codeMenuRemoveInstanceVariable:oldName inClass:aClass
"remove an instance variable"
|cls refactoring methods answer whatTypeOfMethods|
(self askIfModified) ifFalse:[ ^ self ].
cls := aClass whichClassDefinesInstVar:oldName.
cls isNil ifTrue:[
self error:'no class'
].
methods := self class
findInstRefsTo:oldName
under:cls access:#readOrWrite.
methods notEmpty ifTrue:[
whatTypeOfMethods := 'method'.
(methods conform:[:m |
|tree searcher|
tree := RBParser
parseSearchMethod:m source
onError: [:str :pos | nil].
searcher := ParseTreeSearcher isGetterOrSetterMethod:oldName.
(searcher executeTree:tree initialAnswer:nil) notNil.
]) ifTrue:[ whatTypeOfMethods := 'accessor' ].
answer := OptionBox
request:(resources
stringWithCRs:'"%1" is still referenced by %2 %3(s).\\Remove these methods ?'
with:oldName
with:methods size
with:whatTypeOfMethods)
label:'Confirm Removal'
image:(WarningBox iconBitmap)
buttonLabels:(resources array:#('Cancel' 'Browse' 'No' 'Remove Methods'))
values:#(#abort #browse false true)
default:#abort
onCancel:#abort.
answer == #abort ifTrue:[^ self].
answer == #browse ifTrue:[
self class
browseMethods:methods
title:(resources string:'Methods referring to %1' with:oldName).
^ self.
].
answer == true ifTrue:[
self doRemoveMethodsUnconfirmed:methods
].
].
refactoring := RemoveInstanceVariableChange remove:oldName from:cls.
"/ refactoring := RemoveInstanceVariableRefactoring variable:oldName class:cls.
"/ refactoring model name:('remove instvar %1 from %2' bindWith:oldName with:cls name).
self performRefactoring:refactoring.
!
codeMenuRemoveParameter
"remove the parameter which is selected in the codeView"
self codeMenuRemoveParameter:(self selectionInCodeView).
!
codeMenuRemoveParameter:parameterName
"remove the parameter named parameterName"
| cls selector refactoring|
(self askIfModified) ifFalse:[
^ self
].
cls := self theSingleSelectedMethod mclass.
selector := self theSingleSelectedMethod selector.
(self confirm:(resources string:'Remove parameter ''%1'' ?' with:parameterName allBold)) ifFalse:[^ self].
refactoring := RemoveParameterRefactoring removeParameter:parameterName in:cls selector:selector.
(self findSendersOf:selector andConfirmRefactoring:refactoring) ifTrue:[
self performRefactoring:refactoring.
self switchToSelector:refactoring newSelector.
]
!
codeMenuRenameClassVariable
"rename a class variable"
self withCurrentClassDo:[:cls |
|oldName node mthd cls definingClass|
node := self findNode.
node isNil ifTrue:[
(self hasClassVariableSelectedInCodeView) ifFalse:[
oldName := self theSingleSelectedVariable.
oldName isNil ifTrue:[
^ self warn:'Please select a variable'
]
] ifTrue:[
oldName := self selectionInCodeView.
]
] ifFalse:[
node isVariable ifFalse:[
^ self warn:'Please select a variable'
].
oldName := node name.
].
definingClass := cls whichClassDefinesClassVar:oldName.
definingClass isNil ifTrue:[
self warn:'Oops - could not find the defining class'.
^ self
].
definingClass ~~ cls ifTrue:[
(self confirm:'Will rename in ' , definingClass name , ' - OK ?')
ifFalse:[
^ self
].
].
self codeMenuRenameClassVariable:oldName inClass:definingClass.
].
!
codeMenuRenameClassVariable:oldName inClass:aClass
"rename a class variable"
|newName refactoring cls|
(self askIfModified) ifFalse:[
^ self
].
newName := Dialog request:('Enter the new name for classVariable ''%1'':' bindWith:oldName) initialAnswer:oldName.
newName isEmpty ifTrue:[
^ self
].
(cls := aClass whichClassDefinesClassVar:newName) notNil ifTrue:[
(Dialog confirm:(resources string:'Attention: a variable named ''%1'' is already defined in ''%2''.\\Proceed ?'
with:newName allBold
with:cls name allBold))
ifFalse:[
^ self
].
].
(self confirm:'About to rewrite methods...') ifFalse:[^ self].
cls := aClass whichClassDefinesClassVar:oldName.
"/ refactoring := RenameClassVariableChange rename: oldName to: newName in: aClass.
refactoring := RenameClassVariableRefactoring rename:oldName to:newName in:cls.
self performRefactoring:refactoring.
!
codeMenuRenameInstanceVariable
"rename an instance variable"
self withCurrentClassDo:[:cls |
|oldName node mthd definingClass|
cls isMeta ifTrue:[
^ self warn:'Please switch to the non-meta side.'
].
node := self findNode.
node isNil ifTrue:[
(self hasInstanceVariableSelectedInCodeView) ifFalse:[
oldName := self theSingleSelectedVariable.
oldName isNil ifTrue:[
^ self warn:'Please select a variable'
]
] ifTrue:[
oldName := self selectionInCodeView.
]
] ifFalse:[
node isVariable ifFalse:[
^ self warn:'Please select a variable'
].
oldName := node name.
].
definingClass := cls whichClassDefinesInstVar:oldName.
definingClass isNil ifTrue:[
self warn:'Oops - could not find the defining class'.
^ self
].
definingClass ~~ cls ifTrue:[
(self confirm:'Will rename in ' , definingClass name , ' - OK ?')
ifFalse:[
^ self
].
].
self codeMenuRenameInstanceVariable:oldName inClass:definingClass.
mthd notNil ifTrue:[
"/ self switchToSelector:mthd selector.
self switchToMethod:mthd.
].
].
!
codeMenuRenameInstanceVariable:oldName inClass:aClass
"rename an instance variable"
|newName refactoring cls|
(self askIfModified) ifFalse:[ ^ self ].
newName := Dialog
request:(resources
string:'Enter new name for %2 variable ''%1'':'
with:oldName allBold
with:(self meta value ifTrue:['classInstance'] ifFalse:['instance']))
title:(resources string:'Rename Variable')
initialAnswer:oldName.
newName isEmptyOrNil ifTrue:[
^ self
].
(cls := aClass whichClassDefinesInstVar:newName) notNil ifTrue:[
Dialog warn:(resources stringWithCRs:'A variable named ''%1'' is already defined in ''%2''.'
with:newName allBold
with:cls name allBold).
^ self
"/ disabled, because refactoring will fail (need a new one: rewrite uses of var1 to use var2
"/ (Dialog confirm:(resources stringWithCRs:'A variable named ''%1'' is already defined in ''%2''.\\Change the code to use that one as well?'
"/ with:newName allBold
"/ with:cls name allBold)) ifFalse:[
"/ ^ self
"/ ].
"/ self halt.
].
(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 hasInstanceVariableSelectedInCodeView ifTrue:[
self codeMenuRenameInstanceVariable.
^ self.
].
self warn: oldName , ' is not a temporary variable in the method'. ^ self
].
LastVariableRenames isNil ifTrue:[
LastVariableRenames := CacheDictionary new:30.
].
initial := LastVariableRenames at:oldName ifAbsent:oldName.
newName := Dialog request:('Enter new name for ''%1'':' bindWith:oldName allBold) initialAnswer:initial.
newName size == 0 ifTrue:[
^ self "/ cancel
].
newName = oldName ifTrue: [self warn: 'Same name given.'. ^ self].
LastVariableRenames at:oldName put:newName.
refactoring := RenameTemporaryRefactoring
renameTemporaryFrom:node sourceInterval
to:newName
in:(mthd := self theSingleSelectedMethod) mclass
selector:mthd selector.
refactoring source:(self codeView contentsAsString).
refactoring okToRenameAsKnownVariable:true.
"/ refactoring model name:('rename local variable %1 to %2' bindWith:oldName with:newName).
self performRefactoring:refactoring.
self switchToMethod:mthd.
!
codeMenuShowCoverage
self showCoverageInformation value:true.
!
codeMenuSmellsLikeCodeDuplication
"add a 'this method has a smell' annotation"
(self askIfModified) ifFalse:[
^ self
].
self warn:'not yet implemented'.
self selectedMethodsDo:[:eachMethod |
|cls selector|
cls := eachMethod mclass.
selector := eachMethod selector.
].
!
findNode
|interval|
interval := self selectedInterval.
^ self findNodeForInterval:interval
!
findNodeForInterval:interval
^ DoWhatIMeanSupport
findNodeForInterval:interval
in:(self codeView contentsAsString string).
!
findNodeForInterval:interval allowErrors:allowErrors
^ DoWhatIMeanSupport
findNodeForInterval:interval
in:(self codeView contentsAsString string)
allowErrors:allowErrors.
!
findNodeIn:tree forInterval:interval
<resource: #obsolete>
self obsoleteMethodWarning.
^ DoWhatIMeanSupport 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
"Modified: / 20-11-2006 / 12:31:12 / cg"
!
findSendersOf:selector andConfirmRefactoring:refactoring
^ self findSendersOf:selector in:(environment allClasses) andConfirmRefactoring:refactoring
"Modified: / 28-02-2007 / 21:20:23 / cg"
!
findSendersOf:selector in:aSetOfClasses andConfirmRefactoring:refactoring
|senders nSenders classes nClasses firstClassName secondClassName infoMsg answer brwsr|
"/ how many senders are there ?
senders := SystemBrowser findSendersOf:selector in:aSetOfClasses ignoreCase:false match:false.
nSenders := senders size.
nSenders == 0 ifTrue:[ ^ true ].
classes := (senders collect:[:eachMethod | eachMethod mclass]) asIdentitySet.
nClasses := classes size.
nClasses > 0 ifTrue:[
firstClassName := classes first name allBold.
nClasses > 1 ifTrue:[
secondClassName := classes second name allBold.
].
].
nClasses == 1 ifTrue:[
nSenders == 1 ifTrue:[
infoMsg := 'Proceed to rewrite sending method %5'
] ifFalse:[
infoMsg := 'Proceed to rewrite %1 sending method(s) in %3'
]
] ifFalse:[
nClasses == 2 ifTrue:[
infoMsg := 'Proceed to rewrite %1 sending method(s) in %3 and %4'
] ifFalse:[
infoMsg := 'Proceed to rewrite %1 sending method(s) in %2 class(es)'
]
].
infoMsg := resources
string:infoMsg
with:nSenders printString
with:nClasses printString
with:firstClassName
with:secondClassName
with:senders first whoString allBold.
infoMsg := infoMsg , (resources stringWithCRs:'\for "%1" ?' with:refactoring changeString).
answer := Dialog
confirmWithCancel:infoMsg
labels:#('Cancel' 'Browse' 'Rewrite' )
values:#(nil #browse #rewrite)
default:3.
answer isNil ifTrue:[
"/ cancel
^ false
].
answer == #browse ifTrue:[
brwsr := self
spawnMethodBrowserFor:senders in:#newBuffer
label:'Senders of ' , selector
perMethodInfo:nil
sortBy:#class.
"/ WRONG: must do a more intelligent autosearch here.
"/ brwsr autoSearchPattern:selector.
brwsr setSearchSelector:selector ignoreCase:false doMatch:false.
^ false
].
^ true
"Created: / 28-02-2007 / 21:20:10 / cg"
!
formatCode
"format (prettyPrint) the selected method's code.
Does not accept, so caller can decide"
|tree newText mthd codeView|
RBParser isNil ifTrue:[^ nil].
codeView := self codeView.
mthd := self theSingleSelectedMethod.
tree := RBParser
parseMethod:(codeView contentsAsString)
onError: [:aString :position |
codeView selectFromCharacterPosition:1 to:position.
self showInfo:aString.
^ nil "ignore any error"
].
tree isNil ifTrue:[^ nil].
newText := tree printString.
self doSyntaxColoring value ~~ false ifTrue:[
newText := self syntaxHighlightedCodeFor:newText method:mthd.
].
codeView
undoableDo:[ codeView replaceContentsWith:newText ]
info:'Format'.
"/ codeView modified:true.
navigationState modified:true.
navigationState realModifiedState:true.
^ newText.
!
handlingRefactoringErrorDo:aBlock
^ Refactoring preconditionSignal
handle:[:ex |
|param answer errMsg dialogMsg|
errMsg := ex description.
param := ex parameter.
ex willProceed ifTrue:[
dialogMsg := (errMsg last == $?)
ifTrue:[errMsg]
ifFalse:[errMsg , '\\Do you want to proceed?' withCRs].
param notNil ifTrue:[
answer := Dialog
choose:dialogMsg
labels:#('No' 'No, Browse' 'Yes')
values:#(false #browse true)
default:true
] ifFalse:[
answer := Dialog confirm:dialogMsg
].
answer == #browse ifTrue:[
"/ param is either a collection of classes, or methods;
param := param collect:[:each | (each isKindOf:RBAbstractClass) ifTrue:[
each realClass
] ifFalse:[
self error:'should not happen' mayProceed:true.
(each isKindOf:RBMethod) ifTrue:[
] ifFalse:[
].
each
]
].
param first isBehavior ifTrue:[
self
spawnClassBrowserFor:param
label:'Classes affected by change'
in:#newBrowser
select:false
] ifFalse:[
self
spawnMethodBrowserFor:param
in:#newBrowser
label:'Methods affected by change'
].
answer := false
"/ answer := Dialog confirm: (ex description last == $?
"/ ifTrue: [ex description]
"/ ifFalse: [ex description , '\Do you want to proceed?' withCRs]).
].
answer ifTrue:[
ex proceed
]
] ifFalse:[
param notNil ifTrue:[
(Dialog confirm:errMsg) ifTrue:[
ex parameter value
]
] ifFalse:[
ex mayProceed ifTrue:[
(Dialog
confirm:('Missing Precondition for refactoring:\\' withCRs , errMsg)
yesLabel:'Proceed Anyway'
noLabel:'Cancel')
ifTrue:[
ex proceed.
].
] ifFalse:[
Dialog warn:('Refactoring failed:\\' withCRs , errMsg)
].
]
].
ex return
]
do:[self topApplication withWaitCursorDo:aBlock]
!
operationsMenuRedo
self changeRequest ifTrue:[
RefactoryChangeManager instance redoOperation.
]
!
operationsMenuUndo
self changeRequest ifTrue:[
RefactoryChangeManager instance undoOperation.
]
!
operationsMenuUndo:aChange
aChange execute
!
performRefactoring:refactoringArg
|rslt aRefactoring|
(aRefactoring := refactoringArg) isNil ifTrue:[
^ self
].
"/ workaround a bug in jan's fixes
"/ - these call me with a ChangeSet, whereas here a Refactoring is expected.
(aRefactoring class == ChangeSet) ifTrue:[
self halt.
"/ refactoring :=
].
rslt := self
handlingRefactoringErrorDo:
[
| changes |
(aRefactoring isRefactoryChange) ifTrue:[
changes := aRefactoring.
(UserPreferences current confirmRefactorings and:[changes shouldBeConfirmed]) ifTrue:[
changes := ChangeSetBrowser2 confirmChanges: changes.
].
RefactoryChangeManager performChange:changes.
] ifFalse:[
UserPreferences current confirmRefactorings ifTrue:[
aRefactoring primitiveExecute.
changes := aRefactoring changes.
changes changes size > 1 ifTrue:[
changes := ChangeSetBrowser2 confirmChanges: changes.
changes := (CompositeRefactoryChange named: (aRefactoring changeString)) changes: changes.
].
RefactoryChangeManager performChange:changes.
RefactoringManager instance addRefactoring: aRefactoring performChanges: false.
] ifFalse:[
aRefactoring execute
]
].
].
self enqueueDelayedUpdateCodeWithoutAutoSearch.
^ rslt
"Modified: / 16-11-2006 / 19:34:19 / cg"
"Modified: / 15-05-2012 / 13:12:18 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 01-09-2022 / 13:50:33 / Jan Vrany <jan.vrany@labware.com>"
!
selectedClassVariableOrNil
"return the selected class variable from either the variableList or
the codeView. Return nil, if nothing is selected, or the selection is not
a class variable."
|varName cls|
varName := self selectedClassVariableInCodeViewOrNil.
varName notNil ifTrue:[
cls := self theSingleSelectedClass theNonMetaclass whichClassDefinesClassVar:varName.
cls notNil ifTrue:[
^ varName
].
].
self showingClassVarsInVariableList ifTrue:[
varName := self theSingleSelectedVariable.
^ varName.
].
^ nil.
!
selectedInstanceVariableOrNil
"return the selected instance variable from either the variableList or
the codeView. Return nil, if nothing is selected, or the selection is not
an instance variable."
|varName cls|
varName := self selectedInstanceVariableInCodeViewOrNil.
varName notNil ifTrue:[
cls := self theSingleSelectedClass whichClassDefinesInstVar:varName.
cls notNil ifTrue:[
^ varName.
].
].
self showingClassVarsInVariableList ifFalse:[
varName := self theSingleSelectedVariable.
^ varName.
].
^ nil.
!
selectedInterval
| codeView |
codeView := self codeView.
codeView isNil ifTrue:[^1 to: 0].
^ codeView selectedInterval
!
setUndoCount
| undoString undoSize |
(self canUseRefactoringSupport) ifFalse:[^ self].
undoString := Dialog request: 'Enter undo stack size:\(i.e.: Number of remembered operations)' withCRs
initialAnswer:(RefactoryChangeManager undoSize printString).
undoSize := Integer readFrom:undoString onError:nil.
undoSize isNil ifTrue: [^self].
RefactoryChangeManager undoSize: undoSize
!
synchronousUpdate
^ self class synchronousUpdate
!
withCurrentClassDo:aOneArgBlock
|mthd cls|
(self askIfModified) ifFalse:[
^ self
].
(mthd := self theSingleSelectedMethod) notNil ifTrue:[
cls := mthd mclass.
] ifFalse:[
self codeAspect value ~= SyntaxHighlighter codeAspectClassDefinition ifTrue:[
^ self warn:'Select either a single class or a single method.'
].
cls := self theSingleSelectedClass.
].
aOneArgBlock value:cls.
"Modified: / 27-07-2012 / 22:27:10 / cg"
!
withCurrentMethodsClassAndSelectorDo:aTwoArgBlock
|currentMethod cls selector|
(self askIfModified) ifFalse:[
^ self
].
currentMethod := self theSingleSelectedMethod.
cls := currentMethod mclass.
selector := currentMethod selector.
self assert:(cls notNil and:[selector notNil]) message:'no class/method'.
aTwoArgBlock value:cls value:selector.
! !
!NewSystemBrowser methodsFor:'menu actions-debug'!
categoryMenuClearCoverageInfo
"clear coverage information for classes in selected categories"
self withWaitCursorDo:[
self selectedCategoryClassesDo:[:cls |
InstrumentationInfo allInfosOfClass:cls do:[:info |
info cleanInfoWithChange:false
]
].
].
environment changed:#coverageInfo.
self showCoverageInformation changed. "/ to force update
!
classMenuClearCoverageInfo
"clear coverage information for selected classes"
self withWaitCursorDo:[
self selectedClassesDo:[:cls |
InstrumentationInfo allInfosOfClass:cls do:[:info |
info cleanInfoWithChange:false
]
].
].
environment changed:#coverageInfo.
self showCoverageInformation changed. "/ to force update
!
commonTraceHelperWith:aSelector with:argumentOrNil clear:doClearAnyPreviousWrap
"install a break/trace or countPoint for the current method(s).
If doClearAnyPreviousWrap is true, a previous break/trace on that method is
removed first.
(it is as yet untested, if trace/break stacking works, as
technicall, it may work, but the UI must handle wrapped-wrappedMethods gracefully..)"
|anyHaltIgnored alsoRemoveStatementBreakpoints|
alsoRemoveStatementBreakpoints := nil. "/ tri-state !!
anyHaltIgnored := false.
self selectedMethodsDo:[:mthdArg |
|mthd originalMethod cls sel wasWrapped|
mthd := mthdArg.
cls := mthd mclass.
cls notNil ifTrue:[
sel := mthd selector.
wasWrapped := mthd isWrapped.
doClearAnyPreviousWrap ifTrue:[
wasWrapped 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.
]
].
(aSelector == #clearBreakPoint) ifTrue:[
mthd isMethodWithBreakpoints ifTrue:[
(wasWrapped and:[alsoRemoveStatementBreakpoints isNil]) ifTrue:[
alsoRemoveStatementBreakpoints := Dialog confirm:'Also clear statement break/tracepoints?'.
alsoRemoveStatementBreakpoints isNil ifTrue:[ ^ self ].
].
(wasWrapped not or:[alsoRemoveStatementBreakpoints == true]) ifTrue:[
mthd restoreOriginalMethod
]
].
].
"/ sel isNil ifTrue:[sel := mthd selector].
"/ (sel isNil
"/ and:[mthd isWrapped
"/ and:[(originalMethod := mthd originalMethod) notNil]]) ifTrue:[
"/ sel := originalMethod selector
"/ ].
anyHaltIgnored := anyHaltIgnored
and:[
DebugView
isHaltToBeIgnoredIn:mthd
atLineNr:1
context:nil
modifyEntryCount:false
]
]
].
anyHaltIgnored ifTrue:[
(Dialog confirm:'Some halts/breakpoints are currently ignored (in the debugger).\Stop ignoring now?')
ifTrue:[
DebugView stopIgnoringHalts
]
].
!
debugMenuBreakPoint
"set a breakpoint on the selected method(s)"
self commonTraceHelperWith:#setBreakPoint with:nil clear:true.
!
debugMenuBreakPointAfter
"set a breakpoint on the current method(s), which only trigger(s) if
the method has been invoked some number of times."
|answer n|
answer := DialogBox request:'Enter debugger after how many invocations:'.
answer isNil ifTrue:[^self].
n := Number readFrom:answer onError:nil.
n isNil ifTrue:[^self].
self commonTraceHelperWith:#breakPointAfter: with:n clear:true
!
debugMenuBreakPointFor
"set a breakpoint on the current method(s), which only trigger(s) if
the receiver is an instance or subInstance of some class"
|mthd classList initialSelection class conditionBlock|
initialSelection := nil.
"/ LastBreakPointClassName notNil ifTrue:[
"/ initialSelection := LastBreakPointClassName.
"/ ].
mthd := self theSingleSelectedMethod.
classList := mthd mclass withAllSubclasses.
classList sort:[:a :b | a name < b name].
"/ resources := ResourcePack for:self class.
Dialog modifyingBoxWith:[:box |
box window minExtent:300@300.
] do:[
class := Dialog
choose:(resources string:'Break for (Sub-)Instances of')
fromList:classList
lines:20
initialSelection:initialSelection
title:(resources string:'Break for some Instances only').
].
class isNil ifTrue:[^ self].
"/ LastBreakPointClassName := class name.
conditionBlock := [:context :method | context receiver isKindOf:class ].
self commonTraceHelperWith:#breakPointIf: with:conditionBlock clear:true
!
debugMenuBreakPointIf
"set a breakpoint on the current method(s), which only trigger(s) if
some conditionBlock evaluates to true."
|conditionBlockString conditionBlock dialog textHolder template|
template :=
'"/ General breakpoint
"/
"/ the following block should evaluate to true, if the breakPoint is to fire.
"/ Please change as required.
"/ Beginner warning: Smalltalk know-how is useful here.
|counter|
counter := 0.
[:context :method |
counter := counter + 1.
"/ Define condition for breakpoint below:
"/ Useful queries are:
"/ - Processor activeProcess the active process
"/
"/ Useful queries to the context are:
"/ - receiver the receiver
"/ - argAt:N the N''th argument
"/ - receiver instVarNamed:''nm'' an instance variable in the receiver
"/ - sender the sender context
"/ - sender selector the sender context''s selector
"/ - sender receiver the sender context''s receiver
"/
"/ Other Useful stuff:
"/ - counter invocation counter
"/ examples:
"/ stop if the receiver is a NewSystemBrowser
"/ (context receiver isMemberOf:NewSystemBrowser)
"/ stop if some argument has a particular value
"/ (context argAt:1) = ''hello''
"/ (context argAt:1) isString and:[ (context argAt:1) startsWith:''foo'']
"/ (context argAt:1) = 1234
"/ (context argAt:1) = (context argAt:2)
"/ stop if the sender is a Workspace
"/ (context sender receiver isMemberOf:Workspace)
"/ stop if an instance variable is true
"/ ((context receiver instVarNamed:''foo'') == true)
"/ stop if shift-key is pressed
"/ Display shiftDown
"/ stop after 5 calls (notice the scope of the counter variable, outside the block)
"/ counter >= 5
"/ stop always
"/ true
]
'.
LastBreakPointConditionString isNil ifTrue:[
LastBreakPointConditionString := template.
].
"/ resources := ResourcePack for:self class.
textHolder := ValueHolder new.
dialog := Dialog
forRequestText:(resources string:'Enter condition for breakpoint')
lines:20
columns:70
initialAnswer:LastBreakPointConditionString
model:textHolder.
dialog addButton:(Button label:'Template' action:[textHolder value:template. textHolder changed:#value.]).
dialog open.
dialog accepted ifFalse:[^ self].
conditionBlockString := textHolder value.
LastBreakPointConditionString := conditionBlockString.
conditionBlock := Parser evaluate:conditionBlockString.
conditionBlock isBlock ifFalse:[
self error:'bad input'.
^ self
].
self commonTraceHelperWith:#breakPointIf: with:conditionBlock clear:true
"Modified: / 14-02-2012 / 11:14:24 / 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 isDead not]
].
processes := processes sort:[:a :b | a id < b id].
processNames := processes collect:[:aProcess |
|pName theGroup topViews topView topLabel winLabel
busyOrNot iconifiedOrNot sensor pending |
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:[
theGroup isModal ifTrue:[theGroup := (theGroup previousGroup ? theGroup)].
topViews := theGroup topViews select:[:v | v isTopView].
topViews size > 0 ifTrue:[
topView := topViews detect:[:v | v isCollapsed not] ifNone:nil.
topView isNil ifTrue:[ topView := topViews detect:[:v | v application notNil] ifNone:nil].
topView isNil ifTrue:[ topView := topViews first ].
topLabel := (topView label ? '').
busyOrNot := ''.
aProcess isDebugged ifTrue:[
busyOrNot := ' debug'
] ifFalse:[
(sensor := theGroup sensor) notNil ifTrue:[
(pending := sensor pendingEvent) notNil ifTrue:[
(Timestamp now secondDeltaFrom: pending timeStamp) > 1 ifTrue:[
(aProcess isDebugged) ifTrue:[
busyOrNot := ' debug'
] ifFalse:[
busyOrNot := ' busy'
].
]
]
].
].
iconifiedOrNot := ''.
topView isCollapsed ifTrue:[
iconifiedOrNot := ' iconified' withColor:Color blue.
].
busyOrNot notEmptyOrNil ifTrue:[
busyOrNot := busyOrNot allBold withColor:Color red
].
winLabel := ' ("' , topLabel , '"',busyOrNot,iconifiedOrNot, ')'
].
] ifFalse:[
(aProcess isDebugged) ifTrue:[
winLabel := ' (debug)' allBold withColor:Color red
].
].
aProcess id printString , ' [' , pName , ']' , winLabel
].
"/ let user specify which one ...
box := ListSelectionBox new.
box noEnterField.
box list:processNames.
box label:(resources string:'process selection').
box title:(resources
string:'Stop if method is executed by process:\\(current process is %1)'
with:(Processor activeProcess id)
with:(Processor activeProcess nameOrId)) withCRs.
box action:[:selection | selectedProcessIndex := box selectionIndex].
box initialSelection:(processes identityIndexOf:Processor activeProcess).
box extent:(450 @ 350).
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: / 02-02-1998 / 12:39:38 / stefan"
"Modified: / 06-07-2011 / 11:15:52 / cg"
!
debugMenuClearCoverageInfo
"clear all coverage information"
self withWaitCursorDo:[
InstrumentedMethod cleanAllInfoWithChange:false
].
environment changed:#coverageInfo.
self showCoverageInformation changed. "/ to force update
"Created: / 27-04-2010 / 19:00:32 / cg"
!
debugMenuDisableGlobalCoverageRecording
InstrumentationContext setGlobalInstrumentationContext:nil
"Created: / 21-09-2011 / 19:17:45 / cg"
!
debugMenuEnableGlobalCoverageRecording
InstrumentationContext new
coverageOnly:true;
beActiveEverywhere
"Created: / 21-09-2011 / 19:17:42 / cg"
!
debugMenuOpenCallGraphForClasses
"open an OOM CallGraph view on the selected class(es)"
self debugMenuOpenCallGraphForClasses:(self selectedClassesValue).
"Created: / 27-04-2010 / 14:07:58 / cg"
!
debugMenuOpenCallGraphForClasses:classes
"open an OOM CallGraph view on the selected class(es)"
|methods|
methods := classes collectAll:[:cls | cls instAndClassMethods].
self debugMenuOpenCallGraphForMethods:methods.
"Created: / 27-04-2010 / 14:09:29 / cg"
!
debugMenuOpenCallGraphForMethods:methods
"open an OOM CallGraph view on the selected class(es)"
|callingMethods allMethods|
OOM::MetricVisualizer isNil ifTrue:[
Dialog information:'Missing class: OOM::MetricVisualizer'.
^ self.
].
callingMethods := Set new.
methods
do:[:eachMethod |
|info|
InstrumentingCompiler callersOf:eachMethod do:[:callingMethod |
callingMethod == eachMethod ifFalse:[
callingMethods add:callingMethod
]
]
].
callingMethods removeAllFoundIn:methods.
callingMethods do:[:caller |
"/ don't do primitives...
caller hasPrimitiveCode ifFalse:[
caller mclass notNil ifTrue:[
caller isInstrumented ifFalse:[
InstrumentingCompiler compileMethod:caller
].
]
].
].
allMethods := Set withAll:methods.
allMethods addAll:callingMethods.
OOM::MetricVisualizer
openViewerOnDiagramForMethods:allMethods
setupWith:[:viewer | viewer set_DynamicMethodInvocationDiagram]
"Created: / 27-04-2010 / 14:07:07 / cg"
!
debugMenuOpenCallGraphForProjects
"open an OOM CallGraph view on the selected project(s) classes"
self debugMenuOpenCallGraphForClasses:(self selectedProjectClasses).
"Created: / 27-04-2010 / 14:08:02 / cg"
!
debugMenuRemoveAllBreakpoints
"remove all breakpoints in the system"
self withExecuteCursorDo:[
(MessageTracer notNil and:[MessageTracer isLoaded]) ifTrue:[
MessageTracer unwrapAllMethods.
].
(MethodWithBreakpoints notNil and:[MessageTracer isLoaded]) ifTrue:[
MethodWithBreakpoints removeAllBreakpoints.
].
]
!
debugMenuRemoveBreakOrTrace
"remove any break/trace on the selected method(s)"
self commonTraceHelperWith:#clearBreakPoint with:nil clear:false.
!
debugMenuRunLintRuleOn
"apply the selected rule(s) on a chosen set of package classes"
|package packagesInChangeSet ruleset env|
ruleset := RBLintRuleSet new.
self selectedClasses value do:[:each |
|cls|
cls := each theNonMetaclass.
(cls isSubclassOf:RBLintRule) ifTrue:[
(cls isAbstract "cls isBroken" or:[ cls isVisible not ]) ifFalse:[
ruleset addRule:(cls new).
].
].
].
ruleset isEmptyInTree ifTrue:[
Dialog information:'The ruleset is empty (or only abstract/inVisible rules selected'.
^ self
].
packagesInChangeSet :=
(ChangeSet current
collect:[:chg | |cls| (cls := chg changeClass) notNil ifTrue:[cls package] ]
thenSelect:[:pkg | pkg notNil])
asSet asOrderedCollection sort.
package := Dialog
requestProject:'Run rule on package:'
initialAnswer: (LastLintedPackage ? 'stx:libbasic')
suggestions: #( '* all *' ) , packagesInChangeSet.
package isNil ifTrue:[^ self].
LastLintedPackage := package.
env := PackageEnvironment new.
package = '* all *' ifTrue:[
env packageNames:Smalltalk allPackageIDs.
env label:('package ' , package).
] ifFalse:[
env packageNamesMatchingAny: { package }.
env label:('packages matching ' , package).
].
self smalllintRun:ruleset onEnvironment:env.
!
debugMenuStartCounting
"set a countpoint on the current method"
self commonTraceHelperWith:#startCounting with:nil clear:true
!
debugMenuStartCountingByReceiverClass
"set a countpoint for memory usage on the current method"
self commonTraceHelperWith:#startCountingByReceiverClass 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.
!
debugMenuTracelog
"automatically generated by UIEditor ..."
"*** the code below performs no action"
"*** (except for some feedback on the Transcript)"
"*** Please change as required and accept in the browser."
"*** (and replace this comment by something more useful ;-)"
"action to be added ..."
self commonTraceHelperWith:#setTracelog with:nil clear:true.
"Modified: / 15-03-2013 / 11:08:47 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
debugMenuTracelogChangeUpdate
Dialog warn: 'Sorry, not yet implemented'
"Modified: / 15-03-2013 / 11:09:13 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
debugMenuTracelogFullWalkback
Dialog warn: 'Sorry, not yet implemented'
"Modified: / 15-03-2013 / 11:09:21 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
debugMenuTracelogSender
Dialog warn: 'Sorry, not yet implemented'
"Modified: / 15-03-2013 / 11:09:26 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
runTestCases
"run selected testcases (not opening a debugger on error)"
self runTestCasesWithDebug:false
"Modified: / 05-08-2006 / 17:32:19 / cg"
!
runTestCasesForCoverage
"run selected testcases for coverage tests;
First, compile all affected testee-classes with instrumentation,
then run the tests, then open a browser on the tested classes."
|testedClasses browser|
testedClasses := Set new.
self selectedNonAbstractTestCaseClassesDo:[:eachClass |
testedClasses addAll:(eachClass coveredClasses).
].
testedClasses do:[:eachClass |
self recompileClassWithInstrumentation:eachClass
].
self showInfo:nil.
self askForGlobalCoverageRecording.
self runTestCasesWithDebug:false protocols:nil.
browser := self class browseClasses:testedClasses.
browser showCoverageInformation value:true.
browser windowLabel:'Coverage Info after Test Execution'.
"Modified: / 10-08-2010 / 14:36:51 / cg"
!
runTestCasesWithDebug
"run selected testcases (opening a debugger on error)"
self runTestCasesWithDebug:true
"Created: / 05-08-2006 / 17:32:24 / cg"
!
runTestCasesWithDebug:withDebug
"run selected testcases"
^ self runTestCasesWithDebug:withDebug protocols:self selectedProtocolsValue.
!
runTestCasesWithDebug:withDebug protocols:protocolsOrNil
"run selected testcases"
|embeddedTestRunner|
embeddedTestRunner := self navigationState applicationOfComponent:#TestRunnerEmbedded.
embeddedTestRunner notNil ifTrue:[
withDebug ifTrue:[
embeddedTestRunner runWithDebug
"/ embeddedTestRunner debug
] ifFalse:[
embeddedTestRunner run
].
^ self
].
[
[
self
selectedNonAbstractTestCaseClassesDo:[:cls |
|isCompleteSuite suite selectors toRun result|
(protocolsOrNil isEmptyOrNil
or:[ protocolsOrNil includes:BrowserList nameListEntryForALL ])
ifTrue:[
isCompleteSuite := true.
suite := cls buildSuite.
]
ifFalse:[
isCompleteSuite := false.
(selectors := self selectedSelectors) isEmptyOrNil ifTrue:[
selectors := OrderedCollection new.
self
selectedProtocolMethodsDo:[:cls :category :sel :mthd |
(cls isTestCaseLike and:[ cls isAbstract not ]) ifTrue:[
(cls allTestSelectors includes:sel) ifTrue:[
selectors add:sel
].
].
].
].
suite := cls buildSuiteFromMethods:selectors.
].
self busyLabel:'running test %1 ...' with:cls name.
toRun := suite tests size.
withDebug ifTrue:[
result := TestResultForRunWithDebug new.
] ifFalse:[
result := TestResult new.
].
suite
run:result
beforeEachDo:[:case :result |
self showInfo:('To Run: %1 ; executing %2...' bindWith:toRun
with:case printString).
]
afterEachDo:[:case :result | toRun := toRun - 1. ]
debug: withDebug.
result hasPassed ifTrue:[
result passedCount > 0 ifTrue:[
self showInfo:(result printString asText colorizeAllWith:Color black
on:Color green).
].
] ifFalse:[
self showInfo:(result printString asText colorizeAllWith:Color black
on:Color red).
].
].
] benchmark:'test exec time: '.
] ensure:[ self normalLabel ].
"Created: / 05-08-2006 / 17:32:06 / cg"
"Modified: / 06-07-2011 / 14:07:52 / cg"
"Modified: / 21-08-2011 / 13:54:40 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 26-12-2013 / 22:01:37 / f.urbach"
"Modified: / 07-09-2022 / 15:06:03 / Jan Vrany <jan.vrany@labware.com>"
!
selectedNonAbstractTestCaseClassesDo:aBlock
"run selected testcases for coverage tests;
First, compile all affected testee-classes with instrumentation,
then run the tests, then open a browser on the tested classes."
|selectedClasses|
selectedClasses := self selectedClassesValue.
selectedClasses isEmptyOrNil ifTrue:[
selectedClasses := self selectedCategoryClasses
].
selectedClasses do:[:eachClass |
|cls|
cls := eachClass.
cls isLoaded ifFalse:[
cls := eachClass autoload.
].
cls := cls theNonMetaclass.
(cls isTestCaseLike and:[cls isAbstract not]) ifTrue:[
aBlock value:cls
]
].
"Modified: / 28-02-2012 / 16:52:45 / cg"
! !
!NewSystemBrowser methodsFor:'menu actions-help'!
openClassDocumentation
HTMLDocumentView openFullOnDocumentationFile:'overview/basicClasses/TOP.html'
!
openDocumentation
HTMLDocumentView openFullOnDocumentationFile:'tools/newbrowser/TOP.html'
!
openKeywordIndexDocumentation
HTMLDocumentView openFullOnDocumentationFile:'index.html'
!
openRefactoringDocumentation
HTMLDocumentView openFullOnDocumentationFile:'tools/newbrowser/refactorings.html'
!
openSTXDocumentation
HTMLDocumentView openFullOnDocumentationFile:'TOP.html'
! !
!NewSystemBrowser methodsFor:'menu actions-inheritance'!
inheritanceMenuNavigateToClass
self switchToClass:(navigationState inheritanceView scrolledView selectionHolder value)
!
inheritanceMenuUpdate
self updateSpecialCodeEditorVisibility
! !
!NewSystemBrowser methodsFor:'menu actions-methodList'!
methodListMenuBrowseClassPackagesResourceDirectory
"add a buffer/open a browser showing the selected method class packages' resource folder"
|classes|
classes := self selectedMethodsClasses asSet.
classes size == 1 ifTrue:[
self browseClassPackagesResourceDirectoryOf:(classes first).
].
"Created: / 25-11-2016 / 15:09:34 / cg"
!
methodListMenuBrowseClassesPackageDirectory
"add a buffer/open a browser showing the selected method classes' package folder"
|classes|
classes := self selectedMethodsClasses asSet.
classes size == 1 ifTrue:[
self browseClassesPackageDirectoryOf:(classes first).
].
"Created: / 25-11-2016 / 15:07:30 / cg"
!
methodListMenuCheckInClass
"check the selected methods class(es) into the source repository."
<resource: #obsolete> "use ...Using:manager variant"
|classes|
classes := self selectedMethodsClasses asOrderedCollection.
^ self
classMenuCheckIn:true
classes:classes
"Modified: / 18-11-2011 / 18:49:49 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 28-02-2012 / 09:12:37 / cg"
!
methodListMenuCheckInClassUsingManager: manager
"check the selected methods class(es) into the source repository."
|classes|
classes := self selectedMethodsClasses asOrderedCollection.
^ self
classMenuCheckIn:true
classes:classes
usingManager: manager.
"Created: / 18-11-2011 / 18:49:35 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Created: / 21-12-2011 / 20:18:09 / cg"
!
methodListMenuCheckInClassUsingManagerNamed: sourceCodeManagerClassName
"check the selected methods class(es) into the source repository."
^self methodListMenuCheckInClassUsingManager: (self sourceCodeManagerNamed:sourceCodeManagerClassName)
!
methodListMenuCopyList
"copy the method list to the clipBoard "
|text|
text := (self methodListApp methodList collect:[:mthd | mthd whoString]) asStringCollection asString.
self window setClipboardText:text
!
methodListMenuCopyListOfClasses
"copy the list of classes to the clipBoard "
|text|
text := (self methodListApp methodList collect:[:mthd | mthd mclass name] as:Set) asStringCollection asString.
self window setClipboardText:text
"Created: / 09-10-2006 / 12:41:05 / cg"
!
methodListMenuFileOutAllAs
"fileOut all methods from the list - standard format"
^ self methodListMenuFileOutAllAsWithFormat:nil
"Created: / 15.11.2001 / 17:53:09 / cg"
!
methodListMenuFileOutAllAsWithFormat:aFormatSymbolOrNil
"fileOut all methods from the list - file format as specified by the argument:
nil - standard format
#xml - XML standard format
#sif - SIF (smalltalk interchange file) standard format
#binary - ST/X binary format
"
|methods|
methods := self methodListApp methodList.
methods size == 0 ifTrue:[ ^ self ].
self
fileOutMethods:methods
format:aFormatSymbolOrNil
fileNameTemplate:'someMethods'
boxTitle:'FileOut all listed methods as:'
"Created: / 15.11.2001 / 17:53:22 / cg"
"Modified: / 15.11.2001 / 18:00:20 / cg"
!
methodListMenuFileOutAllSIFAs
"fileOut all methods from the list - sif format"
^ self methodListMenuFileOutAllAsWithFormat:#sif
"Created: / 15.11.2001 / 17:53:33 / cg"
!
methodListMenuFileOutAllXMLAs
"fileOut all methods from the list - xml format"
^ self methodListMenuFileOutAllAsWithFormat:#xml
"Created: / 15.11.2001 / 17:53:43 / cg"
!
methodListMenuSpawnBufferWithClassOrSubclassReferences
"add a buffer showing references to any of the selected classes or any of its subclasses"
self spawnClassOrSubclassReferencesBrowserFor:(self selectedMethodsClasses) in:#newBuffer
"Created: / 07-08-2006 / 12:13:16 / cg"
!
methodListMenuSpawnBufferWithClassReferences
"add a buffer showing references to any of the selected classes"
self spawnClassReferencesBrowserFor:(self selectedMethodsClasses) in:#newBuffer
"Created: / 07-08-2006 / 12:12:47 / cg"
!
methodListMenuSpawnBufferWithCommonSuperclass
"add a buffer/open a browser showing the selected methods' common superclass"
^ self spawnWithCommonSuperclassOf:(self selectedMethodsClasses) in:#newBuffer
"Created: / 28-02-2012 / 10:18:01 / cg"
!
methodListMenuSpawnClassOrSubclassReferences
"open a new browser showing references to the selected classes or any of its subclass"
self spawnClassOrSubclassReferencesBrowserFor:(self selectedMethodsClasses) in:#newBrowser
"Created: / 07-08-2006 / 12:15:26 / cg"
!
methodListMenuSpawnClassReferences
"open a new browser showing references to the selected classes "
self spawnClassReferencesBrowserFor:(self selectedMethodsClasses) in:#newBrowser
"Created: / 07-08-2006 / 12:14:45 / cg"
!
methodListMenuSpawnClasses
"add a buffer showing the selected methodss classes"
^ self methodListMenuSpawnClasses:#newBrowser
!
methodListMenuSpawnClasses:where
"add a buffer/open a browser showing the selected method's classes"
|classes|
classes := self selectedMethodsClasses asOrderedCollection.
^ self spawnClassBrowserFor:classes in:where select:false
"Modified: / 28-02-2012 / 09:09:44 / cg"
!
methodListMenuSpawnClassesBuffer
"add a buffer showing the selected method's classes"
^ self methodListMenuSpawnClasses:#newBuffer
!
methodListMenuSpawnCommonSuperclass
"add a buffer/open a browser showing the selected methods' common superclass"
^ self spawnWithCommonSuperclassOf:(self selectedMethodsClasses) in:#newBrowser
"Created: / 28-02-2012 / 10:15:54 / cg"
!
methodListMenuSpawnFullBrowser
"add a buffer showing the selected method's classes"
^ self methodListMenuSpawnFullBrowserIn:#newBrowser
!
methodListMenuSpawnFullBrowserBuffer
"add a buffer showing the selected method's classes"
^ self methodListMenuSpawnFullBrowserIn:#newBuffer
!
methodListMenuSpawnFullBrowserForClasses:classes methods:methods in:where
"add a buffer/open a browser showing the selected methods classes"
|brwsr anyMeta anyNonMeta|
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] as:Set) 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
"Modified: / 28-02-2012 / 16:27:44 / cg"
!
methodListMenuSpawnFullBrowserIn:where
"add a buffer/open a browser showing the selected methods classes"
|methods classes|
methods := self selectedMethodsValue.
classes := self selectedMethodsClasses asOrderedCollection.
self methodListMenuSpawnFullBrowserForClasses:classes methods:methods in:where
"Modified: / 28-02-2012 / 16:27:44 / cg"
! !
!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 := environment 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 := environment at:nm asSymbol ifAbsent:nil.
existing notNil ifTrue:[
existing isNameSpace ifTrue:[
self warn:'A NameSpace named ''%1'' already exists.' with:nm.
^ self
].
existing isBehavior ifFalse:[
self warn:'A class named ''%1'' already exists.' with:nm.
^ self
].
self warn:'A global named ''%1'' already 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)
"Modified: / 04-09-2013 / 17:45:21 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
nameSpaceMenuRemove
"remove the selected namespace(s)"
self selectedNamespacesValue do:[:nm |
|ns|
nm ~= BrowserList nameListEntryForALL ifTrue:[
ns := environment at:nm asSymbol.
environment 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 selectedClassesValue.
self
newBrowserOrBufferDependingOn:where
label:nil
forSpec:spec
setupWith:[:brwsr |
"/ setup for a constant list ...
"/ brwsr immediateUpdate value:true.
brwsr organizerMode value:(OrganizerCanvas organizerModeNamespace).
brwsr nameSpaceListGenerator value:namespaceList.
brwsr selectNamespaces:(singleSelection ifTrue:[namespaceList] ifFalse:[#()]).
"/ brwsr immediateUpdate value:false.
]
"Modified: / 28-02-2012 / 16:53:04 / cg"
! !
!NewSystemBrowser methodsFor:'menu actions-other'!
editModeInsert
self codeView editModeInsert
!
editModeInsertAndSelect
self codeView editModeInsertAndSelect
!
editModeOverwrite
self codeView editModeOverwrite
!
openSettingsDialog
^self openSettingsDialogAndSelect: nil
"Modified: / 06-07-2011 / 12:38:07 / cg"
"Modified: / 15-10-2011 / 12:01:20 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
openSettingsDialogAndSelect: settingsClassToSelectOrNil
|settingsList|
settingsList :=
OrderedCollection new
addAll:
#(
#('Editor' #'AbstractSettingsApplication::EditSettingsAppl' )
#('Editor/Code Editor 2' #'Tools::CodeView2SettingsAppl' )
#('Editor/Syntax Color' #'AbstractSettingsApplication::SyntaxColorSettingsAppl' )
#('Editor/Code Format' #'AbstractSettingsApplication::SourceCodeFormatSettingsAppl' )
#('System Browser' #'AbstractSettingsApplication::SystemBrowserSettingsAppl' )
#('Compiler' #'AbstractSettingsApplication::GeneralCompilerSettingsAppl' )
#('Compiler/ByteCode' #'AbstractSettingsApplication::ByteCodeCompilerSettingsAppl' )
#('Source Code Management' #'AbstractSettingsApplication::SourceCodeManagementSettingsAppl')
);
add:
"/ see initializeSettingsList for how the following is expanded...
{'Source Code Management/[% managerTypeName]' .
[ AbstractSourceCodeManager availableManagers
collect:[:each | each settingsApplicationClass] ] .
'[% defaultIcon]' };
yourself.
SettingsDialog
openWithList:(AbstractLauncherApplication expandSettingsList: settingsList)
label:(resources string:'System Browser Settings')
initialSettingsClass:settingsClassToSelectOrNil
"Created: / 15-10-2011 / 12:01:00 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 14-02-2012 / 15:35:18 / cg"
!
openSettingsDialogAndSelectSourceCodeManagement
self openSettingsDialogAndSelect: AbstractSettingsApplication::SourceCodeManagementSettingsAppl
"Modified: / 06-07-2011 / 12:38:07 / cg"
"Created: / 15-10-2011 / 12:02:26 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
toggleLearnMode
self codeView toggleLearnMode
! !
!NewSystemBrowser methodsFor:'menu actions-project'!
generatePatchSetForClasses:classes
"ask for two tags, generate a patchSet to bring a baseSystem (tag1) to the
level of the tag2 version"
|baseVersionTag patchVersionTag knownTags|
((classes size <= 10)
or:[ |answer|
answer := Dialog
confirmWithCancel:'Fetch known tags to choose from all classes?\(this may take some time)' withCRs
default:false.
answer isNil ifTrue:[^ self].
answer == true
]
) ifTrue:[
"/ fetch from all classes
knownTags := self allKnownTagsInClasses:classes.
] ifFalse:[
"/ only fetch from ProjectDefinitionClasses
knownTags := self allKnownTagsInClasses:(classes select:[:cls | cls isProjectDefinition]).
].
baseVersionTag := Dialog request:'Tag of Base Version:' initialAnswer:LastBaseVersionTag list:knownTags.
baseVersionTag isEmptyOrNil ifTrue:[^ self].
patchVersionTag := Dialog request:'Tag of Patch Version:' initialAnswer:LastTag list:knownTags.
patchVersionTag isEmptyOrNil ifTrue:[^ self].
LastBaseVersionTag := baseVersionTag.
LastTag := patchVersionTag.
self generatePatchSetForClasses:classes from:baseVersionTag to:patchVersionTag.
"Created: / 08-02-2011 / 09:31:22 / cg"
!
generatePatchSetForClasses:classes from:baseVersionTag to:patchVersionTag
"given two tags, generate a patchSet to bring a baseSystem (tag1) to the
level of the tag2 version"
|fullPatchSet answer fileName buttonLabels buttonValues|
fullPatchSet := ChangeSet new.
classes do:[:eachClass |
|tagRevisionMapping baseVersion patchVersion baseVersionSource patchVersionSource
baseChangeSet patchChangeSet diffSet thisPatchSet|
tagRevisionMapping := eachClass sourceCodeManager knownTagsAndRevisionsFor:eachClass.
(tagRevisionMapping includesKey:patchVersionTag) ifTrue:[
(tagRevisionMapping includesKey:baseVersionTag) ifTrue:[
"/ versions?
baseVersion := tagRevisionMapping at:baseVersionTag.
patchVersion := tagRevisionMapping at:patchVersionTag.
baseVersion ~= patchVersion ifTrue:[
"/ change-sets...
baseVersionSource := self getClassSourceFor:eachClass revision:baseVersionTag.
patchVersionSource := self getClassSourceFor:eachClass revision:patchVersionTag.
(baseVersionSource notNil and:[patchVersionSource notNil]) ifTrue:[
baseChangeSet := ChangeSet fromStream:baseVersionSource readStream.
patchChangeSet := ChangeSet fromStream:patchVersionSource readStream.
].
diffSet := baseChangeSet diffSetsAgainst:patchChangeSet.
thisPatchSet := ChangeSet fromDiffSet:diffSet.
fullPatchSet addAll:thisPatchSet.
].
]
]
].
fullPatchSet size == 0 ifTrue:[
Dialog information:'Patch-Set is empty; nothing to generate.'.
^ self.
].
Expecco::KeyFileGenerator isNil ifTrue:[
buttonLabels := #('Cancel' 'Browse' 'Save as Patch...' ).
buttonValues := #(nil browse saveAsPatchFile ).
] ifFalse:[
buttonLabels := #('Cancel' 'Browse' 'Save as Signed Patch...' 'Save as Patch...' ).
buttonValues := #(nil browse saveAsSignedPatchFile saveAsPatchFile ).
].
answer := OptionBox
request:('PatchSet contains %1 individual changes.\\Proceed how?' bindWith:fullPatchSet size) withCRs
label:'Patch-Set Generated'
buttonLabels:(resources array:buttonLabels)
values:buttonValues
default:#saveAsPatchFile.
(answer isNil) ifTrue:[ ^ self ].
answer == #browse ifTrue:[
(UserPreferences current changeSetBrowserClass) openOn:fullPatchSet.
^ self.
].
fileName := Dialog
requestFileNameForSave:'Name of PatchFile'
default:('%1_to_%2.patch' bindWith:baseVersionTag with:patchVersionTag).
answer == #saveAsPatchFile ifTrue:[
fullPatchSet saveToFile:fileName.
^ self.
].
answer == #saveAsSignedPatchFile ifTrue:[
fullPatchSet saveSignedToFile:fileName.
^ self.
].
"Created: / 08-02-2011 / 09:44:36 / cg"
"Modified: / 01-07-2011 / 16:34:21 / cg"
!
generateProjectDefinitionsIn:classes
"update all definitions (contents + version stuff)"
self
generateUndoableChange:'Generate Project Definitions'
overClasses:classes
via:[:generator :eachClass |
eachClass theNonMetaclass
updateMethodsCodeUsingCompiler:generator
ignoreOldDefinition:false
"/ Class packageQuerySignal
"/ answer:eachClass package
"/ do:[
"/ eachClass theNonMetaclass
"/ forEachMethodsCodeToCompileDo:
"/ [:code :category |
"/ generator
"/ compile:code
"/ forClass:eachClass theMetaclass
"/ inCategory:category.
"/ ]
"/ ignoreOldDefinition:false
"/ ].
].
"Created: / 10-08-2006 / 16:33:07 / cg"
"Modified: / 14-09-2006 / 10:53:13 / cg"
!
mailClasses:classes subject:subject
"fileOut classes (chunk format) and eMail to someone"
|tempFile stream|
[
tempFile := Filename newTemporary.
[
stream := tempFile writeStream.
classes do:[:cls |
cls theNonMetaclass fileOutOn:stream.
].
] ensure:[
stream notNil ifTrue:[ stream close ].
].
self sendFileViaEmail:tempFile subject:subject.
] ensure:[
tempFile notNil ifTrue:[ tempFile delete ]
].
"Created: / 20-09-2007 / 15:01:42 / cg"
!
openRepositoryConsistencyDialogForObsoleteContainers:obsoleteContainers classesWithRepositoryMismatches:classesWithRepositoryMismatches classesWithMissingContainer:classesWithMissingContainer classesWhichHaveBeenModified:classesWhichHaveBeenModified classesWithNewerVersionInRepository:classesWithNewerVersionInRepository needExtensionsContainer:needExtensionsContainer hasExtensionContainer:hasExtensionContainer
|bindings listOfObsoleteContainers listOfObsoleteContainerAssocs menuPerformer|
needExtensionsContainer ~~ hasExtensionContainer ifTrue:[
self halt
].
listOfObsoleteContainers := OrderedCollection new.
listOfObsoleteContainerAssocs := OrderedCollection new.
obsoleteContainers do:[:eachAssoc |
eachAssoc value do:[:eachObsolete |
listOfObsoleteContainerAssocs add:eachAssoc key -> eachObsolete.
listOfObsoleteContainers add:eachObsolete , ' (in ' , eachAssoc key , ')'
]
].
bindings := IdentityDictionary new.
bindings at:#listOfObsoleteContainers put:listOfObsoleteContainers.
bindings at:#listOfClassesWithRepositoryMismatches
put:classesWithRepositoryMismatches.
bindings at:#listOfClassesWithMissingContainer
put:classesWithMissingContainer.
bindings at:#listOfClassesWhichHaveBeenModified
put:classesWhichHaveBeenModified.
bindings at:#listOfClassesWithNewerVersionInRepository
put:classesWithNewerVersionInRepository.
bindings at:#obsoleteContainersBoxVisible
put:listOfObsoleteContainers size > 0.
bindings at:#classesWithInvalidInfoBoxVisible
put:classesWithRepositoryMismatches size > 0.
bindings at:#classesWithoutContainerBoxVisible
put:classesWithMissingContainer size > 0.
bindings at:#classesWhichHaveBeenModifiedBoxVisible
put:classesWhichHaveBeenModified size > 0.
bindings at:#classesWithNewerVersionInRepositoryBoxVisible
put:classesWithNewerVersionInRepository size > 0.
bindings at:#selectedClassesWithMissingContainer put:ValueHolder new.
bindings at:#selectedClassesWithRepositoryMismatches put:ValueHolder new.
bindings at:#selectedObsoleteContainers put:ValueHolder new.
bindings at:#selectedClassesWhichHaveBeenModified put:ValueHolder new.
bindings at:#selectedClassesWithNewerVersionInRepository
put:ValueHolder new.
menuPerformer := Plug new.
menuPerformer respondTo:#classMenuFileOutAs
with:[
|classes|
classes := (bindings at:#selectedClassesWithMissingContainer) value
collect:[:idx | classesWithMissingContainer at:idx].
classes do:[:cls |
self
fileOutClass:cls
askForFile:true
withCancelAll:false
format:nil
sourceMode:nil
]
].
menuPerformer respondTo:#classMenuCheckIn
with:[
|classes|
classes := (bindings at:#selectedClassesWithMissingContainer) value
collect:[:idx | classesWithMissingContainer at:idx].
SourceCodeManagerUtilities default
checkinClasses:classes
withInfo:nil
withCheck:true
].
menuPerformer respondTo:#classMenuSpawnClass
with:[
|classes|
classes := (bindings at:#selectedClassesWithMissingContainer) value
collect:[:idx | classesWithMissingContainer at:idx].
self spawnClassBrowserFor:classes in:#newBrowser
].
menuPerformer respondTo:#classMenuRemove
with:[
|classes classesToRemove|
classes := (bindings at:#selectedClassesWithMissingContainer) value
collect:[:idx | classesWithMissingContainer at:idx].
classes do:[:cls |
classesToRemove := OrderedCollection new.
self
addClassesToRemoveForClass:cls
to:classesToRemove
removingSubclasses:true
withCancel:nil.
self removeClasses:classesToRemove pullUpSubclasses:false
]
].
menuPerformer respondTo:#classMenu2SpawnClass
with:[
|classes|
classes := (bindings at:#selectedClassesWithNewerVersionInRepository)
value collect:[:idx | classesWithNewerVersionInRepository at:idx].
self spawnClassBrowserFor:classes in:#newBrowser
].
menuPerformer respondTo:#classMenu2CheckOutNewest
with:[
|classes|
classes := (bindings at:#selectedClassesWithNewerVersionInRepository)
value collect:[:idx | classesWithNewerVersionInRepository at:idx].
self checkOutClasses:classes askForRevision:false
].
menuPerformer respondTo:#classMenu2CompareAgainstNewestInRepository
with:[
|classes|
classes := (bindings at:#selectedClassesWithNewerVersionInRepository)
value collect:[:idx | classesWithNewerVersionInRepository at:idx].
classes do:[:cls |
self compareAgainstNewestInRepository:cls
]
].
menuPerformer respondTo:#classMenu3FileOutAs
with:[
|classes|
classes := (bindings at:#selectedClassesWhichHaveBeenModified) value
collect:[:idx | classesWhichHaveBeenModified at:idx].
classes do:[:cls |
self
fileOutClass:cls
askForFile:true
withCancelAll:false
format:nil
sourceMode:nil
]
].
menuPerformer respondTo:#classMenu3CheckIn
with:[
|classes|
classes := (bindings at:#selectedClassesWhichHaveBeenModified) value
collect:[:idx | classesWhichHaveBeenModified at:idx].
SourceCodeManagerUtilities default
checkinClasses:classes
withInfo:nil
withCheck:true
].
menuPerformer respondTo:#classMenu3SpawnClass
with:[
|classes|
classes := (bindings at:#selectedClassesWhichHaveBeenModified) value
collect:[:idx | classesWhichHaveBeenModified at:idx].
self spawnClassBrowserFor:classes in:#newBrowser
].
menuPerformer respondTo:#classMenu3CompareAgainstNewestInRepository
with:[
|classes|
classes := (bindings at:#selectedClassesWhichHaveBeenModified) value
collect:[:idx | classesWhichHaveBeenModified at:idx].
classes do:[:cls |
self compareAgainstNewestInRepository:cls
]
].
menuPerformer respondTo:#classMenu4CheckOut
with:[
|containers|
containers := (bindings at:#selectedObsoleteContainers) value.
containers do:[:container |
|def packageID moduleDir packageDir fileName|
def := listOfObsoleteContainerAssocs at:container.
packageID := def key.
moduleDir := packageID upTo:$:.
packageDir := packageID copyFrom:moduleDir size + 2.
fileName := def value.
"/ check out that module ...
SourceCodeManager
checkoutModule:moduleDir
directory:packageDir
andDo:[:tempDir |
"/ (Dialog confirm:'FileIn ' , fileName , ' ?') ifTrue:[
Smalltalk fileIn:(tempDir asFilename construct:fileName)
"/ ]
]
]
].
bindings at:#classesWithMissingContainerPopupMenu
put:self class classesWithMissingContainerPopupMenu.
bindings at:#classesWithNewerVersionInRepositoryPopupMenu
put:self class classesWithNewerVersionInRepositoryPopupMenu.
bindings at:#classesWhichHaveBeenModifiedPopupMenu
put:self class classesWhichHaveBeenModifiedPopupMenu.
bindings at:#obsoleteContainersPopupMenu
put:self class obsoleteContainersPopupMenu.
bindings at:#dialogMenuPerformer put:menuPerformer.
SimpleDialog new
openSpec:(self class repositoryConsistencyDialogSpec)
withBindings:bindings
"Modified: / 23-08-2006 / 14:08:28 / cg"
"Modified (format): / 01-07-2011 / 17:16:31 / cg"
!
projectDefinitionClassesForSelectedProjects
|projectClasses|
projectClasses := OrderedCollection new.
self selectedProjectsDo:[:packageID |
|defClass answer|
defClass := ProjectDefinition definitionClassForPackage:packageID createIfAbsent:false.
defClass isNil ifTrue:[
answer := Dialog
confirm:(resources
stringWithCRs:'Missing ProjectDefinition for %1\\Create ?'
with:packageID allBold)
withCancel:(self selectedProjects value size > 1)
default: true.
answer isNil ifTrue:[^ self ].
answer == true ifTrue:[
defClass := self projectDefinitionDialogFor:packageID.
].
].
defClass notNil ifTrue:[
projectClasses add:defClass.
]
].
^ projectClasses
"Created: / 15-09-2006 / 16:46:27 / cg"
!
projectDefinitionDialogFor:aProjectIDOrNil
|boxLabel box initial newProjectID currentProject label nameField typeField
packageIDHolder projectTypeHolder
projectDefinitionClass y defaultProjectType setupDefaultType|
setupDefaultType :=
[:package |
|classesInPackage|
classesInPackage := environment allClassesInPackage:package.
classesInPackage isEmpty ifTrue:[
defaultProjectType := LastNewProjectType ? ProjectDefinition guiApplicationType
] ifFalse:[
(classesInPackage contains:[:cls | cls isBrowserStartable]) ifTrue:[
(classesInPackage contains:[:cls | cls isVisualStartable])
ifTrue:[ defaultProjectType := ProjectDefinition guiApplicationType]
ifFalse:[ defaultProjectType := ProjectDefinition nonGuiApplicationType]
] ifFalse:[
defaultProjectType := ProjectDefinition libraryType
].
]
].
aProjectIDOrNil notNil ifTrue:[
initial := aProjectIDOrNil.
boxLabel := 'Create ProjectDefinition Class'.
setupDefaultType value:aProjectIDOrNil.
] ifFalse:[
initial := 'module:directory'.
currentProject := self theSingleSelectedProject.
(currentProject notNil and:[ currentProject ~= PackageId noProjectID ]) ifTrue:[
initial := currentProject.
(initial includes:$:) ifTrue:[
(ProjectDefinition definitionClassForPackage:initial) notNil ifTrue:[
initial := initial , '/','newProject' allBold.
].
] ifFalse:[
initial := initial , ':module/','newProject' allBold.
].
] ifFalse:[
initial := (UserPreferences current usersModuleName "OperatingSystem getLoginName") , ':module/','newProject' allBold.
].
defaultProjectType := ProjectDefinition defaultProjectType.
setupDefaultType value:initial.
boxLabel := 'Create New Project'.
].
packageIDHolder := ValueHolder with:initial.
projectTypeHolder := defaultProjectType asValue.
box := DialogBox new.
box label:(resources string:boxLabel).
y := box yPosition.
box addVerticalSpace.
label := box addTextLabel:(resources string:'Package-ID (module:directory):') adjust:#right.
label width:0.3; left:0.0; leftInset:3.
box yPosition:y.
nameField := box addInputFieldOn:packageIDHolder tabable:true.
nameField width:0.7; left:0.3; rightInset:3.
aProjectIDOrNil notNil ifTrue:[
nameField readOnly:true.
] ifFalse:[
nameField acceptOnLeave:true.
nameField immediateAccept:true.
nameField entryCompletionBlock:(DoWhatIMeanSupport packageNameEntryCompletionBlock).
].
(initial includesString:'module/') ifTrue:[
nameField selectFrom:(initial findString:'module').
] ifFalse:[
(initial includesString:'newProject') ifTrue:[
nameField selectFrom:(initial findString:'newProject').
].
].
y := box yPosition.
box addVerticalSpace.
label := box addTextLabel:(resources string:'Type:') adjust:#right.
label width:0.3; left:0.0; leftInset:3.
box yPosition:y.
typeField := box addComboListOn:projectTypeHolder tabable:true.
typeField width:0.7; left:0.3; rightInset:3.
typeField list:(ProjectDefinition projectTypes).
box addVerticalSpace.
box addAbortButton; addOkButtonLabelled:(resources string:'Create').
box minExtent:400@(box height).
box open.
box accepted ifFalse:[
^ nil
].
LastNewProjectType := projectTypeHolder value.
self withWaitCursorDo:[
aProjectIDOrNil notNil ifTrue:[
newProjectID := aProjectIDOrNil.
] ifFalse:[
newProjectID := packageIDHolder value.
newProjectID notEmptyOrNil ifTrue:[
newProjectID := newProjectID string.
"/ self immediateUpdate value:true.
self projectListApp addAdditionalProject:newProjectID.
"/ self immediateUpdate value:false.
self selectProject:newProjectID.
self selectedClasses value:#().
].
].
projectDefinitionClass := ProjectDefinition
definitionClassForPackage:newProjectID
projectType: (projectTypeHolder value)
createIfAbsent:true.
].
^ projectDefinitionClass
"Modified: / 20-07-2012 / 19:42:48 / cg"
!
projectMenuBitmapFiles
self projectMenuBitmapFilesUsingManager:SourceCodeManager
!
projectMenuBitmapFilesUsingManager:aManager
self information:'Sorry - this functionality is not yet implemented'
!
projectMenuBrowsePackageDirectory
"open a filebrowser in the package directory"
UserPreferences fileBrowserClass
openIn:(self theSingleSelectedProject asPackageId packageDirectory)
!
projectMenuBuild
self projectMenuBuildExeOnly:false
"Modified: / 21-01-2012 / 13:53:52 / cg"
!
projectMenuBuildExeOnly
self projectMenuBuildExeOnly:true
"Created: / 21-01-2012 / 13:54:00 / cg"
!
projectMenuBuildExeOnly:exeOnly
|projectToBuild projectDefinitionClasses projectDefinition projectBuilder buildDir|
projectToBuild := self theSingleSelectedProject.
projectDefinitionClasses := self projectDefinitionClassesForSelectedProjects.
projectDefinition := projectDefinitionClasses firstIfEmpty:nil.
projectDefinition isNil ifTrue:[
^ self
].
Tools::ProjectBuilderAssistantApplication new
projectType:projectDefinition projectType.
projectBuilder := Tools::ProjectBuilder new.
projectBuilder makeExeOnly:exeOnly; package:projectToBuild.
Transcript isView ifTrue:[
Transcript topView raise.
].
Transcript showCR:'*******************'.
Transcript showCR:('building in %1...' bindWith:projectBuilder buildDirectory pathName).
"/ build
projectBuilder buildWithColorizedOutputTo:Transcript.
buildDir := projectToBuild asPackageId pathRelativeToTopDirectory:projectBuilder buildDirectory.
OperatingSystem isMSWINDOWSlike ifTrue:[
self activityNotification:'Showing result in explorer.'.
buildDir asFilename openExplorer
] ifFalse:[
self activityNotification:'Showing result in filebrowser.'.
FileBrowserV2 openOnDirectory:buildDir
].
Transcript showCR:('buil finished.').
"Created: / 21-01-2012 / 13:53:34 / cg"
!
projectMenuBuildWithApplicationPackager
|package dfnClass|
(package := self theSingleSelectedProject) isNil ifTrue:[
Dialog warn:'Please select exactly one package.'.
^ self.
].
dfnClass := ProjectDefinition definitionClassForPackage:package.
dfnClass notNil ifTrue:[
Tools::ProjectBuilderAssistantApplication openOn:dfnClass.
] ifFalse:[
Tools::ProjectBuilderAssistantApplication openOnPackage:package.
].
"Created: / 20-07-2012 / 12:32:34 / cg"
!
projectMenuCheckInAll
<resource: #obsolete> "use ...Using:manager variant"
self selectedProjectsDo:[:packageToCheckIn |
self
projectMenuCheckInProject:packageToCheckIn
classes:true
extensions:true
buildSupport:true
usingManager: nil.
]
"Modified: / 09-08-2006 / 18:57:28 / fm"
"Modified: / 13-10-2011 / 11:06:50 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified (comment): / 15-10-2011 / 20:22:12 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 25-07-2012 / 22:55:31 / cg"
!
projectMenuCheckInAllUsingManager: manager
self selectedProjectsDo:[:packageToCheckIn |
self
projectMenuCheckInProject:packageToCheckIn
classes:true
extensions:true
buildSupport:true
usingManager: manager
]
"Modified: / 09-08-2006 / 18:57:28 / fm"
"Created: / 13-10-2011 / 10:37:07 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Created: / 21-12-2011 / 20:18:25 / cg"
!
projectMenuCheckInAllUsingManagerNamed: sourceCodeManagerClassName
^self projectMenuCheckInAllUsingManager: (self sourceCodeManagerNamed:sourceCodeManagerClassName)
"Created: / 23-12-2011 / 19:24:41 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 24-07-2012 / 18:00:30 / cg"
!
projectMenuCheckInBuildSupportFiles
<resource: #obsolete> "use ...Using:manager variant"
self selectedProjectsDo:[:packageToCheckIn |
self projectMenuCheckInBuildSupportFilesForProject:packageToCheckIn
]
"Created: / 09-08-2006 / 19:04:52 / fm"
"Modified: / 15-10-2011 / 22:31:27 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
projectMenuCheckInBuildSupportFilesForProject:packageID
<resource: #obsolete> "use ...Using:manager variant"
|defClass mgr|
defClass := ProjectDefinition definitionClassForPackage:packageID createIfAbsent:false.
defClass isNil ifTrue:[
defClass := self projectDefinitionDialogFor:packageID.
defClass isNil ifTrue:[ ^ self ].
defClass compileDescriptionMethods.
].
mgr := SourceCodeManagerUtilities default sourceCodeManagerFor:defClass.
mgr isNil ifTrue:[
self warn:'No sourceCode manager - cannot checkin.'.
^ self.
].
self projectMenuCheckInBuildSupportFilesForProject:packageID definition:defClass usingManager:mgr
"Created: / 09-08-2006 / 18:59:42 / fm"
"Modified: / 16-08-2006 / 18:38:49 / User"
"Modified: / 15-10-2011 / 22:31:57 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 22-12-2011 / 14:03:36 / cg"
!
projectMenuCheckInBuildSupportFilesForProject:packageID definition:defClass usingManager:mgr
(mgr ? (AbstractSourceCodeManager managerForPackage:packageID)) utilities
checkinPackage:packageID classes:false extensions:false buildSupport:true askForMethodsInOtherPackages:false.
!
projectMenuCheckInBuildSupportFilesForProject:packageID usingManager: manager
|defClass|
defClass := ProjectDefinition definitionClassForPackage:packageID createIfAbsent:false.
defClass isNil ifTrue:[
defClass := self projectDefinitionDialogFor:packageID.
defClass isNil ifTrue:[ ^ self ].
defClass compileDescriptionMethods.
].
self projectMenuCheckInBuildSupportFilesForProject:packageID definition:defClass usingManager:manager
"Created: / 09-08-2006 / 18:59:42 / fm"
"Modified: / 16-08-2006 / 18:38:49 / User"
"Modified: / 06-09-2011 / 08:00:43 / cg"
"Created: / 15-10-2011 / 22:32:19 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Created: / 21-12-2011 / 20:25:21 / cg"
"Modified: / 24-01-2012 / 13:03:05 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
projectMenuCheckInBuildSupportFilesUsingManager: manager
self selectedProjectsDo:[:packageToCheckIn |
self projectMenuCheckInBuildSupportFilesForProject:packageToCheckIn usingManager: manager
]
"Created: / 09-08-2006 / 19:04:52 / fm"
"Created: / 15-10-2011 / 22:31:41 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Created: / 21-12-2011 / 20:18:34 / cg"
"Modified: / 24-01-2012 / 13:02:49 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
projectMenuCheckInBuildSupportFilesUsingManagerNamed: sourceCodeManagerClassName
^self projectMenuCheckInBuildSupportFilesUsingManager: (self sourceCodeManagerNamed:sourceCodeManagerClassName)
"Created: / 24-01-2012 / 13:02:36 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified (format): / 24-07-2012 / 18:00:46 / cg"
!
projectMenuCheckInClasses
<resource: #obsolete> "use ...Using:manager variant"
self selectedProjectsDo:[:packageToCheckIn |
self
projectMenuCheckInProject:packageToCheckIn
classes:true
extensions:false
buildSupport:false
]
"Modified: / 15-10-2011 / 20:22:44 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
projectMenuCheckInClassesUsingManager: manager
self selectedProjectsDo:[:packageToCheckIn |
self
projectMenuCheckInProject:packageToCheckIn
classes:true
extensions:false
buildSupport:false
usingManager: manager
]
"Created: / 15-10-2011 / 20:21:23 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Created: / 21-12-2011 / 20:18:42 / cg"
!
projectMenuCheckInClassesUsingManagerNamed: sourceCodeManagerClassName
self projectMenuCheckInClassesUsingManager: (self sourceCodeManagerNamed:sourceCodeManagerClassName)
"Created: / 23-12-2011 / 19:29:55 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 24-07-2012 / 18:02:10 / cg"
!
projectMenuCheckInExtensions
<resource: #obsolete> "use ...Using:manager variant"
self selectedProjectsDo:[:packageToCheckIn |
self
projectMenuCheckInProject:packageToCheckIn
classes:false
extensions:true
buildSupport:false
]
"Modified: / 15-10-2011 / 20:22:30 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
projectMenuCheckInExtensionsUsingManager: manager
self selectedProjectsDo:[:packageToCheckIn |
self
projectMenuCheckInProject:packageToCheckIn
classes:false
extensions:true
buildSupport:false
usingManager: manager
]
"Created: / 15-10-2011 / 20:06:15 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Created: / 21-12-2011 / 20:18:50 / cg"
!
projectMenuCheckInExtensionsUsingManagerNamed: sourceCodeManagerClassName
self projectMenuCheckInExtensionsUsingManager: (self sourceCodeManagerNamed:sourceCodeManagerClassName)
"Created: / 23-12-2011 / 19:30:19 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 24-07-2012 / 18:02:06 / cg"
!
projectMenuCheckInProject:packageToCheckIn classes:doClasses extensions:doExtensions buildSupport:doBuild
<resource: #obsolete>
^ self
projectMenuCheckInProject:packageToCheckIn
classes:doClasses
extensions:doExtensions
buildSupport:doBuild
askForMethodsInOtherPackages:true
"Modified: / 21-08-2006 / 19:43:22 / cg"
"Modified: / 13-10-2011 / 11:07:08 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
projectMenuCheckInProject:packageToCheckIn classes:doClasses extensions:doExtensions buildSupport:doBuild askForMethodsInOtherPackages:askForMethodsInOtherPackages
<resource: #obsolete>
|classes classesToCheckIn methodsToCheckIn
methodsInOtherPackages looseMethods otherPackages
msg classesInChangeSet checkinInfo originalCheckinInfo classesToTag|
classes := Smalltalk allClasses.
classesToCheckIn := IdentitySet new.
methodsToCheckIn := IdentitySet new.
methodsInOtherPackages := IdentitySet new.
looseMethods := IdentitySet new.
"/ classes ...
classes do:[:aClass | |owner classPackage|
(owner := aClass owningClass) notNil ifTrue:[
classPackage := aClass topOwningClass package
] ifFalse:[
classPackage := aClass package
].
(classPackage = packageToCheckIn) ifTrue:[
classesToCheckIn add:aClass.
].
].
"/ cg: O(n^2) algorithm
"/ classesInChangeSet := classesToCheckIn select:[:cls | cls hasUnsavedChanges].
"/ replaced by: O(n) algorithm
classesInChangeSet := ChangeSet current selectClassesForWhichIncludesChangeForClassOrMetaclassOrPrivateClassFrom:classesToCheckIn.
"/ individual methods ...
classes do:[:aClass |
aClass isMeta ifFalse:[
"/ ... whose class is not in the chechIn-set
(classesToCheckIn includes:aClass) ifFalse:[
aClass instAndClassSelectorsAndMethodsDo:[:sel :mthd |
"/ methods in this project ...
(mthd package = packageToCheckIn) ifTrue:[
methodsToCheckIn add:mthd
]
]
].
].
].
doExtensions ifTrue:[
methodsToCheckIn notEmpty ifTrue:[
doClasses ifTrue:[
msg := '%1 classes (%4 changed) '.
] ifFalse:[
msg := ''.
].
doExtensions ifTrue:[
doClasses ifTrue:[
msg := msg , 'and '.
].
msg := msg , '%2 extensions '.
].
msg := msg , 'of project "%3"'.
checkinInfo := SourceCodeManagerUtilities default
getCheckinInfoFor:(msg
bindWith:classesToCheckIn size
with:methodsToCheckIn size
with:packageToCheckIn allBold
with:classesInChangeSet size)
initialAnswer:nil
withQuickOption:(classesToCheckIn size > 0).
checkinInfo isNil ifTrue:[
^ self.
].
(SourceCodeManagerUtilities default
checkinExtensionMethods:methodsToCheckIn
forPackage:packageToCheckIn
withInfo:checkinInfo)
ifFalse:[
self warn:'Could not check in extensions for project %1' with:packageToCheckIn.
^ self.
]
] ifFalse:[
"/ there may have been extension-methods previously - if so, remove them
(SourceCodeManager
checkForExistingContainer:'extensions.st' inPackage:packageToCheckIn)
ifTrue:[
"/ self halt.
(SourceCodeManagerUtilities default
checkinExtensionMethods:#()
forPackage:packageToCheckIn
withInfo:'No extensions any more')
ifFalse:[
self warn:'Could not check in extensions for project %1' with:packageToCheckIn.
^ self.
]
]
].
].
checkinInfo isNil ifTrue:[
checkinInfo := SourceCodeManagerUtilities default
getCheckinInfoFor:('%1 classes (%4 changed) and %2 extensions for project "%3"'
bindWith:classesToCheckIn size
with:methodsToCheckIn size
with:packageToCheckIn allBold
with:classesInChangeSet size)
initialAnswer:nil
withQuickOption:(classesToCheckIn size > 0).
checkinInfo isNil ifTrue:[
^ self.
].
].
checkinInfo quickCheckIn ifTrue:[
(checkinInfo isStable or:[checkinInfo tagIt]) ifTrue:[
classesToTag := classesToCheckIn.
originalCheckinInfo := checkinInfo.
checkinInfo := checkinInfo copy.
checkinInfo isStable:false.
checkinInfo tag:nil.
].
classesToCheckIn := classesInChangeSet.
].
"/ check if any of the classes contains methods for other packages ...
classesToCheckIn do:[:eachClass |
eachClass instAndClassMethodsDo:[:eachMethod |
|mPgk|
mPgk := eachMethod package.
(mPgk = packageToCheckIn) ifFalse:[
mPgk == PackageId noProjectID ifTrue:[
looseMethods add:eachMethod
] ifFalse:[
methodsInOtherPackages add:eachMethod
]
]
].
].
askForMethodsInOtherPackages ifTrue:[
methodsInOtherPackages notEmpty ifTrue:[
otherPackages := Set new.
methodsInOtherPackages do:[:eachMethod | otherPackages add:eachMethod package].
methodsInOtherPackages size == 1 ifTrue:[
msg := 'The ''%4'' method in ''%5'' is contained in the ''%2'' package.'.
msg := msg , '\\This method will remain in its package.'.
] ifFalse:[
otherPackages size == 1 ifTrue:[
msg := 'The %1 methods from the %2 package will remain in its package.'
] ifFalse:[
msg := 'The %1 methods from %3 other packages will remain in their packages.'
].
msg := msg , '\\Hint: if these are meant to belong to this package,'.
msg := msg , '\move them first, then repeat the checkin operation.'.
].
msg := msg withCRs.
msg := msg bindWith:methodsInOtherPackages size
with:otherPackages first allBold
with:otherPackages size
with:methodsInOtherPackages first selector allBold
with:methodsInOtherPackages first mclass name allBold.
(Dialog confirm:msg noLabel:(resources string:'Cancel')) ifFalse:[^ self].
].
].
doClasses ifTrue:[
classesToCheckIn notEmpty ifTrue:[
looseMethods notEmpty ifTrue:[
looseMethods size == 1 ifTrue:[
msg := 'The ''%2'' method in ''%3'' is unassigned (loose).'.
msg := msg , '\\If you proceed, this method will be moved to the ''%4'' package'.
msg := msg , '\\Hint: if this is meant to be an extension of another package,'.
msg := msg , '\cancel and move it to the appropriate package first.'.
] ifFalse:[
msg := 'There are %1 unassigned (loose) methods in classes from this project.'.
msg := msg , '\\If you proceed, those will be moved to the ''%4'' package ?'.
msg := msg , '\\Hint: if these are meant to be extensions of another package,'.
msg := msg , '\cancel and move them to the appropriate package first.'.
].
doClasses ifTrue:[
msg := msg , '\\If you answer with "No" here, you will be asked for each class individually.'.
].
msg := msg withCRs.
msg := msg bindWith:looseMethods size
with:(looseMethods isEmpty ifTrue:[''] ifFalse:[looseMethods first selector allBold])
with:(looseMethods isEmpty ifTrue:[''] ifFalse:[looseMethods first mclass name allBold])
with:packageToCheckIn allBold.
(Dialog confirm:msg noLabel:(resources string:'Cancel')) ifFalse:[^ self].
looseMethods do:[:mthd |
mthd package:packageToCheckIn
].
].
SourceCodeManagerUtilities default checkinClasses:classesToCheckIn withInfo:checkinInfo.
].
originalCheckinInfo notNil ifTrue:[
originalCheckinInfo isStable ifTrue:[
classesToTag do:[:eachClass |
SourceCodeManagerUtilities default tagClass:eachClass as:#stable
].
].
originalCheckinInfo tagIt ifTrue:[
classesToTag do:[:eachClass |
SourceCodeManagerUtilities default tagClass:eachClass as:(originalCheckinInfo tag)
].
].
].
].
doBuild ifTrue:[
self projectMenuCheckInBuildSupportFilesForProject:packageToCheckIn
].
self normalLabel.
"Modified: / 13-10-2011 / 11:07:39 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 04-09-2012 / 14:05:59 / cg"
!
projectMenuCheckInProject:packageToCheckIn classes:doClasses extensions:doExtensions buildSupport:doBuild askForMethodsInOtherPackages:askForMethodsInOtherPackages usingManager: manager
|utilities|
manager isNil ifTrue:[
utilities := (AbstractSourceCodeManager managerForPackage:packageToCheckIn) utilities.
] ifFalse:[
utilities := manager utilities.
].
AbortAllOperationRequest catch:[
self withActivityNotificationsRedirectedToInfoLabelDo:[
self withWaitCursorDo:[
utilities
checkinPackage:packageToCheckIn
classes:doClasses
extensions:doExtensions
buildSupport:doBuild
askForMethodsInOtherPackages:askForMethodsInOtherPackages
]
]
]
"Created: / 13-10-2011 / 10:40:02 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Created: / 21-12-2011 / 20:25:11 / cg"
!
projectMenuCheckInProject:packageToCheckIn classes:doClasses extensions:doExtensions buildSupport:doBuild usingManager: manager
^ self
projectMenuCheckInProject:packageToCheckIn
classes:doClasses
extensions:doExtensions
buildSupport:doBuild
askForMethodsInOtherPackages:true
usingManager: manager
"Modified: / 21-08-2006 / 19:43:22 / cg"
"Created: / 13-10-2011 / 10:37:30 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Created: / 21-12-2011 / 20:18:59 / cg"
!
projectMenuCheckOut
"check-out all classes in the selected project from the source repository.
Individually ask for class revisions.
Offer chance to either overwrite the current version,
or merge-in the repository version.
"
self checkOutClasses:(self selectedProjectClasses) askForRevision:true
!
projectMenuCheckOutExtensions
self selectedProjectsDo:[:packageToCheckOut |
SourceCodeManagerUtilities
checkoutExtensionMethodsForPackage:packageToCheckOut
askForRevision:true
askForMerge:true
usingManager:(SourceCodeManager defaultManager)
]
"Created: / 10-08-2006 / 18:16:51 / cg"
!
projectMenuCheckOutNewest
"check-out the newest version from the source repository of
all classes in the selected project.
Offer chance to either overwrite the current version,
or merge-in the repository version."
(Dialog confirm:('This functionality is not yet completely implemented.'
, String lf
,'For now, only existing classes are updated - no new classes are added or old ones removed.'
, String lf
, 'Please use the import-structure function to get new definitions.')) ifFalse:[^ self].
self selectedProjects value do:[:eachPackageID |
|definitionClass mgr classes|
definitionClass := ProjectDefinition definitionClassForPackage:eachPackageID.
definitionClass isNil ifTrue:[
mgr := SourceCodeManager
] ifFalse:[
mgr := SourceCodeManagerUtilities sourceCodeManagerFor:definitionClass
].
classes := environment allClassesInPackage:eachPackageID.
classes := classes reject:[:cls | cls isPrivate ].
self checkOutClasses:classes askForRevision:false usingManager: mgr.
].
"/ self checkOutClasses:(self selectedProjectClasses) askForRevision:false.
^ self.
"/ #TODO.
"/
"/ self selectedProjects value do:[:eachProject |
"/ |module directory perProjectInfo
"/ classesNotInRepository filesNotInImage classesDeletedInRepository
"/ classesModifiedInImage classesModifiedInRepository
"/ classesDeletedInImage classesAddedInImage
"/ anyDifference box doRemove classDefs changeSets filePerClassDefintion
"/ classesToCheckIn|
"/
"/ module := eachProject asPackageId module.
"/ directory := eachProject asPackageId directory.
"/ perProjectInfo := SourceCodeManager newestRevisionsInModule:module directory:directory.
"/ perProjectInfo := perProjectInfo ? #().
"/ perProjectInfo := perProjectInfo select:[:info | info key asFilename hasSuffix:'st'].
"/ perProjectInfo := Dictionary withAssociations:perProjectInfo.
"/
"/ classesInImage := environment allClassesInPackage:eachProject.
"/ filesInImage := (classesInImage collect:[:cls | cls classBaseFilename]) asSet.
"/ "/ any differences ?
"/ classesNotInRepository := classesInImage reject:[:cls | (perProjectInfo includesKey:cls classBaseFilename)].
"/ classesDeletedInRepository := classesInImage select:[:cls | (perProjectInfo at:cls classBaseFilename ifAbsent:nil) == #deleted].
"/ perProjectInfo := perProjectInfo reject:[:v | v == #deleted].
"/ filesNotInImage := perProjectInfo keys reject:[:file | (filesInImage includes:file)].
"/
"/ classesModifiedInImage := classesInImage select:[:cls | ChangeSet current includesChangeForClassOrMetaclass:cls].
"/ classesModifiedInRepository := classesInImage select:[:cls | |v|
"/ v := (perProjectInfo at:cls classBaseFilename ifAbsent:nil).
"/ v notNil and:[ v > cls revision]].
"/
"/ anyDifference := false.
"/ filesNotInImage notEmpty ifTrue:[
"/ filePerClassDefintion := Dictionary new.
"/ classDefs := ChangeSet new.
"/ changeSets := OrderedCollection new.
"/ filesNotInImage do:[:eachSTFile |
"/ |s chgSet classDefinitions|
"/
"/ s := SourceCodeManager
"/ streamForClass:nil fileName:eachSTFile revision:#newest directory:directory module:module cache:true.
"/ chgSet := ChangeSet fromStream:s.
"/ s close.
"/ changeSets add:chgSet.
"/ classDefinitions := chgSet select:[:change | change isClassDefinitionChange and:[change isPrivateClassDefinitionChange not]].
"/ classDefinitions do:[:def | filePerClassDefintion at:def put:eachSTFile].
"/ classDefs addAll:classDefinitions.
"/ ].
"/ "/ now, install ...
"/ classDefs do:[:eachClassDefinition |
"/ |cls oldPackage|
"/
"/ eachClassDefinition package:eachProject.
"/ eachClassDefinition installAsAutoloadedClassIfPublicWithFilename:(filePerClassDefintion at:eachClassDefinition).
"/ (cls := eachClassDefinition changeClass) notNil ifTrue:[
"/ (oldPackage := cls package) ~= eachProject ifTrue:[
"/ (Dialog confirm:('Move the %1-class from %2 to %3 ?' bindWith:cls name allBold with:oldPackage allBold with:eachProject allBold)) ifTrue:[
"/ cls package:eachProject.
"/ cls instAndClassMethodsDo:[:m | m package = oldPackage ifTrue:[ m package:eachProject]].
"/ ]
"/ ].
"/ ].
"/ ].
"/ changeSets do:[:chgSet |
"/ chgSet apply
"/ ].
"/ ].
"/ classesModifiedInImage notEmpty ifTrue:[
"/ classesToCheckIn := OrderedCollection new.
"/ classesModifiedInImage do:[:eachChangedClass |
"/ |currentVersion repositoryVersion s stFile diffs|
"/
"/ stFile := eachChangedClass classBaseFilename.
"/ s := SourceCodeManager
"/ streamForClass:nil fileName:stFile revision:#newest directory:directory module:module cache:true.
"/ repositoryVersion := ChangeSet fromStream:s.
"/ s close.
"/
"/ currentVersion := ChangeSet forExistingClass:eachChangedClass.
"/ diffs := currentVersion diffSetsAgainst:repositoryVersion.
"/ diffs isEmpty ifTrue:[
"/ ChangeSet current condenseChangesForClass:eachChangedClass
"/ ] ifFalse:[
"/self halt.
"/ classesToCheckIn add:eachChangedClass.
"/ ].
"/ ].
"/ classesToCheckIn notEmpty ifTrue:[
"/self halt.
"/ ].
"/ ].
"/ classesModifiedInRepository notEmpty ifTrue:[
"/ box := Dialog
"/ forRequestText:(resources stringWithCRs:'The following classes need to be updated from the repository.')
"/ editViewClass:ListView
"/ lines:10 columns:20
"/ initialAnswer:nil model:nil
"/ setupWith:
"/ [:v :d |
"/ |removeButton|
"/
"/ v list:classesModifiedInRepository.
"/ d okButton label:(resources string:'Update').
"/ d okButton isReturnButton:true.
"/ ].
"/ box open.
"/ box accepted ifFalse:[
"/ ^ self
"/ ].
"/ classesModifiedInRepository do:[:eachClass|
"/ |s chgSet|
"/
"/ s := SourceCodeManager
"/ streamForClass:eachClass fileName:nil revision:#newest directory:directory module:module cache:true.
"/ chgSet := ChangeSet fromStream:s.
"/ s close.
"/ chgSet apply.
"/ ].
"/ ].
"/ classesDeletedInRepository notEmpty ifTrue:[
"/self halt.
"/ ].
"/ classesNotInRepository notEmpty ifTrue:[
"/ "/ if there are no changeSet entries for those classes, they seem to be
"/ "/ no longer in the repository (possibly moved ?)
"/ "/ If there are entries, these might have been added in the image and need a check-in
"/ classesAddedInImage := classesNotInRepository select:[:cls | ChangeSet current includesChangeForClassOrMetaclass:cls].
"/ classesAddedInImage isEmpty ifTrue:[
"/ doRemove := false.
"/ box := Dialog
"/ forRequestText:(resources stringWithCRs:'The following classes are no longer in the repository (or moved to another package).\\Remove classes from the image ?')
"/ editViewClass:ListView
"/ lines:10 columns:20
"/ initialAnswer:nil model:nil
"/ setupWith:
"/ [:v :d |
"/ |removeButton|
"/
"/ removeButton := Button label:(resources string:'Remove').
"/ removeButton action:[ doRemove := true. box okPressed. ].
"/ v list:classesNotInRepository.
"/ d addButton:removeButton after:(d okButton).
"/ d okButton label:(resources string:'Continue').
"/ d okButton isReturnButton:true.
"/ ].
"/ box open.
"/ box accepted ifFalse:[
"/ ^ self
"/ ].
"/ doRemove ifTrue:[
"/self halt.
"/ classesNotInRepository do:[:eachClassToRemove |
"/ |subClasses|
"/
"/ subClasses := eachClassToRemove allSubclasses.
"/ (subClasses conform:
"/ [:subClass |
"/ |ownerOrClassItself|
"/
"/ ownerOrClassItself := subClass topOwningClass ? subClass.
"/ (classesNotInRepository includes:ownerOrClassItself)
"/ ])
"/ ifTrue:[
"/ Smalltalk removeClass:eachClassToRemove.
"/ ChangeSet current condenseChangesForClass:eachClassToRemove.
"/ ] ifFalse:[
"/ Dialog warn:'Cannit simply remove the class - more repair needed due to subclass(es)'.
"/ ].
"/ ].
"/ ].
"/ ] ifFalse:[
"/self halt.
"/ ].
"/ ].
"/
"/ anyDifference ifFalse:[
"/ "/ Dialog information:(resources string:'%1 is up-to-date.' with:eachProject allBold).
"/ Transcript showCR:('%1 is up-to-date.' bindWith:eachProject allBold).
"/ ChangeSet current condenseChangesForPackage:eachProject.
"/ ] ifTrue:[
"/self halt.
"/ self checkOutClasses:(self selectedProjectClasses) askForRevision:false
"/ ].
"/ ].
"Modified: / 10-02-2012 / 17:32:39 / cg"
!
projectMenuCheckOutNewestUsingManager: manager
"/ If manager is CVSSourceCodeManager, call the old method
"/ until code is moved to CVSSourceCodeManager
manager == CVSSourceCodeManager ifTrue:[
self projectMenuCheckOutNewest.
^ self.
].
self projectMenuCheckOutUsingManager: manager askForRevision: false.
"Created: / 01-04-2014 / 16:59:54 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 04-04-2014 / 11:13:48 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
projectMenuCheckOutNewestUsingManagerNamed: sourceCodeManagerClassName
self projectMenuCheckOutNewestUsingManager: (self sourceCodeManagerNamed:sourceCodeManagerClassName)
"Created: / 01-04-2014 / 16:50:57 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
projectMenuCheckOutUsingManager:manager
"/ If manager is CVSSourceCodeManager, call the old method
"/ until code is moved to CVSSourceCodeManager
manager == CVSSourceCodeManager ifTrue:[
self projectMenuCheckOut.
^ self.
].
self projectMenuCheckOutUsingManager: manager askForRevision: true.
"Created: / 01-04-2014 / 16:57:14 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified (format): / 01-04-2014 / 21:24:58 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
projectMenuCheckOutUsingManager:manager askForRevision: askForRevision
| selectedProjects |
selectedProjects := self selectedProjects value.
(selectedProjects includes:(BrowserList nameListEntryForALL)) ifTrue:[
selectedProjects := environment allPackageIDs.
].
manager utilities checkOutPackages: selectedProjects askForRevision: askForRevision
"Created: / 01-04-2014 / 21:23:26 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
projectMenuCheckOutUsingManagerNamed: sourceCodeManagerClassName
self projectMenuCheckOutUsingManager: (self sourceCodeManagerNamed:sourceCodeManagerClassName)
"Created: / 01-04-2014 / 16:51:36 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
projectMenuCheckPackageIntegrity
"Runs ProjectChecker on selected packages"
self selectedProjectsDo:[:package |
Tools::ProjectCheckerBrowser new
projectChecker: (ProjectChecker forPackage: package);
open;
doCheckAgain
]
"Created: / 26-07-2012 / 12:30:27 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
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 projectMenuCheckRepositoryConsistencyUsingManager:SourceCodeManager
!
projectMenuCheckRepositoryConsistencyUsingManager:aManager
"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..
"
self withWaitCursorDo:[
|classesToLoad classesToUnload classesWithMissingContainer classesWithRepositoryMismatches
obsoleteContainers allChangeSets answer needExtensionsContainer hasExtensionContainer
classesWithNewerVersionInRepository classesWhichHaveBeenModified|
classesWithRepositoryMismatches := OrderedCollection new.
classesWithMissingContainer := OrderedCollection new.
obsoleteContainers := OrderedCollection new.
classesWithNewerVersionInRepository := OrderedCollection new.
classesWhichHaveBeenModified := OrderedCollection new.
self selectedProjectsDo:[:packageToCheck |
|containerModule containerPackage containers allContainers
hasLoadAll hasMakeProto hasMakeSpec hasBcMakefile hasNtMakefile hasAbbrev
otherFiles classesInProject |
containerModule := packageToCheck upTo:$:.
containerPackage := packageToCheck copyFrom:(containerModule size + 2).
self busyLabel:'Checking ' , packageToCheck , '...'.
allContainers := aManager getExistingContainersInModule:containerModule directory:containerPackage.
allContainers := allContainers reject:[:each | (each startsWith:'.') ].
hasLoadAll := allContainers includes:'loadAll'.
hasMakeProto := allContainers includes:'Make.proto'.
hasMakeSpec := allContainers includes:'Make.spec'.
hasBcMakefile := allContainers includes:'bc.mak'.
hasNtMakefile := allContainers includes:'nt.mak'.
hasAbbrev := allContainers includes:'abbrev.stc'.
hasExtensionContainer := allContainers includes:'extensions.st'.
containers := allContainers copyAsOrderedCollection.
containers removeAllFoundIn:#('loadAll' 'Make.proto' 'Make.spec' 'nt.mak' 'bc.mak' 'abbrev.stc' 'extensions.st').
otherFiles := containers reject:[:each | (each asFilename hasSuffix:'st') ].
containers removeAllFoundIn:otherFiles.
classesInProject := IdentitySet new.
needExtensionsContainer := false.
environment 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 := aManager utilities sourceCodeManagerFor:eachClassInProject.
info := mgr sourceInfoOfClass:eachClassInProject.
info isNil ifTrue:[
"/ no container for that class
] ifFalse:[
(info includesKey:#module) ifTrue:[
classesModule := (info at:#module).
].
(info includesKey:#directory) ifTrue:[
classesPackageDir := (info at:#directory).
].
classesContainerFileName := mgr containerFromSourceInfo:info.
"/ module & packageDir must match
((classesModule ~= containerModule)
or:[classesPackageDir ~= containerPackage]) ifTrue:[
classesWithRepositoryMismatches add:eachClassInProject
].
(containers includes:classesContainerFileName) ifFalse:[
classesWithMissingContainer add:eachClassInProject.
] ifTrue:[
eachClassInProject isLoaded ifTrue:[
eachClassInProject revision ~= (mgr newestRevisionOf:eachClassInProject)
ifTrue:[
classesWithNewerVersionInRepository add:eachClassInProject.
].
].
].
containers remove:classesContainerFileName ifAbsent:nil.
].
].
].
"/ any container left ?
containers notEmpty ifTrue:[
obsoleteContainers add:(packageToCheck -> containers).
].
"/ any version mismatches ?
classesInProject do:[:eachClassInProject |
eachClassInProject isLoaded ifTrue:[
(classesWithMissingContainer includes:eachClassInProject) ifFalse:[
(classesWithRepositoryMismatches includes:eachClassInProject) ifFalse:[
"/ class modified ?
allChangeSets isNil ifTrue:[
allChangeSets := ChangeSet allInstances.
].
(allChangeSets contains:[:aChangeSet |
(eachClassInProject hasUnsavedChanges)
or:[eachClassInProject allPrivateClasses contains:[:aPrivateClass |
aPrivateClass hasUnsavedChanges]]
])
ifTrue:[
classesWhichHaveBeenModified add:eachClassInProject
]
]
]
]
].
classesToUnload size >0 ifTrue:[
answer := Dialog confirm:(resources string:'%1 class(es) were loaded - unload them now ?'
with:classesToLoad size)
default:false.
answer ifTrue:[
"/ unload classes which have been loaded temporarily
classesToUnload do:[:eachClassToUnload |
eachClassToUnload unload
].
]
]
].
(obsoleteContainers notEmpty
or:[ classesWithRepositoryMismatches notEmpty
or:[ classesWithMissingContainer notEmpty
or:[ classesWhichHaveBeenModified notEmpty
or:[ classesWithNewerVersionInRepository notEmpty
or:[ needExtensionsContainer ~~ hasExtensionContainer ]]]]])
ifTrue:[
self
openRepositoryConsistencyDialogForObsoleteContainers:obsoleteContainers
classesWithRepositoryMismatches:classesWithRepositoryMismatches
classesWithMissingContainer:classesWithMissingContainer
classesWhichHaveBeenModified:classesWhichHaveBeenModified
classesWithNewerVersionInRepository:classesWithNewerVersionInRepository
needExtensionsContainer:needExtensionsContainer
hasExtensionContainer:hasExtensionContainer
]
].
self normalLabel
"Modified: / 12-09-2006 / 14:21:07 / cg"
!
projectMenuCleanUpChangeSet
"remove all changes for the selected project(s) from the changeSet"
(self confirm:'This will remove all changes for the selected project(s) from the changeSet.\\Really cleanup ?' withCRs)
ifFalse:[ ^ self].
self withWaitCursorDo:[
self selectedProjectsDo:[:eachProject |
ChangeSet current condenseChangesForPackage:eachProject
].
]
"Created: / 26-10-2006 / 19:41:27 / cg"
!
projectMenuCompareAgainstNewestInRepository
"Comparing the current (in-image) version of the project(s)
against the newest version found in the repository."
<resource: #obsolete> "use ...Using:manager variant"
self withWaitCursorDo:[
self selectedProjects value do:[:eachProject |
SourceCodeManagerUtilities default compareProjectWithRepository:eachProject
].
].
"Created: / 12-10-2006 / 17:41:55 / cg"
"Modified: / 15-10-2011 / 23:09:53 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 30-07-2013 / 21:33:05 / cg"
!
projectMenuCompareAgainstNewestInRepositoryUsingManager: manager
"Comparing the current (in-image) version of the project(s)
against the newest version found in the repository."
self withWaitCursorDo:[
manager utilities comparePackages: self selectedProjects value askForRevision: false.
].
"Modified: / 12-10-2006 / 21:46:14 / cg"
"Created: / 15-10-2011 / 23:10:06 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Created: / 21-12-2011 / 20:29:20 / cg"
"Modified: / 04-04-2014 / 15:38:19 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
projectMenuCompareAgainstNewestInRepositoryUsingManagerNamed: sourceCodeManagerClassName
"Comparing the current (in-image) version of the project(s)
against the newest version found in the repository."
^self projectMenuCompareAgainstNewestInRepositoryUsingManager: (self sourceCodeManagerNamed:sourceCodeManagerClassName)
"Created: / 16-01-2012 / 18:45:43 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 24-07-2012 / 18:01:03 / cg"
!
projectMenuCompareAgainstRepository
"Comparing the current (in-image) version of the project(s)
against some older version found in the repository."
self projectMenuCompareAgainstRepositoryUsingManager:SourceCodeManager
!
projectMenuCompareAgainstRepositoryUsingManager:aManager
"Comparing the current (in-image) version of the project(s)
against some older version found in the repository."
self withWaitCursorDo:[
aManager utilities comparePackages: self selectedProjects value askForRevision: true.
].
"Created: / 12-10-2006 / 17:41:55 / cg"
"Modified: / 12-10-2006 / 21:46:14 / cg"
"Modified: / 04-04-2014 / 15:36:16 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
projectMenuCompareAgainstStableInRepository
"Comparing the current (in-image) version of the project(s)
against the stable version found in the repository."
self projectMenuCompareAgainstStableInRepositoryUsingManager:SourceCodeManager
!
projectMenuCompareAgainstStableInRepositoryUsingManager:aManager
"Comparing the current (in-image) version of the project(s)
against the stable version found in the repository."
self withWaitCursorDo:[
self selectedProjects value do:[:eachProject |
aManager utilities compareProject:eachProject withRepositoryVersionTaggedAs:'stable'
].
].
!
projectMenuDocumentation
"save class documentation for each of the package's classes to a directory"
self projectMenuDocumentationUsing:HTMLDocGenerator
!
projectMenuDocumentationForJavaScript
"save class documentation for each of the package's classes to a directory"
self projectMenuDocumentationUsing:HTMLDocGeneratorForJavaScript
!
projectMenuDocumentationUsing:generator
"save class documentation for each of the package's classes to a directory"
|directory|
directory := Dialog
requestDirectoryName:'Save class documentation in'
default:(LastClassDocDirectory ? 'doc/classDoc').
directory isEmptyOrNil ifTrue:[^ self].
LastClassDocDirectory := directory.
directory := directory asFilename.
directory recursiveMakeDirectory.
self saveProjectClassDocumentationIn:directory using:generator
!
projectMenuFileOutAs
"fileOut selected projects - st-source format"
self projectMenuFileOutAsWithFormat:nil
!
projectMenuFileOutAsWithFormat:aFormatSymbolOrNil
|currentProject selectedProjects suffix saveName fileName tmpFilename
"methodsToFileOut fileNameForExtensions" mgr s classesToFileout|
selectedProjects := self selectedProjectsValue.
currentProject := self theSingleSelectedProject.
currentProject notNil ifTrue:[
fileName := ProjectDefinition projectDefinitionClassNameForDefinitionOf:currentProject.
] ifFalse:[
fileName := 'someProjects'
].
suffix := self fileSuffixForClass:nil format:aFormatSymbolOrNil.
suffix notEmptyOrNil ifTrue:[
fileName := fileName,'.',suffix.
].
aFormatSymbolOrNil == #binary ifTrue:[
self error:'binary must go into separate files' mayProceed:true.
^ self
].
aFormatSymbolOrNil == #cypress ifTrue:[
saveName := Dialog
requestDirectoryName: (resources string:'Fileout %1 in:' with:(currentProject ? 'selected projects'))
default: LastCypressDirectory.
] ifFalse: [aFormatSymbolOrNil == #tonel ifTrue:[
| default |
LastTonelDirectories isNil ifTrue: [LastTonelDirectories := Dictionary new].
"/ Here we try to detect suitable default.
"/
"/ For a single package, the is either the last used directory for Tonel fileout
"/ or the directory found along the package path (result of `TonelRepository >> #discoverPackage:`)
"/ Otherwise, package has not default.
"/
"/ If all selected packages have either no default or their default is the same as default
"/ of others, this is the suitable default. Otherwise, there's no default.
selectedProjects do: [:package |
| defaultForPackage |
defaultForPackage := LastTonelDirectories at: package ifAbsent: [(Smalltalk at:#TonelRepository) discoverPackage: package ].
defaultForPackage notNil ifTrue: [
(default notNil and: [ default ~= defaultForPackage ]) ifTrue: [
"/ At least one package has default and that default differ from
"/ default of `package`. So there's no suitable default for the whole
"/ set.
"/
"/ Since we cannot 'break' the cycle, we set default to 0 (zero) to mark
"/ no default can be found.
default := 0.
] ifFalse: [
default := defaultForPackage.
].
].
].
default == 0 ifTrue: [ default := nil ].
saveName := Dialog
requestDirectoryName: (resources string:'Select Tonel repository to fileout %1' with:(currentProject ? 'selected projects'))
default: default.
] ifFalse:[
saveName := Dialog
requestFileNameForSave:(resources string:'Fileout %1 as:' with:(currentProject ? 'selected projects'))
default:fileName
fromDirectory:(FileSelectionBox lastFileSelectionDirectory).
]].
"/ fileBox := FileSelectionBox
"/ title:(resources string:'FileOut %1 as:' with:(currentProject ? 'selected projects'))
"/ okText:(resources string:'FileOut')
"/ abortText:(resources string:'Cancel')
"/ action:[:fileName | saveName := fileName.].
"/
"/ fileBox initialText:fileName.
"/ dir := FileSelectionBox lastFileSelectionDirectory.
"/ dir notNil ifTrue:[
"/ fileBox directory:dir.
"/ ].
"/ fileBox showAtPointer.
"/
"/ fileBox destroy.
"/ fileBox := nil.
saveName isEmptyOrNil ifTrue:[
^ self
].
FileSelectionBox lastFileSelectionDirectory:(saveName asFilename directoryName).
fileName := saveName.
aFormatSymbolOrNil == #sif ifTrue:[
SmalltalkInterchangeSTXFileOutManager initialize.
mgr := SmalltalkInterchangeFileManager newForFileOut.
mgr fileName: fileName.
self selectedProjectClasses do:[:eachClass |
mgr addClass:eachClass.
].
Smalltalk allClassesDo:[:eachClass |
eachClass instAndClassSelectorsAndMethodsDo:[:sel :mthd |
|mPckg|
mPckg := mthd package.
mPckg ~= eachClass package ifTrue:[
(selectedProjects includes:mPckg) ifTrue:[
mgr addMethodNamed:mthd selector ofClass:mthd mclass
]
]
]
].
self busyLabel:'writing...'.
mgr fileOut.
self normalLabel.
^ self
].
((aFormatSymbolOrNil == #vsePackage) or:[ aFormatSymbolOrNil == #vse ]) ifTrue:[
self busyLabel:'writing VSE...'.
tmpFilename := fileName asFilename withSuffix:'part'.
tmpFilename directory exists ifFalse:[
(Dialog confirm:(resources string:'Create Directory "%1"?' with:tmpFilename directory baseName)) ifFalse:[^ self].
tmpFilename directory recursiveMakeDirectory
].
s := tmpFilename writeStream.
s lineEndCRLF.
[
((aFormatSymbolOrNil == #vsePackage)
ifTrue:[ VSEPackageFileSourceWriter ]
ifFalse:[ VSEChunkFileSourceWriter ])
fileOutPackage:currentProject on:s.
] ifCurtailed:[
s close.
tmpFilename remove
].
s close.
tmpFilename renameTo:(fileName asFilename).
self normalLabel.
^ self.
].
(aFormatSymbolOrNil isNil) ifTrue:[
self busyLabel:'writing...'.
tmpFilename := fileName asFilename withSuffix:'part'.
s := tmpFilename writeStream.
[
classesToFileout := OrderedCollection withAll:(self selectedProjectClasses).
classesToFileout topologicalSort:[:a :b | b isSubclassOf:a].
classesToFileout do:[:eachClass |
eachClass fileOutOn:s.
].
"/ fileout extensions
Smalltalk allClassesDo:[:eachClass |
eachClass instAndClassSelectorsAndMethodsDo:[:sel :mthd |
|mPckg|
mPckg := mthd package.
(mPckg = currentProject and:[mPckg ~= eachClass package]) ifTrue:[
eachClass
fileOutCategory:mthd category
methodFilter:[:m | m == mthd]
on:s.
s cr.
]
]
].
] ifCurtailed:[
s close.
tmpFilename remove
].
s close.
tmpFilename renameTo:(fileName asFilename).
self normalLabel.
^ self.
].
aFormatSymbolOrNil == #cypress ifTrue:[
mgr := (Smalltalk at:#CypressRepository) on: saveName.
self showMessage: (resources string:'Writing Cypress package...')
while: [ selectedProjects do:[:each | mgr write: each ] ]
inBackground: true.
LastCypressDirectory := saveName.
^ self
].
aFormatSymbolOrNil == #beestp ifTrue:[
| writer |
writer := [ :project |
tmpFilename := fileName asFilename withSuffix:'part'.
s := tmpFilename writeStream.
s lineEndCRLF.
[
BeeProjectSourceWriter fileOut:currentProject on:s.
] ifCurtailed:[
s close.
tmpFilename remove
].
s close.
tmpFilename renameTo:(fileName asFilename).
].
self showMessage: (resources string:'Writing as Bee Project...')
while: [ selectedProjects do:[:each | writer value: each ] ]
inBackground: true.
LastCypressDirectory := saveName.
^ self
].
aFormatSymbolOrNil == #tonel ifTrue:[
mgr := (Smalltalk at:#TonelRepository) directory: saveName.
self showMessage: (resources string:'Writing Tonel package...')
while: [ selectedProjects do:[:package |
| mcpkg mcwc mcvi mcversion |
mcpkg := MCPackage named: package.
mcwc := mcpkg workingCopy.
mcvi := MCVersionInfo forPackage: package.
[
mcversion := mcwc newVersion.
mcversion snapshot options includeExtrasForSTX:false.
] on:MCVersionNameAndMessageRequest do:[:ex |
ex resume:(Array with:mcvi name with:mcvi message)
].
mcversion info:mcvi.
mgr storeVersion:mcversion.
LastTonelDirectories at: package put: saveName.
(ChangeSet current)
condenseChangesForPackageAfterCommit:package;
condenseChangesForExtensionsInPackage:package;
flushChangedClassesCache;
yourself
] ]
inBackground: true.
^ self
].
self shouldImplement:'support for:',aFormatSymbolOrNil asString.
"Modified: / 27-10-2010 / 11:34:45 / cg"
"Modified: / 14-04-2015 / 14:12:00 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 22-09-2022 / 16:27:23 / Jan Vrany <jan.vrany@labware.com>"
!
projectMenuFileOutBeeProjectSourceAs
self projectMenuFileOutAsWithFormat:#beestp
"Created: / 14-04-2015 / 14:04:53 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
projectMenuFileOutBuildSupportFiles
self selectedProjectsDo:[:packageToCheckIn |
self projectMenuFileOutBuildSupportFilesForProject:packageToCheckIn
]
!
projectMenuFileOutBuildSupportFilesForProject:packageIDSymbol
|directory defClass foundPackageDir packageID fullPathName|
defClass := ProjectDefinition definitionClassForPackage:packageIDSymbol
createIfAbsent:false.
defClass isNil ifTrue:[
defClass := self projectDefinitionDialogFor:packageID.
defClass isNil ifTrue:[
^ self
].
defClass compileDescriptionMethods.
].
self validateProjectDefinition:defClass.
defClass hasAllCompiledClassesFullyLoaded ifFalse:[
(Dialog
confirm:('%1: the dependency information as generated will be incomplete,%<cr>because some compiled class(es) are not loaded (see Transcript).%<cr>%<cr>%2%<cr>Continue anyway ?'
bindWith:defClass name
with:('Warning: these classes will be excluded from the list of compiled classes.'
allBold)))
ifFalse:[ ^ self. ]
].
packageID := packageIDSymbol asPackageId.
directory := packageID directory.
Smalltalk packagePath
detect:[:eachDir |
|thisPackageDir|
thisPackageDir := packageID pathRelativeToTopDirectory:eachDir.
thisPackageDir exists ifTrue:[
foundPackageDir := thisPackageDir.
true.
] ifFalse:[ false ].
].
directory := Dialog
requestDirectoryName:'Directory Where to Generate Build Support Files?'
default:foundPackageDir.
directory isNil ifTrue:[
^ self.
].
directory := directory asFilename.
directory exists ifFalse:[
Dialog warn:'Directory does not exists!!'.
^ self.
].
self activityNotification:(resources
string:'generating build-support files...').
self withActivityNotificationsRedirectedToInfoLabelDo:[
defClass forEachFileNameAndGeneratedContentsDo:[:fileName :fileContents |
self showInfo:(resources string:'fileing out %1...' with:fileName).
fullPathName := directory construct:fileName.
fullPathName directory exists ifFalse:[
"take care for files like 'autopackage/default.apspec'"
fullPathName directory makeDirectory.
].
fullPathName exists ifTrue:[
fullPathName renameTo:(fullPathName pathName,'.sav') asFilename.
].
fullPathName contents:fileContents.
].
].
self activityNotification:nil.
"Created: / 09-08-2006 / 18:59:42 / fm"
"Modified: / 16-08-2006 / 18:38:49 / User"
"Modified: / 23-02-2011 / 15:27:20 / cg"
!
projectMenuFileOutCypressAs
^self projectMenuFileOutAsWithFormat:#cypress
"Modified: / 07-09-2012 / 19:26:34 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
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|
currentProject := self theSingleSelectedProject ? 'selected projects'.
dirName := self
askForDirectoryToFileOut:(resources string:'FileOut %1 in:'
with:currentProject)
default:nil.
dirName isNil ifTrue:[
^ self
].
dirName := dirName asFilename.
dirName exists ifFalse:[
dirName recursiveMakeDirectory
].
self
fileOutEachClassIn:self selectedProjectClasses
in:dirName
withFormat:aFormatSymbolOrNil.
"/ extensions...
self projectMenuFileOutExtensionsIn:dirName withFormat:aFormatSymbolOrNil
!
projectMenuFileOutEachSIFIn
"fileOut selected projects as individual files - sif format"
self projectMenuFileOutEachInWithFormat:#sif
!
projectMenuFileOutEachVSEIn
"fileOut selected projects as individual files - visual smalltalk enterprise format"
self projectMenuFileOutEachInWithFormat:#vse
!
projectMenuFileOutEachXMLIn
"fileOut selected projects as individual files - xml format"
self projectMenuFileOutEachInWithFormat:#xml
!
projectMenuFileOutExtensionsIn
"fileOut selected project extensions - st-source format"
self projectMenuFileOutExtensionsInWithFormat:nil
!
projectMenuFileOutExtensionsIn:dirName withFormat:aFormatSymbolOrNil
|currentProject methodsToFileOut fileNameForExtensions|
currentProject := self theSingleSelectedProject.
"/ extensions...
methodsToFileOut := OrderedCollection new.
environment allClassesDo:[:eachClass |
eachClass instAndClassSelectorsAndMethodsDo:[:sel :mthd |
|mPckg|
mPckg := mthd package.
(mPckg = currentProject and:[mPckg ~= eachClass package]) ifTrue:[
methodsToFileOut add:mthd
]
]
].
fileNameForExtensions := (dirName / 'extensions') withSuffix:(self fileSuffixForFormat:aFormatSymbolOrNil).
self
fileOutMethods:methodsToFileOut
format:aFormatSymbolOrNil
toFile:fileNameForExtensions
withPackage:true
"Modified: / 05-09-2011 / 22:02:48 / cg"
!
projectMenuFileOutExtensionsInWithFormat:aFormatSymbolOrNil
|currentProject dirName|
currentProject := self theSingleSelectedProject.
dirName := self
askForDirectoryToFileOut:(resources string:'FileOut Extensions of %1 in:'
with:currentProject)
default:nil.
dirName isNil ifTrue:[
^ self
].
dirName := dirName asFilename.
dirName exists ifFalse:[
dirName recursiveMakeDirectory
].
"/ extensions...
self projectMenuFileOutExtensionsIn:dirName withFormat:aFormatSymbolOrNil
!
projectMenuFileOutSIFAs
"fileOut selected projects - sif format"
self projectMenuFileOutAsWithFormat:#sif
!
projectMenuFileOutTonelAs
^self projectMenuFileOutAsWithFormat:#tonel
"Created: / 09-07-2020 / 23:56:18 / Jan Vrany <jan.vrany@labware.com>"
!
projectMenuFileOutVSEAs
"fileOut selected projects - visual smalltalk enterprise format"
self projectMenuFileOutAsWithFormat:#vse
!
projectMenuFileOutVSEFormatAs
self projectMenuFileOutAsWithFormat:#vse
!
projectMenuFileOutVSEPackageFormatAs
"fileOut selected projects - visual smalltalk enterprise format"
self projectMenuFileOutAsWithFormat:#vsePackage
!
projectMenuFileOutXMLAs
"fileOut selected projects - xml format"
self projectMenuFileOutAsWithFormat:#xml
!
projectMenuFindClassesNotTaggedAs:aSymbolicTag
"find classes which have a version different from aSymbolicTag."
|differentClasses|
differentClasses := OrderedCollection new.
self withWaitCursorDo:[
self selectedProjectsDo:[:eachProject |
|module directory perProjectInfo classesInImage
autoloadedClassesInImage filesInImage autoloadedFilesInImage
classesNotInRepository classesDeletedInRepository filesNotInImage|
module := eachProject asPackageId module.
directory := eachProject asPackageId directory.
perProjectInfo := SourceCodeManager revisionsInModule:module directory:directory taggedAs:aSymbolicTag.
perProjectInfo := perProjectInfo ? #().
perProjectInfo := perProjectInfo select:[:info | info key asFilename hasSuffix:'st'].
perProjectInfo := Dictionary withAssociations:perProjectInfo.
classesInImage := environment allClassesInPackage:eachProject.
autoloadedClassesInImage := classesInImage reject:[:cls | cls isLoaded].
classesInImage := classesInImage select:[:cls | cls isLoaded and:[cls isPrivate not]].
"/ filesInImage := classesInImage collect:[:cls | cls classBaseFilename] as:Set.
"/ autoloadedFilesInImage := autoloadedClassesInImage collect:[:cls | cls classBaseFilename] as:Set.
"/ "/ any differences ?
"/ classesNotInRepository := classesInImage reject:[:cls | (perProjectInfo includesKey:cls classBaseFilename)].
"/ classesDeletedInRepository := classesInImage select:[:cls | (perProjectInfo at:cls classBaseFilename ifAbsent:nil) == #deleted].
perProjectInfo := perProjectInfo reject:[:v | v == #deleted].
"/ filesNotInImage := perProjectInfo keys reject:[:file | (filesInImage includes:file)].
"/ filesNotInImage := filesNotInImage reject:[:file | (autoloadedFilesInImage includes:file)].
"/ filesNotInImage remove:'extensions.st' ifAbsent:[].
classesInImage do:[:eachClass |
eachClass revision ~= (perProjectInfo at:eachClass classBaseFilename ifAbsent:nil) ifTrue:[
differentClasses add:eachClass
]
].
].
self
spawnClassBrowserFor:differentClasses
label:(resources string:'Classes different from "%1" Version' with:aSymbolicTag)
in:#newBuffer
].
!
projectMenuFindNotStableClasses
"find classes which have a version different from the stable one."
self projectMenuFindClassesNotTaggedAs:'stable'
!
projectMenuFindNotTaggedClasses
"find classes which have a version different from the stable one."
|tag|
tag := Dialog request:'Tag:' initialAnswer:(CVSSourceCodeManager recentTag).
tag isEmptyOrNil ifTrue:[^ self].
CVSSourceCodeManager recentTag:tag.
self projectMenuFindClassesNotTaggedAs:tag
!
projectMenuGenerateBuildSupportFiles
self selectedProjectsDo:[:packageToCheckIn |
self projectMenuGenerateBuildSupportFilesForProject:packageToCheckIn
]
"Created: / 09-08-2006 / 19:04:52 / fm"
"Modified: / 15-10-2011 / 22:31:27 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
projectMenuGenerateBuildSupportFilesForProject:packageID
|defClass|
defClass := ProjectDefinition definitionClassForPackage:packageID createIfAbsent:false.
defClass isNil ifTrue:[
defClass := self projectDefinitionDialogFor:packageID.
defClass isNil ifTrue:[ ^ self ].
defClass compileDescriptionMethods.
].
self projectMenuGenerateBuildSupportFilesForProject:packageID definition:defClass
!
projectMenuGenerateBuildSupportFilesForProject:packageID definition:defClass
|dirName directory|
self validateProjectDefinition:defClass.
dirName := self
askForDirectoryToFileOut:(resources string:'Generate Build Support Files for %1 in:'
with:packageID)
default:nil.
dirName isNil ifTrue:[
^ self
].
directory := dirName asFilename.
directory exists ifFalse:[
directory recursiveMakeDirectory
].
self activityNotification:(resources string:'generating build-support files...').
self withActivityNotificationsRedirectedToInfoLabelDo:[
defClass forEachFileNameAndGeneratedContentsDo:[:fileName :fileContents |
| file |
file := directory construct:fileName.
file directory recursiveMakeDirectory.
file contents:fileContents.
].
].
self activityNotification:nil.
"Modified: / 02-02-2016 / 09:41:33 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
projectMenuGeneratePatchSet
"ask for two tags, generate a patchSet to bring a baseSystem (tag1) to the
level of the tag2 version"
self generatePatchSetForClasses:(self selectedProjectClasses)
"Created: / 08-02-2011 / 09:29:38 / cg"
!
projectMenuGenerateProjectDefinitions
|projectClasses|
projectClasses := self projectDefinitionClassesForSelectedProjects.
self generateProjectDefinitionsIn:projectClasses
"Modified: / 15-09-2006 / 16:46:51 / cg"
!
projectMenuImport
"import packages - but do not load classes"
self projectMenuImport:false usingManager:nil
"Modified: / 27-07-2012 / 13:34:09 / cg"
!
projectMenuImport:doLoadClasses usingManager:managerOrNil
|currentProject default pkg fromWhere module checkedOutPackageDir package numImported numSkipped msg classDefs
filePerClassDefintion importFromFilesystem importDirectory importFromDirectoryAction
sourceCodeManager|
importFromFilesystem := false.
default := LastImportedPackage.
default isNil ifTrue:[
currentProject := self theSingleSelectedProject.
currentProject isNil ifTrue:[
default := 'module:package'.
] ifFalse:[
module := currentProject upTo:$:.
module size + 2 > currentProject size ifTrue:[
default := currentProject , ':*'
] ifFalse:[
default := currentProject , '/*'
].
].
].
SourceCodeManager notNil ifTrue:[
fromWhere := 'repository'
] ifFalse:[
fromWhere := 'file system'
].
msg := 'Name of package to import '.
doLoadClasses ifFalse:[
msg := msg , '(i.e. install as autoloaded) '.
].
msg := msg , 'from ' , fromWhere , ':\'.
msg := msg , ' use ''module:*'' to import a complete module;\'.
msg := msg , ' use ''module:package'' to import a package with all of its subpackages;\'.
msg := msg , ' use ''module:package/*'' to import subpackages only.'.
pkg := Dialog
request:msg withCRs
initialAnswer:default.
pkg size == 0 ifTrue:[^ self].
LastImportedPackage := pkg.
"/ see if such a module/package exists in the repository
module := pkg asPackageId module.
module size + 2 > pkg size ifTrue:[
package := checkedOutPackageDir := nil. "/ i.e. all
] ifFalse:[
package := checkedOutPackageDir := pkg asPackageId directory.
(package includesMatchCharacters) ifTrue:[
"if the match-char is not at the end..."
((package endsWith:'/*') and:[ (package copyButLast:2) includesMatchCharacters not ])
ifTrue:[
checkedOutPackageDir := package copyButLast:2
] ifFalse:[
checkedOutPackageDir := nil. "/ must check out everything and filter
]
].
].
managerOrNil notNil ifTrue:[
sourceCodeManager := managerOrNil.
] ifFalse:[
sourceCodeManager := (AbstractSourceCodeManager managerForPackage:module) ? AbstractSourceCodeManager defaultManager.
].
UnimplementedFunctionalityError,SourceCodeManagerError handle:[:ex |
|msg1 msg2|
(UnimplementedFunctionalityError handles:ex) ifTrue:[
msg1 := 'Cannot access module "%1".\\'.
msg2 := 'Missing functionality in the "%2"-source code manager.'.
] ifFalse:[
msg1 := 'Cannot access module "%1".\\'.
msg2 := ex errorString ? ('No module "%1" in the repository (%2).').
].
(Dialog confirm:
(resources stringWithCRs:msg1 with:module)
,(resources string:msg2 with:module with:sourceCodeManager managerTypeName)
,(resources stringWithCRs:('\\Import from the filesystem ?')))
ifFalse:[
^ self.
].
importFromFilesystem := true.
checkedOutPackageDir isNil ifTrue:[
default := Smalltalk projectDirectoryForPackage:module.
] ifFalse:[
default := Smalltalk projectDirectoryForPackage:pkg.
].
(default notNil
and:[ (default := default asFilename) exists
and:[ default isDirectory ]])
ifFalse:[
default := nil.
].
importDirectory := Dialog
requestDirectoryName:(resources
string:'Import "%1" from Directory:'
with:pkg)
default:default.
importDirectory isEmptyOrNil ifTrue:[
^ self
].
importDirectory := importDirectory asFilename pathName asFilename.
] do:[
sourceCodeManager isNil ifTrue:[ SourceCodeManagerError raise ].
(sourceCodeManager checkForExistingModule:module) ifFalse:[
self warn:(resources string:'No module "%1" in the repository.' with:module).
^ self.
].
checkedOutPackageDir notNil ifTrue:[
(sourceCodeManager checkForExistingModule:module directory:checkedOutPackageDir) ifFalse:[
self warn:(resources string:'No package "%1" in the repository (but the module "%2" exists).' with:checkedOutPackageDir with:module).
^ self
]
].
].
"/ check out that module ...
importFromDirectoryAction :=
[:tempDir |
|filesThere skip|
numImported := numSkipped := 0.
tempDir asFilename withAllDirectoriesDo:[:eachDir |
|relDir theProject anyFound anyUnsavedClass|
( #( 'CVS' 'bitmaps' 'resources' ) includes:eachDir baseName)
ifFalse:[
relDir := eachDir name.
(relDir startsWith:tempDir name) ifTrue:[
relDir := relDir copyFrom:tempDir name size + 2.
] ifFalse:[
self halt:'mhmh - can this happen ?'.
].
checkedOutPackageDir notNil ifTrue:[
relDir size > 0 ifTrue:[
relDir := checkedOutPackageDir asFilename constructString:relDir
] ifFalse:[
relDir := checkedOutPackageDir
]
].
relDir := relDir asUnixFilenameString.
relDir size > 0 ifTrue:[
theProject := module , ':' , relDir
] ifFalse:[
theProject := module
].
skip := false.
(checkedOutPackageDir isNil and:[package notNil]) ifTrue:[
skip := (package ~= (relDir , '/*') ) and:[ (package match:relDir) not ].
].
anyFound := false.
skip ifTrue:[
numSkipped := numSkipped + 1.
] ifFalse:[
Transcript showCR:('processing ' , relDir , '...').
filesThere := eachDir directoryContents select:[:eachFile | eachFile asFilename hasSuffix:'st'].
filesThere isEmpty ifTrue:[
Transcript showCR:(eachDir pathName , ': no smalltalk files in package.').
] ifFalse:[
anyFound := true.
"/ cannot simply fileIn that stuff (because of load order)
"/ instead, create a change set containing all class definitions,
"/ and define them first ...
filePerClassDefintion := Dictionary new.
classDefs := ChangeSet new.
filesThere do:[:eachSTFile |
|s classDefinitions chgSet|
s := (eachDir asFilename construct:eachSTFile) readStream.
chgSet := ChangeSet fromStream:s.
s close.
classDefinitions := chgSet select:[:change | change isClassDefinitionChange and:[change isPrivateClassDefinitionChange not]].
classDefinitions do:[:def | filePerClassDefintion at:def put:eachSTFile].
classDefs addAll:classDefinitions.
].
"/ now, install ...
classDefs do:[:eachClassDefinition |
|cls oldPackage|
eachClassDefinition package:theProject.
eachClassDefinition installAsAutoloadedClassIfPublicWithFilename:(filePerClassDefintion at:eachClassDefinition).
(cls := eachClassDefinition changeClass) notNil ifTrue:[
(oldPackage := cls package) ~= theProject ifTrue:[
(Dialog confirm:('There is already a class named "%1" in the "%2"-pacakge.\\Move it to the "%3"-package?' withCRs
bindWith:cls name allBold
with:oldPackage allBold
with:theProject allBold)) ifTrue:[
cls package:theProject.
cls instAndClassMethodsDo:[:m | m package = oldPackage ifTrue:[ m package:theProject]].
]
].
].
].
doLoadClasses ifTrue:[
anyUnsavedClass := classDefs
contains:[:someClassDefinition |
|cls|
((cls := someClassDefinition changeClass) notNil
and:[cls isLoaded
and:[ChangeSet current includesChangeForClassOrMetaclass:cls]])
].
anyUnsavedClass ifTrue:[
(Dialog
confirm:'There is at least one unsaved class (changed but not yet checked in) in the project.\\Load (i.e. overwrite) ?' withCRs)
ifFalse:[ AbortSignal raise ].
].
filesThere do:[:eachSTFile |
Transcript showCR:(' loading ' , (eachDir asFilename constructString:eachSTFile) , '...').
self activityNotification:('loading ',eachSTFile,'...').
Class packageQuerySignal answer:theProject do:[
Smalltalk fileIn:(eachDir asFilename construct:eachSTFile).
]
].
numImported := numImported + 1.
].
].
].
(anyFound and:[theProject notNil]) ifTrue:[
self projectListApp addAdditionalProject:theProject.
]
]
]
].
importFromFilesystem ifTrue:[
importFromDirectoryAction value:importDirectory
] ifFalse:[
"/ check out that module ...
SourceCodeManagerError handle:[:ex |
Dialog warn:ex description
] do:[
sourceCodeManager
checkoutModule:module
directory:checkedOutPackageDir
andDo:importFromDirectoryAction.
].
].
numImported == 0 ifTrue:[
numSkipped ~~ 0 ifTrue:[
(package endsWith:'*') ifTrue:[
self information:('Nothing imported. Notice:\You may want to try ''' ,
(package copyButLast:2) , ''' (i.e. not the matching sub-packages).') withCRs
] ifFalse:[
self information:'Nothing imported.'
]
].
].
LastImportedPackage := nil.
"Created: / 27-07-2012 / 13:33:08 / cg"
!
projectMenuImportAndLoadClasses
"import packages AND load classes"
self projectMenuImport:true usingManager:nil
"Modified: / 27-07-2012 / 13:34:37 / cg"
!
projectMenuImportAndLoadClassesUsingManagerNamed:sourceCodeManagerClassName
"import packages AND load classes"
self projectMenuImport:true usingManager:(self sourceCodeManagerNamed:sourceCodeManagerClassName)
"Created: / 27-07-2012 / 13:46:40 / cg"
!
projectMenuImportUsingManagerNamed:sourceCodeManagerClassName
"import packages - but do not load classes"
self projectMenuImport:false usingManager:(self sourceCodeManagerNamed:sourceCodeManagerClassName)
"Created: / 27-07-2012 / 13:34:54 / cg"
!
projectMenuLoad
|projects projectsString alreadyWarned|
LastLoadedPackages isNil ifTrue:[
LastLoadedPackages := OrderedCollection new.
].
projects := self selectedProjects value.
projects isEmptyOrNil ifTrue:[
NewLauncher notNil ifTrue:[
"/ use the >>much better<< Launcher-load-package dialog
NewLauncher openLoadPackageDialog.
^ self.
].
projectsString := Dialog
request:'Load which package(s):'
initialAnswer:projectsString
list:LastLoadedPackages.
projectsString size == 0 ifTrue:[^ self].
projects := projectsString asCollectionOfWords.
].
alreadyWarned := Set new.
projects do:[:packageToLoad |
LastLoadedPackages remove:packageToLoad ifAbsent:nil.
LastLoadedPackages addFirst:packageToLoad.
LastLoadedPackages size > 20 ifTrue:[
LastLoadedPackages removeLast.
].
[
Smalltalk loadPackage:packageToLoad.
] on:PackageLoadError do:[:ex|
Dialog warn:(resources
stringWithCRs:'Failed to load package: %1\\Reason: %2'
with: packageToLoad
with:ex description).
alreadyWarned add:packageToLoad.
]
].
"/ any autoloaded?
projects do:[:packageToLoad |
|dfn|
dfn := packageToLoad asPackageId projectDefinitionClass.
dfn isNil ifTrue:[
(alreadyWarned includes:packageToLoad) ifFalse:[
Dialog warn:'Not loaded:: ',packageToLoad
].
] ifFalse:[
dfn hasAllClassesFullyLoaded ifFalse:[
(Dialog confirm:'Load autoloaded classes now?') ifTrue:[
dfn loadAllAutoloadedClasses
]
]
].
].
"Modified: / 14-09-2006 / 17:38:00 / cg"
!
projectMenuMailTo
"fileOut selected classes (chunk format) and eMail to someone"
self
mailClasses:self selectedProjectClasses
subject:'Project Source from Browser'
"Modified: / 20-09-2007 / 15:03:00 / cg"
!
projectMenuMakeCurrentProject
|theProject id|
id := self theSingleSelectedProject asSymbol.
theProject := Project projectWithId:id.
theProject isNil ifTrue:[
"/ create it
theProject := Project new.
theProject name:id.
theProject package:id.
].
Project current:theProject.
!
projectMenuMetricsSummary
|codeView resultStream |
OOM::MetricsSummaryGenerator isNil ifTrue:[
Dialog warn:('The metrics package is not loaded').
^ self
].
(self askIfModified:'Code was modified.\\Show metrics anyway ?') ifFalse:[^ self].
codeView := self codeView.
codeView contents:nil.
codeView modified:false.
navigationState realModifiedState:false.
"/
"/TODO:
"/ Number of top-level classes.
"/ Cyclomatic complexity.
"/ Total cyclomatic complexity.
resultStream := WriteStream on:''.
self
projectMenuWithAllClassesLoadedDo:[:module :package :classesInProject |
|moduleAndPackage text metrics allClasses|
moduleAndPackage := module , ':' , package.
self busyLabel:'Computing metrics for ' , moduleAndPackage , '...'.
Transcript showCR:'Computing metrics for ' , moduleAndPackage , '...'.
allClasses := OrderedCollection new.
allClasses addAll:classesInProject.
classesInProject do:[:eachClass |
allClasses addAll:(eachClass allPrivateClasses).
].
metrics := OOM::MetricsSummaryGenerator new.
metrics computeMetricsForClasses:allClasses.
text := metrics generateSummaryReport.
resultStream nextPutLine:'Package: ', moduleAndPackage.
resultStream cr.
resultStream nextPutLine:text.
].
codeView contents:(resultStream contents).
codeView modified:false.
navigationState realModifiedState:false.
!
projectMenuMoveUnassignedMethodsToClassProject
|noProjectID|
noProjectID := PackageId noProjectID.
Method
allInstancesForWhich:[:m | m package == noProjectID]
do:[:m |
|mclass classPackage|
(mclass := m mclass) notNil ifTrue:[
(classPackage := mclass package) ~= noProjectID ifTrue:[
Transcript show:'move '; show:m; show:' to '; showCR:classPackage.
"/ m package:classPackage
].
].
].
!
projectMenuNew
|projectDefinitionClass appClassName theCode appClass package category
defaultStartupClassName startupClassName startupClass change|
projectDefinitionClass := self projectDefinitionDialogFor:nil.
projectDefinitionClass isNil ifTrue:[
^ self
].
package := projectDefinitionClass package.
Class packageQuerySignal answer:package
do:[
projectDefinitionClass compileDescriptionMethods.
self selectClass:projectDefinitionClass.
category := projectDefinitionClass name copyReplaceAll:$_ with:$-.
projectDefinitionClass isApplicationDefinition ifTrue:[
projectDefinitionClass isGUIApplication ifTrue:[
appClassName := Dialog
request:(resources stringWithCRs:'Create initial application class?\(Enter name or cancel)').
appClassName notEmptyOrNil ifTrue:[
(appClass := environment classNamed:appClassName) notNil ifTrue:[
Dialog warn:(resources stringWithCRs:'Application class already exists\(in "%1")' with:appClass package).
] ifFalse:[
theCode :=
'ApplicationModel subclass: #''%1''
instanceVariableNames:'' ''
classVariableNames:'' ''
poolDictionaries:'' ''
category:''%2''
' bindWith:appClassName with:category.
self canUseRefactoringSupport ifTrue:[
change := AddClassChange definition: theCode.
"/ change changeClassName:appClassName asSymbol.
change name:('Create application class %1' bindWith:appClassName).
RefactoryChangeManager performChange:change
] ifFalse:[
self
doAcceptClassDefinition:theCode
usingCompiler:Compiler.
].
appClass := environment classNamed:appClassName.
appClass package:package.
self classMenuGenerateApplicationCodeForClasses:{ appClass }.
appClass instAndClassMethodsDo:[:m | m package:package].
].
] ifFalse:[
appClassName := nil "/ for xxx below
].
defaultStartupClassName := (appClassName ? 'xxx'),'Start'.
(environment classNamed:defaultStartupClassName) notNil ifTrue:[
defaultStartupClassName := nil
].
startupClassName := Dialog
request:(resources
stringWithCRs:'Create startup class (e.g. main)?\(Enter name or cancel)')
initialAnswer:defaultStartupClassName.
] ifFalse:[
startupClassName := Dialog
request:(resources stringWithCRs:'Create main class?\(Enter name or cancel)').
].
startupClassName notEmptyOrNil ifTrue:[
(startupClass := environment classNamed:startupClassName) notNil ifTrue:[
Dialog warn:(resources stringWithCRs:'Startup class already exists\(in "%1")' with:startupClass package).
] ifFalse:[
theCode := '
StandaloneStartup subclass: #''%1''
instanceVariableNames:'' ''
classVariableNames:'' ''
poolDictionaries:'' ''
category:''%2''
' bindWith:startupClassName with:category.
self canUseRefactoringSupport ifTrue:[
change := AddClassChange definition: theCode.
"/ change changeClassName:startupClassName asSymbol.
change name:('Create startup class %1' bindWith:startupClassName).
RefactoryChangeManager performChange:change
] ifFalse:[
self doAcceptClassDefinition:theCode usingCompiler:Compiler.
].
(startupClass := environment classNamed:startupClassName) notNil ifTrue:[
startupClass package:package.
]
].
"/ update the classList, again
projectDefinitionClass compileDescriptionMethods.
"/ generate startupClass code
startupClass notNil ifTrue:[
SmalltalkCodeGeneratorTool
compile:(projectDefinitionClass startupClassName_codeFor:(startupClass name))
forClass:projectDefinitionClass theMetaclass
inCategory:'description - startup'.
self classMenuGenerateApplicationCodeForClasses:{ startupClass }.
startupClass instAndClassMethodsDo:[:m | m package:package].
].
].
self selectClass:(appClass ? startupClass ? projectDefinitionClass).
]
].
"Modified: / 04-09-2013 / 17:46:28 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 06-06-2016 / 11:57:16 / cg"
!
projectMenuOpenResourceFileEditor
Tools::InternationalLanguageTranslationEditor openOnPackage:self theSingleSelectedProject
!
projectMenuProperties
|project defClass|
project := self theSingleSelectedProject.
project isNil ifTrue:[^ self ].
project asPackageId directory isEmptyOrNil ifTrue:[
Dialog warn:(resources
stringWithCRs:'"%1" is a topLevel module identifier.\\Real packages are required to consist of module:directory (i.e. %1:xxx).\Please create a package below this module first'
with:(ProjectDefinition projectDefinitionClassNameForDefinitionOf:project)).
].
defClass := ProjectDefinition definitionClassForPackage:project.
defClass isNil ifTrue:[
Dialog warn:(resources
string:'Missing ProjectDefinition class: %1'
with:(ProjectDefinition projectDefinitionClassNameForDefinitionOf:project)).
^ self
].
Tools::ProjectDefinitionEditor new
definitionClass:defClass;
open
"Modified: / 20-01-2012 / 16:36:32 / cg"
!
projectMenuRecompile
|selectedProjects allIncluded projectDefinitionClasses|
self selectedProjectClasses do:[:eachClass |
self recompileClass:eachClass
].
"/ do not forget extensions
selectedProjects := self selectedProjects value.
allIncluded := selectedProjects includes:(BrowserList nameListEntryForALL).
allIncluded ifTrue:[
projectDefinitionClasses :=
ProjectDefinition withAllSubclasses reject:[:c | c isAbstract].
] ifFalse:[
projectDefinitionClasses :=
selectedProjects collect:[:p | p asPackageId projectDefinitionClass].
].
projectDefinitionClasses do:[:each |
each extensionMethods do:[:mthd | mthd mclass recompile:mthd selector].
].
"Created: / 31-05-2012 / 12:03:19 / cg"
!
projectMenuRecompileInstrumented
self selectedProjectClasses do:[:eachClass |
self recompileClassWithInstrumentation:eachClass
].
self showInfo:nil.
self askForGlobalCoverageRecording.
"Created: / 27-04-2010 / 12:39:43 / cg"
"Modified: / 30-09-2011 / 12:39:19 / cg"
!
projectMenuRegenerateProjectContentsDefinitions
|projectClasses|
projectClasses := self projectDefinitionClassesForSelectedProjects.
self updateProjectContentsDefinitionsIn:projectClasses regenerate:true
"Created: / 10-10-2006 / 21:05:51 / cg"
!
projectMenuRemove
(self selectedProjects value includes:(BrowserList nameListEntryForALL)) ifTrue:[
self warn:'I won''t do that !!'.
^ self
].
self withWaitCursorDo:[
self selectedProjectsDo:[:packageToRemove |
self projectMenuRemoveProject:packageToRemove
]
]
!
projectMenuRemoveProject:projectToRemove
"remove a project - removes all classes and extensions for that project"
|classesToRemove methodsToRemove msg|
classesToRemove := IdentitySet new.
methodsToRemove := IdentitySet new.
"/ classes ...
"/ ... and individual methods (extensions)
environment 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'
!
projectMenuRepositoryHistoryUsingManager: manager
|projects|
projects := self selectedProjects value.
projects size == 0 ifTrue:[projects := nil].
self repositoryHistoryForProjects:projects usingManager: manager
"Modified: / 12-09-2006 / 15:06:02 / cg"
"Created: / 15-10-2011 / 22:59:02 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Created: / 21-12-2011 / 20:20:03 / cg"
!
projectMenuRepositoryHistoryUsingManagerNamed: sourceCodeManagerClassName
self projectMenuRepositoryHistoryUsingManager: (self sourceCodeManagerNamed:sourceCodeManagerClassName)
!
projectMenuResources
self projectMenuResourcesUsingManager:SourceCodeManager
!
projectMenuResourcesUsingManager:aManager
self information:'Sorry - this functionality is not yet implemented'
!
projectMenuRewrite
MethodRewriter new
projects: self selectedProjectsValue;
open
!
projectMenuSetTagOfBuildSupportFilesUsingManager:aManager
|tag|
SourceCodeManagerError handle:[:ex |
Dialog
warn:(resources
stringWithCRs:'CVS Error:\\%1'
with:ex description).
] do:[
self selectedProjectsDo:[:prj |
|packageId defClass paths|
packageId := prj asPackageId.
defClass := ProjectDefinition definitionClassForPackage:packageId createIfAbsent:false.
tag := self askForTagForClasses:{ defClass }.
tag isEmptyOrNil ifTrue:[^ self ].
self withWaitCursorDo: [
paths := OrderedCollection new.
defClass forEachFileNameAndGeneratedContentsDo:[:fileName :fileContents |
paths add:(packageId pathRelativeToTopDirectory,'/',fileName). "/ always unix names
].
aManager
setSymbolicName:tag
revision:nil
overWrite:true
pathes:paths
].
]
].
"Created: / 29-07-2013 / 09:49:58 / cg"
!
projectMenuSetTagOfBuildSupportFilesUsingManagerNamed: sourceCodeManagerClassName
self projectMenuSetTagOfBuildSupportFilesUsingManager: (self sourceCodeManagerNamed:sourceCodeManagerClassName)
!
projectMenuSetTagUsingManager:aManager
|tag allClasses|
tag := self askForTagForClasses:(self selectedProjectClasses).
tag isEmptyOrNil ifTrue:[^ self ].
self withWaitCursorDo: [
allClasses := OrderedCollection new.
self selectedProjectsDo:[:packageToTag |
allClasses addAll:((Smalltalk allClassesInPackage:packageToTag)
asOrderedCollection reject:[:cls | cls isPrivate]).
].
aManager utilities tagClasses:allClasses as:tag.
]
"Created: / 12-09-2006 / 13:25:09 / cg"
"Modified: / 15-10-2011 / 22:45:31 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 29-07-2013 / 09:23:53 / cg"
!
projectMenuSetTagUsingManagerNamed: sourceCodeManagerClassName
self projectMenuSetTagUsingManager: (self sourceCodeManagerNamed:sourceCodeManagerClassName)
!
projectMenuShowGeneratedBuildFile:whichFile
"/ intermediate - this will be removed later
|package defClass newFile oldFile editor differ theFile missingName|
self hasProjectDefinitionSelected ifTrue:[
self hasSingleClassSelected ifTrue:[
defClass := self theSingleSelectedClass
].
defClass isNil ifTrue:[
self warn:(resources string:'Please select a single project definition class').
^ self.
].
defClass := defClass theNonMetaclass.
package := defClass package.
] ifFalse:[
self hasSingleProjectSelected ifTrue:[
package := self theSingleSelectedProject.
defClass := ProjectDefinition definitionClassForPackage:package.
defClass isNil ifTrue:[
self warn:(resources string:'Missing project definition class (%1)\for package: %2.'
with:(ProjectDefinition projectDefinitionClassNameForDefinitionOf:package)
with:package allBold).
^ self.
].
]
].
theFile := whichFile.
theFile = 'lib.rc' ifTrue:[
theFile := defClass rcFilename.
].
theFile = 'app.nsi' ifTrue:[
theFile := defClass nsiFilename.
].
(missingName := defClass allClassNames "compiled_classNames"
detect:[:aName |
|cls|
cls := environment at:aName asSymbol.
cls isNil
]
ifNone:nil)
notNil ifTrue:[
(Dialog confirm:(resources stringWithCRs:'Some class (%1) from the list of compiled classes is missing in the image!!\\Continue anyway ?'
with:missingName))
ifFalse:[^ self ].
].
whichFile = 'abbrev.stc' ifTrue:[
(defClass compiled_classNames
contains:[:aName |
|cls|
cls := environment at:aName asSymbol.
cls notNil and:[cls isLoaded not]
])
ifTrue:[
(Dialog confirm:'Autoload missing class(es) ?\\Notice: generated abbrev.stc file is wrong if autoloaded classes are unloaded' withCRs) ifTrue:[
defClass compiled_classNames do:[:aName |
(environment at:aName asSymbol) autoload
].
].
].
].
[
newFile := defClass generateFile:theFile.
] on:Error do:[:ex|
self errorNotify:ex description.
^ self.
].
SourceCodeManager notNil ifTrue:[
oldFile := SourceCodeManager
getFile:theFile
revision:#newest
directory:(package asPackageId directory)
module:(package asPackageId module).
].
oldFile isNil ifTrue:[
editor := EditTextView openOnModel:newFile.
editor topView label:(resources string:'Generated %1' with:theFile).
] ifFalse:[
differ := DiffCodeView
openOn:oldFile label:(resources string:'Newest %1 in Repository' with:theFile)
and:newFile label:(resources string:'Generated %1' with:theFile)
title:(resources string:'Comparing %1' with:whichFile).
].
"Created: / 29-08-2006 / 15:35:44 / cg"
"Modified: / 12-09-2011 / 16:03:28 / cg"
!
projectMenuShowGeneratedBuildFile:whichFile usingManager: manager
"/ intermediate - this will be removed later
|package defClass newFile oldFile editor differ theFile missingName|
self hasProjectDefinitionSelected ifTrue:[
self hasSingleClassSelected ifTrue:[
defClass := self theSingleSelectedClass
].
defClass isNil ifTrue:[
self warn:(resources string:'Please select a single project definition class').
^ self.
].
defClass := defClass theNonMetaclass.
package := defClass package.
] ifFalse:[
self hasSingleProjectSelected ifTrue:[
package := self theSingleSelectedProject.
defClass := ProjectDefinition definitionClassForPackage:package.
defClass isNil ifTrue:[
self warn:(resources string:'Missing project definition class (%1)\for package: %2.'
with:(ProjectDefinition projectDefinitionClassNameForDefinitionOf:package)
with:package allBold).
^ self.
].
]
].
theFile := whichFile.
theFile = 'lib.rc' ifTrue:[
theFile := defClass rcFilename.
].
theFile = 'app.nsi' ifTrue:[
theFile := defClass nsiFilename.
].
(missingName := defClass allClassNames "compiled_classNames"
detect:[:aName |
|cls|
cls := environment at:aName asSymbol.
cls isNil
]
ifNone:nil)
notNil ifTrue:[
(Dialog confirm:(resources stringWithCRs:'Some class (%1) from the list of compiled classes is missing in the image!!\\Continue anyway ?'
with:missingName))
ifFalse:[^ self ].
].
whichFile = 'abbrev.stc' ifTrue:[
(defClass compiled_classNames
contains:[:aName |
|cls|
cls := environment at:aName asSymbol.
cls notNil and:[cls isLoaded not]
])
ifTrue:[
(Dialog confirm:'Autoload missing class(es) ?\\Notice: generated abbrev.stc file is wrong if autoloaded classes are unloaded' withCRs) ifTrue:[
defClass compiled_classNames do:[:aName |
(environment at:aName asSymbol) autoload
].
].
].
].
[
newFile := defClass generateFile:theFile.
] on:Error do:[:ex|
self errorNotify:ex description.
^ self.
].
manager notNil ifTrue:[
oldFile := manager
getFile:theFile
revision:#newest
directory:(package asPackageId directory)
module:(package asPackageId module).
].
oldFile isNil ifTrue:[
editor := EditTextView openOnModel:newFile.
editor topView label:(resources string:'Generated %1' with:theFile).
] ifFalse:[
differ := DiffCodeView
openOn:oldFile label:(resources string:'Newest %1 in Repository' with:theFile)
and:newFile label:(resources string:'Generated %1' with:theFile).
].
"Modified: / 12-09-2011 / 16:03:28 / cg"
"Created: / 12-10-2011 / 19:02:44 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Created: / 21-12-2011 / 20:24:42 / cg"
!
projectMenuSmalllintCheck: what
"perform all checks on the selected project's class(es)."
self smalllintRun:what onEnvironment:self selectedPackagesAsEnvironment
"Created: / 05-05-2012 / 10:19:44 / cg"
!
projectMenuSpawn
"open a browser showing the selected projects only"
self spawnProjectBrowserFor:(self selectedProjects value) in:#newBrowser
"Created: / 24.2.2000 / 21:42:26 / cg"
!
projectMenuSpawnAllPrerequisitesBrowser
"add a browser showing projects which are prerequisite to the selected project(s)"
self spawnProjectAllPrerequisitesFor:(self selectedProjects value) in:#newBrowser
!
projectMenuSpawnAllPrerequisitesBuffer
"add a buffer showing projects which are prerequisite to the selected project(s)"
self spawnProjectAllPrerequisitesFor:(self selectedProjects value) in:#newBuffer
!
projectMenuSpawnBuffer
"add a buffer showing the selected projects only"
self spawnProjectBrowserFor:(self selectedProjects value) in:#newBuffer
"Created: / 24.2.2000 / 21:42:40 / cg"
!
projectMenuSpawnExtensionsBrowser
"open a browser showing the selected projects extensions only"
self spawnProjectExtensionBrowserFor:(self selectedProjects value) in:#newBrowser
!
projectMenuSpawnExtensionsBuffer
"add a buffer showing the selected projects extensions only"
self spawnProjectExtensionBrowserFor:(self selectedProjects value) in:#newBuffer
!
projectMenuSpawnPreRequirerBrowser
"open a browser showing projects which have the selected project(s) as prerequisite"
self spawnProjectPreRequirerBrowserFor:(self selectedProjects value) in:#newBrowser
"Created: / 23-01-2007 / 19:23:43 / cg"
!
projectMenuSpawnPreRequirerBuffer
"add a buffer showing projects which have the selected project(s) as prerequisite"
self spawnProjectPreRequirerBrowserFor:(self selectedProjects value) in:#newBuffer
"Created: / 23-01-2007 / 19:23:32 / cg"
!
projectMenuSpawnReferencesBrowser
"open a browser showing projects which have the selected project(s) as prerequisite or subProject"
self spawnProjectReferencesBrowserFor:(self selectedProjects value) in:#newBrowser
!
projectMenuSpawnReferencesBuffer
"add a buffer showing projects which have the selected project(s) as prerequisite or subProject"
self spawnProjectReferencesBrowserFor:(self selectedProjects value) in:#newBuffer
!
projectMenuUpdate
self projectListApp forceUpdateList
!
projectMenuUpdateProjectContentsDefinitions
|projectClasses|
projectClasses := self projectDefinitionClassesForSelectedProjects.
self updateProjectContentsDefinitionsIn:projectClasses regenerate:false
"Created: / 10-10-2006 / 20:59:14 / cg"
!
projectMenuWithAllClassesLoadedDo:aBlock
"/ helper for gen-abbrev and gen-loadAll
"/ intermediate - this will move into a commonly used utility class
"/ (where all the project code support will be collected).
SourceCodeManager isNil ifTrue:[^ self warn:'No SourceCodeManagement is configured.'].
self withWaitCursorDo:[
|classesToLoad classesToUnload answer outStream classesSorted|
self selectedProjectsDo:[:packageToCheck |
|module package containers classesInProject classesWithoutContainer|
module := packageToCheck asPackageId module.
package := packageToCheck asPackageId directory.
"/ containers := SourceCodeManager getExistingContainersInModule:module package:package.
"/ containers := containers select:[:each | (each startsWith:'.') not].
classesInProject := IdentitySet new.
environment allClassesDo:[:aClass |
(packageToCheck = aClass package) ifTrue:[
aClass isPrivate ifFalse:[
aClass isObsolete ifTrue:[
Transcript showCR:'skipping obsolete class: ' , aClass name.
] ifFalse:[
classesInProject add:aClass .
]
]
]
].
"/ load unloaded classes...
classesToLoad := OrderedCollection new.
classesInProject do:[:eachClassInProject |
eachClassInProject isLoaded ifFalse:[
classesToLoad add:eachClassInProject
].
].
classesToLoad size > 0 ifTrue:[
answer := Dialog confirmWithCancel:(resources string:'%1 class(es) are not loaded.\In order to proceed, these must be loaded first.\\Load them now ?'
with:classesToLoad size) withCRs
default:false.
answer isNil ifTrue:[^ self].
answer ifTrue:[
self busyLabel:'Autoloading all classes in ' , packageToCheck , '...'.
classesToUnload := OrderedCollection new.
classesInProject do:[:eachClassInProject |
eachClassInProject isLoaded ifFalse:[
eachClassInProject autoload.
classesToUnload add:eachClassInProject
].
].
].
].
self busyLabel:'Checking for classes without container in ' , packageToCheck , '...'.
"/ any class without container ?
classesWithoutContainer := IdentitySet new.
classesInProject do:[:eachClassInProject |
|mgr info classesModule classesPackageDir classesContainerFileName|
eachClassInProject isPrivate ifFalse:[
mgr := SourceCodeManagerUtilities sourceCodeManagerFor:eachClassInProject.
info := mgr sourceInfoOfClass:eachClassInProject.
info isNil ifTrue:[
"/ no container for that class
classesWithoutContainer add:eachClassInProject
].
].
].
"/ any container left ?
classesWithoutContainer notEmpty ifTrue:[
answer := Dialog warn:(resources string:'%1 class(es) have no container in the repository.\\Please do not forget to check them in.'
with:classesToLoad size) withCRs.
].
aBlock value:module value:package value:classesInProject.
classesToUnload size >0 ifTrue:[
answer := Dialog confirm:(resources string:'%1 class(es) were loaded - unload them now ?'
with:classesToLoad size)
default:false.
answer ifTrue:[
self busyLabel:'Unloading autoloaded classes in ' , packageToCheck , '...'.
"/ unload classes which have been loaded temporarily
classesToUnload do:[:eachClassToUnload |
eachClassToUnload unload
].
]
]
].
].
self normalLabel
"Modified: / 12-09-2006 / 14:22:58 / cg"
!
projectPackageDependencyBrowser
"find methods in a particular release of a set of pacakges
called by a set of packages from a particular release in another set of packages.
Answers the question of which release of the base st/x is required to execute
a particular release of a product (such as expecco).
Releases are specified by their tag."
|packagesToFindMissing packagesToFindCalled classesToFindMissing classesToFindCalled projectList1 projectList2 knownTags1 knownTags2
projectListView1 projectListView2 dialog releaseHolder1 releaseHolder2 manager
methodsImplemented skipAutoloaded cacheTagMappingsHolder packageHull|
manager := SourceCodeManager.
skipAutoloaded := true.
releaseHolder1 := SourceCodeManager recentTag asValue.
releaseHolder2 := 'stable' asValue.
packagesToFindMissing := self selectedProjectsValue.
packagesToFindMissing isEmptyOrNil ifTrue:[^self].
projectList1 := ProjectList "HierarchicalProjectList" new.
projectList1 createBuilder.
projectListView1 := ApplicationSubView new client:projectList1.
projectList2 := ProjectList "HierarchicalProjectList" new.
projectList2 createBuilder.
projectListView2 := ApplicationSubView new client:projectList2.
projectList1 selectedProjects value:packagesToFindMissing.
projectList2 selectedProjects value:#('stx').
packageHull :=
[:packageIDs |
environment allPackageIDs
select:[:p |
packageIDs
contains:[:packageId |
p = packageId
or:[ (p startsWith:packageId,':')
or:[ (p startsWith:packageId,'/') ]]]
]
].
knownTags1 := (self allKnownTagsInClasses:((packageHull value:projectList1 selectedProjects value)
collect:[:id | ProjectDefinition definitionClassForPackage:id]
thenSelect:[:c | c notNil]))
asOrderedCollection reverse.
knownTags2 := (self allKnownTagsInClasses:((packageHull value:projectList2 selectedProjects value)
collect:[:id | ProjectDefinition definitionClassForPackage:id]
thenSelect:[:c | c notNil]))
asOrderedCollection reverse.
dialog := Dialog new.
dialog addCheckBox:'Cache tag -> revision mappings (speedup)' on:(cacheTagMappingsHolder := true asValue) tabable:true.
dialog addMessage:'Find (possible) calls from projects:' centered:false.
dialog leftIndent:30.
(dialog addComponent:projectListView1) width:1.0.
dialog addMessage:'with release:' centered:false.
dialog addComboListOn:releaseHolder1 list:knownTags1 tabable:true.
dialog leftIndent:0.
dialog addMessage:'into projects:' centered:false.
dialog leftIndent:30.
dialog addComponent:projectListView2.
dialog addMessage:'with release:' centered:false.
dialog addComboListOn:releaseHolder2 list:knownTags2 tabable:true.
dialog leftIndent:0.
dialog addAbortAndOkButtons.
dialog extent:400@400.
dialog open.
dialog accepted ifFalse:[ ^ self].
cacheTagMappingsHolder value ifTrue:[
CachedTagToRevisionMapping isNil ifTrue:[
CachedTagToRevisionMapping := Dictionary new
].
].
packagesToFindMissing := projectList1 selectedProjects value.
packagesToFindCalled := projectList2 selectedProjects value.
classesToFindMissing := environment allClasses select:[:cls |
|p|
p := cls package.
p notNil
and:[cls isPrivate not
and:[ packagesToFindMissing contains:[:p2 | (p2 = p)
or:[(p startsWith:(p2,'/'))
or:[p startsWith:(p2,':')]]]]]
].
classesToFindMissing := classesToFindMissing asOrderedCollection sort:[:a :b | a name < b name].
classesToFindCalled := environment allClasses select:[:cls |
|p|
p := cls package.
p notNil
and:[cls isPrivate not
and:[ packagesToFindCalled contains:[:p2 | (p2 = p)
or:[(p startsWith:(p2,'/'))
or:[p startsWith:(p2,':')]]]]]
].
classesToFindCalled := classesToFindCalled asOrderedCollection sort:[:a :b | a name < b name].
"/ CachedMethodsImplemented := methodsImplemented.
methodsImplemented := CachedMethodsImplemented.
methodsImplemented isNil ifTrue:[
methodsImplemented := Set new.
classesToFindCalled do:[:eachClass |
|tag stream changeSet|
(eachClass isLoaded or:[skipAutoloaded not]) ifTrue:[
[
|rev|
tag := releaseHolder2 value.
cacheTagMappingsHolder value ifTrue:[
rev := (CachedTagToRevisionMapping at:tag ifAbsentPut:[Dictionary new])
at:eachClass name ifAbsent:nil.
].
rev isNil ifTrue:[
rev := manager utilities
revisionForSymbolicName:tag
class:eachClass
fileName:(eachClass classFilename)
directory:(eachClass package asPackageId directory)
module:(eachClass package asPackageId module)
manager:manager.
].
rev isNil ifTrue:[
Dialog warn:(resources string:'No version of %1 tagged as %2' with:eachClass name with:tag).
] ifFalse:[
self activityNotification:'reading ',eachClass name,'...'.
stream := manager getSourceStreamFor:eachClass revision:rev.
stream isNil ifTrue:[
"/ class is autoloaded AND does not have a computable class name (would need conultation of abbrev file)
Dialog warn:(resources string:'Cannot extract source of %1 (rev %2)' with:eachClass name with:rev).
] ifFalse:[
changeSet := ChangeSet fromStream:stream.
methodsImplemented addAll:(changeSet changeSelectors).
].
cacheTagMappingsHolder value ifTrue:[
(CachedTagToRevisionMapping at:tag ifAbsentPut:[Dictionary new])
at:eachClass name put:rev.
].
].
] ensure:[
stream notNil ifTrue:[ stream close ].
].
].
].
].
classesToFindMissing do:[:eachClass |
|tag stream changeSet|
(eachClass isLoaded or:[skipAutoloaded not]) ifTrue:[
[
|rev|
tag := releaseHolder1 value.
cacheTagMappingsHolder value ifTrue:[
rev := (CachedTagToRevisionMapping at:tag ifAbsentPut:[Dictionary new])
at:eachClass name ifAbsent:nil.
].
rev isNil ifTrue:[
rev := manager utilities
revisionForSymbolicName:tag
class:eachClass
fileName:(eachClass classFilename)
directory:(eachClass package asPackageId directory)
module:(eachClass package asPackageId module)
manager:manager.
].
rev isNil ifTrue:[
Dialog warn:(resources string:'No version of %1 tagged as %2' with:eachClass name with:tag).
] ifFalse:[
self activityNotification:'reading ',eachClass name,'...'.
stream := manager getSourceStreamFor:eachClass revision:rev.
stream isNil ifTrue:[
"/ class is autoloaded AND does not have a computable class name (would need conultation of abbrev file)
Dialog warn:(resources string:'Cannot extract source of %1 (rev %2)' with:eachClass name with:rev).
] ifFalse:[
changeSet := ChangeSet fromStream:stream.
changeSet do:[:each |
|tree messagesSent|
messagesSent := Set new.
each isMethodCodeChange ifTrue:[
tree := RBParser parseMethod:(each source) onError:[:aString :pos | nil].
tree notNil ifTrue:[
tree nodesDo:[:eachNode |
eachNode isMessage ifTrue:[
messagesSent add:( eachNode selector ).
self halt.
] ifFalse:[
eachNode isVariable ifTrue:[
self halt.
]
]
].
].
tree halt.
].
]
].
cacheTagMappingsHolder value ifTrue:[
(CachedTagToRevisionMapping at:tag ifAbsentPut:[Dictionary new])
at:eachClass name put:rev.
].
].
] ensure:[
stream notNil ifTrue:[ stream close ].
].
].
].
self halt.
!
saveProjectClassDocumentationIn:aDirectory using:docGenerator
"save class documentation for each of the package's classes to a directory"
self selectedProjectClasses do:[:eachClass |
|text f fn|
self showInfo:('Generating doc for %1...' bindWith:eachClass name).
text := docGenerator htmlDocOf:eachClass.
text notNil ifTrue:[
fn := eachClass classFilename asFilename withSuffix:'html'.
f := (aDirectory construct:fn) writeStream.
f nextPutAll:text asString.
f close.
]
].
self showInfo:'Done.'.
!
selectedProjectsDo:aBlock
|selectedProjects allProjects|
selectedProjects := self selectedProjects value ? #().
(selectedProjects includes:BrowserList nameListEntryForALL) ifTrue:[
allProjects := environment allClasses collect:[:eachClass | eachClass package] as:Set.
selectedProjects := allProjects select:[:each| each notNil].
].
selectedProjects := selectedProjects collect: [ :pkg | pkg string ] as: OrderedCollection.
selectedProjects sort do:aBlock
"Modified: / 03-07-2020 / 13:42:04 / Jan Vrany <jan.vrany@labware.com>"
!
spawnProjectAllPrerequisitesFor:someProjects in:how
"open a browser/buffer showing projects which are prerequisite of the selected project(s)"
|addPkg allPrereqs lbl already brwsr delta|
delta := 4.
allPrereqs := OrderedCollection new.
already := Set new.
addPkg :=
[:package :lvl |
|projectDefinition indent|
indent := String new:lvl.
allPrereqs add:(indent,package).
already add:package.
projectDefinition := ProjectDefinition definitionClassForPackage:package string.
projectDefinition notNil ifTrue:[
(projectDefinition effectivePreRequisites) do:[:eachPrereq |
(already includes:eachPrereq) ifFalse:[
addPkg value:eachPrereq value:lvl+delta
] ifTrue:[
indent := String new:lvl+delta.
allPrereqs add:(indent,(eachPrereq withColor:Color grey)).
].
].
].
].
someProjects do:[:each | addPkg value:each value:0].
allPrereqs isEmpty ifTrue:[
Dialog warn:'No prerequisites found.'.
^ self.
].
someProjects size == 1 ifTrue:[
lbl := resources string:'All prerequisites of package "%1"' with:someProjects first
] ifFalse:[
lbl := resources string:'All prerequisites any of %1 packages' with:someProjects size
].
brwsr := self spawnProjectBrowserFor:allPrereqs label:lbl in:how sort:false.
!
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"
^ self spawnProjectBrowserFor:projects label:nil in:where
!
spawnProjectBrowserFor:projects label:labelOrNil 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"
^ self
spawnProjectBrowserFor:projects label:labelOrNil in:where sort:true
!
spawnProjectBrowserFor:projects label:labelOrNil in:where sort:sortItems
"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 brwsr|
(singleSelection := projects size == 1) ifTrue:[
"/ spec := #singleProjectBrowserSpec.
spec := #singleProjectFullBrowserSpec.
] ifFalse:[
"/ spec := #multipleProjectBrowserSpec.
spec := #multipleProjectFullBrowserSpec.
].
projectList := projects copy.
brwsr := self
newBrowserOrBufferDependingOn:where
label:labelOrNil
forSpec:spec
setupWith:[:brwsr |
"/ setup for a constant list ...
brwsr projectListApp includedPseudoEntryForChanged:false.
brwsr immediateUpdate value:true.
brwsr projectListApp slaveMode:false.
sortItems ifFalse:[ brwsr projectListApp sortBy value:#keep ].
brwsr organizerMode value:#project.
brwsr projectListGenerator value:projectList.
brwsr packageFilter value:projectList.
brwsr selectProject:(singleSelection ifTrue:[projectList anElement] ifFalse:[BrowserList nameListEntryForALL]).
brwsr selectCategory:(BrowserList nameListEntryForALL).
brwsr immediateUpdate value:false.
].
^ brwsr
"Modified: / 23-01-2007 / 19:42:18 / cg"
!
spawnProjectExtensionBrowserFor:projects in:where
"browse selected project(s) extensions;
where is: #newBrowser - open a new browser showing the projects
where is: #newBuffer - add a new buffer showing the projects"
|classes title|
classes := environment allClasses
reject:[:each | (projects includes:each package) ].
projects size == 1 ifTrue:[
title := 'Extensions for Project ''' , projects first , ''''
] ifFalse:[
title := 'Extensions for Projects'
].
^ self
browseMenuClassExtensionsFor:projects
in:classes
label:title
openAs:where
!
spawnProjectPreRequirerBrowserFor:someProjects in:how
"open a browser/buffer showing projects which have the selected project(s) as prerequisite"
|requirer lbl|
requirer := Set new.
ProjectDefinition allSubclassesDo:[:eachProjectDefinition |
(eachProjectDefinition effectivePreRequisites includesAny:someProjects) ifTrue:[
requirer add:(eachProjectDefinition package).
]
].
requirer isEmpty ifTrue:[
Dialog warn:'Noone seems to require this package (not found in any prerequisites).'.
^ self.
].
someProjects size == 1 ifTrue:[
lbl := resources string:'Projects which require package "%1"' with:someProjects first
] ifFalse:[
lbl := resources string:'Projects which require any of %1 packages' with:someProjects size
].
self
spawnProjectBrowserFor:(requirer asOrderedCollection sort)
label:lbl
in:how
"Created: / 23-01-2007 / 19:25:00 / cg"
!
spawnProjectReferencesBrowserFor:collectionOfPackageIds in:openHow
"add a buffer / open a new browser showing references to the given packageIDs
from other projects (i.e. prerequisites, subprojects etc.)"
|packages lbl|
packages := Set new.
ProjectDefinition allSubclasses do:[:eachProjectDefinition |
eachProjectDefinition preRequisites do:[:eachPrereqPackage |
(collectionOfPackageIds includes:eachPrereqPackage) ifTrue:[
packages add:eachProjectDefinition package
].
].
eachProjectDefinition subProjects do:[:eachSubProject |
(collectionOfPackageIds includes:eachSubProject) ifTrue:[
packages add:eachProjectDefinition package
].
].
].
collectionOfPackageIds size == 1 ifTrue:[
lbl := resources string:'References to package "%1"' with:collectionOfPackageIds first
] ifFalse:[
lbl := resources string:'References to any of %1 packages' with:collectionOfPackageIds size
].
self spawnProjectBrowserFor:packages label:lbl in:openHow
!
updateProjectContentsDefinitionsIn:classes regenerate:doRegenerate
self
generateUndoableChange:(doRegenerate ifTrue:'Generate Project Definitions' ifFalse:'Update Project Definitions')
overClasses:classes
via:[:generator :eachClass |
eachClass theNonMetaclass
updateContentsMethodsCodeUsingCompiler:generator
ignoreOldDefinition:doRegenerate.
"/ Class packageQuerySignal
"/ answer:eachClass package
"/ do:[
"/ eachClass theNonMetaclass
"/ forEachContentsMethodsCodeToCompileDo:
"/ [:code :category |
"/ generator
"/ compile:code
"/ forClass:eachClass theMetaclass
"/ inCategory:category.
"/ ]
"/ ignoreOldDefinition:doRegenerate
"/ ].
].
"Created: / 10-10-2006 / 21:05:14 / cg"
"Modified: / 23-10-2006 / 11:01:42 / cg"
!
validateProjectDefinition:defClass
SourceCodeManagerUtilities basicNew validateConsistencyOfPackage:defClass package
! !
!NewSystemBrowser methodsFor:'menu actions-project-monticello'!
projectMenuMonticelloBrowseRepositories
MCRepositoryBrowser openOnPrimaryRepositoryForPackage:(self theSingleSelectedProject).
"Created: / 01-12-2011 / 21:47:24 / cg"
! !
!NewSystemBrowser methodsFor:'menu actions-protocol'!
doMoveSelectedProtocolsToProject:newProject
"change the package-id of all methods in the selected protocols.
Will eventually update the Project-object"
self withWaitCursorDo:[
self selectedProtocolMethodsDo:[:cls :protocol :sel :eachMethod |
eachMethod package:newProject.
].
self rememberLastProjectMoveTo:newProject
].
"Modified: / 08-09-2011 / 04:17:32 / cg"
!
doRemoveProtocolAndSelect:nilOrNextOrPrevious
"confirm removal of the selected protocols.
The argument is meant to control the bahavior of the protocolList;
however, it is not yet implemented"
|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.
]
!
methodListMenuUpdate
self methodListApp updateList
!
printOutProtocolsWithSelector:aSelector
|printStream|
printStream := Printer new.
(self selectedClassesValue) 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
"Modified: / 28-02-2012 / 16:59:38 / cg"
!
protocolCheckMenuSmalllintCheck: what
"perform all checks on the selected class(es)."
self smalllintRun:what onEnvironment:self selectedProtocolsAsEnvironment
"Modified: / 28-12-2008 / 14:42:01 / bazantj <enter your email here>"
"Modified: / 13-01-2009 / 13:20:48 / Jiri Bazant <bazanj2@fel.cvut.cz>"
"Created: / 17-04-2010 / 10:49:13 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
protocolMenuCopyToClass
"copy all methods in the selected protocols to some other class."
self protocolMenuMoveOrCopy:#copy
!
protocolMenuFileOutAs
"fileOut all methods in the selected methodcategory of
the current class"
|methods protocols|
protocols := self selectedProtocolsValue.
methods := self methodListApp methodList.
methods := methods select:[:eachMethod| protocols includes:eachMethod category].
self
fileOutMethods:methods
format:nil
fileNameTemplate:self currentClass name , '-' , protocols first
boxTitle:'FileOut protocol as:'
!
protocolMenuGenerateCommonProtocols
"these are needed so often; let the browser do it for me"
|protocols|
self hasMetaSelected ifTrue:[
protocols := #('instance creation' 'documentation' 'defaults')
] ifFalse:[
protocols := #('accessing' 'adding & removing' 'testing' 'initialization' 'queries' 'private'
'printing & storing' 'change & update')
].
protocols do:[:newProtocol |
"/ self immediateUpdate value:true.
self selectedClassesDo:[:cls |
self methodCategoryListApp addAdditionalProtocol:newProtocol forClass:cls.
].
self clearAutoSelectOfLastSelectedProtocol.
"/ self immediateUpdate value:false.
].
!
protocolMenuGenerateDocumentationMethod
"these are needed so often; let the browser do it for me"
|lastClass|
self selectedClassesDo:[:cls |
self methodCategoryListApp addAdditionalProtocol:'documentation' forClass:cls.
(cls includesSelector:#documentation) ifFalse:[
cls programmingLanguage codeGeneratorClass createDocumentationMethodFor:cls.
lastClass := cls.
].
].
self clearAutoSelectOfLastSelectedProtocol.
lastClass notNil ifTrue:[
self switchToClass:lastClass selector:#documentation.
].
!
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 reversed collect:[:cls | cls name]).
subs := (currentClass allSubclasses collect:[:cls | cls name]).
list := supers.
(supers notEmpty and:[subs notEmpty]) ifTrue:[
list := list , (Array with:'---- ' , currentClass name , ' ----')
].
list := list , subs.
"/ preps to use windowSpecs ...
"/
"/ holders := IdentityDictionary new.
"/ holders at:#className put:initial asValue.
"/ holders at:#classList put:list.
"/
"/ (SystemBrowser
"/ openDialogInterface:#methodMoveDialogSpec
"/ withBindings:holders) ifFalse:[
"/ ^ self
"/ ].
"/ newClassName := (holders at:#className) value.
doWhat == #copy ifTrue:[
reqString := 'Copy selected protocols method(s) to which class:'.
okLabel := 'Copy'.
title := 'Copy protocol'.
] ifFalse:[
reqString := 'Move selected protocols method(s) to which class:'.
okLabel := 'Move'.
title := 'Move protocol'.
].
newClassName := Dialog
request:(resources string:reqString)
initialAnswer:initial
okLabel:(resources string:okLabel)
title:(resources string:title)
onCancel:nil
list:list
entryCompletionBlock:(DoWhatIMeanSupport classNameEntryCompletionBlock).
newClassName isNil ifTrue:[^ self].
(newClassName startsWith:'---- ') ifTrue:[^ self].
newClass := environment 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 newPackage|
"/ skip the version method (to avoid confusing the repository)
((AbstractSourceCodeManager isVersionMethodSelector:sel) and:[newClass isMeta]) ifFalse:[
dontDoIt := false.
selectorToCopyOrMove := methodToCopyOrMove selector.
(newClass includesSelector:selectorToCopyOrMove) ifTrue:[
question := (doWhat == #copy)
ifTrue:['%1 already implements #%2\\Copy anyway ?']
ifFalse:['%1 already implements #%2\\Move anyway ?'].
(self confirm:(resources string:question
with:newClass name allBold
with:selectorToCopyOrMove) withCRs) ifFalse:[
dontDoIt := true
]
].
dontDoIt ifFalse:[
lastMethodMoveClass := newClassName.
"/ check if the target class is in a different package;
"/ ask for the package if so
newClass package ~= methodToCopyOrMove package ifTrue:[
|labels values|
labels := { newClass package . methodToCopyOrMove package }.
values := { newClass package . methodToCopyOrMove package }.
(labels includes: PackageId noProjectID) ifFalse:[
labels := labels , { PackageId noProjectID }.
values := values , { PackageId noProjectID }.
].
labels := labels , { (resources string:'Cancel') }.
values := values , { nil }.
newPackage := OptionBox
request:(resources stringWithCRs:'Destination class %1 is in package "%2";\Source method %3 is in package "%4".\\If you choose "%2", it will be a regular method of the class,\if you choose "%4", it will be an extension method.\\Put copied method into which package?'
with:newClass name allBold
with:newClass package allBold
with:methodToCopyOrMove selector allBold
with:methodToCopyOrMove package allBold)
label:(resources string:'Package Confirmation')
image:nil
buttonLabels:labels
values:values
default:newClass package
onCancel:nil.
newPackage isNil ifTrue:[^ self].
"/ self halt.
].
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.
]
].
newPackage notNil ifTrue:[
changes notNil ifTrue:[
changes changeProjectOf:selectorToCopyOrMove in:newClass to:newPackage
] ifFalse:[
newMethod package:newPackage.
].
].
]
]
]
].
changes notNil ifTrue:[
RefactoryChangeManager performChange: changes
].
!
protocolMenuMoveToClass
"move all methods in the selected protocols to some other class."
self protocolMenuMoveOrCopy:#move
!
protocolMenuMoveToProject
"change the package-id of all methods in the selected protocols.
Will eventually update the Project-object"
|newProject|
newProject := self askForProject:'Move all methods in protocol(s) to which project:'.
newProject notNil ifTrue:[
self doMoveSelectedProtocolsToProject:newProject.
].
!
protocolMenuNew
|newProtocol classesMethodCategories allMethodCategories someMethodCategories
someRecentlyVisitedMethodCategories
cls suggestion|
LastNewProtocols notEmptyOrNil ifTrue:[
suggestion := LastNewProtocols first.
].
"/ allMethodCategories := Set new.
"/ environment allBehaviorsDo:[:eachClass |
"/ allMethodCategories addAll:eachClass categories
"/ ].
"/
SharedMethodCategoryCache isNil ifTrue:[
SharedMethodCategoryCache := MethodCategoryCache new
].
allMethodCategories := SharedMethodCategoryCache allMethodCategories.
"/ remove existing ones ...
(cls := self theSingleSelectedClass) notNil ifTrue:[
classesMethodCategories := cls categories asSet.
someMethodCategories := allMethodCategories select:[:cat | (classesMethodCategories includes:cat) not].
"/ someMethodCategories removeAllFoundIn:classesMethodCategories.
(classesMethodCategories includes:suggestion) ifTrue:[
suggestion := nil.
].
].
someMethodCategories := (someMethodCategories ? allMethodCategories) asOrderedCollection sort.
someRecentlyVisitedMethodCategories := self methodCategoryListApp lastSelectedProtocols.
someRecentlyVisitedMethodCategories notEmptyOrNil ifTrue:[
someRecentlyVisitedMethodCategories := someRecentlyVisitedMethodCategories asOrderedCollection sort.
someMethodCategories addFirst:''.
someMethodCategories addAllFirst:someRecentlyVisitedMethodCategories.
suggestion isNil ifTrue:[
suggestion := someRecentlyVisitedMethodCategories first
].
].
newProtocol := self
askForMethodCategory:'Name of new protocol:\(Tab for completion)' withCRs
title:'New MethodCategory'
okLabel:'Create'
list:someMethodCategories
recentList:LastNewProtocols
initialAnswer:suggestion.
newProtocol isNil ifTrue:[^ self].
newProtocol isWideString ifTrue:[
Dialog warn:'Sorry - for now, non-ascii categories are not allowed (no 2-byte symbols).'.
^ self.
].
(NavigatorModel isPseudoCategory:newProtocol) ifTrue:[
(Dialog confirm:(resources
stringWithCRs:'"%1" is a special (reserved) name.\\Are you sure?.'
with:newProtocol))
ifFalse:[
^ self.
].
].
self immediateUpdate value:true.
self selectedClassesDo:[:cls |
self methodCategoryListApp addAdditionalProtocol:newProtocol forClass:cls.
].
self selectProtocol:newProtocol.
self clearAutoSelectOfLastSelectedProtocol.
self immediateUpdate value:false.
LastNewProtocols isNil ifTrue:[
LastNewProtocols := OrderedCollection new
].
LastNewProtocols remove:newProtocol ifAbsent:[].
LastNewProtocols addFirst:newProtocol.
LastNewProtocols size > 10 ifTrue:[
LastNewProtocols removeLast
].
"Modified: / 25.2.2000 / 00:56:04 / cg"
!
protocolMenuPrintOut
self printOutProtocolsWithSelector:#'printOutCategory:on:'.
!
protocolMenuRemove
"confirm removal of the selected protocols"
self doRemoveProtocolAndSelect:nil
!
protocolMenuRemoveAndSelectNext
"confirm removal of the selected protocols"
self doRemoveProtocolAndSelect:#next
!
protocolMenuRemoveAndSelectPrevious
"confirm removal of the selected protocols"
self doRemoveProtocolAndSelect:#previous
!
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 selectedClassesValue) notEmptyOrNil ifTrue:[
selClasses do:[:eachClass |
someCategories addAll:(eachClass categories).
]
] ifFalse:[
"/ offer the current method-classes' protocols in the dialog
(selMethods := self selectedMethodsValue) 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:(environment allMethodCategories reject:[:cat | (someCategories includes:cat) ]) asOrderedCollection sort.
newCategory := self
askForMethodCategory:msg
title:'Rename MethodCategory'
okLabel:'Rename'
list:someCategories
initialAnswer:suggestion.
newCategory isNil ifTrue:[^ self].
newCategory := newCategory withoutSeparators.
newCategory isEmptyOrNil ifTrue:[^ self].
newCategory = currentMethodCategory ifTrue:[^ self].
newCategory isWideString ifTrue:[
Dialog warn:'Sorry - for now, non-ascii categories are not allowed (no 2-byte symbols).'.
^ self.
].
self withWaitCursorDo:[
LastProtocolRenames := LastProtocolRenames select:[:ren | ren key ~= currentMethodCategory].
LastProtocolRenames addLast:(currentMethodCategory -> newCategory).
LastProtocolRenames size > 20 ifTrue:[LastProtocolRenames removeFirst].
methodCategoryListApp := self methodCategoryListApp.
newCategory := newCategory asSymbol.
self selectedProtocolsDo:[:cls :protocol |
|methods|
methods := cls methodDictionary values select:[:m | m category = protocol].
self moveMethods:methods toProtocol:newCategory.
"/ cls renameCategory:protocol to:newCategory.
"/ kludge - must also rename in addedProtocols
methodCategoryListApp notNil ifTrue:[
methodCategoryListApp renameAdditionalProtocol:protocol to:newCategory forClass:cls.
]
].
methodCategoryListApp notNil ifTrue:[
(self selectedClassesValue) 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: / 28-02-2012 / 17:00:47 / cg"
!
protocolMenuSpawn
"open a new browser showing the selected category only"
^ self
spawnProtocolBrowserFor:(self selectedClassesValue)
and:(self selectedProtocols value)
in:#newBrowser
"Modified: / 28-02-2012 / 17:00:28 / cg"
!
protocolMenuSpawnBuffer
"add a new buffer showing the selected category only"
^ self
spawnProtocolBrowserFor:(self selectedClassesValue)
and:(self selectedProtocols value)
in:#newBuffer
"Modified: / 28-02-2012 / 16:54:00 / cg"
!
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.
environment 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 selectedClassesValue) do:[:aClass |
methodCategoryListApp removeAllAdditionalProtocolForClass:aClass
].
methodCategoryListApp forceUpdateList
]
"Modified: / 28-02-2012 / 16:53:56 / cg"
!
spawnFullProtocolBrowserFor:protocols in:where
"browse selected protocols;
where is: #newBrowser - open a new browser showing the classes
where is: #newBuffer - add a new buffer showing the classes"
|spec lbl|
protocols size == 1 ifTrue:[
spec := #singleFullProtocolBrowserSpec.
lbl := protocols first , ' [full Protocol]'
] ifFalse:[
spec := #multipleFullProtocolBrowserSpec.
lbl := '[full Protocols]'
].
"/ selectedMethods := self selectedMethods value copy.
^ self
newBrowserOrBufferDependingOn:where
label:lbl
forSpec:spec
setupWith:[:brwsr |
|generator protocolList|
protocolList := protocols collect:[:each | each string].
"/ setup a special generator ...
generator :=
Iterator on:[:whatToDo |
|all protocols|
protocols := protocolList.
"/ protocols := (brwsr selectedProtocols value) ? protocolList.
all := protocols includes:(BrowserList nameListEntryForALL).
self withWaitCursorDo:[
environment 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 selectedMethodsValue 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.
]
"Modified: / 28-02-2012 / 16:34:54 / cg"
! !
!NewSystemBrowser methodsFor:'menu actions-searching'!
askForClassToSearch:doWhatByDefault single:singleClass msgTail:msgTail resources:resourcesOrNil thenDo:aBlock
"common code for both opening a new browser on a class and
to search for a class in this browser.
doWhat is: #newBrowser, #newBuffer or nil.
If singleClass is true, a single class will be asked for and browsed,
otherwise, a match pattern is allowed and a multi-class browser is opened."
^ self class
askForClassToSearch:doWhatByDefault
single:singleClass
msgTail:msgTail
resources:resourcesOrNil
filter:nil
forBrowser:self
thenDo:aBlock
!
askForClassToSearch:doWhatByDefault single:singleClass msgTail:msgTail thenDo:aBlock
"common code for both opening a new browser on a class and
to search for a class in this browser.
doWhat is: #newBrowser, #newBuffer or nil.
If singleClass is true, a single class will be asked for and browsed,
otherwise, a match pattern is allowed and a multi-class browser is opened."
^ self
askForClassToSearch:doWhatByDefault
single:singleClass
msgTail:msgTail
resources:resources
thenDo:aBlock
!
findClass:classNameArg single:singleClass in:doWhat
|className brwsr class classes box classNames aliases currentNamespace browseButton|
className := classNameArg.
singleClass ifTrue:[
className includesMatchCharacters ifFalse:[
currentNamespace := self currentNamespace.
aliases := environment
keysAndValuesSelect:[:nm :val | (nm sameAs:classNameArg) ]
thenCollect:[:nm :val | val isNil
ifTrue:[ nil ]
ifFalse:[
val isBehavior
ifTrue:[val]
ifFalse:[val class]]].
aliases := aliases select:[:cls | cls notNil].
classes := (self class classesWithNameSimilarTo:className from:currentNamespace) asOrderedCollection.
classes := classes reject:[:each | each isRealNameSpace].
aliases := aliases reject:[:eachAlias | (classes includesIdentical:eachAlias)].
classes addAll:aliases.
class := classes firstIfEmpty:nil.
class isNil ifTrue:[
className := self askForClassNameMatching:className.
"/ ^ self warn:('No such class: ' , className).
] ifFalse:[
classes size == 1 ifTrue:[
className := class name
] ifFalse:[
classNames := classes collect:[:each| (each name?'') , ' (',(each package?'?'),')'].
classNameArg includesMatchCharacters ifFalse:[
classNames := classNames
collect:[:nm |
|idx|
idx := nm asLowercase indexOfSubCollection:classNameArg asLowercase.
idx == 0 ifTrue:[
nm
] ifFalse:[
nm asText emphasizeFrom:idx to:idx+classNameArg size-1 with:#bold
]
]
].
box := self listBoxTitle:('Multiple class with name similar to/containing ''',classNameArg allBold,'''\\Select class to switch to:') withCRs
okText:'OK'
list:classNames "asSortedCollection".
box initialText:(classes first name).
box entryCompletionBlock:(DoWhatIMeanSupport classNameEntryCompletionBlock).
box action:[:aString | className := aString string].
browseButton := Button label:(resources string:'Browse All').
browseButton action:[
self
spawnClassBrowserFor:classes
label:('Classes named like "%1"' bindWith:classNameArg)
in:#newBrowser
select:false.
box hide
].
box addButton:browseButton before:box okButton.
box extent:(400 @ 300).
box open.
className isNil ifTrue:[ "/ cancel
^ nil
].
className := (className upTo:$( ) withoutTrailingSeparators.
].
].
] ifTrue:[
className := self askForClassNameMatching:className.
].
className notNil ifTrue:[
doWhat == #newBrowser ifTrue:[
brwsr := self class new.
brwsr allButOpen.
brwsr switchToClassNamed:className.
brwsr openWindow.
] ifFalse:[
brwsr := self.
doWhat == #newBuffer ifTrue:[
brwsr createBuffer.
] ifFalse:[
"/ self rememberLocationInHistory
].
brwsr switchToClassNamed:className.
].
].
^ self.
].
className includesMatchCharacters ifFalse:[
class := environment at:className asSymbol.
class isBehavior ifTrue:[
classes := IdentitySet with:class
]
] ifTrue:[
classes := environment allClasses select:[:each | className match:each name] as:IdentitySet.
].
classes size == 0 ifTrue:[
^ self warn:'No className matches'.
].
classes copy do:[:eachClass |
|owner|
owner := eachClass owningClass.
[owner notNil] whileTrue:[classes add:owner. owner := owner owningClass].
].
classes := classes asOrderedCollection.
doWhat isNil ifTrue:[
"/ select them ...
self immediateUpdate value:true.
self selectedCategories value: (classes collect:[:each | each category] as:Set) asOrderedCollection.
self selectedClasses value:classes.
self immediateUpdate value:false.
] ifFalse:[
self spawnClassBrowserFor:classes label:('classes matching ''',className,'''') in:doWhat select:false
]
"Created: / 13-02-2000 / 20:35:30 / cg"
"Modified: / 17-06-2010 / 12:24:21 / cg"
!
findResponseTo:selector
^ self findResponseTo:selector in:#newBuffer
!
findResponseTo:selector from:searchClassOrNil in:whereWanted
|where searchClass class mthd currentMethod|
where := whereWanted.
currentMethod := self theSingleSelectedMethod.
searchClass := searchClassOrNil.
searchClass isNil ifTrue:[
searchClass := self classHierarchyTopClass value.
searchClass isNil ifTrue:[
currentMethod notNil ifTrue:[
searchClass := currentMethod mclass
].
].
searchClass isNil ifTrue:[
self information:'No class or method selected (cannot search).'.
^ self
].
(currentMethod notNil
and:[currentMethod selector == selector]) ifTrue:[
searchClass := searchClass superclass.
].
].
"/ search for the implementaion
class := searchClass whichClassIncludesSelector:selector.
class isNil ifTrue:[
searchClass isMeta ifTrue:[
class := searchClass theNonMetaclass whichClassIncludesSelector:selector.
] ifFalse:[
class := searchClass theMetaclass whichClassIncludesSelector:selector.
]
].
"/ cannot switch method in a singleMethod browser ...
(where isNil
and:[navigationState isSingleMethodBrowser
or:[ navigationState isMethodListBrowser and:[(navigationState methodList includesIdentical:mthd) not] ] ])
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)
]
].
!
findResponseTo:selector in:whereWanted
|where searchClass class implClasses mthd currentMethod|
where := whereWanted.
currentMethod := self theSingleSelectedMethod.
searchClass := self theSingleSelectedClass.
searchClass isNil ifTrue:[
searchClass := self classHierarchyTopClass value.
searchClass isNil ifTrue:[
currentMethod notNil ifTrue:[
searchClass := currentMethod mclass
].
].
searchClass isNil ifTrue:[
self information:'No class or method selected (cannot search).'.
^ self
]
].
(currentMethod notNil
and:[currentMethod selector == selector]) ifTrue:[
searchClass := searchClass superclass.
].
"/ search for the implementaion
class := searchClass whichClassIncludesSelector:selector.
class isNil ifTrue:[
searchClass isMeta ifTrue:[
class := searchClass theNonMetaclass whichClassIncludesSelector:selector.
] ifFalse:[
class := searchClass theMetaclass whichClassIncludesSelector:selector.
]
].
"/ cannot switch method in a singleMethod browser ...
(where isNil
and:[navigationState isSingleMethodBrowser
or:[ navigationState isMethodListBrowser and:[(navigationState methodList includesIdentical:mthd) not] ] ])
ifTrue:[
where := #newBuffer.
].
class isNil ifTrue:[
implClasses := searchClass allSubclasses select:[:cls | cls includesSelector:selector].
implClasses isEmpty ifTrue:[
self information:'None found'.
^ self
].
(self confirm:(resources
stringWithCRs:'No implementation found here, but in %1 subclasses.\\Browse those?'
with:implClasses size))
ifFalse:[^ self].
self
spawnMethodBrowserFor:(implClasses collect:[:cls | cls compiledMethodAt:selector]) in:where
label:(resources string:'Responses to %1' with:selector).
^ self.
].
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 class addToBookMarks:cls selector:nil
]
"Modified: / 05-05-2011 / 12:20:56 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
searchMenuFindClass
self rememberLocationInHistory.
self searchMenuFindClass:#find "/ do not open new
!
searchMenuFindClass:doWhatByDefault
"common code for both opening a new browser on a class and
to search for a class in this browser.
doWhat is: #newBrowser, #newBuffer or nil"
^ self searchMenuFindClass:doWhatByDefault single:true
!
searchMenuFindClass:doWhatByDefault single:singleClass
"common code for both opening a new browser on a class and
to search for a class in this browser.
doWhat is: #newBrowser, #newBuffer or nil.
If singleClass is true, a single class will be asked for and browsed,
otherwise, a match pattern is allowed and a multi-class browser is opened."
self
askForClassToSearch:doWhatByDefault
single:singleClass
msgTail:''
thenDo:[:className :single :doWhat |
|theOneClass|
"/ experimental - aut switch to meta for projectDefinitions...
"/ will see how this works out.
(className notEmptyOrNil
and:[ (theOneClass := Smalltalk classNamed:className) notNil
and:[ theOneClass isMeta not
and:[ theOneClass isProjectDefinition ]]])
ifTrue:[
self meta value:true.
].
self findClass:className single:singleClass in:doWhat.
]
!
searchMenuFindImplementationOf
self obsoleteMethodWarning.
^ self searchMenuFindResponseTo.
"/ self
"/ askForSelector:'Search for implementation of (if sent to selected class):'
"/ allowBuffer:true
"/ allowBrowser:true
"/ thenDo:[:selector :where |
"/ |searchClass class mthd currentMethod|
"/
"/ searchClass := self theSingleSelectedClass.
"/ searchClass isNil ifTrue:[
"/ searchClass := self classHierarchyTopClass value.
"/ searchClass isNil ifTrue:[
"/ self information:'No class selected (cannot search).'.
"/ ^ self
"/ ]
"/ ].
"/
"/ currentMethod := self theSingleSelectedMethod.
"/ (currentMethod notNil
"/ and:[currentMethod selector == selector]) ifTrue:[
"/ searchClass := searchClass superclass.
"/ ].
"/
"/ "/ search for the implementaion
"/ class := searchClass whichClassIncludesSelector:selector.
"/ class isNil ifTrue:[
"/ self information:'None found'.
"/ ] ifFalse:[
"/ mthd := class compiledMethodAt:selector.
"/ where isNil ifTrue:[
"/ self rememberLocationInHistory.
"/ self switchToClass:class selector:selector.
"/ ] ifFalse:[
"/ self spawnMethodBrowserFor:(Array with:mthd) in:where
"/ label:(resources string:'Implementation of %1' with:selector)
"/ ]
"/ ].
"/ ]
"Modified: / 01-03-2012 / 07:36:12 / cg"
!
searchMenuFindMethod
|box matchBlock title entryCompletionBlock b openHow|
title := 'selector to find:\(TAB for completion; matchPattern allowed)'.
box := self
listBoxForCodeSelectionTitle:title withCRs
isSelector:true
okText:'Find'.
box label:(resources string:'find method').
matchBlock :=
[
|searchPattern matchingSelectors|
searchPattern := box contents.
searchPattern includesMatchCharacters ifTrue:[
matchingSelectors := Set new.
environment allMethodsWithSelectorDo:[:eachMethod :eachSelector |
(searchPattern match:eachSelector) ifTrue:[
matchingSelectors add:eachSelector.
].
].
box list:(matchingSelectors asOrderedCollection sort).
false.
] ifFalse:[
true
]
].
entryCompletionBlock :=
[:contents |
|s what longest matching|
box topView withWaitCursorDo:[
s := contents withoutSpaces.
s includesMatchCharacters ifTrue:[
matchBlock value
] ifFalse:[
what := DoWhatIMeanSupport selectorCompletion:s inEnvironment:environment.
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
"Modified: / 04-09-2013 / 17:41:51 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
searchMenuFindResponseTo
self
askForSelector:'Goto implementation of (if sent to instances of selected class):\(the list below represents the full protocol)' withCRs
allowBuffer:true
allowBrowser:true
thenDo:[:selector :whereWanted |
self findResponseTo:selector in:whereWanted
]
"Modified: / 29-08-2013 / 09:32:14 / cg"
!
searchMenuRemoveFromBookmarks
"remove the currently selected method/selector"
|cls mthd sel meta bookmarks |
(bookmarks := self class 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'
]
"Modified: / 02-06-2011 / 11:35:43 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
selectResponseTo:selector
self findResponseTo:selector in:nil
! !
!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 := environment 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 reversed.
currentClass isMeta ifTrue:[
supers := supers select:[:each | each isSubclassOf:Class].
].
supers := supers collect:[:cls | cls name].
subs := (currentClass allSubclasses collect:[:cls | cls name]).
list := OrderedCollection withAll:supers.
(supers notEmpty and:[subs notEmpty]) ifTrue:[
list add:'---- '; add:currentClass name; add:' ----'
].
list addAll:(subs sort).
doWhat == #copy ifTrue:[
reqString := 'Copy selected method(s) to which class ?\(enter ''Foo class'' to copy to Metaclass)'.
okLabel := 'Copy'.
title := 'Copy method(s)'.
] ifFalse:[
okLabel := 'Move'.
title := 'Move method(s)'.
doWhat == #move ifTrue:[
reqString := 'Move selected method(s) to which class ?\(enter ''Foo class'' to move to Metaclass)'.
] ifFalse:[
doWhat == #moveAndForward ifTrue:[
reqString := 'Move selected method(s) to which class ?'.
] ifFalse:[
self error:'unknown aspect: ', doWhat printString.
].
].
].
[
newClassName := Dialog
request:(resources string:reqString) withCRs
initialAnswer:(initial ? '')
okLabel:(resources string:okLabel)
title:(resources string:title)
onCancel:nil
list:list
entryCompletionBlock:(DoWhatIMeanSupport classNameEntryCompletionBlock).
newClassName isNil ifTrue:[^ nil].
(newClassName startsWith:'---- ') ifTrue:[^ nil].
newClass := self classIfValidNonMetaClassName:newClassName.
newClass notNil ifTrue:[
LastMethodMoveOrCopyTargetClass := newClass theNonMetaclass name.
^ newClass.
].
initial := newClassName.
] loop
"Modified: / 13-02-2012 / 17:43:10 / 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 := TextDiff2Tool
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
"Modified: / 14-07-2016 / 10:05:25 / jv"
!
doCompareMethodsWithRepository:methods usingManager: manager
"open a diff-textView comparing the current (in-image) versions
with the newest versions found in the repository.
That is the most recent version."
|s aStream comparedSource currentSource thisRevString
current repositoryChangeSet diffs allDiffs
mclass mselector theNonMetaclass lastClass lastRepositoryChangeSet
isExtension title labelA labelB failedToGetSource failureMessage|
failedToGetSource := false.
self withWaitCursorDo:[
SourceCodeManagerError handle:[:ex |
failedToGetSource := true.
failureMessage := 'SourceCodeManager reports: ',ex description.
] do:[
Method flushSourceStreamCache.
methods do:[:eachMethod |
|classPackage methodPackage|
mclass := eachMethod mclass.
mclass isNil ifTrue:[
self warn:('Cannot find methods class (obsolete).').
] ifFalse:[
classPackage := mclass package.
methodPackage := eachMethod package.
(classPackage == methodPackage or:[ methodPackage == PackageId noProjectID ]) ifTrue:[
theNonMetaclass := mclass theNonMetaclass.
isExtension := false.
] ifFalse:[
isExtension := true.
].
mselector := eachMethod selector.
currentSource := eachMethod source asString.
current := ChangeSet new.
current addMethodChange:eachMethod in:mclass.
self busyLabel:'getting repository source...' with:nil.
isExtension ifTrue:[
repositoryChangeSet := manager utilities
changeSetForExtensionMethodsForPackage:methodPackage
askForRevision:false
usingManager:manager.
repositoryChangeSet := repositoryChangeSet
select:[:eachChange | eachChange isMethodChange
and:[eachChange selector = mselector
and:[eachChange className = mclass name]]].
lastClass := nil.
] ifFalse:[
(lastClass ~~ theNonMetaclass) ifTrue:[
aStream := self sourceStreamForRepositorySourceOfClass:theNonMetaclass.
aStream isNil ifTrue:[
failedToGetSource := true.
failureMessage := 'No source for ',theNonMetaclass name.
] ifFalse:[
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).
] ensure:[
s close.
].
lastClass := theNonMetaclass.
self busyLabel:'comparing...' with:nil.
].
].
repositoryChangeSet := (lastRepositoryChangeSet ? #())
select:[:eachChange | eachChange isMethodChange
and:[eachChange selector = mselector
and:[eachChange fullClassName = mclass name]]].
].
repositoryChangeSet notEmptyOrNil ifTrue:[
diffs := repositoryChangeSet diffSetsAgainst:current.
].
allDiffs isNil ifTrue:[
allDiffs := diffs.
] ifFalse:[
allDiffs changed addAll:(diffs changed).
allDiffs onlyInArg addAll:(diffs onlyInArg).
allDiffs onlyInReceiver addAll:(diffs onlyInReceiver).
].
].
].
].
].
failedToGetSource ifTrue:[
self information:'Failed to fetch the source from the repository:\\',failureMessage.
^ self.
].
(allDiffs isNil or:[allDiffs isEmpty]) ifTrue:[
(methods
contains:[:m |
ChangeSet current includesChangeForClass:m mclass selector:m selector
]
) ifTrue:[
(self confirm:'Versions are identical.\\Remove entries from changeSet?' withCRs)
ifTrue:[
methods do:[:m |
ChangeSet current condenseChangesForClass:m mclass selector:m selector.
].
].
] ifFalse:[
self information:'Versions are identical.'.
].
^ self.
].
title := methods size == 1
ifTrue:['Difference of %1' bindWith:methods first whoString]
ifFalse:['Differences of %1 classes' bindWith:methods size].
labelA := 'Repository'.
labelB := 'Image'.
(methods collect:[:m | m mclass theNonMetaclass] as:Set) size == 1 ifTrue:[
"/ all methods of the same class
(methods collect:[:m | m package] as:Set) size == 1 ifTrue:[
"/ all methods from the same package (source container)
labelA := 'Repository (%1)' bindWith:(thisRevString ? '?').
labelB := 'Image (based on %1)' bindWith:(methods first mclass theNonMetaclass revision).
].
].
VersionDiffBrowser
openOnDiffSet:allDiffs
labelA:labelA
labelB:labelB
title:title
ignoreExtensions:false.
self normalLabel.
"Modified: / 11-08-2011 / 12:21:30 / az"
"Created: / 18-11-2011 / 18:45:41 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Created: / 21-12-2011 / 20:17:36 / cg"
!
doMoveSelectedMethodsToProject:newProject
self moveMethods:(self selectedMethodsValue) toProject:newProject
"Modified: / 28-02-2012 / 16:16:12 / cg"
!
doRemoveMethodsConfirmed:methodsToRemove
"confirm removal of the selected methods (but does not search for senders),
then remove them"
self doRemoveMethodsConfirmed:methodsToRemove select:nil
!
doRemoveMethodsConfirmed:methodsToRemove select:nilOrNextOrPrevious
"confirm removal of the selected methods (but does not search for senders),
then remove them.
The second argument is meant to control the behavior of the methodList"
|classes methods numClasses numMethods msg numVersionMethods firstClassName
methodToSelect|
"/ count them ...
classes := IdentitySet new.
methods := IdentitySet new.
numVersionMethods := 0.
methodsToRemove do:[:eachMethod |
classes add:(eachMethod mclass).
methods add:eachMethod.
(AbstractSourceCodeManager isVersionMethodSelector:eachMethod selector) ifTrue:[
eachMethod mclass isMeta ifTrue:[
numVersionMethods := numVersionMethods + 1
]
]
].
numClasses := classes size.
numMethods := methodsToRemove value size.
numMethods == 0 ifTrue:[^ self].
numMethods == 1 ifTrue:[
msg := 'Really remove ''%3'' from ''%4'' ?'.
] ifFalse:[
(methods collect:[:m | m selector]) size == 1 ifTrue:[
msg := 'Really remove ''%3'''.
] ifFalse:[
msg := 'Really remove %1 methods'.
].
numClasses > 1 ifTrue:[
msg := msg , ' from %2 classes'
] ifFalse:[
msg := msg , ' from ''%4'''
].
msg := msg , ' ?'
].
classes notEmpty ifTrue:[
firstClassName := classes first name
] ifFalse:[
firstClassName := '???'
].
msg := resources
string:msg
with:numMethods printString
with:numClasses printString
with:(methods first selector ? '?') allBold
with:firstClassName allBold.
"/ ask again, if a version method is to be removed - danger alert
numVersionMethods > 0 ifTrue:[
msg := msg , '\\' ,
(resources
string:'ATTENTION: Removing a classes version method might make the versionManagers life hard.' allBold).
(OptionBox
request:msg withCRs
label:(resources string:'Attention')
image:(WarningBox iconBitmap)
buttonLabels:(resources array:#('Cancel' 'Remove'))
values:#(false true)
default:false
onCancel:false
) ifFalse:[^ self].
] ifFalse:[
"/ suppress confirmation when removing already inherited functionality
"/ (which is common during refactoring)
(self canUseRefactoringParser
and:[
methodsToRemove value
conform:[:eachMethod |
|nonNilMessageIfSame|
"/ do removed methods redefine inherited methods, which do the same ?
nonNilMessageIfSame := self checkIfSameSemanticsRedefinedWith:eachMethod inClass:(eachMethod mclass).
nonNilMessageIfSame notNil
]
]) ifTrue:[
self showInfo:'Method same as inherited (no confirmation needed)'
] ifFalse:[
(self confirm:msg withCRs) ifFalse:[^ self].
].
].
classes := methods := nil.
nilOrNextOrPrevious notNil ifTrue:[
|methodList idx|
methodList := self methodListApp methodList.
nilOrNextOrPrevious == #next ifTrue:[
idx := (methodList indexOf:(methodsToRemove last)) + 1.
] ifFalse:[
idx := (methodList indexOf:(methodsToRemove first)) - 1
].
(idx between:1 and:methodList size) ifTrue:[
methodToSelect := methodList at:idx.
].
].
"/ then, remove them
self withWaitCursorDo:[
self doRemoveSelectedMethodsUnconfirmed.
].
methodToSelect notNil ifTrue:[
self selectMethod:methodToSelect
].
!
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 selectedMethodsValue copy
"Modified: / 28-02-2012 / 16:16:16 / cg"
!
fileOutMethods:aCollectionOfMethods format:formatSymbolOrNil fileNameTemplate:nameOrNil boxTitle:boxTitleOrNil
"fileOut a bunch of methods;
used both from fileOutMethod-list and fileOut-selected methods."
|saveName stillAsking suffix defaultName|
suffix := self fileSuffixForFormat:formatSymbolOrNil.
defaultName := (nameOrNil ? 'some_methods') , '.' , suffix.
stillAsking := true.
[stillAsking] whileTrue:[
saveName := self
fileNameDialogForFileOut:(resources string:(boxTitleOrNil ? 'FileOut methods as:'))
default:defaultName.
saveName isNil ifTrue:[
^ self
].
saveName isEmpty ifTrue:[ "/ can no longer happen ...
(self confirm:'Bad name given - try again ?') ifFalse:[
^ self.
].
stillAsking := true.
] ifFalse:[
FileSelectionBox lastFileSelectionDirectory:(saveName asFilename directoryName).
stillAsking := false.
].
].
self busyLabel:'saving...'.
self fileOutMethods:aCollectionOfMethods format:formatSymbolOrNil toFile:saveName withPackage:false.
!
fileOutMethods:aCollectionOfMethods format:formatSymbolOrNil toFile:aFilename withPackage:withPackage
"fileOut a bunch of methods;
used both from fileOutMethod-list and fileOut-selected methods."
|aStream fileName lastPackage|
self busyLabel:'saving...'.
Class fileOutErrorSignal
handle:[:ex |
self warn:'Cannot fileOut\(%2)' with:ex description.
self normalLabel.
ex return.
] do:[
formatSymbolOrNil == #sif ifTrue:[
(SmalltalkInterchangeFileManager newForFileOut)
fileName:aFilename;
addMethods:aCollectionOfMethods;
fileOut
] ifFalse:[
fileName := aFilename asFilename.
"
if file exists, save original in a .sav file
"
fileName exists ifTrue:[
fileName copyTo:(fileName withSuffix:'sav')
].
[
aStream := fileName newReadWriteStream.
] on:FileStream openErrorSignal do:[:ex|
^ self warn:('Cannot create file:', fileName name)
].
(formatSymbolOrNil ~~ #xml
and:[formatSymbolOrNil ~~ #binary]) ifTrue:[
aStream := EncodedStream stream:aStream encoder:(CharacterEncoder encoderForUTF8).
aStream nextPutLine:'"{ Encoding: utf8 }" !!'.
].
aCollectionOfMethods do:[:aMethod |
formatSymbolOrNil == #xml ifTrue:[
aMethod mclass fileOutXMLMethod:aMethod on:aStream
] ifFalse:[
formatSymbolOrNil == #binary ifTrue:[
self shouldImplement. "unimplemented: binary fileout"
"/ aClass binaryFileOutOn:(saveName asFilename writeStream binary)
] ifFalse:[
withPackage ifTrue:[
lastPackage ~= aMethod package ifTrue:[
lastPackage := aMethod package.
aStream nextPutAll:('"{ Package: ''%1'' }" !!\\' bindWith:(lastPackage)) withCRs.
].
].
aMethod mclass fileOutMethod:aMethod on:aStream.
aStream cr.
]
]
].
aStream close
]
].
self normalLabel
!
methodTemplate
"return a method definition template string or nil"
|classes cls templateProvider|
cls := self theSingleSelectedClass.
cls isNil ifTrue:[
classes := self selectedClassesValue.
classes notEmptyOrNil ifTrue:[
cls := classes first.
]
].
cls notNil ifTrue:[
templateProvider := cls programmingLanguage
] ifFalse:[
templateProvider := SmalltalkLanguage instance
].
(cls notNil and:[ cls isMeta and:[(cls implements:#documentation) not]]) ifTrue:[
self theSingleSelectedProtocol = 'documentation' ifTrue:[
cls theNonMetaclass isProjectDefinition ifTrue:[
^ templateProvider methodTemplateForPackageDocumentation
].
^ templateProvider methodTemplateForDocumentation
].
].
^ templateProvider methodTemplate
"Modified: / 18-11-2016 / 10:50:35 / cg"
!
methodsPreviousVersionCode
"return the method's previous version's 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.
!
methodsShadowedMethod
"return the method's shadowed method, or nil.
The shadowed method is the original method from its original package,
which was overloaded by another package"
|m mClass mProjectDefinition|
m := self theSingleSelectedMethod.
m isNil ifTrue:[^ nil].
mClass := m mclass.
mClass isNil ifTrue:[ mClass := m getMclass ].
mClass notNil ifTrue:[
mClass := mClass theNonMetaclass.
(m package ~= mClass package
and:[ (mProjectDefinition := mClass projectDefinitionClass) notNil]) ifTrue:[
^ mProjectDefinition savedOverwrittenMethodForClass:m mclass selector:m selector
].
].
^ nil
!
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 affectedPackages|
classesChanged := IdentitySet new.
numMethods := methods size.
affectedPackages := Set new.
methods do:[:eachMethod |
|mClass oldPackage|
mClass := eachMethod mclass.
oldPackage := eachMethod package.
"/ if it was an extension before, the old package needs an update (for its extension list)
(oldPackage ~= mClass package) ifTrue:[
affectedPackages add:oldPackage
].
"/ if it will be an extension afterwards, the new package needs an update (for its extension list)
(newProject ~= mClass package) ifTrue:[
affectedPackages add:newProject
].
].
affectedPackages remove:(PackageId noProjectID) ifAbsent:[].
(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.
environment changed:#projectOrganization with:(Array with:eachClass theNonMetaclass with:(methods select:[:m | m mclass == eachClass])).
].
"/ do we have to update any project definitions?
"/ JV@2016-01-19: NO, don't ask. This is done automacically when one
"/ commits. Doing it each time is just too disturbing. Moreover,
"/ the dialog text does not make clear what's going to be updated
"/ and why. And - it should only update extension methods, not whole
"/ project definition!! So: disabled.
"/ affectedPackages remove:(PackageId noProjectID) ifAbsent:[].
"/ affectedPackages notEmpty ifTrue:[
"/ |prjDefs|
"/
"/ prjDefs := affectedPackages collect:[:id | (PackageId from:id) projectDefinitionClass] as:Set.
"/ prjDefs remove:nil ifAbsent:[].
"/ prjDefs notEmpty ifTrue:[
"/ (Dialog confirm:(resources string:'Update %1 definition(s) now?' with:affectedPackages size)) ifTrue:[
"/ self updateProjectContentsDefinitionsIn:prjDefs regenerate:true
"/ ].
"/ ].
"/ ].
"Created: / 17-02-2000 / 23:04:45 / cg"
"Modified: / 23-11-2006 / 17:02:10 / cg"
"Modified: / 19-01-2016 / 21:47:55 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
moveMethods:methods toProtocol:newCategory
"move some methods to some other category"
|change numMethods|
newCategory isNil ifTrue:[^ self].
lastMethodCategory := newCategory.
numMethods := methods size.
(self canUseRefactoringSupport and:[numMethods > 1]) ifTrue:[
change := CompositeRefactoryChange named:('Change category of ', numMethods printString , ' methods').
methods do:[:eachMethod |
|mClass|
mClass := eachMethod mclass.
change
changeCategoryOf:(eachMethod selector)
in:mClass
to:newCategory.
].
RefactoryChangeManager performChange: change.
] ifFalse:[
methods do:[:mthd |
|mClass|
mClass := mthd mclass.
(self canUseRefactoringSupport) ifTrue:[
change := RefactoryMethodCategoryChange
changeCategoryOf:(mthd selector)
in:mClass
to:newCategory.
RefactoryChangeManager performChange: change.
] ifFalse:[
mthd category:newCategory.
].
].
].
"Modified: / 23-11-2006 / 17:00:01 / cg"
!
moveMethodsWithForwarding:methods toClass:newClass
"move some methods to some other class"
self moveOrCopyMethods:methods toClass:newClass moveOrCopy:#moveAndForward
!
moveOrCopyMethods:methods toClass:newClass moveOrCopy:doWhat
"move or copy some methods to some other class - typically a sister or parent class"
|canUseRefactoringSupport changes nm newClassName anyChangeMade|
canUseRefactoringSupport := self canUseRefactoringSupport.
canUseRefactoringSupport ifTrue:[
nm := (doWhat == #copy)
ifTrue:['Copy %1 to %2']
ifFalse:[
(doWhat == #moveAndForward)
ifTrue:['Move with Forwarding %1 to %2']
ifFalse:['Move %1 to %2']].
nm := nm bindWith:(methods size == 1
ifTrue:[methods first whoString]
ifFalse:[methods size printString , ' methods'])
with:newClass name.
changes := CompositeRefactoryChange named:nm.
].
anyChangeMade := false.
methods copy do:[:methodToCopyOrMove |
|question msg selectorToCopyOrMove
category source dontDoIt newMethod oldClass
template oldProject isExtensionMethod|
dontDoIt := false.
selectorToCopyOrMove := methodToCopyOrMove selector.
(newClass includesSelector:selectorToCopyOrMove) ifTrue:[
|sourceCode|
sourceCode := (newClass sourceCodeAt:selectorToCopyOrMove).
sourceCode := ('The overwritten method is:\\' withCRs , sourceCode) asStringCollection.
sourceCode size > 10 ifTrue:[
sourceCode := sourceCode copyTo:10.
sourceCode := sourceCode copyWith: '... <more code here> ...'.
].
sourceCode := (sourceCode asString) allItalic.
question := (doWhat == #copy)
ifTrue:['%1 already implements #%2\%3\Copy anyway ?']
ifFalse:['%1 already implements #%2\%3\Move anyway ?'].
(self confirm:(resources string:question
with:newClass name allBold
with:selectorToCopyOrMove
with:sourceCode) withCRs) ifFalse:[
dontDoIt := true
]
] ifFalse:[
"/ confirm copy/move of the version method (to avoid confusing the repository)
((AbstractSourceCodeManager isVersionMethodSelector:selectorToCopyOrMove) and:[newClass isMeta]) ifTrue:[
question := (doWhat == #copy)
ifTrue:['Copying a version method might confuse the repository.\\Copy anyway ?']
ifFalse:['Moving a version method might confuse the repository.\\Move anyway ?'].
(self confirm:(resources string:question) withCRs) ifFalse:[
dontDoIt := true
]
].
].
dontDoIt ifFalse:[
anyChangeMade := true.
source := methodToCopyOrMove source.
category := methodToCopyOrMove category.
oldProject := methodToCopyOrMove package.
isExtensionMethod := methodToCopyOrMove isExtension.
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.
"/ changed Jan.2017:
"/ the old code always preserved the method's package,
"/ which leads to confusion and creates extra work most of the time (move to class's package)
"/ Now, we only do it, if the method was an extension.
isExtensionMethod ifTrue:[
canUseRefactoringSupport ifTrue:[
changes
changeProjectOf:selectorToCopyOrMove
in:newClass
to:oldProject.
] ifFalse:[
newMethod package:oldProject.
].
].
(doWhat == #copy) ifFalse:[
canUseRefactoringSupport ifTrue:[
changes removeMethod: selectorToCopyOrMove from:oldClass.
] ifFalse:[
oldClass removeSelector:selectorToCopyOrMove.
].
(doWhat == #moveAndForward) ifTrue:[
template := Parser methodSpecificationForSelector:selectorToCopyOrMove.
newClass == oldClass class ifTrue:[
newClassName := 'self class'.
] ifFalse:[
newClass nameSpace = oldClass nameSpace ifTrue:[
newClassName := newClass theNonMetaclass nameWithoutNameSpacePrefix.
] ifFalse:[
newClassName := newClass theNonMetaclass name
].
].
source := template , '
^ ' , newClassName , ' ' , template , '
'.
canUseRefactoringSupport ifTrue:[
changes
compile:source
in:oldClass
classified:category.
] ifFalse:[
newMethod := oldClass
compile:source
classified:category.
].
"/ changed Jan.2017:
"/ the old code always preserved the method's package,
"/ which leads to confusion and creates extra work most of the time (move to class's package)
"/ Now, we only do it, if the method was an extension.
isExtensionMethod ifTrue:[
canUseRefactoringSupport ifTrue:[
changes
changeProjectOf:selectorToCopyOrMove
in:oldClass
to:oldProject.
] ifFalse:[
newMethod package:oldProject.
].
]
]
]
]
]
].
(canUseRefactoringSupport and:[anyChangeMade]) ifTrue:[
RefactoryChangeManager performChange: changes
].
!
renameMethod:oldSelector in:aClass
|newSelector tree dialog args newArgs map refactoring rslt
renameSelectedMethodsOnly renameOnly rewriteLocalSendersOnly
rewritePackageLocalSendersOnly
affectedClasses classesOfSelectedMethods suggestion|
RBParser isNil ifTrue:[
Dialog warn:'Missing class: RBParser'.
^ self
].
RBParser autoload.
MethodNameDialog isNil ifTrue:[
Dialog warn:'Missing class: MethodNameDialog'.
^ self
].
MethodNameDialog autoload.
tree := aClass parseTreeFor:oldSelector.
tree isNil ifTrue:[
self warn: 'Could not parse the method'.
^ self
].
args := tree argumentNames.
suggestion := DoWhatIMeanSupport goodRenameDefaultFor:oldSelector lastOld:LastRenamedOld lastNew:LastRenamedNew.
dialog := MethodNameDialog methodNameFor: args initial:(suggestion ? oldSelector).
dialog cancelAllVisible value:(AbortAllOperationWantedQuery query).
dialog renameOnlyVisible value:true.
dialog renameSelectedMethodsOnlyVisible value:true.
dialog rewriteLocalMethodsOnlyFlagHolder value:true.
dialog allButOpen.
dialog window label:(resources string:'Rename "%1" to' with:oldSelector).
dialog openWindow.
dialog accepted ifFalse: [^ self].
newArgs := dialog arguments asOrderedCollection.
map := Array new: args size.
1 to: args size do: [:i | map at: i put: (newArgs indexOf: (args at: i))].
newSelector := dialog methodName.
newSelector = oldSelector ifTrue:[
newArgs = args ifTrue:[
Dialog information:'no change'.
^ self.
].
].
LastRenamedOld := oldSelector.
LastRenamedNew := newSelector.
renameSelectedMethodsOnly := dialog isRenameSelectedMethodsOnly.
renameOnly := dialog isRenameOnly.
rewriteLocalSendersOnly := dialog isRewritingLocalSendersOnly.
rewritePackageLocalSendersOnly := dialog isRewritingPackageLocalSendersOnly.
refactoring := RenameMethodRefactoring
renameMethod: oldSelector
in: aClass
to: newSelector
permuation: map.
refactoring suppressRewriteOfSenders:renameOnly.
renameOnly ifFalse:[
affectedClasses := rewriteLocalSendersOnly
ifTrue:[ environment allClasses ]
ifFalse:[
rewritePackageLocalSendersOnly
ifTrue:[ environment allClassesInPackage:aClass package ]
ifFalse:[ aClass withAllSubclasses ]].
"/ ask if so many methods should be rewritten; give chance to cancel
(self findSendersOf:oldSelector in:affectedClasses andConfirmRefactoring:refactoring) ifFalse:[ ^ self ].
].
renameSelectedMethodsOnly ifTrue:[
(self selectedMethodsValue collect:[:m | m selector] as:Set) size == 1 ifFalse:[
Dialog warn:'Multiple different selectors selected'.
^ self.
].
classesOfSelectedMethods := self selectedMethodsValue collect:[:m|m mclass].
"/ classesOfSelectedMethods := classesOfSelectedMethods
"/ collect:[:cls |
"/ |className rbClass|
"/
"/ className := cls theNonMetaclass name.
"/ cls isMeta
"/ ifTrue:[rbClass := RBMetaclass existingNamed: className]
"/ ifFalse:[rbClass := RBClass existingNamed: className].
"/ rbClass model:(RBNamespace new).
"/ rbClass
"/ ].
refactoring onlyRenameTheseImplementors:classesOfSelectedMethods.
].
self withWaitCursorDo:[
|classesOfSelectedMethods affectedImplementors|
"/ refactoring model name:('rename %1 to %2' bindWith:oldSelector storeString with:newSelector storeString).
rslt := self performRefactoring:refactoring.
self switchToSelector:newSelector asSymbol.
].
dialog browseOldSendersHolder value ifTrue:[
self spawnMethodSendersBrowserFor:(Array with:oldSelector) in:#newBrowser
].
dialog browseNewSendersHolder value ifTrue:[
self spawnMethodSendersBrowserFor:(Array with:newSelector) in:#newBrowser
].
dialog browseChangedMethodsHolder value ifTrue:[
self spawnMethodImplementorsBrowserFor:(Array with:newSelector) match:false in:#newBrowser
].
"Modified: / 28-02-2012 / 16:28:12 / cg"
!
selectVariableForMoveMethod
self halt:'not yet needed'.
^ nil.
"/ | mthd mClass parseTree nameList ignoreList |
"/
"/ mthd := self theSingleSelectedMethod.
"/ mClass := mthd mclass.
"/
"/ parseTree := mClass parseTreeFor:mthd selector.
"/ parseTree isNil ifTrue: [^self warn: 'Could not parse sources'].
"/
"/ nameList := OrderedCollection new.
"/ nameList
"/ add: '---- Arguments ----';
"/ addAll: parseTree argumentNames asSortedCollection;
"/ add: '---- Instance Variables ----'.
"/
"/ ignoreList := OrderedCollection with: 1 with: nameList size.
"/ nameList addAll: mClass allInstVarNames asSortedCollection.
"/
"/ ^ self
"/ choose: 'Select variable to move method into:'
"/ fromList: nameList
"/ values: nameList
"/ ignore: ignoreList
"/ initialSelection: nil
"/ lines: 8
"/ cancel: [nil]
!
selectorCheckMenuSmalllintCheck: what
"perform all checks on the selected class(es)."
self smalllintRun:what onEnvironment:self selectedSelectorsAsEnvironment
"Modified: / 28-12-2008 / 14:42:01 / bazantj <enter your email here>"
"Modified: / 13-01-2009 / 13:20:48 / Jiri Bazant <bazanj2@fel.cvut.cz>"
"Created: / 17-04-2010 / 10:49:27 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
selectorMenuAddParameter
self codeMenuAddParameter
!
selectorMenuBackToPrevious
"show the method's 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; yourself.
dummyChangeSet reverse. "/ youngest first.
browser := (UserPreferences current changeSetBrowserClass) openOn:dummyChangeSet.
browser readOnly:true.
"Modified: / 13-06-2011 / 11:32:10 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 26-07-2012 / 14:30:20 / cg"
!
selectorMenuBrowseRepositoryVersionsUsingManager: manager
|method mclass mselector className mgr revisions previousMethods browser
lastSource currentSource lastRevision lastDate lastChange lastAuthor thisIsAnExtensionMethod
packageId directory module currentVersion newestVersion|
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.
currentVersion := mclass theNonMetaclass revisionOfManager:manager.
thisIsAnExtensionMethod := (method isExtension).
thisIsAnExtensionMethod ifTrue:[
packageId := method package asPackageId.
mgr := manager
] ifFalse:[
packageId := mclass package asPackageId.
"/ mgr := packageId projectDefinitionClass sourceCodeManager.
mgr := manager.
"/self assert:(mgr = packageId projectDefinitionClass sourceCodeManager).
].
directory := packageId directory.
module := packageId module.
self withWaitCursorDo:[
|revisionLog numRevisions stop answer t tS list msg first|
thisIsAnExtensionMethod ifTrue:[
revisionLog := mgr
revisionLogOf:nil
fromRevision:nil
toRevision:nil
numberOfRevisions:nil
fileName:'extensions.st'
directory:directory
module:module.
] ifFalse:[
revisionLog := mgr revisionLogOf:mclass.
revisionLog isNil ifTrue:[self error:'cannot get revision log'].
].
revisions := revisionLog at:#revisions.
stop := numRevisions := revisions size.
stop > 20 ifTrue:[
thisIsAnExtensionMethod ifTrue:[
t := 500. "/ fake time
] ifFalse:[
"/ measure the time it takes to checkout a version...
t := Time millisecondsToRun:[
|revSourceStream|
revSourceStream := mgr getSourceStreamFor:mclass revision:((revisions at:10) at:#revision).
ChangeSet fromStream:revSourceStream.
revSourceStream close.
].
].
newestVersion := revisions first at:#revision.
list := revisions collect:[:entry |
|rev author dateString date msg|
rev := entry at:#revision.
author := entry at:#author.
dateString := entry at:#date.
date := Timestamp readGeneralizedFrom:dateString.
dateString := date printStringFormat:'%(year)-%(mon)-%(day) %h:%m:%s'.
entry at:#date put:dateString.
msg := ((entry at:#logMessage) asStringCollection firstIfEmpty:'') asString.
rev,' ',author,' ',dateString,' ',msg
].
msg := 'There are %1 revisions to extract from the repository'.
t := (t * numRevisions / 1000) rounded.
t < 10 ifTrue:[
msg := msg,'\(this will take a few seconds).'.
tS := t.
] ifFalse:[
t := t * numRevisions // 1000 // 10 * 10.
tS := (TimeDuration fromSeconds:t) printStringForApproximation.
msg := msg,'\(this will take roughly %2).'
].
msg := msg,'\\Do you want to see all or only some of the revisions ?'.
answer := Dialog
choose:(resources stringWithCRs:msg with:numRevisions with:tS)
fromList:list values:revisions initialSelection:nil
buttons:nil
values:nil
default:nil
lines:20
cancel:[^ self]
multiple:false
title:(resources string:'Confirmation')
postBuildBlock:
[:dialog |
|b|
b := Button label:(resources string:'Browse Newer than Selected').
b action:[ stop := (dialog componentAt:#ListView) selection. dialog okPressed].
b := dialog addButton:b before:dialog okButton.
dialog okButton label:(resources string:'Browse All').
dialog okButton action:[ stop := revisions size. dialog okPressed].
].
stop isNil ifTrue:[^ self ].
].
t := Time millisecondsToRun:[
previousMethods := ChangeSet new.
currentSource := method source.
currentVersion = newestVersion ifTrue:[
lastSource := currentSource.
].
lastRevision := lastDate := lastAuthor := nil.
first := true.
"/ revisions at:1 is now the newest (may be newer than current!!)
revisions from:1 to:stop do:[:eachLogEntry |
|revision date author revSourceStream|
revision := eachLogEntry at:#revision.
date := eachLogEntry at:#date.
author := eachLogEntry at:#author ifAbsent:'?'.
[
|chg nChg classChangeSet changeSource changeName|
self activityNotification:(resources string:'Fetching revision %1...' with:revision).
thisIsAnExtensionMethod ifTrue:[
revSourceStream := mgr
streamForClass:nil
fileName:'extensions.st'
revision:revision
directory:directory
module:module
cache:true.
] ifFalse:[
revSourceStream := mgr getSourceStreamFor:mclass revision:revision.
].
revSourceStream isNil ifTrue:[
self warn:(resources string:'Could not load source for %1 revision %2 from repository' with:mclass name with:revision).
chg := nil.
] ifFalse:[
classChangeSet := ChangeSet fromStream:revSourceStream.
chg := classChangeSet
detect:[:chg | chg isMethodChange
and:[chg selector = mselector
and:[chg fullClassName = className]]]
ifNone:nil.
chg isNil ifTrue:[
"/ maybe the class was renamed!!
(classChangeSet contains:[:chg | chg isMethodChange and:[chg selector = mselector]]) ifTrue:[
self halt:'check for renamed class'.
]
].
].
chg isNil ifTrue:[
"the method was created in the next version (previous one processed)"
] ifFalse:[
changeSource := chg source.
].
((changeSource isNil and:[lastSource isNil])
or:[ changeSource asString = lastSource asString ]) ifTrue:[
] ifFalse:[
lastChange isNil ifTrue:[
"/ mhm - was not in the previous version
] ifFalse:[
nChg := lastChange asNamedMethodChange
].
lastRevision isNil ifTrue:[
(stop = revisions size) ifTrue:[
changeName := 'current (not in the repository)'.
] ifFalse:[
"/ not showing all - don't really know
changeName := 'current'.
].
] ifFalse:[
changeName := lastRevision,' [',lastDate,' by ',lastAuthor,']'.
first ifTrue:[
(newestVersion compareAsVersionNumberWith:lastRevision) >= 0 ifTrue:[
changeName := changeName,' (= current)'.
].
]
].
nChg notNil ifTrue:[
nChg changeName:changeName.
previousMethods add:nChg.
].
lastSource := changeSource.
lastChange := chg.
first := false.
].
lastRevision := revision.
lastDate := date.
lastAuthor := author.
] ensure:[
revSourceStream notNil ifTrue:[revSourceStream close].
].
].
].
"/ Transcript showCR:('it took %1 seconds' bindWith:(t /1000)printString).
self activityNotification:nil.
browser := (UserPreferences current changeSetBrowserClass) openOn:previousMethods.
browser window label:(resources string:'Revisions of %1 %2' with:mclass name with:mselector).
browser readOnly:true.
].
"Modified: / 01-07-2011 / 16:34:29 / cg"
"Created: / 18-11-2011 / 18:19:50 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Created: / 21-12-2011 / 20:29:42 / cg"
!
selectorMenuBrowseRepositoryVersionsUsingManagerNamed:sourceCodeManagerClassName
^self selectorMenuBrowseRepositoryVersionsUsingManager: (self sourceCodeManagerNamed:sourceCodeManagerClassName)
"Created: / 02-01-2012 / 12:35:03 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 24-07-2012 / 18:01:29 / cg"
!
selectorMenuChangePrivacyTo:privacySymbol
self selectedMethodsDo:[:eachMethod |
(eachMethod privacy ~~ privacySymbol) ifTrue:[
eachMethod privacy:privacySymbol.
]
].
"Modified: / 23-11-2006 / 17:03:39 / cg"
!
selectorMenuCheckInProjectExtensions
self selectorMenuCheckInProjectExtensionsUsingManager:SourceCodeManager
!
selectorMenuCheckInProjectExtensionsUsingManager:aManager
|projects|
projects := self selectedMethodsValue collect:[:each | each package] as:Set.
projects do:[:packageToCheckIn |
self
projectMenuCheckInProject:packageToCheckIn
classes:false
extensions:true
buildSupport:false
usingManager:aManager
].
"Modified: / 28-02-2012 / 16:28:43 / cg"
!
selectorMenuCleanUpChangeSet
"remove all changes for the selected method(s) from the changeSet"
(self confirm:'This will remove all changes for the selected method(s) from the changeSet.\\Really cleanup ?' withCRs)
ifFalse:[ ^ self].
self withWaitCursorDo:[
self selectedMethodsValue do:[:eachMethod |
ChangeSet current condenseChangesForClass:eachMethod mclass selector:eachMethod selector
]
]
"Created: / 06-10-2006 / 16:36:44 / cg"
!
selectorMenuCleanUpChangeSetForClass
"remove all changes for the selected method(s) class(es) and metaclasses from the changeSet"
|classes|
(self confirm:'This will remove all changes for the class(es) of the selected method(s) from the changeSet.\\Really cleanup ?' withCRs)
ifFalse:[ ^ self].
self withWaitCursorDo:[
classes := Set new.
self selectedMethodsValue do:[:eachMethod | classes add:(eachMethod mclass theNonMetaclass)].
classes do:[:eachClass |
ChangeSet current condenseChangesForClass:eachClass
]
]
!
selectorMenuCompareAgainstNewestInRepositoryUsingManager: manager
"open a diff-textView comparing the current (in-image) version
with the newest version found in the repository.
That is the most recent version."
self doCompareMethodsWithRepository:(self selectedMethodsValue) usingManager: manager.
"Created: / 18-11-2011 / 18:44:18 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Created: / 21-12-2011 / 20:20:20 / cg"
!
selectorMenuCompareAgainstNewestInRepositoryUsingManagerNamed: sourceCodeManagerClassName
^ self selectorMenuCompareAgainstNewestInRepositoryUsingManager: (self sourceCodeManagerNamed:sourceCodeManagerClassName)
"Created: / 02-01-2012 / 12:37:02 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 24-07-2012 / 18:01:42 / cg"
!
selectorMenuCompareClassAgainstNewestInRepositoryUsingManager: manager
"open a diff-textView comparing the current (in-image) version of the class(es)
with the newest version found in the repository.
That is the most recent version."
|classes|
classes := self selectedMethodsValue collect:[:m | m mclass theNonMetaclass] as:Set.
self withWaitCursorDo:[
self doCompareClassesWithRepository:classes usingManager: manager
].
"Created: / 18-11-2011 / 18:47:48 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Created: / 21-12-2011 / 20:20:28 / cg"
!
selectorMenuCompareClassAgainstNewestInRepositoryUsingManagerNamed: sourceCodeManagerClassName
"open a diff-textView comparing the current (in-image) version of the class(es)
with the newest version found in the repository.
That is the most recent version."
^ self selectorMenuCompareClassAgainstNewestInRepositoryUsingManager: (self sourceCodeManagerNamed:sourceCodeManagerClassName)
"Created: / 21-12-2011 / 20:20:28 / cg"
"Created: / 02-01-2012 / 12:37:35 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 24-07-2012 / 18:01:54 / cg"
!
selectorMenuCompareTwoSelectedMethods
"compare the two selected methods"
|selectedMethods|
selectedMethods := self selectedMethodsValue.
self
doCompareMethod:(selectedMethods first)
against:(selectedMethods second)
label:(resources string:'Comparing methods')
"Modified: / 28-02-2012 / 16:29:05 / cg"
!
selectorMenuCompareWithInherited
"compare the selected method against the inherited"
|m1 m2|
m1 := self selectedMethodsValue first.
m2 := m1 mclass superclass lookupMethodFor:(m1 selector).
self
doCompareMethod:m1
against:m2
label:(resources string:'Comparing against inherited')
"Modified: / 28-02-2012 / 16:29:11 / cg"
!
selectorMenuCompareWithMethod
"compare the codeViews contents against the methods actual code"
self doCompareIn:self navigationState.
!
selectorMenuCompareWithPreviousVersion
"compare the codeViews contents against the methods previous version"
|m previousCode v|
m := self theSingleSelectedMethod.
previousCode := self methodsPreviousVersionCode.
previousCode isNil ifTrue:[
self information:'Oops - no previous code found'.
^ self
].
self withWaitCursorDo:[
v := DiffCodeView
openOn:previousCode
label:'previous version'
and:m source
label:'current version'.
v topView label:(resources string:'comparing method').
v waitUntilVisible.
].
^ self
!
selectorMenuCompareWithShadowedMethod
"compare the codeView's contents against the method's shadowed version
(that is the original, overloaded method from the method's original package)"
|m originalMethod v|
m := self theSingleSelectedMethod.
originalMethod := self methodsShadowedMethod.
originalMethod isNil ifTrue:[
self information:'Oops - no shadowed (original method) found'.
^ self
].
self withWaitCursorDo:[
v := DiffCodeView
openOn:originalMethod source
label:(resources string:'shadowed (original) in %1' with:originalMethod package allBold)
and:m source
label:(resources string:'current in %1' with:m package allBold).
v topView label:(resources string:'shadowed method %1' with:m whoString).
v leftAcceptAction:[:text | m mclass addSelector:m selector withMethod:originalMethod ].
v waitUntilVisible.
].
^ self
!
selectorMenuCompareWithSmallTeamVersionOnHost:hostName
"compare the codeViews contents against a SmallTeam version"
self selectedMethodsValue do:[:eachMethod |
|v changeList change|
changeList := SmallTeam changesOnHost:hostName.
change := changeList
detectLast:[:change |
change changeClass == eachMethod mclass
and:[ change selector == eachMethod selector ] ]
ifNone:nil.
change notNil ifTrue:[
v := DiffCodeView
openOn:(change source)
label:'Version on ',hostName
and:eachMethod source
label:'Your Version'.
v topView label:(resources string:'Comparing method').
].
].
"Created: / 11-11-2006 / 15:15:26 / cg"
"Modified: / 28-02-2012 / 16:29:13 / cg"
!
selectorMenuCompileWithSTC
"compile the current method to machine code via the stc compiler.
This is not supported on all machines."
self theSingleSelectedMethod isNil ifTrue:[^ self].
ParserFlags
withSTCCompilation:#always
do:[
self codeView accept.
].
!
selectorMenuCopy
"copy the selected methods to some other class - typically a sister class"
self selectorMenuMoveOrCopy:#copy
!
selectorMenuCopyMessageRepresentation
"copy the selectes methods whoString to the clipboard"
|messageString|
messageString := String streamContents:[:writeStream|
self selectedMethodsDo:[:eachMethod|
writeStream
nextPutAll:eachMethod whoString;
cr.
].
writeStream position ~~ 0 ifTrue:[
writeStream backStep. "eat trailing cr"
].
].
messageString notEmpty ifTrue:[
self window setClipboardText:messageString.
]
!
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 selectedMethodsValue.
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: / 28-02-2012 / 16:29:16 / cg"
!
selectorMenuFileOutSIFAs
"fileOut selected methods from the list - sif format"
^ self selectorMenuFileOutAsWithFormat:#sif
!
selectorMenuFileOutXMLAs
"fileOut selected methods from the list - xml format"
XMLCoder isNil ifTrue:[
self warn:'Sorry - missing class: XMLCoder.\\Cannot generate XML file.' withCRs.
^ self
].
^ self selectorMenuFileOutAsWithFormat:#xml
!
selectorMenuGenerateAspectMethod
"generate an aspect method using the common bindings (i.e. not an instvar)"
|aspect cls|
aspect := Dialog request:'Name of aspect:'.
aspect isEmptyOrNil ifTrue:[^ self].
(aspect isValidSmalltalkIdentifier
and:[ aspect isUnarySelector]) ifFalse:[
Dialog warn:'Name of aspect must be a valid Smalltalk unary identifier'.
thisContext restart
].
cls := self theSingleSelectedClass.
cls isNil ifTrue:[^ self].
self
generateUndoableChange:(resources string:'Generate Aspect Method for "%1"' with:aspect)
overClasses:(Array with:cls)
via:[:generator :eachClass |
generator createAspectMethodFor:aspect in:cls
]
!
selectorMenuGenerateCorrespondingInstanceCreationInClass
"generate a subclassResponsibility method in the methods superclass"
self
generateUndoableChangeOverSelectedMethods:'Generate Instance creation for %(singleMethodNameOrNumberOfMethods)'
via:[:generator :eachMethod |
|selector mclass|
selector := eachMethod selector.
mclass := eachMethod mclass.
generator
createInstanceCreationMethodWithSetupFor:selector category:'instance creation' in:mclass theMetaclass.
]
!
selectorMenuGenerateFalseReturnInSuperclass
"generate a ^false method in the method's superclass"
self
generateUndoableChangeOverSelectedMethods:'Generate False-return in superclass for %(singleMethodNameOrNumberOfMethods)'
via:[:generator :eachMethod |
|selector category mclass implClass defineIt answer|
selector := eachMethod selector.
category := eachMethod category.
mclass := eachMethod mclass.
mclass superclass notNil ifTrue:[
(mclass superclass includesSelector:selector) ifFalse:[
defineIt := true.
implClass := mclass superclass whichClassIncludesSelector:selector.
implClass notNil ifTrue:[
answer := Dialog
confirmWithCancel:(resources
string:'%1 is inherited from %2.\\Define as false-return in %3 anyway ?'
with:selector allBold
with:implClass name allBold
with:mclass superclass name allBold
) withCRs.
answer isNil ifTrue:[^ self].
defineIt := answer.
].
defineIt ifTrue:[
generator
createFalseReturnMethodFor:selector category:category in:mclass superclass.
]
].
].
]
!
selectorMenuGenerateForwardingMethodForInstances
"generate a forwarding method on the instance side"
self
generateUndoableChangeOverSelectedMethods:'Generate Forwarder for %(singleMethodNameOrNumberOfMethods)'
via:[:generator :eachMethod |
|selector category mclass implClass defineIt parser spec code|
selector := eachMethod selector.
category := eachMethod category.
mclass := eachMethod mclass.
mclass isMeta ifTrue:[
parser := Parser for:eachMethod source.
parser parseMethod.
spec := Parser methodSpecificationForSelector:selector argNames:parser methodArgs.
(mclass theNonMetaclass includesSelector:selector) ifFalse:[
code := (spec , '\ ^ self class ' , spec , '.') withCRs.
generator
compile:code
forClass:mclass theNonMetaclass
inCategory:category
].
].
]
!
selectorMenuGenerateRedefinitionInSubclass
"generate a ^ super xxx in a subclass"
|possibleSubclasses selectedSubclasses|
possibleSubclasses :=
(self selectedMethodsClasses collectAll:[:cls |
cls allSubclasses
]) asSet.
possibleSubclasses isEmpty ifTrue:[
Dialog information:'No subclass'.
^ self
].
possibleSubclasses size == 1 ifTrue:[
selectedSubclasses := possibleSubclasses
] ifFalse:[
possibleSubclasses := possibleSubclasses asOrderedCollection sort:[:a :b | a name < b name].
selectedSubclasses := Dialog
choose:'Generate super-send in class(es):'
fromList:possibleSubclasses values:possibleSubclasses
buttons:nil values:nil
lines:10 cancel:nil multiple:true.
selectedSubclasses isEmptyOrNil ifTrue:[^ self].
].
self
generateUndoableChangeOverSelectedMethods:'Generate Responsibility for %(singleMethodNameOrNumberOfMethods)'
via:[:generator :eachMethod |
|selector category implClass defineIt parser spec |
selector := eachMethod selector.
category := eachMethod category.
parser := Parser for:eachMethod source.
parser parseMethod.
spec := Parser methodSpecificationForSelector:selector argNames:parser methodArgs.
selectedSubclasses do:[:eachSubClass |
|code|
(eachSubClass includesSelector:selector) ifFalse:[
code := (spec , '\ "/ self halt.\ ^ super ',spec) withCRs.
generator
compile:code
forClass:eachSubClass
inCategory:category
].
].
]
!
selectorMenuGenerateSubclassResponsibilityHere
"generate a subclassResponsibility method (for the selected string)
in the current class"
|selector|
selector := self selectionInCodeView.
selector isEmpty ifTrue:[^ self].
selector := selector asSymbol.
self selectedClassesDo:[:eachClass |
|category|
category := '* as yet unspecified *'.
SmalltalkCodeGeneratorTool
createSubclassResponsibilityMethodFor:selector category:category in:eachClass.
]
"Modified: / 31-01-2011 / 18:29:52 / cg"
!
selectorMenuGenerateSubclassResponsibilityInSuperclass
"generate a subclassResponsibility method in the methods superclass"
self
generateUndoableChangeOverSelectedMethods:'Generate Responsibility in superclass for %(singleMethodNameOrNumberOfMethods)'
via:[:generator :eachMethod |
|selector category mclass implClass defineIt answer|
selector := eachMethod selector.
category := eachMethod category.
mclass := eachMethod mclass.
mclass superclass notNil ifTrue:[
(mclass superclass includesSelector:selector) ifFalse:[
defineIt := true.
implClass := mclass superclass whichClassIncludesSelector:selector.
implClass notNil ifTrue:[
answer := Dialog
confirmWithCancel:(resources
string:'%1 is inherited from %2.\\Define as subclassResponsibility in %3 anyway ?'
with:selector allBold
with:implClass name allBold
with:mclass superclass name allBold
) withCRs.
answer isNil ifTrue:[^ self].
defineIt := answer.
].
defineIt ifTrue:[
generator
createSubclassResponsibilityMethodFor:selector category:category in:mclass superclass.
]
].
].
]
!
selectorMenuGenerateTemplateInAllSubclasses
"generate a template in all subclasses (recursive) for each subclassResponsibility method"
self selectorMenuGenerateTemplateInClassesEnumeratedWith:#allSubclasses
!
selectorMenuGenerateTemplateInClassesEnumeratedWith:aSubclassEnumeratingSelector
"generate a template in some subclass for each subclassResponsibility method"
self
generateUndoableChangeOverSelectedMethods:'Generate Responsibility for %(singleMethodNameOrNumberOfMethods)'
via:[:generator :eachMethod |
|selector category mclass implClass defineIt parser spec |
selector := eachMethod selector.
category := eachMethod category.
mclass := eachMethod mclass.
parser := Parser for:eachMethod source.
parser parseMethod.
spec := Parser methodSpecificationForSelector:selector argNames:parser methodArgs.
(mclass perform:aSubclassEnumeratingSelector) do:[:eachSubClass |
|code|
(eachSubClass includesSelector:selector) ifFalse:[
code := spec , '\ self halt.\ ^ self' withCRs.
generator
compile:code
forClass:eachSubClass
inCategory:category
].
].
]
!
selectorMenuGenerateTemplateInSubclasses
"generate a template in every subclass for each subclassResponsibility method"
self selectorMenuGenerateTemplateInClassesEnumeratedWith:#subclasses
!
selectorMenuInlineParameter
|currentMethod cls selector tree args whichParameter|
(self askIfModified) ifFalse:[
^ self
].
currentMethod := self theSingleSelectedMethod.
cls := currentMethod mclass.
selector := currentMethod selector.
tree := cls parseTreeFor:selector.
tree isNil ifTrue:[
self warn: 'Could not parse the method'.
^ self
].
args := tree argumentNames.
args size > 1 ifTrue:[
whichParameter := self selectionInCodeView.
(whichParameter notEmptyOrNil and:[ args includes:whichParameter]) ifFalse:[
whichParameter := Dialog choose:'Inline which Parameter ?' fromList:args lines:5 title:'Inline Parameter'.
whichParameter isEmptyOrNil ifTrue:[^ self].
].
] ifFalse:[
whichParameter := args first.
].
self codeMenuInlineParameter:whichParameter
!
selectorMenuInlineSelfSends
self codeMenuInlineAllSelfSends
!
selectorMenuInspect
"open an inspector on the single selected method"
|mthd|
mthd := self theSingleSelectedMethod.
mthd notNil ifTrue:[
mthd inspect
].
"Created: / 6.2.2000 / 01:53:56 / cg"
!
selectorMenuLoadSmallTeamVersionFromHost:hostName
"load a smallTeam version"
self selectedMethodsValue do:[:eachMethod |
|changeList change|
changeList := SmallTeam changesOnHost:hostName.
change := changeList
detectLast:[:change |
change changeClass == eachMethod mclass
and:[ change selector == eachMethod selector ] ]
ifNone:nil.
change notNil ifTrue:[
change apply
].
].
"Created: / 12-11-2006 / 15:48:43 / cg"
!
selectorMenuMakeClassMethod
"move the selected methods from inst to their class side or vice versa"
self selectorMenuMakeClassOrInstanceMethod
!
selectorMenuMakeClassMethodWithForwarding
"move the selected methods from inst to their class side
and generate a forwarding method on the instance side"
self selectorMenuMakeClassOrInstanceMethodWithForwarder:true.
!
selectorMenuMakeClassOrInstanceMethod
"move the selected methods from inst to their class side or vice versa"
self selectorMenuMakeClassOrInstanceMethodWithForwarder:false
!
selectorMenuMakeClassOrInstanceMethodWithForwarder:withForwarder
"move the selected methods from inst to their class side or vice versa"
self selectedMethodsValue copy do:[:methodToMove |
|mclass question msg selectorToMove dontDoIt newMethod dstClass|
mclass := methodToMove mclass.
mclass isMeta ifTrue:[
dstClass := mclass theNonMetaclass.
] ifFalse:[
dstClass := mclass theMetaclass.
].
self
moveOrCopyMethods:(Array with:methodToMove)
toClass:dstClass
moveOrCopy:(withForwarder ifTrue:#moveAndForward ifFalse:#move).
"/ dontDoIt := false.
"/ selectorToMove := methodToMove selector.
"/ (dstClass includesSelector:selectorToMove) ifTrue:[
"/ question := '%1 already implements #%2\\Move anyway ?'.
"/ (self confirm:(resources string:question
"/ with:dstClass name allBold
"/ with:selectorToMove) withCRs) ifFalse:[
"/ dontDoIt := true
"/ ]
"/ ].
"/ dontDoIt ifFalse:[
"/ newMethod := dstClass
"/ compile:(methodToMove source)
"/ classified:(methodToMove category).
"/
"/ (newMethod isNil or:[newMethod == #Error]) ifTrue:[
"/ msg := '#%1 not moved - compilation failed due to an error'.
"/ self warn:(resources string:msg with:selectorToMove)
"/ ] ifFalse:[
"/ mclass removeSelector:selectorToMove.
"/ withForwarder ifTrue:[
"/ mClass
"/ compile:(methodToMove source)
"/ classified:(methodToMove category).
"/ self halt.
"/ ].
"/ ]
"/ ]
]
"Modified: / 28-02-2012 / 16:29:23 / cg"
!
selectorMenuMakeIgnored
"make selected methods ignored"
self selectorMenuChangePrivacyTo:#ignored
!
selectorMenuMakeInstanceMethod
"move the selected methods from inst to their class side or vice versa"
self selectorMenuMakeClassOrInstanceMethod
!
selectorMenuMakePrivate
"make selected methods private"
self selectorMenuChangePrivacyTo:#private
!
selectorMenuMakeProtected
"make selected methods protected"
self selectorMenuChangePrivacyTo:#protected
!
selectorMenuMakePublic
"make selected methods public"
self selectorMenuChangePrivacyTo:#public
!
selectorMenuMarkAsObsolete
|useRefactoringSupport changes methodsToChangePackage|
useRefactoringSupport := self canUseRefactoringSupport.
useRefactoringSupport ifTrue:[
changes := CompositeRefactoryChange named:'Mark Method(s) as Obsolete'.
].
methodsToChangePackage := OrderedCollection new.
self selectedMethodsDo:[:eachMethod |
|rs mClass selector source parser definitionPart bodyPart newSource newMethod result
s p1 indent category bodyStartsWithNewLine|
eachMethod isObsolete ifFalse:[
rs := eachMethod resources.
false "rs notEmptyOrNil" ifTrue:[
self halt.
] ifFalse:[
mClass := eachMethod mclass.
selector := eachMethod selector.
source := eachMethod source.
category := eachMethod category.
parser := Parser for:source in:nil.
parser ignoreErrors:true; ignoreWarnings:true; saveComments:true.
parser parseMethodSpec.
"/ insert an obsolete-resource into the first line after the selector-spec
definitionPart := source copyTo:parser endOfSelectorPosition.
bodyPart := source copyFrom:parser endOfSelectorPosition+1.
bodyStartsWithNewLine := false.
s := bodyPart readStream.
[ s peek == Character cr or:[ s peek == Character nl ] ] whileTrue:[ bodyStartsWithNewLine := true. s next ].
p1 := s position.
[ s peek == Character space ] whileTrue:[ s next ].
indent := s position - p1.
indent := indent max:4.
newSource := definitionPart
, '\' withCRs, (String new:indent), '<resource: #obsolete>'.
bodyStartsWithNewLine ifFalse:[
newSource := newSource , '\' withCRs.
].
newSource := newSource , bodyPart.
result := Compiler compile:newSource forClass:mClass install:false.
(result isNil or:[result == #Error]) ifTrue:[
Dialog warn:(resources string:'Failed to compile new version of %1' with:eachMethod whoString allBold).
] ifFalse:[
useRefactoringSupport ifTrue:[
changes
compile:newSource
in:mClass
classified:category.
] ifFalse:[
newMethod := mClass
compile:newSource
classified:category.
].
methodsToChangePackage add:(Array with:mClass
with:selector
with:eachMethod package).
].
].
].
].
useRefactoringSupport ifTrue:[
RefactoryChangeManager performChange: changes.
].
methodsToChangePackage triplesDo:[:cls :sel :pkg|
(cls compiledMethodAt:sel) setPackage:pkg.
].
"Created: / 23-11-2006 / 16:52:27 / cg"
"Modified: / 28-03-2007 / 21:39:59 / cg"
!
selectorMenuMoveOrCopy:doWhat
"move or copy the selected methods to some other class - typically a sister or parent class"
|newClass methods|
newClass := self askForClassToMoveOrCopy:doWhat.
newClass isNil ifTrue:[^ self].
doWhat == #moveAndForward ifTrue:[
newClass isMeta ifFalse:[
(Dialog
confirm:(resources
stringWithCRs:'Destination must be a Metaclass.\\Moving to %1.'
with:newClass theMetaclass name)
noLabel:(resources string:'Cancel')
) ifFalse:[
^ self
].
newClass := newClass theMetaclass.
].
].
methods := self selectedMethodsValue.
self moveOrCopyMethods:methods toClass:newClass moveOrCopy:doWhat
"Modified: / 28-02-2012 / 16:29:26 / cg"
!
selectorMenuMoveToClass
"move the selected methods to some other class - typically a superclass"
self selectorMenuMoveOrCopy:#move
!
selectorMenuMoveToClassProject
"change the package-id of the selected methods to the classes package-id."
|perPackageMethods|
perPackageMethods := Dictionary new.
self selectedMethodsValue do:[:eachMethod |
|methodsPackage classPackage set|
methodsPackage := eachMethod package.
classPackage := eachMethod mclass package.
methodsPackage ~= classPackage ifTrue:[
set := perPackageMethods at:classPackage ifAbsentPut:[Set new].
set add:eachMethod.
].
].
perPackageMethods keysAndValuesDo:[:pkg :setOfMethods |
self moveMethods:setOfMethods toProject:pkg
].
"Created: / 22-11-2006 / 13:17:00 / cg"
!
selectorMenuMoveToClassWithForwarding
"move the selected methods to some other class - typically a superclass"
self selectorMenuMoveOrCopy:#moveAndForward
!
selectorMenuMoveToProject
"change the package-id of the selected methods.
Will eventually update the Project-object"
|newProject classProjects offered affectedMethods msg projectsOfOtherImplementations highRank|
affectedMethods := self selectedMethodsValue.
classProjects := affectedMethods collect:[:eachMethod | eachMethod mclass package] as:Set.
"/ a good default is the grand majority of other implementations (works often)
"/ majority is defined: more than 2/3 of the other impls are in a particular package:
projectsOfOtherImplementations := affectedMethods
collectAll:[:eachMethod |
|selector|
selector := eachMethod selector.
(environment allImplementorsOf:selector)
select:[:cls | (cls compiledMethodAt:selector) ~~ eachMethod]
thenCollect:[:cls | (cls compiledMethodAt:selector) package]
] as: Bag.
"/ Transcript show:'all: '; show:projectsOfOtherImplementations size; show:' this: '; showCR:projectsOfOtherImplementations sortedCounts first.
(projectsOfOtherImplementations notEmpty
and:[
highRank := projectsOfOtherImplementations sortedCounts first.
highRank key > (projectsOfOtherImplementations size * (2/3))
])
ifTrue:[
offered := highRank value
] ifFalse:[
LastProjectMoves size > 0 ifTrue:[
offered := LastProjectMoves first
] ifFalse:[
classProjects size == 1 ifTrue:[
offered := classProjects first
] ifFalse:[
offered := "classesProject ? " Project current package
].
].
].
classProjects remove:offered ifAbsent:[].
classProjects := classProjects asOrderedCollection.
classProjects size == 1 ifTrue:[
msg := resources stringWithCRs:'Move method(s) to which project:\(Hint: The class is in ''%1'')\'
with:(classProjects first allBold).
] ifFalse:[
msg := resources stringWithCRs:'Move method(s) to which project:\'.
].
newProject := self
askForProject:msg
initialText:offered
moreSuggestions:classProjects.
newProject notNil ifTrue:[
self doMoveSelectedMethodsToProject:newProject.
].
"Created: / 17-02-2000 / 23:02:49 / cg"
"Modified: / 28-02-2012 / 16:29:32 / cg"
!
selectorMenuMoveToProtocol
"move selected methods to some other category"
|mthd superClass inherited someCategories goodCandidates newCategory selClasses
initialAnswer methodSelection selectors subclassCategories gotInherited|
methodSelection := self selectedMethodsValue copy.
someCategories := Set new.
goodCandidates := Set new.
"/ offer the current classes's protocols in the dialog
(selClasses := self selectedClassesValue) notNil ifTrue:[
selClasses do:[:eachClass |
someCategories addAll:(eachClass categories).
]
] ifFalse:[
"/ offer the current method-classes' protocols in the dialog
methodSelection do:[:eachMethod | |cls|
(cls := eachMethod mclass) notNil ifTrue:[
someCategories addAll:cls categories
]
]
].
selectors := methodSelection collect:[:each | each selector].
"/ if all selectors are getters/setters, add 'accessing'
RBParser notNil ifTrue:[
|searcher allGettersOrSetters allReturnTrueOrFalse|
searcher := ParseTreeSearcher isGetterOrSetterMethod.
allGettersOrSetters :=
methodSelection
conform:[:eachMethod |
|tree|
tree := RBParser
parseSearchMethod:(eachMethod source)
onError: [:str :pos | nil].
tree notNil and:[ (searcher executeTree:tree initialAnswer:nil) notNil ].
].
allGettersOrSetters ifTrue:[
someCategories add:'accessing'.
goodCandidates add:'accessing'.
initialAnswer := 'accessing'.
].
searcher := ParseTreeSearcher isJustReturningTrueOrFalse.
allReturnTrueOrFalse :=
methodSelection
conform:[:eachMethod |
|tree|
tree := RBParser
parseSearchMethod:(eachMethod source)
onError: [:str :pos | nil].
tree notNil and:[ searcher executeTree:tree initialAnswer:false ].
].
allReturnTrueOrFalse ifTrue:[
someCategories add:'testing'.
goodCandidates add:'testing'.
initialAnswer := 'testing'.
].
].
"/ add actual categories of selected methods
(SystemBrowser findImplementorsOfAny:selectors in:(environment allClasses) ignoreCase:false)
do:[:otherMethod |
|cat|
(methodSelection includesIdentical:otherMethod) ifFalse:[
cat := otherMethod category.
someCategories add:cat.
goodCandidates add:cat.
]
].
"/ look for majority of categories in selection
goodCandidates := (methodSelection collect:[:m | m category]) asBag
reject:[:cat | (cat includesString:'uncategorized')
or:[ cat includesString:'unclassified']].
"/ for isXXX methods, add 'testing'
(methodSelection contains:[:method | method selector = ('is',method mclass name) ]) ifTrue:[
someCategories add:'testing'.
goodCandidates add:'testing'.
].
"/ for hasXXX, canXXX methods, add 'queries'
(methodSelection contains:[:method | |sel|
sel := method selector.
((sel startsWith:'has') and:[sel size > 3 and:[ (sel at:4) isUppercase ]])
or:[ ((sel startsWith:'can') and:[sel size > 3 and:[ (sel at:4) isUppercase ]])
or:[ ((sel startsWith:'is') and:[sel size > 2 and:[ (sel at:3) isUppercase ]]) ]]]) ifTrue:[
someCategories add:'queries'.
goodCandidates add:'queries'.
].
(methodSelection contains:[:method | method selector asLowercase endsWith:'do:']) ifTrue:[
someCategories add:'enumeration'.
goodCandidates add:'enumeration'.
].
(methodSelection contains:[:method | method selector startsWith:'init']) ifTrue:[
someCategories add:'initialization'.
goodCandidates add:'initialization'.
].
(methodSelection contains:[:method | method selector startsWith:'new']) ifTrue:[
someCategories add:'instance creation'.
goodCandidates add:'instance creation'.
].
goodCandidates size == 1 ifTrue:[
initialAnswer := goodCandidates anElement
] ifFalse:[
(mthd := self theSingleSelectedMethod) notNil ifTrue:[
gotInherited := false.
"look for protocol of inherited"
superClass := mthd mclass superclass.
superClass notNil ifTrue:[
superClass := superClass whichClassIncludesSelector:mthd selector.
superClass notNil ifTrue:[
inherited := superClass compiledMethodAt:mthd selector.
inherited notNil ifTrue:[
initialAnswer := inherited category.
gotInherited := true.
]
] ifFalse:[
superClass := mthd mclass superclass.
].
].
"look for majority protocol in subclasses"
subclassCategories := Bag new.
superClass notNil ifTrue:[
mthd mclass allSubclassesDo:[:cls |
|redefined|
redefined := superClass compiledMethodAt:mthd selector.
redefined notNil ifTrue:[
subclassCategories add:(redefined category).
]
].
].
subclassCategories notEmpty ifTrue:[
subclassCategories := (subclassCategories valuesAndCounts
sort:[:a :b | a value > b value])
collect:[:each | each key].
someCategories addAll:(subclassCategories first:(3 min:subclassCategories size)).
gotInherited ifFalse:[
initialAnswer := subclassCategories first.
]
].
]
].
someCategories := someCategories asOrderedCollection sort.
newCategory := self
askForMethodCategory:'Move to which protocol ?'
title:'Change MethodCategory'
okLabel:'Move'
list:someCategories
initialAnswer:(initialAnswer ? (lastMethodCategory ? self theSingleSelectedProtocol)).
self moveMethods:methodSelection toProtocol:newCategory
"Modified: / 28-02-2012 / 16:52:19 / cg"
!
selectorMenuNewImageSpec
"open a bitmap painter for a new image-spec method"
self selectorMenuNewSpecMethodWithType:#image
"Modified: / 01-03-2007 / 20:56:09 / cg"
!
selectorMenuNewMenuSpec
"open a Menu painter for a new menu-spec method"
self selectorMenuNewSpecMethodWithType:#menu
"Modified: / 01-03-2007 / 20:56:19 / cg"
!
selectorMenuNewMethod
"show a template for a new method for an unknown language"
^ self selectorMenuNewMethod: nil "no language"
!
selectorMenuNewMethod: language
"show a template for a new method for a given language"
self setAcceptActionForMethodUsingLanguage: language.
^ self showCode:(self showMethodTemplate value ifTrue:[self methodTemplate] ifFalse:[''])
"Modified: / 17-02-2000 / 23:14:14 / cg"
"Created: / 30-12-2009 / 19:37:43 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
selectorMenuNewSpecMethodWithType:specTypeSymbol
"open a painter for a new specTypeSymbol-spec method.
specTypeSymbol is one of #image, #canvas or #menu"
|editorClass currentClass|
(currentClass := self theSingleSelectedClass) notNil ifTrue:[
"/
"/ kludge - this info should come from somewhere else ...
"/
editorClass := self class resourceEditorClassFor:specTypeSymbol.
editorClass notNil ifTrue: [
editorClass
openOnClass:currentClass theNonMetaclass
andSelector:nil
]
]
"Created: / 01-03-2007 / 20:55:46 / cg"
!
selectorMenuNewTableColumnSpec
"open a GUI painter for a new tableColumn-spec method"
self selectorMenuNewSpecMethodWithType:#tableColumns
!
selectorMenuNewWindowSpec
"open a GUI painter for a new window-spec method"
self selectorMenuNewSpecMethodWithType:#canvas
"Modified: / 01-03-2007 / 20:56:49 / cg"
!
selectorMenuPrintOut
"print out the current method(s)"
|printStream|
printStream := Printer new.
self selectedMethodsDo:[:eachMethod |
eachMethod mclass printOutSource:(eachMethod source) on:printStream.
].
printStream close
!
selectorMenuProcess
"process methods"
|processingBlockString processingBlock dialog textHolder template|
template :=
'"/ general method code processor;
"/ the following block will be evaluated for each selected method.
"/ Beginner warning: Smalltalk know-how is recommended here.
[:class :selector :method|
"/ Useful queries to the method are:
"/ - source to access its full sourceCode
"/ - package the classes package
"/ - hasExtentsion true if it has extensions (methods in other packages)
"/ - implements: true if it implements a particular message
"/ - isSubclassOf: true if it is a subclass of some other class
"/ - isSuperclassOf: true if it is a superclass of some other class
"/ - name the classes name
"/ - category the classes category
"/ - nameSpace the classes namespace
"/ example (rename all foo* methods)
(selector startsWith:''foo'') ifTrue:[
newSource := ''bar'' , (method source copyFrom:3+1).
class
compile:newSource
classified:(method category).
class removeSelector:selector.
].
].
'.
LastMethodProcessingBlockString isNil ifTrue:[
LastMethodProcessingBlockString := template.
].
textHolder := ValueHolder new.
dialog := Dialog
forRequestText:(resources string:'Enter method processing block')
lines:25
columns:70
initialAnswer:LastMethodProcessingBlockString
model:textHolder.
dialog addButton:(Button label:'Template' action:[textHolder value:template. textHolder changed:#value.]).
dialog open.
dialog accepted ifFalse:[^ self].
processingBlockString := textHolder value.
LastMethodProcessingBlockString := processingBlockString.
processingBlock := Parser evaluate:processingBlockString.
processingBlock isBlock ifFalse:[
self error:'bad input'.
^ self
].
self
selectedMethodsDo:[:eachMethod |
processingBlock
value:(eachMethod mclass)
value:(eachMethod selector)
value:eachMethod
]
!
selectorMenuPushDownMethod
"push method(s) into subclass(s)"
self selectorMenuPushMethod:#down
!
selectorMenuPushMethod:upOrDown
"push method(s) into subclass(s) or up into superclas"
|selectedMethods|
(self askIfModified:'Code was modified.\\Push method(s) anyway ?')
ifFalse:[^ self].
selectedMethods := self selectedMethodsValue.
(selectedMethods collect:[:m | m mclass] as:IdentitySet) do:[:eachClass |
|selectors refactoring nm|
selectors := selectedMethods select:[:m | m mclass == eachClass] thenCollect:[:each | each selector].
upOrDown == #down ifTrue:[
refactoring := PushDownMethodRefactoring pushDown:selectors from:eachClass.
nm := 'Push down '.
] ifFalse:[
refactoring := PushUpMethodRefactoring pushUp:selectors from:eachClass.
nm := 'Push up '.
].
selectors size == 1 ifTrue:[
nm := nm , selectors first.
] ifFalse:[
nm := nm , selectors size printString , ' methods'.
].
nm := nm , ' from ' , eachClass name.
refactoring model name:nm.
self performRefactoring:refactoring.
].
"Modified: / 28-02-2012 / 16:29:38 / cg"
!
selectorMenuPushUpMethod
"push method(s) into superclass"
self selectorMenuPushMethod:#up
!
selectorMenuRecompile
"recompile the selected methods (for Debug only)"
self selectedMethodsValue do:[:eachMethod |
eachMethod mclass recompile:eachMethod selector
]
"Modified: / 28-02-2012 / 16:29:42 / cg"
!
selectorMenuRemove
"confirm removal of the selected methods (but does not search for senders),
then remove them."
self doRemoveMethodsConfirmed:(self selectedMethodsValue)
"Modified: / 28-02-2012 / 16:29:45 / cg"
!
selectorMenuRemoveAndSelectNext
"confirm removal of the selected methods (but does not search for senders),
then remove them and select the one after the last selected."
self doRemoveMethodsConfirmed:(self selectedMethodsValue) select:#next
!
selectorMenuRemoveAndSelectPrevious
"confirm removal of the selected methods (but does not search for senders),
then remove them and select the one before the first selected."
self doRemoveMethodsConfirmed:(self selectedMethodsValue) select:#previous
!
selectorMenuRemoveParameter
|currentMethod cls selector tree args whichParameter|
(self askIfModified) ifFalse:[
^ self
].
currentMethod := self theSingleSelectedMethod.
cls := currentMethod mclass.
selector := currentMethod selector.
tree := cls parseTreeFor:selector.
tree isNil ifTrue:[
self warn: 'Could not parse the method'.
^ self
].
args := tree argumentNames.
args size > 1 ifTrue:[
whichParameter := self selectionInCodeView.
(whichParameter notEmptyOrNil and:[ args includes:whichParameter]) ifFalse:[
whichParameter := Dialog choose:'Remove which Parameter ?' fromList:args lines:5 title:'Remove Parameter'.
whichParameter isEmptyOrNil ifTrue:[^ self].
].
] ifFalse:[
whichParameter := args first.
].
self codeMenuRemoveParameter:whichParameter
!
selectorMenuRename
"rename a method (and rewrite all of its callers)"
|mthd methods selectorsDone|
mthd := self theSingleSelectedMethod.
mthd isNil ifTrue:[
methods := self selectedMethodsValue.
(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.
"Modified: / 28-02-2012 / 16:43:57 / cg"
!
selectorMenuRewrite
MethodRewriter new
methods: self selectedMethodsValue;
open
"Created: / 05-07-2011 / 14:49:06 / cg"
!
selectorMenuSaveRemove
"check for senders (and windowSpec/menuSpec refs) to method's selector,
then confirm removal of the selected methods"
|selectorsToRemove methodsToRemove selectorsToCheckForInvokation selectorsToCheckForSelectorUse
possiblyInvoked possiblyUsedAsSelector msg isAre answer selInfo methods brwsr numVersionMethods|
selectorsToRemove := IdentitySet new.
numVersionMethods := 0.
self selectedMethodsDo:[:eachMethod |
selectorsToRemove add:(eachMethod selector).
(AbstractSourceCodeManager isVersionMethodSelector:eachMethod selector) ifTrue:[
eachMethod mclass isMeta ifTrue:[
numVersionMethods := numVersionMethods + 1
]
]
].
selectorsToCheckForInvokation := IdentitySet new addAll:selectorsToRemove; yourself.
selectorsToCheckForSelectorUse := IdentitySet new addAll:selectorsToRemove; yourself.
possiblyInvoked := IdentitySet new.
possiblyUsedAsSelector := IdentitySet new.
methodsToRemove := self selectedMethodsValue copy.
self withSearchCursorDo:[
"/ search through all of the system
environment allMethodsDo:[:mthd |
|sent resources newFound any|
any := false.
mthd literalsDo:[:eachLiteral |
(selectorsToRemove includes:eachLiteral) ifTrue:[any := true].
"/ could be an array (as in a spec)
eachLiteral isArray ifTrue:[
selectorsToRemove contains:[:selToRemove |
(eachLiteral refersToLiteral:selToRemove) ifTrue:[
possiblyUsedAsSelector add:mthd.
]
]
]
].
any ifTrue:[
selectorsToRemove do:[:eachSelectorToRemove |
sent := mthd messagesSent.
(sent includes:eachSelectorToRemove) ifTrue:[
(methodsToRemove includesIdentical:mthd) ifFalse:[
possiblyInvoked add:mthd.
]
]
]
].
mthd hasResource ifTrue:[
newFound := IdentitySet new.
selectorsToRemove do:[:eachSelectorToRemove |
(mthd refersToLiteral:eachSelectorToRemove) ifTrue:[
(methodsToRemove 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
with:possiblyUsedAsSelector size)
, '\\Really remove ?') withCRs
label:(resources string:'Attention')
image:(WarningBox iconBitmap)
buttonLabels:(resources array:#( 'Cancel' 'Remove' 'Remove then Browse Senders' 'Browse Senders'))
values:#(false true #removeAndBrowse #browse )
default:#removeAndBrowse
onCancel:false.
answer == false ifTrue:[^ self].
(answer == #browse or:[answer == #removeAndBrowse]) 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
].
answer == #browse ifTrue:[ ^ self ].
"/ fall into remove
].
self doRemoveMethodsUnconfirmed:methodsToRemove
"Modified: / 11-05-2012 / 10:00:46 / cg"
!
selectorMenuSelectMethodsWithString
"select all methods containing a particular string"
self shouldImplement.
^ self selectMethodsWhere:[:mthd | self shouldImplement ]
!
selectorMenuSpawnExtensionsProject
"open a new browser showing the selected extension methods' project(s)"
|projects|
projects := (self selectedMethodsValue collect:[:m | m package] as:Set) asSortedCollection.
^ self
spawnProjectBrowserFor:projects
in:#newBrowser
"Modified: / 28-02-2012 / 16:30:06 / cg"
!
selectorMenuSpawnExtensionsProjectBuffer
"open a new browser showing the selected extension methods' project(s)"
|projects|
projects := (self selectedMethodsValue collect:[:m | m package] as:Set) asSortedCollection.
^ self
spawnProjectBrowserFor:projects
in:#newBuffer
"Modified: / 28-02-2012 / 16:30:08 / cg"
!
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 selectedMethodsValue)
in:#newBrowser
label:nil
"Modified: / 28-02-2012 / 16:30:11 / cg"
!
selectorMenuSpawnMethodBuffer
"add a new buffer showing the selected methods only"
^ self
spawnMethodBrowserFor:(self selectedMethodsValue)
in:#newBuffer
label:nil
"Modified: / 28-02-2012 / 16:30:14 / cg"
!
selectorMenuSpawnProjectExtensions
"open a new browser showing all extension methods for the
selected methods project(s)"
^ self
spawnProjectExtensionsBrowserFor:(self selectedMethodsValue)
in:#newBrowser
"Modified: / 28-02-2012 / 16:30:16 / cg"
!
selectorMenuSpawnProjectExtensionsBuffer
"add a new buffer showing all extension methods for the
selected methods project(s)"
^ self
spawnProjectExtensionsBrowserFor:(self selectedMethodsValue)
in:#newBuffer
"Modified: / 28-02-2012 / 16:30:19 / cg"
!
selectorMenuSpawnSenders
"open a new browser showing senders of the selected method"
^ self
spawnMethodSendersBrowserFor:(self selectedSelectors)
in:#newBrowser
!
selectorMenuSpawnSendersBuffer
"add a new buffer showing senders of the selected methods selector"
^ self
spawnMethodSendersBrowserFor:(self selectedSelectors)
in:#newBuffer
!
spawnBrowserOnAllImplementorsOf:aSelector
"open a new browser or add a buffer showing the selected methods implementations only"
^ self spawnMethodImplementorsBrowserFor:(Array with:aSelector) match:false in:#newBuffer
!
spawnBrowserOnAllSendersOf:aSelector
"open a new browser or add a buffer showing the selected methods senders only"
^ self spawnMethodSendersBrowserFor:(Array with:aSelector) in:#newBuffer
!
spawnCallersBrowser
"browse callers of the selected method(s)"
^ self spawnCallersIn:#newBrowser
"Created: / 27-04-2010 / 15:09:20 / cg"
!
spawnCallersBrowserFor:aMethodCollection in:openHow
"open a new browser or add a buffer showing the selected method's callers"
|label|
self withSearchCursorDo:[
|cachedList newBrowser searchBlock|
aMethodCollection size == 1 ifTrue:[
label := resources string:('Callers of %1') with:aMethodCollection first whoString allBold.
] ifFalse:[
label := resources string:'Callers of Any'.
].
searchBlock := [
|l|
cachedList notNil ifTrue:[
l := cachedList.
cachedList := nil
] ifFalse:[
l := IdentitySet new.
aMethodCollection do:[:eachCalledMethod |
|info|
info := eachCalledMethod methodInvocationInfo.
info notNil ifTrue:[
info callingMethodsDo:[:caller |
l add:caller
]
]
].
l := l asOrderedCollection
].
l
].
newBrowser := self
spawnMethodBrowserForSearch:searchBlock
sortBy:#class
in:openHow
label:label.
]
"Created: / 27-04-2010 / 15:16:40 / cg"
!
spawnCallersBuffer
"browse callers of the selected method(s)"
^ self spawnCallersIn:#newBuffer
"Created: / 27-04-2010 / 15:09:02 / cg"
!
spawnCallersIn:openHow
"open a new browser or add a buffer showing the selected method's callers"
self spawnCallersBrowserFor:(self selectedMethodsValue) in:openHow
"Created: / 27-04-2010 / 15:17:33 / cg"
!
spawnImplementorChainBrowser
"browse implementations chain"
^ self spawnImplementorChainIn:#newBrowser
!
spawnImplementorChainBuffer
"browse implementations chain"
^ self spawnImplementorChainIn:#newBuffer
!
spawnImplementorChainIn:openHow
"browse implementation chain;
openHow is: #newBrowser - open a new browser showing the method(s)
openHow is: #newBuffer - add a new buffer showing the method(s)
"
|searchBlock "must be first local in block (see #methodsSelectionChangedAt:index, which fetches this value)"
spec aMethod multipleMethods methods lbl|
multipleMethods := self selectedMethodsValue size > 1.
multipleMethods ifTrue:[
methods := self selectedMethodsValue 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:(environment 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: / 28-02-2012 / 16:37:04 / cg"
!
spawnLocalImplementorsBuffer
"add a new buffer showing implementations of the selected method"
^ self
spawnMethodLocalImplementorsBrowserFor:(self selectedSelectors)
in:#newBuffer
"Created: / 05-09-2006 / 10:51:47 / cg"
!
spawnLocalSendersBuffer
"add a new buffer showing local senders of the selected methods selector"
^ self
spawnMethodLocalSendersBrowserFor:(self selectedSelectors)
in:#newBuffer
"Created: / 05-09-2006 / 10:44:28 / cg"
!
spawnMethodBrowserFor:methods in:where label:labelOrNil
"browse selected method(s);
where is: #newBrowser - open a new browser showing the method(s)
where is: #newBuffer - add a new buffer showing the method(s)"
^ self
spawnMethodBrowserFor:methods
in:where
label:labelOrNil
perMethodInfo:nil
sortBy:nil
!
spawnMethodBrowserFor:methods in:where label:labelOrNil perClassInfo:perClassInfoOrNil perMethodInfo:perMethodInfoOrNil sortBy:sortHow
"browse selected method(s);
where is: #newBrowser - open a new browser showing the method(s)
where is: #newBuffer - add a new buffer showing the method(s)"
^ self
spawnMethodBrowserFor:methods
in:where
label:labelOrNil
perClassInfo:perClassInfoOrNil
perMethodInfo:perMethodInfoOrNil
sortBy:sortHow
select:true
!
spawnMethodBrowserFor:methodsOrMethodGeneratorBlock in:where label:labelOrNil perClassInfo:perClassInfoHolder perMethodInfo:perMethodInfoHolder sortBy:sortHow select:doSelect
"browse selected method(s);
where is: #newBrowser - open a new browser showing the method(s)
where is: #newBuffer - add a new buffer showing the method(s)"
|theMethodList spec "singleSelection"|
methodsOrMethodGeneratorBlock isBlock ifTrue:[
theMethodList := methodsOrMethodGeneratorBlock value.
] ifFalse:[
theMethodList := methodsOrMethodGeneratorBlock copy.
].
(theMethodList isEmptyOrNil and:[perClassInfoHolder value isEmptyOrNil]) ifTrue:[
self information:'Nothing found'.
^ self.
].
(perMethodInfoHolder value notEmptyOrNil) ifTrue:[
(perClassInfoHolder value notEmptyOrNil) ifTrue:[
"/ both present
spec := #multipleClassWithInfoAndMethodWithInfoBrowserSpec.
] ifFalse:[
"/ methodInfo present
spec := #multipleMethodWithInfoBrowserSpec.
].
] ifFalse:[
(perClassInfoHolder value notEmptyOrNil) ifTrue:[
"/ classInfo present
spec := #multipleClassWithInfoBrowserSpec.
] ifFalse:[
"/ none present
spec := #multipleMethodBrowserSpec.
].
].
^ self
newBrowserOrBufferDependingOn:where
label:labelOrNil
forSpec:spec
setupWith:[:brwsr |
|methodGenerator classGenerator perClassInfo perMethodInfo
theMethodNameList|
theMethodList isNil ifTrue:[
methodsOrMethodGeneratorBlock isBlock ifTrue:[
theMethodList := methodsOrMethodGeneratorBlock value.
] ifFalse:[
theMethodList := methodsOrMethodGeneratorBlock copy.
].
].
perClassInfo := perClassInfoHolder value.
perMethodInfo := perMethodInfoHolder value.
methodGenerator := Iterator on:[:whatToDo |
theMethodList isNil ifTrue:[
methodsOrMethodGeneratorBlock isBlock ifTrue:[
theMethodList := methodsOrMethodGeneratorBlock value.
] ifFalse:[
theMethodList := methodsOrMethodGeneratorBlock copy.
].
].
perClassInfo := perClassInfoHolder value.
perMethodInfo := perMethodInfoHolder value.
theMethodList do:[:eachMethod |
|methodClass methodSelector realMethod|
eachMethod notNil ifTrue:[
methodClass := eachMethod mclass.
methodClass notNil ifTrue:[
methodSelector := eachMethod selector.
realMethod := methodClass compiledMethodAt:methodSelector.
realMethod notNil ifTrue:[
whatToDo
value:methodClass
value:realMethod category
value:methodSelector
value:realMethod.
].
].
].
].
methodsOrMethodGeneratorBlock isBlock ifTrue:[
theMethodList := nil.
].
"enforce display of class in methodList"
whatToDo
value:nil
value:nil
value:nil
value:nil.
theMethodList size > 7 ifTrue:[
brwsr showInfo:('%1 methods in list.' bindWith:theMethodList size).
]
].
sortHow notNil ifTrue:[brwsr sortBy value:sortHow].
brwsr selectorListGenerator value:methodGenerator.
perClassInfo notNil ifTrue:[
classGenerator := perClassInfo keys.
brwsr classListGenerator value:classGenerator.
brwsr meta value:false.
].
perClassInfo notNil ifTrue:[
brwsr selectedClasses
onChangeEvaluate:[
|class infoText|
brwsr selectedMethods value:nil.
class := brwsr theSingleSelectedClass.
class notNil ifTrue:[
brwsr meta value:false.
infoText := perClassInfoHolder value at:class theNonMetaclass ifAbsent:nil.
infoText isNil ifTrue:[
infoText := perClassInfo at:class theMetaclass ifAbsent:nil
]
].
brwsr methodInfo value:infoText.
]
].
perMethodInfo notNil ifTrue:[
brwsr selectedMethods
onChangeEvaluate:[
|mthd infoText|
brwsr selectedClasses value:nil.
mthd := brwsr theSingleSelectedMethod.
mthd notNil ifTrue:[
infoText := perMethodInfo at:mthd ifAbsent:nil
].
brwsr methodInfo value:infoText.
]
] ifFalse:[
(doSelect and:[theMethodList size == 1]) ifTrue:[
brwsr selectMethods:(Array with:theMethodList first).
brwsr methodsSelectionChanged.
]
].
methodsOrMethodGeneratorBlock isBlock ifTrue:[
theMethodList := nil "/ force re-evaluation
]
]
"Modified: / 19-07-2012 / 11:51:02 / 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|
self withWaitCursorDo:[
theMethodList := searchBlock value.
].
theMethodList isEmptyOrNil 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].
brwsr selectorListGenerator value:generator.
"/ auto-select the first method, if there is only one
theMethodList size == 1 ifTrue:[
brwsr selectMethods:theMethodList.
brwsr methodsSelectionChanged.
].
]
"Modified: / 1.3.2000 / 21:03:34 / cg"
!
spawnMethodImplementorsBrowserFor:aSelectorCollection in:openHow
"open a new browser or add a buffer showing the selected methods only"
^ self
spawnMethodImplementorsBrowserFor:aSelectorCollection
match:true
in:openHow
"Modified: / 05-09-2006 / 10:49:28 / cg"
!
spawnMethodImplementorsBrowserFor:aSelectorCollection match:doMatch in:openHow
"open a new browser or add a buffer showing the selected methods"
self
spawnMethodImplementorsBrowserFor:aSelectorCollection
match:doMatch
in:openHow
classes:environment allClasses
label:'Implementors'
"Modified: / 05-09-2006 / 11:07:20 / cg"
!
spawnMethodImplementorsBrowserFor:aSelectorCollection match:doMatch in:openHow classes:classes label:labelPrefix
"open a new browser or add a buffer showing the selected methods only"
self withSearchCursorDo:[
|newBrowser label impls searchBlock cachedList theSingleSelector|
aSelectorCollection size == 1 ifTrue:[
theSingleSelector := aSelectorCollection first.
label := resources string:(labelPrefix,' of %1') with:(theSingleSelector allBold)
] ifFalse:[
label := resources string:labelPrefix.
].
LastSearchedImplementors isNil ifTrue:[
LastSearchedImplementors := OrderedCollection new.
].
LastSearchedImplementors addAllFirst: aSelectorCollection.
LastSearchedImplementors size > 20 ifTrue:[
LastSearchedImplementors removeFromIndex:21
].
searchBlock :=
[
|list|
(list := cachedList) notNil ifTrue:[
cachedList := nil
] ifFalse:[
list := IdentitySet new.
aSelectorCollection do:[:aSelector |
doMatch ifTrue:[
list addAll:(self class
findImplementorsMatching:aSelector
in:classes
ignoreCase:false
)
] ifFalse:[
list addAll:(self class
findImplementorsOf:aSelector
in:environment allClasses
ignoreCase:false
)
].
].
list := list asOrderedCollection
].
list
].
cachedList := searchBlock value.
(cachedList size == 1 and:[cachedList first == self theSingleSelectedMethod]) ifTrue:[
(Dialog
confirm:label,' - ',(resources stringWithCRs:'only the selected method found.\\Browse anyway?')
initialAnswer:false)
ifFalse:[
^ self
]
].
newBrowser := self
spawnMethodBrowserForSearch:searchBlock
sortBy:nil
in:openHow
label:label.
aSelectorCollection size == 1 ifTrue:[
newBrowser sortBy value:#classes
].
newBrowser
]
"Created: / 05-09-2006 / 11:07:05 / cg"
"Modified: / 13-02-2012 / 13:15:40 / cg"
!
spawnMethodInheritanceBrowserFor:aSelectorCollection in:openHow
"open a new browser or add a buffer showing the selected methods inheritance only"
self withSearchCursorDo:[
|selectedMethods classes list newBrowser label searchBlock
initialList anyRedefined|
(selectedMethods := self selectedMethodsValue) size == 0 ifTrue:[
self warn:'No method selected.'.
^ self
].
"/ classes := self selectedClasses value.
classes isNil ifTrue:[
classes := selectedMethods
collect:[:eachMethod | eachMethod mclass]
thenSelect:[:eachClass | eachClass notNil].
].
searchBlock := [
|list subList already|
(list := initialList) size > 0 ifTrue:[
initialList := nil
] ifFalse:[
already := IdentitySet new.
list := OrderedCollection new.
aSelectorCollection do:[:eachSelector |
classes do:[:eachClass |
(eachClass withAllSuperclasses reversed , 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 showInfo:msg.
"/ 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.
]
"Modified: / 28-02-2012 / 16:30:45 / cg"
!
spawnMethodLocalImplementorsBrowserFor:aSelectorCollection in:openHow
"open a new browser or add a buffer showing the selected methods only"
^ self
spawnMethodImplementorsBrowserFor:aSelectorCollection
match:true
in:openHow
classes:(self selectedLocalMethodClasses)
label:'Local Implementors'
"Created: / 05-09-2006 / 10:49:50 / cg"
!
spawnMethodLocalSendersBrowserFor:aSelectorCollection in:openHow
"open a new browser or add a buffer showing the selected methods local senders"
self
spawnMethodSendersBrowserFor:aSelectorCollection
in:openHow
classes:(self selectedLocalMethodClasses)
label:'Local Senders'
"Created: / 05-09-2006 / 10:46:35 / cg"
!
spawnMethodSendersBrowserFor:aSelectorCollection in:openHow
"open a new browser or add a buffer showing the selected methods senders only"
self
spawnMethodSendersBrowserFor:aSelectorCollection
in:openHow
classes:environment allClasses
label:'Senders'
"Modified: / 13-02-2012 / 13:17:20 / cg"
!
spawnMethodSendersBrowserFor:aSelectorCollection in:openHow classes:setOfClasses label:labelPrefix
"open a new browser or add a buffer showing the selected methods senders from setOfClasses"
self withSearchCursorDo:[
|label cachedList newBrowser theSingleSelector searchBlock answer
implementors numImplementors extraInfo buttonLabels buttonActions|
aSelectorCollection size == 1 ifTrue:[
theSingleSelector := aSelectorCollection first.
label := resources string:(labelPrefix,' of %1') with:theSingleSelector allBold.
] ifFalse:[
label := resources string:labelPrefix.
].
searchBlock :=
[
|l|
cachedList notNil ifTrue:[
l := cachedList.
cachedList := nil
] ifFalse:[
l := IdentitySet new.
aSelectorCollection do:[:aSelector |
l addAll:(self class
findSendersOf:aSelector in:setOfClasses
ignoreCase:false match:false
)
].
l := l asOrderedCollection
].
l
].
theSingleSelector notNil ifTrue:[
cachedList := searchBlock value.
cachedList size == 0 ifTrue:[
"/ check if there are implementors
implementors := SystemBrowser findImplementorsOfAny:aSelectorCollection in:nil ignoreCase:false.
buttonLabels := #('Cancel' 'Search String').
buttonActions := #(nil #string).
(numImplementors := implementors size) == 0 ifTrue:[
"/ no implementors
extraInfo := resources stringWithCRs:'.\\There are no implementors of it'.
] ifFalse:[
((numImplementors == 1)
and:[ implementors first == self theSingleSelectedMethod ]
) ifTrue:[
extraInfo := resources stringWithCRs:'.\\The selected method is the only implemention.'
] ifFalse:[
(numImplementors == 1) ifTrue:[
extraInfo := resources stringWithCRs:'.\\The only implemention is in %1' with:(implementors first mclass name)
] ifFalse:[
extraInfo := resources stringWithCRs:'.\\There are %1 implementions' with:numImplementors
].
buttonLabels := #('Cancel' 'Search String' 'Show Implementors').
buttonActions := #(nil #string #implementors).
].
].
label := label , (resources string:' - none found') , extraInfo.
answer := Dialog
confirmWithCancel:label
labels:(resources array:buttonLabels)
values: buttonActions
default:nil.
(answer == #string) ifTrue:[
self spawnMethodStringSearchBrowserFor:aSelectorCollection in:openHow
] ifFalse:[
(answer == #implementors) ifTrue:[
self spawnMethodImplementorsBrowserFor:aSelectorCollection in:openHow
].
].
^ self
].
(cachedList size == 1 and:[cachedList first == self theSingleSelectedMethod]) ifTrue:[
(Dialog confirm:(label,' - ',(resources stringWithCRs:'only the selected method found.\\Browse anyway ?')))
ifFalse:[
^ self
]
].
].
newBrowser := self
spawnMethodBrowserForSearch:searchBlock
sortBy:#class
in:openHow
label:label.
theSingleSelector notNil ifTrue:[
newBrowser setSearchSelector:theSingleSelector ignoreCase:false doMatch:false.
].
]
"Created: / 05-09-2006 / 10:43:21 / cg"
!
spawnMethodStringSearchBrowserFor:aStringCollection in:openHow
"open a new browser or add a buffer showing the selected methods only"
^ self
spawnMethodStringSearchBrowserFor:aStringCollection
match:false
in:openHow
classes:environment allClasses
label:'string search'
!
spawnMethodStringSearchBrowserFor:aStringCollection match:doMatch in:openHow classes:classes label:labelPrefix
"open a new browser or add a buffer showing the selected methods only"
self withSearchCursorDo:[
|newBrowser label impls searchBlock cachedList theSingleString|
aStringCollection size == 1 ifTrue:[
theSingleString := aStringCollection first.
label := resources string:(labelPrefix,' with %1') with:(theSingleString allBold)
] ifFalse:[
label := resources string:labelPrefix.
].
searchBlock :=
[
|list|
(list := cachedList) notNil ifTrue:[
cachedList := nil
] ifFalse:[
list := IdentitySet new.
aStringCollection do:[:eachString |
list addAll:(self class
findString:eachString
in:classes
ignoreCase:false
match:doMatch
)
].
list := list asOrderedCollection
].
list
].
cachedList := searchBlock value.
(cachedList size == 1 and:[cachedList first == self theSingleSelectedMethod]) ifTrue:[
(Dialog
confirm:label,' - ',(resources stringWithCRs:'only the selected method found.\\Browse anyway?')
initialAnswer:false
) ifFalse:[
^ self
]
].
newBrowser := self
spawnMethodBrowserForSearch:searchBlock
sortBy:nil
in:openHow
label:label.
newBrowser autoSearchPattern:(aStringCollection asStringWith:'|') ignoreCase:false match:doMatch.
newBrowser sortBy value:#classes.
newBrowser
]
!
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] as:Set.
packages size == 1 ifTrue:[
theSinglePackage := packages first.
label := 'Extensions for %1' bindWith:theSinglePackage.
] ifFalse:[
label := 'Extensions'.
].
searchBlock := [
|l|
cachedList notNil ifTrue:[
l := cachedList.
cachedList := nil
] ifFalse:[
l := OrderedCollection new.
environment allClasses
do:[:eachClass |
l addAll:(eachClass extensions
select:[:extensionMethod |
(packages includes:extensionMethod package)])
].
].
l
].
theSinglePackage notNil ifTrue:[
cachedList := searchBlock value.
cachedList size == 0 ifTrue:[
self information:(label , ' - none found').
^ self
].
(cachedList size == 1 and:[cachedList first == self theSingleSelectedMethod]) ifTrue:[
(self confirm:((label bindWith:label) , ' - only the selected method found.\\Browse anyway ?' withCRs))
ifFalse:[
^ self
]
].
].
newBrowser := self
spawnMethodBrowserForSearch:searchBlock
sortBy:#class
in:openHow
label:label.
]
"Modified: / 12-10-2006 / 20:59:02 / cg"
!
spawnSenderChainBrowser
"browse selected methods sender chain"
^ self spawnSenderChainIn:#newBrowser
!
spawnSenderChainBuffer
"browse selected methods sender chain"
^ self spawnSenderChainIn:#newBuffer
!
spawnSenderChainIn:openHow
"browse selected methods sender chain;
openHow is: #newBrowser - open a new browser showing the method(s)
openHow is: #newBuffer - add a new buffer showing the method(s)
"
|searchBlock "must be first local in block (see #methodsSelectionChangedAt:index, which fetches this value)"
spec aMethod multipleMethods methods lbl|
multipleMethods := self selectedMethodsValue size > 1.
multipleMethods ifTrue:[
methods := self selectedMethodsValue 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:(environment 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: / 28-02-2012 / 16:36:22 / cg"
! !
!NewSystemBrowser methodsFor:'menu actions-subversion'!
commonMenuSubversionOpenSettings
^SVN::ConfigurationApp open
"Modified: / 26-03-2010 / 20:01:54 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!NewSystemBrowser methodsFor:'menu actions-subversion-class'!
classMenuSubversionShowRevisionLog
| pkg classes branch path |
classes := self selectedClassesValue.
pkg := self theSingleSelectedProjectFromClasses.
path := classes size == 1
ifTrue: [SVN::Repository containerNameForClass: classes anyOne]
ifFalse:[''].
branch := (self svnRepositoryFor: pkg) branch.
SVN::RevisionLogBrowser new
branch: branch;
path: path;
open
"Modified: / 25-06-2010 / 10:08:16 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 28-02-2012 / 16:48:38 / cg"
! !
!NewSystemBrowser methodsFor:'menu actions-variables'!
browseVarRefsOrModsWithTitle:browserTitle boxTitle:boxTitle variables:varType access:accessType all:browseAll
"show an enterbox for instVar/classVar to search for.
Then open a new browser or add a buffer showing methods referring/modifying to that var"
|box b allNames varNames varNameList openHow classes copyOfClasses |
openHow := #newBuffer.
allNames := Set new.
(self selectedClasses value ? #()) do:[:eachClass |
(varType == #classVarNames) ifTrue:[
allNames addAll:(eachClass allClassVarNames).
] ifFalse:[
(varType == #poolVarNames) ifTrue:[
allNames addAll:(eachClass classVarNames).
] ifFalse:[
(varType == #instVarNames) ifTrue:[
allNames addAll:(eachClass allInstVarNames).
] ifFalse:[
(varType == #classInstVarNames) ifTrue:[
allNames addAll:(eachClass theMetaclass allInstVarNames).
] ifFalse:[
"/ self halt
]
]
]
].
].
allNames := allNames asOrderedCollection sort asNilIfEmpty.
box := self enterBoxForVariableSearch:boxTitle list:allNames.
box action:[:enteredString | varNames := enteredString].
b := Button label:(resources string:'Browser').
box addButton:b after:box okButton.
b action:[
openHow := #newBrowser.
box doAccept.
box okPressed.
].
box label:(resources string:'Search Variable References').
box showAtPointer.
box destroy.
varNames size == 0 ifTrue:[^ self].
varNameList := varNames string asCollectionOfSubstringsSeparatedByAny:' ;,/|'.
classes := self classesToSearchForVariable.
varType == #poolVarNames ifTrue:[
"/ also check classes which refer to that pool
copyOfClasses := IdentitySet withAll:classes.
environment allClassesDo:[:someOtherClass |
(someOtherClass sharedPools includesAny:copyOfClasses) ifTrue:[
classes add:someOtherClass.
]
].
].
self
browseVarRefsToAny:varNameList
classes:classes
variables:varType access:accessType all:browseAll
title:browserTitle in:openHow
"
Tools::NewSystemBrowser new
browseVarRefsToAny:#('x')
classes:{ Point }
variables:#instVarNames access:#write all:true
title:'writes to x' in:#newBrowser
"
"Modified: / 29-08-2013 / 12:24:10 / cg"
!
browseVarRefsToAny:varNameList classes:classesIn variables:varType access:accessType all:browseAll title:browserTitle in:openHow
"Open a new browser or add a buffer showing methods referring/modifying to any var in varNames.
accessType is one of #readOrWrite, #read or #write."
|varNames brwsr classes searchBlock methods|
varNameList size == 0 ifTrue:[^ self].
varNames := varNameList asStringWith:'|'.
"/ the find* methods expect nonMetaclasses ...
classes := classesIn collect:[:each | each theNonMetaclass].
searchBlock := [
|allMethods|
methods notNil ifTrue:[
allMethods := methods.
methods := nil.
] ifFalse:[
allMethods := IdentitySet new.
varNameList do:[:aVariableName |
|homeClasses methods1 methods2|
(browseAll and:[varType ~~ #poolVarNames]) 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 == #poolVarNames) ifTrue:[
eachClass isSharedPool ifTrue:[
methods1 := self class findClassRefsTo:aVariableName inClass:eachClass theNonMetaclass access:accessType.
methods2 := self class findClassRefsTo:aVariableName inClass:eachClass theMetaclass access:accessType.
] ifFalse:[
methods1 := self class findPoolVarRefsTo:aVariableName inClass:eachClass theNonMetaclass access:accessType.
methods2 := self class findPoolVarRefsTo:aVariableName inClass:eachClass theMetaclass access:accessType.
]
] ifFalse:[
(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.
brwsr 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 (or seen);
needs either #instVarNames, #classInstVarNames, #classVarNames or #poolVarNames as aSelector."
|cls homeClass list homeClasses|
homeClasses := IdentitySet new.
collectionOfClasses do:[:currentClass |
cls := currentClass.
[cls notNil] whileTrue:[
"
first, find the class, where the variable is declared
"
aSelector == #classInstVarNames ifTrue:[
list := cls class instVarNames
] ifFalse:[
list := cls perform:aSelector
].
(list includes:aVariableName) ifTrue:[
homeClass := cls.
cls := nil.
] ifFalse:[
cls := cls superclass
]
].
homeClass isNil ifTrue:[
"nope, must be one below ... (could optimize a bit, by searching down
for the declaring class ...
"
homeClass := currentClass
] ifFalse:[
"/ Transcript showCR:'starting search in ' , homeClass name.
].
homeClasses add:homeClass.
].
^ homeClasses
!
instVarNamesOfAllSelectedClasses
|names|
names := Set new.
self selectedClassesDo:[:eachClass | names addAll:eachClass instVarNames. ].
^ names
!
showingClassVarsInVariableList
"true if classVars are shown; false if classInstVars are shown"
|varListApp|
(varListApp := navigationState variableListApplication) isNil ifTrue:[^ false].
^ varListApp showClassVarsInVariableList value
!
variablesMenuAdd
"add a new variable."
^ self variablesMenuAdd:(self showingClassVarsInVariableList) asValueHolder:false
!
variablesMenuAdd:asClassVariableBoolean
"add a new variable."
self variablesMenuAdd:asClassVariableBoolean asValueHolder:false
!
variablesMenuAdd:asClassVariableBoolean asValueHolder:asValueHolder
"add new variable(s)."
|words variablesToAdd initial selectedClass boxTitle msg generateAccessorsHolder|
"/ (self askIfModified) ~~ true ifTrue:[ ^ self ].
initial := ''.
words := (self selectionInCodeView ? '') asCollectionOfWords.
words size == 1 ifTrue:[
initial := words first.
].
boxTitle := 'Add Variable'.
asValueHolder ifTrue:[
(initial isEmpty or:[initial endsWith:'Holder']) ifFalse:[
initial := initial , 'Holder'
].
boxTitle := 'Add ValueHolder'.
].
msg := 'Name of new %1 %2'.
msg := msg
bindWith:
(asClassVariableBoolean
ifTrue:['Class']
ifFalse:[
self meta value
ifTrue:['Class Instance']
ifFalse:['Instance']
])
with:
(asValueHolder
ifTrue:['ValueHolder(s)']
ifFalse:['Variable(s)']).
generateAccessorsHolder := true asValue.
Dialog modifyingBoxWith:[:box |
box verticalPanel
add:((CheckBox
label:(resources string:'Generate Getters and Setters'))
model:generateAccessorsHolder).
] do:[
variablesToAdd :=
Dialog
request:(resources string:msg)
title:(resources string:boxTitle)
initialAnswer:initial.
].
variablesToAdd size == 0 ifTrue:[^ self].
selectedClass := self theSingleSelectedClass.
variablesToAdd := variablesToAdd asCollectionOfWords.
variablesToAdd do:[:variableToAdd |
asClassVariableBoolean ifTrue:[
self codeMenuAddClassVariable:variableToAdd inClass:selectedClass asValueHolder:asValueHolder
] ifFalse:[
self codeMenuAddInstanceVariable:variableToAdd inClass:selectedClass asValueHolder:asValueHolder
]
].
generateAccessorsHolder value ifTrue:[
self
variablesMenuGenerateAccessMethodsFor:variablesToAdd
withChange:false
asValueHolder:false
readersOnly:false
writersOnly:false
lazyInitialization:false.
].
!
variablesMenuAddClassVariable
"add a new variable."
^ self variablesMenuAdd:true asValueHolder:false
!
variablesMenuAddInstanceVariable
"add a new variable."
^ self variablesMenuAdd:false asValueHolder:false
!
variablesMenuAddValueHolder
"add a new variable."
^ self variablesMenuAdd:(self showingClassVarsInVariableList) asValueHolder:true
!
variablesMenuBrowseAllClassInstVarMods
"show an enterbox for classInstVar to search for.
Then open a new browser or add a buffer showing all methods modifying to that var"
self
browseVarRefsOrModsWithTitle:'all writers of class-instance variable %1'
boxTitle:'class-instance variable to browse writers:'
variables:#classInstVarNames access:#write all:true
!
variablesMenuBrowseAllClassInstVarReads
"show an enterbox for classInstVar to search for.
Then open a new browser or add a buffer showing all methods reading to that var"
self
browseVarRefsOrModsWithTitle:'all readers of class-instance variable %1'
boxTitle:'class-instance variable to browse readers:'
variables:#classInstVarNames access:#read all:true
!
variablesMenuBrowseAllClassInstVarRefs
"show an enterbox for classInstVar to search for.
Then open a new browser or add a buffer showing all methods referring to that var"
self
browseVarRefsOrModsWithTitle:'All references to class-instance variable %1'
boxTitle:'Class-instance variable to browse all references to:'
variables:#classInstVarNames access:#readOrWrite all:true
!
variablesMenuBrowseAllClassVarMods
"show an enterbox for classVar to search for.
Then open a new browser or add a buffer showing all methods modifying that var"
self
browseVarRefsOrModsWithTitle:'All writers of class variable %1'
boxTitle:'Class variable to browse all writers:'
variables:#classVarNames access:#write all:true
"Modified (comment): / 29-05-2012 / 12:13:48 / cg"
!
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 that var"
self
browseVarRefsOrModsWithTitle:'All writers of instance variable %1'
boxTitle:'Instance variable to browse all writers:'
variables:#instVarNames access:#write all:true
"Modified (comment): / 29-05-2012 / 12:13:52 / cg"
!
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
!
variablesMenuBrowseAllPoolVarMods
"show an enterbox for poolVar to search for.
Then open a new browser or add a buffer showing methods modifying that var"
self
browseVarRefsOrModsWithTitle:'writers of pool variable %1'
boxTitle:'pool variable to browse writers:'
variables:#poolVarNames access:#write all:true
"Created: / 29-05-2012 / 12:13:06 / cg"
!
variablesMenuBrowseAllPoolVarReads
"show an enterbox for poolVar to search for.
Then open a new browser or add a buffer showing methods reading that var"
self
browseVarRefsOrModsWithTitle:'readers of pool variable %1'
boxTitle:'pool variable to browse readers:'
variables:#poolVarNames access:#read all:true
"Created: / 29-05-2012 / 12:13:34 / cg"
!
variablesMenuBrowseAllPoolVarRefs
"show an enterbox for poolVar to search for.
Then open a new browser or add a buffer showing methods referring to that var"
self
browseVarRefsOrModsWithTitle:'References to pool variable %1'
boxTitle:'Pool variable to browse references to:'
variables:#poolVarNames access:#readOrWrite all:true
"Created: / 29-05-2012 / 12:14:39 / cg"
!
variablesMenuBrowseClassInstVarMods
"show an enterbox for classInstVar to search for.
Then open a new browser or add a buffer showing methods modifying that var"
self
browseVarRefsOrModsWithTitle:'writers of class-instance variable %1'
boxTitle:'class-instance variable to browse writers:'
variables:#classInstVarNames access:#write all:false
"Modified (comment): / 29-05-2012 / 12:13:56 / cg"
!
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 that var"
self
browseVarRefsOrModsWithTitle:'writers of class variable %1'
boxTitle:'class variable to browse writers:'
variables:#classVarNames access:#write all:false
"Modified (comment): / 29-05-2012 / 12:14:01 / cg"
!
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 that var"
self
browseVarRefsOrModsWithTitle:'writers of instance variable %1'
boxTitle:'instance variable to browse writers:'
variables:#instVarNames access:#write all:false
"Modified (comment): / 29-05-2012 / 12:14:05 / cg"
!
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
!
variablesMenuBrowsePoolVarMods
"show an enterbox for poolVar to search for.
Then open a new browser or add a buffer showing methods modifying that var"
self
browseVarRefsOrModsWithTitle:'writers of pool variable %1'
boxTitle:'pool variable to browse writers:'
variables:#poolVarNames access:#write all:false
"Created: / 29-05-2012 / 12:13:06 / cg"
!
variablesMenuBrowsePoolVarReads
"show an enterbox for poolVar to search for.
Then open a new browser or add a buffer showing methods reading that var"
self
browseVarRefsOrModsWithTitle:'readers of pool variable %1'
boxTitle:'pool variable to browse readers:'
variables:#poolVarNames access:#read all:false
"Created: / 29-05-2012 / 12:13:34 / cg"
!
variablesMenuBrowsePoolVarRefs
"show an enterbox for poolVar to search for.
Then open a new browser or add a buffer showing methods referring to that var"
self
browseVarRefsOrModsWithTitle:'References to pool variable %1'
boxTitle:'Pool variable to browse references to:'
variables:#poolVarNames access:#readOrWrite all:false
"Created: / 29-05-2012 / 12:14:39 / cg"
!
variablesMenuClear
"clear the selected (class) variable(s)."
|cls|
cls := self theSingleSelectedClass.
cls isNil ifTrue:[
Dialog warn:'Please select a single class.'.
^ self.
].
cls := cls theNonMetaclass.
self withSelectedVariablesDo:[:variable :isClassVar |
isClassVar ifTrue:[
cls classVarAt:variable put:nil
].
]
!
variablesMenuCopySelectedName
"copy selected variable name(s) to clipboard"
|names first|
first := true.
names :=
String streamContents:[:s |
self selectedVariables value do:[:variableName |
first ifTrue:[
first := false
] ifFalse:[
s space.
].
s nextPutAll:variableName.
]
].
self window setClipboardText:names
!
variablesMenuFindVariable
self shouldImplement
!
variablesMenuGenerateAccessMethods
"create access methods for selected instvars."
self
variablesMenuGenerateAccessMethodsWithChange:false
asValueHolder:false
readersOnly:false
writersOnly:false
lazyInitialization:false
!
variablesMenuGenerateAccessMethodsFor:names withChange:withChange asValueHolder:asValueHolder readersOnly:readersOnly writersOnly:writersOnly lazyInitialization:lazyInitialization
"common helper to create access methods."
|what|
names isEmptyOrNil ifTrue:[^ self].
what := readersOnly
ifTrue:['Getters']
ifFalse:[
writersOnly
ifTrue:['Setters']
ifFalse:['Accessors']].
self
generateUndoableChange:'Generate ',what,' in %(singleClassNameOrNumberOfClasses)'
overSelectedClassesVia:[:generator :eachClass |
|classVars instVars|
classVars := names select:[:var | eachClass classVarNames includes:var].
classVars notEmpty ifTrue:[
generator
createAccessMethodsFor:classVars
in:eachClass theMetaclass
withChange:withChange
asValueHolder:asValueHolder
readersOnly:readersOnly
writersOnly:writersOnly
lazyInitialization:lazyInitialization
].
instVars := names reject:[:var | classVars includes:var].
instVars notEmpty ifTrue:[
generator
createAccessMethodsFor:instVars
in:eachClass
withChange:withChange
asValueHolder:asValueHolder
readersOnly:readersOnly
writersOnly:writersOnly
lazyInitialization:lazyInitialization
]
]
"Modified: / 21-01-2012 / 10:25:52 / cg"
!
variablesMenuGenerateAccessMethodsForAll
|names|
names := self instVarNamesOfAllSelectedClasses.
self
variablesMenuGenerateAccessMethodsFor:names
withChange:false
asValueHolder:false
readersOnly:false
writersOnly:false
lazyInitialization:false
!
variablesMenuGenerateAccessMethodsForValueHolder
"create access methods for selected instvars as valueHolders."
self
variablesMenuGenerateAccessMethodsWithChange:false
asValueHolder:true
readersOnly:false
writersOnly:false
lazyInitialization:false
!
variablesMenuGenerateAccessMethodsForValueHolderWithChange
"create access methods for selected instvars as valueHolders with change notification."
self
variablesMenuGenerateAccessMethodsWithChange:true
asValueHolder:true
readersOnly:false
writersOnly:false
lazyInitialization:false
!
variablesMenuGenerateAccessMethodsWithChange
"create access methods with change notification for selected instvars."
self
variablesMenuGenerateAccessMethodsWithChange:true
asValueHolder:false
readersOnly:false
writersOnly:false
lazyInitialization:false
!
variablesMenuGenerateAccessMethodsWithChange:withChange asValueHolder:asValueHolder readersOnly:readersOnly writersOnly:writersOnly
"common helper to create access methods."
^ self
variablesMenuGenerateAccessMethodsWithChange:withChange
asValueHolder:asValueHolder
readersOnly:readersOnly
writersOnly:writersOnly
lazyInitialization:false
!
variablesMenuGenerateAccessMethodsWithChange:withChange asValueHolder:asValueHolder readersOnly:readersOnly writersOnly:writersOnly lazyInitialization:lazyInitialization
"common helper to create access methods."
|names|
names := self variableFilter value.
self
variablesMenuGenerateAccessMethodsFor:names
withChange:withChange asValueHolder:asValueHolder readersOnly:readersOnly writersOnly:writersOnly lazyInitialization:lazyInitialization
!
variablesMenuGenerateAccessMethodsWithLazyInitialization
"create access methods for selected instvars with lazy ini."
self
variablesMenuGenerateAccessMethodsWithChange:false
asValueHolder:false
readersOnly:false
writersOnly:false
lazyInitialization:true
!
variablesMenuGenerateCollectionAccessMethods
|names|
names := self instVarNamesOfAllSelectedClasses.
self
variablesMenuGenerateCollectionAccessMethodsFor:names withChange:false
"Created: / 04-02-2007 / 15:56:24 / cg"
!
variablesMenuGenerateCollectionAccessMethodsFor:names withChange:withChange
"common helper to create access methods."
self
generateUndoableChange:'Generate collection access in %(singleClassNameOrNumberOfClasses)'
overSelectedClassesVia:[:generator :eachClass |
names size > 0 ifTrue:[
generator
createCollectionAccessMethodsFor:names
in:eachClass
withChange:withChange
]
]
"Created: / 04-02-2007 / 15:57:22 / cg"
!
variablesMenuGenerateGetterMethods
"create access methods for selected instvars."
self
variablesMenuGenerateAccessMethodsWithChange:false
asValueHolder:false
readersOnly:true
writersOnly:false
lazyInitialization:false
!
variablesMenuGenerateGetterMethodsForAll
|names|
names := self instVarNamesOfAllSelectedClasses.
self
variablesMenuGenerateAccessMethodsFor:names
withChange:false
asValueHolder:false
readersOnly:true
writersOnly:false
lazyInitialization:false
!
variablesMenuGenerateSetterMethods
"create setter methods for selected instvars."
self
variablesMenuGenerateAccessMethodsWithChange:false
asValueHolder:false
readersOnly:false
writersOnly:true
lazyInitialization:false
!
variablesMenuGenerateSetterMethodsForAll
|names|
names := self instVarNamesOfAllSelectedClasses.
self
variablesMenuGenerateAccessMethodsFor:names
withChange:false
asValueHolder:false
readersOnly:false
writersOnly:true
lazyInitialization:false
!
variablesMenuInspect
"inspect the selected variable(s)."
|cls|
cls := self theSingleSelectedClass.
cls isNil ifTrue:[
Dialog warn:'Please select a single class.'.
^ self.
].
cls := cls theNonMetaclass.
self withSelectedVariableDo:[:variableToInspect :isClassVar |
|value|
isClassVar ifTrue:[
value := cls classVarAt:variableToInspect
] ifFalse:[
value := cls instVarNamed:variableToInspect
].
value inspect
]
!
variablesMenuPullUp
"pull selected variable into superclass."
self withSelectedVariablesDo:[:variableToPull :isClassVar |
|cls|
self showInfo:'pulling ',variableToPull,'...'.
cls := self theSingleSelectedClass.
isClassVar ifTrue:[
self codeMenuPullUpClassVariable:variableToPull inClass:(cls theNonMetaclass)
] ifFalse:[
self codeMenuPullUpInstanceVariable:variableToPull inClass:cls
]
]
!
variablesMenuPushDown
"push selected variable into subclass."
self withSelectedVariablesDo:[:variableToPush :isClassVar |
|cls|
self showInfo:'pushing ',variableToPush,'...'.
cls := self theSingleSelectedClass.
isClassVar ifTrue:[
self codeMenuPushDownClassVariable:variableToPush inClass:(cls theNonMetaclass)
] ifFalse:[
self codeMenuPushDownInstanceVariable:variableToPush inClass:cls
]
]
!
variablesMenuRemove
"remove selected variable(s)."
|variablesToRemove classVar cls|
(variablesToRemove := self selectedVariables value) size > 0 ifTrue:[
classVar := self showingClassVarsInVariableList.
] ifFalse:[
variablesToRemove := Array with:(self selectionInCodeView).
classVar := self hasClassVariableSelectedInCodeView.
].
"/ cls := self theSingleSelectedClass.
cls := Behavior commonSuperclassOf:(self selectedClassesValue).
variablesToRemove do:[:variableToRemove |
classVar ifTrue:[
self codeMenuRemoveClassVariable:variableToRemove inClass:(cls theNonMetaclass)
] ifFalse:[
self codeMenuRemoveInstanceVariable:variableToRemove inClass:cls
]
].
"Modified: / 28-02-2012 / 16:51:57 / cg"
!
variablesMenuRemoveClassVariable
"remove selected class variable."
|variableToRemove cls|
self showingClassVarsInVariableList ifTrue:[
variableToRemove := self theSingleSelectedVariable.
].
variableToRemove isNil ifTrue:[
self hasClassVariableSelectedInCodeView ifTrue:[
variableToRemove := self selectionInCodeView.
]
].
cls := self theSingleSelectedClass.
self codeMenuRemoveClassVariable:variableToRemove inClass:(cls theNonMetaclass)
!
variablesMenuRemoveInstanceVariable
"remove selected instance variable."
|variableToRemove cls|
self showingClassVarsInVariableList ifFalse:[
variableToRemove := self theSingleSelectedVariable.
].
variableToRemove isNil ifTrue:[
self hasInstanceVariableSelectedInCodeView ifTrue:[
variableToRemove := self selectionInCodeView.
]
].
cls := self theSingleSelectedClass.
self codeMenuRemoveInstanceVariable:variableToRemove inClass:cls
!
variablesMenuRename
"rename selected variable."
self withSelectedVariableDo:[:variableToRename :isClassVar |
|cls|
cls := self theSingleSelectedClass.
isClassVar ifTrue:[
self codeMenuRenameClassVariable:variableToRename inClass:(cls theNonMetaclass)
] ifFalse:[
self codeMenuRenameInstanceVariable:variableToRename inClass:cls
]
]
!
variablesMenuRenameClassVariable
"rename selected variable."
|variableToRename|
self showingClassVarsInVariableList ifTrue:[
variableToRename := self theSingleSelectedVariable.
].
variableToRename isNil ifTrue:[
self hasClassVariableSelectedInCodeView ifTrue:[
variableToRename := self selectionInCodeView.
]
].
self
codeMenuRenameClassVariable:variableToRename
inClass:(self theSingleSelectedClass theNonMetaclass)
!
variablesMenuRenameInstanceVariable
"rename selected variable."
|variableToRename|
self showingClassVarsInVariableList ifFalse:[
variableToRename := self theSingleSelectedVariable.
].
variableToRename isNil ifTrue:[
self hasInstanceVariableSelectedInCodeView ifTrue:[
variableToRename := self selectionInCodeView.
]
].
self
codeMenuRenameInstanceVariable:variableToRename
inClass:(self theSingleSelectedClass theNonMetaclass)
!
variablesMenuTypeBrowe
"browse typical types of a variable"
self variablesMenuTypeInfoOrBrowseTypes:true.
!
variablesMenuTypeInfo
"show typical usage of a variable"
self variablesMenuTypeInfoOrBrowseTypes:false.
!
variablesMenuTypeInfoHelper
"common code for show typical usage of a variable, inspect or browse it"
|name idx classes values value msg cut names instCount subInstCount
searchClass s canInspect canInspectMultiple showingInstVars showingClassVars currentClass
nilIncluded commonSuperClass info|
name := self theSingleSelectedVariable.
name isNil ifTrue:[^ nil].
name := name allBold.
canInspect := canInspectMultiple := false.
showingClassVars := self showingClassVarsInVariableList.
showingClassVars ifFalse:[
showingInstVars := self meta value not
].
currentClass := self theSingleSelectedClass.
showingClassVars ifTrue:[
currentClass isNil ifTrue:[
self selectedNonMetaclassesDo:[:cls |
|sCls|
sCls := (cls whichClassDefinesClassVar:name).
sCls notNil ifTrue:[ searchClass := sCls ]
].
] ifFalse:[
searchClass := currentClass theNonMetaclass whichClassDefinesClassVar:name.
].
value := searchClass classVarAt:(name asSymbol).
values := Array with:value.
s := value displayString.
s size > 60 ifTrue:[
s := (s copyTo:60) , ' ...'
].
msg := name , ' is (currently):\\' , s.
s ~= value classNameWithArticle ifTrue:[
msg := msg , '\\(' , value class name , ')'
].
canInspect := true.
] ifFalse:[
searchClass := currentClass whichClassDefinesInstVar:name.
idx := searchClass instVarIndexFor:name.
idx isNil ifTrue:[^ nil].
classes := IdentitySet new.
values := IdentitySet new.
instCount := 0.
subInstCount := 0.
searchClass allSubInstancesDo:[:i |
|val|
val := i instVarAt:idx.
val notNil ifTrue:[values add:val].
classes add:val class name.
(i isMemberOf:searchClass) ifTrue:[
instCount := instCount + 1.
] ifFalse:[
subInstCount := subInstCount + 1
]
].
classes := classes collect:[:eachName | environment classNamed:eachName].
(instCount == 0 and:[subInstCount == 0]) ifTrue:[
self warn:(resources
string:'There are currently no instances or subInstances of %1.'
with:currentClass name allBold).
^ nil
].
instCount ~~ 0 ifTrue:[
msg := 'in (currently: ' , instCount printString,') instances '.
subInstCount ~~ 0 ifTrue:[
msg := msg , 'and '
]
] ifFalse:[
msg := 'in '.
].
subInstCount ~~ 0 ifTrue:[
msg := msg , '(currently: ' , subInstCount printString, ') derived instances '
].
msg := msg, 'of ' , searchClass name , ',\'.
msg := msg , name allBold , ' '.
canInspectMultiple := values size > 0.
((values size == 1)
or:[classes size == 1 and:[classes first == UndefinedObject]]) ifTrue:[
values size == 1 ifTrue:[
value := values first.
].
(value isNil or:[value == true or:[value == false]]) ifTrue:[
(instCount+subInstCount) == 1 ifTrue:[
msg := msg , 'is'
] ifFalse:[
msg := msg , 'is always'.
classes size > 1 ifTrue:[
"/ must be nil
msg := msg , ' nil or'
].
].
msg := msg , ':\\ ' , value printString.
] ifFalse:[
(instCount+subInstCount) == 1 ifTrue:[
msg := msg , 'is'
] ifFalse:[
classes size > 1 ifTrue:[
"/ must be nil
msg := msg , 'is always nil or the same'
] ifFalse:[
msg := msg , 'is always the same'
]
].
msg := msg , ':\\'.
msg := msg , ' ' , value class name.
value isLiteral ifTrue:[
msg := msg , ' (' , (value storeString copyToMax:50) , ')'
].
canInspect := true.
]
] ifFalse:[
classes size == 1 ifTrue:[
msg := msg , 'is always:\\' , ' ' , classes first name , '\'.
] ifFalse:[
msg := msg , 'is one of:\\'.
classes := classes asOrderedCollection.
classes size > 20 ifTrue:[
classes := classes copyFrom:1 to:20.
cut := true
] ifFalse:[
cut := false.
].
names := classes collect:[:cls |
cls == UndefinedObject ifTrue:[
'nil'
] ifFalse:[
cls == True ifTrue:[
'true'
] ifFalse:[
cls == False ifTrue:[
'false'
] ifFalse:[
cls name
]
]
].
].
names := names copy sort.
names do:[:nm |
msg := msg , ' ' , nm , '\'.
].
]
].
"/ generate a type-decl string
(nilIncluded := (classes includes:UndefinedObject)) ifTrue:[
classes remove:UndefinedObject.
].
classes size > 0 ifTrue:[
commonSuperClass := Behavior commonSuperclassOf:(classes collect:[:each| each name]).
((commonSuperClass == True) or:[commonSuperClass == False]) ifTrue:[
commonSuperClass := Boolean
].
(commonSuperClass == SmallInteger) ifTrue:[
commonSuperClass := Integer
].
commonSuperClass == Object class ifTrue:[
commonSuperClass := Class
].
msg := msg , '\\'.
msg := msg , 'suggested type (for documentation):\\'.
msg := msg , ' <' , commonSuperClass name.
nilIncluded ifTrue:[
msg := msg , ' | nil'
].
msg := msg , '>'.
]
].
info := Dictionary new
at:#message put:msg;
at:#values put:values;
at:#classes put:classes;
at:#searchClass put:searchClass;
yourself.
^ info
!
variablesMenuTypeInfoOrBrowseTypes:doBrowseTypes
"show typical usage of a variable"
|name classes values value msg searchClass canInspect canInspectMultiple showingInstVars showingClassVars currentClass boxLabels boxValues answer info|
name := self theSingleSelectedVariable.
name isNil ifTrue:[^ self].
name := name allBold.
showingClassVars := self showingClassVarsInVariableList.
showingClassVars ifFalse:[
showingInstVars := self meta value not
].
currentClass := self theSingleSelectedClass.
info := self variablesMenuTypeInfoHelper.
info isNil ifTrue:[^ self].
msg := info at:#message.
classes := info at:#classes.
values := info at:#values.
searchClass := info at:#searchClass.
canInspect := values size > 0.
canInspectMultiple := values size > 1.
doBrowseTypes ifTrue:[
classes size > 0 ifTrue:[
self spawnClassBrowserFor:classes in:#newBuffer.
^ self
].
].
boxLabels := #('OK').
boxValues := #(true).
(canInspect or:[canInspectMultiple]) ifTrue:[
canInspectMultiple ifTrue:[
boxLabels := boxLabels , #('Inspect all Values').
boxValues := boxValues , #(#inspectValues).
boxLabels := boxLabels , #('Inspect a Value').
boxValues := boxValues , #(#inspectAValue).
] ifFalse:[
boxLabels := boxLabels , #('Inspect Value').
boxValues := boxValues , #(#inspectAValue).
].
showingClassVars ifFalse:[
canInspectMultiple ifTrue:[
boxLabels := boxLabels , #('Inspect all Instances').
boxValues := boxValues , #(#inspectInstances).
boxLabels := boxLabels , #('Inspect an Instance').
boxValues := boxValues , #(#inspectAnInstance).
] ifFalse:[
boxLabels := boxLabels , #('Inspect Instance').
boxValues := boxValues , #(#inspectAnInstance).
].
].
].
Dialog defaultOKButtonAtLeft ifFalse:[
boxLabels reverse.
boxValues reverse.
].
answer := OptionBox
request:msg withCRs
label:'Variable Type Information'
image:(InfoBox iconBitmap)
buttonLabels:boxLabels
values:boxValues
default:true
onCancel:nil.
answer == #inspectAValue ifTrue:[
canInspect ifTrue:[
value inspect
] ifFalse:[
value := values inject:nil into:[:max :this | this size > max size ifTrue:[this] ifFalse:[max]].
value notNil ifTrue:[
value inspect
] ifFalse:[
values first inspect
].
].
^ self
].
answer == #inspectValues ifTrue:[
(canInspect ifTrue:value ifFalse:values) inspect.
^ self
].
answer == #inspectInstances ifTrue:[
searchClass allSubInstances inspect.
^ self
].
answer == #inspectAnInstance ifTrue:[
searchClass allSubInstances first inspect.
^ self
].
"Modified: / 12-09-2006 / 13:59:24 / cg"
!
variablesRemoveWithConfirmation
"remove selected variable(s)."
|variablesToRemove|
variablesToRemove := self selectedVariables value.
variablesToRemove size == 0 ifTrue:[^ self ].
"/ because we'll ask again if the variable is still references,
"/ do not ask here...
"/ variablesToRemove size == 1 ifTrue:[
"/ msg := 'Remove variable ''%1'' ?'
"/ ] ifFalse:[
"/ msg := 'Remove %2 selected variables ?'.
"/ ].
"/ (self confirm:(resources
"/ string:msg
"/ with:variablesToRemove first allBold
"/ with:variablesToRemove size)) ifFalse:[^ self ]
self variablesMenuRemove
!
withSelectedVariableDo:aBlock
"pull/push/variable manipulation common code for a single selected variable"
|selectedVariable isClassVar|
selectedVariable := self theSingleSelectedVariable.
selectedVariable notNil ifTrue:[
isClassVar := self showingClassVarsInVariableList.
] ifFalse:[
selectedVariable := self selectionInCodeView.
selectedVariable isNil ifTrue:[
^ self
].
isClassVar := self hasClassVariableSelectedInCodeView.
].
aBlock value:selectedVariable value:isClassVar
!
withSelectedVariablesDo:aBlock
"pull/push/variable manipulation common code for possibly multiple selected variables"
|selectedVariable isClassVar|
(self selectedVariables value) notEmptyOrNil ifTrue:[
isClassVar := self showingClassVarsInVariableList.
self selectedVariables value do:[:eachSelectedVariable |
aBlock value:eachSelectedVariable value:isClassVar
].
] ifFalse:[
selectedVariable := self selectionInCodeView.
selectedVariable isNil ifTrue:[
^ self
].
isClassVar := self hasClassVariableSelectedInCodeView.
aBlock value:selectedVariable value:isClassVar
].
! !
!NewSystemBrowser methodsFor:'menu-actions-other'!
goBack
self switchToHistoryEntry: self navigationHistory goBack
"Created: / 22-02-2008 / 10:16:30 / janfrog"
"Modified: / 22-02-2008 / 17:18:43 / janfrog"
!
goBackInGlobalHistory
self switchToHistoryEntry: self class classHistory goBack
"Modified: / 22-02-2008 / 17:18:43 / janfrog"
"Created: / 03-07-2011 / 16:20:18 / cg"
!
goForward
self switchToHistoryEntry: self navigationHistory goForward
"Created: / 22-02-2008 / 10:16:30 / janfrog"
"Modified: / 22-02-2008 / 17:18:56 / janfrog"
! !
!NewSystemBrowser methodsFor:'menus extensions'!
menuExtendersFor: key do: block
"Evaluates a block for each selector that extends particular menu.
Extender methods have to be annotated by <menuextension: key> annotation
and must take one argument (an instance of Menu that the menu extension
extends."
| cls |
cls := self class.
[ cls notNil ] whileTrue:[
cls selectorsAndMethodsDo:[ :selector :method |
method annotationsAt: #menuextension: do: [ :annotation |
annotation arguments first == key ifTrue:[
block value: selector
].
]
].
cls := cls superclass.
].
"Created: / 25-01-2014 / 12:40:10 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 24-02-2014 / 22:44:31 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!NewSystemBrowser methodsFor:'menus-dynamic'!
boockmarksMenu
<resource: #programMenu >
^ [
|m item|
m := Menu new.
item := MenuItem label:(resources string:'Add Bookmark').
m addItem:item.
item itemValue:#'searchMenuAddToBookmarks'.
"/ BookMarks size > 0 ifTrue:[
"/ item := MenuItem label:(resources string:'Remove Bookmark').
"/ m addItem:item.
"/ item value:#'searchMenuRemoveFromBookmarks'.
"/
"/ m addSeparator.
"/
"/ self bookmarksHolder value do:[:entry |
"/ |item name icon sel|
"/
"/ name := entry label.
"/ (icon := entry icon) isNil ifFalse:
"/ [name := LabelAndIcon label: name icon: icon].
"/
"/ item := MenuItem label:name.
"/
"/ m addItem:item.
"/ item value:#'switchToBookmarkEntry:'.
"/ item argument:entry.
"/ ].
"/ ].
m findGuiResourcesIn:self.
m
].
"Modified: / 23-05-2011 / 10:29:18 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 09-09-2012 / 13:11:36 / cg"
!
browseClassExtensionsMenu
<resource: #programMenu >
^ self browseClassExtensionsMenuUsingManagerNamed:nil
!
browseClassExtensionsMenuUsingManagerNamed:sourceCodeManagerNameOrNil
<resource: #programMenu >
^ [
|m extensionProjectIDs classPackage item mgr|
sourceCodeManagerNameOrNil notNil ifTrue:[
mgr := Smalltalk classNamed:sourceCodeManagerNameOrNil.
self assert:(mgr notNil).
].
extensionProjectIDs := Set new.
self selectedClassesDo:[:eachClass |
classPackage := eachClass package.
eachClass theNonMetaclass isProjectDefinition ifTrue:[
eachClass theNonMetaclass hasExtensionMethods ifTrue:[
extensionProjectIDs add:classPackage.
].
] ifFalse:[
eachClass instAndClassSelectorsAndMethodsDo:[:sel :mthd |
mthd package ~= classPackage ifTrue:[
extensionProjectIDs add:mthd package.
]
]
].
].
extensionProjectIDs notEmpty ifTrue:[
m := Menu new.
extensionProjectIDs size > 1 ifTrue:[
item := MenuItem label:'All'.
item itemValue:[ self classMenuCheckInExtensionsUsingManager:mgr ].
m addItem:item.
m addSeparator.
].
extensionProjectIDs asSortedCollection do:[:eachExtensionPackage |
item := MenuItem label:eachExtensionPackage.
item itemValue:[ self classMenuCheckInExtensionsFor: eachExtensionPackage usingManager:mgr ].
m addItem:item.
].
].
m
].
"Modified: / 09-09-2012 / 13:11:49 / cg"
!
bufferMenu
<resource: #programMenu >
^ [
|m selected submenu subItem|
m := self menuFor: #bufferBaseMenu.
m findGuiResourcesIn:self.
m addSeparator.
m addItem:((subItem := MenuItem label:(resources string:'Recently Closed')) submenuChannel:#recentlyClosedMenu).
self closeHistory isEmptyOrNil ifTrue:[ subItem disable ].
"/ m addItem:((MenuItem label:(resources string:'Other Browsers')) submenuChannel:#otherBrowsersMenu).
bufferNameList notEmptyOrNil ifTrue:[
m addSeparator.
selected := selectedBuffer value.
bufferNameList keysAndValuesDo:[:idx :nm |
|item|
item := MenuItem label:nm.
item indication:(idx == selected).
item itemValue:[:i | selectedBuffer value:idx].
m addItem:item.
].
m addSeparator.
] ifFalse:[
(m atNameKey:#'RemoveBuffer') disable
].
m addItem:(MenuItem label:(resources string:'Exit') itemValue:#closeRequest).
m
].
"Modified: / 09-09-2012 / 20:43:01 / cg"
"Modified: / 02-05-2014 / 15:55:46 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
categoryMenuWithFind
"insert the sourcecode manager name"
<resource: #programMenu>
| menu |
menu := self menuFor: #categoryMenuWithFind.
menu receiver:self.
menu findGuiResourcesIn:self.
^ menu
"Created: / 15-10-2011 / 12:28:49 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 25-01-2014 / 12:17:50 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
changedClassesMenu
"returns a block evaluating to a popup menu to navigate
to the last few changed classes"
<resource: #programMenu >
^ [
self
changedMenuForFilter:[:chg | (chg isMethodChange or:[chg isClassChange and:[chg changeClass isNameSpace not]])]
itemClass:[:chg | chg changeClass theNonMetaclass]
itemSelector:[:chg | nil]
label:[:chg |
|cls lbl|
"/ chg changeClass theNonMetaclass name allBold
cls := chg changeClass.
cls isNil ifTrue:[
lbl := chg className asText allStrikedOut.
] ifFalse:[
lbl := cls theNonMetaclass name "allBold"
].
lbl
]
browseActionOfLastItem:[NewSystemBrowser openOnClassesInChangeSet].
].
!
changedMenu
"returns a block evaluating to a popup menu to navigate
to the last few changes (from the changeSet)"
<resource: #programMenu >
^ [
|menu|
menu := self changedMethodsMenu value.
menu isNil ifTrue:[
menu := self changedClassesMenu value.
].
menu
].
!
changedMenuForFilter:aChangeFilter itemClass:itemClassBlock itemSelector:itemSelectorBlock label:labelBlock browseActionOfLastItem:browseActionOfLastItemOrNil
"returns a popup menu to navigate to the last few changes (from the changeSet)"
<resource: #programMenu >
|menu currentMenu nextMenu changes already
maxReached nMaxLevel nMaxItem nLevel nItem nOverAll|
changes := ChangeSet current.
already := Set 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 key|
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 itemValue:browseActionOfLastItemOrNil.
].
currentMenu addItem:item.
]
]
].
maxReached ifFalse:[
cls := aChange changeClass.
cls notNil ifTrue:[
(aChangeFilter value:aChange) ifTrue:[
cls := itemClassBlock value:aChange.
sel := itemSelectorBlock value:aChange.
lbl := labelBlock value:aChange.
key := cls->lbl.
(already includes:key "lbl") ifFalse:[
histEntry := self class
historyEntryForClass:cls
selector:sel.
item := MenuItem label:(lbl contractTo:80).
item itemValue:#'switchToHistoryEntry:' argument:histEntry.
currentMenu addItem:item.
already add:key "lbl".
nItem := nItem + 1.
nOverAll := nOverAll + 1.
]
]
].
]
].
(nOverAll = 0) ifTrue:[
^ nil
].
^ menu
"Modified: / 15-11-2016 / 11:10:39 / cg"
!
changedMethodsMenu
"returns a block evaluating to a popup menu to navigate
to the last few method changes (from the changeSet)"
<resource: #programMenu >
^ [
self
changedMenuForFilter:[:chg | chg isMethodChange]
itemClass:[:chg | chg changeClass]
itemSelector:[:chg | chg selector]
label:[:chg |
|lbl|
"/ lbl := chg printString
lbl := (chg className ? '???') , ' ' , (chg selector ? '???') allBold.
(chg isMethodChange and:[chg changeMethod isNil]) ifTrue:[
lbl := lbl asText allStrikedOut,' ','(removed)' allItalic.
].
lbl
]
browseActionOfLastItem:[NewSystemBrowser openOnMethodsInChangeSet].
].
!
classMenu
"insert the sourcecode manager name"
<resource: #programMenu>
| menu |
menu := self menuFor: #classMenu.
menu receiver:self.
menu findGuiResourcesIn:self.
^ menu
"Created: / 19-04-2011 / 14:29:47 / cg"
"Created: / 11-10-2011 / 09:08:14 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 24-01-2014 / 20:49:39 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
classOperationsMenu
"ask the class for its own special menu.
This allows for special classes (such as Enumeration or Pools) to add their own menu ops"
<resource: #programMenu >
^ [
|cls m |
cls := self theSingleSelectedClass.
cls notNil ifTrue:[
m := cls theNonMetaclass classOperationsMenu
].
m
].
"Modified: / 31-01-2011 / 11:09:04 / cg"
!
classOtherClassNewSlice
<resource: #programMenu >
^ [
|m allLanguages|
allLanguages := OrderedCollection new.
ProgrammingLanguage allDo:[:eachLanguage |
(
{ SmalltalkLanguage .
STXJavaScriptLanguage .
} includes:eachLanguage class
) ifFalse:[
allLanguages add:eachLanguage
]
].
allLanguages sort:[:a :b | a name < b name].
m := Menu new.
allLanguages do:[:eachLanguage |
m addSeparator.
m addItem:(MenuItem
label:(resources string:'%1 Class' with:(eachLanguage name))
value:[self classMenuNewClass:eachLanguage metaClass ])
].
m
].
"Created: / 21-08-2012 / 17:01:41 / cg"
"Modified: / 02-04-2013 / 23:44:05 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
classSCMMenu
"add more functionality to the codeViews text-editor-menu.
Get here via the menuHolder-plug in codeView."
<resource: #programMenu>
|spec menu first skippedManager|
self theSingleSelectedClass notNil ifTrue:[
skippedManager := self theSingleSelectedClass sourceCodeManager.
] ifFalse:[
skippedManager := SourceCodeManager ? AbstractSourceCodeManager defaultManager
].
spec := self class classSCMMenu.
menu := spec decodeAsLiteralArray.
menu itemsDo:[:eachItem |
eachItem argument:skippedManager.
].
false ifTrue:[
SourceCodeManager availableManagers do:[:eachManager |
|newItem subMenu|
eachManager ~= skippedManager ifTrue:[
first ifTrue:[
menu addSeparator.
first := false.
].
subMenu := spec decodeAsLiteralArray.
subMenu receiver:self.
subMenu findGuiResourcesIn:self.
newItem := MenuItem label:eachManager managerTypeName.
newItem submenu:subMenu.
menu addItem:newItem.
].
].
].
"/ SourceCodeManager defaultManager notNil ifTrue:[
"/ item := menu menuItemWithArgument:(SourceCodeManager defaultManager name).
"/ item notNil ifTrue:[
"/ item isVisible:false.
"/ ].
"/ ].
menu receiver:self.
menu findGuiResourcesIn:self.
^ menu
"Created: / 19-04-2011 / 15:00:09 / cg"
!
codeViewMenu
"add more functionality to the codeView's text-editor-menu.
Get here via the menuHolder-plug in codeView."
<resource: #programMenu>
|shiftedMenu codeView menu sensor menuOthers|
shiftedMenu := self menuFor: #shiftedCodeViewPopUpMenu.
shiftedMenu receiver:self.
shiftedMenu findGuiResourcesIn:self.
codeView := self codeView.
sensor := codeView sensor.
sensor shiftDown ifTrue:[
sensor ctrlDown ifFalse:[
^ shiftedMenu
].
].
menu := codeView editMenu.
"/ sensor ctrlDown ifTrue:[
"/ (menu isKindOf:MenuPanel) ifTrue:[
"/ "/ a newStyle menuPanel
"/ self shouldImplement.
"/ ] ifFalse:[
"/ "/ an oldStyle popUpMenu
"/ menuOthers := menu.
"/ ]
"/ ] ifFalse:[
(menu isKindOf:Menu) ifTrue:[
"/ a newStyle menuPanel
"/ (menu atNameKey:'refactor') "atMenuItemLabeled:'Refactor'" putSubmenu:shiftedMenu visible:true.
(menu menuItemLabeled:(resources string:'Refactor')) notNil ifTrue:[
menu atMenuItemLabeled:(resources string:'Refactor') putSubmenu:shiftedMenu visible:true.
].
] ifFalse:[
"/ an oldStyle popUpMenu
"/ this is a kludge...
shiftedMenu := (shiftedMenu asOldStylePopUpMenuFor:self) asMenu.
"/ would like to add the shifted-menu here
menu menuView
addLabels:(Array with:'-' with:(resources string:'Refactor'))
selectors:#( nil refactorings)
accelerators:#(nil 'Shift')
after:#accept.
menu subMenuAt:#refactorings put:shiftedMenu.
menuOthers := menu subMenuAt:#others.
].
"/ ].
"/ sensor shiftDown ifFalse:[
"/ menuOthers notNil ifTrue:[
"/ menuOthers menuView
"/ addLabels:(Array with:'Response to it')
"/ selectors:#( browseResponseToIt)
"/ accelerators:#( nil )
"/ after:#browseReferencesToIt.
"/ menuOthers actionAt:#browseResponseToIt put:[ self browseResponseToIt ].
"/"/ hasLocalSelectorSelectedInCodeView takes too long...
"/ self hasSelectionInCodeView "hasLocalSelectorSelectedInCodeView" ifFalse:[
"/ menuOthers disable:#browseResponseToIt
"/ ].
"/ ].
"/ ].
self menuExtendersFor: #codeViewMenu do:[:each |
self perform: each with: menu
].
^ menu
"Modified: / 18-10-2008 / 18:52:50 / Jan Vrany <vranyj1@fel.cvut.cz>"
"Modified: / 10-09-2013 / 14:40:13 / cg"
"Modified: / 20-08-2015 / 17:29:50 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
compareClassWithSmallTeamVersionMenu
<resource: #programMenu >
^ [
|m anyItem hosts|
m := Menu new.
hosts := Set new.
self selectedClassesValue do:[:cls |
hosts addAll:(SmallTeam hostsWithChangeForClassOrMetaclass:cls theNonMetaclass).
].
hosts := hosts asOrderedCollection sort.
anyItem := false.
hosts do:[:eachHost |
|item|
item := MenuItem label:eachHost.
item itemValue:#'classMenuCompareWithSmallTeamVersionOnHost:' argument:eachHost.
m addItem:item.
anyItem := true.
].
anyItem ifFalse:[ nil ] ifTrue:[ m ]
].
"Created: / 11-11-2006 / 15:19:53 / cg"
!
compareMethodWithSmallTeamVersionMenu
<resource: #programMenu >
^ [
|m anyItem hosts|
anyItem := false.
SmallTeam notNil ifTrue:[
m := Menu new.
hosts := Set new.
self selectedMethodsValue do:[:m |
hosts addAll:(SmallTeam hostsWithChangeForClass:(m mclass) selector:(m selector)).
].
hosts := hosts asOrderedCollection sort.
hosts do:[:eachHost |
|item|
item := MenuItem label:eachHost.
item itemValue:#'selectorMenuCompareWithSmallTeamVersionOnHost:' argument:eachHost.
m addItem:item.
anyItem := true.
].
].
anyItem ifFalse:[ nil ] ifTrue:[ m ]
].
"Created: / 11-11-2006 / 15:19:18 / cg"
!
compareWithSmallTeamVersionMenu
<resource: #programMenu >
^ [
|m anyItem hosts|
m := Menu new.
hosts := Set new.
self selectedMethodsValue do:[:m |
hosts addAll:(SmallTeam hostsWithChangeForClass:(m mclass) selector:(m selector)).
].
hosts := hosts asOrderedCollection sort.
anyItem := false.
hosts do:[:eachHost |
|item|
item := MenuItem label:eachHost.
item itemValue:#'selectorMenuCompareWithSmallTeamVersionOnHost:' argument:eachHost.
m addItem:item.
anyItem := true.
].
anyItem ifFalse:[ nil ] ifTrue:[ m ]
].
"Created: / 11-11-2006 / 15:03:16 / cg"
!
editModeInfoLabelMenu
<resource: #programMenu >
^ self class editModeInfoLabelMenu.
!
findHistoryMenu
<resource: #programMenu >
^ [
|m|
FindHistory size > 0 ifTrue:[
m := Menu new.
FindHistory do:[:entry |
|item itemLabel|
itemLabel := self historyMenuItemLabelFor:entry.
item := MenuItem label:itemLabel.
item itemValue:#'switchToFindHistoryEntry:' argument:entry.
m addItem:item.
(environment classNamed:(entry className ? '?')) isBehavior ifFalse:[
item enabled:false.
item label:(LabelAndIcon icon:(ToolbarIconLibrary erase16x16Icon2) string:itemLabel)
].
].
].
m
].
"Modified: / 09-09-2012 / 13:06:07 / cg"
!
followImplementorMessagesMenu
^ [
self
messagesMenuFor: #'selectResponseTo:'
withCurrentSelector:false
withSenderChain: false
withImplementorChain: false
withLocalSenders: false
withLocalImplementors: false
withCallersOfThisMethod: false
withMethodsCalledByThisMethod: false
selfSendsOnly:true
]
"Modified: / 25-11-2016 / 16:00:46 / cg"
!
globalReferencesMenu
"a menu allowing to browse the referenced globals (typically: classes) of the
selected method(s)"
|menu classes detector|
classes := Set new.
detector :=
[:m :lit |
|cls ns|
lit isSymbol ifTrue:[
(((cls := environment at:lit) notNil and:[ cls isBehavior ])
"JV@2011-11-25: Added check if the nameSpace is really a namespace, it may be
a class if m mclass is a privateClass...
---------------------------------------------v"
or:[ m mclass notNil
and:[ (ns := m mclass nameSpace) notNil
and:[ ns isNameSpace
and:[ ns ~= Smalltalk
and:[ (cls := ns at:lit) notNil and:[ cls isBehavior ]]]]]])
ifTrue:[
classes add:cls
]
] ifFalse:[
lit isArray ifTrue:[
lit do:[:lit | detector value:m value:lit]
].
].
].
self selectedMethodsDo:[:m |
m literalsDo:[:lit |
detector value:m value:lit.
].
].
classes isEmpty ifTrue:[
^ nil
].
classes := classes asOrderedCollection sort:[:a :b | a name < b name].
menu := Menu new.
classes do:[:eachClass |
|item|
item := MenuItem label:eachClass name.
item itemValue:[ self spawnFullBrowserInClass:eachClass selector:nil in:#newBuffer ].
"/ item itemValue:#'spawnBrowserOnClass:' argument:eachClass.
menu addItem:item.
].
^ menu
"Created: / 26-10-2011 / 18:15:01 / cg"
"Modified: / 09-09-2012 / 13:17:27 / cg"
"Modified: / 04-09-2013 / 17:43:07 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
goBackInGlobalHistoryMenu
<resource: #programMenu>
^ self goBackMenuFor:self class classHistory
"Modified: / 27-02-2008 / 11:54:08 / janfrog"
"Created: / 02-07-2011 / 18:39:52 / cg"
!
goBackMenu
<resource: #programMenu>
^ self goBackMenuFor:self navigationHistory
"Created: / 22-02-2008 / 16:55:18 / janfrog"
"Modified: / 27-02-2008 / 11:54:08 / janfrog"
"Modified (format): / 03-07-2011 / 13:53:12 / cg"
!
goBackMenuFor:aHistory
<resource: #programMenu>
^ self menuForHistoryItems:(aHistory goBackItems)
"Modified: / 27-02-2008 / 11:54:08 / janfrog"
"Created: / 02-07-2011 / 18:39:15 / cg"
!
goForwardInGlobalHistoryMenu
<resource: #programMenu>
^ self goForwardMenuFor:self class classHistory
"Created: / 03-07-2011 / 13:52:53 / cg"
!
goForwardMenu
<resource: #programMenu>
^ self goForwardMenuFor:self navigationHistory
"Created: / 22-02-2008 / 16:55:18 / janfrog"
"Modified: / 27-02-2008 / 11:54:27 / janfrog"
"Modified: / 03-07-2011 / 13:53:29 / cg"
!
goForwardMenuFor:aHistory
<resource: #programMenu>
^ self menuForHistoryItems:(aHistory goForwardItems)
"Modified: / 27-02-2008 / 11:54:27 / janfrog"
"Created: / 03-07-2011 / 13:52:06 / cg"
!
historyMenuItemLabelFor:aHistoryEntry
|className name sel|
className := aHistoryEntry className ? '?'.
aHistoryEntry meta ifTrue:[
className := className , ' class'.
].
name := className.
(sel := aHistoryEntry selector) notNil ifTrue:[
name := name , ' ' , sel allBold.
] ifFalse:[
name := name "allBold".
].
^ name contractTo:100.
"Created: / 08-09-2012 / 20:43:17 / cg"
!
implementedMessagesMenu
^ [
self
messagesMenuFor:#'spawnBrowserOnAllImplementorsOf:'
withSenderChain:false
withImplementorChain:true
withLocalSenders:false
withLocalImplementors:true
selfSendsOnly:false
]
"Modified: / 05-09-2006 / 10:34:10 / cg"
!
loadMethodFromSmallTeamHostMenu
<resource: #programMenu >
^ [
|m anyItem hosts|
m := Menu new.
hosts := Set new.
self selectedMethodsValue do:[:m |
hosts addAll:(SmallTeam hostsWithChangeForClass:(m mclass) selector:(m selector)).
].
hosts := hosts asOrderedCollection sort.
anyItem := false.
hosts do:[:eachHost |
|item|
item := MenuItem label:eachHost.
item itemValue:#'selectorMenuLoadSmallTeamVersionFromHost:' argument:eachHost.
m addItem:item.
anyItem := true.
].
anyItem ifFalse:[ nil ] ifTrue:[ m ]
].
"Created: / 12-11-2006 / 15:47:43 / cg"
!
menuForHistoryItems:items
<resource: #programMenu>
| menu any |
any := false.
menu := Menu new.
items do:[:historyEntry|
any := true.
menu addItem:
(MenuItem
label: historyEntry displayString
itemValue:[self switchToHistoryEntry: historyEntry])
].
any ifFalse:[^ nil ].
^ menu
"Modified: / 27-02-2008 / 11:54:08 / janfrog"
"Created: / 02-07-2011 / 18:39:15 / cg"
!
messagesMenuFor:actionSelector
withCurrentSelector:withCurrentSelector
withSenderChain:withSenderChain withImplementorChain:withImplementorChain
withLocalSenders:withLocalSenders withLocalImplementors:withLocalImplementors
withCallersOfThisMethod:withCallersOfThisMethod withMethodsCalledByThisMethod:withMethodsCalledByThisMethod
selfSendsOnly:selfSendsOnly
"common helper for the dynamic senders & implementors (2nd-level) menus in the methodList"
<resource: #programMenu >
|m mthd mSel contractedSelector item l methods allMessagesSent needSep|
m := Menu new.
mthd := self theSingleSelectedMethod.
(mthd notNil and:[ (mSel := mthd selector) notNil]) ifTrue:[
"/ JV: Following code should be language-specific. For Smalltalk, use the old code.
"/ For the rest, delegate to the language's toolbox (if any)
mthd programmingLanguage ~~ SmalltalkLanguage instance ifTrue:[
| toolbox |
toolbox := mthd programmingLanguage toolbox.
toolbox isNil ifTrue:[
m addItem:((MenuItem label: (resources string: 'Not supported for %1 (no toolbox)'with: mthd programmingLanguage name))
enabled: false).
^ m.
].
toolbox browser: self.
toolbox environment: environment.
^ toolbox messagesMenuFor:actionSelector
withMethods: (Array with: mthd)
withMethodSelectors:withCurrentSelector
withSentSelectors: true
withSelfSelectorsOnly: selfSendsOnly
].
needSep := false.
contractedSelector := mSel contractTo:80.
withCurrentSelector ifTrue:[
item := MenuItem label:(' ' , contractedSelector , ' '). "/ ' ' is a kludge - to allow '-' selector
item itemValue:actionSelector argument:mSel.
m addItem:item.
needSep := true.
].
"/ true "withInstanceProtocolOnly" ifTrue:[
"/ item := MenuItem label:(resources string:' %1 - Instance Protocol Only' with:contractedSelector).
"/ item value:actionSelector.
"/ item argument:(#instanceProtocolOnly -> mSel).
"/ m addItem:item.
"/ ].
"/ true "withClassProtocolOnly" ifTrue:[
"/ item := MenuItem label:(resources string:' %1 - Class Protocol Only' with:contractedSelector).
"/ item value:actionSelector.
"/ item argument:(#classProtocolOnly -> mSel).
"/ m addItem:item.
"/ ].
(withLocalSenders or:[ withSenderChain or:[ withLocalImplementors or:[ withImplementorChain]]]) ifTrue:[
needSep ifTrue:[ m addSeparator ].
needSep := false.
].
withLocalSenders ifTrue:[
"/ item := MenuItem label:(resources string:' %1 - Local Senders' with:contractedSelector).
item := MenuItem label:(resources string:'Local Senders of %1' with:contractedSelector).
item itemValue:#spawnLocalSendersBuffer.
m addItem:item. needSep := true
].
withSenderChain ifTrue:[
"/ item := MenuItem label:(resources string:' %1 - Sender Chain' with:contractedSelector).
item := MenuItem label:(resources string:'Sender Chain of %1' with:contractedSelector).
item itemValue:#spawnSenderChainBuffer.
m addItem:item. needSep := true
].
(withCallersOfThisMethod and:[mthd isInstrumented]) ifTrue:[
item := MenuItem label:(resources string:'Callers of this %1' with:contractedSelector).
item itemValue:#spawnCallersBuffer.
m addItem:item. needSep := true
].
withLocalImplementors ifTrue:[
item := MenuItem label:(resources string:'Local Implementors of %1' with:contractedSelector).
item itemValue:#spawnLocalImplementorsBuffer.
m addItem:item. needSep := true
].
withImplementorChain ifTrue:[
item := MenuItem label:(resources string:'Implementor Chain of %1' with:contractedSelector).
item itemValue:#spawnImplementorChainBuffer.
m addItem:item. needSep := true
].
withMethodsCalledByThisMethod ifTrue:[
item := MenuItem label:(resources string:'Methods Called by %1' with:contractedSelector).
item itemValue:#spawnMethodsCalledByBuffer.
m addItem:item. needSep := true
].
selfSendsOnly ifTrue:[
l := mthd messagesSentToSelf.
l := l , (mthd messagesSentToSuper asArray collect:[:each | { each . mthd mclass superclass }]).
l := l , ((mthd messagesPossiblySent
select:[:sel | mthd mclass canUnderstand:sel])
asArray collect:[:each | each allItalic "colorizeAllWith:Color darkGray"]).
] ifFalse:[
l := mthd messagesSent asArray.
l := l , (mthd messagesPossiblySent asArray collect:[:each | each allItalic "colorizeAllWith:Color darkGray"]).
].
l size > 0 ifTrue:[
l := l asOrderedCollection sort:[:a :b |
|sA sB|
sA := a isArray ifTrue:[a first] ifFalse:[a string].
sB := b isArray ifTrue:[b first] ifFalse:[b string].
sA < sB].
needSep ifTrue:[ m addSeparator ].
"/ (l size > 30) ifTrue:[
"/ l removeAllFoundIn:#(ifTrue: ifFalse: ifTrue:ifFalse: ifFalse:ifTrue:
"/ whileTrue: whileFalse:
"/ isNil notNil
"/ and: or:
"/ ).
"/ (l size > 30) ifTrue:[
"/ l removeAllFoundIn:#(#'==' #'~~' class
"/ ).
"/ ]
"/ ].
"/ (cut := l size > 30) ifTrue:[
"/ l := l copyTo:30
"/ ].
l do:[:eachMessageOrPair |
|selector class label arg|
eachMessageOrPair isArray ifTrue:[
selector := eachMessageOrPair first.
class := eachMessageOrPair second.
arg := eachMessageOrPair.
] ifFalse:[
selector := eachMessageOrPair.
arg := eachMessageOrPair string asSymbol.
].
label := (selector contractTo:100).
class notNil ifTrue:[
label := label , ' (super)'.
].
item := MenuItem label:(' ' , label, ' '). "/ ' ' is a kludge - to allow '-' selector (i.e. not confuse with separator)
item itemValue:actionSelector argument:arg.
m addItem:item.
].
"/ cut ifTrue:[
"/ m addItem:(MenuItem label:'-').
"/ m addItem:(MenuItem label:'<< more items ignored >>').
"/ ]
]
] ifFalse:[
| methodsPerLanguage |
allMessagesSent := Set new.
"/ not exactly one method selected;
"/ generate a menu for all selected method's implementors and sent messages.
methods := self selectedMethodsValue.
methods isEmptyOrNil ifTrue:[
methods := OrderedCollection new.
self selectedClassesDo:[:cls |
cls methodsDo:[:eachMethod | methods add:eachMethod].
].
].
methodsPerLanguage := Dictionary new.
methods do:[:each |
(methodsPerLanguage at: each programmingLanguage ifAbsentPut:[Set new]) add: each.
].
methodsPerLanguage keysAndValuesDo:[:language :methods |
language isSmalltalk ifTrue:[
"/ Do it as before...
(methods asNewOrderedCollection sortBySelector:#selector) do:[:eachMethod |
|methodsMessages mSel contractedSelector item|
mSel := eachMethod selector ? '?'.
contractedSelector := mSel contractTo:80.
item := MenuItem label:(' ' , contractedSelector , ' '). "/ ' ' is a kludge - to allow '-' selector
item itemValue:actionSelector argument:mSel.
m addItem:item.
"/ this is ethe expensive part (parsing the code for the messages sent).
"/ for huge classes, the selectors are often already in the set.
(eachMethod literalsDetect:[:lit | (allMessagesSent includes:lit) not] ifNone:[nil]) notNil ifTrue:[
selfSendsOnly ifTrue:[
methodsMessages := eachMethod messagesSentToSelf.
] ifFalse:[
methodsMessages := eachMethod messagesSent.
].
allMessagesSent addAll:methodsMessages
].
].
] ifFalse:[
"/ Not a Smalltalk, must ask toolbox
| toolbox |
toolbox := language toolbox.
toolbox environment: environment.
toolbox notNil ifTrue:[
m addItemsFrom:
(toolbox messagesMenuFor:actionSelector
withMethods: methods
withMethodSelectors:true
withSentSelectors: false
withSelfSelectorsOnly: selfSendsOnly)
].
].
].
needSep := true.
methodsPerLanguage keysAndValuesDo:[:language :methods |
language isSmalltalk ifTrue:[
"/ Do it as before...
allMessagesSent := allMessagesSent asSortedCollection.
allMessagesSent size > 0 ifTrue:[
needSep ifTrue:[
m addSeparator.
needSep := false.
].
allMessagesSent do:[:eachMessage |
item := MenuItem label:(' ' , (eachMessage contractTo:100), ' '). "/ ' ' is a kludge - to allow '-' selector
item itemValue:actionSelector argument:eachMessage asSymbol.
m addItem:item.
].
].
] ifFalse:[
"/ Not a Smalltalk, must ask toolbox
| toolbox |
toolbox := language toolbox.
toolbox notNil ifTrue:[
| lm |
lm := toolbox messagesMenuFor:actionSelector
withMethods: methods
withMethodSelectors:false
withSentSelectors: true
withSelfSelectorsOnly: selfSendsOnly.
(lm items notEmptyOrNil and:[needSep]) ifTrue:[
m addSeparator.
needSep := false.
].
m addItemsFrom: lm.
].
].
].
].
^ m
"Created: / 27-04-2010 / 15:05:52 / cg"
"Modified: / 06-09-2013 / 19:37:07 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 25-11-2016 / 15:56:37 / cg"
"Modified: / 23-03-2023 / 18:27:20 / Jan Vrany <jan.vrany@labware.com>"
!
messagesMenuFor:actionSelector withSenderChain:withSenderChain withImplementorChain:withImplementorChain
^ self
messagesMenuFor:actionSelector
withSenderChain:withSenderChain
withImplementorChain:withImplementorChain
selfSendsOnly:false
"Modified: / 05-09-2006 / 10:26:26 / cg"
!
messagesMenuFor:actionSelector withSenderChain:withSenderChain withImplementorChain:withImplementorChain selfSendsOnly:selfSendsOnly
^ [
self
messagesMenuFor:actionSelector
withSenderChain:withSenderChain
withImplementorChain:withImplementorChain
withLocalSenders:false
withLocalImplementors:false
selfSendsOnly:selfSendsOnly
]
"Modified: / 05-09-2006 / 10:33:05 / cg"
!
messagesMenuFor:actionSelector
withSenderChain:withSenderChain withImplementorChain:withImplementorChain
withLocalSenders:withLocalSenders withLocalImplementors:withLocalImplementors
selfSendsOnly:selfSendsOnly
^ self
messagesMenuFor: actionSelector
withSenderChain: withSenderChain
withImplementorChain: withImplementorChain
withLocalSenders: withLocalSenders
withLocalImplementors: withLocalImplementors
withCallersOfThisMethod: true "false"
withMethodsCalledByThisMethod: false "/ not yet implemented
selfSendsOnly:selfSendsOnly
"Modified: / 27-07-2012 / 18:33:52 / cg"
!
messagesMenuFor:actionSelector
withSenderChain:withSenderChain withImplementorChain:withImplementorChain
withLocalSenders:withLocalSenders withLocalImplementors:withLocalImplementors
withCallersOfThisMethod:withCallersOfThisMethod withMethodsCalledByThisMethod:withMethodsCalledByThisMethod
selfSendsOnly:selfSendsOnly
<resource: #programMenu >
^ self
messagesMenuFor:actionSelector
withCurrentSelector:true
withSenderChain:withSenderChain withImplementorChain:withImplementorChain
withLocalSenders:withLocalSenders withLocalImplementors:withLocalImplementors
withCallersOfThisMethod:withCallersOfThisMethod withMethodsCalledByThisMethod:withMethodsCalledByThisMethod
selfSendsOnly:selfSendsOnly
"Modified: / 25-11-2016 / 16:00:56 / cg"
!
operationsMenu
<resource: #programMenu >
| manager item menu undoCountMenuItem cleanChangesForClassItem
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
label:lUndo
itemValue:[ self operationsMenuUndo ].
item showBusyCursorWhilePerforming:true.
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
label:lRedo
itemValue:[ self operationsMenuRedo ].
item showBusyCursorWhilePerforming:true.
manager hasRedoableOperations ifFalse: [item disable].
menu addItem:item.
undoListMenu := Menu new.
manager undoableOperations reverseDo:[:eachUndoChange |
item := MenuItem
label:(eachUndoChange name contractTo:100)
itemValue:[ self operationsMenuUndo:eachUndoChange ].
item showBusyCursorWhilePerforming:true.
undoListMenu addItem:item.
].
item := MenuItem label:(resources string:'Undo Recent').
item submenu:undoListMenu.
item enabled:manager hasUndoableOperations.
menu addItem:item.
undoCountMenuItem := MenuItem
label: (resources string:'Set Undo Count...')
itemValue: [self setUndoCount].
menu addItemGroup: (Array with: undoCountMenuItem).
cleanChangesForClassItem := MenuItem
label: (resources string:'Remove Class from ChangeSet...')
itemValue: [self classMenuCleanUpChangeSet]
enabled: self hasClassSelectedHolder.
menu addItemGroup: (Array with: cleanChangesForClassItem).
^menu
"Modified: / 09-09-2012 / 13:21:02 / cg"
!
otherBrowsersMenu
<resource: #programMenu >
"a menu showing other browsers, and allowing them to be reactivated"
^ [
|m selected submenu any|
any := false.
m := Menu new.
self class allInstancesDo:[:brwsr |
|item subMenu|
(brwsr ~~ self
and:[ brwsr window notNil
and:[ brwsr window isTopView
and:[ brwsr windowGroup notNil
and:[ brwsr window isOpen ]]]]) ifTrue:[
item := MenuItem label:'"',brwsr window label,'"'.
item itemValue:[:i | brwsr window raiseDeiconified ].
brwsr bufferNameList size == 1 ifTrue:[
] ifFalse:[
brwsr bufferNameList keysAndValuesDo:[:idx :eachBufferName |
true "idx ~~ brwsr selectedBuffer value" ifTrue:[
|subItem|
subMenu isNil ifTrue:[
subMenu := Menu new.
item submenu:subMenu.
].
subItem := MenuItem
label:(eachBufferName)
itemValue:[:i |
brwsr window raiseDeiconified.
brwsr selectedBuffer value:idx
].
subMenu addItem:subItem.
].
].
subMenu notNil ifTrue:[
item submenu:subMenu.
].
].
m addItem:item.
any := true.
]
].
any ifTrue:[
m items sort:[:a :b | a label < b label].
].
m
].
"Modified: / 09-09-2012 / 20:43:01 / cg"
!
projectMenu
<resource: #programMenu>
| menu |
menu := self menuFor: #projectMenu.
menu receiver:self.
menu findGuiResourcesIn:self.
^ menu
"Created: / 18-02-2000 / 12:17:28 / cg"
"Modified: / 25-01-2014 / 12:18:33 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
recentlyClosedMenu
<resource: #programMenu >
"a menu showing entries for recently closed page's locations, and allowing them to be reopened"
^ [
|m|
self closeHistory notEmptyOrNil ifTrue:[
m := Menu new.
self closeHistory do:[:historyEntry |
|item itemLabel|
itemLabel := self historyMenuItemLabelFor:historyEntry.
item := MenuItem label:itemLabel.
item
itemValue:[:i |
|cls|
cls := historyEntry theClass.
historyEntry meta ifTrue:[
cls := cls theMetaclass
].
self
spawnFullBrowserInClass:cls
selector:historyEntry selector
in:#newBuffer
].
m addItem:item.
].
].
m
].
"Modified: / 02-05-2014 / 17:49:17 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
selectedClassesHierarchyMenu
<resource: #programMenu >
^ [
|m cls classes first|
cls := self theSingleSelectedClass.
(cls notNil and:[cls superclass notNil]) ifTrue:[
m := Menu new.
cls := cls superclass.
first := true.
[cls notNil] whileTrue:[
|item className|
className := cls name.
item := MenuItem label:(first ifTrue:[className,' (direct superclass)'] ifFalse:[className]).
m addItem:item beforeIndex:1. "/ reverse
item value:#'switchToClassNamed:'.
item argument:className.
cls := cls superclass.
first := false.
].
].
m
].
"Modified: / 05-02-2012 / 10:30:03 / cg"
!
selectorMenuNewSlice
|m selectedClasses currentLanguage allLanguages|
(selectedClasses := self selectedClasses value) notEmptyOrNil ifTrue:[
selectedClasses size == 1 ifTrue:[
"/Single class selected
currentLanguage := selectedClasses anElement programmingLanguage.
] ifFalse:[
"/Multiple class selected, be strict here
currentLanguage := nil."/unknown
].
] ifFalse:[
currentLanguage := nil."/unknown
].
allLanguages := OrderedCollection new.
ProgrammingLanguage allDo:[:eachLanguage |
eachLanguage isSmalltalk ifFalse:[
allLanguages add:eachLanguage
]
].
allLanguages sort:[:a :b | a name < b name].
m := Menu new.
m addItem:(MenuItem
label:'Smalltalk Method'
value:[self selectorMenuNewMethod: SmalltalkLanguage instance]).
allLanguages do:[:eachLanguage |
eachLanguage compilerClass notNil ifTrue:[
m addItem:((MenuItem
label:(eachLanguage name) , ' Method'
value:[self selectorMenuNewMethod: eachLanguage])
enabled: (eachLanguage supportsExtensionMethods or:[eachLanguage = currentLanguage]))
]
].
^ m
"Created: / 30-12-2009 / 19:43:47 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 17-02-2012 / 22:15:06 / cg"
"Modified: / 10-05-2012 / 20:32:52 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
sentMessagesMenu
^ [
self
messagesMenuFor:#'spawnBrowserOnAllSendersOf:'
withSenderChain:true "(self window sensor ctrlDown)"
withImplementorChain:false
withLocalSenders:true
withLocalImplementors:false
selfSendsOnly:false
]
"Modified: / 05-09-2006 / 10:33:41 / cg"
!
sentMessagesResponseMenu
^ self
messagesMenuFor:#'findResponseTo:'
withSenderChain:false
withImplementorChain:false
selfSendsOnly:true
"Modified: / 05-09-2006 / 10:33:49 / cg"
!
toolBarMenu
<resource: #programMenu>
| menu item |
"/ cg: question: why are the submenuchannels setup here,
"/ and not set in the menuspec?
menu := Menu decodeFromLiteralArray: self class toolBarMenu.
item := menu menuItemWithValue: #goBack.
item notNil ifTrue:[item submenuChannel:[self goBackMenu]].
item := menu menuItemWithValue: #goBackInGlobalHistory.
item notNil ifTrue:[item submenuChannel:[self goBackInGlobalHistoryMenu] ].
item := menu menuItemWithValue: #goForward.
item notNil ifTrue:[item submenuChannel:[self goForwardMenu] ].
"/ no, I explicitly do not want this
"/ (menu menuItemWithValue: #goForwardInGlobalHistory)
"/ submenuChannel:[self goForwardInGlobalHistoryMenu].
item := menu menuItemWithValue: #runLint.
item notNil ifTrue:[item submenuChannel:[ (Menu decodeFromLiteralArray: self class toolBarMenuLint) findGuiResourcesIn: self; yourself] ].
^menu
"Created: / 22-02-2008 / 17:00:05 / janfrog"
"Modified: / 03-07-2011 / 14:40:57 / cg"
"Modified: / 27-11-2014 / 16:01:33 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
variablesMenu
<resource: #programMenu>
| menu |
menu := self menuFor: #variablesMenu.
menu receiver:self.
menu findGuiResourcesIn:self.
^ menu
"Modified: / 25-01-2014 / 12:19:48 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
visitedClassesMenu
<resource: #programMenu >
^ [
|m classHistory currentClass|
currentClass := self theSingleSelectedClass.
classHistory := self class classHistory.
classHistory notEmpty 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).
item itemValue:#'switchToHistoryEntry:' argument:entry.
m addItem:item.
].
].
].
m
].
"Modified: / 09-09-2012 / 13:24:04 / cg"
! !
!NewSystemBrowser methodsFor:'menus-dynamic-SCM'!
categoryMenuSCMCommon
|menu|
menu := self class categoryMenuSCMCommon decodeAsLiteralArray.
self replaceSourceCodeManagerPlaceholderWith: SourceCodeManager in: menu.
^ menu
!
categoryMenuSCMFor: sourceCodeManagerClassName
"insert the sourcecode manager name"
<resource: #programMenu>
|manager menu |
sourceCodeManagerClassName isBehavior ifTrue:[
manager := sourceCodeManagerClassName
] ifFalse:[
sourceCodeManagerClassName notNil ifTrue:[
manager := Smalltalk at: sourceCodeManagerClassName.
].
].
manager isNil ifTrue:[
menu := Menu new.
menu addItem:
(MenuItem
label: (resources string: 'Unavailable - Configure SCM')
itemValue: [self openSettingsDialogAndSelectSourceCodeManagement])
] ifFalse:[
menu := self menuFor: #categoryMenuSCMCommon.
].
self replaceSourceCodeManagerPlaceholderWith: manager in: menu.
^ menu
"Created: / 15-10-2011 / 12:23:52 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 31-01-2014 / 02:22:55 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
categoryMenuSCMSlice
<resource: #programMenu>
^self
commonMenuSCMSliceNamed: #categoryMenuSCMSlice
computeManagerWith:
[:managersInOutCollection|
|packagesAlready|
"/ as packages typically consist of many classes,
"/ do it by package; not by class.
"/ otherwise, some things become very slow
"/ (especially: menu-opening and shortCut finding)
"/ when many or all categories are selected.
packagesAlready := Set new.
self selectedCategoryClassesDo: [:cls|
| package mgr |
package := cls package.
package notNil ifTrue:[
(packagesAlready includes:package) ifFalse:[
mgr := cls sourceCodeManager.
mgr notNil ifTrue:[
managersInOutCollection add: mgr
].
packagesAlready add:package.
]
]
]
].
"Created: / 19-04-2011 / 14:29:47 / cg"
"Created: / 15-10-2011 / 12:31:22 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
categoryMenuSCMSlice_old
|menu|
menu := self class categoryMenuSCMSlice_old decodeAsLiteralArray.
self replaceSourceCodeManagerPlaceholderWith: SourceCodeManager in: menu.
^ menu
!
classGitMenu
|menu|
menu := self menuFor: #classGitMenu.
self replaceSourceCodeManagerPlaceholderWith: GitSourceCodeManager in: menu.
^ menu
"Created: / 23-07-2012 / 15:10:12 / cg"
"Modified: / 25-01-2014 / 12:17:57 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
classMenuSCMExtraFor: sourceCodeManagerClassName
<resource: #programMenu>
|manager spec menu |
sourceCodeManagerClassName isBehavior ifTrue:[
manager := sourceCodeManagerClassName
] ifFalse:[
sourceCodeManagerClassName notNil ifTrue:[
manager := Smalltalk at: sourceCodeManagerClassName.
].
manager isNil ifTrue:[
^Menu new
].
].
spec := self class perform: ('classMenuSCMExtra_' , manager managerTypeNameShort) asSymbol ifNotUnderstood:[nil].
spec notNil ifTrue:[
menu := spec decodeAsLiteralArray.
menu receiver:self.
menu findGuiResourcesIn:self.
menu addItem: (MenuItem separator) beforeIndex: 1
] ifFalse:[
menu := Menu new.
].
^menu
"Created: / 12-10-2011 / 16:04:12 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 31-01-2014 / 02:23:10 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
classMenuSCMExtraForManagerNamed:sourceCodeManagerClassName
<resource: #programMenu>
|manager spec menu |
sourceCodeManagerClassName isBehavior ifTrue:[
manager := sourceCodeManagerClassName
] ifFalse:[
sourceCodeManagerClassName notNil ifTrue:[
manager := Smalltalk at: sourceCodeManagerClassName.
].
manager isNil ifTrue:[
^ Menu new
].
].
spec := self class perform: ('classMenuSCMExtra_' , manager managerTypeNameShort) asSymbol ifNotUnderstood:[nil].
spec notNil ifTrue:[
menu := spec decodeAsLiteralArray.
menu receiver:self.
menu findGuiResourcesIn:self.
menu addItem: (MenuItem separator) beforeIndex: 1
] ifFalse:[
menu := Menu new.
].
^menu
"Created: / 12-10-2011 / 16:04:12 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Created: / 21-12-2011 / 20:01:27 / cg"
"Modified: / 31-01-2014 / 02:23:16 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
classMenuSCMFor: sourceCodeManagerClassName
"insert the sourcecode manager name"
<resource: #programMenu>
^ self scmMenuForManagerNamed:sourceCodeManagerClassName selector:#classMenuSCMCommon
"/ |manager menu |
"/
"/ sourceCodeManagerClassName isBehavior ifTrue:[
"/ manager := sourceCodeManagerClassName
"/ ] ifFalse:[
"/ sourceCodeManagerClassName notNil ifTrue:[
"/ manager := Smalltalk at: sourceCodeManagerClassName.
"/ ].
"/ ].
"/ manager isNil ifTrue:[
"/ menu := Menu new.
"/ menu addItem:
"/ (MenuItem
"/ label: (resources string: 'Unavailable - Configure SCM')
"/ itemValue: [self openSettingsDialogAndSelectSourceCodeManagement])
"/ ] ifFalse:[
"/ menu := self menuFor: #classMenuSCMCommon.
"/ ].
"/ self replaceSourceCodeManagerPlaceholderWith: manager in: menu.
"/
"/ ^ menu
"Created: / 07-10-2011 / 16:18:35 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 31-01-2014 / 02:23:29 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
classMenuSCMSlice
<resource: #programMenu>
^self
commonMenuSCMSliceNamed: #classMenuSCMSlice
computeManagerWith:[:managers|
self selectedClassesDo: [:cls|
| mgr |
mgr := cls theNonMetaclass sourceCodeManager.
mgr notNil ifTrue:[managers add: mgr]
]
].
"Created: / 19-04-2011 / 14:29:47 / cg"
"Created: / 07-10-2011 / 14:53:54 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 10-01-2012 / 00:26:38 / cg"
!
commonMenuSCMSliceNamed: sliceName computeManagerWith: managersBlock
"Common helper for SCM menu creation. managersBlock
is one arg block that should fill a set of managers
(passes as arg) for currently selected thingies
(classes, projects, ...)"
<resource: #programMenu>
| layout menu item managers manager |
layout := UserPreferences current sourceCodeManagementMenuLayout.
menu := self class
perform: (sliceName, '_' , layout) asSymbol
ifNotUnderstood: [self class perform:(sliceName, '_old') asSymbol].
menu := menu decodeAsLiteralArray.
managers := Set new.
managersBlock value: managers.
managers size == 1 ifTrue:[
manager := managers anyOne.
] ifFalse:[
manager := nil
].
item := menu menuItemWithKey:#SCM.
(item notNil) ifTrue:[
manager notNil ifTrue:[
manager := managers anyOne.
item label:(resources string:'Repository') , ' ' , (manager managerTypeName withColor:Color gray).
] ifFalse:[
item label:(resources string:'Repository').
item enabled: false.
].
].
self replaceSourceCodeManagerPlaceholderWith: manager in: menu.
(layout = 'inline') ifTrue:[
menu itemsDo:[:item|
manager notNil ifTrue:[
item argument == manager name ifTrue:[
item label: (item label , ' ' , ((resources string: '(default)') withColor: Color gray)).
]
] ifFalse:[
item enabled: false
].
]
].
^ menu
"Created: / 19-04-2011 / 14:29:47 / cg"
"Created: / 15-10-2011 / 11:02:22 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 01-12-2011 / 21:18:20 / cg"
!
projectMenuSCMCompareBuildSupportFileFor: sourceCodeManagerClassName
<resource: #programMenu>
^ self
scmMenuForManagerNamed:sourceCodeManagerClassName
selector:#projectMenuSCMCompareBuildSupportFile
"/ |manager menu |
"/
"/ sourceCodeManagerClassName isBehavior ifTrue:[
"/ manager := sourceCodeManagerClassName
"/ ] ifFalse:[
"/ sourceCodeManagerClassName notNil ifTrue:[
"/ manager := Smalltalk at: sourceCodeManagerClassName.
"/ ].
"/ ].
"/ manager isNil ifTrue:[
"/ menu := Menu new.
"/ menu addItem:
"/ (MenuItem
"/ label: (resources string: 'Unavailable - Configure SCM')
"/ itemValue: [self openSettingsDialogAndSelectSourceCodeManagement])
"/ ] ifFalse:[
"/ menu := self menuFor: #projectMenuSCMCompareBuildSupportFile.
"/ menu itemsDo:[:item|
"/ | selector |
"/
"/ selector := item value.
"/ item itemValue:[self perform: selector with: item argument with: manager]
"/ ]
"/ ].
"/ menu receiver:self.
"/ menu findGuiResourcesIn:self.
"/ ^ menu
"Created: / 12-10-2011 / 20:23:42 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 09-09-2012 / 13:23:37 / cg"
"Modified: / 31-01-2014 / 02:23:37 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
projectMenuSCMCompareBuildSupportFileForManagerNamed:sourceCodeManagerClassName
<resource: #programMenu>
^ self
scmMenuForManagerNamed:sourceCodeManagerClassName
selector:#projectMenuSCMCompareBuildSupportFile
"Created: / 12-10-2011 / 20:23:42 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Created: / 21-12-2011 / 20:01:10 / cg"
"Modified: / 31-01-2014 / 02:23:43 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
projectMenuSCMExtraFor: sourceCodeManagerClassName
<resource: #programMenu>
|manager spec menu |
sourceCodeManagerClassName isBehavior ifTrue:[
manager := sourceCodeManagerClassName
] ifFalse:[
sourceCodeManagerClassName notNil ifTrue:[
manager := Smalltalk at: sourceCodeManagerClassName.
].
manager isNil ifTrue:[
^Menu new
].
].
spec := self class perform: ('projectMenuSCMExtra_' , manager managerTypeNameShort) asSymbol ifNotUnderstood:[nil].
spec notNil ifTrue:[
menu := spec decodeAsLiteralArray.
menu receiver:self.
menu findGuiResourcesIn:self.
menu addItem: (MenuItem separator) beforeIndex: 1
] ifFalse:[
menu := Menu new.
].
^menu
"Created: / 15-10-2011 / 22:42:37 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 31-01-2014 / 02:23:52 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
projectMenuSCMFor: sourceCodeManagerClassName
"insert the sourcecode manager name"
<resource: #programMenu>
^ self
scmMenuForManagerNamed:sourceCodeManagerClassName
selector:#projectMenuSCMCommon
"/ |manager menu |
"/
"/ sourceCodeManagerClassName isBehavior ifTrue:[
"/ manager := sourceCodeManagerClassName
"/ ] ifFalse:[
"/ sourceCodeManagerClassName notNil ifTrue:[
"/ manager := Smalltalk at: sourceCodeManagerClassName.
"/ ].
"/ ].
"/ manager isNil ifTrue:[
"/ menu := Menu new.
"/ menu addItem:
"/ (MenuItem
"/ label: (resources string: 'Unavailable - Configure SCM')
"/ itemValue: [self openSettingsDialogAndSelectSourceCodeManagement])
"/ ] ifFalse:[
"/ menu := self menuFor: #projectMenuSCMCommon decodeAsLiteralArray.
"/ ].
"/ self replaceSourceCodeManagerPlaceholderWith: manager in: menu.
"/
"/ ^ menu
"Created: / 12-10-2011 / 20:57:20 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 31-01-2014 / 02:24:02 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
projectMenuSCMSlice
<resource: #programMenu>
^self
commonMenuSCMSliceNamed: #projectMenuSCMSlice
computeManagerWith:
[:managers|
self selectedProjectsDo:[:pkg|
| mgr |
mgr := AbstractSourceCodeManager managerForPackage:pkg.
mgr isNil ifFalse:[managers add: mgr]
]].
"Created: / 19-04-2011 / 14:29:47 / cg"
"Created: / 12-10-2011 / 20:53:35 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
scmMenuForManagerNamed:sourceCodeManagerClassName selector:selector
<resource: #programMenu>
|manager menu |
sourceCodeManagerClassName isBehavior ifTrue:[
manager := sourceCodeManagerClassName
] ifFalse:[
sourceCodeManagerClassName notNil ifTrue:[
sourceCodeManagerClassName == #Default ifTrue:[
manager := Smalltalk at: #SourceCodeManager.
] ifFalse:[
manager := Smalltalk at: sourceCodeManagerClassName.
].
].
].
manager isNil ifTrue:[
menu := Menu new.
menu addItem:
(MenuItem
label: (resources string: 'Unavailable - Configure SCM')
itemValue: [self openSettingsDialogAndSelectSourceCodeManagement])
] ifFalse:[
menu := self menuFor: selector.
menu itemsDo:[:item|
| eachSelector |
eachSelector := item value.
eachSelector notNil ifTrue:[
item itemValue:[self perform: eachSelector with: item argument with: manager]
].
]
].
self replaceSourceCodeManagerPlaceholderWith: manager in: menu.
menu receiver:self.
menu findGuiResourcesIn:self.
^ menu
"Created: / 12-10-2011 / 20:23:42 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Created: / 21-12-2011 / 20:01:10 / cg"
"Modified: / 31-01-2014 / 02:23:43 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
selectorMenuSCMExtraFor: sourceCodeManagerClassName
<resource: #programMenu>
|manager spec menu |
sourceCodeManagerClassName isBehavior ifTrue:[
manager := sourceCodeManagerClassName
] ifFalse:[
sourceCodeManagerClassName notNil ifTrue:[
manager := Smalltalk at: sourceCodeManagerClassName.
].
manager isNil ifTrue:[
^Menu new
].
].
spec := self class perform: ('selectorMenuSCMExtra_' , manager managerTypeNameShort) asSymbol ifNotUnderstood:[nil].
spec notNil ifTrue:[
menu := spec decodeAsLiteralArray.
menu receiver:self.
menu findGuiResourcesIn:self.
menu addItem: (MenuItem separator) beforeIndex: 1
] ifFalse:[
menu := Menu new.
].
^menu
"Created: / 15-10-2011 / 22:42:51 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 31-01-2014 / 02:24:12 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
selectorMenuSCMFor: sourceCodeManagerClassName
"insert the sourcecode manager name"
<resource: #programMenu>
^ self
scmMenuForManagerNamed:sourceCodeManagerClassName
selector:#selectorMenuSCMCommon
"/
"/ |manager menu |
"/
"/ sourceCodeManagerClassName isBehavior ifTrue:[
"/ manager := sourceCodeManagerClassName
"/ ] ifFalse:[
"/ sourceCodeManagerClassName notNil ifTrue:[
"/ manager := Smalltalk at: sourceCodeManagerClassName.
"/ ].
"/
"/ ].
"/ manager isNil ifTrue:[
"/ menu := Menu new.
"/ menu addItem:
"/ (MenuItem
"/ label: (resources string: 'Unavailable - Configure SCM')
"/ itemValue: [self openSettingsDialogAndSelectSourceCodeManagement])
"/ ] ifFalse:[
"/ menu := self menuFor: #selectorMenuSCMCommon.
"/ ].
"/ self replaceSourceCodeManagerPlaceholderWith: manager in: menu.
"/
"/ ^ menu
"Created: / 12-10-2011 / 20:58:05 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 31-01-2014 / 02:25:49 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
selectorMenuSCMSlice
<resource: #programMenu>
^self
commonMenuSCMSliceNamed: #selectorMenuSCMSlice
computeManagerWith:
[:managers|
self selectedMethodsDo:[:mthd|
| mgr |
mgr := AbstractSourceCodeManager managerForPackage:mthd package.
mgr isNil ifFalse:[managers add: mgr].
]].
"Created: / 19-04-2011 / 14:29:47 / cg"
"Created: / 12-10-2011 / 20:54:27 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 19-10-2011 / 16:48:31 / cg"
! !
!NewSystemBrowser methodsFor:'menus-dynamic-lint'!
smalllintCheckMenuForCategory
^ self smalllintCheckMenuForEnvironment: self selectedCategoriesAsEnvironment
"Created: / 27-11-2014 / 07:01:34 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
smalllintCheckMenuForClass
ClassEnvironment isNil ifTrue:[
^ Menu new
addItem:(MenuItem label: (resources string: 'SmallLint not available') itemValue: nil enabled: false);
yourself.
].
^ self smalllintCheckMenuForEnvironment: self selectedClassesAsEnvironment
"Created: / 27-11-2014 / 06:52:59 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
smalllintCheckMenuForEnvironment: rbenvironment
| menu |
menu := Menu new.
(self canUseRefactoringSupport and:[RBCompositeLintRule notNil]) ifFalse:[
menu addItem:(MenuItem label: (resources string: 'SmallLint not loaded/available') itemValue: nil enabled: false).
^ menu
].
LastLintRulesHolder value notNil ifTrue:[
menu addItem:
(MenuItem label: (resources string: 'Run Again - %1' with: LastLintRulesHolder value displayString)
itemValue: [ self smalllintRunOnEnvironment:rbenvironment ])
] ifFalse:[
menu addItem: (MenuItem label: (resources string: 'Run Again')
itemValue: [ self smalllintRunOnEnvironment:rbenvironment ]
enabled: false)
].
RBCompositeLintRule rulesets do:[:ruleset|
menu addItem:
(MenuItem label: (resources string: 'Run Checks - %1' with: ruleset displayString)
itemValue: [ self smalllintRun:ruleset onEnvironment:rbenvironment ])
].
menu addItem:
(MenuItem label: (resources string: 'Run Selected...')
itemValue: [ self smalllintRunSelectedOnEnvironment:rbenvironment ]).
^ menu
"Created: / 27-11-2014 / 06:16:55 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 03-12-2014 / 11:27:45 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
smalllintCheckMenuForPackage
^ self smalllintCheckMenuForEnvironment: self selectedPackagesAsEnvironment
"Created: / 27-11-2014 / 06:54:52 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
smalllintCheckMenuForProtocol
^ self smalllintCheckMenuForEnvironment: self selectedProtocolsAsEnvironment
"Created: / 27-11-2014 / 06:54:08 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
smalllintCheckMenuForSelector
^ self smalllintCheckMenuForEnvironment: self selectedSelectorsAsEnvironment
"Created: / 27-11-2014 / 06:53:41 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
smalllintCheckMenuForToolbar
^ self smalllintCheckMenuForEnvironment: self selectedCodeComponentsAsEnvironment.
"Created: / 27-11-2014 / 06:48:50 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!NewSystemBrowser methodsFor:'menus-dynamic-popup'!
categoryPopUpMenu
"return the popUpMenu for the class-category-list view"
<resource: #programMenu>
^[ self categoryMenuWithFind ]
"Created: / 18-02-2000 / 11:58:25 / cg"
"Created: / 15-10-2011 / 12:28:21 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
classPopUpMenu
"return the popUpMenu for the regular class-list view"
<resource: #programMenu>
^[ self classMenu ]
"Created: / 18-02-2000 / 11:58:25 / cg"
"Modified: / 11-10-2011 / 09:18:46 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
hierarchyPopUpMenu
"return the popUpMenu for the class-hierarchy-list view"
<resource: #programMenu>
^ self classPopUpMenu
"Created: / 18.2.2000 / 11:58:25 / cg"
!
projectPopUpMenu
"return the popUpMenu for the project-list view"
<resource: #programMenu>
^[ self projectMenu ]
"Created: / 18-02-2000 / 11:58:25 / cg"
"Created: / 12-10-2011 / 20:28:48 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!NewSystemBrowser methodsFor:'menus-dynamic-subversion'!
commonSubversionBranchMenu
<resource: #programMenu >
| menu repository wc branchAspect|
menu := Menu new.
repository := self selectedProjectSubversionRepository.
repository ifNil:[^nil].
wc := repository workingCopy.
branchAspect := (AspectAdaptor accessWith: #branchOrNil assignWith: #branch:)
subject: wc.
repository branches do:
[:branch|
menu addItem:
(MenuItem new
label: branch displayString ;"/icon: branch icon;
choiceValue: branch;
choice: branchAspect;
enabled:(wc hasBranch not or: [(repository workingCopy branch) = branch]);
yourself)
].
^menu
"Created: / 19-04-2008 / 11:06:15 / Jan Vrany <vranyj1@fel.cvut.cz>"
"Modified: / 24-06-2010 / 14:29:42 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified (format): / 01-12-2011 / 21:06:52 / cg"
! !
!NewSystemBrowser methodsFor:'navigation'!
askForClassNameMatching:matchStringArg
"open a dialog to ask for a class name"
^ self class
askForClassNameMatching:matchStringArg
inEnvironment:self navigationState environment
for:self
!
delayedSwitchToCategory:aCategory
self window sensor
pushUserEvent:#selectCategory:
for:self
withArguments:(Array with:aCategory)
"Created: / 6.2.2000 / 02:14:44 / cg"
"Modified: / 25.2.2000 / 00:50:31 / cg"
!
delayedSwitchToProtocol:aCategory
self window sensor
pushUserEvent:#selectProtocol:
for:self
withArguments:(Array with:aCategory)
"Created: / 6.2.2000 / 02:14:44 / cg"
"Modified: / 25.2.2000 / 00:56:09 / cg"
!
initialOrganizerMode
|canvasType|
(canvasType := browserCanvasType) isNil ifTrue:[
canvasType := navigationState canvasType.
].
canvasType == #singleNameSpaceFullBrowserSpec ifTrue:[^ OrganizerCanvas organizerModeNamespace ].
canvasType == #singleProjectFullBrowserSpec ifTrue:[^ OrganizerCanvas organizerModeProject ].
canvasType == #multipleClassExtensionBrowserSpec ifTrue:[^ nil ].
"/ self halt.
^ OrganizerCanvas organizerModeCategory
!
selectCategories:aCollectionOfCategories
"switch to some categories (by the program)"
self selectedCategories value:aCollectionOfCategories.
"Created: / 25.2.2000 / 00:48:48 / cg"
"Modified: / 25.2.2000 / 00:51:40 / cg"
!
selectCategory:aCategory
self selectCategories:(Array with:aCategory).
"Created: / 25.2.2000 / 00:50:14 / cg"
!
selectClass:aClass
"switch to a class (by the program)"
self selectClasses:(Array with:aClass)
"Created: / 25.2.2000 / 00:57:06 / cg"
!
selectClasses:aCollectionOfClasses
"switch to some classes (by the program)"
|nonNilClasses|
nonNilClasses := aCollectionOfClasses select:[:cls | cls notNil].
self selectedClasses value:nonNilClasses
"Created: / 25.2.2000 / 00:47:10 / cg"
!
selectMethod:aMethod
self selectMethods:(Array with:aMethod).
!
selectMethods:aCollectionOfMethods
"switch to some methods (by the program)"
self selectedMethods value:aCollectionOfMethods
"Created: / 25.2.2000 / 00:52:39 / cg"
!
selectNamespace:aNamespace
self selectNamespaces:(Array with:aNamespace).
"Created: / 25.2.2000 / 02:39:01 / cg"
!
selectNamespaces:aCollectionOfNamespaces
self selectedNamespaces value:aCollectionOfNamespaces.
"Created: / 25.2.2000 / 00:53:29 / cg"
!
selectProject:aProject
self selectProjects:(Array with:aProject).
"Created: / 25.2.2000 / 02:49:23 / cg"
!
selectProjects:aCollectionOfProjects
self selectedProjects value ~= aCollectionOfProjects ifTrue:[
self selectedProjects value:aCollectionOfProjects.
] ifFalse:[
self breakPoint:#cg
]
"Created: / 25.2.2000 / 00:54:14 / cg"
!
selectProtocol:aProtocol
self selectProtocols:(Array with:aProtocol).
"Created: / 25.2.2000 / 00:55:50 / cg"
!
selectProtocols:aCollectionOfProtocols
self selectedProtocols value:aCollectionOfProtocols.
"Created: / 25.2.2000 / 00:55:05 / cg"
!
selectProtocolsMatching:aMatchPattern
|allProtocols|
allProtocols := Set new.
self selectedClassesDo:[:eachClass |
allProtocols addAll:(eachClass categories).
].
allProtocols := allProtocols select:[:each | aMatchPattern match:each].
self selectProtocols:allProtocols asOrderedCollection.
!
setupNavigationStateFrom:anotherNavigationState
"setup my navigationState from another navigationState"
|selectedClasses projects categories protocols namespaces canvasType meta selectedMethods
otherOrganizerMode isMethodBrowser|
otherOrganizerMode := anotherNavigationState organizerMode value.
selectedClasses := anotherNavigationState selectedClasses value copy.
canvasType := navigationState canvasType ? #fullBrowserSpec.
canvasType == #fullBrowserSpec ifTrue:[
isMethodBrowser := anotherNavigationState isMethodListBrowser
or:[anotherNavigationState isSingleMethodBrowser].
(isMethodBrowser
or:[otherOrganizerMode == OrganizerCanvas organizerModeCategory]) ifTrue:[
selectedMethods := anotherNavigationState selectedMethods value ? #().
isMethodBrowser ifTrue:[
selectedClasses := selectedMethods collect:[:each | each mclass] as:IdentitySet.
selectedClasses := selectedClasses select:[:each | each notNil].
protocols := selectedMethods collect:[:each | each category] as:Set.
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.
anotherNavigationState organizerMode value ~~ OrganizerCanvas organizerModeClassHierarchy ifTrue:[
anotherNavigationState organizerMode value ~~ OrganizerCanvas organizerModeHierarchy ifTrue:[
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] as:Set
].
navigationState selectedCategories value:categories.
otherOrganizerMode == OrganizerCanvas organizerModeProject ifTrue:[
navigationState organizerMode value:otherOrganizerMode.
projects := anotherNavigationState selectedProjects value copy.
navigationState selectedProjects value:projects.
].
navigationState meta value:meta.
"/ self immediateUpdate value:true.
"/ selectedClasses := selectedClasses collect:[:each | each theNonMetaclass].
navigationState selectedClasses value:selectedClasses.
navigationState selectedProtocols value:protocols.
"/ self immediateUpdate value:false.
navigationState selectedMethods value:(anotherNavigationState selectedMethods value copy).
^ self
].
navigationState isFullClassSourceBrowser ifTrue:[
otherOrganizerMode == OrganizerCanvas organizerModeCategory ifTrue:[
categories := anotherNavigationState selectedCategories value copy.
] ifFalse:[
"/ collect categories from selected classes.
categories := (selectedClasses ? #())
collect:[:eachClass | eachClass category] as:Set
].
navigationState selectedCategories value:categories.
selectedClasses size > 0 ifTrue:[
navigationState selectedClasses value:(selectedClasses collect:[:each | each theNonMetaclass]).
].
self enqueueDelayedUpdateCode.
^ self
].
navigationState isFullClassSourceBrowser ifTrue:[
otherOrganizerMode == OrganizerCanvas organizerModeCategory ifTrue:[
categories := anotherNavigationState selectedCategories value copy.
] ifFalse:[
"/ collect categories from selected classes.
categories := (selectedClasses ? #())
collect:[:eachClass | eachClass category] as:Set
].
navigationState selectedCategories value:categories.
selectedClasses size > 0 ifTrue:[
navigationState selectedClasses value:(selectedClasses collect:[:each | each theNonMetaclass]).
].
self enqueueDelayedUpdateCode.
^ self
].
navigationState isNameSpaceBrowser ifTrue:[
otherOrganizerMode == OrganizerCanvas organizerModeNamespace ifTrue:[
namespaces := anotherNavigationState selectedNamespaces value copy.
] ifFalse:[
"/ collect namespaces from selected classes.
namespaces := (selectedClasses ? #())
collect:[:eachClass | eachClass nameSpace name] as:Set
].
navigationState selectedNamespaces value:namespaces.
selectedClasses size > 0 ifTrue:[
navigationState selectedClasses value:selectedClasses.
].
self enqueueDelayedUpdateCode.
^ self
].
(navigationState isCategoryBrowser
or:[navigationState isNameSpaceFullBrowser
or:[navigationState isProjectFullBrowser]]) ifTrue:[
otherOrganizerMode == OrganizerCanvas organizerModeCategory ifTrue:[
categories := anotherNavigationState selectedCategories value copy.
] ifFalse:[
"/ collect categories from selected classes.
categories := (selectedClasses ? #())
collect:[:eachClass | eachClass category] as:Set
].
navigationState selectedCategories value:categories.
selectedClasses size > 0 ifTrue:[
navigationState selectedClasses value:selectedClasses.
].
self enqueueDelayedUpdateCode.
^ self
].
"Modified: / 29-09-2006 / 22:35:33 / cg"
!
sortBy:what
"change the sort-order (some methodLists only)"
self sortBy value:what
"Created: / 25.2.2000 / 00:47:10 / cg"
!
switchToAnyMethod:aSelectorString
"find all implementors of aSelectorString, and present a list
to choose from. When an entry is selected, switch to that class/selector.
This allows for quickly moving around in the system."
|classes sel box theClassName|
classes := OrderedCollection new.
(sel := aSelectorString asSymbolIfInterned) notNil ifTrue:[
environment allClassesDo:[:aClass |
(aClass includesSelector:sel) ifTrue:[
classes add:aClass.
].
(aClass class includesSelector:sel) ifTrue:[
classes add:aClass class.
].
]
].
classes size == 0 ifTrue:[
self class showNoneFound.
^ self
].
classes size > 1 ifTrue:[
box := ListSelectionBox
title:(resources stringWithCRs:'searching for #%1 method.\\in which class ?\\(Tab for completion or select)' with:aSelectorString).
box label:'find method'.
box okText:(resources string:'show').
box list:(classes collect:[:aClass | aClass name]) asSortedCollection.
box action:[:aString | theClassName := aString].
box entryCompletionBlock:[:contents |
|s l names|
s := contents withoutSpaces.
s size == 0 ifTrue:[
l := classes
] ifFalse:[
l := classes select:[:cls | cls name startsWith:s].
].
l size == 0 ifTrue:[
l := classes select:[:cls | cls name asLowercase startsWith:s asLowercase].
].
l size > 0 ifTrue:[
box list:(names := l collect:[:aClass | aClass name]) asSortedCollection.
box contents:(names longestCommonPrefix). "/ l first name.
l size ~~ 1 ifTrue:[
self window beep
]
]
].
box showAtPointer.
] ifFalse:[
theClassName := classes first name
].
theClassName notNil ifTrue:[
self rememberLocationInHistory.
self switchToClassNamed:theClassName.
self switchToSelector:aSelectorString.
].
"Modified: / 1.9.1995 / 01:39:58 / claus"
"Modified: / 25.1.2000 / 20:43:35 / cg"
!
switchToBookmarkEntry:entry
"invoked when switching to a method from the bookmark history"
(entry isKindOf: Bookmark)
ifTrue:
[entry switchToBookmarkIn: self]
ifFalse:
[self breakPoint: #jv info:'BrowserHistoryEntries should no longet be used'.
self switchToHistoryEntry: entry].
"Modified: / 05-05-2011 / 23:51:40 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
switchToClass:aClass
self switchToClass:aClass selector:nil
!
switchToClass:aClass selector:aSelector
^ self switchToClass: aClass selector: aSelector updateHistory: true
"Modified: / 27-02-2008 / 16:34:46 / janfrog"
"Modified (format): / 28-02-2012 / 09:29:44 / cg"
!
switchToClass:aClass selector:aSelector updateHistory: updateHistory
"switch to some class (by the program)"
|orgMode cls namespaces nsName cat pkg holder newValue doSwitchMeta mthd answer
ns classes methods|
aClass isNil ifTrue:[
^ self
].
aSelector notNil ifTrue:[
mthd := aClass compiledMethodAt:aSelector.
].
mthd isNil ifTrue:[
methods := OrderedCollection new.
] ifFalse:[
methods := OrderedCollection with:mthd.
].
(navigationState isMethodListBrowser
or:[navigationState isMethodBrowser]) ifTrue:[
"/ must check if that method is in the list ...
mthd isNil ifTrue:[
"/ (self confirm:'Add a buffer for the class ?' withCRs) ifFalse:[
"/ ^ self
"/ ].
self spawnFullBrowserInClass:aClass selector:nil in:#newBuffer.
^ self
].
navigationState methodListApplication isNil ifTrue:[
self spawnFullBrowserInClass:aClass selector:aSelector in:#newBuffer.
^ self
].
(navigationState methodList includesIdentical:mthd) ifFalse:[
answer := OptionBox request:'Method not in list.\\Add a buffer for it ?' withCRs
label:'New Browser ?'
image:(WarningBox iconBitmap)
buttonLabels:(resources array:#( 'Cancel' 'Add Buffer' 'New Browser' ))
values:#(nil #newBuffer #newBrowser)
default:#newBuffer
onCancel:nil.
answer notNil ifTrue:[
self spawnFullBrowserInClass:aClass selector:aSelector in:answer.
].
^ self
].
self selectedMethods value:methods.
^ self
].
(navigationState isClassBrowser) ifTrue:[
"/ must check if that class is in the list ...
((navigationState classList value ? #()) includesIdentical:aClass) ifFalse:[
((navigationState classList value ? #()) includesIdentical:aClass theNonMetaclass) ifFalse:[
navigationState isSingleClassBrowser ifTrue:[
navigationState classList value:(Array with:aClass).
] ifFalse:[
(self confirm:'Class not in list.\\Add a buffer for it ?' withCRs) ifTrue:[
self spawnFullBrowserInClass:aClass selector:aSelector in:#newBuffer.
].
^ self
].
].
].
self selectedClasses value:(OrderedCollection with:aClass).
self selectedMethods value:methods.
^ self
].
(navigationState isProtocolBrowser) ifTrue:[
self selectedMethods value:methods.
(self confirm:'Add a buffer for it ?' withCRs) ifTrue:[
self spawnFullBrowserInClass:aClass selector:aSelector in:#newBuffer.
].
^ self
].
orgMode := self organizerMode value.
"/ if the class is a namespace, ask if mode should be changed
(aClass isNameSpace and:[aClass ~~ Smalltalk]) ifTrue:[
orgMode ~~ OrganizerCanvas organizerModeNamespace ifTrue:[
answer := self
confirmWithCancel:(resources string:'Browser: %1 is a namespace - switch organizers display mode ?' with:aClass name)
defaultAnswer:false.
answer isNil ifTrue:[
AbortOperationRequest raise.
^ self
].
answer ifTrue:[
self organizerMode value:(OrganizerCanvas organizerModeNamespace).
orgMode := self organizerMode value.
] ifFalse:[
((self selectedClassesValue) contains:[:cls | cls nameSpace == aClass]) ifTrue:[^ self ].
"/ select the first class of that namespace
classes := aClass allClasses.
classes notEmpty ifTrue:[
self switchToClass:(classes first) selector:nil.
^ self.
]
]
].
].
"/ if the class is unloaded, turn hideUnloaded off
(aClass isLoaded not
and:[self hideUnloadedClasses value == true]) ifTrue:[
self hideUnloadedClasses value:false
].
doSwitchMeta := true.
"/ FIX bug in protocol-list; will not update selection otherwise ...
self immediateUpdate value:true.
namespaces := self selectedNamespaces value ? #().
ns := aClass topNameSpace.
ns notNil ifTrue:[nsName := ns name].
(namespaces includes:nsName) ifFalse:[
(namespaces includes:(NavigatorModel nameListEntryForALL)) ifFalse:[
self selectedNamespaces value:(OrderedCollection with: NavigatorModel nameListEntryForALL)
]
].
"/ namespaces := self nameSpaceFilter value ? #().
"/ (namespaces includes:aClass nameSpace name) ifFalse:[
"/ (namespaces includes:(NavigatorModel nameListEntryForALL)) ifFalse:[
"/ self nameSpaceFilter value:(OrderedCollection with: NavigatorModel nameListEntryForALL)
"/ ]
"/ ].
orgMode == OrganizerCanvas organizerModeCategory ifTrue:[
cat := aClass category ? '* no category *'.
(self selectedCategoriesValue includes:cat) ifFalse:[
self selectedCategories value:(OrderedCollection with:cat).
]
] ifFalse:[ orgMode == OrganizerCanvas organizerModeNamespace ifTrue:[
aClass isNameSpace ifTrue:[
nsName := aClass name.
] ifFalse:[
nsName := aClass nameSpace name.
].
(self selectedNamespacesValue includes:nsName) ifFalse:[
self selectedNamespaces value:(OrderedCollection with:nsName).
]
] ifFalse:[ orgMode == OrganizerCanvas organizerModeProject ifTrue:[
pkg := aClass package.
holder := self selectedProjects.
newValue := holder value ? #().
(newValue includes:pkg) ifFalse:[
newValue := OrderedCollection with:pkg.
].
mthd notNil ifTrue:[
"/ careful - the method could be in an extension ...
mthd package ~= pkg ifTrue:[
(newValue includes:mthd package) ifFalse:[
newValue := newValue asOrderedCollection.
newValue add:mthd package.
].
].
].
newValue ~= holder value ifTrue:[
holder value:newValue.
].
] ifFalse:[ (orgMode == OrganizerCanvas organizerModeClassHierarchy
or:[orgMode == OrganizerCanvas organizerModeClassInheritance]) ifTrue:[
"/ make sure, that the class is in the hierarchy;
"/ if required, update the hierarchy.
holder := self classHierarchyTopClass.
cls := holder value.
(cls isNil or:[(cls withAllSuperclasses includesIdentical:aClass) not]) ifTrue:[
holder value:aClass.
].
doSwitchMeta := false.
]]]].
doSwitchMeta ifTrue:[
self meta value:(aClass isMeta).
].
(self selectedClassesValue includesIdentical:aClass) ifFalse:[
self selectedClasses value:(OrderedCollection with:aClass).
].
"/ self selectedMethods value:methods.
mthd notNil ifTrue:[
(self selectedProtocolsValue contains:[:cat | (cat isNil and:[mthd category isNil]) or:[cat string = mthd category]]) ifFalse:[
self selectProtocols:(OrderedCollection with:mthd category).
].
self switchToMethod:mthd.
] ifFalse:[
self switchToSelector:aSelector.
].
self immediateUpdate value:false.
updateHistory ifTrue:[
self addToHistory:aClass selector:aSelector
].
self normalLabel.
"/ self selectedMethods value:nil.
self enqueueDelayedClassSelectionChange.
"Created: / 22-02-2008 / 09:05:51 / janfrog"
"Modified: / 27-02-2008 / 16:45:21 / janfrog"
"Modified: / 28-02-2012 / 16:53:17 / cg"
"Modified: / 10-09-2013 / 14:59:19 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
switchToClassNameMatching:aMatchString
|className class|
class := environment classNamed:aMatchString.
class notNil ifTrue:[
self switchToClass:class
] ifFalse:[
className := self askForClassNameMatching:aMatchString.
className notNil ifTrue:[
self switchToClassNamed:className.
]
]
"Modified: / 13.2.2000 / 20:57:42 / cg"
!
switchToClassNameOrSelectorMatching:aMatchString
|className class implementors answer classesMatchingCaseless|
aMatchString isEmptyOrNil ifTrue:[
^ self.
].
aMatchString knownAsSymbol ifTrue:[
class := environment classNamed:aMatchString.
class notNil ifTrue:[
self switchToClass:class.
^ self.
].
classesMatchingCaseless := environment keys select:[:nm | nm sameAs:aMatchString].
"/ matchStringLowercase := aMatchString asLowercase.
"/ classesWithPrefixCaseless := environment keys select:[:nm | nm asLowercase startsWith:aMatchString].
"/ impl := environment allImplementorsOf:aMatchString asSymbol.
"/ impl notEmptyOrNil ifTrue:[
"/ ].
(aMatchString first isLetter not
or:[ aMatchString first isLowercase]) ifTrue:[
implementors := SystemBrowser findImplementorsMatching:aMatchString in:(environment allClasses) ignoreCase:true.
implementors size > 0 ifTrue:[
|searchClassToken browseAllImplementorsToken|
searchClassToken := Object new.
browseAllImplementorsToken := Object new.
"/ (classesMatchingCaseless isEmpty and:[implementors size == 1]) ifTrue:[
"/ answer := Dialog
"/ confirm:(resources
"/ stringWithCRs:'No class named "%1".\But "%2" implements it. Go there ?'
"/ with:aMatchString allBold
"/ with:implementors first mclass name).
"/ answer ifTrue:[
"/ self switchToClass:implementors first mclass selector:implementors first selector.
"/ ].
"/ ^ self.
"/ ].
implementors := implementors asOrderedCollection sort:[:a :b | a mclass name < b mclass name].
classesMatchingCaseless isEmpty ifTrue:[
implementors size == 1 ifTrue:[
answer := browseAllImplementorsToken.
] ifFalse:[
answer := Dialog
choose:(resources
stringWithCRs:'There are %2 implementors of it.\\Goto one of them ?'
with:aMatchString allBold
with:implementors size)
fromList:(#('** show all **'),(implementors collect:[:m | m mclass name]))
values:{browseAllImplementorsToken},implementors
buttons:#('No, Search for a Class' 'Show all Implementors')
values:{searchClassToken . browseAllImplementorsToken}
lines:10 cancel:nil
postBuildBlock:[:box | box minExtent:300@250].
].
] ifFalse:[
answer := Dialog
choose:(resources
stringWithCRs:'No class named "%1".\But there are %2 implementors of it and %3 '
, (classesMatchingCaseless size == 1 ifTrue:['class'] ifFalse:['classes'])
,' with a similar name.\\Goto one of them ?'
with:aMatchString allBold
with:implementors size
with:classesMatchingCaseless size)
fromList:({'Implementors:' withColor:Color gray}
,(implementors collect:[:m | m mclass name])
,'-'
,{'Classes:' withColor:Color gray}
,classesMatchingCaseless)
values:(#(nil),implementors,#(nil nil),classesMatchingCaseless)
buttons:#('No, Search for a Class' 'Show all Implementors')
values:{ searchClassToken . browseAllImplementorsToken}
lines:10 cancel:nil
postBuildBlock:[:box | box minExtent:300@250].
].
answer isNil ifTrue:[^ self].
answer == browseAllImplementorsToken ifTrue:[
implementors size == 1 ifTrue:[
self
methodListMenuSpawnFullBrowserForClasses:{implementors first mclass}
methods:implementors in:#newBuffer
] ifFalse:[
self
spawnMethodBrowserForSearch:[
SystemBrowser
findImplementorsOf:aMatchString
in:environment allClasses
ignoreCase:false.
]
sortBy:#class
in:#newBuffer
label:(resources string:'Implementors of %1' string with:aMatchString).
].
^ self
].
answer ~~ searchClassToken ifTrue:[
answer isSymbol ifTrue:[
self switchToClass:(environment classNamed:answer).
] ifFalse:[
self switchToClass:(answer mclass) selector:(answer selector).
].
^ self.
].
].
].
].
(aMatchString includes: $.) ifTrue:[
"/ Java class?
className := (aMatchString copyReplaceAll: $. with: $/) asSymbolIfInterned.
className notNil ifTrue:[
environment allClassesDo: [:cls |
(cls isJavaClass and:[cls binaryName = className]) ifTrue:[
self switchToClass:cls.
]
].
].
].
className := self askForClassNameMatching:aMatchString.
className notNil ifTrue:[
self switchToClassNamed:className.
]
"Modified: / 04-07-2006 / 18:48:25 / fm"
"Modified (comment): / 07-03-2012 / 12:05:07 / cg"
"Modified: / 14-10-2013 / 10:36:12 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
switchToClassNamed:aString
|str theClass|
str := aString.
(aString endsWith:' class') ifTrue:[
str := aString copyButLast:6.
].
theClass := self findClassNamed:str.
((theClass == self theSingleSelectedClass) or:[theClass isBehavior not]) ifTrue:[^ self].
"/ if currently in meta-mode,
"/ switch to the metaClass
self meta value ifTrue:[
theClass := theClass theMetaclass
] ifFalse:[
theClass := theClass theNonMetaclass
].
self switchToClass:theClass.
"Created: / 13.2.2000 / 21:05:01 / cg"
!
switchToFindHistoryEntry:entry
"invoked when switching back to a method from the find history"
FindHistory removeIdentical:entry ifAbsent:nil.
self switchToHistoryEntry:entry.
FindHistory addFirst:entry.
!
switchToHistoryEntry:entry
"invoked when switching to a class from the visited history"
|cls|
entry isNil ifTrue:[^ self].
cls := environment at:entry className.
"/ Care for Java classes!!
cls isNil ifTrue:[
cls := environment allClasses detect:[:cls | cls name = entry className ] ifNone:[].
].
cls isNil ifTrue:[
self warn:'Oops - class is gone'.
^ self
].
entry meta ifTrue:[
cls := cls theMetaclass
].
self switchToClass:cls selector:entry selector updateHistory: false
"Modified: / 22-02-2008 / 17:17:56 / janfrog"
"Modified: / 19-09-2013 / 12:10:35 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
switchToMethod:aMethod
|orgMode pkg holder category|
"/ care for method being in another package
orgMode := self organizerMode value.
orgMode == OrganizerCanvas organizerModeProject ifTrue:[
pkg := aMethod package.
holder := self selectedProjects.
((holder value ? #()) includes:pkg) ifFalse:[
holder value:(Array with:pkg).
]
].
category := aMethod category.
(self selectedProtocolsValue contains:[:p | p notNil and:[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).
]
"Modified: / 30-08-2011 / 16:03:17 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
switchToSearchItemMatching:aMatchString
self switchToClassNameOrSelectorMatching:aMatchString
"Created: / 10-08-2006 / 18:10:36 / cg"
!
switchToSelector:aSelector
|mthd cls orgMode pkg holder|
aSelector notNil ifTrue:[
(cls := self theSingleSelectedClass) notNil ifTrue:[
mthd := cls compiledMethodAt:aSelector asSymbol.
mthd notNil ifTrue:[
"/ care for method being in another package
orgMode := self organizerMode value.
orgMode == OrganizerCanvas organizerModeProject ifTrue:[
pkg := mthd package.
holder := self selectedProjects.
((holder value ? #()) includes:pkg) ifFalse:[
holder value:(Array with:pkg).
]
].
(self selectedProtocolsValue contains:[:p | (p isNil and:[mthd category isNil]) or:[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: / 04-02-2000 / 23:20:34 / cg"
"Modified: / 05-02-2000 / 23:07:10 / cg"
"Modified: / 10-09-2013 / 14:58:03 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!NewSystemBrowser methodsFor:'private-buffers'!
removeBuffer:nr
|prevBuffer previouslyUsedBuffer newIndex state m|
state := buffers at:nr.
(m := state theSingleSelectedMethod) notNil ifTrue:[
self addToRecentlyClosedHistory:m mclass selector:m selector
].
"/ the buffer before that one
prevBuffer := nr - 1.
prevBuffer == 0 ifTrue:[
prevBuffer := nr.
].
bufferUsageOrder removeIdentical:state.
"/ the buffer used before that one
previouslyUsedBuffer := buffers identityIndexOf:(bufferUsageOrder first).
"/ which one to use prev, next or prevUsed ???
"/ newIndex := prevBuffer.
newIndex := nr.
"/ newIndex := previouslyUsedBuffer.
selectedBuffer value:(newIndex min:buffers size-1).
buffers removeIndex:nr.
bufferNameList removeIndex:nr.
state canvas destroy.
"/ oops
newIndex > buffers size ifTrue:[
selectedBuffer value:buffers size.
].
buffers size == 1 ifTrue:[
selectedBuffer value:nil.
buffers := bufferUsageOrder := nil.
bufferNameList removeAll.
]
"Modified: / 08-09-2012 / 21:17:10 / cg"
"Modified: / 02-05-2014 / 17:32:51 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
removeCurrentBuffer
self removeBuffer:(selectedBuffer value)
! !
!NewSystemBrowser methodsFor:'private-checks'!
anySpecialEditorModified
^ self showSpecialResourceEditors value and:[navigationState anySpecialEditorModified]
!
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 == SyntaxHighlighter codeAspectClassDefinition
or:[codeAspect == SyntaxHighlighter codeAspectMethod]
"Modified: / 27-07-2012 / 22:24:25 / 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 == SyntaxHighlighter codeAspectMethod
"Modified: / 27-07-2012 / 22:19:07 / cg"
!
canFileOutBee
^ self hasOnlySmalltalkClassesSelected
"Created: / 14-04-2015 / 12:48:35 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
canFileOutBinary
^ self hasOnlySmalltalkClassesSelected
!
canFileOutSIF
^ SmalltalkInterchangeFileManager notNil
and:[ self hasOnlySmalltalkClassesSelected ]
!
canFileOutVSE
^ self hasOnlySmalltalkClassesSelected
!
canFileOutXML
^ XMLCoder notNil
and:[ self hasOnlySmalltalkClassesSelected ]
!
canLoadRefactoringSupport
^ RefactoryChangeManager notNil and:[RefactoryChangeManager isLoaded not]
!
canMakePublicClass
"can make public, if selected and any selected class is private"
self selectedClassesDo:[:cls |
cls owningClass notNil ifTrue:[^ true].
].
^ false
"Created: / 23.2.2000 / 00:36:16 / cg"
"Modified: / 23.2.2000 / 00:56:09 / cg"
!
canRemoveNameSpace
"ns can be only be removed, if empty"
^ self hasEmptyNamespacesSelected
!
canRemoveNameSpaceHolder
"ns can be only be removed, if empty"
^ [ self canRemoveNameSpace ]
!
canRenameNameSpace
^ self hasSingleNameSpaceSelected
!
canRenameNameSpaceHolder
^ [ self canRenameNameSpace ]
!
canUseRefactoringParser
^ SmalltalkCodeGeneratorTool canUseRefactoringSupport
"Modified: / 31-01-2011 / 18:29:35 / cg"
!
canUseRefactoringSupport
"for now:
We cannot use refactoring support for non-smalltalk classes"
(self theSingleSelectedClass isNil
or:[ self theSingleSelectedClass programmingLanguage isSmalltalk ]) ifTrue:[
^ SmalltalkCodeGeneratorTool canUseRefactoringSupport
].
^ false
"Modified: / 31-01-2011 / 18:30:00 / cg"
!
canUseRefactoringSupportAndHasClassSelected
^ self canUseRefactoringSupport and:[self hasClassSelected]
!
hasOnlySmalltalkClassesSelected
^ (self selectedClassesValue) conform:[:cls | cls programmingLanguage isSmalltalk]
"Modified: / 28-02-2012 / 16:58:46 / cg"
!
javaMode
"/ ^ currentnamespace == JAVA
^ false
!
parseTreeSearcherAvailable
"/ rb-stuff not available ?
ParseTreeSearcher isNil ifTrue:[ ^ false ].
RBSearchRule isNil ifTrue:[ ^ false ].
^ true
! !
!NewSystemBrowser methodsFor:'private-code update'!
autoSearch:aString
"for compatibility with old browser"
self autoSearchPattern:aString
!
autoSearch:aString ignoreCase:ignoreCase
"for compatibility with old browser"
self autoSearchPattern:aString ignoreCase:ignoreCase
!
autoSearchCodePattern:codePattern
^ self autoSearchCodePatterns:(Array with:codePattern)
!
autoSearchCodePatterns:codePatterns
|searchAction codeView|
codePatterns notEmptyOrNil ifTrue:[
codeView := self codeView.
searchAction :=
[:direction :startLine :startCol :foundBlock :notFoundBlock|
self
searchForCodePatterns:codePatterns
direction:direction
startLine:(codeView cursorLine ? startLine) startCol:(codeView cursorCol ? startCol)
ifFound:[:charPos1 :charPos2 |
codeView
cursorToCharacterPosition:charPos1;
selectFromCharacterPosition:charPos1 to:charPos2
]
ifNotFound:notFoundBlock
].
navigationState autoSearchAction:searchAction.
codeView clearSearchAction. "/ searchAction
codeView setSearchPattern:nil.
]
"Modified: / 11-05-2010 / 14:13:34 / cg"
!
autoSearchPattern
^ navigationState autoSearchPattern
!
autoSearchPattern:aString
self autoSearchPattern:aString ignoreCase:false
!
autoSearchPattern:aString ignoreCase:doIgnoreCase
aString notNil ifTrue:[
self navigationState autoSearchPattern:aString; autoSearchIgnoreCase:doIgnoreCase.
self codeView setSearchPattern:aString ignoreCase:doIgnoreCase.
]
!
autoSearchPattern:aString ignoreCase:doIgnoreCaseBoolean match:doMatchBoolean
aString notNil ifTrue:[
self navigationState
autoSearchPattern:aString ignoreCase:doIgnoreCaseBoolean match:doMatchBoolean.
self codeView
setSearchPattern:aString ignoreCase:doIgnoreCaseBoolean match:doMatchBoolean.
]
!
autoSearchSelector:aSelectorOrCollectionOfSelectors ignoreCase:doIgnoreCase doMatch:doMatch
<resource: #obsolete>
self setSearchSelector:aSelectorOrCollectionOfSelectors ignoreCase:doIgnoreCase doMatch:doMatch
!
autoSearchVariable:aVariable
self autoSearchVariables:(Array with:aVariable)
!
autoSearchVariables:aCollectionOfVariables
self autoSearchVariables:aCollectionOfVariables readers:true writers:true
!
autoSearchVariables:aCollectionOfVariables readers:doReaders writers:doWriters
self setupToSearchVariables:aCollectionOfVariables readers:doReaders writers:doWriters asAutoSearch:true.
!
classDefinitionStringFor:aClass
|s|
s := '' writeStream.
(aClass isRealNameSpace) ifTrue:[
aClass fileOutDefinitionOn:s
] ifFalse:[
aClass theNonMetaclass isJavaClass ifTrue:[
| src |
src := aClass theNonMetaclass source.
src notNil ifTrue:[ ^ src ].
src := aClass theNonMetaclass sourceDecompiled.
src notNil ifTrue:[ ^ src ].
s nextPutAll: '/* ';nextPutAll: (resources string:'Source not available'); nextPutAll: ' */'.
] ifFalse:[
aClass isMeta ifTrue:[
aClass
fileOutClassInstVarDefinitionOn:s
withNameSpace:true.
] ifFalse:[
"/
"/ here, show it with a nameSpace pragma
"/ and prefer short names.
"/
"/ [
aClass
basicFileOutDefinitionOn:s
withNameSpace:true
withPackage:false
"/ ] on:Error do:[:ex |
"/ s nextPutLine:'Error while asking class for its definition:';
"/ nextPutLine:ex description;
"/ cr.
"/ thisContext fullPrintAllOn:s.
"/ ]
].
].
].
^ s contents withTabsExpanded.
"Modified: / 10-11-2006 / 17:13:54 / cg"
"Modified: / 17-02-2015 / 11:59:40 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
commentOrDocumentationStringFromClass:aClass
"the classes documentation-method's comment, or nil"
|commentOrNil isComment infoStream info|
"JV@2012-02-18: We're showing full sourcecode including
possible javadoc comments, so there is no need to display
documentation string at the end"
aClass isJavaClass ifTrue:[ ^ nil ]
.
commentOrNil := aClass commentOrDocumentationString.
isComment := (commentOrNil = aClass comment).
commentOrNil notNil ifTrue:[
commentOrNil := commentOrNil asStringCollection withoutLeadingAndTrailingBlankLines asString
].
infoStream := TextStream on:''.
"/ infoStream "cr; cr;" cr.
commentOrNil isNil ifTrue:[
infoStream nextPutLine:' no comment or documentation method found'.
] ifFalse:[
"/ nextPutLine:' Documentation:'.
infoStream nextPutLine:commentOrNil; cr.
infoStream nextPutLine:' Notice:'.
infoStream nextPutAll:' the above text has been extracted from the classes '.
infoStream nextPutLine:(isComment ifTrue:['comment.'] ifFalse:['documentation method.']).
infoStream nextPutLine:' Any change in it will be lost if you ''accept'' here.'.
infoStream nextPutAll:' To change the '.
infoStream nextPutAll:(isComment ifTrue:['comment'] ifFalse:['documentation']).
infoStream nextPutAll:', switch to the '.
infoStream nextPutAll:(isComment ifTrue:['comment'] ifFalse:['documentation method']).
infoStream nextPutLine:' and ''accept'' any changes there.'.
].
"/ infoStream cr.
info := String streamContents:[:s |
aClass programmingLanguage writeComment:(infoStream contents) on:s
].
info := info emphasizeAllWith:UserPreferences current commentEmphasisAndColor.
^ info
!
searchForCodePattern:codePattern direction:direction startLine:startLine startCol:startCol
ifFound:foundBlock ifNotFound:notFoundBlock
"used as autosearchAction, if showing the result of a code-pattern search.
Does a language-aware search."
^ self
searchForCodePatterns:(Array with:codePattern)
direction:direction startLine:startLine startCol:startCol
ifFound:foundBlock ifNotFound:notFoundBlock
!
searchForCodePatterns:codePatterns direction:direction
startLine:startLine startCol:startCol
ifFound:foundBlock ifNotFound:notFoundBlock
"used as autosearchAction, if showing the result of a code-pattern search.
Does a language-aware search."
|searcher|
self parseTreeSearcherAvailable ifFalse:[ ^ self ].
searcher := ParseTreeSearcher new.
searcher
matchesAnyOf: codePatterns
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
"used as autosearchAction, if showing the result of a senders-search.
Does a language-aware search."
|searcher|
self parseTreeSearcherAvailable ifFalse:[ ^ self ].
doMatch ifTrue:[
(aSelectorOrCollectionOfSelectors isSymbol or:[aSelectorOrCollectionOfSelectors isString]) ifTrue:[
searcher := ParseTreeSearcher allMessageSendsMatching:aSelectorOrCollectionOfSelectors ignoreCase:ignoreCase.
] ifFalse:[
searcher := ParseTreeSearcher allMessageSendsMatchingAny:aSelectorOrCollectionOfSelectors ignoreCase:ignoreCase.
].
] ifFalse:[
(aSelectorOrCollectionOfSelectors isSymbol or:[aSelectorOrCollectionOfSelectors isString]) ifTrue:[
searcher := ParseTreeSearcher allMessageSendsTo:aSelectorOrCollectionOfSelectors ignoreCase:ignoreCase.
] ifFalse:[
searcher := ParseTreeSearcher allMessageSendsToAny:aSelectorOrCollectionOfSelectors ignoreCase:ignoreCase.
].
].
^ self
searchUsingSearcher:searcher
direction:direction
startLine:startLine startCol:startCol
ifFound:foundBlock ifNotFound:notFoundBlock.
!
searchForVariable:aVariableNameOrCollectionOfVariableNames direction:direction
startLine:startLine startCol:startCol
readers:searchReaders writers:searchWriters
ifFound:foundBlock ifNotFound:notFoundBlock
"used as autosearchAction, if showing the result of a variable-search.
Does a language-aware search."
|searcher namesWithAndWithoutNameSpace|
self parseTreeSearcherAvailable ifFalse:[ ^ self ].
namesWithAndWithoutNameSpace := Set withAll:aVariableNameOrCollectionOfVariableNames.
aVariableNameOrCollectionOfVariableNames do:[:each |
(each includesString:'::') ifTrue:[
namesWithAndWithoutNameSpace add:(each copyFrom:(each lastIndexOf:$:)+1).
]
].
searchReaders ifTrue:[
searchWriters ifTrue:[
searcher := ParseTreeSearcher allReferencesToAnyVariableIn:namesWithAndWithoutNameSpace.
] ifFalse:[
searcher := ParseTreeSearcher allReadsOfAnyVariableIn:namesWithAndWithoutNameSpace.
].
] ifFalse:[
searchWriters ifTrue:[
searcher := ParseTreeSearcher allModificationsOfAnyVariableIn:namesWithAndWithoutNameSpace.
] ifFalse:[
self error:'missing search criteria'
].
].
^ self
searchUsingSearcher:searcher direction:direction
startLine:startLine startCol:startCol
ifFound:foundBlock ifNotFound:notFoundBlock.
!
searchUsingSearcher:searcher direction:direction
startLine:startLine startCol:startCol
ifFound:foundBlock ifNotFound:notFoundBlock
"common helper, used by autosearchAction.
Does a language-aware search."
|source codeTree nodes searchStartPos prevNode|
RBParser isNil ifTrue:[^ self].
source := self codeView contents.
codeTree := RBParser
parseSearchMethod:source
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
!
setSearchSelector:aSelectorOrCollectionOfSelectors ignoreCase:doIgnoreCase doMatch:doMatch
"setup the codeView so it auto-searches for a message send"
|searchAction|
aSelectorOrCollectionOfSelectors notNil ifTrue:[
searchAction :=
[:direction :startLine :startCol :foundBlock :notFoundBlock|
|codeView|
codeView := self codeView.
self
searchForSelector:aSelectorOrCollectionOfSelectors direction:direction
startLine:(startLine ? codeView cursorLine) startCol:(startCol ? codeView cursorCol)
ignoreCase:doIgnoreCase doMatch:doMatch
ifFound:
[:charPos1 :charPos2 |
codeView
cursorToCharacterPosition:charPos1;
selectFromCharacterPosition:charPos1 to:charPos2
]
ifNotFound:notFoundBlock
].
self navigationState autoSearchAction:searchAction.
self codeView
clearSearchAction; "/ searchAction
setSearchPattern:nil.
]
!
setupToSearchVariables:aCollectionOfVariables readers:doReaders writers:doWriters asAutoSearch:asAutoSearch
"setup the search action to search for a variable or setof variables"
|searchAction|
aCollectionOfVariables notEmptyOrNil 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])
].
self navigationState autoSearchAction:searchAction.
self codeView searchAction:searchAction
]
!
showClassAspect:codeAspect forClass:aClass
|codeView theNonMetaclass|
codeView := self codeView.
theNonMetaclass := aClass theNonMetaclass.
codeAspect == #classOwnershipGraph ifTrue:[
self showClassOwnershipGraph:theNonMetaclass.
codeView hideCursor.
^ self
].
codeView showCursor.
codeView isCodeView2 ifTrue:[
codeView enableAllServices
].
codeAspect == #classComment ifTrue:[
self showClassComment:theNonMetaclass.
^ self.
].
codeAspect == #classHierarchy ifTrue:[
self showClassHierarchy:theNonMetaclass.
^ self.
].
codeAspect == #classRepositorySummary ifTrue:[
self showClassRepositorySummary:theNonMetaclass.
^ self.
].
((codeAspect == #primitiveDefinitions)
or:[ (codeAspect == #primitiveFunctions)
or:[ (codeAspect == #primitiveVariables) ]]) ifTrue:[
self showClassPrimitive:codeAspect class:theNonMetaclass.
^ self.
].
"/ self codeAspect: #classDefinition.
self setAcceptActionForClass.
self showClassDefinition:aClass.
!
showClassComment:aClass
"show the classes comment.
This is NOT the string extracted from the documentaion method,
but the old-style (ST80-style) comment.
ST/X does not use those, as the eat up memory (they are in-image strings),
whereas the documentation method's comment is only in the sourcefile, and
loaded on demand.
Thus, the ST80 comment will only be shown for classes which have been loaded from
ST80/Squeak source code."
|code codeView|
self codeAspect:#classComment.
self setAcceptActionForClassComment.
"/ self selectedMethods value:nil.
"/ self selectedProtocols value:nil.
aClass notNil ifTrue:[
aClass isLoaded ifFalse:[
code := 'Class is not loaded.'.
] ifTrue:[
code := aClass comment.
].
codeView := self codeView.
codeView contents:code.
codeView modified:false.
navigationState realModifiedState:false.
]
"Modified: / 8.11.2001 / 23:08:31 / cg"
!
showClassDefinition:aClass
|definition highlighter info text|
self codeAspect:SyntaxHighlighter codeAspectClassDefinition.
self setAcceptActionForClass.
aClass isNil ifTrue:[ ^ self ].
(aClass isClass or:[aClass isMetaclass]) ifFalse:[ ^ self ].
definition := self classDefinitionStringFor:aClass.
"JV@2012-07-05: Some class definitions could be quite big, such as Java classes.
Don't format the code here, do it in background instead..."
definition size < 2500 ifTrue:[
self doSyntaxColoring value ~~ false ifTrue:[
highlighter := self syntaxHighlighterForClass: aClass.
highlighter notNil ifTrue:[
definition := highlighter formatClassDefinition:definition in: aClass.
]
].
].
self showCode:definition.
self normalLabel.
aClass isLoaded ifTrue:[
"/ continue fetching the documentation,
"/ which may take longer, if the source must be fetched
"/ from the repository.
"
add documentation as a comment, if there is any
"
info := self commentOrDocumentationStringFromClass:aClass.
text := definition.
info notNil ifTrue:[
text := definition,(Character cr),info.
].
self codeHolder setValue:text.
self codeView notNil ifTrue:[
self codeView setContents:text
].
].
self updatePackageInfoForClass:aClass.
"Modified: / 27-07-2012 / 22:26:12 / cg"
"Modified: / 27-04-2014 / 22:36:00 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
showClassDocumentation
"updates the generated HTML documentation"
|cls text|
"/ show classes documentation
cls := self theSingleSelectedClass.
cls notNil ifTrue:[
cls isLoaded ifFalse:[
text := 'Class is not loaded.'.
] ifTrue:[
text := HTMLDocGenerator htmlDocOf:cls.
].
self classDocumentationHolder value:text.
] ifFalse:[
self showNothing.
].
"Modified: / 01-03-2007 / 20:58:34 / cg"
!
showClassHierarchy:aClass
|code codeView s indent|
self codeAspect:#classHierarchy.
self setAcceptActionForNothing.
aClass notNil ifTrue:[
s := '' writeStream.
indent := 0.
aClass withAllSuperclasses reverseDo:[: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"
!
showClassOwnershipGraph:aClass
|mgr log graph first numLinesByAuthor lineInfo
prevAuthor prevRevision codeView startTime
indicator progress allRevisions numRevisionsDone stop|
self codeAspect:#classOwnershipGraph.
self setNoAcceptAction.
(codeView := self codeView) isCodeView2 ifTrue:[
codeView disableAllServices
].
codeView list:#().
aClass isNil ifTrue:[ ^ self ].
(aClass isClass or:[aClass isMetaclass]) ifFalse:[ ^ self ].
aClass isLoaded ifFalse:[^ self].
mgr := aClass sourceCodeManager.
[
[
self withWaitCursorDo:[
startTime := Timestamp now.
progress := 0 asValue.
self activityNotification:'Fetching version info for ownership graph'.
log := mgr
revisionLogOf:aClass
fromRevision:nil toRevision:nil finishAfter:nil.
graph := OwnershipGraph new.
first := true.
numRevisionsDone := 0.
allRevisions := log at:#revisions.
stop := false.
allRevisions reverseDo:[:eachRevision |
|author date revision codeStream codeLines diffs deltaSummary nDelta|
author := eachRevision at:#author.
author isNil ifTrue:[self halt].
revision := eachRevision at:#revision.
date := eachRevision timestamp.
"/ date := Timestamp readFrom:(eachRevision at:#date).
stop ifTrue:[ ^ self ].
first ifTrue:[
codeStream := mgr getSourceStreamFor:aClass revision:revision.
codeLines := codeStream contents.
codeStream close.
numLinesByAuthor := Bag new.
numLinesByAuthor add:author withOccurrences:codeLines size.
first := false.
] ifFalse:[
lineInfo isNil ifTrue:[
lineInfo := OrderedCollection new:(numLinesByAuthor size) withAll:prevAuthor.
].
"/ can skip the expensive diff info (and use the log's summary),
"/ iff the author is the same as the previous author, and he completely authored the previous version
((author = prevAuthor)
and:[ (numLinesByAuthor occurrencesOf:author) = numLinesByAuthor size "/ prev version completely by prev author
and:[ (deltaSummary := eachRevision at:#numberOfChangedLines ifAbsent:nil) notEmptyOrNil
and:[
nDelta := deltaSummary asCollectionOfWords collect:[:w | Number readFrom:w onError:nil] as:OrderedCollection.
(nDelta includes:nil) not
]]])
ifTrue:[
nDelta := nDelta sum.
nDelta > 0 ifTrue:[
lineInfo add:author withOccurrences:nDelta
] ifFalse:[
nDelta < 0 ifTrue:[
lineInfo removeLast:nDelta negated
]
]
] ifFalse:[
"/ ask for the diff-list and update the auther-per-line info
"/ self activityNotification:('diffing %1 against %2' bindWith:prevRevision with:revision).
diffs := mgr
diffListFor:aClass fileName:nil directory:nil module:nil
revision1:prevRevision revision2:revision.
[
|state delta countOld countNew linesOld linesNew|
delta := 0.
countOld := countNew := 0.
"/ linesOld := OrderedCollection new.
"/ linesNew := OrderedCollection new.
state := #initial.
diffs do:[:entry |
|s nr1a nr1b op nr2a nr2b|
state ~~ #initial ifTrue:[
state == #changed1 ifTrue:[
(entry startsWith:'<') ifTrue:[
"/ linesOld add:entry.
countOld := countOld - 1.
] ifFalse:[
self assert:(countOld == 0).
(entry startsWith:'---') ifTrue:[
state := #changed2
] ifFalse:[
self halt.
state := #initial.
]
]
] ifFalse:[
state == #changed2 ifTrue:[
(entry startsWith:'>') ifTrue:[
"/ linesNew add:entry.
countNew := countNew - 1.
] ifFalse:[
self assert:(countNew == 0).
entry first isDigit ifFalse:[
self halt
].
state := #initial.
]
] ifFalse:[
state == #added ifTrue:[
(entry startsWith:'>') ifTrue:[
"/ linesNew add:entry.
countNew := countNew - 1.
] ifFalse:[
self assert:(countNew == 0).
entry first isDigit ifFalse:[
self halt
].
state := #initial.
]
] ifFalse:[
state == #deleted ifTrue:[
(entry startsWith:'<') ifTrue:[
"/ linesOld add:entry.
countOld := countOld - 1.
] ifFalse:[
self assert:(countOld == 0).
entry first isDigit ifFalse:[
self halt
].
state := #initial.
]
] ifFalse:[
self halt.
]
]
]
]
].
"entry is of the form <nr> <op> <offs> [<offs2>]"
state == #initial ifTrue:[
self assert:(entry first isDigit).
s := ReadStream on:entry.
nr1a := nr1b := Integer readFrom:s.
s peek == $, ifTrue:[
s next.
nr1b := Integer readFrom:s
].
op := s next.
nr2a := nr2b := Integer readFrom:s.
s peek == $, ifTrue:[
s next.
nr2b := Integer readFrom:s
].
op == $c ifTrue:[
state := #changed1.
countOld := (nr1b - nr1a + 1).
countNew := (nr2b - nr2a + 1).
lineInfo removeFromIndex:nr1a+delta toIndex:nr1a+delta+countOld-1.
lineInfo addAll:(Array new:countNew withAll:author) afterIndex:nr1a+delta.
delta := delta - countOld + countNew.
] ifFalse:[
(op == $a) ifTrue:[
state := #added.
countNew := (nr2b - nr2a + 1).
lineInfo addAll:(Array new:countNew withAll:author) afterIndex:nr1a+delta.
delta := delta + countNew.
] ifFalse:[
op == $d ifTrue:[
state := #deleted.
countOld := (nr1b - nr1a + 1).
lineInfo removeFromIndex:nr1a+delta toIndex:nr1a+delta+countOld-1.
delta := delta - countOld.
] ifFalse:[
self halt:'unexpected diff entry'.
]
]
].
].
]
] value.
].
numLinesByAuthor := lineInfo asBag.
].
graph addRevision:revision author:author date:date lineOwnership:numLinesByAuthor.
prevAuthor := author.
prevRevision := revision.
numRevisionsDone := numRevisionsDone + 1.
progress value:(numRevisionsDone / allRevisions size).
indicator isNil ifTrue:[
(Timestamp now secondDeltaFrom: startTime) > 10 ifTrue:[
indicator := ProgressIndicator
progressOpenOn:progress
title:'Fetching deltas'
label:('Fetching %1 revisions takes some time...' bindWith:allRevisions size).
"/ indicator runs another thread
(indicator topView addAbortButton)
label:'Stop this';
action:[
stop := true.
self showInfo:'One moment, please...'.
indicator topView label:'Stopping...'
].
].
].
].
graph generateFormFor:codeView.
codeView list:(Array with:graph).
]
] ensure:[
self activityNotification:nil.
indicator notNil ifTrue:[ indicator topView close ].
].
] ifCurtailed:[
self showClassDefinition:aClass.
indicator := nil.
]
!
showClassPrimitive:aspect class:aClass
|primCode codeView|
self codeAspect:aspect.
aClass isLoaded ifFalse:[
primCode := 'Class is not loaded'.
self setAcceptActionForNothing.
] ifTrue:[
aspect == #primitiveDefinitions ifTrue:[
primCode := aClass primitiveDefinitionsStringOrDefault.
] ifFalse:[
aspect == #primitiveFunctions ifTrue:[
primCode := aClass primitiveFunctionsStringOrDefault.
] ifFalse:[
aspect == #primitiveVariables ifTrue:[
primCode := aClass primitiveVariablesStringOrDefault.
] ifFalse:[
self error:'unknown primitive aspect'.
]
]
].
self setAcceptAction:[:theCode | self doAcceptClassPrimitive:theCode].
].
codeView := self codeView.
codeView contents:primCode.
codeView modified:false.
navigationState realModifiedState:false.
!
showClassPrimitiveDefinitions:aClass
self showClassPrimitive:#primitiveDefinitions class:aClass
!
showClassPrimitiveVariables:aClass
self showClassPrimitive:#primitiveVariables class:aClass
!
showClassRepositorySummary:aClass
"shows summary info from the repository:
current version,
newest in repository,
original checkin date (i.e. age),
tags on the current version
maybe more in the future
"
|info scm codeView|
self codeAspect:#classRepositorySummary.
self setAcceptActionForNothing.
aClass isNil ifTrue:[^ self].
info := String streamContents:[:s |
(scm := aClass sourceCodeManager) isNil ifTrue:[
s nextPutLine:'Class has source code manager defined'.
(scm := SourceCodeManager) isNil ifTrue:[
s nextPutLine:'No default source code manager is defined'.
].
].
scm notNil ifTrue:[
self withWaitCursorDo:[
scm printClassRepositorySummaryForClass:aClass on:s
].
]
].
codeView := self codeView.
codeView contents:info.
codeView modified:false.
navigationState realModifiedState:false.
!
showClassVarInfoFor:var in:aClass value:val
|text valText lines|
text := '%1 (%2) : %3'.
val isNumber ifTrue:[
text := '%1 (%2) : %3 (%4)'.
valText := val printString.
] ifFalse:[
val isLiteral ifTrue:[
text := '%1 (%2) : %4'.
lines := val storeString asCollectionOfLines.
valText := lines first contractTo:30.
valText := valText copy.
valText replaceAllForWhich:[:ch | ch isControlCharacter] with:$?.
lines size > 1 ifTrue:[
valText := valText , '...'.
].
] ifFalse:[
val isCollection ifTrue:[
text := '%1 (%2) : %3 (%4)'.
valText := val isEmpty
ifTrue:['empty']
ifFalse:['size: ' , val size printString].
] ifFalse:[
val isBehavior ifTrue:[
(val isSubclassOf:Error) ifTrue:[
text := '%1 (%2) : %4 (an Error subclass)'.
valText := val name.
] ifFalse:[
(val isSubclassOf:Exception) ifTrue:[
text := '%1 (%2) : %4 (an Exception subclass)'.
valText := val name.
] ifFalse:[
text := '%1 (%2) : %4'.
valText := val name.
]
]
]
]
].
].
text := text
bindWith:var allBold
with:(aClass name)
with:(val class nameWithArticle)
with:valText.
self showInfo:text.
!
showCode:aString
"/Do not scroll to the top if the code is already displayed!!"
self showCode:aString scrollToTop:(self codeView contents string ~= aString)
"Modified: / 01-03-2000 / 11:38:33 / cg"
"Modified: / 10-09-2013 / 01:33:04 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
showCode:codeString scrollToTop:doScrollToTop
|codeView code shownCode prevCode|
code := codeString.
(codeView := self codeView) notNil ifTrue:[
codeView numberOfLines < 1000 ifTrue:[
shownCode := codeView contents.
].
prevCode := (shownCode ? '') asString.
(codeView modified
or:[ prevCode isNil
or:[ code isNil
or:[ (prevCode asText sameStringAndEmphasisAs:(code ? '') asString asText) not
or:[(prevCode withTabsExpanded sameStringAndEmphasisAs: code withTabsExpanded) not]]]]) ifTrue:[
code = 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:code.
"/ code = shownCode ifFalse:[
codeView setContents:code.
"/ ]
] ifFalse:[
self codeHolder value:code.
].
doScrollToTop ifTrue:[
codeView cursorHome.
]
]
] ifFalse:[
code = 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:code.
"/ codeView setContents:aString.
] ifFalse:[
self codeHolder value:code.
]
].
"Created: / 01-03-2000 / 11:38:07 / cg"
"Modified: / 04-08-2011 / 23:23:04 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
showFullClassDefinition:aClass
|definition|
aClass isLoaded ifFalse:[
self showClassDefinition:aClass.
^ self.
].
definition := aClass source.
self showCode:definition.
self codeAspect:SyntaxHighlighter codeAspectClassDefinition.
self normalLabel.
"Modified: / 27-07-2012 / 22:26:15 / cg"
!
showFullClassSource
|cls|
"/ show full classes source - set accept action for fileIn
cls := self theSingleSelectedClass.
cls notNil ifTrue:[
self setAcceptActionForClass.
self showFullClassDefinition:cls.
] ifFalse:[
self showNothing.
].
navigationState modified:false.
navigationState realModifiedState:false.
"Modified: / 01-03-2007 / 20:58:37 / cg"
!
showMethodsCode:mthd
self showMethodsCode:mthd scrollToTop:true
"Modified: / 1.3.2000 / 11:39:14 / cg"
!
showMethodsCode:mthd scrollToTop:doScrollToTop
|code codeView doAutoFormat doSyntaxColoring doUpdateCode prevMthd doShowFullClassSource |
doAutoFormat := self doAutoFormat value and:[RBFormatter notNil and:[mthd programmingLanguage isSmalltalk]].
doShowFullClassSource := self navigationState isFullClassSourceBrowser
or:[mthd isJavaMethod and:[JavaMethod showFullSource]].
doUpdateCode := true.
codeView := self codeView.
self assert:codeView notNil.
code := self sourceOfMethod:mthd.
"if there are no sources, there is a hint to the user.
consisting only of a comment (see #sourceOfMethod) which cannot be parsed as a method"
(code isText or:[code firstOrNil = $"]) ifTrue:[
"/ Already done or not eligible to be formatted...
doSyntaxColoring := false.
] ifFalse:[
"/Do no coloring here if CodeView2 is used,
"/since CodeView2 itself cares about the coloring!!
"/Not working correctly -> do the coloring until fixed in CodeView2
"/JV: Then make a bug report because otherwise it won't be
"/ ever fixed.
"(UserPreferences current useCodeView2In: #Browser)"false ifTrue:[
doSyntaxColoring := code size < 2000
] ifFalse:[
doSyntaxColoring := self doSyntaxColoring value == true.
].
].
doAutoFormat ifTrue:[
Error catch:[
code := RBFormatter format:code
].
].
doShowFullClassSource ifTrue:[
"As whole class source code is shown,
there is no need to set codeview's content if previous method
belonged to the same class. Code is already shown, we need only
to scrool to it..."
"hmm...hmm...how implement it in a better, more generic way?"
mthd isSynthetic not ifTrue:[
prevMthd := navigationState lastMethodShownInCodeView.
prevMthd notNil ifTrue:[
doUpdateCode :=
prevMthd isSynthetic
or:[mthd mclass ~~ prevMthd mclass "/ method is for different class, have to update code
or:[mthd class ~~ prevMthd class "/ method is for different kind, be safe and update code
or:[codeView contents ~= code]]]
] ifFalse:[
"/ If the class definition is shown for the very same class,
"/ do not update the code
| c |
doUpdateCode :=
mthd isJavaMethod
and:[(c := self theSingleSelectedClass) notNil and:[c theNonMetaclass == mthd mclass]]
].
].
].
doUpdateCode ifTrue:[
doSyntaxColoring ifTrue:[
"/ immediate coloring, if code is not too large;
"/ otherwise, do it in the background.
code size < 2000 " 10000 " ifTrue:[
Error handle:[:ex |
Error isHandled ifTrue: [ ex reject ] "/ PS: Sigh, we need to see/handle the error when testing it
ifFalse:[
Transcript showCR:'error in syntaxHighlighter: ',ex description
]
] do:[
code := self syntaxHighlightedCodeFor:code method:mthd.
].
] ifFalse:[
self enqueueDelayedStartSyntaxHighlightProcess.
].
[
codeView modifiedChannel removeDependent:self.
codeView modified:false.
self showCode:code scrollToTop:doScrollToTop.
] ensure:[
codeView modifiedChannel addDependent:self.
]
] ifFalse:[
self showCode:code scrollToTop:doScrollToTop.
].
].
navigationState lastMethodShownInCodeView: mthd.
"/ scroll, for file-based classes (java, ruby, etc.)
doShowFullClassSource ifTrue:[
mthd sourceLineNumber ~~ 1 ifTrue:[
doScrollToTop ifTrue:[ "/ifFalse:[
codeView scrollToLine:mthd sourceLineNumber
]
].
].
self codeAspect:(code ifNil:[nil] ifNotNil:[SyntaxHighlighter codeAspectMethod]).
self normalLabel.
self updatePackageInfoForMethod:mthd.
"Created: / 01-03-2000 / 11:38:57 / cg"
"Modified: / 27-07-2012 / 22:18:18 / cg"
"Modified: / 11-03-2014 / 11:25:51 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified (comment): / 22-11-2021 / 12:27:47 / Patrik Svestka <patrik.svestka@gmail.com>"
!
showNothing
self setAcceptActionForNothing.
self showCode:nil.
self codeAspect:nil.
self normalLabel.
"Modified: / 01-03-2007 / 20:58:30 / cg"
!
showVersionDiff
|ownerClass cls diffApp info mgr sourceInfo packageDir moduleDir classFileName|
diffApp := self navigationState versionDiffApplication.
"/ show version differences against repository
cls := self theSingleSelectedClass.
cls notNil ifTrue:[
cls := cls theNonMetaclass.
(ownerClass := cls topOwningClass) isNil ifTrue:[ownerClass := cls].
mgr := SourceCodeManagerUtilities sourceCodeManagerFor:ownerClass.
info := 'Package: ' , ownerClass package.
"/ (mgr checkForExistingContainerForClass:ownerClass) ifFalse:[
"/ info := info , ' not in repository (?)'
"/ ] ifTrue:[
info := info , ' Version: ' , (ownerClass revision ? 'no-version').
info := info , ' Repository: ' , (ownerClass sourceCodeManager newestRevisionOf:ownerClass).
info := info , ' Location: '.
sourceInfo := mgr sourceInfoOfClass:ownerClass.
sourceInfo notNil ifTrue:[
moduleDir := mgr moduleFromSourceInfo:sourceInfo.
packageDir := mgr directoryFromSourceInfo:sourceInfo.
classFileName := mgr containerFromSourceInfo:sourceInfo.
info := info , ' ' , (moduleDir ? '???').
info := info , '/' , (packageDir ? '???').
info := info , '/' , (classFileName ? '???').
].
"/ ].
] ifFalse:[
info := 'Please select a single class to see the diffs.'
].
diffApp setupForClass:cls againstVersion:nil. "/ #newest
self classesProjectInfoHolder value:info.
self setAcceptActionForNothing.
self normalLabel.
"Modified: / 12-06-2012 / 14:27:47 / cg"
!
sourceCodeManagerOfClass:aClass
|nonMetaclass sourceCodeManager|
nonMetaclass := aClass theNonMetaclass.
nonMetaclass isLoaded ifFalse:[
^ nil
].
"/ hack:
"/ to prevent JAVA-bridge to forward those messages, we check for the presence first,
"/ instead of using perform:ifNotUnderstood:
(nonMetaclass respondsTo:#sourceCodeManagerForSourceAccess) ifTrue:[
sourceCodeManager := nonMetaclass sourceCodeManagerForSourceAccess.
sourceCodeManager notNil ifTrue:[ ^ sourceCodeManager].
].
(nonMetaclass respondsTo:#sourceCodeManagerFromBinaryRevision) ifTrue:[
sourceCodeManager := nonMetaclass sourceCodeManagerFromBinaryRevision.
sourceCodeManager notNil ifTrue:[ ^ sourceCodeManager].
].
(nonMetaclass respondsTo:#sourceCodeManager) ifTrue:[
sourceCodeManager := nonMetaclass sourceCodeManager
].
^ sourceCodeManager
"Modified: / 03-12-2011 / 21:48:44 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 15-01-2012 / 00:15:05 / cg"
!
sourceOfMethod:mthd
|code|
code := mthd source.
code notNil ifTrue:[ ^ code].
"/ wrong: even if there is no source, we
"/ should be able to type in something and accept
"/ 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.
"'.
!
updatePackageInfoBarIfSourceCodeManagersDoesNotMatchForClass: aClass
"Show a warning in package info bar if configured source code manager
does not match the source code manager for source access"
| cls cnfManager srcManager color showInfoButton |
navigationState packageInfoButton isNil ifTrue:[
"JV@2011-10-03: When a browser is embedded in the inspector,
this method is called before the view is set. As a workaround,
return here"
^self.
].
color := Label defaultBackgroundColor.
showInfoButton := false.
(aClass notNil and:[aClass isLoaded]) ifTrue:[
cls := aClass.
[ cls isPrivate ] whileTrue:[cls := cls owningClass].
"For libbasic without #sourceCodeManagerFromBinaryRevision..."
(cls respondsTo: #sourceCodeManagerFromBinaryRevision) ifTrue:[
cnfManager := cls sourceCodeManager.
srcManager := cls sourceCodeManagerFromBinaryRevision.
cnfManager ~~ srcManager ifTrue:[
"Color yellow lighter"
color := (Color red:100.0 green:100.0 blue:54.5464255741207).
showInfoButton := true.
navigationState packageInfoButton action:
[self
informUserAboutPackage: cls package
configuredManager: cnfManager
sourceManager: srcManager
]
]
]
].
navigationState packageInfoButton isVisible: showInfoButton.
navigationState packageInfoBackgroundColorHolder value: color.
"Created: / 03-10-2011 / 13:54:14 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
updatePackageInfoForClass:aClass
|cls packageLabel loadInfo revisionInfo sourceCodeManager sourceCodeManagerName revision lastUser|
(aClass notNil and:[aClass isClass or:[aClass isMetaclass]]) ifTrue:[
"/ packageLabel := 'Base: ' , (aClass package ? '?').
cls := aClass theNonMetaclass.
packageLabel := (aClass package ? '?') asString allBold.
aClass isLoaded ifTrue:[
sourceCodeManager := self sourceCodeManagerOfClass:aClass.
sourceCodeManager notNil ifTrue:[
sourceCodeManagerName := sourceCodeManager managerTypeNameShort , ' '.
revisionInfo := cls revisionInfoOfManager:sourceCodeManager.
] ifFalse:[
sourceCodeManagerName := ''.
revisionInfo := cls revisionInfo.
].
(revisionInfo notNil and:[(revision := revisionInfo symbolicVersionName "revision") notNil]) ifTrue:[
lastUser := ' ',(revisionInfo user ? '').
] ifFalse:[
revision := cls revision.
lastUser := ''.
].
loadInfo := ' [%1%2%3]' bindWith: sourceCodeManagerName with:(revision ? 'no revision') with:lastUser.
aClass wasAutoloaded ifTrue:[
loadInfo := loadInfo , ' {Auto}'.
].
] ifFalse:[
loadInfo := ' {Unloaded}'.
].
packageLabel := packageLabel , loadInfo.
"/ packageLabel := packageLabel,' (Base)'.
].
self updatePackageInfoBarIfSourceCodeManagersDoesNotMatchForClass: cls.
navigationState packageLabelHolder value:packageLabel.
"Modified: / 06-10-2011 / 09:34:26 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 22-11-2011 / 16:19:18 / cg"
"Modified: / 23-03-2023 / 17:24:11 / Jan Vrany <jan.vrany@labware.com>"
!
updatePackageInfoForMethod:aMethod
"update the info-label to show the selected method's version info"
|mpkg info info2 mClass revision sourceCodeManager sourceCodeManagerInfo prjDef scmInfo extensionOrNot|
aMethod isNil ifTrue:[
^ self updatePackageInfoForClass:self theSingleSelectedClass.
].
mClass := aMethod mclass.
mClass isNil ifTrue:[
info := 'Unassigned'
] ifFalse:[
mpkg := aMethod package asSymbol.
info := mpkg allBold.
extensionOrNot := ''.
(mpkg ~= mClass package) ifTrue:[
mpkg = PackageId noProjectID ifTrue:[
info2 := ' (Unassigned)'
] ifFalse:[
extensionOrNot := ' Extension'.
prjDef := ProjectDefinition definitionClassForPackage: mpkg.
prjDef notNil ifTrue:[
sourceCodeManager := self sourceCodeManagerOfClass:prjDef.
scmInfo := prjDef extensionsRevisionInfoForManager:sourceCodeManager.
scmInfo notNil ifTrue:[
revision := scmInfo revision.
]
]
].
] ifFalse:[
sourceCodeManager := self sourceCodeManagerOfClass:mClass theNonMetaclass.
revision := mClass theNonMetaclass revision printString.
].
sourceCodeManager notNil ifTrue:[
sourceCodeManagerInfo := sourceCodeManager managerTypeNameShort , ' '
] ifFalse:[
sourceCodeManagerInfo := ''.
].
revision notNil ifTrue:[
info2 := ' ['.
(ChangeSet current includesChangeForClass:mClass selector:aMethod selector) ifTrue:[
info2 := info2,'derived from '
].
info2 := info2,sourceCodeManagerInfo,revision,extensionOrNot,']'.
].
info2 notNil ifTrue:[info := info,info2].
].
mClass notNil ifTrue:[
self updatePackageInfoBarIfSourceCodeManagersDoesNotMatchForClass: mClass theNonMetaclass.
].
navigationState packageLabelHolder value:info
"Modified (format): / 25-11-2011 / 14:48:14 / cg"
"Modified: / 02-05-2014 / 17:55:53 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 23-03-2023 / 17:28:26 / Jan Vrany <jan.vrany@labware.com>"
! !
!NewSystemBrowser methodsFor:'private-dialogs'!
askForDirectoryToFileOut:title default:defaultDirOrNil
|dirName dir|
dir := defaultDirOrNil.
dir isNil ifTrue:[
dir := FileSelectionBox lastFileSelectionDirectory.
dir isNil ifTrue:[
"
this test allows a smalltalk to be built without Projects/ChangeSets
"
Project notNil ifTrue:[
dir := Project currentProjectDirectory
]
]
].
dirName := Dialog
requestDirectoryName:title
default:dir
ok:(resources string:'FileOut')
abort:(resources string:'Cancel').
dirName isEmptyOrNil ifTrue:[ ^ nil ].
FileSelectionBox lastFileSelectionDirectory:dirName.
^ dirName.
"/
"/ fileBox := FileSelectionBox
"/ title:title
"/ okText:(resources string:'FileOut')
"/ abortText:(resources string:'Cancel')
"/ action:[:fileName |dirName := fileName.].
"/
"/ dir notNil ifTrue:[
"/ fileBox directory:dir.
"/ ].
"/ fileBox selectingDirectory:true.
"/ fileBox open.
"/
"/ fileBox destroy.
"/ fileBox := nil.
"/
"/ dirName notNil ifTrue:[
"/ FileSelectionBox lastFileSelectionDirectory:dirName.
"/ ].
"/ ^ dirName
"Modified: / 23-08-2006 / 12:32:31 / cg"
!
askForMethodAndSpawnSearchTitle:title browserLabel:label searchWith:aSelectorOrBlock
searchArea:whereDefault
"convenient helper method: setup an enterBox for method browsing without text-entry.
SearchArea may be one of
#everywhere,
#currentNameSpace
#currentPackage
#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
#currentPackage
#currentClassesNameSpace
#classCategories
#classes
#classesWithPrivateClasses
#classHierarchies
#classHierarchiesWithPrivateClasses"
^ self
askForMethodAndSpawnSearchTitle:title
browserLabel:label
searchWith:[:dummyString :classes :dummyCaseIgnore :dummyMatch |
aSelectorOrBlock value:classes
]
searchWhat:#special
searchArea:whereDefault
withCaseIgnore:false
withTextEntry:false
withMatch:false
withMethodList:false
setSearchPattern:nil
!
askForMethodAndSpawnSearchTitle:title browserLabel:labelHolderOrBlock
searchWith:aSelectorOrBlock searchWhat:searchWhat searchArea:whereDefault
withCaseIgnore:withCaseIgnore setSearchPattern:setSearchPatternAction
"convenient helper method: setup an enterBox with text from codeView or selected
method for browsing based on a selector. Set action and launch box.
SearchArea may be one of
#everywhere,
#currentNameSpace
#currentPackage
#currentClassesNameSpace
#classCategories
#classes
#classesWithPrivateClasses
#classHierarchies
#classHierarchiesWithPrivateClasses"
^ self
askForMethodAndSpawnSearchTitle:title
browserLabel:labelHolderOrBlock
searchWith:aSelectorOrBlock
searchWhat:searchWhat
searchArea:whereDefault
withCaseIgnore:withCaseIgnore
withTextEntry:true
withMethodList:false
setSearchPattern:setSearchPatternAction
!
askForMethodAndSpawnSearchTitle:title browserLabel:labelHolderOrBlock
searchWith:aSelectorOrBlock searchWhat:searchWhat searchArea:whereDefault
withCaseIgnore:withCaseIgnore withTextEntry:withTextEntry
withMatch:withMatch withMethodList:withMethodList
setSearchPattern:setSearchPatternAction
"convenient common helper method for searches:
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
#currentPackage
#currentClassesNameSpace
#classCategories
#classes
#classesWithPrivateClasses
#classHierarchies
#classHierarchiesWithPrivateClasses
aSelectorOrBlock is either a search selector (to be sent to SystemBrowser, such as findMethods:...)
or a block, or a pair containing class- and methodlist search selectors.
searchWhat is a symbol such as #selector, #code etc.
"
^ self
askForMethodAndSpawnSearchTitle:title browserLabel:labelHolderOrBlock
searchWith:aSelectorOrBlock searchWhat:searchWhat searchArea:whereDefault
withCaseIgnore:withCaseIgnore withTextEntry:withTextEntry
withMatch:withMatch withMethodList:withMethodList
setSearchPattern:setSearchPatternAction
initialText:nil
!
askForMethodAndSpawnSearchTitle:title browserLabel:labelHolderOrBlock
searchWith:searchWithSpec searchWhat:searchWhat searchArea:whereDefault
withCaseIgnore:withCaseIgnore withTextEntry:withTextEntry
withMatch:withMatch withMethodList:withMethodList
setSearchPattern:setSearchPatternAction
initialText:aString
"convenient common helper method for searches:
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
#currentPackage
#currentClassesNameSpace
#classCategories
#classes
#classesWithPrivateClasses
#classHierarchies
#classHierarchiesWithPrivateClasses
aSelectorOrBlock is either a search selector (to be sent to SystemBrowser, such as findMethods:...)
or a block, or a pair containing class- and methodlist search selectors.
searchWhat is a symbol such as #selector, #code etc.
"
|dialog selectorOrBlockOrSelectorPair literalStringSearchSelectors|
selectorOrBlockOrSelectorPair := searchWithSpec.
dialog := SearchDialog new
initialText:aString;
showMetaFilter:true.
"/ very ugly hack...
searchWhat == #string ifTrue:[
selectorOrBlockOrSelectorPair size == 4 ifTrue:[
"/ the first two are for a string search,
"/ the last two for a string-in-literal search.
"/ need to clean that ugly interface up...
literalStringSearchSelectors := selectorOrBlockOrSelectorPair copyFrom:3.
selectorOrBlockOrSelectorPair := selectorOrBlockOrSelectorPair copyTo:2.
dialog withSearchStringInLiterals:true.
].
"/ dialog withSearchFreeStandingWordsOnly:true.
].
dialog
setupToAskForMethodSearchTitle:title
forBrowser:self
searchWhat:searchWhat
searchArea:whereDefault
withCaseIgnore:withCaseIgnore
withMatch:withMatch
withMethodList:withMethodList
allowFind:(self navigationState isMethodBrowser)
allowBuffer:(builder notNil)
allowBrowser:true
withTextEntry:withTextEntry.
[:restart|
dialog askThenDo:[
|classes string ignoreCase openHow match fullWordsOnly methods isMethod searchAction
keepResultList|
"/ some searches are very slow, and we do not want to research automatically
"/ (on change done in another browser).
keepResultList := (searchWhat == #string).
classes := dialog classesToSearch.
string := dialog selectorToSearch.
ignoreCase := dialog searchIgnoringCase.
openHow := dialog openHow.
match := dialog searchWithMatch.
fullWordsOnly := dialog searchFreeStandingWordsOnly.
methods := dialog methodsToSearch.
isMethod := dialog matchMethods.
self withSearchCursorDo:[
|initialList list newBrowser numFound label
selectorList selector entities arguments numArgs answer
alternativeSelector question altArguments t extraStringMsg|
(literalStringSearchSelectors notNil and:[dialog searchStringInLiterals]) ifTrue:[
selectorList := literalStringSearchSelectors.
extraStringMsg := ' (in String literals)'.
] ifFalse:[
selectorList := selectorOrBlockOrSelectorPair.
extraStringMsg := ''.
].
selectorList isArray ifTrue:[
classes notNil ifTrue:[
selector := selectorList first.
entities := classes.
] ifFalse:[
selector := selectorList second.
entities := methods.
].
numArgs := selector numArgs.
] ifFalse:[
entities := classes.
selectorList isSymbol ifTrue:[
selector := selectorList.
] ifFalse:[
selector := nil
].
numArgs := selectorList numArgs.
].
(selector notNil
and:[ (selector numArgs == 1)
and:[ (selector endsWith:'In:') or:[ selector endsWith:'inMethods:' ]]]) ifTrue:[
arguments := Array with:entities
] ifFalse:[
arguments := { string .
entities .
((selector notNil and:[selector endsWith:'isMethod:'])
ifTrue:[isMethod] ifFalse:[ignoreCase]) .
match.
fullWordsOnly
} copyTo:numArgs.
].
searchAction :=
[
|result moreResults extensionMethods arguments2|
ProgressNotification handle:[:ex |
self showInfo:('Searching... (%1%% done)%2'
bindWith:(ex progressValue truncated)
with:((Class tryLocalSourceFirst or:[UserPreferences current keepMethodSourceCode])
ifFalse:[ ' - tune this by enabling method source cache in the SCM settings dialog']
ifTrue:[''])).
ex proceed.
] do:[
selector notNil ifTrue:[
result := self class perform:selector withArguments:arguments.
] ifFalse:[
result := selectorList valueWithArguments:arguments
].
"/ sorry for this special case: when searching in a package,
"/ also search extensionMethods
dialog searchAreaSelected == #currentPackage ifTrue:[
selectorList isArray ifTrue:[
"/ findSendersOf:inMethods:ignoreCase:match:
extensionMethods := environment allExtensionsForPackage:(dialog currentPackage).
arguments2 := arguments copy.
arguments2 at:2 put:extensionMethods.
moreResults := self class perform:(selectorList at:2) withArguments:arguments2.
result := result , moreResults.
]
].
dialog metaclassesOnly ifTrue:[
result := result select:[:m | m mclass isMeta]
] ifFalse:[
dialog classesOnly ifTrue:[
result := result reject:[:m | m mclass isMeta]
].
].
dialog ignoreDocumentationMethods ifTrue:[
result := result reject:[:m | m category = 'documentation' ]
].
].
self showInfo:nil.
result
].
t := TimeDuration toRun:
[
false "classes size > 1" ifTrue:[
self
showMessage:'Searching...'
while:[
initialList := searchAction value.
]
] ifFalse:[
initialList := searchAction value.
].
].
label := labelHolderOrBlock value string.
numFound := initialList size.
numFound == 0 ifTrue:[
question := resources
stringWithCRs:label,extraStringMsg
with:((string ? '')
allBold
withColor:Color red darkened).
question := question , (resources string:' - none found.').
((selector == #findImplementors:in:ignoreCase:match:)
and:[ (arguments first numArgs == 0)
and:[
string := (arguments at:1) asMutator.
altArguments := arguments copy.
altArguments at:1 put:string.
initialList := self class perform:selector withArguments:altArguments.
numFound := initialList size.
numFound ~~ 0
]]) ifTrue:[
question := question,(resources stringWithCRs:'\\But there are %1 implementations of %2 (with colon).\Browse those ?' with:numFound with:(altArguments first)).
answer := Dialog
confirmWithCancel:question
labels:(resources array:#('Cancel' 'Search Again' 'Yes'))
default:2.
answer isNil ifTrue:[
^ self
].
answer ifFalse:[
restart value.
].
arguments := altArguments.
] ifFalse:[
answer := Dialog
confirm:question
yesLabel:(resources string:'Search Again')
noLabel:(resources string:'Cancel').
answer ifFalse:[
^ self
].
restart value.
].
].
(initialList asSet = self selectedMethodsValue asSet)
"/ (numFound == 1 and:[initialList first == self theSingleSelectedMethod])
ifTrue:[
answer := Dialog
confirmWithCancel:((resources stringWithCRs:label with:(string ? 'messages') allBold)
, '.\\' withCRs
, (resources stringWithCRs:'Only the selected method(s) found.\Browse anyway ?'))
labels:(resources array:#('Cancel' 'Search Again' 'Yes' ))
values:#(nil #again true)
default:2.
answer == nil ifTrue:[
^ self
].
answer == #again ifTrue:[
restart value.
]
].
newBrowser := self
spawnMethodBrowserForSearch:[
initialList notNil ifTrue:[
list := initialList.
keepResultList ifFalse:[ initialList := nil ].
] ifFalse:[
list := searchAction value
].
list
]
sortBy:#class
in:openHow
label:(resources string:label string with:string).
setSearchPatternAction notNil ifTrue:[
setSearchPatternAction value:newBrowser value:string value:((selector notNil and:[selector endsWith:'isMethod:']) ifTrue:[isMethod] ifFalse:[ignoreCase]) value:match.
].
newBrowser windowGroup notNil ifTrue:[
t > 5 seconds ifTrue:[
newBrowser methodListApp autoUpdateOnChange: false.
].
].
"/ Transcript show:'search time: '; showCR:t.
^ newBrowser.
].
].
] valueWithRestart.
"Modified: / 20-08-2012 / 13:26:06 / cg"
"Modified: / 04-09-2013 / 17:39:03 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
askForMethodAndSpawnSearchTitle:title browserLabel:labelHolderOrBlock
searchWith:aSelectorOrBlock searchWhat:searchWhat searchArea:whereDefault
withCaseIgnore:withCaseIgnore withTextEntry:withTextEntry
withMethodList:withMethodList setSearchPattern:setSearchPatternAction
"convenient helper method: setup an enterBox with text from codeView or selected
method for browsing based on a selector. Set action and launch box.
SearchArea may be one of
#everywhere,
#currentNameSpace
#currentPackage
#currentClassesNameSpace
#classCategories
#classes
#classesWithPrivateClasses
#classHierarchies
#classHierarchiesWithPrivateClasses"
^self
askForMethodAndSpawnSearchTitle:title
browserLabel:labelHolderOrBlock
searchWith:aSelectorOrBlock
searchWhat:searchWhat
searchArea:whereDefault
withCaseIgnore:withCaseIgnore
withTextEntry:withTextEntry
withMatch:true
withMethodList:withMethodList
setSearchPattern:setSearchPatternAction
!
askForMethodCategory:question title:boxTitle okLabel:okLabel list:someCategories initialAnswer:initialText
"convenient helper method: setup a box asking for a method category"
^ self
askForMethodCategory:question
title:boxTitle
okLabel:okLabel
list:someCategories
recentList:nil
initialAnswer:initialText
!
askForMethodCategory:question title:boxTitle okLabel:okLabel list:someCategories recentList:recentListOrNil initialAnswer:initialText
"convenient helper method: setup a box asking for a method category"
|box listView retVal shownCategories allMethodCategories|
box := self
listBoxTitle:question
okText:okLabel
list:someCategories.
box label:boxTitle.
listView := box listView.
recentListOrNil notNil ifTrue:[
box useComboBoxWithList:recentListOrNil.
].
shownCategories := someCategories.
box initialText:initialText.
box action:[:aString | aString notEmpty ifTrue:[retVal := aString] ].
box entryCompletionBlock:[:contents |
|s what best idx|
s := contents withoutLeadingSeparators.
what := self navigationState environment methodProtocolCompletion:s.
best := what first.
box contents:best.
idx := shownCategories findFirst:[:l | l startsWith:best].
idx == 0 ifTrue:[
allMethodCategories isNil ifTrue:[
allMethodCategories := environment allMethodCategories asArray sort.
].
box list:allMethodCategories.
shownCategories := allMethodCategories.
idx := shownCategories findFirst:[:l | l startsWith:best].
].
idx ~~ 0 ifTrue:[
listView selection:nil.
listView scrollToLine:idx.
].
(what at:2) size ~~ 1 ifTrue:[
self builder window beep
].
].
"/ box enterField
"/ onKey:#CursorDown
"/ leaveWith:[
"/ listView windowGroup focusView:listView byTab:true.
"/ (listView hasSelection not or:[listView lineIsVisible:listView selection]) ifFalse:[
"/ listView selectFirstVisibleLine
"/ ] ifTrue:[
"/ listView selectNext
"/ ].
"/ listView selectionValue isEmptyOrNil ifTrue:[listView selectNext].
"/ ].
box open.
^ retVal
"Created: / 29.2.2000 / 10:53:09 / cg"
!
askForMethodCategoryForAcceptInClass:cls selector:selectorOrNil
"convenient helper method: setup a box asking for a method category"
|methodCategoryListApp meta someCategories initial inheritedMethod|
methodCategoryListApp := navigationState methodCategoryListApplication.
someCategories := Set new.
meta := cls isMeta.
"/ do not include above Class if meta.
cls theNonMetaclass withAllSuperclassesDo:[:eachNonMetaClass |
|eachClass|
eachClass := eachNonMetaClass.
meta ifTrue:[eachClass := eachNonMetaClass theMetaclass].
someCategories addAll:eachClass categories.
methodCategoryListApp notNil ifTrue:[
someCategories addAll:(methodCategoryListApp additionalProtocolForClass:eachClass).
]
].
someCategories := someCategories asOrderedCollection sort.
"/ look for inherited; default to that category
selectorOrNil notNil ifTrue:[
inheritedMethod := cls lookupMethodFor:selectorOrNil.
inheritedMethod notNil ifTrue:[
initial := inheritedMethod category
]
].
initial isNil ifTrue:[
lastMethodCategory isNil ifTrue:[
initial := Compiler defaultMethodCategory "/ 'new methods' '* As yet uncategorized *'
] ifFalse:[
initial := lastMethodCategory
].
].
^ self
askForMethodCategory:'Accept in which method category ?'
title:'Methods Category'
okLabel:'Accept'
list:someCategories
initialAnswer:initial
"Created: / 29.2.2000 / 10:50:38 / cg"
"Modified: / 29.2.2000 / 10:54:26 / cg"
!
askForNameSpace:title title:boxTitle initialText:initialTextOrNil
"Ask for the new namespaces name"
^ Dialog
requestNameSpace:title
title:boxTitle
initialAnswer:initialTextOrNil
"Modified: / 11-02-2011 / 11:26:25 / cg"
!
askForProject:title
"helper for move-class-to-project and move-method-to-ptoject;
Ask for the new project (package-id)"
^ self askForProject:title initialText:(LastProjectMoves ? #('')) first
!
askForProject:title initialText:initialTextOrNil
"helper for move-class-to-project and move-method-to-ptoject;
Ask for the new project (package-id)"
^ self askForProject:title initialText:initialTextOrNil moreSuggestions:#()
"Modified: / 11-08-2006 / 13:31:45 / cg"
!
askForProject:title initialText:initialTextOrNil moreSuggestions:moreSuggestions
"helper for move-class-to-project and move-method-to-ptoject;
Ask for the new project (package-id)"
|offered already allProjects classesProjects selectedClasses selectedMethods|
allProjects := environment allPackageIDs.
selectedClasses := self selectedClassesValue.
selectedClasses notNil ifTrue:[
classesProjects := selectedClasses
collectAll:[:cls |
cls methodDictionary values
collect:[:m | m package] as:Set].
] ifFalse:[
selectedMethods := self selectedMethodsValue.
selectedMethods notEmptyOrNil ifTrue:[
classesProjects := selectedMethods
collectAll:[:mthd |
mthd mclass methodDictionary values
collect:[:m | m package ] as:Set].
] ifFalse:[
classesProjects := #()
]
].
classesProjects remove:(PackageId noProjectID) ifAbsent:nil.
classesProjects removeAllFoundIn:(moreSuggestions ? #()).
classesProjects removeAllFoundIn:(LastProjectMoves ? #()).
classesProjects := classesProjects asOrderedCollection sort.
offered := OrderedCollection new.
already := Set new.
(moreSuggestions ? #()) do:[:p |
(already includes:p) ifFalse:[ offered add:p]
].
(LastProjectMoves ? #()) do:[:p |
(already includes:p) ifFalse:[ offered add:p]
].
classesProjects do:[:p |
(already includes:p) ifFalse:[ offered add:p]
].
^ Dialog
requestProject:((resources ? self class classResources) string:title)
initialAnswer:initialTextOrNil
suggestions:offered
"Created: / 11-08-2006 / 13:31:34 / cg"
"Modified: / 28-02-2012 / 16:45:05 / cg"
!
askForSelector:title allowBuffer:allowBuffer allowBrowser:allowBrowser thenDo:aBlock
"helper for find-implementation;
Ask for the selector "
|methods selectors selector firstMethod firstSelector
box b openHow prevButton searchClass listInBox|
openHow := nil.
selectors := Set new.
methods := self selectedMethodsValue.
methods notEmptyOrNil ifTrue:[
firstMethod := methods first.
firstSelector := firstMethod selector.
].
searchClass := self theSingleSelectedClass ? self classHierarchyTopClass value.
searchClass isNil ifTrue:[
self theSingleSelectedMethod notNil ifTrue:[
searchClass := self theSingleSelectedMethod mclass
]
].
searchClass notNil ifTrue:[
searchClass withAllSuperclassesDo:[:cls |
selectors addAll:(cls methodDictionary keys copy)
]
].
selectors := selectors asOrderedCollection sort.
listInBox := selectors
collect:[:eachSel | eachSel , (' [ ' , (searchClass whichClassIncludesSelector:eachSel) name , ' ]')].
"/ UserPreferences current avoidSlowDrawingOperationsUnderWindows ifFalse:[
"/ listInBox := listInBox collect:[:eachEntry | eachEntry allItalic].
"/ ].
box := ListSelectionBox new.
box title:(resources string:title).
box list:listInBox.
box okAction:[:sel | selector := (sel upTo:$[ ) withoutSeparators asSymbol].
"/ selector := self codeView selection.
"/ selector notNil ifTrue:[
"/ selector := selector asString string
"/ ] ifFalse:[
"/ selector := firstSelector.
"/ ].
selector := self selectorToSearchFor.
selector isNil ifTrue:[
selector := firstSelector
].
box initialText:selector.
box entryCompletionBlock:[:contents |
|s what longest matching|
box topView withWaitCursorDo:[
s := contents withoutSpaces.
what := DoWhatIMeanSupport selectorCompletion:s inEnvironment:environment .
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').
box addButton:b.
b action:[
openHow := #newBuffer.
box doAccept.
box okPressed.
].
prevButton := b.
].
allowBrowser ifTrue:[
b := Button label:(resources string:'Browse').
box addButton:b.
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
"Modified (comment): / 29-08-2013 / 12:16:12 / cg"
"Modified: / 04-09-2013 / 17:40:39 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
askIfModified
"if codeView was modified, return the answer from asking question;
otherwise, return true"
^ self askIfModified:'Modifications have not been saved - please accept first.\\(or continue to forget those modifications)'
!
askIfModified:question
"if codeView was modified, return the answer from asking question;
otherwise, return true"
^ self askIfModified:question default:false
!
askIfModified:question default:default
"if codeView was modified, return the answer from asking question;
otherwise, return true"
^ self
askIfModified:question
default:default
withAccept:(self canAcceptCode)
withCompare:(self canCompareCode)
"Created: / 11.2.2000 / 10:52:28 / cg"
"Modified: / 11.2.2000 / 12:37:34 / cg"
!
askIfModified:question default:default in:aNavigationState
"if codeView was modified, return the answer from asking question;
otherwise, return true"
^ self
askIfModified:question
default:default
withAccept:(self canAcceptCode)
withCompare:(self canCompareCode)
in:aNavigationState
"Created: / 11.2.2000 / 10:52:28 / cg"
"Modified: / 11.2.2000 / 12:37:34 / cg"
!
askIfModified:question default:default withAccept:acceptOffered withCompare:compareOffered
"if codeView was not modified, return true.
If it was, return the answer from asking question, which can be
true - go on
false - cancel
#compare - open a diff-viewer on the code vs. its original
#accept - accept, then proceed
If compareOffered is true, offer the compare option.
If acceptOffered is true, offer the accept option.
Used to confirm selectionChange, closing or buffer removal when code
was modified.
question is the message to ask, or nil for a standard message."
^ self
askIfModified:question
default:default
withAccept:acceptOffered
withCompare:compareOffered
in:navigationState
!
askIfModified:question default:default withAccept:acceptOffered withCompare:compareOffered in:aNavigationState
"if codeView was not modified, return true.
If it was, return the answer from asking question, which can be
true - go on
false - cancel
If compareOffered is true, offer the compare option.
If acceptOffered is true, offer the accept option.
Used to confirm selectionChange, closing or buffer removal when code was modified.
Question is the message to ask, or nil for a standard message."
|answer labels values msg textModified specialEditorModified|
self codeView isNil ifTrue:[
"/ if in documentation browser ...
^ true
].
specialEditorModified := self anySpecialEditorModified.
"/ compare - in case its not really modified
textModified := navigationState modified and:[ self reallyModified:aNavigationState ].
(specialEditorModified not
and:[ textModified not ]) ifTrue:[
^ true
].
(compareOffered and:[ specialEditorModified not ]) ifTrue:[
acceptOffered ifTrue:[
labels := #('Cancel' 'Compare' 'Accept' 'Continue').
values := #(false #compare #accept true).
] ifFalse:[
labels := #('Cancel' 'Compare' 'Continue').
values := #(false #compare true).
]
] ifFalse:[
acceptOffered ifTrue:[
labels := #('Cancel' 'Accept' 'Continue').
values := #(false #accept true).
] ifFalse:[
labels := #('Cancel' 'Continue').
values := #(false true).
].
].
msg := question ? 'Modifications have not been saved.\\Your changes will be lost when continuing.'.
answer := OptionBox
request:(resources string:msg) withCRs
label:(resources string:'Attention')
image:(WarningBox iconBitmap)
buttonLabels:(resources array:labels)
values:values
default:default
onCancel:false.
answer == #accept ifTrue:[
"/ self halt.
specialEditorModified ifTrue:[
self doSaveInSpecialEditors
] ifFalse:[
self doAcceptCodeIn:aNavigationState.
].
^ true
].
answer == #compare ifTrue:[
self doCompareIn:aNavigationState.
^ false.
].
answer ifTrue:[
navigationState modified:false.
].
^ answer
"Modified: / 23.2.2000 / 00:02:29 / cg"
!
askIfModified:question in:aNavigationState
"if codeView was modified, return the answer from asking question;
otherwise, return true"
^ self askIfModified:question default:false in:aNavigationState
!
enterBoxForClassWithCodeSelectionTitle:title withList:listOrNil okText:okText
"convenient method: setup an enterBox with initial text taken
from the codeviews selection."
^ self class
enterBoxForClassWithCodeSelectionTitle:title
withList:listOrNil
okText:okText
forBrowser:self
!
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
^ self enterBoxForVariableSearch:title list:nil
"Modified: / 29-05-2012 / 11:59:35 / cg"
!
enterBoxForVariableSearch:title list:listOrNil
|box sel selectedVariables|
box := self enterBoxForCodeSelectionTitle:title withList:listOrNil 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
"Created: / 29-05-2012 / 11:59:21 / cg"
!
enterBoxTitle:title okText:okText label:label
"convenient method: setup enterBox (especially do the resource stuff)"
^ self class enterBoxTitle:title okText:okText label:label
!
enterBoxTitle:title withList:aListOrNil okText:okText
"convenient method: setup enterBox"
^ self class
enterBoxTitle:title withList:aListOrNil okText:okText
"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 := self class extractSelectorFrom:sel
].
].
box initialText:sel
].
^ box
!
listBoxForCodeSelectionTitle:title okText:okText
"convenient method: setup a listBox with text from codeview"
^ self listBoxForCodeSelectionTitle:title isSelector:false okText:okText
!
listBoxTitle:title okText:okText list:aList
"convenient method: setup a listBox & return it"
^ self class listBoxTitle:title okText:okText list:aList
!
searchMenuFindClassToAdd
|box title className|
title := 'class to add to list (Tab to complete or use matchPattern):'.
box := self
enterBoxForClassWithCodeSelectionTitle:title
withList:(self class visitedClassNamesHistory)
okText:'add'.
box label:(resources string:'add class to list').
box entryCompletionBlock:(DoWhatIMeanSupport classNameEntryCompletionBlock).
box action:[:aString | className := aString].
box showAtPointer.
^ className
"Modified: / 20-11-2006 / 12:22:44 / cg"
!
selectSubclassesOf:aClass
| subclasses |
subclasses := aClass subclasses asSortedCollection: [:a :b | a name < b name].
subclasses isEmpty ifTrue: [^#()].
^Dialog
chooseMultiple: 'Choose Subclasses:'
fromList: subclasses
values: subclasses
buttons: #()
values: #()
lines: 8
cancel: [nil]
! !
!NewSystemBrowser methodsFor:'private-helpers'!
anySelectedClass
"return any (the first) selected class - nil if there is none"
|sel|
sel := self selectedClassesValue.
sel size > 0 ifTrue:[^ sel first].
^ nil
"Modified: / 28-02-2012 / 16:45:01 / cg"
!
anySelectedMethod
"return any (the first) selected method - nil if there is none"
|sel|
sel := self selectedMethodsValue.
sel size > 0 ifTrue:[^ sel anElement].
^ nil
"Modified: / 28-02-2012 / 16:14:38 / cg"
!
classIfValidNonMetaClassName:aClassName
|class selectedClass ns|
aClassName isNil ifTrue:[^ nil].
class := environment classNamed:aClassName.
class isNil ifTrue:[
selectedClass := self theSingleSelectedClass.
selectedClass notNil ifTrue:[
selectedClass isPrivate ifTrue:[
class := (selectedClass owningClass privateClassesAt:aClassName).
class notNil ifTrue:[
(self confirm:(resources
string:'No class named: %1 exists (in Smalltalk).\\Do you mean the private class %1 in %2 ?'
with:aClassName allBold with:selectedClass owningClass name allBold) withCRs)
ifTrue:[
^ class
].
^ nil.
].
].
(ns := selectedClass nameSpace) isNameSpace ifTrue:[
ns ~~ Smalltalk ifTrue:[
class := ns at:aClassName.
class notNil ifTrue:[
(self confirm:(resources
string:'No class named: %1 exists (in Smalltalk).\\Do you mean the class %1 in namespace %2 ?'
with:aClassName allBold with:ns name allBold) withCRs)
ifTrue:[
^ class
].
^ nil.
].
]
].
].
self warn:'No such class: ', aClassName.
^ nil
].
class isBehavior ifFalse:[
self warn:'Not a class: ', aClassName.
^ nil
].
(class isNameSpace
and:[class ~~ Smalltalk]) ifTrue:[
self warn:'Is a nameSpace: ', aClassName.
^ nil
].
(class theNonMetaclass isNameSpace
and:[class theNonMetaclass ~~ Smalltalk]) ifTrue:[
self warn:'Is meta of a nameSpace: ', aClassName.
^ nil
].
^ class
!
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 selectedClassesValue copy.
classes size == 0 ifTrue:[
self isMethodListBrowser ifTrue:[
classes := self selectedMethodsClasses
collect:[:each| each theNonMetaclass] as:IdentitySet.
]
].
^ classes
"Modified: / 28-02-2012 / 16:48:58 / cg"
!
codePaneAndPluginView
"the current buffers codePaneAndPluginView"
^ self navigationState codePaneAndPluginView
"Created: / 22-09-2010 / 22:05:58 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
codeView
"the current buffers codeView"
^ self navigationState codeView
!
fileSuffixForClass:aClassOrNil format:formatSymbolOrNil
formatSymbolOrNil == #sif ifTrue:[
^ 'sif'.
].
formatSymbolOrNil == #xml ifTrue:[
^ 'xml'.
].
formatSymbolOrNil == #binary ifTrue:[
^ 'cls'
].
formatSymbolOrNil == #cypress ifTrue:[
^ ''.
].
formatSymbolOrNil == #vsePackage ifTrue:[
^ 'pkg'
].
formatSymbolOrNil == #beestp ifTrue:[
^ 'stp'
].
aClassOrNil notNil ifTrue:[
^ aClassOrNil sourceFileSuffix
].
^ 'st'.
!
fileSuffixForFormat:formatSymbolOrNil
^ self fileSuffixForClass:nil format:formatSymbolOrNil
!
findClassNamed:aClassName
"search through namespaces for aClassName."
|nm nameSym cls meta currentNamespace listOfNamespaces|
meta := false.
nm := aClassName.
(nm endsWith:' class') ifTrue:[
meta := true.
nm := nm copyButLast:6.
].
nameSym := nm asSymbol.
currentNamespace := self theSingleSelectedNamespace.
listOfNamespaces := self selectedNamespaces value.
currentNamespace = (BrowserList nameListEntryForALL) ifTrue:[
(cls := environment 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 := environment at:nameSym) notNil ifTrue:[
meta ifTrue:[^ cls class].
^ cls
]
].
(nm startsWith:'Smalltalk::') ifTrue:[
cls := environment classNamed:(nm withoutPrefix:'Smalltalk::').
cls notNil ifTrue:[
meta ifTrue:[^ cls class].
^ cls
]
].
^ nil
"Created: / 13.2.2000 / 21:15:29 / cg"
"Modified: / 24.2.2000 / 13:49:44 / cg"
!
findClassNamedInNameSpace:aClassName
"search through current namespaces for aClassName.
Return the class or nil, if not found."
self listOfNamespaces do:[:aNamespace |
|cls|
(cls := aNamespace at:aClassName asSymbol) notNil ifTrue:[
(cls topNameSpace == aNamespace) ifTrue:[
^ cls
]
]
].
^ nil
!
globalNameToSearchFor
"look in codeView and methodListView for a search-string when searching for globals"
|sel nSel mthd classes|
sel := self selectionInCodeView.
sel notNil ifTrue:[
(sel knownAsSymbol and:[environment 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.
^ nil.
]
]
].
].
].
"/ take selected classes name as default
(classes := self selectedClassesValue) notEmptyOrNil ifTrue:[
sel := (classes collect:[:cls | cls theNonMetaclass name]) asSortedCollection asStringWith:$|
].
sel isNil ifTrue:[
(mthd := self theSingleSelectedMethod) notNil ifTrue:[
sel := mthd mclass name
].
].
"/ "/ take last search as default
"/ sel isNil ifTrue:[
"/ sel := LastGlobalSearched
"/ ].
^ sel
"Modified: / 28-02-2012 / 16:49:25 / cg"
!
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 and:[environment == Smalltalk]) ifTrue:[
^ Array with:Smalltalk
].
currentNamespace = (BrowserList nameListEntryForALL) ifTrue:[
^ environment listOfAllNamespaces
].
^ Array with:currentNamespace
"Modified: / 24-02-2000 / 13:49:20 / cg"
"Modified: / 04-09-2013 / 17:44:37 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
newBrowserOrBufferDependingOn:openHowWanted label:labelOrNil forSpec:spec setupWith:aBlock
|brwsr openHow window|
openHow := openHowWanted.
((window := self window) notNil and:[window isApplicationSubView]) ifTrue:[
"/ I am embedded - always open as new window
openHow := #newBrowser
].
openHow == #newBrowser ifTrue:[
brwsr := self class new.
brwsr environment: (environment ? Smalltalk).
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-02-2000 / 19:15:56 / cg"
"Modified: / 18-08-2000 / 16:04:33 / cg"
"Modified: / 27-04-2014 / 12:59:10 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
noteBookView
"the current buffers noteBookView"
^ self navigationState noteBookView
"/ ^ self navigationState canvas builder findComponentAt: 'EditorNoteBook'.
"/ | editorNoteBookCanvas|
"/
"/ editorNoteBookCanvas := self navigationState canvas.
"/ editorNoteBookCanvas isNil ifTrue:[^ nil].
"/ ^ editorNoteBookCanvas superView
"/ | editorNoteBookCanvas|
"/
"/ editorNoteBookCanvas := self navigationState editorNoteBookCanvasHolder value.
"/ editorNoteBookCanvas isNil ifTrue:[^ nil].
"/ ^ editorNoteBookCanvas superView
!
reallyModified:aNavigationState
"check for modified code by comparing the source against
the codeView's contents.
That's the true modified value (in case user undid his changes,
and the displayed text is actually original"
|modified codeAspect changedSource originalSource methods classes mthd cls s1 s2|
aNavigationState modified ifFalse:[
^ false
].
(codeAspect := aNavigationState codeAspect) isNil ifTrue:[
"/ no aspect yet (i.e. there is nothing shown)
^ aNavigationState codeView modified.
].
"/ higher prio to prevent it from being changed while we convert it (by editing)
Processor activeProcess
withHigherPriorityDo:[
changedSource := aNavigationState codeView contentsAsString asStringCollection.
].
changedSource := changedSource collect:[:line | line string withoutTrailingSeparators withTabsExpanded].
changedSource := changedSource collect:[:line | line asNilIfEmpty].
[changedSource size > 0 and:[changedSource last isNil]] whileTrue:[
changedSource := changedSource copyButLast
].
changedSource := changedSource asString.
codeAspect == SyntaxHighlighter codeAspectMethod 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 copyButLast:1
].
s1 := originalSource asString.
s2 := changedSource asString.
modified := (s1 ~= s2)
] ifFalse:[
codeAspect == SyntaxHighlighter codeAspectClassDefinition 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-02-2000 / 23:47:04 / cg"
"Modified: / 27-07-2012 / 22:25:40 / 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 ~= SyntaxHighlighter codeAspectClassDefinition ifTrue:[
^ nil
].
cls := self theSingleSelectedClass.
].
node := self findNode.
node isNil ifTrue:[
(self hasClassVariableSelectedInCodeView) ifFalse:[
^ nil
].
^ self selectionInCodeView.
].
node isVariable ifFalse:[
^ nil
].
^ node name.
"Modified: / 27-07-2012 / 22:26:00 / cg"
!
selectedClassesDo:aBlock
"evaluate aBlock for each selected class."
(self selectedClassesValue) do:aBlock
"Modified: / 28-02-2012 / 16:53:49 / cg"
!
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 includeChangedPseudoCategory changedClasses|
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].
(includeChangedPseudoCategory := aCollectionOfCategories includes:(ClassCategoryList nameListEntryForChanged)) ifTrue:[
changedClasses := ChangeSet current changedClasses collect:[:cls | cls theNonMetaclass].
].
^ environment allClassesForWhich:[:aClass |
(allCategories
or:[(aCollectionOfCategories includes:aClass category)
or:[includeChangedPseudoCategory and:[changedClasses includes:aClass]]])
and:[ (nameSpaceFilter isNil or:[nameSpaceFilter includes:aClass nameSpace name])
and:[ (packageFilter isNil or:[aClass isNameSpace not and:[ packageFilter includes:aClass package]]) ]].
].
"Modified: / 10-08-2006 / 15:58:11 / cg"
!
selectedClassesInNamespaces:namespaces orAll:allNamespaces
"return a collection containing all classes in aCollectionOfNamespaces,
caring for packageFilters"
| packageFilter includeChangedPseudoCategory changedClasses|
packageFilter := navigationState packageFilter value.
(packageFilter notNil and:[packageFilter includes:BrowserList nameListEntryForALL])
ifTrue:[packageFilter := nil].
(includeChangedPseudoCategory := namespaces includes:(ClassCategoryList nameListEntryForChanged)) ifTrue:[
changedClasses := ChangeSet current changedClasses collect:[:cls | cls theNonMetaclass].
].
^ environment allClassesForWhich:[:aClass |
(allNamespaces
or:[(namespaces includes:aClass environment)
or:[includeChangedPseudoCategory and:[changedClasses includes:aClass]]])
and:[ (packageFilter isNil or:[aClass isNameSpace not and:[ packageFilter includes:aClass package]]) ].
].
"Created: / 02-04-2014 / 00:14:32 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
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 selectedClassesValue)
nonMetaDo:aBlock
ifUnloaded:unloadedBlock
ifPrivate:privateBlock
"Modified: / 28-02-2012 / 16:53:41 / cg"
!
selectedClassesWithWaitCursorDo:aBlock
"evaluate aBlock for each selected class, while showing a busy cursor."
self withWaitCursorDo:[
self selectedClassesDo:aBlock
]
!
selectedCodeComponents
| type mode |
type := self navigationState canvasType.
type == #fullBrowserSpec ifTrue:[
mode := self navigationState organizerMode value.
mode == #category ifTrue:[
^ self selectedCodeComponentsUsing: #(selectedMethods selectedProtocolMethods selectedClasses selectedCategoryClasses)
].
mode == #classHierarchy ifTrue:[
^ self selectedCodeComponentsUsing: #(selectedMethods selectedProtocolMethods selectedClasses)
].
mode == #hierarchy ifTrue:[
^ self selectedCodeComponentsUsing: #(selectedMethods selectedProtocolMethods selectedClasses)
].
mode == #hierarchy ifTrue:[
^ self selectedCodeComponentsUsing: #(selectedMethods selectedProtocolMethods selectedClasses selectedNamespaceClasses)
].
mode == #project ifTrue:[
self selectedClasses value notEmptyOrNil ifTrue:[
^ self selectedCodeComponentsUsing: #(selectedMethods selectedProtocolMethods selectedClasses)
].
].
].
type == #smallLintByRuleResultBrowserSpec ifTrue:[
^ self selectedCodeComponentsUsing: #(selectedMethods selectedClasses selectedLintRuleClasses)
].
type == #methodListBrowserSpec ifTrue:[
^ self selectedCodeComponentsUsing: #(selectedMethods)
].
"Add more..."
self breakPoint: #jv.
"/Fallback
^self selectedCodeComponentsUsing:#(selectedMethods selectedClasses).
"Modified: / 25-08-2010 / 11:22:00 / Jan Vrany <enter your email here>"
"Modified (format): / 21-12-2011 / 20:23:13 / cg"
"Modified: / 02-04-2014 / 11:04:21 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
selectedCodeComponentsUsing: selectors
| result |
selectors do:
[:selector|
(result := (self perform: selector) value)
isEmptyOrNil ifFalse:[^result]].
^#()
"Modified: / 04-08-2011 / 19:05:31 / cg"
!
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 ~= SyntaxHighlighter codeAspectClassDefinition 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.
"Modified: / 27-07-2012 / 22:26:04 / cg"
!
selectedLocalMethodClasses
"returns a set of all local classes (for all selected methods)"
|classes|
classes := Set new.
self selectedMethodsClasses
do:[:cls |
classes addAll:(cls withAllSuperclasses).
classes addAll:(cls allSubclasses).
].
^ classes
"Created: / 05-09-2006 / 10:50:48 / cg"
!
selectedMethodsDo:aBlock
"evaluate aBlock for each selected method."
self selectedMethodsValue do:aBlock
"Modified: / 28-02-2012 / 16:43:14 / cg"
!
selectedNamespaceClasses
"return a collection containing all classes affected by the namespace selection"
|selectedNamespaces allNamespaces|
selectedNamespaces := self selectedNamespacesValue.
allNamespaces := selectedNamespaces includes:BrowserList nameListEntryForALL.
^ self
selectedClassesInNamespaces:selectedNamespaces orAll:allNamespaces
"Created: / 02-04-2014 / 00:13:21 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
selectedNonMetaclasses
^ (self selectedClassesValue) collect:[:cls | cls theNonMetaclass].
"Created: / 12-09-2006 / 13:40:25 / cg"
!
selectedNonMetaclassesDo:aBlock
"evaluate aBlock for each selected class."
self selectedNonMetaclasses do:aBlock
"Created: / 12-09-2006 / 13:42:24 / cg"
!
selectedProjectClasses
"return a collection containing all classes affected by the project selection"
|selectedProjects setOfClasses allIncluded|
selectedProjects := self selectedProjects value.
allIncluded := selectedProjects includes:(BrowserList nameListEntryForALL).
allIncluded ifTrue:[ ^ environment allClasses ].
setOfClasses := IdentitySet new.
environment allClassesDo:[:aClass |
(selectedProjects includes:aClass package) ifTrue:[
setOfClasses add:aClass .
]
].
^ setOfClasses
!
selectedProtocolMethods
| methods |
methods := Set new.
self selectedProtocolMethodsDo:
[:ign1 :ign2 :ign3 :mth|methods add: mth].
^methods
!
selectedProtocolMethodsDo:aBlock
"evaluate aBlock for each selected protocols methods.
(each class-protocol combination)"
|protocols allIncluded targets|
protocols := self selectedProtocolsValue.
protocols := protocols collect:[:each | each string].
allIncluded := protocols includes:(BrowserList nameListEntryForALL).
navigationState isFullProtocolBrowser ifTrue:[
targets := environment allClassesAndMetaclasses
] ifFalse:[
targets := self selectedClassesValue
].
targets isEmptyOrNil ifTrue:[^self].
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: / 01-08-2010 / 14:39:50 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 28-02-2012 / 16:52:57 / cg"
!
selectedProtocolsDo:aBlock
"evaluate aBlock for each selected protocol.
(class-protocol combination)"
|protocols targets allIncluded|
protocols := self selectedProtocolsValue.
navigationState isFullProtocolBrowser ifTrue:[
targets := environment allClassesAndMetaclasses
] ifFalse:[
targets := self selectedClassesValue
].
allIncluded := protocols includes:(BrowserList nameListEntryForALL).
targets do:[:cls |
allIncluded ifTrue:[
cls categories do:[:cat |
aBlock value:cls value:cat
]
] ifFalse:[
protocols do:[:aCategory |
|cat|
cat := aCategory string.
(cls methodDictionary contains:[:mthd | cat = mthd category]) ifTrue:[
aBlock value:cls value:cat
]
]
]
].
"Modified: / 28-02-2012 / 16:53:00 / cg"
!
selectedSelectorInCodeViewOrNil
"look in codeView for a selector"
|sel t goodSelectors|
sel := self selectionInCodeView.
sel isNil ifTrue:[^ nil].
sel := sel asSingleByteStringIfPossible.
t := self class extractSelectorFrom:sel.
t notNil ifTrue:[
sel := t.
].
sel knownAsSymbol ifFalse:[
goodSelectors := Parser findBest:5 selectorsFor:sel in:nil forCompletion:false.
goodSelectors size == 0 ifTrue:[
^ nil
].
sel := goodSelectors first
].
sel isNil ifTrue:[^ nil].
^ sel asSymbol
!
selectedSelectors
^ self selectedMethodsValue collect:[:mthd | mthd selector]
"Created: / 11-02-2000 / 10:29:30 / cg"
!
selectedTemporaryVariableInCodeViewOrNil
|node name definingNode|
node := self findNode.
(node isNil or:[node isVariable not]) ifTrue:[^ nil].
name := node name.
definingNode := node whoDefines:name.
definingNode isNil ifTrue: [^ nil].
^ name
!
selectedTemporaryVariablesInCodeViewOrNil
|namesOrNil names|
RBParser isNil ifTrue:[^ #()].
namesOrNil := RBParser parseVariableNames:(self selectionInCodeView).
namesOrNil notNil ifTrue:[
names := namesOrNil collect:[:each |each name].
].
^ names
!
selectedVariableInCodeViewOrNil
|node|
node := self findNode.
(node isNil or:[node isVariable not]) ifTrue:[^ nil].
^ node name.
!
selectionInCodeView
|codeView|
(codeView := self codeView) notNil ifTrue:[
^ codeView selectionAsString.
].
^ nil
!
selectorToSearchFor
"look in codeView and methodListView for a search-string when searching for selectors"
|sel|
sel := self selectedSelectorInCodeViewOrNil.
sel isNil ifTrue:[
"/ sel := self selectionInCodeView.
"/ sel notNil ifTrue:[
"/ t := SystemBrowser extractSelectorFrom:sel.
"/ t notNil ifTrue:[
"/ sel := t.
"/ ].
"/ sel knownAsSymbol ifFalse:[
"/ goodSelectors := Parser new findBestSelectorsFor:sel.
"/ goodSelectors size == 0 ifTrue:[
"/ sel := ''
"/ ] ifFalse:[
"/ sel := goodSelectors first
"/ ]
"/ ]
"/ ] ifFalse:[
sel := self theSingleSelectedSelector.
sel notNil ifTrue:[
sel := sel withoutSpaces upTo:(Character space)
] ifFalse:[
sel := ''
]
].
^ sel string
"Modified: / 1.3.2000 / 12:59:13 / cg"
!
sendFileViaEmail:aFile subject:subject
SendMailTool
openForFile:aFile
withSubject:subject
recipient:nil
"Created: / 20-09-2007 / 15:02:49 / cg"
!
showAllNamespaces
"showing all or topLevel namespaces only ?"
^ true
!
stringSearchToolView
"the current buffers stringSearchToolView"
^ self navigationState stringSearchToolView
"/ ^ self navigationState viewOfComponent: 'StringSearchToolCanvas' "'StringSearchTool'".
!
stringToSearchFor
"look in codeView for a search-string when searching for strings"
|sel|
sel := self selectionInCodeView.
sel notNil ifTrue:[
^ sel string
].
^ sel
!
theSingleSelectedCategory
"the current buffers single selected category;
nil if no selection or if multiple categories are selected"
|categories|
categories := self selectedCategoriesValue.
categories size == 1 ifTrue:[
^ categories first string
].
^ nil
"Created: / 6.2.2000 / 01:13:21 / cg"
!
theSingleSelectedClass
"the current buffers single selected class;
nil if no selection or if multiple classes are selected"
^ self navigationState theSingleSelectedClass
!
theSingleSelectedLintRuleHolder
^BlockValue
with:[:generator|
| rule size |
rule := nil.
size := 0.
(generator value ? #()) do:[:each|rule := each.size := size + 1].
size == 1 ifTrue:[rule] ifFalse:[nil]]
argument: self selectedLintRules
"Created: / 05-02-2010 / 12:56:34 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 01-03-2012 / 15:31:23 / cg"
!
theSingleSelectedLoadedNonMetaclassOrNil
|currentClass|
currentClass := self theSingleSelectedClass.
currentClass isNil ifTrue:[^ nil].
currentClass isLoaded ifFalse:[^ nil].
^ currentClass theNonMetaclass.
"Created: / 01-03-2007 / 20:47:18 / cg"
!
theSingleSelectedMethod
"the current buffers single selected method;
nil if no selection or if multiple methods are selected"
^ self navigationState theSingleSelectedMethod
!
theSingleSelectedMethodName
"the current buffers single selected method name;
nil if no selection or if multiple methods are selected"
|mthd name|
mthd := self theSingleSelectedMethod.
mthd notNil ifTrue:[
name := mthd name
].
^ name
"Created: / 25-08-2009 / 16:01:50 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
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:[
"JV: I changed this to answer the selector (not name),
because for non-smalltalk languages (Ruby for instance)
method selector may differ from method name."
"/sel := mthd name "/ who methodSelector
sel := mthd selector.
].
^ sel
"Created: / 05-02-2000 / 23:09:57 / cg"
"Modified: / 30-08-2009 / 17:12:49 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
theSingleSelectedVariable
"return the selected variable, but only if exactly one is selected.
Otherwise, return nil."
|selectedVariables|
(selectedVariables := self selectedVariables value) size == 1 ifTrue:[
^ selectedVariables first
].
^ nil
!
view:view belongsToSubApplication:anAppOrNil
|appView|
anAppOrNil isNil ifTrue:[
^ false
].
appView := anAppOrNil window.
^ appView notNil
and:[ (view isSameOrComponentOf:appView) ]
! !
!NewSystemBrowser methodsFor:'private-helpers-subApps'!
categoryListApp
^ navigationState classCategoryListApplication
!
classHierarchyListApp
^ navigationState classHierarchyListApplication
!
classListApp
^ navigationState classListApplication
!
inlineMessageApp
^ self navigationState inlineMessageApplication
"Created: / 25-03-2014 / 17:59:44 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 25-02-2015 / 16:52:33 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
methodCategoryList: aView
navigationState methodCategoryList: aView
"Created: / 23-02-2000 / 09:33:47 / cg"
"Created: / 08-08-2011 / 09:18:14 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
methodCategoryListApp
^ navigationState methodCategoryListApplication
"Created: / 23.2.2000 / 09:33:47 / cg"
!
methodList: aView
navigationState methodList: aView
"Created: / 23-02-2000 / 09:33:47 / cg"
"Created: / 08-08-2011 / 15:29:55 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
methodListApp
^ navigationState methodListApplication
!
nameSpaceListApp
^ navigationState nameSpaceListApplication
!
projectListApp
^ navigationState projectListApplication
! !
!NewSystemBrowser methodsFor:'private-history'!
lastSearchPatterns
^ self class lastSearchPatterns
!
rememberLocationInHistory
|mthd cls sel |
mthd := self theSingleSelectedMethod.
mthd isNil ifTrue:[
cls := self theSingleSelectedClass.
] ifFalse:[
cls := mthd mclass.
sel := mthd selector.
].
cls isNil ifTrue:[
^ self
].
self addToFindHistory: cls selector: sel.
self addToHistory: cls selector: sel.
"Modified: / 27-02-2008 / 16:54:06 / janfrog"
"Modified: / 02-07-2011 / 18:29:29 / cg"
"Modified: / 02-05-2014 / 17:28:13 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
rememberSearchPattern:aString
self class rememberSearchPattern:aString
"Modified: / 14-02-2012 / 14:00:36 / cg"
! !
!NewSystemBrowser methodsFor:'private-presentation'!
asyncShowMethodInfo
self
enqueueMessage:#showInfo:
for:self
arguments:(Array with:self getMethodInfo)
!
busyLabel:what
"set the title for some warning"
|window|
(builder notNil
and:[ (window := builder window) notNil
and:[ window isTopView]]) ifTrue:[
window
label:('SystemBrowser - ' , (resources string:what))
]
!
busyLabel:what with:someArgument
"set the title for some warning"
|window|
(window := builder window) isTopView ifTrue:[
window
label:('SystemBrowser - ' , (resources string:what with:someArgument))
]
!
classCategoryInfo
|selectedClasses categories category msg|
self codeInfoVisible value ifFalse:[^ nil].
selectedClasses := self selectedClassesValue.
selectedClasses isEmptyOrNil ifTrue:[^ nil].
categories := selectedClasses collect:[:each|each category] as:Set.
categories size ~~ 1 ifTrue:[^ nil].
category := categories anElement.
selectedClasses size == 1 ifTrue:[
msg := 'Category of %1: %3'
] ifFalse:[
msg := 'Category of %2 classes: %3'
].
^ resources string:msg
with:selectedClasses first name
with:selectedClasses size
with:category
"Modified: / 28-02-2012 / 16:45:20 / cg"
!
classInheritanceInfo
|singleSelectedClass|
self codeInfoVisible value ifFalse:[^ nil].
singleSelectedClass := self theSingleSelectedClass.
singleSelectedClass isNil ifTrue:[^ nil].
self organizerMode value == OrganizerCanvas organizerModeHierarchy ifTrue:[^ nil].
^ self getClassInheritanceInfoForClass:singleSelectedClass
!
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.
!
delayedUpdateBufferLabelWithCheckIfModified
self reallyModified:navigationState
"/ |nr|
"/
"/ (nr := selectedBuffer value) notNil ifTrue:[
"/ nr ~~ 0 ifTrue:[
"/ bufferNameList at:nr put:(self currentBufferLabel).
"/ ]
"/ ]
"Modified: / 5.2.2000 / 04:23:21 / cg"
"Created: / 5.2.2000 / 04:25:54 / cg"
!
displayedClassNameOf:aClass
"depending on the current nameSpace, either show a classes
fullname or its name without the namespace prefix (if its in the current)"
|nm ns currentNamespace|
aClass isJavaClass ifTrue:[
^ aClass nameInBrowser "/ fullName "/ asString replaceAll:$/ with:$.
].
ns := aClass topNameSpace.
ns isNil ifTrue:[ "/ this 'cannot' happen (should always be Smalltalk)
^ aClass name
].
currentNamespace := self currentNamespace.
currentNamespace = (BrowserList nameListEntryForALL) ifTrue:[
(ns == Smalltalk) ifTrue:[
nm := aClass nameWithoutNameSpacePrefix.
^ nm
].
nm := aClass nameWithoutNameSpacePrefix.
^ ns name , '::' , nm "/ full name
].
nm := aClass nameWithoutNameSpacePrefix.
"/ is it in one of the selected namespaces ?
(self findClassNamedInNameSpace:nm) isNil ifTrue:[
^ ns name , '::' , nm "/ full name
].
currentNamespace == ns ifFalse:[
^ ns name , '::' , nm "/ full name
].
^ nm.
"Created: / 20.12.1996 / 17:46:41 / cg"
"Modified: / 24.2.2000 / 13:49:06 / cg"
!
explain:selection inCode:code
self explainInCode:code short:false withTimeout:false
"Modified: / 05-09-2006 / 10:37:30 / cg"
!
explainInCode:code short:short withTimeout:withTimeout
"explain the selection or, if there is none, the node under the cursor"
|process explanation explainTookTooLong|
"/ stop any previous explain activitiy
(process := explainProcess) notNil ifTrue:[
explainProcess := nil.
process terminate.
].
(withTimeout and:[short not]) ifTrue:[self halt].
"/ synchronous
withTimeout ifTrue:[
explainTookTooLong := false.
explanation :=
[
self explanationForCode:code short:short
] valueWithWatchDog:[explainTookTooLong := true] afterMilliseconds:400.
self activityNotification:nil.
explainTookTooLong ifTrue:[
self showInfo:'Explain took too long - cancelled.'.
^ self.
].
self showExplanation:explanation short:short.
^ self
].
short ifFalse:[
explanation := self explanationForCode:code short:short.
self showExplanation:explanation short:short.
^ self.
].
"/ aynchronous - start a process which shows it later
explainProcess :=
[
explanation := self explanationForCode:code short:true.
self
enqueueMessage:#showExplanation:short:
for:self
arguments: { explanation . true }.
] fork.
"Created: / 05-09-2006 / 10:37:04 / cg"
!
explanationForCode:code short:short
"explain the selection or, if there is none, the node under the cursor"
|selection codeView cls crsrPos interval node explanation|
cls := self classOfSelectedMethodOrSelectedClass.
cls isNil ifTrue:[ ^ nil ].
codeView := self codeView.
interval := self selectedInterval.
interval isEmpty ifTrue:[
crsrPos := codeView characterPositionOfCursor.
codeView characterUnderCursor isSeparator ifTrue:[
crsrPos := (crsrPos - 1) max:1
].
interval := crsrPos to:crsrPos.
].
navigationState codeAspect == #classDefinition ifFalse:[
node := self findNodeForInterval:interval.
].
node notNil ifTrue: [
"/ protect end-users from errors
Error handle:[:ex |
Smalltalk isSmalltalkDevelopmentSystem ifTrue:[ex reject].
] do:[
explanation := Explainer explainNode:node in:code forClass:cls short:short interval:interval
]
].
explanation isNil ifTrue:[
codeView hasSelection ifTrue:[
selection := codeView selection.
] ifFalse:[
"/ selection := codeView characterBeforeCursor.
].
selection notNil ifTrue:[
selection := selection asString string withoutSeparators.
explanation := Explainer explain:selection in:code forClass:cls short:short
].
].
^ explanation
"Modified: / 15-07-2006 / 19:28:16 / cg"
!
getClassInfo
|organizerMode msg|
organizerMode := self organizerMode value.
(organizerMode == OrganizerCanvas organizerModeClassHierarchy
or:[ organizerMode == OrganizerCanvas organizerModeHierarchy] ) ifTrue:[
^ self classCategoryInfo.
].
msg := self classInheritanceInfo.
"/ msg isNil ifTrue:[
"/ msg := self methodInheritanceInfo.
"/ msg isNil ifTrue:[
"/ msg := self methodImplementorsInfo
"/ ]
"/ ].
^ (msg ? '').
"Modified: / 29-08-2006 / 14:20:14 / cg"
!
getClassInheritanceInfoForClass:aClass
"get some inheritance info about aClass
to be shown in the info line at the bottom"
|subclasses msg|
subclasses := aClass subclasses.
msg := Explainer infoStringForClasses:subclasses withPrefix:'sub'.
^ resources string:('%1: ' , msg)
with:aClass theNonMetaclass name
with:subclasses size
"Modified: / 27-07-2006 / 10:10:38 / cg"
!
getMethodInfo
"get something about the current method
to be shown in the info line at the bottom"
|msg selectedMethods firstMethod source1 differentSourceButSameSemantic prefix|
self codeInfoVisible value ifFalse:[^ nil].
selectedMethods := self selectedMethodsValue.
selectedMethods isEmptyOrNil ifTrue:[^ nil].
firstMethod := selectedMethods first.
selectedMethods size == 1 ifTrue:[
^ self getMethodInfoForMethod:firstMethod.
].
differentSourceButSameSemantic := false.
source1 := firstMethod source.
selectedMethods asArray from:2 do:[:eachOtherMethod |
eachOtherMethod source ~= source1 ifTrue:[
Error
handle:[:ex | ^ nil]
do:[
firstMethod parseTree ~= eachOtherMethod parseTree ifTrue:[
^ nil.
].
].
differentSourceButSameSemantic := true.
].
].
prefix := differentSourceButSameSemantic ifTrue:['Same effect'] ifFalse:['Same source'].
"/ all are the same.
msg := self getMethodInfoForMethod:firstMethod.
msg isEmptyOrNil ifTrue:[
^ prefix.
].
^ prefix,' - ' , msg.
"Modified: / 28-02-2012 / 16:16:33 / cg"
"Modified: / 16-10-2013 / 00:06:16 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
getMethodInfoForMethod:aMethod
"get some info about aMethod
to be shown in the info line at the bottom"
|msg msg2 method wrapper|
method := aMethod.
method isNil ifTrue:[ ^ nil ].
(wrapper := method wrapper) notNil ifTrue:[
method := wrapper
].
method isNil ifTrue:[
^ 'oops - this method is not attached to any class'.
].
"Explainer can really only work fine with Smalltalk code loaded
in the image, so short-circuit here for everything else (Java,
Javascript, RING2 models, ...)"
method programmingLanguage ~~ SmalltalkLanguage instance ifTrue: [
^ ''.
].
msg := Explainer methodSpecialInfoFor:method.
msg isNil ifTrue:[
msg := Explainer methodInheritanceInfoFor:method.
msg2 := Explainer methodRedefinitionInfoFor:method.
msg2 notNil ifTrue:[
msg := msg isNil
ifTrue:[msg2]
ifFalse:[msg,'; ',msg2]
].
msg isNil ifTrue:[
msg := Explainer methodImplementorsInfoFor:method inEnvironment:environment
].
].
msg := (msg ? '').
method isInstrumented ifTrue:[
msg isEmpty ifTrue:[
msg := 'Instrumented.' withColor:(Color green darkened).
] ifFalse:[
msg := ('Instrumented.' withColor:(Color green darkened)),' ',msg.
].
self showCoverageInformation value ifFalse:[
msg := msg , ' (coverage display is turned off - see "view"-menu)'
].
msg := msg , '.'.
].
^ msg.
"Modified: / 23-03-2023 / 18:47:46 / Jan Vrany <jan.vrany@labware.com>"
!
nameListEntryForALL
^ BrowserList nameListEntryForALL
!
normalLabel
"set the normal (inactive) window- and icon labels"
|window l il|
builder isNil ifTrue:[^ self]. "/ if invoked during setup
window := builder window.
(window notNil and:[window isTopView]) ifFalse:[
"/ if I am used as a subApp, do not update the label
^ self
].
"/ windowLabel notNil ifTrue:[
"/ "if I have been given an explicit label,
"/ and its not the default, take that one"
"/
"/ windowLabel ~= 'NewSystemBrowser' ifTrue:[
"/ l := il := windowLabel
"/ ]
"/ ].
l isNil ifTrue:[
l := il := self currentWindowLabel.
].
navigationState realModifiedState == true ifTrue:[
l := l , (resources string:' [modified]')
] ifFalse:[
buffers notEmptyOrNil ifTrue:[
(buffers contains:[:someNavigationState | someNavigationState realModifiedState == true]) ifTrue:[
l := l , (resources string:' [modified buffer]')
].
].
].
window label:l string; iconLabel:il string.
"Modified: / 15-11-2016 / 17:08:55 / cg"
!
replaceSourceCodeManagerPlaceholderWith: manager in: menu
| nm |
manager isNil ifTrue:[
nm := nil
] ifFalse:[
nm := manager name.
].
menu replaceArgument: #SourceCodeManagerNamePlaceholder with: nm.
menu replaceArgument: #SourceCodeManagerPlaceholder with: manager.
menu receiver:self.
menu findGuiResourcesIn:self.
"Must once again after resolve because of slices!!!!!!"
menu replaceArgument: #SourceCodeManagerNamePlaceholder with: nm.
menu replaceArgument: #SourceCodeManagerPlaceholder with: manager.
"Created: / 12-10-2011 / 20:22:43 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 23-07-2012 / 15:13:27 / cg"
!
showActivity:someMessage
"some activityNotification to be forwarded to the user;
show it in the windows title area here
(invoked, for example, by the CVSManager showing some activity)."
self showInfo:someMessage.
"/ someMessage size == 0 ifTrue:[
"/ self normalLabel
"/ ] ifFalse:[
"/ self busyLabel:someMessage with:nil
"/ ]
!
showExplanation:explanation short:short
"explain-msg arrived"
|html explanationString|
explanation isEmptyOrNil ifTrue:[^ self].
short ifTrue:[
self showInfo:explanation.
^ self.
] .
(explanationString := explanation) isArray ifTrue:[
html := explanation detect:[:entry | entry key == #html] ifNone:[nil].
html notNil ifTrue:[
"/ todo: need a stripped down viewer (small, popup, modal)
HTMLDocumentView openFullOnText:(html value).
^ self.
].
explanationString := explanationString first value.
].
"/ paste into view
self information:explanationString.
builder window flush
"Created: / 05-09-2006 / 10:37:04 / cg"
!
showInfo:msg
"if its a multiline message, only the first line is shown"
|messageShown canvas lbl doAnimate|
navigationState notNil ifTrue:[
(canvas := navigationState canvas) notNil ifTrue:[
lbl := canvas builder componentAt:'InfoLabel'.
].
"/ Transcript showCR:lbl.
"/ Transcript showCR:msg.
lbl notNil ifTrue:[ lbl stopAnimation ].
doAnimate := false.
navigationState showingParseError:false.
].
(messageShown := msg) notNil ifTrue:[
messageShown := msg asStringCollection "asStringWithoutFinalCR".
messageShown size <= 1 ifTrue:[
messageShown := msg.
] ifFalse:[
UserPreferences current showMarqueeInfo ifFalse:[
messageShown := messageShown first
] ifTrue:[
doAnimate := true.
"/ messageShown do:[:eachLine|
"/ Transcript show:' > '; showCR:eachLine; showCR:'"'.
"/].
].
].
].
navigationState notNil ifTrue:[
self infoLabelHolder value:messageShown.
].
doAnimate ifTrue:[
lbl notNil ifTrue:[ lbl startAnimation ].
].
"
WindowGroup activeApplication showInfo: 'Hello'
WindowGroup activeApplication showInfo: ('Hello\World\Bla' withCRs) asStringCollection
WindowGroup activeApplication showInfo: #('Hello' 'World' 'Bla')
"
!
showMethodInfo
"show something about the current method
in the info line at the bottom"
|method metrics complexity msg|
self showInfo:(self getMethodInfo).
self showMethodComplexity value ifTrue:[
OOM::MethodMetrics notNil ifTrue:[
method := self theSingleSelectedMethod.
method notNil ifTrue:[
metrics := OOM::MethodMetrics forMethod:method.
complexity := metrics complexity.
complexity notNil ifTrue:[
msg := metrics class descriptiveName,': ',complexity printString.
].
]
]
].
!
withActivityNotificationsRedirectedToInfoLabelDo:aBlock
ActivityNotification handle:[:ex |
self showInfo:(ex messageText).
ex proceed.
] do:aBlock
"Created: / 01-03-2007 / 17:45:27 / cg"
!
withSearchCursorDo:aBlock
[
self busyLabel:'searching...'.
self withCursor:(Cursor questionMark) do:aBlock
] ensure:[
self normalLabel
]
! !
!NewSystemBrowser methodsFor:'private-searching'!
searchCompletionBlock
"Returns a class/selector name completion block that
is used by the search field in browser's toolbar"
"Following code allows me (JV) to experiment with different
completion blocks as I'm not happy with the standard one
(now in searchCompletionBlock_Standard)"
| sel |
sel := UserPreferences current at: #searchCompletionBlock ifAbsent:[nil].
sel notNil ifTrue:[
^self
perform: ('searchCompletionBlock_' , sel) asSymbol
ifNotUnderstood:[ self searchCompletionBlock_Standard ].
].
^self searchCompletionBlock_Standard
"
UserPreferences current removeKey: #searchCompletionBlock.
UserPreferences current at: #searchCompletionBlock put: #New.
UserPreferences current at: #searchCompletionBlock put: #Standard.
Tools::NewSystemBrowser basicNew searchCompletionBlock
"
"Created: / 09-02-2010 / 21:45:05 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 04-08-2011 / 19:05:28 / cg"
"Modified (comment): / 04-12-2011 / 22:39:11 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
searchCompletionBlock_New
"This returns a class/selector name completion block that uses
JV's private search"
^[:patternString | self searchCompletionNew: patternString]
"Modified: / 04-08-2011 / 19:05:28 / cg"
"Created: / 04-12-2011 / 22:13:51 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
searchCompletionBlock_Standard
"This returns a class/selector name completion block that uses
standard DoWhatIMeanSupport"
^[:partialName | self searchCompletionStandard:partialName]
"Modified: / 10-02-2010 / 08:47:08 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 04-08-2011 / 19:05:28 / cg"
"Created: / 04-12-2011 / 22:11:28 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
searchCompletionNew: patternString
"JV's private search"
| env pattern matches |
patternString isEmptyOrNil ifTrue:[^#('' #())].
env := self theSingleSelectedNamespace ? #Smalltalk.
env = NavigatorModel nameListEntryForALL ifTrue:[env := #Smalltalk].
env := environment at: env.
pattern := StringPattern readFrom: patternString onError: [^#('' #())].
matches := OrderedCollection new.
env keysDo:[:nm|
| cls nmWihoutPrefix |
cls := env at: nm.
(cls notNil and:[cls isBehavior]) ifTrue:[
(pattern match: (nmWihoutPrefix := cls nameWithoutPrefix)) ifTrue:[
matches add: nmWihoutPrefix
].
].
].
matches isEmpty ifTrue:[ ^ #( nil #() ) ].
^ { matches first . matches }
"Modified: / 04-08-2011 / 19:05:28 / cg"
"Created: / 04-12-2011 / 22:22:46 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
searchCompletionStandard:partialName
"This does a class/selector name completion using
standard DoWhatIMeanSupport"
| env firstLetter doMatch classCompletion selectorCompletion|
env := self theSingleSelectedNamespace ? #Smalltalk.
env = NavigatorModel nameListEntryForALL ifTrue:[env := #Smalltalk].
env := environment at: env.
partialName isEmptyOrNil ifTrue: [
^ #('' #())
].
firstLetter := partialName first.
(partialName size > 1
and:[firstLetter == $*
and:[partialName second isLetter]]
) ifTrue:[
firstLetter := partialName second
].
firstLetter isUppercase ifTrue:[
^ DoWhatIMeanSupport classnameCompletion: partialName inEnvironment: env
].
doMatch := true.
"/ to allow searching for multiplication
partialName = '*' ifTrue:[
doMatch := false.
].
selectorCompletion := DoWhatIMeanSupport selectorCompletion: partialName inEnvironment: env match:doMatch.
selectorCompletion second isEmpty ifTrue:[
"/ no completion - try classnames;
"/ allows me to enter lower case classnames
classCompletion := DoWhatIMeanSupport classnameCompletion: partialName inEnvironment: env.
classCompletion second notEmpty ifTrue:[
^ classCompletion
].
].
^ selectorCompletion
! !
!NewSystemBrowser methodsFor:'private-semantic checks'!
checkAcceptedMethod:aMethod inClass:aClass
"do some semantic checks on the just accepted method:
does new method redefine an inherited method, which does the same ?
"
|msg selector subMethods answer|
selector := aMethod selector.
"/ skip for some...
(aClass isMeta) ifTrue:[
(AbstractSourceCodeManager isVersionMethodSelector:selector) ifTrue:[
^ self
].
( #(
documentation
copyright
legalCopyright
) includes:selector) ifTrue:[
^ self
].
].
(self canUseRefactoringParser) ifTrue:[
"/ does new method redefine an inherited method,
"/ which does the same ?
msg := self checkIfSameSemanticsRedefinedWith:aMethod inClass:aClass.
msg notNil ifTrue:[
(Dialog
confirm:msg withCRs
title:'Remove duplicate method'
yesLabel:(resources string:'Remove Here')
noLabel:(resources string:'Keep')
initialAnswer:false)
ifTrue:[
self doRemoveMethodsUnconfirmed:(Array with:aMethod)
].
^ self
].
subMethods := OrderedCollection new.
aClass allSubclassesDo:[:eachInheritingClass |
|redefiningMethod|
redefiningMethod := eachInheritingClass compiledMethodAt:selector.
redefiningMethod notNil ifTrue:[
msg := self checkIfSameSemanticsRedefinedWith:redefiningMethod inClass:eachInheritingClass.
msg notNil ifTrue:[
(eachInheritingClass superclass whichClassIncludesSelector:selector) == aClass
ifTrue:[
subMethods add:redefiningMethod.
]
].
]
].
subMethods size > 0 ifTrue:[
msg := 'The same code is found in the subclass(es):\\'.
subMethods do:[:eachMethod | msg := msg , ' ' , eachMethod mclass name , '\'].
msg := msg , '\You may want to remove it there.'.
answer := Dialog
confirmWithCancel:msg withCRs
labels:(resources array:#('Keep' 'Remove here' 'Remove in Subclass(es)'))
values:#(true #removeHere #removeThere)
default:1.
answer == #removeHere ifTrue:[
self doRemoveMethodsUnconfirmed:(Array with:aMethod)
] ifFalse:[
answer == #removeThere ifTrue:[
self doRemoveMethodsUnconfirmed:subMethods
]
]
]
].
UserPreferences current enforceComment ifTrue:[
"/ check for empty/missing method comment
self checkForEmptyMethodComment:aMethod inClass:aClass.
].
"/ "/ super-send probably missing ?
"/ (self checkIfSuperSendIsProbablyMissingIn:aMethod inClass:aClass)
"/ ifTrue:[^ self].
"Modified: / 29-08-2006 / 10:16:20 / cg"
!
checkForEmptyMethodComment:aMethod inClass:aClass
|src parser firstComment comments|
src := aMethod source ? ''.
src isNil ifTrue:[^ self].
parser := Parser for:src in:nil.
parser ignoreErrors:true; ignoreWarnings:true; saveComments:true.
parser parseMethodSpec.
comments := parser comments.
comments isEmptyOrNil ifTrue:[
Dialog
withOptoutOption:[UserPreferences current enforceComment:false]
labelled:(resources string:'Do not show this dialog again (reenable via Launcher''s settings)')
warn:(resources stringWithCRs:'Missing Method-Comment.\Please add a short description of what the method does.').
^ self
].
firstComment := comments first.
firstComment string withoutSeparators isEmpty ifTrue:[
"/ firstComment isEndOfLineComment ifFalse:[
ParserFlags warnAboutBadComments ifTrue:[
Dialog warn:(resources stringWithCRs:'Useless (empty) Method-Comment.\Please add flesh to it.').
] ifFalse:[
Dialog warn:(resources stringWithCRs:'Useless (empty) Method-Comment.\Please add flesh or remove it.').
].
^ self
"/ ]
].
!
checkIfSameSemanticsRedefinedWith:methodHere inClass:aClass
"check if methodHere (the just accepted or tobe removed method)
redefines an inherited method, which does the same?
Returns an info-message string (if so) or nil if not.
"
|sel superCls implClass methodThere treeThere treeHere
dictionary mClass remainingRenames|
RBParser isNil ifTrue:[^ nil].
RBCodeDuplicationRule isNil ifTrue:[^ nil].
sel := methodHere selector.
methodHere getMclass == aClass ifFalse:[
"/ has become obsolete
^ nil
].
"/ these are meant to be empty and only contain different comments...
aClass isMeta ifTrue:[
(
#(
documentation
version
examples
copyright
history
initialize "/ because that is not invoked if only inherited
) includes:sel
) ifTrue:[
^ nil
]
].
superCls := aClass superclass.
superCls notNil ifTrue:[
implClass := superCls whichClassIncludesSelector:sel.
].
implClass isNil ifTrue:[^ nil]. "/ nothing inherited
"/ ok, it is redefined
methodThere := implClass compiledMethodAt:sel.
(RBCodeDuplicationRule isMethod:methodHere duplicateOfInherited:methodThere) ifTrue:[
^ 'This method''s functionality is already inherited from ', implClass name , '.\\You may want to remove it here.'.
].
"/ 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].
"/
"/ (RBCodeDuplicationRule isParseTree:treeHere in:aClass duplicateOfTree:treeThere) ifTrue:[
"/ ^ 'This method''s functionality is already inherited from ', implClass name , '.\\You may want to remove it here.'.
"/ ].
^ nil
"Modified (format): / 06-07-2011 / 16:44:46 / cg"
!
checkIfSuperSendIsProbablyMissingIn:methodHere inClass:aClass
"is there a chance, that the just accepted method should invoke the
redefined, inherited super method ?
"
|sel superCls implClass methodThere parser treeThere |
aClass compilerClass == Compiler ifFalse:[^ false].
methodHere selector == #initialize ifTrue:[
aClass isMeta ifTrue:[^ false].
aClass == Object ifTrue:[^ false].
aClass superclass == Object ifTrue:[^ false].
].
sel := methodHere selector.
"/ see if new method already invokes the redefined super method
(methodHere referencesLiteral:sel) ifTrue:[
(methodHere messagesSentToSuper includes:sel) ifTrue:[ ^ false ]
].
superCls := aClass superclass.
superCls notNil ifTrue:[
implClass := superCls whichClassIncludesSelector:sel.
].
implClass isNil ifTrue:[^ false].
"/ ok, it is redefined
methodThere := implClass compiledMethodAt:sel.
(methodThere notNil and:[methodThere referencesLiteral:sel]) ifTrue:[
(methodThere messagesSentToSuper includes:sel) ifTrue:[
self information:(resources
string:'Could it be possible, that you forgot a ''super %1''\(I found a ''super %1'' in the overwritten #%1-method) ?'
with:sel) withCRs.
^ true
]
].
"/ see if the redefined method is empty
methodThere notNil ifTrue:[
parser := Parser parseMethod:methodThere source in:methodThere mclass.
treeThere := parser tree.
treeThere isNil ifTrue:[
"/ yes, empty
^ false
].
treeThere isReturnNode ifTrue:[
treeThere expression isSelf ifTrue:[
"/ yes, a simple ^ self
^ false
].
].
].
"/ look if all any subclasses of the superclass do a super-send
"/ implClass allSubclassesDo:[:eachSubclass |
"/ eachSubclass ~~ aClass ifTrue:[
"/ methodThere := eachSubclass compiledMethodAt:sel.
"/ (methodThere notNil and:[methodThere referencesLiteral:sel]) ifTrue:[
"/ (methodThere messagesSentToSuper includes:sel) ifTrue:[
"/ self information:(resources
"/ string:'Could it be possible, that you forgot a ''super %1''\(I found a ''super %1'' in %2''s #%1-method) ?'
"/ with:sel
"/ with:eachSubclass name
"/ ) withCRs.
"/ ^ true
"/ ]
"/ ].
"/ ]
"/ ].
^ false
!
method:mthd selector:sel inClass:cls matchesParseTreeMatcher:aMatcher
|parseTree|
(aMatcher canMatchMethod:mthd) ifFalse: [^ false].
parseTree := RBParser
parseMethod:mthd source
onError: [:str :pos |
Transcript showCR:str. Transcript showCR:pos.
nil
].
parseTree isNil ifTrue:[^ false ].
^ (aMatcher executeTree: parseTree initialAnswer: nil) notNil
"Modified: / 19-11-2016 / 12:00:26 / cg"
!
methodHasUglyCodingStyle:mthd selector:sel inClass:cls
"nil if ok, a string with a description of the uglyness if not.
More has to come here..."
|comment|
comment := mthd comment.
cls isMeta ifTrue:[
(AbstractSourceCodeManager isVersionMethodSelector:sel) ifTrue:[^ nil].
sel == #documentation ifTrue:[
comment isBlank ifTrue:[ ^ 'no documentation in documentation method' ].
^ nil
].
].
comment size == 0 ifTrue:[^ 'missing comment' ].
comment asCollectionOfLines last isEmptyOrNil ifTrue:[^ 'extra line at end of comment' ].
^ nil.
! !
!NewSystemBrowser methodsFor:'private-syntax coloring'!
startSyntaxHighlightProcess
"start a background process, which does the syntax coloring.
When it finishes, it pushes a user event to show the new text in the codeView.
(This is done as an event to synchronize the coloring with modifications
done to the text - the colored text will discarded, if there were
any new modifications in the meanwhile)"
|dontDoIt oldCodeList highlighterClass prio currentMethod methodsClass codeView|
"/ sigh: the codeView2 has its own idea of how to do this.
"/ for now, duplicate code; will be cleaned up asap.
(UserPreferences current useCodeView2In: #Browser) ifTrue:[^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 := self syntaxHighlighterForMethod:currentMethod.
].
highlighterClass isNil ifTrue:[
syntaxColoringProcess notNil ifTrue:[
self stopSyntaxHighlightProcess
].
^ self
].
codeView := self codeView.
"/ "/ this clobbers the codeViews modified state; therefore, we have to remember
"/ "/ this info somewhere ...
"/ codeView modified ifTrue:[
"/ self navigationState realModifiedState:true
"/ ].
"/ codeView modifiedChannel setValue:false.
syntaxColoringProcess notNil ifTrue:[
syntaxColoringProcessRunning ~~ true ifTrue:[
"/ process already created, but did not get a change to start yet;
^ self
].
self stopSyntaxHighlightProcess
].
prio := Processor userBackgroundPriority - 1.
codeView shown ifFalse:[
prio := prio - 1 max:1
].
syntaxColoringProcess :=
[
|oldCode newCode cls sensor|
[
syntaxColoringProcessRunning := true.
cls := methodsClass.
(cls notNil and:[cls isObsolete]) ifTrue:[
cls isMeta ifTrue:[
cls := (environment at:cls theNonMetaclass name) class
] ifFalse:[
cls := environment at:cls name
].
].
"check after every lengthy operation if modified by user in the meantime..."
codeView modified ifFalse:[
oldCodeList := codeView list copy.
codeView modified ifFalse:[
oldCodeList isNil ifFalse:[
oldCode := oldCodeList asStringWithoutEmphasis.
codeView modified ifFalse:[
Screen currentScreenQuerySignal answer:device
do:[
Parser parseErrorSignal handle:[:ex |
|errMsg|
errMsg := ex description asStringCollection first asString.
"/ Transcript topView raiseDeiconified.
"/ Transcript showCR:'ParseError: ', ex description.
"/ self halt.
self showInfo:(errMsg withColor:Color red).
self navigationState showingParseError:true.
newCode := nil.
] do:[
|codeAspect|
codeAspect := self codeAspect.
codeAspect == SyntaxHighlighter codeAspectMethod ifTrue:[
newCode := highlighterClass formatMethod:currentMethod source:oldCode in:cls
] ifFalse:[
codeAspect == SyntaxHighlighter codeAspectClassDefinition ifTrue:[
newCode := highlighterClass formatExpression:oldCode in:cls
].
].
]
].
newCode notNil ifTrue:[
codeView modified ifFalse:[
newCode := newCode asStringCollection.
codeView modified ifFalse:[
syntaxColoringProcess := nil.
(codeView := self codeView) notNil ifTrue:[
"/ must add this event - and not been interrupted
"/ by any arriving key-event.
"/ self showInfo:nil.
codeView sensor
pushUserEvent:#syntaxHighlightedCode:
for:self
withArguments:(Array with:newCode).
self delayedUpdateBufferLabelWithCheckIfModified
]
]
]
]
]
]
]
]
] ensure:[
syntaxColoringProcessRunning := false.
syntaxColoringProcess := nil
]
] newProcess.
syntaxColoringProcess priority:prio.
(prio < Processor userSchedulingPriority) ifTrue:[
"/ ensure, it makes progress...
syntaxColoringProcess priorityRange:(prio to:Processor userSchedulingPriority).
].
syntaxColoringProcess resume
"Modified: / 26-07-2011 / 10:28:51 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 27-07-2012 / 22:26:48 / cg"
!
stopSyntaxHighlightProcess
"stop any syntax coloring background process."
|p|
(p := syntaxColoringProcess) notNil ifTrue:[
syntaxColoringProcess := nil.
p terminate.
"/ raise its prio to make it terminate quickly
p priority:(Processor userSchedulingPriority + 1)
]
!
syntaxHighlightedCode:newCode
"the background synhighlighter has generated new colored text,
with highlighted syntax.
If there have been no modifications in the meantime, install it."
|firstShown lastShown cursorWasOn anyChange newLines l replaceAction codeView list|
codeView := self codeView.
codeView modified ifTrue:[
"/ new user 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
].
self navigationState showingParseError ifTrue:[
self showInfo:''. "/ to erase any previous syntax error
].
firstShown := codeView firstLineShown.
lastShown := codeView lastLineShown.
replaceAction := [:lNr :line |
|oldLine|
oldLine := list at:lNr ifAbsent:nil.
oldLine notNil ifTrue:[
line notNil ifTrue:[
"/ this check is needed - there is a race
"/ when the text is converted. This detects the
"/ resulting error.
"/ Certainly a kludge.
oldLine string = line string ifTrue:[
oldLine emphasis ~= line emphasis ifTrue:[
codeView modifiedChannel removeDependent:self.
list at:lNr put:line.
codeView modifiedChannel addDependent:self.
(lNr between:firstShown and:lastShown) ifTrue:[
anyChange ifFalse:[
anyChange := true.
cursorWasOn := codeView hideCursor
].
codeView redrawLine:lNr
]
]
]
]
]
].
anyChange := false.
newLines := newCode asStringCollection.
list := codeView list.
list isNil ifTrue:[
codeView list:newLines.
] ifFalse:[
"/ the cursor line first - that's where your eyes are ...
(l := codeView cursorLine) notNil ifTrue:[
l <= newLines size ifTrue:[
replaceAction value:l value:(newLines at:l)
]
].
newLines keysAndValuesDo:replaceAction.
anyChange ifTrue:[
cursorWasOn ifTrue:[
codeView showCursor
]
]
].
"Modified: / 09-10-2006 / 11:50:17 / cg"
!
syntaxHighlightedCodeFor:oldText method:mthd
|highlighter cls|
cls := mthd mclass ? Object.
highlighter := self syntaxHighlighterForMethod:mthd.
highlighter isNil ifTrue:[ ^ oldText ].
^ highlighter formatMethod:mthd source:oldText in:cls.
"Modified: / 28-04-2010 / 13:44:34 / cg"
!
syntaxHighlighterForClass: cls
|highlighterClass |
highlighterClass := cls syntaxHighlighterClass.
"When a new class of different language is about to be
created, the language is set (see #classClassDefinitionTemplateFor:in:asNamespace:private:metaClassUsed:)
but the selected class/method is the old (i.e., of different
language than currently accepting one. So here, favour the
value of languageHolder as that one is the right one.
Otherwise, not-yet-accepted definition for different language\
won't be properly highlighted!!!!!!"
self codeView isCodeView2 ifTrue:[
| lang |
lang := self codeView languageHolder value.
lang notNil ifTrue:[
highlighterClass := lang syntaxHighlighterClass
].
].
"HACK!!!!!!"
highlighterClass == SyntaxHighlighter ifTrue:[
highlighterClass := SyntaxHighlighter2
].
^ highlighterClass
"Created: / 05-08-2011 / 00:28:03 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified (comment): / 04-08-2013 / 03:45:01 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
syntaxHighlighterForMethod:mthd
|highlighterClass cls |
cls := mthd mclass ? Object.
highlighterClass := mthd syntaxHighlighterClass.
highlighterClass == #askClass ifTrue:[
highlighterClass := cls syntaxHighlighterClass.
].
"When a new class of different language is about to be
created, the language is set (see #classClassDefinitionTemplateFor:in:asNamespace:private:metaClassUsed:)
but the selected class/method is the old (i.e., of different
language than currently accepting one. So here, favour the
value of languageHolder as that one is the right one.
Otherwise, not-yet-accepted definition for different language\
won't be properly highlighted!!!!!!"
self codeView isCodeView2 ifTrue:[
| lang |
lang := self codeView languageHolder value.
lang notNil ifTrue:[
highlighterClass := lang syntaxHighlighterClass
].
].
"HACK!!!!!!"
highlighterClass == SyntaxHighlighter ifTrue:[
highlighterClass := SyntaxHighlighter2
].
(mthd isInstrumented
and:[ self showCoverageInformation value ]) ifTrue:[
(highlighterClass isKindOf: SyntaxHighlighter class) ifTrue:[
highlighterClass := CodeCoverageHighlighter
].
].
^ highlighterClass
"Created: / 28-04-2010 / 12:49:54 / cg"
"Modified (comment): / 04-08-2013 / 03:45:13 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!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"
!
browserCanvasHolder
^self browserCanvas.
"Created: / 07-06-2011 / 16:36:08 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
browserCanvasType
^ browserCanvasType
!
browserCanvasType:aSpecSymbol
browserCanvasType := aSpecSymbol
!
browserCanvasTypeForPage
navigationState ifNil:[^#fullBrowserSpec].
navigationState canvasType ifNil:[^#fullBrowserSpec].
^navigationState canvasType
"Created: / 07-06-2011 / 21:43:19 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
browserCanvasTypeHolder
^(AspectAdaptor forAspect: #spec)
subjectChannel: self browserCanvas.
"Created: / 07-06-2011 / 21:48:58 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
browserPageCanvas
"return a holder on the current canvas"
| canvas |
browserPageCanvas isNil ifTrue:[
browserPageCanvas := ValueHolder new.
canvas := SubCanvas new.
canvas client:self spec:#browserPageSpec builder: builder.
canvas level:0.
canvas origin:0.0@0.0 corner:1.0@1.0.
browserPageCanvas value: canvas.
].
^ browserPageCanvas
"Modified: / 24-02-2000 / 15:11:31 / cg"
"Modified: / 07-06-2011 / 16:34:49 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
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"
!
postBuildCodePaneAndPluginView: aView
self navigationState codePaneAndPluginView: aView
"Created: / 22-09-2010 / 22:07:49 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
postBuildCodeView:codeView
" this is not more called. see #postBuildFixup instead"
builder componentAt:#CodeView put:codeView.
"/ self codeInfoVisible value ifFalse:[
"/ "/ info not visible
"/ bottomOffset := 0.
"/ ] ifTrue:[
"/ "/ info visible
"/ bottomOffset := -25.
"/ ].
"/ codeView layout bottomOffset:bottomOffset.
self updateCodeInfoAndStringSearchToolVisibility.
codeView formatAction:[:code | self formatCode ].
codeView menuHolder:self; menuMessage:#codeViewMenu.
self stringSearchToolVisibleHolder value ifTrue:[
self codeView searchBarActionBlock: self searchBarActionBlock.
].
!
postBuildEditModeInfoLabel:aLabel
aLabel menuHolder:self; menuMessage:#editModeInfoLabelMenu.
!
postBuildEditorNoteBook:editorNoteBook
builder componentAt:#EditorNoteBook put:editorNoteBook.
self navigationState noteBookView: editorNoteBook.
"/ self codeInfoVisible value ifFalse:[
"/ "/ info not visible
"/ bottomOffset := 0.
"/ ] ifTrue:[
"/ "/ info visible
"/ bottomOffset := -25.
"/ ].
"/ editorNoteBook layout bottomOffset:bottomOffset.
self updateCodeInfoAndStringSearchToolVisibility.
editorNoteBook selectConditionBlock:
[:index |
|canSelect editorCanvas method|
canSelect := true.
self showSpecialResourceEditors value ifTrue:[
(method := self theSingleSelectedMethod) notNil ifTrue:[
"/ toggling away from the special editor - see if it was modified and ask for accept if so
navigationState modified ifTrue:[
canSelect := self askIfModified.
]
].
].
canSelect
].
!
postBuildFixup
|newNavigationState orgModeHolder|
newNavigationState := self navigationState.
self assert:newNavigationState canvasType notNil.
newNavigationState isFullClassSourceBrowser ifTrue:[
self hidePrivateClasses value:true.
].
"/ newNavigationState setUpScrollableCodeView.
self editorNoteBookCanvasHolder value:(newNavigationState scrollableCodeView).
self codeView formatAction:[:code | self formatCode].
(self codeView)
menuHolder:self;
menuMessage:#codeViewMenu.
(UserPreferences current useCodeView2In: #Browser) ifTrue:[
self codeView browserHolder value:self
].
UserPreferences current useSearchBarInBrowser
ifTrue:[
"/ self stringSearchToolVisibleHolder value:true. "/ Initially hidden. Show search bar after pressing CTRL+f or clicking view menu
self codeView searchBarActionBlock:self searchBarActionBlock.
].
self normalLabel.
orgModeHolder := self organizerMode.
newNavigationState isNameSpaceBrowser ifTrue:[
orgModeHolder value:(OrganizerCanvas organizerModeNamespace)
] ifFalse:[
newNavigationState isCategoryBrowser ifTrue:[
orgModeHolder value:(OrganizerCanvas organizerModeCategory)
] ifFalse: [
newNavigationState isProjectBrowser ifTrue:[
orgModeHolder value:(OrganizerCanvas organizerModeProject)
].
].
].
self theSingleSelectedMethod notNil ifTrue:[
"/ fetch the initially selected methods code
self methodsSelectionChanged.
] ifFalse: [
self theSingleSelectedClass notNil ifTrue:[
"/ to show the classes definition initially
self classSelectionChanged.
].
].
newNavigationState codeModifiedHolder addDependent:self.
"Modified (format): / 05-07-2011 / 10:32:23 / cg"
"Modified: / 26-07-2011 / 10:29:18 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
postBuildMessagePane: messagePaneView
<resource: #uiCallback>
builder componentAt:#MessagePane put:messagePaneView.
self navigationState messagePaneView: messagePaneView.
"Modified: / 28-08-2010 / 10:37:04 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
postBuildPackageInfoButton: aButton
<resource: #uiCallback>
navigationState packageInfoButton: aButton
"Created: / 03-10-2011 / 15:36:02 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
postBuildSpecialEditor:specialEditorSubcanvas
builder componentAt:#SpecialEditorCanvas put:specialEditorSubcanvas.
!
postBuildStringSearchTool:aStringSearchTool
builder componentAt:#StringSearchTool put: aStringSearchTool.
self navigationState stringSearchToolView: aStringSearchTool.
aStringSearchTool client textView: self codeView.
!
postBuildTabContentView: tabContentView
<resource: #uiCallback>
builder componentAt:#TabContentView put:tabContentView.
self navigationState tabContentView: tabContentView.
"Modified: / 28-08-2010 / 10:37:53 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
postBuildWith:aBuilder
"/ no need to fixup here - I am always installed as subcanvas
"/ (via noteBookView)
super postBuildWith:aBuilder.
environment addDependent:self.
self codeInfoVisible value ifTrue:[ self codeInfoVisibilityChanged ].
(self toolBarVisibleHolder value or:[self bookmarkBarVisibleHolder value]) ifTrue:[
self toolBarOrBookmarkBarVisibilityChanged
].
"/ self editorNoteBookCanvasHolder value:(navigationState scrollableCodeView).
"/ self codeView formatAction:[:code | self formatCode ].
"/ self codeView menuHolder:self; menuMessage:#codeViewMenu.
"Modified: / 24-02-2000 / 16:11:27 / cg"
"Modified: / 18-05-2011 / 17:30:53 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
postOpenWith:aBuilder
self windowGroup addPreEventHook:self.
"/ self window sensor addEventListener:self.
"/ whenever some action takes longer, automatically show a busy cursor.
"/ now done for all windowGroups by the group itself
"/ self windowGroup showWaitCursorWhenBusyForMillis:100.
super postOpenWith:aBuilder.
!
searchFieldCreated:anInputField
anInputField font:(ListView defaultFont).
anInputField emptyFieldReplacementText:
"/(resources string:'Class Search & History').
(resources string:'Search Class/Selector (Ctrl-L)').
"Modified: / 09-02-2010 / 21:56:04 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 07-03-2012 / 11:59:16 / cg"
!
searchFieldPanelCreated:aPanel
aPanel level:(MenuPanel defaultLevel).
aPanel basicViewBackground:(MenuPanel defaultBackgroundColor).
!
windowLabel:aString
navigationState notNil ifTrue:[
navigationState browserLabel:aString
].
self normalLabel.
! !
!NewSystemBrowser methodsFor:'special editors'!
specialEditorCanvasForMethod:aMethod
|methodsResources|
(methodsResources := aMethod resources) notEmptyOrNil ifTrue:[
#( #image #fileImage #programImage #menu #canvas #help #tableColumns )
do:[:triedResourceType |
|editorCanvas list|
(methodsResources includesKey:triedResourceType) ifTrue:[
editorCanvas := navigationState specialEditorCanvasForResourceType:triedResourceType.
editorCanvas notNil ifTrue:[
^ editorCanvas
].
].
].
].
^ nil
!
updateCodeEditorVisibilityForCanvasEditor:editorCanvas class:aClassOrNil method:aMethod
|editorApplication|
self editorNoteBookCanvasHolder value:editorCanvas.
editorApplication := editorCanvas application.
editorApplication masterApplication:self.
aMethod notNil ifTrue:[
editorApplication
specClass:(aMethod mclass theNonMetaclass);
specSelector:(aMethod selector);
loadFromClass:(aMethod mclass theNonMetaclass)
andSelector:(aMethod selector).
] ifFalse:[
editorApplication
specClass:(aClassOrNil theNonMetaclass)
].
!
updateCodeEditorVisibilityForDocumentationOf:aClass
|view comment|
view := navigationState documentationView.
aClass isLoaded ifFalse:[
comment := 'Class is not loaded.'.
] ifTrue:[
comment := aClass comment.
].
view scrolledView contents:comment.
self editorNoteBookCanvasHolder value:view.
!
updateCodeEditorVisibilityForHTMLDocumentationOf:aClass
|text documentView|
documentView := HTMLDocumentView new.
self editorNoteBookCanvasHolder value:(HVScrollableView forView:documentView).
text := HTMLDocGenerator htmlDocOf:aClass.
text notNil ifTrue:[
documentView top:(Smalltalk getSystemFileName:'doc/online/english/classDoc').
documentView nameSpaceForExecution:(aClass nameSpace).
].
documentView setText:text
!
updateCodeEditorVisibilityForInheritanceOf:aClass
|inheritanceView classTreeView|
inheritanceView := navigationState inheritanceView.
classTreeView := inheritanceView scrolledView.
"/ classTreeView := ClassTreeGraphView new.
classTreeView interestingNode:aClass.
classTreeView topNode:(aClass allSuperclasses lastIfEmpty:[aClass]).
classTreeView selectNode:aClass.
classTreeView middleButtonMenu:nil.
classTreeView menuHolder:[ self class inheritanceViewMenu ].
classTreeView menuPerformer:self.
self editorNoteBookCanvasHolder value:inheritanceView.
!
updateCodeEditorVisibilityForLint
!
updateCodeEditorVisibilityForRewrite
!
updateCodeEditorVisibilityForSource
self editorNoteBookCanvasHolder value:(navigationState scrollableCodeView).
!
updateCodeEditorVisibilityForTestRuns
!
updateCodeEditorVisibilityForTypes
!
updateCodeEditorVisibilityForUML
!
updateCodeEditorVisibilityForWelcomePage
|documentView|
documentView := HTMLDocumentView new.
self editorNoteBookCanvasHolder value:(HVScrollableView forView:documentView).
documentView homeDocument:(HTMLDocumentView documentFileFor:'help/Browser/IntroPage.html')
!
updateDiffViewerVisibilityFor:source1 and:source2
|scr diffView|
diffView := DiffCodeView new.
diffView text1:source1 text2:source2.
diffView addNextPreviousButtons.
diffView moveToNextChanged.
scr := HVScrollableView forView:diffView.
self editorNoteBookCanvasHolder value:scr.
!
updateSpecialCodeEditorVisibility
"update the visibility of the special editors in the codeEditor area,
as appropriate to what is shown currently"
|cls mthd|
cls := self theSingleSelectedClass.
mthd := self theSingleSelectedMethod.
"/ temporary kludge: check if the selected method is really still in the class
mthd notNil ifTrue:[
mthd mclass isNil ifTrue:[
mthd := nil
].
].
self
updateSpecialCodeEditorVisibilityForClass:cls
method:mthd
"Created: / 17-08-2006 / 16:46:50 / cg"
!
updateSpecialCodeEditorVisibilityForClass:aClassOrNil method:aMethod
"update the visibility of the special editors in the codeEditor area,
as appropriate to what is shown currently"
|hideSpecialEditor editorCanvas tabList actionList|
"/ that is a first hack - I don't like it, though...
hideSpecialEditor := true.
tabList := OrderedCollection new.
actionList := OrderedCollection new.
self showMultitabMode value ifTrue:[
"/ self halt.
aMethod isNil ifTrue:[
"/ no method selected
aClassOrNil isNil ifTrue:[
(self selectedClassesValue isEmptyOrNil
and:[ self selectedCategoriesValue isEmptyOrNil
and:[ self selectedProjects value isEmptyOrNil
and:[ navigationState isNameSpaceBrowser not
or:[ self selectedNamespaces value isEmptyOrNil ] ]]]) ifTrue:[
"/ no class selected
navigationState isFullBrowser ifTrue:[
tabList add:'Welcome'. actionList add:[ self updateCodeEditorVisibilityForWelcomePage ].
]
].
].
tabList add:'Definition'. actionList add:[ self updateCodeEditorVisibilityForSource ].
aClassOrNil notNil ifTrue:[
"/ tabList add:'Doc-Gen'. actionList add:[ self updateCodeEditorVisibilityForHTMLDocumentationOf:aClassOrNil ].
"/ tabList add:'Comment'. actionList add:[ self updateCodeEditorVisibilityForDocumentationOf:aClassOrNil ].
ClassTreeGraphView notNil ifTrue:[
tabList add:'Inheritance'. actionList add:[ self updateCodeEditorVisibilityForInheritanceOf:aClassOrNil ].
].
"/ tabList add:'UML'. actionList add:[ self updateCodeEditorVisibilityForUMLOf:aClassOrNil ].
"/ tabList add:'Lint'. actionList add:[ self updateCodeEditorVisibilityForLintOf:aClassOrNil ].
"/ tabList add:'Rewrite'. actionList add:[ self updateCodeEditorVisibilityForRewriteOf:aClassOrNil ].
"/ tabList add:'Types'. actionList add:[ self updateCodeEditorVisibilityForTypesOf:aClassOrNil ].
"/ ((aClassOrNil inheritsFrom:TestCase) and:[aClassOrNil isAbstract not]) ifTrue:[
"/ tabList add:'Test'. actionList add:[ self updateCodeEditorVisibilityForTestRunsOf:aClassOrNil ].
"/ ].
].
] ifFalse:[
tabList add:'Source'. actionList add:[ self updateCodeEditorVisibilityForSource ].
"/ tabList add:'Lint'. actionList add:[ self updateCodeEditorVisibilityForLintOfMethod:aMethod ].
].
self selectedMethodsValue size == 2 ifTrue:[
tabList add:'Diff'.
actionList add:[ self updateDiffViewerVisibilityFor:(self selectedMethodsValue first source)
and:(self selectedMethodsValue second source) ].
].
] ifFalse:[
tabList add:'Source'. actionList add:[ self updateCodeEditorVisibilityForSource ].
].
self showSpecialResourceEditors value ifTrue:[
aMethod notNil ifTrue:[
editorCanvas := self specialEditorCanvasForMethod:aMethod.
] ifFalse:[
(aClassOrNil notNil and:[aClassOrNil theNonMetaclass isProjectDefinition]) ifTrue:[
editorCanvas := navigationState specialEditorCanvasForResourceType:#projectDefinition.
].
].
].
editorCanvas notNil ifTrue:[
hideSpecialEditor := false.
tabList add:(editorCanvas application class nameWithoutPrefix asUppercaseFirst).
actionList add:[ self updateCodeEditorVisibilityForCanvasEditor:editorCanvas class:aClassOrNil method:aMethod ].
].
(hideSpecialEditor and:[tabList size = 1]) ifTrue:[
"/ sigh - setting an empty list also changes the selection to 0 (side effect in NoteBookView).
"/ To avoid flickering change messages, preSet its value to 0.
self selectedEditorNoteBookTabIndexHolder setValue:0.
self editorNoteBookListHolder value notEmptyOrNil ifTrue:[
self editorNoteBookListHolder value:#().
].
self updateCodeEditorVisibilityForSource.
] ifFalse:[
tabList = self editorNoteBookListHolder value ifFalse:[
self editorNoteBookListHolder value:tabList.
].
"/ self selectedEditorNoteBookTabIndexHolder value:1.
"/ make one of the codeViews visible...
self selectedEditorNoteBookTabIndexHolder value == 0 ifTrue:[
self selectedEditorNoteBookTabIndexHolder value:1.
^ self.
].
(actionList at:(self selectedEditorNoteBookTabIndexHolder value)) value.
].
"Created: / 17-08-2006 / 16:44:51 / cg"
"Modified: / 28-02-2012 / 17:02:07 / cg"
! !
!NewSystemBrowser methodsFor:'startup & release'!
closeRequest
"asks for permission before closing"
|nModified modifiedBuffers m|
buffers isNil ifTrue:[
(self
askIfModified:'Modifications have not been saved.\\Exit anyway ?'
default:false
withAccept:false
withCompare:true)
ifFalse:[
^ self
].
] ifFalse:[
nModified := 0.
modifiedBuffers := buffers select:[:aBuffer | aBuffer modified].
modifiedBuffers do:[:aBuffer | |bufferIndex|
bufferIndex := buffers identityIndexOf:aBuffer.
self selectedBuffer value:bufferIndex.
(self
askIfModified:(resources stringWithCRs:'Buffer "%1" was modified.\\Exit anyway ?' with:aBuffer nameString allBold)
default:false
withAccept:(self canAcceptCodeIn:aBuffer)
withCompare:(self canCompareCodeIn:aBuffer)
in:aBuffer)
ifFalse:[
^ self
]
]
].
buffers notEmptyOrNil ifTrue:[
buffers do:[:eachNavigationState |
|m|
(m := eachNavigationState theSingleSelectedMethod) notNil ifTrue:[
self addToRecentlyClosedHistory:m mclass selector:m selector
].
]
] ifFalse:[
(m := navigationState theSingleSelectedMethod) notNil ifTrue:[
self addToRecentlyClosedHistory:m mclass selector:m selector
].
].
environment removeDependent:self.
super closeRequest.
"Created: / 11-02-2000 / 13:23:00 / cg"
"Modified: / 09-09-2012 / 10:26:14 / cg"
"Modified: / 02-05-2014 / 17:47:01 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
release
"/ self class classHistory removeDependent:self.
SystemBrowser removeDependent:self.
smalllintRulesOrDefaultHolder notNil ifTrue:[
LastLintRulesHolder removeDependent: smalllintRulesOrDefaultHolder.
].
navigationState := nil.
super release.
"Modified: / 20-11-2006 / 12:16:37 / cg"
"Modified: / 17-12-2014 / 00:39:46 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!NewSystemBrowser methodsFor:'string search tool'!
hideSearchBar
self stringSearchToolVisibleHolder value: false.
!
searchBackwardWithSearchBar
self stringSearchToolView application searchPreviousText.
!
searchBackwardWithSearchBarWith: aString
self setInitialSearchString: aString.
self searchBackwardWithSearchBar.
!
searchBarActionBlock
^ [:how :view |
how == #search ifTrue:[self showSearchBarWith: view searchPatternForSearchBar ].
how == #forward ifTrue:[self searchForwardWithSearchBarWith: view searchPatternForSearchBar ].
how == #backward ifTrue:[self searchBackwardWithSearchBarWith: view searchPatternForSearchBar ].
]
!
searchForwardWithSearchBar
self stringSearchToolView application searchNextText.
!
searchForwardWithSearchBarWith: aString
self setInitialSearchString: aString.
self searchForwardWithSearchBar.
"Modified (comment): / 17-08-2011 / 15:08:29 / cg"
!
setFocusToSearchBar
|stringSearchTool|
stringSearchTool := self stringSearchToolView.
stringSearchTool notNil ifTrue:[
stringSearchTool takeFocus.
stringSearchTool client searchBarOpened.
].
!
setInitialSearchString: aString
|stringSearchTool|
stringSearchTool := self stringSearchToolView client.
stringSearchTool notNil ifTrue:[
aString notEmptyOrNil ifTrue:[
stringSearchTool initialSearchString: aString string.
].
].
!
showSearchBar
self stringSearchToolVisibleHolder value: true.
self setFocusToSearchBar
!
showSearchBarWith:aString
|stringSearchTool|
self stringSearchToolVisibleHolder value: true.
self setInitialSearchString: aString.
stringSearchTool := self stringSearchToolView client.
stringSearchTool notNil ifTrue:[
stringSearchTool setFocusToSearchTextView.
stringSearchTool searchTextStarted.
].
! !
!NewSystemBrowser methodsFor:'user actions'!
backToLastClass
|localHistory globalHistory entry|
"/ try local history
localHistory := self navigationHistory.
localHistory canGoBack ifTrue:[
self goBack.
^ self
].
"/ try global history
globalHistory := self class classHistory.
globalHistory notEmpty ifTrue:[
entry := globalHistory first.
self switchToFindHistoryEntry:entry
]
"Modified: / 01-11-2010 / 18:17:18 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 03-07-2011 / 16:13:29 / cg"
!
bookmarkBarVisibilityChanged
self toolBarOrBookmarkBarVisibilityChanged
"Created: / 18-05-2011 / 17:29:23 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
classCategoryDoubleClicked
"double click on a category: add a buffer on that category"
|cat|
cat := self theSingleSelectedCategory.
cat notNil ifTrue:[
self spawnCategoryBrowserFor:(self selectedCategoriesValue) in:#newBuffer.
^ self
].
"Created: / 18.8.2000 / 20:03:28 / cg"
"Modified: / 18.8.2000 / 20:13:26 / cg"
!
classDoubleClicked
"double click on a class:
if unloaded : load it
if browserStartable : start the application
if it's a testcase : run it
"
|cls clsName organizerModeHolder organizerMode newMode doSwitchDisplayMode|
cls := self theSingleSelectedClass.
cls isNil ifTrue:[^ self].
(navigationState isVersionDiffBrowser
or:[navigationState isCheckOutputBrowser
or:[navigationState isLintResultBrowser]]) ifTrue:[
self spawnFullBrowserInClass:cls selector:nil in:#newBuffer.
^ self
].
self withWaitCursorDo:[
cls := cls theNonMetaclass.
clsName := cls name.
self window sensor shiftDown ifTrue:[
self spawnClassReferencesBrowserFor:(Array with:cls) in:#newBuffer.
^ self.
].
doSwitchDisplayMode := true.
self window sensor metaDown ifFalse:[
(cls isBrowserStartable) ifTrue:[
(self startApplication:cls) ifTrue:[
doSwitchDisplayMode := false.
].
] ifFalse:[
cls isLoaded ifFalse:[
self busyLabel:'loading %1' with:clsName.
self classLoad.
doSwitchDisplayMode := false.
] ifTrue:[
(cls isTestCaseLike and:[cls isAbstract not]) ifTrue:[
self classMenuOpenTestRunnerOn:cls.
doSwitchDisplayMode := false.
].
].
].
].
doSwitchDisplayMode ifTrue:[
organizerModeHolder := navigationState organizerMode.
organizerMode := organizerModeHolder value.
navigationState isLintResultBrowser ifFalse:[
"/ toggle view mode (between category and class hierarchy)
organizerMode == OrganizerCanvas organizerModeClassHierarchy ifTrue:[
newMode := OrganizerCanvas organizerModeCategory
] ifFalse:[
organizerMode == OrganizerCanvas organizerModeCategory ifTrue:[
newMode := OrganizerCanvas organizerModeClassHierarchy
].
].
].
newMode notNil ifTrue:[
organizerModeHolder value:newMode.
self organizerModeForMenu changed.
]
].
self normalLabel.
].
^ self
"Modified: / 06-07-2011 / 14:06:44 / cg"
!
codeCompletion
"/ I found this code 3 times (CodeView2, NewSystemBrowser and DebugView) - smell?
"/ (can we move that to a utility - probably DoWhatIMeanSupport)
|cls codeView languageOrNil|
codeView := self codeView.
cls := self classOfSelectedMethodOrSelectedClass.
cls notNil ifTrue:[
languageOrNil := cls programmingLanguage
].
UserInformation handle:[:ex |
self showInfo:(ex messageText).
ex proceed.
] do:[
self withWaitCursorDo:[
DoWhatIMeanSupport codeCompletionForLanguage:languageOrNil class:cls context:nil codeView:codeView.
]
].
^ self.
"Modified: / 04-07-2006 / 18:48:26 / fm"
"Modified: / 03-07-2011 / 16:18:31 / cg"
"Modified: / 18-09-2013 / 14:17:45 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
codeCompletionForMessage:node inClass:cls
<resource: #obsolete>
|codeView selector receiver nm srchClass implClass
bestSelectors bestPrefixes best nodeVal info numArgs
newParts nSelParts oldLen newLen selectorParts|
self obsoleteMethodWarning.
codeView := self codeView.
selector := node selector.
receiver := node receiver.
receiver isVariable ifTrue:[
nm := receiver name.
nm = 'self' ifTrue:[
srchClass := cls
].
nm = 'super' ifTrue:[
srchClass := cls superclass
].
(Smalltalk includesKey:nm asSymbol) ifTrue:[
nodeVal := Smalltalk at:nm asSymbol.
nodeVal notNil ifTrue:[
srchClass := nodeVal class
]
]
].
receiver isLiteral ifTrue:[
srchClass := receiver value class
].
srchClass notNil ifTrue:[
bestSelectors := Parser findBest:30 selectorsFor:selector in:srchClass forCompletion:true.
(bestSelectors includes:selector) ifTrue:[
bestSelectors := bestSelectors select:[:sel | sel size > selector size].
].
bestSelectors size > 0 ifTrue:[
bestPrefixes := bestSelectors select:[:sel | sel asLowercase startsWith:selector asLowercase].
bestPrefixes size > 0 ifTrue:[
bestSelectors := bestPrefixes
].
best := bestSelectors first.
bestSelectors size > 1 ifTrue:[
best = selector ifTrue:[
best := bestSelectors second.
].
bestSelectors size < 20 ifTrue:[
|idx|
idx := (PopUpMenu labels:bestSelectors) startUp.
idx == 0 ifTrue:[ ^ self].
best := bestSelectors at:idx.
] ifFalse:[
best := Dialog request:'Matching selectors:' initialAnswer:best list:bestSelectors.
best size == 0 ifTrue:[^ self].
].
] ifFalse:[
best := bestSelectors first.
].
implClass := srchClass whichClassIncludesSelector:best.
].
] ifFalse:[
"/ class not known
self withSearchCursorDo:[
bestSelectors := Parser findBest:30 selectorsFor:selector in:nil forCompletion:true.
].
(bestSelectors includes:selector) ifTrue:[
bestSelectors := bestSelectors select:[:sel | sel size > selector size].
].
bestSelectors size > 0 ifTrue:[
best := bestSelectors first.
bestSelectors size > 1 ifTrue:[
best = selector ifTrue:[
best := bestSelectors second.
].
bestSelectors size < 20 ifTrue:[
|idx|
idx := (PopUpMenu labels:bestSelectors) startUp.
idx == 0 ifTrue:[ ^ self].
best := bestSelectors at:idx.
] ifFalse:[
best := Dialog request:'Matching selectors:' initialAnswer:best list:bestSelectors.
best size == 0 ifTrue:[^ self].
]
] ifFalse:[
best := bestSelectors first.
].
implClass := Smalltalk allClasses select:[:cls | (cls includesSelector:best) or:[cls class includesSelector:best]].
implClass size == 1 ifTrue:[
implClass := implClass first.
] ifFalse:[
implClass := nil
]
].
].
best notNil ifTrue:[
info := best storeString.
implClass notNil ifTrue:[
info := implClass name , ' >> ' , info.
].
self showInfo:info.
best ~= selector ifTrue:[
numArgs := best numArgs.
selectorParts := node selectorParts.
nSelParts := selectorParts size.
newParts := best asCollectionOfSubstringsSeparatedBy:$:.
newParts := newParts select:[:part | part size > 0].
codeView
undoableDo:[
|stop|
numArgs > nSelParts ifTrue:[
stop := selectorParts last stop.
"/ append the rest ...
numArgs downTo:nSelParts+1 do:[:idx |
|newPart|
newPart := newParts at:idx.
(best endsWith:$:) ifTrue:[
newPart := newPart , ':'
].
(codeView characterAtCharacterPosition:stop) == $: ifFalse:[
newPart := ':' , newPart.
].
newPart := (codeView characterAtCharacterPosition:stop) asString , newPart.
codeView replaceFromCharacterPosition:stop to:stop with:newPart
]
].
nSelParts downTo:1 do:[:idx |
|newPart oldPartialToken start stop|
newPart := newParts at:idx.
oldPartialToken := selectorParts at:idx.
start := oldPartialToken start.
stop := oldPartialToken stop.
(best endsWith:$:) ifTrue:[
(codeView characterAtCharacterPosition:stop+1) == $: ifFalse:[
newPart := newPart , ':'
]
] ifFalse:[
(codeView characterAtCharacterPosition:stop) == $: ifTrue:[
newPart := newPart , ':'
] ifFalse:[
(codeView characterAtCharacterPosition:stop+1) isSeparator ifFalse:[
newPart := newPart , ' '
]
]
"/ codeView replaceFromCharacterPosition:start to:stop with:(newPart , ':').
"/ ] ifFalse:[
"/ codeView replaceFromCharacterPosition:start to:stop with:newPart.
].
codeView replaceFromCharacterPosition:start to:stop with:newPart.
oldLen := stop - start + 1.
newLen := newPart size.
codeView selectFromCharacterPosition:start+oldLen to:start+newLen-1.
].
codeView dontReplaceSelectionOnInput.
]
info:'completion'.
].
].
"Created: / 10-11-2006 / 13:18:27 / cg"
!
codeInfoVisibilityChanged
self updateCodeInfoAndStringSearchToolVisibility
"/ |visible cFrame bottomOffset|
"/
"/ visible := self codeInfoVisible value.
"/
"/ cFrame := builder findComponentAt:#EditorNoteBook. "/ #CodeView.
"/ cFrame notNil ifTrue:[
"/ visible ifFalse:[
"/ bottomOffset := 0.
"/ ] ifTrue:[
"/ bottomOffset := -25.
"/ ].
"/ cFrame layout bottomOffset:bottomOffset.
"/ cFrame container notNil ifTrue:[
"/ cFrame containerChangedSize.
"/ ].
"/ ].
"/ DefaultCodeInfoVisible := visible
!
codeModified
"invoked when the user edits the text shown in the codeView"
|navigationState codeView|
navigationState := self navigationState.
(codeView := self codeView) modified ifTrue:[
navigationState realModifiedState:true.
codeView isCodeView2 ifFalse:[
self startSyntaxHighlightProcess.
].
navigationState realModifiedState:true.
codeView modifiedChannel setValue:false.
].
self enqueueDelayedCheckReallyModified.
"/ self updateBufferLabel.
"Modified (comment): / 27-09-2011 / 19:04:32 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 29-11-2011 / 13:25:51 / cg"
!
doNotShowInheritedMethods
self methodVisibilityHolder value:#class.
!
hideBookmarkBar
self bookmarkBarVisibleHolder value:false
"Created: / 18-05-2011 / 17:33:21 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
hideToolbar
self toolBarVisibleHolder value:false
"Created: / 10.12.2001 / 21:00:13 / cg"
!
informUserAboutPackage: package configuredManager: cnfManager sourceManager: srcManager
"Opens a dialog informing user that configured source
code manager does not match the source code manager
for source access"
| dialog cnfManagerName srcManagerName |
cnfManager notNil ifTrue:[
cnfManagerName := cnfManager managerTypeName
] ifFalse:[
cnfManagerName := self class resources at: 'Not configured'.
].
srcManager notNil ifTrue:[
srcManagerName := srcManager managerTypeName
] ifFalse:[
srcManagerName := self class resources at: 'Unknown'.
].
dialog := DialogBox new.
dialog label: package, ': source code managers does not match'.
(dialog addTextLabel:
('The default configured source code manager does NOT match\' ,
'the source code manager (SCM) for the shown class/package.\\' ,
'This may mean that you either have not configured the SCM,\',
'or compiled the package using sources\',
'checked out from a different repository or SCM\',
'then the one you have configured for the package') withCRs)
adjust: #left.
(dialog addTextLabel: 'Package: ', package) adjust: #left.
(dialog addTextLabel: 'Configured SCM: ', cnfManagerName) adjust: #left.
(dialog addTextLabel: 'Source SCM: ', srcManagerName) adjust: #left.
dialog addButton:(Button label:'Open SCM Settings' action:[self openSettingsDialogAndSelectSourceCodeManagement]).
dialog addOkButton.
dialog open.
"Created: / 03-10-2011 / 16:22:17 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
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 ]]].
"/
"/ double clicking on wrapped method removes the wrap
"/
aMethod isWrapped ifTrue:[
self debugMenuRemoveBreakOrTrace.
^ self
].
mSelector := aMethod selector.
mClass := aMethod mclass.
mClass isNil ifTrue:[
Dialog information:'oops - method''s class is gone (try to reselect)'.
^ self.
].
isMethodListLikeBrowser ifTrue:[
self window sensor shiftDown ifTrue:[
self spawnFullBrowserInClass:mClass
selector:mSelector
in:(DoubleClickIsOpenBrowser == true ifTrue:[#newBrowser] ifFalse:[#newBuffer]).
^ self
].
].
"/
"/ double clicking on a resource-methods opens
"/ an appropriate editor
"/
(resources := aMethod resources) notNil
ifTrue:[
"/
"/ kludge - this info should come from somewhere else ...
"/
editorClass := self class resourceEditorClassForResources:resources.
editorClass notNil ifTrue: [
mClass isMeta ifTrue:[
"/ these uzdsakfhiv-stupid editors cannot edit nonMeta-methods - sigh
self withExecuteCursorDo:[
editorClass
openOnClass:mClass theNonMetaclass
andSelector:mSelector.
^ self.
]
]
]
].
"/
"/ double clicking on a normal-method adds a buffer on the class;
"/ but not if I am already a class browser.
"/
isMethodListLikeBrowser ifTrue:[
self spawnFullBrowserInClass:mClass selector:mSelector
in:(DoubleClickIsOpenBrowser == true ifTrue:[#newBrowser] ifFalse:[#newBuffer]).
"/
"/ brwsr := self spawnClassBrowserFor:(Array with:mClass) in:#newBuffer.
"/ "/ brwsr selectClass:mClass.
"/ brwsr immediateUpdate value:true.
"/ brwsr selectProtocol:(aMethod category).
"/ brwsr selectMethod:(aMethod).
"/ brwsr immediateUpdate value:false.
^ self
].
"/
"/ double clicking on any other method adds a senders buffer
"/
"/ self
"/ spawnMethodSendersBrowserFor:(Array with:mSelector)
"/ in:#newBuffer
self
spawnMethodInheritanceBrowserFor:(Array with:mSelector)
in:#newBuffer
"Modified: / 14-02-2012 / 11:11:58 / cg"
!
methodDoubleClickedAt:index
|selectedMethods selectedMethod|
selectedMethods := (navigationState selectedMethodsArrayAt:index) value.
selectedMethods size == 1 ifTrue:[
selectedMethod := selectedMethods first.
self methodDoubleClicked:selectedMethod.
]
!
nameSpaceDoubleClicked
"double click on a nameSpace:
add a buffer browsing that namespace"
self withWaitCursorDo:[
DoubleClickIsOpenBrowser == true ifTrue:[
self nameSpaceMenuSpawn
] ifFalse:[
self nameSpaceMenuSpawnBuffer
]
].
self normalLabel.
!
projectDoubleClicked
"double click on a project:
add a buffer browsing that project"
self withWaitCursorDo:[
DoubleClickIsOpenBrowser == true ifTrue:[
self projectMenuSpawn
] ifFalse:[
self projectMenuSpawnBuffer
]
].
self normalLabel.
!
protocolDoubleClicked
"double click on a protocol:
open a full-protocol browser"
"/ self theSingleSelectedProtocol notNil ifTrue:[
"/ self protocolMenuSpawnFullCategoryBuffer
"/ ]
"Modified: / 25-07-2010 / 14:45:46 / cg"
!
showInheritedMethods
self methodVisibilityHolder value:#allButObject.
!
startApplication:clsArg
"double-click on a class to exec; or launch button.
Return true if successful"
|cls args|
cls := clsArg theNonMetaclass.
"/ (cls isBrowserStartable) ifFalse:[^ false].
(cls isVisualStartable) ifTrue:[
self busyLabel:'starting application %1' with:cls name.
MessageNotUnderstood handle:[:ex |
ex selector ~~ #windowSpec ifTrue:[
ex reject.
]
] do:[
cls open.
].
^ true.
].
(cls isStartableWithMain) ifTrue:[
self busyLabel:'invoking main of %1' with:cls name.
(cls class includesSelector:'main') ifTrue:[
"/ (self confirm:('Invoke %1''s main ?' bindWith:clsName)) ifTrue:[
cls main.
"/ ].
^ true.
].
args := Dialog request:'command line arguments:' initialAnswer:'' onCancel:nil.
args isNil ifTrue:[^ false].
cls main:(args asCollectionOfWords).
^ true
].
(cls isStartableWithStart) ifTrue:[
self busyLabel:'invoking start of %1' with:cls name.
"/ (self confirm:('Invoke %1''s start ?' bindWith:clsName)) ifTrue:[
cls start.
"/ ].
^ true.
].
^ false.
!
stringSearchToolVisibilityChanged
|stringSearchToolVisible|
self updateCodeInfoAndStringSearchToolVisibility.
stringSearchToolVisible := self stringSearchToolVisibleHolder value.
stringSearchToolVisible ifTrue:[
self setFocusToSearchBar.
].
!
switchToCategoryView
self organizerMode value:(OrganizerCanvas organizerModeCategory).
self organizerModeForMenu changed
!
switchToClassHierarchyView
self organizerMode value:OrganizerCanvas organizerModeClassHierarchy.
self organizerModeForMenu changed
!
toolBarOrBookmarkBarVisibilityChanged
|toolBarVisible toolBar bookmarkBarVisible bookmarkBar pageContent topOffset h|
toolBar := self componentAt:#ToolBar.
bookmarkBar := self componentAt:#BookmarkBar.
topOffset := 0.
toolBar isNil ifFalse:[
toolBarVisible := self toolBarVisibleHolder value.
DefaultToolBarVisible := toolBarVisible.
toolBarVisible ifTrue:[
topOffset := topOffset + toolBar height.
]
].
bookmarkBar isNil ifFalse:[
bookmarkBarVisible := self bookmarkBarVisibleHolder value.
UserPreferences current showBookmarkBar:bookmarkBarVisible.
bookmarkBarVisible ifTrue:[
h := bookmarkBar height.
bookmarkBar layout
topOffset:topOffset;
bottomOffset:topOffset + h.
bookmarkBar container notNil ifTrue:[
bookmarkBar containerChangedSize.
].
topOffset := topOffset + h.
]
].
"/ cg: the following is wrong - looks ugly in windows style!!
"/ maybe we have to make this depending on some margin?
"/ topOffset := topOffset - 1.
pageContent := self componentAt:
((browserPageCanvas notNil
or:[builder spec name == #browserPageSpec])
ifTrue:[#BrowserPageContents]
ifFalse:[#NoteBook]).
pageContent notNil ifTrue:[
pageContent layout topOffset:topOffset.
pageContent container notNil ifTrue:[
pageContent containerChangedSize.
].
].
"Created: / 18-05-2011 / 17:28:43 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 07-06-2011 / 16:58:59 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 31-12-2011 / 13:18:24 / cg"
!
toolBarVisibilityChanged
self toolBarOrBookmarkBarVisibilityChanged
"/ |visible toolBar noteBook topOffset|
"/
"/ toolBar := self componentAt:#ToolBar.
"/ toolBar isNil ifTrue:[
"/ topOffset := 0.
"/ ] ifFalse:[
"/ visible := self toolBarVisibleHolder value.
"/ DefaultToolBarVisible := visible.
"/ visible ifTrue:[
"/ topOffset := toolBar height.
"/ ]
"/ ].
"/
"/ noteBook := self componentAt:#NoteBook.
"/ noteBook notNil ifTrue:[
"/ noteBook layout topOffset:topOffset.
"/ noteBook container notNil ifTrue:[
"/ noteBook containerChangedSize.
"/ ].
"/ ].
"Modified: / 18-05-2011 / 17:29:08 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
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 selectedClassesValue
variables:type access:#readOrWrite all:true
title:title in:#newBuffer
"Modified: / 28-02-2012 / 16:51:54 / cg"
! !
!NewSystemBrowser methodsFor:'user actions-accepting'!
acceptMethod:codeArg inClass:cls language: languageOrNil check:doCheck
"accept a new method.
Return false, if NOT accepted (i.e. compilation canceled)"
|code cat returnValue newSelector existingMethod language |
code := codeArg asString.
returnValue := false.
language := languageOrNil notNil
ifTrue: [languageOrNil]
ifFalse: [self hasMethodSelected
ifTrue:[self selectedMethodsValue first programmingLanguage]
ifFalse:[cls programmingLanguage]].
"/ A special kludge for Java, sigh.
"/ When Java is code is about to be accepted AND a method is (was) selected,
"/ we end up here. However, when Java is configured to show full source
"/ (a default so far), then we would like to all #doAcceptJavaClassDefinition:
"/ so all modified states and so on are updated correctly. If we won't, then
"/ all the modified state and delayed code update is confused since it assumes
"/ only a method has changed (which may not be true, one could add a field
"/ meanwhile,... So tricky. I (JV) should review fullClassSource mode...
(language isJavaLike and:[ JavaMethod showFullSource ]) ifTrue:[
"/ Q: Maybe we should preserve method selection if possible...
^ self doAcceptJavaClassDefinition: code.
].
"/ a quick parse for the selector, to check if we overwrite an existing method...
newSelector := self selectorOfMethodFromCode:code in:cls.
existingMethod := cls compiledMethodAt:newSelector ifAbsent:[].
cat := self protocolToAcceptMethod:newSelector class:cls.
cat isNil ifTrue:[
cat := cls isMeta
ifTrue:[BrowserList nameListEntryForStatic]
ifFalse:[BrowserList nameListEntryForNonStatic]
].
AbortOperationRequest catch:[
(Class methodRedefinitionNotification) handle:[:ex |
|answer|
answer := SystemBrowser askForPackageChangeFrom:ex oldPackage to:ex newPackage.
(answer ~~ #cancel) ifTrue:[
ex proceedWith:answer
].
] do:[
|codeView breakpoints package oldMethod oldSelector defPackage answer rslt lang wasInstrumented|
codeView := self codeView.
"/ used to be
"/ oldSelector := self theSingleSelectedSelector.
"/ here; however, with Ruby, a funny selector (fact) instead of fact: is returned...
wasInstrumented := false.
oldMethod := self theSingleSelectedMethod.
oldMethod notNil ifTrue:[
oldSelector := oldMethod selector.
(oldSelector isNil and:[existingMethod notNil]) ifTrue:[
"/ wrapped/unwrapped?
true "(existingMethod isWrapped or:[existingMethod isMethodWithBreakpoints])" ifTrue:[
oldSelector := existingMethod selector
]
].
wasInstrumented := oldMethod isInstrumented.
].
"/ check for overwritten version method
(cls isMeta and:[(AbstractSourceCodeManager isVersionMethodSelector:newSelector)]) ifTrue:[
(self confirm:'ATTENTION: you are about to accept the classes version method.
This method is required by the sourceCodeManager and should correctly return
the classes version as present in the source repository.
An incorrect version method may lead to failures when accessing/showing/changing
the classes source code - i.e. lead to trouble.
You have been warned.
Accept anyway ?')
ifFalse:[
^ false
]
] ifFalse:[
breakpoints := nil.
codeView isCodeView2 ifTrue:[
breakpoints := codeView breakpoints.
].
"/ check if accepting a different selector than the selected one,
"/ and a method for the new selector exists.
(existingMethod notNil and:[oldSelector ~= newSelector]) ifTrue:[
"/ seems to be the same selector; however, we must really compile to see if it is not going
"/ to end up in another namespace. In that case, we give a different warning message.
Parser parseErrorSignal catch:[
"/ BreakpointQuery answer: breakpoints do:[
rslt := language compilerClass
compile:code
forClass:cls
inCategory:cat
notifying:nil
install:false.
"/ ]
].
(rslt notNil and:[ rslt nameSpace notNil ]) ifTrue:[
newSelector := (':',rslt nameSpace name,'::',newSelector) asSymbol.
existingMethod := cls compiledMethodAt:newSelector.
].
].
(existingMethod notNil and:[oldSelector ~= newSelector]) ifTrue:[
answer := OptionBox
request:('You are about to overwrite an existing method.\\Accept anyway ?' withCRs)
label:(resources string:'Attention')
image:(WarningBox iconBitmap)
buttonLabels:(resources array:#('Cancel' 'Compare' 'Yes'))
values:#(false #compare true)
default:false
onCancel:false.
answer == false ifTrue:[ ^ false ].
answer == #compare ifTrue:[
self openDiffViewForText:code againstSourceOfMethod:existingMethod.
^ false
].
]
].
codeView cursorMovementWhenUpdating:nil.
codeView scrollWhenUpdating:nil.
existingMethod notNil ifTrue:[
"keep old package if selector does already exist in class"
package := existingMethod package.
] ifFalse:[
"/ JV: Used to be
"/
"/ cls theNonMetaclass canHaveExtensions ifFalse:[
"/
"/ but this is actually matter of method's language rather than class's language.
"/ Otherwise we could not have Smalltalk (Ruby) extensions in Java classes!!
"/
(language notNil and:[language supportsExtensionMethods]) ifFalse:[
defPackage := package := cls package.
] ifTrue:[
defPackage := Class packageQuerySignal query.
].
"/ if in project-mode,
"/ assign the currently selected packageID (or ask, if there is none or multiple)
"/ otherwise, use the current project
(navigationState isProjectBrowser
or:[navigationState organizerMode value == OrganizerCanvas organizerModeProject])
ifTrue:[
"/ JV: Used to be
"/
"/ cls theNonMetaclass canHaveExtensions ifFalse:[
"/
"/ but this is actually matter of method's language rather than class's language.
"/ Otherwise we could not have Smalltalk (Ruby) extensions in Java classes!!
"/
(language notNil and:[language supportsExtensionMethods]) ifTrue:[
package := self theSingleSelectedProject.
].
package isNil ifTrue:[
package := self
askForProject:'Method shall be assigned to which project ?'
initialText:(LastAcceptPackage ? cls package).
package isNil ifTrue:[^ false].
LastAcceptPackage := package.
] ifFalse:[
package := package asSymbol.
"/ if the current project is different from the selected one
package ~= defPackage ifTrue:[
"/ and the current project is not the default project
(defPackage = PackageId noProjectID) ifFalse:[
"/ ask
package := self
askForProject:('The browsers selected project is ''%1''\however, your currently active (default) project is ''%2''.\\To which project shall the method be assigned ?'
bindWith:package allBold with:defPackage allBold) withCRs
initialText:package.
package isNil ifTrue:[^ false].
LastAcceptPackage := package.
]
]
].
].
package isNil ifTrue:[ package := defPackage ].
].
lang := oldMethod notNil
ifTrue:[ oldMethod programmingLanguage ]
ifFalse:[ language "cls programmingLanguage" ].
"/ notice: when compiling, the classes change message will already
"/ be noticed by the methodList and lead to an update
"/ to be enqueued.
[
|codeCritics|
"/ cg: for now, only smalltalk critics is possible...
(self enforceCodeStyle and:[lang isSmalltalk]) ifTrue:[
codeCritics := CodeCritics checkCodeQuality:code.
codeCritics notNil ifTrue:[
codeCritics do:[:eachCritic |
codeView
highlightingErrorLine:(eachCritic key)
do:[
Dialog
warn:(resources
stringWithCRs:'Ugly code warning\\ %1\\Please beautify.'
with:eachCritic value allBold).
].
].
].
].
"/ done elsewhere
"/ self enforceComment ifTrue:[
"/ "/ allow simple getters, setters, basicNew etc...
"/ "/ should be coupled with a metric
"/ code asCollectionOfLines size > 3 ifTrue:[
"/ (lang parserClass methodCommentFromSource:code) isEmptyOrNil ifTrue:[
"/ Dialog warn:(resources stringWithCRs:'Bad style: please add a method comment.')
"/ ].
"/ ].
"/ ].
"/ do not react on the methodSelectionChanged notification
"/ (which is enforced by the methodList)
self selectedMethods retractInterestsFor:self.
"/ self immediateUpdate value:true.
"/ Transcript showCR:'accepting in package: ', (package ? '__NoPackage__').
Class packageQuerySignal answer:package do:[ |change|
ClassDescription updateHistoryLineQuerySignal answer:true do:[
(ClassDescription updateChangeFileQuerySignal
, ClassDescription updateChangeListQuerySignal) answer:self suppressChangeSetUpdate not
do:[
Class nameSpaceQuerySignal
answer:(self currentNamespace)
do:[
("self canUseRefactoringSupport"
lang isSmalltalk
and:[(environment at:cls theNonMetaclass name)==cls
and:[cls programmingLanguage == lang
and:[InteractiveAddMethodChange notNil]]]
) ifTrue:[
"/ cg: Q: is the AddMethodChange prepared for languages ?
change := InteractiveAddMethodChange compile:code in:cls classified:cat.
change controller:codeView.
"/ change named:('Accept method ' , newSelector ? '???').
Parser parseErrorSignal handle:[:ex |
rslt := nil.
"/ mh - there was no error reporting then; do it again to get the err
"/ highlighted. What a kludge
"/ BreakpointQuery answer: breakpoints do:[
lang compilerClass
compile:code
forClass:cls
inCategory:cat
notifying:codeView
install:false.
"/ ]
] do:[
BreakpointQuery answer: breakpoints do:[
RefactoryChangeManager performChange: change.
rslt := cls compiledMethodAt:newSelector.
]
]
] ifFalse:[
BreakpointQuery answer: breakpoints do:[
rslt := lang compilerClass
compile:code
forClass:cls
inCategory:cat
notifying:codeView
install:true.
].
].
wasInstrumented ifTrue:[
rslt := InstrumentingCompiler
compile:code
forClass:cls
inCategory:cat
notifying:nil
install:true.
].
].
].
].
].
"/ give subcanvases a chance to synchronize ...
"/ self immediateUpdate value:true.
rslt isMethod ifTrue:[
"/ rslt resourceType == #image ifTrue:[
"/ Icon flushCachedIcons
"/ ].
rslt package. "/ sigh: has side effect of setting the instvar in the method (is this needed?)
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.
].
"/ wasInstrumented ifTrue:[
"/ self recompileMethodWithInstrumentation:rslt.
"/ ].
returnValue := true.
self updateBufferLabel.
].
] ensure:[
"/ do again react on the methodSelectionChanged notification
"/ JV: MUST do it asynchronously because the update is caught
"/ by method list which updates its selection ASYNCHRONOUSLY.
"/ so by pushing this into even queue we make sure that
"/ we re-register ourself AFTER all such delayed updates are
"/ processed.
self window sensor pushAction:[
self selectedMethods onChangeSend:#methodsSelectionChanged to:self.
].
immediateUpdate value:false.
].
]
].
^ returnValue.
"Created: / 30-12-2009 / 20:01:41 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 02-08-2012 / 09:37:29 / cg"
"Modified (format): / 17-08-2014 / 10:12:29 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
askForInitialApplicationCodeFor:aClass
|cls mcls codeAspect msg|
cls := aClass theNonMetaclass.
mcls := aClass theMetaclass.
codeAspect := self codeAspect.
codeAspect == #newApplication ifTrue:[ msg := 'Generate initial application code?' ].
codeAspect == #newConsoleApplication ifTrue:[ msg := 'Generate initial console application code?' ].
codeAspect == #newStandaloneApplication ifTrue:[ msg := 'Generate initial application code?' ].
codeAspect == #newDialog ifTrue:[ msg := 'Generate initial dialog code?' ].
codeAspect == #newWebService ifTrue:[ msg := 'Generate initial webService code?' ].
codeAspect == #newWebPage ifTrue:[ msg := 'Generate initial webPage code?' ].
codeAspect == #newWidget ifTrue:[ msg := 'Generate initial widget code?' ].
(msg notNil and:[self confirm:(resources string:msg)])
ifTrue:[
SmalltalkCodeGeneratorTool createDocumentationMethodsFor:mcls.
(codeAspect == #newWebService) ifTrue:[
SmalltalkCodeGeneratorTool createWebServiceCodeFor:cls.
^ self.
].
(codeAspect == #newWebPage) ifTrue:[
SmalltalkCodeGeneratorTool createWebPageCodeFor:cls.
^ self.
].
codeAspect == #newApplication ifTrue:[
SmalltalkCodeGeneratorTool createExamplesMethodFor:mcls.
SmalltalkCodeGeneratorTool createApplicationCodeFor:cls.
].
codeAspect == #newConsoleApplication ifTrue:[
SmalltalkCodeGeneratorTool createApplicationCodeFor:cls.
].
codeAspect == #newStandaloneApplication ifTrue:[
SmalltalkCodeGeneratorTool createStandaloneStartupCodeFor:cls
].
codeAspect == #newWidget ifTrue:[
SmalltalkCodeGeneratorTool createWidgetCodeFor:cls.
].
^ self.
].
(codeAspect == #newTestCase) ifTrue:[
SmalltalkCodeGeneratorTool createDocumentationMethodsFor:mcls.
SmalltalkCodeGeneratorTool createTestCaseSampleCodeFor:cls.
^ self.
]
"Modified: / 31-01-2011 / 18:29:32 / cg"
!
checkCodeQuality:code
code asCollectionOfLines keysAndValuesDo:[:lineNr :eachLine |
|lineString column|
lineString := eachLine string.
(lineString withoutLeadingSeparators startsWith:'^') ifTrue:[
column := lineString indexOf:$^.
(column-1) \\ 4 ~~ 0 ifTrue:[
^ (lineNr -> 'bad indentation').
].
]
].
^ nil
!
classToAcceptMethodIn
| cls mthd className classes classNameList initial commonSuper|
cls := self theSingleSelectedClass.
cls isNil ifTrue:[
mthd := self theSingleSelectedMethod.
mthd notNil ifTrue:[
mthd isWrapped ifTrue:[ mthd := mthd originalMethod ].
cls := mthd mclass.
cls isNil ifTrue:[
cls := mthd getMclass.
].
]
].
cls isNil ifTrue:[
classes := self selectedClassesValue.
classes isEmptyOrNil ifTrue:[
self warn:'oops class is gone; reselect and try again'.
^ nil
].
"/ ask for class in which to accept
commonSuper := Behavior commonSuperclassOf:classes.
(classes includes:commonSuper) ifTrue:[
initial := commonSuper name.
].
classNameList := classes collect:[:cls|cls name].
classNameList size > 0 ifTrue:[
classNameList addLast:'-'.
classNameList addLast:'*'.
].
className := Dialog
request:'Accept code for which class ? ("*" for all)'
initialAnswer:initial
list:classNameList.
className size == 0 ifTrue:[
^ nil
].
className = '*' ifTrue:[
^ classes asArray.
].
cls := environment at:className asSymbol.
cls isNil ifTrue:[
self warn:'No such class - try again'.
^ nil
].
].
^ cls
"Modified: / 28-02-2012 / 16:48:55 / cg"
!
doAcceptClassAspect:aspect get:getSelector set:setSelector code:theCode
"accept comment or primitiveDefs/vars/funs (in the codeView)."
|codeView currentClass|
codeView := self codeView.
currentClass := self theSingleSelectedLoadedNonMetaclassOrNil.
currentClass isNil ifTrue:[
^ self warn:'oops - no loaded class selected'
].
((currentClass class includesSelector:getSelector)
or:[ (currentClass class includesSelector:setSelector) ]) ifTrue:[
self warn:('The "%1"-class redefines the "%2" and/or the "%3"-message.\\The Accept may fail - please check manually.'
bindWith:currentClass name allBold
with:getSelector allBold
with:setSelector allBold) withCRs.
].
[
environment removeDependent:self. "/ avoid update
ClassDescription updateHistoryLineQuerySignal answer:true do:[
(ClassDescription updateChangeFileQuerySignal
, ClassDescription updateChangeListQuerySignal) answer:self suppressChangeSetUpdate not
do:[
currentClass perform:setSelector with:theCode asString string.
].
].
codeView contents:(currentClass perform:getSelector).
codeView modified:false.
navigationState realModifiedState:false.
] ensure:[
environment addDependent:self.
].
self codeAspect:aspect.
"Modified: / 01-03-2007 / 20:53:42 / cg"
!
doAcceptClassComment:theCode
"accept a classComment (in the codeView)."
self doAcceptClassAspect:#classComment get:#comment set:#comment: code:theCode
!
doAcceptClassDefinition:theCode fullClass:thisIsAFullClassesCode usingCompiler:aCompilerClass
"tell the codeView what to do on accept.
Return false, if NOT accepted (i.e. compilation canceled).
Ouch: this shares a lot of duplicate code with setAcceptActionForClass;
please refacor"
|codeView returnValue package|
returnValue := false.
codeView := self codeView.
codeView modified:false.
self withExecuteCursorDo:[
|currentCategory currentClass ns|
currentClass := self theSingleSelectedClass.
currentClass notNil ifTrue:[
ns := currentClass nameSpace
] ifFalse:[
ns := nil
].
ns := nil. "/ experimental - needed for JS parsing; is it still needed for ST ?
currentCategory := self theSingleSelectedCategory.
currentCategory isNil ifTrue:[
currentClass notNil ifTrue:[
currentCategory := currentClass category
]
].
self organizerMode value == OrganizerCanvas organizerModeProject ifTrue:[
currentClass notNil ifTrue:[
package := currentClass package.
] ifFalse:[
package := self theSingleSelectedProject.
].
package isNil ifTrue:[
package := Dialog request:'Add to which project ?'.
package size == 0 ifTrue:[^ self].
].
package := package asSymbol.
] ifFalse:[
package := Class packageQuerySignal query.
].
Class classCategoryQuerySignal answer:(currentCategory ? '* as yet unspecified *')
do:[
Class packageQuerySignal answer:package
do:[
Class nameSpaceQuerySignal handle:[:ex |
ns isNil ifTrue:[
ex reject
].
ex proceedWith:ns
] do:[
AbortOperationRequest catch:[
UndefinedObject createMinimumProtocolInNewSubclassQuery
answer:true
do:[
(Class classRedefinitionNotification) handle:[:ex |
|answer|
"/ cg: now always keep the old packageID
Class catchClassRedefinitions ifFalse:[
ex proceedWith:#keep
].
answer := OptionBox
request:
('You are about to change the definition of a class from another (system-) package.
The class is part of the ''%1'' package.
PS: you can disable this check in the launchers settings-compilation dialog.'
bindWith:(ex oldPackage allBold))
label:'Class redefinition'
image:(WarningBox iconBitmap)
buttonLabels:#('Cancel' 'Continue')
values:#(#cancel #keep)
default:#keep
onCancel:#cancel.
(answer ~~ #cancel) ifTrue:[
ex proceedWith:answer
]
] do:[
|rslt cls mcls|
"/ self immediateUpdate value:true.
navigationState realModifiedState:false.
navigationState modified:false.
ClassDescription updateHistoryLineQuerySignal answer:true do:[
(ClassDescription updateChangeFileQuerySignal
, ClassDescription updateChangeListQuerySignal) answer:self suppressChangeSetUpdate not
do:[
thisIsAFullClassesCode ifTrue:[
rslt := (ReadStream on:theCode asString) fileIn.
] ifFalse:[
ClassBuildError handle:[:ex |
self warn:ex description
] do:[
rslt := (aCompilerClass ? Compiler)
evaluate:theCode asString string
notifying:codeView
compile:false.
].
].
].
].
"/ self immediateUpdate value:false.
(rslt isBehavior and: [rslt programmingLanguage isSmalltalk]) ifTrue:[
"/ look for a comment and generate a documentation method if so
|parser tree comment|
parser := Parser new.
parser
source:theCode asString string;
saveComments:true.
tree := parser
parseExpressionWithSelf:nil
notifying:nil
ignoreErrors:true
ignoreWarnings:true
inNameSpace:nil.
parser nextToken.
(rslt class implements:#documentation) ifFalse:[
comment := (parser comments collect:[:c | c string]) asStringCollection asString.
(comment includesString:'no comment') ifFalse:[
(comment includesString:'the above text has been extracted') ifFalse:[
(comment includesString:'the empty string arguments by true values') ifFalse:[
rslt class
compile:'documentation\"' withCRs,comment,'"'
classified:'documentation'.
]
]
]
].
self switchToClass:rslt.
"/ self switchToClassNamed:rslt name.
returnValue := true.
] ifFalse:[
"/ Switch to class even it is not a Smalltalk class!!"
rslt isBehavior ifTrue:[
self switchToClass:rslt.
].
].
returnValue ifTrue:[
cls := rslt theNonMetaclass.
mcls := rslt theMetaclass.
self askForInitialApplicationCodeFor:mcls.
].
]
]
].
].
].
]
].
self codeAspect:SyntaxHighlighter codeAspectClassDefinition.
^ returnValue
"Created: / 13-02-2000 / 22:43:59 / cg"
"Modified: / 22-07-2013 / 13:47:45 / cg"
"Modified: / 04-08-2013 / 03:46:23 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
doAcceptClassDefinition:theCode usingCompiler:aCompilerClass
"tell the codeView what to do on accept.
Return false, if NOT accepted (i.e. compilation canceled)"
^ self
doAcceptClassDefinition:theCode
fullClass:false
usingCompiler:aCompilerClass
"Modified: / 24.2.2000 / 15:40:11 / cg"
!
doAcceptClassPrimitive:theCode
"accept primitive-definitions/functions or variables (in the codeView)."
|codeAspect setter getter|
codeAspect := self codeAspect.
codeAspect == #primitiveDefinitions ifTrue:[
getter := #'primitiveDefinitionsString'.
setter := #'primitiveDefinitions:'.
] ifFalse:[
codeAspect == #primitiveFunctions ifTrue:[
getter := #'primitiveFunctionsString'.
setter := #'primitiveFunctions:'.
] ifFalse:[
codeAspect == #primitiveVariables ifTrue:[
getter := #'primitiveVariablesString'.
setter := #'primitiveVariables:'.
] ifFalse:[
self error:'unknown codeAspect: ', codeAspect printString.
]
]
].
self doAcceptClassAspect:codeAspect get:getter set:setter code:theCode.
!
doAcceptCodeIn:aNavigationState
"accept changed code in aNavigationState"
|acceptAction codeView codeAspect|
codeView := aNavigationState codeView.
acceptAction := codeView acceptAction.
acceptAction isNil ifTrue:[^ self].
codeAspect := aNavigationState codeAspect.
(codeAspect == SyntaxHighlighter codeAspectClassDefinition
or:[codeAspect == SyntaxHighlighter codeAspectMethod]) ifTrue:[
acceptAction value:(codeView contentsAsString)
].
"Modified: / 27-07-2012 / 22:25:11 / cg"
!
doAcceptFullClassDefinition:theCode usingCompiler:aCompilerClass
"tell the codeView what to do on accept.
Return false, if NOT accepted (i.e. compilation canceled)"
^ self
doAcceptClassDefinition:theCode
fullClass:true
usingCompiler:aCompilerClass
"Created: / 24.2.2000 / 15:40:19 / cg"
!
doAcceptFullJavaClassDefinition:theCode
"tell the codeView what to do on accept.
Return false, if NOT accepted (i.e. compilation canceled)"
self warn:'Accept of Java classes is not yet implemented'.
^ false
!
doAcceptGroovyClassDefinition:theCode
| newClass |
newClass := GroovyCompiler compile: theCode string.
newClass isNil ifTrue:[ ^ self ].
newClass isBehavior ifTrue:[
self switchToClass:newClass.
].
self codeAspect: #classDefinition
"Created: / 18-02-2012 / 18:54:58 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
doAcceptJavaClassDefinition:theCode
"Called upon accepting Java Class definition
Return false, if NOT accepted (i.e. compilation canceled)"
"Hack for now - when a Java class is changed and accepted, it is recompiled
using GroovyCompiler (which effectively turn it into Groovy class)"
| compiler newClass |
compiler := JavaLanguage instance compilerClass.
compiler notNil ifTrue:[
newClass := compiler compile: theCode register: true notifying: self.
newClass isNil ifTrue:[ ^ false ].
newClass isBehavior ifTrue:[
navigationState realModifiedState:false.
navigationState modified:false.
self switchToClass:newClass.
].
^true.
].
self warn:'No JavaCompiler found, so accepting Java code is not possible.'.
^ false
"Modified: / 17-08-2014 / 09:50:14 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
doAcceptMethod:theCode language: languageOrNil
"accept a new/modified method using given language"
|codeWithoutEmphasis classOrClassCollection|
theCode isStringCollection ifTrue:[
codeWithoutEmphasis := theCode
collect:[:eachLine |
eachLine isNil ifTrue:[
nil
] ifFalse:[
eachLine string
]
].
] ifFalse:[
codeWithoutEmphasis := theCode
].
classOrClassCollection := self classToAcceptMethodIn.
classOrClassCollection notNil ifTrue:[
self
withWaitCursorVisibleDo:[
classOrClassCollection isArray ifTrue:[
classOrClassCollection do:[:eachClass |
self
acceptMethod:codeWithoutEmphasis
inClass:eachClass
language: languageOrNil
check:false.
].
] ifFalse:[
self
acceptMethod:codeWithoutEmphasis
inClass:classOrClassCollection
language: languageOrNil
check:true.
].
]
].
"Created: / 30-12-2009 / 20:02:51 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
doSaveInSpecialEditors
"accept changes in special editor"
self navigationState doSaveInSpecialEditors.
!
enforceCodeStyle
^ UserPreferences current enforceCodeStyle
!
enforceComment
^ UserPreferences current enforceComment
"Created: / 17-07-2010 / 14:18:26 / cg"
!
nameOfMethodFromCode:someCode in:aClass
|parser|
parser := aClass parserClass
parseMethodSpecification:someCode asString
in:aClass
ignoreErrors:true ignoreWarnings:true.
(parser notNil and:[parser ~~ #Error]) ifTrue:[
^ parser name.
].
^ nil
"Modified: / 23-04-2009 / 09:32:05 / Jan Vrany <vranyj1@fel.cvut.cz>"
"Created: / 24-08-2009 / 09:31:43 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
openDiffViewForText:theCode againstSourceOfMethod:aMethod
|originalSource changedSource v|
originalSource := aMethod source.
changedSource := theCode asString string.
v := DiffCodeView
openOn:changedSource
label:(resources string:'Code here (to be accepted ?)')
and:originalSource
label:(resources string:'Method''s actual code').
v topView label:(resources string:'Comparing methods').
v waitUntilVisible.
!
protocolToAcceptMethod:selector class:aClass
| cat mthd protocols |
aClass supportsMethodCategories ifFalse:[ ^ nil ].
mthd := self theSingleSelectedMethod.
mthd notNil ifTrue:[
cat := mthd category.
cat isNil ifTrue:[
"/ Unbound / Missing method?
mthd := aClass lookupMethodFor: selector.
cat := mthd category.
]
] ifFalse:[
protocols := self selectedMethodsValue collect:[:m | m category] as:Set.
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
"Modified: / 28-02-2012 / 16:42:53 / cg"
"Modified: / 07-08-2013 / 12:49:34 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
selectorAndNameOfMethodFromCode:someCode in:aClass
|parser|
parser := aClass parserClass
parseMethodSpecification:someCode asString
in:aClass
ignoreErrors:true ignoreWarnings:true.
(parser notNil and:[parser ~~ #Error]) ifTrue:[
^Array
with: parser selector asSymbol
with: parser name
].
^ nil
"Modified: / 23-04-2009 / 09:32:05 / Jan Vrany <vranyj1@fel.cvut.cz>"
"Created: / 24-08-2009 / 09:40:50 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
selectorOfMethodFromCode:someCode in:aClass
"a quick parse for the selector - is done BEFORE we actually compile something,
to be able to get the existing method's category (q: is that really needed - can change
the category afterwards, if the compiled method is installed late)"
|parser|
"/ that's a stupid interface - should ask for a tree and then for a selector...
parser := aClass parserClass
perform:#'parseMethodSpecification:in:ignoreErrors:ignoreWarnings:'
withArguments:(Array with:(someCode asString)
with:aClass
with:true
with:true)
ifNotUnderstood:[ nil ].
(parser notNil and:[parser ~~ #Error]) ifTrue:[
parser selector notNil ifTrue:[
^ parser selector asSymbol.
].
].
^ nil
"Modified: / 23-04-2009 / 09:32:05 / Jan Vrany <vranyj1@fel.cvut.cz>"
!
selectorOfMethodFromCode:someCode in:aClass language: language
|parser|
parser := language parserClass
parseMethodSpecification:someCode asString
in:aClass
ignoreErrors:true ignoreWarnings:true.
(parser notNil and:[parser ~~ #Error]) ifTrue:[
^ parser selector asSymbol.
].
^ nil
"Modified: / 23-04-2009 / 09:32:05 / Jan Vrany <vranyj1@fel.cvut.cz>"
"Created: / 30-12-2009 / 20:06:20 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
setAcceptAction:aBlockOrNil
"tell the codeView what to do on accept"
|codeView|
(codeView := self codeView) notNil ifTrue:[
codeView acceptAction:aBlockOrNil.
].
!
setAcceptActionForClass
"tell the codeView what to do on accept and explain"
self setAcceptActionForMetaClassUsed:nil
!
setAcceptActionForClassComment
"tell the codeView what to do on accept"
|currentClass|
currentClass := self theSingleSelectedClass.
(currentClass isNil
or:[ currentClass programmingLanguage isSmalltalk not
or:[ currentClass isRealNameSpace ]])
ifTrue:[
self setAcceptActionForNothing.
^ self
].
self setAcceptAction:[:theCode | self doAcceptClassComment:theCode].
"Modified: / 10-11-2006 / 17:14:28 / cg"
!
setAcceptActionForJavaClass
"tell the codeView what to do on accept and explain"
|currentClass action|
currentClass := self theSingleSelectedClass.
currentClass isGroovyClass ifTrue:[
action := [:theCode | self doAcceptGroovyClassDefinition:theCode asString string]
] ifFalse:[
navigationState isFullClassSourceBrowser ifTrue:[
action := [:theCode | self doAcceptFullJavaClassDefinition:theCode asString string].
] ifFalse:[
action := [:theCode | self doAcceptJavaClassDefinition:theCode asString string].
].
].
self setAcceptAction:action.
"Modified: / 07-08-2013 / 02:56:16 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
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 notNil and:[currentClass theNonMetaclass isJavaClass]) ifTrue:[
^ self setAcceptActionForJavaClass.
].
].
(currentClass isRealNameSpace) ifTrue:[
self setAcceptActionForNothing.
^ self
].
metaClassUsedOrNil notNil ifTrue:[
compiler := metaClassUsedOrNil basicNew realSubclassDefinerClass
] ifFalse:[
compiler := currentClass
ifNil:[Compiler]
ifNotNil:[ (currentClass subclassDefinerClass ? Compiler) ].
].
navigationState isFullClassSourceBrowser ifTrue:[
action := [:theCode | self doAcceptFullClassDefinition:theCode
usingCompiler:compiler
].
] ifFalse:[
action := [:theCode | self doAcceptClassDefinition:theCode
usingCompiler:compiler
].
].
self setAcceptAction:action.
"Modified: / 10-11-2006 / 17:14:34 / cg"
"Modified: / 02-09-2013 / 09:41:59 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
setAcceptActionForMethod
" means class's own language"
self setAcceptActionForMethodUsingLanguage: nil
"Modified: / 30-12-2009 / 20:04:02 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
setAcceptActionForMethodUsingLanguage: languageOrNil
"tell the codeView what to do on accept"
| codeView |
self setAcceptAction:
[:theCode |
self doAcceptMethod:theCode language: languageOrNil
].
(codeView := self codeView) notNil ifTrue:[
codeView
explainAction:
[:theCode :theSelection |
self explain:theSelection inCode:theCode
].
codeView isCodeView2 ifTrue:[
languageOrNil notNil ifTrue:[
codeView languageHolder value: languageOrNil.
]
]
]
"Created: / 30-12-2009 / 20:03:29 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 20-07-2010 / 15:55:11 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
setAcceptActionForNothing
"tell the codeView what to do on accept"
self setAcceptAction:[:code | self window beep].
!
setAcceptActionForProjectComment
"tell the codeView what to do on accept"
self setAcceptAction:[:code | |package project|
package := self theSingleSelectedProject.
project := Project projectWithId:package.
project isNil ifTrue:[
self warn:'No such project.'
] ifFalse:[
project comment:(code asString string).
navigationState modified:false.
navigationState realModifiedState:false.
].
].
!
setDoitActionForClass
"tell the codeView what to do on doIt"
"set self for doits. This allows accessing the current class
as self, and access to the class variables by name.
Also, the current nameSpace (if there is one) is set for
the doIt.
"
|codeView|
codeView := self codeView.
codeView isNil ifTrue:[^ self].
codeView doItAction:[:theCode |
|compiler nsName ns currentClass currentNonMetaClass currentMethod result|
currentClass := self theSingleSelectedClass.
currentClass isNil ifTrue:[
currentMethod := self theSingleSelectedMethod.
currentMethod notNil ifTrue:[
currentClass := currentMethod mclass
]
].
currentClass notNil ifTrue:[
currentNonMetaClass := currentClass theNonMetaclass.
ns := currentNonMetaClass nameSpace
] ifFalse:[
self organizerMode == OrganizerCanvas organizerModeNamespace ifTrue:[
nsName := self theSingleSelectedNamespace.
nsName notNil ifTrue:[
ns := NameSpace name:nsName
].
]
].
[
compiler := nil.
codeView isCodeView2 ifTrue:[
codeView languageHolder value notNil ifTrue:[
compiler := codeView languageHolder value evaluatorClass.
].
].
compiler isNil ifTrue:[
currentClass isNil ifTrue:[
compiler := Compiler
] ifFalse:[
compiler := currentClass evaluatorClass
].
].
result := compiler
evaluate:theCode string
in:nil
receiver:currentNonMetaClass
notifying:codeView
logged:false
ifFail:nil.
] on: Class nameSpaceQuerySignal do:[:ex |
ns isNil ifTrue:[
ex reject
].
ex proceedWith:ns
].
result
].
"Created: / 23-02-2000 / 11:54:24 / cg"
"Modified (format): / 20-02-2015 / 08:44:37 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
setNoAcceptAction
"tell the codeView what accept is not allowed"
self setAcceptAction:[:code | self codeView flash].
! !
!NewSystemBrowser methodsFor:'user actions-class'!
classLoad
"load an autoloaded class.
Invoked on doubleClick on a class or via the menu"
self loadClasses:self selectedClassesValue.
"/ to force update.
"/ (I guess, this is not needed)
self selectedClasses value:(self selectedClassesValue copy).
"Modified: / 28-02-2012 / 16:45:33 / cg"
!
classMenuUnload
"unload an autsoloaded class"
self unloadClasses:self selectedNonMetaclasses.
"/ to force update.
"/ (I guess, this is not needed)
self selectedClasses value:(self selectedClassesValue copy).
"Modified: / 28-02-2012 / 16:48:42 / cg"
!
classReload
"reload an autoloaded class"
|classes names|
classes := self selectedClassesValue.
names := classes collect:[:cls | cls name].
self unloadClasses:classes.
self loadClasses:(names collect:[:nm | environment classNamed:nm]).
"/ to force update.
"/ (I guess, this is not needed)
self selectedClasses value:(self selectedClassesValue copy).
"Created: / 04-07-2011 / 18:10:08 / cg"
!
loadClasses:aCollectionOfClasses
"load a collection of autoloaded classes.
Invoked on doubleClick on an unloaded class or via the menu"
[
|numClasses|
numClasses := aCollectionOfClasses size.
aCollectionOfClasses do:[:eachClass |
|cls nm nameShown msg|
cls := eachClass theNonMetaclass.
cls isLoaded ifFalse:[
nm := cls name.
nameShown := self displayedClassNameOf:cls.
Autoload autoloadFailedSignal handle:[:ex |
msg := 'Autoload of %1 failed.
Check for a file named ''%2.st'' either in the package ''%3''
along your packagePath, or in the current directory.
The packagePath is: %4.
You can also try to load the class(es) from the repository,
via the ''import and load classes'' menu function of the
project list.'.
(cls packageDirectory exists
and:[ (cls packageDirectory
/ ((Smalltalk fileNameForClass:cls),'.st')) exists not
and:[ (cls packageDirectory
/ (cls nameWithoutNameSpacePrefix,'.st')) exists ]])
ifTrue:[
msg := 'Autoload of %1 failed.
The expected file named "%2.st" was not found in the package ''%3''
along your packagePath, or in the current directory.
The packagePath is: { %4 }.
ATTENTION:
However, a file named "%5.st" (without namespace prefix) was found,
but not listed in the abbrev.stc file, which lists different filenames.
Please fix this either by renaming the file, or by fixing "abbrev.stc",
or by regenerating the build support files via
the browser''s project definition class menu.'.
].
msg := (resources string:msg
with:nameShown
with:(Smalltalk fileNameForClass:cls)
with:cls package
with:((Smalltalk packagePath asStringCollection collect:[:s | '"',s,'"']) asStringWith:' , ')
with:(cls nameWithoutNameSpacePrefix allBold)).
numClasses > 1 ifTrue:[
(Dialog
confirm:msg
yesLabel:'OK' noLabel:'Cancel') ifFalse:[^ self].
] ifFalse:[
Dialog warn:msg.
].
ex return.
] do:[
self busyLabel:'loading %1 ...' with:nameShown.
cls autoload.
].
]
].
] ensure:[
self normalLabel.
].
!
unloadClasses:aCollectionOfClasses
"unload an autoloaded classes in aCollectionOfClasses"
|notAutoloaded force|
notAutoloaded := OrderedCollection new.
aCollectionOfClasses do:[:eachClass |
|eachNonMetaClass|
eachNonMetaClass := eachClass theNonMetaclass.
(eachNonMetaClass isLoaded and:[eachNonMetaClass wasAutoloaded not]) ifTrue:[
notAutoloaded add:eachNonMetaClass.
].
].
notAutoloaded notEmpty ifTrue:[
force := Dialog
confirm:(resources
stringWithCRs:(notAutoloaded size == 1
ifTrue:['%1 was not autoloaded.\\Force unloading it anyway ?']
ifFalse:['Some (%2) classes were not autoloaded.\\Force unloading them anyway ?'])
with:notAutoloaded first name
with:notAutoloaded size).
] ifFalse:[
force := false.
].
aCollectionOfClasses do:[:eachClass |
|nm nameShown doIt eachNonMetaClass|
eachNonMetaClass := eachClass theNonMetaclass.
(force or:[(eachNonMetaClass isLoaded and:[eachNonMetaClass wasAutoloaded])]) ifTrue:[
nm := eachNonMetaClass name.
nameShown := self displayedClassNameOf:eachNonMetaClass.
doIt := true.
eachNonMetaClass hasDerivedInstances ifTrue:[
doIt := self confirm:(resources string:'''%1'' has (derived) instances. Unload anyway ?' with:nameShown allBold)
].
doIt ifTrue:[
self busyLabel:'unloading %1 ...' with:nameShown.
[
eachNonMetaClass unload.
] ensure:[
self normalLabel.
].
].
]
].
"Modified: / 12-09-2006 / 13:48:12 / cg"
! !
!NewSystemBrowser methodsFor:'user actions-comparing'!
doCompareIn:aNavigationState
"compare the codeViews contents in a buffer against its original"
|v selectedMethod selectedClass changedSource originalSource|
changedSource := aNavigationState codeView contentsAsString string.
aNavigationState codeAspect == SyntaxHighlighter codeAspectMethod 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 - method''s source is gone. Cannot compare.'.
^ 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 == SyntaxHighlighter codeAspectClassDefinition 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.'.
^ self
].
v := DiffCodeView
openOn:changedSource
label:(resources string:'Changed definition (to be accepted ?)')
and:originalSource
label:(resources string:'Classes actual definition').
v label:(resources string:'Comparing class definitions').
v waitUntilVisible.
^ self
].
^ self.
"Modified: / 27-07-2012 / 22:25:17 / cg"
! !
!NewSystemBrowser methodsFor:'user actions-events'!
keyInCategoryListView:key rawKey:rawKey
"filter keyboard events for some function key.
Return true, if I have eaten the event"
((false "rawKey == #BackSpace") or:[ key == #CursorLeft ]) ifTrue:[
self
enqueueMessage:#backToLastClass
for:self
arguments:#().
^ true
].
(key == #Rename "rawKey == #Cmdr") ifTrue:[
self
enqueueMessage:#categoryMenuRename
for:self
arguments:#().
^ true
].
(key == #Find or:[ key == #FindNext ]) ifTrue:[
self
enqueueMessage:#searchMenuFindClass
for:self
arguments:#().
^ true
].
^ false
!
keyInClassHierarchyListView:key rawKey:rawKey
"filter keyboard events for some function key.
Return true, if I have eaten the event"
((false "rawKey == #BackSpace") or:[ key == #CursorLeft ]) ifTrue:[
self
enqueueMessage:#backToLastClass
for:self
arguments:#().
^ true
].
(key == #Rename "rawKey == #Cmdr") ifTrue:[
self
enqueueMessage:#classMenuRename
for:self
arguments:#().
^ true
].
((key == #Cut) or:[rawKey == #Delete or:[rawKey == #CmdBackSpace]]) ifTrue:[
self
enqueueMessage:#classMenuRemove
for:self
arguments:#().
^ true
].
(key == #Find or:[ key == #FindNext ]) ifTrue:[
self
enqueueMessage:#searchMenuFindClass
for:self
arguments:#().
^ true
].
^ false
"Modified: / 18-06-2015 / 08:06:52 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
keyInClassListView:key rawKey:rawKey
"filter keyboard events for some function key.
Return true, if I have eaten the event"
((false "rawKey == #BackSpace") or:[ key == #CursorLeft ]) ifTrue:[
self
enqueueMessage:#backToLastClass
for:self
arguments:#().
^ true
].
(key == #Rename "rawKey == #Cmdr") ifTrue:[
self
enqueueMessage:#classMenuRename
for:self
arguments:#().
^ true
].
((key == #Cut) or:[rawKey == #Delete or:[rawKey == #CmdBackSpace]]) ifTrue:[
self
enqueueMessage:#classMenuRemove
for:self
arguments:#().
^ true
].
(key == #Find or:[ key == #FindNext ]) ifTrue:[
self
enqueueMessage:#searchMenuFindClass
for:self
arguments:#().
^ true
].
^ false
"Modified: / 27-04-2012 / 13:08:06 / cg"
"Modified: / 18-06-2015 / 08:06:45 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
keyInCodeView:key rawKey:rawKey
"filter keyboard events for Find key (unless typed into the codeView).
Return true, if I have eaten the event"
(UserPreferences current useCodeView2In:#Browser) ifFalse:[
"/ old-style codeView
key == #CodeCompletion ifTrue:[
"/ complete the word before/under the cursor.
self
enqueueMessage:#codeCompletion
for:self
arguments:#().
^ true
].
].
key == #Rename ifTrue:[
self hasLocalVariableSelectedInCodeView ifTrue:[
self
enqueueMessage:#codeMenuRenameTemporary
for:self
arguments:#().
].
^ true
].
^ false
"Modified (format): / 03-07-2011 / 15:48:44 / cg"
"Modified: / 26-07-2011 / 10:29:32 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
keyInMethodCategoryListView:key rawKey:rawKey
"filter keyboard events for some function key.
Return true, if I have eaten the event"
(key == #Rename "rawKey == #Cmdr") ifTrue:[
self
enqueueMessage:#protocolMenuRename
for:self
arguments:#().
^ true
].
(key == #BackSpace) ifTrue:[
self
enqueueMessage:#protocolMenuRemoveAndSelectPrevious
for:self
arguments:#().
^ true
].
(key == #Delete) ifTrue:[
self
enqueueMessage:#protocolMenuRemoveAndSelectNext
for:self
arguments:#().
^ true
].
"/ cg: no longer; these keys are now ALWAYS forwarded to the codeView
"/ (key == #Find or:[ key == #FindNext ]) ifTrue:[
"/ self
"/ enqueueMessage:#searchMenuFindResponseTo
"/ for:self
"/ arguments:#().
"/ ^ true
"/ ].
(rawKey == #Cmdt) ifTrue:[
self
enqueueMessage:#browseMenuMethodsWithString
for:self
arguments:#().
^ true
].
^ false
!
keyInMethodListView:key rawKey:rawKey
"filter keyboard events for some function key.
Return true, if I have eaten the event"
(rawKey == #CtrlCursorUp) ifTrue:[
self
enqueueMessage:#selectorMenuPushUpMethod
for:self
arguments:#().
^ true
].
((key == #Cut) or:[rawKey == #Delete]) ifTrue:[
self
enqueueMessage:#selectorMenuRemoveAndSelectNext "/ #selectorMenuSaveRemove
for:self
arguments:#().
^ true
].
(key == #BackSpace) ifTrue:[
self
enqueueMessage:#selectorMenuRemoveAndSelectNext "/ #selectorMenuSaveRemove
for:self
arguments:#().
^ true
].
(key == #Delete) ifTrue:[
self
enqueueMessage:#selectorMenuRemoveAndSelectNext "/ #selectorMenuSaveRemove
for:self
arguments:#().
^ true
].
(key == #Rename "rawKey == #Cmdr") ifTrue:[
self
enqueueMessage:#selectorMenuRename
for:self
arguments:#().
^ true
].
(rawKey == #Cmdi) ifTrue:[
self
enqueueMessage:#browseImplementorsOf
for:self
arguments:#().
^ true
].
(rawKey == #Cmdt) ifTrue:[
self
enqueueMessage:#browseMenuMethodsWithString
for:self
arguments:#().
^ true
].
"/ cg: no longer; these keys are now ALWAYS forwarded to the codeView
"/ (key == #Find or:[ key == #FindNext ]) ifTrue:[
"/ self
"/ enqueueMessage:#searchMenuFindResponseTo
"/ for:self
"/ arguments:#().
"/ ^ true
"/ ].
^ false
"Modified: / 28-05-2012 / 10:27:03 / cg"
!
keyInProjectListView:key rawKey:rawKey
"filter keyboard events for some function key.
Return true, if I have eaten the event"
((false "rawKey == #BackSpace") or:[ key == #CursorLeft ]) ifTrue:[
self
enqueueMessage:#backToLastClass
for:self
arguments:#().
^ true
].
(key == #Find or:[ key == #FindNext ]) ifTrue:[
self
enqueueMessage:#searchMenuFindClass
for:self
arguments:#().
^ true
].
^ false
!
keyInVariableListView:key rawKey:rawKey
"filter keyboard events for some function key.
Return true, if I have eaten the event"
|variablesToRemove|
((key == #Cut) or:[rawKey == #Delete or:[rawKey == #BackSpace]]) ifTrue:[
variablesToRemove := self selectedVariables value.
variablesToRemove size > 0 ifTrue:[
self
enqueueMessage:#variablesRemoveWithConfirmation
for:self
arguments:#().
].
^ true
].
(key == #Rename "rawKey == #Cmdr") ifTrue:[
self
enqueueMessage:#variablesMenuRename
for:self
arguments:#().
^ true
].
^ false
"Modified: / 27-04-2012 / 13:08:35 / cg"
!
processEvent:anEvent
"filter keyboard events for Find key (unless typed into the codeView).
Return true, if I have eaten the event"
<resource: #keyboard (#Ctrll #FindNext #FindPrev)>
|codeView evView key rawKey sensor|
codeView := self codeView.
(codeView isCodeView2) ifTrue:[
codeView := codeView textView.
].
evView := anEvent targetView.
evView notNil ifTrue:[
anEvent isKeyPressEvent ifTrue:[
key := anEvent key.
rawKey := anEvent rawKey.
rawKey == #Ctrll ifTrue:
[(self componentAt: #SearchedClassNameComboBox) takeFocus.
^true].
(evView isSameOrComponentOf:codeView) ifTrue:[
^ self keyInCodeView:key rawKey:rawKey
].
"/ key == #Find ifTrue:[
"/ self
"/ enqueueMessage:#searchMenuFindClass
"/ for:self
"/ arguments:#().
"/ ^ true
"/ ].
"/ key == #Cmdt ifTrue:[
"/ self
"/ enqueueMessage:#browseMenuMethodsWithString
"/ for:self
"/ arguments:#().
"/ ^ true
"/ ].
(self view:evView belongsToSubApplication:self categoryListApp) ifTrue:[
^ self keyInCategoryListView:key rawKey:rawKey
].
(self view:evView belongsToSubApplication:self projectListApp) ifTrue:[
^ self keyInProjectListView:key rawKey:rawKey
].
(self view:evView belongsToSubApplication:self classListApp) ifTrue:[
^ self keyInClassListView:key rawKey:rawKey
].
(self view:evView belongsToSubApplication:self classHierarchyListApp) ifTrue:[
^ self keyInClassHierarchyListView:key rawKey:rawKey
].
"/ cg: these keys are now ALWAYS forwarded to the codeView
(false "key == #Find" or:[ key == #FindNext or:[ key == #FindPrev ]]) ifTrue:[
anEvent dispatchTo:self codeView.
^ true
].
(self view:evView belongsToSubApplication:self methodCategoryListApp) ifTrue:[
^ self keyInMethodCategoryListView:key rawKey:rawKey
].
(self view:evView belongsToSubApplication:self methodListApp) ifTrue:[
^ self keyInMethodListView:key rawKey:rawKey
].
(self view:evView belongsToSubApplication:navigationState variableListApplication) ifTrue:[
^ self keyInVariableListView:key rawKey:rawKey
].
].
anEvent isButtonReleaseEvent ifTrue:[
anEvent delegatedFrom isNil ifTrue:[
evView == codeView ifTrue:[
self codeInfoVisible value ifTrue:[
self doImmediateExplaining value ifTrue:[
anEvent delegatedFrom:self.
sensor := evView sensor.
sensor pushEvent:anEvent. "/ must be first in queue
"/ (for the buttonRelease to be processed)
self
enqueueMessage:#delayedExplainSelection
for:self
arguments:#() .
^ true "/ release event has been added already
].
].
]
]
].
].
anEvent isButtonMultiPressEvent ifTrue:[
(anEvent view name = 'CursorLineLabel'
or:[ anEvent view name = 'CursorLineAndColumnLabel' ]) ifTrue:[
self codeView gotoLine
].
].
^ false
"Modified: / 10-12-2001 / 21:02:48 / cg"
"Modified: / 09-08-2009 / 09:40:30 / Jan Vrany <vranyj1@fel.cvut.cz>"
"Modified: / 17-08-2011 / 13:29:24 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!NewSystemBrowser methodsFor:'user actions-helpers'!
showMessage: aString
self inlineMessageApp showMessage: aString.
"/ OLD CODE
"/ self messageHolder value: aString.
"/ self showMessagePane: #messageInfoSpec.
"
WindowGroup activeApplication showMessage: 'Hello'
"
"Created: / 28-08-2010 / 11:47:02 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 25-03-2014 / 18:16:02 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
showMessage:message while:block
"used for long-during operations: show a progressbar and a message in the top pane,
while executing block"
^ self showMessage:message while:block inBackground: false
"Created: / 28-08-2010 / 20:10:18 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 15-05-2012 / 10:47:31 / cg"
!
showMessage:message while:block inBackground:inBackgroundBoolean
"used for long-running lint operations: show a progressbar and a message in the top pane,
optionally execute block in another (background-) thread"
| panel blocker |
panel := self inlineMessageApp.
inBackgroundBoolean ifTrue:[
panel showProgressLabeled: message while: block.
] ifFalse:[
"/ InlineMessageDialog does everything in background, so wait here...
blocker := Semaphore new.
panel showProgressLabeled: message while: [ [ block value ] ensure:[ blocker signal ] ].
blocker wait.
].
"/ OLD CODE
"/ |state actionWithIndicator worker|
"/
"/ state := self navigationState.
"/
"/ actionWithIndicator :=
"/ [
"/ [
"/ self showMessagePane:#progressInfoSpec in:state.
"/ block
"/ on:UserNotification
"/ do:[:notification |
"/ (notification isKindOf:ProgressNotification) ifTrue:[
"/ self progressHolder value:notification progressValue.
"/ inBackgroundBoolean ifFalse:[
"/ "care for redraw and abort-button"
"/ "/ self windowGroup repairDamage.
"/ self windowGroup processEvents.
"/ ].
"/ ] ifFalse:[
"/ self messageHolder value:notification description.
"/ ].
"/ notification proceed
"/ ]
"/ ] ensure:[
"/ self hideMessagePaneIn:state.
"/ ].
"/ ].
"/
"/ inBackgroundBoolean ifTrue:[
"/ worker := actionWithIndicator newProcess.
"/ worker priorityRange:(4 to:8).
"/ state worker:worker.
"/ worker resume.
"/ ^ worker
"/ ].
"/
"/ actionWithIndicator value.
"/ ^ nil
"Created: / 28-08-2010 / 20:10:18 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Created: / 15-05-2012 / 10:46:47 / cg"
"Modified: / 25-03-2014 / 18:14:07 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
showMessage:message whileExecutingBackgroundAction:block
"used for long-running lint operations: show a progressbar and a message in the top pane,
execute block in another (background-) thread"
^ self showMessage:message while:block inBackground: true
"Created: / 28-08-2010 / 20:10:18 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Created: / 15-05-2012 / 10:45:49 / cg"
"Modified (comment): / 25-03-2014 / 17:47:01 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
showMessageWhileTest
| b |
b :=
self
showMessage:'Tools::NewSystemBrowser >> testProgressAction'
whileExecutingBackgroundAction:[
| i |
i := 1.
[ i <= 100] whileTrue:[
(ProgressNotification new)
messageText:('Tools::NewSystemBrowser >> testProgressAction (%1 done)'
bindWith:i);
parameter:i;
raiseRequest.
Delay waitForMilliseconds:30.
i := i + 1.
].
Transcript showCR:'Tools::NewSystemBrowser >> testProgressAction done!!'
]
"
WindowGroup activeApplication showMessageWhileTest
"
"Created: / 28-08-2010 / 10:32:08 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 15-05-2012 / 10:46:06 / cg"
"Modified (comment): / 25-03-2014 / 18:15:15 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!NewSystemBrowser methodsFor:'user actions-profiler'!
spawnProfilerStatistics:statistics in: where
self
newBrowserOrBufferDependingOn: where
label:'Visual Profiler'
forSpec:#visualProfilerSpec
setupWith: [:browser|
browser profilerStatistics value: statistics
]
"Created: / 09-10-2007 / 22:05:36 / janfrog"
"Modified (format): / 29-11-2011 / 14:49:08 / cg"
! !
!NewSystemBrowser::OwnershipGraph class methodsFor:'defaults'!
dateFormat
^ '%y-%m-%d'
"
Date today printStringFormat:(self dateFormat)
"
! !
!NewSystemBrowser::OwnershipGraph class methodsFor:'documentation'!
documentation
"
an instance of me is given to the codeView as a listEntry (i.e. line).
The codeview does not really know that it is not dealing with non-text,
as I mimicry some of the string protocol to make it happy.
(duck typing is cool!!)
to show pre-assigned per-user colors, do something like:
UserPreferences current
at:#preferredOwnerColorMapping
put:(
Dictionary new
at:'cg' put:(Color green);
at:'claus' put:(Color green);
at:'sv' put:(Color blue);
at:'ab' put:(Color orange);
at:'ca' put:(Color cyan);
at:'mb' put:(Color red);
at:'sr' put:(Color yellow);
at:'vrany' put:(Color orange lightened);
yourself
)
"
! !
!NewSystemBrowser::OwnershipGraph methodsFor:'accessing'!
addRevision:revision author:author date:date lineOwnership:lineOwnership
ownershipInfo isNil ifTrue:[
ownershipInfo := OrderedCollection new.
].
ownershipInfo
add:(RevisionOwnershipInfo new
revision:revision author:author date:date lineOwnership:lineOwnership)
!
ownershipInfo
^ ownershipInfo
!
ownershipInfo:something
ownershipInfo := something.
! !
!NewSystemBrowser::OwnershipGraph methodsFor:'displaying'!
displayOn:aGC x:x y:y opaque:opaque
cachedForm isNil ifTrue:[
self generateFormFor:aGC
].
aGC displayForm:cachedForm x:x y:y opaque:opaque
!
generateFormFor:aGC
|maxNumLines xRun hGraph wCol colorsPerOwner colorsToUse preferredColors
y yLine font sepAgenda lastInfo form
maxWRevString maxWAuthorString maxWDateString|
form := Form extent:(self widthOn:aGC)@(self heightOn:aGC) depth:24 onDevice:aGC device.
form fill:(Color white).
colorsPerOwner := OrderedDictionary new.
colorsToUse := self ownerColorsToUse copy.
preferredColors := UserPreferences current at:#preferredOwnerColorMapping ifAbsent:nil.
hGraph := self graphHeight.
wCol := self columnWidth.
font := form font.
"/ aGC displayRectangleX:x y:y width:(self widthOn:aGC) height:hGraph.
maxNumLines := (ownershipInfo collect:[:entry | entry numberOfLines]) max.
xRun := 0.
y := 0.
maxWRevString := maxWAuthorString := maxWDateString := 0.
ownershipInfo do:[:revInfo |
|rev author date|
rev := revInfo revision.
author := revInfo author.
date := revInfo date asDate.
maxWRevString := maxWRevString max:(font widthOf:rev).
maxWAuthorString := maxWAuthorString max:(font widthOf:author).
maxWDateString := maxWDateString max:(font widthOf:(date printStringFormat:self class dateFormat)).
"/ pre determine color here
colorsPerOwner
at:author
ifAbsentPut:[
|clr|
(preferredColors notNil
and:[ (preferredColors includesKey:author) ]) ifTrue:[
clr := preferredColors at:author.
colorsToUse remove:clr ifAbsent:[].
] ifFalse:[
colorsToUse isEmpty ifTrue:[
clr := Color
redByte:(Random nextIntegerBetween:0 and:255)
greenByte:(Random nextIntegerBetween:0 and:255)
blueByte:(Random nextIntegerBetween:0 and:255).
] ifFalse:[
clr := colorsToUse removeFirst
]
].
clr
].
].
ownershipInfo do:[:revInfo |
|numOverallLines hAll rev author date lineInfo authorColor yBot|
rev := revInfo revision.
author := revInfo author.
date := revInfo date asDate.
lineInfo := revInfo lineOwnership.
numOverallLines := lineInfo size.
yBot := y + hGraph.
hAll := 0.
(lineInfo valuesAndCounts copy sort:[:a :b | |pos1 pos2|
pos1 := (colorsPerOwner indexOfKey:a key ifAbsent:999999).
pos2 := (colorsPerOwner indexOfKey:b key ifAbsent:999999).
pos1 < pos2
"/ a value > b value
]) do:[:eachAssoc |
|eachAuthor numLines hThis color yTop|
eachAuthor := eachAssoc key.
numLines := eachAssoc value.
hThis := hGraph * numLines // maxNumLines.
yTop := yBot - hThis.
color := colorsPerOwner at:eachAuthor ifAbsentPut:[colorsToUse removeFirst].
form paint:color.
form fillRectangleX:xRun y:yTop width:wCol height:hThis.
hAll := hAll + hThis.
yBot := yTop.
].
"/ hAll := hGraph * numOverallLines // maxNumLines.
form paint:Color black.
form displayRectangleX:xRun y:(y + (hGraph - hAll))
width:wCol
height:hAll.
authorColor := colorsPerOwner at:author ifAbsentPut:[colorsToUse removeFirst].
form paint:authorColor.
form displayString:rev
x:xRun+(font height)
y:(y + hGraph+5+maxWRevString) angle:-90.
form displayString:(date printStringFormat:self class dateFormat)
x:xRun+(font height)
y:(y + hGraph+5+maxWRevString+10+maxWDateString) angle:-90.
xRun := xRun + wCol
].
sepAgenda := self agendaSeparatorWidth.
yLine := y + (font ascent).
lastInfo := ownershipInfo last value.
colorsPerOwner keysAndValuesReverseDo:[:name :color |
|namePlusPercentage|
form paint:color.
form fillRectangleX:(xRun+sepAgenda) y:yLine-(font ascent) width:16 height:16.
form paint:Color black.
form displayRectangleX:(xRun+sepAgenda) y:yLine-(font ascent) width:16 height:16.
namePlusPercentage := (name ? '?') , '(' , ((lastInfo numberOfLinesOfAuthor:name) / lastInfo numberOfLines * 100) rounded printString , '%, ',(lastInfo numberOfLinesOfAuthor:name) printString,' lines)'.
form displayString:namePlusPercentage x:(xRun+sepAgenda+16+5) y:yLine.
yLine := yLine + (font height + 10).
].
cachedForm := form
! !
!NewSystemBrowser::OwnershipGraph methodsFor:'queries'!
agendaInfoWidth
^ 300
!
agendaSeparatorWidth
^ 20
!
columnWidth
^ 20
!
graphHeight
^ 300
!
heightOn:aGC
cachedForm notNil ifTrue:[^ cachedForm height].
^ self graphHeight + (self revisionInfoHeightOn:aGC)
!
revisionInfoHeight
^ 100
!
revisionInfoHeightOn:aGC
|font maxWRevString maxWAuthorString maxWDateString|
font := aGC font.
maxWRevString := maxWAuthorString := maxWDateString := 0.
ownershipInfo do:[:revInfo |
|rev author date|
rev := revInfo revision.
author := revInfo author.
date := revInfo date.
date notNil ifTrue:[date := date asDate].
maxWRevString := maxWRevString max:(font widthOf:rev).
maxWAuthorString := maxWAuthorString max:(font widthOf:author).
maxWDateString := maxWDateString max:(font widthOf:(date printStringFormat:self class dateFormat)).
].
^ 15 + maxWRevString + 5 + maxWDateString + 10
!
widthOn:aGC
cachedForm notNil ifTrue:[^ cachedForm width].
^ (ownershipInfo size * self columnWidth) + 10 + self agendaInfoWidth
! !
!NewSystemBrowser::OwnershipGraph methodsFor:'string protocol (list entry)'!
asString
^ ' '
!
asStringWithoutEmphasis
^ ''
!
bitsPerCharacter
^ 8 "/ dummy
!
emphasis
^ '' emphasis
!
emphasisAt:colNr
^ nil
!
hasChangeOfEmphasis
^ false
!
isBlank
^ false
!
ownerColorsToUse
|colorsToUse|
colorsToUse := OrderedCollection new.
colorsToUse add:(Color green).
colorsToUse add:(Color blue).
colorsToUse add:(Color yellow).
colorsToUse add:(Color red).
colorsToUse add:(Color cyan).
colorsToUse add:(Color magenta).
colorsToUse add:(Color brown).
colorsToUse add:(Color orange).
colorsToUse add:(Color green lightened lightened).
colorsToUse add:(Color blue lightened lightened).
colorsToUse add:(Color yellow lightened lightened).
colorsToUse add:(Color red lightened lightened).
colorsToUse add:(Color cyan lightened lightened).
colorsToUse add:(Color magenta lightened lightened).
colorsToUse add:(Color brown lightened).
colorsToUse add:(Color orange lightened).
colorsToUse add:(Color gray).
colorsToUse add:(Color darkGray).
colorsToUse add:(Color lightGray).
colorsToUse add:(Color veryLightGray).
colorsToUse add:(Color red darkened lightened).
colorsToUse add:(Color blue darkened lightened).
^ colorsToUse
!
string
^ ' '
!
withoutTrailingSeparators
^ ''
! !
!NewSystemBrowser::OwnershipGraph::RevisionOwnershipInfo class methodsFor:'documentation'!
documentation
"
I keep the information about the revision deltas.
for each revision, I hold: author, date, revisionName and the number of
lines which are owned as per author name (a bag, containing the number of lines
which each owner owns).
"
! !
!NewSystemBrowser::OwnershipGraph::RevisionOwnershipInfo methodsFor:'accessing'!
author
^ author
!
date
^ date
!
lineOwnership
^ lineOwnership
!
numberOfLines
^ lineOwnership size
!
numberOfLinesOfAuthor:authorString
^ lineOwnership occurrencesOf:authorString
!
revision
^ revision
!
revision:revisionArg author:authorArg date:dateArg lineOwnership:lineOwnershipArg
revision := revisionArg.
author := authorArg.
date := dateArg.
lineOwnership := lineOwnershipArg.
! !
!NewSystemBrowser class methodsFor:'documentation'!
version
^ '$Header$'
!
version_CVS
^ '$Header$'
!
version_HG
^ '$Changeset: <not expanded> $'
!
version_SVN
^ '$Id$'
! !
NewSystemBrowser initialize!