119 "Modified: 1.1.1970 / 14:04:42 / cg" |
119 "Modified: 1.1.1970 / 14:04:42 / cg" |
120 ! ! |
120 ! ! |
121 |
121 |
122 !BrowserView methodsFor:'change & update'! |
122 !BrowserView methodsFor:'change & update'! |
123 |
123 |
124 refetchClass |
124 delayedUpdate:something with:someArgument from:changedObject |
125 "after a class definition change in another browser, |
|
126 this is sent to update (otherwise, we'd still refer to the obsolete class)" |
|
127 |
|
128 "/ currentClass := Smalltalk at:(currentClass name asSymbol). |
|
129 self switchToClass:(Smalltalk at:(currentClass name asSymbol)). |
|
130 |
|
131 "/ showInstance ifTrue:[ |
|
132 "/ actualClass := currentClass |
|
133 "/ ] ifFalse:[ |
|
134 "/ actualClass := currentClass class |
|
135 "/ ]. |
|
136 |
|
137 "Created: 8.2.1996 / 13:22:27 / cg" |
|
138 "Modified: 8.2.1996 / 13:40:18 / cg" |
|
139 ! |
|
140 |
|
141 update:something with:someArgument from:changedObject |
|
142 |list selector oldMethod| |
125 |list selector oldMethod| |
143 |
|
144 (changedObject == ObjectMemory) ifTrue:[ |
|
145 (something == #earlyRestart |
|
146 or:[something == #restarted |
|
147 or:[something == #returnFromSnapshot]]) ifTrue:[ |
|
148 "/ those are to be ignored. |
|
149 ^ self |
|
150 ] |
|
151 ]. |
|
152 |
|
153 " |
|
154 avoid update/warn after my own changes |
|
155 " |
|
156 lockUpdates == true ifTrue:[ |
|
157 "/ 'ignored my change' printNL. |
|
158 ^ self |
|
159 ]. |
|
160 |
|
161 "/ changedObject print. ' ' print. someArgument print. ' ' print. |
|
162 "/ something printNL. |
|
163 |
|
164 |
126 |
165 (changedObject == Smalltalk) ifTrue:[ |
127 (changedObject == Smalltalk) ifTrue:[ |
166 allNamespaces := nil. |
128 allNamespaces := nil. |
167 namespaceList notNil ifTrue:[ |
129 namespaceList notNil ifTrue:[ |
168 self setListOfNamespaces |
130 self setListOfNamespaces |
170 |
132 |
171 something == #newClass ifTrue:[ |
133 something == #newClass ifTrue:[ |
172 (currentClass notNil |
134 (currentClass notNil |
173 and:[someArgument name = currentClass name]) ifTrue:[ |
135 and:[someArgument name = currentClass name]) ifTrue:[ |
174 " |
136 " |
175 the current class was autoloaded |
137 the current class has changed |
176 " |
138 " |
|
139 (aspect == #definition |
|
140 and:[codeView modified not]) ifTrue:[ |
|
141 self refetchClass. |
|
142 self classSelectionChanged. |
|
143 ] ifFalse:[ |
|
144 self updateClassListWithScroll:false. |
|
145 ]. |
177 self warnLabel:'the selected class has changed'. |
146 self warnLabel:'the selected class has changed'. |
178 self updateClassListWithScroll:false. |
|
179 ]. |
147 ]. |
180 |
148 |
181 ((someArgument category = currentClassCategory) |
149 ((someArgument category = currentClassCategory) |
182 or:[currentClassCategory notNil |
150 or:[currentClassCategory notNil |
183 and:[currentClassCategory startsWith:'*']]) ifTrue:[ |
151 and:[currentClassCategory startsWith:'*']]) ifTrue:[ |
367 ]. |
335 ]. |
368 |
336 |
369 (changedObject isMethod) ifTrue:[ |
337 (changedObject isMethod) ifTrue:[ |
370 ] |
338 ] |
371 |
339 |
372 "Modified: 20.12.1996 / 18:57:49 / cg" |
340 "Created: 4.1.1997 / 13:54:00 / cg" |
|
341 "Modified: 4.1.1997 / 14:33:34 / cg" |
|
342 ! |
|
343 |
|
344 refetchClass |
|
345 "after a class definition change in another browser, |
|
346 this is sent to update (otherwise, we'd still refer to the obsolete class)" |
|
347 |
|
348 "/ currentClass := Smalltalk at:(currentClass name asSymbol). |
|
349 self switchToClass:(Smalltalk at:(currentClass name asSymbol)). |
|
350 |
|
351 "/ showInstance ifTrue:[ |
|
352 "/ actualClass := currentClass |
|
353 "/ ] ifFalse:[ |
|
354 "/ actualClass := currentClass class |
|
355 "/ ]. |
|
356 |
|
357 "Created: 8.2.1996 / 13:22:27 / cg" |
|
358 "Modified: 8.2.1996 / 13:40:18 / cg" |
|
359 ! |
|
360 |
|
361 update:something with:someArgument from:changedObject |
|
362 |argList| |
|
363 |
|
364 (changedObject == ObjectMemory) ifTrue:[ |
|
365 (something == #earlyRestart |
|
366 or:[something == #restarted |
|
367 or:[something == #returnFromSnapshot]]) ifTrue:[ |
|
368 "/ those are to be ignored. |
|
369 ^ self |
|
370 ] |
|
371 ]. |
|
372 |
|
373 "/ |
|
374 "/ avoid update/warn after my own changes |
|
375 "/ |
|
376 lockUpdates == true ifTrue:[ |
|
377 ^ self |
|
378 ]. |
|
379 |
|
380 "/ |
|
381 "/ if such an update is already in the queue, ignore it. |
|
382 "/ Otherwise push it as an event, to be handled when I am back |
|
383 "/ |
|
384 argList := Array with:something |
|
385 with:someArgument |
|
386 with:changedObject. |
|
387 |
|
388 (self sensor |
|
389 hasEvent:#delayedUpdate:with:from: |
|
390 for:self |
|
391 withArguments:argList) ifTrue:[ |
|
392 ^ self |
|
393 ]. |
|
394 self sensor |
|
395 pushUserEvent:#delayedUpdate:with:from: |
|
396 for:self |
|
397 withArguments:argList |
|
398 |
|
399 "Modified: 4.1.1997 / 14:28:06 / cg" |
373 ! ! |
400 ! ! |
374 |
401 |
375 !BrowserView methodsFor:'class category list menu'! |
402 !BrowserView methodsFor:'class category list menu'! |
376 |
403 |
377 classCategoryClone |
404 classCategoryClone |
1974 ! |
2001 ! |
1975 |
2002 |
1976 classNewClass |
2003 classNewClass |
1977 "create a class-definition prototype in codeview" |
2004 "create a class-definition prototype in codeview" |
1978 |
2005 |
1979 |nm cls| |
2006 |theClass cls| |
1980 |
2007 |
1981 nm := 'Object'. |
2008 theClass := Object. |
1982 currentClass notNil ifTrue:[ |
2009 currentClass notNil ifTrue:[ |
1983 (cls := currentClass superclass) notNil ifTrue:[ |
2010 (cls := currentClass superclass) notNil ifTrue:[ |
1984 nm := cls name |
2011 theClass := cls |
1985 ] |
2012 ] |
1986 ]. |
2013 ]. |
1987 self |
2014 self |
1988 classClassDefinitionTemplateFor:nm |
2015 classClassDefinitionTemplateFor:theClass |
1989 in:currentClassCategory |
2016 in:currentClassCategory |
1990 namespace:false |
2017 namespace:false |
1991 private:false. |
2018 private:false. |
|
2019 |
1992 aspect := nil. |
2020 aspect := nil. |
1993 |
2021 |
1994 "Modified: 23.12.1996 / 13:02:44 / cg" |
2022 "Modified: 4.1.1997 / 14:52:16 / cg" |
1995 ! |
2023 ! |
1996 |
2024 |
1997 classNewPrivateClass |
2025 classNewPrivateClass |
1998 "create a class-definition prototype in codeview" |
2026 "create a class-definition prototype in codeview" |
1999 |
2027 |
2000 self |
2028 self |
2001 classClassDefinitionTemplateFor:'Object' |
2029 classClassDefinitionTemplateFor:Object |
2002 in:nil |
2030 in:nil |
2003 namespace:false |
2031 namespace:false |
2004 private:true. |
2032 private:true. |
2005 aspect := nil. |
2033 aspect := nil. |
2006 |
2034 |
2007 "Created: 11.10.1996 / 16:01:20 / cg" |
2035 "Created: 11.10.1996 / 16:01:20 / cg" |
2008 "Modified: 23.12.1996 / 13:03:09 / cg" |
2036 "Modified: 4.1.1997 / 14:51:49 / cg" |
2009 ! |
2037 ! |
2010 |
2038 |
2011 classNewSubclass |
2039 classNewSubclass |
2012 "create a subclass-definition prototype in codeview" |
2040 "create a subclass-definition prototype in codeview" |
2013 |
2041 |
2014 self doClassMenu:[:currentClass | |
2042 self doClassMenu:[:currentClass | |
2015 self classClassDefinitionTemplateFor:(currentClass name) |
2043 self classClassDefinitionTemplateFor:currentClass |
2016 in:(currentClass category) |
2044 in:(currentClass category) |
2017 namespace:false |
2045 namespace:false |
2018 private:false. |
2046 private:false. |
2019 aspect := nil |
2047 aspect := nil |
2020 ] |
2048 ] |
2021 |
2049 |
2022 "Modified: 23.12.1996 / 12:47:33 / cg" |
2050 "Modified: 4.1.1997 / 14:51:44 / cg" |
2023 ! |
2051 ! |
2024 |
2052 |
2025 classPrimitiveDefinitions |
2053 classPrimitiveDefinitions |
2026 "show the classes primitiveDefinition in the codeView. |
2054 "show the classes primitiveDefinition in the codeView. |
2027 Also, set accept action to change it." |
2055 Also, set accept action to change it." |
3376 ^ false |
3404 ^ false |
3377 ]. |
3405 ]. |
3378 ^ true |
3406 ^ true |
3379 ! |
3407 ! |
3380 |
3408 |
3381 classClassDefinitionTemplateFor:name in:cat namespace:isNameSpace private:isPrivate |
3409 classClassDefinitionTemplateFor:aClass in:cat namespace:isNameSpace private:isPrivate |
3382 "common helper for newClass and newSubclass |
3410 "common helper for newClass and newSubclass |
3383 - show a template to define class name in category cat. |
3411 - show a template to define a subclass of aClass in category cat. |
3384 Also, set acceptaction to install the class." |
3412 Also, set acceptaction to install the class." |
|
3413 |
|
3414 |theSuperClass| |
3385 |
3415 |
3386 currentMethodCategory := nil. |
3416 currentMethodCategory := nil. |
3387 currentMethod := currentSelector := nil. |
3417 currentMethod := currentSelector := nil. |
3388 |
3418 |
3389 classListView setSelection:nil. |
3419 classListView setSelection:nil. |
3391 fullClass ifFalse:[ |
3421 fullClass ifFalse:[ |
3392 methodCategoryListView contents:nil. |
3422 methodCategoryListView contents:nil. |
3393 methodListView contents:nil |
3423 methodListView contents:nil |
3394 ]. |
3424 ]. |
3395 |
3425 |
3396 codeView contents:(self classTemplateFor:name in:cat namespace:isNameSpace private:isPrivate). |
3426 (aClass == Autoload |
|
3427 or:[aClass isLoaded not]) ifTrue:[ |
|
3428 theSuperClass := Object |
|
3429 ] ifFalse:[ |
|
3430 theSuperClass := aClass |
|
3431 ]. |
|
3432 codeView contents:(self classTemplateFor:theSuperClass in:cat namespace:isNameSpace private:isPrivate). |
3397 codeView modified:false. |
3433 codeView modified:false. |
3398 |
3434 |
3399 codeView acceptAction:[:theCode | |
3435 codeView acceptAction:[:theCode | |
3400 codeView cursor:Cursor execute. |
3436 codeView cursor:Cursor execute. |
3401 Object abortSignal catch:[ |
3437 Object abortSignal catch:[ |
3420 ]. |
3456 ]. |
3421 codeView explainAction:nil. |
3457 codeView explainAction:nil. |
3422 self switchToClass:nil |
3458 self switchToClass:nil |
3423 |
3459 |
3424 "Created: 23.12.1996 / 12:45:43 / cg" |
3460 "Created: 23.12.1996 / 12:45:43 / cg" |
3425 "Modified: 23.12.1996 / 12:52:51 / cg" |
3461 "Modified: 4.1.1997 / 15:11:29 / cg" |
3426 ! |
3462 ! |
3427 |
3463 |
3428 classListUpdate |
3464 classListUpdate |
3429 RememberAspect ifTrue:[ |
3465 RememberAspect ifTrue:[ |
3430 aspect == #hierarchy ifTrue:[ |
3466 aspect == #hierarchy ifTrue:[ |
3577 |
3613 |
3578 "Created: 23.11.1995 / 11:32:03 / cg" |
3614 "Created: 23.11.1995 / 11:32:03 / cg" |
3579 "Modified: 3.1.1997 / 15:46:22 / cg" |
3615 "Modified: 3.1.1997 / 15:46:22 / cg" |
3580 ! |
3616 ! |
3581 |
3617 |
3582 classTemplateFor:className in:categoryString namespace:isNameSpace private:isPrivate |
3618 classTemplateFor:aSuperClass in:categoryString namespace:isNameSpace private:isPrivate |
3583 "return a class definition template - be smart in what is offered initially" |
3619 "return a class definition template - be smart in what is offered initially" |
3584 |
3620 |
3585 |cat aString name nameProto namePrefix i existingNames| |
3621 |cat aString name nameProto namePrefix i existingNames withNameSpaceDirective |
|
3622 className ownerName| |
3586 |
3623 |
3587 isNameSpace ifTrue:[ |
3624 isNameSpace ifTrue:[ |
3588 ^ 'Namespace name:''NewNameSpace''' |
3625 ^ 'Namespace name:''NewNameSpace''' |
|
3626 ]. |
|
3627 |
|
3628 withNameSpaceDirective := |
|
3629 currentNamespace notNil |
|
3630 and:[currentNamespace ~= '* all *' |
|
3631 and:[currentNamespace ~= Smalltalk]]. |
|
3632 |
|
3633 withNameSpaceDirective ifTrue:[ |
|
3634 className := aSuperClass nameWithoutNameSpacePrefix |
|
3635 ] ifFalse:[ |
|
3636 className := aSuperClass name. |
3589 ]. |
3637 ]. |
3590 |
3638 |
3591 cat := categoryString. |
3639 cat := categoryString. |
3592 (cat isNil or:[cat startsWith:'*']) ifTrue:[ |
3640 (cat isNil or:[cat startsWith:'*']) ifTrue:[ |
3593 cat := '* no category *' |
3641 cat := '* no category *' |
3615 nameProto := namePrefix , name |
3663 nameProto := namePrefix , name |
3616 ]. |
3664 ]. |
3617 ]. |
3665 ]. |
3618 |
3666 |
3619 isPrivate ifTrue:[ |
3667 isPrivate ifTrue:[ |
|
3668 withNameSpaceDirective ifTrue:[ |
|
3669 ownerName := currentClass nameWithoutNameSpacePrefix |
|
3670 ] ifFalse:[ |
|
3671 ownerName := currentClass name |
|
3672 ]. |
3620 aString := className , ' subclass:#' , name , ' |
3673 aString := className , ' subclass:#' , name , ' |
3621 ' , ' instanceVariableNames: '''' |
3674 ' , ' instanceVariableNames: '''' |
3622 ' , ' classVariableNames: '''' |
3675 ' , ' classVariableNames: '''' |
3623 ' , ' poolDictionaries: '''' |
3676 ' , ' poolDictionaries: '''' |
3624 ' , ' privateIn:' , currentClass name printString |
3677 ' , ' privateIn:' , ownerName |
3625 ] ifFalse:[ |
3678 ] ifFalse:[ |
3626 aString := className , ' subclass:#' , name , ' |
3679 aString := className , ' subclass:#' , name , ' |
3627 ' , ' instanceVariableNames: '''' |
3680 ' , ' instanceVariableNames: '''' |
3628 ' , ' classVariableNames: '''' |
3681 ' , ' classVariableNames: '''' |
3629 ' , ' poolDictionaries: '''' |
3682 ' , ' poolDictionaries: '''' |
3644 either via the menu or the keyboard (usually CMD-A). |
3697 either via the menu or the keyboard (usually CMD-A). |
3645 |
3698 |
3646 To be nice to others (and yourself later), do not forget to |
3699 To be nice to others (and yourself later), do not forget to |
3647 add some documentation; preferably under the classes documentation |
3700 add some documentation; preferably under the classes documentation |
3648 protocol. |
3701 protocol. |
3649 (see the ``create documentation stubs'' item in the methodList menu.) |
3702 (see the `create documentation stubs'' item in the methodList menu.) |
3650 " |
3703 " |
3651 '. |
3704 '. |
3652 |
3705 |
3653 (currentNamespace notNil |
3706 withNameSpaceDirective ifTrue:[ |
3654 and:[currentNamespace ~= '* all *' |
|
3655 and:[currentNamespace ~= Smalltalk]]) ifTrue:[ |
|
3656 aString := '"{ Namespace: ''' , currentNamespace name , ''' }" |
3707 aString := '"{ Namespace: ''' , currentNamespace name , ''' }" |
3657 |
3708 |
3658 ' , aString |
3709 ' , aString |
3659 ]. |
3710 ]. |
3660 ^ aString |
3711 ^ aString |
3661 |
3712 |
3662 "Created: 23.12.1996 / 12:46:31 / cg" |
3713 "Created: 23.12.1996 / 12:46:31 / cg" |
3663 "Modified: 23.12.1996 / 13:02:08 / cg" |
3714 "Modified: 4.1.1997 / 14:56:17 / cg" |
3664 ! |
3715 ! |
3665 |
3716 |
3666 doClassMenu:aBlock |
3717 doClassMenu:aBlock |
3667 "a helper - check if class is selected and evaluate aBlock |
3718 "a helper - check if class is selected and evaluate aBlock |
3668 while showing waitCursor" |
3719 while showing waitCursor" |
3748 match ifFalse:[ |
3799 match ifFalse:[ |
3749 thisCategory := aClass category. |
3800 thisCategory := aClass category. |
3750 match := ((thisCategory = searchCategory) |
3801 match := ((thisCategory = searchCategory) |
3751 or:[thisCategory = aCategory]). |
3802 or:[thisCategory = aCategory]). |
3752 ]. |
3803 ]. |
|
3804 |
|
3805 match ifTrue:[ |
|
3806 fullClass ifTrue:[ |
|
3807 aClass owningClass notNil ifTrue:[ |
|
3808 match := false |
|
3809 ] |
|
3810 ]. |
|
3811 ]. |
|
3812 |
3753 match ifTrue:[ |
3813 match ifTrue:[ |
3754 nm := self displayedClassNameOf:aClass. |
3814 nm := self displayedClassNameOf:aClass. |
3755 "/ (newList includes:aClass) ifFalse:[ |
3815 "/ (newList includes:aClass) ifFalse:[ |
3756 (classNames includes:nm) ifFalse:[ |
3816 (classNames includes:nm) ifFalse:[ |
3757 (owner := aClass topOwningClass) notNil ifTrue:[ |
3817 (owner := aClass topOwningClass) notNil ifTrue:[ |
3768 ] |
3828 ] |
3769 ] |
3829 ] |
3770 ] |
3830 ] |
3771 ] |
3831 ] |
3772 ]. |
3832 ]. |
3773 "/ |
3833 |
3774 "/ mhm - must search through private classes of those |
3834 fullClass ifFalse:[ |
3775 "/ in smalltalk (they are not visible in the nameSpace |
3835 "/ |
3776 "/ |
3836 "/ mhm - must search through private classes of those |
3777 Smalltalk allBehaviorsDo:[:aClass | |
3837 "/ in smalltalk (they are not visible in the nameSpace |
3778 |actualNamespace owner| |
3838 "/ |
3779 |
3839 Smalltalk allBehaviorsDo:[:aClass | |
3780 aClass isMeta ifFalse:[ |
3840 |actualNamespace owner| |
3781 (owner := aClass topOwningClass) notNil ifTrue:[ |
3841 |
3782 (newList includes:owner) ifTrue:[ |
3842 aClass isMeta ifFalse:[ |
3783 nm := self displayedClassNameOf:aClass. |
3843 (owner := aClass topOwningClass) notNil ifTrue:[ |
3784 "/ (newList includes:aClass) ifFalse:[ |
3844 (newList includes:owner) ifTrue:[ |
3785 (classNames includes:nm) ifFalse:[ |
3845 nm := self displayedClassNameOf:aClass. |
3786 classNames add:nm. |
3846 "/ (newList includes:aClass) ifFalse:[ |
3787 newList add:aClass |
3847 (classNames includes:nm) ifFalse:[ |
|
3848 classNames add:nm. |
|
3849 newList add:aClass |
|
3850 ] |
3788 ] |
3851 ] |
3789 ] |
3852 ] |
3790 ] |
3853 ] |
3791 ] |
3854 ]. |
3792 ]. |
3855 ]. |
3793 |
3856 |
3794 (newList size == 0) ifTrue:[^ nil]. |
3857 (newList size == 0) ifTrue:[^ nil]. |
3795 newList := newList asOrderedCollection sort:[:a :b | (self displayedClassNameOf:a) < (self displayedClassNameOf:b)]. |
3858 newList := newList asOrderedCollection sort:[:a :b | (self displayedClassNameOf:a) < (self displayedClassNameOf:b)]. |
3796 |
3859 |
7865 ]. |
7928 ]. |
7866 l isNil ifTrue:[ |
7929 l isNil ifTrue:[ |
7867 l := resources string:'System Browser'. |
7930 l := resources string:'System Browser'. |
7868 |
7931 |
7869 currentClass notNil ifTrue:[ |
7932 currentClass notNil ifTrue:[ |
7870 l := l, ': ', currentClass name. |
7933 "/ l := l, ': ', currentClass name. |
|
7934 l := self displayedClassNameOf:currentClass. |
7871 classListView isNil ifTrue:[ |
7935 classListView isNil ifTrue:[ |
7872 currentSelector notNil ifTrue:[ |
7936 currentSelector notNil ifTrue:[ |
7873 l := l , ' ' , currentSelector |
7937 l := l , ' ' , currentSelector |
7874 ] |
7938 ] |
|
7939 ] ifFalse:[ |
|
7940 currentClass isLoaded ifFalse:[ |
|
7941 l := l , ' (unloaded)' |
|
7942 ] |
7875 ]. |
7943 ]. |
7876 il := currentClass name |
7944 il := currentClass nameWithoutPrefix |
7877 ] ifFalse:[ |
7945 ] ifFalse:[ |
7878 il := l. |
7946 il := l. |
7879 ] |
7947 ] |
7880 ]. |
7948 ]. |
7881 self label:l. |
7949 self label:l. |
7882 self iconLabel:il. |
7950 self iconLabel:il. |
|
7951 |
|
7952 "Modified: 4.1.1997 / 14:37:08 / cg" |
7883 ! |
7953 ! |
7884 |
7954 |
7885 releaseClass |
7955 releaseClass |
7886 |cls meta| |
7956 |cls meta| |
7887 |
7957 |