umerin@tc.Nagasaki.GO.JP (Masanobu UMEDA) (02/21/90)
>>>>> In article <TREVOR.90Feb20152215@emu.lcs.mit.edu>, trevor@theory.lcs.mit.edu (Trevor Jim) writes:
Trevor> I'd like to sort some rmail files by date. Anyone know how to do this?
Yes, here it is.
: This is a shar archive. Extract with sh, not csh.
: The rest of this file will extract:
: rmailsort.el
echo x rmailsort.el
sed 's/^X//' > rmailsort.el << '*-*-END-of-rmailsort.el-*-*'
X;;; Rmail: sort messages.
X;; Copyright (C) 1990 Masanobu UMEDA
X
X;; This file is part of GNU Emacs.
X
X;; GNU Emacs is distributed in the hope that it will be useful,
X;; but WITHOUT ANY WARRANTY. No author or distributor
X;; accepts responsibility to anyone for the consequences of using it
X;; or for whether it serves any particular purpose or works at all,
X;; unless he says so in writing. Refer to the GNU Emacs General Public
X;; License for full details.
X
X;; Everyone is granted permission to copy, modify and redistribute
X;; GNU Emacs, but only under the conditions described in the
X;; GNU Emacs General Public License. A copy of this license is
X;; supposed to have been given to you along with GNU Emacs so you
X;; can know your rights and responsibilities. It should be in a
X;; file named COPYING. Among other things, the copyright notice
X;; and this notice must be preserved on all copies.
X
X(provide 'rmailsort)
X(require 'rmail)
X(require 'sort)
X
X;; GNUS compatible key bindings.
X(define-key rmail-mode-map "\C-c\C-s\C-d" 'rmail-sort-by-date)
X(define-key rmail-mode-map "\C-c\C-s\C-s" 'rmail-sort-by-subject)
X(define-key rmail-mode-map "\C-c\C-s\C-a" 'rmail-sort-by-author)
X(define-key rmail-mode-map "\C-c\C-s\C-r" 'rmail-sort-by-recipient)
X
X(defun rmail-sort-by-date (reverse)
X "Sort messages of current Rmail file by date.
XIf prefix argument REVERSE is non-nil, sort them in reverse order."
X (interactive "P")
X (rmail-sort-messages reverse
X (function
X (lambda (msg)
X (rmail-sortable-date-string
X (rmail-fetch-field msg "Date"))))))
X
X(defun rmail-sort-by-subject (reverse)
X "Sort messages of current Rmail file by subject.
XIf prefix argument REVERSE is non-nil, sort them in reverse order."
X (interactive "P")
X (rmail-sort-messages reverse
X (function
X (lambda (msg)
X (let ((key (or (rmail-fetch-field msg "Subject") ""))
X (case-fold-search t))
X ;; Remove `Re:'
X (if (string-match "^\\(re:[ \t]+\\)*" key)
X (substring key (match-end 0)) key))))))
X
X(defun rmail-sort-by-author (reverse)
X "Sort messages of current Rmail file by author.
XIf prefix argument REVERSE is non-nil, sort them in reverse order."
X (interactive "P")
X (rmail-sort-messages reverse
X (function
X (lambda (msg)
X (mail-strip-quoted-names
X (or (rmail-fetch-field msg "From")
X (rmail-fetch-field msg "Sender") ""))))))
X
X(defun rmail-sort-by-recipient (reverse)
X "Sort messages of current Rmail file by recipient.
XIf prefix argument REVERSE is non-nil, sort them in reverse order."
X (interactive "P")
X (rmail-sort-messages reverse
X (function
X (lambda (msg)
X (mail-strip-quoted-names
X (or (rmail-fetch-field msg "To")
X (rmail-fetch-field msg "Apparently-To") "")
X )))))
X
X
X
X(defun rmail-sort-messages (reverse keyfunc)
X "Sort messages of current Rmail file.
X1st argument REVERSE is non-nil, sort them in reverse order.
X2nd argument KEYFUNC is called with message number, and should return a key."
X (let ((buffer-read-only nil)
X (sort-lists nil))
X (message "Finding sort keys...")
X (widen)
X (let ((msgnum 1))
X (while (>= rmail-total-messages msgnum)
X (setq sort-lists
X (cons (cons (funcall keyfunc msgnum) ;A sort key.
X (buffer-substring
X (rmail-msgbeg msgnum) (rmail-msgend msgnum)))
X sort-lists))
X (setq msgnum (1+ msgnum))))
X (or reverse (setq sort-lists (nreverse sort-lists)))
X (setq sort-lists
X (sort sort-lists
X (function
X (lambda (a b)
X (string-lessp (car a) (car b))))))
X (if reverse (setq sort-lists (nreverse sort-lists)))
X (message "Reordering buffer...")
X (delete-region (rmail-msgbeg 1) (rmail-msgend rmail-total-messages))
X (while sort-lists
X (insert (cdr (car sort-lists)))
X (setq sort-lists (cdr sort-lists)))
X (rmail-set-message-counters)
X (rmail-show-message)
X ))
X
X(defun rmail-fetch-field (msg field)
X "Return the value of the header field FIELD of MSG.
XArguments are MSG and FIELD."
X (let ((next (rmail-msgend msg)))
X (save-restriction
X (goto-char (rmail-msgbeg msg))
X (narrow-to-region (if (search-forward "\n*** EOOH ***\n" next t)
X (point)
X (forward-line 1)
X (point))
X (progn (search-forward "\n\n" nil t) (point)))
X (mail-fetch-field field))))
X
X;; Copy of the function gnus-comparable-date in gnus.el
X
X(defun rmail-sortable-date-string (date)
X "Make sortable string by string-lessp from DATE."
X (let ((month '(("JAN" . " 1")("FEB" . " 2")("MAR" . " 3")
X ("APR" . " 4")("MAY" . " 5")("JUN" . " 6")
X ("JUL" . " 7")("AUG" . " 8")("SEP" . " 9")
X ("OCT" . "10")("NOV" . "11")("DEC" . "12")))
X (date (or date "")))
X ;; Can understand the following styles:
X ;; (1) 14 Apr 89 03:20:12 GMT
X ;; (2) Fri, 17 Mar 89 4:01:33 GMT
X (if (string-match
X "\\([0-9]+\\) \\([^ ,]+\\) \\([0-9]+\\) \\([0-9:]+\\)" date)
X (concat
X ;; Year
X (substring date (match-beginning 3) (match-end 3))
X ;; Month
X (cdr
X (assoc
X (upcase (substring date (match-beginning 2) (match-end 2))) month))
X ;; Day
X (format "%2d" (string-to-int
X (substring date
X (match-beginning 1) (match-end 1))))
X ;; Time
X (substring date (match-beginning 4) (match-end 4)))
X ;; Cannot understand DATE string.
X date
X )
X ))
*-*-END-of-rmailsort.el-*-*
exit 0
--
Masanobu UMEDA
umerin@tc.Nagasaki.GO.JP