1 ;;; pmailsort.el --- Pmail: sort messages
3 ;; Copyright (C) 1990, 1993, 1994, 2001, 2002, 2003, 2004,
4 ;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
6 ;; Author: Masanobu UMEDA <umerin@mse.kyutech.ac.jp>
10 ;; This file is part of GNU Emacs.
12 ;; GNU Emacs is free software: you can redistribute it and/or modify
13 ;; it under the terms of the GNU General Public License as published by
14 ;; the Free Software Foundation, either version 3 of the License, or
15 ;; (at your option) any later version.
17 ;; GNU Emacs is distributed in the hope that it will be useful,
18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
20 ;; GNU General Public License for more details.
22 ;; You should have received a copy of the GNU General Public License
23 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
36 (autoload 'timezone-make-date-sortable
"timezone")
38 (declare-function pmail-update-summary
"pmailsum" (&rest ignore
))
40 ;; Sorting messages in Pmail buffer
43 (defun pmail-sort-by-date (reverse)
44 "Sort messages of current Pmail file by date.
45 If prefix argument REVERSE is non-nil, sort them in reverse order."
47 (pmail-sort-messages reverse
50 (pmail-make-date-sortable
51 (pmail-fetch-field msg
"Date"))))))
54 (defun pmail-sort-by-subject (reverse)
55 "Sort messages of current Pmail file by subject.
56 If prefix argument REVERSE is non-nil, sort them in reverse order."
58 (pmail-sort-messages reverse
61 (let ((key (or (pmail-fetch-field msg
"Subject") ""))
64 (if (string-match "^\\(re:[ \t]*\\)*" key
)
65 (substring key
(match-end 0))
69 (defun pmail-sort-by-author (reverse)
70 "Sort messages of current Pmail file by author.
71 If prefix argument REVERSE is non-nil, sort them in reverse order."
73 (pmail-sort-messages reverse
76 (downcase ;Canonical name
77 (mail-strip-quoted-names
78 (or (pmail-fetch-field msg
"From")
79 (pmail-fetch-field msg
"Sender") "")))))))
82 (defun pmail-sort-by-recipient (reverse)
83 "Sort messages of current Pmail file by recipient.
84 If prefix argument REVERSE is non-nil, sort them in reverse order."
86 (pmail-sort-messages reverse
89 (downcase ;Canonical name
90 (mail-strip-quoted-names
91 (or (pmail-fetch-field msg
"To")
92 (pmail-fetch-field msg
"Apparently-To") "")
96 (defun pmail-sort-by-correspondent (reverse)
97 "Sort messages of current Pmail file by other correspondent.
98 If prefix argument REVERSE is non-nil, sort them in reverse order."
100 (pmail-sort-messages reverse
103 (pmail-select-correspondent
105 '("From" "Sender" "To" "Apparently-To"))))))
107 (defun pmail-select-correspondent (msg fields
)
109 (while (and fields
(string= ans
""))
111 ;; NB despite the name, this lives in mail-utils.el.
113 (mail-strip-quoted-names
114 (or (pmail-fetch-field msg
(car fields
)) ""))))
115 (setq fields
(cdr fields
)))
119 (defun pmail-sort-by-lines (reverse)
120 "Sort messages of current Pmail file by number of lines.
121 If prefix argument REVERSE is non-nil, sort them in reverse order."
123 (pmail-sort-messages reverse
126 (count-lines (pmail-msgbeg msg
)
127 (pmail-msgend msg
))))))
130 (defun pmail-sort-by-labels (reverse labels
)
131 "Sort messages of current Pmail file by labels.
132 If prefix argument REVERSE is non-nil, sort them in reverse order.
133 KEYWORDS is a comma-separated list of labels."
134 (interactive "P\nsSort by labels: ")
135 (or (string-match "[^ \t]" labels
)
136 (error "No labels specified"))
137 (setq labels
(concat (substring labels
(match-beginning 0)) ","))
139 (while (string-match "[ \t]*,[ \t]*" labels
)
142 (substring labels
0 (match-beginning 0))
145 (setq labels
(substring labels
(match-end 0))))
146 (setq labelvec
(apply 'vector
(nreverse labelvec
)))
147 (pmail-sort-messages reverse
151 (while (and (< n
(length labelvec
))
152 (not (pmail-message-labels-p
153 msg
(aref labelvec n
))))
159 (defun pmail-sort-messages (reverse keyfun
)
160 "Sort messages of current Pmail file.
161 If 1st argument REVERSE is non-nil, sort them in reverse order.
162 2nd argument KEYFUN is called with a message number, and should return a key."
163 (pmail-swap-buffers-maybe)
164 (with-current-buffer pmail-buffer
165 (let ((buffer-read-only nil
)
166 (point-offset (- (point) (point-min)))
167 (predicate nil
) ;< or string-lessp
169 (message "Finding sort keys...")
172 (while (>= pmail-total-messages msgnum
)
174 (cons (list (funcall keyfun msgnum
) ;Make sorting key
175 (eq pmail-current-message msgnum
) ;True if current
176 (aref pmail-message-vector msgnum
)
177 (aref pmail-message-vector
(1+ msgnum
)))
179 (if (zerop (% msgnum
10))
180 (message "Finding sort keys...%d" msgnum
))
181 (setq msgnum
(1+ msgnum
))))
182 (or reverse
(setq sort-lists
(nreverse sort-lists
)))
183 ;; Decide predicate: < or string-lessp
184 (if (numberp (car (car sort-lists
))) ;Is a key numeric?
185 (setq predicate
(function <))
186 (setq predicate
(function string-lessp
)))
191 (funcall predicate
(car a
) (car b
))))))
192 (if reverse
(setq sort-lists
(nreverse sort-lists
)))
193 ;; Now we enter critical region. So, keyboard quit is disabled.
194 (message "Reordering messages...")
195 (let ((inhibit-quit t
) ;Inhibit quit
196 (current-message nil
)
199 ;; There's little hope that we can easily undo after that.
200 (buffer-disable-undo (current-buffer))
201 (goto-char (pmail-msgbeg 1))
202 ;; To force update of all markers.
203 (insert-before-markers ?Z
)
205 ;; Now reorder messages.
206 (dolist (msginfo sort-lists
)
207 ;; Swap two messages.
208 (insert-buffer-substring
209 (current-buffer) (nth 2 msginfo
) (nth 3 msginfo
))
210 ;; The last message may not have \n\n after it.
211 (unless (eq (char-before) ?
\n)
213 (delete-region (nth 2 msginfo
) (nth 3 msginfo
))
214 ;; Is current message?
216 (setq current-message msgnum
))
217 (if (zerop (% msgnum
10))
218 (message "Reordering messages...%d" msgnum
))
219 (setq msgnum
(1+ msgnum
)))
220 ;; Delete the garbage inserted before.
224 (pmail-set-message-counters)
225 (pmail-show-message current-message
)
226 (goto-char (+ point-offset
(point-min)))
227 (if (pmail-summary-exists)
228 (pmail-select-summary (pmail-update-summary)))))))
230 (defun pmail-fetch-field (msg field
)
231 "Return the value of the header FIELD of MSG.
232 Arguments are MSG and FIELD."
235 (narrow-to-region (pmail-msgbeg msg
) (pmail-msgend msg
))
236 (pmail-header-get-header field
)))
238 (defun pmail-make-date-sortable (date)
239 "Make DATE sortable using the function string-lessp."
240 ;; Assume the default time zone is GMT.
241 (timezone-make-date-sortable date
"GMT" "GMT"))
246 ;; change-log-default-name: "ChangeLog.pmail"
249 ;; arch-tag: 665da245-f6a7-4115-ad8c-ba19216988d5
250 ;;; pmailsort.el ends here