Mercurial > hg > xemacs-beta
diff lisp/hm--html-menus/internal-drag-and-drop.el @ 177:6075d714658b r20-3b15
Import from CVS: tag r20-3b15
author | cvs |
---|---|
date | Mon, 13 Aug 2007 09:51:16 +0200 |
parents | 25f70ba0133c |
children |
line wrap: on
line diff
--- a/lisp/hm--html-menus/internal-drag-and-drop.el Mon Aug 13 09:50:16 2007 +0200 +++ b/lisp/hm--html-menus/internal-drag-and-drop.el Mon Aug 13 09:51:16 2007 +0200 @@ -1,89 +1,111 @@ -;;; $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 -;;; -;;; 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 you've 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 hm--html-mode: -;;; (defvar hm--html-idd-actions -;;; '((nil (((idd-if-major-mode-p . dired-mode) -;;; (idd-if-dired-file-on-line-p -;;; . ".*\\.\\(gif\\)\\|\\(jpq\\)")) -;;; hm--html-idd-add-include-image-from-dired-line) -;;; (((idd-if-major-mode-p . dired-mode) -;;; (idd-if-dired-no-file-on-line-p . nil)) -;;; hm--html-idd-add-file-link-to-file-on-dired-line) -;;; (((idd-if-major-mode-p . dired-mode) -;;; (idd-if-dired-no-file-on-line-p . t)) -;;; hm--html-idd-add-file-link-to-directory-of-buffer) -;;; (((idd-if-major-mode-p . w3-mode) -;;; (idd-if-url-at-point-p . t)) -;;; hm--html-idd-add-html-link-from-w3-buffer-point) -;;; (((idd-if-major-mode-p . w3-mode)) -;;; hm--html-idd-add-html-link-to-w3-buffer) -;;; (((idd-if-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 actions in the variable `idd-actions'. -;;; -;;; 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! -;;; +;;; internal-drag-and-drop.el --- Internal drag and drop interface + +;; Copyright (C) 1996, 1997 Heiko Muenkel + +;; Author: Heiko Muenkel <muenkel@tnt.uni-hannover.de> +;; Keywords: mouse + +;; $Id: internal-drag-and-drop.el,v 1.5 1997/07/26 22:09:46 steve Exp $ + +;; This file is part of XEmacs. + +;; XEmacs 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 2, or (at your +;; option) any later version. + +;; XEmacs 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 XEmacs; See the file COPYING. if not, write to the Free +;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA +;; 02111-1307, USA. + +;;; Synched up with: Not part of Emacs. + +;;; Commentary: + +;; 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 you've 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 hm--html-mode: +;; (defvar hm--html-idd-actions +;; '((nil (((idd-if-major-mode-p . dired-mode) +;; (idd-if-dired-file-on-line-p +;; . ".*\\.\\(gif\\)\\|\\(jpq\\)")) +;; hm--html-idd-add-include-image-from-dired-line) +;; (((idd-if-major-mode-p . dired-mode) +;; (idd-if-dired-no-file-on-line-p . nil)) +;; hm--html-idd-add-file-link-to-file-on-dired-line) +;; (((idd-if-major-mode-p . dired-mode) +;; (idd-if-dired-no-file-on-line-p . t)) +;; hm--html-idd-add-file-link-to-directory-of-buffer) +;; (((idd-if-major-mode-p . w3-mode) +;; (idd-if-url-at-point-p . t)) +;; hm--html-idd-add-html-link-from-w3-buffer-point) +;; (((idd-if-major-mode-p . w3-mode)) +;; hm--html-idd-add-html-link-to-w3-buffer) +;; (((idd-if-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 actions in the variable `idd-actions'. + +;; 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! + +;;; Code: (require 'adapt) (require 'cl) -(defvar idd-drag-and-drop-mouse-binding-type 'click +(defgroup idd-drag-and-drop nil + "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 you've 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." + :group 'mouse) + +(defcustom 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 @@ -100,7 +122,12 @@ 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.") +this." + :group 'idd-drag-and-drop + :type '(choice (const :tag "Click on source and destination" + :value click) + (const :tag "Press button during mouse move" + :value press-button-during-move))) (defvar idd-global-mouse-keys (if (adapt-emacs19p) (if (eq idd-drag-and-drop-mouse-binding-type @@ -148,25 +175,25 @@ 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)) - idd-action-copy-region)) - - (((idd-if-region-active-p . t)) - (((idd-if-region-active-p . t)) - idd-action-copy-replace-region)) - - (((idd-if-region-active-p . nil) - (idd-if-modifiers-p . nil)) - (((idd-if-region-active-p . t)) - idd-action-move-region)) - - (((idd-if-region-active-p . t) - (idd-if-modifiers-p . nil)) - (((idd-if-region-active-p . t)) - idd-action-move-replace-region)) - ) - "The list with actions, depending on the source and the destination. +(defcustom idd-actions '((((idd-if-region-active-p . nil)) + (((idd-if-region-active-p . t)) + idd-action-copy-region)) + + (((idd-if-region-active-p . t)) + (((idd-if-region-active-p . t)) + idd-action-copy-replace-region)) + + (((idd-if-region-active-p . nil) + (idd-if-modifiers-p . nil)) + (((idd-if-region-active-p . t)) + idd-action-move-region)) + + (((idd-if-region-active-p . t) + (idd-if-modifiers-p . nil)) + (((idd-if-region-active-p . t)) + idd-action-move-replace-region)) + ) + "*The list with actions, depending on the source and the destination. The list looks like: '((<destination-specification-1> (<source-specification-1> <action-1-1>) (<source-specification-2> <action-1-2>) @@ -214,13 +241,59 @@ <action> ist a function, which has two arguments, the first specifies the source and the second the destination. Look at the function definition of `idd-action-copy-region' and `idd-action-copy-replace-region'. They are -examples for such actions.") +examples for such actions." + :group 'idd-drag-and-drop + :type 'list) (make-variable-buffer-local 'idd-actions) -(defvar idd-help-instead-of-action nil +(defcustom idd-help-instead-of-action nil "*If this variable is t, then a help buffer is displayed. -No action will be performed if this variable is t.") +No action will be performed if this variable is t. + +Note: You can also use the help mouse key instead of setting +this to t." + :group 'idd-drag-and-drop + :type 'boolean) + +(defcustom idd-mouse-pointer-image "drop" + "*The name of the image used as mouse pointer during drag and drop. +The image must be in the directory `idd-data-directory'. +Run the command `idd-make-drag-and-drop-pointer-glyph' after changing +this variable." + :group 'idd-drag-and-drop + :type 'file) + +(defcustom idd-data-directory (file-name-as-directory + (expand-file-name "idd" data-directory)) + "Data directory for the file `idd-mouse-pointer-image'. +Run the command `idd-make-drag-and-drop-pointer-glyph' after changing +this variable." + :group 'idd-drag-and-drop + :type 'directory) + +(defcustom idd-overwrite-mouse-pointers + (if (adapt-xemacsp) + '(text-pointer-glyph + nontext-pointer-glyph + selection-pointer-glyph) + nil) + "*A list with pointer glyph variables, which should be overwritten +by the idd-drag-and-drop-pointer-glyph. If it is nil, the pointer +wont be changed. Currently it must be nil in the Emacs." + :group 'idd-drag-and-drop + :type '(repeat lisp)) + +(defvar idd-drag-and-drop-pointer-glyph nil +; (if idd-overwrite-mouse-pointers +; (make-pointer-glyph +; (vector 'autodetect :data idd-mouse-pointer-image)) +; nil) + "The shape of the mouse-pointer when internal drag and drop is active.") + +(defvar idd-original-pointer-image-instances nil + "Internal variable. Alist with the saved images instances of the pointers. +This list is used to restore the old mouse pointers.") (defvar idd-help-start-action-keymap nil "Keymap used in an extent in the help buffer to start the action.") @@ -242,6 +315,49 @@ 'source-or-destination '(cdr specification)))) +(defun idd-get-old-pointer-image-instances (mouse-pointers) + "Returns an alist with the pointer variables and there image instances." + (cond ((not mouse-pointers) nil) + (t (cons (cons (car mouse-pointers) + (glyph-image-instance (eval (car mouse-pointers)))) + (idd-get-old-pointer-image-instances (cdr mouse-pointers)))))) + +(defun idd-set-drag-and-drop-pointer-glyphs-1 (mouse-pointers + drag-and-drop-pointer-glyph) + "Internal function." + (cond ((not mouse-pointers)) + (t (set-glyph-image (eval (car mouse-pointers)) + (glyph-image-instance drag-and-drop-pointer-glyph)) + (idd-set-drag-and-drop-pointer-glyphs-1 (cdr mouse-pointers) + drag-and-drop-pointer-glyph) + ))) + +(defun idd-set-drag-and-drop-pointer-glyphs () + "Set the shape of some pointers to the drag and drop shape. +Only the pointers in the list `idd-overwrite-mouse-pointers' are +used." + (unless (or idd-original-pointer-image-instances + (not idd-overwrite-mouse-pointers)) + (setq idd-original-pointer-image-instances + (idd-get-old-pointer-image-instances idd-overwrite-mouse-pointers)) + (idd-set-drag-and-drop-pointer-glyphs-1 idd-overwrite-mouse-pointers + idd-drag-and-drop-pointer-glyph))) + +(defun idd-restore-original-pointer-glyphs-1 (pointer-alist) + "Internal function." + (cond ((not pointer-alist)) + (t (set-glyph-image (eval (car (car pointer-alist))) + (cdr (car pointer-alist))) + (idd-restore-original-pointer-glyphs-1 (cdr pointer-alist))))) + +(defun idd-restore-original-pointer-glyphs () + "Restores the original pointer shapes." + (interactive) + (when idd-overwrite-mouse-pointers + (idd-restore-original-pointer-glyphs-1 + idd-original-pointer-image-instances) + (setq idd-original-pointer-image-instances nil))) + (defun idd-compare-specifications-1 (source-or-destination specifications value) @@ -678,6 +794,7 @@ `idd-mouse-drag-and-drop-click' is, that you can't select a destination region." (interactive "@e") + (idd-set-drag-and-drop-pointer-glyphs) (let ((drag-and-drop-message "Drag&Drop: Leave the button over the destination!") (source (idd-get-source-or-destination-alist source-event)) @@ -702,7 +819,8 @@ (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))) + (idd-restore-original-pointer-glyphs)) (defun idd-mouse-drag-and-drop-click (source-event) "Performs a drag and drop action. @@ -710,6 +828,7 @@ This must be bind to a mouse button. The SOURCE-EVENT must be a button-press-event." (interactive "@e") + (idd-set-drag-and-drop-pointer-glyphs) (let ((drag-and-drop-message "Drag&Drop: Click on the destination!") (source (idd-get-source-or-destination-alist source-event)) (destination nil) @@ -756,7 +875,8 @@ ;; (setq idd-last-source source) ;; (setq idd-last-destination destination) - )) + ) + (idd-restore-original-pointer-glyphs)) (defun idd-help-start-action (event) "Used to start the action from the help buffer." @@ -769,6 +889,34 @@ idd-help-destination) (delete-extent idd-help-start-extent)) +(if (adapt-xemacsp) + (progn + + (defun idd-make-drag-and-drop-pointer-glyph () + "Creates the drag and drop pointer glyph. +You've to rerun this, if you change either the variable +`idd-data-directory' or `idd-mouse-pointer-image'." + (interactive) + (let ((mouse-pointer-image (if (and idd-data-directory + idd-mouse-pointer-image) + (expand-file-name + (file-name-nondirectory + idd-mouse-pointer-image) + idd-data-directory) + idd-mouse-pointer-image))) + (if (and mouse-pointer-image + (file-exists-p mouse-pointer-image)) + (setq idd-drag-and-drop-pointer-glyph + (make-pointer-glyph + (vector 'autodetect :data mouse-pointer-image))) + (setq idd-drag-and-drop-pointer-glyph (make-pointer-glyph)) + (message + "Warning: Can't find drag and drop mouse pointer image!")))) + + (idd-make-drag-and-drop-pointer-glyph) + + )) + ;; keymap for help buffer extents (if (not idd-help-start-action-keymap) (progn @@ -790,3 +938,5 @@ (provide 'internal-drag-and-drop) + +;;; internal-drag-and-drop ends here