[squeak-dev] The Trunk: Tools-nice.1040.mcz

commits at source.squeak.org commits at source.squeak.org
Wed Apr 14 21:41:59 UTC 2021


Nicolas Cellier uploaded a new version of Tools to project The Trunk:
http://source.squeak.org/trunk/Tools-nice.1040.mcz

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

Name: Tools-nice.1040
Author: nice
Time: 14 April 2021, 11:41:49.287889 pm
UUID: 30dc2572-5638-c849-a103-cd00af68fca7
Ancestors: Tools-mt.1039, Tools-tcj.834, Tools-mva.748, Tools-ct.1006, Tools-ct.1020, Tools-ct.1031

Merge commit

Tools-mt.1039:
	Complements Kernel-mt.1385

Tools-tcj.834:
	Add 'alphabetize' to Package Pane Browser's class category menu, as is found on standard Browser.

Tools-mva.748:
	fix selecting a directory in the left pane in a MVC project FileList on Mac and Linux (and it still works on Windows afterwards)

Tools-ct.1006:
	Complements Compiler-ct.449 (CompilationCue in SyntaxErrorNotification). Fixes syntax highlighting in SyntaxError window.

Tools-ct.1020:
	Fixes code styling in change sorters.

Tools-ct.1031:
	Fixes styling in change sorters if no real method is selected. No need to invoke Shout on messages such as "method was removed".

=============== Diff against Tools-mt.1039 ===============

Item was changed:
  CodeHolder subclass: #ChangeSorter
+ 	instanceVariableNames: 'parent myChangeSet currentClassName currentSelector priorChangeSetList contentsAreStyleable'
- 	instanceVariableNames: 'parent myChangeSet currentClassName currentSelector priorChangeSetList'
  	classVariableNames: ''
  	poolDictionaries: ''
  	category: 'Tools-Changes'!
  
+ !ChangeSorter commentStamp: 'ct 3/10/2021 18:24' prior: 0!
- !ChangeSorter commentStamp: 'wiz 2/3/2010 23:38' prior: 0!
  I display a ChangeSet.  Two of me are in a DualChangeSorter.
  
  aStringOrNil
  Instance Variables
  	currentClassName:		<aStringOrNil>
  	currentSelector:		<aStringOrNil>
  	myChangeSet:		<aChangeSet>
  	parent:		<aDualChangeSorterOrNil>
  	priorChangeSetList:		<aCollection>
+ 	contentsAreStyleable <aBoolean>
  
  
  currentClassName
  	- string parseable into class-name [class] [class trait]
  	needs to be fitlered by (self withoutItemAnnotation: currentClassName) to remove pakaging note
  
  
  currentSelector
  	- string parseable into selector-name 
  	needs to be fitlered by (self withoutItemAnnotation: currentSelector) to remove pakaging note
  
  myChangeSet
  	- name of current changeset
  parent
  	-the dual changesorter that contains this one. Used for dealing with the other half.
  priorChangeSetList
+ 	- holds the current change set list. Used to detect changes in list when a newly generated list no long match the prior list.!
- 	- holds the current change set list. Used to detect changes in list when a newly generated list no long match the prior list.
- 	!

Item was changed:
  ----- Method: ChangeSorter>>aboutToStyle: (in category 'code pane') -----
  aboutToStyle: aStyler
  	"This is a notification that aStyler is about to re-style its text.
  	Set the classOrMetaClass in aStyler, so that identifiers
  	will be resolved correctly.
  	Answer true to allow styling to proceed, or false to veto the styling"
  
+ 	contentsAreStyleable ~= false ifFalse: [^false].
- 	self isModeStyleable ifFalse: [^false].
- 	self currentSelector ifNil: [^false].
  	aStyler classOrMetaClass: self selectedClassOrMetaClass.
  	^true!

Item was changed:
  ----- Method: ChangeSorter>>buildWith:in:rect: (in category 'toolbuilder') -----
  buildWith: builder in: window rect: rect
  	| csListHeight msgListHeight csMsgListHeight listSpec textSpec |
  	contents := ''.
  	csListHeight := 0.25.
  	msgListHeight := 0.25.
  	csMsgListHeight := csListHeight + msgListHeight.
  
  	listSpec := builder pluggableListSpec new.
  	listSpec 
  		model: self;
  		list: #changeSetList; 
  		getSelected: #currentCngSet; 
  		setSelected: #showChangeSetNamed:; 
  		menu: #changeSetMenu:shifted:; 
  		keyPress: #changeSetListKey:from:;
  		dragItem: #dragChangeSet:;
  		autoDeselect: false;
  		frame: (((0 at 0 extent: 0.5 at csListHeight)
  			scaleBy: rect extent) translateBy: rect origin).
  	window children add: listSpec.
  
  	listSpec := builder pluggableListSpec new.
  	listSpec 
  		model: self;
  		list: #classList; 
  		getSelected: #currentClassName; 
  		setSelected: #currentClassName:; 
  		menu: #classListMenu:shifted:; 
  		keyPress: #classListKey:from:;
  		dragItem: #dragClass:;
  		frame: (((0.5 at 0 extent: 0.5 at csListHeight)
  			scaleBy: rect extent) translateBy: rect origin).
  	window children add: listSpec.
  
  	listSpec := builder pluggableListSpec new.
  	listSpec 
  		model: self;
  		list: #messageList; 
  		getSelected: #currentSelector;
  		setSelected: #currentSelector:; 
  		menu: #messageMenu:shifted:; 
  		keyPress: #messageListKey:from:;
  		dragItem: #dragMessage:;
  		frame: (((0 at csListHeight extent: 1 at msgListHeight)
  			scaleBy: rect extent) translateBy: rect origin).
  	window children add: listSpec.
  
+ 	textSpec := builder pluggableCodePaneSpec new.
- 	textSpec := builder pluggableTextSpec new.
  	textSpec 
  		model: self;
  		getText: #contents; 
  		setText: #contents:notifying:; 
  		selection: #contentsSelection; 
  		menu: #codePaneMenu:shifted:;
  		frame: (((0 at csMsgListHeight corner: 1 at 1) scaleBy: rect extent) translateBy: rect origin).
  	window children add: textSpec.
  	^window!

Item was changed:
  ----- Method: ChangeSorter>>setContents (in category 'code pane') -----
  setContents
  	"return the source code that shows in the bottom pane"
  
  	| sel class strm changeType | 
  	self clearUserEditFlag.
+ 	contentsAreStyleable := false.
  	myChangeSet ifNil: [^ contents := String empty].   "should not happen but can"
  	currentClassName ifNil: [^ contents := myChangeSet preambleString ifNil: [String empty]].
  	class := self selectedClassOrMetaClass.
  	(sel := self selectedMessageName) == nil
  		ifFalse: [changeType := (myChangeSet atSelector: (sel := sel asSymbol) class: class).
  			changeType == #remove
  				ifTrue: [^ contents := 'Method has been removed (see versions)'].
  			changeType == #addedThenRemoved
  				ifTrue: [^ contents := 'Added then removed (see versions)'].
  			class ifNil: [^ contents := 'Method was added, but cannot be found!!'].
  			(class includesSelector: sel)
  				ifFalse: [^ contents := 'Method was added, but cannot be found!!'].
+ 			contentsAreStyleable := true.
  			contents := class sourceCodeAt: sel.
  			(#(prettyPrint prettyDiffs) includes: contentsSymbol) ifTrue:
  				[contents :=  class prettyPrinterClass
  					format: contents in: class notifying: nil].
+ 			self showingAnyKindOfDiffs ifTrue: [
+ 				contentsAreStyleable := false.
+ 				contents := self diffFromPriorSourceFor: contents].
- 			self showingAnyKindOfDiffs
- 				ifTrue: [contents := self diffFromPriorSourceFor: contents].
  			^ contents := contents asText makeSelectorBoldIn: class]
  		ifTrue: [strm := WriteStream on: (String new: 100).
  			(myChangeSet classChangeAt: (self withoutItemAnnotation: currentClassName)) do:
  				[:each |
  				each = #remove ifTrue: [strm nextPutAll: 'Entire class was removed.'; cr].
  				each = #addedThenRemoved ifTrue: [strm nextPutAll: 'Class was added then removed.'].
  				each = #rename ifTrue: [strm nextPutAll: 'Class name was changed.'; cr].
  				each = #add ifTrue: [strm nextPutAll: 'Class definition was added.'; cr].
  				each = #change ifTrue: [strm nextPutAll: 'Class definition was changed.'; cr].
  				each = #reorganize ifTrue: [strm nextPutAll: 'Class organization was changed.'; cr].
  				each = #comment ifTrue: [strm nextPutAll: 'New class comment.'; cr.
  				]].
  			^ contents := strm contents].!

Item was changed:
  ----- Method: FileList>>volumeListIndex: (in category 'volume list and pattern') -----
  volumeListIndex: index
  	"Select the volume name having the given index."
  
  	| delim path |
  	volListIndex := index.
  	index = 1 
  		ifTrue: [self directory: (FileDirectory on: '')]
  		ifFalse: [delim := directory pathNameDelimiter.
  				path := String streamContents: [:strm |
  					2 to: index do: [:i |
  						strm nextPutAll: (volList at: i) withBlanksTrimmed.
  						i < index ifTrue: [strm nextPut: delim]]].
+ 				self directory: (FileDirectory on: path)].
- 				self directory: (directory on: path)].
  	brevityState := #FileList.
  	self addPath: path.
  	self changed: #fileList.
  	self changed: #contents.
  	self updateButtonRow.!

Item was changed:
  ----- Method: PackagePaneBrowser>>mainPackageMenu: (in category 'package list') -----
  mainPackageMenu: aMenu
  	"Answer a Menu of operations on class packages to be 
  	displayed when the operate menu button is pressed."
  	<packageListMenu>
  	^aMenu addList: #(
  			('find class...'		findClass)
  			('recent classes...'	recent)
  			-
  			('reorganize'		editSystemCategories)
+ 			('alphabetize'		alphabetizeSystemCategories)
+ 			-				
  			('update'			updatePackages));
  		yourself.
  !

Item was changed:
  ----- Method: SyntaxError>>aboutToStyle: (in category 'text menu support') -----
  aboutToStyle: aStyler
  
  	aStyler
  		classOrMetaClass: self selectedClassOrMetaClass;
+ 		environment: notification environment;
+ 		context: notification context;
  		parseAMethod: notification doitFlag not.
  	^ true!

Item was changed:
+ (PackageInfo named: 'Tools') postscript: 'ChangeSorter allSubInstancesDo: [:sorter |
+ 	(sorter instVarNamed: ''contentsAreStyleable'') ifNil: [
+ 		sorter instVarNamed: ''contentsAreStyleable'' put: true]].'!
- (PackageInfo named: 'Tools') postscript: '(Smalltalk globals at: #ObjectsUnderInspection ifAbsent: [#()])
- 	do: [:objectUnderInspection |
- 		ToolSet inspect: objectUnderInspection].
- Smalltalk globals removeKey: #ObjectsUnderInspection.'!



More information about the Squeak-dev mailing list