Mercurial > hg > xemacs-beta

comparison lisp/dragdrop.el @ 288:e11d67e05968 r21-0b42

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-0b42
author cvs
date Mon, 13 Aug 2007 10:35:54 +0200
parents 558f606b08ae
children c9fe270a4101
comparison
equal deleted inserted replaced
287:13a0bd77a29d 288:e11d67e05968
35 (provide 'dragdrop) 35 (provide 'dragdrop)
36 36
37 ;; I think this is a better name for the custom group 37 ;; I think this is a better name for the custom group
38 ;; looks better in the menu and the group display as dragdrop 38 ;; looks better in the menu and the group display as dragdrop
39 ;; Anyway: is dragdrop- a good prefix for all this? 39 ;; Anyway: is dragdrop- a good prefix for all this?
40 ;; What if someone type drop<TAB> into the minibuffer? 40 ;; What if someone trys drop<TAB> in the minibuffer?
41 (defgroup drag-n-drop nil 41 (defgroup drag-n-drop nil
42 "Window system-independent drag'n'drop support." 42 "Window system-independent drag'n'drop support."
43 :group 'editing) 43 :group 'editing)
44 44
45 (defcustom dragdrop-drop-at-point nil 45 (defcustom dragdrop-drop-at-point nil
81 (const super))) 81 (const super)))
82 (repeat :inline t :value nil :tag "Extra Function Arguments" 82 (repeat :inline t :value nil :tag "Extra Function Arguments"
83 (sexp :tag "Arg" :value nil))) 83 (sexp :tag "Arg" :value nil)))
84 :value '(nil t t)) 84 :value '(nil t t))
85 85
86 ;; button and widget selectors are still "shaky":
87 ;; button may be a number or t (or nil?), t means "Ignore"
88 ;; mods may be t or nil or a list of mod-syms, t means "Ignore"
89 ;; but this seems to be a porblem for the widget, well perhaps I find
90 ;; a solution...
91 (defcustom dragdrop-drop-functions '((dragdrop-drop-url-default t t) 86 (defcustom dragdrop-drop-functions '((dragdrop-drop-url-default t t)
92 (dragdrop-drop-mime-default t t)) 87 (dragdrop-drop-mime-default t t))
93 "This is the standart drop function search list. 88 "This is the standart drop function search list.
94 Each element is a list of a function, a button selector, a modifier 89 Each element is a list of a function, a button selector, a modifier
95 selector and optional argumets to the function call. 90 selector and optional argumets to the function call.
117 :type 'string) 112 :type 'string)
118 113
119 (defvar dragdrop-drop-log-buffer nil 114 (defvar dragdrop-drop-log-buffer nil
120 "Buffer to log drops in debug mode.") 115 "Buffer to log drops in debug mode.")
121 116
117 ;;
118 ;; Drop API
119 ;;
122 (defun dragdrop-drop-dispatch (object) 120 (defun dragdrop-drop-dispatch (object)
123 "This function identifies DROP type misc-user-events. 121 "This function identifies DROP type misc-user-events.
124 It calls functions which will handle the drag." 122 It calls functions which will handle the drag."
125 (let ((event current-mouse-event)) 123 (let ((event current-mouse-event))
126 (and dragdrop-drop-log 124 (and dragdrop-drop-log
229 "Default handler for dropped URL data. 227 "Default handler for dropped URL data.
230 Finds files and URLs. Returns nil if object does not contain URL data." 228 Finds files and URLs. Returns nil if object does not contain URL data."
231 (cond ((eq (car object) 'dragdrop-URL) 229 (cond ((eq (car object) 'dragdrop-URL)
232 (let ((data (cdr object)) 230 (let ((data (cdr object))
233 (frame (event-channel event)) 231 (frame (event-channel event))
234 (x pop-up-windows)) 232 (x pop-up-windows)
233 (window (event-window event)))
235 (setq pop-up-windows nil) 234 (setq pop-up-windows nil)
236 (while (not (eq data ())) 235 (while (not (eq data ()))
237 (cond ((dragdrop-is-some-url "file" (car data)) 236 (cond ((dragdrop-is-some-url "file" (car data))
238 ;; if it is some file, pop it to a buffer 237 ;; if it is some file, pop it to a buffer
239 (pop-to-buffer (find-file-noselect 238 (cond (window
240 (substring (car data) 5)) 239 (select-window window)))
241 nil frame)) 240 (switch-to-buffer (find-file-noselect
241 (substring (car data) 5))))
242 ;; to-do: open ftp URLs with efs... 242 ;; to-do: open ftp URLs with efs...
243 (t 243 (t
244 ;; some other URL, try to fire up some browser for it 244 ;; some other URL, try to fire up some browser for it
245 (if (boundp 'browse-url-browser-function) 245 (if (boundp 'browse-url-browser-function)
246 (funcall browse-url-browser-function (car data)) 246 (funcall browse-url-browser-function (car data))
337 (if (not (string= (substring method -1) ":")) 337 (if (not (string= (substring method -1) ":"))
338 (setq method (concat method ":"))) 338 (setq method (concat method ":")))
339 (string= method (substring url 0 (length method)))) 339 (string= method (substring url 0 (length method))))
340 (t nil))) 340 (t nil)))
341 341
342 ;;
343 ;; Drag API
344 ;;
345 (defun dragdrop-drag (event object)
346 "The generic drag function.
347 Tries to do the best with object in the selected protocol.
348 Object must comply to the standart drag'n'drop object
349 format."
350 (error "Not implemented"))
351
352 (defun dragdrop-drag-region (event begin end)
353 "Drag a region.
354 This function uses special data types if the low-level
355 protocol requires it. It does so by calling
356 dragdrop-drag-pure-text."
357 (dragdrop-drag-pure-text event
358 (buffer-substring-no-properties begin end)))
359
360 (defun dragdrop-drag-pure-text (event text)
361 "Drag text-only data.
362 Takes care of special low-level protocol data types.
363 Text must be a list of strings."
364 (error "Not implemented"))
365
366 (defun dragdrop-drag-pure-file (event file)
367 "Drag filepath-only data.
368 Takes care of special low-level protocol data types.
369 file must be a list of strings."
370 (error "Not implemented"))
371
372 ;;
373 ;; The following ones come from frame.el but the better belong here
374 ;; until changed
375 ;;
376 (defun cde-start-drag (event type data)
377 "Implement the CDE drag operation.
378 Calls the internal function cde-start-drag-internal to do the actual work."
379 (interactive "_eXX")
380 (if (featurep 'cde)
381 ;; Avoid build-time doc string warning by calling the function
382 ;; in the following roundabout way:
383 (funcall (intern "cde-start-drag-internal")
384 event type data)
385 (error "CDE functionality not compiled in.")))
386
387 (defun cde-start-drag-region (event begin end)
388 "Implement the CDE drag operation for a region.
389 Calls the internal function CDE-start-drag-internal to do the actual work.
390 This always does buffer transfers."
391 ;; Oliver Graf <ograf@fga.de>
392 (interactive "_er")
393 (if (featurep 'cde)
394 (funcall (intern "cde-start-drag-internal")
395 event nil (list (buffer-substring-no-properties begin end)))
396 (error "CDE functionality not compiled in.")))
397
398 ;; the OffiX drag stuff will soon move also (perhaps mouse.el)
399 ;; if the drag event is done
400 (defun offix-start-drag (event data &optional type)
401 "Implement the OffiX drag operation.
402 Calls the internal function offix-start-drag-internal to do the actual work.
403 If type is not given, DndText is assumed."
404 ;; Oliver Graf <ograf@fga.de>
405 (interactive "esi")
406 (if (featurep 'offix)
407 (funcall (intern "offix-start-drag-internal") event data type)
408 (error "OffiX functionality not compiled in.")))
409
410 (defun offix-start-drag-region (event begin end)
411 "Implement the OffiX drag operation for a region.
412 Calls the internal function offix-start-drag-internal to do the actual work.
413 This always assumes DndText as type."
414 ;; Oliver Graf <ograf@fga.de>
415 (interactive "_er")
416 (if (featurep 'offix)
417 (funcall (intern "offix-start-drag-internal")
418 event (buffer-substring-no-properties begin end))
419 (error "OffiX functionality not compiled in.")))
420
421
342 ;;; dragdrop.el ends here 422 ;;; dragdrop.el ends here