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@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!