Commit | Line | Data |
---|---|---|
e9dc55ba | 1 | ;;; dnd.el --- drag and drop support. -*- coding: utf-8 -*- |
6018020d | 2 | |
ab422c4d | 3 | ;; Copyright (C) 2005-2013 Free Software Foundation, Inc. |
6018020d | 4 | |
e9dc55ba | 5 | ;; Author: Jan Djärv <jan.h.d@swipnet.se> |
6018020d JD |
6 | ;; Maintainer: FSF |
7 | ;; Keywords: window, drag, drop | |
bd78fa1d | 8 | ;; Package: emacs |
6018020d JD |
9 | |
10 | ;; This file is part of GNU Emacs. | |
11 | ||
eb3fa2cf | 12 | ;; GNU Emacs is free software: you can redistribute it and/or modify |
6018020d | 13 | ;; it under the terms of the GNU General Public License as published by |
eb3fa2cf GM |
14 | ;; the Free Software Foundation, either version 3 of the License, or |
15 | ;; (at your option) any later version. | |
6018020d JD |
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 | |
eb3fa2cf | 23 | ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. |
6018020d JD |
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 | ||
01147a50 | 37 | ;;;###autoload |
6018020d | 38 | (defcustom dnd-protocol-alist |
1e8780b1 DN |
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) | |
c79b0f8f | 43 | ) |
6018020d JD |
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" | |
1ed8284d | 57 | :type '(repeat (cons (regexp) (function))) |
6018020d JD |
58 | :group 'dnd) |
59 | ||
60 | ||
c79b0f8f JD |
61 | (defcustom dnd-open-remote-file-function |
62 | (if (eq system-type 'windows-nt) | |
8e9e7fa1 | 63 | 'dnd-open-local-file |
c79b0f8f JD |
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. | |
8e9e7fa1 JR |
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." | |
c79b0f8f JD |
73 | :version "22.1" |
74 | :type 'function | |
75 | :group 'dnd) | |
76 | ||
6018020d JD |
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 | ||
01aa8c41 | 87 | (defun dnd-handle-one-url (window action url) |
6018020d JD |
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'. | |
a3545af4 | 93 | WINDOW is where the drop happened, ACTION is the action for the drop, |
01aa8c41 | 94 | URL is what has been dropped. |
6018020d JD |
95 | Returns ACTION." |
96 | (require 'browse-url) | |
01aa8c41 | 97 | (let (ret) |
6018020d JD |
98 | (or |
99 | (catch 'done | |
100 | (dolist (bf dnd-protocol-alist) | |
01aa8c41 YM |
101 | (when (string-match (car bf) url) |
102 | (setq ret (funcall (cdr bf) url action)) | |
6018020d JD |
103 | (throw 'done t))) |
104 | nil) | |
105 | (when (not (functionp browse-url-browser-function)) | |
106 | (catch 'done | |
107 | (dolist (bf browse-url-browser-function) | |
01aa8c41 | 108 | (when (string-match (car bf) url) |
6018020d | 109 | (setq ret 'private) |
01aa8c41 | 110 | (funcall (cdr bf) url action) |
6018020d JD |
111 | (throw 'done t))) |
112 | nil)) | |
113 | (progn | |
01aa8c41 | 114 | (dnd-insert-text window action url) |
6018020d JD |
115 | (setq ret 'private))) |
116 | 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 | (let ((hostname (when (string-match "^file://\\([^/]*\\)" uri) | |
126 | (downcase (match-string 1 uri)))) | |
127 | (system-name-no-dot | |
128 | (downcase (if (string-match "^[^\\.]+" system-name) | |
129 | (match-string 0 system-name) | |
130 | system-name)))) | |
131 | (when (and hostname | |
132 | (or (string-equal "localhost" hostname) | |
133 | (string-equal (downcase system-name) hostname) | |
134 | (string-equal system-name-no-dot hostname))) | |
135 | (concat "file://" (substring uri (+ 7 (length hostname))))))) | |
136 | ||
adc0b793 JD |
137 | (defsubst dnd-unescape-uri (uri) |
138 | (replace-regexp-in-string | |
139 | "%[A-Fa-f0-9][A-Fa-f0-9]" | |
140 | (lambda (arg) | |
141 | (let ((str (make-string 1 0))) | |
142 | (aset str 0 (string-to-number (substring arg 1) 16)) | |
143 | str)) | |
144 | uri t t)) | |
145 | ||
146 | ;; http://lists.gnu.org/archive/html/emacs-devel/2006-05/msg01060.html | |
6018020d JD |
147 | (defun dnd-get-local-file-name (uri &optional must-exist) |
148 | "Return file name converted from file:/// or file: syntax. | |
149 | URI is the uri for the file. If MUST-EXIST is given and non-nil, | |
150 | only return non-nil if the file exists. | |
151 | Return nil if URI is not a local file." | |
152 | (let ((f (cond ((string-match "^file:///" uri) ; XDND format. | |
153 | (substring uri (1- (match-end 0)))) | |
154 | ((string-match "^file:" uri) ; Old KDE, Motif, Sun | |
155 | (substring uri (match-end 0)))))) | |
adc0b793 JD |
156 | (and f (setq f (decode-coding-string (dnd-unescape-uri f) |
157 | (or file-name-coding-system | |
158 | default-file-name-coding-system)))) | |
159 | (when (and f must-exist (not (file-readable-p f))) | |
160 | (setq f nil)) | |
83b8ea28 | 161 | f)) |
6018020d | 162 | |
06b60517 | 163 | (defun dnd-open-local-file (uri _action) |
6018020d JD |
164 | "Open a local file. |
165 | The file is opened in the current window, or a new window if | |
166 | `dnd-open-file-other-window' is set. URI is the url for the file, | |
167 | and must have the format file:file-name or file:///file-name. | |
8e9e7fa1 JR |
168 | The last / in file:/// is part of the file name. If the system |
169 | natively supports unc file names, then remote urls of the form | |
170 | file://server-name/file-name will also be handled by this function. | |
171 | An alternative for systems that do not support unc file names is | |
172 | `dnd-open-remote-url'. ACTION is ignored." | |
6018020d JD |
173 | |
174 | (let* ((f (dnd-get-local-file-name uri t))) | |
175 | (if (and f (file-readable-p f)) | |
176 | (progn | |
177 | (if dnd-open-file-other-window | |
178 | (find-file-other-window f) | |
179 | (find-file f)) | |
180 | 'private) | |
181 | (error "Can not read %s" uri)))) | |
182 | ||
06b60517 | 183 | (defun dnd-open-remote-url (uri _action) |
c79b0f8f JD |
184 | "Open a remote file with `find-file' and `url-handler-mode'. |
185 | Turns `url-handler-mode' on if not on before. The file is opened in the | |
186 | current window, or a new window if `dnd-open-file-other-window' is set. | |
187 | URI is the url for the file. ACTION is ignored." | |
188 | (progn | |
1df4d4a8 | 189 | (require 'url-handlers) |
c79b0f8f JD |
190 | (or url-handler-mode (url-handler-mode)) |
191 | (if dnd-open-file-other-window | |
192 | (find-file-other-window uri) | |
193 | (find-file uri)) | |
194 | 'private)) | |
195 | ||
196 | ||
6018020d JD |
197 | (defun dnd-open-file (uri action) |
198 | "Open a local or remote file. | |
199 | The file is opened in the current window, or a new window if | |
200 | `dnd-open-file-other-window' is set. URI is the url for the file, | |
201 | and must have the format file://hostname/file-name. ACTION is ignored. | |
202 | The last / in file://hostname/ is part of the file name." | |
203 | ||
204 | ;; The hostname may be our hostname, in that case, convert to a local | |
205 | ;; file. Otherwise return nil. | |
206 | (let ((local-file (dnd-get-local-file-uri uri))) | |
207 | (if local-file (dnd-open-local-file local-file action) | |
c79b0f8f JD |
208 | (if dnd-open-remote-file-function |
209 | (funcall dnd-open-remote-file-function uri action) | |
210 | (error "Remote files not supported"))))) | |
6018020d JD |
211 | |
212 | ||
213 | (defun dnd-insert-text (window action text) | |
214 | "Insert text at point or push to the kill ring if buffer is read only. | |
215 | TEXT is the text as a string, WINDOW is the window where the drop happened." | |
216 | (if (or buffer-read-only | |
217 | (not (windowp window))) | |
218 | (progn | |
219 | (kill-new text) | |
8a26c165 | 220 | (message "%s" |
6018020d JD |
221 | (substitute-command-keys |
222 | "The dropped text can be accessed with \\[yank]"))) | |
223 | (insert text)) | |
224 | action) | |
225 | ||
226 | ||
227 | (provide 'dnd) | |
228 | ||
229 | ;;; dnd.el ends here |