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

Import from CVS: tag r21-0b40
author cvs
date Mon, 13 Aug 2007 10:34:13 +0200
parents c42ec1d1cded
children e11d67e05968
line wrap: on
line diff
--- a/tests/Dnd/droptest.el	Mon Aug 13 10:33:19 2007 +0200
+++ b/tests/Dnd/droptest.el	Mon Aug 13 10:34:13 2007 +0200
@@ -2,24 +2,21 @@
 ;; combination with extents.
 ;;
 
-(defun dnd-drop-somewhere (object)
-  (message "Dropped somewhere else with :%s" object)
+(defun dnd-drop-message (event object text)
+  (message "Dropped %s with :%s" text object)
   t)
 
-(defun do-nothing (object)
+(defun do-nothing (event object)
   nil)
 
-(defun dnd-target1 (object)
-  (message "Drop on target1 with: %s" object)
-  t)
-
-(defun dnd-target2 (object)
-  (message "Drop on target2 with: %s" object)
-  t)
-
-(defun dnd-target3 (object)
-  (message "Drop on target3 with: %s" object)
-  t)
+(defun start-drag (event what &optional typ)
+  (cond ((featurep 'offix)
+	 (if (numberp typ)
+	     (offix-start-drag event what typ)
+	   (offix-start-drag event what)))
+	((featurep 'cde)
+	 (funcall (intern "cde-start-drag-internal") what))
+	(t display-message 'error "no valid drag protocols implemented")))
 
 (defun make-drop-targets ()
   (let ((buf (get-buffer-create "*DND misc-user extent test buffer*"))
@@ -31,21 +28,28 @@
     (insert "[ DROP TARGET 1]")
     (setq e (point))
     (setq ext (make-extent s e))
-    (set-extent-property ext 'dragdrop-drop-functions '(do-nothing dnd-target1))
+    (set-extent-property ext
+			 'dragdrop-drop-functions
+			 '((do-nothing t t)
+			   (dnd-drop-message t t "on target 1")))
     (set-extent-property ext 'mouse-face 'highlight)
     (insert "    ")
     (setq s (point))
     (insert "[ DROP TARGET 2]")
     (setq e (point))
     (setq ext (make-extent s e))
-    (set-extent-property ext 'dragdrop-drop-functions '(dnd-target2))
+    (set-extent-property ext
+			 'dragdrop-drop-functions
+			 '((dnd-drop-message t t "on target 2")))
     (set-extent-property ext 'mouse-face 'highlight)
     (insert "    ")
     (setq s (point))
     (insert "[ DROP TARGET 3]")
     (setq e (point))
     (setq ext (make-extent s e))
-    (set-extent-property ext 'dragdrop-drop-functions '(dnd-target3))
+    (set-extent-property ext
+			 'dragdrop-drop-functions
+			 '((dnd-drop-message t t "on target 3")))
     (set-extent-property ext 'mouse-face 'highlight)
     (newline 2)))
 
@@ -99,20 +103,23 @@
     
 (defun text-drag (event)
   (interactive "@e")
-  (offix-start-drag event "That's a test"))
+  (start-drag event "That's a test"))
 
 (defun file-drag (event)
   (interactive "@e")
-  (offix-start-drag event "/tmp/printcap" 2))
+  (start-drag event "/tmp/printcap" 2))
 
 (defun url-drag (event)
   (interactive "@e")
-  (offix-start-drag event "http://www.xemacs.org/" 8))
+  (start-drag event "http://www.xemacs.org/" 8))
 
 (defun files-drag (event)
   (interactive "@e")
-  (offix-start-drag event '("/tmp/dragtest" "/tmp/droptest" "/tmp/printcap") 3))
+  (start-drag event '("/tmp/dragtest" "/tmp/droptest" "/tmp/printcap") 3))
 
-(setq dragdrop-drop-functions '(do-nothing dnd-drop-somewhere do-nothing))
+(setq dragdrop-drop-functions '((do-nothing t t)
+				(dnd-drop-message 2 t "region somewhere else")
+				(dnd-drop-message 1 t "drag-source somewhere else")
+				(do-nothing t t)))
 (make-drag-starters)
 (make-drop-targets)