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
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
|
;;; rmailsort.el --- Rmail: sort messages.
;; Copyright (C) 1990, 1993 Free Software Foundation, Inc.
;; Author: Masanobu UMEDA <umerin@mse.kyutech.ac.jp>
;; Version: $Header: /gd/gnu/emacs/19.0/lisp/RCS/rmailsort.el,v 1.20 1994/03/30 02:24:05 kwzh Exp kwzh $
;; Keywords: mail
;; This file is part of GNU Emacs.
;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to
;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
;;; Code:
(require 'sort)
(autoload 'timezone-make-date-sortable "timezone")
;; Sorting messages in Rmail buffer
(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-make-date-sortable
(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)
(downcase ;Canonical name
(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)
(downcase ;Canonical name
(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-lines (reverse)
"Sort messages of current Rmail file by number of lines.
If prefix argument REVERSE is non-nil, sort them in reverse order."
(interactive "P")
(rmail-sort-messages reverse
(function
(lambda (msg)
(count-lines (rmail-msgbeg msg)
(rmail-msgend msg))))))
(defun rmail-sort-by-keywords (reverse labels)
"Sort messages of current Rmail file by labels.
If prefix argument REVERSE is non-nil, sort them in reverse order.
KEYWORDS is a comma-separated list of labels."
(interactive "P\nsSort by labels: ")
(or (string-match "[^ \t]" labels)
(error "No labels specified"))
(setq labels (concat (substring labels (match-beginning 0)) ","))
(let (labelvec)
(while (string-match "[ \t]*,[ \t]*" labels)
(setq labelvec (cons
(concat ", ?\\("
(substring labels 0 (match-beginning 0))
"\\),")
labelvec))
(setq labels (substring labels (match-end 0))))
(setq labelvec (apply 'vector (nreverse labelvec)))
(rmail-sort-messages reverse
(function
(lambda (msg)
(let ((n 0))
(while (and (< n (length labelvec))
(not (rmail-message-labels-p
msg (aref labelvec n))))
(setq n (1+ n)))
n))))))
;; Basic functions
(defun rmail-sort-messages (reverse keyfun)
"Sort messages of current Rmail file.
If 1st argument REVERSE is non-nil, sort them in reverse order.
2nd argument KEYFUN is called with a message number, and should return a key."
(save-excursion
;; If we are in a summary buffer, operate on the Rmail buffer.
(if (eq major-mode 'rmail-summary-mode)
(set-buffer rmail-buffer))
(let ((buffer-read-only nil)
(predicate nil) ;< or string-lessp
(sort-lists nil))
(message "Finding sort keys...")
(widen)
(let ((msgnum 1))
(while (>= rmail-total-messages msgnum)
(setq sort-lists
(cons (list (funcall keyfun msgnum) ;Make sorting key
(eq rmail-current-message msgnum) ;True if current
(aref rmail-message-vector msgnum)
(aref rmail-message-vector (1+ 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)))
;; Decide predicate: < or string-lessp
(if (numberp (car (car sort-lists))) ;Is a key numeric?
(setq predicate (function <))
(setq predicate (function string-lessp)))
(setq sort-lists
(sort sort-lists
(function
(lambda (a b)
(funcall predicate (car a) (car b))))))
(if reverse (setq sort-lists (nreverse sort-lists)))
;; Now we enter critical region. So, keyboard quit is disabled.
(message "Reordering messages...")
(let ((inhibit-quit t) ;Inhibit quit
(current-message nil)
(msgnum 1)
(msginfo nil))
;; There's little hope that we can easily undo after that.
(buffer-disable-undo (current-buffer))
(goto-char (rmail-msgbeg 1))
;; To force update of all markers.
(insert-before-markers ?Z)
(backward-char 1)
;; Now reorder messages.
(while sort-lists
(setq msginfo (car sort-lists))
;; Swap two messages.
(insert-buffer-substring
(current-buffer) (nth 2 msginfo) (nth 3 msginfo))
(delete-region (nth 2 msginfo) (nth 3 msginfo))
;; Is current message?
(if (nth 1 msginfo)
(setq current-message msgnum))
(setq sort-lists (cdr sort-lists))
(if (zerop (% msgnum 10))
(message "Reordering messages...%d" msgnum))
(setq msgnum (1+ msgnum)))
;; Delete the garbage inserted before.
(delete-char 1)
(setq quit-flag nil)
(buffer-enable-undo)
(rmail-set-message-counters)
(rmail-show-message current-message)
(if (rmail-summary-exists)
(rmail-select-summary
(rmail-update-summary)))))))
(defun rmail-fetch-field (msg field)
"Return the value of the header FIELD of MSG.
Arguments are MSG and FIELD."
(save-restriction
(widen)
(let ((next (rmail-msgend msg)))
(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))))
(defun rmail-make-date-sortable (date)
"Make DATE sortable using the function string-lessp."
;; Assume the default time zone is GMT.
(timezone-make-date-sortable date "GMT" "GMT"))
(provide 'rmailsort)
;;; rmailsort.el ends here
|
