--- a/.hgtags Tue Sep 17 11:25:54 2013 +0100
+++ b/.hgtags Thu Sep 19 10:20:29 2013 +0100
@@ -1,6 +1,5 @@
010ac94518b347db8dcc0f986d7e0f31cb6369b7 expeccoNET_1_5_0rc1
010ac94518b347db8dcc0f986d7e0f31cb6369b7 expecco_1_8_2rc1
-02dcd0e97dfff74c08ac41e8c0db885956bb12db stable
0345171682c483a27083e267891c5c409672b786 expecco_1_0_3
0b1ad2518a5cd2c8273fb463e370af9d6abfbd97 expecco_2_1_0
0b715d777c488bf60cadb45e1336e6191b713369 rel2_10_8_6_last2
@@ -54,6 +53,7 @@
c955fe2bbcb582ea2c89428707d2a181ecde2f92 stx_6_2_2
d42566f1a9ba30ece3b2ddea3ac312dfc6802e45 rel5_2_8
d985c7c23d8e1558a5180826cb985ee84938162c rel3_4_1_1
+dc78ae8a04d083e6478d18dfef4479d268f55b05 stable
defcf4bd5764439d0a898491271789b0bfdf12cc expeccoNET_1_6_0_0
ee907655178aa0f5a67f218fcedc36b8482c3754 rel4_1_3_1
f4b0d497d1e608cbf0d8b7925d176f21640bf92a expecco_1_5_0
--- a/AbstractFileBrowser.st Tue Sep 17 11:25:54 2013 +0100
+++ b/AbstractFileBrowser.st Thu Sep 19 10:20:29 2013 +0100
@@ -4295,7 +4295,7 @@
selection := self currentSelectedObjects.
self class currentSelection:selection.
- selectionNotEmpty := selection notEmpty.
+ selectionNotEmpty := selection notEmptyOrNil.
self hasSelection value:selectionNotEmpty.
self hasFileSelection value:(selectionNotEmpty and:[self firstSelectedFile notNil]).
@@ -9307,11 +9307,11 @@
!AbstractFileBrowser class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libtool/AbstractFileBrowser.st,v 1.537 2013-08-31 19:25:38 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libtool/AbstractFileBrowser.st,v 1.538 2013-09-06 16:03:14 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libtool/AbstractFileBrowser.st,v 1.537 2013-08-31 19:25:38 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libtool/AbstractFileBrowser.st,v 1.538 2013-09-06 16:03:14 cg Exp $'
!
version_HG
--- a/AbstractSettingsApplication.st Tue Sep 17 11:25:54 2013 +0100
+++ b/AbstractSettingsApplication.st Thu Sep 19 10:20:29 2013 +0100
@@ -8818,6 +8818,7 @@
label: 'Cartoon Tooltip Style'
name: 'CheckBox2'
activeHelpKey: cartoonToolTipStyle
+ enableChannel: displaySupportsArbitraryShapedViews
model: cartoonToolTipStyle
translateLabel: true
extent: (Point 661 22)
@@ -9060,6 +9061,10 @@
!AbstractSettingsApplication::MiscDisplay2SettingsAppl methodsFor:'queries'!
+displaySupportsArbitraryShapedViews
+ ^ Screen current supportsArbitraryShapedViews
+!
+
hasUnsavedChanges
|currentScreen|
@@ -9472,14 +9477,6 @@
)
extent: (Point 435 30)
)
- (CheckBoxSpec
- label: 'Keyboard Focus Follows Mouse'
- name: 'CheckBox6'
- activeHelpKey: focusFollowsMouse
- model: focusFollowsMouse
- translateLabel: true
- extent: (Point 435 22)
- )
)
)
@@ -18986,11 +18983,11 @@
!AbstractSettingsApplication class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libtool/AbstractSettingsApplication.st,v 1.498 2013-09-04 21:50:52 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libtool/AbstractSettingsApplication.st,v 1.500 2013-09-12 13:07:13 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libtool/AbstractSettingsApplication.st,v 1.498 2013-09-04 21:50:52 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libtool/AbstractSettingsApplication.st,v 1.500 2013-09-12 13:07:13 cg Exp $'
!
version_HG
--- a/CodeCompletionHelpMenuView.st Tue Sep 17 11:25:54 2013 +0100
+++ b/CodeCompletionHelpMenuView.st Thu Sep 19 10:20:29 2013 +0100
@@ -46,6 +46,13 @@
"
! !
+!CodeCompletionHelpMenuView methodsFor:'initialization'!
+
+initStyle
+ super initStyle.
+ self viewBackground:Color orange lightened lightened.
+! !
+
!CodeCompletionHelpMenuView methodsFor:'queries'!
wantsFocusWithPointerEnter
@@ -59,10 +66,10 @@
!CodeCompletionHelpMenuView class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libtool/CodeCompletionHelpMenuView.st,v 1.2 2013-09-03 12:19:27 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libtool/CodeCompletionHelpMenuView.st,v 1.3 2013-09-09 11:21:37 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libtool/CodeCompletionHelpMenuView.st,v 1.2 2013-09-03 12:19:27 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libtool/CodeCompletionHelpMenuView.st,v 1.3 2013-09-09 11:21:37 cg Exp $'
! !
--- a/DebugView.st Tue Sep 17 11:25:54 2013 +0100
+++ b/DebugView.st Thu Sep 19 10:20:29 2013 +0100
@@ -427,7 +427,7 @@
^ self
enter:thisContext sender
- withMessage:'debugger entered'
+ withMessage:'Debugger Entered'
mayProceed:true.
!
@@ -1865,10 +1865,10 @@
windowGroup notNil ifTrue:[
windowGroup setProcess:nil.
].
- NumberOfDebuggers := NumberOfDebuggers - 1.
+ NumberOfDebuggers := (NumberOfDebuggers ? 1) - 1.
self destroy
].
- NumberOfDebuggers := NumberOfDebuggers - 1.
+ NumberOfDebuggers := (NumberOfDebuggers ? 1) - 1.
].
"/ here after my own control loop is finished.
@@ -3062,26 +3062,68 @@
!
initializeCodeViewIn:panel
- |v|
+ |scrollableCodeView|
(UserPreferences current useCodeView2In: #Debugger) ifTrue:[
- v := codeView := Tools::CodeView2 in: panel.
+ scrollableCodeView := codeView := Tools::CodeView2 new.
codeView model: ValueHolder new.
codeView methodHolder: ValueHolder new.
codeView classHolder: ValueHolder new.
] ifFalse:[
- v := HVScrollableView
+ scrollableCodeView := HVScrollableView
for:CodeView
miniScrollerH:true
miniScrollerV:false
in:panel.
- "/ v autoHideScrollBars:true.
- codeView := v scrolledView.
+ codeView := scrollableCodeView scrolledView.
codeView enableMotionEvents. "/ for active help
].
- ^ v
+ UserPreferences current showAcceptCancelBarInBrowser ifTrue:[
+ ViewWithAcceptAndCancelBar notNil ifTrue:[
+ |v|
+
+ v := ViewWithAcceptAndCancelBar new.
+ v slaveView:scrollableCodeView.
+ v reallyModifiedHolder:(codeView isCodeView2
+ ifTrue:[ codeView reallyModifiedChannel ]
+ ifFalse:[
+ BlockValue
+ with:[:m |
+ |same|
+
+ same := (codeView contentsAsString string = currentMethod source string).
+ codeView modifiedChannel setValue:false. "/ so it triggers again
+ same not.
+ ]
+ argument:codeView modifiedChannel
+ ]).
+ v cancelAction:
+ [
+ "/ codeView setClipboardText:(codeView contents). "/ for undo
+ codeView device rememberInCopyBufferHistory:(codeView contents). "/ for undo
+ codeView contents:(currentMethod source).
+ codeView modifiedChannel setValue:false; changed. "/ trigger
+ codeView requestFocus.
+ ].
+ v compareAction:
+ [
+ v := DiffCodeView
+ openOn:codeView contentsAsString
+ label:(resources string:'Changed definition (to be accepted ?)')
+ and:currentMethod source
+ label:(resources string:'Method''s Original Code').
+ v label:(resources string:'Changed Code in Debugger').
+ v waitUntilVisible.
+ "/ codeView requestFocus
+ ].
+ scrollableCodeView := v.
+ ]
+ ].
+
+ panel add:scrollableCodeView.
+ ^ scrollableCodeView
"Modified: / 27-07-2011 / 13:15:44 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
@@ -4623,40 +4665,39 @@
receiversClass := classToDefineIn.
] ifFalse:[
selector := actualContext selector.
-
- implClass := actualContext receiver class whichClassIncludesSelector:selector.
- implClass notNil ifTrue:[
- "/ must be a subclassResponsibility
-
- idx := contextArray identityIndexOf:actualContext.
- idx > 1 ifTrue:[
- callee := contextArray at:idx-1.
-
- callee selector == #subclassResponsibility ifTrue:[
- restart := false.
- ]
- ].
- ].
-
- "generate nice argument names"
- bagOfClassNames := (actualContext args collect:[:eachArg | eachArg class name]) asBag.
- bagOfUsedClassNames := Bag new.
- argNames := actualContext args
- collect:
- [:eachArg |
- |nm|
-
- nm := eachArg class nameWithoutPrefix.
- (bagOfClassNames occurrencesOf:nm) == 1 ifTrue:[
- nm article , nm
- ] ifFalse:[
- bagOfUsedClassNames add:nm.
- nm asLowercaseFirst , (bagOfUsedClassNames occurrencesOf:nm) printString
- ].
+ receiversClass := actualContext receiver class.
+ ].
+
+ implClass := actualContext receiver class whichClassIncludesSelector:selector.
+ implClass notNil ifTrue:[
+ "/ must be a subclassResponsibility
+
+ idx := contextArray identityIndexOf:actualContext.
+ idx > 1 ifTrue:[
+ callee := contextArray at:idx-1.
+
+ callee selector == #subclassResponsibility ifTrue:[
+ restart := false.
+ ]
+ ].
+ ].
+
+ "generate nice argument names"
+ bagOfClassNames := (actualContext args collect:[:eachArg | eachArg class name]) asBag.
+ bagOfUsedClassNames := Bag new.
+ argNames := actualContext args
+ collect:
+ [:eachArg |
+ |nm|
+
+ nm := eachArg class nameWithoutPrefix.
+ (bagOfClassNames occurrencesOf:nm) == 1 ifTrue:[
+ nm article , nm
+ ] ifFalse:[
+ bagOfUsedClassNames add:nm.
+ nm asLowercaseFirst , (bagOfUsedClassNames occurrencesOf:nm) printString
].
-
- receiversClass := actualContext receiver class.
- ].
+ ].
proto := Method methodDefinitionTemplateForSelector:selector andArgumentNames:argNames.
@@ -5431,17 +5472,22 @@
AND it has an applicaiton, return it.
Otherwise, return nil"
- |p wg app|
+ |p wgs app|
p := inspectedProcess ? Processor activeProcess.
(p notNil and:[p isGUIProcess]) ifTrue:[
- wg := WindowGroup scheduledWindowGroups detect:[:wg | wg process == p] ifNone:nil.
- [wg notNil] whileTrue:[
- (app := wg application) notNil ifTrue:[^ app].
- wg isModal ifTrue:[
- wg := wg previousGroup
- ] ifFalse:[
- wg := nil.
+ wgs := WindowGroup scheduledWindowGroups select:[:wg | wg process == p].
+ wgs do:[:wg |
+ |wgi|
+
+ wgi := wg.
+ [wgi notNil] whileTrue:[
+ (app := wgi application) notNil ifTrue:[^ app].
+ wgi isModal ifTrue:[
+ wgi := wgi previousGroup
+ ] ifFalse:[
+ wgi := nil.
+ ]
]
]
].
@@ -7744,7 +7790,7 @@
^ true.
].
- "/ thats a big hack, but I am tired of navigating to find the missing menu message...
+ "/ that's a big hack, but I am tired of navigating to find the missing menu message...
"/ you will thank me!!
mthd selector == #error:mayProceed: ifTrue:[
(callee receiver isKindOf:MenuPanel) ifTrue:[
@@ -8984,11 +9030,11 @@
!DebugView class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libtool/DebugView.st,v 1.633 2013-09-03 17:58:08 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libtool/DebugView.st,v 1.637 2013-09-15 12:43:20 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libtool/DebugView.st,v 1.633 2013-09-03 17:58:08 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libtool/DebugView.st,v 1.637 2013-09-15 12:43:20 cg Exp $'
!
version_HG
@@ -8997,7 +9043,7 @@
!
version_SVN
- ^ '$Id: DebugView.st,v 1.633 2013-09-03 17:58:08 cg Exp $'
+ ^ '$Id: DebugView.st,v 1.637 2013-09-15 12:43:20 cg Exp $'
! !
--- a/InspectorView.st Tue Sep 17 11:25:54 2013 +0100
+++ b/InspectorView.st Thu Sep 19 10:20:29 2013 +0100
@@ -1529,10 +1529,10 @@
#('-') .
(integerDisplayRadix == 10)
ifFalse:[ #('Show Integers as Decimal' #setDisplayRadixTo10 ) ] .
+ (integerDisplayRadix == 16)
+ ifFalse:[ #('Show Integers as Hex' #setDisplayRadixTo16 ) ] .
(integerDisplayRadix == 2)
ifFalse:[ #('Show Integers as Binary' #setDisplayRadixTo2 ) ] .
- (integerDisplayRadix == 16)
- ifFalse:[ #('Show Integers as Hex' #setDisplayRadixTo16 ) ] .
} select:[:el | el notNil].
"Modified: / 24-08-2010 / 17:31:51 / cg"
@@ -3688,11 +3688,11 @@
!InspectorView class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libtool/InspectorView.st,v 1.321 2013-07-30 07:45:25 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libtool/InspectorView.st,v 1.322 2013-09-07 09:09:16 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libtool/InspectorView.st,v 1.321 2013-07-30 07:45:25 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libtool/InspectorView.st,v 1.322 2013-09-07 09:09:16 cg Exp $'
!
version_HG
--- a/SettingsDialog.st Tue Sep 17 11:25:54 2013 +0100
+++ b/SettingsDialog.st Thu Sep 19 10:20:29 2013 +0100
@@ -1329,8 +1329,10 @@
entry := applicationList root
recursiveDetect:[:entry | entry applicationClass = aClass].
- entry makeVisible.
- self selectedItem value:entry
+ entry notNil ifTrue:[
+ entry makeVisible.
+ self selectedItem value:entry
+ ].
"Created: / 29-10-2010 / 11:54:13 / cg"
!
@@ -1340,8 +1342,10 @@
entry := applicationList root
recursiveDetect:[:entry | entry nameString = aPathString].
- entry makeVisible.
- self selectedItem value:entry
+ entry notNil ifTrue:[
+ entry makeVisible.
+ self selectedItem value:entry
+ ].
!
selectionChanged
@@ -1629,8 +1633,6 @@
aGCOrStream nextPut:$].
!
-
-
printOn:aStream
aStream
nextPutAll:self class nameWithoutPrefix;
@@ -1638,9 +1640,7 @@
self label printOn:aStream.
"Created: / 24-08-2010 / 18:36:17 / sr"
-!
-
- !
+! !
!SettingsDialog::HierarchicalApplicationList::ApplicationItem methodsFor:'queries'!
@@ -1800,11 +1800,11 @@
!SettingsDialog class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libtool/SettingsDialog.st,v 1.108 2013-08-19 16:02:12 stefan Exp $'
+ ^ '$Header: /cvs/stx/stx/libtool/SettingsDialog.st,v 1.109 2013-09-11 11:51:33 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libtool/SettingsDialog.st,v 1.108 2013-08-19 16:02:12 stefan Exp $'
+ ^ '$Header: /cvs/stx/stx/libtool/SettingsDialog.st,v 1.109 2013-09-11 11:51:33 cg Exp $'
!
version_HG
--- a/SyntaxElementVariable.st Tue Sep 17 11:25:54 2013 +0100
+++ b/SyntaxElementVariable.st Thu Sep 19 10:20:29 2013 +0100
@@ -61,7 +61,7 @@
!SyntaxElementVariable methodsFor:'accessing'!
assigned
- ^ assigned
+ ^ assigned ? false
!
assigned:something
@@ -97,10 +97,10 @@
!SyntaxElementVariable class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libtool/SyntaxElementVariable.st,v 1.4 2013-06-24 17:09:21 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libtool/SyntaxElementVariable.st,v 1.5 2013-09-08 12:38:09 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libtool/SyntaxElementVariable.st,v 1.4 2013-06-24 17:09:21 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libtool/SyntaxElementVariable.st,v 1.5 2013-09-08 12:38:09 cg Exp $'
! !
--- a/SystemBrowser.st Tue Sep 17 11:25:54 2013 +0100
+++ b/SystemBrowser.st Thu Sep 19 10:20:29 2013 +0100
@@ -1758,6 +1758,8 @@
^ ToolbarIconLibrary testCasePassedIcon
!
+
+
testCaseUnknownResultIcon
<resource: #programImage>
@@ -3881,7 +3883,7 @@
"Modified: / 19-06-1997 / 18:27:57 / cg"
"Modified (format): / 25-11-2011 / 14:00:44 / cg"
- "Modified: / 05-09-2013 / 15:23:53 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 06-09-2013 / 18:02:22 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
findAnyResourceIn:aCollectionOfClasses
@@ -4784,7 +4786,7 @@
"/^ searchBlock.
errAction := [:str :pos |
- Dialog warn:'Error during parse: ' , str , ' (position ' , pos printString , ')'.
+ Dialog warn:'Error during pattern parse: ' , str , ' (position ' , pos printString , ')'.
^ nil
].
@@ -6504,11 +6506,11 @@
!SystemBrowser class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libtool/SystemBrowser.st,v 1.334 2013-08-31 19:24:28 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libtool/SystemBrowser.st,v 1.336 2013-09-14 01:34:26 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libtool/SystemBrowser.st,v 1.334 2013-08-31 19:24:28 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libtool/SystemBrowser.st,v 1.336 2013-09-14 01:34:26 cg Exp $'
!
version_HG
@@ -6517,7 +6519,7 @@
!
version_SVN
- ^ '$Id: SystemBrowser.st,v 1.334 2013-08-31 19:24:28 cg Exp $'
+ ^ '$Id: SystemBrowser.st,v 1.336 2013-09-14 01:34:26 cg Exp $'
! !
--- a/Tools_ClassList.st Tue Sep 17 11:25:54 2013 +0100
+++ b/Tools_ClassList.st Thu Sep 19 10:20:29 2013 +0100
@@ -1110,9 +1110,33 @@
] ifFalse:[
cat := self class nameListEntryForNonStatic.
].
- cls methodDictionary keysAndValuesDo:[:sel :mthd |
- whatToDo value:cls value:cat value:sel value:mthd.
- ].
+
+ "Java classes have static methods in it's instance method dictionary..."
+ cls theNonMetaclass isJavaClass ifTrue:[
+ cls isMeta ifTrue:[
+ "/ Iterate static method...
+ cls theNonMetaclass methodDictionary keysAndValuesDo:[:sel :mthd |
+ (mthd isJavaMethod and:[mthd isStatic]) ifTrue:[
+ whatToDo value:cls value:cat value:sel value:mthd.
+ ]
+ ].
+ "/ ...and possible class extensions/synthetic proxies...
+ cls methodDictionary keysAndValuesDo:[:sel :mthd |
+ whatToDo value:cls value:cat value:sel value:mthd.
+ ].
+ ] ifFalse:[
+ cls methodDictionary keysAndValuesDo:[:sel :mthd |
+ "/ filter out static method
+ (mthd isJavaMethod not or:[mthd isStatic not]) ifTrue:[
+ whatToDo value:cls value:cat value:sel value:mthd.
+ ].
+ ].
+ ]
+ ] ifFalse:[
+ cls methodDictionary keysAndValuesDo:[:sel :mthd |
+ whatToDo value:cls value:cat value:sel value:mthd.
+ ].
+ ]
].
].
@@ -1426,7 +1450,7 @@
nameListForClasses:aClassList
|orgMode namespaces showNamespaces fullNameList nameList
filteredPackages filteredNameSpaces classesInRemoteChangeSet
- classNamesInChangeSet classNamesInRemoteChangeSet|
+ classNamesInChangeSet classNamesInRemoteChangeSet javaClassCountsByBame |
showNamespaces := false.
@@ -1465,6 +1489,15 @@
classesInRemoteChangeSet := SmallTeam isNil ifTrue:[#()] ifFalse:[ SmallTeam changedClasses ].
classNamesInRemoteChangeSet := classesInRemoteChangeSet collect:[:each | each theNonMetaclass name].
+ javaClassCountsByBame := Dictionary new.
+ aClassList do:[:cls |
+ cls isJavaClass ifTrue:[
+ javaClassCountsByBame
+ at: cls name
+ put: (javaClassCountsByBame at: cls name ifAbsent:[0]) + 1
+ ]
+ ].
+
nameList := aClassList
collect:[:cls |
@@ -1476,6 +1509,23 @@
isInRemoteChangeSet := classNamesInRemoteChangeSet includes:className.
nm := self nameListEntryFor:cls withNameSpace:showNamespaces.
+ cls isJavaClass ifTrue:[
+ (javaClassCountsByBame at: cls name) > 1 ifTrue:[
+ | cl clstring |
+
+ cl := cls classLoader.
+ "/ Do not mark classes loaded by primordial, ext or system class loader...
+ (cl notNil
+ and:[JavaVM systemClassLoader isNil
+ or:[cl ~~ JavaVM systemClassLoader
+ and:[cl ~~ (JavaVM systemClassLoader instVarNamed:#parent)]]])
+ ifTrue:[
+ clstring := ' [', cl displayString , ']'.
+ nm := nm , (clstring asText colorizeAllWith: Color gray)
+ ]
+ ]
+ ].
+
self showCoverageInformation value ifTrue:[
clr := self colorForCoverageInformationOfClass:cls.
@@ -1558,6 +1608,7 @@
^ nameList
"Modified: / 27-10-2012 / 12:32:20 / cg"
+ "Modified: / 06-09-2013 / 18:13:58 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
reconstructNameList
@@ -1622,43 +1673,65 @@
found := false.
aCollection isSequenceable ifFalse:[
- classes := aCollection copy.
- aCollection removeAll.
- classes do:[:cls |
- |newClass|
+ classes := aCollection copy.
+ aCollection removeAll.
+ classes do:[:cls |
+ |newClass|
- meta := cls isMeta.
- newClass := environment at:(cls theNonMetaclass name).
- newClass isNil ifTrue:[
- newClass := cls
- ] ifFalse:[
- meta ifTrue:[
- newClass := newClass class
- ]
- ].
- found := cls ~~ newClass.
- aCollection add:newClass.
- ].
+ meta := cls isMeta.
+ "/ Sigh, special care has to be taken for Java classes as
+ "/ for them, !!!!!! (environment at: javaClass name) ~~ javaClass !!!!!!
+ cls theNonMetaclass isJavaClass ifTrue:[
+ "/ Can't use JavaVM>>classNamed:definedBy: for Java classes because environment
+ "/ could not be Java class. Do a full search instead, sigh...
+ newClass := environment allClasses
+ detect:[:each|each isJavaClass and:[each name == cls theNonMetaclass name and:[each classLoader == cls theNonMetaclass classLoader]]]
+ ifNone:[nil].
+ ] ifFalse:[
+ newClass := environment at:(cls theNonMetaclass name).
+ ].
+ newClass isNil ifTrue:[
+ newClass := cls
+ ] ifFalse:[
+ meta ifTrue:[
+ newClass := newClass class
+ ]
+ ].
+ found := cls ~~ newClass.
+ aCollection add:newClass.
+ ].
] ifTrue:[
- aCollection keysAndValuesDo:[:idx :cls |
- |newClass|
+ aCollection keysAndValuesDo:[:idx :cls |
+ |newClass|
- cls notNil ifTrue:[
- meta := cls isMeta.
- newClass := environment at:(cls theNonMetaclass name).
- newClass isNil ifTrue:[
- newClass := cls
- ] ifFalse:[
- meta ifTrue:[
- newClass := newClass class
- ]
- ].
- found := cls ~~ newClass.
- aCollection at:idx put:newClass.
- ]
- ].
+ cls notNil ifTrue:[
+ meta := cls isMeta.
+ "/ Sigh, special care has to be taken for Java classes as
+ "/ for them, !!!!!! (environment at: javaClass name) ~~ javaClass !!!!!!
+ cls theNonMetaclass isJavaClass ifTrue:[
+ "/ Can't use JavaVM>>classNamed:definedBy: for Java classes because environment
+ "/ could not be Java class. Do a full search instead, sigh...
+ newClass := environment allClasses
+ detect:[:each|each isJavaClass and:[each name == cls theNonMetaclass name and:[each classLoader == cls theNonMetaclass classLoader]]]
+ ifNone:[nil].
+ ] ifFalse:[
+ newClass := environment at:(cls theNonMetaclass name).
+ ].
+ newClass isNil ifTrue:[
+ newClass := cls
+ ] ifFalse:[
+ meta ifTrue:[
+ newClass := newClass class
+ ]
+ ].
+ found := cls ~~ newClass.
+ aCollection at:idx put:newClass.
+ ]
+ ].
].
^ found
+
+ "Modified: / 06-09-2013 / 18:10:38 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
updateList
@@ -2028,10 +2101,10 @@
!ClassList class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libtool/Tools_ClassList.st,v 1.76 2013-09-05 10:46:11 vrany Exp $'
+ ^ '$Header: /cvs/stx/stx/libtool/Tools_ClassList.st,v 1.78 2013-09-10 10:46:19 vrany Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libtool/Tools_ClassList.st,v 1.76 2013-09-05 10:46:11 vrany Exp $'
+ ^ '$Header: /cvs/stx/stx/libtool/Tools_ClassList.st,v 1.78 2013-09-10 10:46:19 vrany Exp $'
! !
--- a/Tools_MethodCategoryList.st Tue Sep 17 11:25:54 2013 +0100
+++ b/Tools_MethodCategoryList.st Thu Sep 19 10:20:29 2013 +0100
@@ -417,31 +417,43 @@
refetch := [:oldClass |
|nm cls newClass|
+ "/ Sigh, special care has to be taken for Java classes as
+ "/ for them, !!!!!! (Smalltalk at: javaClass name) ~~ javaClass !!!!!!
nm := oldClass theNonMetaclass name.
+ oldClass theNonMetaclass isJavaClass ifTrue:[
+ "/ Can't use JavaVM>>classNamed:definedBy: for Java classes because environment
+ "/ could not be Java class. Do a full search instead, sigh...
+ newClass := environment allClasses
+ detect:[:each|each isJavaClass and:[each name == oldClass theNonMetaclass name and:[each classLoader == oldClass theNonMetaclass classLoader]]]
+ ifNone:[nil].
+ ] ifFalse:[
+ newClass := Smalltalk at:nm
+ ].
+
oldClass isMeta ifTrue:[
- newClass := environment at:nm.
newClass isNil ifTrue:[
"/ Transcript showCR:'oops - browser lost class ' , nm.
newClass := oldClass
] ifFalse:[
newClass := newClass theMetaclass
]
- ] ifFalse:[
- newClass := environment at:nm
].
+
+
newClass ~~ oldClass ifTrue:[
anyChange := true.
].
newClass
].
- classes := classes collect:refetch.
- leafClasses := leafClasses collect:refetch.
+ classes := classes collect:[:oldClass | oldClass notNil ifTrue:[refetch value: oldClass] ifFalse:[nil]].
+ leafClasses := leafClasses collect:[:oldClass | oldClass notNil ifTrue:[refetch value: oldClass] ifFalse:[nil]].
anyChange ifTrue:[
self updateOutputGenerator
].
"Modified: / 06-07-2011 / 11:44:13 / cg"
+ "Modified: / 06-09-2013 / 18:05:43 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
delayedUpdate:something with:aParameter from:changedObject
@@ -2089,11 +2101,11 @@
!MethodCategoryList class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libtool/Tools_MethodCategoryList.st,v 1.96 2013-09-05 10:46:11 vrany Exp $'
+ ^ '$Header: /cvs/stx/stx/libtool/Tools_MethodCategoryList.st,v 1.97 2013-09-06 18:39:19 vrany Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libtool/Tools_MethodCategoryList.st,v 1.96 2013-09-05 10:46:11 vrany Exp $'
+ ^ '$Header: /cvs/stx/stx/libtool/Tools_MethodCategoryList.st,v 1.97 2013-09-06 18:39:19 vrany Exp $'
! !
--- a/Tools_MethodList.st Tue Sep 17 11:25:54 2013 +0100
+++ b/Tools_MethodList.st Thu Sep 19 10:20:29 2013 +0100
@@ -1288,6 +1288,25 @@
^ false
].
+ "/ JV Following code is just very bad. It assumes that method is a Smalltalk method.
+ "/ But it may not, it could be JavaScript method, Java method or whatever fancy language
+ "/ method. Should be actually delegated to the method itself, just as #messagesSend & co.
+
+ "/ I'm not going to refactor now to keep the differences between jv-branch and CVS
+ "/ ss small as possible. This interface is bad anyway as method is parsed several times
+ "/ to check different things. Once should be enough.
+
+ "/ Hack:
+
+ mthd programmingLanguage isSmalltalk ifFalse:[
+ ^ [
+ usedVars := mthd perform:querySelector.
+ usedVars includesAny:variablesToHighLight
+ ] on: Error do:[
+ false
+ ]
+ ].
+
src := mthd source.
src notNil ifTrue:[
"
@@ -1296,9 +1315,9 @@
"
(variablesToHighLight contains:[:varName | (src findString:varName) ~~ 0]) ifTrue:[
parser := Parser
- parseMethod:src
- in:cls
- ignoreErrors:true
+ parseMethod:src
+ in:cls
+ ignoreErrors:true
ignoreWarnings:true.
(parser notNil and:[parser ~~ #Error]) ifTrue:[
usedVars := parser perform:querySelector.
@@ -1310,6 +1329,8 @@
]
].
^ false
+
+ "Modified: / 06-09-2013 / 18:02:52 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
methodIsInheritedFromAbove:aMethod
@@ -1818,10 +1839,10 @@
!MethodList class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libtool/Tools_MethodList.st,v 1.92 2013-09-05 10:46:11 vrany Exp $'
+ ^ '$Header: /cvs/stx/stx/libtool/Tools_MethodList.st,v 1.93 2013-09-06 18:39:43 vrany Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libtool/Tools_MethodList.st,v 1.92 2013-09-05 10:46:11 vrany Exp $'
+ ^ '$Header: /cvs/stx/stx/libtool/Tools_MethodList.st,v 1.93 2013-09-06 18:39:43 vrany Exp $'
! !
--- a/Tools_NavigationState.st Tue Sep 17 11:25:54 2013 +0100
+++ b/Tools_NavigationState.st Thu Sep 19 10:20:29 2013 +0100
@@ -36,7 +36,8 @@
messagePaneView codePaneAndPluginView
codePaneAndPluginViewRelativeCorners pluginVisibleHolder
bookmarkHolder worker packageInfoBackgroundColorHolder
- packageInfoButton showMethodTemplate showingParseError'
+ packageInfoButton showMethodTemplate lastMethodShownInCodeView
+ showingParseError'
classVariableNames:''
poolDictionaries:''
category:'Interface-Browsers-New'
@@ -190,6 +191,14 @@
^ Smalltalk
!
+lastMethodShownInCodeView
+ ^ lastMethodShownInCodeView
+!
+
+lastMethodShownInCodeView:something
+ lastMethodShownInCodeView := something.
+!
+
messagePaneView
^ messagePaneView
!
@@ -1159,6 +1168,7 @@
"Created: / 24.2.2000 / 23:45:28 / cg"
! !
+
!NavigationState methodsFor:'aspects-kludges'!
metaToggle
@@ -1679,14 +1689,14 @@
!NavigationState class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libtool/Tools_NavigationState.st,v 1.50 2013-06-20 23:22:15 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libtool/Tools_NavigationState.st,v 1.51 2013-09-10 08:50:19 vrany Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libtool/Tools_NavigationState.st,v 1.50 2013-06-20 23:22:15 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libtool/Tools_NavigationState.st,v 1.51 2013-09-10 08:50:19 vrany Exp $'
!
version_SVN
- ^ '$Id: Tools_NavigationState.st,v 1.50 2013-06-20 23:22:15 cg Exp $'
+ ^ '$Id: Tools_NavigationState.st,v 1.51 2013-09-10 08:50:19 vrany Exp $'
! !
--- a/Tools__CodeHighlightingService.st Tue Sep 17 11:25:54 2013 +0100
+++ b/Tools__CodeHighlightingService.st Thu Sep 19 10:20:29 2013 +0100
@@ -209,7 +209,11 @@
mthd := codeView methodHolder value.
"textView" modified ifFalse:[
- oldCodeList := textView list copy.
+ "/ bad bad bad: textView's list may change, while we copy!!!!!!!!!!
+ [
+ oldCodeList := textView list copy.
+ ] valueUninterruptably.
+
"textView" modified ifFalse:[
oldCodeList isNil ifFalse:[
oldCode := oldCodeList asStringWithoutEmphasis.
@@ -377,11 +381,11 @@
!CodeHighlightingService class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libtool/Tools__CodeHighlightingService.st,v 1.44 2013-07-30 17:35:09 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libtool/Tools__CodeHighlightingService.st,v 1.45 2013-09-16 10:40:45 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libtool/Tools__CodeHighlightingService.st,v 1.44 2013-07-30 17:35:09 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libtool/Tools__CodeHighlightingService.st,v 1.45 2013-09-16 10:40:45 cg Exp $'
!
version_HG
@@ -390,6 +394,6 @@
!
version_SVN
- ^ '$Id: Tools__CodeHighlightingService.st,v 1.44 2013-07-30 17:35:09 cg Exp $'
+ ^ '$Id: Tools__CodeHighlightingService.st,v 1.45 2013-09-16 10:40:45 cg Exp $'
! !
--- a/Tools__CodeNavigationService.st Tue Sep 17 11:25:54 2013 +0100
+++ b/Tools__CodeNavigationService.st Thu Sep 19 10:20:29 2013 +0100
@@ -28,8 +28,8 @@
"{ NameSpace: Tools }"
CodeViewService subclass:#CodeNavigationService
- instanceVariableNames:'selectorEmphasis variableEmphasis currentEmphasis
- currentEmphasisForAssign linesToRedraw menuShown
+ instanceVariableNames:'lastHighlightedElement selectorEmphasis variableEmphasis
+ currentEmphasis currentEmphasisForAssign linesToRedraw menuShown
assignmentEmphasis'
classVariableNames:'DefaultVariableEmphasis DefaultSelectorEmphasis
DefaultAssignmentEmphasis'
@@ -561,7 +561,7 @@
!
highlightClear: redraw
-
+ lastHighlightedElement := nil.
codeView syntaxElementSelection == nil ifTrue:[ ^ self ].
textView list isNil ifTrue:[ ^ self ].
@@ -587,8 +587,10 @@
"Modified: / 18-11-2011 / 14:58:08 / cg"
!
-highlightElement:element
- |e savedEmphasis currentSelection|
+highlightElement:element
+ "walk through the chain of element and highlight each"
+
+ |e savedEmphasis currentSelection highlightSingle|
(currentSelection := codeView syntaxElementSelection) == element ifTrue:[ ^ self ]. "/ no change
currentSelection notNil ifTrue:[
@@ -598,10 +600,8 @@
currentEmphasis := savedEmphasis := self highlighEmphasisFor:element.
currentEmphasisForAssign := nil.
- element notNil ifTrue:[
- codeView syntaxElementSelection:element.
- e := element firstElementInChain.
- [ e notNil ] whileTrue:[
+ highlightSingle :=
+ [:e |
e assigned ifTrue:[
[
currentEmphasis := currentEmphasisForAssign := assignmentEmphasis.
@@ -612,6 +612,27 @@
] ifFalse:[
self highlightWithoutClearFrom:e start to:e stop.
].
+ ].
+
+ element notNil ifTrue:[
+ codeView syntaxElementSelection:element.
+ e := element firstElementInChain.
+
+ "/ cg: I thought that this would work, to speedup up the case, where the same
+ "/ element is to be highlighted again (it does, but now, it does not correctly
+ "/ redraw in some situations)
+ "/ can someone check this?
+ false ifTrue:[
+ e == lastHighlightedElement ifTrue:[
+ "/ same chain
+ highlightSingle value:element.
+ ^ self
+ ].
+ lastHighlightedElement := e. "/ remember
+ ].
+
+ [ e notNil ] whileTrue:[
+ highlightSingle value:e.
e := e nextElement
].
].
@@ -630,16 +651,25 @@
!
highlightElementAtLine:line col:col
- |characterPosition syntaxElements index element|
+ |characterPosition syntaxElements index elementOrNil|
characterPosition := textView characterPositionOfLine:line col:col.
syntaxElements := codeView syntaxElements.
- syntaxElements isEmptyOrNil ifTrue:[self highlightElement:nil. ^ self].
- index := syntaxElements indexForInserting:characterPosition.
- index > syntaxElements size ifTrue:[self highlightElement:nil. ^ self].
- element := syntaxElements at:index.
- (characterPosition between: element start and: element stop) ifFalse:[element := nil].
- self highlightElement:element
+ syntaxElements isEmptyOrNil ifTrue:[
+ elementOrNil := nil.
+ ] ifFalse:[
+ index := syntaxElements indexForInserting:characterPosition.
+ index > syntaxElements size ifTrue:[
+ elementOrNil := nil.
+ ] ifFalse:[
+ elementOrNil := syntaxElements at:index.
+ (characterPosition between: elementOrNil start and: elementOrNil stop) ifFalse:[
+ elementOrNil := nil
+ ].
+ ]
+ ].
+
+ self highlightElement:elementOrNil
"Created: / 14-02-2010 / 16:17:22 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 01-08-2010 / 08:50:11 / Jan Vrany <jan.vrany@fit.cvut.cz>"
@@ -770,11 +800,11 @@
!CodeNavigationService class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libtool/Tools__CodeNavigationService.st,v 1.34 2013-09-02 17:51:24 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libtool/Tools__CodeNavigationService.st,v 1.37 2013-09-09 11:21:15 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libtool/Tools__CodeNavigationService.st,v 1.34 2013-09-02 17:51:24 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libtool/Tools__CodeNavigationService.st,v 1.37 2013-09-09 11:21:15 cg Exp $'
!
version_HG
@@ -783,6 +813,6 @@
!
version_SVN
- ^ '$Id: Tools__CodeNavigationService.st,v 1.34 2013-09-02 17:51:24 cg Exp $'
+ ^ '$Id: Tools__CodeNavigationService.st,v 1.37 2013-09-09 11:21:15 cg Exp $'
! !
--- a/Tools__CodeView2.st Tue Sep 17 11:25:54 2013 +0100
+++ b/Tools__CodeView2.st Thu Sep 19 10:20:29 2013 +0100
@@ -223,112 +223,112 @@
<resource: #menu>
- ^
+ ^
#(Menu
- (
- (MenuItem
- label: 'Implementors...'
- itemValue: browseImplementorsOfIt
- submenuChannel: implementorsMenu
- shortcutKey: ImplementorsOfIt
- )
- (MenuItem
- label: 'Senders...'
- itemValue: browseSendersOfIt
- submenuChannel: sendersMenu
- shortcutKey: SendersOfIt
- )
- (MenuItem
- label: 'Refactor'
- nameKey: refactor
- isVisible: false
- shortcutKey: Shift
- )
- (MenuItem
- label: '-'
- )
- (MenuItem
- label: 'Accept'
- itemValue: accept
- shortcutKey: Accept
- )
- (MenuItem
- label: '-'
- )
- (MenuItem
- label: 'Cut'
- itemValue: cut
- shortcutKey: Cut
- )
- (MenuItem
- label: 'Copy'
- itemValue: copySelection
- shortcutKey: Copy
- )
- (MenuItem
- label: 'Paste'
- itemValue: pasteOrReplace
- shortcutKey: Paste
- )
- (MenuItem
- label: '-'
- )
- (MenuItem
- label: 'Undo'
- itemValue: undo
- shortcutKey: Undo
- )
- (MenuItem
- label: 'Redo'
- itemValue: redo
- shortcutKey: Redo
- )
- (MenuItem
- label: '-'
- )
- (MenuItem
- label: 'Do it'
- itemValue: doIt
- shortcutKey: DoIt
- )
- (MenuItem
- label: 'Print it'
- itemValue: printIt
- shortcutKey: PrintIt
- )
- (MenuItem
- label: 'Inspect it'
- itemValue: inspectIt
- shortcutKey: InspectIt
- )
- (MenuItem
- label: 'Profile it'
- itemValue: profileIt
- shortcutKey: InspectIt
- )
- (MenuItem
- label: '-'
- )
- (MenuItem
- label: 'Show Gutter'
- nameKey: ShowGutter
- indication: showGutterChannel
- )
- (MenuItem
- label: 'More'
- nameKey: More
- )
- (MenuItem
- label: 'Services'
- submenuChannel: servicesMenu
- )
- (MenuItem
- label: 'Debug'
- submenuChannel: debugMenu
- )
- )
- nil
- nil
+ (
+ (MenuItem
+ label: 'Implementors...'
+ itemValue: browseImplementorsOfIt
+ submenuChannel: implementorsMenu
+ shortcutKey: ImplementorsOfIt
+ )
+ (MenuItem
+ label: 'Senders...'
+ itemValue: browseSendersOfIt
+ submenuChannel: sendersMenu
+ shortcutKey: SendersOfIt
+ )
+ (MenuItem
+ label: 'Refactor'
+ nameKey: refactor
+ isVisible: false
+ shortcutKey: Shift
+ )
+ (MenuItem
+ label: '-'
+ )
+ (MenuItem
+ label: 'Accept'
+ itemValue: accept
+ shortcutKey: Accept
+ )
+ (MenuItem
+ label: '-'
+ )
+ (MenuItem
+ label: 'Cut'
+ itemValue: cut
+ shortcutKey: Cut
+ )
+ (MenuItem
+ label: 'Copy'
+ itemValue: copySelection
+ shortcutKey: Copy
+ )
+ (MenuItem
+ label: 'Paste'
+ itemValue: pasteOrReplace
+ shortcutKey: Paste
+ )
+ (MenuItem
+ label: '-'
+ )
+ (MenuItem
+ label: 'Undo'
+ itemValue: undo
+ shortcutKey: Undo
+ )
+ (MenuItem
+ label: 'Redo'
+ itemValue: redo
+ shortcutKey: Redo
+ )
+ (MenuItem
+ label: '-'
+ )
+ (MenuItem
+ label: 'Do it'
+ itemValue: doIt
+ shortcutKey: DoIt
+ )
+ (MenuItem
+ label: 'Print it'
+ itemValue: printIt
+ shortcutKey: PrintIt
+ )
+ (MenuItem
+ label: 'Inspect it'
+ itemValue: inspectIt
+ shortcutKey: InspectIt
+ )
+ (MenuItem
+ label: 'Profile it'
+ itemValue: profileIt
+ shortcutKey: InspectIt
+ )
+ (MenuItem
+ label: '-'
+ )
+ (MenuItem
+ label: 'Show Gutter'
+ nameKey: ShowGutter
+ indication: showGutterChannel
+ )
+ (MenuItem
+ label: 'More'
+ nameKey: More
+ )
+ (MenuItem
+ label: 'Services'
+ submenuChannel: servicesMenu
+ )
+ (MenuItem
+ label: 'Debug'
+ submenuChannel: debugMenu
+ )
+ )
+ nil
+ nil
)
!
@@ -1400,7 +1400,11 @@
"Created: / 06-07-2011 / 17:12:58 / jv"
"Modified: / 06-10-2011 / 14:13:44 / cg"
-! !
+!
+
+
+
+ !
!CodeView2 methodsFor:'diff mode'!
@@ -2295,25 +2299,25 @@
"/ self shown ifFalse:[^self].
(changedObject == textView) ifTrue:[
- ((something == #sizeOfContents)
- or:[ false "(something == #sizeOfView)" ]) ifTrue:[
- self adjustSizeForLongestLine.
+ ((something == #sizeOfContents)
+ or:[ false "(something == #sizeOfView)" ]) ifTrue:[
+ self adjustSizeForLongestLine.
"/ (numberOfLines ~= (textView list size max:textView cursorLine)) ifTrue:[
"/ self invalidate.
"/ ].
- ^ self.
- ].
- something == #originOfContents ifTrue:[
- self invalidateLines.
- ^ self.
- ].
- "/ something printCR.
+ ^ self.
+ ].
+ something == #originOfContents ifTrue:[
+ self invalidateLines.
+ ^ self.
+ ].
+ "/ something printCR.
].
(changedObject == textView reallyModifiedChannel) ifTrue:[
- self invalidateAcceptCancelBar.
- ^self.
+ self invalidateAcceptCancelBar.
+ ^self.
].
super update:something with:aParameter from:changedObject
@@ -2471,29 +2475,31 @@
!CodeView2::GutterView methodsFor:'redrawing'!
-invalidateAcceptCancelBar
+invalidateAcceptCancelBar
| w |
(widthAcceptCancel ? 0) == 0 ifTrue:[ ^ self ].
w := ((self paddingLeft) + (widthAcceptCancel ? 0)) + 1.
- self
- invalidateX: 0
- y: 0
- width: w
- height: self height.
+ self
+ invalidateX: 0
+ y: 0
+ width: w
+ height: self height.
"Created: / 10-09-2013 / 03:07:45 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
+
+
invalidateLines
| x0 |
x0 := ((self paddingLeft) + (widthAcceptCancel ? 0)) + 1.
- self
- invalidateX: x0
- y: 0
- width: self width - x0
- height: self height.
+ self
+ invalidateX: x0
+ y: 0
+ width: self width - x0
+ height: self height.
"Created: / 10-09-2013 / 03:08:18 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
@@ -2503,25 +2509,25 @@
| rw acceptBottom cancelBottom |
x > ((self paddingLeft) + (widthAcceptCancel ? 0)) ifTrue:[
- ^self.
+ ^self.
].
rw := ((x + w) min: (self paddingLeft + (widthAcceptCancel ? 0))) - x.
textView reallyModified ifFalse:[
- self fillRectangleX:x y:y width:rw height:h color: self viewBackground
+ self fillRectangleX:x y:y width:rw height:h color: self viewBackground
] ifTrue:[
- acceptBottom := self acceptButtonBottom.
- cancelBottom := self cancelButtonBottom.
- y < acceptBottom ifTrue:[
- self fillRectangleX:x y:y width:rw height: ((y + h) min: acceptBottom) color: acceptColor.
- ].
- (y < cancelBottom) ifTrue:[
- self fillRectangleX:x y: acceptBottom + 1width:rw height: ((y + h) min: cancelBottom) - acceptBottom - 1color: cancelColor.
- ].
- (y + h >= cancelBottom) ifTrue:[
- self fillRectangleX:x y: cancelBottom + 1 width:rw height: (y + h) - cancelBottom - 1 color: diffColor.
- ]
+ acceptBottom := self acceptButtonBottom.
+ cancelBottom := self cancelButtonBottom.
+ y < acceptBottom ifTrue:[
+ self fillRectangleX:x y:y width:rw height: ((y + h) min: acceptBottom) color: acceptColor.
+ ].
+ (y < cancelBottom) ifTrue:[
+ self fillRectangleX:x y: acceptBottom + 1width:rw height: ((y + h) min: cancelBottom) - acceptBottom - 1color: cancelColor.
+ ].
+ (y + h >= cancelBottom) ifTrue:[
+ self fillRectangleX:x y: cancelBottom + 1 width:rw height: (y + h) - cancelBottom - 1 color: diffColor.
+ ]
]
@@ -2591,15 +2597,15 @@
newFont := self lineFontForLine:line.
newFont isNil ifTrue:[
- newFont := oldFont.
- newColor := self lineColorForLine:line.
- newColor ifNotNil:[ self paint:newColor ].
+ newFont := oldFont.
+ newColor := self lineColorForLine:line.
+ newColor ifNotNil:[ self paint:newColor ].
].
newFont ~~ oldFont ifTrue:[
- (newFont heightOn:device) > (textView font heightOn:device) ifTrue:[
- newFont := textView font.
- ].
- self font:newFont
+ (newFont heightOn:device) > (textView font heightOn:device) ifTrue:[
+ newFont := textView font.
+ ].
+ self font:newFont
].
fontAscent := textView font ascentOn:device.
fontDescent := textView font descentOn:device.
@@ -2608,9 +2614,9 @@
yBaseline := yTop + fontAscent.
cleared ifFalse:[
- self clearRectangleX:0 y:yBaseline - font ascent
- width: width - 2
- height: font ascent + font descent.
+ self clearRectangleX:0 y:yBaseline - font ascent
+ width: width - 2
+ height: font ascent + font descent.
].
"/ cg: this should be done differently: services know about the
@@ -2618,33 +2624,33 @@
"/ otherwise, some redraws become unusably slow (especially
"/ with multiple fonts/colors/emphases)...
drawServices ifTrue:[
- "Let services draw annotations and other stuff"
- codeView
- drawLine:line in: self
- atX: (self paddingLeft + self usedWidthForAcceptCancel) y:yBaseline width: widthAnnotations height: font height
- from:nil to:nil with:self paint and: self backgroundColor.
+ "Let services draw annotations and other stuff"
+ codeView
+ drawLine:line in: self
+ atX: (self paddingLeft + self usedWidthForAcceptCancel) y:yBaseline width: widthAnnotations height: font height
+ from:nil to:nil with:self paint and: self backgroundColor.
].
self
- displayString:lineString
- x:(width - textW - 2 - self paddingRight - widthDiffInfo)
- y:yBaseline.
+ displayString:lineString
+ x:(width - textW - 2 - self paddingRight - widthDiffInfo)
+ y:yBaseline.
newFont
- ifNotNil:[
- self font:oldFont.
- self paint:oldColor
- ]
- ifNil:[
- newColor ifNotNil:[ self paint:oldColor ].
- ].
+ ifNotNil:[
+ self font:oldFont.
+ self paint:oldColor
+ ]
+ ifNil:[
+ newColor ifNotNil:[ self paint:oldColor ].
+ ].
"/ If the view has been cleared here, we have also to redraw corresponding portion
"/ of accept/cancel bar !!
cleared ifFalse:[
- "/ In that case it was cleared above.
- self redrawAcceptCancelBarX:0 y:yBaseline - font ascent
- width: width - 2
- height: font ascent + font descent.
+ "/ In that case it was cleared above.
+ self redrawAcceptCancelBarX:0 y:yBaseline - font ascent
+ width: width - 2
+ height: font ascent + font descent.
].
^ requiredW.
@@ -2654,6 +2660,8 @@
"Modified: / 28-08-2013 / 15:17:56 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
+
+
redrawVisibleLine:line
|absLine|
@@ -2825,6 +2833,7 @@
list:aCollection expandTabs:expand scanForNonStrings:scan includesNonStrings:nonStrings
super list:aCollection expandTabs:expand scanForNonStrings:scan includesNonStrings:nonStrings.
+
listOriginal := aCollection copy.
reallyModifiedChannel value: false.
@@ -2894,24 +2903,24 @@
copyFrom:aDrawable x:srcX y:srcY toX:dstX y:dstY width:w height:h async:async
"/ a vertical scroll operation ?
aDrawable == self ifTrue:[
- ((srcY ~= dstY) and:[srcX = dstX]) ifTrue:[
- "/ Do copy in gutter, but not accept-cancel bar!!
- | x0 |
-
- x0 := gutterView acceptCancelRight.
- gutterView
- copyFrom:gutterView
- x:x0
- y:srcY
- toX:x0
- y:dstY
- width:(gutterView width - x0)
- height:h
- async:false
- ]
+ ((srcY ~= dstY) and:[srcX = dstX]) ifTrue:[
+ "/ Do copy in gutter, but not accept-cancel bar!!
+ | x0 |
+
+ x0 := gutterView acceptCancelRight.
+ gutterView
+ copyFrom:gutterView
+ x:x0
+ y:srcY
+ toX:x0
+ y:dstY
+ width:(gutterView width - x0)
+ height:h
+ async:false
+ ]
].
^ super
- copyFrom:aDrawable x:srcX y:srcY toX:dstX y:dstY width:w height:h async:async
+ copyFrom:aDrawable x:srcX y:srcY toX:dstX y:dstY width:w height:h async:async
"Modified (comment): / 10-09-2013 / 03:13:07 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
@@ -3063,6 +3072,8 @@
"Modified: / 17-03-2012 / 10:04:49 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
+
+
redrawLines
"redraw diff lines"
@@ -3738,6 +3749,8 @@
!CodeView2::TextView methodsFor:'scrolling'!
+
+
basicScrollTo:anOrigin redraw:doRedraw
super scrollTo:anOrigin redraw:doRedraw
@@ -3746,6 +3759,8 @@
"Created: / 19-03-2012 / 17:01:36 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
+
+
originChanged:delta
super originChanged:delta.
@@ -3755,6 +3770,8 @@
"Created: / 07-12-2009 / 21:50:49 / Jindra <a>"
!
+
+
scrollTo:anOrigin redraw:doRedraw
codeView scrollTo:anOrigin redraw:doRedraw in: self.
@@ -3763,7 +3780,9 @@
"Modified: / 06-04-2010 / 14:04:28 / Jakub <zelenja7@fel.cvut.cz>"
"Modified: / 17-03-2012 / 10:06:10 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Created: / 19-03-2012 / 17:05:22 / Jan Vrany <jan.vrany@fit.cvut.cz>"
-! !
+!
+
+ !
!CodeView2::TextView methodsFor:'undo & again'!
@@ -3786,11 +3805,11 @@
!CodeView2 class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libtool/Tools__CodeView2.st,v 1.112 2013-08-26 08:41:40 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libtool/Tools__CodeView2.st,v 1.117 2013-09-06 12:25:17 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libtool/Tools__CodeView2.st,v 1.112 2013-08-26 08:41:40 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libtool/Tools__CodeView2.st,v 1.117 2013-09-06 12:25:17 cg Exp $'
!
version_HG
@@ -3799,7 +3818,7 @@
!
version_SVN
- ^ '$Id: Tools__CodeView2.st,v 1.112 2013-08-26 08:41:40 cg Exp $'
+ ^ '$Id: Tools__CodeView2.st,v 1.117 2013-09-06 12:25:17 cg Exp $'
! !
--- a/Tools__CodeViewService.st Tue Sep 17 11:25:54 2013 +0100
+++ b/Tools__CodeViewService.st Thu Sep 19 10:20:29 2013 +0100
@@ -376,7 +376,7 @@
x:x + dx
y:y - h + dy + 4.
- "Modified: / 30-01-2012 / 16:01:20 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Created: / 17-09-2013 / 15:40:54 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
drawLine:lineNo in: view atX:x y:y width: w height:h from:startCol to:endColOrNil with:fg and:bg
@@ -439,7 +439,7 @@
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libtool/Tools__CodeViewService.st,v 1.14 2013-09-05 23:19:43 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libtool/Tools__CodeViewService.st,v 1.15 2013-09-17 14:44:33 vrany Exp $'
!
version_HG
@@ -448,6 +448,6 @@
!
version_SVN
- ^ '$Id: Tools__CodeViewService.st,v 1.14 2013-09-05 23:19:43 cg Exp $'
+ ^ '$Id: Tools__CodeViewService.st,v 1.15 2013-09-17 14:44:33 vrany Exp $'
! !
--- a/Tools__NewSystemBrowser.st Tue Sep 17 11:25:54 2013 +0100
+++ b/Tools__NewSystemBrowser.st Thu Sep 19 10:20:29 2013 +0100
@@ -15,37 +15,37 @@
SystemBrowser subclass:#NewSystemBrowser
instanceVariableNames:'environment navigationState bufferNameList selectedBuffer buffers
- bufferUsageOrder browserCanvas immediateUpdate showClassPackages
- lastMethodCategory lastMethodMoveClass browserCanvasType
- syntaxColoringProcessRunning syntaxColoringProcess
- methodInfoProcess browsletShowHideLabelHolder browserPageCanvas
- isEmbedded'
+ bufferUsageOrder browserCanvas immediateUpdate showClassPackages
+ lastMethodCategory lastMethodMoveClass browserCanvasType
+ syntaxColoringProcessRunning syntaxColoringProcess
+ methodInfoProcess browsletShowHideLabelHolder browserPageCanvas
+ isEmbedded'
classVariableNames:'LastNewProtocols LastProtocolRenames LastCategoryRenames
- LastCategoryRenameOld LastCategoryRenameNew LastProjectMoves
- LastNameSpaceMove LastMethodMoveOrCopyTargetClass
- LastClassFilterBlockString LastMethodFilterBlockString
- LastBreakPointConditionString LastIndividualChecks
- LastAcceptPackage LastVariableRenames LastVisitorClassName
- LastTemporaryVariableName FindHistory
- CheckForInstancesWhenRemovingClasses SynchronousUpdate
- DoubleClickIsOpenBrowser ShowMethodTemplateWhenProtocolIsSelected
- DefaultShowMethodInheritance DefaultEmphasizeUnloadedClasses
- DefaultImmediateSyntaxColoring DefaultImmediateExplaining
- DefaultSyntaxColoring DefaultToolBarVisible
- DefaultCodeInfoVisible DefaultShortNameInTabs
- DefaultHideUnloadedClasses DefaultMarkApplications
- DefaultAutoFormat DefaultShowMethodComplexity
- DefaultShowMethodTypeIcon DefaultShowSpecialResourceEditors
- SharedMethodCategoryCache LastMethodProcessingBlockString
- LastLoadedPackages DefaultShortAllClassesInNameSpaceOrganisation
- LastBaseVersionTag DefaultShowPseudoProtocols
- DefaultShowMultitabMode LastRenamedOld LastRenamedNew
- LastImportedPackage LastLintRules NewNavigationHistory
- LastLiteralReplacementType LastLiteralReplacementNewName
- LastLiteralReplacementOldLiteral LastNewProjectType
- LastClassProcessingBlockString RecentlyClosedList
- LastClassSearchBoxShowedFullName CachedTagToRevisionMapping
- CachedMethodsImplemented DefaultShowSyntheticMethods'
+ LastCategoryRenameOld LastCategoryRenameNew LastProjectMoves
+ LastNameSpaceMove LastMethodMoveOrCopyTargetClass
+ LastClassFilterBlockString LastMethodFilterBlockString
+ LastBreakPointConditionString LastIndividualChecks
+ LastAcceptPackage LastVariableRenames LastVisitorClassName
+ LastTemporaryVariableName FindHistory
+ CheckForInstancesWhenRemovingClasses SynchronousUpdate
+ DoubleClickIsOpenBrowser ShowMethodTemplateWhenProtocolIsSelected
+ DefaultShowMethodInheritance DefaultEmphasizeUnloadedClasses
+ DefaultImmediateSyntaxColoring DefaultImmediateExplaining
+ DefaultSyntaxColoring DefaultToolBarVisible
+ DefaultCodeInfoVisible DefaultShortNameInTabs
+ DefaultHideUnloadedClasses DefaultMarkApplications
+ DefaultAutoFormat DefaultShowMethodComplexity
+ DefaultShowMethodTypeIcon DefaultShowSpecialResourceEditors
+ SharedMethodCategoryCache LastMethodProcessingBlockString
+ LastLoadedPackages DefaultShortAllClassesInNameSpaceOrganisation
+ LastBaseVersionTag DefaultShowPseudoProtocols
+ DefaultShowMultitabMode LastRenamedOld LastRenamedNew
+ LastImportedPackage LastLintRules NewNavigationHistory
+ LastLiteralReplacementType LastLiteralReplacementNewName
+ LastLiteralReplacementOldLiteral LastNewProjectType
+ LastClassProcessingBlockString RecentlyClosedList
+ LastClassSearchBoxShowedFullName CachedTagToRevisionMapping
+ CachedMethodsImplemented'
poolDictionaries:''
category:'Interface-Browsers-New'
!
@@ -12494,256 +12494,256 @@
^
#(Menu
- (
- (MenuItem
- label: 'Toolbar'
- translateLabel: true
- hideMenuOnActivated: false
- indication: toolBarVisibleHolder
- )
- (MenuItem
- label: 'Bookmarks'
- translateLabel: true
- hideMenuOnActivated: false
- indication: bookmarkBarVisibleHolder
- )
- (MenuItem
- label: 'Searchbar'
- translateLabel: true
- hideMenuOnActivated: false
- indication: stringSearchToolVisibleHolder
- )
- (MenuItem
- label: 'Info'
- translateLabel: true
- hideMenuOnActivated: false
- indication: codeInfoVisible
- )
- (MenuItem
- label: '-'
- )
- (MenuItem
- label: 'Multitab Mode'
- translateLabel: true
- hideMenuOnActivated: false
- indication: showMultitabMode
- )
- (MenuItem
- label: 'Enable Embedded Resource Editors'
- translateLabel: true
- hideMenuOnActivated: false
- indication: showSpecialResourceEditors
- )
- (MenuItem
- label: 'Coverage Info'
- translateLabel: true
- hideMenuOnActivated: false
- indication: showCoverageInformation
- )
- (MenuItem
- label: 'Browslet'
- itemValue: showPlugin:
- translateLabel: true
- isVisible: false
- hideMenuOnActivated: false
- indication: showPlugin
- )
- (MenuItem
- label: '-'
- )
- (MenuItem
- label: 'Class'
- translateLabel: true
- submenu:
- (Menu
- (
- (MenuItem
- label: 'Hide Unloaded Classes'
- translateLabel: true
- hideMenuOnActivated: false
- indication: hideUnloadedClasses
- )
- (MenuItem
- label: 'Show All Classes in NameSpace View'
- translateLabel: true
- hideMenuOnActivated: false
- indication: showAllClassesInNameSpaceOrganisation
- )
- (MenuItem
- label: '-'
- )
- (MenuItem
- enabled: showUnloadedClasses
- label: 'Emphasize Unloaded Classes'
- translateLabel: true
- hideMenuOnActivated: false
- indication: emphasizeUnloadedClasses
- )
- (MenuItem
- label: 'Show Class Type Indicator'
- translateLabel: true
- hideMenuOnActivated: false
- indication: markApplicationsHolder
- )
- (MenuItem
- label: 'Short Class Names in Tabs'
- translateLabel: true
- hideMenuOnActivated: false
- indication: shortNamesInTabs
- )
- (MenuItem
- label: 'Show Class-Packages'
- translateLabel: true
- hideMenuOnActivated: false
- indication: showClassPackages
- )
- (MenuItem
- label: '-'
- )
- (MenuItem
- label: 'Sort and Indent by Inheritance'
- translateLabel: true
- hideMenuOnActivated: false
- indication: sortByNameAndInheritance
- )
- )
- nil
- nil
- )
- )
- (MenuItem
- label: 'Protocol'
- translateLabel: true
- submenu:
- (Menu
- (
- (MenuItem
- label: 'Show Pseudo Protocols'
- translateLabel: true
- hideMenuOnActivated: false
- indication: showPseudoProtocols
- )
- )
- nil
- nil
- )
- )
- (MenuItem
- label: 'Selector'
- translateLabel: true
- submenu:
- (Menu
- (
- (MenuItem
- label: 'Show Inherited Methods'
- translateLabel: true
- hideMenuOnActivated: false
- choice: methodVisibilityHolder
- choiceValue: all
- )
- (MenuItem
- label: 'Show Inherited Methods except Object''s'
- translateLabel: true
- hideMenuOnActivated: false
- choice: methodVisibilityHolder
- choiceValue: allButObject
- )
- (MenuItem
- label: 'Do not Show Inherited Methods'
- translateLabel: true
- hideMenuOnActivated: false
- choice: methodVisibilityHolder
- choiceValue: class
- )
- (MenuItem
- label: '-'
- )
- (MenuItem
- label: 'Show Synthetic Methods'
- translateLabel: true
- hideMenuOnActivated: false
- indication: showSyntheticMethods
- )
- (MenuItem
- label: '-'
- )
- (MenuItem
- label: 'Show Method Inheritance Indicator'
- translateLabel: true
- hideMenuOnActivated: false
- indication: showMethodInheritance
- )
- (MenuItem
- label: 'Show Method Type Indicator'
- translateLabel: true
- hideMenuOnActivated: false
- indication: showMethodTypeIcon
- )
- (MenuItem
- enabled: hasOOMPackageLoadedHolder
- label: 'Show Method-Complexity'
- translateLabel: true
- hideMenuOnActivated: false
- indication: showMethodComplexity
- )
- )
- nil
- nil
- )
- )
- (MenuItem
- label: 'Code'
- translateLabel: true
- submenu:
- (Menu
- (
- (MenuItem
- label: 'Syntax Coloring'
- translateLabel: true
- hideMenuOnActivated: false
- indication: doSyntaxColoring
- )
- (MenuItem
- enabled: doSyntaxColoring
- label: 'Immediate Syntax Coloring'
- translateLabel: true
- hideMenuOnActivated: false
- indication: doImmediateSyntaxColoring
- )
- (MenuItem
- label: 'Immediate Explaining'
- translateLabel: true
- hideMenuOnActivated: false
- indication: doImmediateExplaining
- )
- (MenuItem
- label: 'Auto-Format Code'
- translateLabel: true
- hideMenuOnActivated: false
- indication: doAutoFormat
- )
- (MenuItem
- label: 'Show MethodTemplate for New Methods'
- translateLabel: true
- hideMenuOnActivated: false
- indication: showMethodTemplate
- )
- )
- nil
- nil
- )
- )
- (MenuItem
- label: '-'
- )
- (MenuItem
- label: 'Settings...'
- itemValue: openSettingsDialog
- translateLabel: true
- )
- )
- nil
- nil
+ (
+ (MenuItem
+ label: 'Toolbar'
+ translateLabel: true
+ hideMenuOnActivated: false
+ indication: toolBarVisibleHolder
+ )
+ (MenuItem
+ label: 'Bookmarks'
+ translateLabel: true
+ hideMenuOnActivated: false
+ indication: bookmarkBarVisibleHolder
+ )
+ (MenuItem
+ label: 'Searchbar'
+ translateLabel: true
+ hideMenuOnActivated: false
+ indication: stringSearchToolVisibleHolder
+ )
+ (MenuItem
+ label: 'Info'
+ translateLabel: true
+ hideMenuOnActivated: false
+ indication: codeInfoVisible
+ )
+ (MenuItem
+ label: '-'
+ )
+ (MenuItem
+ label: 'Multitab Mode'
+ translateLabel: true
+ hideMenuOnActivated: false
+ indication: showMultitabMode
+ )
+ (MenuItem
+ label: 'Enable Embedded Resource Editors'
+ translateLabel: true
+ hideMenuOnActivated: false
+ indication: showSpecialResourceEditors
+ )
+ (MenuItem
+ label: 'Coverage Info'
+ translateLabel: true
+ hideMenuOnActivated: false
+ indication: showCoverageInformation
+ )
+ (MenuItem
+ label: 'Browslet'
+ itemValue: showPlugin:
+ translateLabel: true
+ isVisible: false
+ hideMenuOnActivated: false
+ indication: showPlugin
+ )
+ (MenuItem
+ label: '-'
+ )
+ (MenuItem
+ label: 'Class'
+ translateLabel: true
+ submenu:
+ (Menu
+ (
+ (MenuItem
+ label: 'Hide Unloaded Classes'
+ translateLabel: true
+ hideMenuOnActivated: false
+ indication: hideUnloadedClasses
+ )
+ (MenuItem
+ label: 'Show All Classes in NameSpace View'
+ translateLabel: true
+ hideMenuOnActivated: false
+ indication: showAllClassesInNameSpaceOrganisation
+ )
+ (MenuItem
+ label: '-'
+ )
+ (MenuItem
+ enabled: showUnloadedClasses
+ label: 'Emphasize Unloaded Classes'
+ translateLabel: true
+ hideMenuOnActivated: false
+ indication: emphasizeUnloadedClasses
+ )
+ (MenuItem
+ label: 'Show Class Type Indicator'
+ translateLabel: true
+ hideMenuOnActivated: false
+ indication: markApplicationsHolder
+ )
+ (MenuItem
+ label: 'Short Class Names in Tabs'
+ translateLabel: true
+ hideMenuOnActivated: false
+ indication: shortNamesInTabs
+ )
+ (MenuItem
+ label: 'Show Class-Packages'
+ translateLabel: true
+ hideMenuOnActivated: false
+ indication: showClassPackages
+ )
+ (MenuItem
+ label: '-'
+ )
+ (MenuItem
+ label: 'Sort and Indent by Inheritance'
+ translateLabel: true
+ hideMenuOnActivated: false
+ indication: sortByNameAndInheritance
+ )
+ )
+ nil
+ nil
+ )
+ )
+ (MenuItem
+ label: 'Protocol'
+ translateLabel: true
+ submenu:
+ (Menu
+ (
+ (MenuItem
+ label: 'Show Pseudo Protocols'
+ translateLabel: true
+ hideMenuOnActivated: false
+ indication: showPseudoProtocols
+ )
+ )
+ nil
+ nil
+ )
+ )
+ (MenuItem
+ label: 'Selector'
+ translateLabel: true
+ submenu:
+ (Menu
+ (
+ (MenuItem
+ label: 'Show Inherited Methods'
+ translateLabel: true
+ hideMenuOnActivated: false
+ choice: methodVisibilityHolder
+ choiceValue: all
+ )
+ (MenuItem
+ label: 'Show Inherited Methods except Object''s'
+ translateLabel: true
+ hideMenuOnActivated: false
+ choice: methodVisibilityHolder
+ choiceValue: allButObject
+ )
+ (MenuItem
+ label: 'Do not Show Inherited Methods'
+ translateLabel: true
+ hideMenuOnActivated: false
+ choice: methodVisibilityHolder
+ choiceValue: class
+ )
+ (MenuItem
+ label: '-'
+ )
+ (MenuItem
+ label: 'Show Synthetic Methods'
+ translateLabel: true
+ hideMenuOnActivated: false
+ indication: showSyntheticMethods
+ )
+ (MenuItem
+ label: '-'
+ )
+ (MenuItem
+ label: 'Show Method Inheritance Indicator'
+ translateLabel: true
+ hideMenuOnActivated: false
+ indication: showMethodInheritance
+ )
+ (MenuItem
+ label: 'Show Method Type Indicator'
+ translateLabel: true
+ hideMenuOnActivated: false
+ indication: showMethodTypeIcon
+ )
+ (MenuItem
+ enabled: hasOOMPackageLoadedHolder
+ label: 'Show Method-Complexity'
+ translateLabel: true
+ hideMenuOnActivated: false
+ indication: showMethodComplexity
+ )
+ )
+ nil
+ nil
+ )
+ )
+ (MenuItem
+ label: 'Code'
+ translateLabel: true
+ submenu:
+ (Menu
+ (
+ (MenuItem
+ label: 'Syntax Coloring'
+ translateLabel: true
+ hideMenuOnActivated: false
+ indication: doSyntaxColoring
+ )
+ (MenuItem
+ enabled: doSyntaxColoring
+ label: 'Immediate Syntax Coloring'
+ translateLabel: true
+ hideMenuOnActivated: false
+ indication: doImmediateSyntaxColoring
+ )
+ (MenuItem
+ label: 'Immediate Explaining'
+ translateLabel: true
+ hideMenuOnActivated: false
+ indication: doImmediateExplaining
+ )
+ (MenuItem
+ label: 'Auto-Format Code'
+ translateLabel: true
+ hideMenuOnActivated: false
+ indication: doAutoFormat
+ )
+ (MenuItem
+ label: 'Show MethodTemplate for New Methods'
+ translateLabel: true
+ hideMenuOnActivated: false
+ indication: showMethodTemplate
+ )
+ )
+ nil
+ nil
+ )
+ )
+ (MenuItem
+ label: '-'
+ )
+ (MenuItem
+ label: 'Settings...'
+ itemValue: openSettingsDialog
+ translateLabel: true
+ )
+ )
+ nil
+ nil
)
!
@@ -17862,225 +17862,230 @@
doWhat := doWhatByDefault.
canFind := aBrowserOrNil notNil
- and:[aBrowserOrNil navigationState notNil and:[ aBrowserOrNil navigationState isFullBrowser ]].
+ and:[aBrowserOrNil navigationState notNil and:[ aBrowserOrNil navigationState isFullBrowser ]].
(doWhat isNil or:[aBrowserOrNil isNil]) ifTrue:[
- title := ''.
- boxLabel := (resources string:'Select a class').
- okText := 'OK'.
- okText2 := nil. doWhat2 := nil.
- okText3 := nil. doWhat3 := nil.
- ] ifFalse:[
- title := (singleClass ifTrue:[ 'Class to browse' ] ifFalse:[ 'Class(es) to browse' ]).
- boxLabel := (resources string:'Browse or Search').
-
- (doWhat isNil and:[canFind not]) ifTrue:[
- doWhat := #newBuffer.
- ].
-
- doWhat == #newBrowser ifTrue:[
- okText := 'Open'.
- okText2 := 'Add Buffer'. doWhat2 := #newBuffer.
- okText3 := 'Find'. doWhat3 := nil.
- ] ifFalse:[ doWhat == #newBuffer ifTrue:[
- okText := 'Add Buffer'.
- okText2 := 'Open New'. doWhat2 := #newBrowser.
- okText3 := 'Find'. doWhat3 := nil.
- ] ifFalse:[
- title := (singleClass ifTrue:[ 'Class to find' ] ifFalse:[ 'Class(es) to find' ]).
- okText := 'Find'.
- okText2 := 'Open New'. doWhat2 := #newBrowser.
- okText3 := 'Add Buffer'. doWhat3 := #newBuffer.
- ]].
+ title := ''.
+ boxLabel := (resources string:'Select a class').
+ okText := 'OK'.
+ okText2 := nil. doWhat2 := nil.
+ okText3 := nil. doWhat3 := nil.
+ ] ifFalse:[
+ title := (singleClass ifTrue:[ 'Class to browse' ] ifFalse:[ 'Class(es) to browse' ]).
+ boxLabel := (resources string:'Browse or Search').
+
+ (doWhat isNil and:[canFind not]) ifTrue:[
+ doWhat := #newBuffer.
+ ].
+
+ doWhat == #newBrowser ifTrue:[
+ okText := 'Open'.
+ okText2 := 'Add Buffer'. doWhat2 := #newBuffer.
+ okText3 := 'Find'. doWhat3 := nil.
+ ] ifFalse:[ doWhat == #newBuffer ifTrue:[
+ okText := 'Add Buffer'.
+ okText2 := 'Open New'. doWhat2 := #newBrowser.
+ okText3 := 'Find'. doWhat3 := nil.
+ ] ifFalse:[
+ title := (singleClass ifTrue:[ 'Class to find' ] ifFalse:[ 'Class(es) to find' ]).
+ okText := 'Find'.
+ okText2 := 'Open New'. doWhat2 := #newBrowser.
+ okText3 := 'Add Buffer'. doWhat3 := #newBuffer.
+ ]].
].
genShortNameListEntry :=
- [:cls |
- |ns|
-
- cls isNil ifTrue:[
- nil
- ] ifFalse:[
- ns := cls topNameSpace name.
- ns = 'Smalltalk'
- ifTrue:[ ns := '' ]
- ifFalse:[ns := ' (in ',ns,')'].
- cls nameWithoutNameSpacePrefix,ns
- ].
- ].
+ [:cls |
+ |ns|
+
+ cls isNil ifTrue:[
+ nil
+ ] ifFalse:[
+ ns := cls topNameSpace name.
+ ns = 'Smalltalk'
+ ifTrue:[ ns := '' ]
+ ifFalse:[ns := ' (in ',ns,')'].
+ cls nameWithoutNameSpacePrefix,ns
+ ].
+ ].
classNamesInChangeSet := ChangeSet current changedClasses
- select: (filterOrNil ? [:cls | true])
- thenCollect:[:each | each theNonMetaclass name].
+ select: (filterOrNil ? [:cls | true])
+ thenCollect:[:each | each theNonMetaclass name].
initialFullNames := self visitedClassNamesHistory.
(filterOrNil notNil) ifTrue:[
- initialFullNames := initialFullNames select:[:nm | filterOrNil value:(Smalltalk at:nm)].
+ initialFullNames := initialFullNames select:[:nm | filterOrNil value:(Smalltalk at:nm)].
].
initialFullNames := initialFullNames select:[:nm | nm notNil].
- initialShortNames := initialFullNames collect:[:nm |
- |cls|
-
- cls := Smalltalk at:nm.
- cls isNil ifTrue:[
- "/ class no longer exists (removed?)
- nm colorizeAllWith:(Color grey)
- ] ifFalse:[
- genShortNameListEntry value:(Smalltalk at:nm)
- ].
- ].
-
- colorizedFullNames := initialFullNames collect:[:clsName |
- (classNamesInChangeSet includes:clsName) ifTrue:[
- clsName asText emphasisAllAdd:(UserPreferences current emphasisForChangedCode)
- ] ifFalse:[
- clsName
- ].
- ].
-
- colorizedShortNames := initialShortNames with:initialFullNames collect:[:shortName :clsName |
- (classNamesInChangeSet includes:clsName) ifTrue:[
- shortName asText emphasisAllAdd:(UserPreferences current emphasisForChangedCode)
- ] ifFalse:[
- shortName
- ].
- ].
+ initialShortNames := initialFullNames collect:[:nm |
+ |cls|
+
+ cls := Smalltalk at:nm.
+ cls isNil ifTrue:[
+ "/ class no longer exists (removed?)
+ nm colorizeAllWith:(Color grey)
+ ] ifFalse:[
+ genShortNameListEntry value:(Smalltalk at:nm)
+ ].
+ ].
+
+ colorizedFullNames := initialFullNames collect:[:clsName |
+ (classNamesInChangeSet includes:clsName) ifTrue:[
+ clsName asText emphasisAllAdd:(UserPreferences current emphasisForChangedCode)
+ ] ifFalse:[
+ clsName
+ ].
+ ].
+
+ colorizedShortNames := initialShortNames with:initialFullNames collect:[:shortName :clsName |
+ (classNamesInChangeSet includes:clsName) ifTrue:[
+ shortName asText emphasisAllAdd:(UserPreferences current emphasisForChangedCode)
+ ] ifFalse:[
+ shortName
+ ].
+ ].
title := (resources string:title) , msgTail , '.\' , (resources string:'(TAB to complete; matchPattern allowed - "*" for all):').
box := self
- enterBoxForClassWithCodeSelectionTitle:title withCRs
- withList:(showFullNameHolder value ifTrue:[colorizedFullNames] ifFalse:[colorizedShortNames])
- okText:okText
- forBrowser:aBrowserOrNil.
+ enterBoxForClassWithCodeSelectionTitle:title withCRs
+ withList:(showFullNameHolder value ifTrue:[colorizedFullNames] ifFalse:[colorizedShortNames])
+ okText:okText
+ forBrowser:aBrowserOrNil.
box label:boxLabel.
doWhat notNil ifTrue:[
- button2 := Button label:(resources string:okText2).
- (aBrowserOrNil notNil and:[aBrowserOrNil navigationState isFullBrowser]) "singleClass" ifTrue:[
- button3 := Button label:(resources string:okText3)
- ].
- box addButton:button2 after:(box okButton).
- button3 notNil ifTrue:[box addButton:button3 after:button2].
-
- button2 action:[
- doWhat := doWhat2.
- box doAccept.
- box okPressed.
- ].
- button3 notNil ifTrue:[
- button3 action:[
- doWhat := doWhat3.
- box doAccept.
- box okPressed.
- ].
- ].
+ button2 := Button label:(resources string:okText2).
+ (aBrowserOrNil notNil and:[aBrowserOrNil navigationState isFullBrowser]) "singleClass" ifTrue:[
+ button3 := Button label:(resources string:okText3)
+ ].
+ box addButton:button2 after:(box okButton).
+ button3 notNil ifTrue:[box addButton:button3 after:button2].
+
+ button2 action:[
+ doWhat := doWhat2.
+ box doAccept.
+ box okPressed.
+ ].
+ button3 notNil ifTrue:[
+ button3 action:[
+ doWhat := doWhat3.
+ box doAccept.
+ box okPressed.
+ ].
+ ].
].
allClasses := Smalltalk allClasses copyAsOrderedCollection.
filterOrNil notNil ifTrue:[
- allClasses := allClasses select: filterOrNil
+ allClasses := allClasses select: filterOrNil
].
allNames := (allClasses
- collect:[:cls |
- |ns nm|
-
- ns := cls topNameSpace name.
- ns = 'Smalltalk'
- ifTrue:[ ns := '' ]
- ifFalse:[ns := ' (in ',ns,')'].
- cls isNameSpace ifTrue:[
- nm := cls nameWithoutNameSpacePrefix,ns,' (Namespace)'
- ] ifFalse:[
- nm := cls nameWithoutNameSpacePrefix,ns
- ].
- (classNamesInChangeSet includes:cls name) ifTrue:[
- nm asText emphasisAllAdd:(UserPreferences current emphasisForChangedCode)
- ] ifFalse:[
- nm
- ].
- ]) sortWith:allClasses; yourself.
-
- allFullNames := (allClasses
- collect:[:cls |
- |nm|
-
- nm := cls name.
- (classNamesInChangeSet includes:cls name) ifTrue:[
- nm asText emphasisAllAdd:(UserPreferences current emphasisForChangedCode)
- ] ifFalse:[
- nm
- ].
- ]) sortWith:allClasses; yourself.
+ collect:[:cls |
+ |ns nm|
+
+ ns := cls topNameSpace name.
+ ns = 'Smalltalk'
+ ifTrue:[ ns := '' ]
+ ifFalse:[ns := ' (in ',ns,')'].
+ cls isNameSpace ifTrue:[
+ nm := cls nameWithoutNameSpacePrefix,ns,' (Namespace)'
+ ] ifFalse:[
+ nm := cls nameWithoutNameSpacePrefix,ns
+ ].
+ (classNamesInChangeSet includes:cls name) ifTrue:[
+ nm asText emphasisAllAdd:(UserPreferences current emphasisForChangedCode)
+ ] ifFalse:[
+ nm
+ ].
+ ]) sortWith:allClasses; yourself.
+
+ allFullNames := (allClasses
+ collect:[:cls |
+ |nm|
+
+ nm := cls name.
+ (classNamesInChangeSet includes:cls name) ifTrue:[
+ nm asText emphasisAllAdd:(UserPreferences current emphasisForChangedCode)
+ ] ifFalse:[
+ nm
+ ].
+ ]) sortWith:allClasses; yourself.
updateList := [
- |nameToSearch list namesStarting namesIncluding lcName nameList|
-
- (nameToSearch := classNameHolder value withoutSeparators) isEmpty ifTrue:[
- showingWhatLabel label:(resources string:'Recently visited:').
- list := (showFullNameHolder value ifTrue:[colorizedFullNames] ifFalse:[colorizedShortNames]).
- ] ifFalse:[
- showingWhatLabel label:(resources string:'Matching classes:').
- nameList := showFullNameHolder value
- ifTrue:[ allFullNames ]
- ifFalse:[ allNames ].
-
- lcName := nameToSearch asLowercase.
- (lcName includesString:'::') ifTrue:[
- list := OrderedCollection new.
- allClasses doWithIndex:[:cls :idx |
- |isIncluded|
-
- (nameToSearch includesMatchCharacters) ifTrue:[
- isIncluded := (lcName match:cls name asLowercase)
- ] ifFalse:[
- isIncluded := (cls name includesString:lcName caseSensitive:false)
- ].
- isIncluded ifTrue:[
- list add:(nameList at:idx)
- ].
- ].
- ] ifFalse:[
- (nameToSearch includesMatchCharacters) ifTrue:[
- list := nameList select:[:nm | lcName match:nm asLowercase]
- ] ifFalse:[
- namesIncluding := nameList
- select:[:nm |
- "/ nm asLowercase startsWith:lcName
- nm asLowercase includesString:lcName caseSensitive:false
- ].
- namesStarting := namesIncluding select:[:nm | nm asLowercase startsWith:lcName].
- list := namesStarting , {nil} , (namesIncluding \ namesStarting).
- ]
- ]
- ].
- box listView
- list:list;
- scrollToLine:((list findFirst:[:line | (line ? '') startsWith:lcName]) max:1)
- ].
+ |nameToSearch list namesStarting namesIncluding lcName nameList|
+
+ (nameToSearch := classNameHolder value withoutSeparators) isEmpty ifTrue:[
+ showingWhatLabel label:(resources string:'Recently visited:').
+ list := (showFullNameHolder value ifTrue:[colorizedFullNames] ifFalse:[colorizedShortNames]).
+ ] ifFalse:[
+ showingWhatLabel label:(resources string:'Matching classes:').
+ nameList := showFullNameHolder value
+ ifTrue:[ allFullNames ]
+ ifFalse:[ allNames ].
+
+ lcName := nameToSearch asLowercase.
+ (lcName includesString:'::') ifTrue:[
+ list := OrderedCollection new.
+ allClasses doWithIndex:[:cls :idx |
+ |isIncluded|
+
+ (nameToSearch includesMatchCharacters) ifTrue:[
+ isIncluded := (lcName match:cls name asLowercase)
+ ] ifFalse:[
+ isIncluded := (cls name includesString:lcName caseSensitive:false)
+ ].
+ isIncluded ifTrue:[
+ list add:(nameList at:idx)
+ ].
+ ].
+ ] ifFalse:[
+ (nameToSearch includesMatchCharacters) ifTrue:[
+ list := nameList select:[:nm | lcName match:nm asLowercase]
+ ] ifFalse:[
+ namesIncluding := nameList
+ select:[:nm |
+ "/ nm asLowercase startsWith:lcName
+ nm asLowercase includesString:lcName caseSensitive:false
+ ].
+ namesStarting := namesIncluding select:[:nm | nm asLowercase startsWith:lcName].
+ list := namesStarting , {nil} , (namesIncluding \ namesStarting).
+ ]
+ ]
+ ].
+ box listView
+ list:list;
+ scrollToLine:((list findFirst:[:line | (line ? '') startsWith:lcName]) max:1)
+ ].
classNameHolder := '' asValue.
box enterField
- model:classNameHolder;
- immediateAccept:true.
+ model:classNameHolder;
+ immediateAccept:true.
classNameHolder onChangeEvaluate:updateList.
box entryCompletionBlock:(DoWhatIMeanSupport classNameEntryCompletionBlock).
box action:[:aString | className := aString].
box panelView
- addSubView:(showingWhatLabel := (Label label:(resources string:'Recently visited:')) adjust:#left) before:nil;
- addSubView:(check := CheckBox label:(resources string:'Show Full Name (do not strip off Namespace)') model:showFullNameHolder) before:nil.
+ addSubView:(showingWhatLabel := (Label label:(resources string:'Recently visited:')) adjust:#left) before:nil;
+ addSubView:(check := CheckBox label:(resources string:'Show Full Name (do not strip off Namespace)') model:showFullNameHolder) before:nil.
showFullNameHolder onChangeEvaluate:updateList.
box enterField origin:(0 @ check corner y).
- box enterField onKey:#CursorDown leaveWith:[ box listView requestFocus.
- box listView hasSelection ifFalse:[
- box listView selectFirst
- ]
- ].
+ box enterField
+ onKey:#CursorDown
+ leaveWith:[
+ box listView windowGroup focusView:box listView byTab:true.
+ box listView hasSelection ifFalse:[
+ box listView selectFirst
+ ] ifTrue:[
+ box listView selectNext
+ ].
+ ].
box listView origin:(0 @ check corner y).
box extent:(400 @ 350).
@@ -18091,23 +18096,23 @@
LastClassSearchBoxShowedFullName := showFullNameHolder value.
(className endsWith:$) ) ifTrue:[
- (className indexOfSubCollection:'(in ') == 0 ifTrue:[
- "/ a namespace
- className := (className copyTo:(className indexOfSubCollection:'(Name')-1) withoutSeparators
- ] ifFalse:[
- className := ((className copyFrom:(className indexOfSubCollection:'(in ')+4)
- copyButLast:1)
- , '::' , className asCollectionOfWords first
- ].
+ (className indexOfSubCollection:'(in ') == 0 ifTrue:[
+ "/ a namespace
+ className := (className copyTo:(className indexOfSubCollection:'(Name')-1) withoutSeparators
+ ] ifFalse:[
+ className := ((className copyFrom:(className indexOfSubCollection:'(in ')+4)
+ copyButLast:1)
+ , '::' , className asCollectionOfWords first
+ ].
].
(doWhat isNil or:[aBrowserOrNil isNil]) ifTrue:[
- aBlock notNil ifTrue:[aBlock value:className optionalArgument:singleClass and:doWhat].
- ^ className
+ aBlock notNil ifTrue:[aBlock value:className optionalArgument:singleClass and:doWhat].
+ ^ className
].
aBrowserOrNil withSearchCursorDo:[
- aBlock value:className value:singleClass value:doWhat.
+ aBlock value:className value:singleClass value:doWhat.
].
^ className
@@ -19016,8 +19021,6 @@
"Created: / 24.2.2000 / 23:28:06 / cg"
! !
-
-
!NewSystemBrowser methodsFor:'aspects-organization'!
categoryMenuVisible
@@ -22713,7 +22716,6 @@
^ UserPreferences current useSearchBarInBrowser or:[self codeView searchBarActionBlock notNil]
! !
-
!NewSystemBrowser methodsFor:'change & update'!
categorySelectionChanged
@@ -34640,34 +34642,34 @@
"/ find the highest numbered patchfile
'stxPatches' asFilename directoryContentsDo:[:fn |
- (fn includes:$_) ifTrue:[
- nrString := fn upTo:$_.
- nr := Integer readFrom:nrString onError:nil.
- nr notNil ifTrue:[
- nr > (highest ? -1) ifTrue:[
- highest := nr.
- highestString := nrString.
- ]
- ].
- ].
+ (fn includes:$_) ifTrue:[
+ nrString := fn upTo:$_.
+ nr := Integer readFrom:nrString onError:nil.
+ nr notNil ifTrue:[
+ nr > (highest ? -1) ifTrue:[
+ highest := nr.
+ highestString := nrString.
+ ]
+ ].
+ ].
].
highest isNil ifTrue:[
- fileNamePrefix := '01'
- ] ifFalse:[
- fileNamePrefix := (highest+1) printStringLeftPaddedTo:(highestString size) with:$0.
+ fileNamePrefix := '01'
+ ] ifFalse:[
+ fileNamePrefix := (highest+1) printStringLeftPaddedTo:(highestString size) with:$0.
].
changedClassesAndMetaclasses := diffSet changedClasses.
changedClasses := changedClassesAndMetaclasses collect:[:clsOrMeta | clsOrMeta theNonMetaclass].
- changedOwningClasses := changedClasses collect:[:each | each isPrivate
- ifTrue:[ each owningClass ]
- ifFalse:[ each ]] as:Set.
+ changedOwningClasses := changedClasses collect:[:each | each isPrivate
+ ifTrue:[ each owningClass ]
+ ifFalse:[ each ]] as:Set.
changedOwningClasses := changedOwningClasses asOrderedCollection.
changedOwningClasses size == 1 ifTrue:[
- fileNameMiddle := changedOwningClasses first nameWithoutPrefix
- ] ifFalse:[
- fileNameMiddle := 'patches'
+ fileNameMiddle := changedOwningClasses first nameWithoutPrefix
+ ] ifFalse:[
+ fileNameMiddle := 'patches'
].
fileNameMiddle := fileNameMiddle asFilename makeLegalFilename name.
fileName := (fileNamePrefix,'_',fileNameMiddle,'.st') asFilename.
@@ -34678,24 +34680,24 @@
tempStream nextPutLine:('"/ first, a guard, to ignore the patch if the library already contains an up-to-date class:').
tempStream nextPutLine:('"/').
changedOwningClasses do:[:eachClass |
- tempStream nextPutLine:('(AbstractSourceCodeManager isRevision:(%2 revision) sameOrAfter:''%1'') ifTrue:[ AbortSignal raise ].'
- bindWith:eachClass revision
- with:eachClass name).
+ tempStream nextPutLine:('(AbstractSourceCodeManager isRevision:(%2 revision) sameOrAfter:''%1'') ifTrue:[ AbortSignal raiseErrorString:''patch is for older version'' ].'
+ bindWith:eachClass revision
+ with:eachClass name).
].
tempStream nextPutChunkSeparator; cr; cr.
changeSet := ChangeSet fromDiffSet:diffSet.
changeSet fileOutOn:tempStream.
tempStream syncData; close.
-
+
generatedPatchFilename := ('stxPatches' asFilename construct:fileName).
tempStream fileName renameTo:generatedPatchFilename.
- (Dialog
- confirm:('Created new patchFile as: "%1"' bindWith:generatedPatchFilename name)
- yesLabel:'Show' noLabel:'OK')
+ (Dialog
+ confirm:('Created new patchFile as: "%1"' bindWith:generatedPatchFilename name)
+ yesLabel:'Show' noLabel:'OK')
ifTrue:[
- UserPreferences fileBrowserClass openOn:generatedPatchFilename
+ UserPreferences fileBrowserClass openOn:generatedPatchFilename
].
"Created: / 26-09-2012 / 15:13:07 / cg"
@@ -38122,7 +38124,6 @@
HTMLDocumentView openFullOnDocumentationFile:'TOP.html'
! !
-
!NewSystemBrowser methodsFor:'menu actions-inheritance'!
inheritanceMenuNavigateToClass
@@ -44705,198 +44706,198 @@
mselector := method selector.
className := mclass name.
[
- |set|
-
- set := ChangeSet forExistingMethods:(Array with:method).
- set := set select:[:c | c isMethodChange].
- lastChange := set first.
+ |set|
+
+ set := ChangeSet forExistingMethods:(Array with:method).
+ set := set select:[:c | c isMethodChange].
+ lastChange := set first.
] value.
thisIsAnExtensionMethod := (method isExtension).
thisIsAnExtensionMethod ifTrue:[
- packageId := method package asPackageId.
- mgr := manager
- ] ifFalse:[
- packageId := mclass package asPackageId.
- "/ mgr := packageId projectDefinitionClass sourceCodeManager.
- mgr := manager.
- "/self assert:(mgr = packageId projectDefinitionClass sourceCodeManager).
+ packageId := method package asPackageId.
+ mgr := manager
+ ] ifFalse:[
+ packageId := mclass package asPackageId.
+ "/ mgr := packageId projectDefinitionClass sourceCodeManager.
+ mgr := manager.
+ "/self assert:(mgr = packageId projectDefinitionClass sourceCodeManager).
].
directory := packageId directory.
module := packageId module.
self withWaitCursorDo:[
- |revisionLog start stop answer t tS list msg first|
-
- thisIsAnExtensionMethod ifTrue:[
- revisionLog := mgr
- revisionLogOf:nil
- fromRevision:nil
- toRevision:nil
- numberOfRevisions:nil
- fileName:'extensions.st'
- directory:directory
- module:module.
- ] ifFalse:[
- revisionLog := mgr revisionLogOf:mclass.
- ].
- revisions := revisionLog at:#revisions.
-
- start := 1.
- stop := revisions size.
- stop > 20 ifTrue:[
- thisIsAnExtensionMethod ifTrue:[
- t := 500. "/ fake time
- ] ifFalse:[
- "/ measure the time it takes to checkout a version...
- t := Time millisecondsToRun:[
- |revSourceStream|
-
- revSourceStream := mgr getSourceStreamFor:mclass revision:((revisions at:10) at:#revision).
- ChangeSet fromStream:revSourceStream.
- revSourceStream close.
- ].
- ].
-
- list := revisions collect:[:entry |
- |rev author dateString date msg|
-
- rev := entry at:#revision.
- author := entry at:#author.
- dateString := entry at:#date.
- date := Timestamp readGeneralizedFrom:dateString.
- dateString := date printStringFormat:'%(year)-%(mon)-%(day) %h:%m:%s'.
- entry at:#date put:dateString.
- msg := (entry at:#logMessage) asStringCollection first asString.
- rev,' ',author,' ',dateString,' ',msg
- ].
- msg := 'There are %1 revisions to extract from the repository'.
- t := (t * revisions size / 1000) rounded.
- t < 10 ifTrue:[
- msg := msg,'\(this will take a few seconds).'.
- tS := t.
- ] ifFalse:[
- t := t * revisions size // 1000 // 10 * 10.
- tS := (TimeDuration fromSeconds:t) printStringForApproximation.
- msg := msg,'\(this will take roughly %2).'
- ].
- msg := msg,'\\Do you want to see all or only some of the revisions ?'.
-
- answer := Dialog
- choose:(resources stringWithCRs:msg
- with:revisions size
- with:tS)
- fromList:list values:revisions initialSelection:nil
- buttons:nil
- values:nil
- default:nil
- lines:20
- cancel:[^ self]
- multiple:false
- title:(resources string:'Confirmation')
- postBuildBlock:[:dialog |
- |b|
-
- b := Button label:(resources string:'Browse Newer than Selected').
- b action:[ stop := (dialog componentAt:#ListView) selection. dialog okPressed].
- b := dialog addButton:b before:dialog okButton.
-
- dialog okButton label:(resources string:'Browse All').
- dialog okButton action:[ stop := revisions size. dialog okPressed].
- ].
-
- stop isNil ifTrue:[^ self ].
- ].
+ |revisionLog start stop answer t tS list msg first|
+
+ thisIsAnExtensionMethod ifTrue:[
+ revisionLog := mgr
+ revisionLogOf:nil
+ fromRevision:nil
+ toRevision:nil
+ numberOfRevisions:nil
+ fileName:'extensions.st'
+ directory:directory
+ module:module.
+ ] ifFalse:[
+ revisionLog := mgr revisionLogOf:mclass.
+ ].
+ revisions := revisionLog at:#revisions.
+
+ start := 1.
+ stop := revisions size.
+ stop > 20 ifTrue:[
+ thisIsAnExtensionMethod ifTrue:[
+ t := 500. "/ fake time
+ ] ifFalse:[
+ "/ measure the time it takes to checkout a version...
+ t := Time millisecondsToRun:[
+ |revSourceStream|
+
+ revSourceStream := mgr getSourceStreamFor:mclass revision:((revisions at:10) at:#revision).
+ ChangeSet fromStream:revSourceStream.
+ revSourceStream close.
+ ].
+ ].
+
+ list := revisions collect:[:entry |
+ |rev author dateString date msg|
+
+ rev := entry at:#revision.
+ author := entry at:#author.
+ dateString := entry at:#date.
+ date := Timestamp readGeneralizedFrom:dateString.
+ dateString := date printStringFormat:'%(year)-%(mon)-%(day) %h:%m:%s'.
+ entry at:#date put:dateString.
+ msg := ((entry at:#logMessage) asStringCollection firstIfEmpty:'') asString.
+ rev,' ',author,' ',dateString,' ',msg
+ ].
+ msg := 'There are %1 revisions to extract from the repository'.
+ t := (t * revisions size / 1000) rounded.
+ t < 10 ifTrue:[
+ msg := msg,'\(this will take a few seconds).'.
+ tS := t.
+ ] ifFalse:[
+ t := t * revisions size // 1000 // 10 * 10.
+ tS := (TimeDuration fromSeconds:t) printStringForApproximation.
+ msg := msg,'\(this will take roughly %2).'
+ ].
+ msg := msg,'\\Do you want to see all or only some of the revisions ?'.
+
+ answer := Dialog
+ choose:(resources stringWithCRs:msg
+ with:revisions size
+ with:tS)
+ fromList:list values:revisions initialSelection:nil
+ buttons:nil
+ values:nil
+ default:nil
+ lines:20
+ cancel:[^ self]
+ multiple:false
+ title:(resources string:'Confirmation')
+ postBuildBlock:[:dialog |
+ |b|
+
+ b := Button label:(resources string:'Browse Newer than Selected').
+ b action:[ stop := (dialog componentAt:#ListView) selection. dialog okPressed].
+ b := dialog addButton:b before:dialog okButton.
+
+ dialog okButton label:(resources string:'Browse All').
+ dialog okButton action:[ stop := revisions size. dialog okPressed].
+ ].
+
+ stop isNil ifTrue:[^ self ].
+ ].
t := Time millisecondsToRun:[
- previousMethods := ChangeSet new.
- lastSource := currentSource := method source.
- lastRevision := lastDate := nil.
- first := true.
-
- revisions from:start to:stop do:[:eachLogEntry |
- |revision date revSourceStream|
-
- revision := eachLogEntry at:#revision.
- date := eachLogEntry at:#date.
-
- [
- |chg nChg classChangeSet changeSource changeName|
-
- self activityNotification:('Fetching revision ',revision,'...').
- thisIsAnExtensionMethod ifTrue:[
- revSourceStream := mgr
- streamForClass:nil
- fileName:'extensions.st'
- revision:revision
- directory:directory
- module:module
- cache:true.
- ] ifFalse:[
- revSourceStream := mgr getSourceStreamFor:mclass revision:revision.
- ].
- revSourceStream isNil ifTrue:[
- self warn:'could not load source for ' , mclass name , ' revision ', revision, ' from repository'.
- chg := nil.
- ] ifFalse:[
- classChangeSet := ChangeSet fromStream:revSourceStream.
-
- chg := classChangeSet
- detect:[:chg | chg isMethodChange
- and:[chg selector = mselector
- and:[chg className = className]]]
- ifNone:nil.
- ].
-
- chg isNil ifTrue:[
- "the method was created in the next version (previous one processed)"
- ] ifFalse:[
- changeSource := chg source.
- ].
- ((changeSource isNil and:[lastSource isNil])
- or:[ changeSource asString = lastSource asString ]) ifTrue:[
- ] ifFalse:[
- lastChange isNil ifTrue:[
- "/ mhm - was not in the previous version
- ] ifFalse:[
- nChg := lastChange asNamedMethodChange
- ].
- lastRevision isNil ifTrue:[
- (stop = revisions size) ifTrue:[
- changeName := 'current (not in the repository)'.
- ] ifFalse:[
- "/ not showing all - dont really know
- changeName := 'current'.
- ].
- ] ifFalse:[
- changeName := lastRevision,' [',lastDate,']'.
- first ifTrue:[
- changeName := changeName,' (= current)'.
- ]
- ].
- nChg notNil ifTrue:[
- nChg changeName:changeName.
- previousMethods add:nChg.
- ].
- lastSource := changeSource.
- lastChange := chg.
-
- first := false.
- ].
- lastRevision := revision.
- lastDate := date.
- ] ensure:[
- revSourceStream notNil ifTrue:[revSourceStream close].
- ].
- ].
+ previousMethods := ChangeSet new.
+ lastSource := currentSource := method source.
+ lastRevision := lastDate := nil.
+ first := true.
+
+ revisions from:start to:stop do:[:eachLogEntry |
+ |revision date revSourceStream|
+
+ revision := eachLogEntry at:#revision.
+ date := eachLogEntry at:#date.
+
+ [
+ |chg nChg classChangeSet changeSource changeName|
+
+ self activityNotification:('Fetching revision ',revision,'...').
+ thisIsAnExtensionMethod ifTrue:[
+ revSourceStream := mgr
+ streamForClass:nil
+ fileName:'extensions.st'
+ revision:revision
+ directory:directory
+ module:module
+ cache:true.
+ ] ifFalse:[
+ revSourceStream := mgr getSourceStreamFor:mclass revision:revision.
+ ].
+ revSourceStream isNil ifTrue:[
+ self warn:'could not load source for ' , mclass name , ' revision ', revision, ' from repository'.
+ chg := nil.
+ ] ifFalse:[
+ classChangeSet := ChangeSet fromStream:revSourceStream.
+
+ chg := classChangeSet
+ detect:[:chg | chg isMethodChange
+ and:[chg selector = mselector
+ and:[chg className = className]]]
+ ifNone:nil.
+ ].
+
+ chg isNil ifTrue:[
+ "the method was created in the next version (previous one processed)"
+ ] ifFalse:[
+ changeSource := chg source.
+ ].
+ ((changeSource isNil and:[lastSource isNil])
+ or:[ changeSource asString = lastSource asString ]) ifTrue:[
+ ] ifFalse:[
+ lastChange isNil ifTrue:[
+ "/ mhm - was not in the previous version
+ ] ifFalse:[
+ nChg := lastChange asNamedMethodChange
+ ].
+ lastRevision isNil ifTrue:[
+ (stop = revisions size) ifTrue:[
+ changeName := 'current (not in the repository)'.
+ ] ifFalse:[
+ "/ not showing all - dont really know
+ changeName := 'current'.
+ ].
+ ] ifFalse:[
+ changeName := lastRevision,' [',lastDate,']'.
+ first ifTrue:[
+ changeName := changeName,' (= current)'.
+ ]
+ ].
+ nChg notNil ifTrue:[
+ nChg changeName:changeName.
+ previousMethods add:nChg.
+ ].
+ lastSource := changeSource.
+ lastChange := chg.
+
+ first := false.
+ ].
+ lastRevision := revision.
+ lastDate := date.
+ ] ensure:[
+ revSourceStream notNil ifTrue:[revSourceStream close].
+ ].
+ ].
].
"/ Transcript showCR:('it took %1 seconds' bindWith:(t /1000)printString).
- self activityNotification:nil.
- browser := (UserPreferences current changeSetBrowserClass) openOn:previousMethods.
- browser window label:('Revisions of ' , mclass name , ' ' , mselector).
- browser readOnly:true.
+ self activityNotification:nil.
+ browser := (UserPreferences current changeSetBrowserClass) openOn:previousMethods.
+ browser window label:('Revisions of ' , mclass name , ' ' , mselector).
+ browser readOnly:true.
].
"Modified: / 01-07-2011 / 16:34:29 / cg"
@@ -47584,7 +47585,6 @@
"Modified: / 28-02-2012 / 16:48:38 / cg"
! !
-
!NewSystemBrowser methodsFor:'menu actions-variables'!
browseVarRefsOrModsWithTitle:browserTitle boxTitle:boxTitle variables:varType access:accessType all:browseAll
@@ -49419,7 +49419,7 @@
<resource: #programMenu>
- |shiftedMenu codeView menu sensor refactorItem menuOthers|
+ |shiftedMenu codeView menu sensor menuOthers|
shiftedMenu := self class shiftedCodeViewPopUpMenu decodeAsLiteralArray.
shiftedMenu receiver:self.
@@ -49428,9 +49428,9 @@
codeView := self codeView.
sensor := codeView sensor.
sensor shiftDown ifTrue:[
- sensor ctrlDown ifFalse:[
- ^ shiftedMenu
- ].
+ sensor ctrlDown ifFalse:[
+ ^ shiftedMenu
+ ].
].
menu := codeView editMenu.
@@ -49444,24 +49444,26 @@
"/ menuOthers := menu.
"/ ]
"/ ] ifFalse:[
- (menu isKindOf:Menu) ifTrue:[
- "/ a newStyle menuPanel
- "/ (menu atNameKey:'refactor') "atMenuItemLabeled:'Refactor'" putSubmenu:shiftedMenu visible:true.
- menu atMenuItemLabeled:(resources string:'Refactor') putSubmenu:shiftedMenu visible:true.
- ] ifFalse:[
- "/ an oldStyle popUpMenu
- "/ this is a kludge...
- shiftedMenu := shiftedMenu asOldStylePopUpMenuFor:self.
- "/ would like to add the shifted-menu here
- menu menuView
- addLabels:(Array with:'-' with:(resources string:'Refactor'))
- selectors:#( nil refactorings)
- accelerators:#(nil 'Shift')
- after:#accept.
- menu subMenuAt:#refactorings put:shiftedMenu.
-
- menuOthers := menu subMenuAt:#others.
- ].
+ (menu isKindOf:Menu) ifTrue:[
+ "/ a newStyle menuPanel
+ "/ (menu atNameKey:'refactor') "atMenuItemLabeled:'Refactor'" putSubmenu:shiftedMenu visible:true.
+ (menu menuItemLabeled:(resources string:'Refactor')) notNil ifTrue:[
+ menu atMenuItemLabeled:(resources string:'Refactor') putSubmenu:shiftedMenu visible:true.
+ ].
+ ] ifFalse:[
+ "/ an oldStyle popUpMenu
+ "/ this is a kludge...
+ shiftedMenu := shiftedMenu asOldStylePopUpMenuFor:self.
+ "/ would like to add the shifted-menu here
+ menu menuView
+ addLabels:(Array with:'-' with:(resources string:'Refactor'))
+ selectors:#( nil refactorings)
+ accelerators:#(nil 'Shift')
+ after:#accept.
+ menu subMenuAt:#refactorings put:shiftedMenu.
+
+ menuOthers := menu subMenuAt:#others.
+ ].
"/ ].
"/ sensor shiftDown ifFalse:[
@@ -49482,7 +49484,7 @@
^ menu
"Modified: / 18-10-2008 / 18:52:50 / Jan Vrany <vranyj1@fel.cvut.cz>"
- "Modified: / 01-03-2012 / 20:04:50 / cg"
+ "Modified: / 10-09-2013 / 14:40:13 / cg"
!
compareClassWithSmallTeamVersionMenu
@@ -49819,35 +49821,36 @@
(mthd notNil and:[ (mSel := mthd selector) notNil]) ifTrue:[
- "/ JV: Following code should be language-specific. For Smalltalk, use the old code.
- "/ For the rest, delegate to the language's toolbox (if any)
- mthd programmingLanguage isSmalltalk ifFalse:[
- | toolbox |
-
- toolbox := mthd programmingLanguage toolbox.
- toolbox isNil ifTrue:[
- m addItem:((MenuItem label: (resources string: 'Not supported for %1 (no toolbox)'with: mthd programmingLanguage name))
- enabled: false).
- ^ m.
- ].
- toolbox browser: self.
- ^ toolbox messagesMenuFor:actionSelector
- withMethods: (Array with: mthd)
- withMethodSelectors:withCurrentSelector
- withSentSelectors: true
- withSelfSelectorsOnly: selfSendsOnly
- ].
-
- needSep := false.
-
- contractedSelector := mSel contractTo:80.
-
- withCurrentSelector ifTrue:[
- item := MenuItem label:(' ' , contractedSelector , ' '). "/ ' ' is a kludge - to allow '-' selector
- item itemValue:actionSelector argument:mSel.
- m addItem:item.
- needSep := true.
- ].
+ "/ JV: Following code should be language-specific. For Smalltalk, use the old code.
+ "/ For the rest, delegate to the language's toolbox (if any)
+ mthd programmingLanguage isSmalltalk ifFalse:[
+ | toolbox |
+
+ toolbox := mthd programmingLanguage toolbox.
+ toolbox isNil ifTrue:[
+ m addItem:((MenuItem label: (resources string: 'Not supported for %1 (no toolbox)'with: mthd programmingLanguage name))
+ enabled: false).
+ ^ m.
+ ].
+ toolbox browser: self.
+ toolbox environment: environment.
+ ^ toolbox messagesMenuFor:actionSelector
+ withMethods: (Array with: mthd)
+ withMethodSelectors:withCurrentSelector
+ withSentSelectors: true
+ withSelfSelectorsOnly: selfSendsOnly
+ ].
+
+ needSep := false.
+
+ contractedSelector := mSel contractTo:80.
+
+ withCurrentSelector ifTrue:[
+ item := MenuItem label:(' ' , contractedSelector , ' '). "/ ' ' is a kludge - to allow '-' selector
+ item itemValue:actionSelector argument:mSel.
+ m addItem:item.
+ needSep := true.
+ ].
"/ true "withInstanceProtocolOnly" ifTrue:[
"/ item := MenuItem label:(resources string:' %1 - Instance Protocol Only' with:contractedSelector).
"/ item value:actionSelector.
@@ -49861,63 +49864,63 @@
"/ m addItem:item.
"/ ].
- (withLocalSenders or:[ withSenderChain or:[ withLocalImplementors or:[ withImplementorChain]]]) ifTrue:[
- needSep ifTrue:[ m addSeparator ].
- needSep := false.
- ].
-
- withLocalSenders ifTrue:[
- "/ item := MenuItem label:(resources string:' %1 - Local Senders' with:contractedSelector).
- item := MenuItem label:(resources string:'Local Senders of %1' with:contractedSelector).
- item itemValue:#spawnLocalSendersBuffer.
- m addItem:item. needSep := true
- ].
- withSenderChain ifTrue:[
- "/ item := MenuItem label:(resources string:' %1 - Sender Chain' with:contractedSelector).
- item := MenuItem label:(resources string:'Sender Chain of %1' with:contractedSelector).
- item itemValue:#spawnSenderChainBuffer.
- m addItem:item. needSep := true
- ].
- (withCallersOfThisMethod and:[mthd isInstrumented]) ifTrue:[
- item := MenuItem label:(resources string:'Callers of this %1' with:contractedSelector).
- item itemValue:#spawnCallersBuffer.
- m addItem:item. needSep := true
- ].
-
- withLocalImplementors ifTrue:[
- item := MenuItem label:(resources string:'Local Implementors of %1' with:contractedSelector).
- item itemValue:#spawnLocalImplementorsBuffer.
- m addItem:item. needSep := true
- ].
- withImplementorChain ifTrue:[
- item := MenuItem label:(resources string:'Implementor Chain of %1' with:contractedSelector).
- item itemValue:#spawnImplementorChainBuffer.
- m addItem:item. needSep := true
- ].
- withMethodsCalledByThisMethod ifTrue:[
- item := MenuItem label:(resources string:'Methods Called by %1' with:contractedSelector).
- item itemValue:#spawnMethodsCalledByBuffer.
- m addItem:item. needSep := true
- ].
-
- selfSendsOnly ifTrue:[
- l := mthd messagesSentToSelf.
- l := l , (mthd messagesSentToSuper asArray collect:[:each | { each . mthd mclass superclass }]).
- l := l , ((mthd messagesPossiblySent
- select:[:sel | mthd mclass canUnderstand:sel])
- asArray collect:[:each | each colorizeAllWith:Color darkGrey]).
- ] ifFalse:[
- l := mthd messagesSent asArray.
- l := l , (mthd messagesPossiblySent asArray collect:[:each | each colorizeAllWith:Color darkGrey]).
- ].
- l size > 0 ifTrue:[
- l := l asOrderedCollection sort:[:a :b |
- |sA sB|
- sA := a isArray ifTrue:[a first] ifFalse:[a string].
- sB := b isArray ifTrue:[b first] ifFalse:[b string].
- sA < sB].
-
- needSep ifTrue:[ m addSeparator ].
+ (withLocalSenders or:[ withSenderChain or:[ withLocalImplementors or:[ withImplementorChain]]]) ifTrue:[
+ needSep ifTrue:[ m addSeparator ].
+ needSep := false.
+ ].
+
+ withLocalSenders ifTrue:[
+ "/ item := MenuItem label:(resources string:' %1 - Local Senders' with:contractedSelector).
+ item := MenuItem label:(resources string:'Local Senders of %1' with:contractedSelector).
+ item itemValue:#spawnLocalSendersBuffer.
+ m addItem:item. needSep := true
+ ].
+ withSenderChain ifTrue:[
+ "/ item := MenuItem label:(resources string:' %1 - Sender Chain' with:contractedSelector).
+ item := MenuItem label:(resources string:'Sender Chain of %1' with:contractedSelector).
+ item itemValue:#spawnSenderChainBuffer.
+ m addItem:item. needSep := true
+ ].
+ (withCallersOfThisMethod and:[mthd isInstrumented]) ifTrue:[
+ item := MenuItem label:(resources string:'Callers of this %1' with:contractedSelector).
+ item itemValue:#spawnCallersBuffer.
+ m addItem:item. needSep := true
+ ].
+
+ withLocalImplementors ifTrue:[
+ item := MenuItem label:(resources string:'Local Implementors of %1' with:contractedSelector).
+ item itemValue:#spawnLocalImplementorsBuffer.
+ m addItem:item. needSep := true
+ ].
+ withImplementorChain ifTrue:[
+ item := MenuItem label:(resources string:'Implementor Chain of %1' with:contractedSelector).
+ item itemValue:#spawnImplementorChainBuffer.
+ m addItem:item. needSep := true
+ ].
+ withMethodsCalledByThisMethod ifTrue:[
+ item := MenuItem label:(resources string:'Methods Called by %1' with:contractedSelector).
+ item itemValue:#spawnMethodsCalledByBuffer.
+ m addItem:item. needSep := true
+ ].
+
+ selfSendsOnly ifTrue:[
+ l := mthd messagesSentToSelf.
+ l := l , (mthd messagesSentToSuper asArray collect:[:each | { each . mthd mclass superclass }]).
+ l := l , ((mthd messagesPossiblySent
+ select:[:sel | mthd mclass canUnderstand:sel])
+ asArray collect:[:each | each colorizeAllWith:Color darkGrey]).
+ ] ifFalse:[
+ l := mthd messagesSent asArray.
+ l := l , (mthd messagesPossiblySent asArray collect:[:each | each colorizeAllWith:Color darkGrey]).
+ ].
+ l size > 0 ifTrue:[
+ l := l asOrderedCollection sort:[:a :b |
+ |sA sB|
+ sA := a isArray ifTrue:[a first] ifFalse:[a string].
+ sB := b isArray ifTrue:[b first] ifFalse:[b string].
+ sA < sB].
+
+ needSep ifTrue:[ m addSeparator ].
"/ (l size > 30) ifTrue:[
"/ l removeAllFoundIn:#(ifTrue: ifFalse: ifTrue:ifFalse: ifFalse:ifTrue:
@@ -49934,125 +49937,126 @@
"/ l := l copyTo:30
"/ ].
- l do:[:eachMessageOrPair |
- |selector class label arg|
-
- eachMessageOrPair isArray ifTrue:[
- selector := eachMessageOrPair first.
- class := eachMessageOrPair second.
- arg := eachMessageOrPair.
- ] ifFalse:[
- selector := eachMessageOrPair.
- arg := eachMessageOrPair string asSymbol.
- ].
- label := (selector contractTo:100).
- class notNil ifTrue:[
- label := label , ' (super)'.
- ].
- item := MenuItem label:(' ' , label, ' '). "/ ' ' is a kludge - to allow '-' selector (i.e. not confuse with separator)
- item itemValue:actionSelector argument:arg.
- m addItem:item.
- ].
+ l do:[:eachMessageOrPair |
+ |selector class label arg|
+
+ eachMessageOrPair isArray ifTrue:[
+ selector := eachMessageOrPair first.
+ class := eachMessageOrPair second.
+ arg := eachMessageOrPair.
+ ] ifFalse:[
+ selector := eachMessageOrPair.
+ arg := eachMessageOrPair string asSymbol.
+ ].
+ label := (selector contractTo:100).
+ class notNil ifTrue:[
+ label := label , ' (super)'.
+ ].
+ item := MenuItem label:(' ' , label, ' '). "/ ' ' is a kludge - to allow '-' selector (i.e. not confuse with separator)
+ item itemValue:actionSelector argument:arg.
+ m addItem:item.
+ ].
"/ cut ifTrue:[
"/ m addItem:(MenuItem label:'-').
"/ m addItem:(MenuItem label:'<< more items ignored >>').
"/ ]
- ]
- ] ifFalse:[
- | methodsPerLanguage |
-
- allMessagesSent := Set new.
-
- "/ not exactly one method selected;
- "/ generate a menu for all selected method's implementors and sent messages.
- methods := self selectedMethodsValue.
- methods isEmptyOrNil ifTrue:[
- methods := OrderedCollection new.
- self selectedClassesDo:[:cls |
- cls methodsDo:[:eachMethod | methods add:eachMethod].
- ].
- ].
- methodsPerLanguage := Dictionary new.
- methods do:[:each |
- (methodsPerLanguage at: each programmingLanguage ifAbsentPut:[Set new]) add: each.
- ].
- methodsPerLanguage keysAndValuesDo:[:language :methods |
- language isSmalltalk ifTrue:[
- "/ Do it as before...
- methods do:[:eachMethod |
- mSel := eachMethod selector ? '?'.
- contractedSelector := mSel contractTo:80.
-
- item := MenuItem label:(' ' , contractedSelector , ' '). "/ ' ' is a kludge - to allow '-' selector
- item itemValue:actionSelector argument:mSel.
- m addItem:item.
-
- selfSendsOnly ifTrue:[
- allMessagesSent addAll:(eachMethod messagesSentToSelf).
- ] ifFalse:[
- allMessagesSent addAll:(eachMethod messagesSent).
- ].
- ].
- ] ifFalse:[
- "/ Not a Smalltalk, must ask toolbox
- | toolbox |
-
- toolbox := language toolbox.
- toolbox notNil ifTrue:[
- m addItemsFrom:
- (toolbox messagesMenuFor:actionSelector
- withMethods: methods
- withMethodSelectors:true
- withSentSelectors: false
- withSelfSelectorsOnly: selfSendsOnly)
- ].
- ].
- ].
-
- needSep := true.
- methodsPerLanguage keysAndValuesDo:[:language :methods |
- language isSmalltalk ifTrue:[
- "/ Do it as before...
- allMessagesSent := allMessagesSent asSortedCollection.
- allMessagesSent size > 0 ifTrue:[
- needSep ifTrue:[
- m addSeparator.
- needSep := false.
- ].
- allMessagesSent do:[:eachMessage |
- item := MenuItem label:(' ' , (eachMessage contractTo:100), ' '). "/ ' ' is a kludge - to allow '-' selector
- item itemValue:actionSelector argument:eachMessage asSymbol.
- m addItem:item.
- ].
- ].
- ] ifFalse:[
- "/ Not a Smalltalk, must ask toolbox
- | toolbox |
-
- toolbox := language toolbox.
- toolbox notNil ifTrue:[
- | lm |
-
- lm := toolbox messagesMenuFor:actionSelector
- withMethods: methods
- withMethodSelectors:false
- withSentSelectors: true
- withSelfSelectorsOnly: selfSendsOnly.
- (lm items notEmptyOrNil and:[needSep]) ifTrue:[
- m addSeparator.
- needSep := false.
- ].
- m addItemsFrom: lm.
- ].
- ].
- ].
+ ]
+ ] ifFalse:[
+ | methodsPerLanguage |
+
+ allMessagesSent := Set new.
+
+ "/ not exactly one method selected;
+ "/ generate a menu for all selected method's implementors and sent messages.
+ methods := self selectedMethodsValue.
+ methods isEmptyOrNil ifTrue:[
+ methods := OrderedCollection new.
+ self selectedClassesDo:[:cls |
+ cls methodsDo:[:eachMethod | methods add:eachMethod].
+ ].
+ ].
+ methodsPerLanguage := Dictionary new.
+ methods do:[:each |
+ (methodsPerLanguage at: each programmingLanguage ifAbsentPut:[Set new]) add: each.
+ ].
+ methodsPerLanguage keysAndValuesDo:[:language :methods |
+ language isSmalltalk ifTrue:[
+ "/ Do it as before...
+ methods do:[:eachMethod |
+ mSel := eachMethod selector ? '?'.
+ contractedSelector := mSel contractTo:80.
+
+ item := MenuItem label:(' ' , contractedSelector , ' '). "/ ' ' is a kludge - to allow '-' selector
+ item itemValue:actionSelector argument:mSel.
+ m addItem:item.
+
+ selfSendsOnly ifTrue:[
+ allMessagesSent addAll:(eachMethod messagesSentToSelf).
+ ] ifFalse:[
+ allMessagesSent addAll:(eachMethod messagesSent).
+ ].
+ ].
+ ] ifFalse:[
+ "/ Not a Smalltalk, must ask toolbox
+ | toolbox |
+
+ toolbox := language toolbox.
+ toolbox environment: environment.
+ toolbox notNil ifTrue:[
+ m addItemsFrom:
+ (toolbox messagesMenuFor:actionSelector
+ withMethods: methods
+ withMethodSelectors:true
+ withSentSelectors: false
+ withSelfSelectorsOnly: selfSendsOnly)
+ ].
+ ].
+ ].
+
+ needSep := true.
+ methodsPerLanguage keysAndValuesDo:[:language :methods |
+ language isSmalltalk ifTrue:[
+ "/ Do it as before...
+ allMessagesSent := allMessagesSent asSortedCollection.
+ allMessagesSent size > 0 ifTrue:[
+ needSep ifTrue:[
+ m addSeparator.
+ needSep := false.
+ ].
+ allMessagesSent do:[:eachMessage |
+ item := MenuItem label:(' ' , (eachMessage contractTo:100), ' '). "/ ' ' is a kludge - to allow '-' selector
+ item itemValue:actionSelector argument:eachMessage asSymbol.
+ m addItem:item.
+ ].
+ ].
+ ] ifFalse:[
+ "/ Not a Smalltalk, must ask toolbox
+ | toolbox |
+
+ toolbox := language toolbox.
+ toolbox notNil ifTrue:[
+ | lm |
+
+ lm := toolbox messagesMenuFor:actionSelector
+ withMethods: methods
+ withMethodSelectors:false
+ withSentSelectors: true
+ withSelfSelectorsOnly: selfSendsOnly.
+ (lm items notEmptyOrNil and:[needSep]) ifTrue:[
+ m addSeparator.
+ needSep := false.
+ ].
+ m addItemsFrom: lm.
+ ].
+ ].
+ ].
].
^ m
"Created: / 27-04-2010 / 15:05:52 / cg"
"Modified: / 30-07-2013 / 15:53:58 / cg"
- "Modified: / 01-09-2013 / 18:25:18 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 06-09-2013 / 19:37:07 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
messagesMenuFor:actionSelector withSenderChain:withSenderChain withImplementorChain:withImplementorChain
@@ -50853,7 +50857,6 @@
"Modified: / 19-10-2011 / 16:48:31 / cg"
! !
-
!NewSystemBrowser methodsFor:'menus-dynamic-popup'!
categoryPopUpMenu
@@ -51308,67 +51311,72 @@
ns classes|
aClass isNil ifTrue:[
- ^ self
+ ^ self
].
aSelector notNil ifTrue:[
- mthd := aClass compiledMethodAt:aSelector.
+ mthd := aClass compiledMethodAt:aSelector.
].
(navigationState isMethodListBrowser
or:[navigationState isMethodBrowser]) ifTrue:[
- "/ must check if that method is in the list ...
-
- mthd isNil ifTrue:[
+ "/ must check if that method is in the list ...
+
+ mthd isNil ifTrue:[
"/ (self confirm:'Add a buffer for the class ?' withCRs) ifFalse:[
"/ ^ self
"/ ].
- self spawnFullBrowserInClass:aClass selector:nil in:#newBuffer.
- ^ self
- ].
-
- navigationState methodListApplication isNil ifTrue:[
- self spawnFullBrowserInClass:aClass selector:aSelector in:#newBuffer.
- ^ self
- ].
-
- (navigationState methodList includesIdentical:mthd) ifFalse:[
- answer := OptionBox request:'Method not in list.\\Add a buffer for it ?' withCRs
- label:'New Browser ?'
- image:(WarningBox iconBitmap)
- buttonLabels:(resources array:#('New Browser' 'Add Buffer' 'Cancel'))
- values:#(#newBrowser #newBuffer nil)
- default:#newBuffer
- onCancel:nil.
- answer notNil ifTrue:[
- self spawnFullBrowserInClass:aClass selector:aSelector in:answer.
- ].
- ^ self
- ].
- self selectedMethods value:(OrderedCollection with:mthd).
- ^ self
- ].
-
+ self spawnFullBrowserInClass:aClass selector:nil in:#newBuffer.
+ ^ self
+ ].
+
+ navigationState methodListApplication isNil ifTrue:[
+ self spawnFullBrowserInClass:aClass selector:aSelector in:#newBuffer.
+ ^ self
+ ].
+
+ (navigationState methodList includesIdentical:mthd) ifFalse:[
+ answer := OptionBox request:'Method not in list.\\Add a buffer for it ?' withCRs
+ label:'New Browser ?'
+ image:(WarningBox iconBitmap)
+ buttonLabels:(resources array:#('New Browser' 'Add Buffer' 'Cancel'))
+ values:#(#newBrowser #newBuffer nil)
+ default:#newBuffer
+ onCancel:nil.
+ answer notNil ifTrue:[
+ self spawnFullBrowserInClass:aClass selector:aSelector in:answer.
+ ].
+ ^ self
+ ].
+ self selectedMethods value:(OrderedCollection with:mthd).
+ ^ self
+ ].
+
+ mthd isNil ifTrue:[
+ self selectedMethods value:(OrderedCollection new).
+ ] ifFalse:[
+ self selectedMethods value:(OrderedCollection with:mthd).
+ ].
(navigationState isClassBrowser) ifTrue:[
- "/ must check if that class is in the list ...
- ((navigationState classList value ? #()) includesIdentical:aClass) ifFalse:[
- navigationState isSingleClassBrowser ifTrue:[
- navigationState classList value:(Array with:aClass).
- ] ifFalse:[
- (self confirm:'Class not in list.\\Add a buffer for it ?' withCRs) ifTrue:[
- self spawnFullBrowserInClass:aClass selector:aSelector in:#newBuffer.
- ].
- ^ self
- ].
- ].
- self selectedClasses value:(OrderedCollection with:aClass).
- ^ self
+ "/ must check if that class is in the list ...
+ ((navigationState classList value ? #()) includesIdentical:aClass) ifFalse:[
+ navigationState isSingleClassBrowser ifTrue:[
+ navigationState classList value:(Array with:aClass).
+ ] ifFalse:[
+ (self confirm:'Class not in list.\\Add a buffer for it ?' withCRs) ifTrue:[
+ self spawnFullBrowserInClass:aClass selector:aSelector in:#newBuffer.
+ ].
+ ^ self
+ ].
+ ].
+ self selectedClasses value:(OrderedCollection with:aClass).
+ ^ self
].
(navigationState isProtocolBrowser) ifTrue:[
- (self confirm:'Add a buffer for it ?' withCRs) ifTrue:[
- self spawnFullBrowserInClass:aClass selector:aSelector in:#newBuffer.
- ].
- ^ self
+ (self confirm:'Add a buffer for it ?' withCRs) ifTrue:[
+ self spawnFullBrowserInClass:aClass selector:aSelector in:#newBuffer.
+ ].
+ ^ self
].
orgMode := self organizerMode value.
@@ -51376,34 +51384,34 @@
"/ if the class is a namespace, ask if mode should be changed
(aClass isNameSpace and:[aClass ~~ Smalltalk]) ifTrue:[
- orgMode ~~ OrganizerCanvas organizerModeNamespace ifTrue:[
- answer := self
- confirmWithCancel:(resources string:'Browser: %1 is a namespace - switch organizers display mode ?' with:aClass name)
- defaultAnswer:false.
- answer isNil ifTrue:[
- AbortOperationRequest raise.
- ^ self
- ].
- answer ifTrue:[
- self organizerMode value:(OrganizerCanvas organizerModeNamespace).
- orgMode := self organizerMode value.
- ] ifFalse:[
- ((self selectedClassesValue) contains:[:cls | cls nameSpace == aClass]) ifTrue:[^ self ].
-
- "/ select the first class of that namespace
- classes := aClass allClasses.
- classes notEmpty ifTrue:[
- self switchToClass:(classes first) selector:nil.
- ^ self.
- ]
- ]
- ].
+ orgMode ~~ OrganizerCanvas organizerModeNamespace ifTrue:[
+ answer := self
+ confirmWithCancel:(resources string:'Browser: %1 is a namespace - switch organizers display mode ?' with:aClass name)
+ defaultAnswer:false.
+ answer isNil ifTrue:[
+ AbortOperationRequest raise.
+ ^ self
+ ].
+ answer ifTrue:[
+ self organizerMode value:(OrganizerCanvas organizerModeNamespace).
+ orgMode := self organizerMode value.
+ ] ifFalse:[
+ ((self selectedClassesValue) contains:[:cls | cls nameSpace == aClass]) ifTrue:[^ self ].
+
+ "/ select the first class of that namespace
+ classes := aClass allClasses.
+ classes notEmpty ifTrue:[
+ self switchToClass:(classes first) selector:nil.
+ ^ self.
+ ]
+ ]
+ ].
].
"/ if the class is unloaded, turn hideUnloaded off
(aClass isLoaded not
and:[self hideUnloadedClasses value == true]) ifTrue:[
- self hideUnloadedClasses value:false
+ self hideUnloadedClasses value:false
].
doSwitchMeta := true.
@@ -51414,9 +51422,9 @@
ns := aClass topNameSpace.
ns notNil ifTrue:[nsName := ns name].
(namespaces includes:nsName) ifFalse:[
- (namespaces includes:(NavigatorModel nameListEntryForALL)) ifFalse:[
- self selectedNamespaces value:(OrderedCollection with: NavigatorModel nameListEntryForALL)
- ]
+ (namespaces includes:(NavigatorModel nameListEntryForALL)) ifFalse:[
+ self selectedNamespaces value:(OrderedCollection with: NavigatorModel nameListEntryForALL)
+ ]
].
"/ namespaces := self nameSpaceFilter value ? #().
"/ (namespaces includes:aClass nameSpace name) ifFalse:[
@@ -51425,72 +51433,73 @@
"/ ]
"/ ].
orgMode == OrganizerCanvas organizerModeCategory ifTrue:[
- cat := aClass category ? '* no category *'.
- (self selectedCategoriesValue includes:cat) ifFalse:[
- self selectedCategories value:(OrderedCollection with:cat).
- ]
+ cat := aClass category ? '* no category *'.
+ (self selectedCategoriesValue includes:cat) ifFalse:[
+ self selectedCategories value:(OrderedCollection with:cat).
+ ]
] ifFalse:[ orgMode == OrganizerCanvas organizerModeNamespace ifTrue:[
- aClass isNameSpace ifTrue:[
- nsName := aClass name.
- ] ifFalse:[
- nsName := aClass nameSpace name.
- ].
- (self selectedNamespacesValue includes:nsName) ifFalse:[
- self selectedNamespaces value:(OrderedCollection with:nsName).
- ]
+ aClass isNameSpace ifTrue:[
+ nsName := aClass name.
+ ] ifFalse:[
+ nsName := aClass nameSpace name.
+ ].
+ (self selectedNamespacesValue includes:nsName) ifFalse:[
+ self selectedNamespaces value:(OrderedCollection with:nsName).
+ ]
] ifFalse:[ orgMode == OrganizerCanvas organizerModeProject ifTrue:[
- pkg := aClass package.
- holder := self selectedProjects.
- newValue := holder value ? #().
- (newValue includes:pkg) ifFalse:[
- newValue := OrderedCollection with:pkg.
- ].
- mthd notNil ifTrue:[
- "/ careful - the method could be in an extension ...
- mthd package ~= pkg ifTrue:[
- (newValue includes:mthd package) ifFalse:[
- newValue := newValue asOrderedCollection.
- newValue add:mthd package.
- ].
- ].
- ].
- newValue ~= holder value ifTrue:[
- holder value:newValue.
- ].
+ pkg := aClass package.
+ holder := self selectedProjects.
+ newValue := holder value ? #().
+ (newValue includes:pkg) ifFalse:[
+ newValue := OrderedCollection with:pkg.
+ ].
+ mthd notNil ifTrue:[
+ "/ careful - the method could be in an extension ...
+ mthd package ~= pkg ifTrue:[
+ (newValue includes:mthd package) ifFalse:[
+ newValue := newValue asOrderedCollection.
+ newValue add:mthd package.
+ ].
+ ].
+ ].
+ newValue ~= holder value ifTrue:[
+ holder value:newValue.
+ ].
] ifFalse:[ (orgMode == OrganizerCanvas organizerModeClassHierarchy
- or:[orgMode == OrganizerCanvas organizerModeClassInheritance]) ifTrue:[
- "/ make sure, that the class is in the hierarchy;
- "/ if required, update the hierarchy.
-
- holder := self classHierarchyTopClass.
- cls := holder value.
- (cls isNil or:[(cls withAllSuperclasses includesIdentical:aClass) not]) ifTrue:[
- holder value:aClass.
- ].
- doSwitchMeta := false.
+ or:[orgMode == OrganizerCanvas organizerModeClassInheritance]) ifTrue:[
+ "/ make sure, that the class is in the hierarchy;
+ "/ if required, update the hierarchy.
+
+ holder := self classHierarchyTopClass.
+ cls := holder value.
+ (cls isNil or:[(cls withAllSuperclasses includesIdentical:aClass) not]) ifTrue:[
+ holder value:aClass.
+ ].
+ doSwitchMeta := false.
]]]].
doSwitchMeta ifTrue:[
- self meta value:(aClass isMeta).
+ self meta value:(aClass isMeta).
].
(self selectedClassesValue includesIdentical:aClass) ifFalse:[
- self selectedClasses value:(OrderedCollection with:aClass).
+ self selectedClasses value:(OrderedCollection with:aClass).
].
mthd notNil ifTrue:[
- (self selectedProtocolsValue contains:[:cat | cat string = mthd category]) ifFalse:[
- self selectProtocols:(OrderedCollection with:mthd category).
- ].
- self switchToMethod:mthd.
- ] ifFalse:[
- self switchToSelector:aSelector.
+
+ (self selectedProtocolsValue contains:[:cat | (cat isNil and:[mthd category isNil]) or:[cat string = mthd category]]) ifFalse:[
+ self selectProtocols:(OrderedCollection with:mthd category).
+ ].
+ self switchToMethod:mthd.
+ ] ifFalse:[
+ self switchToSelector:aSelector.
].
self immediateUpdate value:false.
updateHistory ifTrue:[
- self addToHistory:aClass selector:aSelector
+ self addToHistory:aClass selector:aSelector
].
self normalLabel.
@@ -51501,6 +51510,7 @@
"Created: / 22-02-2008 / 09:05:51 / janfrog"
"Modified: / 27-02-2008 / 16:45:21 / janfrog"
"Modified: / 28-02-2012 / 16:53:17 / cg"
+ "Modified: / 10-09-2013 / 14:59:19 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
switchToClassNameMatching:aMatchString
@@ -51721,34 +51731,35 @@
|mthd cls orgMode pkg holder|
aSelector notNil ifTrue:[
- (cls := self theSingleSelectedClass) notNil ifTrue:[
- mthd := cls compiledMethodAt:aSelector asSymbol.
- mthd notNil ifTrue:[
-
- "/ care for method being in another package
- orgMode := self organizerMode value.
- orgMode == OrganizerCanvas organizerModeProject ifTrue:[
- pkg := mthd package.
- holder := self selectedProjects.
- ((holder value ? #()) includes:pkg) ifFalse:[
- holder value:(Array with:pkg).
- ]
- ].
-
- (self selectedProtocolsValue contains:[:p | p string = mthd category]) ifFalse:[
- (self selectedProtocolsValue includes:BrowserList nameListEntryForALL) ifFalse:[
- self selectProtocols:(Array with:mthd category).
- ]
- ].
- self theSingleSelectedMethod ~~ mthd ifTrue:[
- self selectedMethods value:(Array with:mthd).
- ]
- ]
- ]
- ].
-
- "Created: / 4.2.2000 / 23:20:34 / cg"
- "Modified: / 5.2.2000 / 23:07:10 / cg"
+ (cls := self theSingleSelectedClass) notNil ifTrue:[
+ mthd := cls compiledMethodAt:aSelector asSymbol.
+ mthd notNil ifTrue:[
+
+ "/ care for method being in another package
+ orgMode := self organizerMode value.
+ orgMode == OrganizerCanvas organizerModeProject ifTrue:[
+ pkg := mthd package.
+ holder := self selectedProjects.
+ ((holder value ? #()) includes:pkg) ifFalse:[
+ holder value:(Array with:pkg).
+ ]
+ ].
+
+ (self selectedProtocolsValue contains:[:p | (p isNil and:[mthd category isNil]) or:[p string = mthd category]]) ifFalse:[
+ (self selectedProtocolsValue includes:BrowserList nameListEntryForALL) ifFalse:[
+ self selectProtocols:(Array with:mthd category).
+ ]
+ ].
+ self theSingleSelectedMethod ~~ mthd ifTrue:[
+ self selectedMethods value:(Array with:mthd).
+ ]
+ ]
+ ]
+ ].
+
+ "Created: / 04-02-2000 / 23:20:34 / cg"
+ "Modified: / 05-02-2000 / 23:07:10 / cg"
+ "Modified: / 10-09-2013 / 14:58:03 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!NewSystemBrowser methodsFor:'private-buffers'!
@@ -52041,39 +52052,39 @@
s := '' writeStream.
(aClass isRealNameSpace) ifTrue:[
- aClass fileOutDefinitionOn:s
- ] ifFalse:[
- aClass theNonMetaclass isJavaClass ifTrue:[
- | src |
- src := aClass theNonMetaclass source.
- src notNil ifTrue:[ ^ src ].
- s nextPutLine: '// *** WARNING ***'.
- s nextPutLine: '// Following code has been decompiled from loaded class'.
- s nextPutLine: '// *** WARNING ***'.
- s cr.
- aClass fileOutDefinitionOn:s
- ] ifFalse:[
- aClass isMeta ifTrue:[
- aClass
- fileOutClassInstVarDefinitionOn:s
- withNameSpace:true.
- ] ifFalse:[
- "/
- "/ here, show it with a nameSpace pragma
- "/ and prefer short names.
- "/
- aClass
- basicFileOutDefinitionOn:s
- withNameSpace:true
- withPackage:false
- ].
- ].
+ aClass fileOutDefinitionOn:s
+ ] ifFalse:[
+ aClass theNonMetaclass isJavaClass ifTrue:[
+ | src |
+ src := aClass theNonMetaclass source.
+ src notNil ifTrue:[ ^ src ].
+ s nextPutLine: '// *** WARNING ***'.
+ s nextPutLine: '// Following code has been decompiled from loaded class'.
+ s nextPutLine: '// *** WARNING ***'.
+ s cr.
+ aClass theNonMetaclass fileOutDefinitionOn:s
+ ] ifFalse:[
+ aClass isMeta ifTrue:[
+ aClass
+ fileOutClassInstVarDefinitionOn:s
+ withNameSpace:true.
+ ] ifFalse:[
+ "/
+ "/ here, show it with a nameSpace pragma
+ "/ and prefer short names.
+ "/
+ aClass
+ basicFileOutDefinitionOn:s
+ withNameSpace:true
+ withPackage:false
+ ].
+ ].
].
^ s contents withTabsExpanded.
"Modified: / 10-11-2006 / 17:13:54 / cg"
- "Modified: / 30-03-2012 / 20:08:01 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 10-09-2013 / 01:31:42 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
commentOrDocumentationStringFromClass:aClass
@@ -52368,9 +52379,8 @@
add documentation as a comment, if there is any
"
info := self commentOrDocumentationStringFromClass:aClass.
- text := definition.
info notNil ifTrue:[
- text := text,(Character cr),info.
+ text := definition,(Character cr),info.
].
self codeHolder setValue:text.
self codeView notNil ifTrue:[
@@ -52380,8 +52390,7 @@
self updatePackageInfoForClass:aClass.
"Modified: / 27-07-2012 / 22:26:12 / cg"
- "Modified: / 05-07-2012 / 21:41:16 / Jan Vrany <jan.vrany@fit.cvut.cz>"
- "Modified (format): / 10-09-2013 / 01:34:25 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 10-09-2013 / 01:34:54 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
showClassDocumentation
@@ -52750,11 +52759,11 @@
showCode:aString
- "No, do not scroll to the top if the code is already displayed!!"
+ "/Do not scroll to the top if the code is already displayed!!"
self showCode:aString scrollToTop:(self codeView contents string ~= aString)
"Modified: / 01-03-2000 / 11:38:33 / cg"
- "Modified: / 04-08-2013 / 11:44:58 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 10-09-2013 / 01:33:04 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
showCode:codeString scrollToTop:doScrollToTop
@@ -52846,21 +52855,23 @@
|code codeView doAutoFormat doSyntaxColoring doUpdateCode prevMthd doShowFullClassSource |
doAutoFormat := self doAutoFormat value and:[RBFormatter notNil].
- doShowFullClassSource := self navigationState isFullClassSourceBrowser or:[mthd isJavaMethod and:[JavaMethod showFullSource]].
+ doShowFullClassSource := self navigationState isFullClassSourceBrowser
+ or:[mthd isJavaMethod].
doUpdateCode := true.
codeView := self codeView.
self assert:codeView notNil.
code := self sourceOfMethod:mthd.
code isText ifTrue:[
+ "/Already done...
doSyntaxColoring := false.
] ifFalse:[
"/Do no coloring here if CodeView2 is used,
"/since CodeView2 itself cares about the coloring!!
"/Not working correctly -> do the coloring until fixed in CodeView2
- "JV: Enable is, otherwise I won't notice that it does not work
- correctly!!"
- (UserPreferences current useCodeView2In: #Browser) ifTrue:[
+ "/JV: Then make a bug report because otherwise it won't be
+ "/ ever fixed.
+ "(UserPreferences current useCodeView2In: #Browser)"false ifTrue:[
doSyntaxColoring := code size < 2000
] ifFalse:[
doSyntaxColoring := self doSyntaxColoring value == true.
@@ -52885,6 +52896,8 @@
prevMthd notNil ifTrue:[
doUpdateCode := prevMthd isSynthetic or:[mthd mclass ~~ prevMthd mclass]
].
+
+
].
].
doUpdateCode ifTrue:[
@@ -52915,19 +52928,20 @@
navigationState lastMethodShownInCodeView: mthd.
"/ scroll, for file-based classes (java, ruby, etc.)
- mthd sourceLineNumber ~~ 1 ifTrue:[
- doScrollToTop ifTrue:[
- codeView scrollToLine:mthd sourceLineNumber.
+ doShowFullClassSource ifTrue:[
+ mthd sourceLineNumber ~~ 1 ifTrue:[
+ doScrollToTop "ifTrue:" ifFalse:[
+ codeView scrollToLine:mthd sourceLineNumber
+ ]
].
].
-
self codeAspect:(code ifNil:[nil] ifNotNil:[SyntaxHighlighter codeAspectMethod]).
self normalLabel.
self updatePackageInfoForMethod:mthd.
"Created: / 01-03-2000 / 11:38:57 / cg"
"Modified: / 27-07-2012 / 22:18:18 / cg"
- "Modified: / 14-09-2013 / 13:22:54 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 10-09-2013 / 01:29:26 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
showNothing
@@ -53630,6 +53644,16 @@
self builder window beep
].
].
+ box enterField
+ onKey:#CursorDown
+ leaveWith:[
+ box listView windowGroup focusView:box listView byTab:true.
+ box listView hasSelection ifFalse:[
+ box listView selectFirst
+ ] ifTrue:[
+ box listView selectNext
+ ]
+ ].
box open.
^ retVal
@@ -55332,7 +55356,6 @@
^ navigationState projectListApplication
! !
-
!NewSystemBrowser methodsFor:'private-history'!
lastSearchPatterns
@@ -55571,31 +55594,40 @@
explainInCode:code short:short withTimeout:withTimeout
"explain the selection or, if there is none, the node under the cursor"
- |explanation explainTookTooLong|
+ |explanation explainTookTooLong html|
explainTookTooLong := false.
withTimeout ifTrue:[
- explanation :=
- [ self explanationForCode:code short:short ]
- valueWithWatchDog:[explainTookTooLong := true]
- afterMilliseconds:200.
- ] ifFalse:[
- explanation := self explanationForCode:code short:short
+ explanation :=
+ [ self explanationForCode:code short:short ]
+ valueWithWatchDog:[explainTookTooLong := true]
+ afterMilliseconds:200.
+ ] ifFalse:[
+ explanation := self explanationForCode:code short:short
].
self activityNotification:nil.
explainTookTooLong ifTrue:[
- self showInfo:'Explain took too long - cancelled.'.
- ^ self.
+ self showInfo:'Explain took too long - cancelled.'.
+ ^ self.
].
explanation notEmptyOrNil ifTrue:[
- short ifTrue:[
- self showInfo:explanation
- ] ifFalse:[
- self information:explanation
- ].
- builder window flush
+ short ifTrue:[
+ self showInfo:explanation
+ ] ifFalse:[
+ explanation isArray ifTrue:[
+ html := explanation detect:[:entry | entry key == #html] ifNone:nil.
+ html notNil ifTrue:[
+ "/ todo: need a stripped down viewer (small, popup, modal)
+ HTMLDocumentView openFullOnText:(html value).
+ ^ self.
+ ].
+ explanation := explanation first value.
+ ].
+ self information:explanation
+ ].
+ builder window flush
].
"Created: / 05-09-2006 / 10:37:04 / cg"
@@ -60766,11 +60798,11 @@
!NewSystemBrowser class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libtool/Tools__NewSystemBrowser.st,v 1.1975 2013-09-05 22:48:24 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libtool/Tools__NewSystemBrowser.st,v 1.1984 2013-09-16 15:12:57 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libtool/Tools__NewSystemBrowser.st,v 1.1975 2013-09-05 22:48:24 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libtool/Tools__NewSystemBrowser.st,v 1.1984 2013-09-16 15:12:57 cg Exp $'
!
version_HG
@@ -60779,7 +60811,7 @@
!
version_SVN
- ^ '$Id: Tools__NewSystemBrowser.st,v 1.1975 2013-09-05 22:48:24 cg Exp $'
+ ^ '$Id: Tools__NewSystemBrowser.st,v 1.1984 2013-09-16 15:12:57 cg Exp $'
! !
--- a/VersionDiffBrowser.st Tue Sep 17 11:25:54 2013 +0100
+++ b/VersionDiffBrowser.st Thu Sep 19 10:20:29 2013 +0100
@@ -1708,42 +1708,42 @@
singleView := self componentAt:#singleTextView.
(Array
- with:leftView
- with:rightView
- with:singleView)
+ with:leftView
+ with:rightView
+ with:singleView)
do:[:v |
- |mGen|
-
- mGen := [
- |m|
-
- m := v editMenu.
-
- (m selectorAt:#accept) isNil ifTrue:[
- m addLabels:(resources array:#('-' 'Accept'))
- selectors:(Array with:nil with:#accept)
- after:#copySelection.
- ].
- m
- actionAt:#accept
- put:[
- v == singleView ifTrue:[
- self acceptInSingleView
- ] ifFalse:[
- v == leftView ifTrue:[
- self acceptInLeftView
- ] ifFalse:[
- self acceptInRightView
- ].
- ].
- ].
- m selectorAt:#accept put:nil.
- m enable:#copySelection.
- m setEnable:#accept to:[self canAcceptInCodeView].
- m
- ].
- v menuHolder:mGen.
- v menuMessage:#value.
+ |mGen|
+
+ mGen := [
+ |m|
+
+ m := v editMenu.
+
+ (m selectorAt:#accept) isNil ifTrue:[
+ m addLabels:(resources array:#('-' 'Accept'))
+ selectors:#(nil #accept)
+ after:#copySelection.
+ ].
+ m
+ actionAt:#accept
+ put:[
+ v == singleView ifTrue:[
+ self acceptInSingleView
+ ] ifFalse:[
+ v == leftView ifTrue:[
+ self acceptInLeftView
+ ] ifFalse:[
+ self acceptInRightView
+ ].
+ ].
+ ].
+ m selectorAt:#accept put:nil.
+ m enable:#copySelection.
+ m setEnable:#accept to:[self canAcceptInCodeView].
+ m
+ ].
+ v menuHolder:mGen.
+ v menuMessage:#value.
]
!
@@ -2481,11 +2481,11 @@
!VersionDiffBrowser class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libtool/VersionDiffBrowser.st,v 1.116 2013-08-07 09:57:46 stefan Exp $'
+ ^ '$Header: /cvs/stx/stx/libtool/VersionDiffBrowser.st,v 1.117 2013-09-12 08:29:48 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libtool/VersionDiffBrowser.st,v 1.116 2013-08-07 09:57:46 stefan Exp $'
+ ^ '$Header: /cvs/stx/stx/libtool/VersionDiffBrowser.st,v 1.117 2013-09-12 08:29:48 cg Exp $'
!
version_HG
--- a/ViewWithAcceptAndCancelBar.st Tue Sep 17 11:25:54 2013 +0100
+++ b/ViewWithAcceptAndCancelBar.st Thu Sep 19 10:20:29 2013 +0100
@@ -143,14 +143,14 @@
|app|
slaveView notNil ifTrue:[
- (app := self application) notNil ifTrue:[
- (changedObject == reallyModifiedHolder
- or:[ changedObject == slaveView modifiedChannel ]) ifTrue:[
- app
- enqueueMessage:#updateBarVisibility
- for:self
- arguments:#().
- ].
+ (changedObject == reallyModifiedHolder
+ or:[ changedObject == slaveView modifiedChannel ]) ifTrue:[
+ (app := self application) notNil ifTrue:[
+ "/ not sure if we really need to send it through the application
+ app enqueueMessage:#updateBarVisibility for:self arguments:#().
+ ] ifFalse:[
+ self sensor pushUserEvent:#updateBarVisibility for:self withArguments:#()
+ ]
].
].
super update:something with:aParameter from:changedObject
@@ -287,11 +287,11 @@
!ViewWithAcceptAndCancelBar class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libtool/ViewWithAcceptAndCancelBar.st,v 1.11 2012-09-26 12:44:28 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libtool/ViewWithAcceptAndCancelBar.st,v 1.12 2013-09-06 15:09:05 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libtool/ViewWithAcceptAndCancelBar.st,v 1.11 2012-09-26 12:44:28 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libtool/ViewWithAcceptAndCancelBar.st,v 1.12 2013-09-06 15:09:05 cg Exp $'
!
version_HG
--- a/resources/de.rs Tue Sep 17 11:25:54 2013 +0100
+++ b/resources/de.rs Thu Sep 19 10:20:29 2013 +0100
@@ -1,6 +1,6 @@
#encoding utf8
-; $Header: /cvs/stx/stx/libtool/resources/de.rs,v 1.239 2013-09-05 13:47:52 cg Exp $
+; $Header: /cvs/stx/stx/libtool/resources/de.rs,v 1.240 2013-09-17 21:28:02 cg Exp $
;
; German Workspace (and other tools) resources
;
@@ -574,7 +574,7 @@
'Inspect' 'Inspizieren'
'Inspect Class' 'Klasse inspizieren'
-'Inspect Subclasses' 'Subklasse inspizieren'
+'Inspect Subclasses' 'Subklassen inspizieren'
'Inspect Instances' 'Instanzen inspizieren'
'Inspect Derived Instances' 'Abgeleitete Instanzen inspizieren'