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