rmail navigation by summary

[Alex Schroeder]

I propose the following patch in order to make navigation by summary
more robust.  All functions now get their regular expression from the
same place.  The only ugly hack I'm using is this one in
rmail-current-subject-regexp:

            (if (string= "\\`" (substring rmail-reply-regexp 0 2))
                (substring rmail-reply-regexp 2)
              rmail-reply-regexp)

This makes sure that rmail-reply-regexp can still start with \\` (as
it continues to do by default).

I would apply this patch unless anybody objects.


2006-01-07  Alex Schroeder  <address@hidden>

        * mail/rmail.el (rmail-current-subject): New function.
        (rmail-current-subject-regexp): New function.
        (rmail-next-same-subject): Use it.

        * mail/rmailsum.el (rmail-summary-by-topic): Use
        rmail-current-subject and rmail-current-subject-regexp.
        (rmail-summary-next-same-subject): Ditto.

*** rmailsum.el 24 Sep 2005 15:43:58 +0200      1.139
--- rmailsum.el 07 Jan 2006 19:12:39 +0100      
***************
*** 132,138 ****
  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)
--- 132,146 ----
  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
!    (let* ((subject (with-current-buffer rmail-buffer
!                    (rmail-current-subject)))
!         (subject-re (with-current-buffer rmail-buffer
!                       (rmail-current-subject-regexp)))
!         (prompt (concat "Topics to summarize by (regexp"
!                         (if subject ", default current subject" "")
!                         "): ")))
!      (list (read-string prompt nil nil subject) current-prefix-arg)))
    (rmail-new-summary
     (concat "about " subject)
     (list 'rmail-summary-by-topic subject whole-message)
***************
*** 568,584 ****
  With prefix argument N, do this N times.
  If N is negative, go backwards."
    (interactive "p")
!   (let (subject search-regexp  i found
!       (forward (> n 0)))
!     (save-excursion
!       (set-buffer rmail-buffer)
!       (setq subject (mail-fetch-field "Subject"))
!       (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
--- 576,586 ----
  With prefix argument N, do this N times.
  If N is negative, go backwards."
    (interactive "p")
!   (let ((forward (> n 0))
!       search-regexp i found)
!     (with-current-buffer rmail-buffer
!       (setq search-regexp (rmail-current-subject-regexp)
!           i rmail-current-message))
      (save-excursion
        (while (and (/= n 0)
                  (if forward





Index: rmail.el
===================================================================
RCS file: /sources/emacs/emacs/lisp/mail/rmail.el,v
retrieving revision 1.416
diff -c -r1.416 rmail.el
*** rmail.el    10 Dec 2005 11:29:53 -0000      1.416
--- rmail.el    7 Jan 2006 18:21:36 -0000
***************
*** 3143,3172 ****
  ;;    (rmail-show-message found))
      found))
  
! (defun rmail-next-same-subject (n)
!   "Go to the next mail message having the same subject header.
! With prefix argument N, do this N times.
! If N is negative, go backwards instead."
!   (interactive "p")
!   (let ((subject (mail-fetch-field "Subject"))
!       (forward (> n 0))
!       (i rmail-current-message)
!       (case-fold-search t)
!       search-regexp found)
      (if (string-match "\\`[ \t]+" subject)
        (setq subject (substring subject (match-end 0))))
!     (if (string-match "\\`\\(Re:[ \t]*\\)+" subject)
        (setq subject (substring subject (match-end 0))))
      (if (string-match "[ \t]+\\'" subject)
        (setq subject (substring subject 0 (match-beginning 0))))
      ;; If Subject is long, mailers will break it into several lines at
      ;; arbitrary places, so replace whitespace with a regexp that will
      ;; match any sequence of spaces, TABs, and newlines.
      (setq subject (regexp-quote subject))
      (setq subject
          (replace-regexp-in-string "[ \t\n]+" "[ \t\n]+" subject t t))
!     (setq search-regexp (concat "^Subject: *\\(Re:[ \t]*\\)*"
!                               subject "[ \t]*\n"))
      (save-excursion
        (save-restriction
        (widen)
--- 3143,3194 ----
  ;;    (rmail-show-message found))
      found))
  
! (defun rmail-current-subject ()
!   "Return the current subject.
! The subject is stripped of leading and trailing whitespace, and
! of typical reply prefixes such as Re:."
!   (let ((subject (or (mail-fetch-field "Subject") "")))
      (if (string-match "\\`[ \t]+" subject)
        (setq subject (substring subject (match-end 0))))
!     (if (string-match rmail-reply-regexp subject)
        (setq subject (substring subject (match-end 0))))
      (if (string-match "[ \t]+\\'" subject)
        (setq subject (substring subject 0 (match-beginning 0))))
+     subject))
+ 
+ (defun rmail-current-subject-regexp ()
+   "Return a regular expression matching the current subject.
+ The regular expression matches the subject header line of
+ messages about the same subject.  The subject itself is stripped
+ of leading and trailing whitespace, of typical reply prefixes
+ such as Re: and whitespace within the subject is replaced by a
+ regular expression matching whitespace in general in order to
+ take into account that subject header lines may include newlines
+ and more whitespace.  The returned regular expressions contains
+ `rmail-reply-regexp' and ends with a newline."
+   (let ((subject (rmail-current-subject)))
      ;; If Subject is long, mailers will break it into several lines at
      ;; arbitrary places, so replace whitespace with a regexp that will
      ;; match any sequence of spaces, TABs, and newlines.
      (setq subject (regexp-quote subject))
      (setq subject
          (replace-regexp-in-string "[ \t\n]+" "[ \t\n]+" subject t t))
!     (concat "^Subject: "
!           (if (string= "\\`" (substring rmail-reply-regexp 0 2))
!               (substring rmail-reply-regexp 2)
!             rmail-reply-regexp)
!           subject "[ \t]*\n")))
! 
! (defun rmail-next-same-subject (n)
!   "Go to the next mail message having the same subject header.
! With prefix argument N, do this N times.
! If N is negative, go backwards instead."
!   (interactive "p")
!   (let ((search-regexp (rmail-current-subject-regexp))
!       (forward (> n 0))
!       (i rmail-current-message)
!       (case-fold-search t)
!       found)
      (save-excursion
        (save-restriction
        (widen)