--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/lisp/hm--html-menus/internal-drag-and-drop.el	Mon Aug 13 08:46:35 2007 +0200
@@ -0,0 +1,329 @@
+;;; $Id: internal-drag-and-drop.el,v 1.1.1.1 1996/12/18 03:46:48 steve Exp $
+;;; 
+;;; Copyright (C) 1996 Heiko Muenkel
+;;; email: muenkel@tnt.uni-hannover.de
+;;;
+;;;  This program is free software; you can redistribute it and/or modify
+;;;  it under the terms of the GNU General Public License as published by
+;;;  the Free Software Foundation; either version 1, or (at your option)
+;;;  any later version.
+;;;
+;;;  This program is distributed in the hope that it will be useful,
+;;;  but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;;  GNU General Public License for more details.
+;;;
+;;;  You should have received a copy of the GNU General Public License
+;;;  along with this program; if not, write to the Free Software
+;;;  Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+;;;
+;;; 
+;;; Description:
+;;;
+;;;	This package provides functions to define and call internal
+;;;	drag and drop actions in the emacs. One could start such an 
+;;;	action by clicking with the mouse in the source buffer and 
+;;;	then in the destination buffer. The action could depend on
+;;;	the points where youve clicked with the mouse, on the state
+;;;	of the region, the point, the mark and any other properties
+;;;	of the source and the destination buffers. The actions are
+;;;	defined by the variable `idd-actions', which is a buffer local
+;;;	variable. The following is an example for the html-mode:
+;;;	(defvar html-idd-actions
+;;;	  '((nil (((idd-major-mode-p . dired-mode)
+;;;		   (idd-dired-file-on-line-p . ".*\\.\\(gif\\)\\|\\(jpq\\)"))
+;;;		  hm--html-idd-add-include-image-from-dired-line)
+;;;		 (((idd-major-mode-p . dired-mode)
+;;;		   (idd-dired-no-file-on-line-p . nil))
+;;;		  hm--html-idd-add-file-link-to-file-on-dired-line)
+;;;		 (((idd-major-mode-p . dired-mode)
+;;;		   (idd-dired-no-file-on-line-p . t))
+;;;		  hm--html-idd-add-file-link-to-directory-of-buffer)
+;;;		 (((idd-major-mode-p . w3-mode)
+;;;		   (idd-url-at-point-p . t))
+;;;		  hm--html-idd-add-html-link-from-w3-buffer-point)
+;;;		 (((idd-major-mode-p . w3-mode))
+;;;		  hm--html-idd-add-html-link-to-w3-buffer)
+;;;		 (((idd-local-file-p . t))
+;;;		  hm--html-idd-add-file-link-to-buffer)))
+;;;	Look at the variable `idd-actions' for further descriptions.
+;;;
+;;;	
+;;; 
+;;; Installation: 
+;;;   
+;;;	Put this file in one of your load path directories.
+;;;	
+;;;	Put the following in your .emacs:
+;;;	(autoload 'idd-mouse-drag-and-drop "internal-drag-and-drop"
+;;;	   "Performs a drag and drop action.
+;;;         At first you must click on the source and 
+;;;         after that on the destination."
+;;;	   t)
+;;;	(define-key global-map [(meta button1)] 'idd-mouse-drag-and-drop)
+;;;	
+;;;	Define actions in the variable `idd-actions'.
+;;;
+
+(defvar idd-actions nil
+  "The list with actions, depending on the source and the destination.
+The list looks like:
+  '((<source-specification-1> (<destination-specification-1> <action-1-1>)
+                              (<destination-specification-2> <action-1-2>)
+                              :
+     )
+    (<source-specification-2> (<destination-specification-1> <action-2-1>)
+                              (<destination-specification-2> <action-2-2>)
+                              :
+     )
+    :
+    )
+The <source-specification> looks like the following:
+  '([(<specification-type> <value>)])
+with <specification-type> :== idd-minor-mode-p | idd-buffer-name-p
+			      | idd-region-active-p ...
+
+The <destination-specification> looks like <source-specification>, except
+that a valid <specification-type> is also idd-major-mode-p.
+
+If <source-specification-1> or <destination-specification-1> is set to
+nil, then every source or destination matches. `idd-actions' is a
+buffer local variable, which should be at least mode depended. So if
+the <source-specification-1> is set to nil it says, that the source
+buffer must only have a specific mode. But however, it's also possible
+to define a general `idd-actions' list, where the source mode is
+specified by idd-major-mode-p.
+
+<action> ist a function, which has two arguments, the specifies the
+source and the second the destination.")
+
+(make-variable-buffer-local 'idd-actions)
+
+(defun idd-compare-a-specification (source-or-destination
+				    specification)
+  "Tests if SOURCE-OR-DESTINATION matches the SPECIFICATION.
+It returns a value (1 in general) if both are matching or nil."
+  (eval (list (car specification)
+	      'source-or-destination
+	      '(cdr specification))))
+
+(defun idd-compare-specifications-1 (source-or-destination
+				    specifications
+				    value)
+  "Internal function of `idd-compare-specifications'.
+VALUE is the value of the last matches."
+  (cond ((not specifications) value)
+	(t (let ((match (idd-compare-a-specification source-or-destination
+						     (car specifications))))
+	     (cond ((not match) 0)
+		   (t (idd-compare-specifications-1 source-or-destination
+						    (cdr specifications)
+						    (+ value match))))))))
+
+(defun idd-compare-specifications (source-or-destination
+				  specifications)
+  "Determines how good SOURCE-OR-DESTINATION and SPECIFICATIONS are matching.
+A return value of zero means, that they don't match. The higher the
+return value the better is the matching."
+  (cond ((not specifications) 1)
+	(t (idd-compare-specifications-1 source-or-destination
+					specifications
+					0))))
+
+(defun idd-get-action-depending-on-destination (destination
+						actions-depending-on-dest
+						source-value
+						value-action-pair)
+  "Internal function of `idd-get-action-depending-on-source-and-destination'."
+  (let ((destination-value (idd-compare-specifications
+			    destination
+			    (car (car actions-depending-on-dest)))))
+    (cond ((not actions-depending-on-dest) value-action-pair)
+	  ((or (= destination-value 0)
+	       (<= (+ source-value destination-value) (car value-action-pair)))
+	   (idd-get-action-depending-on-destination 
+	    destination
+	    (cdr actions-depending-on-dest)
+	    source-value
+	    value-action-pair))
+	  (t (idd-get-action-depending-on-destination 
+	      destination
+	      (cdr actions-depending-on-dest)
+	      source-value
+	      (cons (+ source-value destination-value)
+		    (second (car actions-depending-on-dest))))))))
+
+(defun idd-get-action-depending-on-source-and-destination (source
+							   destination
+							   actions
+							   value-action-pair)
+  "Internal function of `idd-get-action'.
+VALUE-ACTION-PAIR is a list like (<value> <action>).
+It returns VALUE-ACTION-PAIR, if no other action is found, which has a
+value higher than (car VALUE-ACTION-PAIR)."
+  (let ((source-value (idd-compare-specifications source (car (car actions)))))
+    (cond ((not actions) value-action-pair)
+	  ((= source-value 0)
+	   (idd-get-action-depending-on-source-and-destination
+	    source
+	    destination
+	    (cdr actions)
+	    value-action-pair))
+	  (t (idd-get-action-depending-on-source-and-destination
+	      source
+	      destination
+	      (cdr actions)
+	      (idd-get-action-depending-on-destination
+	       destination
+	       (cdr (car actions))
+	       source-value
+	       value-action-pair))))))
+
+(defun idd-get-action (source destination actions)
+  "Returns the action, which depends on the SOURCE and the DESTINATION.
+The list ACTIONS contains all possible actions. Look at the variable
+`idd-actions' for a description of the format of this list."
+  (idd-get-action-depending-on-source-and-destination source
+						      destination
+						      actions
+						      '(0 . nil)))
+
+(defun idd-get-buffer-url (source-or-destination)
+  "Returns the URL of the buffer specified by SOURCE-OR-DESTINATION."
+  (save-excursion
+    (idd-set-point source-or-destination)
+    (url-view-url t)))
+
+(defun idd-get-url-at-point (source-or-destination)
+  "Returns the URL at the point specified by SOURCE-OR-DESTINATION.
+It returns nil, if there is no URL."
+  (save-excursion
+    (idd-set-point source-or-destination)
+    (w3-view-this-url t)))
+
+(defun idd-url-at-point-p (source-or-destination value)
+  "Checks if there is an URL at the point of SOURCE-OR-DESTINATION.
+If that is t and VALUE is t, or that is nil and VALUE is nil, then 1
+is returned. Otherwise nil is returned."
+  (if value
+      (if (idd-get-url-at-point source-or-destination)
+	  1
+	nil)
+    (if (idd-get-url-at-point source-or-destination)
+	nil
+      1)))
+
+(defun idd-major-mode-p (source-or-destination mode)
+  "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)))
+    (if (eq major-mode mode)
+	1
+      nil)))
+
+(defun idd-set-point (source-or-destination)
+  "Sets the point and buffer to SOURCE-OR-DESTINATION."
+  (set-buffer (cdr (assoc ':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)))
+  (goto-char (car (cdr (assoc ':region-active source-or-destination))))
+  (set-mark (cdr (cdr (assoc ':region-active source-or-destination))))
+  (activate-region))
+
+(defun idd-get-dired-filename-from-line (source-or-destination)
+  "Returns the filename form the line in a dired buffer.
+The position and the buffer is specified by SOURCE-OR-DESTINATION."
+  (save-excursion
+    (idd-set-point source-or-destination)
+    (dired-get-filename nil t)))
+
+(defun idd-dired-file-on-line-p (source-or-destination filename-regexp)
+  "Checks, if the filename on the line match FILENAME-REGEXP.
+The function `dired-get-filename' is used, to get the filename from
+the SOURCE-OR-DESTINATION. It returns 1, if it matchs or nil."
+  (let ((case-fold-search t))
+    (if (and (idd-get-dired-filename-from-line source-or-destination)
+	     (string-match filename-regexp
+			   (idd-get-dired-filename-from-line
+			    source-or-destination)))
+	1
+      nil)))
+	       
+(defun idd-dired-no-file-on-line-p (source-or-destination value)
+  "Checks, if a filename is in the dired buffer of SOURCE-OR-DESTINATION.
+It returns 1, if a filename is on the line and if VALUE is t, or if
+no filename is on the line and VALUE is nil, otherwise it returns
+nil. For the test the function `dired-get-filename' is used."
+  (if (idd-get-dired-filename-from-line source-or-destination)
+      (if value nil 1)
+    (if value 1 nil)))
+
+(autoload 'ange-ftp-ftp-path "ange-ftp"
+  "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-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))))
+
+(defun idd-get-directory-of-buffer (source-or-destination)
+  "Returns the directory name assigned to the SOURCE-OR-DESTINATION buffer."
+  (save-excursion
+    (idd-set-point source-or-destination)
+    default-directory))
+
+(defun idd-local-file-p (source-or-destination value)
+  "Checks, if SOURCE-OR-DESTINATION has a file on the local filesystem.
+If that is t and VALUE is t, or that is nil and VALUE is nil, then 1
+is returned. Otherwise nil is returned."
+  (let ((filename (idd-get-local-filename source-or-destination)))
+    (if (and filename
+	     (not (ange-ftp-ftp-path filename)))
+	(if value 1 nil)
+      (if value nil 1))))
+
+(defun idd-call-action (action source destination)
+  "Calls the drag and drop ACTION with its arguments SOURCE and DESTINATION."
+  (if (> (car action) 0)
+      (if (symbol-function (cdr action))
+	  (eval (list (cdr action) 'source 'destination))
+	(error "Error: Action %s isn't a valid function!" (cdr action)))
+    (message "No valid action defined for this source and this destination!")))
+
+(defun idd-mouse-drag-and-drop (source-event)
+  "Performs a drag and drop action.
+At first you must click on the source and after that on the destination."
+  (interactive "@e")
+  (let ((source (list (cons ':buffer (current-buffer))
+		      (cons ':drag-or-drop-point
+			    (event-closest-point source-event))
+		      (cons ':region-active (if (region-active-p)
+						(cons (point)
+						      (mark))))))
+	(destination nil)
+	(destination-event))
+    (if (adapt-xemacsp)
+	(dispatch-event (next-command-event)))
+    (setq destination-event 
+	  (next-command-event nil "Drag&Drop: Click on the destination!"))
+    (cond ((button-press-event-p destination-event)
+	   (setq destination (list (cons ':buffer 
+					 (event-buffer destination-event))
+				   (cons ':drag-or-drop-point 
+					 (event-closest-point 
+					  destination-event))
+				   (cons ':region-active nil)))
+	   (if (adapt-emacs19p)
+	       (while (not (button-release-event-p (next-command-event)))))
+	   (idd-call-action (idd-get-action source destination idd-actions)
+			    source
+			    destination))
+	  (t (setq action "Wrong event") nil))))
+
+
+(provide 'internal-drag-and-drop)