Trailing whitepace deleted.
[bpt/emacs.git] / lisp / mail / rmailsort.el
CommitLineData
55535639 1;;; rmailsort.el --- Rmail: sort messages
c88ab9ce 2
27d42947 3;; Copyright (C) 1990, 1993, 1994, 2001 Free Software Foundation, Inc.
9750e079 4
f00de7c3 5;; Author: Masanobu UMEDA <umerin@mse.kyutech.ac.jp>
1884e325 6;; Maintainer: FSF
d7b4d18f 7;; Keywords: mail
e5167999 8
8fc3fee1
RS
9;; This file is part of GNU Emacs.
10
70e1dad8
RS
11;; GNU Emacs is free software; you can redistribute it and/or modify
12;; it under the terms of the GNU General Public License as published by
e5167999 13;; the Free Software Foundation; either version 2, or (at your option)
70e1dad8
RS
14;; any later version.
15
8fc3fee1 16;; GNU Emacs is distributed in the hope that it will be useful,
70e1dad8
RS
17;; but WITHOUT ANY WARRANTY; without even the implied warranty of
18;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19;; GNU General Public License for more details.
20
21;; You should have received a copy of the GNU General Public License
71bccd7f
KH
22;; along with GNU Emacs; see the file COPYING. If not, write to the
23;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
24;; Boston, MA 02111-1307, USA.
70e1dad8 25
55535639
PJ
26;;; Commentary:
27
e5167999 28;;; Code:
8fc3fee1 29
8fc3fee1
RS
30(require 'sort)
31
7999547d
KH
32;; For rmail-select-summary
33(require 'rmail)
34
f00de7c3
RS
35(autoload 'timezone-make-date-sortable "timezone")
36
f00de7c3 37;; Sorting messages in Rmail buffer
8fc3fee1 38
372a91d7 39;;;###autoload
8fc3fee1
RS
40(defun rmail-sort-by-date (reverse)
41 "Sort messages of current Rmail file by date.
42If prefix argument REVERSE is non-nil, sort them in reverse order."
43 (interactive "P")
44 (rmail-sort-messages reverse
45 (function
46 (lambda (msg)
f00de7c3 47 (rmail-make-date-sortable
8fc3fee1
RS
48 (rmail-fetch-field msg "Date"))))))
49
372a91d7 50;;;###autoload
8fc3fee1
RS
51(defun rmail-sort-by-subject (reverse)
52 "Sort messages of current Rmail file by subject.
53If prefix argument REVERSE is non-nil, sort them in reverse order."
54 (interactive "P")
55 (rmail-sort-messages reverse
56 (function
57 (lambda (msg)
58 (let ((key (or (rmail-fetch-field msg "Subject") ""))
59 (case-fold-search t))
60 ;; Remove `Re:'
b0304aef
KH
61 (if (string-match "^\\(re:[ \t]*\\)*" key)
62 (substring key (match-end 0))
63 key))))))
8fc3fee1 64
372a91d7 65;;;###autoload
8fc3fee1
RS
66(defun rmail-sort-by-author (reverse)
67 "Sort messages of current Rmail file by author.
68If prefix argument REVERSE is non-nil, sort them in reverse order."
69 (interactive "P")
70 (rmail-sort-messages reverse
71 (function
72 (lambda (msg)
f00de7c3
RS
73 (downcase ;Canonical name
74 (mail-strip-quoted-names
75 (or (rmail-fetch-field msg "From")
76 (rmail-fetch-field msg "Sender") "")))))))
8fc3fee1 77
372a91d7 78;;;###autoload
8fc3fee1
RS
79(defun rmail-sort-by-recipient (reverse)
80 "Sort messages of current Rmail file by recipient.
81If prefix argument REVERSE is non-nil, sort them in reverse order."
82 (interactive "P")
83 (rmail-sort-messages reverse
84 (function
85 (lambda (msg)
f00de7c3
RS
86 (downcase ;Canonical name
87 (mail-strip-quoted-names
88 (or (rmail-fetch-field msg "To")
89 (rmail-fetch-field msg "Apparently-To") "")
90 ))))))
8fc3fee1 91
372a91d7 92;;;###autoload
22a72f53
RS
93(defun rmail-sort-by-correspondent (reverse)
94 "Sort messages of current Rmail file by other correspondent.
95If prefix argument REVERSE is non-nil, sort them in reverse order."
96 (interactive "P")
97 (rmail-sort-messages reverse
98 (function
99 (lambda (msg)
100 (rmail-select-correspondent
101 msg
102 '("From" "Sender" "To" "Apparently-To"))))))
103
104(defun rmail-select-correspondent (msg fields)
105 (let ((ans ""))
f00de7c3
RS
106 (while (and fields (string= ans ""))
107 (setq ans
108 (rmail-dont-reply-to
109 (mail-strip-quoted-names
110 (or (rmail-fetch-field msg (car fields)) ""))))
111 (setq fields (cdr fields)))
112 ans))
113
372a91d7 114;;;###autoload
f00de7c3 115(defun rmail-sort-by-lines (reverse)
8b1d5b31 116 "Sort messages of current Rmail file by number of lines.
51693c8c
RS
117If prefix argument REVERSE is non-nil, sort them in reverse order."
118 (interactive "P")
119 (rmail-sort-messages reverse
120 (function
121 (lambda (msg)
be4e7157
KH
122 (count-lines (rmail-msgbeg msg)
123 (rmail-msgend msg))))))
15589977 124
372a91d7 125;;;###autoload
27d42947 126(defun rmail-sort-by-labels (reverse labels)
15589977
KH
127 "Sort messages of current Rmail file by labels.
128If prefix argument REVERSE is non-nil, sort them in reverse order.
129KEYWORDS is a comma-separated list of labels."
130 (interactive "P\nsSort by labels: ")
131 (or (string-match "[^ \t]" labels)
132 (error "No labels specified"))
133 (setq labels (concat (substring labels (match-beginning 0)) ","))
134 (let (labelvec)
135 (while (string-match "[ \t]*,[ \t]*" labels)
a1506d29 136 (setq labelvec (cons
15589977
KH
137 (concat ", ?\\("
138 (substring labels 0 (match-beginning 0))
139 "\\),")
140 labelvec))
141 (setq labels (substring labels (match-end 0))))
142 (setq labelvec (apply 'vector (nreverse labelvec)))
143 (rmail-sort-messages reverse
144 (function
145 (lambda (msg)
146 (let ((n 0))
147 (while (and (< n (length labelvec))
148 (not (rmail-message-labels-p
149 msg (aref labelvec n))))
150 (setq n (1+ n)))
151 n))))))
8fc3fee1 152\f
f00de7c3
RS
153;; Basic functions
154
155(defun rmail-sort-messages (reverse keyfun)
8fc3fee1 156 "Sort messages of current Rmail file.
f00de7c3
RS
157If 1st argument REVERSE is non-nil, sort them in reverse order.
1582nd argument KEYFUN is called with a message number, and should return a key."
1884e325 159 (save-current-buffer
36bedc4f
RS
160 ;; If we are in a summary buffer, operate on the Rmail buffer.
161 (if (eq major-mode 'rmail-summary-mode)
162 (set-buffer rmail-buffer))
163 (let ((buffer-read-only nil)
1884e325 164 (point-offset (- (point) (point-min)))
36bedc4f
RS
165 (predicate nil) ;< or string-lessp
166 (sort-lists nil))
167 (message "Finding sort keys...")
168 (widen)
169 (let ((msgnum 1))
170 (while (>= rmail-total-messages msgnum)
171 (setq sort-lists
172 (cons (list (funcall keyfun msgnum) ;Make sorting key
173 (eq rmail-current-message msgnum) ;True if current
174 (aref rmail-message-vector msgnum)
175 (aref rmail-message-vector (1+ msgnum)))
176 sort-lists))
177 (if (zerop (% msgnum 10))
178 (message "Finding sort keys...%d" msgnum))
179 (setq msgnum (1+ msgnum))))
180 (or reverse (setq sort-lists (nreverse sort-lists)))
181 ;; Decide predicate: < or string-lessp
182 (if (numberp (car (car sort-lists))) ;Is a key numeric?
183 (setq predicate (function <))
184 (setq predicate (function string-lessp)))
185 (setq sort-lists
186 (sort sort-lists
187 (function
188 (lambda (a b)
189 (funcall predicate (car a) (car b))))))
190 (if reverse (setq sort-lists (nreverse sort-lists)))
191 ;; Now we enter critical region. So, keyboard quit is disabled.
192 (message "Reordering messages...")
193 (let ((inhibit-quit t) ;Inhibit quit
194 (current-message nil)
195 (msgnum 1)
196 (msginfo nil))
197 ;; There's little hope that we can easily undo after that.
9baf79c7 198 (buffer-disable-undo (current-buffer))
36bedc4f
RS
199 (goto-char (rmail-msgbeg 1))
200 ;; To force update of all markers.
201 (insert-before-markers ?Z)
202 (backward-char 1)
203 ;; Now reorder messages.
204 (while sort-lists
205 (setq msginfo (car sort-lists))
206 ;; Swap two messages.
207 (insert-buffer-substring
208 (current-buffer) (nth 2 msginfo) (nth 3 msginfo))
209 (delete-region (nth 2 msginfo) (nth 3 msginfo))
210 ;; Is current message?
211 (if (nth 1 msginfo)
212 (setq current-message msgnum))
213 (setq sort-lists (cdr sort-lists))
214 (if (zerop (% msgnum 10))
215 (message "Reordering messages...%d" msgnum))
216 (setq msgnum (1+ msgnum)))
217 ;; Delete the garbage inserted before.
218 (delete-char 1)
219 (setq quit-flag nil)
220 (buffer-enable-undo)
221 (rmail-set-message-counters)
030ecb3c 222 (rmail-show-message current-message)
1884e325 223 (goto-char (+ point-offset (point-min)))
030ecb3c
KH
224 (if (rmail-summary-exists)
225 (rmail-select-summary
226 (rmail-update-summary)))))))
f00de7c3 227
8fc3fee1 228(defun rmail-fetch-field (msg field)
f00de7c3 229 "Return the value of the header FIELD of MSG.
8fc3fee1 230Arguments are MSG and FIELD."
f00de7c3
RS
231 (save-restriction
232 (widen)
233 (let ((next (rmail-msgend msg)))
8fc3fee1
RS
234 (goto-char (rmail-msgbeg msg))
235 (narrow-to-region (if (search-forward "\n*** EOOH ***\n" next t)
236 (point)
237 (forward-line 1)
238 (point))
239 (progn (search-forward "\n\n" nil t) (point)))
240 (mail-fetch-field field))))
241
f00de7c3
RS
242(defun rmail-make-date-sortable (date)
243 "Make DATE sortable using the function string-lessp."
244 ;; Assume the default time zone is GMT.
245 (timezone-make-date-sortable date "GMT" "GMT"))
246
49116ac0 247(provide 'rmailsort)
c88ab9ce
ER
248
249;;; rmailsort.el ends here