home *** CD-ROM | disk | FTP | other *** search
Text File | 1993-06-21 | 37.8 KB | 1,072 lines |
- ;;; rmailsum.el --- make summary buffers for the mail reader
-
- ;; Copyright (C) 1985, 1993 Free Software Foundation, Inc.
-
- ;; Maintainer: FSF
- ;; Keywords: mail
-
- ;; This file is part of GNU Emacs.
-
- ;; GNU Emacs 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.
-
- ;; GNU Emacs is distributed in the hope that it will be useful,
- ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
- ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
- ;; GNU General Public License for more details.
-
- ;; You should have received a copy of the GNU General Public License
- ;; along with GNU Emacs; see the file COPYING. If not, write to
- ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
-
- ;;; Commentary:
-
- ;; Extended by Bob Weiner of Motorola
- ;; Provided all commands from rmail-mode in rmail-summary-mode and made key
- ;; bindings in both modes wholly compatible.
-
- ;;; Code:
-
- ;; Entry points for making a summary buffer.
-
- ;; Regenerate the contents of the summary
- ;; using the same selection criterion as last time.
- ;; M-x revert-buffer in a summary buffer calls this function.
- (defun rmail-update-summary (&rest ignore)
- (apply (car rmail-summary-redo) (cdr rmail-summary-redo)))
-
- (defun rmail-summary ()
- "Display a summary of all messages, one line per message."
- (interactive)
- (rmail-new-summary "All" '(rmail-summary) nil))
-
- (defun rmail-summary-by-labels (labels)
- "Display a summary of all messages with one or more LABELS.
- LABELS should be a string containing the desired labels, separated by commas."
- (interactive "sLabels to summarize by: ")
- (if (string= labels "")
- (setq labels (or rmail-last-multi-labels
- (error "No label specified"))))
- (setq rmail-last-multi-labels labels)
- (rmail-new-summary (concat "labels " labels)
- (list 'rmail-summary-by-labels labels)
- 'rmail-message-labels-p
- (concat ", \\(" (mail-comma-list-regexp labels) "\\),")))
-
- (defun rmail-summary-by-recipients (recipients &optional primary-only)
- "Display a summary of all messages with the given RECIPIENTS.
- Normally checks the To, From and Cc fields of headers;
- but if PRIMARY-ONLY is non-nil (prefix arg given),
- only look in the To and From fields.
- RECIPIENTS is a string of regexps separated by commas."
- (interactive "sRecipients to summarize by: \nP")
- (rmail-new-summary
- (concat "recipients " recipients)
- (list 'rmail-summary-by-recipients recipients primary-only)
- 'rmail-message-recipients-p
- (mail-comma-list-regexp recipients) primary-only))
-
- (defun rmail-summary-by-regexp (regexp)
- "Display a summary of all messages according to regexp REGEXP.
- If the regular expression is found in the header of the message
- \(including in the date and other lines, as well as the subject line),
- Emacs will list the header line in the RMAIL-summary."
- (interactive "sRegexp to summarize by: ")
- (if (string= regexp "")
- (setq regexp (or rmail-last-regexp
- (error "No regexp specified."))))
- (setq rmail-last-regexp regexp)
- (rmail-new-summary (concat "regexp " regexp)
- (list 'rmail-summary-by-regexp regexp)
- 'rmail-message-regexp-p
- regexp))
-
- ;; rmail-summary-by-topic
- ;; 1989 R.A. Schnitzler
-
- (defun rmail-summary-by-topic (subject &optional whole-message)
- "Display a summary of all messages with the given SUBJECT.
- Normally checks the Subject field of headers;
- but if WHOLE-MESSAGE is non-nil (prefix arg given),
- look in the whole message.
- SUBJECT is a string of regexps separated by commas."
- (interactive "sTopics to summarize by: \nP")
- (rmail-new-summary
- (concat "about " subject)
- (list 'rmail-summary-by-topic subject whole-message)
- 'rmail-message-subject-p
- (mail-comma-list-regexp subject) whole-message))
-
- (defun rmail-message-subject-p (msg subject &optional whole-message)
- (save-restriction
- (goto-char (rmail-msgbeg msg))
- (search-forward "\n*** EOOH ***\n")
- (narrow-to-region
- (point)
- (progn (search-forward (if whole-message "\^_" "\n\n")) (point)))
- (goto-char (point-min))
- (if whole-message (re-search-forward subject nil t)
- (string-match subject (or (mail-fetch-field "Subject") "")) )))
-
- (defun rmail-summary-by-senders (senders)
- "Display a summary of all messages with the given SENDERS.
- SENDERS is a string of names separated by commas."
- (interactive "sSenders to summarize by: ")
- (rmail-new-summary
- (concat "senders " senders)
- 'rmail-message-senders-p
- (mail-comma-list-regexp senders)))
-
- (defun rmail-message-senders-p (msg senders)
- (save-restriction
- (goto-char (rmail-msgbeg msg))
- (search-forward "\n*** EOOH ***\n")
- (narrow-to-region (point) (progn (search-forward "\n\n") (point)))
- (string-match senders (or (mail-fetch-field "From") ""))))
-
- ;; General making of a summary buffer.
-
- (defvar rmail-summary-symbol-number 0)
-
- (defun rmail-new-summary (description redo-form function &rest args)
- "Create a summary of selected messages.
- DESCRIPTION makes part of the mode line of the summary buffer.
- For each message, FUNCTION is applied to the message number and ARGS...
- and if the result is non-nil, that message is included.
- nil for FUNCTION means all messages."
- (message "Computing summary lines...")
- (let (sumbuf mesg was-in-summary)
- (save-excursion
- ;; Go to the Rmail buffer.
- (if (eq major-mode 'rmail-summary-mode)
- (progn
- (setq was-in-summary t)
- (set-buffer rmail-buffer)))
- ;; Find its summary buffer, or make one.
- (setq sumbuf
- (if (and rmail-summary-buffer
- (buffer-name rmail-summary-buffer))
- rmail-summary-buffer
- (generate-new-buffer (concat (buffer-name) "-summary"))))
- (setq mesg rmail-current-message)
- ;; Filter the messages; make or get their summary lines.
- (let ((summary-msgs ())
- (new-summary-line-count 0))
- (let ((msgnum 1)
- (buffer-read-only nil))
- (save-restriction
- (save-excursion
- (widen)
- (goto-char (point-min))
- (while (>= rmail-total-messages msgnum)
- (if (or (null function)
- (apply function (cons msgnum args)))
- (setq summary-msgs
- (cons (cons msgnum (rmail-make-summary-line msgnum))
- summary-msgs)))
- (setq msgnum (1+ msgnum)))
- (setq summary-msgs (nreverse summary-msgs)))))
- ;; Temporarily, while summary buffer is unfinished,
- ;; we "don't have" a summary.
- (setq rmail-summary-buffer nil)
- (save-excursion
- (let ((rbuf (current-buffer))
- (total rmail-total-messages))
- (set-buffer sumbuf)
- ;; Set up the summary buffer's contents.
- (let ((buffer-read-only nil))
- (erase-buffer)
- (while summary-msgs
- (princ (cdr (car summary-msgs)) sumbuf)
- (setq summary-msgs (cdr summary-msgs)))
- (goto-char (point-min)))
- ;; Set up the rest of its state and local variables.
- (setq buffer-read-only t)
- (rmail-summary-mode)
- (make-local-variable 'minor-mode-alist)
- (setq minor-mode-alist (list '(t (concat ": " description))))
- (setq rmail-buffer rbuf
- rmail-summary-redo redo-form
- rmail-total-messages total))))
- (setq rmail-summary-buffer sumbuf))
- ;; Now display the summary buffer and go to the right place in it.
- (or was-in-summary
- (pop-to-buffer sumbuf))
- (rmail-summary-goto-msg mesg t t)
- (message "Computing summary lines...done")))
-
- ;; Low levels of generating a summary.
-
- (defun rmail-make-summary-line (msg)
- (let ((line (or (aref rmail-summary-vector (1- msg))
- (progn
- (setq new-summary-line-count
- (1+ new-summary-line-count))
- (if (zerop (% new-summary-line-count 10))
- (message "Computing summary lines...%d"
- new-summary-line-count))
- (rmail-make-summary-line-1 msg)))))
- ;; Fix up the part of the summary that says "deleted" or "unseen".
- (aset line 4
- (if (rmail-message-deleted-p msg) ?\D
- (if (= ?0 (char-after (+ 3 (rmail-msgbeg msg))))
- ?\- ?\ )))
- line))
-
- (defun rmail-make-summary-line-1 (msg)
- (goto-char (rmail-msgbeg msg))
- (let* ((lim (save-excursion (forward-line 2) (point)))
- pos
- (labels
- (progn
- (forward-char 3)
- (concat
- ; (if (save-excursion (re-search-forward ",answered," lim t))
- ; "*" "")
- ; (if (save-excursion (re-search-forward ",filed," lim t))
- ; "!" "")
- (if (progn (search-forward ",,") (eolp))
- ""
- (concat "{"
- (buffer-substring (point)
- (progn (end-of-line) (point)))
- "} ")))))
- (line
- (progn
- (forward-line 1)
- (if (looking-at "Summary-line: ")
- (progn
- (goto-char (match-end 0))
- (setq line
- (buffer-substring (point)
- (progn (forward-line 1) (point)))))))))
- ;; Obsolete status lines lacking a # should be flushed.
- (and line
- (not (string-match "#" line))
- (progn
- (delete-region (point)
- (progn (forward-line -1) (point)))
- (setq line nil)))
- ;; If we didn't get a valid status line from the message,
- ;; make a new one and put it in the message.
- (or line
- (let* ((case-fold-search t)
- (next (rmail-msgend msg))
- (beg (if (progn (goto-char (rmail-msgbeg msg))
- (search-forward "\n*** EOOH ***\n" next t))
- (point)
- (forward-line 1)
- (point)))
- (end (progn (search-forward "\n\n" nil t) (point))))
- (save-restriction
- (narrow-to-region beg end)
- (goto-char beg)
- (setq line (rmail-make-basic-summary-line)))
- (goto-char (rmail-msgbeg msg))
- (forward-line 2)
- (insert "Summary-line: " line)))
- (setq pos (string-match "#" line))
- (aset rmail-summary-vector (1- msg)
- (concat (format "%4d " msg)
- (substring line 0 pos)
- labels
- (substring line (1+ pos))))))
-
- (defun rmail-make-basic-summary-line ()
- (goto-char (point-min))
- (concat (save-excursion
- (if (not (re-search-forward "^Date:" nil t))
- " "
- (cond ((re-search-forward "\\([^0-9:]\\)\\([0-3]?[0-9]\\)\\([- \t_]+\\)\\([adfjmnos][aceopu][bcglnprtvy]\\)"
- (save-excursion (end-of-line) (point)) t)
- (format "%2d-%3s"
- (string-to-int (buffer-substring
- (match-beginning 2)
- (match-end 2)))
- (buffer-substring
- (match-beginning 4) (match-end 4))))
- ((re-search-forward "\\([^a-z]\\)\\([adfjmnos][acepou][bcglnprtvy]\\)\\([-a-z \t_]*\\)\\([0-9][0-9]?\\)"
- (save-excursion (end-of-line) (point)) t)
- (format "%2d-%3s"
- (string-to-int (buffer-substring
- (match-beginning 4)
- (match-end 4)))
- (buffer-substring
- (match-beginning 2) (match-end 2))))
- (t "??????"))))
- " "
- (save-excursion
- (if (not (re-search-forward "^From:[ \t]*" nil t))
- " "
- (let* ((from (mail-strip-quoted-names
- (buffer-substring
- (1- (point))
- (progn (end-of-line)
- (skip-chars-backward " \t")
- (point)))))
- len mch lo)
- (if (string-match (concat "^"
- (regexp-quote (user-login-name))
- "\\($\\|@\\)")
- from)
- (save-excursion
- (goto-char (point-min))
- (if (not (re-search-forward "^To:[ \t]*" nil t))
- nil
- (setq from
- (concat "to: "
- (mail-strip-quoted-names
- (buffer-substring
- (point)
- (progn (end-of-line)
- (skip-chars-backward " \t")
- (point)))))))))
- (setq len (length from))
- (setq mch (string-match "[@%]" from))
- (format "%25s"
- (if (or (not mch) (<= len 25))
- (substring from (max 0 (- len 25)))
- (substring from
- (setq lo (cond ((< (- mch 9) 0) 0)
- ((< len (+ mch 16))
- (- len 25))
- (t (- mch 9))))
- (min len (+ lo 25))))))))
- " #"
- (if (re-search-forward "^Subject:" nil t)
- (progn (skip-chars-forward " \t")
- (buffer-substring (point)
- (progn (end-of-line)
- (point))))
- (re-search-forward "[\n][\n]+" nil t)
- (buffer-substring (point) (progn (end-of-line) (point))))
- "\n"))
-
- ;; Simple motion in a summary buffer.
-
- (defun rmail-summary-next-all (&optional number)
- (interactive "p")
- (forward-line (if number number 1))
- (display-buffer rmail-buffer))
-
- (defun rmail-summary-previous-all (&optional number)
- (interactive "p")
- (forward-line (- (if number number 1)))
- (display-buffer rmail-buffer))
-
- (defun rmail-summary-next-msg (&optional number)
- "Display next non-deleted msg from rmail file.
- With optional prefix argument NUMBER, moves forward this number of non-deleted
- messages, or backward if NUMBER is negative."
- (interactive "p")
- (forward-line 0)
- (and (> number 0) (end-of-line))
- (let ((count (if (< number 0) (- number) number))
- (search (if (> number 0) 're-search-forward 're-search-backward))
- (non-del-msg-found nil))
- (while (and (> count 0) (setq non-del-msg-found
- (or (funcall search "^....[^D]" nil t)
- non-del-msg-found)))
- (setq count (1- count))))
- (beginning-of-line)
- (display-buffer rmail-buffer))
-
- (defun rmail-summary-previous-msg (&optional number)
- (interactive "p")
- (rmail-summary-next-msg (- (if number number 1))))
-
- (defun rmail-summary-next-labeled-message (n labels)
- "Show next message with LABEL. Defaults to last labels used.
- With prefix argument N moves forward N messages with these labels."
- (interactive "p\nsMove to next msg with labels: ")
- (save-excursion
- (set-buffer rmail-buffer)
- (rmail-next-labeled-message n labels)))
-
- (defun rmail-summary-previous-labeled-message (n labels)
- "Show previous message with LABEL. Defaults to last labels used.
- With prefix argument N moves backward N messages with these labels."
- (interactive "p\nsMove to previous msg with labels: ")
- (save-excursion
- (set-buffer rmail-buffer)
- (rmail-previous-labeled-message n labels)))
-
- ;; Delete and undelete summary commands.
-
- (defun rmail-summary-delete-forward (&optional backward)
- "Delete this message and move to next nondeleted one.
- Deleted messages stay in the file until the \\[rmail-expunge] command is given.
- With prefix argument, delete and move backward."
- (interactive "P")
- (let (end)
- (rmail-summary-goto-msg)
- (pop-to-buffer rmail-buffer)
- (rmail-delete-forward backward)
- (pop-to-buffer rmail-summary-buffer)))
-
- (defun rmail-summary-delete-backward ()
- "Delete this message and move to previous nondeleted one.
- Deleted messages stay in the file until the \\[rmail-expunge] command is given."
- (interactive)
- (rmail-summary-delete-forward t))
-
- (defun rmail-summary-mark-deleted (&optional n undel)
- (and n (rmail-summary-goto-msg n t t))
- (or (eobp)
- (let ((buffer-read-only nil))
- (skip-chars-forward " ")
- (skip-chars-forward "[0-9]")
- (if undel
- (if (looking-at "D")
- (progn (delete-char 1) (insert " ")))
- (delete-char 1)
- (insert "D"))))
- (beginning-of-line))
-
- (defun rmail-summary-mark-undeleted (n)
- (rmail-summary-mark-deleted n t))
-
- (defun rmail-summary-deleted-p (&optional n)
- (save-excursion
- (and n (rmail-summary-goto-msg n nil t))
- (skip-chars-forward " ")
- (skip-chars-forward "[0-9]")
- (looking-at "D")))
-
- (defun rmail-summary-undelete (&optional arg)
- "Undelete current message.
- Optional prefix ARG means undelete ARG previous messages."
- (interactive "p")
- (if (/= arg 1)
- (rmail-summary-undelete-many arg)
- (let ((buffer-read-only nil))
- (end-of-line)
- (cond ((re-search-backward "\\(^ *[0-9]*\\)\\(D\\)" nil t)
- (replace-match "\\1 ")
- (rmail-summary-goto-msg)
- (pop-to-buffer rmail-buffer)
- (and (rmail-message-deleted-p rmail-current-message)
- (rmail-undelete-previous-message))
- (pop-to-buffer rmail-summary-buffer))))))
-
- (defun rmail-summary-undelete-many (&optional n)
- "Undelete all deleted msgs, optional prefix arg N means undelete N prev msgs."
- (interactive "P")
- (save-excursion
- (set-buffer rmail-buffer)
- (let* ((init-msg (if n rmail-current-message rmail-total-messages))
- (rmail-current-message init-msg)
- (n (or n rmail-total-messages))
- (msgs-undeled 0))
- (while (and (> rmail-current-message 0)
- (< msgs-undeled n))
- (if (rmail-message-deleted-p rmail-current-message)
- (progn (rmail-set-attribute "deleted" nil)
- (setq msgs-undeled (1+ msgs-undeled))))
- (setq rmail-current-message (1- rmail-current-message)))
- (set-buffer rmail-summary-buffer)
- (setq rmail-current-message init-msg msgs-undeled 0)
- (while (and (> rmail-current-message 0)
- (< msgs-undeled n))
- (if (rmail-summary-deleted-p rmail-current-message)
- (progn (rmail-summary-mark-undeleted rmail-current-message)
- (setq msgs-undeled (1+ msgs-undeled))))
- (setq rmail-current-message (1- rmail-current-message))))
- (rmail-summary-goto-msg)))
-
- ;; Rmail Summary mode is suitable only for specially formatted data.
- (put 'rmail-summary-mode 'mode-class 'special)
-
- (defun rmail-summary-mode ()
- "Rmail Summary Mode is invoked from Rmail Mode by using \\<rmail-mode-map>\\[rmail-summary].
- As commands are issued in the summary buffer, they are applied to the
- corresponding mail messages in the rmail buffer.
-
- All normal editing commands are turned off.
- Instead, all of the Rmail Mode commands are available, plus:
-
- \\[rmail-summary-undelete-many] Undelete all or prefix arg deleted messages."
- (interactive)
- (kill-all-local-variables)
- (setq major-mode 'rmail-summary-mode)
- (setq mode-name "RMAIL Summary")
- (use-local-map rmail-summary-mode-map)
- (setq truncate-lines t)
- (setq buffer-read-only t)
- (set-syntax-table text-mode-syntax-table)
- (make-local-variable 'rmail-buffer)
- (make-local-variable 'rmail-total-messages)
- (make-local-variable 'rmail-current-message)
- (setq rmail-current-message nil)
- (make-local-variable 'rmail-summary-redo)
- (setq rmail-summary-redo nil)
- (make-local-variable 'revert-buffer-function)
- (setq revert-buffer-function 'rmail-update-summary)
- (make-local-variable 'post-command-hook)
- (add-hook 'post-command-hook 'rmail-summary-rmail-update)
- (run-hooks 'rmail-summary-mode-hook))
-
- ;; Show in Rmail the message described by the summary line that point is on,
- ;; but only if the Rmail buffer is already visible.
- ;; This is a post-command-hook in summary buffers.
- (defun rmail-summary-rmail-update ()
- (if (get-buffer-window rmail-buffer)
- (let (buffer-read-only)
- (save-excursion
- (beginning-of-line)
- (skip-chars-forward " ")
- (let ((beg (point))
- msg-num
- (buf rmail-buffer))
- (skip-chars-forward "0-9")
- (setq msg-num (string-to-int (buffer-substring beg (point))))
- (or (eq rmail-current-message msg-num)
- (let (go-where window (owin (selected-window)))
- (setq rmail-current-message msg-num)
- (if (= (following-char) ?-)
- (progn
- (delete-char 1)
- (insert " ")))
- (setq window (display-buffer rmail-buffer))
- ;; Using save-window-excursion caused the new value
- ;; of point to get lost.
- (unwind-protect
- (progn
- (select-window window)
- (rmail-show-message msg-num))
- (select-window owin)))))))))
-
- (defvar rmail-summary-mode-map nil)
-
- (if rmail-summary-mode-map
- nil
- (setq rmail-summary-mode-map (make-keymap))
- (suppress-keymap rmail-summary-mode-map)
- (define-key rmail-summary-mode-map "a" 'rmail-summary-add-label)
- (define-key rmail-summary-mode-map "c" 'rmail-summary-continue)
- (define-key rmail-summary-mode-map "d" 'rmail-summary-delete-forward)
- (define-key rmail-summary-mode-map "\C-d" 'rmail-summary-delete-backward)
- (define-key rmail-summary-mode-map "e" 'rmail-summary-edit-current-message)
- (define-key rmail-summary-mode-map "f" 'rmail-summary-forward)
- (define-key rmail-summary-mode-map "g" 'rmail-summary-get-new-mail)
- (define-key rmail-summary-mode-map "h" 'rmail-summary)
- (define-key rmail-summary-mode-map "i" 'rmail-summary-input)
- (define-key rmail-summary-mode-map "j" 'rmail-summary-goto-msg)
- (define-key rmail-summary-mode-map "k" 'rmail-summary-kill-label)
- (define-key rmail-summary-mode-map "l" 'rmail-summary-by-labels)
- (define-key rmail-summary-mode-map "\e\C-h" 'rmail-summary)
- (define-key rmail-summary-mode-map "\e\C-l" 'rmail-summary-by-labels)
- (define-key rmail-summary-mode-map "\e\C-r" 'rmail-summary-by-recipients)
- (define-key rmail-summary-mode-map "\e\C-s" 'rmail-summary-by-regexp)
- (define-key rmail-summary-mode-map "\e\C-t" 'rmail-summary-by-topic)
- (define-key rmail-summary-mode-map "m" 'rmail-summary-mail)
- (define-key rmail-summary-mode-map "\M-m" 'rmail-summary-retry-failure)
- (define-key rmail-summary-mode-map "n" 'rmail-summary-next-msg)
- (define-key rmail-summary-mode-map "\en" 'rmail-summary-next-all)
- (define-key rmail-summary-mode-map "\e\C-n" 'rmail-summary-next-labeled-message)
- (define-key rmail-summary-mode-map "o" 'rmail-summary-output-to-rmail-file)
- (define-key rmail-summary-mode-map "\C-o" 'rmail-summary-output)
- (define-key rmail-summary-mode-map "p" 'rmail-summary-previous-msg)
- (define-key rmail-summary-mode-map "\ep" 'rmail-summary-previous-all)
- (define-key rmail-summary-mode-map "\e\C-p" 'rmail-summary-previous-labeled-message)
- (define-key rmail-summary-mode-map "q" 'rmail-summary-quit)
- (define-key rmail-summary-mode-map "r" 'rmail-summary-reply)
- (define-key rmail-summary-mode-map "s" 'rmail-summary-expunge-and-save)
- (define-key rmail-summary-mode-map "\es" 'rmail-summary-search)
- (define-key rmail-summary-mode-map "t" 'rmail-summary-toggle-header)
- (define-key rmail-summary-mode-map "u" 'rmail-summary-undelete)
- (define-key rmail-summary-mode-map "\M-u" 'rmail-summary-undelete-many)
- (define-key rmail-summary-mode-map "w" 'rmail-summary-wipe)
- (define-key rmail-summary-mode-map "x" 'rmail-summary-expunge)
- (define-key rmail-summary-mode-map "." 'rmail-summary-beginning-of-message)
- (define-key rmail-summary-mode-map "<" 'rmail-summary-first-message)
- (define-key rmail-summary-mode-map ">" 'rmail-summary-last-message)
- (define-key rmail-summary-mode-map " " 'rmail-summary-scroll-msg-up)
- (define-key rmail-summary-mode-map "\177" 'rmail-summary-scroll-msg-down)
- (define-key rmail-summary-mode-map "?" 'describe-mode)
- (define-key rmail-summary-mode-map "\C-c\C-s\C-d"
- 'rmail-summary-sort-by-date)
- (define-key rmail-summary-mode-map "\C-c\C-s\C-s"
- 'rmail-summary-sort-by-subject)
- (define-key rmail-summary-mode-map "\C-c\C-s\C-a"
- 'rmail-summary-sort-by-author)
- (define-key rmail-summary-mode-map "\C-c\C-s\C-r"
- 'rmail-summary-sort-by-recipient)
- (define-key rmail-summary-mode-map "\C-c\C-s\C-c"
- 'rmail-summary-sort-by-correspondent)
- (define-key rmail-summary-mode-map "\C-c\C-s\C-l"
- 'rmail-summary-sort-by-lines)
- )
-
- ;;; Menu bar bindings.
-
- (define-key rmail-summary-mode-map [menu-bar] (make-sparse-keymap))
-
- (define-key rmail-summary-mode-map [menu-bar classify]
- (cons "Classify" (make-sparse-keymap "Classify")))
-
- (define-key rmail-summary-mode-map [menu-bar classify output-inbox]
- '("Output (inbox)" . rmail-summary-output))
-
- (define-key rmail-summary-mode-map [menu-bar classify output]
- '("Output (Rmail)" . rmail-summary-output-to-rmail-file))
-
- (define-key rmail-summary-mode-map [menu-bar classify kill-label]
- '("Kill Label" . rmail-summary-kill-label))
-
- (define-key rmail-summary-mode-map [menu-bar classify add-label]
- '("Add Label" . rmail-summary-add-label))
-
- (define-key rmail-summary-mode-map [menu-bar summary]
- (cons "Summary" (make-sparse-keymap "Summary")))
-
- (define-key rmail-summary-mode-map [menu-bar summary labels]
- '("By Labels" . rmail-summary-by-labels))
-
- (define-key rmail-summary-mode-map [menu-bar summary recipients]
- '("By Recipients" . rmail-summary-by-recipients))
-
- (define-key rmail-summary-mode-map [menu-bar summary topic]
- '("By Topic" . rmail-summary-by-topic))
-
- (define-key rmail-summary-mode-map [menu-bar summary regexp]
- '("By Regexp" . rmail-summary-by-regexp))
-
- (define-key rmail-summary-mode-map [menu-bar summary all]
- '("All" . rmail-summary))
-
- (define-key rmail-summary-mode-map [menu-bar mail]
- (cons "Mail" (make-sparse-keymap "Mail")))
-
- (define-key rmail-summary-mode-map [menu-bar mail continue]
- '("Continue" . rmail-summary-continue))
-
- (define-key rmail-summary-mode-map [menu-bar mail forward]
- '("Forward" . rmail-summary-forward))
-
- (define-key rmail-summary-mode-map [menu-bar mail retry]
- '("Retry" . rmail-summary-retry-failure))
-
- (define-key rmail-summary-mode-map [menu-bar mail reply]
- '("Reply" . rmail-summary-reply))
-
- (define-key rmail-summary-mode-map [menu-bar mail mail]
- '("Mail" . rmail-summary-mail))
-
- (define-key rmail-summary-mode-map [menu-bar delete]
- (cons "Delete" (make-sparse-keymap "Delete")))
-
- (define-key rmail-summary-mode-map [menu-bar delete expunge/save]
- '("Expunge/Save" . rmail-summary-expunge-and-save))
-
- (define-key rmail-summary-mode-map [menu-bar delete expunge]
- '("Expunge" . rmail-summary-expunge))
-
- (define-key rmail-summary-mode-map [menu-bar delete undelete]
- '("Undelete" . rmail-summary-undelete))
-
- (define-key rmail-summary-mode-map [menu-bar delete delete]
- '("Delete" . rmail-summary-delete-forward))
-
- (define-key rmail-summary-mode-map [menu-bar move]
- (cons "Move" (make-sparse-keymap "Move")))
-
- (define-key rmail-summary-mode-map [menu-bar move search-back]
- '("Search Back" . rmail-summary-search-backward))
-
- (define-key rmail-summary-mode-map [menu-bar move search]
- '("Search" . rmail-summary-search))
-
- (define-key rmail-summary-mode-map [menu-bar move previous]
- '("Previous Nondeleted" . rmail-summary-previous-msg))
-
- (define-key rmail-summary-mode-map [menu-bar move next]
- '("Next Nondeleted" . rmail-summary-next-msg))
-
- (define-key rmail-summary-mode-map [menu-bar move last]
- '("Last" . rmail-summary-last-message))
-
- (define-key rmail-summary-mode-map [menu-bar move first]
- '("First" . rmail-summary-first-message))
-
- (define-key rmail-summary-mode-map [menu-bar move previous]
- '("Previous" . rmail-summary-previous-all))
-
- (define-key rmail-summary-mode-map [menu-bar move next]
- '("Next" . rmail-summary-next-all))
-
- (defun rmail-summary-goto-msg (&optional n nowarn skip-rmail)
- (interactive "P")
- (if (consp n) (setq n (prefix-numeric-value n)))
- (if (eobp) (forward-line -1))
- (beginning-of-line)
- (let ((buf rmail-buffer)
- (cur (point))
- (curmsg (string-to-int
- (buffer-substring (point)
- (min (point-max) (+ 5 (point)))))))
- (if (not n)
- (setq n curmsg)
- (if (< n 1)
- (progn (message "No preceding message")
- (setq n 1)))
- (if (> n rmail-total-messages)
- (progn (message "No following message")
- (goto-char (point-max))
- (rmail-summary-goto-msg)))
- (goto-char (point-min))
- (if (not (re-search-forward (concat "^ *" (int-to-string n)) nil t))
- (progn (or nowarn (message "Message %d not found" n))
- (setq n curmsg)
- (goto-char cur))))
- (beginning-of-line)
- (skip-chars-forward " ")
- (skip-chars-forward "0-9")
- (save-excursion (if (= (following-char) ?-)
- (let ((buffer-read-only nil))
- (delete-char 1)
- (insert " "))))
- (beginning-of-line)
- (if skip-rmail
- nil
- (pop-to-buffer buf)
- (rmail-show-message n)
- (pop-to-buffer rmail-summary-buffer))))
-
- (defun rmail-summary-scroll-msg-up (&optional dist)
- "Scroll other window forward."
- (interactive "P")
- (scroll-other-window dist))
-
- (defun rmail-summary-scroll-msg-down (&optional dist)
- "Scroll other window backward."
- (interactive "P")
- (scroll-other-window
- (cond ((eq dist '-) nil)
- ((null dist) '-)
- (t (- (prefix-numeric-value dist))))))
-
- (defun rmail-summary-beginning-of-message ()
- "Show current message from the beginning."
- (interactive)
- (pop-to-buffer rmail-buffer)
- (beginning-of-buffer)
- (pop-to-buffer rmail-summary-buffer))
-
- (defun rmail-summary-quit ()
- "Quit out of Rmail and Rmail summary."
- (interactive)
- (rmail-summary-wipe)
- (rmail-quit))
-
- (defun rmail-summary-wipe ()
- "Kill and wipe away Rmail summary, remaining within Rmail."
- (interactive)
- (save-excursion (set-buffer rmail-buffer) (setq rmail-summary-buffer nil))
- (let ((rmail-wind (get-buffer-window rmail-buffer)))
- (kill-buffer (current-buffer))
- ;; Delete window if not only one.
- (if (not (eq (selected-window) (next-window nil 'no-minibuf)))
- (delete-window))
- ;; Switch to the rmail buffer in this window.
- ;; Select the window with rmail in it, then delete this window.
- (and rmail-wind (select-window rmail-wind))))
-
- (defun rmail-summary-expunge ()
- "Actually erase all deleted messages and recompute summary headers."
- (interactive)
- (save-excursion
- (set-buffer rmail-buffer)
- (rmail-only-expunge))
- (rmail-update-summary))
-
- (defun rmail-summary-expunge-and-save ()
- "Expunge and save RMAIL file."
- (interactive)
- (save-excursion
- (set-buffer rmail-buffer)
- (rmail-only-expunge))
- (rmail-update-summary)
- (save-excursion
- (set-buffer rmail-buffer)
- (save-buffer)))
-
- (defun rmail-summary-get-new-mail ()
- "Get new mail and recompute summary headers."
- (interactive)
- (let (msg)
- (save-excursion
- (set-buffer rmail-buffer)
- (rmail-get-new-mail)
- ;; Get the proper new message number.
- (setq msg rmail-current-message))
- ;; Make sure that message is displayed.
- (rmail-summary-goto-msg msg)))
-
- (defun rmail-summary-input (filename)
- "Run Rmail on file FILENAME."
- (interactive "FRun rmail on RMAIL file: ")
- ;; We switch windows here, then display the other Rmail file there.
- (pop-to-buffer rmail-buffer)
- (rmail filename))
-
- (defun rmail-summary-first-message ()
- "Show first message in Rmail file from summary buffer."
- (interactive)
- (beginning-of-buffer))
-
- (defun rmail-summary-last-message ()
- "Show last message in Rmail file from summary buffer."
- (interactive)
- (end-of-buffer)
- (forward-line -1))
-
- (defvar rmail-summary-edit-map nil)
- (if rmail-summary-edit-map
- nil
- (setq rmail-summary-edit-map
- (nconc (make-sparse-keymap) (cdr text-mode-map)))
- (define-key rmail-summary-edit-map "\C-c\C-c" 'rmail-cease-edit)
- (define-key rmail-summary-edit-map "\C-c\C-]" 'rmail-abort-edit))
-
- (defun rmail-summary-edit-current-message ()
- "Edit the contents of this message."
- (interactive)
- (pop-to-buffer rmail-buffer)
- (rmail-edit-current-message)
- (use-local-map rmail-summary-edit-map))
-
- (defun rmail-summary-cease-edit ()
- "Finish editing message, then go back to Rmail summary buffer."
- (interactive)
- (rmail-cease-edit)
- (pop-to-buffer rmail-summary-buffer))
-
- (defun rmail-summary-abort-edit ()
- "Abort edit of current message; restore original contents.
- Go back to summary buffer."
- (interactive)
- (rmail-abort-edit)
- (pop-to-buffer rmail-summary-buffer))
-
- (defun rmail-summary-search-backward (regexp &optional n)
- "Show message containing next match for REGEXP.
- Prefix argument gives repeat count; negative argument means search
- backwards (through earlier messages).
- Interactively, empty argument means use same regexp used last time."
- (interactive
- (let* ((reversep (>= (prefix-numeric-value current-prefix-arg) 0))
- (prompt
- (concat (if reversep "Reverse " "") "Rmail search (regexp): "))
- regexp)
- (if rmail-search-last-regexp
- (setq prompt (concat prompt
- "(default "
- rmail-search-last-regexp
- ") ")))
- (setq regexp (read-string prompt))
- (cond ((not (equal regexp ""))
- (setq rmail-search-last-regexp regexp))
- ((not rmail-search-last-regexp)
- (error "No previous Rmail search string")))
- (list rmail-search-last-regexp
- (prefix-numeric-value current-prefix-arg))))
- ;; Don't use save-excursion because that prevents point from moving
- ;; properly in the summary buffer.
- (let ((buffer (current-buffer)))
- (unwind-protect
- (progn
- (set-buffer rmail-buffer)
- (rmail-search regexp (- n)))
- (set-buffer buffer))))
-
- (defun rmail-summary-search (regexp &optional n)
- "Show message containing next match for REGEXP.
- Prefix argument gives repeat count; negative argument means search
- backwards (through earlier messages).
- Interactively, empty argument means use same regexp used last time."
- (interactive
- (let* ((reversep (< (prefix-numeric-value current-prefix-arg) 0))
- (prompt
- (concat (if reversep "Reverse " "") "Rmail search (regexp): "))
- regexp)
- (if rmail-search-last-regexp
- (setq prompt (concat prompt
- "(default "
- rmail-search-last-regexp
- ") ")))
- (setq regexp (read-string prompt))
- (cond ((not (equal regexp ""))
- (setq rmail-search-last-regexp regexp))
- ((not rmail-search-last-regexp)
- (error "No previous Rmail search string")))
- (list rmail-search-last-regexp
- (prefix-numeric-value current-prefix-arg))))
- ;; Don't use save-excursion because that prevents point from moving
- ;; properly in the summary buffer.
- (let ((buffer (current-buffer)))
- (unwind-protect
- (progn
- (set-buffer rmail-buffer)
- (rmail-search regexp n))
- (set-buffer buffer))))
-
- (defun rmail-summary-toggle-header ()
- "Show original message header if pruned header currently shown, or vice versa."
- (interactive)
- (save-excursion
- (set-buffer rmail-buffer)
- (rmail-toggle-header)))
-
- (defun rmail-summary-add-label (label)
- "Add LABEL to labels associated with current Rmail message.
- Completion is performed over known labels when reading."
- (interactive (list (save-excursion
- (set-buffer rmail-buffer)
- (rmail-read-label "Add label"))))
- (save-excursion
- (set-buffer rmail-buffer)
- (rmail-add-label label)))
-
- (defun rmail-summary-kill-label (label)
- "Remove LABEL from labels associated with current Rmail message.
- Completion is performed over known labels when reading."
- (interactive (list (save-excursion
- (set-buffer rmail-buffer)
- (rmail-read-label "Kill label"))))
- (save-excursion
- (set-buffer rmail-buffer)
- (rmail-set-label label nil)))
-
- ;;;; *** Rmail Summary Mailing Commands ***
-
- (defun rmail-summary-mail ()
- "Send mail in another window.
- While composing the message, use \\[mail-yank-original] to yank the
- original message into it."
- (interactive)
- (mail-other-window nil nil nil nil nil rmail-buffer)
- (use-local-map (copy-keymap (current-local-map)))
- (define-key (current-local-map)
- "\C-c\C-c" 'rmail-summary-send-and-exit))
-
- (defun rmail-summary-continue ()
- "Continue composing outgoing message previously being composed."
- (interactive)
- (mail-other-window t))
-
- (defun rmail-summary-reply (just-sender)
- "Reply to the current message.
- Normally include CC: to all other recipients of original message;
- prefix argument means ignore them.
- While composing the reply, use \\[mail-yank-original] to yank the
- original message into it."
- (interactive "P")
- (let (mailbuf)
- (save-window-excursion
- (set-buffer rmail-buffer)
- (rmail-reply just-sender)
- (setq mailbuf (current-buffer)))
- (pop-to-buffer mailbuf)
- (use-local-map (copy-keymap (current-local-map)))
- (define-key (current-local-map)
- "\C-c\C-c" 'rmail-summary-send-and-exit)))
-
- (defun rmail-summary-retry-failure ()
- "Edit a mail message which is based on the contents of the current message.
- For a message rejected by the mail system, extract the interesting headers and
- the body of the original message; otherwise copy the current message."
- (interactive)
- (let (mailbuf)
- (save-window-excursion
- (set-buffer rmail-buffer)
- (rmail-retry-failure)
- (setq mailbuf (current-buffer)))
- (pop-to-buffer mailbuf)
- (use-local-map (copy-keymap (current-local-map)))
- (define-key (current-local-map)
- "\C-c\C-c" 'rmail-summary-send-and-exit)))
-
- (defun rmail-summary-send-and-exit ()
- "Send mail reply and return to summary buffer."
- (interactive)
- (mail-send-and-exit t))
-
- (defun rmail-summary-forward ()
- "Forward the current message to another user."
- (interactive)
- (save-excursion
- (set-buffer rmail-buffer)
- (rmail-forward)
- (use-local-map (copy-keymap (current-local-map)))
- (define-key (current-local-map)
- "\C-c\C-c" 'rmail-summary-send-and-exit)))
-
- ;; Summary output commands.
-
- (defun rmail-summary-output-to-rmail-file ()
- "Append the current message to an Rmail file named FILE-NAME.
- If the file does not exist, ask if it should be created.
- If file is being visited, the message is appended to the Emacs
- buffer visiting that file."
- (interactive)
- (save-excursion
- (set-buffer rmail-buffer)
- (call-interactively 'rmail-output-to-rmail-file)))
-
- (defun rmail-summary-output ()
- "Append this message to Unix mail file named FILE-NAME."
- (interactive)
- (save-excursion
- (set-buffer rmail-buffer)
- (call-interactively 'rmail-output)))
-
- ;; Sorting messages in Rmail Summary buffer.
-
- (defun rmail-summary-sort-by-date (reverse)
- "Sort messages of current Rmail summary by date.
- If prefix argument REVERSE is non-nil, sort them in reverse order."
- (interactive "P")
- (rmail-sort-from-summary (function rmail-sort-by-date) reverse))
-
- (defun rmail-summary-sort-by-subject (reverse)
- "Sort messages of current Rmail summary by subject.
- If prefix argument REVERSE is non-nil, sort them in reverse order."
- (interactive "P")
- (rmail-sort-from-summary (function rmail-sort-by-subject) reverse))
-
- (defun rmail-summary-sort-by-author (reverse)
- "Sort messages of current Rmail summary by author.
- If prefix argument REVERSE is non-nil, sort them in reverse order."
- (interactive "P")
- (rmail-sort-from-summary (function rmail-sort-by-author) reverse))
-
- (defun rmail-summary-sort-by-recipient (reverse)
- "Sort messages of current Rmail summary by recipient.
- If prefix argument REVERSE is non-nil, sort them in reverse order."
- (interactive "P")
- (rmail-sort-from-summary (function rmail-sort-by-recipient) reverse))
-
- (defun rmail-summary-sort-by-correspondent (reverse)
- "Sort messages of current Rmail summary by other correspondent.
- If prefix argument REVERSE is non-nil, sort them in reverse order."
- (interactive "P")
- (rmail-sort-from-summary (function rmail-sort-by-correspondent) reverse))
-
- (defun rmail-summary-sort-by-lines (reverse)
- "Sort messages of current Rmail summary by lines of the message.
- If prefix argument REVERSE is non-nil, sort them in reverse order."
- (interactive "P")
- (rmail-sort-from-summary (function rmail-sort-by-lines) reverse))
-
- (defun rmail-sort-from-summary (sortfun reverse)
- "Sort Rmail messages from Summary buffer and update it after sorting."
- (require 'rmailsort)
- (pop-to-buffer rmail-buffer)
- (funcall sortfun reverse)
- (rmail-summary))
-
- ;;; rmailsum.el ends here
-