1 ;;; rmailsort.el --- Rmail: sort messages.
3 ;; Copyright (C) 1990 Free Software Foundation, Inc.
7 ;; This file is part of GNU Emacs.
9 ;; GNU Emacs is free software; you can redistribute it and/or modify
10 ;; it under the terms of the GNU General Public License as published by
11 ;; the Free Software Foundation; either version 2, or (at your option)
14 ;; GNU Emacs is distributed in the hope that it will be useful,
15 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17 ;; GNU General Public License for more details.
19 ;; You should have received a copy of the GNU General Public License
20 ;; along with GNU Emacs; see the file COPYING. If not, write to
21 ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
28 ;; GNUS compatible key bindings.
29 (define-key rmail-mode-map
"\C-c\C-s\C-d" 'rmail-sort-by-date
)
30 (define-key rmail-mode-map
"\C-c\C-s\C-s" 'rmail-sort-by-subject
)
31 (define-key rmail-mode-map
"\C-c\C-s\C-a" 'rmail-sort-by-author
)
32 (define-key rmail-mode-map
"\C-c\C-s\C-r" 'rmail-sort-by-recipient
)
33 (define-key rmail-mode-map
"\C-c\C-s\C-c" 'rmail-sort-by-correspondent
)
34 (define-key rmail-mode-map
"\C-c\C-s\C-l" 'rmail-sort-by-size-lines
)
36 (defun rmail-sort-by-date (reverse)
37 "Sort messages of current Rmail file by date.
38 If prefix argument REVERSE is non-nil, sort them in reverse order."
40 (rmail-sort-messages reverse
43 (rmail-sortable-date-string
44 (rmail-fetch-field msg
"Date"))))))
46 (defun rmail-sort-by-subject (reverse)
47 "Sort messages of current Rmail file by subject.
48 If prefix argument REVERSE is non-nil, sort them in reverse order."
50 (rmail-sort-messages reverse
53 (let ((key (or (rmail-fetch-field msg
"Subject") ""))
56 (if (string-match "^\\(re:[ \t]+\\)*" key
)
57 (substring key
(match-end 0)) key
))))))
59 (defun rmail-sort-by-author (reverse)
60 "Sort messages of current Rmail file by author.
61 If prefix argument REVERSE is non-nil, sort them in reverse order."
63 (rmail-sort-messages reverse
66 (mail-strip-quoted-names
67 (or (rmail-fetch-field msg
"From")
68 (rmail-fetch-field msg
"Sender") ""))))))
70 (defun rmail-sort-by-recipient (reverse)
71 "Sort messages of current Rmail file by recipient.
72 If prefix argument REVERSE is non-nil, sort them in reverse order."
74 (rmail-sort-messages reverse
77 (mail-strip-quoted-names
78 (or (rmail-fetch-field msg
"To")
79 (rmail-fetch-field msg
"Apparently-To") "")
82 (defun rmail-sort-by-correspondent (reverse)
83 "Sort messages of current Rmail file by other correspondent.
84 If prefix argument REVERSE is non-nil, sort them in reverse order."
86 (rmail-sort-messages reverse
89 (rmail-select-correspondent
91 '("From" "Sender" "To" "Apparently-To"))))))
93 (defun rmail-select-correspondent (msg fields
)
95 (while (and fields
(string= ans
""))
98 (mail-strip-quoted-names
99 (or (rmail-fetch-field msg
(car fields
)) ""))))
100 (setq fields
(cdr fields
)))
103 (defun rmail-sort-by-size-lines (reverse)
104 "Sort messages of current Rmail file by message size.
105 If prefix argument REVERSE is non-nil, sort them in reverse order."
107 (rmail-sort-messages reverse
111 (count-lines (rmail-msgbeg msgnum
)
112 (rmail-msgend msgnum
)))))))
115 (defun rmail-sort-messages (reverse keyfunc
)
116 "Sort messages of current Rmail file.
117 1st argument REVERSE is non-nil, sort them in reverse order.
118 2nd argument KEYFUNC is called with message number, and should return a key."
119 (let ((buffer-read-only nil
)
121 (message "Finding sort keys...")
124 (while (>= rmail-total-messages msgnum
)
126 (cons (cons (funcall keyfunc msgnum
) ;A sort key.
128 (rmail-msgbeg msgnum
) (rmail-msgend msgnum
)))
130 (if (zerop (% msgnum
10))
131 (message "Finding sort keys...%d" msgnum
))
132 (setq msgnum
(1+ msgnum
))))
133 (or reverse
(setq sort-lists
(nreverse sort-lists
)))
138 (string-lessp (car a
) (car b
))))))
139 (if reverse
(setq sort-lists
(nreverse sort-lists
)))
140 (message "Reordering buffer...")
141 (delete-region (rmail-msgbeg 1) (rmail-msgend rmail-total-messages
))
144 (insert (cdr (car sort-lists
)))
145 (if (zerop (% msgnum
10))
146 (message "Reordering buffer...%d" msgnum
))
147 (setq sort-lists
(cdr sort-lists
))
148 (setq msgnum
(1+ msgnum
))))
149 (rmail-set-message-counters)
150 (rmail-show-message 1)))
152 (defun rmail-fetch-field (msg field
)
153 "Return the value of the header field FIELD of MSG.
154 Arguments are MSG and FIELD."
155 (let ((next (rmail-msgend msg
)))
157 (goto-char (rmail-msgbeg msg
))
158 (narrow-to-region (if (search-forward "\n*** EOOH ***\n" next t
)
162 (progn (search-forward "\n\n" nil t
) (point)))
163 (mail-fetch-field field
))))
165 ;; Copy of the function gnus-comparable-date in gnus.el
167 (defun rmail-sortable-date-string (date)
168 "Make sortable string by string-lessp from DATE."
169 (let ((month '(("JAN" .
" 1")("FEB" .
" 2")("MAR" .
" 3")
170 ("APR" .
" 4")("MAY" .
" 5")("JUN" .
" 6")
171 ("JUL" .
" 7")("AUG" .
" 8")("SEP" .
" 9")
172 ("OCT" .
"10")("NOV" .
"11")("DEC" .
"12")
173 ("JANUARY" .
" 1") ("FEBRUARY" .
" 2")
174 ("MARCH" .
" 3") ("APRIL" .
" 4")
175 ("MAY" .
" 5") ("JUNE" .
" 6")
176 ("JULY" .
" 7") ("AUGUST" .
" 8")
177 ("SEPTEMBER" " 9") ("OCTOBER" .
"10")
178 ("NOVEMBER" "11") ("DECEMBER" .
"12")))
180 ;; Can understand the following styles:
181 ;; (1) 14 Apr 89 03:20:12 GMT
182 ;; (2) Fri, 17 Mar 89 4:01:33 GMT
184 "\\([0-9]+\\) +\\([^ ,]+\\) +\\([0-9]+\\) +\\([0-9:]+\\)" date
)
187 (rmail-date-full-year
188 (substring date
(match-beginning 3) (match-end 3)))
192 (upcase (substring date
(match-beginning 2) (match-end 2))) month
))
194 (format "%2d" (string-to-int
196 (match-beginning 1) (match-end 1))))
198 (substring date
(match-beginning 4) (match-end 4)))
199 ;; Cannot understand DATE string.
202 (defun rmail-date-full-year (year-string)
203 (if (<= (length year-string
) 2)
204 (concat "19" year-string
)
209 ;;; rmailsort.el ends here