Mercurial > emacs
diff lisp/mail/rmailsort.el @ 90:92266e9b90bb
Initial revision
author | Richard M. Stallman <rms@gnu.org> |
---|---|
date | Mon, 10 Sep 1990 02:16:19 +0000 |
parents | |
children | 2b8bcdcca3a1 |
line wrap: on
line diff
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/mail/rmailsort.el Mon Sep 10 02:16:19 1990 +0000 @@ -0,0 +1,154 @@ +;;; Rmail: sort messages. +;; Copyright (C) 1990 Masanobu UMEDA + +;; This file is part of GNU Emacs. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY. No author or distributor +;; accepts responsibility to anyone for the consequences of using it +;; or for whether it serves any particular purpose or works at all, +;; unless he says so in writing. Refer to the GNU Emacs General Public +;; License for full details. + +;; Everyone is granted permission to copy, modify and redistribute +;; GNU Emacs, but only under the conditions described in the +;; GNU Emacs General Public License. A copy of this license is +;; supposed to have been given to you along with GNU Emacs so you +;; can know your rights and responsibilities. It should be in a +;; file named COPYING. Among other things, the copyright notice +;; and this notice must be preserved on all copies. + +(provide 'rmailsort) +(require 'rmail) +(require 'sort) + +;; GNUS compatible key bindings. +(define-key rmail-mode-map "\C-c\C-s\C-d" 'rmail-sort-by-date) +(define-key rmail-mode-map "\C-c\C-s\C-s" 'rmail-sort-by-subject) +(define-key rmail-mode-map "\C-c\C-s\C-a" 'rmail-sort-by-author) +(define-key rmail-mode-map "\C-c\C-s\C-r" 'rmail-sort-by-recipient) + +(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." + (interactive "P") + (rmail-sort-messages reverse + (function + (lambda (msg) + (rmail-sortable-date-string + (rmail-fetch-field msg "Date")))))) + +(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." + (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)))))) + +(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." + (interactive "P") + (rmail-sort-messages reverse + (function + (lambda (msg) + (mail-strip-quoted-names + (or (rmail-fetch-field msg "From") + (rmail-fetch-field msg "Sender") "")))))) + +(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." + (interactive "P") + (rmail-sort-messages reverse + (function + (lambda (msg) + (mail-strip-quoted-names + (or (rmail-fetch-field msg "To") + (rmail-fetch-field msg "Apparently-To") "") + ))))) + + + +(defun rmail-sort-messages (reverse keyfunc) + "Sort messages of current Rmail file. +1st argument REVERSE is non-nil, sort them in reverse order. +2nd argument KEYFUNC is called with message number, and should return a key." + (let ((buffer-read-only nil) + (sort-lists nil)) + (message "Finding sort keys...") + (widen) + (let ((msgnum 1)) + (while (>= rmail-total-messages msgnum) + (setq sort-lists + (cons (cons (funcall keyfunc msgnum) ;A sort key. + (buffer-substring + (rmail-msgbeg msgnum) (rmail-msgend msgnum))) + sort-lists)) + (setq msgnum (1+ msgnum)))) + (or reverse (setq sort-lists (nreverse sort-lists))) + (setq sort-lists + (sort sort-lists + (function + (lambda (a b) + (string-lessp (car a) (car b)))))) + (if reverse (setq sort-lists (nreverse sort-lists))) + (message "Reordering buffer...") + (delete-region (rmail-msgbeg 1) (rmail-msgend rmail-total-messages)) + (while sort-lists + (insert (cdr (car sort-lists))) + (setq sort-lists (cdr sort-lists))) + (rmail-set-message-counters) + (rmail-show-message) + )) + +(defun rmail-fetch-field (msg field) + "Return the value of the header field FIELD of MSG. +Arguments are MSG and FIELD." + (let ((next (rmail-msgend msg))) + (save-restriction + (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)))) + +;; Copy of the function gnus-comparable-date in gnus.el + +(defun rmail-sortable-date-string (date) + "Make sortable string by string-lessp from DATE." + (let ((month '(("JAN" . " 1")("FEB" . " 2")("MAR" . " 3") + ("APR" . " 4")("MAY" . " 5")("JUN" . " 6") + ("JUL" . " 7")("AUG" . " 8")("SEP" . " 9") + ("OCT" . "10")("NOV" . "11")("DEC" . "12"))) + (date (or date ""))) + ;; Can understand the following styles: + ;; (1) 14 Apr 89 03:20:12 GMT + ;; (2) Fri, 17 Mar 89 4:01:33 GMT + (if (string-match + "\\([0-9]+\\) \\([^ ,]+\\) \\([0-9]+\\) \\([0-9:]+\\)" date) + (concat + ;; Year + (substring date (match-beginning 3) (match-end 3)) + ;; Month + (cdr + (assoc + (upcase (substring date (match-beginning 2) (match-end 2))) month)) + ;; Day + (format "%2d" (string-to-int + (substring date + (match-beginning 1) (match-end 1)))) + ;; Time + (substring date (match-beginning 4) (match-end 4))) + ;; Cannot understand DATE string. + date + ) + ))