wl/wl-dnd.el

   1 ;;; wl-dnd.el --- dragdrop support on Wanderlust.
   2
   3 ;; Copyright (C) 1998,1999,2000 Yuuichi Teranishi <teranisi@gohome.org>
   4
   5 ;; Author: Yuuichi Teranishi <teranisi@gohome.org>
   6 ;; Keywords: mail, net news
   7
   8 ;; This file is part of Wanderlust (Yet Another Message Interface on Emacsen).
   9
  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.
  14 ;;
  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.
  19 ;;
  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.
  24 ;;
  25
  26 ;;; Commentary:
  27 ;;
  28
  29 ;;; Code:
  30 ;;
  31 (eval-when-compile (require 'static))
  32
  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))))
  46
  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                      (number-to-string (wl-summary-message-number)))))
  53
  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)))
  77       ))
  78   t)
  79
  80 (defun wl-dnd-default-drop-message (event object)
  81   (message "Dropping here is meaningless.")
  82   t)
  83
  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)
  92
  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)))
 100
 101 (require 'product)
 102 (product-provide (provide 'wl-dnd) (require 'wl-version))
 103
 104 ;;; wl-dnd.el ends here