Function: x-dnd-handle-motif
x-dnd-handle-motif is a byte-compiled function defined in x-dnd.el.gz.
Signature
(x-dnd-handle-motif EVENT FRAME WINDOW MESSAGE-ATOM FORMAT DATA)
Source Code
;; Defined in /usr/src/emacs/lisp/x-dnd.el.gz
(defun x-dnd-handle-motif (event frame window _message-atom _format data)
(let* ((message-type (cdr (assoc (logand (aref data 0) #x3f)
x-dnd-motif-message-types)))
(initiator-p (eq (ash (aref data 0) -7) 0))
(source-byteorder (aref data 1))
(my-byteorder (byteorder))
(source-flags (x-dnd-get-motif-value data 2 2 source-byteorder))
(source-action (cdr (assoc (logand ?\xF source-flags)
x-dnd-motif-to-action))))
(when initiator-p
(cond ((eq message-type 'XmTOP_LEVEL_ENTER)
(let* ((dnd-source (x-dnd-get-motif-value
data 8 4 source-byteorder))
(selection-atom (x-dnd-get-motif-value
data 12 4 source-byteorder))
(atom-name (x-get-atom-name selection-atom))
(types (x-dnd-xm-read-targets frame dnd-source
atom-name)))
(x-dnd-forget-drop frame)
(when types (x-dnd-save-state window nil nil
types dnd-source))))
;; Can not forget drop here, LEAVE comes before DROP_START and
;; we need the state in DROP_START.
((eq message-type 'XmTOP_LEVEL_LEAVE)
nil)
((eq message-type 'XmDRAG_MOTION)
(let* ((state (x-dnd-get-state-for-frame frame))
(timestamp (x-dnd-motif-value-to-list
(x-dnd-get-motif-value data 4 4
source-byteorder)
4 my-byteorder))
(x (x-dnd-motif-value-to-list
(x-dnd-get-motif-value data 8 2 source-byteorder)
2 my-byteorder))
(y (x-dnd-motif-value-to-list
(x-dnd-get-motif-value data 10 2 source-byteorder)
2 my-byteorder))
(dnd-source (aref state 6))
(first-move (not (aref state 3)))
(action-type (x-dnd-maybe-call-test-function
window
source-action))
(reply-action (car (rassoc (car action-type)
x-dnd-motif-to-action)))
(reply-flags
(if (posn-area (event-start event))
(x-dnd-motif-value-to-list ?\x20 ; 20: invalid drop site
2 my-byteorder)
(x-dnd-motif-value-to-list
(if reply-action
(+ reply-action
?\x30 ; 30: valid drop site
?\x700) ; 700: can do copy, move or link
?\x30) ; 30: drop site, but noop.
2 my-byteorder)))
(reply (append
(list
(+ ?\x80 ; 0x80 indicates a reply.
(if first-move
3 ; First time, reply is SITE_ENTER.
2)) ; Not first time, reply is DRAG_MOTION.
my-byteorder)
reply-flags
timestamp
x
y)))
(x-display-set-last-user-time timestamp)
(x-send-client-message frame
dnd-source
frame
"_MOTIF_DRAG_AND_DROP_MESSAGE"
8
reply)
(dnd-handle-movement (event-start event))))
((eq message-type 'XmOPERATION_CHANGED)
(let* ((state (x-dnd-get-state-for-frame frame))
(timestamp (x-dnd-motif-value-to-list
(x-dnd-get-motif-value data 4 4 source-byteorder)
4 my-byteorder))
(dnd-source (aref state 6))
(action-type (x-dnd-maybe-call-test-function
window
source-action))
(reply-action (car (rassoc (car action-type)
x-dnd-motif-to-action)))
(reply-flags
(if (posn-area (event-start event))
(x-dnd-motif-value-to-list ?\x20 ; 20: invalid drop site
2 my-byteorder)
(x-dnd-motif-value-to-list
(if reply-action
(+ reply-action
?\x30 ; 30: valid drop site
?\x700) ; 700: can do copy, move or link
?\x30) ; 30: drop site, but noop.
2 my-byteorder)))
(reply (append
(list
(+ ?\x80 ; 0x80 indicates a reply.
8) ; 8 is OPERATION_CHANGED
my-byteorder)
reply-flags
timestamp)))
(x-display-set-last-user-time timestamp)
(x-send-client-message frame
dnd-source
frame
"_MOTIF_DRAG_AND_DROP_MESSAGE"
8
reply)))
((eq message-type 'XmDROP_START)
(when (windowp window)
(select-window window))
(let* ((x (x-dnd-motif-value-to-list
(x-dnd-get-motif-value data 8 2 source-byteorder)
2 my-byteorder))
(y (x-dnd-motif-value-to-list
(x-dnd-get-motif-value data 10 2 source-byteorder)
2 my-byteorder))
(selection-atom (x-dnd-get-motif-value
data 12 4 source-byteorder))
(atom-name (x-get-atom-name selection-atom))
(dnd-source (x-dnd-get-motif-value
data 16 4 source-byteorder)))
;; This might be a drop from a program that doesn't use
;; the Motif drag protocol. Compute all the necessary
;; state here if that is true.
(unless (and (x-dnd-get-state-for-frame frame)
(aref (x-dnd-get-state-for-frame frame) 2))
(x-dnd-forget-drop frame)
(let ((types (x-dnd-xm-read-targets frame dnd-source
atom-name)))
(x-dnd-save-state window nil nil types dnd-source)))
(let* ((action-type (x-dnd-maybe-call-test-function
window
source-action))
(reply-action (and (not (posn-area (event-start event)))
(car (rassoc (car action-type)
x-dnd-motif-to-action))))
(reply-flags
(x-dnd-motif-value-to-list
(if (posn-area (event-start event))
(+ ?\x20 ; 20: invalid drop site
?\x200) ; 200: drop cancel
(if reply-action
(+ reply-action
?\x30 ; 30: valid drop site
?\x700) ; 700: can do copy, move or link
(+ ?\x30 ; 30: drop site, but noop.
?\x200))) ; 200: drop cancel.
2 my-byteorder))
(reply (append
(list
(+ ?\x80 ; 0x80 indicates a reply.
5) ; DROP_START.
my-byteorder)
reply-flags
x y))
(timestamp (x-dnd-get-motif-value
data 4 4 source-byteorder))
action)
(x-display-set-last-user-time timestamp)
(x-send-client-message frame
dnd-source
frame
"_MOTIF_DRAG_AND_DROP_MESSAGE"
8
reply)
(unwind-protect
(setq action
(when (and reply-action atom-name)
(let* ((value (x-get-selection-internal
(intern atom-name)
(intern (x-dnd-current-type window))
timestamp)))
(when value
(condition-case info
(x-dnd-drop-data event frame window value
(x-dnd-current-type window))
(error
(message "Error: %s" info)
nil))))))
(x-get-selection-internal
(intern atom-name)
(if action 'XmTRANSFER_SUCCESS 'XmTRANSFER_FAILURE)
timestamp)
(x-dnd-forget-drop frame)))))
(t (message "Unknown Motif drag-and-drop message: %s"
(logand (aref data 0) #x3f)))))))