--- /dev/null
+;; "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)))
+\f
+(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)))
projects / emacs.git / commitdiff