[squeak-dev] The Trunk: Morphic-pre.1787.mcz

commits at source.squeak.org commits at source.squeak.org
Wed Nov 10 14:15:01 UTC 2021


Patrick Rein uploaded a new version of Morphic to project The Trunk:
http://source.squeak.org/trunk/Morphic-pre.1787.mcz

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

Name: Morphic-pre.1787
Author: pre
Time: 10 November 2021, 3:14:54.221616 pm
UUID: 47110e44-c26f-8444-bc66-849696a5bc9b
Ancestors: Morphic-eem.1786

Recategorizes unclassified methods.

=============== Diff against Morphic-eem.1786 ===============

Item was changed:
+ ----- Method: ComplexProgressIndicator>>addProgressDecoration: (in category 'private') -----
- ----- Method: ComplexProgressIndicator>>addProgressDecoration: (in category 'as yet unclassified') -----
  addProgressDecoration: extraParam 
  	| f m |
  	targetMorph ifNil: [^self].
  	(extraParam isForm) 
  		ifTrue: 
  			[targetMorph 
  				submorphsDo: [:mm | (mm isSketchMorph) ifTrue: [mm delete]].
  			f := Form extent: extraParam extent depth: extraParam depth.
  			extraParam displayOn: f.
  			m := SketchMorph withForm: f.
  			m align: m fullBounds leftCenter
  				with: targetMorph fullBounds leftCenter + (2 @ 0).
  			targetMorph addMorph: m.
  			^self].
  	(extraParam isString) 
  		ifTrue: 
  			[targetMorph 
  				submorphsDo: [:mm | (mm isKindOf: StringMorph) ifTrue: [mm delete]].
  			m := StringMorph contents: extraParam translated.
  			m align: m fullBounds bottomCenter + (0 @ 8)
  				with: targetMorph bounds bottomCenter.
  			targetMorph addMorph: m.
  			^self]!

Item was changed:
+ ----- Method: ComplexProgressIndicator>>backgroundWorldDisplay (in category 'private') -----
- ----- Method: ComplexProgressIndicator>>backgroundWorldDisplay (in category 'as yet unclassified') -----
  backgroundWorldDisplay
  
  	| world |
  	self flag: #bob.		"really need a better way to do this"
  
  			"World displayWorldSafely."
  
  	"ugliness to try to track down a possible error"
  
  	world := Project current world.
  	[world displayWorld] ifError: [ :a :b |
  		| f |
  		stageCompleted := 999.
  		f := FileDirectory default fileNamed: 'bob.errors'.
  		f nextPutAll: a printString,'  ',b printString; cr; cr.
  		f nextPutAll: 'worlds equal ',(formerWorld == world) printString; cr; cr.
  		f nextPutAll: thisContext longStack; cr; cr.
  		f nextPutAll: formerProcess suspendedContext longStack; cr; cr.
  		f close. Beeper beep.
  	].
  !

Item was changed:
+ ----- Method: ComplexProgressIndicator>>forkProgressWatcher (in category 'private - background process') -----
- ----- Method: ComplexProgressIndicator>>forkProgressWatcher (in category 'as yet unclassified') -----
  forkProgressWatcher
  
  	[
  	| currentWorld killTarget |
  		currentWorld := Project current world.
  		[stageCompleted < 999 and: 
  				[formerProject == Project current and: 
  				[formerWorld == currentWorld and: 
  				[translucentMorph world notNil and:
  				[formerProcess suspendedContext notNil and: 
  				[Project uiProcess == formerProcess]]]]]] whileTrue: [
  
  			translucentMorph setProperty: #revealTimes toValue: 
  					{(Time millisecondClockValue - start max: 1). (estimate * newRatio max: 1)}.
  			translucentMorph changed.
  			translucentMorph owner addMorphInLayer: translucentMorph.
  			(Time millisecondClockValue - WorldState lastCycleTime) abs > 500 ifTrue: [
  				self backgroundWorldDisplay
  			].
  			(Delay forMilliseconds: 100) wait.
  		].
  		translucentMorph removeProperty: #revealTimes.
  		self loadingHistoryAt: 'total' add: (Time millisecondClockValue - start max: 1).
  		killTarget := targetMorph ifNotNil: [
  			targetMorph valueOfProperty: #deleteOnProgressCompletion
  		].
  		formerWorld == currentWorld ifTrue: [
  			translucentMorph delete.
  			killTarget ifNotNil: [killTarget delete].
  		] ifFalse: [
  			translucentMorph privateDeleteWithAbsolutelyNoSideEffects.
  			killTarget ifNotNil: [killTarget privateDeleteWithAbsolutelyNoSideEffects].
  		].
  	] forkAt: Processor lowIOPriority.!

Item was changed:
+ ----- Method: ComplexProgressIndicator>>historyCategory: (in category 'configuration') -----
- ----- Method: ComplexProgressIndicator>>historyCategory: (in category 'as yet unclassified') -----
  historyCategory: aKey
  
  	History ifNil: [History := Dictionary new].
  	specificHistory := History
  		at: aKey
  		ifAbsentPut: [Dictionary new].
  	^specificHistory
  !

Item was changed:
+ ----- Method: ComplexProgressIndicator>>loadingHistoryAt:add: (in category 'private') -----
- ----- Method: ComplexProgressIndicator>>loadingHistoryAt:add: (in category 'as yet unclassified') -----
  loadingHistoryAt: aKey add: aNumber
  
  	(self loadingHistoryDataForKey: aKey) add: aNumber.
  
  !

Item was changed:
+ ----- Method: ComplexProgressIndicator>>loadingHistoryDataForKey: (in category 'private') -----
- ----- Method: ComplexProgressIndicator>>loadingHistoryDataForKey: (in category 'as yet unclassified') -----
  loadingHistoryDataForKey: anObject
  
  	| answer |
  	answer := specificHistory 
  		at: anObject
  		ifAbsentPut: [OrderedCollection new].
  	answer size > 50 ifTrue: [
  		answer := answer copyFrom: 25 to: answer size.
  		specificHistory at: anObject put: answer.
  	].
  	^answer
  
  !

Item was changed:
+ ----- Method: ComplexProgressIndicator>>targetMorph: (in category 'configuration') -----
- ----- Method: ComplexProgressIndicator>>targetMorph: (in category 'as yet unclassified') -----
  targetMorph: aMorph
  
  	targetMorph := aMorph!

Item was changed:
+ ----- Method: ComplexProgressIndicator>>withProgressDo: (in category 'configuration') -----
- ----- Method: ComplexProgressIndicator>>withProgressDo: (in category 'as yet unclassified') -----
  withProgressDo: aBlock
  
  	| safetyFactor totals trialRect delta |
  
  	Smalltalk isMorphic ifFalse: [^aBlock value].
  	formerProject := Project current.
  	formerWorld := formerProject world.
  	formerProcess := Processor activeProcess.
  	targetMorph
  		ifNil: [targetMorph := ProgressTargetRequestNotification signal].
  	targetMorph ifNil: [
  		trialRect := Rectangle center: Sensor cursorPoint extent: 80 at 80.
  		delta := trialRect amountToTranslateWithin: formerWorld bounds.
  		trialRect := trialRect translateBy: delta.
  		translucentMorph := TranslucentProgessMorph new
  			opaqueBackgroundColor: Color white;
  			bounds: trialRect;
  			openInWorld: formerWorld.
  	] ifNotNil: [
  		translucentMorph := TranslucentProgessMorph new
  			morphicLayerNumber: targetMorph morphicLayerNumber - 0.1;
  			bounds: targetMorph boundsInWorld;
  			openInWorld: targetMorph world.
  	].
  	stageCompleted := 0.
  	safetyFactor := 1.1.	"better to guess high than low"
  	translucentMorph setProperty: #progressStageNumber toValue: 1.
  	translucentMorph hide.
  	totals := self loadingHistoryDataForKey: 'total'.
  	newRatio := 1.0.
  	estimate := totals size < 2 ifTrue: [
  		15000		"be a pessimist"
  	] ifFalse: [
  		(totals sum - totals max) / (totals size - 1 max: 1) * safetyFactor.
  	].
  	start := Time millisecondClockValue.
  	self forkProgressWatcher.
  
  	[
  		aBlock 
  			on: ProgressInitiationException
  			do: [ :ex | 
  				ex sendNotificationsTo: [ :min :max :curr |
  					"ignore this as it is inaccurate"
  				].
  			].
  	] on: ProgressNotification do: [ :note | | stageCompletedString |
  		translucentMorph show.
  		note extraParam ifNotNil:[self addProgressDecoration: note extraParam].
  		stageCompletedString := (note messageText findTokens: ' ') first.
  		stageCompleted := (stageCompletedString copyUpTo: $:) asNumber.
  		cumulativeStageTime := Time millisecondClockValue - start max: 1.
  		prevData := self loadingHistoryDataForKey: stageCompletedString.
  		prevData isEmpty ifFalse: [
  			newRatio := (cumulativeStageTime / (prevData average max: 1)) asFloat.
  		].
  		self 
  			loadingHistoryAt: stageCompletedString 
  			add: cumulativeStageTime.
  		translucentMorph 
  			setProperty: #progressStageNumber 
  			toValue: stageCompleted + 1.
  		note resume.
  	].
  
  	stageCompleted := 999.	"we may or may not get here"
  
  !

Item was changed:
+ ----- Method: IconicButton>>darken (in category 'ui') -----
- ----- Method: IconicButton>>darken (in category 'as yet unclassified') -----
  darken
  
  	self firstSubmorph form: self darkenedForm!

Item was changed:
+ ----- Method: KeyboardBuffer>>flushKeyboard (in category 'keyboard control') -----
- ----- Method: KeyboardBuffer>>flushKeyboard (in category 'as yet unclassified') -----
  flushKeyboard
  	eventUsed ifFalse: [^ eventUsed := true].!

Item was changed:
+ ----- Method: KeyboardBuffer>>keyboard (in category 'keyboard control') -----
- ----- Method: KeyboardBuffer>>keyboard (in category 'as yet unclassified') -----
  keyboard
  	eventUsed ifFalse: [eventUsed := true.  ^ event keyCharacter].
  	^ nil!

Item was changed:
+ ----- Method: KeyboardBuffer>>keyboardPeek (in category 'keyboard control') -----
- ----- Method: KeyboardBuffer>>keyboardPeek (in category 'as yet unclassified') -----
  keyboardPeek
  	eventUsed ifFalse: [^ event keyCharacter].
  	^ nil!

Item was changed:
+ ----- Method: KeyboardBuffer>>startingEvent: (in category 'private') -----
- ----- Method: KeyboardBuffer>>startingEvent: (in category 'as yet unclassified') -----
  startingEvent: evt
  	event := evt.
  	eventUsed := false!

Item was changed:
+ ----- Method: SVColorSelectorMorph>>extent: (in category 'geometry') -----
- ----- Method: SVColorSelectorMorph>>extent: (in category 'as yet unclassified') -----
  extent: p
  	"Update the gradient directions."
  
  	super extent: p.
  	self updateGradients!

Item was removed:
- ----- Method: TextEditor>>systemNavigation (in category 'as yet unclassified') -----
- systemNavigation
- 	^ SystemNavigation for: model environment!



More information about the Squeak-dev mailing list