cgit.sxemacs.org Git - packages/blob - xemacs-packages/speedbar/sb-rmail.el.upstream

   1 ;;; sb-rmail --- Speedbar support for rmail
   2
   3 ;; Copyright (C) 1997, 1998, 1999, 2001, 2002, 2003 Free Software Foundation
   4 ;;
   5 ;; Author: Eric M. Ludlam <zappo@gnu.ai.mit.edu>
   6 ;; Version: 0.1
   7 ;; Keywords: file, tags, tools
   8 ;; X-RCS: $Id: sb-rmail.el.upstream,v 1.1 2007-11-26 15:02:18 michaels Exp $
   9 ;;
  10 ;; This file is part of GNU Emacs.
  11 ;;
  12 ;; This program is free software; you can redistribute it and/or modify
  13 ;; it under the terms of the GNU General Public License as published by
  14 ;; the Free Software Foundation; either version 2, or (at your option)
  15 ;; any later version.
  16 ;;
  17 ;; This program is distributed in the hope that it will be useful,
  18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  20 ;; GNU General Public License for more details.
  21 ;;
  22 ;; You should have received a copy of the GNU General Public License
  23 ;; along with this program; if not, you can either send email to this
  24 ;; program's author (see below) or write to:
  25 ;;
  26 ;;              The Free Software Foundation, Inc.
  27 ;;              675 Mass Ave.
  28 ;;              Cambridge, MA 02139, USA.
  29 ;;
  30 ;; Please send bug reports, etc. to zappo@gnu.ai.mit.edu.
  31 ;;
  32
  33 ;;; Commentary:
  34 ;;
  35 ;;   Speedbar provides a frame in which files, and locations in
  36 ;; files are displayed.  These functions provide rmail specific support,
  37 ;; showing links and addresses in the side-bar.
  38 ;;
  39 ;;   To enable in emacs 20.2 or earlier, add this to your .emacs file.
  40 ;;   (autoload 'rmail-speedbar-buttons "sb-rmail"
  41 ;;             "Rmail specific speedbar button generator.")
  42 ;;
  43 ;;   This file requires speedbar.
  44 (eval-when-compile (require 'speedbar))
  45 ;;; Change log:
  46 ;; 0.1   - first revision copied from speedbspec.el V 0.1.1
  47 ;; 0.1.1 - removed require speedbspec.
  48 ;; 0.1.2 - Changed to handle new keymap feature.
  49
  50 ;;; Code:
  51 (defvar rmail-speedbar-match-folder-regexp "^[A-Z0-9]+\\(\\.[A-Z0-9]+\\)?$"
  52   "*This regex is used to match folder names to be displayed in speedbar.
  53 Enabling this will permit speedbar to display your folders for easy
  54 browsing, and moving of messages.")
  55
  56 (defvar rmail-speedbar-last-user nil
  57   "The last user to be displayed in the speedbar.")
  58
  59 (defvar rmail-speedbar-key-map nil
  60   "Keymap used when in rmail display mode.")
  61
  62 (defun rmail-install-speedbar-variables ()
  63   "Install those variables used by speedbar to enhance rmail."
  64   (if rmail-speedbar-key-map
  65       nil
  66     (setq rmail-speedbar-key-map (speedbar-make-specialized-keymap))
  67
  68     (define-key rmail-speedbar-key-map "e" 'speedbar-edit-line)
  69     (define-key rmail-speedbar-key-map "r" 'speedbar-edit-line)
  70     (define-key rmail-speedbar-key-map "\C-m" 'speedbar-edit-line)
  71     (define-key rmail-speedbar-key-map "M"
  72       'rmail-speedbar-move-message-to-folder-on-line)))
  73
  74 (defvar rmail-speedbar-menu-items
  75   '(["Read Folder" speedbar-edit-line t]
  76     ["Move message to folder" rmail-speedbar-move-message-to-folder-on-line
  77      (save-excursion (beginning-of-line)
  78                      (looking-at "<M> "))])
  79   "Additional menu-items to add to speedbar frame.")
  80
  81 ;; Make sure our special speedbar major mode is loaded
  82 (if (featurep 'speedbar)
  83     (rmail-install-speedbar-variables)
  84   (add-hook 'speedbar-load-hook 'rmail-install-speedbar-variables))
  85
  86 ;;;###autoload
  87 (defun rmail-speedbar-buttons (buffer)
  88   "Create buttons for BUFFER containing rmail messages.
  89 Click on the address under Reply to: to reply to this person.
  90 Under Folders: Click a name to read it, or on the <M> to move the
  91 current message into that RMAIL folder."
  92   (let ((from nil))
  93     (save-excursion
  94       (set-buffer buffer)
  95       (goto-char (point-min))
  96       (if (not (re-search-forward "^Reply-To: " nil t))
  97           (if (not (re-search-forward "^From:? " nil t))
  98               (setq from t)))
  99       (if from
 100           nil
 101         (setq from (buffer-substring (point) (save-excursion
 102                                                (end-of-line)
 103                                                (point))))))
 104     (goto-char (point-min))
 105     (if (and (looking-at "\\(//\\)?Reply to:")
 106              (equal from rmail-speedbar-last-user))
 107         nil
 108       (setq rmail-speedbar-last-user from)
 109       (erase-buffer)
 110       (speedbar-insert-separator "Reply To")
 111       (if (stringp from)
 112           (speedbar-insert-button from 'speedbar-directory-face 'highlight
 113                                   'rmail-speedbar-button 'rmail-reply))
 114       (speedbar-insert-separator "Folders")
 115       (let* ((case-fold-search nil)
 116              (df (directory-files (save-excursion (set-buffer buffer)
 117                                                   default-directory)
 118                                   nil rmail-speedbar-match-folder-regexp)))
 119         (while df
 120           (speedbar-insert-button "<M>" 'speedbar-button-face 'highlight
 121                                   'rmail-speedbar-move-message (car df))
 122           (speedbar-insert-button (car df) 'speedbar-file-face 'highlight
 123                                   'rmail-speedbar-find-file nil t)
 124           (setq df (cdr df)))))))
 125
 126 (defun rmail-speedbar-button (text token indent)
 127   "Execute an rmail command specified by TEXT.
 128 The command used is TOKEN.  INDENT is not used."
 129   (speedbar-with-attached-buffer
 130    (funcall token t)))
 131
 132 (defun rmail-speedbar-find-file (text token indent)
 133   "Load in the rmail file TEXT.
 134 TOKEN and INDENT are not used."
 135   (speedbar-with-attached-buffer
 136    (speedbar-message "Loading in RMAIL file %s..." text)
 137    (find-file text)))
 138
 139 (defun rmail-speedbar-move-message-to-folder-on-line ()
 140   "If the current line is a folder, move current message to it."
 141   (interactive)
 142   (save-excursion
 143     (beginning-of-line)
 144     (if (re-search-forward "<M> " (save-excursion (end-of-line) (point)) t)
 145         (progn
 146           (forward-char -2)
 147           (speedbar-do-function-pointer)))))
 148
 149 (defun rmail-speedbar-move-message (text token indent)
 150   "From button TEXT, copy current message to the rmail file specified by TOKEN.
 151 TEXT and INDENT are not used."
 152   (speedbar-with-attached-buffer
 153    (message "Moving message to %s" token)
 154    (rmail-output-to-rmail-file token)))
 155
 156 (provide 'sb-rmail)
 157 ;;; sb-rmail.el ends here