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/>.
34 (autoload 'timezone-make-date-sortable
"timezone")
36 ;; Sorting messages in Pmail buffer
39 (defun pmail-sort-by-date (reverse)
40 "Sort messages of current Pmail file by date.
41 If prefix argument REVERSE is non-nil, sort them in reverse order."
43 (pmail-sort-messages reverse
46 (pmail-make-date-sortable
47 (pmail-fetch-field msg
"Date"))))))
50 (defun pmail-sort-by-subject (reverse)
51 "Sort messages of current Pmail file by subject.
52 If prefix argument REVERSE is non-nil, sort them in reverse order."
54 (pmail-sort-messages reverse
57 (let ((key (or (pmail-fetch-field msg
"Subject") ""))
60 (if (string-match "^\\(re:[ \t]*\\)*" key
)
61 (substring key
(match-end 0))
65 (defun pmail-sort-by-author (reverse)
66 "Sort messages of current Pmail file by author.
67 If prefix argument REVERSE is non-nil, sort them in reverse order."
69 (pmail-sort-messages reverse
72 (downcase ;Canonical name
73 (mail-strip-quoted-names
74 (or (pmail-fetch-field msg
"From")
75 (pmail-fetch-field msg
"Sender") "")))))))
78 (defun pmail-sort-by-recipient (reverse)
79 "Sort messages of current Pmail file by recipient.
80 If prefix argument REVERSE is non-nil, sort them in reverse order."
82 (pmail-sort-messages reverse
85 (downcase ;Canonical name
86 (mail-strip-quoted-names
87 (or (pmail-fetch-field msg
"To")
88 (pmail-fetch-field msg
"Apparently-To") "")
92 (defun pmail-sort-by-correspondent (reverse)
93 "Sort messages of current Pmail file by other correspondent.
94 If prefix argument REVERSE is non-nil, sort them in reverse order."
96 (pmail-sort-messages reverse
99 (pmail-select-correspondent
101 '("From" "Sender" "To" "Apparently-To"))))))
103 (defun pmail-select-correspondent (msg fields
)
105 (while (and fields
(string= ans
""))
108 (mail-strip-quoted-names
109 (or (pmail-fetch-field msg
(car fields
)) ""))))
110 (setq fields
(cdr fields
)))
114 (defun pmail-sort-by-lines (reverse)
115 "Sort messages of current Pmail file by number of lines.
116 If prefix argument REVERSE is non-nil, sort them in reverse order."
118 (pmail-sort-messages reverse
121 (count-lines (pmail-desc-get-start msg
)
122 (pmail-desc-get-end msg
))))))
125 (defun pmail-sort-by-labels (reverse labels
)
126 "Sort messages of current Pmail file by labels.
127 If prefix argument REVERSE is non-nil, sort them in reverse order.
128 KEYWORDS is a comma-separated list of labels."
129 (interactive "P\nsSort by labels: ")
130 (or (string-match "[^ \t]" labels
)
131 (error "No labels specified"))
132 (setq labels
(concat (substring labels
(match-beginning 0)) ","))
134 (while (string-match "[ \t]*,[ \t]*" labels
)
137 (substring labels
0 (match-beginning 0))
140 (setq labels
(substring labels
(match-end 0))))
141 (setq labelvec
(apply 'vector
(nreverse labelvec
)))
142 (pmail-sort-messages reverse
146 (while (and (< n
(length labelvec
))
147 (not (pmail-message-labels-p
148 msg
(aref labelvec n
))))
154 (declare-function pmail-update-summary
"pmailsum" (&rest ignore
))
156 (defun pmail-sort-messages (reverse keyfun
)
157 "Sort messages of current Pmail file.
158 If 1st argument REVERSE is non-nil, sort them in reverse order.
159 2nd argument KEYFUN is called with a message number, and should return a key."
161 ;; If we are in a summary buffer, operate on the Pmail buffer.
162 (if (eq major-mode
'pmail-summary-mode
)
163 (set-buffer pmail-buffer
))
164 (let ((buffer-read-only nil
)
165 (point-offset (- (point) (point-min)))
166 (predicate nil
) ;< or string-lessp
168 (message "Finding sort keys...")
169 (pmail-header-show-headers)
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 (pmail-desc-get-marker-start msgnum
)
177 (pmail-desc-get-marker-end 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-desc-get-start 1))
202 ;; To force update of all markers.
203 (insert-before-markers ?Z
)
205 ;; Now reorder messages.
207 (setq msginfo
(car sort-lists
))
208 ;; Swap two messages.
209 (insert-buffer-substring
210 (current-buffer) (nth 2 msginfo
) (nth 3 msginfo
))
211 (delete-region (nth 2 msginfo
) (nth 3 msginfo
))
212 ;; Is current message?
214 (setq current-message msgnum
))
215 (setq sort-lists
(cdr sort-lists
))
216 (if (zerop (% msgnum
10))
217 (message "Reordering messages...%d" msgnum
))
218 (setq msgnum
(1+ msgnum
)))
219 ;; Delete the garbage inserted before.
223 (goto-char (point-min))
224 (pmail-initialize-messages)
225 (pmail-show-message current-message
)
226 (if (pmail-summary-exists)
227 (pmail-select-summary
228 (pmail-update-summary)))))))
231 (defun pmail-fetch-field (msg field
)
232 "Return the value of the header FIELD of MSG.
233 Arguments are MSG and FIELD."
237 (pmail-desc-get-start msg
)
238 (pmail-desc-get-end msg
))
239 (pmail-header-get-header field
)))
241 (defun pmail-make-date-sortable (date)
242 "Make DATE sortable using the function string-lessp."
243 ;; Assume the default time zone is GMT.
244 (timezone-make-date-sortable date
"GMT" "GMT"))
248 ;; arch-tag: 665da245-f6a7-4115-ad8c-ba19216988d5
249 ;;; pmailsort.el ends here