[squeak-dev] The Trunk: Morphic-mt.2061.mcz

commits at source.squeak.org commits at source.squeak.org
Wed Jan 11 12:49:38 UTC 2023


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

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

Name: Morphic-mt.2061
Author: mt
Time: 11 January 2023, 1:49:35.875506 pm
UUID: c8c81280-47e9-bf46-8852-577a736a8c90
Ancestors: Morphic-ct.2058, Morphic-ct.2060, Morphic-ct.2057, Morphic-ct.2051

Merges Morphic-ct.2058, Morphic-ct.2060, Morphic-ct.2057, Morphic-ct.2051.

Morphic-ct.2058:
	Fixes dangling formatting of IndentingListItemMorph labels when the previous label was a text and is now replaced with a string. 
You can reproduce this behavior by inserting the following before the last line in FontImporterTool>>#labelOf::
	(label runs anySatisfy: #notEmpty) ifFalse: [label := label asString].

Morphic-ct.2060:
	Preserves selection in TextMorph when changing the text style.

Morphic-ct.2057:
	Prevents pluggable buttons without a menu from acting on yellow-click. Why did we never notice this earlier? Yellow-click is for menus only ...

Morphic-ct.2051:
	Makes keyboard exerciser scale-factor-aware. Fixes layout of instruction text, which was previously not wrapped within the morph, overlapped the check buttons, and caused invalidations when moving or closing the exerciser. For this, uses a classical row-based tabel layout.

=============== Diff against Morphic-ct.2056 ===============

Item was changed:
  ----- Method: FillInTheBlankMorph class>>requestPassword:initialAnswer:centerAt:inWorld:onCancelReturn:acceptOnCR: (in category 'instance creation') -----
  requestPassword: queryString initialAnswer: defaultAnswer centerAt: aPoint inWorld: aWorld onCancelReturn: returnOnCancel acceptOnCR: acceptBoolean
  	"Create an instance of me whose question is queryString with the given initial answer. Invoke it centered at the given point, and answer the string the user accepts.   If the user cancels, answer returnOnCancel."
  	"FillInTheBlankMorph
+ 		requestPassword: 'Type something, then type CR.'
- 		request: 'Type something, then type CR.'
  		initialAnswer: 'yo ho ho!!'
+ 		centerAt: Display center
+ 		inWorld: self currentWorld
+ 		onCancelReturn: nil
+ 		acceptOnCR: true"
- 		centerAt: Display center"
  
  	| aFillInTheBlankMorph |
  	aFillInTheBlankMorph := self new
  		setPasswordQuery: queryString
  		initialAnswer: defaultAnswer
  		answerHeight: 50
  		acceptOnCR: acceptBoolean.
  
  	aFillInTheBlankMorph createAcceptButton
  		action: [aFillInTheBlankMorph textPane accept].
  	aFillInTheBlankMorph createCancelButton
  		action: [aFillInTheBlankMorph closeDialog: returnOnCancel].
  		
  	aFillInTheBlankMorph preferredPosition: aPoint.
  	^ aFillInTheBlankMorph getUserResponse!

Item was added:
+ ----- Method: IndentingListItemMorph>>contents: (in category 'accessing') -----
+ contents: newContents
+ 
+ 	(newContents isText not and: [self hasAnyAttributeFromText]) ifTrue: [
+ 		"Make sure to reset attributes from previous label text."
+ 		^ self contents: newContents asText].
+ 	^ super contents: newContents!

Item was added:
+ ----- Method: IndentingListItemMorph>>hasAnyAttributeFromText (in category 'testing') -----
+ hasAnyAttributeFromText
+ 
+ 	^ (self hasProperty: #hasFontFromText)
+ 		or: [self hasProperty: #hasEmphasisFromText]
+ 		or: [self hasProperty: #hasColorFromText]!

Item was changed:
  ----- Method: IndentingListItemMorph>>initWithColor:andFont: (in category 'initialization') -----
  initWithColor: aColor andFont: aFont
+ 	"Configure the receiver with aColor and aFont as prescribed by the owning tree morph. Ignore a property if overridden from text label. See #initializeFromText:.
+ 	That is, a tree morph prescribes a certain appearance for all its items, which it will constantly create and destroy as users collapse and expand items in the tree. During construction of each item, any text label will be set *before* calling this method. So we can check #hasColorFromText and other flags that will help us decide whether to keep a property or not."
  
  	(self hasProperty: #hasColorFromText)
  		ifFalse: [self color: aColor].
  
  	(self hasProperty: #hasEmphasisFromText)
  		ifTrue: [
  			(self hasProperty: #hasFontFromText)
  				ifFalse: [self font: aFont "Keeps emphasis from text."]]
  		ifFalse: [
  			(self hasProperty: #hasFontFromText)
  				ifTrue: [self emphasis: aFont emphasis "Keeps font from text."]
  				ifFalse: [self font: aFont emphasis: aFont emphasis]]
  !

Item was changed:
  ----- Method: IndentingListItemMorph>>initializeFromText: (in category 'initialization') -----
  initializeFromText: aText
  	"Overridden to keep track of text-based attributes."
  	
  	| priorFont priorEmphasis priorColor |
  	priorFont := self font.
  	priorEmphasis := self emphasis.
  	priorColor := self color.
  	
  	super initializeFromText: aText.
  	
+ 	self setProperty: #hasFontFromText toValue: priorFont ~~ self font.
+ 	self setProperty: #hasEmphasisFromText toValue: priorFont ~~ self emphasis.
+ 	self setProperty: #hasColorFromText toValue: priorColor ~~ self color.!
- 	priorFont == self font
- 		ifFalse: [self setProperty: #hasFontFromText toValue: true].
- 	priorFont == self emphasis
- 		ifFalse: [self setProperty: #hasEmphasisFromText toValue: true].
- 	priorColor == self color
- 		ifFalse: [self setProperty: #hasColorFromText toValue: true].!

Item was changed:
  ----- Method: IndentingListItemMorph>>refresh (in category 'initialization') -----
  refresh
+ 	"Query model data to update the visual appearance of the receiver, which includes icons and text emphasis. Invoked when a model sends #objectChanged via #changed:with:. See PluggableTreeMorph >> #updateMorph:."
  
  	self contents: self getLabel.
  	self refreshIcon.
  	
  	(self valueOfProperty: #wasRefreshed ifAbsent: [false]) ifFalse: [
  		self setProperty: #wasRefreshed toValue: true].!

Item was changed:
  Morph subclass: #KeyboardExerciser
+ 	instanceVariableNames: 'checkButtons eventPane'
- 	instanceVariableNames: ''
  	classVariableNames: ''
  	poolDictionaries: ''
  	category: 'Morphic-Demo'!

Item was added:
+ ----- Method: KeyboardExerciser>>addCheckButtons (in category 'initialization') -----
+ addCheckButtons
+ 
+ 	| buttonPane |
+ 	buttonPane := Morph new
+ 		beTransparent;
+ 		changeTableLayout;
+ 		hResizing: #spaceFill;
+ 		vResizing: #shrinkWrap;
+ 		listDirection: #leftToRight;
+ 		wrapDirection: #topToBottom;
+ 		cellGap: 10 px;
+ 		yourself.
+ 	
+ 	checkButtons := OrderedCollection new.
+ 	#(processKeyStroke 'Test key stroke'
+ 	processKeyDown 'Test key down'
+ 	processKeyUp 'Test key up')
+ 		groupsDo: [:selector :label |
+ 			| button |
+ 			button := ThreePhaseButtonMorph checkBox
+ 				target: self;
+ 				actionSelector: selector;
+ 				label: label;
+ 				yourself.
+ 			checkButtons addLast: button.
+ 			buttonPane addMorphBack: button].
+ 	
+ 	self addMorphBack: buttonPane.
+ 	^ buttonPane!

Item was added:
+ ----- Method: KeyboardExerciser>>addEventPane (in category 'initialization') -----
+ addEventPane
+ 
+ 	eventPane := Morph new
+ 		beTransparent;
+ 		changeTableLayout;
+ 		listDirection: #leftToRight;
+ 		wrapDirection: #topToBottom;
+ 		hResizing: #spaceFill;
+ 		vResizing: #shrinkWrap;
+ 		cellGap: 5 px;
+ 		height: 0;
+ 		yourself.
+ 	
+ 	self addMorphBack: eventPane.
+ 	^ eventPane!

Item was added:
+ ----- Method: KeyboardExerciser>>addTitle (in category 'initialization') -----
+ addTitle
+ 
+ 	| title |
+ 	title := TextMorph new
+ 		contents: 'Move your mouse cursor to here and start typing. Try modifiers, too.' translated;
+ 		font: Preferences standardButtonFont;
+ 		color: Color gray;
+ 		hResizing: #spaceFill;
+ 		lock;
+ 		yourself.
+ 	
+ 	self addMorphBack: title.
+ 	^ title!

Item was changed:
  ----- Method: KeyboardExerciser>>checkButton: (in category 'initialization') -----
  checkButton: checkIndex
  
+ 	self checkButtons do: [:button |
+ 		button state: #off].
- 	1 to: 3 do: [:index |
- 		(self submorphs at: index)
- 			state: #off].
  	
+ 	(self checkButtons at: checkIndex) state: #on.!
- 	(self submorphs at: checkIndex) state: #on.!

Item was added:
+ ----- Method: KeyboardExerciser>>checkButtons (in category 'accessing') -----
+ checkButtons
+ 
+ 	^ checkButtons!

Item was changed:
  ----- Method: KeyboardExerciser>>clear (in category 'initialization') -----
  clear
  
+ 	eventPane removeAllMorphs.
+ 	eventPane height: 0.!
- 	(self submorphs allButFirst: 3) do: [:m | m delete].!

Item was removed:
- ----- Method: KeyboardExerciser>>drawOn: (in category 'drawing') -----
- drawOn: aCanvas
- 
- 	super drawOn: aCanvas.
- 	
- 	aCanvas
- 		drawString: 'Move your mouse cursor to here and start typing. Try modifiers, too.' translated
- 		at: self topLeft
- 		font: Preferences standardButtonFont
- 		color: Color gray.!

Item was added:
+ ----- Method: KeyboardExerciser>>eventMorphs (in category 'accessing') -----
+ eventMorphs
+ 
+ 	^ eventPane submorphs!

Item was changed:
  ----- Method: KeyboardExerciser>>handleEvent:inspect: (in category 'actions') -----
  handleEvent: mouseEvent inspect: morph
  
+ 	mouseEvent shiftPressed
- 	mouseEvent	 shiftPressed
  		ifTrue: [(morph valueOfProperty: #event) explore]
  		ifFalse: [(morph valueOfProperty: #event) inspect].!

Item was changed:
  ----- Method: KeyboardExerciser>>initialize (in category 'initialization') -----
  initialize
  
  	super initialize.
  	
  	self
+ 		color: ((self userInterfaceTheme get: #color for: #ScrollPane) ifNil: [Color white]);
+ 		borderStyle: ((self userInterfaceTheme get: #borderStyle for: #ScrollPane) ifNil: [BorderStyle simple]) copy;
+ 		borderColor: ((self userInterfaceTheme get: #borderColor for: #ScrollPane) ifNil: [Color gray: 0.6]);
+ 		borderWidth: (((self userInterfaceTheme get: #borderWidth for: #ScrollPane) ifNil: [1]) * RealEstateAgent scaleFactor) truncated;
+ 		extent: 350 px @ 50 px;
- 		color: (self userInterfaceTheme get: #color for: #ScrollPane);
- 		extent: 300 at 50;
  		layoutPolicy: TableLayout new;
+ 		listDirection: #topToBottom;
- 		listDirection: #leftToRight;
- 		wrapDirection: #topToBottom;
  		hResizing: #rigid;
  		vResizing: #shrinkWrap;
+ 		cellGap: 10 px;
+ 		layoutInset: 13 px @ 10 px;
- 		cellGap: 10;
- 		layoutInset: 20;
  		yourself.
  	
+ 	self addTitle.
+ 	self addCheckButtons.
+ 	self addEventPane.
- 	#(processKeyStroke 'Test key stroke'
- 	processKeyDown 'Test key down'
- 	processKeyUp 'Test key up')
- 		groupsDo: [:selector :label |
- 			self addMorphBack: (ThreePhaseButtonMorph checkBox
- 				target: self;
- 				actionSelector: selector;
- 				label: label;
- 				yourself)].
  	
  	self processKeyStroke.!

Item was added:
+ ----- Method: KeyboardExerciser>>instructionMorph (in category 'accessing') -----
+ instructionMorph
+ 
+ 	^ self hasSubmorphs ifTrue: [self firstSubmorph]!

Item was changed:
  ----- Method: KeyboardExerciser>>lastEvent (in category 'accessing') -----
  lastEvent
  
  	| view event |
+ 	view := (self eventMorphs ifEmpty: [^ nil]) last.
- 	view := self submorphs last.
  	(view hasProperty: #event) ifFalse: [^ nil].	
  	event := view valueOfProperty: #event.
  	event isCollection ifTrue: [event := event last].
  	^ event!

Item was changed:
  ----- Method: KeyboardExerciser>>logEvent: (in category 'event handling') -----
  logEvent: evt
  
  	| eventMorph |
  	evt = self lastEvent
  		ifTrue: [^ self logEventRepetition: evt].
  
  	eventMorph := evt asMorph.
  	eventMorph
  		setProperty: #event toValue: evt copy;
  		balloonText: ('Click to inspect. Shift+click to explore.\\Virtual key: {8}\Virtual modifiers: {5}\\Physical key: {9}\Physical modifiers: {6}\\Key value: 0x{1} ({2}) \Key character: {3}\Key string: {4}\\{7}' translated withCRs format: {
  			evt keyValue printPaddedWith: $0 to: 2 base: 16.
  			evt keyValue.
  			evt isKeystroke ifTrue: [evt keyCharacter printString] ifFalse: ['-'].
  			evt isKeystroke ifTrue: [evt keyString printString] ifFalse: ['-'].
  			(evt virtualModifiers joinSeparatedBy: ' ') asUppercase.
  			(evt physicalModifiers joinSeparatedBy: ' ') asUppercase.
  			evt printString.
  			evt virtualKey printString.
  			evt physicalKey asString printString}).
  			
  	eventMorph
  		on: #mouseEnter send: #handleEvent:emphasize: to: self;
  		on: #mouseLeave send: #handleEvent:deemphasize: to: self;
  		on: #mouseDown send: #handleEvent:inspect: to: self.
  
+ 	eventPane addMorphBack: eventMorph.!
- 	self addMorphBack: eventMorph.!

Item was changed:
  ----- Method: KeyboardExerciser>>logEventRepetition: (in category 'event handling') -----
  logEventRepetition: evt
  
  	| label lastEvents box |
+ 	(self eventMorphs last hasProperty: #repetition)
+ 		ifTrue: [box := self eventMorphs last. label := box submorphs first]
- 	(self submorphs last hasProperty: #repetition)
- 		ifTrue: [box := self submorphs last. label := box submorphs first]
  		ifFalse: [
  			box := Morph new
  				setProperty: #repetition toValue: true;
  				color: Color transparent;
  				layoutPolicy: TableLayout new;
  				hResizing: #shrinkWrap;
  				vResizing:#shrinkWrap;
  				yourself.
  			label := '' asText asMorph lock.
  			box addMorph: label.
  			box setProperty: #event toValue: (OrderedCollection with: self lastEvent).
+ 			eventPane addMorphBack: box].
- 			self addMorphBack: box].
  
  	lastEvents := box valueOfProperty: #event.
  	lastEvents add: evt copy.
  	box setProperty: #event toValue: lastEvents.
  
  	label newContents: (('x ', (lastEvents size)) asText
  		addAttribute: (TextFontReference toFont: Preferences standardButtonFont);
  		yourself).
  	box balloonText: ('{1}{2}'  format: {
  		lastEvents size > 10 ifTrue: ['... {1} older events and:\' translated withCRs format: {lastEvents size - 10}] ifFalse: [''].
  		(lastEvents last: (10 min: lastEvents size)) joinSeparatedBy: String cr.
  		}).
  			
  	box
  		on: #mouseEnter send: #handleEvent:emphasize: to: self;
  		on: #mouseLeave send: #handleEvent:deemphasize: to: self;
  		on: #mouseDown send: #handleEvent:inspect: to: self.!

Item was changed:
  ----- Method: PluggableButtonMorph>>mouseUp: (in category 'event handling') -----
  mouseUp: evt
  
+ 	evt yellowButtonChanged ifTrue: [^ super mouseUp: evt].
  	self updateFillStyle: evt.
  	(self containsPoint: evt cursorPoint)
  		ifTrue: [self performAction].!

Item was changed:
  ----- Method: TextMorph>>textStyle: (in category 'accessing') -----
  textStyle: aTextStyle
  	"Change the receiver's set of fonts to aTextStyle. You can access those fonts via the TextFontChange text attribute. If you want to enfore a specific font face or point size, use #font: instead. NOTE THAT you must provide either a freshly created instance of TextStyle or a copy of an existing one. NEVER use, for example, TextStyle class >> #default directly. Also see senders and implementors of #asNewTextStyle."
  
+ 	| previousSelection |
  	textStyle := aTextStyle.
+ 	previousSelection := self selectionInterval.
+ 	self releaseParagraph; changed.
+ 	previousSelection ifNotNil: [self selectionInterval: previousSelection].!
- 	self releaseParagraph; changed.!

Item was changed:
  ----- Method: TheWorldMainDockingBar>>transcriptMenuItemOn: (in category 'submenu - tools') -----
  transcriptMenuItemOn: menu
  
  	menu addItem: [ :item |
  		item
  			contents: 'Transcript' translated;
  			help: 'Open the Transcript' translated;
  			icon: (self colorIcon: Transcript windowColorToUse);
+ 			target: [ (Smalltalk at: #Transcript) open ];
+ 			selector: #value ].!
- 			target: Transcript;
- 			selector: #open ]!

Item was changed:
  ----- Method: TheWorldMenu>>openTranscript (in category 'commands') -----
  openTranscript
  
+ 	Transcript open.!
- 	Transcript openLabel: 'Transcript'!

Item was changed:
+ (PackageInfo named: 'Morphic') postscript: 'TheWorldMainDockingBar updateInstances. "Fix ''Tools > Transcript'' to make it late-bound."'!
- (PackageInfo named: 'Morphic') postscript: 'TheWorldMainDockingBar updateInstances. "Updates menu for Help > Contributing to Squeak"'!



More information about the Squeak-dev mailing list