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