Mercurial > hg > xemacs-beta

comparison lisp/hm--html-menus/internal-drag-and-drop.el @ 2:ac2d302a0011 r19-15b2

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r19-15b2
author cvs
date Mon, 13 Aug 2007 08:46:35 +0200
parents
children 8fc7fe29b841
comparison
equal deleted inserted replaced
1:c0c6a60d29db 2:ac2d302a0011
1 ;;; $Id: internal-drag-and-drop.el,v 1.1.1.1 1996/12/18 03:46:48 steve Exp $
2 ;;;
3 ;;; Copyright (C) 1996 Heiko Muenkel
4 ;;; email: muenkel@tnt.uni-hannover.de
5 ;;;
6 ;;; This program is free software; you can redistribute it and/or modify
7 ;;; it under the terms of the GNU General Public License as published by
8 ;;; the Free Software Foundation; either version 1, or (at your option)
9 ;;; any later version.
10 ;;;
11 ;;; This program is distributed in the hope that it will be useful,
12 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
13 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 ;;; GNU General Public License for more details.
15 ;;;
16 ;;; You should have received a copy of the GNU General Public License
17 ;;; along with this program; if not, write to the Free Software
18 ;;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
19 ;;;
20 ;;;
21 ;;; Description:
22 ;;;
23 ;;; This package provides functions to define and call internal
24 ;;; drag and drop actions in the emacs. One could start such an
25 ;;; action by clicking with the mouse in the source buffer and
26 ;;; then in the destination buffer. The action could depend on
27 ;;; the points where youve clicked with the mouse, on the state
28 ;;; of the region, the point, the mark and any other properties
29 ;;; of the source and the destination buffers. The actions are
30 ;;; defined by the variable `idd-actions', which is a buffer local
31 ;;; variable. The following is an example for the html-mode:
32 ;;; (defvar html-idd-actions
33 ;;; '((nil (((idd-major-mode-p . dired-mode)
34 ;;; (idd-dired-file-on-line-p . ".*\\.\\(gif\\)\\|\\(jpq\\)"))
35 ;;; hm--html-idd-add-include-image-from-dired-line)
36 ;;; (((idd-major-mode-p . dired-mode)
37 ;;; (idd-dired-no-file-on-line-p . nil))
38 ;;; hm--html-idd-add-file-link-to-file-on-dired-line)
39 ;;; (((idd-major-mode-p . dired-mode)
40 ;;; (idd-dired-no-file-on-line-p . t))
41 ;;; hm--html-idd-add-file-link-to-directory-of-buffer)
42 ;;; (((idd-major-mode-p . w3-mode)
43 ;;; (idd-url-at-point-p . t))
44 ;;; hm--html-idd-add-html-link-from-w3-buffer-point)
45 ;;; (((idd-major-mode-p . w3-mode))
46 ;;; hm--html-idd-add-html-link-to-w3-buffer)
47 ;;; (((idd-local-file-p . t))
48 ;;; hm--html-idd-add-file-link-to-buffer)))
49 ;;; Look at the variable `idd-actions' for further descriptions.
50 ;;;
51 ;;;
52 ;;;
53 ;;; Installation:
54 ;;;
55 ;;; Put this file in one of your load path directories.
56 ;;;
57 ;;; Put the following in your .emacs:
58 ;;; (autoload 'idd-mouse-drag-and-drop "internal-drag-and-drop"
59 ;;; "Performs a drag and drop action.
60 ;;; At first you must click on the source and
61 ;;; after that on the destination."
62 ;;; t)
63 ;;; (define-key global-map [(meta button1)] 'idd-mouse-drag-and-drop)
64 ;;;
65 ;;; Define actions in the variable `idd-actions'.
66 ;;;
67
68 (defvar idd-actions nil
69 "The list with actions, depending on the source and the destination.
70 The list looks like:
71 '((<source-specification-1> (<destination-specification-1> <action-1-1>)
72 (<destination-specification-2> <action-1-2>)
73 :
74 )
75 (<source-specification-2> (<destination-specification-1> <action-2-1>)
76 (<destination-specification-2> <action-2-2>)
77 :
78 )
79 :
80 )
81 The <source-specification> looks like the following:
82 '([(<specification-type> <value>)])
83 with <specification-type> :== idd-minor-mode-p | idd-buffer-name-p
84 | idd-region-active-p ...
85
86 The <destination-specification> looks like <source-specification>, except
87 that a valid <specification-type> is also idd-major-mode-p.
88
89 If <source-specification-1> or <destination-specification-1> is set to
90 nil, then every source or destination matches. `idd-actions' is a
91 buffer local variable, which should be at least mode depended. So if
92 the <source-specification-1> is set to nil it says, that the source
93 buffer must only have a specific mode. But however, it's also possible
94 to define a general `idd-actions' list, where the source mode is
95 specified by idd-major-mode-p.
96
97 <action> ist a function, which has two arguments, the specifies the
98 source and the second the destination.")
99
100 (make-variable-buffer-local 'idd-actions)
101
102 (defun idd-compare-a-specification (source-or-destination
103 specification)
104 "Tests if SOURCE-OR-DESTINATION matches the SPECIFICATION.
105 It returns a value (1 in general) if both are matching or nil."
106 (eval (list (car specification)
107 'source-or-destination
108 '(cdr specification))))
109
110 (defun idd-compare-specifications-1 (source-or-destination
111 specifications
112 value)
113 "Internal function of `idd-compare-specifications'.
114 VALUE is the value of the last matches."
115 (cond ((not specifications) value)
116 (t (let ((match (idd-compare-a-specification source-or-destination
117 (car specifications))))
118 (cond ((not match) 0)
119 (t (idd-compare-specifications-1 source-or-destination
120 (cdr specifications)
121 (+ value match))))))))
122
123 (defun idd-compare-specifications (source-or-destination
124 specifications)
125 "Determines how good SOURCE-OR-DESTINATION and SPECIFICATIONS are matching.
126 A return value of zero means, that they don't match. The higher the
127 return value the better is the matching."
128 (cond ((not specifications) 1)
129 (t (idd-compare-specifications-1 source-or-destination
130 specifications
131 0))))
132
133 (defun idd-get-action-depending-on-destination (destination
134 actions-depending-on-dest
135 source-value
136 value-action-pair)
137 "Internal function of `idd-get-action-depending-on-source-and-destination'."
138 (let ((destination-value (idd-compare-specifications
139 destination
140 (car (car actions-depending-on-dest)))))
141 (cond ((not actions-depending-on-dest) value-action-pair)
142 ((or (= destination-value 0)
143 (<= (+ source-value destination-value) (car value-action-pair)))
144 (idd-get-action-depending-on-destination
145 destination
146 (cdr actions-depending-on-dest)
147 source-value
148 value-action-pair))
149 (t (idd-get-action-depending-on-destination
150 destination
151 (cdr actions-depending-on-dest)
152 source-value
153 (cons (+ source-value destination-value)
154 (second (car actions-depending-on-dest))))))))
155
156 (defun idd-get-action-depending-on-source-and-destination (source
157 destination
158 actions
159 value-action-pair)
160 "Internal function of `idd-get-action'.
161 VALUE-ACTION-PAIR is a list like (<value> <action>).
162 It returns VALUE-ACTION-PAIR, if no other action is found, which has a
163 value higher than (car VALUE-ACTION-PAIR)."
164 (let ((source-value (idd-compare-specifications source (car (car actions)))))
165 (cond ((not actions) value-action-pair)
166 ((= source-value 0)
167 (idd-get-action-depending-on-source-and-destination
168 source
169 destination
170 (cdr actions)
171 value-action-pair))
172 (t (idd-get-action-depending-on-source-and-destination
173 source
174 destination
175 (cdr actions)
176 (idd-get-action-depending-on-destination
177 destination
178 (cdr (car actions))
179 source-value
180 value-action-pair))))))
181
182 (defun idd-get-action (source destination actions)
183 "Returns the action, which depends on the SOURCE and the DESTINATION.
184 The list ACTIONS contains all possible actions. Look at the variable
185 `idd-actions' for a description of the format of this list."
186 (idd-get-action-depending-on-source-and-destination source
187 destination
188 actions
189 '(0 . nil)))
190
191 (defun idd-get-buffer-url (source-or-destination)
192 "Returns the URL of the buffer specified by SOURCE-OR-DESTINATION."
193 (save-excursion
194 (idd-set-point source-or-destination)
195 (url-view-url t)))
196
197 (defun idd-get-url-at-point (source-or-destination)
198 "Returns the URL at the point specified by SOURCE-OR-DESTINATION.
199 It returns nil, if there is no URL."
200 (save-excursion
201 (idd-set-point source-or-destination)
202 (w3-view-this-url t)))
203
204 (defun idd-url-at-point-p (source-or-destination value)
205 "Checks if there is an URL at the point of SOURCE-OR-DESTINATION.
206 If that is t and VALUE is t, or that is nil and VALUE is nil, then 1
207 is returned. Otherwise nil is returned."
208 (if value
209 (if (idd-get-url-at-point source-or-destination)
210 1
211 nil)
212 (if (idd-get-url-at-point source-or-destination)
213 nil
214 1)))
215
216 (defun idd-major-mode-p (source-or-destination mode)
217 "Checks, if the major mode of SOURCE-OR-DESTINATION is MODE.
218 It returns 1, if that is t and nil otherwise."
219 (save-excursion
220 (set-buffer (cdr (assoc ':buffer source-or-destination)))
221 (if (eq major-mode mode)
222 1
223 nil)))
224
225 (defun idd-set-point (source-or-destination)
226 "Sets the point and buffer to SOURCE-OR-DESTINATION."
227 (set-buffer (cdr (assoc ':buffer source-or-destination)))
228 (goto-char (cdr (assoc ':drag-or-drop-point source-or-destination))))
229
230 (defun idd-set-region (source-or-destination)
231 "Sets the point, mark and buffer to SOURCE-OR-DESTINATION.
232 The region is active after this function is called."
233 (set-buffer (cdr (assoc ':buffer source-or-destination)))
234 (goto-char (car (cdr (assoc ':region-active source-or-destination))))
235 (set-mark (cdr (cdr (assoc ':region-active source-or-destination))))
236 (activate-region))
237
238 (defun idd-get-dired-filename-from-line (source-or-destination)
239 "Returns the filename form the line in a dired buffer.
240 The position and the buffer is specified by SOURCE-OR-DESTINATION."
241 (save-excursion
242 (idd-set-point source-or-destination)
243 (dired-get-filename nil t)))
244
245 (defun idd-dired-file-on-line-p (source-or-destination filename-regexp)
246 "Checks, if the filename on the line match FILENAME-REGEXP.
247 The function `dired-get-filename' is used, to get the filename from
248 the SOURCE-OR-DESTINATION. It returns 1, if it matchs or nil."
249 (let ((case-fold-search t))
250 (if (and (idd-get-dired-filename-from-line source-or-destination)
251 (string-match filename-regexp
252 (idd-get-dired-filename-from-line
253 source-or-destination)))
254 1
255 nil)))
256
257 (defun idd-dired-no-file-on-line-p (source-or-destination value)
258 "Checks, if a filename is in the dired buffer of SOURCE-OR-DESTINATION.
259 It returns 1, if a filename is on the line and if VALUE is t, or if
260 no filename is on the line and VALUE is nil, otherwise it returns
261 nil. For the test the function `dired-get-filename' is used."
262 (if (idd-get-dired-filename-from-line source-or-destination)
263 (if value nil 1)
264 (if value 1 nil)))
265
266 (autoload 'ange-ftp-ftp-path "ange-ftp"
267 "Parse PATH according to ange-ftp-path-format (which see).
268 Returns a list (HOST USER PATH), or nil if PATH does not match the format.")
269
270 (defun idd-get-local-filename (source-or-destination)
271 "Returns the filename of a local file specified by SOURCE-OR-DESTINATION."
272 (buffer-file-name (cdr (assoc ':buffer source-or-destination))))
273
274 (defun idd-get-directory-of-buffer (source-or-destination)
275 "Returns the directory name assigned to the SOURCE-OR-DESTINATION buffer."
276 (save-excursion
277 (idd-set-point source-or-destination)
278 default-directory))
279
280 (defun idd-local-file-p (source-or-destination value)
281 "Checks, if SOURCE-OR-DESTINATION has a file on the local filesystem.
282 If that is t and VALUE is t, or that is nil and VALUE is nil, then 1
283 is returned. Otherwise nil is returned."
284 (let ((filename (idd-get-local-filename source-or-destination)))
285 (if (and filename
286 (not (ange-ftp-ftp-path filename)))
287 (if value 1 nil)
288 (if value nil 1))))
289
290 (defun idd-call-action (action source destination)
291 "Calls the drag and drop ACTION with its arguments SOURCE and DESTINATION."
292 (if (> (car action) 0)
293 (if (symbol-function (cdr action))
294 (eval (list (cdr action) 'source 'destination))
295 (error "Error: Action %s isn't a valid function!" (cdr action)))
296 (message "No valid action defined for this source and this destination!")))
297
298 (defun idd-mouse-drag-and-drop (source-event)
299 "Performs a drag and drop action.
300 At first you must click on the source and after that on the destination."
301 (interactive "@e")
302 (let ((source (list (cons ':buffer (current-buffer))
303 (cons ':drag-or-drop-point
304 (event-closest-point source-event))
305 (cons ':region-active (if (region-active-p)
306 (cons (point)
307 (mark))))))
308 (destination nil)
309 (destination-event))
310 (if (adapt-xemacsp)
311 (dispatch-event (next-command-event)))
312 (setq destination-event
313 (next-command-event nil "Drag&Drop: Click on the destination!"))
314 (cond ((button-press-event-p destination-event)
315 (setq destination (list (cons ':buffer
316 (event-buffer destination-event))
317 (cons ':drag-or-drop-point
318 (event-closest-point
319 destination-event))
320 (cons ':region-active nil)))
321 (if (adapt-emacs19p)
322 (while (not (button-release-event-p (next-command-event)))))
323 (idd-call-action (idd-get-action source destination idd-actions)
324 source
325 destination))
326 (t (setq action "Wrong event") nil))))
327
328
329 (provide 'internal-drag-and-drop)