mirror of
https://git.savannah.gnu.org/git/emacs.git
synced 2024-12-24 10:38:38 +00:00
Initial revision
This commit is contained in:
parent
305d4b11c1
commit
4d4d11ccf5
474
lisp/mail/rmailsum.el
Normal file
474
lisp/mail/rmailsum.el
Normal file
@ -0,0 +1,474 @@
|
||||
;; "RMAIL" mail reader for Emacs.
|
||||
;; Copyright (C) 1985 Free Software Foundation, Inc.
|
||||
|
||||
;; 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 1, 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.
|
||||
|
||||
|
||||
;; summary things
|
||||
|
||||
(defun rmail-summary ()
|
||||
"Display a summary of all messages, one line per message."
|
||||
(interactive)
|
||||
(rmail-new-summary "All" 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)
|
||||
'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 names separated by commas."
|
||||
(interactive "sRecipients to summarize by: \nP")
|
||||
(rmail-new-summary
|
||||
(concat "recipients " recipients)
|
||||
'rmail-message-recipients-p
|
||||
(mail-comma-list-regexp recipients) primary-only))
|
||||
|
||||
(defun rmail-message-recipients-p (msg recipients &optional primary-only)
|
||||
(save-restriction
|
||||
(goto-char (rmail-msgbeg msg))
|
||||
(search-forward "\n*** EOOH ***\n")
|
||||
(narrow-to-region (point) (progn (search-forward "\n\n") (point)))
|
||||
(or (string-match recipients (or (mail-fetch-field "To") ""))
|
||||
(string-match recipients (or (mail-fetch-field "From") ""))
|
||||
(if (not primary-only)
|
||||
(string-match recipients (or (mail-fetch-field "Cc") ""))))))
|
||||
|
||||
(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)
|
||||
'rmail-message-regexp-p
|
||||
regexp))
|
||||
|
||||
(defun rmail-message-regexp-p (msg regexp)
|
||||
"Return t, if for message number MSG, regexp REGEXP matches in the header."
|
||||
(goto-char (rmail-msgbeg msg))
|
||||
(let ((end
|
||||
(save-excursion
|
||||
(search-forward "*** EOOH ***" (point-max)) (point))))
|
||||
(re-search-forward regexp end t)))
|
||||
|
||||
(defun rmail-new-summary (description 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...")
|
||||
(or (and rmail-summary-buffer
|
||||
(buffer-name rmail-summary-buffer))
|
||||
(setq rmail-summary-buffer
|
||||
(generate-new-buffer (concat (buffer-name) "-summary"))))
|
||||
(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 (rmail-make-summary-line msgnum)
|
||||
summary-msgs)))
|
||||
(setq msgnum (1+ msgnum))))))
|
||||
(let ((sbuf rmail-summary-buffer)
|
||||
(rbuf (current-buffer))
|
||||
(total rmail-total-messages)
|
||||
(mesg rmail-current-message))
|
||||
(pop-to-buffer sbuf)
|
||||
;; Our scroll command should always scroll the Rmail buffer.
|
||||
(make-local-variable 'other-window-scroll-buffer)
|
||||
(setq other-window-scroll-buffer rbuf)
|
||||
(let ((buffer-read-only nil))
|
||||
(erase-buffer)
|
||||
(cond (summary-msgs
|
||||
(princ (nreverse summary-msgs) sbuf)
|
||||
(delete-char -1)
|
||||
(subst-char-in-region 1 2 ?\( ?\ ))))
|
||||
(setq buffer-read-only t)
|
||||
(goto-char (point-min))
|
||||
(rmail-summary-mode)
|
||||
(make-local-variable 'minor-mode-alist)
|
||||
(setq minor-mode-alist (list ": " description))
|
||||
(setq rmail-buffer rbuf
|
||||
rmail-total-messages total)
|
||||
(rmail-summary-goto-msg mesg t)))
|
||||
(message "Computing summary lines...done"))
|
||||
|
||||
(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"))
|
||||
|
||||
(defun rmail-summary-next-all (&optional number)
|
||||
(interactive "p")
|
||||
(forward-line (if number number 1))
|
||||
(rmail-summary-goto-msg))
|
||||
|
||||
(defun rmail-summary-previous-all (&optional number)
|
||||
(interactive "p")
|
||||
(forward-line (- (if number number 1)))
|
||||
(rmail-summary-goto-msg))
|
||||
|
||||
(defun rmail-summary-next-msg (&optional number)
|
||||
(interactive "p")
|
||||
(forward-line 0)
|
||||
(and (> number 0) (forward-line 1))
|
||||
(let ((count (if (< number 0) (- number) number))
|
||||
(search (if (> number 0) 're-search-forward 're-search-backward))
|
||||
end)
|
||||
(while (and (> count 0) (funcall search "^.....[^D]" nil t))
|
||||
(setq count (1- count)))
|
||||
(rmail-summary-goto-msg)))
|
||||
|
||||
(defun rmail-summary-previous-msg (&optional number)
|
||||
(interactive "p")
|
||||
(rmail-summary-next-msg (- (if number number 1))))
|
||||
|
||||
(defun rmail-summary-delete-forward ()
|
||||
(interactive)
|
||||
(let (end)
|
||||
(rmail-summary-goto-msg)
|
||||
(pop-to-buffer rmail-buffer)
|
||||
(rmail-delete-message)
|
||||
(pop-to-buffer rmail-summary-buffer)
|
||||
(let ((buffer-read-only nil))
|
||||
(skip-chars-forward " ")
|
||||
(skip-chars-forward "[0-9]")
|
||||
(delete-char 1)
|
||||
(insert "D"))
|
||||
(rmail-summary-next-msg 1)))
|
||||
|
||||
(defun rmail-summary-delete-backward ()
|
||||
(interactive)
|
||||
(let (end)
|
||||
(rmail-summary-goto-msg)
|
||||
(pop-to-buffer rmail-buffer)
|
||||
(rmail-delete-message)
|
||||
(pop-to-buffer rmail-summary-buffer)
|
||||
(let ((buffer-read-only nil))
|
||||
(skip-chars-forward " ")
|
||||
(skip-chars-forward "[0-9]")
|
||||
(delete-char 1)
|
||||
(insert "D"))
|
||||
(rmail-summary-next-msg -1)))
|
||||
|
||||
(defun rmail-summary-undelete ()
|
||||
(interactive)
|
||||
(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))
|
||||
(t
|
||||
(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 ()
|
||||
"Major mode in effect in Rmail summary buffer.
|
||||
A subset of the Rmail mode commands are supported in this mode.
|
||||
As commands are issued in the summary buffer the corresponding
|
||||
mail message is displayed in the rmail buffer.
|
||||
|
||||
n Move to next undeleted message, or arg messages.
|
||||
p Move to previous undeleted message, or arg messages.
|
||||
M-n Move to next, or forward arg messages.
|
||||
M-p Move to previous, or previous arg messages.
|
||||
j Jump to the message at the cursor location.
|
||||
d Delete the message at the cursor location and move to next message.
|
||||
C-d Delete the message at the cursor location and move to previous message.
|
||||
u Undelete this or previous deleted message.
|
||||
q Quit Rmail.
|
||||
x Exit and kill the summary window.
|
||||
space Scroll message in other window forward.
|
||||
delete Scroll message backward.
|
||||
|
||||
Entering this mode calls value of hook variable rmail-summary-mode-hook."
|
||||
(interactive)
|
||||
(kill-all-local-variables)
|
||||
(make-local-variable 'rmail-buffer)
|
||||
(make-local-variable 'rmail-total-messages)
|
||||
(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)
|
||||
(run-hooks 'rmail-summary-mode-hook))
|
||||
|
||||
(defun rmail-summary-goto-msg (&optional n nowarn)
|
||||
(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)
|
||||
(pop-to-buffer buf)
|
||||
(rmail-show-message n)
|
||||
(pop-to-buffer rmail-summary-buffer)))
|
||||
|
||||
(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 "j" 'rmail-summary-goto-msg)
|
||||
(define-key rmail-summary-mode-map "n" 'rmail-summary-next-msg)
|
||||
(define-key rmail-summary-mode-map "p" 'rmail-summary-previous-msg)
|
||||
(define-key rmail-summary-mode-map "\en" 'rmail-summary-next-all)
|
||||
(define-key rmail-summary-mode-map "\ep" 'rmail-summary-previous-all)
|
||||
(define-key rmail-summary-mode-map " " 'rmail-summary-scroll-msg-up)
|
||||
(define-key rmail-summary-mode-map "q" 'rmail-summary-quit)
|
||||
(define-key rmail-summary-mode-map "u" 'rmail-summary-undelete)
|
||||
(define-key rmail-summary-mode-map "x" 'rmail-summary-exit)
|
||||
(define-key rmail-summary-mode-map "\177" 'rmail-summary-scroll-msg-down)
|
||||
(define-key rmail-summary-mode-map "d" 'rmail-summary-delete-forward)
|
||||
(define-key rmail-summary-mode-map "\C-d" 'rmail-summary-delete-backward))
|
||||
|
||||
(defun rmail-summary-scroll-msg-up (&optional dist)
|
||||
"Scroll other window forward."
|
||||
(interactive "P")
|
||||
(let ((window (selected-window))
|
||||
(new-window (display-buffer rmail-buffer)))
|
||||
(unwind-protect
|
||||
(progn
|
||||
(select-window new-window)
|
||||
(scroll-up dist))
|
||||
(select-window window))))
|
||||
|
||||
(defun rmail-summary-scroll-msg-down (&optional dist)
|
||||
"Scroll other window backward."
|
||||
(interactive "P")
|
||||
(let ((window (selected-window))
|
||||
(new-window (display-buffer rmail-buffer)))
|
||||
(unwind-protect
|
||||
(progn
|
||||
(select-window new-window)
|
||||
(scroll-down dist))
|
||||
(select-window window))))
|
||||
|
||||
(defun rmail-summary-quit ()
|
||||
"Quit out of rmail and rmail summary."
|
||||
(interactive)
|
||||
(rmail-summary-exit)
|
||||
(rmail-quit))
|
||||
|
||||
(defun rmail-summary-exit ()
|
||||
"Exit rmail summary, remaining within rmail."
|
||||
(interactive)
|
||||
(bury-buffer (current-buffer))
|
||||
(if (get-buffer-window rmail-buffer)
|
||||
;; Select the window with rmail in it, then delete this window.
|
||||
(select-window (prog1
|
||||
(get-buffer-window rmail-buffer)
|
||||
(delete-window (selected-window))))
|
||||
;; Switch to the rmail buffer in this window.
|
||||
(switch-to-buffer rmail-buffer)))
|
Loading…
Reference in New Issue
Block a user