hg/stx-libtool: comparison BrowserView.st

equal deleted inserted replaced

-:de8d39d459fd
+:6f4460d5a09d
 hereby transferred.
 "
 StandardSystemView subclass:#BrowserView
 	 instanceVariableNames:'classCategoryListView classListView methodCategoryListView
-methodListView classMethodListView codeView classToggle
+		methodListView classMethodListView codeView classToggle
-instanceToggle currentClassCategory currentClassHierarchy
+		instanceToggle currentClassCategory currentClassHierarchy
-currentClass currentMethodCategory currentMethod currentSelector
+		currentClass currentMethodCategory currentMethod currentSelector
-showInstance actualClass fullClass lastMethodCategory aspect
+		showInstance actualClass fullClass lastMethodCategory aspect
-variableListView fullProtocol lockUpdates autoSearch myLabel
+		variableListView fullProtocol lockUpdates autoSearch myLabel
-acceptClass'
+		acceptClass'
 	 classVariableNames:'CheckForInstancesWhenRemovingClasses RememberAspect DefaultIcon'
 	 poolDictionaries:''
 	 category:'Interface-Browsers'
 !
 			    ^ self
 			].
 			"compare the source codes"
 			currentMethod notNil ifTrue:[
 			    changedMethod source = codeView contents ifFalse:[
-				self warnLabel:'the code shown may not up to date'.
+				self warnLabel:'method has changed - the code shown may be obsolete'.
 			    ]
 			].
 			^ self
 		    ].
 		    ^ self
 !BrowserView methodsFor:'class category list menu'!
 classCategoryCheckinEach
 self withWaitCursorDo:[
-|logMessage|
+	|logMessage|
-logMessage := Dialog
+	logMessage := Dialog
-request:'enter a log message (used for all):'
+			 request:'enter a log message (used for all):'
-initialAnswer:''
+			 initialAnswer:''
-onCancel:nil.
+			 onCancel:nil.
-logMessage notNil ifTrue:[
+	logMessage notNil ifTrue:[
-Smalltalk allClassesInCategory:currentClassCategory do:[:aClass |
+	    Smalltalk allClassesInCategory:currentClassCategory do:[:aClass |
-self busyLabel:'checking in %1' with:aClass name.
+		self busyLabel:'checking in %1' with:aClass name.
-SourceCodeManager checkinClass:aClass logMessage:logMessage.
+		SourceCodeManager checkinClass:aClass logMessage:logMessage.
-self normalLabel.
+		self normalLabel.
-]
+	    ]
-].
+	].
-self normalLabel.
+	self normalLabel.
 ]
 "Created: 23.11.1995 / 11:41:38 / cg"
 "Modified: 23.11.1995 / 18:43:34 / cg"
 !
 classCategoryMenu
 |labels selectors|
 (device ctrlDown
 and:[currentClassCategory notNil]) ifTrue:[
-labels :=  #(
+	labels :=  #(
-'checkin each'
+		       'checkin each'
-).
+		    ).
-selectors := #(
+	selectors := #(
-classCategoryCheckinEach
+		       classCategoryCheckinEach
-).
+		     ).
 ] ifFalse:[
-currentClassCategory isNil ifTrue:[
+	currentClassCategory isNil ifTrue:[
-labels := #(
+	    labels := #(
-'spawn full class'
+			'spawn full class'
-'-'
+			'-'
-'update'
+			'update'
-'find class ...'
+			'find class ...'
-'find method ...'
+			'find method ...'
-'-'
+			'-'
-'new class category ...'
+			'new class category ...'
-).
+		       ).
-selectors := #(
+	    selectors := #(
-classCategorySpawnFullClass
+			classCategorySpawnFullClass
-nil
+			nil
-classCategoryUpdate
+			classCategoryUpdate
-classCategoryFindClass
+			classCategoryFindClass
-classCategoryFindMethod
+			classCategoryFindMethod
-nil
+			nil
-classCategoryNewCategory
+			classCategoryNewCategory
-).
+		       ).
-] ifFalse:[
+	] ifFalse:[
-labels := #(
+	    labels := #(
-'fileOut'
+			'fileOut'
-'fileOut each'
+			'fileOut each'
 "/
 "/                      'fileOut binary'
 "/
-'printOut'
+			'printOut'
-'printOut protocol'
+			'printOut protocol'
-'-'
+			'-'
-'clone'
+			'clone'
-'SPAWN_CATEGORY'
+			'SPAWN_CATEGORY'
-'spawn full class'
+			'spawn full class'
-'-'
+			'-'
-'update'
+			'update'
-'find class ...'
+			'find class ...'
-'find method ...'
+			'find method ...'
-'-'
+			'-'
-'new class category ...'
+			'new class category ...'
-'rename ...'
+			'rename ...'
-'remove'
+			'remove'
-).
+		       ).
-selectors := #(
+	    selectors := #(
-classCategoryFileOut
+		       classCategoryFileOut
-classCategoryFileOutEach
+		       classCategoryFileOutEach
-classCategoryPrintOut
+		       classCategoryPrintOut
-classCategoryPrintOutProtocol
+		       classCategoryPrintOutProtocol
-nil
+		       nil
-classCategoryClone
+		       classCategoryClone
-classCategorySpawn
+		       classCategorySpawn
-classCategorySpawnFullClass
+		       classCategorySpawnFullClass
-nil
+		       nil
-classCategoryUpdate
+		       classCategoryUpdate
-classCategoryFindClass
+		       classCategoryFindClass
-classCategoryFindMethod
+		       classCategoryFindMethod
-nil
+		       nil
-classCategoryNewCategory
+		       classCategoryNewCategory
-classCategoryRename
+		       classCategoryRename
-classCategoryRemove
+		       classCategoryRemove
-).
+		       ).
-].
+	].
 ].
 ^ PopUpMenu labels:(resources array:labels)
-selectors:selectors
+		selectors:selectors
 "Created: 14.9.1995 / 10:50:17 / claus"
 "Modified: 23.11.1995 / 18:37:06 / cg"
 !
 ^ self
 !
 classRefs
 self doClassMenu:[:currentClass |
-self withSearchCursorDo:[
+	self withSearchCursorDo:[
-SystemBrowser browseReferendsOf:currentClass name asSymbol
+	    SystemBrowser browseReferendsOf:currentClass name asSymbol
-]
+	]
 ]
 "Created: 23.11.1995 / 14:11:43 / cg"
 !
 "a powerful tool, when trying to learn more about where
 a class is used. This one searches all uses of a class,
 and shows a list of uses - try it and like it"
 self doClassMenu:[:currentClass |
-self withSearchCursorDo:[
+	self withSearchCursorDo:[
-SystemBrowser browseUsesOf:currentClass
+	    SystemBrowser browseUsesOf:currentClass
-]
+	]
 ]
 "Created: 23.11.1995 / 14:11:47 / cg"
 !
 classCheckin
 "check a class into the source repository"
 self doClassMenu:[:currentClass |
-|logMessage|
+	|logMessage|
-logMessage := Dialog
+	logMessage := Dialog
-request:'enter a log message:'
+			 request:'enter a log message:'
-initialAnswer:''
+			 initialAnswer:''
-onCancel:nil.
+			 onCancel:nil.
-logMessage notNil ifTrue:[
+	logMessage notNil ifTrue:[
-self busyLabel:'checking in %1' with:currentClass name.
+	    self busyLabel:'checking in %1' with:currentClass name.
-SourceCodeManager checkinClass:currentClass logMessage:logMessage.
+	    SourceCodeManager checkinClass:currentClass logMessage:logMessage.
-aspect == #revisionInfo ifTrue:[
+	    aspect == #revisionInfo ifTrue:[
-self classListUpdate
+		self classListUpdate
-].
+	    ].
-self normalLabel.
+	    self normalLabel.
-]
+	]
 ]
 "Created: 23.11.1995 / 11:41:38 / cg"
 "Modified: 23.11.1995 / 18:34:42 / cg"
 !
 classRevisionInfo
 "show current classes revision info in codeView"
 self doClassMenu:[:currentClass |
-|aStream info info2 s|
+	|aStream info info2 s|
-aStream := WriteStream on:(String new:200).
+	aStream := WriteStream on:(String new:200).
-currentClass notNil ifTrue:[
+	currentClass notNil ifTrue:[
-info := currentClass revisionInfo.
+	    info := currentClass revisionInfo.
-info notNil ifTrue:[
+	    info notNil ifTrue:[
-s := info at:#repositoryPath ifAbsent:nil.
+		s := info at:#repositoryPath ifAbsent:nil.
-s notNil ifTrue:[
+		s notNil ifTrue:[
-aStream nextPut:'Source repository : ' , s; cr
+		    aStream nextPut:'Source repository : ' , s; cr
-].
+		].
-aStream nextPutAll:'Filename ........ : ' , (info at:#fileName ifAbsent:'?'); cr.
+		aStream nextPutAll:'Filename ........ : ' , (info at:#fileName ifAbsent:'?'); cr.
-aStream nextPutAll:'Revision ........ : ' , (info at:#revision ifAbsent:'?'); cr.
+		aStream nextPutAll:'Revision ........ : ' , (info at:#revision ifAbsent:'?'); cr.
-aStream nextPutAll:'Checkin date .... : ' , (info at:#date ifAbsent:'?') , ' ' , (info at:#time ifAbsent:'?'); cr.
+		aStream nextPutAll:'Checkin date .... : ' , (info at:#date ifAbsent:'?') , ' ' , (info at:#time ifAbsent:'?'); cr.
-aStream nextPutAll:'Checkin user .... : ' , (info at:#user ifAbsent:'?'); cr.
+		aStream nextPutAll:'Checkin user .... : ' , (info at:#user ifAbsent:'?'); cr.
-(info2 := currentClass sourceCodeInfo) notNil ifTrue:[
+		(info2 := currentClass sourceCodeInfo) notNil ifTrue:[
-aStream nextPutAll:'Repository: ..... : ' , (info2 at:#module ifAbsent:'?'); cr.
+		    aStream nextPutAll:'Repository: ..... : ' , (info2 at:#module ifAbsent:'?'); cr.
-aStream nextPutAll:'Directory: ...... : ' , (info2 at:#directory ifAbsent:'?'); cr.
+		    aStream nextPutAll:'Directory: ...... : ' , (info2 at:#directory ifAbsent:'?'); cr.
-].
+		].
-aStream nextPutAll:'Container ....... : ' , (info at:#repositoryPathName ifAbsent:'?'); cr.
+		aStream nextPutAll:'Container ....... : ' , (info at:#repositoryPathName ifAbsent:'?'); cr.
-aStream cr.
+		aStream cr.
-SourceCodeManager notNil ifTrue:[
+		SourceCodeManager notNil ifTrue:[
-aStream nextPutAll:'Repository revisions:'; cr; cr.
+		    aStream nextPutAll:'Repository revisions:'; cr; cr.
-SourceCodeManager writeRevisionLogOf:currentClass to:aStream.
+		    SourceCodeManager writeRevisionLogOf:currentClass to:aStream.
-]
+		]
-]
+	    ]
-].
+	].
-codeView contents:(aStream contents).
+	codeView contents:(aStream contents).
-codeView modified:false.
+	codeView modified:false.
-codeView acceptAction:nil.
+	codeView acceptAction:nil.
-codeView explainAction:nil.
+	codeView explainAction:nil.
-methodListView notNil ifTrue:[
+	methodListView notNil ifTrue:[
-methodListView deselect
+	    methodListView deselect
-].
+	].
-aspect := #revisionInfo.
+	aspect := #revisionInfo.
-self normalLabel
+	self normalLabel
 ]
 "Created: 14.11.1995 / 16:43:15 / cg"
 "Modified: 23.11.1995 / 11:33:37 / cg"
 ! !
 self switchToClass:nil
 !
 classListUpdate
 RememberAspect ifTrue:[
-aspect == #hierarchy ifTrue:[
+	aspect == #hierarchy ifTrue:[
-^ self classHierarchy
+	    ^ self classHierarchy
-].
+	].
-aspect == #classInstVars ifTrue:[
+	aspect == #classInstVars ifTrue:[
-^ self classClassInstVars
+	    ^ self classClassInstVars
-].
+	].
-aspect == #comment ifTrue:[
+	aspect == #comment ifTrue:[
-^ self classComment
+	    ^ self classComment
-].
+	].
-aspect == #primitiveDefinitions ifTrue:[
+	aspect == #primitiveDefinitions ifTrue:[
-^ self classPrimitiveDefinitions
+	    ^ self classPrimitiveDefinitions
-].
+	].
-aspect == #primitiveFunctions ifTrue:[
+	aspect == #primitiveFunctions ifTrue:[
-^ self classPrimitiveFunctions
+	    ^ self classPrimitiveFunctions
-].
+	].
-aspect == #primitiveVariables ifTrue:[
+	aspect == #primitiveVariables ifTrue:[
-^ self classPrimitiveVariables
+	    ^ self classPrimitiveVariables
-].
+	].
-aspect == #revisionInfo ifTrue:[
+	aspect == #revisionInfo ifTrue:[
-^ self classRevisionInfo
+	    ^ self classRevisionInfo
-].
+	].
 ].
 self classDefinition
 "Created: 23.11.1995 / 11:28:58 / cg"
 "Modified: 23.11.1995 / 11:36:08 / cg"
 classSelectionChanged
 |oldMethodCategory oldMethod oldSelector|
 self withWaitCursorDo:[
-oldMethodCategory := currentMethodCategory.
+	oldMethodCategory := currentMethodCategory.
-oldMethod := currentMethod.
+	oldMethod := currentMethod.
-oldSelector := currentSelector.
+	oldSelector := currentSelector.
-showInstance ifTrue:[
+	showInstance ifTrue:[
-actualClass := acceptClass := currentClass
+	    actualClass := acceptClass := currentClass
-] ifFalse:[
+	] ifFalse:[
-actualClass := acceptClass := currentClass class
+	    actualClass := acceptClass := currentClass class
-].
+	].
-currentMethodCategory := nil.
+	currentMethodCategory := nil.
-currentMethod := nil.
+	currentMethod := nil.
-currentSelector := nil.
+	currentSelector := nil.
-self updateVariableList.
+	self updateVariableList.
-self updateMethodCategoryList.
+	self updateMethodCategoryList.
-oldMethodCategory notNil ifTrue:[
+	oldMethodCategory notNil ifTrue:[
-methodCategoryListView selectElement:oldMethodCategory.
+	    methodCategoryListView selectElement:oldMethodCategory.
-methodCategoryListView hasSelection ifTrue:[
+	    methodCategoryListView hasSelection ifTrue:[
-currentMethodCategory := oldMethodCategory.
+		currentMethodCategory := oldMethodCategory.
-self methodCategorySelectionChanged
+		self methodCategorySelectionChanged
-]
+	    ]
-].
+	].
-self updateMethodList.
+	self updateMethodList.
-self updateCodeView.
+	self updateCodeView.
-fullClass ifTrue:[
+	fullClass ifTrue:[
-codeView acceptAction:[:theCode |
+	    codeView acceptAction:[:theCode |
-codeView cursor:Cursor execute.
+		codeView cursor:Cursor execute.
-Object abortSignal catch:[
+		Object abortSignal catch:[
-self compileCode:theCode asString.
+		    self compileCode:theCode asString.
-codeView modified:false.
+		    codeView modified:false.
-].
+		].
-codeView cursor:Cursor normal.
+		codeView cursor:Cursor normal.
-].
+	    ].
-] ifFalse:[
+	] ifFalse:[
 "/            self classDefinition.
 self classListUpdate.
-codeView acceptAction:[:theCode |
+	    codeView acceptAction:[:theCode |
-codeView cursor:Cursor execute.
+		codeView cursor:Cursor execute.
-Object abortSignal catch:[
+		Object abortSignal catch:[
-(Compiler evaluate:theCode asString notifying:codeView compile:false)
+		    (Compiler evaluate:theCode asString notifying:codeView compile:false)
-isBehavior ifTrue:[
+		    isBehavior ifTrue:[
-self classCategoryUpdate.
+			self classCategoryUpdate.
-self updateClassListWithScroll:false.
+			self updateClassListWithScroll:false.
-codeView modified:false.
+			codeView modified:false.
-].
+		    ].
-].
+		].
-codeView cursor:Cursor normal.
+		codeView cursor:Cursor normal.
-].
+	    ].
-].
+	].
-codeView explainAction:nil.
+	codeView explainAction:nil.
-classCategoryListView notNil ifTrue:[
+	classCategoryListView notNil ifTrue:[
-(currentClassCategory = currentClass category) ifFalse:[
+	    (currentClassCategory = currentClass category) ifFalse:[
-currentClassCategory := currentClass category.
+		currentClassCategory := currentClass category.
-classCategoryListView selectElement:currentClassCategory
+		classCategoryListView selectElement:currentClassCategory
-]
+	    ]
-].
+	].
-self setDoitActionForClass
+	self setDoitActionForClass
 ]
 "Created: 23.11.1995 / 11:32:03 / cg"
 !
 self methodCategorySelectionChanged.
 aspect := nil.
 "if there is only one method, show it right away"
 methodListView list size == 1 ifTrue:[
-methodListView selection:1.
+	methodListView selection:1.
-self methodSelection:1
+	self methodSelection:1
 "/    ] ifFalse:[
 "/      oldSelector notNil ifTrue:[
 "/          methodListView selectElement:oldSelector.
 "/          methodListView hasSelection ifTrue:[
 "/              self methodSelection:methodListView selection.
 methodCategorySelectionChanged
 "method category selection has changed - update dependent views"
 self withWaitCursorDo:[
-currentMethod := currentSelector := nil.
+	currentMethod := currentSelector := nil.
-self updateMethodList.
+	self updateMethodList.
-self updateCodeView.
+	self updateCodeView.
-currentMethodCategory notNil ifTrue:[
+	currentMethodCategory notNil ifTrue:[
-methodCategoryListView selectElement:currentMethodCategory
+	    methodCategoryListView selectElement:currentMethodCategory
-].
+	].
-self setAcceptAndExplainActionsForMethod.
+	self setAcceptAndExplainActionsForMethod.
-self hilightMethodsInMethodCategoryList:false inMethodList:true.
+	self hilightMethodsInMethodCategoryList:false inMethodList:true.
 ]
 "Created: 23.11.1995 / 14:17:38 / cg"
 "Modified: 23.11.1995 / 14:19:49 / cg"
 !
 methodLocalSuperSends
 "launch a browser showing super sends in current class & subclasses"
 self checkClassSelected ifFalse:[^ self].
 self withSearchCursorDo:[
-SystemBrowser browseSuperCallsUnder:currentClass
+	SystemBrowser browseSuperCallsUnder:currentClass
 ]
 "Created: 23.11.1995 / 12:03:57 / cg"
 "Modified: 23.11.1995 / 14:12:15 / cg"
 !
 searchLabels searchSelectors
 sepLocalLabels sepLocalSelectors
 localSearchLabels localSearchSelectors|
 device ctrlDown ifTrue:[
-"/ 'secret' developpers menu
+	"/ 'secret' developpers menu
-currentMethod isNil ifTrue:[
+	currentMethod isNil ifTrue:[
-methodListView flash.
+	    methodListView flash.
-^ nil
+	    ^ nil
-].
+	].
-labels := #(
+	labels := #(
-'inspect method'
+			'inspect method'
-'compile to machine code'
+			'compile to machine code'
-'decompile'
+			'decompile'
-'-'
+			'-'
-'make private'
+			'make private'
-'make protected'
+			'make protected'
-'make public'
+			'make public'
-).
+		   ).
-selectors := #(
+	selectors := #(
-methodInspect
+			methodInspect
-methodSTCCompile
+			methodSTCCompile
-methodDecompile
+			methodDecompile
-nil
+			nil
-methodMakePrivate
+			methodMakePrivate
-methodMakeProtected
+			methodMakeProtected
-methodMakePublic
+			methodMakePublic
-)
+		      )
 ] ifFalse:[
-sepLocalLabels := sepLocalSelectors := #().
+	sepLocalLabels := sepLocalSelectors := #().
-searchLabels := #(
+	searchLabels := #(
-'senders ...'
+				    'senders ...'
-'implementors ...'
+				    'implementors ...'
-'globals ...'
+				    'globals ...'
-'string search ...'
+				    'string search ...'
-'apropos ...'
+				    'apropos ...'
-).
+			).
-searchSelectors := #(
+	searchSelectors := #(
-methodSenders
+				    methodSenders
-methodImplementors
+				    methodImplementors
-methodGlobalReferends
+				    methodGlobalReferends
-methodStringSearch
+				    methodStringSearch
-methodAproposSearch
+				    methodAproposSearch
-).
+			    ).
-currentClass notNil ifTrue:[
+	currentClass notNil ifTrue:[
-localSearchLabels := #(
+	    localSearchLabels := #(
-'-'
+				    '-'
-'local senders ...'
+				    'local senders ...'
-'local implementors ...'
+				    'local implementors ...'
-'local super sends ...'
+				    'local super sends ...'
-'local string search ...'
+				    'local string search ...'
-'local apropos ...'
+				    'local apropos ...'
-).
+				).
-localSearchSelectors := #(
+	    localSearchSelectors := #(
-nil
+				    nil
-methodLocalSenders
+				    methodLocalSenders
-methodLocalImplementors
+				    methodLocalImplementors
-methodLocalSuperSends
+				    methodLocalSuperSends
-methodLocalStringSearch
+				    methodLocalStringSearch
-methodLocalAproposSearch
+				    methodLocalAproposSearch
-).
+				  ).
-] ifFalse:[
+	] ifFalse:[
-localSearchLabels := localSearchSelectors := #()
+	    localSearchLabels := localSearchSelectors := #()
-].
+	].
-currentMethodCategory notNil ifTrue:[
+	currentMethodCategory notNil ifTrue:[
-sepLocalLabels := #('-'). sepLocalSelectors := #(nil).
+	    sepLocalLabels := #('-'). sepLocalSelectors := #(nil).
-newLabels :=           #(
+	    newLabels :=           #(
-'new method'
+				    'new method'
-).
+				    ).
-newSelectors :=    #(
+	    newSelectors :=    #(
-methodNewMethod
+				    methodNewMethod
-).
+				 ).
-] ifFalse:[
+	] ifFalse:[
-newLabels := newSelectors := #()
+	    newLabels := newSelectors := #()
-].
+	].
-currentMethod notNil ifTrue:[
+	currentMethod notNil ifTrue:[
-fileLabels :=           #(
+	    fileLabels :=           #(
-'fileOut'
+				    'fileOut'
-'printOut'
+				    'printOut'
-'-'
+				    '-'
-'SPAWN_METHOD'
+				    'SPAWN_METHOD'
-'-'
+				    '-'
-).
+				    ).
-fileSelectors :=    #(
+	    fileSelectors :=    #(
-methodFileOut
+				    methodFileOut
-methodPrintOut
+				    methodPrintOut
-nil
+				    nil
-methodSpawn
+				    methodSpawn
-nil
+				    nil
-).
+				 ).
-sepLocalLabels := #('-'). sepLocalSelectors := #(nil).
+	    sepLocalLabels := #('-'). sepLocalSelectors := #(nil).
-mthdLabels :=           #(
+	    mthdLabels :=           #(
-'change category ...'
+				    'change category ...'
-'remove'
+				    'remove'
-).
+				    ).
-mthdSelectors :=    #(
+	    mthdSelectors :=    #(
-methodChangeCategory
+				    methodChangeCategory
-methodRemove
+				    methodRemove
-).
+				 ).
-currentMethod isWrapped ifTrue:[
+	    currentMethod isWrapped ifTrue:[
-brkLabels := #(
+		brkLabels := #(
-'remove break/trace'
+				    'remove break/trace'
-'-'
+				    '-'
-).
+			      ).
-brkSelectors := #(
+		brkSelectors := #(
-methodRemoveBreakOrTrace
+				    methodRemoveBreakOrTrace
-nil
+				    nil
-)
+				 )
-] ifFalse:[
+	    ] ifFalse:[
-brkLabels := #(
+		brkLabels := #(
-'breakpoint'
+				    'breakpoint'
-'trace'
+				    'trace'
-'trace sender'
+				    'trace sender'
-'-'
+				    '-'
-).
+			      ).
-brkSelectors := #(
+		brkSelectors := #(
-methodBreakPoint
+				    methodBreakPoint
-methodTrace
+				    methodTrace
-methodTraceSender
+				    methodTraceSender
-nil
+				    nil
-)
+				 )
-]
+	    ]
-] ifFalse:[
+	] ifFalse:[
-fileLabels := fileSelectors := #().
+	    fileLabels := fileSelectors := #().
-brkLabels := brkSelectors := #().
+	    brkLabels := brkSelectors := #().
-mthdLabels := mthdSelectors := #().
+	    mthdLabels := mthdSelectors := #().
-].
+	].
-labels :=
+	labels :=
-fileLabels ,
+		    fileLabels ,
-searchLabels ,
+		    searchLabels ,
-localSearchLabels ,
+		    localSearchLabels ,
-sepLocalLabels ,
+		    sepLocalLabels ,
-brkLabels ,
+		    brkLabels ,
-newLabels ,
+		    newLabels ,
-mthdLabels.
+		    mthdLabels.
-selectors :=
+	selectors :=
-fileSelectors ,
+		    fileSelectors ,
-searchSelectors ,
+		    searchSelectors ,
-localSearchSelectors ,
+		    localSearchSelectors ,
-sepLocalSelectors ,
+		    sepLocalSelectors ,
-brkSelectors ,
+		    brkSelectors ,
-newSelectors ,
+		    newSelectors ,
-mthdSelectors.
+		    mthdSelectors.
 "
-labels := #(
+	labels := #(
-'fileOut'
+				    'fileOut'
-'printOut'
+				    'printOut'
-'-'
+				    '-'
-'SPAWN_METHOD'
+				    'SPAWN_METHOD'
-'-'
+				    '-'
-'senders ...'
+				    'senders ...'
-'implementors ...'
+				    'implementors ...'
-'globals ...'
+				    'globals ...'
-'string search ...'
+				    'string search ...'
-'apropos ...'
+				    'apropos ...'
-'-'
+				    '-'
-'local senders ...'
+				    'local senders ...'
-'local implementors ...'
+				    'local implementors ...'
-'local string search ...'
+				    'local string search ...'
-'local apropos ...'
+				    'local apropos ...'
-'-'
+				    '-'
-'breakpoint'
+				    'breakpoint'
-'trace'
+				    'trace'
-'trace sender'
+				    'trace sender'
-'-'
+				    '-'
-'new method'
+				    'new method'
-'change category ...'
+				    'change category ...'
-'remove'
+				    'remove'
-).
+				).
-selectors := #(
+	 selectors := #(
-methodFileOut
+				    methodFileOut
-methodPrintOut
+				    methodPrintOut
-nil
+				    nil
-methodSpawn
+				    methodSpawn
-nil
+				    nil
-methodSenders
+				    methodSenders
-methodImplementors
+				    methodImplementors
-methodGlobalReferends
+				    methodGlobalReferends
-methodStringSearch
+				    methodStringSearch
-methodAproposSearch
+				    methodAproposSearch
-nil
+				    nil
-methodLocalSenders
+				    methodLocalSenders
-methodLocalImplementors
+				    methodLocalImplementors
-methodLocalStringSearch
+				    methodLocalStringSearch
-methodLocalAproposSearch
+				    methodLocalAproposSearch
-nil
+				    nil
-methodBreakPoint
+				    methodBreakPoint
-methodTrace
+				    methodTrace
-methodTraceSender
+				    methodTraceSender
-nil
+				    nil
-methodNewMethod
+				    methodNewMethod
-methodChangeCategory
+				    methodChangeCategory
-methodRemove
+				    methodRemove
-)
+				  )
 "
 ].
 m := PopUpMenu
-labels:(resources array:labels)
+	 labels:(resources array:labels)
-selectors:selectors.
+	 selectors:selectors.
 currentMethod notNil ifTrue:[
-currentMethod isPrivate ifTrue:[
+	currentMethod isPrivate ifTrue:[
-m disable:#methodMakePrivate
+	    m disable:#methodMakePrivate
-].
+	].
-currentMethod isProtected ifTrue:[
+	currentMethod isProtected ifTrue:[
-m disable:#methodMakeProtected
+	    m disable:#methodMakeProtected
-].
+	].
-currentMethod isPublic ifTrue:[
+	currentMethod isPublic ifTrue:[
-m disable:#methodMakePublic
+	    m disable:#methodMakePublic
-].
+	].
 ].
 currentMethod notNil ifTrue:[
-(currentMethod code notNil
+	(currentMethod code notNil
-or:[Compiler canCreateMachineCode not]) ifTrue:[
+	or:[Compiler canCreateMachineCode not]) ifTrue:[
-m disable:#methodSTCCompile
+	    m disable:#methodSTCCompile
-].
+	].
-currentMethod byteCode isNil ifTrue:[
+	currentMethod byteCode isNil ifTrue:[
-m disable:#methodDecompile
+	    m disable:#methodDecompile
-].
+	].
 ].
 ^ m
 "Created: 23.11.1995 / 12:02:29 / cg"
 !
 methodSelectionChanged
 "method selection has changed - update dependent views"
 self withWaitCursorDo:[
-|index cls|
+	|index cls|
-self updateCodeView.
+	self updateCodeView.
-aspect := nil.
+	aspect := nil.
-self setAcceptAndExplainActionsForMethod.
+	self setAcceptAndExplainActionsForMethod.
-"
+	"
-if there is any autoSearch string, do the search
+	 if there is any autoSearch string, do the search
-"
+	"
-autoSearch notNil ifTrue:[
+	autoSearch notNil ifTrue:[
-codeView searchFwd:autoSearch startingAtLine:1 col:0 ifAbsent:[]
+	    codeView searchFwd:autoSearch startingAtLine:1 col:0 ifAbsent:[]
-].
+	].
-fullProtocol ifTrue:[
+	fullProtocol ifTrue:[
-"
+	    "
-remove any bold attribute from classList
+	     remove any bold attribute from classList
-"
+	    "
-1 to:classListView list size do:[:i |
+	    1 to:classListView list size do:[:i |
-classListView attributeAt:i remove:#bold.
+		classListView attributeAt:i remove:#bold.
-].
+	    ].
-"
+	    "
-boldify the class where this method is implemented
+	     boldify the class where this method is implemented
-"
+	    "
-currentMethod notNil ifTrue:[
+	    currentMethod notNil ifTrue:[
-cls := currentMethod who at:1.
+		cls := currentMethod who at:1.
-index := classListView list indexOf:(cls name).
+		index := classListView list indexOf:(cls name).
-(index == 0
+		(index == 0
-and:[cls isMeta
+		 and:[cls isMeta
-and:[cls name endsWith:'class']]) ifTrue:[
+		 and:[cls name endsWith:'class']]) ifTrue:[
-index := classListView list indexOf:(cls name copyWithoutLast:5).
+		    index := classListView list indexOf:(cls name copyWithoutLast:5).
-].
+		].
-index ~~ 0 ifTrue:[
+		index ~~ 0 ifTrue:[
-classListView attributeAt:index add:#bold.
+		    classListView attributeAt:index add:#bold.
-].
+		].
-currentClass := acceptClass := cls.
+		currentClass := acceptClass := cls.
-]
+	    ]
-].
+	].
 ]
 "Created: 23.11.1995 / 14:17:44 / cg"
 !
 updateCodeView
 |code|
 fullClass ifTrue:[
-currentClass notNil ifTrue:[
+	currentClass notNil ifTrue:[
-code := currentClass source.
+	    code := currentClass source.
-]
+	]
 ] ifFalse:[
-currentMethod notNil ifTrue:[
+	currentMethod notNil ifTrue:[
-(codeView acceptAction isNil
+	    (codeView acceptAction isNil
-and:[actualClass notNil
+	    and:[actualClass notNil
-and:[currentMethodCategory notNil]]) ifTrue:[
+	    and:[currentMethodCategory notNil]]) ifTrue:[
-self setAcceptAndExplainActionsForMethod.
+		self setAcceptAndExplainActionsForMethod.
-].
+	    ].
-code := currentMethod source.
+	    code := currentMethod source.
-]
+	]
 ].
 codeView contents:code.
 codeView modified:false.
 self normalLabel.
 |string|
 string := self askForSelectorTitle:title.
 string notNil ifTrue:[
-self withSearchCursorDo:[
+	self withSearchCursorDo:[
-SystemBrowser perform:selector with:string
+	    SystemBrowser perform:selector with:string
-]
+	]
 ].
 "Created: 23.11.1995 / 14:11:34 / cg"
 !
 |string|
 string := self askForSelectorTitle:title.
 string notNil ifTrue:[
-self withSearchCursorDo:[
+	self withSearchCursorDo:[
-SystemBrowser perform:selector with:string with:arg
+	    SystemBrowser perform:selector with:string with:arg
-]
+	]
 ].
 "Created: 23.11.1995 / 14:11:38 / cg"
 !
 busyLabel:what with:someArgument
 "set the title for some warning"
 self label:('System Browser - ' , (resources string:what with:someArgument))
+!
+checkSelectionChangeAllowedWithCompare:compareOffered
+"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"
+|action labels values|
+codeView modified ifFalse:[
+	^ true
+].
+compareOffered ifTrue:[
+	labels := #('abort' 'compare' 'accept' 'continue').
+	values := #(false #compare #accept true).
+] ifFalse:[
+	labels := #('abort' 'accept' 'continue').
+	values := #(false #accept true).
+].
+action := OptionBox
+		  request:(resources at:'text has not been accepted.\\Your modifications will be lost when continuing.') withCRs
+		  label:(resources string:'Attention')
+		  form:(WarningBox iconBitmap)
+		  buttonLabels:(resources array:labels)
+		  values:values
+		  default:true.
+action ~~ #accept ifTrue:[
+	^ action
+].
+codeView accept.
+^ true
+"Created: 24.11.1995 / 10:54:46 / 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"
-|action|
+|what m src v|
-codeView modified ifFalse:[
+currentMethod notNil ifTrue:[
-	^ true
+	m := actualClass compiledMethodAt:currentSelector.
-].
+	(src := m source) = codeView contents ifFalse:[
-action := OptionBox
+	    what := self checkSelectionChangeAllowedWithCompare:true.
-		  request:(resources at:'text has not been accepted.\\Your modifications will be lost when continuing.') withCRs
+	    what == #compare ifTrue:[
-		  label:(resources string:'Attention')
+		v := DiffTextView
-		  form:(WarningBox iconBitmap)
+			openOn:codeView contents label:'code here (to be accepted ?)'
-		  buttonLabels:(resources array:#('abort' 'accept' 'continue'))
+			and:src label:'methods actual code'.
-		  values:#(false #accept true)
+		v label:'comparing method versions'.
-		  default:true.
+		^ false
-action ~~ #accept ifTrue:[
+	    ].
-	^ action
+	    ^ what
-].
+	]
-codeView accept. ^ true
+].
+^ self checkSelectionChangeAllowedWithCompare:false
+"Created: 24.11.1995 / 11:03:33 / cg"
+"Modified: 24.11.1995 / 11:05:49 / cg"
 !
 classHierarchyDo:aBlock
 "eavluate the 2-arg block for every class,
 starting at Object; passing class and nesting level to the block."
 allClassOrInstVarRefsTitle:title access:access mods:modifications
 "show an enterbox for instVar to search for"
 self doClassMenu:[:currentClass |
-|box|
+	|box|
-box := self enterBoxForVariableSearch:title.
+	box := self enterBoxForVariableSearch:title.
-box action:[:aVariableName |
+	box action:[:aVariableName |
-|homeClass|
+	    |homeClass|
-aVariableName isEmpty ifFalse:[
+	    aVariableName isEmpty ifFalse:[
-self withSearchCursorDo:[
+		self withSearchCursorDo:[
-homeClass := self findClassOfVariable:aVariableName accessWith:access.
+		    homeClass := self findClassOfVariable:aVariableName accessWith:access.
-access == #classVarNames ifTrue:[
+		    access == #classVarNames ifTrue:[
-SystemBrowser
+			SystemBrowser
-browseClassRefsTo:aVariableName
+			    browseClassRefsTo:aVariableName
-under:homeClass
+			    under:homeClass
-modificationsOnly:modifications
+			    modificationsOnly:modifications
-] ifFalse:[
+		    ] ifFalse:[
-SystemBrowser
+			SystemBrowser
-browseInstRefsTo:aVariableName
+			    browseInstRefsTo:aVariableName
-under:homeClass
+			    under:homeClass
-modificationsOnly:modifications
+			    modificationsOnly:modifications
-]
+		    ]
-]
+		]
-]
+	    ]
-].
+	].
-box showAtPointer
+	box showAtPointer
 ]
 "Created: 23.11.1995 / 14:13:24 / cg"
 !
 classVarRefsOrModsTitle:title mods:mods
 "show an enterbox for classVar to search for"
 self doClassMenu:[:currentClass |
-|box|
+	|box|
-box := self enterBoxForVariableSearch:title.
+	box := self enterBoxForVariableSearch:title.
-box action:[:aString |
+	box action:[:aString |
-aString notEmpty ifTrue:[
+	    aString notEmpty ifTrue:[
-self withSearchCursorDo:[
+		self withSearchCursorDo:[
-SystemBrowser
+		    SystemBrowser
-browseClassRefsTo:aString
+			   browseClassRefsTo:aString
-in:(Array with:currentClass)
+			   in:(Array with:currentClass)
-modificationsOnly:mods
+			   modificationsOnly:mods
-]
+		]
-]
+	    ]
-].
+	].
-box showAtPointer
+	box showAtPointer
 ]
 "Created: 23.11.1995 / 14:12:56 / cg"
 !
 instVarRefsOrModsTitle:title mods:mods
 "show an enterbox for instvar to search for"
 self doClassMenu:[:currentClass |
-|box|
+	|box|
-box := self enterBoxForVariableSearch:title.
+	box := self enterBoxForVariableSearch:title.
-box action:[:aString |
+	box action:[:aString |
-aString notEmpty ifTrue:[
+	    aString notEmpty ifTrue:[
-self withSearchCursorDo:[
+		self withSearchCursorDo:[
-SystemBrowser
+		    SystemBrowser
-browseInstRefsTo:aString
+			browseInstRefsTo:aString
-in:(Array with:currentClass)
+			in:(Array with:currentClass)
-modificationsOnly:mods
+			modificationsOnly:mods
-]
+		]
-]
+	    ]
-].
+	].
-box showAtPointer
+	box showAtPointer
 ]
 "Created: 23.11.1995 / 14:12:40 / cg"
 !
 name := variableListView selectionValue.
 name isNil ifTrue:[^ self].
 self withSearchCursorDo:[
-|classes filter any|
+	|classes filter any|
-classes := Array with:actualClass.
+	classes := Array with:actualClass.
-currentClassHierarchy notNil ifTrue:[
+	currentClassHierarchy notNil ifTrue:[
-classes := classes , actualClass allSuperclasses.
+	    classes := classes , actualClass allSuperclasses.
-redefinedSelectors := IdentitySet new.
+	    redefinedSelectors := IdentitySet new.
-].
+	].
-filter := SystemBrowser filterToSearchRefsTo:name classVars:showInstance not modificationsOnly:false.
+	filter := SystemBrowser filterToSearchRefsTo:name classVars:showInstance not modificationsOnly:false.
-any := false.
+	any := false.
-"
+	"
-highlight the method that ref this variable
+	 highlight the method that ref this variable
-"
+	"
-classes do:[:someClass |
+	classes do:[:someClass |
-(fullProtocol
+	    (fullProtocol
-and:[classListView valueIsInSelection:(someClass name)]) ifFalse:[
+	    and:[classListView valueIsInSelection:(someClass name)]) ifFalse:[
-someClass methodArray with:someClass selectorArray
+		someClass methodArray with:someClass selectorArray
-do:[:method :selector |
+		do:[:method :selector |
-(inCat
+		    (inCat
-or:[methodListView list notNil
+		    or:[methodListView list notNil
-and:[methodListView list includes:selector]])
+			and:[methodListView list includes:selector]])
-ifTrue:[
+		    ifTrue:[
-(redefinedSelectors isNil
+			(redefinedSelectors isNil
-or:[(redefinedSelectors includes:selector) not])
+			or:[(redefinedSelectors includes:selector) not])
-ifTrue:[
+		       ifTrue:[
-(filter value:someClass value:method value:selector) ifTrue:[
+			   (filter value:someClass value:method value:selector) ifTrue:[
-|idx cat|
+			       |idx cat|
-(inCat
+			       (inCat
-and:[methodCategoryListView notNil
+			       and:[methodCategoryListView notNil
-and:[methodCategoryListView list notNil]]) ifTrue:[
+			       and:[methodCategoryListView list notNil]]) ifTrue:[
-cat := method category.
+				   cat := method category.
-"
+				   "
-highlight the methodCategory
+				    highlight the methodCategory
-"
+				   "
-idx := methodCategoryListView list indexOf:cat.
+				   idx := methodCategoryListView list indexOf:cat.
-idx ~~ 0 ifTrue:[
+				   idx ~~ 0 ifTrue:[
-methodCategoryListView attributeAt:idx put:#bold.
+				       methodCategoryListView attributeAt:idx put:#bold.
-].
+				   ].
-].
+			       ].
-(inMethods
+			       (inMethods
-and:[methodListView notNil
+			       and:[methodListView notNil
-and:[methodListView list notNil]]) ifTrue:[
+			       and:[methodListView list notNil]]) ifTrue:[
-"
+				   "
-highlight the method
+				    highlight the method
-"
+				   "
-idx := methodListView list indexOf:selector.
+				   idx := methodListView list indexOf:selector.
-idx ~~ 0 ifTrue:[
+				   idx ~~ 0 ifTrue:[
-methodListView attributeAt:idx put:#bold.
+				       methodListView attributeAt:idx put:#bold.
-].
+				   ].
-any := true
+				   any := true
-].
+			       ].
-].
+			   ].
-redefinedSelectors notNil ifTrue:[
+			   redefinedSelectors notNil ifTrue:[
-redefinedSelectors add:selector
+			       redefinedSelectors add:selector
-]
+			   ]
-]
+			]
-]
+		    ]
-]
+		]
-]
+	    ]
-].
+	].
-any ifTrue:[
+	any ifTrue:[
-self setSearchPattern:name
+	    self setSearchPattern:name
-]
+	]
 ]
 "Created: 23.11.1995 / 14:12:08 / cg"
 !
 ! !
 !BrowserView class methodsFor:'documentation'!
 version
-^ '$Header: /cvs/stx/stx/libtool/BrowserView.st,v 1.48 1995-11-23 17:50:00 cg Exp $'! !
+^ '$Header: /cvs/stx/stx/libtool/BrowserView.st,v 1.49 1995-11-24 10:30:53 cg Exp $'! !
 BrowserView initialize!

changeset 204	6f4460d5a09d
parent 201	3331e9abc9f0
child 213	4b8b25b6baa1