Add "Package:" file headers to denote built-in packages.
[bpt/emacs.git] / lisp / dnd.el
CommitLineData
e9dc55ba 1;;; dnd.el --- drag and drop support. -*- coding: utf-8 -*-
6018020d 2
e9dc55ba
GM
3;; Copyright (C) 2005, 2006, 2007, 2008, 2009, 2010
4;; Free Software Foundation, Inc.
6018020d 5
e9dc55ba 6;; Author: Jan Djärv <jan.h.d@swipnet.se>
6018020d
JD
7;; Maintainer: FSF
8;; Keywords: window, drag, drop
bd78fa1d 9;; Package: emacs
6018020d
JD
10
11;; This file is part of GNU Emacs.
12
eb3fa2cf 13;; GNU Emacs is free software: you can redistribute it and/or modify
6018020d 14;; it under the terms of the GNU General Public License as published by
eb3fa2cf
GM
15;; the Free Software Foundation, either version 3 of the License, or
16;; (at your option) any later version.
6018020d
JD
17
18;; GNU Emacs is distributed in the hope that it will be useful,
19;; but WITHOUT ANY WARRANTY; without even the implied warranty of
20;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
21;; GNU General Public License for more details.
22
23;; You should have received a copy of the GNU General Public License
eb3fa2cf 24;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
6018020d
JD
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
01147a50 38;;;###autoload
6018020d 39(defcustom dnd-protocol-alist
1e8780b1
DN
40 `((,(purecopy "^file:///") . dnd-open-local-file) ; XDND format.
41 (,(purecopy "^file://") . dnd-open-file) ; URL with host
42 (,(purecopy "^file:") . dnd-open-local-file) ; Old KDE, Motif, Sun
43 (,(purecopy "^\\(https?\\|ftp\\|file\\|nfs\\)://") . dnd-open-file)
c79b0f8f 44 )
6018020d
JD
45
46 "The functions to call for different protocols when a drop is made.
47This variable is used by `dnd-handle-one-url' and `dnd-handle-file-name'.
48The list contains of (REGEXP . FUNCTION) pairs.
49The functions shall take two arguments, URL, which is the URL dropped and
50ACTION which is the action to be performed for the drop (move, copy, link,
51private or ask).
52If no match is found here, and the value of `browse-url-browser-function'
53is a pair of (REGEXP . FUNCTION), those regexps are tried for a match.
54If no match is found, the URL is inserted as text by calling `dnd-insert-text'.
55The function shall return the action done (move, copy, link or private)
56if some action was made, or nil if the URL is ignored."
57 :version "22.1"
1ed8284d 58 :type '(repeat (cons (regexp) (function)))
6018020d
JD
59 :group 'dnd)
60
61
c79b0f8f
JD
62(defcustom dnd-open-remote-file-function
63 (if (eq system-type 'windows-nt)
8e9e7fa1 64 'dnd-open-local-file
c79b0f8f
JD
65 'dnd-open-remote-url)
66 "The function to call when opening a file on a remote machine.
67The function will be called with two arguments; URI and ACTION. See
68`dnd-open-file' for details.
69If nil, then dragging remote files into Emacs will result in an error.
8e9e7fa1
JR
70Predefined functions are `dnd-open-local-file' and `dnd-open-remote-url'.
71`dnd-open-local-file' attempts to open a remote file using its UNC name and
72is the default on MS-Windows. `dnd-open-remote-url' uses `url-handler-mode'
73and is the default except for MS-Windows."
c79b0f8f
JD
74 :version "22.1"
75 :type 'function
76 :group 'dnd)
77
6018020d
JD
78
79(defcustom dnd-open-file-other-window nil
80 "If non-nil, always use find-file-other-window to open dropped files."
81 :version "22.1"
82 :type 'boolean
83 :group 'dnd)
84
85
86;; Functions
87
01aa8c41 88(defun dnd-handle-one-url (window action url)
6018020d
JD
89 "Handle one dropped url by calling the appropriate handler.
90The handler is first located by looking at `dnd-protocol-alist'.
91If no match is found here, and the value of `browse-url-browser-function'
92is a pair of (REGEXP . FUNCTION), those regexps are tried for a match.
93If no match is found, just call `dnd-insert-text'.
a3545af4 94WINDOW is where the drop happened, ACTION is the action for the drop,
01aa8c41 95URL is what has been dropped.
6018020d
JD
96Returns ACTION."
97 (require 'browse-url)
01aa8c41 98 (let (ret)
6018020d
JD
99 (or
100 (catch 'done
101 (dolist (bf dnd-protocol-alist)
01aa8c41
YM
102 (when (string-match (car bf) url)
103 (setq ret (funcall (cdr bf) url action))
6018020d
JD
104 (throw 'done t)))
105 nil)
106 (when (not (functionp browse-url-browser-function))
107 (catch 'done
108 (dolist (bf browse-url-browser-function)
01aa8c41 109 (when (string-match (car bf) url)
6018020d 110 (setq ret 'private)
01aa8c41 111 (funcall (cdr bf) url action)
6018020d
JD
112 (throw 'done t)))
113 nil))
114 (progn
01aa8c41 115 (dnd-insert-text window action url)
6018020d
JD
116 (setq ret 'private)))
117 ret))
118
119
120(defun dnd-get-local-file-uri (uri)
121 "Return an uri converted to file:/// syntax if uri is a local file.
122Return nil if URI is not a local file."
123
124 ;; The hostname may be our hostname, in that case, convert to a local
125 ;; file. Otherwise return nil. TODO: How about an IP-address as hostname?
126 (let ((hostname (when (string-match "^file://\\([^/]*\\)" uri)
127 (downcase (match-string 1 uri))))
128 (system-name-no-dot
129 (downcase (if (string-match "^[^\\.]+" system-name)
130 (match-string 0 system-name)
131 system-name))))
132 (when (and hostname
133 (or (string-equal "localhost" hostname)
134 (string-equal (downcase system-name) hostname)
135 (string-equal system-name-no-dot hostname)))
136 (concat "file://" (substring uri (+ 7 (length hostname)))))))
137
138(defun dnd-get-local-file-name (uri &optional must-exist)
139 "Return file name converted from file:/// or file: syntax.
140URI is the uri for the file. If MUST-EXIST is given and non-nil,
141only return non-nil if the file exists.
142Return nil if URI is not a local file."
143 (let ((f (cond ((string-match "^file:///" uri) ; XDND format.
144 (substring uri (1- (match-end 0))))
145 ((string-match "^file:" uri) ; Old KDE, Motif, Sun
146 (substring uri (match-end 0))))))
147 (when (and f must-exist)
01aa8c41 148 (setq f (replace-regexp-in-string
e39ef891 149 "%[A-Fa-f0-9][A-Fa-f0-9]"
01aa8c41 150 (lambda (arg)
62a714fc
KH
151 (let ((str (make-string 1 0)))
152 (aset str 0 (string-to-number (substring arg 1) 16))
153 str))
e22f775c 154 f t t))
6018020d
JD
155 (let* ((decoded-f (decode-coding-string
156 f
157 (or file-name-coding-system
158 default-file-name-coding-system)))
159 (try-f (if (file-readable-p decoded-f) decoded-f f)))
160 (when (file-readable-p try-f) try-f)))))
161
162
163(defun dnd-open-local-file (uri action)
164 "Open a local file.
165The 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,
167and must have the format file:file-name or file:///file-name.
8e9e7fa1
JR
168The last / in file:/// is part of the file name. If the system
169natively supports unc file names, then remote urls of the form
170file://server-name/file-name will also be handled by this function.
171An 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
c79b0f8f
JD
183(defun dnd-open-remote-url (uri action)
184 "Open a remote file with `find-file' and `url-handler-mode'.
185Turns `url-handler-mode' on if not on before. The file is opened in the
186current window, or a new window if `dnd-open-file-other-window' is set.
187URI 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.
199The 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,
201and must have the format file://hostname/file-name. ACTION is ignored.
202The 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.
215TEXT 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
0436c0c2 229;; arch-tag: 0472f6a5-2e8f-4304-9e44-1a0877c771b7
6018020d 230;;; dnd.el ends here