[Emacs-diffs] emacs/lisp/mail rmailsort.el

[Glenn Morris]

CVSROOT:        /sources/emacs
Module name:    emacs
Changes by:     Glenn Morris <gm>       09/03/04 04:19:12

Modified files:
        lisp/mail      : rmailsort.el 

Log message:
        Replace `(function (lambda' by `(lambda' throughout.
        (rmail-sort-by-date, rmail-sort-by-subject)
        (rmail-sort-by-author, rmail-sort-by-recipient)
        (rmail-sort-by-correspondent, rmail-select-correspondent)
        (rmail-sort-by-lines, rmail-sort-by-labels, rmail-sort-messages)
        (rmail-make-date-sortable): Doc fixes.
        (rmail-sort-by-correspondent): Downcase correspondents.
        (rmail-sort-by-labels): Make it work.
        (rmail-sort-messages): Restore undo if it was initially enabled.
        Fix bobp/bolp typo that was adding a line on every sort.

CVSWeb URLs:
http://cvs.savannah.gnu.org/viewcvs/emacs/lisp/mail/rmailsort.el?cvsroot=emacs&r1=1.46&r2=1.47

Patches:
Index: rmailsort.el
===================================================================
RCS file: /sources/emacs/emacs/lisp/mail/rmailsort.el,v
retrieving revision 1.46
retrieving revision 1.47
diff -u -b -r1.46 -r1.47
--- rmailsort.el        13 Feb 2009 07:44:18 -0000      1.46
+++ rmailsort.el        4 Mar 2009 04:19:12 -0000       1.47
@@ -1,7 +1,7 @@
 ;;; rmailsort.el --- Rmail: sort messages
 
-;; Copyright (C) 1990, 1993, 1994, 2001, 2002, 2003, 2004,
-;;   2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc.
+;; Copyright (C) 1990, 1993, 1994, 2001, 2002, 2003, 2004, 2005, 2006,
+;;   2007, 2008, 2009  Free Software Foundation, Inc.
 
 ;; Author: Masanobu UMEDA <address@hidden>
 ;; Maintainer: FSF
@@ -24,78 +24,82 @@
 
 ;;; Commentary:
 
+;; Functions for sorting messages in an Rmail buffer.
+
 ;;; Code:
 
 (require 'rmail)
 
-;; Sorting messages in Rmail buffer
-
 ;;;###autoload
 (defun rmail-sort-by-date (reverse)
-  "Sort messages of current Rmail file by date.
-If prefix argument REVERSE is non-nil, sort them in reverse order."
+  "Sort messages of current Rmail buffer by \"Date\" header.
+If prefix argument REVERSE is non-nil, sorts in reverse order."
   (interactive "P")
   (rmail-sort-messages reverse
-                      (function
                        (lambda (msg)
                          (rmail-make-date-sortable
-                          (rmail-get-header "Date" msg))))))
+                         (rmail-get-header "Date" msg)))))
 
 ;;;###autoload
 (defun rmail-sort-by-subject (reverse)
-  "Sort messages of current Rmail file by subject.
-If prefix argument REVERSE is non-nil, sort them in reverse order."
+  "Sort messages of current Rmail buffer by \"Subject\" header.
+Ignores any \"Re: \" prefix.  If prefix argument REVERSE is
+non-nil, sorts in reverse order."
+  ;; Note this is a case-sensitive sort.
   (interactive "P")
   (rmail-sort-messages reverse
-                      (function
                        (lambda (msg)
                          (let ((key (or (rmail-get-header "Subject" msg) ""))
                                (case-fold-search t))
                            ;; Remove `Re:'
                            (if (string-match "^\\(re:[ \t]*\\)*" key)
                                (substring key (match-end 0))
-                             key))))))
+                            key)))))
 
 ;;;###autoload
 (defun rmail-sort-by-author (reverse)
-  "Sort messages of current Rmail file by author.
-If prefix argument REVERSE is non-nil, sort them in reverse order."
+  "Sort messages of current Rmail buffer by author.
+This uses either the \"From\" or \"Sender\" header, downcased.
+If prefix argument REVERSE is non-nil, sorts in reverse order."
   (interactive "P")
   (rmail-sort-messages reverse
-                      (function
                        (lambda (msg)
-                         (downcase     ;Canonical name
+                        (downcase      ; canonical name
                           (mail-strip-quoted-names
                            (or (rmail-get-header "From" msg)
-                               (rmail-get-header "Sender" msg) "")))))))
+                              (rmail-get-header "Sender" msg) ""))))))
 
 ;;;###autoload
 (defun rmail-sort-by-recipient (reverse)
-  "Sort messages of current Rmail file by recipient.
-If prefix argument REVERSE is non-nil, sort them in reverse order."
+  "Sort messages of current Rmail buffer by recipient.
+This uses either the \"To\" or \"Apparently-To\" header, downcased.
+If prefix argument REVERSE is non-nil, sorts in reverse order."
   (interactive "P")
   (rmail-sort-messages reverse
-                      (function
                        (lambda (msg)
-                         (downcase     ;Canonical name
+                        (downcase      ; canonical name
                           (mail-strip-quoted-names
                            (or (rmail-get-header "To" msg)
-                               (rmail-get-header "Apparently-To" msg) "")
-                           ))))))
+                              (rmail-get-header "Apparently-To" msg) ""))))))
 
 ;;;###autoload
 (defun rmail-sort-by-correspondent (reverse)
-  "Sort messages of current Rmail file by other correspondent.
-If prefix argument REVERSE is non-nil, sort them in reverse order."
+  "Sort messages of current Rmail buffer by other correspondent.
+This uses either the \"From\", \"Sender\", \"To\", or
+\"Apparently-To\" header, downcased.  Uses the first header not
+excluded by `rmail-dont-reply-to-names'.  If prefix argument
+REVERSE is non-nil, sorts in reverse order."
   (interactive "P")
   (rmail-sort-messages reverse
-                      (function
                        (lambda (msg)
+                        (downcase
                          (rmail-select-correspondent
                           msg
                           '("From" "Sender" "To" "Apparently-To"))))))
 
 (defun rmail-select-correspondent (msg fields)
+  "Find the first header not excluded by `rmail-dont-reply-to-names'.
+MSG is a message number.  FIELDS is a list of header names."
   (let ((ans ""))
     (while (and fields (string= ans ""))
       (setq ans
@@ -108,40 +112,54 @@
 
 ;;;###autoload
 (defun rmail-sort-by-lines (reverse)
-  "Sort messages of current Rmail file by number of lines.
-If prefix argument REVERSE is non-nil, sort them in reverse order."
+  "Sort messages of current Rmail buffer by the number of lines.
+If prefix argument REVERSE is non-nil, sorts in reverse order."
   (interactive "P")
   (rmail-sort-messages reverse
-                      (function
                        (lambda (msg)
                          (count-lines (rmail-msgbeg msg)
-                                      (rmail-msgend msg))))))
+                                     (rmail-msgend msg)))))
 
 ;;;###autoload
 (defun rmail-sort-by-labels (reverse labels)
-  "Sort messages of current Rmail file by labels.
-If prefix argument REVERSE is non-nil, sort them in reverse order.
-KEYWORDS is a comma-separated list of labels."
+  "Sort messages of current Rmail buffer by labels.
+LABELS is a comma-separated list of labels.  The order of these
+labels specifies the order of messages: messages with the first
+label come first, messages with the second label come second, and
+so on.  Messages that have none of these labels come last.
+If prefix argument REVERSE is non-nil, sorts in reverse order."
   (interactive "P\nsSort by labels: ")
-  (or (string-match "[^ \t]" labels)
+  (or (string-match "[^ \t]" labels)   ; need some non-whitespace
       (error "No labels specified"))
+  ;; Remove leading whitespace, add trailing comma.
   (setq labels (concat (substring labels (match-beginning 0)) ","))
-  (let (labelvec)
+  (let (labelvec nmax)
+    ;; Convert "l1,..." into "\\(, \\|\\`\\)l1\\(,\\|\\'\\)" "..." ...
     (while (string-match "[ \t]*,[ \t]*" labels)
       (setq labelvec (cons
-                     (concat ", ?\\("
+                     (concat "\\(, \\|\\`\\)"
                              (substring labels 0 (match-beginning 0))
-                             "\\),")
+                             "\\(,\\|\\'\\)")
                      labelvec))
       (setq labels (substring labels (match-end 0))))
-    (setq labelvec (apply 'vector (nreverse labelvec)))
+    (setq labelvec (apply 'vector (nreverse labelvec))
+         nmax (length labelvec))
     (rmail-sort-messages reverse
-                        (function
-                         (lambda (msg)
-                           (let ((n 0))
-                             (while (and (< n (length labelvec))
-                                         (not (rmail-message-labels-p
-                                               msg (aref labelvec n))))
+                        ;; If no labels match, returns nmax; if they
+                        ;; match the first specified in LABELS,
+                        ;; returns 0; if they match the second, returns 1; etc.
+                        ;; Hence sorts as described in the doc-string.
+                        (lambda (msg)
+                          (let ((n 0)
+                                (str (concat (rmail-get-attr-names msg)
+                                             ", "
+                                             (rmail-get-keywords msg))))
+                            ;; No labels: can't match anything.
+                            (if (string-equal ", " str)
+                                nmax
+                              (while (and (< n nmax)
+                                          (not (string-match (aref labelvec n)
+                                                             str)))
                                (setq n (1+ n)))
                              n))))))
 
@@ -149,9 +167,10 @@
 (declare-function rmail-update-summary "rmailsum" (&rest ignore))
 
 (defun rmail-sort-messages (reverse keyfun)
-  "Sort messages of current Rmail file.
-If 1st argument REVERSE is non-nil, sort them in reverse order.
-2nd argument KEYFUN is called with a message number, and should return a key."
+  "Sort messages of current Rmail buffer.
+If REVERSE is non-nil, sorts in reverse order.  Calls the
+function KEYFUN with a message number (it should return a sort key).
+Numeric keys are sorted numerically, all others as strings."
   (with-current-buffer rmail-buffer
     (let ((return-to-point
           (if (rmail-buffers-swapped-p)
@@ -177,9 +196,8 @@
                   ;; Decide predicate: < or string-lessp
                   (if (numberp (car (car sort-lists))) ;Is a key numeric?
                       'car-less-than-car
-                    (function
                      (lambda (a b)
-                       (string-lessp (car a) (car b)))))))
+                     (string-lessp (car a) (car b))))))
       (if reverse (setq sort-lists (nreverse sort-lists)))
       ;; Now we enter critical region.  So, keyboard quit is disabled.
       (message "Reordering messages...")
@@ -187,7 +205,8 @@
            (inhibit-read-only t)
            (current-message nil)
            (msgnum 1)
-           (msginfo nil))
+           (msginfo nil)
+           (undo (not (eq buffer-undo-list t))))
        ;; There's little hope that we can easily undo after that.
        (buffer-disable-undo (current-buffer))
        (goto-char (rmail-msgbeg 1))
@@ -201,7 +220,7 @@
          (insert-buffer-substring
           (current-buffer) (nth 2 msginfo) (nth 3 msginfo))
          ;; The last message may not have \n\n after it.
-         (unless (bobp)
+         (unless (bolp)
            (insert "\n"))
          (unless (looking-back "\n\n")
            (insert "\n"))
@@ -215,6 +234,9 @@
        ;; Delete the dummy separator Z inserted before.
        (delete-char 1)
        (setq quit-flag nil)
+       ;; If undo was on before, re-enable it.  But note that it is
+       ;; disabled in mbox Rmail, so this is kind of pointless.
+       (if undo (buffer-enable-undo))
        (rmail-set-message-counters)
        (rmail-show-message-1 current-message)
        (if return-to-point
@@ -225,7 +247,7 @@
 (autoload 'timezone-make-date-sortable "timezone")
 
 (defun rmail-make-date-sortable (date)
-  "Make DATE sortable using the function string-lessp."
+  "Make DATE sortable using the function `string-lessp'."
   ;; Assume the default time zone is GMT.
   (timezone-make-date-sortable date "GMT" "GMT"))