speedbar / sb-rmail.el

Full commit
;;; sb-rmail --- Speedbar support for rmail

;; Copyright (C) 1997, 1998 Free Software Foundation
;; Author: Eric M. Ludlam <>
;; Version: 0.1
;; Keywords: file, tags, tools
;; X-RCS: $Id$
;; This file is part of GNU Emacs.
;; 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 2, 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
;; 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, you can either send email to this
;; program's author (see below) or write to:
;;              The Free Software Foundation, Inc.
;;              675 Mass Ave.
;;              Cambridge, MA 02139, USA.
;; Please send bug reports, etc. to

;;; Commentary:
;;   Speedbar provides a frame in which files, and locations in
;; files are displayed.  These functions provide rmail specific support,
;; showing links and addresses in the side-bar.
;;   To provide special service to all the modes supported by this file,
;; put the following in your .emacs file.
;; (require 'speedbspec)
;;   This will load in the known functions, and the mode-enabling code
;; into 'change-major-mode-hook.
;;   This file requires speedbar.

;;; Change log:
;; 0.1 - first revision copied from speedbspec.el V 0.1.1

(require 'speedbspec)

;;; Code:
(defvar rmail-speedbar-last-user nil
  "The last user to be displayed in the speedbar.")

(defvar rmail-speedbar-menu-items
  '(["Browse Item On Line" speedbar-edit-line t]
    ["Move message to folder" rmail-move-message-to-folder-on-line
     (save-excursion (beginning-of-line)
		     (looking-at "<M> "))])
  "Additional menu-items to add to speedbar frame.")

(defun rmail-speedbar-buttons (buffer)
  "Create buttons for BUFFER containing rmail messages.
Click on the address under Reply to: to reply to this person.
Under Folders: Click a name to read it, or on the <M> to move the
current message into that RMAIL folder."
  (let ((from nil))
      (set-buffer buffer)
      (goto-char (point-min))
      (if (not (re-search-forward "^Reply-To: " nil t))
	  (if (not (re-search-forward "^From:? " nil t))
	      (setq from t)))
      (if from
	(setq from (buffer-substring (point) (save-excursion
    (goto-char (point-min))
    (if (and (looking-at "Reply to:")
	     (equal from rmail-speedbar-last-user))
      (setq rmail-speedbar-last-user from)
      (insert "Reply To:\n")
      (if (stringp from)
	  (speedbar-insert-button from 'speedbar-directory-face 'highlight
				  'rmail-speedbar-button 'rmail-reply))
      (insert "Folders:\n")
      (let* ((case-fold-search nil)
	     (df (directory-files (save-excursion (set-buffer buffer)
				  nil "^[A-Z0-9]+\\(\\.[A-Z0-9]+\\)?$")))
	(while df
	  (speedbar-insert-button "<M>" 'speedbar-button-face 'highlight
				  'rmail-speedbar-move-message (car df))
	  (speedbar-insert-button (car df) 'speedbar-file-face 'highlight
				  'rmail-speedbar-find-file nil t)
	  (setq df (cdr df)))))))

(defun rmail-speedbar-button (text token indent)
  "Execute an rmail command specified by TEXT.
The command used is TOKEN.  INDENT is not used."
   (funcall token t)))

(defun rmail-speedbar-find-file (text token indent)
  "Load in the rmail file TEXT.
TOKEN and INDENT are not used."
   (message "Loading in RMAIL file %s..." text)
   (find-file text)))

(defun rmail-move-message-to-folder-on-line ()
  "If the current line is a folder, move current message to it."
    (if (re-search-forward "<M> " (save-excursion (end-of-line) (point)) t)
	  (forward-char -2)

(defun rmail-speedbar-move-message (text token indent)
  "From button TEXT, copy current message to the rmail file specified by TOKEN.
TEXT and INDENT are not used."
   (message "Moving message to %s" token)
   (rmail-output-to-rmail-file token)))

(provide 'sb-rmail)
;;; sb-rmail.el ends here