[squeak-dev] The Trunk: Morphic-mt.1821.mczcommits at source.squeak.org commits at source.squeak.orgFri Dec 10 13:11:36 UTC 2021
Marcel Taeumel uploaded a new version of Morphic to project The Trunk: http://source.squeak.org/trunk/Morphic-mt.1821.mcz ==================== Summary ==================== Name: Morphic-mt.1821 Author: mt Time: 10 December 2021, 2:11:30.564787 pm UUID: 08edffba-d9ac-a646-b3f6-2d5069433b34 Ancestors: Morphic-mt.1820, Morphic-ct.1686, Morphic-tonyg.1804, Morphic-ct.1793, Morphic-ct.1791, Morphic-ct.1789, Morphic-ct.1785 Merge. Revise. Merge. Morphic-ct.1686: Fix: Don't defer construction of main docking bar when initializing a new MorphicProject. Such lazy construction can be really disturbing when preparing a project from another one, as it will be done in Objectland. Morphic-tonyg.1804: Suggested customization hooks to set various kinds of grip/scrollbar sizes. I have found this useful for working with Squeak on cell-phone sized devices with high DPI. Morphic-ct.1793: Resolves two sends to deprecated messages. Morphic-ct.1791: Documentation: Adds example of #add:subMenu:target:selector:argumentList: to MenuMorph example. Morphic-ct.1789: Fixes yellow-button menu invocation for hierarchical lists that are not inside a system window. [...] Morphic-ct.1785: Revises proposal from Morphic-ct.1781 to rearrange menu items in the docking bar. [...] =============== Diff against Morphic-mt.1820 =============== Item was changed: ----- Method: AbstractResizerMorph class>>gripThickness (in category 'preferences') ----- gripThickness "A number in pixels that encodes the area were the user can target splitters or edge grips." <preference: 'Grip Thickness' category: 'windows' description: 'A number in pixels that encodes the area were the user can target splitters or edge grips such as in application windows. Bigger grips make it easier to click on them.' type: #Number> + ^ ((GripThickness ifNil: [4]) * RealEstateAgent scaleFactor) rounded! - ^ GripThickness ifNil: [4]! Item was changed: ----- Method: AbstractResizerMorph class>>gripThickness: (in category 'preferences') ----- gripThickness: anInteger + GripThickness := (anInteger / RealEstateAgent scaleFactor) rounded. - GripThickness := anInteger. Project current restoreDisplay. self flag: #todo. "mt: Update existing grips. This is challenging because it interferes with ProportionalLayoutPolicy, which is tricky to refresh from here for arbitrary morphs."! Item was changed: ----- Method: AbstractResizerMorph class>>handleLength (in category 'preferences') ----- handleLength <preference: 'Handle Length' category: 'windows' description: 'AThe size of a grip handle if shown. Can be interpreted as width or height, depending of the resizer orientation. Does not affect the clickable area. See grip thickness for that.' type: #Number> + ^ ((HandleLength ifNil: [25]) * RealEstateAgent scaleFactor) rounded! - ^ HandleLength ifNil: [25]! Item was changed: ----- Method: AbstractResizerMorph class>>handleLength: (in category 'preferences') ----- handleLength: anInteger + HandleLength := (anInteger / RealEstateAgent scaleFactor) rounded. - HandleLength := anInteger. Project current restoreDisplay. self flag: #todo. "mt: Update existing grips. This is challenging because it interferes with ProportionalLayoutPolicy, which is tricky to refresh from here for arbitrary morphs."! Item was changed: ----- Method: MenuMorph class>>example (in category 'example') ----- example "MenuMorph example popUpInWorld" | menu | menu := MenuMorph new. menu addTitle: 'Fruit' translated. menu addStayUpItem. menu add: 'apples' action: #apples. menu add: 'oranges' action: #oranges. menu addLine. menu addLine. "extra lines ignored" menu add: 'peaches' action: #peaches. menu addLine. menu add: 'pears' action: #pears. menu addLine. + menu add: 'test' subMenu: (MenuMorph new + defaultTarget: #peaches; + add: 'foo' action: #inspect; + yourself) target: 42 selector: #inform: argumentList: #('hello'). + ^ menu! - ^ menu - ! Item was changed: ----- Method: MenuMorph>>balloonTextForLastItem: (in category 'construction') ----- balloonTextForLastItem: balloonText + submorphs last balloonText: balloonText! - submorphs last setBalloonText: balloonText! Item was changed: ----- Method: MorphicProject>>initialize (in category 'initialize') ----- initialize "Initialize a new Morphic Project" + super initialize. + world := PasteUpMorph newWorldForProject: self. self setWorldBackground: true. + Locale switchToID: CurrentProject localeID. + Preferences useVectorVocabulary ifTrue: [world installVectorVocabulary]. + + self assureMainDockingBarPresenceMatchesPreference.! - Preferences useVectorVocabulary ifTrue: [world installVectorVocabulary]! Item was changed: ----- Method: ScrollPane class>>scrollBarThickness (in category 'defaults') ----- scrollBarThickness + ^ ((Preferences scrollBarsNarrow ifTrue: [10] ifFalse: [14]) + * RealEstateAgent scaleFactor) truncated! - ^ Preferences scrollBarsNarrow - ifTrue: [10] - ifFalse: [14]! Item was changed: ----- Method: SimpleHierarchicalListMorph>>addMorphsTo:from:allowSorting:withExpandedItems:atLevel: (in category 'private') ----- addMorphsTo: morphList from: aCollection allowSorting: sortBoolean withExpandedItems: expandedItems atLevel: newIndent | priorMorph newCollection firstAddition | priorMorph := nil. newCollection := (sortBoolean and: [sortingSelector notNil]) ifTrue: [ aCollection sorted: [ :a :b | (a perform: sortingSelector) <= (b perform: sortingSelector)] ] ifFalse: [ aCollection ]. firstAddition := nil. newCollection do: [:item | priorMorph := self indentingItemClass basicNew initWithContents: item prior: priorMorph forList: self indentLevel: newIndent. priorMorph initWithColor: self textColor andFont: self font. priorMorph selectionColor: self selectionColor; selectionTextColor: self selectionTextColor; hoverColor: self hoverColor; highlightTextColor: self highlightTextColor; filterColor: self filterColor; + filterTextColor: self filterTextColor; + wantsYellowButtonMenu: false. - filterTextColor: self filterTextColor. firstAddition ifNil: [firstAddition := priorMorph]. morphList add: priorMorph. ((item hasEquivalentIn: expandedItems) or: [priorMorph isExpanded]) ifTrue: [ self flag: #bug. "mt: Endless recursion can happen for similar items in the tree." priorMorph isExpanded: true. priorMorph addChildrenForList: self addingTo: morphList withExpandedItems: expandedItems. ]. ]. ^firstAddition ! Item was changed: ----- Method: SimpleHierarchicalListMorph>>addSubmorphsAfter:fromCollection:allowSorting: (in category 'private') ----- addSubmorphsAfter: parentMorph fromCollection: aCollection allowSorting: sortBoolean | priorMorph morphList newCollection | priorMorph := nil. newCollection := (sortBoolean and: [sortingSelector notNil]) ifTrue: [ aCollection sorted: [ :a :b | (a perform: sortingSelector) <= (b perform: sortingSelector)] ] ifFalse: [ aCollection ]. morphList := OrderedCollection new. newCollection do: [:item | priorMorph := self indentingItemClass basicNew initWithContents: item prior: priorMorph forList: self indentLevel: parentMorph indentLevel + 1. priorMorph color: self textColor; font: self font; selectionColor: self selectionColor; selectionTextColor: self selectionTextColor; hoverColor: self hoverColor; highlightTextColor: self highlightTextColor; filterColor: self filterColor; + filterTextColor: self filterTextColor; + wantsYellowButtonMenu: false. - filterTextColor: self filterTextColor. morphList add: priorMorph. ]. scroller addAllMorphs: morphList after: parentMorph. ^morphList ! Item was changed: ----- Method: SimpleHierarchicalListMorph>>initialize (in category 'initialization') ----- initialize "initialize the state of the receiver" super initialize. self setProperty: #autoExpand toValue: false. + scroller wantsYellowButtonMenu: false. self on: #mouseMove send: #mouseStillDown:onItem: to: self! Item was changed: ----- Method: SystemWindow>>closeBoxHit (in category 'open/close') ----- closeBoxHit "The user clicked on the close-box control in the window title. For Mac users only, the Mac convention of option-click-on-close-box is obeyed if the mac option key is down." Preferences dismissAllOnOptionClose ifTrue: + [self currentEvent optionKeyPressed ifTrue: - [Sensor rawMacOptionKeyPressed ifTrue: [^ self world closeUnchangedWindows]]. self delete ! Item was changed: ----- Method: TheWorldMainDockingBar>>listChangesOn: (in category 'submenu - changes') ----- listChangesOn: menu + | fetchChangesBlock | + { + 'Browse current change set' translated. #browseChangeSet. nil. + 'Browse changed methods' translated. #browseChangedMethods. nil. + nil. nil. nil. + 'Simple Change Sorter' translated. #browseChanges. ChangeSorter. + 'Dual Change Sorter' translated. #browseChangesDual. DualChangeSorter. + nil. nil. nil. + } groupsDo: [:label :selector :modelClass | + label ifNil: [menu addLine] ifNotNil: [ + menu addItem: [:item | + item + contents: label; + icon: (modelClass ifNotNil: [self colorIcon: modelClass basicNew windowColorToUse]); + target: self; + selector: selector]] ]. - | 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]. + fetchChangesBlock := [ | latestMethodChanges latestClassChanges updateBlock | + self flag: #concurrency. "mt: Is this safe enough given the current update frequency of change sets and when this code is executed?" + latestMethodChanges := (Array streamContents: [:s | + ChangeSet current changedMethodsDo: [:method :changeType :dateAndTime :category | + s nextPut: { dateAndTime. method. changeType. category }]]) + sorted: [:a :b | a first >= b first]. + 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]. + updateBlock := [self listMethodChanges: latestMethodChanges andClassChanges: latestClassChanges on: menu]. + Project current uiProcess == Processor activeProcess + ifTrue: updateBlock + ifFalse: [Project current addDeferredUIMessage: [ + menu isInWorld ifTrue: [menu lastItem delete. updateBlock value]] ]]. - 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]. + ChangeSet current numberOfChanges <= 30 + ifTrue: fetchChangesBlock ifFalse: [ + "We have too much data to process. Do it in the background to keep the UI responsive." + menu add: '... fetching changes ...' translated action: nil. + menu lastItem isEnabled: false. + fetchChangesBlock forkAt: Processor userBackgroundPriority].! - 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 defaultTarget: self. - menu addTranslatedList: #( - - - ('Browse current change set' browseChangeSet) - ('Browse changed methods' browseChangedMethods) - - - ('Simple Change Sorter' browseChanges) - ('Dual Change Sorter' browseChangesDual)). - - - ! Item was changed: ----- Method: TheWorldMainDockingBar>>listCommonRequestsOn: (in category 'submenu - do') ----- listCommonRequestsOn: aMenu | strings | + aMenu add: 'edit this list' translated target: Utilities action: #editCommonRequestStrings. + aMenu addLine. + strings := Utilities commonRequestStrings contents. - strings asString linesDo: [:aString | aString = '-' ifTrue: [aMenu addLine] + ifFalse: [aMenu add: (aString ifEmpty: [' ']) target: Utilities selector: #eval: argument: aString]].! - ifFalse: [aMenu add: (aString ifEmpty: [' ']) target: Utilities selector: #eval: argument: aString]]. - - aMenu addLine. - aMenu add: 'edit this list' translated target: Utilities action: #editCommonRequestStrings.! Item was added: + ----- Method: TheWorldMainDockingBar>>listMethodChanges:andClassChanges:on: (in category 'submenu - changes') ----- + listMethodChanges: methodChanges andClassChanges: classChanges on: menu + + | latestMethodChanges latestClassChanges | + latestMethodChanges := methodChanges. + + 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 := classChanges. + + 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}]]! Item was changed: ----- Method: TheWorldMainDockingBar>>listWindowsOn: (in category 'submenu - windows') ----- listWindowsOn: menu | windows | + menu + addLine; + add: 'Collapse all windows' target: (Project current world) selector: #collapseAllWindows; + addItem: [:item | item + contents: 'Find Workspace...'; + subMenuUpdater: self + selector: #workspacesMenuFor: + arguments: #()]; + addLine; + add: 'Close all windows' target: self selector: #closeAllWindowsUnsafe; + addItem: [:item | item + contents: 'Close all windows without changes'; + target: self; + icon: MenuIcons smallBroomIcon; + selector: #closeAllWindows]; + add: 'Close all windows but workspaces' target: self selector: #closeAllWindowsButWorkspaces; + addLine. + windows := self allVisibleWindows sorted: [:winA :winB | ((winA model isNil or: [winB model isNil]) or: [winA model name = winB model name]) ifTrue: [winA label < winB label] ifFalse: [winA model name < winB model name]]. windows ifEmpty: [ menu addItem: [ :item | item contents: 'No Windows' translated; isEnabled: false ] ]. windows do: [ :each | | windowColor | windowColor := (each model respondsTo: #windowColorToUse) ifTrue: [each model windowColorToUse] ifFalse: [UserInterfaceTheme current get: #uniformWindowColor for: Model]. menu addItem: [ :item | item contents: (self windowMenuItemLabelFor: each); icon: (self colorIcon: windowColor); target: each; selector: #comeToFront; subMenuUpdater: self selector: #windowMenuFor:on: arguments: { each }; + action: [ each beKeyWindow; expand ] ] ].! - action: [ each beKeyWindow; expand ] ] ]. - menu - addLine; - add: 'Collapse all windows' target: (Project current world) selector: #collapseAllWindows; - add: 'Close all windows' target: self selector: #closeAllWindowsUnsafe; - addItem: [:item | item - contents: 'Close all windows without changes'; - target: self; - icon: MenuIcons smallBroomIcon; - selector: #closeAllWindows]; - add: 'Close all windows but workspaces' target: self selector: #closeAllWindowsButWorkspaces; - addItem: - [ :item | - item - contents: 'Find Workspace...'; - subMenuUpdater: self - selector: #workspacesMenuFor: - arguments: #()]!
More information about the Squeak-dev mailing list |