[Pkg] The Trunk: Tools-ar.159.mcz

commits at source.squeak.org commits at source.squeak.org
Sun Jan 3 23:55:35 UTC 2010


Andreas Raab uploaded a new version of Tools to project The Trunk:
http://source.squeak.org/trunk/Tools-ar.159.mcz

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

Name: Tools-ar.159
Author: ar
Time: 4 January 2010, 12:54:43 pm
UUID: a4cc75ec-086a-cb47-8306-b82b0c28d165
Ancestors: Tools-nice.157

Make Etoys unloadable: Remove support for isolatedCodePane and installTilesAsSelection since both require Etoys to be present.

=============== Diff against Tools-nice.157 ===============

Item was changed:
  ----- Method: ChangeSorter>>shiftedMessageMenu: (in category 'message list') -----
  shiftedMessageMenu: aMenu
  	"Arm the menu so that it holds items appropriate to the message-list while the shift key is down.  Answer the menu."
  
  	^ aMenu addList: #(
  		-
- 		('method pane'						makeIsolatedCodePane)
  		('toggle diffing (D)'					toggleDiffing)
  		('implementors of sent messages'		browseAllMessages)
  		('change category...'				changeCategory)
  			-
  		('sample instance'					makeSampleInstance)
  		('inspect instances'					inspectInstances)
  		('inspect subinstances'				inspectSubInstances)
  		-
  		('change sets with this method'		findMethodInChangeSets)
  		('revert to previous version'			revertToPreviousVersion)
  		('revert & remove from changes'	revertAndForget)
  		-
  		('more...'							unshiftedYellowButtonActivity))!

Item was changed:
  ----- Method: Browser>>messageListMenu:shifted: (in category 'message functions') -----
  messageListMenu: aMenu shifted: shifted 
  	"Answer the message-list menu"
  	(self menuHook: aMenu named: #messageListMenu shifted: shifted) ifTrue:[^aMenu].
  	shifted ifTrue: [^ self shiftedMessageListMenu: aMenu].
  	aMenu addList: #(
  			('what to show...'			offerWhatToShowMenu)
  			('toggle break on entry'		toggleBreakOnEntry)
  			-
  			('browse full (b)' 			browseMethodFull)
  			('browse hierarchy (h)'			classHierarchy)
  			('browse method (O)'			openSingleMessageBrowser)
  			('browse protocol (p)'			browseFullProtocol)
  			-
  			('fileOut'				fileOutMessage)
  			('printOut'				printOutMessage)
  			-
  			('senders of... (n)'			browseSendersOfMessages)
  			('implementors of... (m)'		browseMessages)
  			('inheritance (i)'			methodHierarchy)
- 			('tile scriptor'			openSyntaxView)
  			('versions (v)'				browseVersions)
  			-
  			('inst var refs...'			browseInstVarRefs)
  			('inst var defs...'			browseInstVarDefs)
  			('class var refs...'			browseClassVarRefs)
  			('class variables'			browseClassVariables)
  			('class refs (N)'			browseClassRefs)
  			-
  			('remove method (x)'			removeMessage)
  			-
  			('more...'				shiftedYellowButtonActivity)).
  	^ aMenu!

Item was changed:
  ----- Method: CodeHolder class>>defaultContentsSymbolQuints (in category 'controls') -----
  defaultContentsSymbolQuints
  	"Default list of quintuplets representing information on the alternative views available in the code pane
  		first element:	the contentsSymbol used
  		second element:	the selector to call when this item is chosen.
  		third element:	the selector to call to obtain the wording of the menu item.
  		fourth element:	the wording to represent this view
  		fifth element:	balloon help
  	A hypen indicates a need for a seperator line in a menu of such choices"
  
  	^ {
  		{#source
  			. #togglePlainSource 
  			. #showingPlainSourceString 
  			. 'source'
  			. 'the textual source code as written' translated} .
  		{#documentation
  			. #toggleShowDocumentation
  			. #showingDocumentationString
  			. 'documentation'
  			. 'the first comment in the method' translated} .
  
  		#- .
  		{#prettyPrint
  			. #togglePrettyPrint
  			. #prettyPrintString
  			. 'prettyPrint'
  			. 'the method source presented in a standard text format' translated} .
  
  		#- .
  		{#showDiffs
  			. #toggleRegularDiffing
  			. #showingRegularDiffsString
  			. 'showDiffs'
  			. 'the textual source diffed from its prior version' translated} .
  
  		#- .
  		{#decompile
  			. #toggleDecompile
  			. #showingDecompileString
  			. 'decompile'
  			. 'source code decompiled from byteCodes' translated} .
  		{#byteCodes
  			. #toggleShowingByteCodes
  			. #showingByteCodesString
  			. 'byteCodes'	
  			. 'the bytecodes that comprise the compiled method' translated} .
- 
- 		#- .
- 		{#tiles
- 			. #toggleShowingTiles
- 			. #showingTilesString
- 			. 'tiles'
- 			. 'universal tiles representing the method' translated}
  	}!

Item was changed:
  ----- Method: MethodHolder>>doItReceiver (in category 'menu') -----
  doItReceiver
  	"If there is an instance associated with me, answer it, for true mapping of self.  If not, then do what other code-bearing tools do, viz. give access to the class vars."
- 
- 	(self dependents detect: [:m | m isKindOf: MethodMorph]) ifNotNil:
- 		[:mm | (mm owner isKindOf: ScriptEditorMorph) ifTrue:
- 			[^ mm owner playerScripted]].
- 
  	^ self selectedClass ifNil: [FakeClassPool new]!

Item was changed:
  ----- Method: Browser>>shiftedMessageListMenu: (in category 'message functions') -----
  shiftedMessageListMenu: aMenu
  	"Fill aMenu with the items appropriate when the shift key is held down"
  
  	Smalltalk isMorphic ifTrue: [aMenu addStayUpItem].
  	aMenu addList: #(
- 		('method pane' 							makeIsolatedCodePane)
- 		('tile scriptor'							openSyntaxView)
  		('toggle diffing (D)'						toggleDiffing)
  		('implementors of sent messages'			browseAllMessages)
  		-
  		('local senders of...'						browseLocalSendersOfMessages)
  		('local implementors of...'				browseLocalImplementors)
  		-
  		('spawn sub-protocol'					spawnProtocol)
  		('spawn full protocol'					spawnFullProtocol)
  		-
  		('sample instance'						makeSampleInstance)
  		('inspect instances'						inspectInstances)
  		('inspect subinstances'					inspectSubInstances)).
  
  	self addExtraShiftedItemsTo: aMenu.
  	aMenu addList: #(
  		-
  		('change category...'					changeCategory)).
  
  	self canShowMultipleMessageCategories ifTrue: [aMenu addList:
  		 #(('show category (C)'						showHomeCategory))].
  	aMenu addList: #(
  		-
  		('change sets with this method'			findMethodInChangeSets)
  		('revert to previous version'				revertToPreviousVersion)
  		('remove from current change set'		removeFromCurrentChanges)
  		('revert & remove from changes'		revertAndForget)
  		('add to current change set'				adoptMessageInCurrentChangeset)
  		('copy up or copy down...'				copyUpOrCopyDown)
  		-
  		('more...' 								unshiftedYellowButtonActivity)).
  	^ aMenu
  !

Item was changed:
+ ----- Method: CodeHolder>>installTextualCodingPane (in category 'diffs') -----
- ----- Method: CodeHolder>>installTextualCodingPane (in category 'misc') -----
  installTextualCodingPane
  	"Install text into the code pane"
  
  	| aWindow codePane aPane boundsToUse |
  	(aWindow := self containingWindow) ifNil: [self error: 'where''s that window?'].
  	codePane := aWindow findDeepSubmorphThat:   
+ 		[:m | ((m isKindOf: PluggableTextMorph) and: [m getTextSelector == #contents])]
+ 			ifAbsent: [self error: 'no code pane'].
- 		[:m | ((m isKindOf: PluggableTextMorph) and: [m getTextSelector == #contents]) or:
- 			[m isKindOf: PluggableTileScriptorMorph]] ifAbsent: [self error: 'no code pane'].
  	aPane := self buildMorphicCodePaneWith: nil.
  	boundsToUse := (codePane bounds origin- (1 at 1)) corner: (codePane owner bounds corner " (1 at 1").
  	aWindow replacePane: codePane with: aPane.
  	aPane vResizing: #spaceFill; hResizing: #spaceFill; borderWidth: 0.
  	aPane bounds: boundsToUse.
  	aPane owner clipSubmorphs: false.
  
  	self contentsChanged!

Item was removed:
- ----- Method: MethodHolder class>>makeIsolatedCodePaneForClass:selector: (in category 'instance creation') -----
- makeIsolatedCodePaneForClass: aClass selector: aSelector
- 	"Create, and place in the morphic Hand, an isolated code pane bearing source code for the given class and selector"
- 
- 	(self isolatedCodePaneForClass: aClass selector: aSelector) openInHand!

Item was removed:
- ----- Method: StringHolder>>makeIsolatedCodePane (in category '*Tools') -----
- makeIsolatedCodePane
- 	| msgName |
- 
- 	(msgName := self selectedMessageName) ifNil: [^ Beeper beep].
- 	MethodHolder makeIsolatedCodePaneForClass: self selectedClassOrMetaClass selector: msgName!

Item was removed:
- ----- Method: ComponentLayout>>inspectModelInMorphic (in category '*Tools') -----
- inspectModelInMorphic
- 	| insp |
- 	insp := InspectorBrowser openOn: self model.
- 	self world addMorph: insp; startStepping: insp!

Item was removed:
- ----- Method: MethodHolder class>>isolatedCodePaneForClass:selector: (in category 'instance creation') -----
- isolatedCodePaneForClass: aClass selector: aSelector
- 	"Answer a MethodMorph on the given class and selector"
- 
- 	| aCodePane aMethodHolder |
- 
- 	aMethodHolder := self new.
- 	aMethodHolder methodClass: aClass methodSelector: aSelector.
- 
- 	aCodePane := MethodMorph on: aMethodHolder text: #contents accept: #contents:notifying:
- 			readSelection: #contentsSelection menu: #codePaneMenu:shifted:.
- 	aMethodHolder addDependent: aCodePane.
- 	aCodePane borderWidth: 2; color: Color white.
- 	aCodePane scrollBarOnLeft: false.
- 	aCodePane width: 300.
- 	^ aCodePane!



More information about the Packages mailing list