diff lisp/hm--html-menus/internal-drag-and-drop.el @ 153:25f70ba0133c r20-3b3

Import from CVS: tag r20-3b3
author cvs
date Mon, 13 Aug 2007 09:38:25 +0200
parents 9f59509498e1
children 6075d714658b
line wrap: on
line diff
--- a/lisp/hm--html-menus/internal-drag-and-drop.el	Mon Aug 13 09:37:21 2007 +0200
+++ b/lisp/hm--html-menus/internal-drag-and-drop.el	Mon Aug 13 09:38:25 2007 +0200
@@ -1,4 +1,4 @@
-;;; $Id: internal-drag-and-drop.el,v 1.3 1997/03/28 02:28:42 steve Exp $
+;;; $Id: internal-drag-and-drop.el,v 1.4 1997/05/29 23:49:44 steve Exp $
 ;;; 
 ;;; Copyright (C) 1996, 1997 Heiko Muenkel
 ;;; email: muenkel@tnt.uni-hannover.de
@@ -67,16 +67,46 @@
 ;;;	The variable `idd-global-mouse-keys' defines the mouse keys,
 ;;;	which are bound to the drag and drop command.
 ;;;
+;;;	The variable `idd-global-help-mouse-keys' defines the mouse keys,
+;;;	which are bound to the drag and drop help command.
+;;;
 ;;;	The variable `idd-drag-and-drop-mouse-binding-type' determines
 ;;;	if you've to hold a mouse button down during moving the mouse
 ;;;	from the source to the destination or not.
 ;;;
+;;;	Emacs 19 users should read carefully the whole comments of
+;;;	`idd-drag-and-drop-mouse-binding-type', `idd-global-mouse-keys'
+;;;	and `idd-global-help-mouse-keys', if they would like to change
+;;;	any of these variables or the mouse bindings!
+;;;
 
 (require 'adapt)
 (require 'cl)
 
+(defvar idd-drag-and-drop-mouse-binding-type 'click
+  "*The type of the drag and drop mouse binding.
+The value maybe `click' or `press-button-during-move'.
+A value of `click' means, that you've to click over the source, leave
+the button and click it again over the destination.
+A value of `press-button-during-move' means, that you've to press
+the button down over the source and hold it until the mouse pointer
+is over the destination.
+
+The disadvantage of the `press-button-during-move' type compared with 
+the `click' type is, that you can't select a destination region and 
+therefore a drag and drop action depending on a selected region can't
+be started with that type of mouse binding.
+
+Note: In the Emacs 19 you'll have to change also the keybindings of
+the drag and drop commands, if you change this variable. Look at the
+variables `idd-global-mouse-keys' and `idd-global-help-mouse-keys' for
+this.")
+
 (defvar idd-global-mouse-keys (if (adapt-emacs19p)
-				  [(meta control mouse-1)]
+				  (if (eq idd-drag-and-drop-mouse-binding-type
+					  'click)
+				      [(meta control mouse-1)]
+				    [(meta control down-mouse-1)])
 				[(meta control button1)])
   "The mouse keys for the command `idd-mouse-drag-and-drop'.
 The command `idd-mouse-drag-and-drop' is bound during the loading
@@ -86,11 +116,21 @@
 Set it to nil, if you don't want to bind this function during loading.
 
 If the command is already bound in the global keymap during loading,
-then this key sequence will not be bind.")
+then this key sequence will not be bind.
 
-(defvar idd-global-help-mouse-keys (if (adapt-emacs19p)
-				       [(meta control mouse-3)]
-				     [(meta control button3)])
+Note: In the Emacs 19 the mouse keys must contain the modifier
+`down', if `idd-drag-and-drop-mouse-binding-type' is set to 
+`press-button-during-move' and must not contain the modifier, if it
+is set to `click'. If you set `idd-drag-and-drop-mouse-binding-type'
+before loading the package internal-drag-and-drop, the mouse will
+be bind in the right way.")
+
+(defvar idd-global-help-mouse-keys
+  (if (adapt-emacs19p)
+      (if (eq idd-drag-and-drop-mouse-binding-type 'click)
+	  [(meta control mouse-3)]
+	[(meta control down-mouse-3)])
+    [(meta control button3)])
   "The mouse keys for the command `idd-help-mouse-drag-and-drop'.
 The command `idd-help-mouse-drag-and-drop' is bound during the loading
 of the package internal-drag-and-drop to this keys in the global
@@ -99,21 +139,14 @@
 Set it to nil, if you don't want to bind this function during loading.
 
 If the command is already bound in the global keymap during loading,
-then this key sequence will not be bind.")
+then this key sequence will not be bind.
 
-(defvar idd-drag-and-drop-mouse-binding-type 'click
-  "*The type of the drag and drop mouse binding.
-The value maybe `click or 'press-button-during-move.
-A value of `click means, that you've to click over the source, leave
-the button and click it again over the destination.
-A value of 'press-button-during-move means, that you've to press
-the button down over the source and hold it until the mouse pointer
-is over the destination.
-
-The disadvantage of the `press-button-during-move' type compared with 
-the `click' type is, that you can't select a destination region and 
-therefore a drag and drop action depending on a selected region can't
-be started with that type of mouse binding.")
+Note: In the Emacs 19 the mouse keys must contain the modifier
+`down', if `idd-drag-and-drop-mouse-binding-type' is set to 
+`press-button-during-move' and must not contain the modifier, if it
+is set to `click'. If you set `idd-drag-and-drop-mouse-binding-type'
+before loading the package internal-drag-and-drop, the mouse will
+be bind in the right way.")
 
 (defvar idd-actions '((((idd-if-region-active-p . nil))
 		       (((idd-if-region-active-p . t))
@@ -295,18 +328,24 @@
 ;  "Parse PATH according to ange-ftp-path-format (which see).
 ;Returns a list (HOST USER PATH), or nil if PATH does not match the format.")
 
+(defun idd-get-buffer (source-or-destination)
+  "Returns the buffer of the SOURCE-OR-DESTINATION."
+  (cdr (assoc ':buffer source-or-destination)))
+
 (defun idd-set-point (source-or-destination)
   "Sets the point and buffer to SOURCE-OR-DESTINATION."
-  (set-buffer (cdr (assoc ':buffer source-or-destination)))
+  (set-buffer (idd-get-buffer source-or-destination))
   (goto-char (cdr (assoc ':drag-or-drop-point source-or-destination))))
 
 (defun idd-set-region (source-or-destination)
   "Sets the point, mark and buffer to SOURCE-OR-DESTINATION.
 The region is active after this function is called."
-  (set-buffer (cdr (assoc ':buffer source-or-destination)))
+  (set-buffer (idd-get-buffer source-or-destination))
   (goto-char (car (cdr (assoc ':region-active source-or-destination))))
   (set-mark (cdr (cdr (assoc ':region-active source-or-destination))))
-  (activate-region))
+  (if (adapt-xemacsp)
+      (activate-region))
+  )
 
 
 ;;; Specification type functions for the list `idd-actions'
@@ -349,7 +388,7 @@
   "Checks, if the major mode of SOURCE-OR-DESTINATION is MODE.
 It returns 1, if that is t and nil otherwise."
   (save-excursion
-    (set-buffer (cdr (assoc ':buffer source-or-destination)))
+    (set-buffer (idd-get-buffer source-or-destination))
     (if (eq major-mode mode)
 	1
       nil)))
@@ -358,7 +397,7 @@
   "Checks, if the variable named VARIABLE isn't t in  SOURCE-OR-DESTINATION.
 It returns 1, if this is t."
   (save-excursion
-    (set-buffer (cdr (assoc ':buffer source-or-destination)))
+    (set-buffer (idd-get-buffer source-or-destination))
     (if (eval variable)
 	1
       nil)))
@@ -398,7 +437,7 @@
 
 (defun idd-get-local-filename (source-or-destination)
   "Returns the filename of a local file specified by SOURCE-OR-DESTINATION."
-  (buffer-file-name (cdr (assoc ':buffer source-or-destination))))
+  (buffer-file-name (idd-get-buffer source-or-destination)))
 
 (defun idd-get-directory-of-buffer (source-or-destination)
   "Returns the directory name assigned to the SOURCE-OR-DESTINATION buffer."
@@ -421,7 +460,7 @@
   "Checks, if SOURCE-OR-DESTINATION has a buffer called BUFFER-NAME.
 It returns 1 if this is the case or nil otherwise."
   (if (string= buffer-name
-	       (buffer-name (cdr (assoc ':buffer source-or-destination))))
+	       (buffer-name (idd-get-buffer source-or-destination)))
       1
     nil))
 
@@ -528,8 +567,10 @@
 		  (setq idd-help-start-extent (make-extent start (point)))
 		  (set-extent-mouse-face idd-help-start-extent 'highlight)
 		  (set-extent-face idd-help-start-extent 'bold)
-		  (set-extent-keymap idd-help-start-extent
-				     idd-help-start-action-keymap)
+		  (if (adapt-xemacsp)
+		      (set-extent-keymap idd-help-start-extent
+					 idd-help-start-action-keymap)
+		    )
 		  )
 		(insert "'\n")
 		(insert (format "Source buffer       : `%s'\n"
@@ -573,7 +614,12 @@
     (setq source-event
 	  (next-command-event nil drag-and-drop-message))
     (if (button-press-event-p source-event)
-	(idd-mouse-drag-and-drop source-event)
+	(progn
+	  (when (and (adapt-emacs19p)
+		     (mouse-event-p source-event)
+		     (eq idd-drag-and-drop-mouse-binding-type 'click))
+	    (while (not (button-release-event-p (next-command-event)))))
+	  (idd-mouse-drag-and-drop source-event)) 
       (message "Wrong event! Exit drag and drop."))))
 
 (defun idd-help-mouse-drag-and-drop (source-event)
@@ -641,7 +687,9 @@
     (setq destination-event 
 	  (next-command-event nil drag-and-drop-message))
     (message "")
-    (cond ((button-release-event-p destination-event)
+    (cond ((or (button-release-event-p destination-event)
+	       (and (adapt-emacs19p)
+		    (button-drag-event-p destination-event)))
 	   (setq destination (idd-get-source-or-destination-alist
 			      destination-event))
 	   (idd-set-point destination)
@@ -667,8 +715,8 @@
 	(destination nil)
 	(destination-event))
     (message drag-and-drop-message)
-    (if (and (adapt-xemacsp) (mouse-event-p source-event))
-	(dispatch-event (next-command-event)))
+    (when (and (adapt-xemacsp) (mouse-event-p source-event))
+      (dispatch-event (next-command-event)))
     (setq destination-event 
 	  (next-command-event nil drag-and-drop-message))
     (message "")
@@ -677,8 +725,8 @@
 	   (setq destination (idd-get-source-or-destination-alist
 			      destination-event))
 	   (idd-set-point destination)
-	   (if (adapt-emacs19p)
-	       (while (not (button-release-event-p (next-command-event)))))
+;	   (when (adapt-emacs19p)
+;	       (while (not (button-release-event-p (next-command-event)))))
 	   (if idd-help-instead-of-action
 	       (idd-display-help-about-action (idd-get-action source
 							      destination
@@ -702,7 +750,13 @@
 	     (idd-call-action (idd-get-action source destination idd-actions)
 			      source
 			      destination)))
-	  (t (message "Wrong event! Exit drag and drop.") nil))))
+	  (t (message "Wrong event! Exit drag and drop.") nil))
+
+    ;; Useful for debugging
+    ;;    (setq idd-last-source source)
+    ;;    (setq idd-last-destination destination)
+
+    ))
 
 (defun idd-help-start-action (event)
   "Used to start the action from the help buffer."