|
98
|
1 ;;; $Id: internal-drag-and-drop.el,v 1.2 1997/02/15 22:21:05 steve Exp $
|
|
2
|
2 ;;;
|
|
98
|
3 ;;; Copyright (C) 1996, 1997 Heiko Muenkel
|
|
2
|
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
|
|
98
|
27 ;;; the points where you've clicked with the mouse, on the state
|
|
2
|
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
|
|
98
|
31 ;;; variable. The following is an example for the hm--html-mode:
|
|
|
32 ;;; (defvar hm--html-idd-actions
|
|
|
33 ;;; '((nil (((idd-if-major-mode-p . dired-mode)
|
|
|
34 ;;; (idd-if-dired-file-on-line-p
|
|
|
35 ;;; . ".*\\.\\(gif\\)\\|\\(jpq\\)"))
|
|
2
|
36 ;;; hm--html-idd-add-include-image-from-dired-line)
|
|
98
|
37 ;;; (((idd-if-major-mode-p . dired-mode)
|
|
|
38 ;;; (idd-if-dired-no-file-on-line-p . nil))
|
|
2
|
39 ;;; hm--html-idd-add-file-link-to-file-on-dired-line)
|
|
98
|
40 ;;; (((idd-if-major-mode-p . dired-mode)
|
|
|
41 ;;; (idd-if-dired-no-file-on-line-p . t))
|
|
2
|
42 ;;; hm--html-idd-add-file-link-to-directory-of-buffer)
|
|
98
|
43 ;;; (((idd-if-major-mode-p . w3-mode)
|
|
|
44 ;;; (idd-if-url-at-point-p . t))
|
|
2
|
45 ;;; hm--html-idd-add-html-link-from-w3-buffer-point)
|
|
98
|
46 ;;; (((idd-if-major-mode-p . w3-mode))
|
|
2
|
47 ;;; hm--html-idd-add-html-link-to-w3-buffer)
|
|
98
|
48 ;;; (((idd-if-local-file-p . t))
|
|
2
|
49 ;;; hm--html-idd-add-file-link-to-buffer)))
|
|
|
50 ;;; Look at the variable `idd-actions' for further descriptions.
|
|
|
51 ;;;
|
|
|
52 ;;;
|
|
|
53 ;;;
|
|
|
54 ;;; Installation:
|
|
|
55 ;;;
|
|
|
56 ;;; Put this file in one of your load path directories.
|
|
|
57 ;;;
|
|
|
58 ;;; Put the following in your .emacs:
|
|
|
59 ;;; (autoload 'idd-mouse-drag-and-drop "internal-drag-and-drop"
|
|
|
60 ;;; "Performs a drag and drop action.
|
|
|
61 ;;; At first you must click on the source and
|
|
|
62 ;;; after that on the destination."
|
|
|
63 ;;; t)
|
|
|
64 ;;;
|
|
|
65 ;;; Define actions in the variable `idd-actions'.
|
|
|
66 ;;;
|
|
98
|
67 ;;; The variable `idd-global-mouse-keys' defines the mouse keys,
|
|
|
68 ;;; which are bound to the drag and drop command.
|
|
|
69 ;;;
|
|
|
70 ;;; The variable `idd-drag-and-drop-mouse-binding-type' determines
|
|
|
71 ;;; if you've to hold a mouse button down during moving the mouse
|
|
|
72 ;;; from the source to the destination or not.
|
|
|
73 ;;;
|
|
2
|
74
|
|
98
|
75 (require 'adapt)
|
|
|
76 (require 'cl)
|
|
|
77
|
|
|
78 (defvar idd-global-mouse-keys (if (adapt-emacs19p)
|
|
|
79 [(meta control mouse-1)]
|
|
|
80 [(meta control button1)])
|
|
|
81 "The mouse keys for the command `idd-mouse-drag-and-drop'.
|
|
|
82 The command `idd-mouse-drag-and-drop' is bound during the loading
|
|
|
83 of the package internal-drag-and-drop to this keys in the global
|
|
|
84 key map.
|
|
|
85
|
|
|
86 Set it to nil, if you don't want to bind this function during loading.
|
|
|
87
|
|
|
88 If the command is already bound in the global keymap during loading,
|
|
|
89 then this key sequence will not be bind.")
|
|
|
90
|
|
|
91 (defvar idd-global-help-mouse-keys (if (adapt-emacs19p)
|
|
|
92 [(meta control mouse-3)]
|
|
|
93 [(meta control button3)])
|
|
|
94 "The mouse keys for the command `idd-help-mouse-drag-and-drop'.
|
|
|
95 The command `idd-mouse-drag-and-drop' is bound during the loading
|
|
|
96 of the package internal-drag-and-drop to this keys in the global
|
|
|
97 key map.
|
|
|
98
|
|
|
99 Set it to nil, if you don't want to bind this function during loading.
|
|
|
100
|
|
|
101 If the command is already bound in the global keymap during loading,
|
|
|
102 then this key sequence will not be bind.")
|
|
|
103
|
|
|
104 (defvar idd-drag-and-drop-mouse-binding-type 'click
|
|
|
105 "*The type of the drag and drop mouse binding.
|
|
|
106 The value maybe `click or 'press-button-during-move.
|
|
|
107 A value of `click means, that you've to click over the source, leave
|
|
|
108 the button and click it again over the destination.
|
|
|
109 A value of 'press-button-during-move means, that you've to press
|
|
|
110 the button down over the source and hold it until the mouse pointer
|
|
|
111 is over the destination.
|
|
|
112
|
|
|
113 The disadvantage of the `press-button-during-move' type compared with
|
|
|
114 the `click' type is, that you can't select a destination region and
|
|
|
115 therefore a drag and drop action depending on a selected region can't
|
|
|
116 be started with that type of mouse binding.")
|
|
|
117
|
|
|
118 (defvar idd-actions '((((idd-if-region-active-p . nil))
|
|
|
119 (((idd-if-region-active-p . t))
|
|
|
120 idd-action-copy-region))
|
|
|
121
|
|
|
122 (((idd-if-region-active-p . t))
|
|
|
123 (((idd-if-region-active-p . t))
|
|
|
124 idd-action-copy-replace-region))
|
|
|
125
|
|
|
126 (((idd-if-region-active-p . nil)
|
|
|
127 (idd-if-modifiers-p . nil))
|
|
|
128 (((idd-if-region-active-p . t))
|
|
|
129 idd-action-move-region))
|
|
|
130
|
|
|
131 (((idd-if-region-active-p . t)
|
|
|
132 (idd-if-modifiers-p . nil))
|
|
|
133 (((idd-if-region-active-p . t))
|
|
|
134 idd-action-move-replace-region))
|
|
|
135 )
|
|
2
|
136 "The list with actions, depending on the source and the destination.
|
|
|
137 The list looks like:
|
|
98
|
138 '((<destination-specification-1> (<source-specification-1> <action-1-1>)
|
|
|
139 (<source-specification-2> <action-1-2>)
|
|
|
140 :
|
|
2
|
141 )
|
|
98
|
142 (<destination-specification-2> (<source-specification-1> <action-2-1>)
|
|
|
143 (<source-specification-2> <action-2-2>)
|
|
|
144 :
|
|
2
|
145 )
|
|
|
146 :
|
|
|
147 )
|
|
|
148 The <source-specification> looks like the following:
|
|
|
149 '([(<specification-type> <value>)])
|
|
98
|
150 with <specification-type> :== idd-if-minor-mode-p | idd-if-buffer-name-p
|
|
|
151 | idd-if-region-active-p | idd-if-url-at-point-p
|
|
|
152 | idd-if-major-mode-p | idd-if-variable-non-nil-p
|
|
|
153 | idd-if-dired-file-on-line-p
|
|
|
154 | idd-if-dired-no-file-on-line-p
|
|
|
155 | idd-if-local-file-p | idd-if-buffer-name-p
|
|
|
156 | idd-if-modifiers-p | ...
|
|
2
|
157
|
|
98
|
158 The <specification-type> - functions must have two arguments, the first one
|
|
|
159 is the source or destination and the second is the <value>. It must return
|
|
|
160 nil, if the test wasn't successfull and a number (in general 1), which
|
|
|
161 specifies the weight of the test function. The weights of all single tests
|
|
|
162 are added to a summary weight and assigned to the action. The action
|
|
|
163 with the highest weight is called from the action handler. Look at
|
|
|
164 the definition of `idd-if-major-mode-p', `idd-if-minor-mode-p' and so on for
|
|
|
165 examples. Look at the function `idd-get-source-or-destination-alist', if
|
|
|
166 you wan't to know the structure of the 'source-or-destination' argument
|
|
|
167 of these functions.
|
|
|
168
|
|
|
169 The <destination-specification> looks like <source-specification>,
|
|
|
170 but in general it could be set to nil in mode specific idd-action
|
|
|
171 lists.
|
|
|
172
|
|
|
173 If <destination-specification-1> or <source-specification-1> is set to
|
|
|
174 nil, then every source or source matches. `idd-actions' is a
|
|
70
|
175 buffer local variable, which should be at least mode depended. So if
|
|
98
|
176 the <destination-specification-1> is set to nil it says, that the destination
|
|
70
|
177 buffer must only have a specific mode. But however, it's also possible
|
|
98
|
178 to define a general `idd-actions' list, where the destination mode is
|
|
|
179 specified by `idd-if-major-mode-p'.
|
|
22
|
180
|
|
98
|
181 <action> ist a function, which has two arguments, the first specifies the
|
|
|
182 source and the second the destination. Look at the function definition
|
|
|
183 of `idd-action-copy-region' and `idd-action-copy-replace-region'. They are
|
|
|
184 examples for such actions.")
|
|
2
|
185
|
|
|
186 (make-variable-buffer-local 'idd-actions)
|
|
|
187
|
|
98
|
188 (defvar idd-help-instead-of-action nil
|
|
|
189 "*If this variable is t, then a help buffer is displayed.
|
|
|
190 No action will be performed if this variable is t.")
|
|
|
191
|
|
|
192 (defvar idd-help-start-action-keymap nil
|
|
|
193 "Keymap used in an extent in the help buffer to start the action.")
|
|
|
194
|
|
|
195 (defvar idd-help-source nil
|
|
|
196 "Contains the source of an action. Used only in the help buffer.")
|
|
|
197
|
|
|
198 (defvar idd-help-destination nil
|
|
|
199 "Contains the destination of an action. Used only in the help buffer.")
|
|
|
200
|
|
|
201 (defvar idd-help-start-extent nil
|
|
|
202 "The start extent in the help buffer.")
|
|
|
203
|
|
2
|
204 (defun idd-compare-a-specification (source-or-destination
|
|
|
205 specification)
|
|
|
206 "Tests if SOURCE-OR-DESTINATION matches the SPECIFICATION.
|
|
|
207 It returns a value (1 in general) if both are matching or nil."
|
|
|
208 (eval (list (car specification)
|
|
|
209 'source-or-destination
|
|
|
210 '(cdr specification))))
|
|
|
211
|
|
|
212 (defun idd-compare-specifications-1 (source-or-destination
|
|
98
|
213 specifications
|
|
|
214 value)
|
|
2
|
215 "Internal function of `idd-compare-specifications'.
|
|
|
216 VALUE is the value of the last matches."
|
|
|
217 (cond ((not specifications) value)
|
|
|
218 (t (let ((match (idd-compare-a-specification source-or-destination
|
|
|
219 (car specifications))))
|
|
|
220 (cond ((not match) 0)
|
|
|
221 (t (idd-compare-specifications-1 source-or-destination
|
|
|
222 (cdr specifications)
|
|
|
223 (+ value match))))))))
|
|
|
224
|
|
|
225 (defun idd-compare-specifications (source-or-destination
|
|
98
|
226 specifications)
|
|
2
|
227 "Determines how good SOURCE-OR-DESTINATION and SPECIFICATIONS are matching.
|
|
|
228 A return value of zero means, that they don't match. The higher the
|
|
|
229 return value the better is the matching."
|
|
|
230 (cond ((not specifications) 1)
|
|
|
231 (t (idd-compare-specifications-1 source-or-destination
|
|
98
|
232 specifications
|
|
|
233 0))))
|
|
2
|
234
|
|
98
|
235 (defun idd-get-action-depending-on-source (source
|
|
|
236 actions-depending-on-source
|
|
|
237 destination-value
|
|
|
238 value-action-pair)
|
|
2
|
239 "Internal function of `idd-get-action-depending-on-source-and-destination'."
|
|
98
|
240 (let ((source-value (idd-compare-specifications
|
|
|
241 source
|
|
|
242 (car (car actions-depending-on-source)))))
|
|
|
243 (cond ((not actions-depending-on-source) value-action-pair)
|
|
|
244 ((or (= source-value 0)
|
|
|
245 (<= (+ destination-value source-value) (car value-action-pair)))
|
|
|
246 (idd-get-action-depending-on-source
|
|
|
247 source
|
|
|
248 (cdr actions-depending-on-source)
|
|
|
249 destination-value
|
|
2
|
250 value-action-pair))
|
|
98
|
251 (t (idd-get-action-depending-on-source
|
|
|
252 source
|
|
|
253 (cdr actions-depending-on-source)
|
|
|
254 destination-value
|
|
|
255 (cons (+ destination-value source-value)
|
|
|
256 (second (car actions-depending-on-source))))))))
|
|
2
|
257
|
|
|
258 (defun idd-get-action-depending-on-source-and-destination (source
|
|
|
259 destination
|
|
|
260 actions
|
|
|
261 value-action-pair)
|
|
|
262 "Internal function of `idd-get-action'.
|
|
|
263 VALUE-ACTION-PAIR is a list like (<value> <action>).
|
|
|
264 It returns VALUE-ACTION-PAIR, if no other action is found, which has a
|
|
|
265 value higher than (car VALUE-ACTION-PAIR)."
|
|
98
|
266 (let ((destination-value
|
|
|
267 (idd-compare-specifications destination (car (car actions)))))
|
|
2
|
268 (cond ((not actions) value-action-pair)
|
|
98
|
269 ((= destination-value 0)
|
|
2
|
270 (idd-get-action-depending-on-source-and-destination
|
|
|
271 source
|
|
|
272 destination
|
|
|
273 (cdr actions)
|
|
|
274 value-action-pair))
|
|
|
275 (t (idd-get-action-depending-on-source-and-destination
|
|
|
276 source
|
|
|
277 destination
|
|
|
278 (cdr actions)
|
|
98
|
279 (idd-get-action-depending-on-source
|
|
|
280 source
|
|
2
|
281 (cdr (car actions))
|
|
98
|
282 destination-value
|
|
2
|
283 value-action-pair))))))
|
|
|
284
|
|
|
285 (defun idd-get-action (source destination actions)
|
|
|
286 "Returns the action, which depends on the SOURCE and the DESTINATION.
|
|
|
287 The list ACTIONS contains all possible actions. Look at the variable
|
|
|
288 `idd-actions' for a description of the format of this list."
|
|
|
289 (idd-get-action-depending-on-source-and-destination source
|
|
|
290 destination
|
|
|
291 actions
|
|
|
292 '(0 . nil)))
|
|
|
293
|
|
98
|
294 (autoload 'ange-ftp-ftp-path "ange-ftp"
|
|
|
295 "Parse PATH according to ange-ftp-path-format (which see).
|
|
|
296 Returns a list (HOST USER PATH), or nil if PATH does not match the format.")
|
|
|
297
|
|
|
298 (defun idd-set-point (source-or-destination)
|
|
|
299 "Sets the point and buffer to SOURCE-OR-DESTINATION."
|
|
|
300 (set-buffer (cdr (assoc ':buffer source-or-destination)))
|
|
|
301 (goto-char (cdr (assoc ':drag-or-drop-point source-or-destination))))
|
|
|
302
|
|
|
303 (defun idd-set-region (source-or-destination)
|
|
|
304 "Sets the point, mark and buffer to SOURCE-OR-DESTINATION.
|
|
|
305 The region is active after this function is called."
|
|
|
306 (set-buffer (cdr (assoc ':buffer source-or-destination)))
|
|
|
307 (goto-char (car (cdr (assoc ':region-active source-or-destination))))
|
|
|
308 (set-mark (cdr (cdr (assoc ':region-active source-or-destination))))
|
|
|
309 (activate-region))
|
|
|
310
|
|
|
311
|
|
|
312 ;;; Specification type functions for the list `idd-actions'
|
|
|
313
|
|
|
314 (defun idd-if-region-active-p (source-or-destination value)
|
|
|
315 "Checks if the region in the SOURCE-OR-DESTINATION was active.
|
|
|
316 It returns 1, if the region was active and VALUE is t, or if
|
|
|
317 the region was not active and VALUE is nil. Otherwise it returns
|
|
|
318 nil."
|
|
|
319 (if (cdr (assoc ':region-active source-or-destination))
|
|
|
320 (if value 1 nil)
|
|
|
321 (if value nil 1)))
|
|
|
322
|
|
2
|
323 (defun idd-get-buffer-url (source-or-destination)
|
|
|
324 "Returns the URL of the buffer specified by SOURCE-OR-DESTINATION."
|
|
|
325 (save-excursion
|
|
|
326 (idd-set-point source-or-destination)
|
|
|
327 (url-view-url t)))
|
|
|
328
|
|
|
329 (defun idd-get-url-at-point (source-or-destination)
|
|
|
330 "Returns the URL at the point specified by SOURCE-OR-DESTINATION.
|
|
|
331 It returns nil, if there is no URL."
|
|
|
332 (save-excursion
|
|
|
333 (idd-set-point source-or-destination)
|
|
|
334 (w3-view-this-url t)))
|
|
|
335
|
|
98
|
336 (defun idd-if-url-at-point-p (source-or-destination value)
|
|
2
|
337 "Checks if there is an URL at the point of SOURCE-OR-DESTINATION.
|
|
|
338 If that is t and VALUE is t, or that is nil and VALUE is nil, then 1
|
|
|
339 is returned. Otherwise nil is returned."
|
|
|
340 (if value
|
|
|
341 (if (idd-get-url-at-point source-or-destination)
|
|
|
342 1
|
|
|
343 nil)
|
|
|
344 (if (idd-get-url-at-point source-or-destination)
|
|
|
345 nil
|
|
|
346 1)))
|
|
|
347
|
|
98
|
348 (defun idd-if-major-mode-p (source-or-destination mode)
|
|
2
|
349 "Checks, if the major mode of SOURCE-OR-DESTINATION is MODE.
|
|
|
350 It returns 1, if that is t and nil otherwise."
|
|
|
351 (save-excursion
|
|
|
352 (set-buffer (cdr (assoc ':buffer source-or-destination)))
|
|
|
353 (if (eq major-mode mode)
|
|
|
354 1
|
|
|
355 nil)))
|
|
|
356
|
|
98
|
357 (defun idd-if-variable-non-nil-p (source-or-destination variable)
|
|
|
358 "Checks, if the variable named VARIABLE isn't t in SOURCE-OR-DESTINATION.
|
|
|
359 It returns 1, if this is t."
|
|
|
360 (save-excursion
|
|
|
361 (set-buffer (cdr (assoc ':buffer source-or-destination)))
|
|
|
362 (if (eval variable)
|
|
|
363 1
|
|
|
364 nil)))
|
|
2
|
365
|
|
98
|
366 (defun idd-if-minor-mode-p (source-or-destination minor-mode-variable)
|
|
|
367 "Checks, if the variable MINOR-MODE-VARIABLE is t in SOURCE-OR-DESTINATION.
|
|
|
368 MINOR-MODE-VARIABLE is the name of the variable!."
|
|
|
369 (idd-variable-non-nil-p source-or-destination minor-mode-variable))
|
|
2
|
370
|
|
|
371 (defun idd-get-dired-filename-from-line (source-or-destination)
|
|
|
372 "Returns the filename form the line in a dired buffer.
|
|
|
373 The position and the buffer is specified by SOURCE-OR-DESTINATION."
|
|
|
374 (save-excursion
|
|
|
375 (idd-set-point source-or-destination)
|
|
|
376 (dired-get-filename nil t)))
|
|
|
377
|
|
98
|
378 (defun idd-if-dired-file-on-line-p (source-or-destination filename-regexp)
|
|
2
|
379 "Checks, if the filename on the line match FILENAME-REGEXP.
|
|
|
380 The function `dired-get-filename' is used, to get the filename from
|
|
|
381 the SOURCE-OR-DESTINATION. It returns 1, if it matchs or nil."
|
|
|
382 (let ((case-fold-search t))
|
|
|
383 (if (and (idd-get-dired-filename-from-line source-or-destination)
|
|
|
384 (string-match filename-regexp
|
|
|
385 (idd-get-dired-filename-from-line
|
|
|
386 source-or-destination)))
|
|
|
387 1
|
|
|
388 nil)))
|
|
|
389
|
|
98
|
390 (defun idd-if-dired-no-file-on-line-p (source-or-destination value)
|
|
2
|
391 "Checks, if a filename is in the dired buffer of SOURCE-OR-DESTINATION.
|
|
|
392 It returns 1, if a filename is on the line and if VALUE is t, or if
|
|
|
393 no filename is on the line and VALUE is nil, otherwise it returns
|
|
|
394 nil. For the test the function `dired-get-filename' is used."
|
|
|
395 (if (idd-get-dired-filename-from-line source-or-destination)
|
|
|
396 (if value nil 1)
|
|
|
397 (if value 1 nil)))
|
|
|
398
|
|
|
399 (defun idd-get-local-filename (source-or-destination)
|
|
|
400 "Returns the filename of a local file specified by SOURCE-OR-DESTINATION."
|
|
|
401 (buffer-file-name (cdr (assoc ':buffer source-or-destination))))
|
|
|
402
|
|
|
403 (defun idd-get-directory-of-buffer (source-or-destination)
|
|
|
404 "Returns the directory name assigned to the SOURCE-OR-DESTINATION buffer."
|
|
|
405 (save-excursion
|
|
|
406 (idd-set-point source-or-destination)
|
|
|
407 default-directory))
|
|
|
408
|
|
98
|
409 (defun idd-if-local-file-p (source-or-destination value)
|
|
2
|
410 "Checks, if SOURCE-OR-DESTINATION has a file on the local filesystem.
|
|
|
411 If that is t and VALUE is t, or that is nil and VALUE is nil, then 1
|
|
|
412 is returned. Otherwise nil is returned."
|
|
|
413 (let ((filename (idd-get-local-filename source-or-destination)))
|
|
|
414 (if (and filename
|
|
70
|
415 (not (ange-ftp-ftp-path filename)))
|
|
2
|
416 (if value 1 nil)
|
|
|
417 (if value nil 1))))
|
|
|
418
|
|
98
|
419 (defun idd-if-buffer-name-p (source-or-destination buffer-name)
|
|
|
420 "Checks, if SOURCE-OR-DESTINATION has a buffer called BUFFER-NAME.
|
|
|
421 It returns 1 if this is the case or nil otherwise."
|
|
|
422 (if (string= buffer-name
|
|
|
423 (buffer-name (cdr (assoc ':buffer source-or-destination))))
|
|
|
424 1
|
|
|
425 nil))
|
|
|
426
|
|
|
427 (defun idd-list-1-subset-of-list-2 (list-1 list-2)
|
|
|
428 "Returns t, if LIST-1 is a subset of LIST-2."
|
|
|
429 (cond ((not list-1))
|
|
|
430 ((member (car list-1 list-2))
|
|
|
431 (idd-list-1-subset-of-list-2 (cdr list-1) list-2))
|
|
|
432 (t nil)))
|
|
|
433
|
|
|
434 (defun idd-same-modifiers (list-1 list-2)
|
|
|
435 "Returns t, if both list have the same modifiers."
|
|
|
436 (and (length list-1 list-2)
|
|
|
437 (idd-list-1-subset-of-list-2 list-1-list-2)))
|
|
|
438
|
|
|
439 (defun idd-if-modifiers-p (source-or-destination modifiers)
|
|
|
440 "Checks, if the MODIFIERS hold during selecting the SOURCE-OR-DESTINATION.
|
|
|
441 Returns 1, if the list MODIFIERS contains the same modifiers,
|
|
|
442 or if any modyfiers are hold and MODIFIERS is t,
|
|
|
443 or if no modyfiers are hold and MODIFIERS is nil.
|
|
|
444 Otherwise nil is returned."
|
|
|
445 (let ((event-modifiers (event-modifiers
|
|
|
446 (cdr (assoc ':event source-or-destination)))))
|
|
|
447 (cond ((not modifiers)
|
|
|
448 (if event-modifiers nil 1))
|
|
|
449 ((listp modifiers)
|
|
|
450 (if (idd-same-elements modifiers event-modifiers)
|
|
|
451 1
|
|
|
452 nil))
|
|
|
453 (t (if event-modifiers 1 nil)))))
|
|
|
454
|
|
|
455 ;;; action functions
|
|
|
456
|
|
|
457 (defun idd-action-copy-region (source destination)
|
|
|
458 "Copy the region from DESTINATION to SOURCE."
|
|
|
459 (idd-set-region source)
|
|
|
460 (let ((region-contents (buffer-substring (point) (mark))))
|
|
|
461 (idd-set-point destination)
|
|
|
462 (insert region-contents)))
|
|
|
463
|
|
|
464 (defun idd-action-copy-replace-region (source destination)
|
|
|
465 "Copy the region from SOURCE and replace the DESTINATION region with it."
|
|
|
466 (idd-set-region source)
|
|
|
467 (let ((region-contents (buffer-substring (point) (mark))))
|
|
|
468 (idd-set-region destination)
|
|
|
469 (delete-region (point) (mark))
|
|
|
470 (insert region-contents)))
|
|
|
471
|
|
|
472 (defmacro* idd-with-source-and-destination (source
|
|
|
473 destination
|
|
|
474 &key
|
|
|
475 do-in-source
|
|
|
476 do-in-destination)
|
|
|
477 "Macro, usefull for the definition of action functions.
|
|
|
478 Look at the example `idd-action-move-region'."
|
|
|
479 `(progn
|
|
|
480 (if (idd-if-region-active-p ,source t)
|
|
|
481 (idd-set-region ,source)
|
|
|
482 (idd-set-point ,source))
|
|
|
483 ,(when do-in-source
|
|
|
484 (cons 'progn do-in-source))
|
|
|
485 (if (idd-if-region-active-p ,destination t)
|
|
|
486 (idd-set-region ,destination)
|
|
|
487 (idd-set-point ,destination))
|
|
|
488 ,(when do-in-destination
|
|
|
489 (cons 'progn do-in-destination))))
|
|
|
490
|
|
|
491 (defun idd-action-move-region (source destination)
|
|
|
492 "Move the region from SOURCE to DESTINATION."
|
|
|
493 (let ((region))
|
|
|
494 (idd-with-source-and-destination
|
|
|
495 source destination
|
|
|
496 :do-in-source ((setq region (buffer-substring (point) (mark)))
|
|
|
497 (delete-region (point) (mark)))
|
|
|
498 :do-in-destination ((insert region)))))
|
|
|
499
|
|
|
500
|
|
|
501 (defun idd-action-move-replace-region (source destination)
|
|
|
502 "Delete the region at SOURCE and overwrite the DESTINATION region with it."
|
|
|
503 (let ((region))
|
|
|
504 (idd-with-source-and-destination
|
|
|
505 source destination
|
|
|
506 :do-in-source ((setq region (buffer-substring (point) (mark)))
|
|
|
507 (delete-region (point) (mark)))
|
|
|
508 :do-in-destination ((delete-region (point) (mark))
|
|
|
509 (insert region)))))
|
|
|
510
|
|
|
511
|
|
|
512 ;;; Performing the drag and drop
|
|
|
513
|
|
|
514 (defun idd-display-help-about-action (action source destination)
|
|
|
515 "Display a help buffer with information about the action."
|
|
|
516 (if (> (car action) 0)
|
|
|
517 (if (symbol-function (cdr action))
|
|
|
518 (progn
|
|
|
519 (with-displaying-help-buffer
|
|
|
520 '(lambda ()
|
|
|
521 (set-buffer "*Help*")
|
|
|
522 (setq idd-help-source source)
|
|
|
523 (setq idd-help-destination destination)
|
|
|
524 (insert "Drag and drop action: `")
|
|
|
525 (let ((start (point)))
|
|
|
526 (insert (format "%s" (cdr action)))
|
|
|
527 (setq idd-help-start-extent (make-extent start (point)))
|
|
|
528 (set-extent-mouse-face idd-help-start-extent 'highlight)
|
|
|
529 (set-extent-face idd-help-start-extent 'bold)
|
|
|
530 (set-extent-keymap idd-help-start-extent
|
|
|
531 idd-help-start-action-keymap)
|
|
|
532 )
|
|
|
533 (insert "'\n")
|
|
|
534 (insert (format "Source buffer : `%s'\n"
|
|
|
535 (buffer-name (cdr (assoc ':buffer source)))))
|
|
|
536 (insert (format "Destination buffer : `%s'\n"
|
|
|
537 (buffer-name (cdr (assoc ':buffer destination))
|
|
|
538 )))
|
|
|
539 (insert "=================================================="
|
|
|
540 "====================\n")
|
|
|
541 (insert "Look at `idd-actions' in the "
|
|
|
542 "destination buffer for other actions!\n")
|
|
|
543 (insert (format "The documentation of `%s':\n\n"
|
|
|
544 (cdr action)))
|
|
|
545 (insert (documentation (cdr action)))))
|
|
|
546 )
|
|
|
547 (error "Error: Action %s isn't a valid function!" (cdr action)))
|
|
|
548 (message "No valid action defined for this source and this destination!")))
|
|
|
549
|
|
2
|
550 (defun idd-call-action (action source destination)
|
|
|
551 "Calls the drag and drop ACTION with its arguments SOURCE and DESTINATION."
|
|
|
552 (if (> (car action) 0)
|
|
|
553 (if (symbol-function (cdr action))
|
|
|
554 (eval (list (cdr action) 'source 'destination))
|
|
|
555 (error "Error: Action %s isn't a valid function!" (cdr action)))
|
|
|
556 (message "No valid action defined for this source and this destination!")))
|
|
|
557
|
|
98
|
558 (defun idd-start-help-mouse-drag-and-drop ()
|
|
|
559 "Starts help on `idd-start-mouse-drag-and-drop'."
|
|
|
560 (interactive)
|
|
|
561 (let ((idd-help-instead-of-action t))
|
|
|
562 (idd-start-mouse-drag-and-drop)))
|
|
|
563
|
|
|
564 (defun idd-start-mouse-drag-and-drop ()
|
|
|
565 "Starts a drag and drop command.
|
|
|
566 This command could be used to start a drag and drop command without a
|
|
|
567 button event. Therefore this should not be bind direct to a mouse button."
|
|
|
568 (interactive)
|
|
|
569 (let ((destination-event)
|
|
|
570 (drag-and-drop-message "Drag&Drop: Click on the source!"))
|
|
|
571 (message drag-and-drop-message)
|
|
|
572 (setq source-event
|
|
|
573 (next-command-event nil drag-and-drop-message))
|
|
|
574 (if (button-press-event-p source-event)
|
|
|
575 (idd-mouse-drag-and-drop source-event)
|
|
|
576 (message "Wrong event! Exit drag and drop."))))
|
|
|
577
|
|
|
578 (defun idd-help-mouse-drag-and-drop (source-event)
|
|
|
579 "Displays help about the drag and drop action."
|
|
|
580 (interactive "@e")
|
|
|
581 (let ((idd-help-instead-of-action t))
|
|
|
582 (idd-mouse-drag-and-drop source-event)))
|
|
|
583
|
|
2
|
584 (defun idd-mouse-drag-and-drop (source-event)
|
|
|
585 "Performs a drag and drop action.
|
|
98
|
586 It calls the command `idd-mouse-drag-and-drop-click' or
|
|
|
587 `idd-mouse-drag-and-drop-press-button-during-move' depending on
|
|
|
588 the value of `idd-drag-and-drop-mouse-binding-type'."
|
|
2
|
589 (interactive "@e")
|
|
98
|
590 (if (eq idd-drag-and-drop-mouse-binding-type 'click)
|
|
|
591 (idd-mouse-drag-and-drop-click source-event)
|
|
|
592 (idd-mouse-drag-and-drop-press-button-during-move source-event)))
|
|
|
593
|
|
|
594 (defun idd-get-source-or-destination-alist (event)
|
|
|
595 "Returns an alist with the description of a source or destination point.
|
|
|
596 The EVENT must be the button event, which has selected the source or
|
|
|
597 destination of the drag and drop command.
|
|
|
598
|
|
|
599 The alist has the following structure:
|
|
|
600 '((:buffer . <buffer-of-the-event>)
|
|
|
601 (:drag-or-drop-point . <closest-point-to-the-event>)
|
|
|
602 (:region-active . <t-or-nil>)
|
|
|
603 (:event . EVENT))
|
|
|
604
|
|
|
605 Note: <closest-point-to-the-event> is (event-closest-point EVENT),
|
|
|
606 if the EVENT is a mouse event and if it isn't nil. Otherwise the
|
|
|
607 point is used."
|
|
|
608 ; (set-buffer (event-buffer event))
|
|
|
609 (list (cons ':buffer (event-buffer event))
|
|
|
610 (cons ':drag-or-drop-point (set-marker
|
|
|
611 (make-marker)
|
|
|
612 (if (mouse-event-p event)
|
|
|
613 (or (event-closest-point event)
|
|
|
614 (point))
|
|
|
615 (point))))
|
|
|
616 (cons ':region-active (if (region-active-p)
|
|
|
617 (cons (set-marker (make-marker) (point))
|
|
|
618 (set-marker (make-marker) (mark)))))
|
|
|
619 (cons ':event event))
|
|
|
620 )
|
|
|
621
|
|
|
622 (defun idd-mouse-drag-and-drop-press-button-during-move (source-event)
|
|
|
623 "Performs a drag and drop action.
|
|
|
624 At first you must press the button down over the source and then
|
|
|
625 move with the pressed button to the destination, where you must leave
|
|
|
626 the button up.
|
|
|
627 This must be bind to a mouse button. The SOURCE-EVENT must be a
|
|
|
628 button-press-event.
|
|
|
629
|
|
|
630 The disadvantage of this command compared with the command
|
|
|
631 `idd-mouse-drag-and-drop-click' is, that you can't select a
|
|
|
632 destination region."
|
|
|
633 (interactive "@e")
|
|
|
634 (let ((drag-and-drop-message
|
|
|
635 "Drag&Drop: Leave the button over the destination!")
|
|
|
636 (source (idd-get-source-or-destination-alist source-event))
|
|
2
|
637 (destination nil)
|
|
|
638 (destination-event))
|
|
98
|
639 (message drag-and-drop-message)
|
|
|
640 (setq destination-event
|
|
|
641 (next-command-event nil drag-and-drop-message))
|
|
|
642 (message "")
|
|
|
643 (cond ((button-release-event-p destination-event)
|
|
|
644 (setq destination (idd-get-source-or-destination-alist
|
|
|
645 destination-event))
|
|
|
646 (idd-set-point destination)
|
|
|
647 (if idd-help-instead-of-action
|
|
|
648 (idd-display-help-about-action (idd-get-action source
|
|
|
649 destination
|
|
|
650 idd-actions)
|
|
|
651 source
|
|
|
652 destination)
|
|
|
653 (idd-call-action (idd-get-action source destination idd-actions)
|
|
|
654 source
|
|
|
655 destination)))
|
|
|
656 (t (message "Wrong event! Exit drag and drop.") nil))))
|
|
|
657
|
|
|
658 (defun idd-mouse-drag-and-drop-click (source-event)
|
|
|
659 "Performs a drag and drop action.
|
|
|
660 At first you must click on the source and after that on the destination.
|
|
|
661 This must be bind to a mouse button. The SOURCE-EVENT must be a
|
|
|
662 button-press-event."
|
|
|
663 (interactive "@e")
|
|
|
664 (let ((drag-and-drop-message "Drag&Drop: Click on the destination!")
|
|
|
665 (source (idd-get-source-or-destination-alist source-event))
|
|
|
666 (destination nil)
|
|
|
667 (destination-event))
|
|
|
668 (message drag-and-drop-message)
|
|
|
669 (if (and (adapt-xemacsp) (mouse-event-p source-event))
|
|
2
|
670 (dispatch-event (next-command-event)))
|
|
|
671 (setq destination-event
|
|
98
|
672 (next-command-event nil drag-and-drop-message))
|
|
|
673 (setq heiko source-event)
|
|
|
674 (message "")
|
|
2
|
675 (cond ((button-press-event-p destination-event)
|
|
98
|
676 (mouse-track destination-event)
|
|
|
677 (setq destination (idd-get-source-or-destination-alist
|
|
|
678 destination-event))
|
|
|
679 (idd-set-point destination)
|
|
2
|
680 (if (adapt-emacs19p)
|
|
|
681 (while (not (button-release-event-p (next-command-event)))))
|
|
98
|
682 (if idd-help-instead-of-action
|
|
|
683 (idd-display-help-about-action (idd-get-action source
|
|
|
684 destination
|
|
|
685 idd-actions)
|
|
|
686 source
|
|
|
687 destination)
|
|
|
688 (idd-call-action (idd-get-action source destination idd-actions)
|
|
|
689 source
|
|
|
690 destination)))
|
|
|
691 (t (message "Wrong event! Exit drag and drop.") nil))))
|
|
|
692
|
|
|
693 (defun idd-help-start-action (event)
|
|
|
694 "Used to start the action from the help buffer."
|
|
|
695 (interactive "@e")
|
|
|
696 (idd-set-point idd-help-destination)
|
|
|
697 (idd-call-action (idd-get-action idd-help-source
|
|
|
698 idd-help-destination
|
|
|
699 idd-actions)
|
|
|
700 idd-help-source
|
|
|
701 idd-help-destination)
|
|
|
702 (delete-extent idd-help-start-extent))
|
|
|
703
|
|
|
704 ;; keymap for help buffer extents
|
|
|
705 (if (not idd-help-start-action-keymap)
|
|
|
706 (progn
|
|
|
707 (setq idd-help-start-action-keymap
|
|
|
708 (make-sparse-keymap 'idd-help-start-action-keymap))
|
|
|
709 (if (adapt-emacs19p)
|
|
|
710 (define-key idd-help-start-action-keymap [(mouse-2)]
|
|
|
711 'idd-help-start-action)
|
|
|
712 (define-key idd-help-start-action-keymap "[(button2)]"
|
|
|
713 'idd-help-start-action))))
|
|
|
714
|
|
|
715 ;; global key bindings
|
|
|
716 (when idd-global-mouse-keys
|
|
|
717 (unless (where-is-internal 'idd-mouse-drag-and-drop global-map t)
|
|
|
718 (define-key global-map idd-global-mouse-keys 'idd-mouse-drag-and-drop))
|
|
|
719 (unless (where-is-internal 'idd-help-mouse-drag-and-drop global-map t)
|
|
|
720 (define-key global-map
|
|
|
721 idd-global-help-mouse-keys 'idd-help-mouse-drag-and-drop)))
|
|
2
|
722
|
|
|
723
|
|
|
724 (provide 'internal-drag-and-drop)
|
