Posted by
commits-2 on
Apr 18, 2021; 5:00pm
URL: https://forum.world.st/The-Trunk-Morphic-mt-1755-mcz-tp5128818.html
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.htmlBy 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.'''!