X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/9596811a3d13a77893315e7db35a74a7fccd1b14..f98b752f204fbcd2a3ae8e57678e026470b34b27:/lisp/mail/rmailsum.el

diff --git a/lisp/mail/rmailsum.el b/lisp/mail/rmailsum.el
index 799f14d0bb..916782cb4b 100644
--- a/lisp/mail/rmailsum.el
+++ b/lisp/mail/rmailsum.el
@@ -33,6 +33,18 @@
 ;; For rmail-select-summary
 (require 'rmail)
 
+;;;###autoload
+(defcustom rmail-summary-scroll-between-messages t
+  "*Non-nil means Rmail summary scroll commands move between messages."
+  :type 'boolean
+  :group 'rmail-summary)
+
+;;;###autoload
+(defcustom rmail-summary-line-count-flag t
+  "*Non-nil if Rmail summary should show the number of lines in each message."
+  :type 'boolean
+  :group 'rmail-summary)
+
 (defvar rmail-summary-font-lock-keywords
   '(("^....D.*" . font-lock-string-face)			; Deleted.
     ("^....-.*" . font-lock-type-face)				; Unread.
@@ -49,11 +61,13 @@
 (defun rmail-update-summary (&rest ignore)
   (apply (car rmail-summary-redo) (cdr rmail-summary-redo)))
 
+;;;###autoload
 (defun rmail-summary ()
   "Display a summary of all messages, one line per message."
   (interactive)
   (rmail-new-summary "All" '(rmail-summary) nil))
 
+;;;###autoload
 (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."
@@ -67,6 +81,7 @@ LABELS should be a string containing the desired labels, separated by commas."
 		     'rmail-message-labels-p
 		     (concat ", \\(" (mail-comma-list-regexp labels) "\\),")))
 
+;;;###autoload
 (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;
@@ -80,6 +95,7 @@ RECIPIENTS is a string of regexps separated by commas."
    'rmail-message-recipients-p
    (mail-comma-list-regexp recipients) primary-only))
 
+;;;###autoload
 (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
@@ -98,6 +114,7 @@ Emacs will list the header line in the RMAIL-summary."
 ;; rmail-summary-by-topic
 ;; 1989 R.A. Schnitzler
 
+;;;###autoload
 (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;
@@ -122,6 +139,7 @@ SUBJECT is a string of regexps separated by commas."
     (if whole-message (re-search-forward subject nil t)
       (string-match subject (or (mail-fetch-field "Subject") "")) )))
 
+;;;###autoload
 (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."
@@ -190,6 +208,7 @@ nil for FUNCTION means all messages."
 	(setq rmail-summary-buffer nil)
 	(save-excursion
 	  (let ((rbuf (current-buffer))
+		(vbuf rmail-view-buffer)
 		(total rmail-total-messages))
 	    (set-buffer sumbuf)
 	    ;; Set up the summary buffer's contents.
@@ -203,8 +222,9 @@ nil for FUNCTION means all messages."
 	    (setq buffer-read-only t)
 	    (rmail-summary-mode)
 	    (make-local-variable 'minor-mode-alist)
-	    (setq minor-mode-alist (list '(t (concat ": " description))))
+	    (setq minor-mode-alist (list (list t (concat ": " description))))
 	    (setq rmail-buffer rbuf
+		  rmail-view-buffer vbuf
 		  rmail-summary-redo redo-form
 		  rmail-total-messages total))))
       (setq rmail-summary-buffer sumbuf))
@@ -250,6 +270,14 @@ nil for FUNCTION means all messages."
 		?\- ?\ )))
     line))
 
+;;;###autoload
+(defcustom rmail-summary-line-decoder (function identity)
+  "*Function to decode summary-line.
+
+By default, `identity' is set."
+  :type 'function
+  :group 'rmail-summary)
+
 (defun rmail-make-summary-line-1 (msg)
   (goto-char (rmail-msgbeg msg))
   (let* ((lim (save-excursion (forward-line 2) (point)))
@@ -304,10 +332,12 @@ nil for FUNCTION means all messages."
 	  (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))))))
+	  (funcall rmail-summary-line-decoder
+		   (concat (format "%4d  " msg)
+			   (substring line 0 pos)
+			   labels
+			   (substring line (1+ pos)))))
+    ))
 
 (defun rmail-make-basic-summary-line ()
   (goto-char (point-min))
@@ -330,6 +360,15 @@ nil for FUNCTION means all messages."
 					     (match-end 4)))
 			     (buffer-substring
 			      (match-beginning 2) (match-end 2))))
+		    ((re-search-forward "\\(19\\|20\\)\\([0-9][0-9]\\)-\\([01][0-9]\\)-\\([0-3][0-9]\\)"
+		      (save-excursion (end-of-line) (point)) t)
+		     (format "%2s%2s%2s"
+			     (buffer-substring
+			      (match-beginning 2) (match-end 2))
+			     (buffer-substring
+			      (match-beginning 3) (match-end 3))
+			     (buffer-substring
+			      (match-beginning 4) (match-end 4))))
 		    (t "??????"))))
 	  "  "
 	  (save-excursion
@@ -352,7 +391,14 @@ nil for FUNCTION means all messages."
 		(if (string-match (concat "^\\("
 					  (regexp-quote (user-login-name))
 					  "\\($\\|@\\)\\|"
-					  (regexp-quote user-mail-address)
+					  (regexp-quote
+					   ;; Don't lose if run from init file
+					   ;; where user-mail-address is not
+					   ;; set yet.
+					   (or user-mail-address
+					       (concat (user-login-name) "@"
+						       (or mail-host-address
+							   (system-name)))))
 					  "\\>\\)")
 				  from)
 		    (save-excursion
@@ -378,17 +424,26 @@ nil for FUNCTION means all messages."
 						     (- len 25))
 						    (t (- mch 14))))
 				     (min len (+ lo 25))))))))
-	  (save-excursion
-	    (save-restriction
-	      (widen)
-	      (let
-		  ((lines (count-lines (rmail-msgbeg msgnum) (rmail-msgend msgnum))))
-		(format (cond
-			 ((<= lines     9) "   [%d]")
-			 ((<= lines    99) "  [%d]")
-			 ((<= lines   999) " [%3d]")
-			 (t		    "[%d]"))
-			lines))))
+          (if rmail-summary-line-count-flag
+	      (save-excursion
+		(save-restriction
+		  (widen)
+		  (let ((beg (rmail-msgbeg msgnum))
+			(end (rmail-msgend msgnum))
+			lines)
+		    (save-excursion
+		      (goto-char beg)
+		      ;; Count only lines in the reformatted header,
+		      ;; if we have reformatted it.
+		      (search-forward "\n*** EOOH ***\n" end t)
+		      (setq lines (count-lines (point) end)))
+		    (format (cond
+			     ((<= lines     9) "   [%d]")
+			     ((<= lines    99) "  [%d]")
+			     ((<= lines   999) " [%3d]")
+			     (t		    "[%d]"))
+			    lines))))
+            " ")
 	  " #"				;The # is part of the format.
 	  (if (re-search-forward "^Subject:" nil t)
 	      (progn (skip-chars-forward " \t")
@@ -432,7 +487,8 @@ messages, or backward if NUMBER is negative."
 				      non-del-msg-found)))
       (setq count (1- count))))
   (beginning-of-line)
-  (display-buffer rmail-buffer))
+  (display-buffer rmail-view-buffer)
+  )
 
 (defun rmail-summary-previous-msg (&optional number)
   (interactive "p")
@@ -442,17 +498,23 @@ messages, or backward if NUMBER is negative."
   "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)))
+  (let (msg)
+    (save-excursion
+      (set-buffer rmail-buffer)
+      (rmail-next-labeled-message n labels)
+      (setq msg rmail-current-message))
+    (rmail-summary-goto-msg msg)))
 
 (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)))
+  (let (msg)
+    (save-excursion
+      (set-buffer rmail-buffer)
+      (rmail-previous-labeled-message n labels)
+      (setq msg rmail-current-message))
+    (rmail-summary-goto-msg msg)))
 
 (defun rmail-summary-next-same-subject (n)
   "Go to the next message in the summary having the same subject.
@@ -464,12 +526,12 @@ If N is negative, go backwards."
     (save-excursion
       (set-buffer rmail-buffer)
       (setq subject (mail-fetch-field "Subject"))
-      (setq search-regexp (concat "^Subject: *\\(Re: *\\)?"
-				  (regexp-quote subject)
-				  "\n"))
       (setq i rmail-current-message))
     (if (string-match "Re:[ \t]*" subject)
 	(setq subject (substring subject (match-end 0))))
+    (setq search-regexp (concat "^Subject: *\\(Re: *\\)?"
+				(regexp-quote subject)
+				"\n"))
     (save-excursion
       (while (and (/= n 0)
 		  (if forward
@@ -514,17 +576,20 @@ If N is negative, go forwards instead."
 
 ;; Delete and undelete summary commands.
 
-(defun rmail-summary-delete-forward (&optional backward)
+(defun rmail-summary-delete-forward (&optional count)
   "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-message)
-    (let ((del-msg rmail-current-message))
-      (pop-to-buffer rmail-summary-buffer)
+A prefix argument serves as a repeat count;
+a negative argument means to delete and move backward."
+  (interactive "p")
+  (unless (numberp count) (setq count 1))
+  (let (end del-msg
+	    (backward (< count 0)))
+    (while (/= count 0)
+      (rmail-summary-goto-msg)
+      (with-current-buffer rmail-buffer
+	(rmail-delete-message)
+	(setq del-msg rmail-current-message))
       (rmail-summary-mark-deleted del-msg)
       (while (and (not (if backward (bobp) (eobp)))
 		  (save-excursion (beginning-of-line)
@@ -532,13 +597,17 @@ With prefix argument, delete and move backward."
 	(forward-line (if backward -1 1)))
       ;; It looks ugly to move to the empty line at end of buffer.
       (and (eobp) (not backward)
-	   (forward-line -1)))))
+	   (forward-line -1))
+      (setq count
+	    (if (> count 0) (1- count) (1+ count))))))
 
-(defun rmail-summary-delete-backward ()
+(defun rmail-summary-delete-backward (&optional count)
   "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))
+Deleted messages stay in the file until the \\[rmail-expunge] command is given.
+A prefix argument serves as a repeat count;
+a negative argument means to delete and move forward."
+  (interactive "p")
+  (rmail-summary-delete-forward (- count)))
 
 (defun rmail-summary-mark-deleted (&optional n undel)
   ;; Since third arg is t, this only alters the summary, not the Rmail buf.
@@ -642,6 +711,7 @@ Commands for sorting the summary:
   (setq buffer-read-only t)
   (set-syntax-table text-mode-syntax-table)
   (make-local-variable 'rmail-buffer)
+  (make-local-variable 'rmail-view-buffer)
   (make-local-variable 'rmail-total-messages)
   (make-local-variable 'rmail-current-message)
   (setq rmail-current-message nil)
@@ -665,6 +735,13 @@ Commands for sorting the summary:
   (add-hook 'post-command-hook 'rmail-summary-rmail-update nil t)
   (setq revert-buffer-function 'rmail-update-summary))
 
+(defvar rmail-summary-put-back-unseen nil
+  "Used for communicating between calls to `rmail-summary-rmail-update'.
+If it moves to a message within an Incremental Search, and removes
+the `unseen' attribute from that message, it sets this flag
+so that if the next motion between messages is in the same Incremental
+Search, the `unseen' attribute is restored.")
+
 ;; 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.
@@ -680,14 +757,38 @@ Commands for sorting the summary:
 				     (point)
 				     (progn (skip-chars-forward "0-9")
 					    (point))))))
+	;; Always leave `unseen' removed
+	;; if we get out of isearch mode.
+	;; Don't let a subsequent isearch restore that `unseen'.
+	(if (not isearch-mode)
+	    (setq rmail-summary-put-back-unseen nil))
+
 	(or (eq rmail-current-message msg-num)
-	    (let ((window (get-buffer-window rmail-buffer))
+	    (let ((window (get-buffer-window rmail-view-buffer t))
 		  (owin (selected-window)))
+	      (if isearch-mode
+		  (save-excursion
+		    (set-buffer rmail-buffer)
+		    ;; If we first saw the previous message in this search,
+		    ;; and we have gone to a different message while searching,
+		    ;; put back `unseen' on the former one.
+		    (rmail-set-attribute "unseen" t
+					 rmail-current-message)
+		    ;; Arrange to do that later, for the new current message,
+		    ;; if it still has `unseen'.
+		    (setq rmail-summary-put-back-unseen
+			  (rmail-message-labels-p msg-num ", ?\\(unseen\\),")))
+		(setq rmail-summary-put-back-unseen nil))
+
+	      ;; Go to the desired message.
 	      (setq rmail-current-message msg-num)
+
+	      ;; Update the summary to show the message has been seen.
 	      (if (= (following-char) ?-)
 		  (progn
 		    (delete-char 1)
 		    (insert " ")))
+
 	      (if window
 		  ;; Using save-window-excursion would cause the new value
 		  ;; of point to get lost.
@@ -708,7 +809,10 @@ Commands for sorting the summary:
     nil
   (setq rmail-summary-mode-map (make-keymap))
   (suppress-keymap rmail-summary-mode-map)
+
+  (define-key rmail-summary-mode-map [mouse-2] 'rmail-summary-mouse-goto-message)
   (define-key rmail-summary-mode-map "a"      'rmail-summary-add-label)
+  (define-key rmail-summary-mode-map "b"      'rmail-summary-bury)
   (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)
@@ -802,6 +906,9 @@ Commands for sorting the summary:
 (define-key rmail-summary-mode-map [menu-bar summary]
   (cons "Summary" (make-sparse-keymap "Summary")))
 
+(define-key rmail-summary-mode-map [menu-bar summary senders]
+  '("By Senders..." . rmail-summary-by-senders))
+
 (define-key rmail-summary-mode-map [menu-bar summary labels]
   '("By Labels..." . rmail-summary-by-labels))
 
@@ -889,15 +996,19 @@ Commands for sorting the summary:
 (defvar rmail-summary-overlay nil)
 (put 'rmail-summary-overlay 'permanent-local t)
 
-;; Go to message N in the summary buffer which is current,
-;; and in the corresponding Rmail buffer.
-;; If N is nil, use the message corresponding to point in the summary
-;; and move to that message in the Rmail buffer.
-
-;; If NOWARN, don't say anything if N is out of range.
-;; If SKIP-RMAIL, don't do anything to the Rmail buffer.
+(defun rmail-summary-mouse-goto-message (event)
+  "Select the message whose summary line you click on."
+  (interactive "@e")
+  (goto-char (posn-point (event-end event)))
+  (rmail-summary-goto-msg))
 
 (defun rmail-summary-goto-msg (&optional n nowarn skip-rmail)
+  "Go to message N in the summary buffer and the Rmail buffer.
+If N is nil, use the message corresponding to point in the summary
+and move to that message in the Rmail buffer.
+
+If NOWARN, don't say anything if N is out of range.
+If SKIP-RMAIL, don't do anything to the Rmail buffer."
   (interactive "P")
   (if (consp n) (setq n (prefix-numeric-value n)))
   (if (eobp) (forward-line -1))
@@ -975,7 +1086,7 @@ advance to the next message."
   (interactive "P")
   (if (eq dist '-)
       (rmail-summary-scroll-msg-down nil)
-    (let ((rmail-buffer-window (get-buffer-window rmail-buffer)))
+    (let ((rmail-buffer-window (get-buffer-window rmail-view-buffer)))
       (if rmail-buffer-window
 	  (if (let ((rmail-summary-window (selected-window)))
 		(select-window rmail-buffer-window)
@@ -987,17 +1098,18 @@ advance to the next message."
 			(end-of-line)
 			(eobp)))
 		  (select-window rmail-summary-window)))
-	      (rmail-summary-next-msg (or dist 1))
-	    (let ((other-window-scroll-buffer rmail-buffer))
+	      (if (not rmail-summary-scroll-between-messages)
+		  (error "End of buffer")
+		(rmail-summary-next-msg (or dist 1)))
+	    (let ((other-window-scroll-buffer rmail-view-buffer))
 	      (scroll-other-window dist)))
-	;; This forces rmail-buffer to be sized correctly later.
-	(display-buffer rmail-buffer)
-	(setq rmail-current-message nil)))))
+	;; If it isn't visible at all, show the beginning.
+	(rmail-summary-beginning-of-message)))))
 
 (defun rmail-summary-scroll-msg-down (&optional dist)
   "Scroll the Rmail window backward.
-If the Rmail window is displaying the beginning of a message,
-advance to the previous message."
+If the Rmail window is now displaying the beginning of a message,
+move to the previous message."
   (interactive "P")
   (if (eq dist '-)
       (rmail-summary-scroll-msg-up nil)
@@ -1012,20 +1124,42 @@ advance to the previous message."
 		      (beginning-of-line)
 		      (bobp))
 		  (select-window rmail-summary-window)))
-	      (rmail-summary-previous-msg (or dist 1))
+	      (if (not rmail-summary-scroll-between-messages)
+		  (error "Beginning of buffer")
+		(rmail-summary-previous-msg (or dist 1)))
 	    (let ((other-window-scroll-buffer rmail-buffer))
 	      (scroll-other-window-down dist)))
-	;; This forces rmail-buffer to be sized correctly later.
-	(display-buffer rmail-buffer)
-	(setq rmail-current-message nil)))))
+	;; If it isn't visible at all, show the beginning.
+	(rmail-summary-beginning-of-message)))))
 
 (defun rmail-summary-beginning-of-message ()
   "Show current message from the beginning."
   (interactive)
-  (pop-to-buffer rmail-buffer)
+  (if (and (one-window-p) (not pop-up-frames))
+      ;; If there is just one window, put the summary on the top.
+      (let ((buffer rmail-buffer))
+	(split-window (selected-window) rmail-summary-window-size)
+	(select-window (frame-first-window))
+	(pop-to-buffer rmail-buffer)
+	;; If pop-to-buffer did not use that window, delete that
+	;; window.  (This can happen if it uses another frame.)
+	(or (eq buffer (window-buffer (next-window (frame-first-window))))
+	    (delete-other-windows)))
+    (pop-to-buffer rmail-buffer))
   (beginning-of-buffer)
   (pop-to-buffer rmail-summary-buffer))
 
+(defun rmail-summary-bury ()
+  "Bury the Rmail buffer and the Rmail summary buffer."
+  (interactive)
+  (let ((buffer-to-bury (current-buffer)))
+    (let (window)
+      (while (setq window (get-buffer-window rmail-buffer))
+	(set-window-buffer window (other-buffer rmail-buffer)))
+      (bury-buffer rmail-buffer))
+    (switch-to-buffer (other-buffer buffer-to-bury))
+    (bury-buffer buffer-to-bury)))
+
 (defun rmail-summary-quit ()
   "Quit out of Rmail and Rmail summary."
   (interactive)
@@ -1064,13 +1198,20 @@ advance to the previous message."
     (save-buffer))
   (set-buffer-modified-p nil))
 
-(defun rmail-summary-get-new-mail ()
-  "Get new mail and recompute summary headers."
-  (interactive)
+(defun rmail-summary-get-new-mail (&optional file-name)
+  "Get new mail and recompute summary headers.
+
+Optionally you can specify the file to get new mail from.  In this case,
+the file of new mail is not changed or deleted.  Noninteractively, you can
+pass the inbox file name as an argument.  Interactively, a prefix
+argument says to read a file name and use that file as the inbox."
+  (interactive
+   (list (if current-prefix-arg
+	     (read-file-name "Get new mail from file: "))))
   (let (msg)
     (save-excursion
       (set-buffer rmail-buffer)
-      (rmail-get-new-mail)
+      (rmail-get-new-mail file-name)
       ;; Get the proper new message number.
       (setq msg rmail-current-message))
     ;; Make sure that message is displayed.