Function: x-dnd-handle-xdnd
x-dnd-handle-xdnd is a byte-compiled function defined in x-dnd.el.gz.
Signature
(x-dnd-handle-xdnd EVENT FRAME WINDOW MESSAGE FORMAT DATA)
Documentation
Receive one XDND event (client message) and send the appropriate reply.
EVENT is the client message. FRAME is where the mouse is now. WINDOW is the window within FRAME where the mouse is now. DATA is the vector containing the data of the client message as a vector of cardinals. MESSAGE is the type of the ClientMessage that was sent.
Source Code
;; Defined in /usr/src/emacs/lisp/x-dnd.el.gz
(defun x-dnd-handle-xdnd (event frame window message _format data)
"Receive one XDND event (client message) and send the appropriate reply.
EVENT is the client message. FRAME is where the mouse is now.
WINDOW is the window within FRAME where the mouse is now.
DATA is the vector containing the data of the client message as a
vector of cardinals.
MESSAGE is the type of the ClientMessage that was sent."
(cond ((equal "XdndEnter" message)
(let* ((flags (aref data 1))
(version (x-dnd-version-from-flags flags))
(more-than-3 (x-dnd-more-than-3-from-flags flags))
(dnd-source (aref data 0)))
(when version ;; If flags is bad, version will be nil.
(x-dnd-save-state
window nil nil
(if (> more-than-3 0)
(x-window-property "XdndTypeList"
frame "AnyPropertyType"
dnd-source nil t)
(vector (x-get-atom-name (aref data 2))
(x-get-atom-name (aref data 3))
(x-get-atom-name (aref data 4))))
version))))
((equal "XdndPosition" message)
;; If (flags >> 10) & 1, then Emacs should scroll according
;; to the button passed in bits 8 and 9, and the state passed
;; in bits 0 to 7.
(let ((state (x-dnd-get-state-for-frame window)))
(when (windowp (posn-window (event-start event)))
(let ((flags (aref data 1))
(version (aref state 6)))
(when (not (zerop (logand (ash flags -10) 1)))
(let* ((button (+ 4 (logand (ash flags -8) #x3)))
(count (or (and (>= version 1)
(x-dnd-note-click button
(aref data 3)))
1))
(state (logand flags #xff)))
(with-selected-window (posn-window (event-start event))
(x-dnd-mwheel-scroll button count state)
(let ((old-x-y (posn-x-y (event-start event))))
(setcar (cdr event)
(posn-at-x-y (max (car old-x-y) 0)
(max (cdr old-x-y) 0)))))))))
(let* ((version (aref state 6))
(action (if (< version 2) 'copy ; `copy' is the default action.
(x-get-atom-name (aref data 4))))
(dnd-source (aref data 0))
(action-type (x-dnd-maybe-call-test-function
window
(cdr (assoc action x-dnd-xdnd-to-action)) t))
(reply-action (car (rassoc
;; Mozilla and some other programs
;; support XDS, but only if we
;; reply with `copy'. We can
;; recognize these broken programs
;; by checking to see if
;; `XdndActionDirectSave' was
;; originally specified.
(if (and (eq (car action-type)
'direct-save)
(not (eq action 'direct-save)))
'copy
(car action-type))
x-dnd-xdnd-to-action)))
(accept ;; 1 = accept, 0 = reject
(if (and reply-action action-type
;; Only allow drops on the text area of a
;; window.
(not (posn-area (event-start event))))
1 0))
(rect (x-dnd-get-drop-rectangle window
(event-start event)))
(list-to-send
(list (string-to-number
(frame-parameter frame 'outer-window-id))
;; 1 = accept, 0 = reject. 2 = "want position
;; updates even for movement inside the given
;; widget bounds".
accept
(cons (car rect) (cadr rect))
(cons (nth 2 rect) (nth 3 rect))
;; The no-toolkit Emacs build can actually
;; receive drops from programs that speak
;; versions of XDND earlier than 3 (such as
;; GNUstep), since the toplevel window is the
;; innermost window.
(if (>= version 2)
(or reply-action 0)
0))))
(x-send-client-message
frame dnd-source frame "XdndStatus" 32 list-to-send)
(dnd-handle-movement (event-start event)))))
((equal "XdndLeave" message)
(x-dnd-forget-drop window))
((equal "XdndDrop" message)
(if (windowp window) (select-window window))
(let* ((state (x-dnd-get-state-for-frame frame))
(version (aref state 6))
(dnd-source (aref data 0))
(timestamp (aref data 2))
(current-action (aref state 5))
(current-type (aref state 4))
success action value)
(x-display-set-last-user-time timestamp)
(if (and (eq current-action 'direct-save)
(equal current-type "XdndDirectSave0"))
(x-dnd-handle-xds-drop event window dnd-source version)
(setq value (and (x-dnd-current-type window)
(x-get-selection-internal
'XdndSelection
(intern (x-dnd-current-type window))
timestamp)))
(unwind-protect
(setq action (if value
(condition-case info
(x-dnd-drop-data
event frame window value
(x-dnd-current-type window))
(error
(message "Error: %s" info)
nil))))
(setq success (if action 1 0))
(when (>= version 2)
(x-send-client-message
frame dnd-source frame "XdndFinished" 32
(list (string-to-number
(frame-parameter frame 'outer-window-id))
(if (>= version 5) success 0) ;; 1 = Success, 0 = Error
(if (or (not action) (< version 5)) 0
(or (car (rassoc action
x-dnd-xdnd-to-action))
0)))))
(x-dnd-forget-drop window)))))
(t (error "Unknown XDND message %s %s" message data))))