| 1 | ;;; dnd.el --- drag and drop support. |
| 2 | |
| 3 | ;; Copyright (C) 2005, 2006 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 2, or (at your option) |
| 14 | ;; 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; see the file COPYING. If not, write to the |
| 23 | ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, |
| 24 | ;; Boston, MA 02110-1301, USA. |
| 25 | |
| 26 | ;;; Commentary: |
| 27 | |
| 28 | ;; This file provides the generic handling of the drop part only. |
| 29 | ;; Different DND backends (X11, W32, etc.) that handle the platform |
| 30 | ;; specific DND parts call the functions here to do final delivery of |
| 31 | ;; a drop. |
| 32 | |
| 33 | ;;; Code: |
| 34 | |
| 35 | ;;; Customizable variables |
| 36 | |
| 37 | |
| 38 | ;;;###autoload |
| 39 | (defcustom dnd-protocol-alist |
| 40 | '( |
| 41 | ("^file:///" . dnd-open-local-file) ; XDND format. |
| 42 | ("^file://" . dnd-open-file) ; URL with host |
| 43 | ("^file:" . dnd-open-local-file) ; Old KDE, Motif, Sun |
| 44 | ) |
| 45 | |
| 46 | "The functions to call for different protocols when a drop is made. |
| 47 | This variable is used by `dnd-handle-one-url' and `dnd-handle-file-name'. |
| 48 | The list contains of (REGEXP . FUNCTION) pairs. |
| 49 | The functions shall take two arguments, URL, which is the URL dropped and |
| 50 | ACTION which is the action to be performed for the drop (move, copy, link, |
| 51 | private or ask). |
| 52 | If no match is found here, and the value of `browse-url-browser-function' |
| 53 | is a pair of (REGEXP . FUNCTION), those regexps are tried for a match. |
| 54 | If no match is found, the URL is inserted as text by calling `dnd-insert-text'. |
| 55 | The function shall return the action done (move, copy, link or private) |
| 56 | if some action was made, or nil if the URL is ignored." |
| 57 | :version "22.1" |
| 58 | :type '(repeat (cons (regexp) (function))) |
| 59 | :group 'dnd) |
| 60 | |
| 61 | |
| 62 | |
| 63 | (defcustom dnd-open-file-other-window nil |
| 64 | "If non-nil, always use find-file-other-window to open dropped files." |
| 65 | :version "22.1" |
| 66 | :type 'boolean |
| 67 | :group 'dnd) |
| 68 | |
| 69 | |
| 70 | ;; Functions |
| 71 | |
| 72 | (defun dnd-handle-one-url (window action arg) |
| 73 | "Handle one dropped url by calling the appropriate handler. |
| 74 | The handler is first located by looking at `dnd-protocol-alist'. |
| 75 | If no match is found here, and the value of `browse-url-browser-function' |
| 76 | is a pair of (REGEXP . FUNCTION), those regexps are tried for a match. |
| 77 | If no match is found, just call `dnd-insert-text'. |
| 78 | WINDOW is where the drop happend, ACTION is the action for the drop, |
| 79 | ARG is the URL that has been dropped. |
| 80 | Returns ACTION." |
| 81 | (require 'browse-url) |
| 82 | (let* ((uri (replace-regexp-in-string |
| 83 | "%[A-Z0-9][A-Z0-9]" |
| 84 | (lambda (arg) |
| 85 | (format "%c" (string-to-number (substring arg 1) 16))) |
| 86 | arg)) |
| 87 | ret) |
| 88 | (or |
| 89 | (catch 'done |
| 90 | (dolist (bf dnd-protocol-alist) |
| 91 | (when (string-match (car bf) uri) |
| 92 | (setq ret (funcall (cdr bf) uri action)) |
| 93 | (throw 'done t))) |
| 94 | nil) |
| 95 | (when (not (functionp browse-url-browser-function)) |
| 96 | (catch 'done |
| 97 | (dolist (bf browse-url-browser-function) |
| 98 | (when (string-match (car bf) uri) |
| 99 | (setq ret 'private) |
| 100 | (funcall (cdr bf) uri action) |
| 101 | (throw 'done t))) |
| 102 | nil)) |
| 103 | (progn |
| 104 | (dnd-insert-text window action uri) |
| 105 | (setq ret 'private))) |
| 106 | ret)) |
| 107 | |
| 108 | |
| 109 | (defun dnd-get-local-file-uri (uri) |
| 110 | "Return an uri converted to file:/// syntax if uri is a local file. |
| 111 | Return nil if URI is not a local file." |
| 112 | |
| 113 | ;; The hostname may be our hostname, in that case, convert to a local |
| 114 | ;; file. Otherwise return nil. TODO: How about an IP-address as hostname? |
| 115 | (let ((hostname (when (string-match "^file://\\([^/]*\\)" uri) |
| 116 | (downcase (match-string 1 uri)))) |
| 117 | (system-name-no-dot |
| 118 | (downcase (if (string-match "^[^\\.]+" system-name) |
| 119 | (match-string 0 system-name) |
| 120 | system-name)))) |
| 121 | (when (and hostname |
| 122 | (or (string-equal "localhost" hostname) |
| 123 | (string-equal (downcase system-name) hostname) |
| 124 | (string-equal system-name-no-dot hostname))) |
| 125 | (concat "file://" (substring uri (+ 7 (length hostname))))))) |
| 126 | |
| 127 | (defun dnd-get-local-file-name (uri &optional must-exist) |
| 128 | "Return file name converted from file:/// or file: syntax. |
| 129 | URI is the uri for the file. If MUST-EXIST is given and non-nil, |
| 130 | only return non-nil if the file exists. |
| 131 | Return nil if URI is not a local file." |
| 132 | (let ((f (cond ((string-match "^file:///" uri) ; XDND format. |
| 133 | (substring uri (1- (match-end 0)))) |
| 134 | ((string-match "^file:" uri) ; Old KDE, Motif, Sun |
| 135 | (substring uri (match-end 0)))))) |
| 136 | (when (and f must-exist) |
| 137 | (let* ((decoded-f (decode-coding-string |
| 138 | f |
| 139 | (or file-name-coding-system |
| 140 | default-file-name-coding-system))) |
| 141 | (try-f (if (file-readable-p decoded-f) decoded-f f))) |
| 142 | (when (file-readable-p try-f) try-f))))) |
| 143 | |
| 144 | |
| 145 | (defun dnd-open-local-file (uri action) |
| 146 | "Open a local file. |
| 147 | The file is opened in the current window, or a new window if |
| 148 | `dnd-open-file-other-window' is set. URI is the url for the file, |
| 149 | and must have the format file:file-name or file:///file-name. |
| 150 | The last / in file:/// is part of the file name. ACTION is ignored." |
| 151 | |
| 152 | (let* ((f (dnd-get-local-file-name uri t))) |
| 153 | (if (and f (file-readable-p f)) |
| 154 | (progn |
| 155 | (if dnd-open-file-other-window |
| 156 | (find-file-other-window f) |
| 157 | (find-file f)) |
| 158 | 'private) |
| 159 | (error "Can not read %s" uri)))) |
| 160 | |
| 161 | (defun dnd-open-file (uri action) |
| 162 | "Open a local or remote 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://hostname/file-name. ACTION is ignored. |
| 166 | The last / in file://hostname/ is part of the file name." |
| 167 | |
| 168 | ;; The hostname may be our hostname, in that case, convert to a local |
| 169 | ;; file. Otherwise return nil. |
| 170 | (let ((local-file (dnd-get-local-file-uri uri))) |
| 171 | (if local-file (dnd-open-local-file local-file action) |
| 172 | (error "Remote files not supported")))) |
| 173 | |
| 174 | |
| 175 | (defun dnd-insert-text (window action text) |
| 176 | "Insert text at point or push to the kill ring if buffer is read only. |
| 177 | TEXT is the text as a string, WINDOW is the window where the drop happened." |
| 178 | (if (or buffer-read-only |
| 179 | (not (windowp window))) |
| 180 | (progn |
| 181 | (kill-new text) |
| 182 | (message "%s" |
| 183 | (substitute-command-keys |
| 184 | "The dropped text can be accessed with \\[yank]"))) |
| 185 | (insert text)) |
| 186 | action) |
| 187 | |
| 188 | |
| 189 | (provide 'dnd) |
| 190 | |
| 191 | ;; arch-tag: 0472f6a5-2e8f-4304-9e44-1a0877c771b7 |
| 192 | ;;; dnd.el ends here |