;;; rmailsort.el --- Rmail: sort messages
-;; Copyright (C) 1990, 1993, 1994, 2001, 2002, 2003, 2004,
-;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
+;; Copyright (C) 1990, 1993, 1994, 2001, 2002, 2003, 2004, 2005, 2006,
+;; 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
;; Author: Masanobu UMEDA <umerin@mse.kyutech.ac.jp>
;; Maintainer: FSF
;; Keywords: mail
+;; Package: rmail
;; This file is part of GNU Emacs.
;;; Commentary:
-;;; Code:
+;; Functions for sorting messages in an Rmail buffer.
-(require 'sort)
+;;; Code:
-;; For rmail-select-summary
(require 'rmail)
-(autoload 'timezone-make-date-sortable "timezone")
-
-;; 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-fetch-field msg "Date"))))))
+ (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-fetch-field msg "Subject") ""))
- (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-fetch-field msg "From")
- (rmail-fetch-field msg "Sender") "")))))))
+ (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-fetch-field msg "To")
- (rmail-fetch-field msg "Apparently-To") "")
- ))))))
+ (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
+ ;; NB despite the name, this lives in mail-utils.el.
(rmail-dont-reply-to
(mail-strip-quoted-names
- (or (rmail-fetch-field msg (car fields)) ""))))
+ (or (rmail-get-header (car fields) msg) ""))))
(setq fields (cdr fields)))
ans))
;;;###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))))))
\f
;; 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."
- (save-current-buffer
- ;; If we are in a summary buffer, operate on the Rmail buffer.
- (if (eq major-mode 'rmail-summary-mode)
- (set-buffer rmail-buffer))
- (let ((buffer-read-only nil)
- (point-offset (- (point) (point-min)))
- (predicate nil) ;< or string-lessp
+ "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)
+ (point)))
(sort-lists nil))
+ (rmail-swap-buffers-maybe)
(message "Finding sort keys...")
(widen)
(let ((msgnum 1))
(message "Finding sort keys...%d" msgnum))
(setq msgnum (1+ msgnum))))
(or reverse (setq sort-lists (nreverse sort-lists)))
- ;; Decide predicate: < or string-lessp
- (if (numberp (car (car sort-lists))) ;Is a key numeric?
- (setq predicate (function <))
- (setq predicate (function string-lessp)))
(setq sort-lists
(sort sort-lists
- (function
- (lambda (a b)
- (funcall predicate (car a) (car b))))))
+ ;; Decide predicate: < or string-lessp
+ (if (numberp (car (car sort-lists))) ;Is a key numeric?
+ 'car-less-than-car
+ (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...")
(let ((inhibit-quit t) ;Inhibit quit
+ (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))
- ;; To force update of all markers.
+ ;; To force update of all markers,
+ ;; keep the new copies separated from the remaining old messages.
(insert-before-markers ?Z)
(backward-char 1)
;; Now reorder messages.
- (while sort-lists
- (setq msginfo (car sort-lists))
+ (dolist (msginfo sort-lists)
;; Swap two messages.
(insert-buffer-substring
(current-buffer) (nth 2 msginfo) (nth 3 msginfo))
- (delete-region (nth 2 msginfo) (nth 3 msginfo))
+ ;; The last message may not have \n\n after it.
+ (rmail-ensure-blank-line)
+ (delete-region (nth 2 msginfo) (nth 3 msginfo))
;; Is current message?
(if (nth 1 msginfo)
(setq current-message msgnum))
- (setq sort-lists (cdr sort-lists))
(if (zerop (% msgnum 10))
(message "Reordering messages...%d" msgnum))
(setq msgnum (1+ msgnum)))
- ;; Delete the garbage inserted before.
+ ;; Delete the dummy separator Z inserted before.
(delete-char 1)
(setq quit-flag nil)
- (buffer-enable-undo)
+ ;; 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 current-message)
- (goto-char (+ point-offset (point-min)))
+ (rmail-show-message-1 current-message)
+ (if return-to-point
+ (goto-char return-to-point))
(if (rmail-summary-exists)
- (rmail-select-summary
- (rmail-update-summary)))))))
-
-(defun rmail-fetch-field (msg field)
- "Return the value of the header FIELD of MSG.
-Arguments are MSG and FIELD."
- (save-restriction
- (widen)
- (let ((next (rmail-msgend msg)))
- (goto-char (rmail-msgbeg msg))
- (narrow-to-region (if (search-forward "\n*** EOOH ***\n" next t)
- (point)
- (forward-line 1)
- (point))
- (progn (search-forward "\n\n" nil t) (point)))
- (mail-fetch-field field))))
+ (rmail-select-summary (rmail-update-summary)))))))
+
+(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"))
(provide 'rmailsort)
-;; arch-tag: 0d90896b-0c35-46ac-b240-38be5ada2360
+;; Local Variables:
+;; generated-autoload-file: "rmail.el"
+;; End:
+
+;; arch-tag: 665da245-f6a7-4115-ad8c-ba19216988d5
;;; rmailsort.el ends here
HCoop / bpt / emacs.git / blobdiff