# HG changeset patch # User Glenn Morris # Date 1236140352 0 # Node ID 7592f552ba105de34be537ce21aa8fd8b56739c0 # Parent 5850b3824f16feb9b3b86e873530aee20916500d 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. diff -r 5850b3824f16 -r 7592f552ba10 lisp/mail/rmailsort.el --- a/lisp/mail/rmailsort.el Wed Mar 04 04:18:51 2009 +0000 +++ b/lisp/mail/rmailsort.el Wed Mar 04 04:19:12 2009 +0000 @@ -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 ;; 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)))))) + (lambda (msg) + (rmail-make-date-sortable + (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)))))) + (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))))) ;;;###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 - (mail-strip-quoted-names - (or (rmail-get-header "From" msg) - (rmail-get-header "Sender" msg) ""))))))) + (lambda (msg) + (downcase ; canonical name + (mail-strip-quoted-names + (or (rmail-get-header "From" 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 - (mail-strip-quoted-names - (or (rmail-get-header "To" msg) - (rmail-get-header "Apparently-To" msg) "") - )))))) + (lambda (msg) + (downcase ; canonical name + (mail-strip-quoted-names + (or (rmail-get-header "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) + (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,50 +112,65 @@ ;;;###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)))))) + (lambda (msg) + (count-lines (rmail-msgbeg 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)))) - (setq n (1+ n))) - 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)))))) ;; Basic functions (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))))))) + (lambda (a 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"))