1 ;;; rmailsort.el --- Rmail: sort messages.
4 ;; Last-Modified: 16 Mar 1992
7 ;; Copyright (C) 1990 Free Software Foundation, Inc.
8 ;; This file is part of GNU Emacs.
10 ;; GNU Emacs is free software; you can redistribute it and/or modify
11 ;; it under the terms of the GNU General Public License as published by
12 ;; the Free Software Foundation; either version 2, or (at your option)
15 ;; GNU Emacs is distributed in the hope that it will be useful,
16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18 ;; GNU General Public License for more details.
20 ;; You should have received a copy of the GNU General Public License
21 ;; along with GNU Emacs; see the file COPYING. If not, write to
22 ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
29 ;; GNUS compatible key bindings.
30 (define-key rmail-mode-map "\C-c\C-s\C-d" 'rmail-sort-by-date)
31 (define-key rmail-mode-map "\C-c\C-s\C-s" 'rmail-sort-by-subject)
32 (define-key rmail-mode-map "\C-c\C-s\C-a" 'rmail-sort-by-author)
33 (define-key rmail-mode-map "\C-c\C-s\C-r" 'rmail-sort-by-recipient)
34 (define-key rmail-mode-map "\C-c\C-s\C-c" 'rmail-sort-by-correspondent)
35 (define-key rmail-mode-map "\C-c\C-s\C-l" 'rmail-sort-by-size-lines)
37 (defun rmail-sort-by-date (reverse)
38 "Sort messages of current Rmail file by date.
39 If prefix argument REVERSE is non-nil, sort them in reverse order."
41 (rmail-sort-messages reverse
44 (rmail-sortable-date-string
45 (rmail-fetch-field msg "Date"))))))
47 (defun rmail-sort-by-subject (reverse)
48 "Sort messages of current Rmail file by subject.
49 If prefix argument REVERSE is non-nil, sort them in reverse order."
51 (rmail-sort-messages reverse
54 (let ((key (or (rmail-fetch-field msg "Subject") ""))
57 (if (string-match "^\\(re:[ \t]+\\)*" key)
58 (substring key (match-end 0)) key))))))
60 (defun rmail-sort-by-author (reverse)
61 "Sort messages of current Rmail file by author.
62 If prefix argument REVERSE is non-nil, sort them in reverse order."
64 (rmail-sort-messages reverse
67 (mail-strip-quoted-names
68 (or (rmail-fetch-field msg "From")
69 (rmail-fetch-field msg "Sender") ""))))))
71 (defun rmail-sort-by-recipient (reverse)
72 "Sort messages of current Rmail file by recipient.
73 If prefix argument REVERSE is non-nil, sort them in reverse order."
75 (rmail-sort-messages reverse
78 (mail-strip-quoted-names
79 (or (rmail-fetch-field msg "To")
80 (rmail-fetch-field msg "Apparently-To") "")
83 (defun rmail-sort-by-correspondent (reverse)
84 "Sort messages of current Rmail file by other correspondent.
85 If prefix argument REVERSE is non-nil, sort them in reverse order."
87 (rmail-sort-messages reverse
90 (rmail-select-correspondent
92 '("From" "Sender" "To" "Apparently-To"))))))
94 (defun rmail-select-correspondent (msg fields)
96 (while (and fields (string= ans ""))
99 (mail-strip-quoted-names
100 (or (rmail-fetch-field msg (car fields)) ""))))
101 (setq fields (cdr fields)))
104 (defun rmail-sort-by-size-lines (reverse)
105 "Sort messages of current Rmail file by message size.
106 If prefix argument REVERSE is non-nil, sort them in reverse order."
108 (rmail-sort-messages reverse
112 (count-lines (rmail-msgbeg msgnum)
113 (rmail-msgend msgnum)))))))
116 (defun rmail-sort-messages (reverse keyfunc)
117 "Sort messages of current Rmail file.
118 1st argument REVERSE is non-nil, sort them in reverse order.
119 2nd argument KEYFUNC is called with message number, and should return a key."
120 (let ((buffer-read-only nil)
122 (message "Finding sort keys...")
125 (while (>= rmail-total-messages msgnum)
127 (cons (cons (funcall keyfunc msgnum) ;A sort key.
129 (rmail-msgbeg msgnum) (rmail-msgend msgnum)))
131 (if (zerop (% msgnum 10))
132 (message "Finding sort keys...%d" msgnum))
133 (setq msgnum (1+ msgnum))))
134 (or reverse (setq sort-lists (nreverse sort-lists)))
139 (string-lessp (car a) (car b))))))
140 (if reverse (setq sort-lists (nreverse sort-lists)))
141 (message "Reordering buffer...")
142 (delete-region (rmail-msgbeg 1) (rmail-msgend rmail-total-messages))
145 (insert (cdr (car sort-lists)))
146 (if (zerop (% msgnum 10))
147 (message "Reordering buffer...%d" msgnum))
148 (setq sort-lists (cdr sort-lists))
149 (setq msgnum (1+ msgnum))))
150 (rmail-set-message-counters)
151 (rmail-show-message 1)))
153 (defun rmail-fetch-field (msg field)
154 "Return the value of the header field FIELD of MSG.
155 Arguments are MSG and FIELD."
156 (let ((next (rmail-msgend msg)))
158 (goto-char (rmail-msgbeg msg))
159 (narrow-to-region (if (search-forward "\n*** EOOH ***\n" next t)
163 (progn (search-forward "\n\n" nil t) (point)))
164 (mail-fetch-field field))))
166 ;; Copy of the function gnus-comparable-date in gnus.el
168 (defun rmail-sortable-date-string (date)
169 "Make sortable string by string-lessp from DATE."
170 (let ((month '(("JAN" . " 1")("FEB" . " 2")("MAR" . " 3")
171 ("APR" . " 4")("MAY" . " 5")("JUN" . " 6")
172 ("JUL" . " 7")("AUG" . " 8")("SEP" . " 9")
173 ("OCT" . "10")("NOV" . "11")("DEC" . "12")
174 ("JANUARY" . " 1") ("FEBRUARY" . " 2")
175 ("MARCH" . " 3") ("APRIL" . " 4")
176 ("MAY" . " 5") ("JUNE" . " 6")
177 ("JULY" . " 7") ("AUGUST" . " 8")
178 ("SEPTEMBER" " 9") ("OCTOBER" . "10")
179 ("NOVEMBER" "11") ("DECEMBER" . "12")))
181 ;; Can understand the following styles:
182 ;; (1) 14 Apr 89 03:20:12 GMT
183 ;; (2) Fri, 17 Mar 89 4:01:33 GMT
185 "\\([0-9]+\\) +\\([^ ,]+\\) +\\([0-9]+\\) +\\([0-9:]+\\)" date)
188 (rmail-date-full-year
189 (substring date (match-beginning 3) (match-end 3)))
193 (upcase (substring date (match-beginning 2) (match-end 2))) month))
195 (format "%2d" (string-to-int
197 (match-beginning 1) (match-end 1))))
199 (substring date (match-beginning 4) (match-end 4)))
200 ;; Cannot understand DATE string.
203 (defun rmail-date-full-year (year-string)
204 (if (<= (length year-string) 2)
205 (concat "19" year-string)
210 ;;; rmailsort.el ends here