| 1 | ;;; dnd.el --- drag and drop support. -*- coding: utf-8 -*- |
| 2 | |
| 3 | ;; Copyright (C) 2005-2014 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 | (require 'browse-url) |
| 97 | (let (ret) |
| 98 | (or |
| 99 | (catch 'done |
| 100 | (dolist (bf dnd-protocol-alist) |
| 101 | (when (string-match (car bf) url) |
| 102 | (setq ret (funcall (cdr bf) url action)) |
| 103 | (throw 'done t))) |
| 104 | nil) |
| 105 | (when (not (functionp browse-url-browser-function)) |
| 106 | (catch 'done |
| 107 | (dolist (bf browse-url-browser-function) |
| 108 | (when (string-match (car bf) url) |
| 109 | (setq ret 'private) |
| 110 | (funcall (cdr bf) url action) |
| 111 | (throw 'done t))) |
| 112 | nil)) |
| 113 | (progn |
| 114 | (dnd-insert-text window action url) |
| 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 | |
| 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 |
| 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))))) |
| 156 | (coding (if (equal system-type 'windows-nt) |
| 157 | ;; W32 pretends that file names are UTF-8 encoded. |
| 158 | 'utf-8 |
| 159 | (or file-name-coding-system |
| 160 | default-file-name-coding-system)))) |
| 161 | (and f (setq f (decode-coding-string (dnd-unescape-uri f) coding))) |
| 162 | (when (and f must-exist (not (file-readable-p f))) |
| 163 | (setq f nil)) |
| 164 | f)) |
| 165 | |
| 166 | (defun dnd-open-local-file (uri _action) |
| 167 | "Open a local file. |
| 168 | The file is opened in the current window, or a new window if |
| 169 | `dnd-open-file-other-window' is set. URI is the url for the file, |
| 170 | and must have the format file:file-name or file:///file-name. |
| 171 | The last / in file:/// is part of the file name. If the system |
| 172 | natively supports unc file names, then remote urls of the form |
| 173 | file://server-name/file-name will also be handled by this function. |
| 174 | An alternative for systems that do not support unc file names is |
| 175 | `dnd-open-remote-url'. ACTION is ignored." |
| 176 | |
| 177 | (let* ((f (dnd-get-local-file-name uri t))) |
| 178 | (if (and f (file-readable-p f)) |
| 179 | (progn |
| 180 | (if dnd-open-file-other-window |
| 181 | (find-file-other-window f) |
| 182 | (find-file f)) |
| 183 | 'private) |
| 184 | (error "Can not read %s" uri)))) |
| 185 | |
| 186 | (defun dnd-open-remote-url (uri _action) |
| 187 | "Open a remote file with `find-file' and `url-handler-mode'. |
| 188 | Turns `url-handler-mode' on if not on before. The file is opened in the |
| 189 | current window, or a new window if `dnd-open-file-other-window' is set. |
| 190 | URI is the url for the file. ACTION is ignored." |
| 191 | (progn |
| 192 | (require 'url-handlers) |
| 193 | (or url-handler-mode (url-handler-mode)) |
| 194 | (if dnd-open-file-other-window |
| 195 | (find-file-other-window uri) |
| 196 | (find-file uri)) |
| 197 | 'private)) |
| 198 | |
| 199 | |
| 200 | (defun dnd-open-file (uri action) |
| 201 | "Open a local or remote file. |
| 202 | The file is opened in the current window, or a new window if |
| 203 | `dnd-open-file-other-window' is set. URI is the url for the file, |
| 204 | and must have the format file://hostname/file-name. ACTION is ignored. |
| 205 | The last / in file://hostname/ is part of the file name." |
| 206 | |
| 207 | ;; The hostname may be our hostname, in that case, convert to a local |
| 208 | ;; file. Otherwise return nil. |
| 209 | (let ((local-file (dnd-get-local-file-uri uri))) |
| 210 | (if local-file (dnd-open-local-file local-file action) |
| 211 | (if dnd-open-remote-file-function |
| 212 | (funcall dnd-open-remote-file-function uri action) |
| 213 | (error "Remote files not supported"))))) |
| 214 | |
| 215 | |
| 216 | (defun dnd-insert-text (window action text) |
| 217 | "Insert text at point or push to the kill ring if buffer is read only. |
| 218 | TEXT is the text as a string, WINDOW is the window where the drop happened." |
| 219 | (if (or buffer-read-only |
| 220 | (not (windowp window))) |
| 221 | (progn |
| 222 | (kill-new text) |
| 223 | (message "%s" |
| 224 | (substitute-command-keys |
| 225 | "The dropped text can be accessed with \\[yank]"))) |
| 226 | (insert text)) |
| 227 | action) |
| 228 | |
| 229 | |
| 230 | (provide 'dnd) |
| 231 | |
| 232 | ;;; dnd.el ends here |