Packages March 2018

packages@lists.squeakfoundation.org

1 participants
71 discussions

The Trunk: Tools-mt.802.mcz
by commits＠source.squeak.org 29 Mar '18

29 Mar '18

Marcel Taeumel uploaded a new version of Tools to project The Trunk: http://source.squeak.org/trunk/Tools-mt.802.mcz ==================== Summary ==================== Name: Tools-mt.802 Author: mt Time: 29 March 2018, 9:39:05.973053 am UUID: 17d05dbc-cfba-5e40-9f1c-5d9c8e01723d Ancestors: Tools-tcj.801 Pick color for class-comment nagging from UI theme. =============== Diff against Tools-tcj.801 =============== Item was changed: ----- Method: Browser>>noCommentNagString (in category 'class comment pane') ----- noCommentNagString + ^ Text + string: 'THIS CLASS HAS NO COMMENT!!' translated + attribute: (TextColor color: (self userInterfaceTheme noClassCommentColor ifNil: [Color red]))! - ^ Text string: 'THIS CLASS HAS NO COMMENT!!' translated attribute: TextColor red. - !

1 0

The Trunk: Morphic-mt.1403.mcz
by commits＠source.squeak.org 29 Mar '18

29 Mar '18

Marcel Taeumel uploaded a new version of Morphic to project The Trunk: http://source.squeak.org/trunk/Morphic-mt.1403.mcz ==================== Summary ==================== Name: Morphic-mt.1403 Author: mt Time: 29 March 2018, 9:29:39.408053 am UUID: a71ca488-3caf-e649-bea1-9cd9e0d8d770 Ancestors: Morphic-mt.1402 Minor visual fix regarding the border of scroll panes. =============== Diff against Morphic-mt.1402 =============== Item was added: + ----- Method: ScrollPane>>drawOn: (in category 'drawing') ----- + drawOn: aCanvas + + self wantsRoundedCorners + ifTrue: [aCanvas fillRoundRect: self bounds radius: self cornerRadius fillStyle: self fillStyle] + ifFalse: [aCanvas fillRectangle: self bounds fillStyle: self fillStyle].! Item was added: + ----- Method: ScrollPane>>drawOverlayOn: (in category 'drawing') ----- + drawOverlayOn: aCanvas + "Draw my border OVER my submorphs because the scrollbars overlap." + + self borderStyle width = 0 ifTrue: [^ self]. + + self wantsRoundedCorners + ifTrue: [aCanvas frameRoundRect: self bounds radius: self cornerRadius width: self borderStyle width color: self borderStyle color] + ifFalse: [aCanvas frameRectangle: self bounds width: self borderStyle width color: self borderStyle color].!

1 0

The Trunk: WebClient-Core-topa.114.mcz
by commits＠source.squeak.org 28 Mar '18

28 Mar '18

Tobias Pape uploaded a new version of WebClient-Core to project The Trunk: http://source.squeak.org/trunk/WebClient-Core-topa.114.mcz ==================== Summary ==================== Name: WebClient-Core-topa.114 Author: topa Time: 28 March 2018, 9:49:17.368144 pm UUID: 6f483d27-959e-49ce-8a4b-2e825409953b Ancestors: WebClient-Core-ul.113 Support token-based Bearer/OAuth2 auth. Note: server part is overly simplified and surely needs extensions for proper OAuth2 =============== Diff against WebClient-Core-ul.113 =============== Item was added: + ----- Method: WebAuthRequired>>token: (in category 'initialize') ----- + token: aString + "Use the given token as credentials" + + | params | + params := self isProxyAuth ifTrue:[client proxyParams] ifFalse:[client authParams]. + + (params at: #token ifAbsent: [nil]) = aString + ifFalse: + [params at: #token put: aString. + self resume: true] + ! Item was changed: ----- Method: WebClient>>authDispatch:from:header:params: (in category 'authentication') ----- authDispatch: request from: response header: authHeader params: params "Dispatch on an authentication method. Subclasses can extend this method to support more auth methods." (authHeader copyUpTo: Character space) caseOf: { ['Basic'] -> [self basicAuth: request from: response header: authHeader params: params]. ['Digest'] -> [self digestAuth: request from: response header: authHeader params: params]. + ['Bearer'] -> [self bearerAuth: request from: response + header: authHeader params: params]. } otherwise:["ignore"]. ! Item was added: + ----- Method: WebClient>>bearerAuth:from:header:params: (in category 'authentication') ----- + bearerAuth: request from: response header: header params: params + "Provide token-based OAuth2 authentication for the request" + + | token args | + authParams at: #authMethod ifPresent:[:method| ^self]. "do not retry repeatedly" + authParams at: #authMethod put: 'Bearer'. + + args := WebUtils parseAuthParams: header. + args at: 'realm' ifPresent:[:realm| authParams at: #authRealm put: realm]. + + token := (params at: #token ifAbsent:[nil]) ifNil:[^self]. + authParams at: #authResponse put: token. + ! Item was added: + ----- Method: WebClient>>token (in category 'accessing') ----- + token + "The token for remote OAuth2 authentication" + + ^authParams at: #token ifAbsent:[nil]! Item was added: + ----- Method: WebClient>>token: (in category 'accessing') ----- + token: aString + "The token for remote OAuth2 authentication" + + authParams at: #token put: aString! Item was added: + ----- Method: WebServer>>addToken:toRealm: (in category 'authentication') ----- + addToken: aString toRealm: realm + | hash | + hash := WebUtils md5Digest: aString, ':', realm. + self passwordHashAt: (aString,':',realm) put: hash! Item was changed: ----- Method: WebServer>>authAccept:request:realm:header: (in category 'authentication') ----- authAccept: method request: request realm: realm header: authHeader "Performs the requested authentication method. Returns true if successfully authenticated. Subclasses can extend this method to support more auth methods." ^method asLowercase caseOf: { ['basic'] -> [self basicAuth: request realm: realm header: authHeader]. ['digest'] -> [self digestAuth: request realm: realm header: authHeader]. + ['bearer'] -> [self bearerAuth: request realm: realm header: authHeader]. } otherwise:[false]. ! Item was changed: ----- Method: WebServer>>authHeader:request:realm: (in category 'authentication') ----- authHeader: method request: request realm: realm "Answer the authentication header for the given method. Subclasses can extend this method to support more auth methods." ^method asLowercase caseOf: { ['basic'] -> ['Basic realm="', realm,'"']. ['digest'] -> ['Digest realm="', realm,'", nonce="', self newNonce,'", qop="auth"']. + ['bearer'] -> ['Bearer realm="', realm,'"']. } otherwise:[nil]. ! Item was added: + ----- Method: WebServer>>bearerAuth:realm:header: (in category 'authentication') ----- + bearerAuth: request realm: realm header: authHeader + "Perform Bearer-based OAuth2 auth for the given request" + + | data hash | + data := authHeader copyAfter: $ . + hash := WebUtils md5Digest: data, ':', realm. + ^(self passwordHashAt: data, ':', realm) = hash + !

1 0

The Trunk: WebClient-Tests-topa.55.mcz
by commits＠source.squeak.org 28 Mar '18

28 Mar '18

Tobias Pape uploaded a new version of WebClient-Tests to project The Trunk: http://source.squeak.org/trunk/WebClient-Tests-topa.55.mcz ==================== Summary ==================== Name: WebClient-Tests-topa.55 Author: topa Time: 28 March 2018, 9:47:24.339011 pm UUID: af4b368e-87fd-4823-a3bd-86ef1d76eb7d Ancestors: WebClient-Tests-ul.54 test token-based Bearer/OAuth2 auth =============== Diff against WebClient-Tests-ul.54 =============== Item was changed: ----- Method: WebClientServerTest>>setUp (in category 'setup') ----- setUp server := WebServer new listenOn: self port. server passwordAt: 'user' realm: 'test' put: 'pass'. + server addToken: 'shushitsissupersecret' toRealm: 'test'.! - ! Item was added: + ----- Method: WebClientServerTest>>testBerarerAuth (in category 'tests - auth') ----- + testBerarerAuth + "Test client and server berarer auth" + + | resp reqHeader | + server addService: '/test/auth' action:[:req | + server authenticate: req realm: 'test' methods: #(bearer) do:[ + reqHeader := req headerAt: 'Authorization'. + req send200Response: 'ok'] ]. + + resp := WebClient new httpGet: self localHostUrl, '/test/auth'. + self assert: resp code = 401. + + [resp := WebClient httpGet: self localHostUrl, '/test/auth'] + on: WebAuthRequired do:[:ex| ex token: 'ihavenoideawhatiamdoing']. + self assert: resp code = 401. + + [resp := WebClient httpGet: self localHostUrl, '/test/auth'] + on: WebAuthRequired do:[:ex| ex token:'shushitsissupersecret']. + self assert: resp code = 200. + self assert: resp content = 'ok'. + self assert: (reqHeader beginsWith: 'Bearer '). + !

1 0

The Trunk: System-mt.1007.mcz
by commits＠source.squeak.org 28 Mar '18

28 Mar '18

Marcel Taeumel uploaded a new version of System to project The Trunk: http://source.squeak.org/trunk/System-mt.1007.mcz ==================== Summary ==================== Name: System-mt.1007 Author: mt Time: 28 March 2018, 4:12:58.634604 pm UUID: 9616347c-6655-7746-b0f4-b5e04d9e11b6 Ancestors: System-eem.1006 Adds border-color modifier to all Squeak-based UI themes. =============== Diff against System-eem.1006 =============== Item was changed: ----- Method: SqueakTheme class>>addWindowColors: (in category 'instance creation') ----- addWindowColors: theme theme set: #titleFont for: #SystemWindow to: [Preferences windowTitleFont]; set: #borderColorModifier for: #SystemWindow to: [ [:c | c adjustBrightness: -0.3] ]; + set: #borderColorModifier for: #ScrollPane to: [ [:c | c adjustBrightness: -0.3] ]; set: #borderWidth for: #SystemWindow to: 1; set: #uniformWindowColor for: #Model to: Color veryVeryLightGray; derive: #uniformWindowColor for: #TranscriptStream from: #Model; derive: #color for: #SystemWindow from: #Model at: #uniformWindowColor; "Fall back for windows without models." set: #unfocusedWindowColorModifier for: #SystemWindow to: [ [:color | color darker] ]; set: #unfocusedLabelColor for: #SystemWindow to: Color darkGray; set: #focusedLabelColor for: #SystemWindow to: Color black; set: #customWindowColor for: #Browser to: (Color r: 0.764 g: 0.9 b: 0.63); set: #customWindowColor for: #ChangeList to: (Color r: 0.719 g: 0.9 b: 0.9); set: #customWindowColor for: #ChangeSorter to: (Color r: 0.719 g: 0.9 b: 0.9); set: #customWindowColor for: #ChatNotes to: (Color r: 1.0 g: 0.7 b: 0.8); set: #customWindowColor for: #ClassCommentVersionsBrowser to: (Color r: 0.753 g: 0.677 b: 0.9); set: #customWindowColor for: #Debugger to: (Color r: 0.9 g: 0.719 b: 0.719); set: #customWindowColor for: #DualChangeSorter to: (Color r: 0.719 g: 0.9 b: 0.9); set: #customWindowColor for: #FileContentsBrowser to: (Color r: 0.7 g: 0.7 b: 0.508); set: #customWindowColor for: #FileList to: (Color r: 0.65 g: 0.65 b: 0.65); set: #customWindowColor for: #InstanceBrowser to: (Color r: 0.726 g: 0.9 b: 0.9); set: #customWindowColor for: #Lexicon to: (Color r: 0.79 g: 0.9 b: 0.79); set: #customWindowColor for: #MCTool to: (Color r: 0.65 g: 0.691 b: 0.876); set: #customWindowColor for: #MessageNames to: (Color r: 0.639 g: 0.9 b: 0.497); set: #customWindowColor for: #MessageSet to: (Color r: 0.719 g: 0.9 b: 0.9); set: #customWindowColor for: #PackagePaneBrowser to: (Color r: 0.9 g: 0.9 b: 0.63); set: #customWindowColor for: #PluggableFileList to: Color lightYellow; set: #customWindowColor for: #PreferenceBrowser to: (Color r: 0.671 g: 0.9 b: 0.9); set: #customWindowColor for: #SMLoader to: (Color r: 0.801 g: 0.801 b: 0.614); set: #customWindowColor for: #SMLoaderPlus to: (Color r: 0.801 g: 0.801 b: 0.614); set: #customWindowColor for: #SMReleaseBrowser to: (Color r: 0.801 g: 0.801 b: 0.614); set: #customWindowColor for: #ScriptingDomain to: (Color r: 0.91 g: 0.91 b: 0.91); set: #customWindowColor for: #SelectorBrowser to: (Color r: 0.45 g: 0.9 b: 0.9); set: #customWindowColor for: #StringHolder to: (Color r: 0.9 g: 0.9 b: 0.719); set: #customWindowColor for: #TestRunner to: (Color r: 0.9 g: 0.576 b: 0.09); set: #customWindowColor for: #TranscriptStream to: (Color r: 0.9 g: 0.75 b: 0.45); set: #customWindowColor for: #VersionsBrowser to: (Color r: 0.782 g: 0.677 b: 0.9).!

1 0

The Trunk: Morphic-mt.1402.mcz
by commits＠source.squeak.org 28 Mar '18

28 Mar '18

Marcel Taeumel uploaded a new version of Morphic to project The Trunk: http://source.squeak.org/trunk/Morphic-mt.1402.mcz ==================== Summary ==================== Name: Morphic-mt.1402 Author: mt Time: 28 March 2018, 4:10:37.386604 pm UUID: 2c70c8c0-1a1c-ca40-a286-6fd3527295d4 Ancestors: Morphic-mt.1401 Ask UI theme for border color modifier in scroll panes. =============== Diff against Morphic-mt.1401 =============== Item was changed: ----- Method: ScrollPane>>adoptPaneColor: (in category 'accessing') ----- adoptPaneColor: paneColor super adoptPaneColor: paneColor. "May not be in the hierarchy at the moment." scrollBar adoptPaneColor: paneColor. hScrollBar adoptPaneColor: paneColor. + paneColor ifNotNil: [:pc | self borderColor: ((self userInterfaceTheme borderColorModifier ifNil: [ [:c | c adjustBrightness: -0.3] ]) value: pc)].! - paneColor ifNotNil: [:c | self borderColor: (c adjustBrightness: -0.3)].!

1 0

The Trunk: Kernel-eem.1164.mcz
by commits＠source.squeak.org 27 Mar '18

27 Mar '18

Eliot Miranda uploaded a new version of Kernel to project The Trunk: http://source.squeak.org/trunk/Kernel-eem.1164.mcz ==================== Summary ==================== Name: Kernel-eem.1164 Author: eem Time: 27 March 2018, 11:44:42.020383 am UUID: 1e50cd13-d194-479f-877a-eac64559142b Ancestors: Kernel-cbc.1163 The selector of a method should never be found (unless it occurs as a literal or in a pragma) irrespective of thorough search. =============== Diff against Kernel-cbc.1163 =============== Item was changed: ----- Method: CompiledCode>>refersTo:bytecodeScanner:thorough: (in category 'literals') ----- refersTo: literal bytecodeScanner: scanBlockOrNil thorough: thorough "Answer if the receiver refers to the literal. If the scan block is non-nil, then use it to find the literal in bytecode. If thorough is true, dive down into literal arrays and method properties to locate references to the literal there-in." + 2 to: (self isCompiledBlock + ifTrue: [self numLiterals] "exclude outerCode or methodClass" + ifFalse: [self numLiterals - 1]) "exclude selector/properties and methodClass" - 2 to: ((self isCompiledBlock or: [thorough]) - ifTrue: [self numLiterals] "exclude outerCode or methodClass" - ifFalse: [self numLiterals - 1]) "exclude selector/properties and methodClass" do: [:i| | lit | lit := self objectAt: i. (literal == lit or: [literal literalEqual: lit]) ifTrue: [^true]. "== for Float bindingOf: #NaN since NaN ~= NaN" lit isCompiledCode ifTrue: [(lit refersTo: literal bytecodeScanner: scanBlockOrNil thorough: thorough) ifTrue: [^true]] ifFalse: [thorough ifTrue: [lit isVariableBinding ifTrue: [literal == lit key ifTrue: [^true]] ifFalse: [(lit isArray and: [(lit hasLiteral: literal) or: [literal isVariableBinding and: [literal key isSymbol and: [lit hasLiteral: literal key]]]]) ifTrue: [^true]]]]]. scanBlockOrNil ifNotNil: [(self scanFor: scanBlockOrNil) ifTrue: [^true]]. ^false!

1 0

The Trunk: KernelTests-eem.339.mcz
by commits＠source.squeak.org 27 Mar '18

27 Mar '18

Eliot Miranda uploaded a new version of KernelTests to project The Trunk: http://source.squeak.org/trunk/KernelTests-eem.339.mcz ==================== Summary ==================== Name: KernelTests-eem.339 Author: eem Time: 27 March 2018, 11:42:08.383576 am UUID: 8c45b1d4-42d5-405e-888d-9fc6a5418e2c Ancestors: KernelTests-eem.338 comment that last stipulation =============== Diff against KernelTests-eem.338 =============== Item was changed: ----- Method: LiteralRefLocatorTest>>testThoroughFindLiteralsInBytecode (in category 'tests') ----- testThoroughFindLiteralsInBytecode "Create a method referencing integers, characters, special selectors and nil, true & false. Compile it and check that the objects are found." | literals problem primary secondary | literals := #(-1 0 1 $0 $1 1.0 #[1 2 3 4] 'one' #one nil true false NaN). problem := Float bindingOf: #NaN. primary := CompiledCode classPool at: #PrimaryBytecodeSetEncoderClass. secondary := CompiledCode classPool at: #SecondaryBytecodeSetEncoderClass. { primary. secondary } do: [:encoderClass| | method | #(('' '') ('^[' ']')) do: "And the locators should work whether in a block or not" [:pFixes| "NaN's binding should still be found even though (Float bindingOf: #NaN) ~= (Float bindingOf: #NaN)" method := (Parser new encoderClass: encoderClass; parse: 'foo ', pFixes first, '^NaN', pFixes last class: Float) generate: CompiledMethodTrailer empty. [:literal| self assert: (method refersTo: literal primaryBytecodeScanner: (primary scanBlockOrNilForLiteral: literal) secondaryBytecodeScanner: (secondary scanBlockOrNilForLiteral: literal) thorough: false). self assert: (method refersTo: literal primaryBytecodeScanner: (primary scanBlockOrNilForLiteral: literal) secondaryBytecodeScanner: (secondary scanBlockOrNilForLiteral: literal) thorough: true). + "The selector of a method should never be found (unless it occurs as a literal or in a pragma)" self deny: (method refersTo: method selector primaryBytecodeScanner: (primary scanBlockOrNilForLiteral: literal) secondaryBytecodeScanner: (secondary scanBlockOrNilForLiteral: literal) thorough: false). self deny: (method refersTo: method selector primaryBytecodeScanner: (primary scanBlockOrNilForLiteral: literal) secondaryBytecodeScanner: (secondary scanBlockOrNilForLiteral: literal) thorough: true)] value: problem. "All the literals should be found in a thorough search, but not otherwise" method := (Parser new encoderClass: encoderClass; parse: 'foo ', pFixes first, '^', literals storeString, pFixes last class: Float) generate: CompiledMethodTrailer empty. literals, {problem. problem key} do: [:literal| self deny: (method refersTo: literal primaryBytecodeScanner: (primary scanBlockOrNilForLiteral: literal) secondaryBytecodeScanner: (secondary scanBlockOrNilForLiteral: literal) thorough: false). self assert: (method refersTo: literal primaryBytecodeScanner: (primary scanBlockOrNilForLiteral: literal) secondaryBytecodeScanner: (secondary scanBlockOrNilForLiteral: literal) thorough: true)]]. "Likewise if in a pragma" method := (Parser new encoderClass: encoderClass; parse: 'foo <pragma: ', literals storeString, ' with: ', problem key storeString, '>' class: Float) generate: CompiledMethodTrailer empty. literals, {problem. problem key} do: [:literal| self deny: (method refersTo: literal primaryBytecodeScanner: (primary scanBlockOrNilForLiteral: literal) secondaryBytecodeScanner: (secondary scanBlockOrNilForLiteral: literal) thorough: false). self assert: (method refersTo: literal primaryBytecodeScanner: (primary scanBlockOrNilForLiteral: literal) secondaryBytecodeScanner: (secondary scanBlockOrNilForLiteral: literal) thorough: true)]]!

1 0

The Trunk: KernelTests-eem.338.mcz
by commits＠source.squeak.org 27 Mar '18

27 Mar '18

Eliot Miranda uploaded a new version of KernelTests to project The Trunk: http://source.squeak.org/trunk/KernelTests-eem.338.mcz ==================== Summary ==================== Name: KernelTests-eem.338 Author: eem Time: 27 March 2018, 11:39:37.221317 am UUID: 70d48127-ccfe-4108-9e9e-4db931a396c4 Ancestors: KernelTests-cbc.337 The selector of a method should not be found when looking for literals irrespective of thorough search. Make the LiteralRefLocatorTest reflect this. =============== Diff against KernelTests-cbc.337 =============== Item was changed: ----- Method: LiteralRefLocatorTest>>testThoroughFindLiteralsInBytecode (in category 'tests') ----- testThoroughFindLiteralsInBytecode "Create a method referencing integers, characters, special selectors and nil, true & false. Compile it and check that the objects are found." | literals problem primary secondary | literals := #(-1 0 1 $0 $1 1.0 #[1 2 3 4] 'one' #one nil true false NaN). problem := Float bindingOf: #NaN. primary := CompiledCode classPool at: #PrimaryBytecodeSetEncoderClass. secondary := CompiledCode classPool at: #SecondaryBytecodeSetEncoderClass. { primary. secondary } do: [:encoderClass| | method | #(('' '') ('^[' ']')) do: "And the locators should work whether in a block or not" [:pFixes| "NaN's binding should still be found even though (Float bindingOf: #NaN) ~= (Float bindingOf: #NaN)" method := (Parser new encoderClass: encoderClass; parse: 'foo ', pFixes first, '^NaN', pFixes last class: Float) generate: CompiledMethodTrailer empty. [:literal| self assert: (method refersTo: literal primaryBytecodeScanner: (primary scanBlockOrNilForLiteral: literal) secondaryBytecodeScanner: (secondary scanBlockOrNilForLiteral: literal) thorough: false). self assert: (method refersTo: literal primaryBytecodeScanner: (primary scanBlockOrNilForLiteral: literal) secondaryBytecodeScanner: (secondary scanBlockOrNilForLiteral: literal) + thorough: true). + self deny: (method + refersTo: method selector + primaryBytecodeScanner: (primary scanBlockOrNilForLiteral: literal) + secondaryBytecodeScanner: (secondary scanBlockOrNilForLiteral: literal) + thorough: false). + self deny: (method + refersTo: method selector + primaryBytecodeScanner: (primary scanBlockOrNilForLiteral: literal) + secondaryBytecodeScanner: (secondary scanBlockOrNilForLiteral: literal) thorough: true)] value: problem. "All the literals should be found in a thorough search, but not otherwise" method := (Parser new encoderClass: encoderClass; parse: 'foo ', pFixes first, '^', literals storeString, pFixes last class: Float) generate: CompiledMethodTrailer empty. literals, {problem. problem key} do: [:literal| self deny: (method refersTo: literal primaryBytecodeScanner: (primary scanBlockOrNilForLiteral: literal) secondaryBytecodeScanner: (secondary scanBlockOrNilForLiteral: literal) thorough: false). self assert: (method refersTo: literal primaryBytecodeScanner: (primary scanBlockOrNilForLiteral: literal) secondaryBytecodeScanner: (secondary scanBlockOrNilForLiteral: literal) thorough: true)]]. "Likewise if in a pragma" method := (Parser new encoderClass: encoderClass; parse: 'foo <pragma: ', literals storeString, ' with: ', problem key storeString, '>' class: Float) generate: CompiledMethodTrailer empty. literals, {problem. problem key} do: [:literal| self deny: (method refersTo: literal primaryBytecodeScanner: (primary scanBlockOrNilForLiteral: literal) secondaryBytecodeScanner: (secondary scanBlockOrNilForLiteral: literal) thorough: false). self assert: (method refersTo: literal primaryBytecodeScanner: (primary scanBlockOrNilForLiteral: literal) secondaryBytecodeScanner: (secondary scanBlockOrNilForLiteral: literal) thorough: true)]]!

1 0

The Trunk: Morphic-mt.1401.mcz
by commits＠source.squeak.org 27 Mar '18

27 Mar '18

Marcel Taeumel uploaded a new version of Morphic to project The Trunk: http://source.squeak.org/trunk/Morphic-mt.1401.mcz ==================== Summary ==================== Name: Morphic-mt.1401 Author: mt Time: 27 March 2018, 4:50:25.366732 pm UUID: 7db07362-382c-c94c-b78b-0c4181f5e2e6 Ancestors: Morphic-eem.1400 Fixes two regressions regarding Morphic halo invocation and event handling: 1) do not make halo-invoked morphs come to front, 2) support regular event dispatch while a halo is visible. Note that I realized that we needed another kind of event dispatch for focused morphs. I called it "all-over dispatch" in addition to "full dispatch". If the full event dispatch around the focused morph was not successful, try regular dispatch to give, for example, sibling morphs a chance. The focused morph, however, will be locked during that attempt to not (unsuccessfully) handle the event again. Now, the global halo morph is an example for the use of this all-over dispatch. Maybe you can think of a better name for it. Let me know. =============== Diff against Morphic-eem.1400 =============== Item was added: + ----- Method: MorphicEventDispatcher>>dispatchFocusEventAllOver:with: (in category 'focus events') ----- + dispatchFocusEventAllOver: evt with: focusMorph + "Like a full event dispatch BUT adds regular dispatch if the focus morph did nothing with the event. This is useful for letting the focusMorph's siblings handle the events instead. Take halo invocation as an example. See senders of me." + + | result hand mouseFocus | + result := self dispatchFocusEventFully: evt with: focusMorph. + + result == #rejected ifTrue: [^ result]. + result wasIgnored ifTrue: [^ result]. + result wasHandled ifTrue: [^ result]. + + hand := evt hand. + mouseFocus := hand mouseFocus. + + [ + "Avoid re-dispatching the event to the focus morph. See Morph >> #rejectsEvent:." + focusMorph lock. + + "Handle side effect for mouse-enter and mouse-leave events." + self flag: #hacky. "mt: Maybe we find a better way to synthesize enter/leave events in the future." + hand newMouseFocus: nil. + hand mouseOverHandler processMouseOver: hand lastEvent. + + "Give the morph's world a chance to normally dispatch the event." + ^ focusMorph world processEvent: evt using: self + ] ensure: [ + focusMorph unlock. + evt hand newMouseFocus: mouseFocus].! Item was changed: ----- Method: PasteUpMorph>>tryInvokeHalo: (in category 'events-processing') ----- tryInvokeHalo: anEvent | innerMost target | anEvent hand halo ifNotNil: [^ self "No invocation needed. Halo will handle transfer itself."]. Preferences noviceMode ifTrue: [^ self "No halo in novice mode."]. Preferences cmdGesturesEnabled ifFalse: [^ self]. innerMost := (self morphsAt: anEvent position unlocked: true) first. "1) Try to use innermost morph but skip all the ones that do not want to show a halo along the owner chain." target := innerMost. [target isNil or: [target wantsHaloFromClick]] whileFalse: [target := target owner]. target ifNil: [^ self]. "2) Without a modifier, which is normal, find the outermost container for that inner morph." (innerMost == self or: [anEvent shiftPressed]) ifFalse: [ | previousTargets | previousTargets := OrderedCollection new. [target notNil and: [target owner ~~ self]] whileTrue: [ previousTargets add: target. target := target owner]. target ifNil: [^ self]. [previousTargets isEmpty or: [target wantsHaloFromClick]] whileFalse: [ target := previousTargets removeLast]. target wantsHaloFromClick ifFalse: [^ self]]. + + "3) Now that we have the target, show the halo. Abort event dispatching, too, to avoid confusion." - - "3) Show the container of that nested structure, which is usually my direct submorph." - target withAllOwnersDo: [:ea | ea owner == self ifTrue: [ea comeToFront]]. - - "4) Now that we have the target, show the halo. Abort event dispatching, too, to avoid confusion." anEvent hand newMouseFocus: target event: anEvent. target invokeHaloOrMove: anEvent. anEvent ignore.! Item was changed: ----- Method: SimpleHaloMorph>>processFocusEvent:using: (in category 'events') ----- processFocusEvent: evt using: dispatcher + ^ dispatcher dispatchFocusEventAllOver: evt with: self! - ^ dispatcher dispatchFocusEventFully: evt with: self!

1 0

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

2005

Packages March 2018