[squeak-dev] The Trunk: Tools-fbs.512.mcz

commits at source.squeak.org commits at source.squeak.org
Sun Dec 29 19:18:41 UTC 2013


Frank Shearar uploaded a new version of Tools to project The Trunk:
http://source.squeak.org/trunk/Tools-fbs.512.mcz

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

Name: Tools-fbs.512
Author: fbs
Time: 29 December 2013, 7:10:20.18 pm
UUID: 49c920b7-6e0d-a04d-83e5-dfa1578622ca
Ancestors: Tools-cmm.511

Make browseWithPrettyPrint, browseWithDragNDrop pragma-based preferences.

=============== Diff against Tools-cmm.511 ===============

Item was changed:
  ----- Method: Browser>>buildClassListWith: (in category 'toolbuilder') -----
  buildClassListWith: builder
  	| listSpec |
  	listSpec := builder pluggableListSpec new.
  	listSpec 
  		model: self;
  		list: #classList; 
  		getIndex: #classListIndex; 
  		setIndex: #classListIndex:; 
  		menu: #classListMenu:shifted:; 
  		keyPress: #classListKey:from:.
+ 	SystemBrowser browseWithDragNDrop 
- 	Preferences browseWithDragNDrop 
  		ifTrue:[listSpec dragItem: #dragFromClassList:].
  
  	^listSpec
  !

Item was changed:
  ----- Method: Browser>>buildMessageCategoryListWith: (in category 'toolbuilder') -----
  buildMessageCategoryListWith: builder
  	| listSpec |
  	listSpec := builder pluggableListSpec new.
  	listSpec 
  		model: self;
  		list: #messageCategoryList; 
  		getIndex: #messageCategoryListIndex; 
  		setIndex: #messageCategoryListIndex:; 
  		menu: #messageCategoryMenu:; 
  		keyPress: #arrowKey:from:.
+ 	SystemBrowser browseWithDragNDrop ifTrue:[
- 	Preferences browseWithDragNDrop ifTrue:[
  		listSpec
  			dropAccept: #wantsMessageCategoriesDrop:;
  			dropItem: #dropOnMessageCategories:at:].
  	^listSpec
  !

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:; 
  		menu: #messageListMenu:shifted:; 
  		keyPress: #messageListKey:from:.
+ 	SystemBrowser browseWithDragNDrop 
- 	Preferences browseWithDragNDrop 
  		ifTrue:[listSpec dragItem: #dragFromMessageList:].
  	^listSpec
  !

Item was changed:
  ----- Method: Browser>>buildSystemCategoryListWith: (in category 'toolbuilder') -----
  buildSystemCategoryListWith: builder
  	| listSpec |
  	listSpec := builder pluggableListSpec new.
  	listSpec 
  		model: self;
  		list: #systemCategoryList; 
  		getIndex: #systemCategoryListIndex; 
  		setIndex: #systemCategoryListIndex:; 
  		menu: #systemCategoryMenu:; 
  		keyPress: #systemCatListKey:from:.
+ 	SystemBrowser browseWithDragNDrop ifTrue:[
- 	Preferences browseWithDragNDrop ifTrue:[
  		listSpec
  			dropAccept: #wantsSystemCategoriesDrop:;
  			dropItem: #dropOnSystemCategories:at:].
  	^listSpec!

Item was changed:
  ----- Method: CodeHolder>>contentsSymbol (in category 'contents') -----
  contentsSymbol
  	"Answer a symbol indicating what kind of content should be shown for the method; for normal showing of source code, this symbol is #source.  A nil value in the contentsSymbol slot will be set to #source by this method"
  
  	^ contentsSymbol ifNil:
+ 		[contentsSymbol := SystemBrowser browseWithPrettyPrint
- 		[contentsSymbol := Preferences browseWithPrettyPrint
  								ifTrue:
  									[#prettyPrint]
  								ifFalse:
  									[#source]]!

Item was changed:
  ----- Method: FileContentsBrowser>>selectedMessage (in category 'edit pane') -----
  selectedMessage
  	"Answer a copy of the source code for the selected message selector."
  
  	| class selector |
  	class := self selectedClassOrMetaClass.
  	selector := self selectedMessageName.
  	contents := class sourceCodeAt: selector.
+ 	SystemBrowser browseWithPrettyPrint 
- 	Preferences browseWithPrettyPrint 
  		ifTrue: 
  			[contents := class prettyPrinterClass 
  						format: contents
  						in: class
  						notifying: nil
  						decorated: false].
  	self showingAnyKindOfDiffs 
  		ifTrue: 
  			[contents := self 
  						methodDiffFor: contents
  						class: self selectedClass
  						selector: self selectedMessageName
  						meta: self metaClassIndicated].
  	^contents asText makeSelectorBoldIn: class!

Item was changed:
  ----- Method: FileList>>buildDirectoryTreeWith: (in category 'toolbuilder') -----
  buildDirectoryTreeWith: builder 
  	| treeSpec |
  	treeSpec := builder pluggableTreeSpec new.
  	treeSpec
  		 model: self ;
  		 roots: #rootDirectoryList ;
  		 hasChildren: #hasMoreDirectories: ;
  		 getChildren: #subDirectoriesOf: ;
  		 getSelectedPath: #selectedPath ;
  		 setSelected: #setDirectoryTo: ;
  		 label: #directoryNameOf: ;
  		 menu: #volumeMenu: ;
  		 autoDeselect: false.
+ 	SystemBrowser browseWithDragNDrop ifTrue:
- 	Preferences browseWithDragNDrop ifTrue:
  		[ treeSpec
  			 dragItem: #dragFromDirectoryList: ;
  			 dropItem: #drop:ontoDirectory:shouldCopy: ].
  	^ treeSpec!

Item was changed:
  ----- Method: FileList>>buildFileListWith: (in category 'toolbuilder') -----
  buildFileListWith: builder 
  	| buttons listSpec top |
  	top := builder pluggablePanelSpec new.
  	top children: OrderedCollection new.
  	buttons := self buildButtonPaneWith: builder.
  	buttons frame:
  		(self
  			topConstantHeightFrame: self buttonHeight
  			fromLeft: 0
  			width: 1).
  	top children add: buttons.
  	listSpec := builder pluggableListSpec new.
  	listSpec
  		 model: self ;
  		 list: #fileList ;
  		 getIndex: #fileListIndex ;
  		 setIndex: #fileListIndex: ;
  		 menu: #fileListMenu: ;
  		 keyPress: nil ;
  		 frame:
  		(self
  			frameOffsetFromTop: self buttonHeight + 4
  			fromLeft: 0
  			width: 1
  			bottomFraction: 1) ;
  		 color: Color white.
+ 	SystemBrowser browseWithDragNDrop ifTrue: [ listSpec dragItem: #dragFromFileList: ].
- 	Preferences browseWithDragNDrop ifTrue: [ listSpec dragItem: #dragFromFileList: ].
  	top children add: listSpec.
  	^ top!

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:; 
  		menu: #messageListMenu:shifted:; 
  		keyPress: #messageListKey:from:.
+ 	SystemBrowser browseWithDragNDrop 
- 	Preferences browseWithDragNDrop 
  		ifTrue:[listSpec dragItem: #dragFromMessageList:].
  	^listSpec
  !

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: ;
  		menu: #messageListMenu:shifted: ; 
  		getSelectionList: #isMessageSelectedAt: ;
  		setSelectionList: #messageAt:beSelected: ;
  		keyPress: #messageListKey:from:.
+ 	SystemBrowser browseWithDragNDrop 
- 	Preferences browseWithDragNDrop 
  		ifTrue: [ listSpec dragItem: #dragFromMessageList: ].
  	^ listSpec!

Item was changed:
  AppRegistry subclass: #SystemBrowser
  	instanceVariableNames: ''
+ 	classVariableNames: 'BrowseWithDragNDrop BrowseWithPrettyPrint'
- 	classVariableNames: ''
  	poolDictionaries: ''
  	category: 'Tools-Base'!
  
  !SystemBrowser commentStamp: '<historical>' prior: 0!
  This is the AppRegistry class for class browsing!

Item was added:
+ ----- Method: SystemBrowser class>>browseWithDragNDrop (in category 'preferences') -----
+ browseWithDragNDrop
+ 	<preference: 'Browse with drag ''n'' drop' category: 'browsing' description: 'If true, new browsers will open with drag & drop functionality (only in Morphic)' type: #Boolean>
+ 	^ BrowseWithDragNDrop ifNil: [false].!

Item was added:
+ ----- Method: SystemBrowser class>>browseWithDragNDrop: (in category 'preferences') -----
+ browseWithDragNDrop: aBoolean
+ 	BrowseWithDragNDrop := aBoolean.!

Item was added:
+ ----- Method: SystemBrowser class>>browseWithPrettyPrint (in category 'preferences') -----
+ browseWithPrettyPrint
+ 	<preference: 'Browse with pretty-print' category: 'browsing' description: 'If true, browsers will automatically format their contents' type: #Boolean>
+ 	^ BrowseWithPrettyPrint ifNil: [false].!

Item was added:
+ ----- Method: SystemBrowser class>>browseWithPrettyPrint: (in category 'preferences') -----
+ browseWithPrettyPrint: aBoolean
+ 	BrowseWithPrettyPrint := aBoolean.!

Item was changed:
  ----- Method: TimeProfileBrowser>>selectedMessage (in category 'message list') -----
  selectedMessage
  	"Answer the source method for the currently selected message."
  
  	
  	self setClassAndSelectorIn: 
  			[:class :selector | | source | 
  			source := class sourceMethodAt: selector ifAbsent: [^'Missing'].
+ 			SystemBrowser browseWithPrettyPrint 
- 			Preferences browseWithPrettyPrint 
  				ifTrue: 
  					[source := class prettyPrinterClass 
  								format: source
  								in: class
  								notifying: nil
  								decorated: false].
  			self selectedClass: class.
  			self selectedSelector: selector.
  			^source asText makeSelectorBoldIn: class].
  	^''!

Item was changed:
+ (PackageInfo named: 'Tools') postscript: 'SystemBrowser browseWithPrettyPrint: Preferences browseWithPrettyPrint.
+ SystemBrowser browseWithDragNDrop: Preferences browseWithDragNDrop.
+ 
+ Preferences removePreference: #browseWithPrettyPrint.
+ Preferences removePreference: #browseWithDragNDrop.'!
- (PackageInfo named: 'Tools') postscript: 'SystemBrowser browserShowsPackagePane: Preferences browserShowsPackagePane.
- Preferences removePreference: #browserShowsPackagePane.'!



More information about the Squeak-dev mailing list