BrowserView.st
changeset 484 7680e95d51cb
parent 481 7a550399e2aa
child 486 fb6c24e0123c
equal deleted inserted replaced
483:548634e3d258 484:7680e95d51cb
   435 classCategoryFindClass
   435 classCategoryFindClass
   436     |box|
   436     |box|
   437 
   437 
   438     box := self enterBoxForCodeSelectionTitle:'class to find:' okText:'find'.
   438     box := self enterBoxForCodeSelectionTitle:'class to find:' okText:'find'.
   439     box entryCompletionBlock:[:contents |
   439     box entryCompletionBlock:[:contents |
   440 	|s what m|
   440         |s what m|
   441 
   441 
   442 	s := contents withoutSpaces.
   442         s := contents withoutSpaces.
   443 	what := Smalltalk classnameCompletion:s.
   443         what := Smalltalk classnameCompletion:s.
   444 	box contents:what first.
   444         box contents:what first.
   445 	(what at:2) size ~~ 1 ifTrue:[
   445         (what at:2) size ~~ 1 ifTrue:[
   446 	    device beep
   446             device beep
   447 	]
   447         ]
   448     ].
   448     ].
   449     box action:[:aString | self switchToClassNameMatching:aString].
   449     box action:[:aString | self switchToClassNameMatching:aString].
   450     box showAtPointer
   450     box showAtPointer
       
   451 
       
   452     "Modified: 18.4.1996 / 13:26:00 / cg"
   451 !
   453 !
   452 
   454 
   453 classCategoryFindMethod
   455 classCategoryFindMethod
   454     |box|
   456     |box|
   455 
   457 
   513     ].
   515     ].
   514 
   516 
   515     currentClassCategory isNil ifTrue:[
   517     currentClassCategory isNil ifTrue:[
   516         labels := #(
   518         labels := #(
   517                     'clone'
   519                     'clone'
       
   520                     'open for class ...'
   518                     'spawn full class'
   521                     'spawn full class'
   519                     '-'
   522                     '-'
   520                     'update'
   523                     'update'
   521                     'find class ...'
   524                     'find class ...'
   522                     'find method ...'
   525                     'find method ...'
   525                     '-'
   528                     '-'
   526                     'others ...'
   529                     'others ...'
   527                    ).
   530                    ).
   528         selectors := #(
   531         selectors := #(
   529                     classCategoryClone
   532                     classCategoryClone
       
   533                     classCategoryOpenInClass
   530                     classCategorySpawnFullClass
   534                     classCategorySpawnFullClass
   531                     nil
   535                     nil
   532                     classCategoryUpdate
   536                     classCategoryUpdate
   533                     classCategoryFindClass
   537                     classCategoryFindClass
   534                     classCategoryFindMethod
   538                     classCategoryFindMethod
   555                     'fileOut each'
   559                     'fileOut each'
   556                     'printOut' 
   560                     'printOut' 
   557                     'printOut protocol'
   561                     'printOut protocol'
   558                     '-'
   562                     '-'
   559                     'clone'
   563                     'clone'
       
   564                     'open for class ...'
   560                     'SPAWN_CATEGORY'
   565                     'SPAWN_CATEGORY'
   561                     'spawn full class'
   566                     'spawn full class'
   562                     '-'
   567                     '-'
   563                     'update'
   568                     'update'
   564                     'find class ...'
   569                     'find class ...'
   575                    classCategoryFileOutEach
   580                    classCategoryFileOutEach
   576                    classCategoryPrintOut
   581                    classCategoryPrintOut
   577                    classCategoryPrintOutProtocol
   582                    classCategoryPrintOutProtocol
   578                    nil
   583                    nil
   579                    classCategoryClone
   584                    classCategoryClone
       
   585                     classCategoryOpenInClass
   580                    classCategorySpawn
   586                    classCategorySpawn
   581                    classCategorySpawnFullClass
   587                    classCategorySpawnFullClass
   582                    nil
   588                    nil
   583                    classCategoryUpdate
   589                    classCategoryUpdate
   584                    classCategoryFindClass
   590                    classCategoryFindClass
   619 
   625 
   620     m subMenuAt:#otherMenu put:specialMenu.
   626     m subMenuAt:#otherMenu put:specialMenu.
   621     ^ m
   627     ^ m
   622 
   628 
   623     "Created: 14.9.1995 / 10:50:17 / claus"
   629     "Created: 14.9.1995 / 10:50:17 / claus"
   624     "Modified: 7.3.1996 / 13:43:55 / cg"
   630     "Modified: 18.4.1996 / 13:26:21 / cg"
   625 !
   631 !
   626 
   632 
   627 classCategoryNewCategory
   633 classCategoryNewCategory
   628     |box|
   634     |box|
   629 
   635 
   653 	    actualClass := acceptClass := nil.
   659 	    actualClass := acceptClass := nil.
   654 	    self classCategorySelectionChanged
   660 	    self classCategorySelectionChanged
   655 	]
   661 	]
   656     ].
   662     ].
   657     box showAtPointer
   663     box showAtPointer
       
   664 !
       
   665 
       
   666 classCategoryOpenInClass
       
   667     |box|
       
   668 
       
   669     box := self enterBoxForCodeSelectionTitle:'class to find:' okText:'find'.
       
   670     box entryCompletionBlock:[:contents |
       
   671         |s what m|
       
   672 
       
   673         s := contents withoutSpaces.
       
   674         what := Smalltalk classnameCompletion:s.
       
   675         box contents:what first.
       
   676         (what at:2) size ~~ 1 ifTrue:[
       
   677             device beep
       
   678         ]
       
   679     ].
       
   680     box action:[:aString | (SystemBrowser open) switchToClassNameMatching:aString].
       
   681     box showAtPointer
       
   682 
       
   683     "Modified: 18.4.1996 / 13:27:36 / cg"
   658 !
   684 !
   659 
   685 
   660 classCategoryPrintOut
   686 classCategoryPrintOut
   661     |printStream|
   687     |printStream|
   662 
   688 
  2867 
  2893 
  2868     meta := false.
  2894     meta := false.
  2869     str := aString.
  2895     str := aString.
  2870     classSymbol := aString asSymbolIfInterned.
  2896     classSymbol := aString asSymbolIfInterned.
  2871     classSymbol isNil ifTrue:[
  2897     classSymbol isNil ifTrue:[
  2872 	(aString endsWith:'class') ifTrue:[
  2898         (aString endsWith:'class') ifTrue:[
  2873 	    str := aString copyWithoutLast:5.
  2899             str := aString copyWithoutLast:5.
  2874 	    classSymbol := str asSymbolIfInterned.
  2900             classSymbol := str asSymbolIfInterned.
  2875 	    classSymbol isNil ifTrue:[
  2901             classSymbol isNil ifTrue:[
  2876 		^ self
  2902                 ^ self
  2877 	    ].
  2903             ].
  2878 	    meta := true
  2904             meta := true
  2879 	].
  2905         ].
  2880     ].
  2906     ].
  2881 
  2907 
  2882     theClass := Smalltalk at:classSymbol.
  2908     theClass := Smalltalk at:classSymbol.
  2883     (theClass isNil and:[str endsWith:'class']) ifTrue:[
  2909     (theClass isNil and:[str endsWith:'class']) ifTrue:[
  2884 	str := str copyWithoutLast:5.
  2910         str := str copyWithoutLast:5.
  2885 	classSymbol := str asSymbolIfInterned.
  2911         classSymbol := str asSymbolIfInterned.
  2886 	classSymbol isNil ifTrue:[
  2912         classSymbol isNil ifTrue:[
  2887 	    ^ self
  2913             ^ self
  2888 	].
  2914         ].
  2889 	meta := true.
  2915         meta := true.
  2890 	theClass := Smalltalk at:classSymbol.
  2916         theClass := Smalltalk at:classSymbol.
       
  2917     ].
       
  2918 
       
  2919     classCategoryListView notNil ifTrue:[
       
  2920         classCategoryListView list size == 0 ifTrue:[
       
  2921             classCategoryListView list:(self listOfAllClassCategories).
       
  2922         ]
  2891     ].
  2923     ].
  2892 
  2924 
  2893     theClass == currentClass ifTrue:[^ self].
  2925     theClass == currentClass ifTrue:[^ self].
  2894 
  2926 
  2895     theClass isBehavior ifTrue:[
  2927     theClass isBehavior ifTrue:[
  2896 	classCategoryListView notNil ifTrue:[
  2928         classCategoryListView notNil ifTrue:[
  2897 	    currentClassHierarchy isNil ifTrue:[
  2929             currentClassHierarchy isNil ifTrue:[
  2898 		((newCat := theClass category) ~= currentClassCategory) ifTrue:[
  2930                 ((newCat := theClass category) ~= currentClassCategory) ifTrue:[
  2899 		    currentClassCategory := newCat.
  2931                     currentClassCategory := newCat.
  2900 		    newCat isNil ifTrue:[
  2932                     newCat isNil ifTrue:[
  2901 			element := '* no category *'
  2933                         element := '* no category *'
  2902 		    ] ifFalse:[
  2934                     ] ifFalse:[
  2903 			element := newCat.
  2935                         element := newCat.
  2904 		    ].
  2936                     ].
  2905 		    classCategoryListView selectElement:element.
  2937                     classCategoryListView selectElement:element.
  2906 		    "/ classCategoryListView makeSelectionVisible.
  2938                     "/ classCategoryListView makeSelectionVisible.
  2907 		]
  2939                 ]
  2908 	    ]
  2940             ]
  2909 	].
  2941         ].
  2910 	self updateClassList.
  2942         self updateClassList.
  2911 	self switchToClass:theClass.
  2943         self switchToClass:theClass.
  2912 
  2944 
  2913 	classListView selectElement:str.
  2945         classListView selectElement:str.
  2914 	self instanceProtocol:meta not.
  2946         self instanceProtocol:meta not.
  2915 	self classSelectionChanged
  2947         self classSelectionChanged.
       
  2948         classCategoryListView notNil ifTrue:[
       
  2949             classCategoryListView selectElement:theClass category
       
  2950         ]
  2916     ]
  2951     ]
  2917 
  2952 
  2918     "Modified: 1.9.1995 / 01:41:35 / claus"
  2953     "Modified: 1.9.1995 / 01:41:35 / claus"
       
  2954     "Modified: 18.4.1996 / 13:33:52 / cg"
  2919 !
  2955 !
  2920 
  2956 
  2921 updateClassList
  2957 updateClassList
  2922     self updateClassListWithScroll:true
  2958     self updateClassListWithScroll:true
  2923 !
  2959 !
  3337 
  3373 
  3338     checkBlock := [:lineNr | self checkSelectionChangeAllowed].
  3374     checkBlock := [:lineNr | self checkSelectionChangeAllowed].
  3339 
  3375 
  3340     v := classCategoryListView.
  3376     v := classCategoryListView.
  3341     v notNil ifTrue:[
  3377     v notNil ifTrue:[
  3342 	v action:[:lineNr | self classCategorySelection:lineNr].
  3378         v action:[:lineNr | self classCategorySelection:lineNr].
  3343 	v selectConditionBlock:checkBlock.
  3379         v selectConditionBlock:checkBlock.
  3344 	v ignoreReselect:false.
  3380         v ignoreReselect:false.
  3345 	v contents:(self listOfAllClassCategories).
  3381         v list size == 0 ifTrue:[
  3346 	"
  3382             v list:(self listOfAllClassCategories).
  3347 	 tell classCategoryListView to ask for the menu
  3383         ].
  3348 	"
  3384         "
  3349 	v menuHolder:self; menuPerformer:self; menuMessage:#classCategoryMenu.
  3385          tell classCategoryListView to ask for the menu
       
  3386         "
       
  3387         v menuHolder:self; menuPerformer:self; menuMessage:#classCategoryMenu.
  3350     ].
  3388     ].
  3351 
  3389 
  3352     v := classListView.
  3390     v := classListView.
  3353     v notNil ifTrue:[
  3391     v notNil ifTrue:[
  3354 	v action:[:lineNr | self classSelection:lineNr].
  3392         v action:[:lineNr | self classSelection:lineNr].
  3355 	v selectConditionBlock:checkBlock.
  3393         v selectConditionBlock:checkBlock.
  3356 	v ignoreReselect:false.
  3394         v ignoreReselect:false.
  3357 	"
  3395         "
  3358 	 tell classListView to ask for the menu
  3396          tell classListView to ask for the menu
  3359 	"
  3397         "
  3360 	v menuHolder:self; menuPerformer:self; menuMessage:#classMenu.
  3398         v menuHolder:self; menuPerformer:self; menuMessage:#classMenu.
  3361     ].
  3399     ].
  3362 
  3400 
  3363     v := methodCategoryListView.
  3401     v := methodCategoryListView.
  3364     v notNil ifTrue:[
  3402     v notNil ifTrue:[
  3365 	v action:[:lineNr | self methodCategorySelection:lineNr].
  3403         v action:[:lineNr | self methodCategorySelection:lineNr].
  3366 	v selectConditionBlock:checkBlock.
  3404         v selectConditionBlock:checkBlock.
  3367 	v ignoreReselect:false.
  3405         v ignoreReselect:false.
  3368 	"
  3406         "
  3369 	 tell methodCategoryListView to ask for the menu
  3407          tell methodCategoryListView to ask for the menu
  3370 	"
  3408         "
  3371 	v menuHolder:self; menuPerformer:self; menuMessage:#methodCategoryMenu.
  3409         v menuHolder:self; menuPerformer:self; menuMessage:#methodCategoryMenu.
  3372     ].
  3410     ].
  3373 
  3411 
  3374     v := methodListView.
  3412     v := methodListView.
  3375     v notNil ifTrue:[
  3413     v notNil ifTrue:[
  3376 	v action:[:lineNr | self methodSelection:lineNr].
  3414         v action:[:lineNr | self methodSelection:lineNr].
  3377 	v selectConditionBlock:checkBlock.
  3415         v selectConditionBlock:checkBlock.
  3378 	v ignoreReselect:false.
  3416         v ignoreReselect:false.
  3379 	"
  3417         "
  3380 	 tell methodListView to ask for the menu
  3418          tell methodListView to ask for the menu
  3381 	"
  3419         "
  3382 	v menuHolder:self; menuPerformer:self; menuMessage:#methodMenu.
  3420         v menuHolder:self; menuPerformer:self; menuMessage:#methodMenu.
  3383     ].
  3421     ].
  3384 
  3422 
  3385     v := classMethodListView.
  3423     v := classMethodListView.
  3386     v notNil ifTrue:[
  3424     v notNil ifTrue:[
  3387 	v action:[:lineNr | self classMethodSelection:lineNr].
  3425         v action:[:lineNr | self classMethodSelection:lineNr].
  3388 	v selectConditionBlock:checkBlock.
  3426         v selectConditionBlock:checkBlock.
  3389 	v ignoreReselect:false.
  3427         v ignoreReselect:false.
  3390 	"
  3428         "
  3391 	 tell classMethodListView to ask for the menu
  3429          tell classMethodListView to ask for the menu
  3392 	"
  3430         "
  3393 	v menuHolder:self; menuPerformer:self; menuMessage:#classMethodMenu.
  3431         v menuHolder:self; menuPerformer:self; menuMessage:#classMethodMenu.
  3394     ].
  3432     ].
  3395 
  3433 
  3396     v := variableListView.
  3434     v := variableListView.
  3397     v notNil ifTrue:[
  3435     v notNil ifTrue:[
  3398 	v action:[:lineNr | self variableSelection:lineNr].
  3436         v action:[:lineNr | self variableSelection:lineNr].
  3399 	v ignoreReselect:false.
  3437         v ignoreReselect:false.
  3400 	v toggleSelect:true.
  3438         v toggleSelect:true.
  3401 	v menuHolder:self; menuPerformer:self; menuMessage:#variableListMenu.
  3439         v menuHolder:self; menuPerformer:self; menuMessage:#variableListMenu.
  3402     ].
  3440     ].
  3403 
  3441 
  3404     "
  3442     "
  3405      normal browsers show the top at first;
  3443      normal browsers show the top at first;
  3406      hierarchy and fullProtocol browsers better show the end
  3444      hierarchy and fullProtocol browsers better show the end
  3407      initially
  3445      initially
  3408     "
  3446     "
  3409     currentClassHierarchy notNil ifTrue:[
  3447     currentClassHierarchy notNil ifTrue:[
  3410 	classListView scrollToBottom.
  3448         classListView scrollToBottom.
  3411     ]
  3449     ]
       
  3450 
       
  3451     "Modified: 18.4.1996 / 13:34:05 / cg"
  3412 !
  3452 !
  3413 
  3453 
  3414 terminate
  3454 terminate
  3415     (self checkSelectionChangeAllowed) ifTrue:[
  3455     (self checkSelectionChangeAllowed) ifTrue:[
  3416 	super terminate
  3456 	super terminate
  6984 ! !
  7024 ! !
  6985 
  7025 
  6986 !BrowserView class methodsFor:'documentation'!
  7026 !BrowserView class methodsFor:'documentation'!
  6987 
  7027 
  6988 version
  7028 version
  6989     ^ '$Header: /cvs/stx/stx/libtool/BrowserView.st,v 1.125 1996-04-16 18:45:52 cg Exp $'
  7029     ^ '$Header: /cvs/stx/stx/libtool/BrowserView.st,v 1.126 1996-04-18 11:36:45 cg Exp $'
  6990 ! !
  7030 ! !
  6991 BrowserView initialize!
  7031 BrowserView initialize!