Line data Source code
1 : ;;; dnd.el --- drag and drop support
2 :
3 : ;; Copyright (C) 2005-2017 Free Software Foundation, Inc.
4 :
5 : ;; Author: Jan Djärv <jan.h.d@swipnet.se>
6 : ;; Maintainer: emacs-devel@gnu.org
7 : ;; Keywords: window, drag, drop
8 : ;; Package: emacs
9 :
10 : ;; This file is part of GNU Emacs.
11 :
12 : ;; GNU Emacs is free software: you can redistribute it and/or modify
13 : ;; it under the terms of the GNU General Public License as published by
14 : ;; the Free Software Foundation, either version 3 of the License, or
15 : ;; (at your option) any later version.
16 :
17 : ;; GNU Emacs is distributed in the hope that it will be useful,
18 : ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
19 : ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
20 : ;; GNU General Public License for more details.
21 :
22 : ;; You should have received a copy of the GNU General Public License
23 : ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
24 :
25 : ;;; Commentary:
26 :
27 : ;; This file provides the generic handling of the drop part only.
28 : ;; Different DND backends (X11, W32, etc.) that handle the platform
29 : ;; specific DND parts call the functions here to do final delivery of
30 : ;; a drop.
31 :
32 : ;;; Code:
33 :
34 : ;;; Customizable variables
35 :
36 :
37 : ;;;###autoload
38 : (defcustom dnd-protocol-alist
39 : `((,(purecopy "^file:///") . dnd-open-local-file) ; XDND format.
40 : (,(purecopy "^file://") . dnd-open-file) ; URL with host
41 : (,(purecopy "^file:") . dnd-open-local-file) ; Old KDE, Motif, Sun
42 : (,(purecopy "^\\(https?\\|ftp\\|file\\|nfs\\)://") . dnd-open-file)
43 : )
44 :
45 : "The functions to call for different protocols when a drop is made.
46 : This variable is used by `dnd-handle-one-url' and `dnd-handle-file-name'.
47 : The list contains of (REGEXP . FUNCTION) pairs.
48 : The functions shall take two arguments, URL, which is the URL dropped and
49 : ACTION which is the action to be performed for the drop (move, copy, link,
50 : private or ask).
51 : If no match is found here, and the value of `browse-url-browser-function'
52 : is a pair of (REGEXP . FUNCTION), those regexps are tried for a match.
53 : If no match is found, the URL is inserted as text by calling `dnd-insert-text'.
54 : The function shall return the action done (move, copy, link or private)
55 : if some action was made, or nil if the URL is ignored."
56 : :version "22.1"
57 : :type '(repeat (cons (regexp) (function)))
58 : :group 'dnd)
59 :
60 :
61 : (defcustom dnd-open-remote-file-function
62 : (if (eq system-type 'windows-nt)
63 : 'dnd-open-local-file
64 : 'dnd-open-remote-url)
65 : "The function to call when opening a file on a remote machine.
66 : The function will be called with two arguments; URI and ACTION. See
67 : `dnd-open-file' for details.
68 : If nil, then dragging remote files into Emacs will result in an error.
69 : Predefined functions are `dnd-open-local-file' and `dnd-open-remote-url'.
70 : `dnd-open-local-file' attempts to open a remote file using its UNC name and
71 : is the default on MS-Windows. `dnd-open-remote-url' uses `url-handler-mode'
72 : and is the default except for MS-Windows."
73 : :version "22.1"
74 : :type 'function
75 : :group 'dnd)
76 :
77 :
78 : (defcustom dnd-open-file-other-window nil
79 : "If non-nil, always use find-file-other-window to open dropped files."
80 : :version "22.1"
81 : :type 'boolean
82 : :group 'dnd)
83 :
84 :
85 : ;; Functions
86 :
87 : (defun dnd-handle-one-url (window action url)
88 : "Handle one dropped url by calling the appropriate handler.
89 : The handler is first located by looking at `dnd-protocol-alist'.
90 : If no match is found here, and the value of `browse-url-browser-function'
91 : is a pair of (REGEXP . FUNCTION), those regexps are tried for a match.
92 : If no match is found, just call `dnd-insert-text'.
93 : WINDOW is where the drop happened, ACTION is the action for the drop,
94 : URL is what has been dropped.
95 : Returns ACTION."
96 0 : (require 'browse-url)
97 0 : (let (ret)
98 0 : (or
99 0 : (catch 'done
100 0 : (dolist (bf dnd-protocol-alist)
101 0 : (when (string-match (car bf) url)
102 0 : (setq ret (funcall (cdr bf) url action))
103 0 : (throw 'done t)))
104 0 : nil)
105 0 : (when (not (functionp browse-url-browser-function))
106 0 : (catch 'done
107 0 : (dolist (bf browse-url-browser-function)
108 0 : (when (string-match (car bf) url)
109 0 : (setq ret 'private)
110 0 : (funcall (cdr bf) url action)
111 0 : (throw 'done t)))
112 0 : nil))
113 0 : (progn
114 0 : (dnd-insert-text window action url)
115 0 : (setq ret 'private)))
116 0 : ret))
117 :
118 :
119 : (defun dnd-get-local-file-uri (uri)
120 : "Return an uri converted to file:/// syntax if uri is a local file.
121 : Return nil if URI is not a local file."
122 :
123 : ;; The hostname may be our hostname, in that case, convert to a local
124 : ;; file. Otherwise return nil. TODO: How about an IP-address as hostname?
125 0 : (let ((sysname (system-name)))
126 0 : (let ((hostname (when (string-match "^file://\\([^/]*\\)" uri)
127 0 : (downcase (match-string 1 uri))))
128 : (sysname-no-dot
129 0 : (downcase (if (string-match "^[^\\.]+" sysname)
130 0 : (match-string 0 sysname)
131 0 : sysname))))
132 0 : (when (and hostname
133 0 : (or (string-equal "localhost" hostname)
134 0 : (string-equal (downcase sysname) hostname)
135 0 : (string-equal sysname-no-dot hostname)))
136 0 : (concat "file://" (substring uri (+ 7 (length hostname))))))))
137 :
138 : (defsubst dnd-unescape-uri (uri)
139 0 : (replace-regexp-in-string
140 : "%[A-Fa-f0-9][A-Fa-f0-9]"
141 : (lambda (arg)
142 0 : (let ((str (make-string 1 0)))
143 0 : (aset str 0 (string-to-number (substring arg 1) 16))
144 0 : str))
145 0 : uri t t))
146 :
147 : ;; http://lists.gnu.org/archive/html/emacs-devel/2006-05/msg01060.html
148 : (defun dnd-get-local-file-name (uri &optional must-exist)
149 : "Return file name converted from file:/// or file: syntax.
150 : URI is the uri for the file. If MUST-EXIST is given and non-nil,
151 : only return non-nil if the file exists.
152 : Return nil if URI is not a local file."
153 0 : (let ((f (cond ((string-match "^file:///" uri) ; XDND format.
154 0 : (substring uri (1- (match-end 0))))
155 0 : ((string-match "^file:" uri) ; Old KDE, Motif, Sun
156 0 : (substring uri (match-end 0)))))
157 0 : (coding (if (equal system-type 'windows-nt)
158 : ;; W32 pretends that file names are UTF-8 encoded.
159 : 'utf-8
160 0 : (or file-name-coding-system
161 0 : default-file-name-coding-system))))
162 0 : (and f (setq f (decode-coding-string (dnd-unescape-uri f) coding)))
163 0 : (when (and f must-exist (not (file-readable-p f)))
164 0 : (setq f nil))
165 0 : f))
166 :
167 : (defun dnd-open-local-file (uri _action)
168 : "Open a local file.
169 : The file is opened in the current window, or a new window if
170 : `dnd-open-file-other-window' is set. URI is the url for the file,
171 : and must have the format file:file-name or file:///file-name.
172 : The last / in file:/// is part of the file name. If the system
173 : natively supports unc file names, then remote urls of the form
174 : file://server-name/file-name will also be handled by this function.
175 : An alternative for systems that do not support unc file names is
176 : `dnd-open-remote-url'. ACTION is ignored."
177 :
178 0 : (let* ((f (dnd-get-local-file-name uri t)))
179 0 : (if (and f (file-readable-p f))
180 0 : (progn
181 0 : (if dnd-open-file-other-window
182 0 : (find-file-other-window f)
183 0 : (find-file f))
184 0 : 'private)
185 0 : (error "Can not read %s" uri))))
186 :
187 : (defun dnd-open-remote-url (uri _action)
188 : "Open a remote file with `find-file' and `url-handler-mode'.
189 : Turns `url-handler-mode' on if not on before. The file is opened in the
190 : current window, or a new window if `dnd-open-file-other-window' is set.
191 : URI is the url for the file. ACTION is ignored."
192 0 : (progn
193 0 : (require 'url-handlers)
194 0 : (or url-handler-mode (url-handler-mode))
195 0 : (if dnd-open-file-other-window
196 0 : (find-file-other-window uri)
197 0 : (find-file uri))
198 0 : 'private))
199 :
200 :
201 : (defun dnd-open-file (uri action)
202 : "Open a local or remote file.
203 : The file is opened in the current window, or a new window if
204 : `dnd-open-file-other-window' is set. URI is the url for the file,
205 : and must have the format file://hostname/file-name. ACTION is ignored.
206 : The last / in file://hostname/ is part of the file name."
207 :
208 : ;; The hostname may be our hostname, in that case, convert to a local
209 : ;; file. Otherwise return nil.
210 0 : (let ((local-file (dnd-get-local-file-uri uri)))
211 0 : (if local-file (dnd-open-local-file local-file action)
212 0 : (if dnd-open-remote-file-function
213 0 : (funcall dnd-open-remote-file-function uri action)
214 0 : (error "Remote files not supported")))))
215 :
216 :
217 : (defun dnd-insert-text (window action text)
218 : "Insert text at point or push to the kill ring if buffer is read only.
219 : TEXT is the text as a string, WINDOW is the window where the drop happened."
220 0 : (if (or buffer-read-only
221 0 : (not (windowp window)))
222 0 : (progn
223 0 : (kill-new text)
224 0 : (message "%s"
225 0 : (substitute-command-keys
226 0 : "The dropped text can be accessed with \\[yank]")))
227 0 : (insert text))
228 0 : action)
229 :
230 :
231 : (provide 'dnd)
232 :
233 : ;;; dnd.el ends here
|