Mercurial > hg > xemacs-beta

comparison tests/Dnd/droptest.el @ 290:c9fe270a4101 r21-0b43

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-0b43
author cvs
date Mon, 13 Aug 2007 10:36:47 +0200
parents e11d67e05968
children
comparison
equal deleted inserted replaced
289:6e6992ccc4b6 290:c9fe270a4101
21 (if (not typ) 21 (if (not typ)
22 (funcall (intern "cde-start-drag-internal") event nil (list what)) 22 (funcall (intern "cde-start-drag-internal") event nil (list what))
23 (funcall (intern "cde-start-drag-internal") event t what))) 23 (funcall (intern "cde-start-drag-internal") event t what)))
24 (t display-message 'error "no valid drag protocols implemented"))) 24 (t display-message 'error "no valid drag protocols implemented")))
25 25
26 (defun start-region-drag (event)
27 (interactive "_e")
28 (if (click-inside-extent-p event zmacs-region-extent)
29 ;; okay, this is a drag
30 (cond ((featurep 'offix)
31 (offix-start-drag-region event
32 (extent-start-position zmacs-region-extent)
33 (extent-end-position zmacs-region-extent)))
34 ((featurep 'cde)
35 ;; should also work with CDE
36 (cde-start-drag-region event
37 (extent-start-position zmacs-region-extent)
38 (extent-end-position zmacs-region-extent)))
39 (t (error "No offix or CDE support compiled in")))))
40
26 (defun make-drop-targets () 41 (defun make-drop-targets ()
27 (let ((buf (get-buffer-create "*DND misc-user extent test buffer*")) 42 (let ((buf (get-buffer-create "*DND misc-user extent test buffer*"))
28 (s nil) 43 (s nil)
29 (e nil)) 44 (e nil))
30 (set-buffer buf) 45 (set-buffer buf)
32 (setq s (point)) 47 (setq s (point))
33 (insert "[ DROP TARGET 1]") 48 (insert "[ DROP TARGET 1]")
34 (setq e (point)) 49 (setq e (point))
35 (setq ext (make-extent s e)) 50 (setq ext (make-extent s e))
36 (set-extent-property ext 51 (set-extent-property ext
37 'dragdrop-drop-functions 52 'experimental-dragdrop-drop-functions
38 '((do-nothing t t) 53 '((do-nothing t t)
39 (dnd-drop-message t t "on target 1"))) 54 (dnd-drop-message t t "on target 1")))
40 (set-extent-property ext 'mouse-face 'highlight) 55 (set-extent-property ext 'mouse-face 'highlight)
41 (insert " ") 56 (insert " ")
42 (setq s (point)) 57 (setq s (point))
43 (insert "[ DROP TARGET 2]") 58 (insert "[ DROP TARGET 2]")
44 (setq e (point)) 59 (setq e (point))
45 (setq ext (make-extent s e)) 60 (setq ext (make-extent s e))
46 (set-extent-property ext 61 (set-extent-property ext
47 'dragdrop-drop-functions 62 'experimental-dragdrop-drop-functions
48 '((dnd-drop-message t t "on target 2"))) 63 '((dnd-drop-message t t "on target 2")))
49 (set-extent-property ext 'mouse-face 'highlight) 64 (set-extent-property ext 'mouse-face 'highlight)
50 (insert " ") 65 (insert " ")
51 (setq s (point)) 66 (setq s (point))
52 (insert "[ DROP TARGET 3]") 67 (insert "[ DROP TARGET 3]")
53 (setq e (point)) 68 (setq e (point))
54 (setq ext (make-extent s e)) 69 (setq ext (make-extent s e))
55 (set-extent-property ext 70 (set-extent-property ext
56 'dragdrop-drop-functions 71 'experimental-dragdrop-drop-functions
57 '((dnd-drop-message t t "on target 3"))) 72 '((dnd-drop-message t t "on target 3")))
58 (set-extent-property ext 'mouse-face 'highlight) 73 (set-extent-property ext 'mouse-face 'highlight)
59 (newline 2))) 74 (newline 2)))
60 75
61 (defun make-drag-starters () 76 (defun make-drag-starters ()
123 (interactive "@e") 138 (interactive "@e")
124 (start-drag event "That's a test")) 139 (start-drag event "That's a test"))
125 140
126 (defun file-drag (event) 141 (defun file-drag (event)
127 (interactive "@e") 142 (interactive "@e")
128 (start-drag event "/tmp/printcap" 2)) 143 (start-drag event "/tmp/DropTest.xpm" 2))
129 144
130 (defun cde-file-drag (event) 145 (defun cde-file-drag (event)
131 (interactive "@e") 146 (interactive "@e")
132 (start-drag event '("/tmp/printcap") t)) 147 (start-drag event '("/tmp/DropTest.xpm") t))
133 148
134 (defun url-drag (event) 149 (defun url-drag (event)
135 (interactive "@e") 150 (interactive "@e")
136 (start-drag event "http://www.xemacs.org/" 8)) 151 (start-drag event "http://www.xemacs.org/" 8))
137 152
138 (defun files-drag (event) 153 (defun files-drag (event)
139 (interactive "@e") 154 (interactive "@e")
140 (start-drag event '("/tmp/dragtest" "/tmp/droptest" "/tmp/printcap") 3)) 155 (start-drag event '("/tmp/DropTest.html" "/tmp/DropTest.xpm" "/tmp/DropTest.tex") 3))
141 156
142 (setq dragdrop-drop-functions '((do-nothing t t) 157 (setq experimental-dragdrop-drop-functions '((do-nothing t t)
143 ;; CDE does not have any button info... 158 ;; CDE does not have any button info...
144 (dnd-drop-message 0 t "cde-drop somewhere else") 159 (dnd-drop-message 0 t "cde-drop somewhere else")
145 (dnd-drop-message 2 t "region somewhere else") 160 (dnd-drop-message 2 t "region somewhere else")
146 (dnd-drop-message 1 t "drag-source somewhere else") 161 (dnd-drop-message 1 t "drag-source somewhere else")
147 (do-nothing t t))) 162 (do-nothing t t)))
156 171
157 (setq lmap (make-keymap)) 172 (setq lmap (make-keymap))
158 (use-local-map lmap) 173 (use-local-map lmap)
159 (local-set-key [q] 'end-dnd-demo) 174 (local-set-key [q] 'end-dnd-demo)
160 (setq button2-func (lookup-key global-map [button2])) 175 (setq button2-func (lookup-key global-map [button2]))
161 (global-unset-key [button2]) 176 (global-set-key [button2] 'start-region-drag)