-;;; x-dnd.el --- drag and drop support for X.
+;;; x-dnd.el --- drag and drop support for X
-;; Copyright (C) 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
+;; Copyright (C) 2004-2016 Free Software Foundation, Inc.
-;; Author: Jan Dj\e,Ad\e(Brv <jan.h.d@swipnet.se>
-;; Maintainer: FSF
+;; Author: Jan Djรคrv <jan.h.d@swipnet.se>
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: window, drag, drop
+;; Package: emacs
;; This file is part of GNU Emacs.
;;; Customizable variables
(defcustom x-dnd-test-function 'x-dnd-default-test-function
"The function drag and drop uses to determine if to accept or reject a drop.
-The function takes three arguments, WINDOW ACTION and TYPES.
+The function takes three arguments, WINDOW, ACTION and TYPES.
WINDOW is where the mouse is when the function is called. WINDOW may be a
frame if the mouse isn't over a real window (i.e. menu bar, tool bar or
scroll bar). ACTION is the suggested action from the drag and drop source,
-one of the symbols move, copy link or ask. TYPES is a list of available types
-for the drop.
+one of the symbols move, copy, link or ask. TYPES is a list of available
+types for the drop.
The function shall return nil to reject the drop or a cons with two values,
the wanted action as car and the wanted type as cdr. The wanted action
(defcustom x-dnd-types-alist
- '(
- ("text/uri-list" . x-dnd-handle-uri-list)
- ("text/x-moz-url" . x-dnd-handle-moz-url)
- ("_NETSCAPE_URL" . x-dnd-handle-uri-list)
- ("FILE_NAME" . x-dnd-handle-file-name)
- ("UTF8_STRING" . x-dnd-insert-utf8-text)
- ("text/plain;charset=UTF-8" . x-dnd-insert-utf8-text)
- ("text/plain;charset=utf-8" . x-dnd-insert-utf8-text)
- ("text/unicode" . x-dnd-insert-utf16-text)
- ("text/plain" . dnd-insert-text)
- ("COMPOUND_TEXT" . x-dnd-insert-ctext)
- ("STRING" . dnd-insert-text)
- ("TEXT" . dnd-insert-text)
+ `(
+ (,(purecopy "text/uri-list") . x-dnd-handle-uri-list)
+ (,(purecopy "text/x-moz-url") . x-dnd-handle-moz-url)
+ (,(purecopy "_NETSCAPE_URL") . x-dnd-handle-uri-list)
+ (,(purecopy "FILE_NAME") . x-dnd-handle-file-name)
+ (,(purecopy "UTF8_STRING") . x-dnd-insert-utf8-text)
+ (,(purecopy "text/plain;charset=UTF-8") . x-dnd-insert-utf8-text)
+ (,(purecopy "text/plain;charset=utf-8") . x-dnd-insert-utf8-text)
+ (,(purecopy "text/unicode") . x-dnd-insert-utf16-text)
+ (,(purecopy "text/plain") . dnd-insert-text)
+ (,(purecopy "COMPOUND_TEXT") . x-dnd-insert-ctext)
+ (,(purecopy "STRING") . dnd-insert-text)
+ (,(purecopy "TEXT") . dnd-insert-text)
)
"Which function to call to handle a drop of that type.
If the type for the drop is not present, or the function is nil,
and DATA. WINDOW is where the drop occurred, ACTION is the action for
this drop (copy, move, link, private or ask) as determined by a previous
call to `x-dnd-test-function'. DATA is the drop data.
-The function shall return the action used (copy, move, link or private) if drop
-is successful, nil if not."
+The function shall return the action used (copy, move, link or private)
+if drop is successful, nil if not."
:version "22.1"
:type 'alist
:group 'x)
(defcustom x-dnd-known-types
+ (mapcar 'purecopy
'("text/uri-list"
"text/x-moz-url"
"_NETSCAPE_URL"
"COMPOUND_TEXT"
"STRING"
"TEXT"
- )
+ ))
"The types accepted by default for dropped data.
The types are chosen in the order they appear in the list."
:version "22.1"
(x-dnd-init-motif-for-frame frame)))
(defun x-dnd-get-state-cons-for-frame (frame-or-window)
- "Return the entry in x-dnd-current-state for a frame or window."
+ "Return the entry in `x-dnd-current-state' for a frame or window."
(let* ((frame (if (framep frame-or-window) frame-or-window
(window-frame frame-or-window)))
(display (frame-parameter frame 'display)))
(assoc display x-dnd-current-state)))
(defun x-dnd-get-state-for-frame (frame-or-window)
- "Return the state in x-dnd-current-state for a frame or window."
+ "Return the state in `x-dnd-current-state' for a frame or window."
(cdr (x-dnd-get-state-cons-for-frame frame-or-window)))
-(defun x-dnd-default-test-function (window action types)
+(defun x-dnd-default-test-function (_window _action types)
"The default test function for drag and drop.
-WINDOW is where the mouse is when this function is called. It may be a frame
-if the mouse is over the menu bar, scroll bar or tool bar.
+WINDOW is where the mouse is when this function is called. It may be
+a frame if the mouse is over the menu bar, scroll bar or tool bar.
ACTION is the suggested action from the source, and TYPES are the
types the drop data can have. This function only accepts drops with
types in `x-dnd-known-types'. It always returns the action private."
(let ((buffer (when (window-live-p window)
(window-buffer window)))
(current-state (x-dnd-get-state-for-frame window)))
- (when (or (not (equal buffer (aref current-state 0)))
- (not (equal window (aref current-state 1)))
- (not (equal action (aref current-state 3))))
- (save-excursion
+ (unless (and (equal buffer (aref current-state 0))
+ (equal window (aref current-state 1))
+ (equal action (aref current-state 3)))
+ (save-current-buffer
(when buffer (set-buffer buffer))
(let* ((action-type (funcall x-dnd-test-function
window
(defun x-dnd-handle-moz-url (window action data)
"Handle one item of type text/x-moz-url.
WINDOW is the window where the drop happened. ACTION is ignored.
-DATA is the moz-url, which is formatted as two strings separated by \r\n.
+DATA is the moz-url, which is formatted as two strings separated by \\r\\n.
The first string is the URL, the second string is the title of that URL.
DATA is encoded in utf-16. Decode the URL and call `x-dnd-handle-uri-list'."
- ;; Mozilla and applications based on it (Galeon for example) uses
- ;; text/unicode, but it is impossible to tell if it is le or be. Use what
- ;; the machine Emacs runs on use. This looses if dropping between machines
- ;; with different endian, but it is the best we can do.
+ ;; Mozilla and applications based on it use text/unicode, but it is
+ ;; impossible to tell if it is le or be. Use what the machine Emacs
+ ;; runs on uses. This loses if dropping between machines
+ ;; with different endian-ness, but it is the best we can do.
(let* ((coding (if (eq (byteorder) ?B) 'utf-16be 'utf-16le))
(string (decode-coding-string data coding))
(strings (split-string string "[\r\n]" t))
;; Can one drop more than one moz-url ?? Assume not.
- (url (car strings))
- (title (car (cdr strings))))
+ (url (car strings)))
(x-dnd-handle-uri-list window action url)))
(defun x-dnd-insert-utf8-text (window action text)
(defun x-dnd-handle-uri-list (window action string)
"Split an uri-list into separate URIs and call `dnd-handle-one-url'.
WINDOW is the window where the drop happened.
-STRING is the uri-list as a string. The URIs are separated by \r\n."
+STRING is the uri-list as a string. The URIs are separated by \\r\\n."
(let ((uri-list (split-string string "[\0\r\n]" t))
retval)
(dolist (bf uri-list)
- ;; If one URL is handeled, treat as if the whole drop succeeded.
+ ;; If one URL is handled, treat as if the whole drop succeeded.
(let ((did-action (dnd-handle-one-url window action bf)))
(when did-action (setq retval did-action))))
retval))
WINDOW is the window where the drop happened.
STRING is the file names as a string, separated by nulls."
(let ((uri-list (split-string string "[\0\r\n]" t))
- (coding (and default-enable-multibyte-characters
+ (coding (and (default-value 'enable-multibyte-characters)
(or file-name-coding-system
default-file-name-coding-system)))
retval)
(dolist (bf uri-list)
- ;; If one URL is handeled, treat as if the whole drop succeeded.
+ ;; If one URL is handled, treat as if the whole drop succeeded.
(if coding (setq bf (encode-coding-string bf coding)))
(let* ((file-uri (concat "file://"
(mapconcat 'url-hexify-string
"Choose which type we want to receive for the drop.
TYPES are the types the source of the drop offers, a vector of type names
as strings or symbols. Select among the types in `x-dnd-known-types' or
-KNOWN-TYPES if given, and return that type name.
+KNOWN-TYPES if given, and return that type name.
If no suitable type is found, return nil."
(let* ((known-list (or known-types x-dnd-known-types))
(first-known-type (car known-list))
(defun x-dnd-drop-data (event frame window data type)
"Drop one data item onto a frame.
-EVENT is the client message for the drop, FRAME is the frame the drop occurred
-on. WINDOW is the window of FRAME where the drop happened. DATA is the data
-received from the source, and type is the type for DATA, see
-`x-dnd-types-alist').
+EVENT is the client message for the drop, FRAME is the frame the drop
+occurred on. WINDOW is the window of FRAME where the drop happened.
+DATA is the data received from the source, and type is the type for DATA,
+see `x-dnd-types-alist').
Returns the action used (move, copy, link, private) if drop was successful,
nil if not."
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Old KDE protocol. Only dropping of files.
-(defun x-dnd-handle-old-kde (event frame window message format data)
+(declare-function x-window-property "xfns.c"
+ (prop &optional frame type source delete-p vector-ret-p))
+
+(defun x-dnd-handle-old-kde (_event frame window _message _format _data)
"Open the files in a KDE 1.x drop."
(let ((values (x-window-property "DndSelection" frame nil 0 t)))
(x-dnd-handle-uri-list window 'private
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; XDND protocol.
-(defvar x-dnd-xdnd-to-action
+(defconst x-dnd-xdnd-to-action
'(("XdndActionPrivate" . private)
("XdndActionCopy" . copy)
("XdndActionMove" . move)
("XdndActionAsk" . ask))
"Mapping from XDND action types to lisp symbols.")
+(declare-function x-change-window-property "xfns.c"
+ (prop value &optional frame type format outer-P))
+
(defun x-dnd-init-xdnd-for-frame (frame)
"Set the XdndAware property for FRAME to indicate that we do XDND."
(x-change-window-property "XdndAware"
frame "ATOM" 32 t))
(defun x-dnd-get-drop-width-height (frame w accept)
- "Return the widht/height to be sent in a XDndStatus message.
+ "Return the width/height to be sent in a XDndStatus message.
FRAME is the frame and W is the window where the drop happened.
If ACCEPT is nil return 0 (empty rectangle),
-otherwise if W is a window, return its widht/height,
+otherwise if W is a window, return its width/height,
otherwise return the frame width/height."
(if accept
(if (windowp w) ;; w is not a window if dropping on the menu bar,
"Return the x/y coordinates to be sent in a XDndStatus message.
Coordinates are required to be absolute.
FRAME is the frame and W is the window where the drop happened.
-If W is a window, return its absolute corrdinates,
+If W is a window, return its absolute coordinates,
otherwise return the frame coordinates."
(let* ((frame-left (frame-parameter frame 'left))
;; If the frame is outside the display, frame-left looks like
(+ frame-real-top (nth 1 edges))))
(cons frame-real-left frame-real-top))))
-(declare-function x-get-atom-name "xselect.c")
-(declare-function x-send-client-message "xselect.c")
-
-(defun x-dnd-handle-xdnd (event frame window message format data)
+(declare-function x-get-atom-name "xselect.c" (value &optional frame))
+(declare-function x-send-client-message "xselect.c"
+ (display dest from message-type format values))
+(declare-function x-get-selection-internal "xselect.c"
+ (selection-symbol target-type &optional time-stamp terminal))
+
+(defun x-dnd-version-from-flags (flags)
+ "Return the version byte from the 32 bit FLAGS in an XDndEnter message"
+ (if (consp flags) ;; Long as cons
+ (ash (car flags) -8)
+ (ash flags -24))) ;; Ordinary number
+
+(defun x-dnd-more-than-3-from-flags (flags)
+ "Return the nmore-than3 bit from the 32 bit FLAGS in an XDndEnter message"
+ (if (consp flags)
+ (logand (cdr flags) 1)
+ (logand flags 1)))
+
+(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.
FORMAT is 32 (not used). MESSAGE is the data part of an XClientMessageEvent."
(cond ((equal "XdndEnter" message)
(let* ((flags (aref data 1))
- (version (and (consp flags) (ash (car flags) -8)))
- (more-than-3 (and (consp flags) (cdr flags)))
+ (version (x-dnd-version-from-flags flags))
+ (more-than-3 (x-dnd-more-than-3-from-flags flags))
(dnd-source (aref data 0)))
+ (message "%s %s" version more-than-3)
(if version ;; If flags is bad, version will be nil.
(x-dnd-save-state
window nil nil
(x-get-atom-name (aref data 4))))))))
((equal "XdndPosition" message)
- (let* ((x (car (aref data 2)))
- (y (cdr (aref data 2)))
- (action (x-get-atom-name (aref data 4)))
+ (let* ((action (x-get-atom-name (aref data 4)))
(dnd-source (aref data 0))
- (dnd-time (aref data 3))
(action-type (x-dnd-maybe-call-test-function
window
(cdr (assoc action x-dnd-xdnd-to-action))))
(x-get-selection-internal
'XdndSelection
(intern (x-dnd-current-type window)))))
- success action ret-action)
+ success action)
(setq action (if value
(condition-case info
nil))))
(setq success (if action 1 0))
- (setq ret-action
- (if (eq success 1)
- (or (car (rassoc action x-dnd-xdnd-to-action))
- "XdndActionPrivate")
- 0))
(x-send-client-message
frame dnd-source frame "XdndFinished" 32
;;; Motif protocol.
(defun x-dnd-init-motif-for-frame (frame)
- "Set _MOTIF_DRAG_RECEIVER_INFO for FRAME to indicate that we do Motif DND."
+ "Set _MOTIF_DRAG_RECEIVER_INFO for FRAME to indicate that we do Motif DND."
(x-change-window-property "_MOTIF_DRAG_RECEIVER_INFO"
(list
(byteorder)
(2 . private)) ; Motif does not have private, so use copy for private.
"Mapping from number to operation for Motif DND.")
-(defun x-dnd-handle-motif (event frame window message-atom format data)
+(defun x-dnd-handle-motif (event frame window message-atom _format data)
(let* ((message-type (cdr (assoc (aref data 0) x-dnd-motif-message-types)))
(source-byteorder (aref data 1))
(my-byteorder (byteorder))
(provide 'x-dnd)
-;; arch-tag: b621fb7e-50da-4323-850b-5fc71ae64621
;;; x-dnd.el ends here