--- a/BrowserView.st Wed Oct 29 16:56:36 1997 +0100
+++ b/BrowserView.st Wed Oct 29 17:02:53 1997 +0100
@@ -193,6 +193,14 @@
"Modified: 15.8.1997 / 15:29:16 / cg"
!
+fileImageIcon
+ "answer an icon to mark file-loading image methods"
+
+ ^ self imageIcon
+
+ "Created: / 29.10.1997 / 03:32:43 / cg"
+!
+
imageIcon
"answer an icon to mark image (menuSpec) methods"
@@ -4216,6 +4224,17 @@
"Modified: 16.1.1997 / 01:46:39 / cg"
!
+classDoubleClick:lineNr
+ currentClass notNil ifTrue:[
+ currentClass isVisualStartable ifTrue:[
+ currentClass open
+ ]
+ ]
+
+ "Modified: / 28.10.1997 / 12:45:05 / cg"
+ "Created: / 29.10.1997 / 15:50:26 / cg"
+!
+
classListUpdate
RememberAspect ifTrue:[
aspect == #hierarchy ifTrue:[
@@ -5532,6 +5551,7 @@
v := classListView.
v notNil ifTrue:[
v action:[:lineNr | self classSelection:lineNr].
+ v doubleClickAction:[:lineNr | self classDoubleClick:lineNr].
v selectConditionBlock:checkBlock.
v ignoreReselect:false.
"
@@ -5591,7 +5611,7 @@
]
"Created: / 24.7.1997 / 18:14:59 / cg"
- "Modified: / 27.10.1997 / 00:29:30 / cg"
+ "Modified: / 29.10.1997 / 15:50:26 / cg"
!
terminate
@@ -7201,28 +7221,29 @@
w := currentMethod who.
w notNil ifTrue:[
- cls := w methodClass.
- cls notNil ifTrue:[
- cls ~~ actualClass ifTrue:[
- ^ self warn:'oops - obsolete class; please reselect class ...'
- ].
- cls isMeta ifTrue:[
- cls := cls soleInstance
- ] ifFalse:[
- cls := nil
- ].
- cls notNil ifTrue:[
- sel := w methodSelector.
- sel notNil ifTrue:[
- actualClass perform:sel.
- ^ self
- ]
- ]
- ].
+ cls := w methodClass.
+ cls notNil ifTrue:[
+ cls ~~ actualClass ifTrue:[
+ ^ self warn:'oops - obsolete class; please reselect class ...'
+ ].
+ cls isMeta ifTrue:[
+ cls := cls soleInstance
+ ] ifFalse:[
+ cls := nil
+ ].
+ cls notNil ifTrue:[
+ sel := w methodSelector.
+ sel notNil ifTrue:[
+ currentClass perform:sel.
+ ^ self
+ ]
+ ]
+ ].
].
self warn:'cannot invoke method (no class)'
- "Modified: 29.4.1997 / 11:24:30 / dq"
+ "Modified: / 29.4.1997 / 11:24:30 / dq"
+ "Modified: / 29.10.1997 / 15:50:28 / cg"
!
methodLocalSuperSends
@@ -8130,8 +8151,12 @@
(resources includesKey:#image) ifTrue:[
icn := self imageIcon
] ifFalse:[
- (resources includesKey:#programMenu) ifTrue:[
- icn := self programMenuIcon
+ (resources includesKey:#fileImage) ifTrue:[
+ icn := self fileImageIcon
+ ] ifFalse:[
+ (resources includesKey:#programMenu) ifTrue:[
+ icn := self programMenuIcon
+ ]
]
]
]
@@ -8146,7 +8171,7 @@
^ s
"Created: / 22.10.1996 / 19:51:00 / cg"
- "Modified: / 28.10.1997 / 13:39:38 / cg"
+ "Modified: / 29.10.1997 / 03:31:41 / cg"
!
listOfAllMethodsInCategory:aCategory inFullProtocolHierarchyOfClass:aClass
@@ -8867,6 +8892,8 @@
!BrowserView methodsFor:'namespace menu'!
nameSpaceMenu
+ <resource: #programMenu >
+
|labels selectors|
labels := #('new namespace').
@@ -8884,20 +8911,20 @@
(currentNamespace notNil
and:[currentNamespace ~~ Smalltalk
and:[currentNamespace ~= '* all *']]) ifTrue:[
- "/ is it all empty ?
- currentNamespace allClasses isEmpty ifTrue:[
- labels := labels , #('-' 'remove').
- selectors := selectors , #(nil nameSpaceRemove).
- ]
+ "/ is it all empty ?
+ currentNamespace allClasses isEmpty ifTrue:[
+ labels := labels , #('-' 'remove').
+ selectors := selectors , #(nil nameSpaceRemove).
+ ]
].
^ PopUpMenu
- labels:(resources array:labels)
- selectors:selectors
- receiver:self.
-
- "Created: 4.1.1997 / 23:51:38 / cg"
- "Modified: 31.7.1997 / 22:40:33 / cg"
+ labels:(resources array:labels)
+ selectors:selectors
+ receiver:self.
+
+ "Created: / 4.1.1997 / 23:51:38 / cg"
+ "Modified: / 29.10.1997 / 03:39:12 / cg"
!
nameSpaceNewNameSpace
@@ -9999,55 +10026,84 @@
"tell the codeView what to do on accept and explain"
codeView acceptAction:[:theCode |
- |cat cls rslt|
-
- fullProtocol ifTrue:[
- cls := acceptClass
- ].
- cls isNil ifTrue:[
- cls := actualClass
- ].
- cls isNil ifTrue:[
- self warning:'oops class is gone; reselect and try again'.
- ^ self
- ].
-
- codeView cursor:Cursor execute.
-
- (cat := currentMethodCategory) = '* all *' ifTrue:[
- "must check from which category this code came from ...
- ... thanks to Arno for pointing this out"
-
- cat := self askForMethodCategory.
- ].
- (cat notNil and:[cat notEmpty]) ifTrue:[
- Object abortSignal catch:[
- lockUpdates := true.
-
- rslt := actualClass compilerClass
- compile:theCode asString
- forClass:cls
- inCategory:cat
- notifying:codeView.
-
- codeView modified:false.
- currentMethod := actualClass compiledMethodAt:currentSelector.
- self updateMethodListWithScroll:false keepSelection:(rslt == currentMethod).
- self normalLabel.
- ].
- lockUpdates := false.
- ].
- codeView cursor:Cursor normal.
+ |cat cls rslt|
+
+ fullProtocol ifTrue:[
+ cls := acceptClass
+ ].
+ cls isNil ifTrue:[
+ cls := actualClass.
+ cls isNil ifTrue:[
+ self warning:'oops class is gone; reselect and try again'.
+ ^ self
+ ].
+ ].
+
+ codeView cursor:Cursor execute.
+
+ (cat := currentMethodCategory) = '* all *' ifTrue:[
+ "must check from which category this code came from ...
+ ... thanks to Arno for pointing this out"
+
+ cat := self askForMethodCategory.
+ ].
+ (cat notNil and:[cat notEmpty]) ifTrue:[
+ Object abortSignal catch:[
+ lockUpdates := true.
+
+ Class methodRedefinitionSignal handle:[:ex |
+ |answer oldVsNew oldPkg newPkg|
+
+ oldVsNew := ex parameter.
+ oldPkg := oldVsNew key package.
+ newPkg := oldVsNew value package.
+ answer := OptionBox
+ request:
+('You are about to change code from another (system-) package.
+The methods original packageID was ''%1''.
+If you proceed, the new code will be marked as belonging
+to the ''%2'' package (and this warning will not be shown again).
+If you proceed with ''keep'', the old packageID will be preserved.
+Otherwise, hit ''cancel'' to leave the code unchanged.
+
+PS: you can disable these checks in the launchers settings-compilation dialog.' bindWith:oldPkg with:newPkg)
+
+ label:'Method redefinition'
+ form:(WarningBox iconBitmap)
+ buttonLabels:#('cancel' 'keep' 'continue')
+ values:#(#cancel #keep #continue)
+ default:#continue.
+
+ (answer ~~ #cancel) ifTrue:[
+ ex proceedWith:answer
+ ]
+ ] do:[
+
+ rslt := actualClass compilerClass
+ compile:theCode asString
+ forClass:cls
+ inCategory:cat
+ notifying:codeView.
+
+ codeView modified:false.
+ currentMethod := actualClass compiledMethodAt:currentSelector.
+ self updateMethodListWithScroll:false keepSelection:(rslt == currentMethod).
+ self normalLabel.
+ ]
+ ].
+ lockUpdates := false.
+ ].
+ codeView cursor:Cursor normal.
].
codeView explainAction:[:theCode :theSelection |
- self showExplanation:(Explainer
- explain:theSelection
- in:theCode
- forClass:actualClass)
- ].
-
- "Modified: 19.6.1997 / 18:57:35 / cg"
+ self showExplanation:(Explainer
+ explain:theSelection
+ in:theCode
+ forClass:actualClass)
+ ].
+
+ "Modified: / 29.10.1997 / 15:48:35 / cg"
!
setDoitActionForClass
@@ -10178,6 +10234,15 @@
"Created: 1.8.1997 / 12:36:14 / cg"
!
+fileImageIcon
+ "answer an icon to mark fileImage methods"
+
+ ^ self class fileImageIcon
+
+ "Modified: / 7.4.1997 / 17:31:40 / cg"
+ "Created: / 29.10.1997 / 03:32:05 / cg"
+!
+
imageIcon
"answer an icon to mark image methods"
@@ -11073,6 +11138,6 @@
!BrowserView class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libtool/BrowserView.st,v 1.345 1997-10-28 18:26:12 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libtool/BrowserView.st,v 1.346 1997-10-29 16:02:53 cg Exp $'
! !
BrowserView initialize!