Mercurial > hg > xemacs-beta

comparison tests/Dnd/droptest.el @ 284:558f606b08ae r21-0b40

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-0b40
author cvs
date Mon, 13 Aug 2007 10:34:13 +0200
parents c42ec1d1cded
children e11d67e05968
comparison
equal deleted inserted replaced
283:fa3d41851a08 284:558f606b08ae
1 ;; a short example how to use the new Drag'n'Drop API in 1 ;; a short example how to use the new Drag'n'Drop API in
2 ;; combination with extents. 2 ;; combination with extents.
3 ;; 3 ;;
4 4
5 (defun dnd-drop-somewhere (object) 5 (defun dnd-drop-message (event object text)
6 (message "Dropped somewhere else with :%s" object) 6 (message "Dropped %s with :%s" text object)
7 t) 7 t)
8 8
9 (defun do-nothing (object) 9 (defun do-nothing (event object)
10 nil) 10 nil)
11 11
12 (defun dnd-target1 (object) 12 (defun start-drag (event what &optional typ)
13 (message "Drop on target1 with: %s" object) 13 (cond ((featurep 'offix)
14 t) 14 (if (numberp typ)
15 15 (offix-start-drag event what typ)
16 (defun dnd-target2 (object) 16 (offix-start-drag event what)))
17 (message "Drop on target2 with: %s" object) 17 ((featurep 'cde)
18 t) 18 (funcall (intern "cde-start-drag-internal") what))
19 19 (t display-message 'error "no valid drag protocols implemented")))
20 (defun dnd-target3 (object)
21 (message "Drop on target3 with: %s" object)
22 t)
23 20
24 (defun make-drop-targets () 21 (defun make-drop-targets ()
25 (let ((buf (get-buffer-create "*DND misc-user extent test buffer*")) 22 (let ((buf (get-buffer-create "*DND misc-user extent test buffer*"))
26 (s nil) 23 (s nil)
27 (e nil)) 24 (e nil))
29 (pop-to-buffer buf) 26 (pop-to-buffer buf)
30 (setq s (point)) 27 (setq s (point))
31 (insert "[ DROP TARGET 1]") 28 (insert "[ DROP TARGET 1]")
32 (setq e (point)) 29 (setq e (point))
33 (setq ext (make-extent s e)) 30 (setq ext (make-extent s e))
34 (set-extent-property ext 'dragdrop-drop-functions '(do-nothing dnd-target1)) 31 (set-extent-property ext
32 'dragdrop-drop-functions
33 '((do-nothing t t)
34 (dnd-drop-message t t "on target 1")))
35 (set-extent-property ext 'mouse-face 'highlight) 35 (set-extent-property ext 'mouse-face 'highlight)
36 (insert " ") 36 (insert " ")
37 (setq s (point)) 37 (setq s (point))
38 (insert "[ DROP TARGET 2]") 38 (insert "[ DROP TARGET 2]")
39 (setq e (point)) 39 (setq e (point))
40 (setq ext (make-extent s e)) 40 (setq ext (make-extent s e))
41 (set-extent-property ext 'dragdrop-drop-functions '(dnd-target2)) 41 (set-extent-property ext
42 'dragdrop-drop-functions
43 '((dnd-drop-message t t "on target 2")))
42 (set-extent-property ext 'mouse-face 'highlight) 44 (set-extent-property ext 'mouse-face 'highlight)
43 (insert " ") 45 (insert " ")
44 (setq s (point)) 46 (setq s (point))
45 (insert "[ DROP TARGET 3]") 47 (insert "[ DROP TARGET 3]")
46 (setq e (point)) 48 (setq e (point))
47 (setq ext (make-extent s e)) 49 (setq ext (make-extent s e))
48 (set-extent-property ext 'dragdrop-drop-functions '(dnd-target3)) 50 (set-extent-property ext
51 'dragdrop-drop-functions
52 '((dnd-drop-message t t "on target 3")))
49 (set-extent-property ext 'mouse-face 'highlight) 53 (set-extent-property ext 'mouse-face 'highlight)
50 (newline 2))) 54 (newline 2)))
51 55
52 (defun make-drag-starters () 56 (defun make-drag-starters ()
53 (let ((buf (get-buffer-create "*DND misc-user extent test buffer*")) 57 (let ((buf (get-buffer-create "*DND misc-user extent test buffer*"))
97 (set-extent-property ext 'keymap kmap) 101 (set-extent-property ext 'keymap kmap)
98 (newline 3))) 102 (newline 3)))
99 103
100 (defun text-drag (event) 104 (defun text-drag (event)
101 (interactive "@e") 105 (interactive "@e")
102 (offix-start-drag event "That's a test")) 106 (start-drag event "That's a test"))
103 107
104 (defun file-drag (event) 108 (defun file-drag (event)
105 (interactive "@e") 109 (interactive "@e")
106 (offix-start-drag event "/tmp/printcap" 2)) 110 (start-drag event "/tmp/printcap" 2))
107 111
108 (defun url-drag (event) 112 (defun url-drag (event)
109 (interactive "@e") 113 (interactive "@e")
110 (offix-start-drag event "http://www.xemacs.org/" 8)) 114 (start-drag event "http://www.xemacs.org/" 8))
111 115
112 (defun files-drag (event) 116 (defun files-drag (event)
113 (interactive "@e") 117 (interactive "@e")
114 (offix-start-drag event '("/tmp/dragtest" "/tmp/droptest" "/tmp/printcap") 3)) 118 (start-drag event '("/tmp/dragtest" "/tmp/droptest" "/tmp/printcap") 3))
115 119
116 (setq dragdrop-drop-functions '(do-nothing dnd-drop-somewhere do-nothing)) 120 (setq dragdrop-drop-functions '((do-nothing t t)
121 (dnd-drop-message 2 t "region somewhere else")
122 (dnd-drop-message 1 t "drag-source somewhere else")
123 (do-nothing t t)))
117 (make-drag-starters) 124 (make-drag-starters)
118 (make-drop-targets) 125 (make-drop-targets)