--- a/BrowserView.st Tue Oct 24 20:24:22 2000 +0200
+++ b/BrowserView.st Wed Oct 25 12:24:39 2000 +0200
@@ -1037,17 +1037,17 @@
|brwsr|
brwsr := SystemBrowser openInClass:actualClass selector:currentSelector.
- environment notNil ifTrue:[
- brwsr environment:environment.
- brwsr switchToClassNamed:actualClass name.
- brwsr classSelectionChanged.
- currentSelector notNil ifTrue:[
- brwsr switchToMethodNamed:currentSelector.
- ]
+
+ brwsr environment:environment.
+ brwsr switchToClassNamed:actualClass name.
+ brwsr classSelectionChanged.
+ currentSelector notNil ifTrue:[
+ brwsr switchToMethodNamed:currentSelector.
].
"Created: 14.9.1995 / 10:55:20 / claus"
- "Modified: 14.9.1995 / 10:59:31 / claus"!
+ "Modified: 14.9.1995 / 10:59:31 / claus"
+!
classCategoryFileOut
"create a file 'categoryName.st' consisting of all classes in current category
@@ -1484,7 +1484,7 @@
self environment ~~ Smalltalk ifTrue:[
specialMenu disableAll:#(classCategoryValidateClassRevisions classCategoryCheckinEach
- classCategoryLoadFromRepository
+ classCategoryLoadFromRepository classCategoryFileOutBinaryEach
)
].
@@ -1500,6 +1500,7 @@
('clone' classCategoryClone )
('open for class...' classCategoryOpenInClass )
('spawn full class' classCategorySpawnFullClass )
+ ('class extensions' classCategorySpawnExtensions )
('-' nil )
('update' classCategoryUpdate )
('find class...' classCategoryFindClass #Find )
@@ -1526,6 +1527,7 @@
('open for class...' classCategoryOpenInClass Cmdo )
('SPAWN_CATEGORY' classCategorySpawn )
('spawn full class' classCategorySpawnFullClass )
+ ('class extensions' classCategorySpawnExtensions )
('-' nil )
('update' classCategoryUpdate )
('find class...' classCategoryFindClass Find )
@@ -1572,7 +1574,8 @@
"Created: / 14.9.1995 / 10:50:17 / claus"
"Modified: / 16.1.1998 / 17:16:28 / stefan"
- "Modified: / 7.8.1998 / 18:39:46 / cg"!
+ "Modified: / 7.8.1998 / 18:39:46 / cg"
+!
classCategoryNewCategory
|box|
@@ -1786,13 +1789,38 @@
|brwsr|
brwsr := SystemBrowser browseClassCategory:currentClassCategory.
- environment notNil ifTrue:[
- brwsr environment:environment
- ].
- ]
- ]
-
- "Modified: 18.8.1997 / 15:42:58 / cg"!
+ brwsr environment:environment
+ ]
+ ]
+
+ "Modified: 18.8.1997 / 15:42:58 / cg"
+!
+
+classCategorySpawnExtensions
+ "create a new SystemBrowser browsing all extensions"
+
+ self withBusyCursorDo:[
+ |brwsr methods|
+
+ methods := IdentitySet new.
+ environment allClassesDo:[:eachClass |
+ |classPackage|
+
+ classPackage := eachClass package.
+ eachClass methodDictionary keysAndValuesDo:[:sel :mthd |
+ mthd package ~= classPackage ifTrue:[ methods add:mthd ].
+ ].
+ eachClass theMetaclass methodDictionary keysAndValuesDo:[:sel :mthd |
+ mthd package ~= classPackage ifTrue:[ methods add:mthd ].
+ ].
+ ].
+
+ brwsr := SystemBrowser browseMethods:methods title:'All Class extensions'.
+ brwsr environment:environment
+ ]
+
+ "Modified: 18.8.1997 / 15:42:58 / cg"
+!
classCategorySpawnFullClass
"create a new SystemBrowser browsing full class"
@@ -1801,9 +1829,7 @@
self withBusyCursorDo:[
newBrowser := SystemBrowser browseFullClasses.
- environment notNil ifTrue:[
- newBrowser environment:environment
- ].
+ newBrowser environment:environment.
" "
currentClass notNil ifTrue:[
newBrowser switchToClassNamed:(currentClass name)
@@ -1811,7 +1837,8 @@
" "
]
- "Modified: 18.8.1997 / 15:43:01 / cg"!
+ "Modified: 18.8.1997 / 15:43:01 / cg"
+!
classCategoryUpdate
"update class category list and dependants"
@@ -3410,6 +3437,7 @@
self environment ~~ Smalltalk ifTrue:[
specialMenu disableAll:#(classMakePrivate classMakePublic classModifyContainer classRemoveContainer
classRevisionInfo classLoadRevision classCheckin classModifyPackage
+ classLoadNewRevision classFileOutBinary classFileOutBinaryAs
)
].
@@ -3552,7 +3580,8 @@
].
^ m
- "Modified: / 20.5.1999 / 18:36:25 / cg"!
+ "Modified: / 20.5.1999 / 18:36:25 / cg"
+!
classNewApplication
"create a class-definition prototype for an application in codeview"
@@ -3908,9 +3937,7 @@
^ self
].
browser := SystemBrowser browseClass:cls.
- environment notNil ifTrue:[
- browser environment:environment
- ].
+ browser environment:environment.
cls hasMethods ifFalse:[
browser instanceProtocol:false.
].
@@ -3924,27 +3951,26 @@
select 'Smalltalk' and use spawn from the class menu
"
- "Modified: 20.12.1996 / 15:41:16 / cg"!
+ "Modified: 20.12.1996 / 15:41:16 / cg"
+!
classSpawnFullProtocol
"create a new browser, browsing current classes full protocol"
self doClassMenuWithSelection:[:cls :sel | |brwsr|
brwsr := SystemBrowser browseFullClassProtocol:cls.
- environment notNil ifTrue:[
- brwsr environment:environment
- ]
- ]!
+ brwsr environment:environment
+ ]
+!
classSpawnHierarchy
"create a new HierarchyBrowser browsing current class"
self doClassMenuWithSelection:[:cls :sel | |brwsr|
brwsr := SystemBrowser browseClassHierarchy:cls.
- environment notNil ifTrue:[
- brwsr environment:environment
- ]
- ]!
+ brwsr environment:environment
+ ]
+!
classSpawnSubclasses
"create a new browser browsing current class's subclasses"
@@ -3961,13 +3987,12 @@
brwsr := SystemBrowser browseClasses:subs
title:('subclasses of ' , cls name)
sort:false.
- environment notNil ifTrue:[
- brwsr environment:environment
- ]
- ]
- ]
-
- "Modified: 4.1.1997 / 13:35:55 / cg"!
+ brwsr environment:environment
+ ]
+ ]
+
+ "Modified: 4.1.1997 / 13:35:55 / cg"
+!
classUnload
"unload an autoloaded class"
@@ -5793,12 +5818,11 @@
|brwsr|
brwsr := SystemBrowser openInClass:actualClass selector:currentSelector.
- environment notNil ifTrue:[
- brwsr environment:environment
- ].
+ brwsr environment:environment
"Created: 13.12.1995 / 15:05:12 / cg"
- "Modified: 13.12.1995 / 15:06:26 / cg"!
+ "Modified: 13.12.1995 / 15:06:26 / cg"
+!
classMethodFileOutAll
"fileout all methods into one source file"
@@ -6189,6 +6213,10 @@
|pos s|
s := aString string withoutSpaces.
+ (s endsWith:'???') ifTrue:[
+ s := s copyWithoutLast:3. "/ kludge
+ s := s withoutSpaces.
+ ].
(s includes:${ ) ifTrue:[
s := s copyTo:(s indexOf:${ ) - 1.
s := s withoutSpaces.
@@ -8119,13 +8147,12 @@
brwsr := SystemBrowser browseClass:actualClass
methodCategory:currentMethodCategory.
- environment notNil ifTrue:[
- brwsr environment:environment
- ].
- ]
- ]
-
- "Modified: 18.8.1997 / 15:44:18 / cg"!
+ brwsr environment:environment
+ ]
+ ]
+
+ "Modified: 18.8.1997 / 15:44:18 / cg"
+!
methodCategorySpawnCategory
"create a new SystemBrowser browsing all methods from all
@@ -8974,8 +9001,8 @@
methodMenu
"return a popupmenu as appropriate for the methodList"
+ <resource: #programMenu >
<resource: #keyboard ( #Cmds #Cmdi #Cmdg #Cmdt #Cmda #Ctrl) >
- <resource: #programMenu >
|specialMenu m items
newItems brkItems fileItems mthdItems
@@ -9231,7 +9258,8 @@
"Created: / 23.11.1995 / 12:02:29 / cg"
"Modified: / 18.12.1995 / 16:20:07 / stefan"
"Modified: / 29.4.1997 / 11:20:59 / dq"
- "Modified: / 30.4.1999 / 09:15:32 / cg"!
+ "Modified: / 30.4.1999 / 09:15:32 / cg"
+!
methodModifyPackage
"change the methods package assignment"
@@ -9678,13 +9706,11 @@
self withBusyCursorDo:[
w := currentMethod who.
brwsr := SystemBrowser browseClass:(w methodClass) selector:(w methodSelector).
- environment notNil ifTrue:[
- brwsr environment:environment
- ].
-
- ]
-
- "Modified: 18.8.1997 / 15:46:10 / cg"!
+ brwsr environment:environment
+ ]
+
+ "Modified: 18.8.1997 / 15:46:10 / cg"
+!
methodStartCounting
"set a countpoint on the current method"
@@ -10751,11 +10777,11 @@
nameSpaceMenu
<resource: #programMenu >
- |items|
+ |items m|
items := #(
- ('new namespace' nameSpaceNewNameSpace)
- ).
+ ('new namespace' nameSpaceNewNameSpace)
+ ).
"/ showAllNamespaces ifTrue:[
"/ items := items , #( ('-') ('show topLevel namespaces only' showTopLevelNamespaces)).
@@ -10767,22 +10793,26 @@
(currentNamespace notNil
and:[currentNamespace ~~ Smalltalk
and:[currentNamespace ~= '* all *']]) ifTrue:[
- "/ is it all empty ?
- currentNamespace allClasses isEmpty ifTrue:[
- items := items , #(
- ('-')
- ('remove' nameSpaceRemove)).
- ] ifFalse:[
- items := items , #(
- ('-')
- ('remove all classes...' nameSpaceRemoveAllClasses)
- ('-')
- ('checkin each...' nameSpaceCheckInEach)
- ).
- ]
- ].
-
- ^ PopUpMenu itemList:items resources:resources performer:self
+ "/ is it all empty ?
+ currentNamespace allClasses isEmpty ifTrue:[
+ items := items , #(
+ ('-')
+ ('remove' nameSpaceRemove)).
+ ] ifFalse:[
+ items := items , #(
+ ('-')
+ ('remove all classes...' nameSpaceRemoveAllClasses)
+ ('-')
+ ('checkin each...' nameSpaceCheckInEach)
+ ).
+ ]
+ ].
+
+ m := PopUpMenu itemList:items resources:resources performer:self.
+ self environment ~~ Smalltalk ifTrue:[
+ m disableAll:#(nameSpaceRemove nameSpaceRemoveAllClasses nameSpaceCheckInEach nameSpaceNewNameSpace)
+ ].
+ ^ m.
"Created: / 4.1.1997 / 23:51:38 / cg"
"Modified: / 3.2.1999 / 20:13:57 / cg"
@@ -12137,79 +12167,82 @@
setAcceptActionForClass
"tell the codeView what to do on accept and explain"
+ ((environment ~~ Smalltalk)
+ or:[ (currentClass isNameSpace and:[currentClass ~~ Smalltalk])
+ or:[ currentClass isLoaded not ]])
+ ifTrue:[
+ self clearAcceptAction.
+ ^ self
+ ].
currentClass isJavaClass ifTrue:[
^ self setAcceptActionForJavaClass.
].
- (currentClass isNameSpace and:[currentClass ~~ Smalltalk]) ifTrue:[
- self clearAcceptAction.
- ] ifFalse:[
- codeView acceptAction:[:theCode |
- |ns|
-
- currentClass notNil ifTrue:[
- ns := currentClass nameSpace
- ] ifFalse:[
- ns := nil
- ].
-
- codeView withWaitCursorDo:[
-
- Class nameSpaceQuerySignal handle:[:ex |
- ns isNil ifTrue:[
- ex reject
- ].
- ex proceedWith:ns
- ] do:[
- Object abortSignal catch:[
- UndefinedObject createMinimumProtocolInNewSubclassQuery
- answer:true
- do:[
- (Class classRedefinitionSignal)handle:[:ex |
- |answer oldVsNew oldPkg newPkg|
-
- oldVsNew := ex parameter.
- oldPkg := oldVsNew key package.
- newPkg := oldVsNew value package.
+ codeView acceptAction:[:theCode |
+ |ns|
+
+ currentClass notNil ifTrue:[
+ ns := currentClass nameSpace
+ ] ifFalse:[
+ ns := nil
+ ].
+
+ codeView withWaitCursorDo:[
+
+ Class nameSpaceQuerySignal handle:[:ex |
+ ns isNil ifTrue:[
+ ex reject
+ ].
+ ex proceedWith:ns
+ ] do:[
+ Object abortSignal catch:[
+ UndefinedObject createMinimumProtocolInNewSubclassQuery
+ answer:true
+ do:[
+ (Class classRedefinitionSignal)handle:[:ex |
+ |answer oldVsNew oldPkg newPkg|
+
+ oldVsNew := ex parameter.
+ oldPkg := oldVsNew key package.
+ newPkg := oldVsNew value package.
"/ cg: now always keep the old packageID
- answer := OptionBox
- request:
+ answer := OptionBox
+ request:
('You are about to change the definition of a class from another (system-) package.
The class is part of the ''%1'' package.
PS: you can disable this check in the launchers settings-compilation dialog.'
- bindWith:(oldPkg asText allBold))
-
- label:'Class redefinition'
- form:(WarningBox iconBitmap)
- buttonLabels:#('cancel' 'continue')
- values:#(#cancel #keep)
- default:#keep.
-
- (answer ~~ #cancel) ifTrue:[
- ex proceedWith:answer
- ]
- ] do:[
- |rslt|
-
- rslt := Compiler
- evaluate:theCode asString
- notifying:codeView
- compile:false.
-
- rslt isBehavior ifTrue:[
- self classCategoryUpdate.
- self updateClassListWithScroll:false.
- codeView modified:false.
- codeModified := false.
- ].
+ bindWith:(oldPkg asText allBold))
+
+ label:'Class redefinition'
+ form:(WarningBox iconBitmap)
+ buttonLabels:#('cancel' 'continue')
+ values:#(#cancel #keep)
+ default:#keep.
+
+ (answer ~~ #cancel) ifTrue:[
+ ex proceedWith:answer
]
+ ] do:[
+ |rslt|
+
+ rslt := Compiler
+ evaluate:theCode asString
+ notifying:codeView
+ compile:false.
+
+ rslt isBehavior ifTrue:[
+ self classCategoryUpdate.
+ self updateClassListWithScroll:false.
+ codeView modified:false.
+ codeModified := false.
+ ].
]
- ].
+ ]
].
].
].
- ]
+ ].
"Modified: / 10.2.2000 / 14:14:46 / cg"
!
@@ -12217,6 +12250,12 @@
setAcceptActionForClassInstVars
"tell the codeView what to do on accept"
+ ((environment ~~ Smalltalk)
+ or:[ currentClass isLoaded not ])
+ ifTrue:[
+ self clearAcceptAction.
+ ^ self
+ ].
codeView acceptAction:[:theCode |
codeView withWaitCursorDo:[
Object abortSignal catch:[
@@ -12239,6 +12278,10 @@
setAcceptActionForFullClass
"tell the codeView what to do on accept"
+ (environment ~~ Smalltalk) ifTrue:[
+ self clearAcceptAction.
+ ^ self
+ ].
codeView acceptAction:[:theCode |
codeView withWaitCursorDo:[
Object abortSignal catch:[
@@ -12261,6 +12304,10 @@
setAcceptActionForNewClass
"tell the codeView what to do on accept and explain"
+ (environment ~~ Smalltalk) ifTrue:[
+ self clearAcceptAction.
+ ^ self
+ ].
codeView acceptAction:[:theCode |
codeView withWaitCursorDo:[
Object abortSignal catch:[
@@ -12288,7 +12335,6 @@
].
].
self clearExplainAction.
-
!
setAcceptActionForNewJavaClass
@@ -12326,6 +12372,10 @@
setAcceptAndExplainActionsForMethod
"tell the codeView what to do on accept and explain"
+ (environment ~~ Smalltalk) ifTrue:[
+ self clearAcceptAction.
+ ^ self
+ ].
codeView acceptAction:[:theCode |
|cat cls rslt|
@@ -12433,7 +12483,8 @@
"/ ]
"/ ].
- "Modified: / 10.2.2000 / 14:17:14 / cg"!
+ "Modified: / 10.2.2000 / 14:17:14 / cg"
+!
setDoitActionForClass
"tell the codeView what to do on doIt"
@@ -13739,6 +13790,6 @@
!BrowserView class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libtool/BrowserView.st,v 1.643 2000-10-24 18:22:41 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libtool/BrowserView.st,v 1.644 2000-10-25 10:24:39 cg Exp $'
! !
BrowserView initialize!