--- a/BrowserView.st Fri Mar 22 09:22:38 2013 +0000
+++ b/BrowserView.st Wed Mar 27 12:24:47 2013 +0000
@@ -79,6 +79,7 @@
"
! !
+
!BrowserView class methodsFor:'initialization'!
initialize
@@ -128,6 +129,7 @@
"Modified: / 27.10.1997 / 17:34:25 / cg"
! !
+
!BrowserView class methodsFor:'class history'!
addToClassHistory:aClass selector:aSelector
@@ -140,6 +142,7 @@
SystemBrowser checkClassHistory
! !
+
!BrowserView class methodsFor:'cleanup'!
lowSpaceCleanup
@@ -156,6 +159,7 @@
Icons := DefaultIcon := nil.
! !
+
!BrowserView class methodsFor:'defaults'!
changeHistoryMaxSize
@@ -229,6 +233,7 @@
"Created: / 29.10.1997 / 03:32:43 / cg"
! !
+
!BrowserView class methodsFor:'interface specs'!
methodFilterSpec
@@ -611,6 +616,7 @@
)
! !
+
!BrowserView class methodsFor:'menu specs'!
menuSpec
@@ -1669,12 +1675,14 @@
)
! !
+
!BrowserView class methodsFor:'resources'!
classResources
^ SystemBrowser classResources
! !
+
!BrowserView methodsFor:'change & update'!
delayedUpdate:something with:someArgument from:changedObject
@@ -2086,6 +2094,7 @@
"Modified: 26.3.1997 / 18:29:51 / cg"
! !
+
!BrowserView methodsFor:'class category list menu'!
browserClone
@@ -2960,6 +2969,7 @@
"Modified: / 10.4.1998 / 12:25:38 / cg"
! !
+
!BrowserView methodsFor:'class category source administration'!
classCategoryCheckinEach
@@ -3416,6 +3426,7 @@
"Modified (format): / 29-09-2011 / 16:09:52 / cg"
! !
+
!BrowserView methodsFor:'class category stuff'!
checkClassCategorySelected
@@ -3700,6 +3711,7 @@
"Modified: / 27.7.1998 / 10:56:50 / cg"
! !
+
!BrowserView methodsFor:'class history'!
changeHistoryMenu
@@ -3897,6 +3909,7 @@
self class classHistory:savedHistory.
! !
+
!BrowserView methodsFor:'class list menu'!
classClassInstVars
@@ -5207,6 +5220,7 @@
"Modified: 17.6.1997 / 13:32:40 / cg"
! !
+
!BrowserView methodsFor:'class list source administration'!
classCheckin
@@ -5756,6 +5770,7 @@
"Modified: / 10.2.2000 / 14:14:09 / cg"
! !
+
!BrowserView methodsFor:'class stuff'!
allClasses
@@ -6931,6 +6946,7 @@
"Modified: 10.1.1997 / 14:01:20 / cg"
! !
+
!BrowserView methodsFor:'class-method list menu'!
classMethodBrowse
@@ -7144,6 +7160,7 @@
"Modified: / 7.8.1998 / 17:13:47 / cg"
! !
+
!BrowserView methodsFor:'class-method stuff'!
classFromClassMethodString:aString
@@ -7432,6 +7449,7 @@
"Modified: / 17.10.1998 / 11:30:35 / cg"
! !
+
!BrowserView methodsFor:'event handling'!
handlesKeyPress:key inView:view
@@ -7534,6 +7552,7 @@
"Modified: / 18.4.1998 / 15:56:36 / cg"
! !
+
!BrowserView methodsFor:'help'!
helpTextFor:aComponent
@@ -7555,6 +7574,7 @@
"Modified: 28.6.1997 / 15:00:18 / cg"
! !
+
!BrowserView methodsFor:'initialization & release'!
autoSearch:aString
@@ -7741,6 +7761,7 @@
"Modified: 18.8.1997 / 15:19:50 / cg"
! !
+
!BrowserView methodsFor:'initialize subviews'!
createClassListViewIn:frame
@@ -8311,6 +8332,7 @@
"Modified: / 25.10.1997 / 19:27:40 / cg"
! !
+
!BrowserView methodsFor:'method category list menu'!
createAccessMethodsFor:aCollectionOfInstVarNames withChange:withChange
@@ -8852,6 +8874,7 @@
]
! !
+
!BrowserView methodsFor:'method category stuff'!
asBrowserList:aList
@@ -9098,6 +9121,7 @@
"Modified: 18.8.1997 / 15:44:38 / cg"
! !
+
!BrowserView methodsFor:'method list menu'!
commonTraceHelperWith:aSelector
@@ -10523,6 +10547,7 @@
"Modified: / 12.1.1998 / 19:16:22 / cg"
! !
+
!BrowserView methodsFor:'method stuff'!
checkMethodSelected
@@ -11066,6 +11091,7 @@
"Modified: 30.7.1997 / 15:55:06 / cg"
! !
+
!BrowserView methodsFor:'misc'!
beep
@@ -11362,6 +11388,7 @@
"Modified: / 10.2.2000 / 14:15:03 / cg"
! !
+
!BrowserView methodsFor:'namespace menu'!
nameSpaceCheckInEach
@@ -11514,6 +11541,7 @@
"Modified: / 3.2.1999 / 20:18:13 / cg"
! !
+
!BrowserView methodsFor:'namespace stuff'!
changeNameSpaceTo:nsName
@@ -11699,6 +11727,7 @@
"Created: 8.1.1997 / 10:54:03 / cg"
! !
+
!BrowserView methodsFor:'private'!
askAndBrowseMethodCategory:title action:aBlock
@@ -13253,8 +13282,15 @@
"Created: 18.8.1997 / 15:41:52 / cg"
! !
+
!BrowserView methodsFor:'private-defaults'!
+breakPointedIcon
+ "answer an icon to mark breakPointed methods"
+
+ ^ self fetchIcon:#breakPointed selector:#breakPointedIcon
+!
+
canvasIcon
"answer an icon to mark canvas (windowSpec) methods"
@@ -13265,13 +13301,14 @@
"answer an icon"
icons isNil ifTrue:[icons := IdentityDictionary new].
- Icons isNil ifTrue:[Icons := IdentityDictionary new].
+ "/ Icons isNil ifTrue:[Icons := IdentityDictionary new].
^ icons at:name ifAbsentPut:[
|fh icn h|
- (icn := Icons at:name ifAbsent:nil) isNil ifTrue: [
- Icons at:name put:(icn := (SystemBrowser perform:fetchSelector) onDevice:Display).
+ true "(icn := Icons at:name ifAbsent:nil) isNil" ifTrue: [
+ icn := (SystemBrowser perform:fetchSelector) onDevice:Display.
+ "/ Icons at:name put:icn.
icn clearMaskedPixels.
].
h := icn height.
@@ -13370,6 +13407,7 @@
^ self fetchIcon:#trace selector:#traceIcon
! !
+
!BrowserView methodsFor:'private-queries'!
hasClassCategorySelected
@@ -13493,6 +13531,7 @@
and:[ variableListView selectionValue notNil ]]
! !
+
!BrowserView methodsFor:'syntax coloring'!
startSyntaxHighlightProcess
@@ -13680,6 +13719,7 @@
"Modified: / 20.11.2001 / 00:38:09 / cg"
! !
+
!BrowserView methodsFor:'unused'!
listOfAllMethodCategoriesInHierarchy:aClass
@@ -13726,6 +13766,7 @@
"Modified: 5.6.1996 / 11:42:12 / stefan"
! !
+
!BrowserView methodsFor:'variable list menu'!
allClassInstVarMods
@@ -14238,6 +14279,7 @@
"Modified: 25.5.1996 / 12:26:07 / cg"
! !
+
!BrowserView methodsFor:'variable stuff'!
hilightEntryFor:entry
@@ -14549,10 +14591,11 @@
"Modified: / 17.9.1998 / 13:45:02 / cg"
! !
+
!BrowserView class methodsFor:'documentation'!
version_CVS
- ^ '$Header: /cvs/stx/stx/libtool/BrowserView.st,v 1.839 2012-09-09 12:58:33 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libtool/BrowserView.st,v 1.840 2013-03-22 11:36:31 cg Exp $'
!
version_HG
--- a/DebugView.st Fri Mar 22 09:22:38 2013 +0000
+++ b/DebugView.st Wed Mar 27 12:24:47 2013 +0000
@@ -29,7 +29,7 @@
isStoppedAtHaltOrBreakPoint exceptionInfoLabel methodCodeToggle
methodCodeToggleSelectionHolder
isStoppedAtBreakPointWithParameter breakPointParameter
- hideSupportCode'
+ hideSupportCode contextInfoLabel'
classVariableNames:'CachedDebugger CachedExclusive OpenDebuggers MoreDebuggingDetail
DebuggingDebugger DebuggingDebugger2
DefaultDebuggerBackgroundColor InitialNChainShown IgnoredHalts
@@ -444,7 +444,7 @@
^ self
enter:ex returnableSuspendedContext
- withMessage:ex descriptionForDebugger
+ withMessage:('[',ex originalSignal class name,']: ',ex descriptionForDebugger)
mayProceed:(ex mayProceed).
!
@@ -1007,8 +1007,8 @@
submenuChannel: viewMenuSpec
)
(MenuItem
- label: 'Linked Menu'
- submenuChannel: unspecified
+ label: 'Process'
+ submenuChannel: processMenuSpec
)
(MenuItem
label: 'Context'
@@ -2508,14 +2508,15 @@
initialize
|menu menuPanel mH panel bpanel bH bpanel1 bH1 bpanel2 bH2 codePanel
- newLayout v exceptionAndTogglePanel codeToggleLabels|
+ newLayout v exceptionAndTogglePanel codeToggleLabels userPrefs|
super initialize.
font := font onDevice:device.
-
- verboseBacktrace := UserPreferences current verboseBacktraceInDebugger ? false.
- hideSupportCode := UserPreferences current hideSupportCodeInDebugger ? false.
+ userPrefs := UserPreferences current.
+
+ verboseBacktrace := userPrefs verboseBacktraceInDebugger ? false.
+ hideSupportCode := userPrefs hideSupportCodeInDebugger ? false.
ignoreBreakpoints := true. "/ ignore halts/breakpoints in doIts of
"/ the debugger
@@ -2539,7 +2540,7 @@
mH := menuPanel preferredHeight.
menuPanel origin:(0.0 @ 0.0) corner:(1.0 @ (mH)).
- newLayout := UserPreferences current useNewLayoutInDebugger.
+ newLayout := userPrefs useNewLayoutInDebugger.
newLayout ifFalse:[
bpanel := HorizontalPanelView in:self.
@@ -2568,6 +2569,10 @@
bpanel1 := HorizontalPanelView in:self.
self initializeButtons1In:bpanel1.
+ contextInfoLabel := Label label:''.
+ contextInfoLabel adjust:#left.
+ bpanel1 add:contextInfoLabel.
+
bH1 := bpanel1 preferredHeight + 5.
bpanel1 origin:(0.0 @ mH)
extent:(1.0 @ bH1).
@@ -3101,7 +3106,7 @@
exceptionInfoLabel notNil ifTrue:[
exceptionInfoLabel
label:(resources
- string:'Exception: %1 in process %2 [%3]%4'
+ string:'%1 in process %2 [%3]%4'
with:(lines first colorizeAllWith:Color red)
with:(processNameOrNil ? '')
with:(pidOrNil ? '')
@@ -7544,6 +7549,38 @@
stackInspector showLast
!
+updateContextInfoFor:aContext
+ "additional info as-per selected context;
+ for now:
+ update:with:from: - show who was responsible
+ "
+
+ |changedObject receiver|
+
+ aContext selector == #'update:with:from:' ifTrue:[
+ receiver := aContext receiver.
+ changedObject := aContext argAt:3.
+ receiver class allInstanceVariableNames keysAndValuesDo:[:i :nm |
+ (receiver instVarAt:i) == changedObject ifTrue:[
+ contextInfoLabel label:('update (',(aContext argAt:1) printString allBold,') triggered by ',nm allBold).
+ ^ self
+ ]
+ ].
+
+ (receiver isKindOf:ApplicationModel) ifTrue:[
+ receiver builder notNil ifTrue:[
+ (receiver builder bindings ? #()) keysAndValuesDo:[:eachAspect :eachValue |
+ eachValue == changedObject ifTrue:[
+ contextInfoLabel label:('update (',(aContext argAt:1) printString allBold,') triggered by aspect ',eachAspect allBold).
+ ^ self
+ ]
+ ]
+ ]
+ ].
+ ].
+ contextInfoLabel label:nil.
+!
+
updateForContext:lineNr
"show selected code for lineNr in contextList in textView.
Also used to autoselect an interesting context on entry."
@@ -7943,6 +7980,7 @@
] ifTrue:[
sendButton enable.
].
+ self updateContextInfoFor:con.
"clear out locals to prevent keeping around unneeded contexts
(due to the block held in codeView).
@@ -7965,9 +8003,7 @@
defineButton beInvisible.
].
- "
- enable/disable some menu items
- "
+ "/ enable/disable some menu items
self updateMenuItems
"Created: / 14-08-1997 / 20:15:00 / cg"
@@ -8225,11 +8261,11 @@
!DebugView class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libtool/DebugView.st,v 1.572 2013-03-06 09:06:59 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libtool/DebugView.st,v 1.574 2013-03-26 16:53:21 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libtool/DebugView.st,v 1.572 2013-03-06 09:06:59 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libtool/DebugView.st,v 1.574 2013-03-26 16:53:21 cg Exp $'
!
version_HG
--- a/DirectoryTreeBrowser.st Fri Mar 22 09:22:38 2013 +0000
+++ b/DirectoryTreeBrowser.st Wed Mar 27 12:24:47 2013 +0000
@@ -66,23 +66,19 @@
"
! !
+
!DirectoryTreeBrowser class methodsFor:'instance creation'!
-open
- ^ super open
-"
- DirectoryTreeBrowser open
-"
-!
openOn:aFileName
+ | file |
- | file |
file := aFileName asFilename.
file exists ifTrue:[
- self openOn:aFileName withFiles:(file isDirectory not)
- ]
+ ^ self openOn:aFileName withFiles:(file isDirectory not)
+ ].
+ ^ self open
"
DirectoryTreeBrowser openOn:Filename homeDirectory
@@ -98,12 +94,15 @@
instance open.
instance viewFilesInDirectoryTree value:aBoolean.
instance currentFileNameHolder value:(OrderedCollection with:aFileName).
+ ^ instance
+
"
DirectoryTreeBrowser openOn:Filename homeDirectory
DirectoryTreeBrowser openOn:(Filename homeDirectory construct:'.bashrc') withFiles:false
"
! !
+
!DirectoryTreeBrowser class methodsFor:'defaults'!
timeForExpandOnDropInMilliseconds
@@ -111,6 +110,7 @@
^ 1500
! !
+
!DirectoryTreeBrowser class methodsFor:'interface specs'!
windowSpec
@@ -179,6 +179,7 @@
)
! !
+
!DirectoryTreeBrowser class methodsFor:'menu specs'!
menu
@@ -399,6 +400,7 @@
)
! !
+
!DirectoryTreeBrowser class methodsFor:'plugIn spec'!
aspectSelectors
@@ -421,6 +423,7 @@
).
! !
+
!DirectoryTreeBrowser methodsFor:'accessing'!
allowRenameOnOneClick
@@ -453,6 +456,7 @@
^ updateTreeSelection
! !
+
!DirectoryTreeBrowser methodsFor:'actions'!
doDoubleClick:anIndex
@@ -708,6 +712,7 @@
]
! !
+
!DirectoryTreeBrowser methodsFor:'aspects'!
allowFileOperations
@@ -801,6 +806,7 @@
^ treeSelectionHolder
! !
+
!DirectoryTreeBrowser methodsFor:'change & update'!
changeMatchBlock
@@ -919,6 +925,7 @@
^ self
! !
+
!DirectoryTreeBrowser methodsFor:'drag & drop'!
dropDestinationPath
@@ -1045,6 +1052,7 @@
afterMilliseconds:(self class timeForExpandOnDropInMilliseconds).
! !
+
!DirectoryTreeBrowser methodsFor:'event handling'!
processEvent:anEvent
@@ -1106,6 +1114,7 @@
^ false
! !
+
!DirectoryTreeBrowser methodsFor:'queries'!
hasOpenEditor
@@ -1135,6 +1144,7 @@
"/ ^ false
! !
+
!DirectoryTreeBrowser methodsFor:'selection'!
firstSelectedDirectory
@@ -1258,6 +1268,7 @@
^ Array with:selection. "Wrap single value into Array"
! !
+
!DirectoryTreeBrowser methodsFor:'startup & release'!
makeDependent
@@ -1360,6 +1371,7 @@
^ super release.
! !
+
!DirectoryTreeBrowser::DirTreeBrowserHFL methodsFor:'accessing'!
draggedItem
@@ -1372,6 +1384,7 @@
draggedItem := anItemOrNil.
! !
+
!DirectoryTreeBrowser::DirTreeBrowserHFL methodsFor:'protocol'!
grayDirectoryIcon
@@ -1392,14 +1405,15 @@
^ super iconFor:anItem.
! !
+
!DirectoryTreeBrowser class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libtool/DirectoryTreeBrowser.st,v 1.122 2013-01-17 11:16:54 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libtool/DirectoryTreeBrowser.st,v 1.123 2013-03-24 11:40:12 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libtool/DirectoryTreeBrowser.st,v 1.122 2013-01-17 11:16:54 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libtool/DirectoryTreeBrowser.st,v 1.123 2013-03-24 11:40:12 cg Exp $'
!
version_HG
--- a/InspectorView.st Fri Mar 22 09:22:38 2013 +0000
+++ b/InspectorView.st Wed Mar 27 12:24:47 2013 +0000
@@ -1262,12 +1262,19 @@
selectorsByFirstCharacter alphaMenu
localSelectors|
+ sel := self selection.
+
items := #(
('Copy Name or Key' #doCopyKey )
('-')
('Inspect' #doInspect )
('BasicInspect' #doBasicInspect )
).
+ sel isValueModel ifTrue:[
+ items := items , #(
+ ('Inspect Value' #doInspectValue )
+ ).
+ ].
NewInspector::NewInspectorView notNil ifTrue:[
items := items , #(
('Inspect Hierarchical' #doNewInspect )
@@ -1276,6 +1283,12 @@
items := items , #(
('Browse' #browse )
).
+ sel isValueModel ifTrue:[
+ items := items , #(
+ ('Browse Value' #browseValue )
+ ).
+ ].
+
items := items , (self optionalToolItems).
items := items , (self optionalViewSelectionItems).
items := items , #(
@@ -1286,8 +1299,6 @@
"/ ('Browse full class protocol' #browseFullClassProtocol)
).
- sel := self selection.
-
items := items , (self optionalMethodOrBlockSelectionItems).
items := items , (self optionalStreamSelectionItems).
items := items , (self optionalFilenameSelectionItems).
@@ -1600,14 +1611,7 @@
!InspectorView methodsFor:'menu actions'!
browse
- |cls|
-
- cls := self selectedField class.
- (cls browserClass ? UserPreferences current systemBrowserClass)
- openInClass:cls selector:nil
-
- "Created: / 14-12-1995 / 19:15:50 / cg"
- "Modified: / 27-07-2012 / 22:42:44 / cg"
+ self doBrowse:self selectedField
!
browseClass
@@ -1687,6 +1691,10 @@
title:'Update Method(s) of dependent(s)'
!
+browseValue
+ self doBrowse:self selectedField value
+!
+
doBack
"user selected back-menu entry"
@@ -1707,7 +1715,18 @@
doBasicInspect
"user selected inspect-menu entry"
- self doInspect:true
+ self doInspect:self selectedField basic:true
+!
+
+doBrowse:what
+ |cls|
+
+ cls := what class.
+ (cls browserClass ? UserPreferences current systemBrowserClass)
+ openInClass:cls selector:nil
+
+ "Created: / 14-12-1995 / 19:15:50 / cg"
+ "Modified: / 27-07-2012 / 22:42:44 / cg"
!
doCatchChanges
@@ -1741,16 +1760,19 @@
!
doInspect
- "user selected inspect-menu entry"
-
- self doInspect:false
+ "user selected inspect menu entry"
+
+ self doInspect:self selectedField basic:false
+!
+
+doInspectValue
+ "user selected inspect-value menu entry"
+
+ self doInspect:self selectedField value basic:false
!
doNewInspect
self doInspect:#new
-
- "Created: / 31.10.1997 / 12:45:38 / cg"
- "Modified: / 31.10.1997 / 12:47:11 / cg"
!
doStartMonitor
@@ -3347,12 +3369,17 @@
]
!
-doInspect:basic
+doInspect:basicBooleanOrSymbolForHow
"user selected inspect-menu entry"
- |objectToInspect app |
-
- objectToInspect := self selectedField.
+ self doInspect:self selectedField basic:basicBooleanOrSymbolForHow
+!
+
+doInspect:objectToInspect basic:basic
+ "user selected inspect-menu entry"
+
+ |app |
+
objectToInspect notNil ifTrue:[
(basic == #new and:[NewInspector::NewInspectorView notNil]) ifTrue:[
NewInspector::NewInspectorView inspect:objectToInspect
@@ -3462,10 +3489,10 @@
!InspectorView class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libtool/InspectorView.st,v 1.300 2013-03-21 09:40:25 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libtool/InspectorView.st,v 1.301 2013-03-26 11:18:01 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libtool/InspectorView.st,v 1.300 2013-03-21 09:40:25 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libtool/InspectorView.st,v 1.301 2013-03-26 11:18:01 cg Exp $'
! !
--- a/NewLauncher.st Fri Mar 22 09:22:38 2013 +0000
+++ b/NewLauncher.st Wed Mar 27 12:24:47 2013 +0000
@@ -4261,20 +4261,39 @@
]
] valueWithExit.
+ menu := Menu new receiver: self.
+
changeHistory isEmpty ifTrue:[
- ^ nil
+ menu addItem:(MenuItem new
+ label:'>> no changes <<';
+ enabled:false).
+ ] ifFalse:[
+ menu addItemGroup:
+ (changeHistory collect:[:change|
+ MenuItem new
+ translateLabel: false;
+ label: (change className , ' ' , (change selector ? '???'));
+ value: [UserPreferences systemBrowserClass openInClass:change changeClass selector:change selector];
+ activeHelpKey: #classBrowserOnChangedMethod
+ ]).
].
- menu := Menu new receiver: self.
- menu addItemGroup:
- (changeHistory collect:[:change|
- MenuItem new
+ menu addItemGroup:
+ {
+ MenuItem new
translateLabel: false;
- label: (change className , ' ' , (change selector ? '???'));
- value: [UserPreferences systemBrowserClass openInClass:change changeClass selector:change selector];
- activeHelpKey: #classBrowserOnChangedMethod
- ]
- ).
+ label: 'Open Changes Browser on File...';
+ value:
+ [
+ |file|
+
+ file := Dialog requestFileName:'Change or Source File' default:ObjectMemory nameForChanges.
+ file notEmptyOrNil ifTrue:[
+ UserPreferences current changesBrowserClass openOn:file
+ ]
+ ];
+ activeHelpKey: #changeBrowserOnFile
+ }.
menu findGuiResourcesIn:self.
^menu
@@ -4971,11 +4990,11 @@
!NewLauncher class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libtool/NewLauncher.st,v 1.451 2013-03-21 20:55:36 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libtool/NewLauncher.st,v 1.455 2013-03-25 21:25:21 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libtool/NewLauncher.st,v 1.451 2013-03-21 20:55:36 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libtool/NewLauncher.st,v 1.455 2013-03-25 21:25:21 cg Exp $'
!
version_HG
--- a/ProcessMonitorV2.st Fri Mar 22 09:22:38 2013 +0000
+++ b/ProcessMonitorV2.st Wed Mar 27 12:24:47 2013 +0000
@@ -1651,9 +1651,10 @@
showColSeparator: false
)
(DataSetColumnSpec
- label: ''
+ label: 'Instr.'
id: instrumentation
labelAlignment: left
+ width: 50
"/ activeHelpKey: 'processInstrumentation'
activeHelpKeyForLabel: 'processInstrumentation'
labelButtonType: Button
@@ -3849,11 +3850,11 @@
!ProcessMonitorV2 class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libtool/ProcessMonitorV2.st,v 1.64 2013-02-24 20:22:33 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libtool/ProcessMonitorV2.st,v 1.65 2013-03-23 11:38:20 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libtool/ProcessMonitorV2.st,v 1.64 2013-02-24 20:22:33 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libtool/ProcessMonitorV2.st,v 1.65 2013-03-23 11:38:20 cg Exp $'
!
version_HG
--- a/SystemBrowser.st Fri Mar 22 09:22:38 2013 +0000
+++ b/SystemBrowser.st Wed Mar 27 12:24:47 2013 +0000
@@ -804,6 +804,13 @@
!
breakPointedIcon
+ <resource: #programImage>
+
+ ^ ToolbarIconLibrary breakpointRedEnabled16x16
+ "/ ^ self breakPointedIcon2
+!
+
+breakPointedIcon1
"This resource specification was automatically generated
by the ImageEditor of ST/X."
@@ -811,18 +818,38 @@
the ImageEditor may not be able to read the specification."
"
- self breakPointedIcon inspect
- ImageEditor openOnClass:self andSelector:#breakPointedIcon
+ self breakPointedIcon1 inspect
+ ImageEditor openOnClass:self andSelector:#breakPointedIcon1
Icon flushCachedIcons
"
<resource: #image>
^Icon
- constantNamed:'SystemBrowser breakPointedIcon'
+ constantNamed:'SystemBrowser breakPointedIcon1'
ifAbsentPut:[(Depth4Image new) width: 13; height: 11; photometric:(#palette); bitsPerSample:(#[4]); samplesPerPixel:(1); bits:(ByteArray fromPackedString:'@@@@@@@@@P@@L3@@@@$@L@@@L@@H@@@C@@@@APL@DQ@C@@@C@1DS@0@B@0@QD@L@@@@@@0@@@@@@L@@@L@@@@@@3L@@@@ @@@@@@@@ b') ; colorMapFromArray:#[255 0 0 255 255 255 0 0 0 255 199 199]; mask:((Depth1Image new) width: 13; height: 11; photometric:(#blackIs0); bitsPerSample:(#(1)); samplesPerPixel:(1); bits:(ByteArray fromPackedString:'@@@N@C>@O8A?0G?@_<@? C>@C @@@@@a') ; yourself); yourself]
!
+breakPointedIcon2
+ "This resource specification was automatically generated
+ by the ImageEditor of ST/X."
+
+ "Do not manually edit this!! If it is corrupted,
+ the ImageEditor may not be able to read the specification."
+
+ "
+ self breakPointedIcon2 inspect
+ ImageEditor openOnClass:self andSelector:#breakPointedIcon2
+ Icon flushCachedIcons
+ "
+
+ <resource: #image>
+
+ ^Icon
+ constantNamed:'SystemBrowser breakPointedIcon2'
+ ifAbsentPut:[(Depth4Image new) width: 13; height: 11; photometric:(#palette); bitsPerSample:(#[4]); samplesPerPixel:(1); bits:(ByteArray fromPackedString:'DQH"H!!DQDAD!!DQD!!DQ@RDQDQD!!DPHQDQDQD!!DBDQDQDQHQ@!!DQDQDRDZHQDQDQD!!FBDQDQDQHQ@RDQDQD!!DPDRDQDRDQDADRH"HQDQ@b') ; colorMapFromArray:#[255 255 255 255 0 0 128 0 0]; mask:((Depth1Image new) width: 13; height: 11; photometric:(#blackIs0); bitsPerSample:(#(1)); samplesPerPixel:(1); bits:(ByteArray fromPackedString:'G0@? G?@?>C?8O? ?>C?8G?@O8@_@@@a') ; yourself); yourself]
+!
+
canvasIcon
"This resource specification was automatically generated
by the ImageEditor of ST/X."
@@ -1576,6 +1603,13 @@
!
stopIcon
+ <resource: #programImage>
+
+ ^ ToolbarIconLibrary stopPoint16x16
+ "/ ^ self stopIcon2
+!
+
+stopIcon1
"This resource specification was automatically generated
by the ImageEditor of ST/X."
@@ -1583,15 +1617,36 @@
the ImageEditor may not be able to read the specification."
"
- self stopIcon inspect
- ImageEditor openOnClass:self andSelector:#stopIcon
+ self stopIcon1 inspect
+ ImageEditor openOnClass:self andSelector:#stopIcon1
+ Icon flushCachedIcons
"
<resource: #image>
^Icon
- constantNamed:#'SystemBrowser class stopIcon'
- ifAbsentPut:[(Depth1Image new) width: 13; height: 11; photometric:(#palette); bitsPerSample:(#(1 )); samplesPerPixel:(1); bits:(ByteArray fromPackedString:'@@@N@@8@C @N@@P@@@@D@@8@A@@@@@@a') ; colorMapFromArray:#[255 0 0 255 255 255]; mask:((Depth1Image new) width: 13; height: 11; photometric:(#blackIs0); bitsPerSample:(#(1 )); samplesPerPixel:(1); bits:(ByteArray fromPackedString:'G0@? G?@?>C?8O? ?>C?8G?@O8@_@@@a') ; yourself); yourself]
+ constantNamed:'SystemBrowser stopIcon1'
+ ifAbsentPut:[(Depth4Image new) width: 13; height: 11; photometric:(#palette); bitsPerSample:(#[4]); samplesPerPixel:(1); bits:(ByteArray fromPackedString:'DQH"H!!DQDAD!!DAD!!DQ@RDP@AD!!DPHQD@@QD!!DBDQ@@DQHQ@!!DQ@QDRDZHQDQDQD!!FBDQDADQHQ@RDP@AD!!DPDRDPDRDQDADRH"HQDQ@b') ; colorMapFromArray:#[255 255 255 255 0 0 128 0 0]; mask:((Depth1Image new) width: 13; height: 11; photometric:(#blackIs0); bitsPerSample:(#(1)); samplesPerPixel:(1); bits:(ByteArray fromPackedString:'G0@? G?@?>C?8O? ?>C?8G?@O8@_@@@a') ; yourself); yourself]
+!
+
+stopIcon2
+ "This resource specification was automatically generated
+ by the ImageEditor of ST/X."
+
+ "Do not manually edit this!! If it is corrupted,
+ the ImageEditor may not be able to read the specification."
+
+ "
+ self stopIcon2 inspect
+ ImageEditor openOnClass:self andSelector:#stopIcon2
+ Icon flushCachedIcons
+ "
+
+ <resource: #image>
+
+ ^Icon
+ constantNamed:'SystemBrowser stopIcon2'
+ ifAbsentPut:[(Depth4Image new) width: 13; height: 11; photometric:(#palette); bitsPerSample:(#[4]); samplesPerPixel:(1); bits:(ByteArray fromPackedString:'DQH"H!!DQDAD!!DQD!!DQ@RDQDQD!!DPHQDQDQD!!DBDSL3LQHQ@!!D@@@DRDZHQL3L1D!!FBDQDQDQHQ@RDQDQD!!DPDRDQDRDQDADRH"HQDQ@b') ; colorMapFromArray:#[255 255 255 255 0 0 128 0 0 255 163 163]; mask:((Depth1Image new) width: 13; height: 11; photometric:(#blackIs0); bitsPerSample:(#(1)); samplesPerPixel:(1); bits:(ByteArray fromPackedString:'G0@? G?@?>C?8O? ?>C?8G?@O8@_@@@a') ; yourself); yourself]
!
tabListIcon
@@ -5932,7 +5987,7 @@
!SystemBrowser class methodsFor:'documentation'!
version_CVS
- ^ '$Header: /cvs/stx/stx/libtool/SystemBrowser.st,v 1.309 2013-03-18 13:25:35 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libtool/SystemBrowser.st,v 1.310 2013-03-22 11:36:48 cg Exp $'
!
version_HG
--- a/Tools_BrowserList.st Fri Mar 22 09:22:38 2013 +0000
+++ b/Tools_BrowserList.st Wed Mar 27 12:24:47 2013 +0000
@@ -961,6 +961,12 @@
^ self fetchIcon:#abstractMethod selector:#abstractMethodIcon
!
+breakPointedIcon
+ "answer an icon to mark breakPointed methods"
+
+ ^ self fetchIcon:#breakPointed selector:#breakPointedIcon
+!
+
canvasIcon
"answer an icon to mark canvas spec methods"
@@ -976,13 +982,14 @@
"answer an icon to mark methods"
icons isNil ifTrue:[icons := IdentityDictionary new].
- Icons isNil ifTrue:[Icons := IdentityDictionary new].
+ "/ Icons isNil ifTrue:[Icons := IdentityDictionary new].
^ icons at:name ifAbsentPut:[
|fh icn h|
- (icn := Icons at:name ifAbsent:nil) isNil ifTrue: [
- Icons at:name put:(icn := (SystemBrowser perform:fetchSelector) onDevice:Display).
+ true "(icn := Icons at:name ifAbsent:nil) isNil" ifTrue: [
+ icn := (SystemBrowser perform:fetchSelector) onDevice:Display.
+ "/ Icons at:name put:icn.
icn clearMaskedPixels.
].
h := icn height.
@@ -1871,10 +1878,10 @@
!BrowserList class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libtool/Tools_BrowserList.st,v 1.56 2013-03-10 15:52:52 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libtool/Tools_BrowserList.st,v 1.57 2013-03-22 11:36:34 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libtool/Tools_BrowserList.st,v 1.56 2013-03-10 15:52:52 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libtool/Tools_BrowserList.st,v 1.57 2013-03-22 11:36:34 cg Exp $'
! !
--- a/Tools_ClassCategoryList.st Fri Mar 22 09:22:38 2013 +0000
+++ b/Tools_ClassCategoryList.st Wed Mar 27 12:24:47 2013 +0000
@@ -271,7 +271,7 @@
delayedUpdate:something with:aParameter from:changedObject
|selectedCategories allSelectedBefore
- nameListEntryForALL categoryOfClass wg|
+ nameListEntryForALL cls categoryOfClass wg|
selectedCategories := self selectedCategoriesStrings.
@@ -312,6 +312,33 @@
].
^ self
].
+ something == #projectOrganization ifTrue:[
+ listValid == false ifTrue:[
+ ^ self
+ ].
+ aParameter isNil ifTrue:[
+ self invalidateList.
+ slaveMode value ~~ true ifTrue:[
+ selectedCategories notEmptyOrNil ifTrue:[
+ self enqueueDelayedUpdateOutputGenerator
+ ].
+ ]
+ ] ifFalse:[
+ cls := aParameter first.
+ categoryOfClass := cls category.
+
+ (rawCategoryList includes:categoryOfClass) ifFalse:[
+ self invalidateList.
+ ].
+
+ slaveMode value ~~ true ifTrue:[
+ (selectedCategories includes:categoryOfClass) ifTrue:[
+ self enqueueDelayedUpdateOutputGenerator
+ ].
+ ]
+ ].
+ ^ self
+ ].
self invalidateList.
@@ -976,10 +1003,10 @@
!ClassCategoryList class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libtool/Tools_ClassCategoryList.st,v 1.42 2013-03-20 10:37:35 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libtool/Tools_ClassCategoryList.st,v 1.44 2013-03-25 22:07:48 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libtool/Tools_ClassCategoryList.st,v 1.42 2013-03-20 10:37:35 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libtool/Tools_ClassCategoryList.st,v 1.44 2013-03-25 22:07:48 cg Exp $'
! !
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/Tools_MethodList.st Wed Mar 27 12:24:47 2013 +0000
@@ -0,0 +1,1825 @@
+"
+ COPYRIGHT (c) 2000 by eXept Software AG
+ All Rights Reserved
+
+ This software is furnished under a license and may be used
+ only in accordance with the terms of that license and with the
+ inclusion of the above copyright notice. This software may not
+ be provided or otherwise made available to, or used by, any
+ other person. No title to or ownership of the software is
+ hereby transferred.
+"
+"{ Package: 'stx:libtool' }"
+
+"{ NameSpace: Tools }"
+
+BrowserList subclass:#MethodList
+ instanceVariableNames:'classes selectedMethodNameIndices methodList lastSelectedMethods
+ browserNameList variableFilter filterClassVars updateProcess
+ lastShowClass lastShowCategory lastShowClassFirst
+ showMethodInheritance lastMethodClass lastMethodClassesSubclasses
+ classAndSelectorsRedefinedBySubclassesOfClass showClass
+ showMethodComplexity showMethodTypeIcon
+ showImageResourceMethodsImages'
+ classVariableNames:'ShowComplexityValue'
+ poolDictionaries:''
+ category:'Interface-Browsers-New'
+!
+
+!MethodList class methodsFor:'documentation'!
+
+copyright
+"
+ COPYRIGHT (c) 2000 by eXept Software AG
+ All Rights Reserved
+
+ This software is furnished under a license and may be used
+ only in accordance with the terms of that license and with the
+ inclusion of the above copyright notice. This software may not
+ be provided or otherwise made available to, or used by, any
+ other person. No title to or ownership of the software is
+ hereby transferred.
+"
+!
+
+documentation
+"
+ I implement the method list in the new system browser
+"
+! !
+
+!MethodList class methodsFor:'interface specs'!
+
+singleMethodWindowSpec
+ "This resource specification was automatically generated
+ by the UIPainter of ST/X."
+
+ "Do not manually edit this!! If it is corrupted,
+ the UIPainter may not be able to read the specification."
+
+ "
+ UIPainter new openOnClass:MethodList andSelector:#singleMethodWindowSpec
+ MethodList new openInterface:#singleMethodWindowSpec
+ "
+
+ <resource: #canvas>
+
+ ^
+ #(#FullSpec
+ #name: #singleMethodWindowSpec
+ #window:
+ #(#WindowSpec
+ #label: 'SingleSelectorList'
+ #name: 'SingleSelectorList'
+ #min: #(#Point 0 0)
+ #max: #(#Point 1024 721)
+ #bounds: #(#Rectangle 12 22 312 322)
+ )
+ #component:
+ #(#SpecCollection
+ #collection: #(
+ #(#LabelSpec
+ #label: 'MethodName'
+ #name: 'MethodLabel'
+ #layout: #(#LayoutFrame 0 0.0 0 0 0 1.0 25 0)
+ #translateLabel: true
+ #labelChannel: #methodLabelHolder
+ #menu: #menuHolder
+ )
+ )
+
+ )
+ )
+
+ "Modified: / 1.3.2000 / 20:50:15 / cg"
+!
+
+windowSpec
+ "This resource specification was automatically generated
+ by the UIPainter of ST/X."
+
+ "Do not manually edit this!! If it is corrupted,
+ the UIPainter may not be able to read the specification."
+
+ "
+ UIPainter new openOnClass:Tools::MethodList andSelector:#windowSpec
+ Tools::MethodList new openInterface:#windowSpec
+ Tools::MethodList open
+ "
+
+ <resource: #canvas>
+
+ ^
+ #(FullSpec
+ name: windowSpec
+ window:
+ (WindowSpec
+ label: 'SelectorList'
+ name: 'SelectorList'
+ min: (Point 0 0)
+ bounds: (Rectangle 0 0 300 300)
+ )
+ component:
+ (SpecCollection
+ collection: (
+ (SequenceViewSpec
+ name: 'List'
+ layout: (LayoutFrame 0 0.0 0 0.0 0 1.0 0 1.0)
+ tabable: true
+ model: selectedMethodNameIndices
+ menu: menuHolder
+ hasHorizontalScrollBar: true
+ hasVerticalScrollBar: true
+ miniScrollerHorizontal: true
+ isMultiSelect: true
+ valueChangeSelector: selectionChangedByClick
+ useIndex: true
+ sequenceList: browserNameList
+ doubleClickChannel: doubleClickChannel
+ properties:
+ (PropertyListDictionary
+ canDropSelector: canDropContext:
+ dragArgument: nil
+ dropArgument: nil
+ dropSelector: doDropContext:
+ )
+ )
+ )
+
+ )
+ )
+! !
+
+!MethodList class methodsFor:'plugIn spec'!
+
+aspectSelectors
+ "This resource specification was automatically generated
+ by the UIPainter of ST/X."
+
+ "Do not manually edit this. If it is corrupted,
+ the UIPainter may not be able to read the specification."
+
+ "Return a description of exported aspects;
+ these can be connected to aspects of an embedding application
+ (if this app is embedded in a subCanvas)."
+
+ ^ #(
+ #(doubleClickChannel action)
+ #filterClassVars
+ #forceGeneratorTrigger
+ #immediateUpdate
+ #inGeneratorHolder
+ #menuHolder
+ #methodCategoryHolder
+ #packageFilter
+ #selectedMethods
+ #selectionChangeCondition
+ #showCoverageInformation
+ #showImageResourceMethodsImages
+ #showMethodComplexity
+ #showMethodInheritance
+ #showMethodTypeIcon
+ #sortBy
+ #updateTrigger
+ #variableFilter
+ ).
+
+! !
+
+!MethodList methodsFor:'aspects'!
+
+browserNameList
+ browserNameList isNil ifTrue:[
+ browserNameList := List new.
+ ].
+ ^ browserNameList.
+
+ "Modified: / 31.1.2000 / 00:42:44 / cg"
+ "Created: / 5.2.2000 / 22:38:32 / cg"
+!
+
+defaultSlaveModeValue
+ ^ false.
+!
+
+filterClassVars
+ filterClassVars isNil ifTrue:[
+ filterClassVars := false asValue.
+ filterClassVars addDependent:self
+ ].
+ ^ filterClassVars
+!
+
+filterClassVars:aValueHolder
+ filterClassVars notNil ifTrue:[
+ filterClassVars removeDependent:self
+ ].
+ filterClassVars := aValueHolder.
+ filterClassVars notNil ifTrue:[
+ filterClassVars addDependent:self
+ ].
+!
+
+methodLabelHolder
+ ^ self pseudoListLabelHolder
+
+ "Created: / 1.3.2000 / 20:50:07 / cg"
+!
+
+methodList
+ ^ methodList
+!
+
+selectedMethodNameIndices
+ selectedMethodNameIndices isNil ifTrue:[
+ selectedMethodNameIndices := ValueHolder new.
+ selectedMethodNameIndices addDependent:self
+ ].
+ ^ selectedMethodNameIndices.
+
+ "Modified: / 5.2.2000 / 00:31:48 / cg"
+ "Created: / 5.2.2000 / 22:59:31 / cg"
+!
+
+selectedMethods
+ ^ self selectionHolder
+!
+
+selectedMethods:aValueHolder
+ ^ self selectionHolder:aValueHolder
+!
+
+showImageResourceMethodsImages
+ showImageResourceMethodsImages isNil ifTrue:[
+ showImageResourceMethodsImages := false asValue.
+ showImageResourceMethodsImages addDependent:self
+ ].
+ ^ showImageResourceMethodsImages
+!
+
+showImageResourceMethodsImages:aValueHolder
+ showImageResourceMethodsImages notNil ifTrue:[
+ showImageResourceMethodsImages removeDependent:self
+ ].
+ showImageResourceMethodsImages := aValueHolder.
+ showImageResourceMethodsImages notNil ifTrue:[
+ showImageResourceMethodsImages addDependent:self
+ ].
+!
+
+showMethodComplexity
+ showMethodComplexity isNil ifTrue:[
+ showMethodComplexity := false asValue.
+ showMethodComplexity addDependent:self
+ ].
+ ^ showMethodComplexity
+!
+
+showMethodComplexity:aValueHolder
+ showMethodComplexity notNil ifTrue:[
+ showMethodComplexity removeDependent:self
+ ].
+ showMethodComplexity := aValueHolder.
+ showMethodComplexity notNil ifTrue:[
+ showMethodComplexity addDependent:self
+ ].
+!
+
+showMethodInheritance
+ showMethodInheritance isNil ifTrue:[
+ showMethodInheritance := false asValue.
+ showMethodInheritance addDependent:self
+ ].
+ ^ showMethodInheritance
+!
+
+showMethodInheritance:aValueHolder
+ showMethodInheritance notNil ifTrue:[
+ showMethodInheritance removeDependent:self
+ ].
+ showMethodInheritance := aValueHolder.
+ showMethodInheritance notNil ifTrue:[
+ showMethodInheritance addDependent:self
+ ].
+!
+
+showMethodTypeIcon
+ showMethodTypeIcon isNil ifTrue:[
+ showMethodTypeIcon := true asValue.
+ showMethodTypeIcon addDependent:self
+ ].
+ ^ showMethodTypeIcon
+!
+
+showMethodTypeIcon:aValueHolder
+ showMethodTypeIcon notNil ifTrue:[
+ showMethodTypeIcon removeDependent:self
+ ].
+ showMethodTypeIcon := aValueHolder.
+ showMethodTypeIcon notNil ifTrue:[
+ showMethodTypeIcon addDependent:self
+ ].
+!
+
+variableFilter
+ variableFilter isNil ifTrue:[
+ variableFilter := nil asValue.
+ variableFilter addDependent:self
+ ].
+ ^ variableFilter
+!
+
+variableFilter:aValueHolder
+ variableFilter notNil ifTrue:[
+ variableFilter removeDependent:self
+ ].
+ variableFilter := aValueHolder.
+ variableFilter notNil ifTrue:[
+ variableFilter addDependent:self
+ ].
+! !
+
+!MethodList methodsFor:'change & update'!
+
+delayedUpdate:something with:aParameter from:changedObject
+ |cls sel oldMethod newMethod methods newSelection
+ selectionHolder selection needSelectionChange|
+
+ selectionHolder := self selectedMethods.
+ selection := selectionHolder value.
+
+ changedObject == Smalltalk ifTrue:[
+ classes notNil ifTrue:[
+ something == #classDefinition ifTrue:[
+ cls := aParameter.
+ (classes contains:[:aClass | aClass name == cls name]) ifFalse:[
+ ^ self "/ I dont care for that class
+ ].
+ classes := classes collect:[:eachClass | eachClass isMeta ifTrue:[
+ (Smalltalk at:eachClass theNonMetaclass name) class
+ ] ifFalse:[
+ Smalltalk at:eachClass name
+ ]
+ ].
+ self invalidateList.
+"/ self updateList.
+ ^ self.
+ ].
+
+ something == #methodCategory ifTrue:[
+ "/ ignore here - methodCategoryList will tell me if required
+ ^ self
+ ].
+ (something == #classOrganization
+ or:[ something == #methodCategoryAdded
+ or:[ something == #methodCategoryRemoved
+ or:[ something == #methodCategoriesRemoved
+ or:[ something == #methodCategoryRenamed ]]]]) ifTrue:[
+ "/ ignore here - methodCategoryList will tell me if required
+ ^ self
+ ].
+
+ (something == #methodInClass
+ or:[something == #methodCoverageInfo]) ifTrue:[
+ "/ a method has been added/changed
+ cls := aParameter at:1.
+ (classes includesIdentical:cls) ifTrue:[
+ sel := aParameter at:2.
+ oldMethod := aParameter at:3.
+ newMethod := cls compiledMethodAt:sel.
+ (oldMethod notNil and:[newMethod notNil]) ifTrue:[
+ "a method was changed & acccepted;
+ No need for a rescan of the methodDictionary;
+ however, ensure that the refs to the old method are updated
+ "
+ methods := selection.
+ methods size > 0 ifTrue:[
+ (methods includesIdentical:oldMethod) ifTrue:[
+ needSelectionChange := true.
+ ]
+ ].
+ methodList replaceAllIdentical:oldMethod with:newMethod.
+ lastSelectedMethods notNil ifTrue:[
+ lastSelectedMethods replaceAllIdentical:oldMethod with:newMethod
+ ].
+ methods size > 0 ifTrue:[
+ methods := methods asOrderedCollection.
+ methods replaceAllIdentical:oldMethod with:newMethod.
+ ].
+
+ needSelectionChange == true ifTrue:[
+ selectionHolder setValue:methods.
+ "/ self enqueueDelayedMethodsSelectionChanged.
+ "/ need this to inform my browser that method was changed
+ "/ by someone else.
+ selectionHolder changed.
+ ].
+ "/JV@2011-07-22: Update always - I need to see immediately that
+ "/the method has changed. Also, add/remove breakpoint etc.
+
+"/ (variableFilter value size > 0
+"/ or:[oldMethod package ~= newMethod package
+"/ or:[oldMethod resources ~= newMethod resources
+"/ or:[showMethodComplexity value == true]]])
+ self autoUpdateOnChange ifTrue:[
+ "/ only update that method's entry
+ self updateListEntryFor:newMethod.
+ "/ sigh - must invalidate
+ "/ self invalidateList.
+ ].
+ ^ self.
+ ].
+ "/ method was added - update the methodList
+ "/ Q: is this needed (methodCategoryList should send me a new inGenerator)
+ self invalidateList.
+ ].
+ ^ self.
+ ].
+
+ something == #methodInClassRemoved ifTrue:[
+ cls := aParameter at:1.
+ (classes includesIdentical:cls) ifTrue:[
+ sel := aParameter at:2.
+ "/ method was removed - update the methodList
+ "/ Q: is this needed (methodCategoryList should send me a new inGenerator)
+ self invalidateList.
+ ].
+ ^ self.
+ ].
+
+ something == #methodCoverageInfo ifTrue:[
+ "/ already checked if it is one of my classes
+ self updateListEntryFor:aParameter.
+"/ self enqueueDelayedUpdateList.
+"/ listValid == true ifTrue:[
+"/ self invalidateList.
+"/ ].
+ ^ self.
+ ].
+
+ (something == #methodTrap
+ or:[ something == #lastTestRunResult
+ or:[ something == #privacyOfMethod ]]) ifTrue:[
+ cls := aParameter at:1.
+ sel := aParameter at:2.
+ (classes includesIdentical:cls) ifFalse:[ ^ self].
+
+ newMethod := cls compiledMethodAt:sel.
+ newMethod isNil ifTrue:[
+ self invalidateList.
+ ^ self
+ ].
+
+ ((something == #privacyOfMethod) or:[something == #lastTestRunResult]) ifTrue:[
+ self updateListEntryFor:newMethod.
+ ].
+
+ (something == #methodTrap) ifTrue:[
+ newMethod isWrapped ifTrue:[
+ oldMethod := newMethod originalMethod
+ ] ifFalse:[
+ selection size > 0 ifTrue:[
+ oldMethod := selection detect:[:each | each isWrapped and:[each originalMethod == newMethod]] ifNone:nil.
+ ]
+ ].
+
+ selection size > 0 ifTrue:[
+ (selection includesIdentical:oldMethod) ifTrue:[
+ needSelectionChange := true.
+ ]
+ ].
+ methodList replaceAllIdentical:oldMethod with:newMethod.
+ lastSelectedMethods notNil ifTrue:[
+ lastSelectedMethods replaceAllIdentical:oldMethod with:newMethod
+ ].
+ selection size > 0 ifTrue:[
+ selection := selection asOrderedCollection.
+ selection replaceAllIdentical:oldMethod with:newMethod.
+ ].
+ needSelectionChange == true ifTrue:[
+ selectionHolder changed.
+ ].
+
+ "/ actually, could just change that single item ...
+ "/ ... might be cheaper, if list is huge.
+ "/ only update that methods entry
+ self updateListEntryFor:newMethod.
+ "/ self invalidateList.
+ ].
+ ^ self
+ ].
+
+ (something == #projectOrganization
+ or:[something == #lastTestRunResult]) ifTrue:[
+ aParameter notNil ifTrue:[
+ cls := aParameter at:1.
+ cls notNil ifTrue:[
+ ((classes includesIdentical:cls theNonMetaclass)
+ or:[(classes includesIdentical:cls theMetaclass)]) ifTrue:[
+ self invalidateList.
+ ].
+ ].
+ ] ifFalse:[
+ self invalidateList.
+ ].
+ ^ self
+ ].
+
+ "/ everything else is ignored
+ "/ self halt.
+ ].
+ ^ self
+ ].
+
+"/ something == #organization ifTrue:[
+"/self halt:'no longer'.
+"/^ self.
+"/ "/ a methods cateory has changed
+"/ (classes includesIdentical:changedObject) ifTrue:[
+"/ aParameter isSymbol ifTrue:[
+"/ "/ a method with a new category
+"/ (self methodList includesIdentical:(changedObject compiledMethodAt:aParameter)) ifTrue:[
+"/ self invalidateList.
+"/ ].
+"/ ^ self.
+"/ ].
+"/ "/ a new category (no method yet)
+"/ self invalidateList
+"/ ].
+"/ ^ self
+"/ ].
+
+"/ something == #methodDictionary ifTrue:[
+"/self halt:'no longer'.
+"/^ self.
+"/ "/ a method has been added/removed
+"/ (classes includesIdentical:changedObject) ifTrue:[
+"/ aParameter isArray ifTrue:[
+"/ sel := aParameter at:1.
+"/ oldMethod := aParameter at:2.
+"/ newMethod := changedObject compiledMethodAt:sel.
+"/ oldMethod notNil ifTrue:[
+"/ "a method was changed & acccepted;
+"/ No need for a rescan of the methodDictionary;
+"/ however, ensure that the refs to the old method are updated
+"/ "
+"/ methods := selection.
+"/ methods size > 0 ifTrue:[
+"/ (methods includesIdentical:oldMethod) ifTrue:[
+"/ needSelectionChange := true.
+"/ ]
+"/ ].
+"/ methodList replaceAllIdentical:oldMethod with:newMethod.
+"/ lastSelectedMethods notNil ifTrue:[
+"/ lastSelectedMethods replaceAllIdentical:oldMethod with:newMethod
+"/ ].
+"/ methods size > 0 ifTrue:[
+"/ methods := methods asOrderedCollection.
+"/ methods replaceAllIdentical:oldMethod with:newMethod.
+"/ ].
+"/ needSelectionChange == true ifTrue:[
+"/ selectionHolder setValue:methods.
+"/ selectionHolder changed.
+"/ ].
+"/ ^ self.
+"/ ]
+"/ ].
+"/ "/ class has changed must update the methodList
+"/ self invalidateList.
+"/ ].
+"/ ^ self.
+"/ ].
+
+"/ something == #projectOrganization ifTrue:[
+"/ ((classes includesIdentical:changedObject theNonMetaclass)
+"/ or:[(classes includesIdentical:changedObject theMetaclass)]) ifTrue:[
+"/ self invalidateList.
+"/ ].
+"/ ^ self
+"/ ].
+
+ changedObject == sortBy ifTrue:[
+ listValid ~~ true ifTrue:[ "/ could be nil
+ inGeneratorHolder value isNil ifTrue:[
+ "/ ok, no need to react on that one
+ "/ (will invalidate anyway, once I have more info at hand)
+ ^ self
+ ].
+ ].
+ self invalidateList.
+ ^ self
+ ].
+
+ (changedObject == variableFilter
+ or:[changedObject == filterClassVars
+ or:[changedObject == showMethodInheritance
+ or:[changedObject == showMethodComplexity]]]) ifTrue:[
+ self invalidateList.
+ ^ self
+ ].
+
+ changedObject == selectedMethodNameIndices ifTrue:[
+ newSelection := self selectedMethodNameIndices value collect:[:idx | methodList at:idx].
+ newSelection ~= selection ifTrue:[
+ selectionHolder value:newSelection.
+ lastSelectedMethods := newSelection.
+ lastSelectedMethods notNil ifTrue:[
+ lastSelectedMethods := lastSelectedMethods asOrderedCollection
+ ].
+ ] ifFalse:[
+ "/ a reselect - force update
+"/ selection size == 1 ifTrue:[
+ selectionHolder setValue:newSelection.
+ selectionHolder changed:#value.
+"/ ].
+ ].
+ ^ self
+ ].
+ changedObject == selectionHolder ifTrue:[
+ self selectedMethodsChanged.
+ lastSelectedMethods := selectionHolder value.
+ lastSelectedMethods notNil ifTrue:[
+ lastSelectedMethods := lastSelectedMethods asOrderedCollection
+ ].
+ ^ self
+ ].
+"/ something == #methodTrap ifTrue:[
+"/self halt:'no longer'.
+"/^ self.
+"/ (classes includesIdentical:changedObject) ifTrue:[
+"/ newMethod := changedObject compiledMethodAt:aParameter.
+"/ newMethod isNil ifTrue:[
+"/ self invalidateList.
+"/ ^ self
+"/ ].
+"/ newMethod isWrapped ifTrue:[
+"/ oldMethod := newMethod originalMethod
+"/ ] ifFalse:[
+"/ selection size > 0 ifTrue:[
+"/ oldMethod := selection detect:[:each | each isWrapped and:[each originalMethod == newMethod]] ifNone:nil.
+"/ ]
+"/ ].
+"/
+"/ selection size > 0 ifTrue:[
+"/ (selection includesIdentical:oldMethod) ifTrue:[
+"/ needSelectionChange := true.
+"/ ]
+"/ ].
+"/"/ methodList replaceAllIdentical:oldMethod with:newMethod.
+"/ lastSelectedMethods notNil ifTrue:[
+"/ lastSelectedMethods replaceAllIdentical:oldMethod with:newMethod
+"/ ].
+"/ selection size > 0 ifTrue:[
+"/ selection := selection asOrderedCollection.
+"/ selection replaceAllIdentical:oldMethod with:newMethod.
+"/ ].
+"/ needSelectionChange == true ifTrue:[
+"/ selectionHolder changed.
+"/ ].
+"/ self invalidateList.
+"/ ^ self
+"/ ].
+"/ ^ self
+"/ ].
+ super delayedUpdate:something with:aParameter from:changedObject
+
+ "Created: / 05-02-2000 / 13:42:14 / cg"
+ "Modified: / 22-07-2011 / 18:12:23 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 05-06-2012 / 23:47:15 / cg"
+!
+
+selectedMethodsChanged
+ "the set of selected methods has changed;
+ update the selection-index collection (for the selectionInListView)"
+
+ |indices methods reverseMap
+ selectedMethodsHolder selectedMethods selectedMethodNameIndicesHolder|
+
+ methods := methodList ? #().
+ methods size == 0 ifTrue:[
+ "/ this may happen during early startup,
+ "/ when invoked with a preset methodSelection,
+ "/ and the methodGenerator has not yet been setup
+ "/ to not clobber the selection, defer the update
+ "/ until the methodList arrives ...
+ ^ self
+ ].
+
+ selectedMethodsHolder := self selectedMethods.
+ selectedMethods := selectedMethodsHolder value.
+
+ "/ check if all is selected (likely)
+ ((selectedMethods size == methodList size)
+ and:[selectedMethods = methodList]) ifTrue:[
+ indices := (1 to:selectedMethods size)
+ ] ifFalse:[
+ selectedMethods size > 100 ifTrue:[
+ "/ check if all is selected (likely)
+ ((selectedMethods size == methodList size)
+ and:[selectedMethods = methodList]) ifTrue:[
+ indices := (1 to:selectedMethods size)
+ ] ifFalse:[
+ "/ for big collections, generate a reverse map
+ reverseMap := IdentityDictionary new.
+ methods keysAndValuesDo:[:idx :mthd | reverseMap at:mthd put:idx].
+ indices := selectedMethods collect:[:eachSelectedMethod |
+ reverseMap at:eachSelectedMethod ifAbsent:0
+ ]
+ ]
+ ] ifFalse:[
+ indices := (selectedMethods ? #()) collect:[:eachSelectedMethod |
+ methods identityIndexOf:eachSelectedMethod.
+ ]
+ ].
+ indices := indices select:[:idx | idx ~= 0].
+ ].
+
+ selectedMethodNameIndicesHolder := self selectedMethodNameIndices.
+ selectedMethodNameIndicesHolder value ~= indices ifTrue:[
+ selectedMethodNameIndicesHolder value:indices.
+ ]
+!
+
+selectionChanged
+ |methods|
+
+ methods := ((self selectedMethodNameIndices value) ? #()) collect:[:idx | methodList at:idx].
+ methods notEmpty ifTrue:[
+ lastSelectedMethods := methods asOrderedCollection.
+ ].
+ "/ to allow reselect, change my valueHolder, even if the same collection
+"/ self selectedMethods value ~= methods ifTrue:[
+ self selectedMethods value:methods
+"/ ]
+
+ "Created: / 5.2.2000 / 13:42:14 / cg"
+ "Modified: / 5.2.2000 / 23:32:20 / cg"
+!
+
+selectionChangedByClick
+ "we are not interested in that - get another notification
+ via the changed valueHolder"
+
+!
+
+update:something with:aParameter from:changedObject
+ |cls sel mthd mustFlushInheritanceInfo|
+
+ mustFlushInheritanceInfo := true.
+
+ "/ some can be ignored immediately
+ changedObject == Smalltalk ifTrue:[
+ classes isNil ifTrue:[
+ ^ self.
+ ].
+ something isNil ifTrue:[
+ "/ self halt "/ huh - Smalltalk changed - so what ?
+ ^ self.
+ ].
+ something == #classComment ifTrue:[
+ ^ self.
+ ].
+ something == #classVariables ifTrue:[
+ ^ self.
+ ].
+ something == #organization ifTrue:[
+ ^ self.
+ ].
+ something == #methodCategory ifTrue:[
+ "/ ignore here - methodCategoryList will tell me if required
+ ^ self
+ ].
+ (something == #classOrganization
+ or:[ something == #methodCategoryAdded
+ or:[ something == #methodCategoryRemoved
+ or:[ something == #methodCategoriesRemoved
+ or:[ something == #methodCategoryRenamed ]]]]) ifTrue:[
+ "/ ignore here - methodCategoryList will tell me if required
+ ^ self
+ ].
+
+ something == #methodCoverageInfo ifTrue:[
+ self showCoverageInformation value ifFalse:[^ self].
+ mthd := aParameter.
+ (classes notNil and:[classes includesIdentical:mthd mclass]) ifFalse:[
+ ^ self "/ I don't care for that class
+ ].
+ mustFlushInheritanceInfo := false.
+ ].
+
+ (something == #methodTrap
+ or:[ something == #methodPrivacy
+ or:[ something == #lastTestRunResult] ]) ifTrue:[
+ cls := aParameter at:1.
+ (classes includesIdentical:cls) ifFalse:[
+ ^ self "/ I dont care for that class
+ ].
+ self window shown ifFalse:[
+ "JV@2011-11-17: Do not break the dependency here,
+ because then the window won't get updates once
+ deiconified -> leads to confusing behavior
+ (browser shows obsolete info)"
+ "/changedObject removeDependent:self. "/ ?????
+ self invalidateList.
+ ^ self
+ ].
+ sel := aParameter at:2.
+ mthd := cls compiledMethodAt:sel.
+ (mthd isWrapped or:[mthd isMethodWithBreakpoints]) ifTrue:[
+ (methodList includes:mthd originalMethod) ifTrue:[
+ methodList replaceAll:mthd originalMethod with:mthd.
+ lastSelectedMethods replaceAll:mthd originalMethod with:mthd.
+ ]
+ ].
+ mustFlushInheritanceInfo := false.
+ ].
+ something == #newClass ifTrue:[
+ ^ self.
+ ].
+
+ (something == #methodInClass
+ or:[ something == #methodInClassRemoved ]) ifTrue:[
+ sel := aParameter second.
+ cls := aParameter first.
+ (classes contains:[:aClass | aClass name == cls name]) ifFalse:[
+ ^ self "/ I dont care for that class
+ ].
+ (methodList contains:[:mthd | mthd getMclass notNil and:[mthd selector = sel]]) ifFalse:[
+ mustFlushInheritanceInfo := false.
+ self window topView hasFocus ifFalse:[
+ self enqueueDelayedUpdate:something with:aParameter from:changedObject.
+ ^ self.
+ ].
+ ].
+ ].
+
+ mustFlushInheritanceInfo ifTrue:[
+ "/ as the organisation changes, flush my remembered redefinition-cache-info
+ classAndSelectorsRedefinedBySubclassesOfClass := nil.
+ ].
+
+ something == #classDefinition ifTrue:[
+ cls := aParameter.
+ (classes contains:[:aClass | aClass name == cls name]) ifFalse:[
+ ^ self "/ I dont care for that class
+ ].
+ self enqueueDelayedUpdate:something with:aParameter from:changedObject.
+ ^ self.
+ ].
+ something == #classRemove ifTrue:[
+ ^ self.
+ ].
+ something == #classRename ifTrue:[
+ ^ self.
+ ].
+ ].
+
+ "/ these must lead to immediate update of the selectedMethods collection
+ "/ (otherwise, that collection might be updated too late, leading to
+ "/ an obsolete methods code being shown by the codeView.
+ (something == #methodInClass
+ or:[ something == #methodCoverageInfo ]) ifTrue:[
+ "/ as the organisation changes, flush my remembered redefinition-cache-info
+ classAndSelectorsRedefinedBySubclassesOfClass := nil.
+ cls := aParameter at:1.
+ (classes includesIdentical:cls) ifFalse:[
+ ^ self "/ I dont care for that class
+ ].
+ self enqueueDelayedUpdate:something with:aParameter from:changedObject.
+ ^ self
+ ].
+
+ something == #coverageInfo ifTrue:[
+ listValid == true ifTrue:[
+ self enqueueDelayedUpdateList
+ ].
+ ^ self.
+ ].
+
+ something == #methodInClassRemoved ifTrue:[
+ cls := aParameter at:1.
+ (classes includesIdentical:cls) ifFalse:[
+ ^ self "/ I dont care for that class
+ ].
+ ].
+
+ super update:something with:aParameter from:changedObject
+
+ "Modified: / 17-11-2011 / 19:22:48 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 05-06-2012 / 23:41:50 / cg"
+! !
+
+!MethodList methodsFor:'drag & drop'!
+
+canDropContext:aDropContext
+ |methods|
+
+ aDropContext sourceWidget == aDropContext targetWidget ifTrue:[^ false].
+
+ methods := aDropContext dropObjects collect:[:obj | obj theObject].
+ (methods conform:[:aMethod | aMethod isMethod]) ifFalse:[^ false].
+
+ self masterApplication theSingleSelectedClass isNil ifTrue:[^ false].
+ ^ true
+
+ "Modified: / 13-09-2006 / 11:43:54 / cg"
+!
+
+doDropContext:aDropContext
+ |methods browser|
+
+ methods := aDropContext dropObjects collect:[:aDropObject | aDropObject theObject].
+ (methods conform:[:something | something isMethod]) ifFalse:[^ self].
+
+ browser := self masterApplication.
+ aDropContext dragType == DropContext dragTypeCopy ifTrue:[
+ browser
+ copyMethods:methods
+ toClass:(browser theSingleSelectedClass).
+ ] ifFalse:[
+ browser
+ moveMethods:methods
+ toClass:(browser theSingleSelectedClass).
+ ].
+
+ "Modified: / 13-09-2006 / 11:43:44 / cg"
+! !
+
+!MethodList methodsFor:'private'!
+
+isMethodToBeShown:aMethod
+ "invoked, when we get a change for aMethod which was previously not
+ in the list (for example, if I show a filtered list).
+ Check if that single method is to be shown now.
+ Used to speed up update for senders/string/implementors lists"
+
+ |generator|
+
+ generator := inGeneratorHolder value.
+ generator isNil ifTrue:[
+ ^ false
+ ].
+
+ "/ generator generates nil-selector entries
+ "/ to pass multiple-class and multiple-protocol info
+
+ generator do:[:cls :cat :sel :mthd |
+ mthd == aMethod ifTrue:[
+ mthd isSynthetic ifFalse:[
+ sel notNil ifTrue:[
+"/ cg: no longer filter those...
+"/ (packageFilter value isNil
+"/ or:[ packageFilter value includes:mthd package ]) ifTrue:[
+ ^ true
+"/ ]
+ ]
+ ].
+ ^ false
+ ]
+ ].
+ ^ false
+
+ "Created: / 17-08-2011 / 15:03:34 / cg"
+!
+
+listOfMethodNames
+ |methods entries selectorBag newNameList allClasses newClasses
+ allCategories "allSelectors"
+ generator doShowClass doShowClassFirst doShowCategory enforceClassAndProtocolInList
+ theMethod sortByClass anyMethodToWatch mclass
+ packageFilterValue nameListEntryForExtensions
+ suppressInheritanceInfoNow startTime|
+
+ suppressInheritanceInfoNow := (showMethodInheritance value ? true) not.
+ startTime := Timestamp now.
+
+ generator := inGeneratorHolder value.
+ generator isNil ifTrue:[
+ ^ #()
+ ].
+ allClasses := IdentitySet new.
+ allCategories := IdentitySet new.
+
+ "/ allSelectors := Set new.
+
+ newClasses := IdentitySet new.
+ selectorBag := Bag new.
+ entries := OrderedCollection new.
+ enforceClassAndProtocolInList := false.
+ anyMethodToWatch := false.
+"/ no longer filter those
+"/ packageFilterValue := packageFilter value.
+
+ "/ generator generates nil-selector entries
+ "/ to pass multiple-class and multiple-protocol info
+ nameListEntryForExtensions := self class nameListEntryForExtensions.
+
+ generator do:[:cls :cat :sel :mthd |
+ |categoryIsExtensionsPseudoCategory|
+
+ categoryIsExtensionsPseudoCategory := (cat = nameListEntryForExtensions).
+
+ (cls isNil and:[ cat isNil and:[ sel isNil ] ]) ifTrue:[
+ enforceClassAndProtocolInList := true
+ ] ifFalse:[
+ cls notNil ifTrue:[
+ allClasses add:cls.
+ ].
+"/ cat notNil ifTrue:[
+"/ allCategories add:cat.
+"/ ].
+ "/ JV: Filter method through package filter
+ "/ but not, if it is an extension method and we are showing extensions
+ (mthd notNil
+ and:[ mthd isSynthetic not
+ and:[ sel notNil ]]
+ ) ifTrue:[
+ (packageFilterValue isNil
+ or:[ (packageFilterValue includes:mthd package)
+ or:[ categoryIsExtensionsPseudoCategory and:[ mthd isExtension] ]]
+ ) ifTrue:[
+ entries add:(Array with:cls with:sel with:mthd).
+ selectorBag add:sel.
+ newClasses add:cls.
+
+ allCategories add:mthd category.
+ "/ allSelectors add:sel.
+ ]
+ ]
+ ].
+ (mthd notNil and:[ mthd isWrapped ]) ifTrue:[
+ (mthd isTiming or:[ mthd isCounting or:[ mthd isCountingMemoryUsage ] ]) ifTrue:[
+ anyMethodToWatch := true
+ ]
+ ].
+ ].
+ showMethodInheritance value ~~ false ifTrue:[
+ "/ collect redefinition information once (big speedup for #methodIsRedefinedbelow)
+ classAndSelectorsRedefinedBySubclassesOfClass isNil ifTrue:[
+ classAndSelectorsRedefinedBySubclassesOfClass := IdentityDictionary new.
+ ].
+ allClasses do:[:cls |
+ |d|
+
+ d := classAndSelectorsRedefinedBySubclassesOfClass.
+ (d notNil and:[ (d includesKey:cls) not ]) ifTrue:[
+ cls isLoaded ifTrue:[
+ d at:cls put:(self setOfAllSelectorsImplementedBelow:cls)
+ ]
+ ]
+ ].
+ ].
+
+ "/ multiple classes must: add the className for some
+
+ doShowClass := enforceClassAndProtocolInList or:[ allClasses size > 1 ].
+
+ "/ multiple categories: must add the categorie for some
+
+ doShowCategory := enforceClassAndProtocolInList or:[ allCategories size > 1 ].
+
+ doShowClassFirst := doShowClass.
+ doShowClassFirst := doShowClass and:[ sortBy value == #class ].
+ sortBy value == false ifTrue:[
+ "/ do not sort
+ ] ifFalse:[
+ (doShowClass not and:[ sortBy value == #class ]) ifTrue:[
+ "/ multiple classes must add the className for some
+ "/ check, if doShowClass must be enforced
+ entries do:[:entry |
+ |cls sel mthd s needClass|
+
+ cls := entry at:1.
+ sel := entry at:2.
+ mthd := entry at:3.
+ doShowClass ifFalse:[
+ doShowClass := (selectorBag occurrencesOf:sel) > 1
+ ].
+ ].
+ ].
+ sortByClass := doShowClass and:[ sortBy value == #class ].
+ sortByClass ifTrue:[
+ entries
+ sort:[:a :b |
+ |nmA nmB clsNmA clsNmB nsNmA nsNmB|
+
+ clsNmA := (a at:1) name.
+ clsNmB := (b at:1) name.
+ clsNmA = clsNmB ifTrue:[
+ nmA := (a at:2) asSymbol selector.
+ nmB := (b at:2) asSymbol selector.
+ nmA = nmB ifTrue:[
+ nsNmA := (a at:3) nameSpaceName.
+ nsNmB := (b at:3) nameSpaceName.
+ nsNmA < nsNmB
+ ] ifFalse:[ nmA < nmB ]
+ ] ifFalse:[
+ clsNmA < clsNmB
+ ]
+ ].
+ ] ifFalse:[
+ sortBy value == #category ifTrue:[
+ entries
+ sort:[:a :b |
+ |nmA nmB catA catB clsNmA clsNmB nsNmA nsNmB|
+
+ catA := (a at:3) category.
+ catB := (b at:3) category.
+ catA = catB ifTrue:[
+ nmA := (a at:2) asSymbol selector.
+ nmB := (b at:2) asSymbol selector.
+ nmA = nmB ifTrue:[
+ clsNmA := (a at:1) name.
+ clsNmB := (b at:1) name.
+ clsNmA = clsNmB ifTrue:[
+ nsNmA := (a at:3) nameSpaceName.
+ nsNmB := (b at:3) nameSpaceName.
+ nsNmA < nsNmB
+ ] ifFalse:[
+ clsNmA < clsNmB
+ ]
+ ] ifFalse:[ nmA < nmB ]
+ ] ifFalse:[
+ catA < catB
+ ]
+ ].
+ ] ifFalse:[
+ entries
+ sort:[:a :b |
+ |nmA nmB clsNmA clsNmB nsNmA nsNmB|
+
+ nmA := (a at:2) asSymbol selector.
+ nmB := (b at:2) asSymbol selector.
+ nmA = nmB ifTrue:[
+ clsNmA := (a at:1) name.
+ clsNmB := (b at:1) name.
+ clsNmA = clsNmB ifTrue:[
+ nsNmA := (a at:3) nameSpaceName.
+ nsNmB := (b at:3) nameSpaceName.
+ nsNmA < nsNmB
+ ] ifFalse:[
+ clsNmA < clsNmB
+ ]
+ ] ifFalse:[ nmA < nmB ]
+ ].
+ ].
+ ].
+ ].
+ methods := OrderedCollection new:(entries size).
+
+ "/ first generate the new methodList, and see if it is different ...
+
+ entries do:[:entry |
+ |sel mthd|
+
+ mthd := entry at:3.
+ methods add:mthd.
+ ].
+ false "methodList = methods" "does not care for changed icons" ifTrue:[
+ "/ same list
+ newNameList := self browserNameList.
+ ] ifFalse:[
+ newNameList := OrderedCollection new:(entries size).
+
+ "/ multiple classes must add the className for some
+
+ entries do:[:entry |
+ |cls sel mthd s needClass|
+
+ cls := entry at:1.
+ sel := entry at:2.
+ mthd := entry at:3.
+ needClass := doShowClass.
+
+"/ needClass ifFalse:[
+"/ needClass := (selectorBag occurrencesOf:sel) > 1
+"/ ].
+ (suppressInheritanceInfoNow not
+ and:[ (Timestamp now deltaFrom:startTime) > 3 seconds ]) ifTrue:[
+ suppressInheritanceInfoNow := true.
+ ].
+
+ s := self
+ listEntryForMethod:mthd
+ selector:sel
+ class:cls
+ showClass:needClass
+ showCategory:doShowCategory
+ classFirst:doShowClassFirst
+ suppressInheritanceInfo:suppressInheritanceInfoNow.
+
+ newNameList add:s.
+ ].
+ ].
+ self makeIndependent.
+ classes := newClasses.
+ self makeDependent.
+ methodList := methods.
+ methods size == 1 ifTrue:[
+ theMethod := methods first.
+ mclass := theMethod mclass.
+ mclass isNil ifTrue:[
+ theMethod isWrapped ifTrue:[
+ theMethod := theMethod originalMethod.
+ mclass := theMethod mclass.
+ ].
+ ].
+ self methodLabelHolder value:(mclass isNil
+ ifTrue:[ ('???' , ' ' , '???') ]
+ ifFalse:[ (mclass name , ' ' , theMethod selector) ])
+ ].
+"/ anyMethodToWatch ifTrue:[
+"/ self startWatchProcess.
+"/ ] ifFalse:[
+"/ self stopWatchProcess.
+"/ ].
+
+ "/ remember these, in case of an incremental (single method only)
+ "/ update in the future.
+
+ lastShowClass := doShowClass.
+ lastShowClassFirst := doShowClassFirst.
+ lastShowCategory := doShowCategory.
+ ^ newNameList.
+
+ "Created: / 05-02-2000 / 22:43:40 / cg"
+ "Modified: / 20-07-2010 / 11:21:15 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 24-08-2010 / 20:34:09 / Jan Vrany <enter your email here>"
+ "Modified: / 20-07-2012 / 20:00:58 / cg"
+!
+
+makeDependent
+ Smalltalk addDependent:self.
+"/ ChangeSet addDependent:self.
+
+ "Modified: / 10-11-2006 / 17:57:01 / cg"
+!
+
+makeIndependent
+ Smalltalk removeDependent:self.
+"/ ChangeSet removeDependent:self.
+!
+
+method:mthd includesModsOfClassVariable:variablesToHighLight
+ ^ self method:mthd includesRefsToVariable:variablesToHighLight askParserWith:#modifiedClassVars
+!
+
+method:mthd includesModsOfInstanceVariable:variablesToHighLight
+ ^ self method:mthd includesRefsToVariable:variablesToHighLight askParserWith:#modifiedInstVars
+!
+
+method:mthd includesRefsToClassVariable:variablesToHighLight
+ ^ self method:mthd includesRefsToVariable:variablesToHighLight askParserWith:#usedClassVars
+!
+
+method:mthd includesRefsToInstanceVariable:variablesToHighLight
+ ^ self method:mthd includesRefsToVariable:variablesToHighLight askParserWith:#usedInstVars
+!
+
+method:mthd includesRefsToVariable:variablesToHighLight askParserWith:querySelector
+ |cls src parser usedVars anyVarNameAccessable|
+
+ cls := mthd mclass.
+ cls isNil ifTrue:[^ false].
+
+ anyVarNameAccessable := cls allInstVarNames includesAny:variablesToHighLight.
+ anyVarNameAccessable ifFalse:[
+ anyVarNameAccessable := cls theNonMetaclass allClassVarNames includesAny:variablesToHighLight.
+ ].
+ anyVarNameAccessable ifFalse:[
+ "/ no need to parse
+ ^ false
+ ].
+
+ src := mthd source.
+ src notNil ifTrue:[
+ "
+ before doing a slow parse, quickly scan the
+ methods source for the variables name ...
+ "
+ (variablesToHighLight contains:[:varName | (src findString:varName) ~~ 0]) ifTrue:[
+ parser := Parser
+ parseMethod:src
+ in:cls
+ ignoreErrors:true
+ ignoreWarnings:true.
+ (parser notNil and:[parser ~~ #Error]) ifTrue:[
+ usedVars := parser perform:querySelector.
+ (usedVars includesAny:variablesToHighLight)
+ ifTrue:[
+ ^ true
+ ]
+ ]
+ ]
+ ].
+ ^ false
+!
+
+methodIsInheritedFromAbove:aMethod
+ |mClass|
+
+ mClass := aMethod mclass.
+ (mClass notNil and:[mClass superclass notNil]) ifTrue:[
+ ^ (mClass superclass whichClassIncludesSelector:aMethod selector) notNil.
+ ].
+ ^ false
+!
+
+methodIsRedefinedBelow:aMethod
+ |mclass subClasses setOfRedefinedSelectors|
+
+ mclass := aMethod mclass.
+ mclass isNil ifTrue:[^ false].
+
+ "/ if possible, make use of info prepared by listOfMethodNames
+ classAndSelectorsRedefinedBySubclassesOfClass notNil
+ ifTrue:[
+ setOfRedefinedSelectors := classAndSelectorsRedefinedBySubclassesOfClass at:mclass ifAbsent:nil.
+ setOfRedefinedSelectors notNil ifTrue:[
+ ^ setOfRedefinedSelectors includes:aMethod selector
+ ]
+ ].
+
+ lastMethodClass == mclass ifTrue:[
+ subClasses := lastMethodClassesSubclasses
+ ] ifFalse:[
+ subClasses := aMethod mclass allSubclasses.
+ lastMethodClassesSubclasses := subClasses.
+ lastMethodClass := mclass.
+ ].
+ ^ subClasses contains:[:cls | cls includesSelector:aMethod selector].
+!
+
+redefinedOrInheritedIconFor:aMethod
+ |inherited redefined subclassResponsibility|
+
+ inherited := self methodIsInheritedFromAbove:aMethod.
+ redefined := self methodIsRedefinedBelow:aMethod.
+
+ inherited ifTrue:[
+ redefined ifTrue:[
+ ^ self methodInheritedFromAboveAndRedefinedBelowIcon.
+ ].
+ ^ self methodInheritedFromAboveIcon.
+ ].
+
+ subclassResponsibility := aMethod sends:#subclassResponsibility.
+ redefined ifTrue:[
+ subclassResponsibility ifTrue:[
+ ^ self methodIsSubclassResponsibilityAndRedefinedBelowIcon.
+ ].
+ ^ self methodRedefinedBelowIcon.
+ ].
+ subclassResponsibility ifTrue:[
+ ^ self methodIsSubclassResponsibilityIcon.
+ ].
+
+ ^ self methodEmptyInheritedIcon
+!
+
+release
+ super release.
+
+ filterClassVars removeDependent:self.
+ selectedMethodNameIndices removeDependent:self.
+ showMethodInheritance removeDependent:self.
+ variableFilter removeDependent:self.
+!
+
+resourceIconForMethod:aMethod
+ ^ SystemBrowser resourceIconForMethod:aMethod
+
+ "Modified: / 17-08-2006 / 09:09:01 / cg"
+!
+
+setOfAllSelectorsImplementedBelow:aClass
+ |set|
+
+ set := IdentitySet new.
+ aClass allSubclassesDo:[:eachSubclass |
+ set addAll:(eachSubclass methodDictionary keys).
+ ].
+ ^ set
+!
+
+updateList
+ |prevSelection newList newSelection newSelIdx reverseMap sameContents newListSize oldListSize
+ prevClasses methodSet selectedMethodsHolder|
+
+ selectedMethodsHolder := self selectedMethods.
+ prevSelection := selectedMethodsHolder value ? #().
+
+ prevClasses := classes ifNil:[ #() ] ifNotNil:[ classes copy ].
+
+ oldListSize := self browserNameList size.
+
+ self topApplication withWaitCursorDo:[
+ newList := self listOfMethodNames.
+ ].
+ newListSize := newList size.
+ sameContents := self updateListFor:newList.
+
+ sameContents ifFalse:[
+ "/ self browserNameList value:newList.
+
+ (prevSelection size == 0
+ and:[selectedMethodsHolder value size ~~ 0]) ifTrue:[
+ "/ this happens during early startup time,
+ "/ when the selection is already (pre-)set,
+ "/ and the methodList is generated the first time
+ "/ (i.e. when opened with preset selection
+
+ "/ do not clobber the selection in this case.
+ prevSelection := selectedMethodsHolder value.
+ ].
+
+ (methodList size == 0 or:[prevSelection size == 0]) ifTrue:[
+ newSelection := #()
+ ] ifFalse:[
+ methodSet := methodList.
+
+ "/ inclusion test is much faster with sets, if the number of items is large
+ methodList size > 30 ifTrue:[
+ "/ however, only if its worth building the set ...
+ prevSelection size > 5 ifTrue:[
+ methodSet := methodSet asIdentitySet.
+ ]
+ ].
+ newSelection := prevSelection select:[:item | methodSet includesIdentical:item].
+ ].
+ newSelection size > 0 ifTrue:[
+ newSelection size > 100 ifTrue:[
+ "/ need selection indices - might be expensive if done straight forward...
+ reverseMap := IdentityDictionary new.
+ methodList keysAndValuesDo:[:idx :mthd | reverseMap at:mthd put:idx].
+ newSelIdx := newSelection collect:[:mthd | reverseMap at:mthd].
+ ] ifFalse:[
+ newSelIdx := newSelection collect:[:mthd | methodList identityIndexOf:mthd]
+ ].
+"/ self halt.
+ "/ force change (for dependents)
+ newSelIdx ~= selectedMethodNameIndices value ifTrue:[
+ selectedMethodNameIndices value:newSelIdx.
+ ].
+ ] ifFalse:[
+ lastSelectedMethods := selectedMethodsHolder value.
+ lastSelectedMethods notNil ifTrue:[
+ lastSelectedMethods := lastSelectedMethods asOrderedCollection
+ ].
+ selectedMethodNameIndices value size > 0 ifTrue:[
+ selectedMethodNameIndices value:#().
+ ]
+ ].
+
+ newSelection ~= prevSelection ifTrue:[
+ self selectionChanged.
+ ]
+ ] ifTrue:[
+ "/ same list - but classes might have changed
+ "/ that is the case, if the class selection has been changed,
+ "/ to another class which has the same categories.
+
+ (prevClasses size ~= classes size
+ or:[prevClasses asOrderedCollection ~= (classes ? #()) asOrderedCollection ]) ifTrue:[
+ (newListSize > 0 or:[oldListSize > 0]) ifTrue:[
+ self selectionChanged.
+ ]
+ ]
+ ]
+ "/ ].
+
+ "Modified: / 05-03-2007 / 16:07:24 / cg"
+!
+
+updateListEntryFor:aMethod
+ "update my list for a single method.
+ (used when a single methods package, code or whatever changes, and a full udpate
+ would be too slow)"
+
+ |s idx|
+
+ s := self
+ listEntryForMethod:aMethod
+ selector:aMethod selector
+ class:aMethod mclass
+ showClass:lastShowClass
+ showCategory:lastShowCategory
+ classFirst:lastShowClassFirst
+ suppressInheritanceInfo:false.
+
+ idx := methodList identityIndexOf:aMethod.
+ idx == 0 ifTrue:[
+ aMethod isWrapped ifTrue:[
+ idx := methodList identityIndexOf:aMethod originalMethod.
+ idx == 0 ifTrue:[
+ "/ aMethod (wrapped) has changed its status, but is not in the list.
+ ^ self.
+ ].
+ ]
+ ].
+ idx == 0 ifTrue:[
+ "/ method was not previously shown; try to avoid a full update
+ (self isMethodToBeShown:aMethod) ifTrue:[
+ self invalidateList
+ ].
+ ] ifFalse:[
+ self browserNameList at:idx put:s.
+ ]
+
+ "Modified: / 17-08-2011 / 15:05:02 / cg"
+! !
+
+!MethodList methodsFor:'private-presentation'!
+
+colorForCoverageInformationOfMethod:aMethod
+ aMethod isInstrumented ifFalse:[^ nil].
+ aMethod category = 'documentation' ifTrue:[^ nil].
+
+ aMethod hasBeenCalled ifTrue:[
+ aMethod haveAllBlocksBeenExecuted ifTrue:[
+ ^ UserPreferences current colorForInstrumentedFullyCoveredCode
+ ].
+ ^ UserPreferences current colorForInstrumentedPartiallyCoveredCode
+ ].
+ ^ UserPreferences current colorForInstrumentedNeverCalledCode
+
+ "Created: / 30-04-2010 / 11:53:38 / cg"
+!
+
+listEntryForMethod:aMethod selector:selector class:cls showClass:showClass showCategory:showCategory classFirst:showClassFirst
+ "answer a method list entry
+ gimmics:
+ adding a little image to breakPointed methods,
+ inheritance indicators,
+ highlight accessors of variable"
+
+ ^ self
+ listEntryForMethod:aMethod
+ selector:selector
+ class:cls
+ showClass:showClass showCategory:showCategory
+ classFirst:showClassFirst
+ suppressInheritanceInfo:false
+!
+
+listEntryForMethod:aMethod selector:selector class:cls showClass:showClass showCategory:showCategory classFirst:showClassFirst suppressInheritanceInfo:suppressInheritanceInfo
+ "answer a method list entry
+ gimmics:
+ adding a little image to breakPointed methods,
+ inheritance indicators,
+ highlight accessors of variable"
+
+ |s icn variablesToHighlight classVarsToHighLight
+ doHighLight doHighLightRed clr emp cat l redefIcon
+ metrics complexity complexityString complexityIcon mark lastResultOrNil|
+
+ aMethod isNil ifTrue:[
+ "/ a non-existing (pseudo) method (such as required protocol)
+ ^ selector colorizeAllWith:Color red.
+ ].
+
+ showClassFirst ifTrue:[
+ s := aMethod printStringForBrowserWithSelector:selector allBold inClass:cls.
+ s := cls nameInBrowser , ' ' , s
+ ] ifFalse:[
+ s := aMethod printStringForBrowserWithSelector:selector inClass:cls.
+ ].
+
+ "/
+ "/ wrap icons (i.e. break- or trace points on the method)
+ "/ have higher prio ...
+ "/
+ (aMethod notNil and:[aMethod isWrapped]) ifTrue:[
+ (s endsWith:' !!') ifTrue:[
+ s := s copyWithoutLast:2
+ ].
+ aMethod isBreakpointed ifTrue:[
+ icn := self stopIcon
+ ] ifFalse:[
+ aMethod isTimed ifTrue:[
+ icn := self timeIcon
+ ] ifFalse:[
+ icn := self traceIcon
+ ]
+ ].
+ ].
+
+ "/
+ "/ breakpoint icons (i.e. break- or trace points inside)
+ "/
+ icn isNil ifTrue:[
+ (aMethod notNil and:[aMethod isMethodWithBreakpoints]) ifTrue:[
+ icn := self breakPointedIcon
+ ].
+ ].
+
+ icn isNil ifTrue:[
+ self showImageResourceMethodsImages value ~~ false ifTrue:[
+ (aMethod hasImageResource) ifTrue:[
+ aMethod mclass isMeta ifTrue:[
+ icn := aMethod valueWithReceiver:nil arguments:nil .
+ ].
+ ].
+ ].
+ ].
+
+ icn isNil ifTrue:[
+ showMethodTypeIcon value ~~ false ifTrue:[
+ icn := self resourceIconForMethod:aMethod.
+ ].
+ icn isNil ifTrue:[
+ aMethod isProtected ifTrue:[
+ icn := self protectedMethodIcon
+ ] ifFalse:[
+ aMethod isPrivate ifTrue:[
+ icn := self privateMethodIcon
+ ] ifFalse:[
+ (aMethod isIgnored) ifTrue:[
+ icn := self ignoredMethodIcon
+ ] ifFalse:[
+ (aMethod isJavaMethod and:[aMethod isAbstract]) ifTrue:[
+ icn := self abstractMethodIcon
+ ]
+ ]
+ ]
+ ].
+ ].
+ ].
+ icn isNil ifTrue:[
+ (selector startsWith:'test') ifTrue:[
+ ((cls isSubclassOf:TestCase)
+ and:[cls isAbstract not]) ifTrue:[
+ "JV@2011-11-17: Show thumbs even if not all test were run"
+
+ lastResultOrNil := cls rememberedOutcomeFor:selector.
+ lastResultOrNil notNil ifTrue:[
+ (lastResultOrNil result == TestResult statePass) ifTrue:[
+ icn := SystemBrowser testCasePassedIcon
+ ] ifFalse:[
+ ((lastResultOrNil result == TestResult stateError)
+ or:[ (lastResultOrNil result == TestResult stateFail) ]) ifTrue:[
+ icn := SystemBrowser testCaseFailedIcon
+ ]
+ ]
+ ].
+ ].
+ ]
+ ].
+
+ showClass ifTrue:[
+ showClassFirst ifFalse:[
+ s := s , ' [' , cls name allBold , ']'.
+ ]
+ ].
+ showCategory ifTrue:[
+ cat := aMethod category.
+ cat notNil ifTrue:[
+ s := s , ' {' , (cat "asText allItalic" colorizeAllWith:Color grey), '}'
+ ]
+ ].
+
+ self showCoverageInformation value ifTrue:[
+ clr := self colorForCoverageInformationOfMethod:aMethod.
+ clr notNil ifTrue:[
+ s := self colorize:s with:(#color->clr).
+ "/ aMethod isInstrumented ifTrue:[
+ "/ icn := self instrumentationIcon
+ "/ ].
+ ].
+ ] ifFalse:[
+ (ChangeSet current includesChangeForClass:cls selector:selector) ifTrue:[
+ mark := self class markForBeingInChangeList.
+ "/ mark := self colorizeForChangedCode:mark.
+ s := s , mark.
+ "/ cg: I dont know why this was disabled - it is req'd to
+ "/ see changed methods in a method list (implementors...)
+ s := self colorizeForChangedCode:s.
+ ].
+
+ (SmallTeam notNil and:[SmallTeam includesChangeForClass:cls selector:selector]) ifTrue:[
+ s := (self colorizeForChangedCodeInSmallTeam:'!! '),s
+ ].
+ ].
+
+ variablesToHighlight := variableFilter value.
+ variablesToHighlight size > 0 ifTrue:[
+ classVarsToHighLight := filterClassVars value.
+ classVarsToHighLight ifTrue:[
+ doHighLight := self method:aMethod includesRefsToClassVariable:variablesToHighlight.
+ doHighLight ifTrue:[
+ doHighLightRed := self method:aMethod includesModsOfClassVariable:variablesToHighlight.
+ ].
+ ] ifFalse:[
+ doHighLight := self method:aMethod includesRefsToInstanceVariable:variablesToHighlight.
+ doHighLight ifTrue:[
+ doHighLightRed := self method:aMethod includesModsOfInstanceVariable:variablesToHighlight
+ ]
+ ].
+ doHighLight ifTrue:[
+ s := s allBold.
+ doHighLightRed ifTrue:[
+ emp := (UserPreferences current emphasisForWrittenVariable)
+ ] ifFalse:[
+ emp := (UserPreferences current emphasisForReadVariable)
+ ].
+ s := s emphasisAllAdd:emp
+ ]
+ ].
+
+ (showMethodComplexity value == true
+ and:[ OOM::MethodMetrics notNil ]) ifTrue:[
+ icn isNil ifTrue:[
+ metrics := OOM::MethodMetrics forMethod:aMethod.
+ complexity := metrics complexity ? 0.
+ complexityIcon := OOM::MethodMetrics iconForComplexity:complexity.
+
+ ShowComplexityValue == true ifTrue:[
+ complexityString := '{' , complexity printString , '}'.
+ s := complexityString , ' ' , s.
+ ].
+ "/ icn := icn ? complexityIcon.
+ s := LabelAndIcon icon:complexityIcon string:s.
+ ].
+ ].
+
+ (showMethodInheritance value ? true) ifTrue:[
+ suppressInheritanceInfo ifTrue:[
+ redefIcon := self methodEmptyInheritedIcon.
+ ] ifFalse:[
+ redefIcon := self redefinedOrInheritedIconFor:aMethod.
+ ].
+ ].
+
+ (icn notNil or:[redefIcon notNil]) ifTrue:[
+ "/eXept version
+ "/l := LabelAndIcon icon:redefIcon string:s.
+ "/l image:icn.
+ "/JV:
+ l := LabelAndIcon icon:icn string:s.
+ l image:redefIcon.
+ icn isNil ifTrue:[l offset: 13].
+ l gap:1.
+ ^ l
+ ].
+ ^ s
+
+ "Created: / 22-10-1996 / 19:51:00 / cg"
+ "Modified: / 15-08-2009 / 13:13:32 / Jan Vrany <vranyj1@fel.cvut.cz>"
+ "Modified: / 17-11-2011 / 20:51:18 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 07-03-2012 / 19:06:09 / cg"
+! !
+
+!MethodList methodsFor:'private-watching'!
+
+startWatchProcess
+ updateProcess notNil ifTrue:[
+ ^ self
+ ].
+ updateProcess := [
+ [true] whileTrue:[
+ Delay waitForSeconds:1.
+ self enqueueDelayedUpdateList
+ ]
+ ] fork.
+!
+
+stopWatchProcess
+ |p|
+
+ (p := updateProcess) notNil ifTrue:[
+ updateProcess := nil.
+ p terminate
+ ].
+! !
+
+!MethodList methodsFor:'setup'!
+
+postBuildWith:aBuilder
+ |methodListView|
+
+ super postBuildWith:aBuilder.
+
+ methodListView := aBuilder componentAt:'List'.
+ methodListView notNil ifTrue:[
+ methodListView allowDrag:true.
+ methodListView dragObjectConverter:[:obj |
+ |nm method idx|
+
+ nm := obj theObject asString string string.
+ idx := browserNameList value findFirst:[:item | item string string = nm].
+ method := methodList value at:idx.
+ DropObject newMethod:method.
+ ].
+ ]
+! !
+
+!MethodList class methodsFor:'documentation'!
+
+version
+ ^ '$Header: /cvs/stx/stx/libtool/Tools_MethodList.st,v 1.78 2013-03-26 17:15:45 stefan Exp $'
+!
+
+version_CVS
+ ^ '$Header: /cvs/stx/stx/libtool/Tools_MethodList.st,v 1.78 2013-03-26 17:15:45 stefan Exp $'
+! !
+
--- a/Tools_OrganizerCanvas.st Fri Mar 22 09:22:38 2013 +0000
+++ b/Tools_OrganizerCanvas.st Wed Mar 27 12:24:47 2013 +0000
@@ -4706,9 +4706,12 @@
changedObject == selectedClasses ifTrue:[
selectedClasses value size ~~ 0 ifTrue:[
(orgMode ~~ OrganizerCanvas organizerModeClassHierarchy
- and:[ true "orgMode ~~ OrganizerCanvas organizerModeProject"
- and:[ orgMode ~~ OrganizerCanvas organizerModePackageDiagram ]]) ifTrue:[
- self updateOrganizationFromChangedClass.
+ and:[ orgMode ~~ OrganizerCanvas organizerModePackageDiagram ]) ifTrue:[
+ "/ if the organizerMode is project, avoid clobbering the project selection
+ (orgMode ~~ OrganizerCanvas organizerModeProject
+ or:[ (self selectedProjects value includesAll:( selectedClasses value collect:[:each | each package] )) not ]) ifTrue:[
+ self updateOrganizationFromChangedClass.
+ ].
].
]
].
@@ -5041,10 +5044,10 @@
!OrganizerCanvas class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libtool/Tools_OrganizerCanvas.st,v 1.51 2013-02-08 13:28:53 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libtool/Tools_OrganizerCanvas.st,v 1.52 2013-03-26 16:28:36 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libtool/Tools_OrganizerCanvas.st,v 1.51 2013-02-08 13:28:53 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libtool/Tools_OrganizerCanvas.st,v 1.52 2013-03-26 16:28:36 cg Exp $'
! !
--- a/Tools_ProjectList.st Fri Mar 22 09:22:38 2013 +0000
+++ b/Tools_ProjectList.st Wed Mar 27 12:24:47 2013 +0000
@@ -233,7 +233,8 @@
"/ (self slaveMode value == true)
ifTrue:[
(changedObject == Smalltalk
- or:[ something == #projectOrganization ]) ifTrue:[
+ or:[ something == #projectOrganization ]) ifTrue:[
+ listValid ifFalse:[ ^ self].
listValid := false
].
changedObject == self selectionHolder ifTrue:[
@@ -249,7 +250,7 @@
(changedObject == self selectionHolder) ifTrue:[
self updateSelectionIndexFromSelection.
- self enqueueDelayedUpdateOutputGenerator.
+ "/ self enqueueDelayedUpdateOutputGenerator.
^ self.
].
@@ -286,7 +287,9 @@
changedObject == Smalltalk ifTrue:[
something == #projectOrganization ifTrue:[
self invalidateList.
- self enqueueDelayedUpdateOutputGenerator.
+ slaveMode value == true ifFalse:[
+ self enqueueDelayedUpdateOutputGenerator.
+ ].
^ self.
].
something == #methodInClass ifTrue:[
@@ -358,11 +361,14 @@
"we are not interested in that - get another notification
via the changed valueHolder"
+ self enqueueDelayedUpdateOutputGenerator.
+
"Created: / 17.2.2000 / 23:41:17 / cg"
!
update:something with:aParameter from:changedObject
(self builder isNil or:[self window topView realized not]) ifTrue:[
+ "/ ignore those changes while I am invisible
"/ self makeIndependent.
listValid := false.
selectionIndexValid := false.
@@ -1007,10 +1013,10 @@
!ProjectList class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libtool/Tools_ProjectList.st,v 1.61 2013-03-10 14:22:06 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libtool/Tools_ProjectList.st,v 1.63 2013-03-26 16:29:25 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libtool/Tools_ProjectList.st,v 1.61 2013-03-10 14:22:06 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libtool/Tools_ProjectList.st,v 1.63 2013-03-26 16:29:25 cg Exp $'
! !
--- a/Tools__BreakpointBrowser.st Fri Mar 22 09:22:38 2013 +0000
+++ b/Tools__BreakpointBrowser.st Wed Mar 27 12:24:47 2013 +0000
@@ -16,10 +16,10 @@
ApplicationModel subclass:#BreakpointBrowser
instanceVariableNames:'updatingLabelShown breakpointList shownCopyOfBreakpointList
selectionIndexHolder currentSortColumn currentSortIsReverse
- showHalts showOthers showAssertions showCodeBreakpoints
- showCodeBreakpointsFor showMethodBreakpoints showLineBreakpoints
- showDebugCode codeView infoHolder updateProcess
- showWhichHaltsHolder'
+ showHalts showOthers showAssertions showAssertionsInTests
+ showCodeBreakpoints showCodeBreakpointsFor showMethodBreakpoints
+ showLineBreakpoints showDebugCode codeView infoHolder
+ updateProcess showWhichHaltsHolder'
classVariableNames:'MessagesAndTypes'
poolDictionaries:''
category:'Interface-Smalltalk-Breakpoints'
@@ -32,7 +32,7 @@
privateIn:BreakpointBrowser
!
-BreakpointBrowser::BreakpointListEntry subclass:#BreakpointListEntryForLineBreak
+Tools::BreakpointBrowser::BreakpointListEntry subclass:#BreakpointListEntryForLineBreak
instanceVariableNames:'breakPoint'
classVariableNames:''
poolDictionaries:''
@@ -71,6 +71,7 @@
"
! !
+
!BreakpointBrowser class methodsFor:'initialization'!
defaultListOfMessagesAndTypes
@@ -94,6 +95,7 @@
MessagesAndTypes := self defaultListOfMessagesAndTypes
! !
+
!BreakpointBrowser class methodsFor:'defaults'!
defaultIcon
@@ -102,6 +104,7 @@
^ ToolbarIconLibrary openBreakpointBrowserIcon
! !
+
!BreakpointBrowser class methodsFor:'interface specs'!
windowSpec
@@ -204,6 +207,7 @@
)
! !
+
!BreakpointBrowser class methodsFor:'menu specs'!
itemMenu
@@ -314,6 +318,13 @@
indication: showAssertions
)
(MenuItem
+ enabled: showAssertions
+ label: 'Assertions in Tests'
+ itemValue: showAssertionsInTests:
+ hideMenuOnActivated: false
+ indication: showAssertionsInTests
+ )
+ (MenuItem
label: 'Halts'
itemValue: showHalts:
hideMenuOnActivated: false
@@ -495,6 +506,7 @@
)
! !
+
!BreakpointBrowser class methodsFor:'tableColumns specs'!
tableColumns
@@ -762,6 +774,7 @@
)
! !
+
!BreakpointBrowser methodsFor:'accessing'!
aboutThisApplicationText
@@ -812,6 +825,7 @@
^ updatingLabelShown
! !
+
!BreakpointBrowser methodsFor:'aspects'!
enableAssertions
@@ -883,6 +897,15 @@
self updateShownBreakpointList
!
+showAssertionsInTests
+ ^ showAssertionsInTests ? false
+!
+
+showAssertionsInTests:aBoolean
+ showAssertionsInTests := aBoolean.
+ self updateShownBreakpointList
+!
+
showCodeBreakpoints
^ showCodeBreakpoints ? true
!
@@ -945,6 +968,7 @@
^ showWhichHaltsHolder
! !
+
!BreakpointBrowser methodsFor:'change & update'!
delayedUpdate:something with:aParameter from:changedObject
@@ -985,6 +1009,14 @@
].
self showAssertions ifFalse:[
newList := newList reject:[:entry | entry isAssertion].
+ ] ifTrue:[
+ self showAssertionsInTests ifFalse:[
+ newList := newList reject:[:entry | |cls|
+ entry isAssertion
+ and:[ (entry selector startsWith:'test')
+ and:[ (cls := Smalltalk classNamed: entry className) notNil
+ and:[ cls theNonMetaclass isTestCaseLike ]]]].
+ ].
].
self showHalts ifFalse:[
@@ -1310,6 +1342,7 @@
].
! !
+
!BreakpointBrowser methodsFor:'initialization & release'!
codeViewClass
@@ -1355,6 +1388,7 @@
super release
! !
+
!BreakpointBrowser methodsFor:'menu actions-item'!
browseItem
@@ -1383,6 +1417,7 @@
"Modified: / 18-02-2007 / 12:57:58 / cg"
! !
+
!BreakpointBrowser methodsFor:'menus-dynamic'!
codeBreakpointMenu
@@ -1492,6 +1527,7 @@
"Modified: / 09-09-2012 / 13:11:30 / cg"
! !
+
!BreakpointBrowser methodsFor:'tests'!
aMethodWith_assert
@@ -1555,6 +1591,7 @@
self todo
! !
+
!BreakpointBrowser methodsFor:'user actions'!
browseSelectedItem
@@ -1663,6 +1700,7 @@
self showOthers:(self showOthers not).
! !
+
!BreakpointBrowser::BreakpointListEntry methodsFor:'accessing'!
arg
@@ -1711,6 +1749,7 @@
enabled := enabledArg.
! !
+
!BreakpointBrowser::BreakpointListEntry methodsFor:'actions'!
browse
@@ -1730,6 +1769,7 @@
^ (Smalltalk classNamed:className) compiledMethodAt:selector.
! !
+
!BreakpointBrowser::BreakpointListEntry methodsFor:'testing'!
isAssertion
@@ -1761,6 +1801,7 @@
^ type == #other
! !
+
!BreakpointBrowser::BreakpointListEntryForLineBreak methodsFor:'accessing'!
breakPoint
@@ -1773,6 +1814,7 @@
breakPoint := something.
! !
+
!BreakpointBrowser::MessageArgumentExtractor methodsFor:'accessing'!
callBack:something
@@ -1783,6 +1825,7 @@
selectorToSearch := something.
! !
+
!BreakpointBrowser::MessageArgumentExtractor methodsFor:'visiting'!
acceptMessageNode: aMessageNode
@@ -1833,14 +1876,15 @@
super acceptMessageNode: aMessageNode
! !
+
!BreakpointBrowser class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libtool/Tools__BreakpointBrowser.st,v 1.39 2012-11-04 14:02:58 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libtool/Tools__BreakpointBrowser.st,v 1.40 2013-03-26 00:43:36 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libtool/Tools__BreakpointBrowser.st,v 1.39 2012-11-04 14:02:58 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libtool/Tools__BreakpointBrowser.st,v 1.40 2013-03-26 00:43:36 cg Exp $'
!
version_HG
--- a/Tools__BreakpointService.st Fri Mar 22 09:22:38 2013 +0000
+++ b/Tools__BreakpointService.st Wed Mar 27 12:24:47 2013 +0000
@@ -202,6 +202,11 @@
class := oldMethod mclass.
class isNil ifTrue:[
class := codeView classHolder value.
+ class isNil ifTrue:[
+ self breakPoint:#jv.
+ Dialog warn:'oops - lost the methods''s class'.
+ ^ self.
+ ]
].
selector := oldMethod selector.
@@ -230,21 +235,28 @@
].
(class primAddSelector: selector withMethod:newMethod) ifFalse:[
+ oldMethod mclass:class.
self breakPoint: #cg.
self breakPoint: #jv.
^ self
].
codeView methodHolder value:newMethod.
oldMethod mclass isNil ifTrue:[
+ "/ although this is not strictly true, not doing this
+ "/ would confuse a lot of other tools (such as the browser)
oldMethod mclass:class.
].
+ class changed:#methodTrap with:selector. "/ tell browsers
+ MethodTrapChangeNotificationParameter notNil ifTrue:[
+ Smalltalk changed:#methodTrap with:(MethodTrapChangeNotificationParameter changeClass:class changeSelector:selector).
+ ].
].
"/ self halt.
breakpoints := breakpoints
select:[:bp |
- bp isReached ifFalse:[
- "/ Transcript show:'remove unreached:'; showCR:bp
- ].
+"/ bp isReached ifFalse:[
+"/ "/ Transcript show:'remove unreached:'; showCR:bp
+"/ ].
bp isReached
]
]
@@ -321,7 +333,7 @@
!BreakpointService class methodsFor:'documentation'!
version_CVS
- ^ '$Header: /cvs/stx/stx/libtool/Tools__BreakpointService.st,v 1.17 2012-11-01 14:18:23 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libtool/Tools__BreakpointService.st,v 1.18 2013-03-22 11:38:00 cg Exp $'
!
--- a/Tools__ChangeSetBrowser2.st Fri Mar 22 09:22:38 2013 +0000
+++ b/Tools__ChangeSetBrowser2.st Wed Mar 27 12:24:47 2013 +0000
@@ -89,9 +89,9 @@
compatibility with other tools"
^aStringOrChangeSet isString ifTrue:[
- self onFile: aStringOrChangeSet
+ self onFile: aStringOrChangeSet
] ifFalse:[
- self on: aStringOrChangeSet label: aStringOrChangeSet name
+ self on: aStringOrChangeSet label: aStringOrChangeSet name
]
"Modified: / 21-05-2012 / 13:55:40 / Jan Vrany <jan.vrany@fit.cvut.cz>"
@@ -1418,192 +1418,192 @@
^
#(Menu
- (
- (MenuItem
- label: 'File'
- submenu:
- (Menu
- (
- (MenuItem
- label: 'New'
- submenu:
- (Menu
- (
- (MenuItem
- activeHelpKey: fileNew
- label: 'New Changeset'
- itemValue: doOpenNew
- )
- (MenuItem
- label: 'New Window'
- itemValue: doOpenNewWindow
- )
- )
- nil
- nil
- )
- )
- (MenuItem
- label: '-'
- )
- (MenuItem
- activeHelpKey: fileOpenSelection
- enabled: isWorkingNotHolder
- label: 'Spawn Browser on Selection'
- itemValue: doOpenOnSelection
- isVisible: allowOpenHolder
- )
- (MenuItem
- activeHelpKey: fileOpenSelection
- enabled: isWorkingNotHolder
- label: 'Spawn on Selection'
- itemValue: doOpenOnSelection
- isVisible: allowOpenHolder
- )
- (MenuItem
- label: '-'
- )
- (MenuItem
- activeHelpKey: fileLoad
- enabled: isWorkingNotHolder
- label: 'Open...'
- itemValue: doOpen
- isVisible: allowOpenHolder
- shortcutKey: Ctrlo
- )
- (MenuItem
- activeHelpKey: fileOpenCurrent
- enabled: isWorkingNotHolder
- label: 'Open Current'
- itemValue: doOpenCurrent
- isVisible: allowOpenHolder
- )
- (MenuItem
- activeHelpKey: fileOpenCurrent
- enabled: isWorkingNotHolder
- label: 'Open Cypress Package'
- itemValue: doOpenCypress
- isVisible: allowOpenHolderAndCypressPresent
- )
- (MenuItem
- activeHelpKey: fileSaveAs
- enabled: isWorkingNotHolder
- label: 'Save'
- itemValue: doSave
- )
- (MenuItem
- enabled: isWorkingNotHolder
- label: 'Save As...'
- itemValue: doSaveAs
- )
- (MenuItem
- label: '-'
- )
- (MenuItem
- label: 'Exit'
- itemValue: closeRequest
- )
- )
- nil
- nil
- )
- )
- (MenuItem
- enabled: isWorkingNotHolder
- label: 'Changes'
- isVisible: isTwoColumnHolderNot
- submenuChannel: list1MenuHolder
- )
- (MenuItem
- enabled: isWorkingNotHolder
- label: 'Left'
- isVisible: isTwoColumnHolder
- submenuChannel: list1MenuHolder
- )
- (MenuItem
- enabled: isWorkingNotHolder
- label: 'Right'
- isVisible: isTwoColumnHolder
- submenuChannel: list2MenuHolder
- )
- (MenuItem
- label: 'View'
- submenu:
- (Menu
- (
- (MenuItem
- label: 'List'
- choice: navigatorSpecHolder
- choiceValue: oneColumnNavigatorSpec
- )
- (MenuItem
- label: 'Hierarchical List'
- choice: navigatorSpecHolder
- choiceValue: hierarchicalNavigatorSpec
- )
- (MenuItem
- label: 'Browser Like'
- choice: navigatorSpecHolder
- choiceValue: twoColumnNavigatorSpec
- )
- (MenuItem
- label: '-'
- )
- (MenuItem
- label: 'Show Deleted'
- indication: showRemovedAspect
- )
- (MenuItem
- label: 'Show Same'
- indication: showSameAspect
- )
- (MenuItem
- label: '-'
- )
- (MenuItem
- label: 'Show Filter'
- indication: showFilterHolder
- )
- (MenuItem
- label: '-'
- )
- (MenuItem
- label: 'Show Timestamp'
- indication: showTimestampHolder
- )
- )
- nil
- nil
- )
- )
- (MenuItem
- label: 'Loading'
- submenu:
- (Menu
- (
- (MenuItem
- label: 'Set Target Package...'
- itemValue: setTargetPackage
- )
- (MenuItem
- label: 'Set Target Namespace...'
- itemValue: setTargetNamespace
- )
- (MenuItem
- label: '-'
- )
- (MenuItem
- label: 'Update Changefile'
- indication: updateChangeFileHolder
- )
- )
- nil
- nil
- )
- )
- )
- nil
- nil
+ (
+ (MenuItem
+ label: 'File'
+ submenu:
+ (Menu
+ (
+ (MenuItem
+ label: 'New'
+ submenu:
+ (Menu
+ (
+ (MenuItem
+ activeHelpKey: fileNew
+ label: 'New Changeset'
+ itemValue: doOpenNew
+ )
+ (MenuItem
+ label: 'New Window'
+ itemValue: doOpenNewWindow
+ )
+ )
+ nil
+ nil
+ )
+ )
+ (MenuItem
+ label: '-'
+ )
+ (MenuItem
+ activeHelpKey: fileOpenSelection
+ enabled: isWorkingNotHolder
+ label: 'Spawn Browser on Selection'
+ itemValue: doOpenOnSelection
+ isVisible: allowOpenHolder
+ )
+ (MenuItem
+ activeHelpKey: fileOpenSelection
+ enabled: isWorkingNotHolder
+ label: 'Spawn on Selection'
+ itemValue: doOpenOnSelection
+ isVisible: allowOpenHolder
+ )
+ (MenuItem
+ label: '-'
+ )
+ (MenuItem
+ activeHelpKey: fileLoad
+ enabled: isWorkingNotHolder
+ label: 'Open...'
+ itemValue: doOpen
+ isVisible: allowOpenHolder
+ shortcutKey: Ctrlo
+ )
+ (MenuItem
+ activeHelpKey: fileOpenCurrent
+ enabled: isWorkingNotHolder
+ label: 'Open Current'
+ itemValue: doOpenCurrent
+ isVisible: allowOpenHolder
+ )
+ (MenuItem
+ activeHelpKey: fileOpenCurrent
+ enabled: isWorkingNotHolder
+ label: 'Open Cypress Package'
+ itemValue: doOpenCypress
+ isVisible: allowOpenHolderAndCypressPresent
+ )
+ (MenuItem
+ activeHelpKey: fileSaveAs
+ enabled: isWorkingNotHolder
+ label: 'Save'
+ itemValue: doSave
+ )
+ (MenuItem
+ enabled: isWorkingNotHolder
+ label: 'Save As...'
+ itemValue: doSaveAs
+ )
+ (MenuItem
+ label: '-'
+ )
+ (MenuItem
+ label: 'Exit'
+ itemValue: closeRequest
+ )
+ )
+ nil
+ nil
+ )
+ )
+ (MenuItem
+ enabled: isWorkingNotHolder
+ label: 'Changes'
+ isVisible: isTwoColumnHolderNot
+ submenuChannel: list1MenuHolder
+ )
+ (MenuItem
+ enabled: isWorkingNotHolder
+ label: 'Left'
+ isVisible: isTwoColumnHolder
+ submenuChannel: list1MenuHolder
+ )
+ (MenuItem
+ enabled: isWorkingNotHolder
+ label: 'Right'
+ isVisible: isTwoColumnHolder
+ submenuChannel: list2MenuHolder
+ )
+ (MenuItem
+ label: 'View'
+ submenu:
+ (Menu
+ (
+ (MenuItem
+ label: 'List'
+ choice: navigatorSpecHolder
+ choiceValue: oneColumnNavigatorSpec
+ )
+ (MenuItem
+ label: 'Hierarchical List'
+ choice: navigatorSpecHolder
+ choiceValue: hierarchicalNavigatorSpec
+ )
+ (MenuItem
+ label: 'Browser Like'
+ choice: navigatorSpecHolder
+ choiceValue: twoColumnNavigatorSpec
+ )
+ (MenuItem
+ label: '-'
+ )
+ (MenuItem
+ label: 'Show Deleted'
+ indication: showRemovedAspect
+ )
+ (MenuItem
+ label: 'Show Same'
+ indication: showSameAspect
+ )
+ (MenuItem
+ label: '-'
+ )
+ (MenuItem
+ label: 'Show Filter'
+ indication: showFilterHolder
+ )
+ (MenuItem
+ label: '-'
+ )
+ (MenuItem
+ label: 'Show Timestamp'
+ indication: showTimestampHolder
+ )
+ )
+ nil
+ nil
+ )
+ )
+ (MenuItem
+ label: 'Loading'
+ submenu:
+ (Menu
+ (
+ (MenuItem
+ label: 'Set Target Package...'
+ itemValue: setTargetPackage
+ )
+ (MenuItem
+ label: 'Set Target Namespace...'
+ itemValue: setTargetNamespace
+ )
+ (MenuItem
+ label: '-'
+ )
+ (MenuItem
+ label: 'Update Changefile'
+ indication: updateChangeFileHolder
+ )
+ )
+ nil
+ nil
+ )
+ )
+ )
+ nil
+ nil
)
"Modified: / 27-07-2012 / 21:17:20 / cg"
@@ -2351,7 +2351,9 @@
"Created: / 07-09-2011 / 15:54:03 / cg"
"Created: / 11-02-2012 / 22:40:27 / Jan Vrany <jan.vrany@fit.cvut.cz>"
-! !
+!
+
+ !
!ChangeSetBrowser2 methodsFor:'aspects-queries'!
@@ -2803,6 +2805,12 @@
"Created: / 27-07-2012 / 21:20:44 / cg"
!
+menuUpdate
+ self changesetChanged.
+"/ list1 updateList.
+"/ list2 updateList.
+!
+
setTargetNamespace
"specify an st/x namespace to be used as default"
@@ -3813,11 +3821,11 @@
!ChangeSetBrowser2 class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libtool/Tools__ChangeSetBrowser2.st,v 1.43 2012-12-14 09:09:51 stefan Exp $'
+ ^ '$Header: /cvs/stx/stx/libtool/Tools__ChangeSetBrowser2.st,v 1.44 2013-03-26 00:01:56 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libtool/Tools__ChangeSetBrowser2.st,v 1.43 2012-12-14 09:09:51 stefan Exp $'
+ ^ '$Header: /cvs/stx/stx/libtool/Tools__ChangeSetBrowser2.st,v 1.44 2013-03-26 00:01:56 cg Exp $'
!
version_HG
--- a/Tools__Inspector2.st Fri Mar 22 09:22:38 2013 +0000
+++ b/Tools__Inspector2.st Wed Mar 27 12:24:47 2013 +0000
@@ -644,8 +644,7 @@
openOn: anObject
- self new
- openOn: anObject.
+ ^ self new openOn: anObject.
"Modified: / 17-02-2008 / 10:29:45 / janfrog"
"Modified (format): / 11-07-2011 / 22:28:03 / cg"
@@ -1054,7 +1053,7 @@
!Inspector2::NavigationState class methodsFor:'documentation'!
version
- ^'$Header: /cvs/stx/stx/libtool/Tools__Inspector2.st,v 1.33 2013-02-01 13:20:56 cg Exp $'
+ ^'$Header: /cvs/stx/stx/libtool/Tools__Inspector2.st,v 1.34 2013-03-24 11:42:12 cg Exp $'
!
version_SVN
@@ -1274,11 +1273,11 @@
!Inspector2 class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libtool/Tools__Inspector2.st,v 1.33 2013-02-01 13:20:56 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libtool/Tools__Inspector2.st,v 1.34 2013-03-24 11:42:12 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libtool/Tools__Inspector2.st,v 1.33 2013-02-01 13:20:56 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libtool/Tools__Inspector2.st,v 1.34 2013-03-24 11:42:12 cg Exp $'
!
version_CVS_jvrany
--- a/Tools__NewSystemBrowser.st Fri Mar 22 09:22:38 2013 +0000
+++ b/Tools__NewSystemBrowser.st Wed Mar 27 12:24:47 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
@@ -5453,6 +5459,7 @@
"Modified: / 07-06-2011 / 14:39:04 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
+
!NewSystemBrowser class methodsFor:'interface specs-dialogs'!
repositoryConsistencyDialogSpec
@@ -5710,6 +5717,7 @@
)
! !
+
!NewSystemBrowser class methodsFor:'interface specs-message pane'!
messageInfoSpec
@@ -5822,6 +5830,7 @@
)
! !
+
!NewSystemBrowser class methodsFor:'menu specs'!
browseMenu
@@ -9971,78 +9980,69 @@
<resource: #menu>
- ^
+ ^
#(Menu
(
(MenuItem
enabled: hasProjectSelectedHolder
label: 'File out'
- translateLabel: true
- submenu:
+ submenu:
(Menu
(
(MenuItem
enabled: hasProjectSelectedHolder
label: 'as...'
itemValue: projectMenuFileOutAs
- translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasProjectSelectedAndCanFileOutXMLHolder
label: 'XML as...'
itemValue: projectMenuFileOutXMLAs
- translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasProjectSelectedAndCanFileOutSIFHolder
label: 'SIF as...'
itemValue: projectMenuFileOutSIFAs
- translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
- enabled: hasProjectSelectedAndCanFileOutCypressHolder
- label: 'Cypress as...'
- itemValue: projectMenuFileOutCypressAs
- )
- (MenuItem
+ enabled: hasProjectSelectedAndCanFileOutCypressHolder
+ label: 'Cypress as...'
+ itemValue: projectMenuFileOutCypressAs
+ )
+ (MenuItem
label: '-'
)
(MenuItem
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
@@ -10052,7 +10052,6 @@
enabled: hasProjectSelectedHolder
label: 'Mail To...'
itemValue: projectMenuMailTo
- translateLabel: true
showBusyCursorWhilePerforming: true
)
)
@@ -10062,7 +10061,6 @@
)
(MenuItem
label: 'Repository'
- translateLabel: true
submenuChannel: projectMenuSCMSlice
isMenuSlice: true
)
@@ -10071,15 +10069,13 @@
)
(MenuItem
label: 'Documentation'
- translateLabel: true
- submenu:
+ submenu:
(Menu
(
(MenuItem
enabled: hasSingleRealProjectSelectedHolder
label: 'Generate Project Documentation'
itemValue: projectMenuDocumentation
- translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
@@ -10089,7 +10085,6 @@
enabled: hasOOMPackageLoadedAndSingleRealProjectSelectedHolder
label: 'Metrics Summary Report'
itemValue: projectMenuMetricsSummary
- translateLabel: true
)
)
nil
@@ -10102,27 +10097,23 @@
(MenuItem
enabled: hasProjectSelectedHolder
label: 'Spawn'
- translateLabel: true
- submenu:
+ submenu:
(Menu
(
(MenuItem
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: '-'
@@ -10131,19 +10122,16 @@
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
@@ -10153,7 +10141,6 @@
(MenuItem
enabled: hasProjectSelectedHolder
label: 'Find'
- translateLabel: true
submenuChannel: searchMenu
)
(MenuItem
@@ -10162,19 +10149,16 @@
(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
)
@@ -10182,60 +10166,49 @@
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:
+ submenu:
(Menu
(
(MenuItem
+ label: 'Build with Interactive Application Packager...'
+ itemValue: projectMenuBuildWithApplicationPackager
+ )
+ (MenuItem
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
label: '-'
)
(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
)
)
@@ -10246,27 +10219,23 @@
(MenuItem
enabled: hasProjectSelectedHolder
label: 'Generate'
- translateLabel: true
- submenu:
+ submenu:
(Menu
(
(MenuItem
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
@@ -10277,31 +10246,26 @@
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:
+ submenu:
(Menu
(
(MenuItem
enabled: hasSingleRealProjectSelectedHolder
label: 'Remove from ChangeSet'
itemValue: projectMenuCleanUpChangeSet
- translateLabel: true
)
(MenuItem
label: '-'
@@ -10311,7 +10275,6 @@
enabled: hasSingleRealProjectSelectedHolder
label: 'Make Current Project'
itemValue: projectMenuMakeCurrentProject
- translateLabel: true
isVisible: false
)
)
@@ -10326,7 +10289,6 @@
enabled: hasSingleRealProjectSelectedHolder
label: 'Properties...'
itemValue: projectMenuProperties
- translateLabel: true
)
(MenuItem
label: '-'
@@ -10334,15 +10296,11 @@
(MenuItem
label: 'Update'
itemValue: projectMenuUpdate
- 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
@@ -13037,6 +12995,7 @@
)
! !
+
!NewSystemBrowser class methodsFor:'menu specs-SCM-category'!
categoryMenuSCMCommon
@@ -13421,6 +13380,7 @@
)
! !
+
!NewSystemBrowser class methodsFor:'menu specs-SCM-class'!
classCVSMenu
@@ -15342,6 +15302,7 @@
"Modified: / 28-10-2012 / 11:54:14 / cg"
! !
+
!NewSystemBrowser class methodsFor:'menu specs-SCM-project'!
projectCVSMenu
@@ -16287,6 +16248,7 @@
"Modified: / 24-07-2012 / 17:40:34 / cg"
! !
+
!NewSystemBrowser class methodsFor:'menu specs-SCM-selector'!
selectorMenuCVS
@@ -16655,6 +16617,7 @@
)
! !
+
!NewSystemBrowser class methodsFor:'menu specs-dialogs'!
classesWhichHaveBeenModifiedPopupMenu
@@ -16847,6 +16810,7 @@
"Modified: / 29-09-2006 / 16:11:08 / cg"
! !
+
!NewSystemBrowser class methodsFor:'menu specs-monticello'!
projectMonticelloMenu
@@ -16884,6 +16848,7 @@
)
! !
+
!NewSystemBrowser class methodsFor:'menu specs-popup'!
categoryPopUpMenu
@@ -17029,6 +16994,7 @@
"Created: / 18.2.2000 / 11:58:25 / cg"
! !
+
!NewSystemBrowser class methodsFor:'menu specs-subversion'!
classSubversionMenu
@@ -17292,6 +17258,7 @@
)
! !
+
!NewSystemBrowser class methodsFor:'menu specs-toolbar'!
toolBarMenu
@@ -17610,6 +17577,7 @@
)
! !
+
!NewSystemBrowser class methodsFor:'queries'!
hasSubversionSupport
@@ -17619,6 +17587,7 @@
"Modified: / 19-01-2012 / 10:46:05 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
+
!NewSystemBrowser class methodsFor:'startup'!
browseClass:aClass
@@ -17838,6 +17807,7 @@
"Created: / 06-07-2011 / 18:27:53 / cg"
! !
+
!NewSystemBrowser class methodsFor:'utilities'!
enterBoxTitle:title okText:okText label:label
@@ -17856,6 +17826,7 @@
"Created: / 6.2.2000 / 01:07:11 / cg"
! !
+
!NewSystemBrowser methodsFor:'accessing'!
isEmbeddedBrowser
@@ -17870,6 +17841,7 @@
isEmbedded := aBoolean.
! !
+
!NewSystemBrowser methodsFor:'aspects'!
bookmarkHolder
@@ -18175,6 +18147,7 @@
builder aspectAt:#suppressChangeSetUpdate put:aBoolean
! !
+
!NewSystemBrowser methodsFor:'aspects-environment'!
selectedCategoriesAsEnvironment
@@ -18302,6 +18275,7 @@
"Modified: / 28-02-2012 / 16:28:38 / cg"
! !
+
!NewSystemBrowser methodsFor:'aspects-kludges'!
metaToggle
@@ -18315,6 +18289,7 @@
! !
+
!NewSystemBrowser methodsFor:'aspects-menus'!
categoryMenu
@@ -18512,6 +18487,7 @@
^ self class visitedClassNamesHistory
! !
+
!NewSystemBrowser methodsFor:'aspects-navigation'!
categoryList
@@ -18733,7 +18709,6 @@
! !
-
!NewSystemBrowser methodsFor:'aspects-organization'!
categoryMenuVisible
@@ -19207,6 +19182,7 @@
"Modified: / 18.8.2000 / 19:03:48 / cg"
! !
+
!NewSystemBrowser methodsFor:'aspects-presentation'!
bookmarkBarVisibleHolder
@@ -19664,6 +19640,7 @@
"Created: / 02-07-2011 / 18:27:29 / cg"
! !
+
!NewSystemBrowser methodsFor:'aspects-queries'!
anyBreakOrTracePointsAreSet
@@ -22466,7 +22443,7 @@
self updateInitSharedPoolVisibility.
self updateLaunchApplicationVisibility.
self updateTextEditorBehavior.
- self delayedUpdateCode.
+ "/ self delayedUpdateCode.
"Modified: / 01-06-2012 / 23:01:52 / cg"
!
@@ -23514,6 +23491,7 @@
self navigationState versionDiffApplication:diffApp.
! !
+
!NewSystemBrowser methodsFor:'help specs'!
flyByHelpSpec
@@ -23541,6 +23519,7 @@
^ super flyByHelpTextFor:aComponent
! !
+
!NewSystemBrowser methodsFor:'history'!
addToHistory: class
@@ -23559,6 +23538,7 @@
"Modified: / 02-07-2011 / 18:33:22 / cg"
! !
+
!NewSystemBrowser methodsFor:'menu actions-browse'!
browseImplementorsOf
@@ -25067,8 +25047,11 @@
(i.e. that have a break, trace or watchPoint)"
self
- spawnMethodBrowserForSearch:[ MessageTracer allWrappedMethods ]
- sortBy:#class in:#newBuffer label:'Wrapped methods'
+ spawnMethodBrowserForSearch:[
+ Smalltalk allMethodsForWhich:[:m | m isWrapped or:[m isMethodWithBreakpoints]].
+ ]
+ sortBy:#class in:#newBuffer
+ label:'BreakPointed Methods'
!
browseMenuMethodsWithoutComment
@@ -25587,24 +25570,13 @@
browseMethodsForWhich:checkBlock in:openHow label:aString
|searchBlock|
- searchBlock := [
- |defaultId methods methodsInOrder|
-
- methods := OrderedCollection new.
-
- Smalltalk allMethodsDo:[:mthd |
- (checkBlock value:mthd) ifTrue:[
- methods add:mthd.
- ].
- ].
- methods
- ].
-
- ^ self
- spawnMethodBrowserForSearch:searchBlock
- sortBy:#class
- in:openHow
- label:aString
+ searchBlock := [ Smalltalk allMethodsForWhich:checkBlock ].
+
+ ^ self
+ spawnMethodBrowserForSearch:searchBlock
+ sortBy:#class
+ in:openHow
+ label:aString
!
browseResponseToIt
@@ -25853,6 +25825,7 @@
viewMenuSelectAllClasses
! !
+
!NewSystemBrowser methodsFor:'menu actions-buffers'!
bufferMenuCreateBuffer
@@ -26017,6 +25990,7 @@
"Modified: / 28-02-2012 / 10:22:24 / cg"
! !
+
!NewSystemBrowser methodsFor:'menu actions-category'!
categoryMenuCheckInEach
@@ -26826,6 +26800,7 @@
self spawnCategoryBrowserFor:(self selectedCategoriesValue) in:where
! !
+
!NewSystemBrowser methodsFor:'menu actions-checks-lint'!
foo
@@ -27232,6 +27207,7 @@
"Modified: / 01-03-2012 / 19:52:57 / cg"
! !
+
!NewSystemBrowser methodsFor:'menu actions-checks-old'!
classMenuCheck
@@ -27393,6 +27369,7 @@
"Modified (comment): / 01-03-2012 / 14:10:43 / cg"
! !
+
!NewSystemBrowser methodsFor:'menu actions-class'!
addClassesToRemoveForClass:aClass to:classesToRemove removingSubclasses:removingSubclasses withCancel:withCancel
@@ -32146,6 +32123,7 @@
self classMenuGenerateMultiSetterMethod
! !
+
!NewSystemBrowser methodsFor:'menu actions-class hierarchy'!
classHierarchyMenuSelectWithAllSubclasses
@@ -32198,6 +32176,7 @@
^ self selectedClasses
! !
+
!NewSystemBrowser methodsFor:'menu actions-class packaging'!
excludeClasses: toExclude fromProject:aDefinitionClass using:generator
@@ -32229,6 +32208,7 @@
aDefinitionClass makeClassesAutoloaded:toMakeAutoloaded usingCompiler:generator
! !
+
!NewSystemBrowser methodsFor:'menu actions-class repository'!
allKnownTagsInClasses:aCollectionOfClasses
@@ -34859,6 +34839,7 @@
"Created: / 21-12-2011 / 20:11:25 / cg"
! !
+
!NewSystemBrowser methodsFor:'menu actions-code'!
codeMenuAddClassVariable:newName inClass:aClass asValueHolder:asValueHolder
@@ -36742,6 +36723,7 @@
aTwoArgBlock value:cls value:selector.
! !
+
!NewSystemBrowser methodsFor:'menu actions-debug'!
classMenuClearCoverageInfo
@@ -37375,6 +37357,7 @@
"Modified: / 28-02-2012 / 16:52:45 / cg"
! !
+
!NewSystemBrowser methodsFor:'menu actions-help'!
openClassDocumentation
@@ -37408,6 +37391,7 @@
self updateSpecialCodeEditorVisibility
! !
+
!NewSystemBrowser methodsFor:'menu actions-methodList'!
methodListMenuCheckInClass
@@ -37762,6 +37746,7 @@
"Modified: / 28-02-2012 / 16:53:04 / cg"
! !
+
!NewSystemBrowser methodsFor:'menu actions-other'!
editModeInsert
@@ -37827,6 +37812,7 @@
"Created: / 15-10-2011 / 12:02:26 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
+
!NewSystemBrowser methodsFor:'menu actions-project'!
classMenuCheckInBuildSupportFiles
@@ -38302,47 +38288,47 @@
projectDefinitionClass y defaultProjectType setupDefaultType|
setupDefaultType :=
- [:package |
- |classesInPackage|
-
- classesInPackage := Smalltalk allClassesInPackage:package.
- classesInPackage isEmpty ifTrue:[
- defaultProjectType := LastNewProjectType ? ProjectDefinition guiApplicationType
- ] ifFalse:[
- (classesInPackage contains:[:cls | cls isBrowserStartable]) ifTrue:[
- (classesInPackage contains:[:cls | cls isVisualStartable])
- ifTrue:[ defaultProjectType := ProjectDefinition guiApplicationType]
- ifFalse:[ defaultProjectType := ProjectDefinition nonGuiApplicationType]
- ] ifFalse:[
- defaultProjectType := ProjectDefinition libraryType
- ].
- ]
- ].
+ [:package |
+ |classesInPackage|
+
+ classesInPackage := Smalltalk allClassesInPackage:package.
+ classesInPackage isEmpty ifTrue:[
+ defaultProjectType := LastNewProjectType ? ProjectDefinition guiApplicationType
+ ] ifFalse:[
+ (classesInPackage contains:[:cls | cls isBrowserStartable]) ifTrue:[
+ (classesInPackage contains:[:cls | cls isVisualStartable])
+ ifTrue:[ defaultProjectType := ProjectDefinition guiApplicationType]
+ ifFalse:[ defaultProjectType := ProjectDefinition nonGuiApplicationType]
+ ] ifFalse:[
+ defaultProjectType := ProjectDefinition libraryType
+ ].
+ ]
+ ].
aProjectIDOrNil notNil ifTrue:[
- initial := aProjectIDOrNil.
- boxLabel := 'Create ProjectDefinition Class'.
-
- setupDefaultType value:aProjectIDOrNil.
- ] ifFalse:[
- initial := 'module:directory'.
- currentProject := self theSingleSelectedProject.
- currentProject notNil ifTrue:[
- initial := currentProject.
- (initial includes:$:) ifTrue:[
- (ProjectDefinition definitionClassForPackage:initial) isNil ifTrue:[
- initial := initial , '/','newProject' allBold.
- ].
- ] ifFalse:[
- initial := initial , ':module/','newProject' allBold.
- ].
- ] ifFalse:[
- initial := OperatingSystem getLoginName , ':module/'.'newProject' allBold.
- ].
-
- defaultProjectType := ProjectDefinition defaultProjectType.
- setupDefaultType value:initial.
- boxLabel := 'Create New Project'.
+ initial := aProjectIDOrNil.
+ boxLabel := 'Create ProjectDefinition Class'.
+
+ setupDefaultType value:aProjectIDOrNil.
+ ] ifFalse:[
+ initial := 'module:directory'.
+ currentProject := self theSingleSelectedProject.
+ currentProject notNil ifTrue:[
+ initial := currentProject.
+ (initial includes:$:) ifTrue:[
+ (ProjectDefinition definitionClassForPackage:initial) notNil ifTrue:[
+ initial := initial , '/','newProject' allBold.
+ ].
+ ] ifFalse:[
+ initial := initial , ':module/','newProject' allBold.
+ ].
+ ] ifFalse:[
+ initial := OperatingSystem getLoginName , ':module/'.'newProject' allBold.
+ ].
+
+ defaultProjectType := ProjectDefinition defaultProjectType.
+ setupDefaultType value:initial.
+ boxLabel := 'Create New Project'.
].
packageIDHolder := ValueHolder with:initial.
@@ -38361,11 +38347,11 @@
field := box addInputFieldOn:packageIDHolder tabable:true.
field width:0.7; left:0.3; rightInset:3.
aProjectIDOrNil notNil ifTrue:[
- field readOnly:true.
- ] ifFalse:[
- field acceptOnLeave:true.
- field immediateAccept:true.
- field entryCompletionBlock:(DoWhatIMeanSupport packageNameEntryCompletionBlock).
+ field readOnly:true.
+ ] ifFalse:[
+ field acceptOnLeave:true.
+ field immediateAccept:true.
+ field entryCompletionBlock:(DoWhatIMeanSupport packageNameEntryCompletionBlock).
].
y := box yPosition.
@@ -38385,29 +38371,29 @@
box open.
box accepted ifFalse:[
- ^ nil
+ ^ nil
].
LastNewProjectType := projectTypeHolder value.
self withWaitCursorDo:[
- aProjectIDOrNil notNil ifTrue:[
- newProjectID := aProjectIDOrNil.
- ] ifFalse:[
- newProjectID := packageIDHolder value.
- newProjectID notEmptyOrNil ifTrue:[
- newProjectID := newProjectID string.
- "/ self immediateUpdate value:true.
- self projectListApp addAdditionalProject:newProjectID.
- "/ self immediateUpdate value:false.
- self selectProject:newProjectID.
- self selectedClasses value:#().
- ].
- ].
- projectDefinitionClass := ProjectDefinition
- definitionClassForPackage:newProjectID
- projectType: (projectTypeHolder value)
- createIfAbsent:true.
+ aProjectIDOrNil notNil ifTrue:[
+ newProjectID := aProjectIDOrNil.
+ ] ifFalse:[
+ newProjectID := packageIDHolder value.
+ newProjectID notEmptyOrNil ifTrue:[
+ newProjectID := newProjectID string.
+ "/ self immediateUpdate value:true.
+ self projectListApp addAdditionalProject:newProjectID.
+ "/ self immediateUpdate value:false.
+ self selectProject:newProjectID.
+ self selectedClasses value:#().
+ ].
+ ].
+ projectDefinitionClass := ProjectDefinition
+ definitionClassForPackage:newProjectID
+ projectType: (projectTypeHolder value)
+ createIfAbsent:true.
].
^ projectDefinitionClass
@@ -40328,25 +40314,32 @@
|projects projectsString|
LastLoadedPackages isNil ifTrue:[
- LastLoadedPackages := OrderedCollection new.
+ LastLoadedPackages := OrderedCollection new.
].
projects := self selectedProjects value.
projects isEmptyOrNil ifTrue:[
- projectsString := Dialog
- request:'Load which package(s):'
- initialAnswer:projectsString
- list:LastLoadedPackages.
- projectsString size == 0 ifTrue:[^ self].
- projects := projectsString asCollectionOfWords.
+ projectsString := Dialog
+ request:'Load which package(s):'
+ initialAnswer:projectsString
+ list:LastLoadedPackages.
+ projectsString size == 0 ifTrue:[^ self].
+ projects := projectsString asCollectionOfWords.
].
projects do:[:packageToLoad |
- LastLoadedPackages add:packageToLoad.
- LastLoadedPackages size > 20 ifTrue:[
- LastLoadedPackages removeFirst.
- ].
- Smalltalk loadPackage:packageToLoad
+ LastLoadedPackages add:packageToLoad.
+ LastLoadedPackages size > 20 ifTrue:[
+ LastLoadedPackages removeFirst.
+ ].
+ Smalltalk loadPackage:packageToLoad
+ ].
+
+ "/ any autoloaded?
+ (projects conform:[:packageToLoad | packageToLoad asPackageId projectDefinitionClass hasAllClassesFullyLoaded]) ifFalse:[
+ (Dialog confirm:'Load autoloaded classes now?') ifTrue:[
+ projects do:[:packageToLoad | packageToLoad asPackageId projectDefinitionClass loadAllAutoloadedClasses]
+ ].
].
"Modified: / 14-09-2006 / 17:38:00 / cg"
@@ -41216,6 +41209,7 @@
"Modified: / 23-10-2006 / 11:01:42 / cg"
! !
+
!NewSystemBrowser methodsFor:'menu actions-project-monticello'!
projectMenuMonticelloBrowseRepositories
@@ -41224,6 +41218,7 @@
"Created: / 01-12-2011 / 21:47:24 / cg"
! !
+
!NewSystemBrowser methodsFor:'menu actions-protocol'!
doMoveSelectedProtocolsToProject:newProject
@@ -41958,6 +41953,7 @@
"Modified: / 28-02-2012 / 16:34:54 / cg"
! !
+
!NewSystemBrowser methodsFor:'menu actions-searching'!
askForClassToSearch:doWhatByDefault single:singleClass msgTail:msgTail resources:resourcesOrNil thenDo:aBlock
@@ -42614,6 +42610,7 @@
self findResponseTo:selector in:nil
! !
+
!NewSystemBrowser methodsFor:'menu actions-selector'!
askForClassToMoveOrCopy:doWhat
@@ -46536,6 +46533,7 @@
"Modified: / 28-02-2012 / 16:36:22 / cg"
! !
+
!NewSystemBrowser methodsFor:'menu actions-subversion'!
commonMenuSubversionOpenSettings
@@ -46545,6 +46543,7 @@
"Modified: / 26-03-2010 / 20:01:54 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
+
!NewSystemBrowser methodsFor:'menu actions-subversion-class'!
classMenuSubversionShowRevisionLog
@@ -47936,6 +47935,7 @@
aBlock value:selectedVariable value:isClassVar
! !
+
!NewSystemBrowser methodsFor:'menu-actions-other'!
goBack
@@ -47962,6 +47962,7 @@
"Modified: / 22-02-2008 / 17:18:56 / janfrog"
! !
+
!NewSystemBrowser methodsFor:'menus-dynamic'!
boockmarksMenu
@@ -48588,38 +48589,39 @@
classes := Set new.
self selectedMethodsDo:[:m |
- m literalsDo:[:lit |
- |cls ns|
-
- lit isSymbol ifTrue:[
- (((cls := Smalltalk at:lit) notNil and:[ cls isBehavior ])
- "JV@2011-11-25: Added check if the nameSpace is really a namespace, it may be
- a class if m mclass is a privateClass...
- ---------------------------------------------v"
- or:[ m mclass notNil
- and:[ (ns := m mclass nameSpace) notNil
- and:[ ns isNameSpace
- and:[ ns ~= Smalltalk
- and:[ (cls := ns at:lit) notNil and:[ cls isBehavior ]]]]]])
- ifTrue:[
- classes add:cls
- ]
- ]
- ].
+ m literalsDo:[:lit |
+ |cls ns|
+
+ lit isSymbol ifTrue:[
+ (((cls := Smalltalk at:lit) notNil and:[ cls isBehavior ])
+ "JV@2011-11-25: Added check if the nameSpace is really a namespace, it may be
+ a class if m mclass is a privateClass...
+ ---------------------------------------------v"
+ or:[ m mclass notNil
+ and:[ (ns := m mclass nameSpace) notNil
+ and:[ ns isNameSpace
+ and:[ ns ~= Smalltalk
+ and:[ (cls := ns at:lit) notNil and:[ cls isBehavior ]]]]]])
+ ifTrue:[
+ classes add:cls
+ ]
+ ]
+ ].
].
classes isEmpty ifTrue:[
- ^ nil
+ ^ nil
].
classes := classes asOrderedCollection sort:[:a :b | a name < b name].
m := Menu new.
- classes do:[:each |
- |item|
-
- item := MenuItem label:each name.
- item itemValue:#'spawnBrowserOnClass:' argument:each.
- m addItem:item.
+ classes do:[:eachClass |
+ |item|
+
+ item := MenuItem label:eachClass name.
+ item itemValue:[ self spawnFullBrowserInClass:eachClass selector:nil in:#newBuffer ].
+"/ item itemValue:#'spawnBrowserOnClass:' argument:eachClass.
+ m addItem:item.
].
^ m
@@ -49226,6 +49228,7 @@
"Modified: / 09-09-2012 / 13:24:04 / cg"
! !
+
!NewSystemBrowser methodsFor:'menus-dynamic-SCM'!
categoryMenuSCMFor: sourceCodeManagerClassName
@@ -49707,6 +49710,7 @@
"Created: / 12-10-2011 / 20:28:48 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
+
!NewSystemBrowser methodsFor:'menus-dynamic-subversion'!
commonSubversionBranchMenu
@@ -49739,6 +49743,7 @@
"Modified (format): / 01-12-2011 / 21:06:52 / cg"
! !
+
!NewSystemBrowser methodsFor:'navigation'!
askForClassNameMatching:matchStringArg
@@ -50558,6 +50563,7 @@
"Modified: / 5.2.2000 / 23:07:10 / cg"
! !
+
!NewSystemBrowser methodsFor:'private-buffers'!
removeBuffer:nr
@@ -50609,6 +50615,7 @@
self removeBuffer:(selectedBuffer value)
! !
+
!NewSystemBrowser methodsFor:'private-checks'!
anySpecialEditorModified
@@ -50746,6 +50753,7 @@
^ true
! !
+
!NewSystemBrowser methodsFor:'private-code update'!
autoSearch:aString
@@ -51794,6 +51802,7 @@
"Modified: / 01-12-2011 / 14:26:59 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
+
!NewSystemBrowser methodsFor:'private-dialogs'!
askForDirectoryToFileOut:title default:defaultDirOrNil
@@ -52876,6 +52885,7 @@
cancel: [nil]
! !
+
!NewSystemBrowser methodsFor:'private-helpers'!
anySelectedClass
@@ -54003,6 +54013,7 @@
and:[ (view isSameOrComponentOf:appView) ]
! !
+
!NewSystemBrowser methodsFor:'private-helpers-subApps'!
categoryListApp
@@ -54084,6 +54095,7 @@
"Modified: / 14-02-2012 / 14:00:36 / cg"
! !
+
!NewSystemBrowser methodsFor:'private-presentation'!
asyncShowMethodInfo
@@ -54727,6 +54739,7 @@
]
! !
+
!NewSystemBrowser methodsFor:'private-searching'!
searchCompletionBlock
@@ -54859,6 +54872,7 @@
"Created: / 06-04-2012 / 12:56:10 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
+
!NewSystemBrowser methodsFor:'private-semantic checks'!
checkAcceptedMethod:aMethod inClass:aClass
@@ -55189,6 +55203,7 @@
^ nil.
! !
+
!NewSystemBrowser methodsFor:'private-smalllint'!
smalllintRulesAll
@@ -55223,6 +55238,7 @@
"Created: / 06-09-2012 / 14:49:52 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
+
!NewSystemBrowser methodsFor:'private-syntax coloring'!
startSyntaxHighlightProcess
@@ -55515,6 +55531,7 @@
"Modified: / 08-08-2011 / 15:09:17 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
+
!NewSystemBrowser methodsFor:'setup'!
browserCanvas
@@ -55822,6 +55839,7 @@
self normalLabel.
! !
+
!NewSystemBrowser methodsFor:'special editors'!
specialEditorCanvasForMethod:aMethod
@@ -56068,6 +56086,7 @@
"Modified: / 28-02-2012 / 17:02:07 / cg"
! !
+
!NewSystemBrowser methodsFor:'startup & release'!
closeRequest
@@ -56131,6 +56150,7 @@
"Modified: / 20-11-2006 / 12:16:37 / cg"
! !
+
!NewSystemBrowser methodsFor:'string search tool'!
hideSearchBar
@@ -56209,6 +56229,7 @@
].
! !
+
!NewSystemBrowser methodsFor:'user actions'!
backToLastClass
@@ -57007,6 +57028,7 @@
"Modified: / 28-02-2012 / 16:51:54 / cg"
! !
+
!NewSystemBrowser methodsFor:'user actions-accepting'!
acceptMethod:codeArg inClass:cls language: languageOrNil check:doCheck
@@ -57019,10 +57041,10 @@
code := codeArg asString.
returnValue := false.
language := languageOrNil
- ifNotNil: [languageOrNil]
- ifNil: [self hasMethodSelected
- ifTrue:[self selectedMethodsValue first programmingLanguage]
- ifFalse:[cls programmingLanguage]].
+ ifNotNil: [languageOrNil]
+ ifNil: [self hasMethodSelected
+ ifTrue:[self selectedMethodsValue first programmingLanguage]
+ ifFalse:[cls programmingLanguage]].
"/ a quick parse for the selector, to check if we overwrite an existing method...
newSelector := self selectorOfMethodFromCode:code in:cls.
@@ -57030,36 +57052,36 @@
cat := self protocolToAcceptMethod:newSelector class:cls.
AbortOperationRequest catch:[
- (Class methodRedefinitionNotification) handle:[:ex |
- |answer|
-
- answer := SystemBrowser askForPackageChangeFrom:ex oldPackage to:ex newPackage.
- (answer ~~ #cancel) ifTrue:[
- ex proceedWith:answer
- ].
- ] do:[
- |codeView package oldMethod oldSelector defPackage answer rslt lang wasInstrumented|
-
- "/ used to be
- "/ oldSelector := self theSingleSelectedSelector.
- "/ here; however, with Ruby, a funny selector (fact) instead of fact: is returned...
- wasInstrumented := false.
-
- oldMethod := self theSingleSelectedMethod.
- oldMethod notNil ifTrue:[
- oldSelector := oldMethod selector.
- (oldSelector isNil and:[existingMethod notNil]) ifTrue:[
- "/ wrapped?
- (existingMethod isWrapped or:[existingMethod isMethodWithBreakpoints]) ifTrue:[
- oldSelector := existingMethod selector
- ].
- ].
- wasInstrumented := oldMethod isInstrumented.
- ].
-
- "/ check for overwritten version method
- (cls isMeta and:[(AbstractSourceCodeManager isVersionMethodSelector:newSelector)]) ifTrue:[
- (self confirm:'ATTENTION: you are about to accept the classes version method.
+ (Class methodRedefinitionNotification) handle:[:ex |
+ |answer|
+
+ answer := SystemBrowser askForPackageChangeFrom:ex oldPackage to:ex newPackage.
+ (answer ~~ #cancel) ifTrue:[
+ ex proceedWith:answer
+ ].
+ ] do:[
+ |codeView package oldMethod oldSelector defPackage answer rslt lang wasInstrumented|
+
+ "/ used to be
+ "/ oldSelector := self theSingleSelectedSelector.
+ "/ here; however, with Ruby, a funny selector (fact) instead of fact: is returned...
+ wasInstrumented := false.
+
+ oldMethod := self theSingleSelectedMethod.
+ oldMethod notNil ifTrue:[
+ oldSelector := oldMethod selector.
+ (oldSelector isNil and:[existingMethod notNil]) ifTrue:[
+ "/ wrapped/unwrapped?
+ true "(existingMethod isWrapped or:[existingMethod isMethodWithBreakpoints])" ifTrue:[
+ oldSelector := existingMethod selector
+ ]
+ ].
+ wasInstrumented := oldMethod isInstrumented.
+ ].
+
+ "/ check for overwritten version method
+ (cls isMeta and:[(AbstractSourceCodeManager isVersionMethodSelector:newSelector)]) ifTrue:[
+ (self confirm:'ATTENTION: you are about to accept the classes version method.
This method is required by the sourceCodeManager and should correctly return
the classes version as present in the source repository.
An incorrect version method may lead to failures when accessing/showing/changing
@@ -57067,239 +57089,239 @@
You have been warned.
Accept anyway ?')
- ifFalse:[
- ^ false
- ]
- ] ifFalse:[
- "/ check if accepting a different selector than the selected one,
- "/ and a method for the new selector exists.
- (existingMethod notNil and:[oldSelector ~= newSelector]) ifTrue:[
- "/ seems to be the same selector; however, we must really compile to see if it is not going
- "/ to end up in another namespace. In that case, we give a different warning message.
- Parser parseErrorSignal catch:[
- rslt := language compilerClass
- compile:code
- forClass:cls
- inCategory:cat
- notifying:nil
- install:false.
- ].
- (rslt notNil and:[ rslt nameSpace notNil ]) ifTrue:[
- newSelector := (':',rslt nameSpace name,'::',newSelector) asSymbol.
- existingMethod := cls compiledMethodAt:newSelector.
- ].
- ].
- (existingMethod notNil and:[oldSelector ~= newSelector]) ifTrue:[
- answer := OptionBox
- request:('You are about to overwrite an existing method.\\Accept anyway ?' withCRs)
- label:(resources string:'Attention')
- image:(WarningBox iconBitmap)
- buttonLabels:(resources array:#('Cancel' 'Compare' 'Yes'))
- values:#(false #compare true)
- default:false
- onCancel:false.
-
- answer == false ifTrue:[ ^ false ].
- answer == #compare ifTrue:[
- self openDiffViewForText:code againstSourceOfMethod:existingMethod.
- ^ false
- ].
- ]
- ].
-
- codeView := self codeView.
- codeView cursorMovementWhenUpdating:nil.
- codeView scrollWhenUpdating:nil.
-
- existingMethod notNil ifTrue:[
- "keep old package if selector does already exist in class"
- package := existingMethod package.
- ] ifFalse:[
- cls theNonMetaclass canHaveExtensions ifFalse:[
- defPackage := package := cls package.
- ] ifTrue:[
- defPackage := Class packageQuerySignal query.
- ].
-
- "/ if in project-mode,
- "/ assign the currently selected packageID (or ask, if there is none or multiple)
- "/ otherwise, use the current project
-
- (navigationState isProjectBrowser
- or:[navigationState organizerMode value == OrganizerCanvas organizerModeProject])
- ifTrue:[
- cls theNonMetaclass canHaveExtensions ifTrue:[
- package := self theSingleSelectedProject.
- ].
- package isNil ifTrue:[
- package := self
- askForProject:'Method shall be assigned to which project ?'
- initialText:(LastAcceptPackage ? cls package).
- package isNil ifTrue:[^ false].
- LastAcceptPackage := package.
- ] ifFalse:[
- package := package asSymbol.
- "/ if the current project is different from the selected one
- package ~= defPackage ifTrue:[
- "/ and the current project is not the default project
- (defPackage = PackageId noProjectID) ifFalse:[
- "/ ask
- package := self
- askForProject:('The browsers selected project is ''%1''\however, your currently active (default) project is ''%2''.\\To which project shall the method be assigned ?'
- bindWith:package allBold with:defPackage allBold) withCRs
- initialText:package.
- package isNil ifTrue:[^ false].
- LastAcceptPackage := package.
- ]
- ]
- ].
- ].
- package isNil ifTrue:[ package := defPackage ].
- ].
-
- lang := oldMethod notNil
- ifTrue:[ oldMethod programmingLanguage ]
- ifFalse:[ cls programmingLanguage ].
-
- "/ notice: when compiling, the classes change message will already
- "/ be noticed by the methodList and lead to an update
- "/ to be enqueued.
-
- [
- |codeCritics|
-
- "/ cg: for now, only smalltalk critics is possible...
- (self enforceCodeStyle and:[lang isSmalltalk]) ifTrue:[
- codeCritics := CodeCritics checkCodeQuality:code.
- codeCritics notNil ifTrue:[
- codeCritics do:[:eachCritic |
- codeView
- highlightingErrorLine:(eachCritic key)
- do:[
- Dialog
- warn:(resources
- stringWithCRs:'Ugly code warning\\ %1\\Please beautify.'
- with:eachCritic value allBold).
- ].
- ].
- ].
- ].
- self enforceComment ifTrue:[
- "/ allow simple getters, setters, basicNew etc...
- "/ should be coupled with a metric
- code asCollectionOfLines size > 3 ifTrue:[
- (lang parserClass methodCommentFromSource:code) isEmptyOrNil ifTrue:[
- Dialog warn:(resources stringWithCRs:'Bad style: please add a method comment.')
- ].
- ].
- ].
-
- "/ do not react on the methodSelectionChanged notification
- "/ (which is enforced by the methodList)
- self selectedMethods retractInterestsFor:self.
- "/ self immediateUpdate value:true.
-
- "/ Transcript showCR:'accepting in package: ', (package ? '__NoPackage__').
- Class packageQuerySignal answer:package do:[ |change|
- ClassDescription updateHistoryLineQuerySignal answer:true do:[
- (ClassDescription updateChangeFileQuerySignal
- , ClassDescription updateChangeListQuerySignal) answer:self suppressChangeSetUpdate not
- do:[
+ ifFalse:[
+ ^ false
+ ]
+ ] ifFalse:[
+ "/ check if accepting a different selector than the selected one,
+ "/ and a method for the new selector exists.
+ (existingMethod notNil and:[oldSelector ~= newSelector]) ifTrue:[
+ "/ seems to be the same selector; however, we must really compile to see if it is not going
+ "/ to end up in another namespace. In that case, we give a different warning message.
+ Parser parseErrorSignal catch:[
+ rslt := language compilerClass
+ compile:code
+ forClass:cls
+ inCategory:cat
+ notifying:nil
+ install:false.
+ ].
+ (rslt notNil and:[ rslt nameSpace notNil ]) ifTrue:[
+ newSelector := (':',rslt nameSpace name,'::',newSelector) asSymbol.
+ existingMethod := cls compiledMethodAt:newSelector.
+ ].
+ ].
+ (existingMethod notNil and:[oldSelector ~= newSelector]) ifTrue:[
+ answer := OptionBox
+ request:('You are about to overwrite an existing method.\\Accept anyway ?' withCRs)
+ label:(resources string:'Attention')
+ image:(WarningBox iconBitmap)
+ buttonLabels:(resources array:#('Cancel' 'Compare' 'Yes'))
+ values:#(false #compare true)
+ default:false
+ onCancel:false.
+
+ answer == false ifTrue:[ ^ false ].
+ answer == #compare ifTrue:[
+ self openDiffViewForText:code againstSourceOfMethod:existingMethod.
+ ^ false
+ ].
+ ]
+ ].
+
+ codeView := self codeView.
+ codeView cursorMovementWhenUpdating:nil.
+ codeView scrollWhenUpdating:nil.
+
+ existingMethod notNil ifTrue:[
+ "keep old package if selector does already exist in class"
+ package := existingMethod package.
+ ] ifFalse:[
+ cls theNonMetaclass canHaveExtensions ifFalse:[
+ defPackage := package := cls package.
+ ] ifTrue:[
+ defPackage := Class packageQuerySignal query.
+ ].
+
+ "/ if in project-mode,
+ "/ assign the currently selected packageID (or ask, if there is none or multiple)
+ "/ otherwise, use the current project
+
+ (navigationState isProjectBrowser
+ or:[navigationState organizerMode value == OrganizerCanvas organizerModeProject])
+ ifTrue:[
+ cls theNonMetaclass canHaveExtensions ifTrue:[
+ package := self theSingleSelectedProject.
+ ].
+ package isNil ifTrue:[
+ package := self
+ askForProject:'Method shall be assigned to which project ?'
+ initialText:(LastAcceptPackage ? cls package).
+ package isNil ifTrue:[^ false].
+ LastAcceptPackage := package.
+ ] ifFalse:[
+ package := package asSymbol.
+ "/ if the current project is different from the selected one
+ package ~= defPackage ifTrue:[
+ "/ and the current project is not the default project
+ (defPackage = PackageId noProjectID) ifFalse:[
+ "/ ask
+ package := self
+ askForProject:('The browsers selected project is ''%1''\however, your currently active (default) project is ''%2''.\\To which project shall the method be assigned ?'
+ bindWith:package allBold with:defPackage allBold) withCRs
+ initialText:package.
+ package isNil ifTrue:[^ false].
+ LastAcceptPackage := package.
+ ]
+ ]
+ ].
+ ].
+ package isNil ifTrue:[ package := defPackage ].
+ ].
+
+ lang := oldMethod notNil
+ ifTrue:[ oldMethod programmingLanguage ]
+ ifFalse:[ cls programmingLanguage ].
+
+ "/ notice: when compiling, the classes change message will already
+ "/ be noticed by the methodList and lead to an update
+ "/ to be enqueued.
+
+ [
+ |codeCritics|
+
+ "/ cg: for now, only smalltalk critics is possible...
+ (self enforceCodeStyle and:[lang isSmalltalk]) ifTrue:[
+ codeCritics := CodeCritics checkCodeQuality:code.
+ codeCritics notNil ifTrue:[
+ codeCritics do:[:eachCritic |
+ codeView
+ highlightingErrorLine:(eachCritic key)
+ do:[
+ Dialog
+ warn:(resources
+ stringWithCRs:'Ugly code warning\\ %1\\Please beautify.'
+ with:eachCritic value allBold).
+ ].
+ ].
+ ].
+ ].
+ self enforceComment ifTrue:[
+ "/ allow simple getters, setters, basicNew etc...
+ "/ should be coupled with a metric
+ code asCollectionOfLines size > 3 ifTrue:[
+ (lang parserClass methodCommentFromSource:code) isEmptyOrNil ifTrue:[
+ Dialog warn:(resources stringWithCRs:'Bad style: please add a method comment.')
+ ].
+ ].
+ ].
+
+ "/ do not react on the methodSelectionChanged notification
+ "/ (which is enforced by the methodList)
+ self selectedMethods retractInterestsFor:self.
+ "/ self immediateUpdate value:true.
+
+ "/ Transcript showCR:'accepting in package: ', (package ? '__NoPackage__').
+ Class packageQuerySignal answer:package do:[ |change|
+ ClassDescription updateHistoryLineQuerySignal answer:true do:[
+ (ClassDescription updateChangeFileQuerySignal
+ , ClassDescription updateChangeListQuerySignal) answer:self suppressChangeSetUpdate not
+ do:[
Class nameSpaceQuerySignal
answer:(self currentNamespace)
do:[
- ("self canUseRefactoringSupport"
- language isSmalltalk
- and:[(Smalltalk at:cls theNonMetaclass name)==cls
- and:[cls programmingLanguage == language
- and:[InteractiveAddMethodChange notNil]]]
- ) ifTrue:[
- "/ cg: Q: is the AddMethodChange prepared for languages ?
- change := InteractiveAddMethodChange compile:code in:cls classified:cat.
- change controller:codeView.
- "/ change named:('Accept method ' , newSelector ? '???').
-
- RefactoryChangeManager performChange: change.
- rslt := cls compiledMethodAt:newSelector.
- ] ifFalse:[
- rslt := language compilerClass
- compile:code
- forClass:cls
- inCategory:cat
- notifying:codeView
- install:true.
- ].
- wasInstrumented ifTrue:[
- rslt := InstrumentingCompiler
- compile:code
- forClass:cls
- inCategory:cat
- notifying:nil
- install:true.
- ].
+ ("self canUseRefactoringSupport"
+ language isSmalltalk
+ and:[(Smalltalk at:cls theNonMetaclass name)==cls
+ and:[cls programmingLanguage == language
+ and:[InteractiveAddMethodChange notNil]]]
+ ) ifTrue:[
+ "/ cg: Q: is the AddMethodChange prepared for languages ?
+ change := InteractiveAddMethodChange compile:code in:cls classified:cat.
+ change controller:codeView.
+ "/ change named:('Accept method ' , newSelector ? '???').
+
+ RefactoryChangeManager performChange: change.
+ rslt := cls compiledMethodAt:newSelector.
+ ] ifFalse:[
+ rslt := language compilerClass
+ compile:code
+ forClass:cls
+ inCategory:cat
+ notifying:codeView
+ install:true.
+ ].
+ wasInstrumented ifTrue:[
+ rslt := InstrumentingCompiler
+ compile:code
+ forClass:cls
+ inCategory:cat
+ notifying:nil
+ install:true.
+ ].
].
- ].
- ].
- ].
-
-
- "/ give subcanvases a chance to synchronize ...
-
- "/ self immediateUpdate value:true.
-
- rslt isMethod ifTrue:[
+ ].
+ ].
+ ].
+
+
+ "/ give subcanvases a chance to synchronize ...
+
+ "/ self immediateUpdate value:true.
+
+ rslt isMethod ifTrue:[
"/ rslt resourceType == #image ifTrue:[
"/ Icon flushCachedIcons
"/ ].
- rslt package. "/ sigh: has side effect of setting the instvar in the method (is this needed?)
- navigationState realModifiedState:false.
- codeView modified:false.
-
- "/ immediateUpdate value:true.
- "/ self switchToSelector:rslt selector.
-
- codeView cursorMovementWhenUpdating:nil.
- codeView scrollWhenUpdating:nil.
- codeView setSearchPattern:nil.
- lastMethodCategory := rslt category.
-
- (self selectedProtocolsValue contains:[:p | p string = lastMethodCategory]) ifFalse:[
- (self selectedProtocolsValue includes:BrowserList nameListEntryForALL) ifFalse:[
- "/ self selectedProtocols setValue:(Array with:rslt category).
- self selectProtocols:(Array with:lastMethodCategory).
- ]
- ].
-
- oldSelector ~= rslt selector ifTrue:[
- self selectedMethods value:(Array with:rslt).
- "/ self switchToSelector:rslt selector
- ] ifFalse:[
+ rslt package. "/ sigh: has side effect of setting the instvar in the method (is this needed?)
+ navigationState realModifiedState:false.
+ codeView modified:false.
+
+ "/ immediateUpdate value:true.
+ "/ self switchToSelector:rslt selector.
+
+ codeView cursorMovementWhenUpdating:nil.
+ codeView scrollWhenUpdating:nil.
+ codeView setSearchPattern:nil.
+ lastMethodCategory := rslt category.
+
+ (self selectedProtocolsValue contains:[:p | p string = lastMethodCategory]) ifFalse:[
+ (self selectedProtocolsValue includes:BrowserList nameListEntryForALL) ifFalse:[
+ "/ self selectedProtocols setValue:(Array with:rslt category).
+ self selectProtocols:(Array with:lastMethodCategory).
+ ]
+ ].
+
+ oldSelector ~= rslt selector ifTrue:[
+ self selectedMethods value:(Array with:rslt).
+ "/ self switchToSelector:rslt selector
+ ] ifFalse:[
"/ "/ do not notify myself (to avoid scroll-to-top)
"/
"/ self selectedMethods value:(Array with:rslt).
- ].
+ ].
"/ self showMethodsCode:rslt scrollToTop:false.
"/ self selectedMethods setValue:(Array with:rslt).
"/ self switchToClass:cls selector:rslt selector.
- "/ immediateUpdate value:false.
- doCheck ifTrue:[
- self checkAcceptedMethod:rslt inClass:cls.
- ].
+ "/ immediateUpdate value:false.
+ doCheck ifTrue:[
+ self checkAcceptedMethod:rslt inClass:cls.
+ ].
"/ wasInstrumented ifTrue:[
"/ self recompileMethodWithInstrumentation:rslt.
"/ ].
- returnValue := true.
- "/ self updateBufferLabel.
- ].
- ] ensure:[
- "/ do again react on the methodSelectionChanged notification
- self selectedMethods onChangeSend:#methodsSelectionChanged to:self.
- "/ self immediateUpdate value:false.
- ].
- ]
+ returnValue := true.
+ "/ self updateBufferLabel.
+ ].
+ ] ensure:[
+ "/ do again react on the methodSelectionChanged notification
+ self selectedMethods onChangeSend:#methodsSelectionChanged to:self.
+ "/ self immediateUpdate value:false.
+ ].
+ ]
].
^ returnValue.
@@ -57466,7 +57488,7 @@
"tell the codeView what to do on accept.
Return false, if NOT accepted (i.e. compilation canceled).
Ouch: this shares a lot of duplicate code with setAcceptActionForClass;
- please refacor"
+ please refacor"
|codeView returnValue package|
@@ -57477,121 +57499,121 @@
codeView modified:false.
self withExecuteCursorDo:[
- |currentCategory currentClass ns|
-
- currentClass := self theSingleSelectedClass.
- currentClass notNil ifTrue:[
- ns := currentClass nameSpace
- ] ifFalse:[
- ns := nil
- ].
- ns := nil. "/ experimental - needed for JS parsing; is it still needed for ST ?
-
- currentCategory := self theSingleSelectedCategory.
- currentCategory isNil ifTrue:[
- currentClass notNil ifTrue:[
- currentCategory := currentClass category
- ]
- ].
-
- self organizerMode value == OrganizerCanvas organizerModeProject ifTrue:[
- currentClass notNil ifTrue:[
- package := currentClass package.
- ] ifFalse:[
- package := self theSingleSelectedProject.
- ].
- package isNil ifTrue:[
- package := Dialog request:'Add to which project ?'.
- package size == 0 ifTrue:[^ self].
- ].
- package := package asSymbol.
- ] ifFalse:[
- package := Class packageQuerySignal query.
- ].
-
- Class classCategoryQuerySignal answer:(currentCategory ? '* as yet unspecified *')
- do:[
- Class packageQuerySignal answer:package
- do:[
- Class nameSpaceQuerySignal handle:[:ex |
- ns isNil ifTrue:[
- ex reject
- ].
- ex proceedWith:ns
- ] do:[
- AbortOperationRequest catch:[
- UndefinedObject createMinimumProtocolInNewSubclassQuery
- answer:true
- do:[
- (Class classRedefinitionNotification) handle:[:ex |
- |answer|
+ |currentCategory currentClass ns|
+
+ currentClass := self theSingleSelectedClass.
+ currentClass notNil ifTrue:[
+ ns := currentClass nameSpace
+ ] ifFalse:[
+ ns := nil
+ ].
+ ns := nil. "/ experimental - needed for JS parsing; is it still needed for ST ?
+
+ currentCategory := self theSingleSelectedCategory.
+ currentCategory isNil ifTrue:[
+ currentClass notNil ifTrue:[
+ currentCategory := currentClass category
+ ]
+ ].
+
+ self organizerMode value == OrganizerCanvas organizerModeProject ifTrue:[
+ currentClass notNil ifTrue:[
+ package := currentClass package.
+ ] ifFalse:[
+ package := self theSingleSelectedProject.
+ ].
+ package isNil ifTrue:[
+ package := Dialog request:'Add to which project ?'.
+ package size == 0 ifTrue:[^ self].
+ ].
+ package := package asSymbol.
+ ] ifFalse:[
+ package := Class packageQuerySignal query.
+ ].
+
+ Class classCategoryQuerySignal answer:(currentCategory ? '* as yet unspecified *')
+ do:[
+ Class packageQuerySignal answer:package
+ do:[
+ Class nameSpaceQuerySignal handle:[:ex |
+ ns isNil ifTrue:[
+ ex reject
+ ].
+ ex proceedWith:ns
+ ] do:[
+ AbortOperationRequest catch:[
+ UndefinedObject createMinimumProtocolInNewSubclassQuery
+ answer:true
+ do:[
+ (Class classRedefinitionNotification) handle:[:ex |
+ |answer|
"/ cg: now always keep the old packageID
- Class catchClassRedefinitions ifFalse:[
- ex proceedWith:#keep
- ].
- answer := OptionBox
- request:
+ Class catchClassRedefinitions ifFalse:[
+ ex proceedWith:#keep
+ ].
+ answer := OptionBox
+ request:
('You are about to change the definition of a class from another (system-) package.
The class is part of the ''%1'' package.
PS: you can disable this check in the launchers settings-compilation dialog.'
- bindWith:(ex oldPackage allBold))
-
- label:'Class redefinition'
- image:(WarningBox iconBitmap)
- buttonLabels:#('Cancel' 'Continue')
- values:#(#cancel #keep)
- default:#keep
- onCancel:#cancel.
-
- (answer ~~ #cancel) ifTrue:[
- ex proceedWith:answer
- ]
- ] do:[
- |rslt cls mcls|
-
- self immediateUpdate value:true.
- navigationState realModifiedState:false.
- navigationState modified:false.
-
- ClassDescription updateHistoryLineQuerySignal answer:true do:[
- (ClassDescription updateChangeFileQuerySignal
- , ClassDescription updateChangeListQuerySignal) answer:self suppressChangeSetUpdate not
- do:[
- thisIsAFullClassesCode ifTrue:[
- rslt := (ReadStream on:theCode asString) fileIn.
- ] ifFalse:[
- ClassBuildError handle:[:ex |
- self warn:ex description
- ] do:[
- rslt := (aCompilerClass ? Compiler)
- evaluate:theCode asString string
- notifying:codeView
- compile:false.
-
- ].
- ].
- ].
- ].
- self immediateUpdate value:false.
-
- rslt isBehavior ifTrue:[
- self switchToClass:rslt.
- "/ self switchToClassNamed:rslt name.
- returnValue := true.
- ].
-
- returnValue ifTrue:[
- cls := rslt theNonMetaclass.
- mcls := rslt theMetaclass.
- self askForInitialApplicationCodeFor:mcls.
- ].
- ]
- ]
- ].
- ].
- ].
+ bindWith:(ex oldPackage allBold))
+
+ label:'Class redefinition'
+ image:(WarningBox iconBitmap)
+ buttonLabels:#('Cancel' 'Continue')
+ values:#(#cancel #keep)
+ default:#keep
+ onCancel:#cancel.
+
+ (answer ~~ #cancel) ifTrue:[
+ ex proceedWith:answer
+ ]
+ ] do:[
+ |rslt cls mcls|
+
+ "/ self immediateUpdate value:true.
+ navigationState realModifiedState:false.
+ navigationState modified:false.
+
+ ClassDescription updateHistoryLineQuerySignal answer:true do:[
+ (ClassDescription updateChangeFileQuerySignal
+ , ClassDescription updateChangeListQuerySignal) answer:self suppressChangeSetUpdate not
+ do:[
+ thisIsAFullClassesCode ifTrue:[
+ rslt := (ReadStream on:theCode asString) fileIn.
+ ] ifFalse:[
+ ClassBuildError handle:[:ex |
+ self warn:ex description
+ ] do:[
+ rslt := (aCompilerClass ? Compiler)
+ evaluate:theCode asString string
+ notifying:codeView
+ compile:false.
+
+ ].
+ ].
+ ].
+ ].
+ "/ self immediateUpdate value:false.
+
+ rslt isBehavior ifTrue:[
+ self switchToClass:rslt.
+ "/ self switchToClassNamed:rslt name.
+ returnValue := true.
+ ].
+
+ returnValue ifTrue:[
+ cls := rslt theNonMetaclass.
+ mcls := rslt theMetaclass.
+ self askForInitialApplicationCodeFor:mcls.
+ ].
+ ]
+ ]
+ ].
+ ].
+ ].
]
].
@@ -58109,6 +58131,7 @@
self setAcceptAction:[:code | self codeView flash].
! !
+
!NewSystemBrowser methodsFor:'user actions-class'!
classLoad
@@ -58256,6 +58279,7 @@
"Modified: / 12-09-2006 / 13:48:12 / cg"
! !
+
!NewSystemBrowser methodsFor:'user actions-comparing'!
doCompareIn:aNavigationState
@@ -58326,6 +58350,7 @@
"Modified: / 27-07-2012 / 22:25:17 / cg"
! !
+
!NewSystemBrowser methodsFor:'user actions-events'!
keyInCategoryListView:key rawKey:rawKey
@@ -58696,6 +58721,7 @@
"Modified: / 17-08-2011 / 13:29:24 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
+
!NewSystemBrowser methodsFor:'user actions-helpers'!
hideMessagePane
@@ -58862,6 +58888,7 @@
"Modified: / 15-05-2012 / 10:46:06 / cg"
! !
+
!NewSystemBrowser methodsFor:'user actions-profiler'!
spawnProfilerStatistics:statistics in: where
@@ -58878,6 +58905,7 @@
"Modified (format): / 29-11-2011 / 14:49:08 / cg"
! !
+
!NewSystemBrowser::ClassCompletionEntry methodsFor:'accessing'!
klass
@@ -58896,6 +58924,7 @@
showPrefix := something.
! !
+
!NewSystemBrowser::ClassCompletionEntry methodsFor:'converting'!
asString
@@ -58908,6 +58937,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
@@ -58958,6 +58988,7 @@
"Created: / 20-04-2012 / 18:19:46 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
+
!NewSystemBrowser::ClassCompletionEntry methodsFor:'printing & storing'!
printOn:aStream
@@ -58971,14 +59002,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.1843 2013-03-21 18:58:38 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libtool/Tools__NewSystemBrowser.st,v 1.1849 2013-03-26 16:30:13 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libtool/Tools__NewSystemBrowser.st,v 1.1843 2013-03-21 18:58:38 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libtool/Tools__NewSystemBrowser.st,v 1.1849 2013-03-26 16:30:13 cg Exp $'
!
version_HG
--- a/VersionDiffBrowser.st Fri Mar 22 09:22:38 2013 +0000
+++ b/VersionDiffBrowser.st Wed Mar 27 12:24:47 2013 +0000
@@ -69,6 +69,7 @@
! !
+
!VersionDiffBrowser class methodsFor:'interface specs'!
windowSpec
@@ -282,6 +283,7 @@
)
! !
+
!VersionDiffBrowser class methodsFor:'menu specs'!
mainMenu
@@ -552,6 +554,7 @@
"Modified: / 31-08-2007 / 14:16:39 / cg"
! !
+
!VersionDiffBrowser class methodsFor:'plugIn spec'!
aspectSelectors
@@ -573,6 +576,7 @@
! !
+
!VersionDiffBrowser class methodsFor:'startup'!
openOnClass:aClass againstVersion:aVersionA
@@ -795,6 +799,7 @@
"
! !
+
!VersionDiffBrowser methodsFor:'accessing'!
canIncludeExtensions:something
@@ -953,6 +958,7 @@
^ classChangeSet labelB
! !
+
!VersionDiffBrowser methodsFor:'actions'!
acceptInLeftView
@@ -1041,64 +1047,17 @@
].
].
self diffTextView
- text1:(changeA prettyPrintedSource) text2:(changeB prettyPrintedSource);
- moveToNextChanged
+ text1:(changeA prettyPrintedSource)
+ text2:(changeB prettyPrintedSource)
].
self showDiffTextView.
+ self diffTextView moveToNextChanged
]
"Modified: / 03-09-1999 / 15:01:30 / ps"
"Modified: / 17-07-2012 / 18:27:06 / cg"
!
-methodsOnlyInASelectionChanged
- "
- the selection in the list of the 'method only in version A' changed.
- Reset the selection of the two other lists and show the method in
- the text view.
-
- <return: self>
- "
- |change sel|
-
- self infoHolder value:''.
-
- sel := self methodsOnlyInASelection value.
- sel notNil ifTrue:[
- self methodsOnlyInBSelection value:nil.
- self methodsChangedSelection value:nil.
- change := methodsOnlyInAFiltered "self changeSetA" at:sel.
- self methodText value:(change prettyPrintedSource).
- self showSingleTextView.
- ]
-
- "Modified: / 17-07-2012 / 18:31:22 / cg"
-!
-
-methodsOnlyInBSelectionChanged
- "
- the selection in the list of the 'method only in version B' changed.
- Reset the selection of the two other lists and show the method in
- the text view.
-
- <return: self>
- "
- |change sel|
-
- self infoHolder value:''.
-
- sel := self methodsOnlyInBSelection value.
- sel notNil ifTrue:[
- self methodsOnlyInASelection value:nil.
- self methodsChangedSelection value:nil.
- change := methodsOnlyInBFiltered "self changeSetB" at:sel.
- self methodText value:(change prettyPrintedSource).
- self showSingleTextView.
- ]
-
- "Modified: / 17-07-2012 / 18:31:32 / cg"
-!
-
removeSelectedChangeInBFromImage
|change cls sel op|
@@ -1119,6 +1078,7 @@
"Modified: / 15-08-2010 / 21:35:00 / cg"
! !
+
!VersionDiffBrowser methodsFor:'aspects'!
boxAVisible
@@ -1394,6 +1354,7 @@
"Modified: / 25-07-2006 / 11:15:07 / cg"
! !
+
!VersionDiffBrowser methodsFor:'aspects-exported'!
changedLabelHolder:aValueHolder
@@ -1439,6 +1400,7 @@
]
! !
+
!VersionDiffBrowser methodsFor:'aspects-menu'!
canAcceptInCodeView
@@ -1459,8 +1421,57 @@
^ self methodsChangedSelection value notNil
! !
+
!VersionDiffBrowser methodsFor:'change & update'!
+methodsOnlyInASelectionChanged
+ "
+ the selection in the list of the 'method only in version A' changed.
+ Reset the selection of the two other lists and show the method in
+ the text view.
+
+ <return: self>
+ "
+ |change sel|
+
+ self infoHolder value:''.
+
+ sel := self methodsOnlyInASelection value.
+ sel notNil ifTrue:[
+ self methodsOnlyInBSelection value:nil.
+ self methodsChangedSelection value:nil.
+ change := methodsOnlyInAFiltered "self changeSetA" at:sel.
+ self methodText value:(change prettyPrintedSource).
+ self showSingleTextView.
+ ]
+
+ "Modified: / 17-07-2012 / 18:31:22 / cg"
+!
+
+methodsOnlyInBSelectionChanged
+ "
+ the selection in the list of the 'method only in version B' changed.
+ Reset the selection of the two other lists and show the method in
+ the text view.
+
+ <return: self>
+ "
+ |change sel|
+
+ self infoHolder value:''.
+
+ sel := self methodsOnlyInBSelection value.
+ sel notNil ifTrue:[
+ self methodsOnlyInASelection value:nil.
+ self methodsChangedSelection value:nil.
+ change := methodsOnlyInBFiltered "self changeSetB" at:sel.
+ self methodText value:(change prettyPrintedSource).
+ self showSingleTextView.
+ ]
+
+ "Modified: / 17-07-2012 / 18:31:32 / cg"
+!
+
update:something with:parameter from:changedObject
((changedObject == includeExtensionsHolder)
or:[ changedObject == includeCategoryChangesHolder
@@ -1480,6 +1491,7 @@
"Modified: / 17-07-2012 / 17:48:58 / cg"
! !
+
!VersionDiffBrowser methodsFor:'initialization & release'!
postBuildWith:aBuilder
@@ -1494,6 +1506,7 @@
super postBuildWith:aBuilder
! !
+
!VersionDiffBrowser methodsFor:'menu action'!
browseChange:aChange
@@ -1689,6 +1702,7 @@
].
! !
+
!VersionDiffBrowser methodsFor:'private'!
addAcceptToTextViewMenus
@@ -2003,6 +2017,7 @@
"Modified: / 17-07-2012 / 18:34:36 / cg"
! !
+
!VersionDiffBrowser methodsFor:'setup'!
setupForClass:aClass againstVersion:aVersionA
@@ -2080,6 +2095,7 @@
self classChangeSet:changeSet
! !
+
!VersionDiffBrowser::ClassChangeSet class methodsFor:'instance creation'!
changeSetForClass:aClass
@@ -2296,6 +2312,7 @@
].
! !
+
!VersionDiffBrowser::ClassChangeSet methodsFor:'accessing'!
classBeingCompared
@@ -2398,12 +2415,14 @@
versionB := something.
! !
+
!VersionDiffBrowser::ClassChangeSet methodsFor:'misc'!
removeAllVersionMethods
diffSet removeAllVersionMethods.
! !
+
!VersionDiffBrowser::ClassChangeSet methodsFor:'setup'!
setupForClass:aClass againstVersion:aVersionA
@@ -2443,14 +2462,15 @@
^ diffSet
! !
+
!VersionDiffBrowser class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libtool/VersionDiffBrowser.st,v 1.111 2012-10-30 16:04:26 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libtool/VersionDiffBrowser.st,v 1.112 2013-03-23 11:37:08 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libtool/VersionDiffBrowser.st,v 1.111 2012-10-30 16:04:26 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libtool/VersionDiffBrowser.st,v 1.112 2013-03-23 11:37:08 cg Exp $'
!
version_HG