hg/stx-libtool: comparison BrowserView.st

equal deleted inserted replaced

-:a9e69d353cb8
+:9806b72e36f9
 ].
 ]
 "Created: / 4.1.1997 / 13:54:00 / cg"
 "Modified: / 30.7.1998 / 17:33:03 / cg"
-"Modified: / 27.10.1998 / 12:02:05 / ps"!
+"Modified: / 27.10.1998 / 12:02:05 / ps"
+!
 refetchClass
 "after a class definition change in another browser,
 this is sent to update (otherwise, we'd still refer to the obsolete class)"
 "/    ] ifFalse:[
 "/        actualClass := currentClass class
 "/    ].
 "Created: / 8.2.1996 / 13:22:27 / cg"
-"Modified: / 17.6.1998 / 16:51:14 / cg"!
+"Modified: / 17.6.1998 / 16:51:14 / cg"
+!
 update:something with:someArgument from:changedObject
 "enqueue a delayed update"
 |argList sensor|
 ].
 ].
 ]
 "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
 into the current projects defaultDirectory."
 ].
 box showAtPointer.
 ] valueWithRestart
-"Modified: / 25.1.2000 / 21:51:59 / cg"!
+"Modified: / 25.1.2000 / 21:51:59 / cg"
+!
 classCategoryMenu
 <resource: #keyboard ( #Find #Cmdn) >
 <resource: #programMenu >
 aClass printOutProtocolOn:printStream.
 printStream close
 ]
 ]
-"Modified: 16.1.1997 / 20:22:12 / cg"!
+"Modified: 16.1.1997 / 20:22:12 / cg"
+!
 classCategoryRemove
 "remove all classes in current category"
 |count overallCount t classesToRemove subclassesRemoved box t2|
 brwsr := SystemBrowser browseClassCategory:currentClassCategory.
 brwsr environment:environment
 ]
 ]
-"Modified: 18.8.1997 / 15:42:58 / cg"!
+"Modified: 18.8.1997 / 15:42:58 / cg"
+!
 classCategorySpawnExtensions
 "create a new SystemBrowser browsing all extensions"
 self withBusyCursorDo:[
 brwsr switchToClassNamed:(currentClass name)
 ]
 " "
 ]
-"Modified: 18.8.1997 / 15:43:01 / cg"!
+"Modified: 18.8.1997 / 15:43:01 / cg"
+!
 classCategoryUpdate
 "update class category list and dependants"
 |oldClass oldClassName oldMethodCategory newClass|
 ].
 self updateNamespaceList
 ]
-"Modified: / 10.4.1998 / 12:25:38 / cg"! !
+"Modified: / 10.4.1998 / 12:25:38 / cg"
+! !
 !BrowserView methodsFor:'class category source administration'!
 classCategoryCheckinEach
 (self checkSelectionChangeAllowedWithCompare:false) ifFalse:[^ self].
 self normalLabel.
 ]
 ]
 "Modified: / 16.1.1998 / 17:12:24 / stefan"
-"Modified: / 10.4.1998 / 12:25:34 / cg"!
+"Modified: / 10.4.1998 / 12:25:34 / cg"
+!
 classCategorySelectionChanged
 "class category has changed - update dependent views"
 self withBusyCursorDo:[
 newList add:'* all *'; add:'* hierarchy *'.
 ].
 ^ newList asOrderedCollection sort.
-"Modified: 5.1.1997 / 17:12:01 / cg"!
+"Modified: 5.1.1997 / 17:12:01 / cg"
+!
 renameCurrentClassCategoryTo:aString
 "helper - do the rename"
 |any categories|
 self updateMethodCategoryList.
 self switchToMethodNamed:aSelectorString.
 ].
 "Modified: / 1.9.1995 / 01:39:58 / claus"
-"Modified: / 25.1.2000 / 20:43:35 / cg"!
+"Modified: / 25.1.2000 / 20:43:35 / cg"
+!
 updateClassCategoryList
 self updateClassCategoryListWithScroll:true.
 "Modified: 8.1.1997 / 10:58:06 / cg"
 ].
 aspect := #definition.
 self normalLabel
 ]
-"Modified: / 18.7.1998 / 22:52:50 / cg"!
+"Modified: / 18.7.1998 / 22:52:50 / cg"
+!
 classDerivedInstancesInspect
 "inspect the current classes derived instances"
 |insts|
 classMakePublic
 "change a class from private to public;
 check if a public class with the same name exists,
 before doing this."
-(Smalltalk classNamed:(currentClass nameWithoutPrefix)) notNil ifTrue:[
+|ns baseName|
-	self warn:(resources
-			string:'a public class named ''%1'' already exists.\\Please remove/rename that one first,\or rename the private class ''%1'' here\and try again.'
+baseName := currentClass nameWithoutPrefix.
-			with:currentClass nameWithoutPrefix) withCRs.
+(ns := currentClass topOwningClass nameSpace) ~~ Smalltalk ifTrue:[
-	^ self
+ns := Dialog confirmWithCancel:(resources string:'Make public in ''Smalltalk'' or in its nameSpace ''%1'' ?' with:ns name)
-].
+labels:(Array with:'cancel' with:'in Smalltalk' with:'in ' , ns name)
+values:(Array with:nil with:Smalltalk with:ns)
-currentClass makePublic
+default:3.
+ns isNil ifTrue:[^ self].
+].
+(ns classNamed:baseName) notNil ifTrue:[
+self warn:(resources
+string:'A public class named ''%1'' already exists in %2.\\Please remove/rename that one first,\or rename the private class ''%1'' here\and try again.'
+with:baseName with:ns name) withCRs.
+^ self
+].
+currentClass makePublicIn:ns
 "Modified: 3.7.1997 / 13:26:21 / cg"
 !
 classMenu
 ]
 ].
 self doClassMenu:[:currentClass | aBlock value:currentClass value:sel]
 "Modified: 17.6.1996 / 16:51:49 / stefan"
-"Modified: 18.8.1997 / 15:44:01 / cg"! !
+"Modified: 18.8.1997 / 15:44:01 / cg"
+! !
 !BrowserView methodsFor:'class list source administration'!
 classCheckin
 "check a class into the source repository"
 ]
 ]
 ]
 ]
 ].
-^ classes!
+^ classes
+!
 allClassesInCategory:aCategory
 |classes|
 currentNamespace = '* all *' ifTrue:[
 ]
 ].
 ^ classes
 "Created: 23.12.1996 / 10:26:28 / cg"
-"Modified: 23.12.1996 / 11:33:13 / cg"!
+"Modified: 23.12.1996 / 11:33:13 / cg"
+!
 allClassesInCategory:aCategory do:aBlock
 |classes|
 classes := self allClassesInCategory:aCategory.
 aBlock value:aClass
 ]
 ]
 "Created: / 16.1.1997 / 20:18:47 / cg"
-"Modified: / 18.6.1998 / 15:06:23 / cg"!
+"Modified: / 18.6.1998 / 15:06:23 / cg"
+!
 changeCurrentClass:newClass
 "change the current class to some other class;
 keep instance protocol as it was.
 This does not update any views."
 actualClass notNil ifTrue:[
 self addToClassHistory: actualClass name asString
 ]
-"Modified: / 10.2.2000 / 14:14:18 / cg"!
+"Modified: / 10.2.2000 / 14:14:18 / cg"
+!
 classSelectionChanged
 |oldMethodCategory oldMethod oldSelector|
 self withBusyCursorDo:[
 self setDoitActionForClass
 ]
 "Created: / 23.11.1995 / 11:32:03 / cg"
-"Modified: / 24.2.2000 / 15:50:17 / cg"!
+"Modified: / 24.2.2000 / 15:50:17 / cg"
+!
 classTemplateFor:aSuperClass in:categoryString namespace:isNameSpace private:isPrivate
 "return a class definition template - be smart in what is offered initially"
 |cat name nameProto namePrefix i existingNames withNameSpaceDirective
 ].
 ^ listOfClassNames
 "Created: 10.1.1997 / 13:57:34 / cg"
-"Modified: 22.3.1997 / 14:03:36 / cg"!
+"Modified: 22.3.1997 / 14:03:36 / cg"
+!
 listOfClassNameHierarchyOf:aClass
 "return a hierarchy class-list"
 |startClass classes thisOne|
 classes := classes , startClass allSubclassesInOrder
 ].
 ^ classes collect:[:c | self displayedClassNameOf:c "c name"]
 "Created: 10.1.1997 / 14:01:06 / cg"
-"Modified: 30.7.1997 / 17:47:24 / cg"!
+"Modified: 30.7.1997 / 17:47:24 / cg"
+!
 renameCurrentClassTo:newNameString
 "helper - do the class-rename"
 self doClassMenu:[:currentClass |
 className := className copyReplaceAll:$. with:$/
 ].
 self switchToClassNamed:className.
 self classSelectionChanged.
-"Modified: / 22.2.1999 / 18:55:25 / cg"!
+"Modified: / 22.2.1999 / 18:55:25 / cg"
+!
 switchToClassNamed:aString
 |meta str theClass newCat element idx l|
 meta := false.
 brwsr := SystemBrowser openInClass:actualClass selector:currentSelector.
 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"
 |list classString selectorString cls mth outStream fileName append
 methodChangeCategory methodMove methodRemove
 )
 ].
 ^ m
-"Modified: / 7.8.1998 / 17:13:47 / cg"! !
+"Modified: / 7.8.1998 / 17:13:47 / cg"
+! !
 !BrowserView methodsFor:'class-method stuff'!
 classFromClassMethodString:aString
 "helper for classMethod-list - extract class name from the string"
 self setDoitActionForClass
 "Modified: / 31.8.1995 / 11:56:02 / claus"
 "Modified: / 17.6.1996 / 16:51:28 / stefan"
-"Modified: / 24.12.1999 / 02:10:45 / cg"!
+"Modified: / 24.12.1999 / 02:10:45 / cg"
+!
 classNameFromClassMethodString:aString
 "helper for classMethod-list - extract the class name from the string"
 |pos s words clsName|
 Smalltalk addDependent:self.
 "create a history"
 self class classHistory.
-environment := Smalltalk.!
+environment := Smalltalk.
+!
 postRealize
 |v checkBlock|
 super postRealize.
 box label:(resources string:'copy methods').
 box action:[:aString | self copyMethodsFromClass:aString].
 box showAtPointer
-"Modified: 16.1.1997 / 00:01:20 / cg"!
+"Modified: 16.1.1997 / 00:01:20 / cg"
+!
 methodCategoryCreateAccessMethods
 "create access methods for instvars.
 If no variable is selected, for all instvars;
 otherwise for that selected instvar."
 "/        self updateMethodCategoryListWithScroll:false.
 "/        self updateMethodListWithScroll:false
 ]
-"Modified: / 1.2.1998 / 16:10:03 / cg"!
+"Modified: / 1.2.1998 / 16:10:03 / cg"
+!
 methodCategoryCreateDocumentationMethods
 "create empty documentation methods"
 |cls fn txt|
 "/        self updateMethodCategoryListWithScroll:false.
 "/        self updateMethodListWithScroll:false
 ]
-"Modified: / 1.2.1998 / 16:10:03 / cg"!
+"Modified: / 1.2.1998 / 16:10:03 / cg"
+!
 methodCategoryCreateUpdateMethod
 "create an update:with:from: method
 (I'm tired of typing)"
 outStream close.
 self normalLabel.
 ].
 "Modified: / 7.6.1996 / 09:03:56 / stefan"
-"Modified: / 28.10.1997 / 14:37:32 / cg"!
+"Modified: / 28.10.1997 / 14:37:32 / cg"
+!
 methodCategoryMenu
 <resource: #keyboard (#Cmdn)>
 <resource: #programMenu >
 )
 ].
 ^ m
-"Modified: / 10.2.2000 / 13:38:58 / cg"!
+"Modified: / 10.2.2000 / 13:38:58 / cg"
+!
 methodCategoryNewCategory
 "show the enter box to add a new method category.
 Offer existing superclass categories in box to help avoiding
 useless typing."
 category:(box aspectFor:#fieldValue) value
 ]
 ]
 "Modified: / 16.1.1997 / 20:15:51 / cg"
-"Modified: / 19.12.1997 / 12:27:42 / stefan"!
+"Modified: / 19.12.1997 / 12:27:42 / stefan"
+!
 copyMethodsFromClass:class category:category
 currentClass notNil ifTrue:[
 	Object abortSignal catch:[
 	    class methodDictionary do:[:aMethod |
 label:(resources string:'code here')
 and:method source asString string
 label:'method compare'.
 v label:'comparing with ' , className , ' ' , methodName.
-"Modified: 7.11.1996 / 18:53:55 / cg"!
+"Modified: 7.11.1996 / 18:53:55 / cg"
+!
 methodCompareWithPreviousVersion
 "compare with previous version"
 |prev v|
 classified:currentMethodCategory.
 (copiedMethod isNil or:[copiedMethod == #Error]) ifTrue:[
 self warn:'not copied - compilation failed due to an error'.
 ^ self
-].!
+].
+!
 methodDecompile
 "decompile the current methods bytecodes.
 The Decompiler is delivered as an extra, and not normally
 avaliable with the system."
 newText := tree printString.
 codeView contents:newText.
 codeView modified:true.
-"Modified: / 22.11.1999 / 11:53:55 / cg"!
+"Modified: / 22.11.1999 / 11:53:55 / cg"
+!
 methodGlobalReferends
 "launch an enterBox for global symbol to search for"
 self askForSearchTitle:'global variable to search users of:'
 ].
 self methodRemove
 "Created: 13.12.1995 / 10:56:42 / cg"
-"Modified: 25.6.1997 / 13:58:56 / cg"!
+"Modified: 25.6.1997 / 13:58:56 / cg"
+!
 methodNewImageSpec
 "open a BitmapEditor"
 |specSel|
 onToggle turnOn.
 offToggle turnOff.
 ]
 ]
-"Modified: / 31.3.1998 / 23:40:04 / cg"!
+"Modified: / 31.3.1998 / 23:40:04 / cg"
+!
 processName
 "the name of my process - for the processMonitor only"
 ^ 'System Browser'.
 ].
 ].
 self normalLabel.
 "Created: / 23.11.1995 / 14:16:43 / cg"
-"Modified: / 10.2.2000 / 14:15:03 / cg"! !
+"Modified: / 10.2.2000 / 14:15:03 / cg"
+! !
 !BrowserView methodsFor:'namespace menu'!
 nameSpaceCheckInEach
 |classes|
 self changeNameSpaceTo:'* all *'.
 namespaceList contents:'* all *'
 ]
 ].
-"Modified: 18.8.1997 / 15:44:31 / cg"!
+"Modified: 18.8.1997 / 15:44:31 / cg"
+!
 nameSpaceRemoveAllClasses
 "remove all classes in that nameSpace - but only after confirmation"
 |classes|
 classes copy do:[:cls |
 environment removeClass:cls.
 ]
 ]
-"Modified: / 3.2.1999 / 20:18:13 / cg"! !
+"Modified: / 3.2.1999 / 20:18:13 / cg"
+! !
 !BrowserView methodsFor:'namespace stuff'!
 changeNameSpaceTo:nsName
 |n selectedClass str selectedCategory l newCat|
 ]
 ].
 ]
 "Created: 3.1.1997 / 11:11:13 / cg"
-"Modified: 29.1.1997 / 18:33:42 / cg"!
+"Modified: 29.1.1997 / 18:33:42 / cg"
+!
 displayedClassNameOf:aClass
 "depending on the current nameSpace, either show a classes
 fullname or its name without the namespace prefix (if its in the current)"
 ].
 ^ Array with:currentNamespace
 "Created: 26.10.1996 / 11:25:39 / cg"
-"Modified: 20.12.1996 / 19:18:18 / cg"!
+"Modified: 20.12.1996 / 19:18:18 / cg"
+!
 setListOfNamespaces
 |l hasSmalltalk|
 namespaceList isNil ifTrue:[ ^ self ].
 ]
 ]
 ]
 "Created: / 18.6.1998 / 16:39:44 / cg"
-"Modified: / 5.8.1998 / 00:29:54 / cg"!
+"Modified: / 5.8.1998 / 00:29:54 / cg"
+!
 busyLabel:what with:someArgument
 "set the title for some warning"
 self topView
 self information:'This methods functionality is already inherited from ', implClass name.
 ]
 ]
 ].
-"Modified: / 18.2.2000 / 11:34:12 / cg"!
+"Modified: / 18.2.2000 / 11:34:12 / cg"
+!
 checkSelectionChangeAllowed
 "return true, if selection change is ok;
 its not ok, if code has been changed.
 in this case, return the result of a user query"
 aBlock value:aNilSubclass value:0
 ]
 ].
 "Created: 28.5.1996 / 13:46:23 / cg"
-"Modified: 5.1.1997 / 18:44:50 / cg"!
+"Modified: 5.1.1997 / 18:44:50 / cg"
+!
 classesInFullProtocolHierarchy:aClass do:aBlock
 "evaluate aBlock for all non-striked out classes in
 the hierarchy"
 !
 environment
 "allows me to browse something different from Smalltalk (a SnapShotImage for example)"
-^ environment ? Smalltalk!
+^ environment ? Smalltalk
+!
 environment:anEnvironment
 "allows me to browse something different from Smalltalk (a SnapShotImage for example)"
-environment := anEnvironment!
+environment := anEnvironment
+!
 extractClassAndSelectorFromSelectionInto:aBlock
 "given a string which can be either 'class>>sel' or
 'class sel', extract className and selector, and call aBlock with
 the result."
 ] ifFalse:[
 "/        Transcript showCR:'starting search in ' , homeClass name.
 ].
 ^ homeClass
-"Modified: / 25.10.1997 / 20:26:25 / cg"!
+"Modified: / 25.10.1997 / 20:26:25 / cg"
+!
 hideMethodCategoryList
 classCategoryListView isNil ifTrue:[
 	classListView notNil ifTrue:[
 	    methodCategoryListView superView extent:0.0 @ 1.0.
 ].
 cls removeDependent:self.
 meta removeDependent:self.
 ].
-"Created: 13.12.1995 / 15:32:21 / cg"!
+"Created: 13.12.1995 / 15:32:21 / cg"
+!
 releaseMethod
 currentMethod notNil ifTrue:[
 	currentMethod removeDependent:self.
 	currentMethod isWrapped ifTrue:[
 "/                                in:codeView contents
 "/                                forClass:actualClass)
 "/        ]
 "/    ].
-"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"
 "set self for doits. This allows accessing the current class
 ].
 box showAtPointer
 ]
 "Created: / 25.10.1997 / 20:12:52 / cg"
-"Modified: / 25.10.1997 / 21:10:34 / cg"!
+"Modified: / 25.10.1997 / 21:10:34 / cg"
+!
 varTypeInfo
 "show typical usage of a variable"
 |name idx classes values value msg cut names instCount subInstCount box
 oldSelection notNil ifTrue:[
 variableListView setSelectElement:oldSelection.
 self hilightMethodsInMethodCategoryList:true inMethodList:true.
 ]
-"Modified: / 17.9.1998 / 13:45:02 / cg"! !
+"Modified: / 17.9.1998 / 13:45:02 / cg"
+! !
 !BrowserView class methodsFor:'documentation'!
 version
-^ '$Header: /cvs/stx/stx/libtool/BrowserView.st,v 1.647 2000-11-08 16:04:35 cg Exp $'
+^ '$Header: /cvs/stx/stx/libtool/BrowserView.st,v 1.648 2000-11-14 13:41:56 cg Exp $'
 ! !
 BrowserView initialize!

changeset 2840	9806b72e36f9
parent 2833	5bceae325a3e
child 2859	52d100fdd8e6