hg/stx-libtool: comparison BrowserView.st

equal deleted inserted replaced

-:56fe927e0734
+:6aa43ef227c3
 "Modified: 1.1.1970 / 14:04:42 / cg"
 ! !
 !BrowserView methodsFor:'change & update'!
-refetchClass
+delayedUpdate:something with:someArgument from:changedObject
-"after a class definition change in another browser,
-this is sent to update (otherwise, we'd still refer to the obsolete class)"
-"/    currentClass := Smalltalk at:(currentClass name asSymbol).
-self switchToClass:(Smalltalk at:(currentClass name asSymbol)).
-"/    showInstance ifTrue:[
-"/        actualClass := currentClass
-"/    ] ifFalse:[
-"/        actualClass := currentClass class
-"/    ].
-"Created: 8.2.1996 / 13:22:27 / cg"
-"Modified: 8.2.1996 / 13:40:18 / cg"
-!
-update:something with:someArgument from:changedObject
 |list selector oldMethod|
-(changedObject == ObjectMemory) ifTrue:[
-(something == #earlyRestart
-or:[something == #restarted
-or:[something == #returnFromSnapshot]]) ifTrue:[
-"/ those are to be ignored.
-^ self
-]
-].
-"
-avoid update/warn after my own changes
-"
-lockUpdates == true ifTrue:[
-"/         'ignored my change' printNL.
-^ self
-].
-"/ changedObject print. ' ' print. someArgument print. ' ' print.
-"/ something printNL.
 (changedObject == Smalltalk) ifTrue:[
 allNamespaces := nil.
 namespaceList notNil ifTrue:[
 self setListOfNamespaces
 something == #newClass ifTrue:[
 (currentClass notNil
 and:[someArgument name = currentClass name]) ifTrue:[
 "
-the current class was autoloaded
+the current class has changed
 "
+(aspect == #definition
+and:[codeView modified not]) ifTrue:[
+self refetchClass.
+self classSelectionChanged.
+] ifFalse:[
+self updateClassListWithScroll:false.
+].
 self warnLabel:'the selected class has changed'.
-self updateClassListWithScroll:false.
 ].
 ((someArgument category = currentClassCategory)
 or:[currentClassCategory notNil
 and:[currentClassCategory startsWith:'*']]) ifTrue:[
 ].
 (changedObject isMethod) ifTrue:[
 ]
-"Modified: 20.12.1996 / 18:57:49 / cg"
+"Created: 4.1.1997 / 13:54:00 / cg"
+"Modified: 4.1.1997 / 14:33:34 / cg"
+!
+refetchClass
+"after a class definition change in another browser,
+this is sent to update (otherwise, we'd still refer to the obsolete class)"
+"/    currentClass := Smalltalk at:(currentClass name asSymbol).
+self switchToClass:(Smalltalk at:(currentClass name asSymbol)).
+"/    showInstance ifTrue:[
+"/        actualClass := currentClass
+"/    ] ifFalse:[
+"/        actualClass := currentClass class
+"/    ].
+"Created: 8.2.1996 / 13:22:27 / cg"
+"Modified: 8.2.1996 / 13:40:18 / cg"
+!
+update:something with:someArgument from:changedObject
+|argList|
+(changedObject == ObjectMemory) ifTrue:[
+(something == #earlyRestart
+or:[something == #restarted
+or:[something == #returnFromSnapshot]]) ifTrue:[
+"/ those are to be ignored.
+^ self
+]
+].
+"/
+"/ avoid update/warn after my own changes
+"/
+lockUpdates == true ifTrue:[
+^ self
+].
+"/
+"/ if such an update is already in the queue, ignore it.
+"/ Otherwise push it as an event, to be handled when I am back
+"/
+argList := Array with:something
+with:someArgument
+with:changedObject.
+(self sensor
+hasEvent:#delayedUpdate:with:from:
+for:self
+withArguments:argList) ifTrue:[
+^ self
+].
+self sensor
+pushUserEvent:#delayedUpdate:with:from:
+for:self
+withArguments:argList
+"Modified: 4.1.1997 / 14:28:06 / cg"
 ! !
 !BrowserView methodsFor:'class category list menu'!
 classCategoryClone
 !
 classNewClass
 "create a class-definition prototype in codeview"
-|nm cls|
+|theClass cls|
-nm := 'Object'.
+theClass := Object.
 currentClass notNil ifTrue:[
 (cls := currentClass superclass) notNil ifTrue:[
-nm := cls name
+theClass := cls
 ]
 ].
 self
-classClassDefinitionTemplateFor:nm
+classClassDefinitionTemplateFor:theClass
 in:currentClassCategory
 namespace:false
 private:false.
 aspect := nil.
-"Modified: 23.12.1996 / 13:02:44 / cg"
+"Modified: 4.1.1997 / 14:52:16 / cg"
 !
 classNewPrivateClass
 "create a class-definition prototype in codeview"
 self
-classClassDefinitionTemplateFor:'Object'
+classClassDefinitionTemplateFor:Object
 in:nil
 namespace:false
 private:true.
 aspect := nil.
 "Created: 11.10.1996 / 16:01:20 / cg"
-"Modified: 23.12.1996 / 13:03:09 / cg"
+"Modified: 4.1.1997 / 14:51:49 / cg"
 !
 classNewSubclass
 "create a subclass-definition prototype in codeview"
 self doClassMenu:[:currentClass |
-self classClassDefinitionTemplateFor:(currentClass name)
+self classClassDefinitionTemplateFor:currentClass
 in:(currentClass category)
 namespace:false
 private:false.
 aspect := nil
 ]
-"Modified: 23.12.1996 / 12:47:33 / cg"
+"Modified: 4.1.1997 / 14:51:44 / cg"
 !
 classPrimitiveDefinitions
 "show the classes primitiveDefinition in the codeView.
 Also, set accept action to change it."
 ^ false
 ].
 ^ true
 !
-classClassDefinitionTemplateFor:name in:cat namespace:isNameSpace private:isPrivate
+classClassDefinitionTemplateFor:aClass in:cat namespace:isNameSpace private:isPrivate
 "common helper for newClass and newSubclass
-- show a template to define class name in category cat.
+- show a template to define a subclass of aClass in category cat.
 Also, set acceptaction to install the class."
+|theSuperClass|
 currentMethodCategory := nil.
 currentMethod := currentSelector := nil.
 classListView setSelection:nil.
 fullClass ifFalse:[
 methodCategoryListView contents:nil.
 methodListView contents:nil
 ].
-codeView contents:(self classTemplateFor:name in:cat namespace:isNameSpace private:isPrivate).
+(aClass == Autoload
+or:[aClass isLoaded not]) ifTrue:[
+theSuperClass := Object
+] ifFalse:[
+theSuperClass := aClass
+].
+codeView contents:(self classTemplateFor:theSuperClass in:cat namespace:isNameSpace private:isPrivate).
 codeView modified:false.
 codeView acceptAction:[:theCode |
 codeView cursor:Cursor execute.
 Object abortSignal catch:[
 ].
 codeView explainAction:nil.
 self switchToClass:nil
 "Created: 23.12.1996 / 12:45:43 / cg"
-"Modified: 23.12.1996 / 12:52:51 / cg"
+"Modified: 4.1.1997 / 15:11:29 / cg"
 !
 classListUpdate
 RememberAspect ifTrue:[
 aspect == #hierarchy ifTrue:[
 "Created: 23.11.1995 / 11:32:03 / cg"
 "Modified: 3.1.1997 / 15:46:22 / cg"
 !
-classTemplateFor:className in:categoryString namespace:isNameSpace private:isPrivate
+classTemplateFor:aSuperClass in:categoryString namespace:isNameSpace private:isPrivate
 "return a class definition template - be smart in what is offered initially"
-|cat aString name nameProto namePrefix i existingNames|
+|cat aString name nameProto namePrefix i existingNames withNameSpaceDirective
+className ownerName|
 isNameSpace ifTrue:[
 ^ 'Namespace name:''NewNameSpace'''
+].
+withNameSpaceDirective :=
+currentNamespace notNil
+and:[currentNamespace ~= '* all *'
+and:[currentNamespace ~= Smalltalk]].
+withNameSpaceDirective ifTrue:[
+className := aSuperClass nameWithoutNameSpacePrefix
+] ifFalse:[
+className := aSuperClass name.
 ].
 cat := categoryString.
 (cat isNil or:[cat startsWith:'*']) ifTrue:[
 cat := '* no category *'
 nameProto := namePrefix , name
 ].
 ].
 isPrivate ifTrue:[
+withNameSpaceDirective ifTrue:[
+ownerName := currentClass nameWithoutNameSpacePrefix
+] ifFalse:[
+ownerName := currentClass name
+].
 aString := className , ' subclass:#' , name  , '
 ' , '    instanceVariableNames: ''''
 ' , '    classVariableNames: ''''
 ' , '    poolDictionaries: ''''
-' , '    privateIn:' , currentClass name printString
+' , '    privateIn:' , ownerName
 ] ifFalse:[
 aString := className , ' subclass:#' , name , '
 ' , '    instanceVariableNames: ''''
 ' , '    classVariableNames: ''''
 ' , '    poolDictionaries: ''''
 either via the menu or the keyboard (usually CMD-A).
 To be nice to others (and yourself later), do not forget to
 add some documentation; preferably under the classes documentation
 protocol.
-(see the ``create documentation stubs'' item in the methodList menu.)
+(see the `create documentation stubs'' item in the methodList menu.)
 "
 '.
-(currentNamespace notNil
+withNameSpaceDirective ifTrue:[
-and:[currentNamespace ~= '* all *'
-and:[currentNamespace ~= Smalltalk]]) ifTrue:[
 aString := '"{ Namespace: ''' , currentNamespace name , ''' }"
 ' , aString
 ].
 ^ aString
 "Created: 23.12.1996 / 12:46:31 / cg"
-"Modified: 23.12.1996 / 13:02:08 / cg"
+"Modified: 4.1.1997 / 14:56:17 / cg"
 !
 doClassMenu:aBlock
 "a helper - check if class is selected and evaluate aBlock
 while showing waitCursor"
 match ifFalse:[
 thisCategory := aClass category.
 match := ((thisCategory = searchCategory)
 or:[thisCategory = aCategory]).
 ].
+match ifTrue:[
+fullClass ifTrue:[
+aClass owningClass notNil ifTrue:[
+match := false
+]
+].
+].
 match ifTrue:[
 nm := self displayedClassNameOf:aClass.
 "/                        (newList includes:aClass) ifFalse:[
 (classNames includes:nm) ifFalse:[
 (owner := aClass topOwningClass) notNil ifTrue:[
 ]
 ]
 ]
 ]
 ].
-"/
-"/ mhm - must search through private classes of those
+fullClass ifFalse:[
-"/ in smalltalk (they are not visible in the nameSpace
+"/
-"/
+"/ mhm - must search through private classes of those
-Smalltalk allBehaviorsDo:[:aClass |
+"/ in smalltalk (they are not visible in the nameSpace
-|actualNamespace owner|
+"/
+Smalltalk allBehaviorsDo:[:aClass |
-aClass isMeta ifFalse:[
+|actualNamespace owner|
-(owner := aClass topOwningClass) notNil ifTrue:[
-(newList includes:owner) ifTrue:[
+aClass isMeta ifFalse:[
-nm := self displayedClassNameOf:aClass.
+(owner := aClass topOwningClass) notNil ifTrue:[
-"/                    (newList includes:aClass) ifFalse:[
+(newList includes:owner) ifTrue:[
-(classNames includes:nm) ifFalse:[
+nm := self displayedClassNameOf:aClass.
-classNames add:nm.
+"/                    (newList includes:aClass) ifFalse:[
-newList add:aClass
+(classNames includes:nm) ifFalse:[
+classNames add:nm.
+newList add:aClass
+]
 ]
 ]
 ]
-]
+].
 ].
 (newList size == 0) ifTrue:[^ nil].
 newList := newList asOrderedCollection sort:[:a :b | (self displayedClassNameOf:a) < (self displayedClassNameOf:b)].
 s
 ].
 ^ newList
-"Modified: 4.1.1997 / 13:35:33 / cg"
+"Modified: 4.1.1997 / 15:07:47 / cg"
 !
 listOfClassHierarchyOf:aClass
 "return a hierarchy class-list"
 ].
 l isNil ifTrue:[
 l := resources string:'System Browser'.
 currentClass notNil ifTrue:[
-l := l, ': ', currentClass name.
+"/            l := l, ': ', currentClass name.
+l := self displayedClassNameOf:currentClass.
 classListView isNil ifTrue:[
 currentSelector notNil ifTrue:[
 l := l , ' ' ,  currentSelector
 ]
+] ifFalse:[
+currentClass isLoaded ifFalse:[
+l := l , ' (unloaded)'
+]
 ].
-il := currentClass name
+il := currentClass nameWithoutPrefix
 ] ifFalse:[
 il := l.
 ]
 ].
 self label:l.
 self iconLabel:il.
+"Modified: 4.1.1997 / 14:37:08 / cg"
 !
 releaseClass
 |cls meta|
 ! !
 !BrowserView class methodsFor:'documentation'!
 version
-^ '$Header: /cvs/stx/stx/libtool/BrowserView.st,v 1.238 1997-01-04 12:39:25 cg Exp $'
+^ '$Header: /cvs/stx/stx/libtool/BrowserView.st,v 1.239 1997-01-04 14:45:38 cg Exp $'
 ! !
 BrowserView initialize!

changeset 902	6aa43ef227c3
parent 900	6fd4cb8c03e9
child 903	843c830fa921