Path: utzoo!utgpu!jarvis.csri.toronto.edu!cs.utexas.edu!wuarchive!brutus.cs.uiuc.edu!apple!sun-barr!ccut!kyu-cs!champon!umerin From: umerin@tc.Nagasaki.GO.JP (Masanobu UMEDA) Newsgroups: gnu.emacs Subject: Re: rmail sorting Message-ID: Date: 21 Feb 90 07:54:53 GMT References: Sender: news@tc.nagasaki.go.jp Distribution: gnu Organization: Technology Center, Nagasaki, Japan. Lines: 170 In-reply-to: trevor@theory.lcs.mit.edu's message of 20 Feb 90 23:22:15 GMT >>>>> In article , 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