--- a/Tools__NewSystemBrowser.st Tue Jan 22 12:24:41 2013 +0000
+++ b/Tools__NewSystemBrowser.st Wed Jan 30 11:15:09 2013 +0000
@@ -107,6 +107,7 @@
"
! !
+
!NewSystemBrowser class methodsFor:'initialization'!
initialize
@@ -236,6 +237,7 @@
].
! !
+
!NewSystemBrowser class methodsFor:'accessing-history'!
addToBookMarks:aClass selector:aSelectorOrNil
@@ -317,6 +319,7 @@
"Modified: / 13-09-2012 / 18:14:26 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
+
!NewSystemBrowser class methodsFor:'defaults'!
synchronousUpdate
@@ -330,6 +333,7 @@
"Modified (comment): / 24-08-2011 / 15:33:27 / cg"
! !
+
!NewSystemBrowser class methodsFor:'help specs'!
flyByHelpSpec
@@ -498,6 +502,7 @@
)
! !
+
!NewSystemBrowser class methodsFor:'image specs'!
defaultIcon
@@ -740,6 +745,7 @@
^ ToolbarIconLibrary startNewSystemBrowserIcon
! !
+
!NewSystemBrowser class methodsFor:'interface specs'!
browserPageSpec
@@ -1427,6 +1433,7 @@
)
)
+ keepSpaceForOSXResizeHandleH: true
)
)
@@ -3593,7 +3600,7 @@
subAspect: showMethodComplexity
aspect: showMethodComplexity
)
- (SubChannelInfoSpec
+ (SubChannelInfoSpec
subAspect: showSyntheticMethods
aspect: showSyntheticMethods
)
@@ -5452,6 +5459,7 @@
"Modified: / 07-06-2011 / 14:39:04 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
+
!NewSystemBrowser class methodsFor:'interface specs-dialogs'!
repositoryConsistencyDialogSpec
@@ -5709,6 +5717,7 @@
)
! !
+
!NewSystemBrowser class methodsFor:'interface specs-message pane'!
messageInfoSpec
@@ -5821,6 +5830,7 @@
)
! !
+
!NewSystemBrowser class methodsFor:'menu specs'!
browseMenu
@@ -6381,6 +6391,7 @@
(MenuItem
enabled: hasCategorySelectedHolder
label: 'FileOut'
+ translateLabel: true
submenu:
(Menu
(
@@ -6388,19 +6399,21 @@
enabled: hasCategorySelectedHolder
label: 'as...'
itemValue: categoryMenuFileOutAs
+ translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasCategorySelectedAndCanFileOutXMLHolder
label: 'XML as...'
itemValue: categoryMenuFileOutXMLAs
+ translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasCategorySelectedAndCanFileOutSIFHolder
label: 'SIF as...'
itemValue: categoryMenuFileOutSIFAs
- showBusyCursorWhilePerforming: true
+ translateLabel: true
)
(MenuItem
enabled: hasCategorySelectedAndCanFileOutCypressHolder
@@ -6415,24 +6428,28 @@
enabled: hasCategorySelectedHolder
label: 'Each in...'
itemValue: categoryMenuFileOutEachIn
+ translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasCategorySelectedAndCanFileOutXMLHolder
label: 'Each XML in...'
itemValue: categoryMenuFileOutEachXMLIn
+ translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasCategorySelectedAndCanFileOutSIFHolder
label: 'Each SIF in...'
itemValue: categoryMenuFileOutEachSIFIn
+ translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasCategorySelectedHolder
label: 'Each Binary in...'
itemValue: categoryMenuFileOutEachBinaryIn
+ translateLabel: true
showBusyCursorWhilePerforming: true
)
)
@@ -6442,6 +6459,7 @@
)
(MenuItem
label: 'Repository'
+ translateLabel: true
submenuChannel: categoryMenuSCMSlice
isMenuSlice: true
)
@@ -8669,38 +8687,46 @@
#(Menu
(
(MenuItem
+ enabled: hasClassSelectedHolder
+ label: 'Remove from ChangeSet'
+ itemValue: classMenuCleanUpChangeSet
+ )
+ (MenuItem
+ enabled: hasClassSelectedHolder
+ label: 'Entries in ChangeSet'
+ itemValue: classMenuShowEntriesInChangeSet
+ )
+ (MenuItem
+ label: '-'
+ )
+ (MenuItem
enabled: hasAnyUnloadedClassSelectedHolder
label: 'Load'
itemValue: classMenuLoad
- translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasProjectDefinitionWithAnyUnloadedClassSelectedHolder
label: 'Load Project'
itemValue: classMenuLoadProject
- translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasClassSelectedHolder
label: 'Unload'
itemValue: classMenuUnload
- translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasClassSelectedHolder
label: 'Initialize Class(es)'
itemValue: classMenuInitialize
- translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasClassSelectedHolder
label: 'Compile Lazy Methods'
itemValue: classMenuCompileLazyMethods
- translateLabel: true
isVisible: false
showBusyCursorWhilePerforming: true
)
@@ -8708,7 +8734,6 @@
enabled: hasClassSelectedHolder
label: 'Reload'
itemValue: classMenuReload
- translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
@@ -8718,21 +8743,18 @@
enabled: hasClassSelectedWhichCanBeIncludedInProjectHolder
label: 'Include in Project as Compiled Class'
itemValue: classMenuIncludeInProject
- translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasClassSelectedWhichCanBeMadeAutoloadedInProject
label: 'Include in Project as Autoloaded Class'
itemValue: classMenuMakeAutoloadedInProject
- translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasClassSelectedWhichCanBeExcludedFromProject
label: 'Exclude from Project'
itemValue: classMenuExcludeFromProject
- translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
@@ -8742,21 +8764,18 @@
enabled: hasSingleLoadedClassSelectedHolder
label: 'Primitive Definitions'
itemValue: classMenuPrimitiveDefinitions
- translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasSingleLoadedClassSelectedHolder
label: 'Primitive Functions'
itemValue: classMenuPrimitiveFunctions
- translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasSingleLoadedClassSelectedHolder
label: 'Primitive Variables'
itemValue: classMenuPrimitiveVariables
- translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
@@ -8772,28 +8791,11 @@
)
(MenuItem
enabled: hasClassSelectedHolder
- label: 'Remove from ChangeSet'
- itemValue: classMenuCleanUpChangeSet
- translateLabel: true
- )
- (MenuItem
- enabled: hasClassSelectedHolder
- label: 'Entries in ChangeSet'
- itemValue: classMenuShowEntriesInChangeSet
- translateLabel: true
- )
- (MenuItem
- label: '-'
- )
- (MenuItem
- enabled: hasClassSelectedHolder
label: 'Do...'
itemValue: classMenuDoUserProvidedAction
- translateLabel: true
)
(MenuItem
label: 'Special ClassOPS'
- translateLabel: true
submenuChannel: classOperationsMenu
isMenuSlice: true
)
@@ -8801,8 +8803,6 @@
nil
nil
)
-
- "Modified: / 26-07-2012 / 11:48:32 / cg"
!
codeMenu
@@ -9688,7 +9688,7 @@
label: '-'
)
(MenuItem
- label: 'Search && Rewrite'
+ label: 'Search && Rewrite...'
itemValue: selectorMenuRewrite
translateLabel: true
)
@@ -9940,6 +9940,7 @@
(MenuItem
enabled: hasProjectSelectedHolder
label: 'File out'
+ translateLabel: true
submenu:
(Menu
(
@@ -9947,18 +9948,21 @@
enabled: hasProjectSelectedHolder
label: 'as...'
itemValue: projectMenuFileOutAs
+ translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasProjectSelectedAndCanFileOutXMLHolder
label: 'XML as...'
itemValue: projectMenuFileOutXMLAs
+ translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasProjectSelectedAndCanFileOutSIFHolder
label: 'SIF as...'
itemValue: projectMenuFileOutSIFAs
+ translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
@@ -9973,30 +9977,35 @@
enabled: hasProjectSelectedHolder
label: 'Each in...'
itemValue: projectMenuFileOutEachIn
+ translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasProjectSelectedHolder
label: 'Build Support File in...'
itemValue: projectMenuFileOutBuildSupportFiles
+ translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasProjectSelectedAndCanFileOutXMLHolder
label: 'Each XML in...'
itemValue: projectMenuFileOutEachXMLIn
+ translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasProjectSelectedAndCanFileOutSIFHolder
label: 'Each SIF in...'
itemValue: projectMenuFileOutEachSIFIn
+ translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasProjectSelectedHolder
label: 'Each Binary in...'
itemValue: projectMenuFileOutEachBinaryIn
+ translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
@@ -10006,6 +10015,7 @@
enabled: hasProjectSelectedHolder
label: 'Mail To...'
itemValue: projectMenuMailTo
+ translateLabel: true
showBusyCursorWhilePerforming: true
)
)
@@ -10015,6 +10025,7 @@
)
(MenuItem
label: 'Repository'
+ translateLabel: true
submenuChannel: projectMenuSCMSlice
isMenuSlice: true
)
@@ -10023,6 +10034,7 @@
)
(MenuItem
label: 'Documentation'
+ translateLabel: true
submenu:
(Menu
(
@@ -10030,6 +10042,7 @@
enabled: hasSingleRealProjectSelectedHolder
label: 'Generate Project Documentation'
itemValue: projectMenuDocumentation
+ translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
@@ -10039,6 +10052,7 @@
enabled: hasOOMPackageLoadedAndSingleRealProjectSelectedHolder
label: 'Metrics Summary Report'
itemValue: projectMenuMetricsSummary
+ translateLabel: true
)
)
nil
@@ -10051,6 +10065,7 @@
(MenuItem
enabled: hasProjectSelectedHolder
label: 'Spawn'
+ translateLabel: true
submenu:
(Menu
(
@@ -10058,16 +10073,19 @@
enabled: hasProjectSelectedHolder
label: 'Buffer'
itemValue: projectMenuSpawnBuffer
+ translateLabel: true
)
(MenuItem
enabled: hasProjectSelectedHolder
label: 'Buffer with Extensions'
itemValue: projectMenuSpawnExtensionsBuffer
+ translateLabel: true
)
(MenuItem
enabled: hasProjectSelectedHolder
label: 'Buffer with Projects Requiring this Project'
itemValue: projectMenuSpawnPreRequirerBuffer
+ translateLabel: true
)
(MenuItem
label: '-'
@@ -10076,16 +10094,19 @@
enabled: hasProjectSelectedHolder
label: 'Browser'
itemValue: projectMenuSpawn
+ translateLabel: true
)
(MenuItem
enabled: hasProjectSelectedHolder
label: 'Browser on Extensions'
itemValue: projectMenuSpawnExtensionsBrowser
+ translateLabel: true
)
(MenuItem
enabled: hasProjectSelectedHolder
label: 'Browser on Projects Requiring this Project'
itemValue: projectMenuSpawnPreRequirerBrowser
+ translateLabel: true
)
)
nil
@@ -10095,6 +10116,7 @@
(MenuItem
enabled: hasProjectSelectedHolder
label: 'Find'
+ translateLabel: true
submenuChannel: searchMenu
)
(MenuItem
@@ -10103,16 +10125,19 @@
(MenuItem
label: 'New...'
itemValue: projectMenuNew
+ translateLabel: true
)
(MenuItem
label: 'Load...'
itemValue: projectMenuLoad
+ translateLabel: true
isVisible: hasNoProjectSelectedHolder
showBusyCursorWhilePerforming: true
)
(MenuItem
label: 'Load'
itemValue: projectMenuLoad
+ translateLabel: true
isVisible: hasProjectSelectedHolder
showBusyCursorWhilePerforming: true
)
@@ -10120,17 +10145,20 @@
enabled: hasProjectSelectedHolder
label: 'Rename...'
itemValue: projectMenuRename
+ translateLabel: true
)
(MenuItem
enabled: hasProjectSelectedHolder
label: 'Remove...'
itemValue: projectMenuRemove
+ translateLabel: true
)
(MenuItem
label: '-'
)
(MenuItem
label: 'Build'
+ translateLabel: true
submenu:
(Menu
(
@@ -10138,12 +10166,14 @@
enabled: hasSingleRealProjectSelectedHolder
label: 'Build Package for Deployment'
itemValue: projectMenuBuild
+ translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasSingleRealProjectSelectedHolder
label: 'Build Binaries for Execution'
itemValue: projectMenuBuildExeOnly
+ translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
@@ -10152,14 +10182,23 @@
(MenuItem
label: 'Build with Interactive Application Packager...'
itemValue: projectMenuBuildWithApplicationPackager
+ translateLabel: true
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasProjectSelectedHolder
+ label: 'Generate Build Support Files in...'
+ itemValue: projectMenuGenerateBuildSupportFiles
+ translateLabel: true
+ showBusyCursorWhilePerforming: true
+ )
+ (MenuItem
+ enabled: hasProjectSelectedHolder
label: 'Patch-Set...'
itemValue: projectMenuGeneratePatchSet
+ translateLabel: true
showBusyCursorWhilePerforming: true
)
)
@@ -10170,6 +10209,7 @@
(MenuItem
enabled: hasProjectSelectedHolder
label: 'Generate'
+ translateLabel: true
submenu:
(Menu
(
@@ -10177,16 +10217,19 @@
enabled: hasSingleRealProjectSelectedHolder
label: 'Generate Project Definition Methods'
itemValue: projectMenuGenerateProjectDefinitions
+ translateLabel: true
)
(MenuItem
enabled: hasSingleRealProjectSelectedHolder
label: 'Update Project Contents Definition Methods'
itemValue: projectMenuUpdateProjectContentsDefinitions
+ translateLabel: true
)
(MenuItem
enabled: hasSingleRealProjectSelectedHolder
label: 'Regenerate Project Contents Definition Methods'
itemValue: projectMenuRegenerateProjectContentsDefinitions
+ translateLabel: true
)
)
nil
@@ -10197,19 +10240,23 @@
enabled: hasProjectSelectedAndSourceCodeManagerHolder
label: 'Package Integrity Check...'
itemValue: projectMenuCheckPackageIntegrity
+ translateLabel: true
)
(MenuItem
label: 'Static Analysis (Lint)'
+ translateLabel: true
submenuChannel: projectCheckMenu
labelImage: (ResourceRetriever ToolbarIconLibrary lint16x16Icon 'Static Analysis (Lint)')
)
(MenuItem
label: 'Debug'
+ translateLabel: true
submenuChannel: projectDebugMenu
keepLinkedMenu: true
)
(MenuItem
label: 'Special'
+ translateLabel: true
submenu:
(Menu
(
@@ -10217,6 +10264,7 @@
enabled: hasSingleRealProjectSelectedHolder
label: 'Remove from ChangeSet'
itemValue: projectMenuCleanUpChangeSet
+ translateLabel: true
)
(MenuItem
label: '-'
@@ -10226,6 +10274,7 @@
enabled: hasSingleRealProjectSelectedHolder
label: 'Make Current Project'
itemValue: projectMenuMakeCurrentProject
+ translateLabel: true
isVisible: false
)
)
@@ -10240,6 +10289,7 @@
enabled: hasSingleRealProjectSelectedHolder
label: 'Properties...'
itemValue: projectMenuProperties
+ translateLabel: true
)
(MenuItem
label: '-'
@@ -10247,11 +10297,15 @@
(MenuItem
label: 'Update'
itemValue: projectMenuUpdate
- )
- )
- nil
- nil
- )
+ translateLabel: true
+ )
+ )
+ nil
+ nil
+ )
+
+ "Modified: / 24-07-2012 / 15:20:51 / cg"
+ "Modified: / 26-07-2012 / 12:33:19 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
protocolCheckMenu
@@ -10304,6 +10358,7 @@
"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
@@ -10515,12 +10570,6 @@
label: '-'
)
(MenuItem
- label: 'Static Anlysis (Lint)'
- translateLabel: true
- submenuChannel: protocolCheckMenu
- labelImage: (ResourceRetriever ToolbarIconLibrary lint16x16Icon 'Static Anlysis (Lint)')
- )
- (MenuItem
label: 'Generate'
translateLabel: true
submenu:
@@ -11378,7 +11427,9 @@
label: 'Remove...'
itemValue: selectorMenuRemove
translateLabel: true
+ shortcutKey: Delete
labelImage: (ResourceRetriever ToolbarIconLibrary erase16x16Icon 'Remove...')
+ ignoreShortcutKeys: true
)
)
nil
@@ -12954,6 +13005,7 @@
)
! !
+
!NewSystemBrowser class methodsFor:'menu specs-SCM-category'!
categoryMenuSCMCommon
@@ -12979,7 +13031,7 @@
label: 'CheckIn all...'
itemValue: categoryMenuCheckInEachUsing:
translateLabel: true
- argument: SourceCodeManagerPlaceholder
+ argument: SourceCodeManagerNamePlaceholder
labelImage: (ResourceRetriever ToolbarIconLibrary repositoryCheckIn 'CheckIn all...')
showBusyCursorWhilePerforming: true
)
@@ -12991,7 +13043,7 @@
label: 'CheckOut Newest All'
itemValue: categoryMenuCheckOutNewestUsing:
translateLabel: true
- argument: SourceCodeManagerPlaceholder
+ argument: SourceCodeManagerNamePlaceholder
labelImage: (ResourceRetriever ToolbarIconLibrary repositoryCheckOut 'CheckOut Newest All')
showBusyCursorWhilePerforming: true
)
@@ -13000,7 +13052,7 @@
label: 'CheckOut Previous Versions All...'
itemValue: categoryMenuCheckOutUsing:
translateLabel: true
- argument: SourceCodeManagerPlaceholder
+ argument: SourceCodeManagerNamePlaceholder
showBusyCursorWhilePerforming: true
)
(MenuItem
@@ -13011,7 +13063,7 @@
label: 'Repository History...'
itemValue: categoryMenuRepositoryHistoryUsing:
translateLabel: true
- argument: SourceCodeManagerPlaceholder
+ argument: SourceCodeManagerNamePlaceholder
labelImage: (ResourceRetriever ToolbarIconLibrary repositoryLog 'Repository History...')
showBusyCursorWhilePerforming: true
)
@@ -13120,6 +13172,7 @@
(MenuItem
enabled: hasClassSelectedAndCVSSourceCodeManagerHolder
label: 'CVS'
+ translateLabel: true
submenuChannel: categoryMenuSCMFor:
labelImage: (ResourceRetriever ToolbarIconLibrary repositoryCVSIcon 'CVS')
argument: CVSSourceCodeManager
@@ -13128,6 +13181,7 @@
(MenuItem
enabled: hasClassesSelectedAndSubversionRepositoryExistsHolder
label: 'SubVersion'
+ translateLabel: true
isVisible: hasSubversionSupport
submenuChannel: categoryMenuSCMFor:
labelImage: (ResourceRetriever ToolbarIconLibrary repositorySVNIcon 'SubVersion')
@@ -13144,6 +13198,7 @@
(MenuItem
enabled: hasClassSelectedAndSourceCodeManagerHolder
label: 'Perforce'
+ translateLabel: true
isVisible: hasPerforceSupport
submenuChannel: categoryMenuSCMFor:
labelImage: (ResourceRetriever ToolbarIconLibrary repositorySVNIcon 'Perforce')
@@ -13335,6 +13390,7 @@
)
! !
+
!NewSystemBrowser class methodsFor:'menu specs-SCM-class'!
classCVSMenu
@@ -14500,8 +14556,9 @@
(
(MenuItem
enabled: hasClassSelectedAndCVSSourceCodeManagerHolder
+ isVisible: cvsRepositoryMenusAreShown
label: 'CVS'
- isVisible: cvsRepositoryMenusAreShown
+ translateLabel: true
submenuChannel: classMenuSCMFor:
labelImage: (ResourceRetriever ToolbarIconLibrary repositoryCVSIcon 'CVS')
argument: CVSSourceCodeManager
@@ -14509,8 +14566,9 @@
)
(MenuItem
enabled: hasClassesSelectedAndSubversionRepositoryExistsHolder
+ isVisible: svnRepositoryMenusAreShown
label: 'SubVersion'
- isVisible: svnRepositoryMenusAreShown
+ translateLabel: true
submenuChannel: classMenuSCMFor:
labelImage: (ResourceRetriever ToolbarIconLibrary repositorySVNIcon 'SubVersion')
argument: SVNSourceCodeManager
@@ -14534,15 +14592,16 @@
(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'
- isVisible: perforceRepositoryMenusAreShown
+ translateLabel: true
submenuChannel: classMenuSCMFor:
labelImage: (ResourceRetriever ToolbarIconLibrary repositorySVNIcon 'Perforce')
argument: PerforceSourceCodeManager
@@ -15253,6 +15312,7 @@
"Modified: / 28-10-2012 / 11:54:14 / cg"
! !
+
!NewSystemBrowser class methodsFor:'menu specs-SCM-project'!
projectCVSMenu
@@ -15990,6 +16050,7 @@
(MenuItem
enabled: hasProjectSelectedAndSourceCodeManagerHolder
label: 'CVS'
+ translateLabel: true
submenuChannel: projectMenuSCMFor:
labelImage: (ResourceRetriever ToolbarIconLibrary repositoryCVSIcon 'CVS')
argument: CVSSourceCodeManager
@@ -15998,6 +16059,7 @@
(MenuItem
enabled: hasProjectSelectedAndSourceCodeManagerHolder
label: 'SubVersion'
+ translateLabel: true
isVisible: hasSubversionSupport
submenuChannel: projectMenuSCMFor:
labelImage: (ResourceRetriever ToolbarIconLibrary repositorySVNIcon 'SubVersion')
@@ -16022,6 +16084,7 @@
(MenuItem
enabled: hasProjectSelectedAndSourceCodeManagerHolder
label: 'Perforce'
+ translateLabel: true
isVisible: hasPerforceSupport
submenuChannel: projectMenuSCMFor:
labelImage: (ResourceRetriever ToolbarIconLibrary repositoryP4Icon 'Perforce')
@@ -16030,6 +16093,7 @@
(MenuItem
enabled: hasProjectSelectedAndSourceCodeManagerHolder
label: 'Monticello'
+ translateLabel: true
isVisible: hasMonticelloSupport
submenuChannel: projectMenuSCMFor:
labelImage: (ResourceRetriever ToolbarIconLibrary repositoryMCIcon 'Monticello')
@@ -16194,6 +16258,7 @@
"Modified: / 24-07-2012 / 17:40:34 / cg"
! !
+
!NewSystemBrowser class methodsFor:'menu specs-SCM-selector'!
selectorMenuCVS
@@ -16388,6 +16453,7 @@
(MenuItem
enabled: hasMethodSelectedAndSourceCodeManagerHolder
label: 'CVS'
+ translateLabel: true
submenuChannel: selectorMenuSCMFor:
labelImage: (ResourceRetriever ToolbarIconLibrary repositoryCVSIcon 'CVS')
argument: CVSSourceCodeManager
@@ -16396,6 +16462,7 @@
(MenuItem
enabled: hasMethodSelectedAndSourceCodeManagerHolder
label: 'SubVersion'
+ translateLabel: true
isVisible: hasSubversionSupport
submenuChannel: selectorMenuSCMFor:
labelImage: (ResourceRetriever ToolbarIconLibrary repositorySVNIcon 'SubVersion')
@@ -16420,6 +16487,7 @@
(MenuItem
enabled: hasMethodSelectedAndSourceCodeManagerHolder
label: 'Perforce'
+ translateLabel: true
isVisible: hasPerforceSupport
submenuChannel: selectorMenuSCMFor:
labelImage: (ResourceRetriever ToolbarIconLibrary repositoryP4Icon 'Perforce')
@@ -16559,6 +16627,7 @@
)
! !
+
!NewSystemBrowser class methodsFor:'menu specs-dialogs'!
classesWhichHaveBeenModifiedPopupMenu
@@ -16751,6 +16820,7 @@
"Modified: / 29-09-2006 / 16:11:08 / cg"
! !
+
!NewSystemBrowser class methodsFor:'menu specs-popup'!
categoryPopUpMenu
@@ -16896,6 +16966,7 @@
"Created: / 18.2.2000 / 11:58:25 / cg"
! !
+
!NewSystemBrowser class methodsFor:'menu specs-subversion'!
classSubversionMenu
@@ -17159,6 +17230,7 @@
)
! !
+
!NewSystemBrowser class methodsFor:'menu specs-toolbar'!
toolBarMenu
@@ -17477,6 +17549,7 @@
)
! !
+
!NewSystemBrowser class methodsFor:'queries'!
hasSubversionSupport
@@ -17486,6 +17559,7 @@
"Modified: / 19-01-2012 / 10:46:05 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
+
!NewSystemBrowser class methodsFor:'startup'!
browseClass:aClass
@@ -17705,6 +17779,7 @@
"Created: / 06-07-2011 / 18:27:53 / cg"
! !
+
!NewSystemBrowser class methodsFor:'utilities'!
enterBoxTitle:title okText:okText label:label
@@ -17723,6 +17798,7 @@
"Created: / 6.2.2000 / 01:07:11 / cg"
! !
+
!NewSystemBrowser methodsFor:'accessing'!
isEmbeddedBrowser
@@ -17737,6 +17813,7 @@
isEmbedded := aBoolean.
! !
+
!NewSystemBrowser methodsFor:'aspects'!
bookmarkHolder
@@ -18042,6 +18119,7 @@
builder aspectAt:#suppressChangeSetUpdate put:aBoolean
! !
+
!NewSystemBrowser methodsFor:'aspects-environment'!
selectedCategoriesAsEnvironment
@@ -18169,6 +18247,7 @@
"Modified: / 28-02-2012 / 16:28:38 / cg"
! !
+
!NewSystemBrowser methodsFor:'aspects-kludges'!
metaToggle
@@ -18182,6 +18261,7 @@
! !
+
!NewSystemBrowser methodsFor:'aspects-menus'!
categoryMenu
@@ -18379,6 +18459,7 @@
^ self class visitedClassNamesHistory
! !
+
!NewSystemBrowser methodsFor:'aspects-navigation'!
categoryList
@@ -18599,6 +18680,7 @@
"Created: / 24.2.2000 / 23:28:06 / cg"
! !
+
!NewSystemBrowser methodsFor:'aspects-organization'!
categoryMenuVisible
@@ -19072,6 +19154,7 @@
"Modified: / 18.8.2000 / 19:03:48 / cg"
! !
+
!NewSystemBrowser methodsFor:'aspects-presentation'!
bookmarkBarVisibleHolder
@@ -19529,6 +19612,7 @@
"Created: / 02-07-2011 / 18:27:29 / cg"
! !
+
!NewSystemBrowser methodsFor:'aspects-queries'!
anyBreakOrTracePointsAreSet
@@ -22245,6 +22329,7 @@
^ UserPreferences current useSearchBarInBrowser or:[self codeView searchBarActionBlock notNil]
! !
+
!NewSystemBrowser methodsFor:'change & update'!
categorySelectionChanged
@@ -23059,6 +23144,37 @@
"Created: / 5.2.2000 / 04:25:54 / 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|
@@ -23338,6 +23454,7 @@
self navigationState versionDiffApplication:diffApp.
! !
+
!NewSystemBrowser methodsFor:'help specs'!
flyByHelpSpec
@@ -23365,6 +23482,7 @@
^ super flyByHelpTextFor:aComponent
! !
+
!NewSystemBrowser methodsFor:'history'!
addToHistory: class
@@ -23383,6 +23501,7 @@
"Modified: / 02-07-2011 / 18:33:22 / cg"
! !
+
!NewSystemBrowser methodsFor:'menu actions-browse'!
browseImplementorsOf
@@ -25677,6 +25796,7 @@
viewMenuSelectAllClasses
! !
+
!NewSystemBrowser methodsFor:'menu actions-buffers'!
bufferMenuCreateBuffer
@@ -25841,6 +25961,7 @@
"Modified: / 28-02-2012 / 10:22:24 / cg"
! !
+
!NewSystemBrowser methodsFor:'menu actions-category'!
categoryMenuCheckInEach
@@ -26649,7 +26770,380 @@
self spawnCategoryBrowserFor:(self selectedCategoriesValue) in:where
! !
-!NewSystemBrowser methodsFor:'menu actions-checks'!
+
+!NewSystemBrowser methodsFor:'menu actions-checks-lint'!
+
+foo
+ ^ true
+!
+
+isFoo
+ ^ true
+!
+
+loadSmalllint
+ |pkg |
+
+ pkg := Smalltalk at:#'stx_goodies_refactoryBrowser_lint'.
+ (pkg isNil or:[ pkg isFullyLoaded not ]) ifTrue:[
+ Smalltalk loadPackage:#'stx:goodies/refactoryBrowser/lint' asAutoloaded:false
+ ].
+
+ "
+ 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 the new smallLint checker tool"
+
+ self runLintOnPreviousRules
+
+ "Modified: / 17-04-2010 / 10:44:00 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 07-03-2012 / 17:39:34 / cg"
+!
+
+runLintOnAllRules
+ "run the new smallLint checker tool on all rules"
+
+ self
+ smalllintCheck: self selectedCodeComponentsAsEnvironment
+ against: #smalllintRulesAll
+
+ "Created: / 07-03-2012 / 17:40:07 / cg"
+!
+
+runLintOnPreviousRules
+ "run the new smallLint checker tool"
+
+ self
+ smalllintCheck: self selectedCodeComponentsAsEnvironment
+ against: #smalllintRules
+
+ "Modified: / 17-04-2010 / 10:44:00 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified (comment): / 01-03-2012 / 14:10:47 / cg"
+ "Created: / 07-03-2012 / 17:39:28 / cg"
+!
+
+runLintOnSelectedRules
+ "run the new smallLint checker tool on selected rules"
+
+ self
+ smalllintCheck: self selectedCodeComponentsAsEnvironment
+ against: #smalllintRulesFromUser
+
+ "Created: / 07-03-2012 / 17:40:23 / cg"
+!
+
+smalllintCheck:anEnvironment against:ruleSetSymbol
+ "this is exected by an async task!!"
+
+ |rule runRules|
+
+ self assert:(#( #smalllintRulesAll #smalllintRulesFromUser #smalllintRules ) includes:ruleSetSymbol).
+
+ rule := self perform:ruleSetSymbol asSymbol.
+ rule isNil ifTrue:[ ^ self ].
+"/ cg: that is wrong implemented in RBxxxRule: isEmpty has two meanings:
+"/ for composite: has sub-rules
+"/ for non-composite: has a result
+"/ therefore, isEmpty returns true here, so we will be always asked twice!!
+
+ rule isEmptyInTree ifTrue:[
+ ruleSetSymbol ~~ #smalllintRulesFromUser ifTrue:[
+ rule := self smalllintRulesFromUser.
+ rule isNil ifTrue:[ ^ self ].
+ ]
+ ].
+
+ runRules :=
+ [
+ |showResult|
+
+ self smalllintRunRule:rule onEnvironment:anEnvironment.
+ showResult := true.
+ [rule notNil and:[rule isEmpty]] whileTrue:[
+ (Dialog confirm:'Nothing special found.\\Proceed to select more/different lint rules.' withCRs) ifTrue:[
+ rule := self smalllintRulesFromUser.
+ rule notNil ifTrue:[
+ self smalllintRunRule:rule onEnvironment:anEnvironment.
+ ].
+ ] ifFalse:[
+ rule := nil
+ ].
+ ].
+ rule notNil ifTrue:[
+ self
+ spawnSmalllintBrowserByRuleFor:rule
+ in:#newBuffer
+ label:'SmallLint results for ' , anEnvironment label
+ ].
+ ].
+
+ "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: / 28-08-2010 / 20:45:52 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 15-05-2012 / 10:46:02 / cg"
+!
+
+smalllintRules
+
+ ^LastLintRules
+ ifNil:[self smalllintRulesFromUser]
+ ifNotNil:[LastLintRules]
+
+
+ "
+ Tools::NewSystemBrowser basicNew smalllintRules
+ "
+
+ "Modified: / 17-04-2010 / 09:42:51 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+smalllintRulesFromUser
+ |dlg|
+
+ self loadSmalllint.
+ dlg := Tools::LintRuleSelectionDialog new.
+
+ dlg selection: (LastLintRules ifNil:[nil"self smalllintRulesAll flattened"] ifNotNil:[LastLintRules flattened]).
+ ^ (dlg open; accepted)
+ ifTrue:[ LastLintRules := dlg selectionAsRule ]
+ ifFalse:[ nil ].
+
+ "
+ LastLintRules := nil.
+ Tools::NewSystemBrowser basicNew smalllintRulesFromUser
+ "
+
+ "Created: / 17-04-2010 / 09:41:54 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 25-08-2010 / 15:35:16 / Jan Vrany <enter your email here>"
+ "Modified (format): / 06-03-2012 / 18:55:09 / cg"
+!
+
+smalllintRulesOrAll
+ "Returns a set of user-selected SmallLint rules or all rules,
+ if no user selection is done"
+
+ ^LastLintRules notNil
+ ifTrue:[ LastLintRules ]
+ ifFalse:[ self smalllintRulesAll ]
+
+ "Created: / 23-01-2012 / 10:59:55 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified (format): / 07-03-2012 / 20:05:40 / cg"
+!
+
+smalllintRulesOrAllHolder
+ "Returns a holder on user-selected SmallLint rules
+ (or all rules if user made no selection"
+
+ ^[ self smalllintRulesOrAll ]
+
+ "Modified: / 17-04-2010 / 09:42:51 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Created: / 23-01-2012 / 11:05:50 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+smalllintRunRule: aLintRule onEnvironment: anEnvironment
+ "run a checker in the background"
+
+ | rules |
+
+ rules := aLintRule flattened.
+ rules withIndexDo:[:rule :index|
+ |t|
+
+ ProgressNotification new
+ messageText: ('Checking: ', rule name);
+ parameter: (rules size / 100) * index;
+ raiseRequest.
+ t := Time millisecondsToRun:[
+ (SmalllintChecker runRule: rule onEnvironment: anEnvironment)
+ ].
+ Transcript show:rule name,': ';showCR:t.
+ ].
+ ProgressNotification new
+ messageText: ('Done');
+ parameter: 100;
+ raiseRequest.
+
+ "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: / 01-03-2012 / 15:22:20 / cg"
+!
+
+spawnSmalllintBrowserByRuleFor: result in:where label:labelOrNil
+ ^ self
+ newBrowserOrBufferDependingOn:where
+ label:labelOrNil
+ forSpec: #smallLintByRuleResultBrowserSpec
+ setupWith:[:browser |
+ |methodGenerator classGenerator ruleGenerator|
+
+ ruleGenerator :=
+ Iterator on:[:whatToDo|
+ result failedRules do:whatToDo].
+
+ methodGenerator :=
+ Iterator on: [:whatToDo|
+ | selectedRules selectedClasses failedMethods |
+
+ selectedClasses := browser selectedClasses value.
+ selectedRules := browser selectedLintRules value.
+ failedMethods := OrderedCollection new.
+ selectedClasses isEmptyOrNil ifFalse:
+ [selectedRules ? #() do:
+ [:rule|
+ 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.
+
+ browser selectedClasses
+ onChangeSend: #changed to: browser selectorListGenerator.
+ browser selectedLintRules
+ onChangeSend: #changed to: browser selectorListGenerator.
+ browser meta
+ onChangeSend: #changed to: browser selectorListGenerator.
+
+ "/ cg: does not work - why?
+ result failedRules size == 1 ifTrue:[
+ "/ autoselect the first one
+ browser selectedLintRules value:(result failedRules).
+ ].
+
+ "/self halt.
+ "
+ theMethodList isNil ifTrue:[
+ methodsOrMethodGeneratorBlock isBlock ifTrue:[
+ theMethodList := methodsOrMethodGeneratorBlock value.
+ ] ifFalse:[
+ theMethodList := methodsOrMethodGeneratorBlock copy.
+ ].
+ ].
+ perClassInfo := perClassInfoHolder value.
+ perMethodInfo := perMethodInfoHolder value.
+
+ methodGenerator := Iterator on:[:whatToDo |
+ theMethodList isNil ifTrue:[
+ methodsOrMethodGeneratorBlock isBlock ifTrue:[
+ theMethodList := methodsOrMethodGeneratorBlock value.
+ ] ifFalse:[
+ theMethodList := methodsOrMethodGeneratorBlock copy.
+ ].
+ ].
+ perClassInfo := perClassInfoHolder value.
+ perMethodInfo := perMethodInfoHolder value.
+
+ theMethodNameList := theMethodList collect:[:eachMethod | eachMethod mclass -> eachMethod selector].
+ theMethodNameList do:[:mAssoc |
+ |methodClass methodSelector method|
+
+ methodClass := mAssoc key.
+ methodSelector := mAssoc value.
+ methodClass notNil ifTrue:[
+ method := methodClass compiledMethodAt:methodSelector.
+ method notNil ifTrue:[
+ whatToDo
+ value:methodClass
+ value:method category
+ value:methodSelector
+ value:method.
+ ].
+ ].
+ ].
+ methodsOrMethodGeneratorBlock isBlock ifTrue:[
+ theMethodList := nil.
+ ].
+ whatToDo
+ value:nil
+ value:nil
+ value:nil
+ value:nil.
+ ].
+
+ sortHow notNil ifTrue:[brwsr sortBy value:sortHow].
+
+ brwsr selectorListGenerator value:methodGenerator.
+ perClassInfo notNil ifTrue:[
+ classGenerator := perClassInfo keys.
+ brwsr classListGenerator value:classGenerator.
+ brwsr meta value:false.
+ ].
+
+ perClassInfo notNil ifTrue:[
+ brwsr selectedClasses
+ onChangeEvaluate:[
+ |class infoText|
+
+ brwsr selectedMethods value:nil.
+ class := brwsr theSingleSelectedClass.
+ class notNil ifTrue:[
+ brwsr meta value:false.
+ infoText := perClassInfoHolder value at:class theNonMetaclass ifAbsent:nil.
+ infoText isNil ifTrue:[
+ infoText := perClassInfo at:class theMetaclass ifAbsent:nil
+ ]
+ ].
+ brwsr methodInfo value:infoText.
+ ]
+ ].
+
+ perMethodInfo notNil ifTrue:[
+ brwsr selectedMethods
+ onChangeEvaluate:[
+ |mthd infoText|
+
+ brwsr selectedClasses value:nil.
+ mthd := brwsr theSingleSelectedMethod.
+ mthd notNil ifTrue:[
+ infoText := perMethodInfo at:mthd ifAbsent:nil
+ ].
+ brwsr methodInfo value:infoText.
+ ]
+ ] ifFalse:[
+ (doSelect and:[theMethodList size == 1]) ifTrue:[
+ brwsr selectMethods:(Array with:theMethodList first).
+ brwsr methodsSelectionChanged.
+ ]
+ ].
+
+ methodsOrMethodGeneratorBlock isBlock ifTrue:[
+ theMethodList := nil
+ ]
+ "
+ ]
+
+ "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: / 02-02-2010 / 21:46:35 / 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"
+! !
+
+
+!NewSystemBrowser methodsFor:'menu actions-checks-old'!
classMenuCheck
"perform a bunch of checks on the selected class(es).
@@ -26810,71 +27304,6 @@
"Modified (comment): / 01-03-2012 / 14:10:43 / cg"
! !
-!NewSystemBrowser methodsFor:'menu actions-checks-lint'!
-
-foo
- ^ true
-!
-
-isFoo
- ^ true
-!
-
-runLintOnAllRules
- "run the new smallLint checker tool on all rules"
-
- self
- smalllintCheck: self selectedCodeComponentsAsEnvironment
- against: #smalllintRulesAll
-
- "Created: / 07-03-2012 / 17:40:07 / cg"
-!
-
-runLintOnPreviousRules
- "run the new smallLint checker tool"
-
- self
- smalllintCheck: self selectedCodeComponentsAsEnvironment
- against: #smalllintRules
-
- "Modified: / 17-04-2010 / 10:44:00 / Jan Vrany <jan.vrany@fit.cvut.cz>"
- "Modified (comment): / 01-03-2012 / 14:10:47 / cg"
- "Created: / 07-03-2012 / 17:39:28 / cg"
-!
-
-runLintOnSelectedRules
- "run the new smallLint checker tool on selected rules"
-
- self
- smalllintCheck: self selectedCodeComponentsAsEnvironment
- against: #smalllintRulesFromUser
-
- "Created: / 07-03-2012 / 17:40:23 / cg"
-!
-
-smalllintRules
-
- ^LastLintRules
- ifNil:[self smalllintRulesFromUser]
- ifNotNil:[LastLintRules]
-
-
- "
- Tools::NewSystemBrowser basicNew smalllintRules
- "
-
- "Modified: / 17-04-2010 / 09:42:51 / Jan Vrany <jan.vrany@fit.cvut.cz>"
-!
-
-smalllintRulesOrAllHolder
- "Returns a holder on user-selected SmallLint rules
- (or all rules if user made no selection"
-
- ^[ self smalllintRulesOrAll ]
-
- "Modified: / 17-04-2010 / 09:42:51 / Jan Vrany <jan.vrany@fit.cvut.cz>"
- "Created: / 23-01-2012 / 11:05:50 / Jan Vrany <jan.vrany@fit.cvut.cz>"
-! !
!NewSystemBrowser methodsFor:'menu actions-class'!
@@ -27018,11 +27447,11 @@
Such a query is not only annoying but also confusing to newcomers
"
eachClassToRemove sourceCodeManager isCVS ifTrue:[
- confirmed := Dialog
- confirmWithCancel:(resources
- string:'Remove the source container for ''%1'' in the repository ?\\Warning: can only be undone by manually fixing the CVS repository !!'
- with:eachClassToRemove name allBold) withCRs
- default:false.
+ confirmed := 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:[
"JV@2012-02-09: Mhh, mhh, what to return here?"
confirmed := false. "/false avoids timely listing of huge expecco's repository,
@@ -31611,6 +32040,7 @@
self classMenuGenerateMultiSetterMethod
! !
+
!NewSystemBrowser methodsFor:'menu actions-class hierarchy'!
classHierarchyMenuSelectWithAllSubclasses
@@ -31663,6 +32093,7 @@
^ self selectedClasses
! !
+
!NewSystemBrowser methodsFor:'menu actions-class packaging'!
excludeClasses: toExclude fromProject:aDefinitionClass using:generator
@@ -31694,6 +32125,7 @@
aDefinitionClass makeClassesAutoloaded:toMakeAutoloaded usingCompiler:generator
! !
+
!NewSystemBrowser methodsFor:'menu actions-class repository'!
allKnownTagsInClasses:aCollectionOfClasses
@@ -32041,63 +32473,63 @@
(aManagerOrNil isNil or:[aManagerOrNil performsCompilabilityChecks not]) ifTrue:[
errors := self checkCompilabilityOfAll:aCollectionOfClasses withExtensions: true errorsOnly:true.
errors notEmptyOrNil ifTrue:[
- (TextBox openOn:errors title:'Attention: about to check in class with errors' readOnly:true) isNil
- ifTrue:[
- AbortSignal raise
- ].
+ (TextBox openOn:errors title:'Attention: about to check in class with errors' readOnly:true) isNil
+ ifTrue:[
+ AbortSignal raise
+ ].
].
].
utilities := aManagerOrNil isNil
- ifTrue:[ SourceCodeManagerUtilities default ]
- ifFalse:[ aManagerOrNil utilities ].
+ ifTrue:[ SourceCodeManagerUtilities default ]
+ ifFalse:[ aManagerOrNil utilities ].
self withActivityNotificationsRedirectedToInfoLabelDo:[
- utilities
- checkinClasses:aCollectionOfClasses
- withInfo:logInfoOrNil
- withCheck:doCheck
- usingManager:aManagerOrNil.
+ 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:[
- (def allClassNames includes:cls name) not]
- ].
+ |pkg def|
+
+ pkg := cls package.
+ pkg notNil ifTrue:[
+ def := ProjectDefinition definitionClassForPackage:pkg.
+ ].
+ def notNil and:[
+ (def allClassNames includes:cls name) not]
+ ].
classesNotInPackage := classesNotInPackage collect:[:cls | cls theNonMetaclass].
classesNotInPackage notEmpty ifTrue:[
- classesNotInPackage size > 1 ifTrue:[
- msg := 'Add %2 classes to their Package definition (Make compiled or autoloaded) ?'
- ] ifFalse:[
- msg := 'Add %1 to its Package definition (Make compiled or autoloaded) ?'
- ].
- answer := Dialog
- confirmWithCancel:((resources string:msg
- with:classesNotInPackage first name
- with:classesNotInPackage size)
- , (resources
- stringWithCRs:'\\(Notice: You have to "checkIn build support files" for the package\for the compilation to become effective)')
- )
- labels:(resources array:#('Cancel' 'Autoloaded' 'Compiled')).
- answer == nil ifTrue:[^ self ].
-
- classesNotInPackage do:[:eachClass |
- |defClass|
-
- defClass := eachClass projectDefinitionClass.
- answer == true ifTrue:[
- defClass includeClasses:{ eachClass } usingCompiler:nil
- ] ifFalse:[
- defClass makeClassesAutoloaded:{ eachClass } usingCompiler:nil
- ].
- ].
+ classesNotInPackage size > 1 ifTrue:[
+ msg := 'Add %2 classes to their Package definition (Make compiled or autoloaded) ?'
+ ] ifFalse:[
+ msg := 'Add %1 to its Package definition (Make compiled or autoloaded) ?'
+ ].
+ answer := Dialog
+ confirmWithCancel:((resources string:msg
+ with:classesNotInPackage first name
+ with:classesNotInPackage size)
+ , (resources
+ stringWithCRs:'\\(Notice: You have to "checkIn build support files" for the package\for the compilation to become effective)')
+ )
+ labels:(resources array:#('Cancel' 'Autoloaded' 'Compiled')).
+ answer == nil ifTrue:[^ self ].
+
+ 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"
@@ -32962,18 +33394,22 @@
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 default sourceCodeManagerFor:currentClass.
mgr isNil ifTrue:[
^ self
].
self classMenuCompareTwoRepositoryVersionsUsingManager: mgr
+
"Modified (format): / 26-09-2012 / 12:17:45 / cg"
!
@@ -33170,174 +33606,42 @@
|mgr newestRev|
-<conflict>
-<conflict>
-<conflict>
-<conflict>
-<conflict>
-
-<conflict>
-<conflict>
-<conflict>
-<conflict>
-<conflict>
-<conflict>
-<conflict>
-<conflict>
-<conflict>
-<conflict>
-<conflict>
-<conflict>
-<conflict>
-<conflict>
-<conflict>
-<conflict>
-<conflict>
-<conflict>
-<conflict>
-
-<conflict>
-<conflict>
-<conflict>
-<conflict>
-<conflict>
-<conflict>
-<conflict>
-<conflict>
-<conflict>
-<conflict>
-<conflict>
-<conflict>
-<conflict>
-<conflict>
-<conflict>
-<conflict>
-<conflict>
-<conflict>
-<conflict>
-<conflict>
-<conflict>
-<conflict>
-<conflict>
-<conflict>
-<conflict>
-<conflict>
-<conflict>
-<conflict>
-<conflict>
-<conflict>
-<conflict>
-<conflict>
-<conflict>
-<conflict>
-<conflict>
-<conflict>
-<conflict>
-<conflict>
-<conflict>
-<conflict>
-<conflict>
-<conflict>
-<conflict>
-<conflict>
-<conflict>
-<conflict>
-<conflict>
-<conflict>
-<conflict>
-<conflict>
-<conflict>
-<conflict>
-<conflict>
-<conflict>
-<conflict>
-<conflict>
-<conflict>
-<conflict>
-<conflict>
-<conflict>
-<conflict>
-<conflict>
-<conflict>
-<conflict>
-<conflict>
-<conflict>
-<conflict>
-<conflict>
-<conflict>
-<conflict>
-<conflict>
-<conflict>
-<conflict>
-<conflict>
-<conflict>
-<conflict>
-<conflict>
-<conflict>
-<conflict>
-<conflict>
-<conflict>
-<conflict>
-<conflict>
-<conflict>
-<conflict>
-<conflict>
-<conflict>
-<conflict>
-<conflict>
-<conflict>
-<conflict>
-<conflict>
-<conflict>
-<conflict>
-<conflict>
-<conflict>
-<conflict>
-<conflict>
-<conflict>
-<conflict>
-<conflict>
-<conflict>
-<conflict>
-<conflict>
-<conflict>
-<conflict>
-<conflict>
-<conflict>
-<conflict>
-<conflict>
-<conflict>
-<conflict>
-<conflict>
-<conflict>
-<conflict>
-<conflict>
-<conflict>
-<conflict>
-<conflict>
-<conflict>
-<conflict>
-<conflict>
-<conflict>
-<conflict>
-<conflict>
-<conflict>
-<conflict>
-<conflict>
-<conflict>
-<conflict>
-<conflict>
-<conflict>
-<conflict>
-<conflict>
-<conflict>
-<conflict>
-<conflict>
-<conflict>
-<conflict>
-<conflict>
-<conflict>
-<conflict>
+ 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 := mgr newestRevisionOf:currentClass) notNil ifTrue:[
+ revString := '(newest is ' , rev , ')'
+ ]
+ ].
+
+ self busyLabel:'comparing ...' with:nil.
+ (UserPreferences versionDiffViewerClass)
+ openOnClass:currentClass
+ labelA:('repository: ' , revString)
+ sourceA:comparedSource
+ labelB:('current: (based on: ' , thisRevString , ')')
+ sourceB:currentSource
+ title:('comparing ' , currentClass name)
+ ifSame:[versionsAreTheSame := true].
+ ].
+ versionsAreTheSame ifTrue:[
+ ((thisRevString = 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.'.
+ ]
+ ].
+ ].
"Modified: / 11-10-2011 / 16:25:31 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Created: / 21-12-2011 / 20:28:48 / cg"
@@ -34116,7 +34420,9 @@
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"
!
@@ -34309,7 +34615,9 @@
"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"
!
@@ -34447,6 +34755,7 @@
"Created: / 21-12-2011 / 20:11:25 / cg"
! !
+
!NewSystemBrowser methodsFor:'menu actions-code'!
codeMenuAddClassVariable:newName inClass:aClass asValueHolder:asValueHolder
@@ -35853,7 +36162,7 @@
with:(self meta value ifTrue:['classInstance'] ifFalse:['instance']))
title:(resources string:'Rename Variable')
initialAnswer:oldName.
- newName isEmpty ifTrue:[
+ newName isEmptyOrNil ifTrue:[
^ self
].
(cls := aClass whichClassDefinesInstVar:newName) notNil ifTrue:[
@@ -36328,6 +36637,7 @@
aTwoArgBlock value:cls value:selector.
! !
+
!NewSystemBrowser methodsFor:'menu actions-debug'!
classMenuClearCoverageInfo
@@ -36927,6 +37237,7 @@
"Modified: / 28-02-2012 / 16:52:45 / cg"
! !
+
!NewSystemBrowser methodsFor:'menu actions-help'!
openClassDocumentation
@@ -36949,6 +37260,7 @@
HTMLDocumentView openFullOnDocumentationFile:'TOP.html'
! !
+
!NewSystemBrowser methodsFor:'menu actions-inheritance'!
inheritanceMenuNavigateToClass
@@ -36959,16 +37271,6 @@
self updateSpecialCodeEditorVisibility
! !
-!NewSystemBrowser methodsFor:'menu actions-lint'!
-
-runLint
- "run the new smallLint checker tool"
-
- self runLintOnPreviousRules
-
- "Modified: / 17-04-2010 / 10:44:00 / Jan Vrany <jan.vrany@fit.cvut.cz>"
- "Modified: / 07-03-2012 / 17:39:34 / cg"
-! !
!NewSystemBrowser methodsFor:'menu actions-methodList'!
@@ -37198,6 +37500,7 @@
"Modified: / 28-02-2012 / 16:27:44 / cg"
! !
+
!NewSystemBrowser methodsFor:'menu actions-namespace'!
nameSpaceMenuCheckOut
@@ -37323,6 +37626,7 @@
"Modified: / 28-02-2012 / 16:53:04 / cg"
! !
+
!NewSystemBrowser methodsFor:'menu actions-other'!
editModeInsert
@@ -37388,6 +37692,7 @@
"Created: / 15-10-2011 / 12:02:26 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
+
!NewSystemBrowser methodsFor:'menu actions-project'!
classMenuCheckInBuildSupportFiles
@@ -38648,201 +38953,216 @@
or merge-in the repository version.
"
- |classesInImage filesInImage|
+ |classesInImage filesInImage mgr|
(Dialog confirm:('This functionality is not yet completely implemented.'
, String lf
,'For now, only existing classes are updated - no new classes are added or old ones removed.'
, String lf
, 'Please use the import-structure function to get new definitions.')) ifFalse:[^ self].
- self checkOutClasses:(self selectedProjectClasses) askForRevision:false.
+
+ self selectedProjects value do:[:eachPackageID |
+ |definitionClass mgr classes|
+
+ definitionClass := ProjectDefinition definitionClassForPackage:eachPackageID.
+ definitionClass isNil ifTrue:[
+ mgr := SourceCodeManager
+ ] ifFalse:[
+ mgr := SourceCodeManagerUtilities default sourceCodeManagerFor:definitionClass
+ ].
+
+ classes := Smalltalk 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 := Smalltalk allClassesInPackage:eachProject.
- filesInImage := (classesInImage collect:[:cls | cls classBaseFilename]) asSet.
- "/ any differences ?
- classesNotInRepository := classesInImage reject:[:cls | (perProjectInfo includesKey:cls classBaseFilename)].
- classesDeletedInRepository := classesInImage select:[:cls | (perProjectInfo at:cls classBaseFilename ifAbsent:nil) == #deleted].
- perProjectInfo := perProjectInfo reject:[:v | v == #deleted].
- filesNotInImage := perProjectInfo keys reject:[:file | (filesInImage includes:file)].
-
- classesModifiedInImage := classesInImage select:[:cls | ChangeSet current includesChangeForClassOrMetaclass:cls].
- classesModifiedInRepository := classesInImage select:[:cls | |v|
- v := (perProjectInfo at:cls classBaseFilename ifAbsent:nil).
- v notNil and:[ v > cls revision]].
-
- anyDifference := false.
- filesNotInImage notEmpty ifTrue:[
- filePerClassDefintion := Dictionary new.
- classDefs := ChangeSet new.
- changeSets := OrderedCollection new.
- filesNotInImage do:[:eachSTFile |
- |s chgSet classDefinitions|
-
- s := SourceCodeManager
- streamForClass:nil fileName:eachSTFile revision:#newest directory:directory module:module cache:true.
- chgSet := ChangeSet fromStream:s.
- s close.
- changeSets add:chgSet.
- classDefinitions := chgSet select:[:change | change isClassDefinitionChange and:[change isPrivateClassDefinitionChange not]].
- classDefinitions do:[:def | filePerClassDefintion at:def put:eachSTFile].
- classDefs addAll:classDefinitions.
- ].
- "/ now, install ...
- classDefs do:[:eachClassDefinition |
- |cls oldPackage|
-
- eachClassDefinition package:eachProject.
- eachClassDefinition installAsAutoloadedClassIfPublicWithFilename:(filePerClassDefintion at:eachClassDefinition).
- (cls := eachClassDefinition changeClass) notNil ifTrue:[
- (oldPackage := cls package) ~= eachProject ifTrue:[
- (Dialog confirm:('Move the %1-class from %2 to %3 ?' bindWith:cls name allBold with:oldPackage allBold with:eachProject allBold)) ifTrue:[
- cls package:eachProject.
- cls instAndClassMethodsDo:[:m | m package = oldPackage ifTrue:[ m package:eachProject]].
- ]
- ].
- ].
- ].
- changeSets do:[:chgSet |
- chgSet apply
- ].
- ].
- classesModifiedInImage notEmpty ifTrue:[
- classesToCheckIn := OrderedCollection new.
- classesModifiedInImage do:[:eachChangedClass |
- |currentVersion repositoryVersion s stFile diffs|
-
- stFile := eachChangedClass classBaseFilename.
- s := SourceCodeManager
- streamForClass:nil fileName:stFile revision:#newest directory:directory module:module cache:true.
- repositoryVersion := ChangeSet fromStream:s.
- s close.
-
- currentVersion := ChangeSet forExistingClass:eachChangedClass.
- diffs := currentVersion diffSetsAgainst:repositoryVersion.
- diffs isEmpty ifTrue:[
- ChangeSet current condenseChangesForClass:eachChangedClass
- ] ifFalse:[
-self halt.
- classesToCheckIn add:eachChangedClass.
- ].
- ].
- classesToCheckIn notEmpty ifTrue:[
-self halt.
- ].
- ].
- classesModifiedInRepository notEmpty ifTrue:[
- box := Dialog
- forRequestText:(resources stringWithCRs:'The following classes need to be updated from the repository.')
- editViewClass:ListView
- lines:10 columns:20
- initialAnswer:nil model:nil
- setupWith:
- [:v :d |
- |removeButton|
-
- v list:classesModifiedInRepository.
- d okButton label:(resources string:'Update').
- d okButton isReturnButton:true.
- ].
- box open.
- box accepted ifFalse:[
- ^ self
- ].
- classesModifiedInRepository do:[:eachClass|
- |s chgSet|
-
- s := SourceCodeManager
- streamForClass:eachClass fileName:nil revision:#newest directory:directory module:module cache:true.
- chgSet := ChangeSet fromStream:s.
- s close.
- chgSet apply.
- ].
- ].
- classesDeletedInRepository notEmpty ifTrue:[
-self halt.
- ].
- classesNotInRepository notEmpty ifTrue:[
- "/ if there are no changeSet entries for those classes, they seem to be
- "/ no longer in the repository (possibly moved ?)
- "/ If there are entries, these might have been added in the image and need a check-in
- classesAddedInImage := classesNotInRepository select:[:cls | ChangeSet current includesChangeForClassOrMetaclass:cls].
- classesAddedInImage isEmpty ifTrue:[
- doRemove := false.
- box := Dialog
- forRequestText:(resources stringWithCRs:'The following classes are no longer in the repository (or moved to another package).\\Remove classes from the image ?')
- editViewClass:ListView
- lines:10 columns:20
- initialAnswer:nil model:nil
- setupWith:
- [:v :d |
- |removeButton|
-
- removeButton := Button label:(resources string:'Remove').
- removeButton action:[ doRemove := true. box okPressed. ].
- v list:classesNotInRepository.
- d addButton:removeButton after:(d okButton).
- d okButton label:(resources string:'Continue').
- d okButton isReturnButton:true.
- ].
- box open.
- box accepted ifFalse:[
- ^ self
- ].
- doRemove ifTrue:[
-self halt.
- classesNotInRepository do:[:eachClassToRemove |
- |subClasses|
-
- subClasses := eachClassToRemove allSubclasses.
- (subClasses conform:
- [:subClass |
- |ownerOrClassItself|
-
- ownerOrClassItself := subClass topOwningClass ? subClass.
- (classesNotInRepository includes:ownerOrClassItself)
- ])
- ifTrue:[
- Smalltalk removeClass:eachClassToRemove.
- ChangeSet current condenseChangesForClass:eachClassToRemove.
- ] ifFalse:[
- Dialog warn:'Cannit simply remove the class - more repair needed due to subclass(es)'.
- ].
- ].
- ].
- ] ifFalse:[
-self halt.
- ].
- ].
-
- anyDifference ifFalse:[
- "/ Dialog information:(resources string:'%1 is up-to-date.' with:eachProject allBold).
- Transcript showCR:('%1 is up-to-date.' bindWith:eachProject allBold).
- ChangeSet current condenseChangesForPackage:eachProject.
- ] ifTrue:[
-self halt.
- self checkOutClasses:(self selectedProjectClasses) askForRevision:false
- ].
- ].
-
- "Modified: / 13-10-2006 / 01:31:43 / cg"
+"/ #TODO.
+"/
+"/ self selectedProjects value do:[:eachProject |
+"/ |module directory perProjectInfo
+"/ classesNotInRepository filesNotInImage classesDeletedInRepository
+"/ classesModifiedInImage classesModifiedInRepository
+"/ classesDeletedInImage classesAddedInImage
+"/ anyDifference box doRemove classDefs changeSets filePerClassDefintion
+"/ classesToCheckIn|
+"/
+"/ module := eachProject asPackageId module.
+"/ directory := eachProject asPackageId directory.
+"/ perProjectInfo := SourceCodeManager newestRevisionsInModule:module directory:directory.
+"/ perProjectInfo := perProjectInfo ? #().
+"/ perProjectInfo := perProjectInfo select:[:info | info key asFilename hasSuffix:'st'].
+"/ perProjectInfo := Dictionary withAssociations:perProjectInfo.
+"/
+"/ classesInImage := Smalltalk allClassesInPackage:eachProject.
+"/ filesInImage := (classesInImage collect:[:cls | cls classBaseFilename]) asSet.
+"/ "/ any differences ?
+"/ classesNotInRepository := classesInImage reject:[:cls | (perProjectInfo includesKey:cls classBaseFilename)].
+"/ classesDeletedInRepository := classesInImage select:[:cls | (perProjectInfo at:cls classBaseFilename ifAbsent:nil) == #deleted].
+"/ perProjectInfo := perProjectInfo reject:[:v | v == #deleted].
+"/ filesNotInImage := perProjectInfo keys reject:[:file | (filesInImage includes:file)].
+"/
+"/ classesModifiedInImage := classesInImage select:[:cls | ChangeSet current includesChangeForClassOrMetaclass:cls].
+"/ classesModifiedInRepository := classesInImage select:[:cls | |v|
+"/ v := (perProjectInfo at:cls classBaseFilename ifAbsent:nil).
+"/ v notNil and:[ v > cls revision]].
+"/
+"/ anyDifference := false.
+"/ filesNotInImage notEmpty ifTrue:[
+"/ filePerClassDefintion := Dictionary new.
+"/ classDefs := ChangeSet new.
+"/ changeSets := OrderedCollection new.
+"/ filesNotInImage do:[:eachSTFile |
+"/ |s chgSet classDefinitions|
+"/
+"/ s := SourceCodeManager
+"/ streamForClass:nil fileName:eachSTFile revision:#newest directory:directory module:module cache:true.
+"/ chgSet := ChangeSet fromStream:s.
+"/ s close.
+"/ changeSets add:chgSet.
+"/ classDefinitions := chgSet select:[:change | change isClassDefinitionChange and:[change isPrivateClassDefinitionChange not]].
+"/ classDefinitions do:[:def | filePerClassDefintion at:def put:eachSTFile].
+"/ classDefs addAll:classDefinitions.
+"/ ].
+"/ "/ now, install ...
+"/ classDefs do:[:eachClassDefinition |
+"/ |cls oldPackage|
+"/
+"/ eachClassDefinition package:eachProject.
+"/ eachClassDefinition installAsAutoloadedClassIfPublicWithFilename:(filePerClassDefintion at:eachClassDefinition).
+"/ (cls := eachClassDefinition changeClass) notNil ifTrue:[
+"/ (oldPackage := cls package) ~= eachProject ifTrue:[
+"/ (Dialog confirm:('Move the %1-class from %2 to %3 ?' bindWith:cls name allBold with:oldPackage allBold with:eachProject allBold)) ifTrue:[
+"/ cls package:eachProject.
+"/ cls instAndClassMethodsDo:[:m | m package = oldPackage ifTrue:[ m package:eachProject]].
+"/ ]
+"/ ].
+"/ ].
+"/ ].
+"/ changeSets do:[:chgSet |
+"/ chgSet apply
+"/ ].
+"/ ].
+"/ classesModifiedInImage notEmpty ifTrue:[
+"/ classesToCheckIn := OrderedCollection new.
+"/ classesModifiedInImage do:[:eachChangedClass |
+"/ |currentVersion repositoryVersion s stFile diffs|
+"/
+"/ stFile := eachChangedClass classBaseFilename.
+"/ s := SourceCodeManager
+"/ streamForClass:nil fileName:stFile revision:#newest directory:directory module:module cache:true.
+"/ repositoryVersion := ChangeSet fromStream:s.
+"/ s close.
+"/
+"/ currentVersion := ChangeSet forExistingClass:eachChangedClass.
+"/ diffs := currentVersion diffSetsAgainst:repositoryVersion.
+"/ diffs isEmpty ifTrue:[
+"/ ChangeSet current condenseChangesForClass:eachChangedClass
+"/ ] ifFalse:[
+"/self halt.
+"/ classesToCheckIn add:eachChangedClass.
+"/ ].
+"/ ].
+"/ classesToCheckIn notEmpty ifTrue:[
+"/self halt.
+"/ ].
+"/ ].
+"/ classesModifiedInRepository notEmpty ifTrue:[
+"/ box := Dialog
+"/ forRequestText:(resources stringWithCRs:'The following classes need to be updated from the repository.')
+"/ editViewClass:ListView
+"/ lines:10 columns:20
+"/ initialAnswer:nil model:nil
+"/ setupWith:
+"/ [:v :d |
+"/ |removeButton|
+"/
+"/ v list:classesModifiedInRepository.
+"/ d okButton label:(resources string:'Update').
+"/ d okButton isReturnButton:true.
+"/ ].
+"/ box open.
+"/ box accepted ifFalse:[
+"/ ^ self
+"/ ].
+"/ classesModifiedInRepository do:[:eachClass|
+"/ |s chgSet|
+"/
+"/ s := SourceCodeManager
+"/ streamForClass:eachClass fileName:nil revision:#newest directory:directory module:module cache:true.
+"/ chgSet := ChangeSet fromStream:s.
+"/ s close.
+"/ chgSet apply.
+"/ ].
+"/ ].
+"/ classesDeletedInRepository notEmpty ifTrue:[
+"/self halt.
+"/ ].
+"/ classesNotInRepository notEmpty ifTrue:[
+"/ "/ if there are no changeSet entries for those classes, they seem to be
+"/ "/ no longer in the repository (possibly moved ?)
+"/ "/ If there are entries, these might have been added in the image and need a check-in
+"/ classesAddedInImage := classesNotInRepository select:[:cls | ChangeSet current includesChangeForClassOrMetaclass:cls].
+"/ classesAddedInImage isEmpty ifTrue:[
+"/ doRemove := false.
+"/ box := Dialog
+"/ forRequestText:(resources stringWithCRs:'The following classes are no longer in the repository (or moved to another package).\\Remove classes from the image ?')
+"/ editViewClass:ListView
+"/ lines:10 columns:20
+"/ initialAnswer:nil model:nil
+"/ setupWith:
+"/ [:v :d |
+"/ |removeButton|
+"/
+"/ removeButton := Button label:(resources string:'Remove').
+"/ removeButton action:[ doRemove := true. box okPressed. ].
+"/ v list:classesNotInRepository.
+"/ d addButton:removeButton after:(d okButton).
+"/ d okButton label:(resources string:'Continue').
+"/ d okButton isReturnButton:true.
+"/ ].
+"/ box open.
+"/ box accepted ifFalse:[
+"/ ^ self
+"/ ].
+"/ doRemove ifTrue:[
+"/self halt.
+"/ classesNotInRepository do:[:eachClassToRemove |
+"/ |subClasses|
+"/
+"/ subClasses := eachClassToRemove allSubclasses.
+"/ (subClasses conform:
+"/ [:subClass |
+"/ |ownerOrClassItself|
+"/
+"/ ownerOrClassItself := subClass topOwningClass ? subClass.
+"/ (classesNotInRepository includes:ownerOrClassItself)
+"/ ])
+"/ ifTrue:[
+"/ Smalltalk removeClass:eachClassToRemove.
+"/ ChangeSet current condenseChangesForClass:eachClassToRemove.
+"/ ] ifFalse:[
+"/ Dialog warn:'Cannit simply remove the class - more repair needed due to subclass(es)'.
+"/ ].
+"/ ].
+"/ ].
+"/ ] ifFalse:[
+"/self halt.
+"/ ].
+"/ ].
+"/
+"/ anyDifference ifFalse:[
+"/ "/ Dialog information:(resources string:'%1 is up-to-date.' with:eachProject allBold).
+"/ Transcript showCR:('%1 is up-to-date.' bindWith:eachProject allBold).
+"/ ChangeSet current condenseChangesForPackage:eachProject.
+"/ ] ifTrue:[
+"/self halt.
+"/ self checkOutClasses:(self selectedProjectClasses) askForRevision:false
+"/ ].
+"/ ].
+
+ "Modified: / 10-02-2012 / 17:32:39 / cg"
!
projectMenuCheckPackageIntegrity
@@ -39176,17 +39496,17 @@
suffix := ''.
] ifFalse:[
aFormatSymbolOrNil == #xml ifTrue:[
- suffix := '.xml'
- ] ifFalse:[
- aFormatSymbolOrNil == #sif ifTrue:[
- suffix := '.sif'
- ] ifFalse:[
- aFormatSymbolOrNil == #binary ifTrue:[
- suffix := '.cls'
- ] ifFalse:[
- suffix := '.st'
- ]
- ]
+ suffix := '.xml'
+ ] ifFalse:[
+ aFormatSymbolOrNil == #sif ifTrue:[
+ suffix := '.sif'
+ ] ifFalse:[
+ aFormatSymbolOrNil == #binary ifTrue:[
+ suffix := '.cls'
+ ] ifFalse:[
+ suffix := '.st'
+ ]
+ ]
].
].
fileName := fileName , suffix.
@@ -39201,10 +39521,10 @@
requestDirectoryName: (resources string:'FileOut %1 in:' with:(currentProject ? 'selected projects'))
"default: (FileSelectionBox lastFileSelectionDirectory)"
] ifFalse:[
- saveName := Dialog
- requestFileNameForSave:(resources string:'FileOut %1 as:' with:(currentProject ? 'selected projects'))
- default:fileName
- fromDirectory:(FileSelectionBox lastFileSelectionDirectory).
+ saveName := Dialog
+ requestFileNameForSave:(resources string:'FileOut %1 as:' with:(currentProject ? 'selected projects'))
+ default:fileName
+ fromDirectory:(FileSelectionBox lastFileSelectionDirectory).
].
"/ fileBox := FileSelectionBox
@@ -39496,6 +39816,55 @@
].
!
+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|
+
+ defClass validateDescription.
+
+ 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 |
+ (directory construct:fileName) contents:fileContents.
+ ].
+ ].
+
+ self activityNotification:nil.
+!
+
projectMenuGeneratePatchSet
"ask for two tags, generate a patchSet to bring a baseSystem (tag1) to the
level of the tag2 version"
@@ -40709,6 +41078,7 @@
"Modified: / 23-10-2006 / 11:01:42 / cg"
! !
+
!NewSystemBrowser methodsFor:'menu actions-project-monticello'!
projectMenuMonticelloBrowseRepositories
@@ -40717,6 +41087,7 @@
"Created: / 01-12-2011 / 21:47:24 / cg"
! !
+
!NewSystemBrowser methodsFor:'menu actions-protocol'!
doMoveSelectedProtocolsToProject:newProject
@@ -41451,6 +41822,7 @@
"Modified: / 28-02-2012 / 16:34:54 / cg"
! !
+
!NewSystemBrowser methodsFor:'menu actions-searching'!
askForClassToSearch:doWhatByDefault single:singleClass msgTail:msgTail resources:resourcesOrNil thenDo:aBlock
@@ -42101,6 +42473,7 @@
"Modified: / 02-06-2011 / 11:35:43 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
+
!NewSystemBrowser methodsFor:'menu actions-selector'!
askForClassToMoveOrCopy:doWhat
@@ -42170,27 +42543,28 @@
].
].
- newClassName := Dialog
- request:(resources string:reqString) withCRs
- initialAnswer:(initial ? '')
- okLabel:(resources string:okLabel)
- title:(resources string:title)
- onCancel:nil
- list:list
- entryCompletionBlock:(DoWhatIMeanSupport classNameEntryCompletionBlock).
-
- newClassName isNil ifTrue:[^ nil].
- (newClassName startsWith:'---- ') ifTrue:[^ nil].
-
- newClass := self classIfValidNonMetaClassName:newClassName.
- newClass isNil ifTrue:[
- ^ nil
- ].
-
- LastMethodMoveOrCopyTargetClass := newClass theNonMetaclass name.
- ^ newClass.
-
- "Modified: / 22.12.2001 / 03:04:48 / cg"
+ [
+ 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
@@ -42924,7 +43298,7 @@
"/ ask if so many methods should be rewritten; give chance to cancel
"/ JV: but not if refactorings are confimed anyway in performRefactoring:...
UserPreferences current confirmRefactorings ifFalse:[
- (self findSendersOf:oldSelector in:affectedClasses andConfirmRefactoring:refactoring) ifFalse:[ ^ self ].
+ (self findSendersOf:oldSelector in:affectedClasses andConfirmRefactoring:refactoring) ifFalse:[ ^ self ].
].
].
@@ -44468,13 +44842,15 @@
].
"look for majority protocol in subclasses"
subclassCategories := Bag new.
- mthd mclass allSubclassesDo:[:cls |
- |redefined|
-
- redefined := superClass compiledMethodAt:mthd selector.
- redefined notNil ifTrue:[
- subclassCategories add:(redefined category).
- ]
+ 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
@@ -45796,7 +46172,7 @@
classes:Smalltalk allClasses
label:'Senders'
- "Modified: / 05-09-2006 / 10:42:46 / cg"
+ "Modified: / 13-02-2012 / 13:17:20 / cg"
!
spawnMethodSendersBrowserFor:aSelectorCollection in:openHow classes:setOfClasses label:labelPrefix
@@ -46020,6 +46396,7 @@
"Modified: / 28-02-2012 / 16:36:22 / cg"
! !
+
!NewSystemBrowser methodsFor:'menu actions-subversion'!
commonMenuSubversionOpenSettings
@@ -46029,6 +46406,7 @@
"Modified: / 26-03-2010 / 20:01:54 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
+
!NewSystemBrowser methodsFor:'menu actions-subversion-class'!
classMenuSubversionShowRevisionLog
@@ -46049,6 +46427,7 @@
"Modified: / 28-02-2012 / 16:48:38 / cg"
! !
+
!NewSystemBrowser methodsFor:'menu actions-variables'!
browseVarRefsOrModsWithTitle:browserTitle boxTitle:boxTitle variables:varType access:accessType all:browseAll
@@ -47419,6 +47798,7 @@
aBlock value:selectedVariable value:isClassVar
! !
+
!NewSystemBrowser methodsFor:'menu-actions-other'!
goBack
@@ -47445,6 +47825,7 @@
"Modified: / 22-02-2008 / 17:18:56 / janfrog"
! !
+
!NewSystemBrowser methodsFor:'menus-dynamic'!
boockmarksMenu
@@ -48515,25 +48896,29 @@
<resource: #programMenu >
^ [
- |m cls classes|
+ |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:className.
+ 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
@@ -48665,6 +49050,7 @@
"Modified: / 09-09-2012 / 13:24:04 / cg"
! !
+
!NewSystemBrowser methodsFor:'menus-dynamic-SCM'!
categoryMenuSCMFor: sourceCodeManagerClassName
@@ -49100,6 +49486,7 @@
"Modified: / 19-10-2011 / 16:48:31 / cg"
! !
+
!NewSystemBrowser methodsFor:'menus-dynamic-popup'!
categoryPopUpMenu
@@ -49145,6 +49532,7 @@
"Created: / 12-10-2011 / 20:28:48 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
+
!NewSystemBrowser methodsFor:'menus-dynamic-subversion'!
commonSubversionBranchMenu
@@ -49177,6 +49565,7 @@
"Modified (format): / 01-12-2011 / 21:06:52 / cg"
! !
+
!NewSystemBrowser methodsFor:'navigation'!
askForClassNameMatching:matchStringArg
@@ -49768,108 +50157,108 @@
|className class implementors answer classesMatchingCaseless|
aMatchString isEmptyOrNil ifTrue:[
- ^ self.
+ ^ self.
].
aMatchString knownAsSymbol ifTrue:[
- class := Smalltalk classNamed:aMatchString.
- class notNil ifTrue:[
- self switchToClass:class.
- ^ self.
- ].
- classesMatchingCaseless := Smalltalk keys select:[:nm | nm sameAs:aMatchString].
+ class := Smalltalk classNamed:aMatchString.
+ class notNil ifTrue:[
+ self switchToClass:class.
+ ^ self.
+ ].
+ classesMatchingCaseless := Smalltalk keys select:[:nm | nm sameAs:aMatchString].
"/ matchStringLowercase := aMatchString asLowercase.
"/ classesWithPrefixCaseless := Smalltalk keys select:[:nm | nm asLowercase startsWith:aMatchString].
"/ impl := Smalltalk allImplementorsOf:aMatchString asSymbol.
"/ impl notEmptyOrNil ifTrue:[
"/ ].
- (aMatchString first isLetter not
- or:[ aMatchString first isLowercase]) ifTrue:[
- implementors := SystemBrowser findImplementorsMatching:aMatchString in:(Smalltalk allClasses) ignoreCase:true.
- implementors size > 0 ifTrue:[
- (classesMatchingCaseless isEmpty and:[implementors size == 1]) ifTrue:[
- answer := Dialog
- confirm:(resources
- stringWithCRs:'No class named "%1".\But "%2" implements it. Go there ?'
- with:aMatchString allBold
- with:implementors first mclass name).
- answer ifTrue:[
- self switchToClass:implementors first mclass selector:implementors first selector.
- ].
- ^ self.
- ].
- implementors := implementors asOrderedCollection sort:[:a :b | a mclass name < b mclass name].
- classesMatchingCaseless isEmpty ifTrue:[
- answer := Dialog
- choose:(resources
- stringWithCRs:'No class named "%1.\But there are %2 implementors of it.\\Goto one of them ?'
- with:aMatchString allBold
- with:implementors size)
- fromList:(implementors collect:[:m | m mclass name])
- values:implementors
- buttons:#('No, Search for a Class' 'Show all Implementors') values:#(searchClass browseAllImplementors)
- 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:' colorizeAllWith:Color grey}
- ,(implementors collect:[:m | m mclass name])
- ,{'Classes:' colorizeAllWith:Color grey}
- ,classesMatchingCaseless)
- values:(#(nil),implementors,#(nil),classesMatchingCaseless)
- buttons:#('No, Search for a Class' 'Show all Implementors') values:#(searchClass browseAllImplementors)
- lines:10 cancel:nil
- postBuildBlock:[:box | box minExtent:300@250].
- ].
-
- answer isNil ifTrue:[^ self].
- answer == #browseAllImplementors ifTrue:[
- self
- spawnMethodBrowserForSearch:[
- SystemBrowser
- findImplementorsOf:aMatchString
- in:Smalltalk allClasses
- ignoreCase:false.
- ]
- sortBy:#class
- in:#newBuffer
- label:(resources string:'Implementors of %1' string with:aMatchString).
- ^ self
- ].
- answer ~~ #searchClass ifTrue:[
- answer isSymbol ifTrue:[
- self switchToClass:(Smalltalk classNamed:answer).
- ] ifFalse:[
- self switchToClass:(answer mclass) selector:(answer selector).
- ].
- ^ self.
- ].
- ].
- ].
+ (aMatchString first isLetter not
+ or:[ aMatchString first isLowercase]) ifTrue:[
+ implementors := SystemBrowser findImplementorsMatching:aMatchString in:(Smalltalk allClasses) ignoreCase:true.
+ implementors size > 0 ifTrue:[
+ (classesMatchingCaseless isEmpty and:[implementors size == 1]) ifTrue:[
+ answer := Dialog
+ confirm:(resources
+ stringWithCRs:'No class named "%1".\But "%2" implements it. Go there ?'
+ with:aMatchString allBold
+ with:implementors first mclass name).
+ answer ifTrue:[
+ self switchToClass:implementors first mclass selector:implementors first selector.
+ ].
+ ^ self.
+ ].
+ implementors := implementors asOrderedCollection sort:[:a :b | a mclass name < b mclass name].
+ classesMatchingCaseless isEmpty ifTrue:[
+ answer := Dialog
+ choose:(resources
+ stringWithCRs:'No class named "%1.\But there are %2 implementors of it.\\Goto one of them ?'
+ with:aMatchString allBold
+ with:implementors size)
+ fromList:(implementors collect:[:m | m mclass name])
+ values:implementors
+ buttons:#('No, Search for a Class' 'Show all Implementors') values:#(searchClass browseAllImplementors)
+ 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:' colorizeAllWith:Color grey}
+ ,(implementors collect:[:m | m mclass name])
+ ,{'Classes:' colorizeAllWith:Color grey}
+ ,classesMatchingCaseless)
+ values:(#(nil),implementors,#(nil),classesMatchingCaseless)
+ buttons:#('No, Search for a Class' 'Show all Implementors') values:#(searchClass browseAllImplementors)
+ lines:10 cancel:nil
+ postBuildBlock:[:box | box minExtent:300@250].
+ ].
+
+ answer isNil ifTrue:[^ self].
+ answer == #browseAllImplementors ifTrue:[
+ self
+ spawnMethodBrowserForSearch:[
+ SystemBrowser
+ findImplementorsOf:aMatchString
+ in:Smalltalk allClasses
+ ignoreCase:false.
+ ]
+ sortBy:#class
+ in:#newBuffer
+ label:(resources string:'Implementors of %1' string with:aMatchString).
+ ^ self
+ ].
+ answer ~~ #searchClass ifTrue:[
+ answer isSymbol ifTrue:[
+ self switchToClass:(Smalltalk classNamed:answer).
+ ] ifFalse:[
+ self switchToClass:(answer mclass) selector:(answer selector).
+ ].
+ ^ self.
+ ].
+ ].
+ ].
].
"Look for Java class..."
(JAVA notNil and:[aMatchString includes: $.]) ifTrue:[
- | javaClass |
-
- javaClass := Java at: aMatchString.
- javaClass notNil ifTrue:[
- self switchToClass: javaClass.
- ^self
- ].
+ | javaClass |
+
+ javaClass := Java at: aMatchString.
+ javaClass notNil ifTrue:[
+ self switchToClass: javaClass.
+ ^self
+ ].
].
className := self askForClassNameMatching:aMatchString.
className notNil ifTrue:[
- self switchToClassNamed:className.
+ self switchToClassNamed:className.
]
"Modified: / 04-07-2006 / 18:48:25 / fm"
@@ -49994,6 +50383,7 @@
"Modified: / 5.2.2000 / 23:07:10 / cg"
! !
+
!NewSystemBrowser methodsFor:'private-buffers'!
removeBuffer:nr
@@ -50045,6 +50435,7 @@
self removeBuffer:(selectedBuffer value)
! !
+
!NewSystemBrowser methodsFor:'private-checks'!
anySpecialEditorModified
@@ -50182,6 +50573,7 @@
^ true
! !
+
!NewSystemBrowser methodsFor:'private-code update'!
autoSearch:aString
@@ -51230,6 +51622,7 @@
"Modified: / 01-12-2011 / 14:26:59 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
+
!NewSystemBrowser methodsFor:'private-dialogs'!
askForDirectoryToFileOut:title default:defaultDirOrNil
@@ -52299,6 +52692,7 @@
cancel: [nil]
! !
+
!NewSystemBrowser methodsFor:'private-helpers'!
anySelectedClass
@@ -53420,6 +53814,7 @@
and:[ (view isSameOrComponentOf:appView) ]
! !
+
!NewSystemBrowser methodsFor:'private-helpers-subApps'!
categoryListApp
@@ -53468,6 +53863,7 @@
^ navigationState projectListApplication
! !
+
!NewSystemBrowser methodsFor:'private-history'!
lastSearchPatterns
@@ -53500,6 +53896,7 @@
"Modified: / 14-02-2012 / 14:00:36 / cg"
! !
+
!NewSystemBrowser methodsFor:'private-presentation'!
asyncShowMethodInfo
@@ -54125,37 +54522,6 @@
].
!
-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"
-!
-
withActivityNotificationsRedirectedToInfoLabelDo:aBlock
ActivityNotification handle:[:ex |
self showInfo:(ex messageText).
@@ -54174,6 +54540,7 @@
]
! !
+
!NewSystemBrowser methodsFor:'private-searching'!
searchCompletionBlock
@@ -54306,6 +54673,7 @@
"Created: / 06-04-2012 / 12:56:10 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
+
!NewSystemBrowser methodsFor:'private-semantic checks'!
checkAcceptedMethod:aMethod inClass:aClass
@@ -54636,84 +55004,9 @@
^ nil.
! !
+
!NewSystemBrowser methodsFor:'private-smalllint'!
-loadSmalllint
- |pkg |
-
- pkg := Smalltalk at:#'stx_goodies_refactoryBrowser_lint'.
- (pkg isNil or:[ pkg isFullyLoaded not ]) ifTrue:[
- Smalltalk loadPackage:#'stx:goodies/refactoryBrowser/lint' asAutoloaded:false
- ].
-
- "
- 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"
-!
-
-smalllintCheck:anEnvironment against:ruleSetSymbol
- "this is exected by an async task!!"
-
- |rule runRules|
-
- self assert:(#( #smalllintRulesAll #smalllintRulesFromUser #smalllintRules ) includes:ruleSetSymbol).
-
- rule := self perform:ruleSetSymbol asSymbol.
- rule isNil ifTrue:[ ^ self ].
-"/ cg: that is wrong implemented in RBxxxRule: isEmpty has two meanings:
-"/ for composite: has sub-rules
-"/ for non-composite: has a result
-"/ therefore, isEmpty returns true here, so we will be always asked twice!!
-
- rule isEmptyInTree ifTrue:[
- ruleSetSymbol ~~ #smalllintRulesFromUser ifTrue:[
- rule := self smalllintRulesFromUser.
- rule isNil ifTrue:[ ^ self ].
- ]
- ].
-
- runRules :=
- [
- |showResult|
-
- self smalllintRunRule:rule onEnvironment:anEnvironment.
- showResult := true.
- [rule notNil and:[rule isEmpty]] whileTrue:[
- (Dialog confirm:'Nothing special found.\\Proceed to select more/different lint rules.' withCRs) ifTrue:[
- rule := self smalllintRulesFromUser.
- rule notNil ifTrue:[
- self smalllintRunRule:rule onEnvironment:anEnvironment.
- ].
- ] ifFalse:[
- rule := nil
- ].
- ].
- rule notNil ifTrue:[
- self
- spawnSmalllintBrowserByRuleFor:rule
- in:#newBuffer
- label:'SmallLint results for ' , anEnvironment label
- ].
- ].
-
- "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: / 28-08-2010 / 20:45:52 / Jan Vrany <jan.vrany@fit.cvut.cz>"
- "Modified: / 15-05-2012 / 10:46:02 / cg"
-!
-
smalllintRulesAll
"Return all lint rules except those specific for portability or
dialect-specific rules"
@@ -54726,27 +55019,6 @@
"Modified: / 06-09-2012 / 14:56:48 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
-smalllintRulesFromUser
- |dlg|
-
- self loadSmalllint.
- dlg := Tools::LintRuleSelectionDialog new.
-
- dlg selection: (LastLintRules ifNil:[nil"self smalllintRulesAll flattened"] ifNotNil:[LastLintRules flattened]).
- ^ (dlg open; accepted)
- ifTrue:[ LastLintRules := dlg selectionAsRule ]
- ifFalse:[ nil ].
-
- "
- LastLintRules := nil.
- Tools::NewSystemBrowser basicNew smalllintRulesFromUser
- "
-
- "Created: / 17-04-2010 / 09:41:54 / Jan Vrany <jan.vrany@fit.cvut.cz>"
- "Modified: / 25-08-2010 / 15:35:16 / Jan Vrany <enter your email here>"
- "Modified (format): / 06-03-2012 / 18:55:09 / cg"
-!
-
smalllintRulesGood
"Return all 'good' lint rules - good means that they are verified and
should be used"
@@ -54756,18 +55028,6 @@
"Created: / 06-09-2012 / 14:54:15 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
-smalllintRulesOrAll
- "Returns a set of user-selected SmallLint rules or all rules,
- if no user selection is done"
-
- ^LastLintRules notNil
- ifTrue:[ LastLintRules ]
- ifFalse:[ self smalllintRulesAll ]
-
- "Created: / 23-01-2012 / 10:59:55 / Jan Vrany <jan.vrany@fit.cvut.cz>"
- "Modified (format): / 07-03-2012 / 20:05:40 / cg"
-!
-
smalllintRulesOrGood
"Returns a set of user-selected SmallLint rules or all 'good' rules,
if no user selection is done"
@@ -54777,194 +55037,8 @@
ifFalse:[ self smalllintRulesGood ]
"Created: / 06-09-2012 / 14:49:52 / Jan Vrany <jan.vrany@fit.cvut.cz>"
-!
-
-smalllintRunRule: aLintRule onEnvironment: anEnvironment
- "run a checker in the background"
-
- | rules |
-
- rules := aLintRule flattened.
- rules withIndexDo:[:rule :index|
- |t|
-
- ProgressNotification new
- messageText: ('Checking: ', rule name);
- parameter: (rules size / 100) * index;
- raiseRequest.
- t := Time millisecondsToRun:[
- (SmalllintChecker runRule: rule onEnvironment: anEnvironment)
- ].
- Transcript show:rule name,': ';showCR:t.
- ].
- ProgressNotification new
- messageText: ('Done');
- parameter: 100;
- raiseRequest.
-
- "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: / 01-03-2012 / 15:22:20 / cg"
-!
-
-spawnSmalllintBrowserByRuleFor: result in:where label:labelOrNil
- ^ self
- newBrowserOrBufferDependingOn:where
- label:labelOrNil
- forSpec: #smallLintByRuleResultBrowserSpec
- setupWith:[:browser |
- |methodGenerator classGenerator ruleGenerator|
-
- ruleGenerator :=
- Iterator on:[:whatToDo|
- result failedRules do:whatToDo].
-
- methodGenerator :=
- Iterator on: [:whatToDo|
- | selectedRules selectedClasses failedMethods |
-
- selectedClasses := browser selectedClasses value.
- selectedRules := browser selectedLintRules value.
- failedMethods := OrderedCollection new.
- selectedClasses isEmptyOrNil ifFalse:
- [selectedRules ? #() do:
- [:rule|
- 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.
-
- browser selectedClasses
- onChangeSend: #changed to: browser selectorListGenerator.
- browser selectedLintRules
- onChangeSend: #changed to: browser selectorListGenerator.
- browser meta
- onChangeSend: #changed to: browser selectorListGenerator.
-
- "/ cg: does not work - why?
- result failedRules size == 1 ifTrue:[
- "/ autoselect the first one
- browser selectedLintRules value:(result failedRules).
- ].
-
- "/self halt.
- "
- theMethodList isNil ifTrue:[
- methodsOrMethodGeneratorBlock isBlock ifTrue:[
- theMethodList := methodsOrMethodGeneratorBlock value.
- ] ifFalse:[
- theMethodList := methodsOrMethodGeneratorBlock copy.
- ].
- ].
- perClassInfo := perClassInfoHolder value.
- perMethodInfo := perMethodInfoHolder value.
-
- methodGenerator := Iterator on:[:whatToDo |
- theMethodList isNil ifTrue:[
- methodsOrMethodGeneratorBlock isBlock ifTrue:[
- theMethodList := methodsOrMethodGeneratorBlock value.
- ] ifFalse:[
- theMethodList := methodsOrMethodGeneratorBlock copy.
- ].
- ].
- perClassInfo := perClassInfoHolder value.
- perMethodInfo := perMethodInfoHolder value.
-
- theMethodNameList := theMethodList collect:[:eachMethod | eachMethod mclass -> eachMethod selector].
- theMethodNameList do:[:mAssoc |
- |methodClass methodSelector method|
-
- methodClass := mAssoc key.
- methodSelector := mAssoc value.
- methodClass notNil ifTrue:[
- method := methodClass compiledMethodAt:methodSelector.
- method notNil ifTrue:[
- whatToDo
- value:methodClass
- value:method category
- value:methodSelector
- value:method.
- ].
- ].
- ].
- methodsOrMethodGeneratorBlock isBlock ifTrue:[
- theMethodList := nil.
- ].
- whatToDo
- value:nil
- value:nil
- value:nil
- value:nil.
- ].
-
- sortHow notNil ifTrue:[brwsr sortBy value:sortHow].
-
- brwsr selectorListGenerator value:methodGenerator.
- perClassInfo notNil ifTrue:[
- classGenerator := perClassInfo keys.
- brwsr classListGenerator value:classGenerator.
- brwsr meta value:false.
- ].
-
- perClassInfo notNil ifTrue:[
- brwsr selectedClasses
- onChangeEvaluate:[
- |class infoText|
-
- brwsr selectedMethods value:nil.
- class := brwsr theSingleSelectedClass.
- class notNil ifTrue:[
- brwsr meta value:false.
- infoText := perClassInfoHolder value at:class theNonMetaclass ifAbsent:nil.
- infoText isNil ifTrue:[
- infoText := perClassInfo at:class theMetaclass ifAbsent:nil
- ]
- ].
- brwsr methodInfo value:infoText.
- ]
- ].
-
- perMethodInfo notNil ifTrue:[
- brwsr selectedMethods
- onChangeEvaluate:[
- |mthd infoText|
-
- brwsr selectedClasses value:nil.
- mthd := brwsr theSingleSelectedMethod.
- mthd notNil ifTrue:[
- infoText := perMethodInfo at:mthd ifAbsent:nil
- ].
- brwsr methodInfo value:infoText.
- ]
- ] ifFalse:[
- (doSelect and:[theMethodList size == 1]) ifTrue:[
- brwsr selectMethods:(Array with:theMethodList first).
- brwsr methodsSelectionChanged.
- ]
- ].
-
- methodsOrMethodGeneratorBlock isBlock ifTrue:[
- theMethodList := nil
- ]
- "
- ]
-
- "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: / 02-02-2010 / 21:46:35 / 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"
-! !
+! !
+
!NewSystemBrowser methodsFor:'private-syntax coloring'!
@@ -55258,6 +55332,7 @@
"Modified: / 08-08-2011 / 15:09:17 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
+
!NewSystemBrowser methodsFor:'setup'!
browserCanvas
@@ -55565,6 +55640,7 @@
self normalLabel.
! !
+
!NewSystemBrowser methodsFor:'special editors'!
specialEditorCanvasForMethod:aMethod
@@ -55811,6 +55887,7 @@
"Modified: / 28-02-2012 / 17:02:07 / cg"
! !
+
!NewSystemBrowser methodsFor:'startup & release'!
closeRequest
@@ -55874,6 +55951,7 @@
"Modified: / 20-11-2006 / 12:16:37 / cg"
! !
+
!NewSystemBrowser methodsFor:'string search tool'!
hideSearchBar
@@ -55952,6 +56030,7 @@
].
! !
+
!NewSystemBrowser methodsFor:'user actions'!
backToLastClass
@@ -56750,6 +56829,7 @@
"Modified: / 28-02-2012 / 16:51:54 / cg"
! !
+
!NewSystemBrowser methodsFor:'user actions-accepting'!
acceptMethod:codeArg inClass:cls language: languageOrNil check:doCheck
@@ -57852,6 +57932,7 @@
self setAcceptAction:[:code | self codeView flash].
! !
+
!NewSystemBrowser methodsFor:'user actions-class'!
classLoad
@@ -57999,6 +58080,7 @@
"Modified: / 12-09-2006 / 13:48:12 / cg"
! !
+
!NewSystemBrowser methodsFor:'user actions-comparing'!
doCompareIn:aNavigationState
@@ -58069,6 +58151,7 @@
"Modified: / 27-07-2012 / 22:25:17 / cg"
! !
+
!NewSystemBrowser methodsFor:'user actions-events'!
keyInCategoryListView:key rawKey:rawKey
@@ -58242,16 +58325,8 @@
^ true
].
((key == #Cut) or:[rawKey == #Delete]) ifTrue:[
- "JV@2012-05-08: This used to be 'unsafe' remove. When changing
- such a havily used feature, please at least add an preference to
- to switch it back to old behavior!!!!!!
-
- Perhaps, we need a better framework to define shortcuts.
-
- HACK: changed back
- "
self
- enqueueMessage:#selectorMenuRemove
+ enqueueMessage:#selectorMenuRemove "/ #selectorMenuSaveRemove
for:self
arguments:#().
^ true
@@ -58287,8 +58362,7 @@
"/ ].
^ false
- "Modified: / 27-04-2012 / 13:08:15 / cg"
- "Modified (format): / 08-05-2012 / 13:31:50 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 28-05-2012 / 10:27:03 / cg"
!
keyInProjectListView:key rawKey:rawKey
@@ -58344,6 +58418,8 @@
"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.
@@ -58446,6 +58522,7 @@
"Modified: / 17-08-2011 / 13:29:24 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
+
!NewSystemBrowser methodsFor:'user actions-helpers'!
hideMessagePane
@@ -58612,6 +58689,7 @@
"Modified: / 15-05-2012 / 10:46:06 / cg"
! !
+
!NewSystemBrowser methodsFor:'user actions-profiler'!
spawnProfilerStatistics:statistics in: where
@@ -58628,6 +58706,7 @@
"Modified (format): / 29-11-2011 / 14:49:08 / cg"
! !
+
!NewSystemBrowser::ClassCompletionEntry methodsFor:'accessing'!
klass
@@ -58646,6 +58725,7 @@
showPrefix := something.
! !
+
!NewSystemBrowser::ClassCompletionEntry methodsFor:'converting'!
asString
@@ -58658,6 +58738,7 @@
"Created: / 04-04-2012 / 13:00:58 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
+
!NewSystemBrowser::ClassCompletionEntry methodsFor:'displaying'!
displayOn:aGC x:x y:y opaque:opaque
@@ -58699,15 +58780,16 @@
| name |
showPrefix ifTrue:[
- name := klass name.
- ] ifFalse:[
- name := klass nameWithoutPrefix.
+ name := klass name.
+ ] ifFalse:[
+ name := klass nameWithoutPrefix.
].
^name
"Created: / 20-04-2012 / 18:19:46 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
+
!NewSystemBrowser::ClassCompletionEntry methodsFor:'printing & storing'!
printOn:aStream
@@ -58721,14 +58803,15 @@
"Modified: / 06-04-2012 / 13:30:50 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
+
!NewSystemBrowser class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libtool/Tools__NewSystemBrowser.st,v 1.1827 2012/12/13 14:16:31 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libtool/Tools__NewSystemBrowser.st,v 1.1832 2013-01-26 21:08:14 cg Exp $'
!
version_CVS
- ^ '§Header: /cvs/stx/stx/libtool/Tools__NewSystemBrowser.st,v 1.1827 2012/12/13 14:16:31 cg Exp §'
+ ^ '$Header: /cvs/stx/stx/libtool/Tools__NewSystemBrowser.st,v 1.1832 2013-01-26 21:08:14 cg Exp $'
!
version_HG
@@ -58737,7 +58820,8 @@
!
version_SVN
- ^ '$Id: Tools__NewSystemBrowser.st 8083 2013-01-14 11:48:37Z vranyj1 $'
-! !
+ ^ '§Id: Tools__NewSystemBrowser.st 7817 2011-08-18 09:38:28Z vranyj1 §'
+! !
+
NewSystemBrowser initialize!