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