[Pkg] The Trunk: Morphic-mt.1755.mcz

commits at source.squeak.org commits at source.squeak.org
Sun Apr 18 17:00:48 UTC 2021 

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

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

Name: Morphic-mt.1755
Author: mt
Time: 18 April 2021, 7:00:43.878254 pm
UUID: e5705780-2988-a54e-b6c7-21b4194fcd5c
Ancestors: Morphic-mt.1754, Morphic-ct.1659

Fix our two menu-invocating buttons to act on mouse-down and actually look like menus: (1) menu button in system window and (2) change-set button in world-main-docking-bar.

Merges Morphic-ct.1659. Thanks Christoph (ct) for pointing out this issue about menu invocation through buttons. See http://forum.world.st/The-Inbox-Morphic-ct-1659-mcz-tp5116728.html

By example, this commit also adds a menu to the change-set button in the docking bar. This menu lists the latest method and class changes.

To make this work, the following things got addressed:
- Fixes DockingBarUpdatingItemMorph, which missed several changes from DockingBarItemMorph. (Interesting specialization challenge...)
- Let menus #rubberBandCells to allow for changing menu item's widths.
- Adds query about latest changes to #listChangesOn:. (Feel free to improve this. Maybe add preference for number of elements?)

Complements (and depends on) System-mt.1228 and  Tools-mt.1042.

=============== Diff against Morphic-mt.1754 ===============

Item was changed:
  ----- Method: DockingBarMorph>>addUpdatingItem: (in category 'construction') -----
  addUpdatingItem: aBlock
  	| item |
  	item := DockingBarUpdatingItemMorph new.
  	aBlock value: item.
+ 	item subMenu ifNotNil: [:menu |
+ 		"Docking bar and protruding menu should appear visually merged."
+ 		menu morphicLayerNumber: self morphicLayerNumber + 1].
  	self addMorphBack: item!

Item was changed:
  ----- Method: DockingBarMorph>>ensureSelectedItem: (in category 'events') -----
  ensureSelectedItem: evt
  	
  	self selectedItem ifNil: [
  		self 
  			selectItem: (
  				self submorphs 
+ 					detect: [ :each | each isMenuItemMorph ] 
- 					detect: [ :each | each isKindOf: DockingBarItemMorph ] 
  					ifNone: [ ^self ]) 
  			event: evt ]!

Item was changed:
  ----- Method: DockingBarMorph>>filterEvent:for: (in category 'events-processing') -----
  filterEvent: aKeyboardEvent for: anObject
  	"Provide keyboard shortcuts."
  	
  	| index itemToSelect |
  
  	aKeyboardEvent controlKeyPressed
  		ifFalse: [^ aKeyboardEvent].
  
  	aKeyboardEvent isKeystroke
  		ifFalse: [^ aKeyboardEvent].
  			
  	"Search field."
  	aKeyboardEvent keyCharacter = $0
  		ifTrue: [
  			self searchBarMorph ifNotNil: [ :morph |
  				morph model activate: aKeyboardEvent in: morph ].
  			^ aKeyboardEvent ignore "hit!!"].
  	
  	"Select menu items."
  	(aKeyboardEvent keyValue 
  		between: $1 asciiValue 
  		and: $9 asciiValue)
  			ifFalse: [^ aKeyboardEvent].	
  			
  	index := aKeyboardEvent keyValue - $1 asciiValue + 1.
  	itemToSelect := (self submorphs select: [ :each | 
+ 		each isMenuItemMorph ]) 
- 		each isKindOf: DockingBarItemMorph ]) 
  			at: index 
  			ifAbsent: [^ aKeyboardEvent].
  			
  	self activate: aKeyboardEvent.
  	self 
  		selectItem: itemToSelect
  		event: aKeyboardEvent.
  
  	^ aKeyboardEvent ignore "hit!!"!

Item was changed:
  ----- Method: DockingBarMorph>>moveSelectionDown:event: (in category 'control') -----
  moveSelectionDown: direction event: evt
  	"Move the current selection up or down by one, presumably under keyboard control.
  	direction = +/-1"
  
  	| index |
  	index := (submorphs indexOf: selectedItem ifAbsent: [1-direction]) + direction.
  	submorphs do: "Ensure finite"
  		[:unused | | m |
  		m := submorphs atWrap: index.
+ 		(m isMenuItemMorph and: [m isEnabled]) ifTrue:
- 		((m isKindOf: DockingBarItemMorph) and: [m isEnabled]) ifTrue:
  			[^ self selectItem: m event: evt].
  		"Keep looking for an enabled item"
  		index := index + direction sign].
  	^ self selectItem: nil event: evt!

Item was added:
+ ----- Method: DockingBarUpdatingItemMorph>>adjacentTo (in category 'selecting') -----
+ adjacentTo
+ 
+ 	| roundedCornersOffset verticalOffset |
+ 	roundedCornersOffset := MenuMorph roundedMenuCorners
+ 		ifTrue: [Morph preferredCornerRadius negated]
+ 		ifFalse: [0].
+ 	verticalOffset := 2.
+ 
+ 	owner isFloating
+ 		ifTrue: [^ {self bounds bottomLeft + (roundedCornersOffset @ verticalOffset)}].
+ 	owner isAdheringToTop
+ 		ifTrue: [^ {self bounds bottomLeft + (roundedCornersOffset @ verticalOffset)}].
+ 	owner isAdheringToLeft
+ 		ifTrue: [^ {self bounds topRight + (roundedCornersOffset @ verticalOffset)}].
+ 	owner isAdheringToBottom
+ 		ifTrue: [^ {self bounds topLeft + (roundedCornersOffset @ verticalOffset)}].
+ 	owner isAdheringToRight
+ 		ifTrue: [^ {self bounds topLeft + (roundedCornersOffset @ verticalOffset negated)}].
+ 	^ {self bounds bottomLeft + (roundedCornersOffset @ 5)}!

Item was added:
+ ----- Method: DockingBarUpdatingItemMorph>>createSubmenu (in category 'private') -----
+ createSubmenu
+ 
+ 	^DockingBarMenuMorph new!

Item was added:
+ ----- Method: DockingBarUpdatingItemMorph>>createUpdatingSubmenu (in category 'private') -----
+ createUpdatingSubmenu
+ 
+ 	^DockingBarUpdatingMenuMorph new!

Item was changed:
+ ----- Method: DockingBarUpdatingItemMorph>>decorateOwner (in category 'world') -----
- ----- Method: DockingBarUpdatingItemMorph>>decorateOwner (in category 'as yet unclassified') -----
  decorateOwner
  
  	"Ignore."!

Item was added:
+ ----- Method: DockingBarUpdatingItemMorph>>drawIconOn: (in category 'drawing') -----
+ drawIconOn: aCanvas 
+ 
+ 	| pos |
+ 	self hasIcon ifTrue: [
+ 		| iconForm | 
+ 		iconForm := self iconForm.
+ 
+ 		pos := (contents
+ 			ifEmpty: [self left + (self width - iconForm width // 2)]
+ 			ifNotEmpty: [self left])
+ 				@ (self top + (self height - iconForm height // 2)).
+ 
+ 		aCanvas
+ 			translucentImage: iconForm 
+ 			at: pos].!

Item was added:
+ ----- Method: DockingBarUpdatingItemMorph>>drawLabelOn: (in category 'drawing') -----
+ drawLabelOn: aCanvas 
+ 
+ 	| stringBounds |	
+ 	self contents ifEmpty: [^ self].
+ 	
+ 	stringBounds := bounds.
+ 	
+ 	self hasIcon ifTrue: [
+ 		stringBounds := stringBounds left: stringBounds left + self iconForm width + 2 ].
+ 	
+ 	"Vertical centering."
+ 	stringBounds := stringBounds top: stringBounds top + stringBounds bottom - self fontToUse height // 2.
+ 	"Horizontal centering."
+ 	stringBounds := stringBounds left: stringBounds left + (stringBounds width - (self fontToUse widthOfString: contents) // 2) abs.
+ 
+ 	aCanvas
+ 		drawString: contents
+ 		in: stringBounds
+ 		font: self fontToUse
+ 		color: self colorToUse.!

Item was added:
+ ----- Method: DockingBarUpdatingItemMorph>>drawSubMenuMarkerOn: (in category 'drawing') -----
+ drawSubMenuMarkerOn: aCanvas 
+ 	"Ignore."!

Item was added:
+ ----- Method: DockingBarUpdatingItemMorph>>mouseDown: (in category 'events') -----
+ mouseDown: evt
+ 	"Handle a mouse down event. Menu items get activated when the mouse is over them."
+ 
+ 	(evt shiftPressed and:[self wantsKeyboardFocusOnShiftClick]) ifTrue: [ ^super mouseDown: evt ].  "enable label editing" 
+ 	isSelected
+ 		ifTrue: [
+ 			owner selectItem: nil event: evt. ]
+ 		ifFalse: [
+ 			owner activate: evt. "Redirect to menu for valid transitions"
+ 			owner selectItem: self event: evt. ]
+ !

Item was changed:
+ ----- Method: DockingBarUpdatingItemMorph>>mouseEnter: (in category 'events') -----
- ----- Method: DockingBarUpdatingItemMorph>>mouseEnter: (in category 'as yet unclassified') -----
  mouseEnter: evt
  	"Do not hover docking bar items directory. Mouse-down required. But if you already see a submenu, support hovering."
  
  	owner selectedItem ifNotNil: [owner selectItem: self event: evt]!

Item was added:
+ ----- Method: DockingBarUpdatingItemMorph>>mouseUp: (in category 'events') -----
+ mouseUp: evt
+ 	"Handle a mouse up event. Menu items get activated when the mouse is over them. Do nothing if we're not in a 'valid menu transition', meaning that the current hand focus must be aimed at the owning menu."
+ 	
+ 	evt hand mouseFocus == owner ifFalse: [ ^self ].
+ 	self contentString ifNotNil: [
+ 		self contents: self contentString withMarkers: true inverse: true.
+ 		self refreshWorld.
+ 		(Delay forMilliseconds: 200) wait ].!

Item was added:
+ ----- Method: DockingBarUpdatingItemMorph>>select: (in category 'selecting') -----
+ select: evt
+ 
+ 	super select: evt.
+ 	subMenu ifNotNil: [
+ 		evt hand newKeyboardFocus: subMenu ]!

Item was added:
+ ----- Method: DockingBarUpdatingItemMorph>>wantsKeyboardFocusOnShiftClick (in category 'events') -----
+ wantsKeyboardFocusOnShiftClick
+ 	"set this preference to false to prevent user editing of docking bar menu items"
+ 	^Preferences valueOfPreference: #allowMenubarItemEditing ifAbsent: [false]!

Item was added:
+ ----- Method: DockingBarUpdatingMenuMorph>>morphicLayerNumber: (in category 'update') -----
+ morphicLayerNumber: n
+ 
+ 	super morphicLayerNumber: n.
+ 	!

Item was changed:
  ----- Method: MenuMorph>>initialize (in category 'initialization') -----
  initialize
  	super initialize.
  
  	self setDefaultParameters.
  
  	self changeTableLayout.
  	self listDirection: #topToBottom.
  	self hResizing: #shrinkWrap.
  	self vResizing: #shrinkWrap.
+ 	self rubberBandCells: true.
  	self disableLayout: true.
  	self morphicLayerNumber: self class menuLayer.
  	defaultTarget := nil.
  	selectedItem := nil.
  	stayUp := false.
  	popUpOwner := nil.!

Item was changed:
  ----- Method: SystemWindow>>createMenuBox (in category 'initialization') -----
  createMenuBox
  	^ (self createBox: self class menuBoxImage)
  		actionSelector: #offerWindowMenu;
+ 		setBalloonText: 'window menu' translated;
+ 		actWhen: #buttonDown;
+ 		yourself!
- 		setBalloonText: 'window menu' translated!

Item was changed:
+ ----- Method: TheWorldMainDockingBar>>browseChanges (in category 'submenu - changes') -----
- ----- Method: TheWorldMainDockingBar>>browseChanges (in category 'right side') -----
  browseChanges
  
  	ChangeSorter open.!

Item was changed:
+ ----- Method: TheWorldMainDockingBar>>browseChangesLabel (in category 'submenu - changes') -----
- ----- Method: TheWorldMainDockingBar>>browseChangesLabel (in category 'right side') -----
  browseChangesLabel
  	"The project name is the same as the current change set."
  	
  	^ Project current name!

Item was added:
+ ----- Method: TheWorldMainDockingBar>>changesMenuOn: (in category 'submenu - changes') -----
+ changesMenuOn: aDockingBar
+ 	
+ 	aDockingBar addUpdatingItem: [:item |
+ 		item
+ 			help: 'Browse this project''s changes' translated;
+ 			wordingProvider: self
+ 			wordingSelector: #browseChangesLabel;
+ 			subMenuUpdater: self
+ 			selector: #listChangesOn:].!

Item was changed:
  ----- Method: TheWorldMainDockingBar>>fillDockingBar: (in category 'construction') -----
  fillDockingBar: aDockingBar 
  	"Private - fill the given docking bar"
  	
  	self menusOn: aDockingBar.
  	aDockingBar addSpacer.
+ 	self changesMenuOn: aDockingBar.
- 	self projectNameOn: aDockingBar.
  	aDockingBar addSpacer.
  	self rightSideOn: aDockingBar.
  	aDockingBar
  		setProperty: #mainDockingBarTimeStamp 
  		toValue: self class timeStamp.!

Item was added:
+ ----- Method: TheWorldMainDockingBar>>listChangesOn: (in category 'submenu - changes') -----
+ listChangesOn: menu
+ 
+ 	| latestMethodChanges latestClassChanges|
+ 	latestMethodChanges := (Array streamContents: [:s |
+ 		ChangeSet current changedMethodsDo: [:method :changeType :dateAndTime :category |
+ 			s nextPut: { dateAndTime. method. changeType. category }]])
+ 			sorted: [:a :b | a first >= b first].
+ 
+ 	1 to: (10 min: latestMethodChanges size) do: [:index | | spec method |
+ 		spec := latestMethodChanges at: index.
+ 		method := spec second.
+ 		menu addItem: [:item |
+ 			item
+ 				contents: ('{1} {2} \{{3}\} \{{4}\}' format: {method methodClass. method selector. spec fourth. method methodClass category}) ;
+ 				target: ToolSet;
+ 				balloonText: spec third asString;
+ 				icon: ((#(remove addedThenRemoved) includes: spec third) ifTrue: [MenuIcons smallDeleteIcon] ifFalse: [
+ 					spec third = #add ifTrue: [MenuIcons smallNewIcon] ifFalse: [MenuIcons blankIcon]]);
+ 				selector: (method isInstalled ifTrue: [#browseMethod:] ifFalse: [#browseMethodVersion:]);
+ 				arguments: {method}]].
+ 				
+ 	latestClassChanges := (Array streamContents: [:s |
+ 		ChangeSet current changedClassesDo: [:class :changeTypes :dateAndTime :category |
+ 			"We are not interested in classes whose method's did only change."
+ 			changeTypes ifNotEmpty: [s nextPut: { dateAndTime. class. changeTypes. category }]]])
+ 			sorted: [:a :b | a first >= b first].
+ 
+ 	latestClassChanges ifNotEmpty: [menu addLine].
+ 	1 to: (10 min: latestClassChanges size) do: [:index | | spec class |
+ 		spec := latestClassChanges at: index.
+ 		class := spec second.
+ 		menu addItem: [:item |
+ 			item
+ 				contents: ('{1} \{{2}\}' format: {class name. spec fourth }) ;
+ 				target: ToolSet;
+ 				balloonText: (spec third sorted joinSeparatedBy: Character space);
+ 				icon: ((spec third includesAnyOf: #(remove addedThenRemoved))
+ 					ifTrue: [MenuIcons smallDeleteIcon]
+ 					ifFalse: [
+ 						(spec third includes: #add)
+ 							ifTrue: [MenuIcons smallNewIcon]
+ 							ifFalse: [MenuIcons blankIcon]]);
+ 				selector: ((spec third includes: #remove) ifTrue: [#inspect:] ifFalse: [#browseClass:]);
+ 				arguments: {class}]].
+ 				
+ 	menu addLine; addItem: [:item |
+ 		item
+ 			contents: 'Browse current change set...' translated;
+ 			target: self;
+ 			selector: #browseChanges].!

Item was removed:
- ----- Method: TheWorldMainDockingBar>>projectNameOn: (in category 'right side') -----
- projectNameOn: aDockingBar
- 	
- 	aDockingBar addUpdatingItem: [:item |
- 		item
- 			help: 'Browse this project''s changes';
- 			target: self;
- 			selector: #browseChanges;
- 			wordingProvider: self
- 			wordingSelector: #browseChangesLabel].!

Item was changed:
+ (PackageInfo named: 'Morphic') postscript: 'TheWorldMainDockingBar updateInstances.'!
- (PackageInfo named: 'Morphic') postscript: 'Transcript showln: ''[NOTICE] There is a new preference called "Interactive print-it". Please check your preference browser to choose the preferred value.'''!

More information about the Packages mailing list