Marcel Taeumel uploaded a new version of Morphic to project The Trunk:
http://source.squeak.org/trunk/Morphic-mt.1710.mcz ==================== Summary ==================== Name: Morphic-mt.1710 Author: mt Time: 2 November 2020, 4:37:15.795816 pm UUID: c0f2f967-9599-0d4b-831a-be2df0cb9b1e Ancestors: Morphic-mt.1709 Let file-drag/drop events from the host system arrive as regular (in-image) drag/drop events for a uniform look-and-feel. Thanks to Christoph (ct)! For backwards compatibility, DropFilesEvent stays functional until the package 60Deprecated is unloaded. Users should move away from Morph >> #(handle|wants|.)dropFiles to use #acceptDroppingMorph:event: (etc.) and check #dragTransferType for #filesAndDirectories. Note that, in the long term, this unification (to always use DropEvent) makes sense because it will help extract event handling from Morphic to a more generic, object-oriented, GUI-framework-agnostic mechanism to be used in -- for example -- Morphic, MVC, and SqueakShell. =============== Diff against Morphic-mt.1709 =============== Item was removed: - DropEvent subclass: #DropFilesEvent - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'Morphic-Events'! Item was removed: - ----- Method: DropFilesEvent>>sentTo: (in category 'dispatching') ----- - sentTo: anObject - "Dispatch the receiver into anObject" - self type == #dropFilesEvent ifTrue:[^anObject handleDropFiles: self].! Item was removed: - ----- Method: DropFilesEvent>>type (in category 'accessing') ----- - type - ^#dropFilesEvent! Item was changed: Morph subclass: #HandMorph + instanceVariableNames: 'mouseFocus keyboardFocus eventListeners mouseListeners keyboardListeners eventCaptureFilters mouseCaptureFilters keyboardCaptureFilters mouseClickState mouseOverHandler targetOffset lastMouseEvent damageRecorder cacheCanvas cachedCanvasHasHoles temporaryCursor temporaryCursorOffset hardwareCursor hasChanged savedPatch userInitials lastEventBuffer genieGestureProcessor keyboardInterpreter externalDropMorph' - instanceVariableNames: 'mouseFocus keyboardFocus eventListeners mouseListeners keyboardListeners eventCaptureFilters mouseCaptureFilters keyboardCaptureFilters mouseClickState mouseOverHandler targetOffset lastMouseEvent damageRecorder cacheCanvas cachedCanvasHasHoles temporaryCursor temporaryCursorOffset hardwareCursor hasChanged savedPatch userInitials lastEventBuffer genieGestureProcessor keyboardInterpreter' classVariableNames: 'CompositionWindowManager DoubleClickTime DragThreshold EventStats MinimalWheelDelta NewEventRules NormalCursor PasteBuffer SendMouseWheelToKeyboardFocus ShowEvents SynthesizeMouseWheelEvents' poolDictionaries: 'EventSensorConstants' category: 'Morphic-Kernel'! !HandMorph commentStamp: '<historical>' prior: 0! The cursor may be thought of as the HandMorph. The hand's submorphs hold anything being carried by dragging. There is some minimal support for multiple hands in the same world.! Item was added: + ----- Method: HandMorph>>cleanUp: (in category 'initialize-release') ----- + cleanUp: aggressive + + aggressive ifTrue: [ + externalDropMorph := nil].! Item was added: + ----- Method: HandMorph>>collectDropFilesAndDirectories: (in category 'private events') ----- + collectDropFilesAndDirectories: numFiles + + ^ (1 to: numFiles) collect: [:index | + (FileDirectory requestDropDirectory: index) + ifNil: [FileStream requestDropStream: index]]! Item was changed: ----- Method: HandMorph>>dropMorph:event: (in category 'grabbing/dropping') ----- dropMorph: aMorph event: anEvent "Drop the given morph which was carried by the hand" | event dropped | + (anEvent isMouseUp and: [aMorph shouldDropOnMouseUp not]) ifTrue: [^ self]. - (anEvent isMouseUp and:[aMorph shouldDropOnMouseUp not]) ifTrue:[^self]. + "Note: For robustness in drag and drop handling, we remove the morph BEFORE we drop it, but we keep its owner set to the hand. This prevents system lockups when there is a problem in drop handling (for example if there's an error in #wantsToBeDroppedInto:). THIS TECHNIQUE IS NOT RECOMMENDED FOR CASUAL USE." - "Note: For robustness in drag and drop handling we remove the morph BEFORE we drop him, but we keep his owner set to the hand. This prevents system lockups when there is a problem in drop handling (for example if there's an error in #wantsToBeDroppedInto:). THIS TECHNIQUE IS NOT RECOMMENDED FOR CASUAL USE." self privateRemove: aMorph. aMorph privateOwner: self. + - dropped := aMorph. (dropped hasProperty: #addedFlexAtGrab) + ifTrue: [dropped := aMorph removeFlexShell]. - ifTrue:[dropped := aMorph removeFlexShell]. event := DropEvent new setPosition: self position contents: dropped hand: self. [ "In case of an error, ensure that the morph-to-be-dropped will be disposed. Otherwise it may confuse garbage handler. See the sends of #privateRemove: and #privateOwner: above." event := self sendEvent: event focus: nil. "event filters can apply and filtered events will be returned" event wasHandled ifFalse: [aMorph rejectDropMorphEvent: event] ] ensure: [ aMorph owner == self ifTrue: [aMorph delete] ]. self mouseOverHandler processMouseOver: anEvent.! Item was changed: ----- Method: HandMorph>>generateDropFilesEvent: (in category 'private events') ----- generateDropFilesEvent: evtBuf + "Generate the appropriate mouse event for the given raw event buffer." - "Generate the appropriate mouse event for the given raw event buffer" - "Note: This is still in an experimental phase and will need more work" - | position buttons modifiers stamp numFiles dragType | stamp := evtBuf second. + stamp = 0 ifTrue: [stamp := Time eventMillisecondClock]. - stamp = 0 ifTrue: [stamp := Sensor eventTimeNow]. dragType := evtBuf third. position := evtBuf fourth @ evtBuf fifth. + buttons := MouseEvent redButton. "hacked because necessary for correct mouseMoveDragging handling" - buttons := 0. modifiers := evtBuf sixth. buttons := buttons bitOr: (modifiers bitShift: 3). numFiles := evtBuf seventh. + + dragType caseOf: { + [1] -> [ "dragEnter" + externalDropMorph := TransferMorph new + dragTransferType: #filesAndDirectories; + source: self; + passenger: (numFiles = 0 "Usually, numFiles and drop paths are delivered on dragDrop only. Still reserving this possibility for able host implementations." + ifTrue: [self flag: #vmCapabilityMissing. 'Unknown host content' translated] + ifFalse: [self collectDropFilesAndDirectories: numFiles]); + yourself. + + "During the drag operation, the host system is responsible for displaying the cursor." + self grabMorph: externalDropMorph. + self showTemporaryCursor: Cursor blank. + externalDropMorph bottomRight: self topLeft. "Southeast area of the cursor is blocked by drawings from the source application. Display our drop morph at the opposite corner of the cursor." ]. + [2] -> [ "dragMove" + ^ MouseMoveEvent new + setType: #mouseMove + startPoint: self position + endPoint: position + trail: "{self position. position}"(self mouseDragTrailFrom: evtBuf) + buttons: buttons + hand: self + stamp: stamp ]. + [3] -> [ "dragLeave" + externalDropMorph ifNotNil: #abandon. + externalDropMorph := nil. + self showTemporaryCursor: nil ]. + [4] -> [ "dragDrop" + | oldButtons | + externalDropMorph ifNil: [ + "dragDrop has been sent without prior dragging. This happens when the VM is configured as singleton application and has been called again (aka #launchDrop)." + ^ self error: 'Launch drop for singleton Squeak not yet implemented.']. + + self showTemporaryCursor: nil. + externalDropMorph passenger isString ifTrue: [ + self flag: #vmCapabilityMissing. "See above." + externalDropMorph passenger: (self collectDropFilesAndDirectories: numFiles)]. + externalDropMorph := nil. + + (Smalltalk classNamed: #DropFilesEvent) ifNotNil: [:eventClass | + | classicEvent | + "Generate classic DropFilesEvent, providing backward compatibility." + classicEvent := eventClass new + setPosition: position + contents: numFiles + hand: self. + self processEvent: classicEvent. + classicEvent wasHandled ifTrue: [^ nil]]. + + oldButtons := lastEventBuffer fifth + bitOr: (lastEventBuffer sixth bitShift: 3). + ^ MouseButtonEvent new + setType: #mouseUp + position: position + which: (oldButtons bitXor: buttons) + buttons: buttons + nClicks: 0 + hand: self + stamp: stamp ]. + [5] -> [ "drag request" + "For dnd out. Not properly implemented at the moment." + self shouldBeImplemented] }. + ^ nil! - dragType = 4 - ifTrue: - ["e.g., drop" - - owner borderWidth: 0. - ^DropFilesEvent new - setPosition: position - contents: numFiles - hand: self]. - "the others are currently not handled by morphs themselves" - dragType = 1 - ifTrue: - ["experimental drag enter" - - owner - borderWidth: 4; - borderColor: owner color asColor negated]. - dragType = 2 - ifTrue: - ["experimental drag move" - - ]. - dragType = 3 - ifTrue: - ["experimental drag leave" - - owner borderWidth: 0]. - ^nil! Item was changed: ----- Method: HandMorph>>logEvent: (in category 'events-debugging') ----- logEvent: anEvent "Update statistics for processed events." + EventStats ifNil: [EventStats := IdentityDictionary new]. + EventStats at: #count put: (EventStats at: #count ifAbsent: [0]) + 1. + EventStats at: anEvent type put: (EventStats at: anEvent type ifAbsent: [0]) + 1.! - EventStats ifNil:[EventStats := IdentityDictionary new]. - EventStats at: #count put: (EventStats at: #count ifAbsent:[0]) + 1. - EventStats at: anEvent type put: (EventStats at: anEvent type ifAbsent:[0]) + 1.! Item was added: + ----- Method: HandMorph>>mouseDragTrailFrom: (in category 'private events') ----- + mouseDragTrailFrom: currentBuf + "Current event, a dragMove event buffer, is about to be processed. If there are other similar dragMove events queued up, then drop them from the queue, and report the positions inbetween. Adapted version of #mouseTrailFrom:." + + | nextEvent trail | + trail := WriteStream on: (Array new: 1). + trail nextPut: currentBuf fourth @ currentBuf fifth. + [(nextEvent := Sensor peekEvent) isNil] whileFalse: [ + nextEvent first = currentBuf first + ifFalse: [^ trail contents "different event type"]. + nextEvent third = currentBuf third + ifFalse: [^ trail contents "dragType changed"]. + nextEvent sixth = currentBuf sixth + ifFalse: [^ trail contents "modifiers changed"]. + nextEvent seventh = currentBuf seventh + ifFalse: [^ trail contents "numFiles changed"]. + "nextEvent is similar. Remove it from the queue, and check the next." + nextEvent := Sensor nextEvent. + trail nextPut: nextEvent fourth @ nextEvent fifth]. + ^ trail contents! Item was changed: ----- Method: HandMorph>>processEvents (in category 'event handling') ----- processEvents "Process user input events from the local input devices." + | evtBuf hadAny | - | evt evtBuf type hadAny | self currentEvent ~= lastMouseEvent ifTrue: [ "Meaning that we were invoked from within an event response. Make sure z-order is up to date." self mouseOverHandler processMouseOver: lastMouseEvent]. hadAny := false. + [(evtBuf := Sensor nextEvent) isNil] whileFalse: [ + | evt | + evt := evtBuf first "type" + caseOf: { + [EventTypeMouse] -> [self generateMouseEvent: evtBuf]. + [EventTypeMouseWheel] -> [self generateMouseWheelEvent: evtBuf]. + [EventTypeKeyboard] -> [self generateKeyboardEvent: evtBuf]. + [EventTypeDragDropFiles] -> [self generateDropFilesEvent: evtBuf]. + [EventTypeWindow] -> [self generateWindowEvent: evtBuf] } + otherwise: [nil "All other events are ignored"]. + + evt ifNotNil: [ + "Finally, handle it" + self handleEvent: evt. + hadAny := true. + + "For better user feedback, return immediately after a mouse event has been processed." + evt isMouse ifTrue: [^ self] ] ]. - [(evtBuf := Sensor nextEvent) isNil] whileFalse: - [evt := nil. "for unknown event types" - type := evtBuf first. - type = EventTypeMouse - ifTrue: [evt := self generateMouseEvent: evtBuf]. - type = EventTypeMouseWheel - ifTrue: [evt := self generateMouseWheelEvent: evtBuf]. - type = EventTypeKeyboard - ifTrue: [evt := self generateKeyboardEvent: evtBuf]. - type = EventTypeDragDropFiles - ifTrue: [evt := self generateDropFilesEvent: evtBuf]. - type = EventTypeWindow - ifTrue:[evt := self generateWindowEvent: evtBuf]. - "All other events are ignored" - (type ~= EventTypeDragDropFiles and: [evt isNil]) ifTrue: [^self]. - evt ifNotNil: ["Finally, handle it." - self handleEvent: evt. - hadAny := true. - - "For better user feedback, return immediately after a mouse event has been processed." - evt isMouse ifTrue: [^ self]]]. "note: if we come here we didn't have any mouse events" mouseClickState ifNotNil: [ "No mouse events during this cycle. Make sure click states time out accordingly" mouseClickState handleEvent: lastMouseEvent asMouseMove from: self]. hadAny ifFalse: [ "No pending events. Make sure z-order is up to date" self mouseOverHandler processMouseOver: lastMouseEvent].! Item was removed: - ----- Method: Morph>>asDraggableMorph (in category 'converting') ----- - asDraggableMorph - "Huge or complex morphs have a serious impact on performance while being dragged. Use the thumbnail version." - - ^ self thumbnail asMorph! Item was removed: - ----- Method: Morph>>dropFiles: (in category 'event handling') ----- - dropFiles: anEvent - "Handle a number of files dropped from the OS" - ! Item was removed: - ----- Method: Morph>>handleDropFiles: (in category 'events-processing') ----- - handleDropFiles: anEvent - "Handle a drop from the OS." - anEvent wasHandled ifTrue:[^self]. "not interested" - (self wantsDropFiles: anEvent) ifFalse:[^self]. - anEvent wasHandled: true. - self dropFiles: anEvent. - ! Item was removed: - ----- Method: Morph>>wantsDropFiles: (in category 'event handling') ----- - wantsDropFiles: anEvent - "Return true if the receiver wants files dropped from the OS." - ^false! Item was removed: - ----- Method: Object>>asDraggableMorph (in category '*morphic') ----- - asDraggableMorph - "Converts the receiver into a Morph suitable for dragging" - ^(StringMorph contents: ( - (self respondsTo: #dragLabel) - ifTrue:[self dragLabel] - ifFalse:[self printString])) - color: ((self userInterfaceTheme get: #textColor for: #TransferMorph) ifNil: [Color black]); - font: ((self userInterfaceTheme get: #font for: #TransferMorph) ifNil: [TextStyle defaultFont]) - yourself! Item was changed: ----- Method: PasteUpMorph>>acceptDroppingMorph:event: (in category 'dropping/grabbing') ----- acceptDroppingMorph: dropped event: evt "The supplied morph, known to be acceptable to the receiver, is now to be assimilated; the precipitating event is supplied" | aMorph | + (self isWorldMorph and: + [dropped isTransferMorph and: + [dropped dragTransferType = #filesAndDirectories]]) ifTrue: + [^ self dropFiles: dropped passenger event: evt]. + aMorph := self morphToDropFrom: dropped. self isWorldMorph + ifFalse: [super acceptDroppingMorph: aMorph event: evt] + ifTrue: + ["Add the given morph to this world and start stepping it if it wants to be." + aMorph isInWorld ifFalse: [aMorph position: evt position]. + self addMorphFront: aMorph. + (aMorph fullBounds intersects: self viewBox) ifFalse: + [Beeper beep. + aMorph position: self bounds center]]. + - ifTrue:["Add the given morph to this world and start stepping it if it wants to be." - aMorph isInWorld not ifTrue: [aMorph position: evt position]. - self addMorphFront: aMorph. - (aMorph fullBounds intersects: self viewBox) ifFalse: - [Beeper beep. aMorph position: self bounds center]] - ifFalse:[super acceptDroppingMorph: aMorph event: evt]. - aMorph submorphsDo: [:m | (m isKindOf: HaloMorph) ifTrue: [m delete]]. aMorph allMorphsDo: "Establish any penDown morphs in new world" [:m | | tfm mm | m player ifNotNil: [m player getPenDown ifTrue: [((mm := m player costume) notNil and: [(tfm := mm owner transformFrom: self) notNil]) ifTrue: [self noteNewLocation: (tfm localPointToGlobal: mm referencePosition) forPlayer: m player]]]]. + - self isPartsBin ifTrue: [aMorph isPartsDonor: true. aMorph stopSteppingSelfAndSubmorphs. aMorph suspendEventHandler] ifFalse: [self world startSteppingSubmorphsOf: aMorph]. + - " self presenter morph: aMorph droppedIntoPasteUpMorph: self." self griddingOn ifTrue: [aMorph position: (self gridPoint: aMorph position)]. self showingListView ifTrue: [self sortSubmorphsBy: (self valueOfProperty: #sortOrder). self currentWorld abandonAllHalos]. + + self bringTopmostsToFront.! - - self bringTopmostsToFront. - ! Item was removed: - ----- Method: PasteUpMorph>>dropFiles: (in category 'event handling') ----- - dropFiles: anEvent - "Handle a number of dropped files from the OS. - TODO: - - use a more general mechanism for figuring out what to do with the file (perhaps even offering a choice from a menu) - - remember the resource location or (when in browser) even the actual file handle - " - | numFiles | - numFiles := anEvent contents. - 1 to: numFiles do: [ :i | - (FileDirectory requestDropDirectory: i) - ifNotNil: [:directory | self handleDroppedItem: directory event: anEvent] - ifNil: [(FileStream requestDropStream: i) ifNotNil: [:stream | - [self handleDroppedItem: stream event: anEvent] ensure: [stream close]]]]. - ! Item was added: + ----- Method: PasteUpMorph>>dropFiles:event: (in category 'event handling') ----- + dropFiles: filesAndDirectories event: anEvent + "Handle a number of dropped files from the OS." + + filesAndDirectories do: [ :file | + self handleDroppedItem: file event: anEvent].! Item was changed: ----- Method: PasteUpMorph>>morphToDropFrom: (in category 'dropping/grabbing') ----- morphToDropFrom: aMorph + "Given a morph being carried by the hand which the hand is about to drop, answer the actual morph to be deposited. Normally this would be just the morph itself, but several unusual cases arise, which this method is designed to service." - "Given a morph being carried by the hand, which the hand is about to drop, answer the actual morph to be deposited. Normally this would be just the morph itself, but several unusual cases arise, which this method is designed to service." | aNail representee handy posBlock | handy := self primaryHand. posBlock := [:z | | tempPos | tempPos := handy position - ((handy targetOffset - aMorph formerPosition) * (z extent / aMorph extent)) rounded. self pointFromWorld: tempPos]. self alwaysShowThumbnail ifTrue: [aNail := aMorph representativeNoTallerThan: self maxHeightToAvoidThumbnailing norWiderThan: self maximumThumbnailWidth thumbnailHeight: self heightForThumbnails. aNail == aMorph ifFalse: [aMorph formerPosition: aMorph position. aNail position: (posBlock value: aNail)]. ^aNail]. ((aMorph isKindOf: MorphThumbnail) and: [(representee := aMorph morphRepresented) owner isNil]) ifTrue: [representee position: (posBlock value: representee). ^representee]. self showingListView ifTrue: [^aMorph listViewLineForFieldList: (self valueOfProperty: #fieldListSelectors)]. (aMorph hasProperty: #newPermanentScript) ifTrue: [^aMorph asEmptyPermanentScriptor]. ((aMorph isPhraseTileMorph) or: [aMorph isSyntaxMorph]) ifFalse: [^aMorph morphToDropInPasteUp: self]. aMorph userScriptSelector isEmptyOrNil ifTrue: ["non-user" self automaticPhraseExpansion ifFalse: [^aMorph]]. ^aMorph morphToDropInPasteUp: self! Item was removed: - ----- Method: PasteUpMorph>>wantsDropFiles: (in category 'event handling') ----- - wantsDropFiles: anEvent - ^self isWorldMorph! Item was added: + ----- Method: PasteUpMorph>>wantsDroppedTransferMorph: (in category 'dropping/grabbing') ----- + wantsDroppedTransferMorph: transferMorph + + ^ self hasTransferMorphConverter + or: [transferMorph dragTransferType = #filesAndDirectories]! Item was removed: - ----- Method: Text>>asDraggableMorph (in category '*Morphic-converting') ----- - asDraggableMorph - - ^ self copy - addAttribute: (TextFontReference toFont: ((self userInterfaceTheme get: #font for: #TransferMorph) ifNil: [TextStyle defaultFont])); - asMorph! Item was added: + ----- Method: TransferMorph>>createDraggableMorph: (in category 'initialization') ----- + createDraggableMorph: anObject + + (anObject respondsTo: #asDraggableMorph) + ifTrue: [^ anObject asDraggableMorph]. + + anObject isMorph + ifTrue: ["Huge or complex morphs have a serious impact on performance while being dragged. Use the thumbnail version." + ^ anObject thumbnail asMorph]. + + anObject isText + ifTrue: [ + ^ anObject copy + addAttribute: (TextFontReference toFont: (self userInterfaceTheme font ifNil: [TextStyle defaultFont])); + asMorph]. + + ^ ((anObject respondsTo: #dragLabel) ifTrue: [anObject dragLabel] ifFalse: [anObject printString]) asMorph + color: (self userInterfaceTheme textColor ifNil: [Color black]); + font: (self userInterfaceTheme font ifNil: [TextStyle defaultFont]) + yourself + ! Item was changed: ----- Method: TransferMorph>>passenger: (in category 'accessing') ----- passenger: anObject passenger := anObject. self removeAllMorphs; + addMorph: (self createDraggableMorph: passenger); - addMorph: passenger asDraggableMorph; updateCopyIcon; setDefaultParameters.! Item was changed: ----- Method: TransferMorph>>wantsToBeDroppedInto: (in category 'dropping/grabbing') ----- wantsToBeDroppedInto: aMorph + ^ aMorph isWorldMorph + ifTrue: [aMorph wantsDroppedTransferMorph: self] + ifFalse: [super wantsToBeDroppedInto: aMorph]! - ifTrue: [ aMorph hasTransferMorphConverter ] - ifFalse: [ super wantsToBeDroppedInto: aMorph ]! Item was removed: - ----- Method: WorldState class>>cleanUp (in category 'class initialization') ----- - cleanUp - "Reset command histories" - - self allInstances do: [ :ea | ea clearCommandHistory ].! Item was added: + ----- Method: WorldState class>>cleanUp: (in category 'class initialization') ----- + cleanUp: aggressive + + self allInstancesDo: [:worldState | worldState cleanUp: aggressive].! Item was added: + ----- Method: WorldState>>cleanUp: (in category 'initialization') ----- + cleanUp: aggressive + + self clearCommandHistory. + self handsDo: [:hand | hand cleanUp: aggressive].! |
Free forum by Nabble | Edit this page |