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
  32 (static-cond
  33  ((featurep 'offix)
  34   (defun start-drag (event what &optional typ)
  35     (if (numberp typ)
  36         (funcall (intern "offix-start-drag") event what typ)
  37       (funcall (intern "offix-start-drag") event what))))
  38  ((featurep 'cde)
  39   (defun start-drag (event what &optional typ)
  40     (if (not typ)
  41         (funcall (intern "cde-start-drag-internal") event nil
  42                  (list what))
  43       (funcall (intern "cde-start-drag-internal") event t what))))
  44  (t (defun start-drag (event what &optional typ))))
  45
  46 (defun wl-dnd-start-drag (event)
  47   (interactive "@e")
  48   (mouse-set-point event)
  49   (start-drag event (concat
  50                      wl-summary-buffer-folder-name " "
  51                      (int-to-string (wl-summary-message-number)))))
  52
  53 (defun wl-dnd-drop-func (event object text)
  54   (interactive "@e")
  55   (mouse-set-point event)
  56   (beginning-of-line)
  57   (when (looking-at "^[ ]*\\([^\\[].+\\):.*\n")
  58     (let* ((src-spec (save-match-data
  59                        (split-string (nth 2 (car (cdr object)))
  60                                      " ")))
  61            (src-fld (nth 0 src-spec))
  62            (number  (string-to-int (nth 1 src-spec)))
  63            target)
  64       (setq target
  65             (wl-folder-get-folder-name-by-id (get-text-property
  66                                               (point)
  67                                               'wl-folder-entity-id)))
  68       (message "%s is dropped at %s." number
  69                (buffer-substring (match-beginning 1)
  70                                  (match-end 1)))
  71       (set-buffer (wl-summary-get-buffer src-fld))
  72       (save-match-data
  73         (wl-summary-jump-to-msg number))
  74       (wl-summary-refile target number)
  75       (select-window (get-buffer-window (current-buffer)))
  76       ))
  77   t)
  78
  79 (defun wl-dnd-default-drop-message (event object)
  80   (message "Dropping here is meaningless.")
  81   t)
  82
  83 (defun wl-dnd-set-drop-target (beg end)
  84   (let (ext substr)
  85     (setq ext (make-extent beg end))
  86     (set-extent-property
  87      ext
  88      'experimental-dragdrop-drop-functions
  89      '((wl-dnd-drop-func t t (buffer-substring beg end))))))
  90 ;;; (set-extent-property ext 'mouse-face 'highlight)
  91
  92 (defun wl-dnd-set-drag-starter (beg end)
  93   (let (ext kmap)
  94     (setq ext (make-extent beg end))
  95 ;;; (set-extent-property ext 'mouse-face 'isearch)
  96     (setq kmap (make-keymap))
  97     (define-key kmap [button1] 'wl-dnd-start-drag)
  98     (set-extent-property ext 'keymap kmap)))
  99
 100 (require 'product)
 101 (product-provide (provide 'wl-dnd) (require 'wl-version))
 102
 103 ;;; wl-dnd.el ends here