# HG changeset patch # User Claus Gittinger # Date 852389138 -3600 # Node ID 6aa43ef227c3c902ab9ce7e215895d80376fc097 # Parent 56fe927e0734c952611f646cc8c99ac5aca0355a delayed update; fixed class-def template for namespace & private classes. do not show private classes in full-class browser. diff -r 56fe927e0734 -r 6aa43ef227c3 BrowserView.st --- a/BrowserView.st Sat Jan 04 13:45:38 1997 +0100 +++ b/BrowserView.st Sat Jan 04 15:45:38 1997 +0100 @@ -121,47 +121,9 @@ !BrowserView methodsFor:'change & update'! -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 +delayedUpdate: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:[ @@ -172,10 +134,16 @@ (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) @@ -369,7 +337,66 @@ (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'! @@ -1976,50 +2003,51 @@ classNewClass "create a class-definition prototype in codeview" - |nm cls| - - nm := 'Object'. + |theClass cls| + + 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 @@ -3378,11 +3406,13 @@ ^ 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. @@ -3393,7 +3423,13 @@ 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 | @@ -3422,7 +3458,7 @@ 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 @@ -3579,15 +3615,27 @@ "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 *' @@ -3617,11 +3665,16 @@ ]. 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: '''' @@ -3646,13 +3699,11 @@ 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 - and:[currentNamespace ~= '* all *' - and:[currentNamespace ~= Smalltalk]]) ifTrue:[ + withNameSpaceDirective ifTrue:[ aString := '"{ Namespace: ''' , currentNamespace name , ''' }" ' , aString @@ -3660,7 +3711,7 @@ ^ 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 @@ -3750,6 +3801,15 @@ 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:[ @@ -3770,25 +3830,28 @@ ] ] ]. - "/ - "/ mhm - must search through private classes of those - "/ in smalltalk (they are not visible in the nameSpace - "/ - Smalltalk allBehaviorsDo:[:aClass | - |actualNamespace owner| - - aClass isMeta ifFalse:[ - (owner := aClass topOwningClass) notNil ifTrue:[ - (newList includes:owner) ifTrue:[ - nm := self displayedClassNameOf:aClass. -"/ (newList includes:aClass) ifFalse:[ - (classNames includes:nm) ifFalse:[ - classNames add:nm. - newList add:aClass + + fullClass ifFalse:[ + "/ + "/ mhm - must search through private classes of those + "/ in smalltalk (they are not visible in the nameSpace + "/ + Smalltalk allBehaviorsDo:[:aClass | + |actualNamespace owner| + + aClass isMeta ifFalse:[ + (owner := aClass topOwningClass) notNil ifTrue:[ + (newList includes:owner) ifTrue:[ + nm := self displayedClassNameOf:aClass. + "/ (newList includes:aClass) ifFalse:[ + (classNames includes:nm) ifFalse:[ + classNames add:nm. + newList add:aClass + ] ] ] ] - ] + ]. ]. (newList size == 0) ifTrue:[^ nil]. @@ -3810,7 +3873,7 @@ ^ newList - "Modified: 4.1.1997 / 13:35:33 / cg" + "Modified: 4.1.1997 / 15:07:47 / cg" ! listOfClassHierarchyOf:aClass @@ -7867,19 +7930,26 @@ 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 @@ -8914,6 +8984,6 @@ !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! diff -r 56fe927e0734 -r 6aa43ef227c3 BrwsrView.st --- a/BrwsrView.st Sat Jan 04 13:45:38 1997 +0100 +++ b/BrwsrView.st Sat Jan 04 15:45:38 1997 +0100 @@ -121,47 +121,9 @@ !BrowserView methodsFor:'change & update'! -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 +delayedUpdate: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:[ @@ -172,10 +134,16 @@ (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) @@ -369,7 +337,66 @@ (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'! @@ -1976,50 +2003,51 @@ classNewClass "create a class-definition prototype in codeview" - |nm cls| - - nm := 'Object'. + |theClass cls| + + 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 @@ -3378,11 +3406,13 @@ ^ 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. @@ -3393,7 +3423,13 @@ 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 | @@ -3422,7 +3458,7 @@ 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 @@ -3579,15 +3615,27 @@ "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 *' @@ -3617,11 +3665,16 @@ ]. 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: '''' @@ -3646,13 +3699,11 @@ 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 - and:[currentNamespace ~= '* all *' - and:[currentNamespace ~= Smalltalk]]) ifTrue:[ + withNameSpaceDirective ifTrue:[ aString := '"{ Namespace: ''' , currentNamespace name , ''' }" ' , aString @@ -3660,7 +3711,7 @@ ^ 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 @@ -3750,6 +3801,15 @@ 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:[ @@ -3770,25 +3830,28 @@ ] ] ]. - "/ - "/ mhm - must search through private classes of those - "/ in smalltalk (they are not visible in the nameSpace - "/ - Smalltalk allBehaviorsDo:[:aClass | - |actualNamespace owner| - - aClass isMeta ifFalse:[ - (owner := aClass topOwningClass) notNil ifTrue:[ - (newList includes:owner) ifTrue:[ - nm := self displayedClassNameOf:aClass. -"/ (newList includes:aClass) ifFalse:[ - (classNames includes:nm) ifFalse:[ - classNames add:nm. - newList add:aClass + + fullClass ifFalse:[ + "/ + "/ mhm - must search through private classes of those + "/ in smalltalk (they are not visible in the nameSpace + "/ + Smalltalk allBehaviorsDo:[:aClass | + |actualNamespace owner| + + aClass isMeta ifFalse:[ + (owner := aClass topOwningClass) notNil ifTrue:[ + (newList includes:owner) ifTrue:[ + nm := self displayedClassNameOf:aClass. + "/ (newList includes:aClass) ifFalse:[ + (classNames includes:nm) ifFalse:[ + classNames add:nm. + newList add:aClass + ] ] ] ] - ] + ]. ]. (newList size == 0) ifTrue:[^ nil]. @@ -3810,7 +3873,7 @@ ^ newList - "Modified: 4.1.1997 / 13:35:33 / cg" + "Modified: 4.1.1997 / 15:07:47 / cg" ! listOfClassHierarchyOf:aClass @@ -7867,19 +7930,26 @@ 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 @@ -8914,6 +8984,6 @@ !BrowserView class methodsFor:'documentation'! version - ^ '$Header: /cvs/stx/stx/libtool/Attic/BrwsrView.st,v 1.238 1997-01-04 12:39:25 cg Exp $' + ^ '$Header: /cvs/stx/stx/libtool/Attic/BrwsrView.st,v 1.239 1997-01-04 14:45:38 cg Exp $' ! ! BrowserView initialize!