Commit | Line | Data |
---|---|---|
6018020d JD |
1 | ;;; dnd.el --- drag and drop support. |
2 | ||
aaef169d | 3 | ;; Copyright (C) 2005, 2006 Free Software Foundation, Inc. |
6018020d JD |
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 | |
086add15 LK |
23 | ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, |
24 | ;; Boston, MA 02110-1301, USA. | |
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 JD |
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" | |
1ed8284d | 58 | :type '(repeat (cons (regexp) (function))) |
6018020d JD |
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) | |
8a26c165 | 182 | (message "%s" |
6018020d JD |
183 | (substitute-command-keys |
184 | "The dropped text can be accessed with \\[yank]"))) | |
185 | (insert text)) | |
186 | action) | |
187 | ||
188 | ||
189 | (provide 'dnd) | |
190 | ||
0436c0c2 | 191 | ;; arch-tag: 0472f6a5-2e8f-4304-9e44-1a0877c771b7 |
6018020d | 192 | ;;; dnd.el ends here |