New feature: toggle visibility of mime buttons.
[more-wl.git] / wl / wl-dnd.el
blob4aa4a42aa98fa0960f13838999c254aed37d722b
1 ;;; wl-dnd.el --- dragdrop support on Wanderlust.
3 ;; Copyright (C) 1998,1999,2000 Yuuichi Teranishi <teranisi@gohome.org>
5 ;; Author: Yuuichi Teranishi <teranisi@gohome.org>
6 ;; Keywords: mail, net news
8 ;; This file is part of Wanderlust (Yet Another Message Interface on Emacsen).
10 ;; This program is free software; you can redistribute it and/or modify
11 ;; it under the terms of the GNU General Public License as published by
12 ;; the Free Software Foundation; either version 2, or (at your option)
13 ;; any later version.
15 ;; This program is distributed in the hope that it will be useful,
16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18 ;; GNU General Public License for more details.
20 ;; You should have received a copy of the GNU General Public License
21 ;; along with GNU Emacs; see the file COPYING. If not, write to the
22 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
23 ;; Boston, MA 02111-1307, USA.
26 ;;; Commentary:
29 ;;; Code:
31 (eval-when-compile (require 'static))
33 (static-cond
34 ((featurep 'offix)
35 (defun start-drag (event what &optional typ)
36 (if (numberp typ)
37 (funcall (intern "offix-start-drag") event what typ)
38 (funcall (intern "offix-start-drag") event what))))
39 ((featurep 'cde)
40 (defun start-drag (event what &optional typ)
41 (if (not typ)
42 (funcall (intern "cde-start-drag-internal") event nil
43 (list what))
44 (funcall (intern "cde-start-drag-internal") event t what))))
45 (t (defun start-drag (event what &optional typ))))
47 (defun wl-dnd-start-drag (event)
48 (interactive "@e")
49 (mouse-set-point event)
50 (start-drag event (concat
51 wl-summary-buffer-folder-name " "
52 (int-to-string (wl-summary-message-number)))))
54 (defun wl-dnd-drop-func (event object text)
55 (interactive "@e")
56 (mouse-set-point event)
57 (beginning-of-line)
58 (when (looking-at "^[ ]*\\([^\\[].+\\):.*\n")
59 (let* ((src-spec (save-match-data
60 (split-string (nth 2 (car (cdr object)))
61 " ")))
62 (src-fld (nth 0 src-spec))
63 (number (string-to-number (nth 1 src-spec)))
64 target)
65 (setq target
66 (wl-folder-get-folder-name-by-id (get-text-property
67 (point)
68 'wl-folder-entity-id)))
69 (message "%s is dropped at %s." number
70 (buffer-substring (match-beginning 1)
71 (match-end 1)))
72 (set-buffer (wl-summary-get-buffer src-fld))
73 (save-match-data
74 (wl-summary-jump-to-msg number))
75 (funcall (symbol-function 'wl-summary-refile) number target)
76 (select-window (get-buffer-window (current-buffer)))
80 (defun wl-dnd-default-drop-message (event object)
81 (message "Dropping here is meaningless.")
84 (defun wl-dnd-set-drop-target (beg end)
85 (let (ext substr)
86 (setq ext (make-extent beg end))
87 (set-extent-property
88 ext
89 'experimental-dragdrop-drop-functions
90 '((wl-dnd-drop-func t t (buffer-substring beg end))))))
91 ;;; (set-extent-property ext 'mouse-face 'highlight)
93 (defun wl-dnd-set-drag-starter (beg end)
94 (let (ext kmap)
95 (setq ext (make-extent beg end))
96 ;;; (set-extent-property ext 'mouse-face 'isearch)
97 (setq kmap (make-keymap))
98 (define-key kmap [button1] 'wl-dnd-start-drag)
99 (set-extent-property ext 'keymap kmap)))
101 (require 'product)
102 (product-provide (provide 'wl-dnd) (require 'wl-version))
104 ;;; wl-dnd.el ends here