[squeak-dev] The Trunk: Tools-mt.645.mcz

commits at source.squeak.org commits at source.squeak.org
Fri Nov 6 11:10:37 UTC 2015


Marcel Taeumel uploaded a new version of Tools to project The Trunk:
http://source.squeak.org/trunk/Tools-mt.645.mcz

==================== Summary ====================

Name: Tools-mt.645
Author: mt
Time: 6 November 2015, 12:10:12.372 pm
UUID: a9fab090-87fa-4068-84d7-ccc4ab227b80
Ancestors: Tools-mt.644

Makes the preference #balloonHelpInMessageLists functional again.

Applies the preferences "Show message icons" and #balloonHelpInMessageLists also to senders, implementors, message traces, debuggers, etc.

=============== Diff against Tools-mt.644 ===============

Item was changed:
  ----- Method: Browser>>buildMessageListWith: (in category 'toolbuilder') -----
  buildMessageListWith: builder
  	| listSpec |
  	listSpec := builder pluggableListSpec new.
  	listSpec 
  		model: self;
  		list: #messageList; 
  		getIndex: #messageListIndex; 
  		setIndex: #messageListIndex:; 
  		icon: #messageIconAt:;
+ 		help: #messageHelpAt:;
  		menu: #messageListMenu:shifted:; 
  		keyPress: #messageListKey:from:.
  	SystemBrowser browseWithDragNDrop 
  		ifTrue:[listSpec dragItem: #dragFromMessageList:].
  	^listSpec
  !

Item was added:
+ ----- Method: Browser>>messageHelpAt: (in category 'message list') -----
+ messageHelpAt: anIndex
+ 	"Show the first n lines of the sources code of the selected message."
+ 	
+ 	| source formatted lineCount |
+ 	Preferences balloonHelpInMessageLists ifFalse: [^ nil].
+ 	self messageList size < anIndex ifTrue: [^ nil].
+ 	
+ 	source := (self selectedClassOrMetaClass >> (self messageList at: anIndex)) getSource.
+ 	formatted := SHTextStylerST80 new
+ 		classOrMetaClass: self selectedClassOrMetaClass;
+ 		styledTextFor: source asText.
+ 	
+ 	lineCount := 0.
+ 	source doWithIndex: [:char :index |
+ 		char = Character cr ifTrue: [lineCount := lineCount + 1].
+ 		lineCount > 10 ifTrue: [
+ 			formatted := formatted copyFrom: 1 to: index-1.
+ 			formatted append: ' [...]'.
+ 			^ formatted]].
+ 
+ 	^ formatted!

Item was changed:
  ----- Method: Debugger>>buildFullWith: (in category 'toolbuilder') -----
  buildFullWith: builder
  	| windowSpec listSpec textSpec |
  	windowSpec := builder pluggableWindowSpec new
  		model: self;
  		label: 'Debugger';
  		children: OrderedCollection new.
  
  	listSpec := builder pluggableListSpec new.
  	listSpec 
  		model: self;
  		list: #contextStackList; 
  		getIndex: #contextStackIndex; 
  		setIndex: #toggleContextStackIndex:; 
  		menu: #contextStackMenu:shifted:; 
+ 		icon: #messageIconAt:;
+ 		help: #messageHelpAt:; 
  		keyPress: #contextStackKey:from:;
  		frame: (0 at 0 corner: 1 at 0.22).
  	windowSpec children add: listSpec.
  
  
  	textSpec := self buildCodePaneWith: builder.
  	textSpec frame: (0 at 0.22corner: 1 at 0.8).
  	windowSpec children add: textSpec.
  
  	listSpec := builder pluggableListSpec new.
  	listSpec 
  		model: self receiverInspector;
  		list: #fieldList; 
  		getIndex: #selectionIndex; 
  		setIndex: #toggleIndex:; 
  		menu: #fieldListMenu:; 
  		keyPress: #inspectorKey:from:;
  		frame: (0 at 0.8 corner: 0.2 at 1).
  	windowSpec children add: listSpec.
  
  	textSpec := builder pluggableTextSpec new.
  	textSpec 
  		model: self receiverInspector;
  		getText: #contents; 
  		setText: #accept:; 
  		help: '<- Select receiver''s field' translated;
  		selection: #contentsSelection; 
  		menu: #codePaneMenu:shifted:;
  		frame: (0.2 at 0.8 corner: 0.5 at 1).
  	windowSpec children add: textSpec.
  
  	listSpec := builder pluggableListSpec new.
  	listSpec 
  		model: self contextVariablesInspector;
  		list: #fieldList; 
  		getIndex: #selectionIndex; 
  		setIndex: #toggleIndex:; 
  		menu: #fieldListMenu:; 
  		keyPress: #inspectorKey:from:;
  		frame: (0.5 at 0.8 corner: 0.7 at 1).
  	windowSpec children add: listSpec.
  
  	textSpec := builder pluggableTextSpec new.
  	textSpec 
  		model: self contextVariablesInspector;
  		getText: #contents; 
  		setText: #accept:; 
  		help: '<- Select context''s field' translated;
  		selection: #contentsSelection; 
  		menu: #codePaneMenu:shifted:;
  		frame: (0.7 at 0.8 corner: 1 at 1).
  	windowSpec children add: textSpec.
  
  	^builder build: windowSpec!

Item was changed:
  ----- Method: Debugger>>buildNotifierWith:label:message: (in category 'toolbuilder') -----
  buildNotifierWith: builder label: label message: messageString
  	| windowSpec listSpec textSpec panelSpec quads |
  	windowSpec := builder pluggableWindowSpec new
  		model: self;
  		extent: self initialExtentForNotifier;
  		label: label;
  		children: OrderedCollection new.
  
  	panelSpec := builder pluggablePanelSpec new.
  	panelSpec children: OrderedCollection new.
  	quads := self preDebugButtonQuads.
  	(self interruptedContext selector == #doesNotUnderstand:) ifTrue: [
  		quads := quads copyWith: 
  			{ 'Create'. #createMethod. #magenta. 'create the missing method' }
  	].
  	(#(#notYetImplemented #shouldBeImplemented #requirement) includes: self interruptedContext selector) ifTrue: [
  		quads := quads copyWith: 
  			{ 'Create'. #createImplementingMethod. #magenta. 'implement the marked method' }
  	].
  	(self interruptedContext selector == #subclassResponsibility) ifTrue: [
  		quads := quads copyWith: 
  			{ 'Create'. #createOverridingMethod. #magenta. 'create the missing overriding method' }
  	].
  	quads do:[:spec| | buttonSpec |
  		buttonSpec := builder pluggableButtonSpec new.
  		buttonSpec model: self.
  		buttonSpec label: spec first.
  		buttonSpec action: spec second.
  		buttonSpec help: spec fourth.
  		panelSpec children add: buttonSpec.
  	].
  	panelSpec layout: #horizontal. "buttons"
  	panelSpec frame: self preDebugButtonQuadFrame.
  	windowSpec children add: panelSpec.
  
  	Preferences eToyFriendly | messageString notNil ifFalse:[
  		listSpec := builder pluggableListSpec new.
  		listSpec 
  			model: self;
  			list: #contextStackList; 
  			getIndex: #contextStackIndex; 
  			setIndex: #debugAt:; 
+ 			icon: #messageIconAt:;
+ 			help: #messageHelpAt:; 
  			frame: self contextStackFrame.
  		windowSpec children add: listSpec.
  	] ifTrue:[
  		message := messageString.
  		textSpec := builder pluggableTextSpec new.
  		textSpec 
  			model: self;
  			getText: #preDebugMessageString; 
  			setText: nil; 
  			selection: nil; 
  			menu: #debugProceedMenu:;
  			frame: self contextStackFrame.
  		windowSpec children add: textSpec.
  	].
  
  	^windowSpec!

Item was added:
+ ----- Method: Debugger>>messageHelpAt: (in category 'context stack (message list)') -----
+ messageHelpAt: anIndex
+ 	"Show the first n lines of the sources code of the selected message."
+ 	
+ 	| method source formatted lineCount |
+ 	Preferences balloonHelpInMessageLists ifFalse: [^ nil].
+ 	contextStack size < anIndex ifTrue: [^ nil].
+ 	
+ 	method := (contextStack at: anIndex) method.
+ 	
+ 	source := method getSource.
+ 	formatted := SHTextStylerST80 new
+ 		classOrMetaClass: method methodClass;
+ 		styledTextFor: source asText.
+ 	
+ 	lineCount := 0.
+ 	source doWithIndex: [:char :index |
+ 		char = Character cr ifTrue: [lineCount := lineCount + 1].
+ 		lineCount > 10 ifTrue: [
+ 			formatted := formatted copyFrom: 1 to: index-1.
+ 			formatted append: ' [...]'.
+ 			^ formatted]].
+ 
+ 	^ formatted!

Item was added:
+ ----- Method: Debugger>>messageIconAt: (in category 'context stack (message list)') -----
+ messageIconAt: anIndex
+ 
+ 	Browser showMessageIcons
+ 		ifFalse: [^ nil].
+ 
+ 	^ ToolIcons iconNamed: (ToolIcons
+ 		iconForClass: (contextStack at: anIndex) method methodClass
+ 		selector: (contextStack at: anIndex) method selector)!

Item was changed:
  ----- Method: MessageSet>>buildMessageListWith: (in category 'toolbuilder') -----
  buildMessageListWith: builder
  	| listSpec |
  	listSpec := builder pluggableListSpec new.
  	listSpec 
  		model: self;
  		list: #messageList; 
  		getIndex: #messageListIndex; 
+ 		setIndex: #messageListIndex:;
+ 		icon: #messageIconAt:;
+ 		help: #messageHelpAt:; 
- 		setIndex: #messageListIndex:; 
  		menu: #messageListMenu:shifted:; 
  		keyPress: #messageListKey:from:.
  	SystemBrowser browseWithDragNDrop 
  		ifTrue:[listSpec dragItem: #dragFromMessageList:].
  	^listSpec
  !

Item was added:
+ ----- Method: MessageSet>>messageHelpAt: (in category 'message list') -----
+ messageHelpAt: anIndex
+ 	"Show the first n lines of the sources code of the selected message."
+ 	
+ 	| reference source formatted lineCount |
+ 	Preferences balloonHelpInMessageLists ifFalse: [^ nil].
+ 	self messageList size < anIndex ifTrue: [^ nil].
+ 	
+ 	reference := self messageList at: anIndex.
+ 	reference isValid ifFalse: [^ nil].
+ 	
+ 	source := reference compiledMethod getSource.
+ 	formatted := SHTextStylerST80 new
+ 		classOrMetaClass: reference actualClass;
+ 		styledTextFor: source asText.
+ 	
+ 	lineCount := 0.
+ 	source doWithIndex: [:char :index |
+ 		char = Character cr ifTrue: [lineCount := lineCount + 1].
+ 		lineCount > 10 ifTrue: [
+ 			formatted := formatted copyFrom: 1 to: index-1.
+ 			formatted append: ' [...]'.
+ 			^ formatted]].
+ 
+ 	^ formatted!

Item was added:
+ ----- Method: MessageSet>>messageIconAt: (in category 'message list') -----
+ messageIconAt: anIndex
+ 
+ 	Browser showMessageIcons
+ 		ifFalse: [^ nil].
+ 
+ 	^ ToolIcons iconNamed: (ToolIcons
+ 		iconForClass: (self messageList at: anIndex) actualClass
+ 		selector: (self messageList at: anIndex) selector)!

Item was changed:
  ----- Method: MessageTrace>>buildMessageListWith: (in category 'private initializing') -----
  buildMessageListWith: builder
  	| listSpec |
  	listSpec := builder pluggableAlternateMultiSelectionListSpec new.
  	listSpec 
  		model: self ;
  		list: #messageList ;
  		getIndex: #messageListIndex ;
  		setIndex: #toggleSelectionAt:shifted:controlled: ;
+ 		icon: #messageIconAt:;
+ 		help: #messageHelpAt:; 
  		menu: #messageListMenu:shifted: ; 
  		getSelectionList: #isMessageSelectedAt: ;
  		setSelectionList: #messageAt:beSelected: ;
  		keyPress: #messageListKey:from:.
  	SystemBrowser browseWithDragNDrop 
  		ifTrue: [ listSpec dragItem: #dragFromMessageList: ].
  	^ listSpec!

Item was removed:
- ----- Method: StringMorph>>balloonTextForClassAndMethodString (in category '*Tools') -----
- balloonTextForClassAndMethodString
- 	"Answer suitable balloon text for the receiver thought of as an encoding of the form
- 		<className>  [ class ] <selector>"
- 
- 	| aComment |
- 	Preferences balloonHelpInMessageLists
- 		ifFalse: [^ nil].
- 	MessageSet parse: self contents asString toClassAndSelector:
- 		[:aClass :aSelector |
- 			(aClass notNil and: [aSelector notNil]) ifTrue:
- 				[aComment := aClass precodeCommentOrInheritedCommentFor: aSelector]].
- 	^ aComment
- !

Item was removed:
- ----- Method: StringMorph>>balloonTextForLexiconString (in category '*Tools') -----
- balloonTextForLexiconString
- 	"Answer suitable balloon text for the receiver thought of as an encoding (used in Lexicons) of the form
- 		<selector> <spaces> (<className>>)"
- 
- 	| aComment contentsString aSelector aClassName |
- 	Preferences balloonHelpInMessageLists
- 		ifFalse: [^ nil].
- 	contentsString := self contents asString.
- 	aSelector := contentsString upTo: $ .
- 	aClassName := contentsString copyFrom: ((contentsString indexOf: $() + 1) to: ((contentsString indexOf: $)) - 1).
- 	MessageSet parse: (aClassName, ' dummy') toClassAndSelector:
- 		[:cl :sel | cl ifNotNil:
- 			[aComment := cl precodeCommentOrInheritedCommentFor: aSelector]].
- 	^ aComment
- !

Item was removed:
- ----- Method: StringMorph>>balloonTextForMethodString (in category '*Tools') -----
- balloonTextForMethodString
- 	"Answer suitable balloon text for the receiver thought of as a method belonging to the currently-selected class of a browser tool."
- 
- 	| aWindow aCodeHolder aClass |
- 	Preferences balloonHelpInMessageLists
- 		ifFalse: [^ nil].
- 	aWindow := self ownerThatIsA: SystemWindow.
- 	(aWindow isNil or: [((aCodeHolder := aWindow model) isKindOf: CodeHolder) not])
- 		ifTrue:	[^ nil].
- 	((aClass := aCodeHolder selectedClassOrMetaClass) isNil or:
- 		[(aClass includesSelector: contents asSymbol) not])
- 			ifTrue: [^ nil].
- 	^ aClass precodeCommentOrInheritedCommentFor: contents asSymbol
- !



More information about the Squeak-dev mailing list