1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
|
;;; Rmail: sort messages.
;; Copyright (C) 1990 Masanobu UMEDA
;; umerin@tc.Nagasaki.GO.JP?
;; 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)
(define-key rmail-mode-map "\C-c\C-s\C-c" 'rmail-sort-by-correspondent)
(define-key rmail-mode-map "\C-c\C-s\C-l" 'rmail-sort-by-size-lines)
(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-by-correspondent (reverse)
"Sort messages of current Rmail file by other correspondent.
If prefix argument REVERSE is non-nil, sort them in reverse order."
(interactive "P")
(rmail-sort-messages reverse
(function
(lambda (msg)
(rmail-select-correspondent
msg
'("From" "Sender" "To" "Apparently-To"))))))
(defun rmail-select-correspondent (msg fields)
(let ((ans ""))
(while (and fields (string= ans ""))
(setq ans
(rmail-dont-reply-to
(mail-strip-quoted-names
(or (rmail-fetch-field msg (car fields)) ""))))
(setq fields (cdr fields)))
ans))
(defun rmail-sort-by-size-lines (reverse)
"Sort messages of current Rmail file by message size.
If prefix argument REVERSE is non-nil, sort them in reverse order."
(interactive "P")
(rmail-sort-messages reverse
(function
(lambda (msg)
(format "%9d"
(count-lines (rmail-msgbeg msgnum)
(rmail-msgend msgnum)))))))
(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))
(if (zerop (% msgnum 10))
(message "Finding sort keys...%d" msgnum))
(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))
(let ((msgnum 1))
(while sort-lists
(insert (cdr (car sort-lists)))
(if (zerop (% msgnum 10))
(message "Reordering buffer...%d" msgnum))
(setq sort-lists (cdr sort-lists))
(setq msgnum (1+ msgnum))))
(rmail-set-message-counters)
(rmail-show-message 1)))
(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")
("JANUARY" . " 1") ("FEBRUARY" . " 2")
("MARCH" . " 3") ("APRIL" . " 4")
("MAY" . " 5") ("JUNE" . " 6")
("JULY" . " 7") ("AUGUST" . " 8")
("SEPTEMBER" " 9") ("OCTOBER" . "10")
("NOVEMBER" "11") ("DECEMBER" . "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
(rmail-date-full-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)))
(defun rmail-date-full-year (year-string)
(if (<= (length year-string) 2)
(concat "19" year-string)
year-string))
|
