annotate lisp/mail/rmailsort.el @ 81055:acfe3e8598d8

*** empty log message ***
author Eli Zaretskii <eliz@gnu.org>
date Wed, 23 May 2007 18:36:16 +0000
parents e3694f1cb928
children 8e27d63c45eb 95d0cdf160ea
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
38412
253f761ad37b Some fixes to follow coding conventions in files maintained by FSF.
Pavel Janík <Pavel@Janik.cz>
parents: 37591
diff changeset
1 ;;; rmailsort.el --- Rmail: sort messages
658
7cbd4fcd8b0f *** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 584
diff changeset
2
64754
fafd692d1e40 Update years in copyright notice; nfc.
Thien-Thi Nguyen <ttn@gnuvola.org>
parents: 64085
diff changeset
3 ;; Copyright (C) 1990, 1993, 1994, 2001, 2002, 2003, 2004,
75347
e3694f1cb928 Add 2007 to copyright years.
Glenn Morris <rgm@gnu.org>
parents: 68648
diff changeset
4 ;; 2005, 2006, 2007 Free Software Foundation, Inc.
845
213978acbc1e entered into RCS
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 814
diff changeset
5
3133
2c1553d7aad1 New version from Umeda. Needs detailed entry.
Richard M. Stallman <rms@gnu.org>
parents: 2851
diff changeset
6 ;; Author: Masanobu UMEDA <umerin@mse.kyutech.ac.jp>
16988
18b8f50567b2 (rmail-sort-messages): Preserve point
Richard M. Stallman <rms@gnu.org>
parents: 16348
diff changeset
7 ;; Maintainer: FSF
814
38b2499cb3e9 *** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 807
diff changeset
8 ;; Keywords: mail
807
4f28bd14272c *** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 767
diff changeset
9
767
02bfc9709961 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 658
diff changeset
10 ;; This file is part of GNU Emacs.
90
92266e9b90bb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
11
767
02bfc9709961 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 658
diff changeset
12 ;; GNU Emacs is free software; you can redistribute it and/or modify
02bfc9709961 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 658
diff changeset
13 ;; it under the terms of the GNU General Public License as published by
807
4f28bd14272c *** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 767
diff changeset
14 ;; the Free Software Foundation; either version 2, or (at your option)
767
02bfc9709961 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 658
diff changeset
15 ;; any later version.
90
92266e9b90bb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
16
92266e9b90bb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
17 ;; GNU Emacs is distributed in the hope that it will be useful,
767
02bfc9709961 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 658
diff changeset
18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
02bfc9709961 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 658
diff changeset
19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
02bfc9709961 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 658
diff changeset
20 ;; GNU General Public License for more details.
90
92266e9b90bb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
21
767
02bfc9709961 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 658
diff changeset
22 ;; You should have received a copy of the GNU General Public License
14171
e8e99446ef2c Comment fixes.
Karl Heuer <kwzh@gnu.org>
parents: 7298
diff changeset
23 ;; along with GNU Emacs; see the file COPYING. If not, write to the
64085
18a818a2ee7c Update FSF's address.
Lute Kamstra <lute@gnu.org>
parents: 52401
diff changeset
24 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
18a818a2ee7c Update FSF's address.
Lute Kamstra <lute@gnu.org>
parents: 52401
diff changeset
25 ;; Boston, MA 02110-1301, USA.
767
02bfc9709961 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 658
diff changeset
26
38412
253f761ad37b Some fixes to follow coding conventions in files maintained by FSF.
Pavel Janík <Pavel@Janik.cz>
parents: 37591
diff changeset
27 ;;; Commentary:
253f761ad37b Some fixes to follow coding conventions in files maintained by FSF.
Pavel Janík <Pavel@Janik.cz>
parents: 37591
diff changeset
28
807
4f28bd14272c *** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 767
diff changeset
29 ;;; Code:
90
92266e9b90bb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
30
92266e9b90bb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
31 (require 'sort)
92266e9b90bb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
32
14235
48efd0c5b5dc (rmail): Add (require 'rmail).
Karl Heuer <kwzh@gnu.org>
parents: 14171
diff changeset
33 ;; For rmail-select-summary
48efd0c5b5dc (rmail): Add (require 'rmail).
Karl Heuer <kwzh@gnu.org>
parents: 14171
diff changeset
34 (require 'rmail)
48efd0c5b5dc (rmail): Add (require 'rmail).
Karl Heuer <kwzh@gnu.org>
parents: 14171
diff changeset
35
3133
2c1553d7aad1 New version from Umeda. Needs detailed entry.
Richard M. Stallman <rms@gnu.org>
parents: 2851
diff changeset
36 (autoload 'timezone-make-date-sortable "timezone")
2c1553d7aad1 New version from Umeda. Needs detailed entry.
Richard M. Stallman <rms@gnu.org>
parents: 2851
diff changeset
37
2c1553d7aad1 New version from Umeda. Needs detailed entry.
Richard M. Stallman <rms@gnu.org>
parents: 2851
diff changeset
38 ;; Sorting messages in Rmail buffer
90
92266e9b90bb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
39
16348
2cf33d3c5540 Add many autoload cookies.
Richard M. Stallman <rms@gnu.org>
parents: 14235
diff changeset
40 ;;;###autoload
90
92266e9b90bb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
41 (defun rmail-sort-by-date (reverse)
92266e9b90bb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
42 "Sort messages of current Rmail file by date.
92266e9b90bb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
43 If prefix argument REVERSE is non-nil, sort them in reverse order."
92266e9b90bb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
44 (interactive "P")
92266e9b90bb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
45 (rmail-sort-messages reverse
92266e9b90bb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
46 (function
92266e9b90bb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
47 (lambda (msg)
3133
2c1553d7aad1 New version from Umeda. Needs detailed entry.
Richard M. Stallman <rms@gnu.org>
parents: 2851
diff changeset
48 (rmail-make-date-sortable
90
92266e9b90bb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
49 (rmail-fetch-field msg "Date"))))))
92266e9b90bb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
50
16348
2cf33d3c5540 Add many autoload cookies.
Richard M. Stallman <rms@gnu.org>
parents: 14235
diff changeset
51 ;;;###autoload
90
92266e9b90bb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
52 (defun rmail-sort-by-subject (reverse)
92266e9b90bb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
53 "Sort messages of current Rmail file by subject.
92266e9b90bb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
54 If prefix argument REVERSE is non-nil, sort them in reverse order."
92266e9b90bb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
55 (interactive "P")
92266e9b90bb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
56 (rmail-sort-messages reverse
92266e9b90bb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
57 (function
92266e9b90bb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
58 (lambda (msg)
92266e9b90bb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
59 (let ((key (or (rmail-fetch-field msg "Subject") ""))
92266e9b90bb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
60 (case-fold-search t))
92266e9b90bb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
61 ;; Remove `Re:'
6490
8c6205143fb1 (rmail-sort-by-subject): Fix `Re:' regexp.
Karl Heuer <kwzh@gnu.org>
parents: 6315
diff changeset
62 (if (string-match "^\\(re:[ \t]*\\)*" key)
8c6205143fb1 (rmail-sort-by-subject): Fix `Re:' regexp.
Karl Heuer <kwzh@gnu.org>
parents: 6315
diff changeset
63 (substring key (match-end 0))
8c6205143fb1 (rmail-sort-by-subject): Fix `Re:' regexp.
Karl Heuer <kwzh@gnu.org>
parents: 6315
diff changeset
64 key))))))
90
92266e9b90bb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
65
16348
2cf33d3c5540 Add many autoload cookies.
Richard M. Stallman <rms@gnu.org>
parents: 14235
diff changeset
66 ;;;###autoload
90
92266e9b90bb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
67 (defun rmail-sort-by-author (reverse)
92266e9b90bb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
68 "Sort messages of current Rmail file by author.
92266e9b90bb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
69 If prefix argument REVERSE is non-nil, sort them in reverse order."
92266e9b90bb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
70 (interactive "P")
92266e9b90bb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
71 (rmail-sort-messages reverse
92266e9b90bb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
72 (function
92266e9b90bb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
73 (lambda (msg)
3133
2c1553d7aad1 New version from Umeda. Needs detailed entry.
Richard M. Stallman <rms@gnu.org>
parents: 2851
diff changeset
74 (downcase ;Canonical name
2c1553d7aad1 New version from Umeda. Needs detailed entry.
Richard M. Stallman <rms@gnu.org>
parents: 2851
diff changeset
75 (mail-strip-quoted-names
2c1553d7aad1 New version from Umeda. Needs detailed entry.
Richard M. Stallman <rms@gnu.org>
parents: 2851
diff changeset
76 (or (rmail-fetch-field msg "From")
2c1553d7aad1 New version from Umeda. Needs detailed entry.
Richard M. Stallman <rms@gnu.org>
parents: 2851
diff changeset
77 (rmail-fetch-field msg "Sender") "")))))))
90
92266e9b90bb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
78
16348
2cf33d3c5540 Add many autoload cookies.
Richard M. Stallman <rms@gnu.org>
parents: 14235
diff changeset
79 ;;;###autoload
90
92266e9b90bb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
80 (defun rmail-sort-by-recipient (reverse)
92266e9b90bb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
81 "Sort messages of current Rmail file by recipient.
92266e9b90bb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
82 If prefix argument REVERSE is non-nil, sort them in reverse order."
92266e9b90bb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
83 (interactive "P")
92266e9b90bb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
84 (rmail-sort-messages reverse
92266e9b90bb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
85 (function
92266e9b90bb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
86 (lambda (msg)
3133
2c1553d7aad1 New version from Umeda. Needs detailed entry.
Richard M. Stallman <rms@gnu.org>
parents: 2851
diff changeset
87 (downcase ;Canonical name
2c1553d7aad1 New version from Umeda. Needs detailed entry.
Richard M. Stallman <rms@gnu.org>
parents: 2851
diff changeset
88 (mail-strip-quoted-names
2c1553d7aad1 New version from Umeda. Needs detailed entry.
Richard M. Stallman <rms@gnu.org>
parents: 2851
diff changeset
89 (or (rmail-fetch-field msg "To")
2c1553d7aad1 New version from Umeda. Needs detailed entry.
Richard M. Stallman <rms@gnu.org>
parents: 2851
diff changeset
90 (rmail-fetch-field msg "Apparently-To") "")
2c1553d7aad1 New version from Umeda. Needs detailed entry.
Richard M. Stallman <rms@gnu.org>
parents: 2851
diff changeset
91 ))))))
90
92266e9b90bb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
92
16348
2cf33d3c5540 Add many autoload cookies.
Richard M. Stallman <rms@gnu.org>
parents: 14235
diff changeset
93 ;;;###autoload
131
d4c523560fe8 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 92
diff changeset
94 (defun rmail-sort-by-correspondent (reverse)
d4c523560fe8 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 92
diff changeset
95 "Sort messages of current Rmail file by other correspondent.
d4c523560fe8 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 92
diff changeset
96 If prefix argument REVERSE is non-nil, sort them in reverse order."
d4c523560fe8 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 92
diff changeset
97 (interactive "P")
d4c523560fe8 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 92
diff changeset
98 (rmail-sort-messages reverse
d4c523560fe8 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 92
diff changeset
99 (function
d4c523560fe8 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 92
diff changeset
100 (lambda (msg)
d4c523560fe8 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 92
diff changeset
101 (rmail-select-correspondent
d4c523560fe8 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 92
diff changeset
102 msg
d4c523560fe8 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 92
diff changeset
103 '("From" "Sender" "To" "Apparently-To"))))))
d4c523560fe8 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 92
diff changeset
104
d4c523560fe8 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 92
diff changeset
105 (defun rmail-select-correspondent (msg fields)
d4c523560fe8 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 92
diff changeset
106 (let ((ans ""))
3133
2c1553d7aad1 New version from Umeda. Needs detailed entry.
Richard M. Stallman <rms@gnu.org>
parents: 2851
diff changeset
107 (while (and fields (string= ans ""))
2c1553d7aad1 New version from Umeda. Needs detailed entry.
Richard M. Stallman <rms@gnu.org>
parents: 2851
diff changeset
108 (setq ans
2c1553d7aad1 New version from Umeda. Needs detailed entry.
Richard M. Stallman <rms@gnu.org>
parents: 2851
diff changeset
109 (rmail-dont-reply-to
2c1553d7aad1 New version from Umeda. Needs detailed entry.
Richard M. Stallman <rms@gnu.org>
parents: 2851
diff changeset
110 (mail-strip-quoted-names
2c1553d7aad1 New version from Umeda. Needs detailed entry.
Richard M. Stallman <rms@gnu.org>
parents: 2851
diff changeset
111 (or (rmail-fetch-field msg (car fields)) ""))))
2c1553d7aad1 New version from Umeda. Needs detailed entry.
Richard M. Stallman <rms@gnu.org>
parents: 2851
diff changeset
112 (setq fields (cdr fields)))
2c1553d7aad1 New version from Umeda. Needs detailed entry.
Richard M. Stallman <rms@gnu.org>
parents: 2851
diff changeset
113 ans))
148
a099f0c77321 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 131
diff changeset
114
16348
2cf33d3c5540 Add many autoload cookies.
Richard M. Stallman <rms@gnu.org>
parents: 14235
diff changeset
115 ;;;###autoload
3133
2c1553d7aad1 New version from Umeda. Needs detailed entry.
Richard M. Stallman <rms@gnu.org>
parents: 2851
diff changeset
116 (defun rmail-sort-by-lines (reverse)
3878
fab096be7274 Don't touch rmail-summary-mode-map.
Richard M. Stallman <rms@gnu.org>
parents: 3133
diff changeset
117 "Sort messages of current Rmail file by number of lines.
148
a099f0c77321 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 131
diff changeset
118 If prefix argument REVERSE is non-nil, sort them in reverse order."
a099f0c77321 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 131
diff changeset
119 (interactive "P")
a099f0c77321 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 131
diff changeset
120 (rmail-sort-messages reverse
a099f0c77321 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 131
diff changeset
121 (function
a099f0c77321 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 131
diff changeset
122 (lambda (msg)
6315
f6a596a8a248 (rmail-sort-by-lines): msgnum variable should be msg.
Karl Heuer <kwzh@gnu.org>
parents: 5159
diff changeset
123 (count-lines (rmail-msgbeg msg)
f6a596a8a248 (rmail-sort-by-lines): msgnum variable should be msg.
Karl Heuer <kwzh@gnu.org>
parents: 5159
diff changeset
124 (rmail-msgend msg))))))
6718
c13953896b24 (rmail-sort-by-keywords): New function.
Karl Heuer <kwzh@gnu.org>
parents: 6584
diff changeset
125
16348
2cf33d3c5540 Add many autoload cookies.
Richard M. Stallman <rms@gnu.org>
parents: 14235
diff changeset
126 ;;;###autoload
37591
0858ec0fee79 (rmail-sort-by-labels): Renamed from
Gerd Moellmann <gerd@gnu.org>
parents: 16988
diff changeset
127 (defun rmail-sort-by-labels (reverse labels)
6718
c13953896b24 (rmail-sort-by-keywords): New function.
Karl Heuer <kwzh@gnu.org>
parents: 6584
diff changeset
128 "Sort messages of current Rmail file by labels.
c13953896b24 (rmail-sort-by-keywords): New function.
Karl Heuer <kwzh@gnu.org>
parents: 6584
diff changeset
129 If prefix argument REVERSE is non-nil, sort them in reverse order.
c13953896b24 (rmail-sort-by-keywords): New function.
Karl Heuer <kwzh@gnu.org>
parents: 6584
diff changeset
130 KEYWORDS is a comma-separated list of labels."
c13953896b24 (rmail-sort-by-keywords): New function.
Karl Heuer <kwzh@gnu.org>
parents: 6584
diff changeset
131 (interactive "P\nsSort by labels: ")
c13953896b24 (rmail-sort-by-keywords): New function.
Karl Heuer <kwzh@gnu.org>
parents: 6584
diff changeset
132 (or (string-match "[^ \t]" labels)
c13953896b24 (rmail-sort-by-keywords): New function.
Karl Heuer <kwzh@gnu.org>
parents: 6584
diff changeset
133 (error "No labels specified"))
c13953896b24 (rmail-sort-by-keywords): New function.
Karl Heuer <kwzh@gnu.org>
parents: 6584
diff changeset
134 (setq labels (concat (substring labels (match-beginning 0)) ","))
c13953896b24 (rmail-sort-by-keywords): New function.
Karl Heuer <kwzh@gnu.org>
parents: 6584
diff changeset
135 (let (labelvec)
c13953896b24 (rmail-sort-by-keywords): New function.
Karl Heuer <kwzh@gnu.org>
parents: 6584
diff changeset
136 (while (string-match "[ \t]*,[ \t]*" labels)
49598
0d8b17d428b5 Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 38412
diff changeset
137 (setq labelvec (cons
6718
c13953896b24 (rmail-sort-by-keywords): New function.
Karl Heuer <kwzh@gnu.org>
parents: 6584
diff changeset
138 (concat ", ?\\("
c13953896b24 (rmail-sort-by-keywords): New function.
Karl Heuer <kwzh@gnu.org>
parents: 6584
diff changeset
139 (substring labels 0 (match-beginning 0))
c13953896b24 (rmail-sort-by-keywords): New function.
Karl Heuer <kwzh@gnu.org>
parents: 6584
diff changeset
140 "\\),")
c13953896b24 (rmail-sort-by-keywords): New function.
Karl Heuer <kwzh@gnu.org>
parents: 6584
diff changeset
141 labelvec))
c13953896b24 (rmail-sort-by-keywords): New function.
Karl Heuer <kwzh@gnu.org>
parents: 6584
diff changeset
142 (setq labels (substring labels (match-end 0))))
c13953896b24 (rmail-sort-by-keywords): New function.
Karl Heuer <kwzh@gnu.org>
parents: 6584
diff changeset
143 (setq labelvec (apply 'vector (nreverse labelvec)))
c13953896b24 (rmail-sort-by-keywords): New function.
Karl Heuer <kwzh@gnu.org>
parents: 6584
diff changeset
144 (rmail-sort-messages reverse
c13953896b24 (rmail-sort-by-keywords): New function.
Karl Heuer <kwzh@gnu.org>
parents: 6584
diff changeset
145 (function
c13953896b24 (rmail-sort-by-keywords): New function.
Karl Heuer <kwzh@gnu.org>
parents: 6584
diff changeset
146 (lambda (msg)
c13953896b24 (rmail-sort-by-keywords): New function.
Karl Heuer <kwzh@gnu.org>
parents: 6584
diff changeset
147 (let ((n 0))
c13953896b24 (rmail-sort-by-keywords): New function.
Karl Heuer <kwzh@gnu.org>
parents: 6584
diff changeset
148 (while (and (< n (length labelvec))
c13953896b24 (rmail-sort-by-keywords): New function.
Karl Heuer <kwzh@gnu.org>
parents: 6584
diff changeset
149 (not (rmail-message-labels-p
c13953896b24 (rmail-sort-by-keywords): New function.
Karl Heuer <kwzh@gnu.org>
parents: 6584
diff changeset
150 msg (aref labelvec n))))
c13953896b24 (rmail-sort-by-keywords): New function.
Karl Heuer <kwzh@gnu.org>
parents: 6584
diff changeset
151 (setq n (1+ n)))
c13953896b24 (rmail-sort-by-keywords): New function.
Karl Heuer <kwzh@gnu.org>
parents: 6584
diff changeset
152 n))))))
90
92266e9b90bb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
153
3133
2c1553d7aad1 New version from Umeda. Needs detailed entry.
Richard M. Stallman <rms@gnu.org>
parents: 2851
diff changeset
154 ;; Basic functions
2c1553d7aad1 New version from Umeda. Needs detailed entry.
Richard M. Stallman <rms@gnu.org>
parents: 2851
diff changeset
155
2c1553d7aad1 New version from Umeda. Needs detailed entry.
Richard M. Stallman <rms@gnu.org>
parents: 2851
diff changeset
156 (defun rmail-sort-messages (reverse keyfun)
90
92266e9b90bb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
157 "Sort messages of current Rmail file.
3133
2c1553d7aad1 New version from Umeda. Needs detailed entry.
Richard M. Stallman <rms@gnu.org>
parents: 2851
diff changeset
158 If 1st argument REVERSE is non-nil, sort them in reverse order.
2c1553d7aad1 New version from Umeda. Needs detailed entry.
Richard M. Stallman <rms@gnu.org>
parents: 2851
diff changeset
159 2nd argument KEYFUN is called with a message number, and should return a key."
16988
18b8f50567b2 (rmail-sort-messages): Preserve point
Richard M. Stallman <rms@gnu.org>
parents: 16348
diff changeset
160 (save-current-buffer
5159
484e65abfdea (rmail-sort-messages): In summary buf, go to rmail buf.
Richard M. Stallman <rms@gnu.org>
parents: 3878
diff changeset
161 ;; If we are in a summary buffer, operate on the Rmail buffer.
484e65abfdea (rmail-sort-messages): In summary buf, go to rmail buf.
Richard M. Stallman <rms@gnu.org>
parents: 3878
diff changeset
162 (if (eq major-mode 'rmail-summary-mode)
484e65abfdea (rmail-sort-messages): In summary buf, go to rmail buf.
Richard M. Stallman <rms@gnu.org>
parents: 3878
diff changeset
163 (set-buffer rmail-buffer))
484e65abfdea (rmail-sort-messages): In summary buf, go to rmail buf.
Richard M. Stallman <rms@gnu.org>
parents: 3878
diff changeset
164 (let ((buffer-read-only nil)
16988
18b8f50567b2 (rmail-sort-messages): Preserve point
Richard M. Stallman <rms@gnu.org>
parents: 16348
diff changeset
165 (point-offset (- (point) (point-min)))
5159
484e65abfdea (rmail-sort-messages): In summary buf, go to rmail buf.
Richard M. Stallman <rms@gnu.org>
parents: 3878
diff changeset
166 (predicate nil) ;< or string-lessp
484e65abfdea (rmail-sort-messages): In summary buf, go to rmail buf.
Richard M. Stallman <rms@gnu.org>
parents: 3878
diff changeset
167 (sort-lists nil))
484e65abfdea (rmail-sort-messages): In summary buf, go to rmail buf.
Richard M. Stallman <rms@gnu.org>
parents: 3878
diff changeset
168 (message "Finding sort keys...")
484e65abfdea (rmail-sort-messages): In summary buf, go to rmail buf.
Richard M. Stallman <rms@gnu.org>
parents: 3878
diff changeset
169 (widen)
484e65abfdea (rmail-sort-messages): In summary buf, go to rmail buf.
Richard M. Stallman <rms@gnu.org>
parents: 3878
diff changeset
170 (let ((msgnum 1))
484e65abfdea (rmail-sort-messages): In summary buf, go to rmail buf.
Richard M. Stallman <rms@gnu.org>
parents: 3878
diff changeset
171 (while (>= rmail-total-messages msgnum)
484e65abfdea (rmail-sort-messages): In summary buf, go to rmail buf.
Richard M. Stallman <rms@gnu.org>
parents: 3878
diff changeset
172 (setq sort-lists
484e65abfdea (rmail-sort-messages): In summary buf, go to rmail buf.
Richard M. Stallman <rms@gnu.org>
parents: 3878
diff changeset
173 (cons (list (funcall keyfun msgnum) ;Make sorting key
484e65abfdea (rmail-sort-messages): In summary buf, go to rmail buf.
Richard M. Stallman <rms@gnu.org>
parents: 3878
diff changeset
174 (eq rmail-current-message msgnum) ;True if current
484e65abfdea (rmail-sort-messages): In summary buf, go to rmail buf.
Richard M. Stallman <rms@gnu.org>
parents: 3878
diff changeset
175 (aref rmail-message-vector msgnum)
484e65abfdea (rmail-sort-messages): In summary buf, go to rmail buf.
Richard M. Stallman <rms@gnu.org>
parents: 3878
diff changeset
176 (aref rmail-message-vector (1+ msgnum)))
484e65abfdea (rmail-sort-messages): In summary buf, go to rmail buf.
Richard M. Stallman <rms@gnu.org>
parents: 3878
diff changeset
177 sort-lists))
484e65abfdea (rmail-sort-messages): In summary buf, go to rmail buf.
Richard M. Stallman <rms@gnu.org>
parents: 3878
diff changeset
178 (if (zerop (% msgnum 10))
484e65abfdea (rmail-sort-messages): In summary buf, go to rmail buf.
Richard M. Stallman <rms@gnu.org>
parents: 3878
diff changeset
179 (message "Finding sort keys...%d" msgnum))
484e65abfdea (rmail-sort-messages): In summary buf, go to rmail buf.
Richard M. Stallman <rms@gnu.org>
parents: 3878
diff changeset
180 (setq msgnum (1+ msgnum))))
484e65abfdea (rmail-sort-messages): In summary buf, go to rmail buf.
Richard M. Stallman <rms@gnu.org>
parents: 3878
diff changeset
181 (or reverse (setq sort-lists (nreverse sort-lists)))
484e65abfdea (rmail-sort-messages): In summary buf, go to rmail buf.
Richard M. Stallman <rms@gnu.org>
parents: 3878
diff changeset
182 ;; Decide predicate: < or string-lessp
484e65abfdea (rmail-sort-messages): In summary buf, go to rmail buf.
Richard M. Stallman <rms@gnu.org>
parents: 3878
diff changeset
183 (if (numberp (car (car sort-lists))) ;Is a key numeric?
484e65abfdea (rmail-sort-messages): In summary buf, go to rmail buf.
Richard M. Stallman <rms@gnu.org>
parents: 3878
diff changeset
184 (setq predicate (function <))
484e65abfdea (rmail-sort-messages): In summary buf, go to rmail buf.
Richard M. Stallman <rms@gnu.org>
parents: 3878
diff changeset
185 (setq predicate (function string-lessp)))
484e65abfdea (rmail-sort-messages): In summary buf, go to rmail buf.
Richard M. Stallman <rms@gnu.org>
parents: 3878
diff changeset
186 (setq sort-lists
484e65abfdea (rmail-sort-messages): In summary buf, go to rmail buf.
Richard M. Stallman <rms@gnu.org>
parents: 3878
diff changeset
187 (sort sort-lists
484e65abfdea (rmail-sort-messages): In summary buf, go to rmail buf.
Richard M. Stallman <rms@gnu.org>
parents: 3878
diff changeset
188 (function
484e65abfdea (rmail-sort-messages): In summary buf, go to rmail buf.
Richard M. Stallman <rms@gnu.org>
parents: 3878
diff changeset
189 (lambda (a b)
484e65abfdea (rmail-sort-messages): In summary buf, go to rmail buf.
Richard M. Stallman <rms@gnu.org>
parents: 3878
diff changeset
190 (funcall predicate (car a) (car b))))))
484e65abfdea (rmail-sort-messages): In summary buf, go to rmail buf.
Richard M. Stallman <rms@gnu.org>
parents: 3878
diff changeset
191 (if reverse (setq sort-lists (nreverse sort-lists)))
484e65abfdea (rmail-sort-messages): In summary buf, go to rmail buf.
Richard M. Stallman <rms@gnu.org>
parents: 3878
diff changeset
192 ;; Now we enter critical region. So, keyboard quit is disabled.
484e65abfdea (rmail-sort-messages): In summary buf, go to rmail buf.
Richard M. Stallman <rms@gnu.org>
parents: 3878
diff changeset
193 (message "Reordering messages...")
484e65abfdea (rmail-sort-messages): In summary buf, go to rmail buf.
Richard M. Stallman <rms@gnu.org>
parents: 3878
diff changeset
194 (let ((inhibit-quit t) ;Inhibit quit
484e65abfdea (rmail-sort-messages): In summary buf, go to rmail buf.
Richard M. Stallman <rms@gnu.org>
parents: 3878
diff changeset
195 (current-message nil)
484e65abfdea (rmail-sort-messages): In summary buf, go to rmail buf.
Richard M. Stallman <rms@gnu.org>
parents: 3878
diff changeset
196 (msgnum 1)
484e65abfdea (rmail-sort-messages): In summary buf, go to rmail buf.
Richard M. Stallman <rms@gnu.org>
parents: 3878
diff changeset
197 (msginfo nil))
484e65abfdea (rmail-sort-messages): In summary buf, go to rmail buf.
Richard M. Stallman <rms@gnu.org>
parents: 3878
diff changeset
198 ;; There's little hope that we can easily undo after that.
6584
ec24b7ded9bc (rmail-sort-messages): Use buffer-disable-undo, not buffer-flush-undo.
Karl Heuer <kwzh@gnu.org>
parents: 6583
diff changeset
199 (buffer-disable-undo (current-buffer))
5159
484e65abfdea (rmail-sort-messages): In summary buf, go to rmail buf.
Richard M. Stallman <rms@gnu.org>
parents: 3878
diff changeset
200 (goto-char (rmail-msgbeg 1))
484e65abfdea (rmail-sort-messages): In summary buf, go to rmail buf.
Richard M. Stallman <rms@gnu.org>
parents: 3878
diff changeset
201 ;; To force update of all markers.
484e65abfdea (rmail-sort-messages): In summary buf, go to rmail buf.
Richard M. Stallman <rms@gnu.org>
parents: 3878
diff changeset
202 (insert-before-markers ?Z)
484e65abfdea (rmail-sort-messages): In summary buf, go to rmail buf.
Richard M. Stallman <rms@gnu.org>
parents: 3878
diff changeset
203 (backward-char 1)
484e65abfdea (rmail-sort-messages): In summary buf, go to rmail buf.
Richard M. Stallman <rms@gnu.org>
parents: 3878
diff changeset
204 ;; Now reorder messages.
484e65abfdea (rmail-sort-messages): In summary buf, go to rmail buf.
Richard M. Stallman <rms@gnu.org>
parents: 3878
diff changeset
205 (while sort-lists
484e65abfdea (rmail-sort-messages): In summary buf, go to rmail buf.
Richard M. Stallman <rms@gnu.org>
parents: 3878
diff changeset
206 (setq msginfo (car sort-lists))
484e65abfdea (rmail-sort-messages): In summary buf, go to rmail buf.
Richard M. Stallman <rms@gnu.org>
parents: 3878
diff changeset
207 ;; Swap two messages.
484e65abfdea (rmail-sort-messages): In summary buf, go to rmail buf.
Richard M. Stallman <rms@gnu.org>
parents: 3878
diff changeset
208 (insert-buffer-substring
484e65abfdea (rmail-sort-messages): In summary buf, go to rmail buf.
Richard M. Stallman <rms@gnu.org>
parents: 3878
diff changeset
209 (current-buffer) (nth 2 msginfo) (nth 3 msginfo))
484e65abfdea (rmail-sort-messages): In summary buf, go to rmail buf.
Richard M. Stallman <rms@gnu.org>
parents: 3878
diff changeset
210 (delete-region (nth 2 msginfo) (nth 3 msginfo))
484e65abfdea (rmail-sort-messages): In summary buf, go to rmail buf.
Richard M. Stallman <rms@gnu.org>
parents: 3878
diff changeset
211 ;; Is current message?
484e65abfdea (rmail-sort-messages): In summary buf, go to rmail buf.
Richard M. Stallman <rms@gnu.org>
parents: 3878
diff changeset
212 (if (nth 1 msginfo)
484e65abfdea (rmail-sort-messages): In summary buf, go to rmail buf.
Richard M. Stallman <rms@gnu.org>
parents: 3878
diff changeset
213 (setq current-message msgnum))
484e65abfdea (rmail-sort-messages): In summary buf, go to rmail buf.
Richard M. Stallman <rms@gnu.org>
parents: 3878
diff changeset
214 (setq sort-lists (cdr sort-lists))
484e65abfdea (rmail-sort-messages): In summary buf, go to rmail buf.
Richard M. Stallman <rms@gnu.org>
parents: 3878
diff changeset
215 (if (zerop (% msgnum 10))
484e65abfdea (rmail-sort-messages): In summary buf, go to rmail buf.
Richard M. Stallman <rms@gnu.org>
parents: 3878
diff changeset
216 (message "Reordering messages...%d" msgnum))
484e65abfdea (rmail-sort-messages): In summary buf, go to rmail buf.
Richard M. Stallman <rms@gnu.org>
parents: 3878
diff changeset
217 (setq msgnum (1+ msgnum)))
484e65abfdea (rmail-sort-messages): In summary buf, go to rmail buf.
Richard M. Stallman <rms@gnu.org>
parents: 3878
diff changeset
218 ;; Delete the garbage inserted before.
484e65abfdea (rmail-sort-messages): In summary buf, go to rmail buf.
Richard M. Stallman <rms@gnu.org>
parents: 3878
diff changeset
219 (delete-char 1)
484e65abfdea (rmail-sort-messages): In summary buf, go to rmail buf.
Richard M. Stallman <rms@gnu.org>
parents: 3878
diff changeset
220 (setq quit-flag nil)
484e65abfdea (rmail-sort-messages): In summary buf, go to rmail buf.
Richard M. Stallman <rms@gnu.org>
parents: 3878
diff changeset
221 (buffer-enable-undo)
484e65abfdea (rmail-sort-messages): In summary buf, go to rmail buf.
Richard M. Stallman <rms@gnu.org>
parents: 3878
diff changeset
222 (rmail-set-message-counters)
6583
363f38b4648a (rmail-sort-messages): Update summary buffer.
Karl Heuer <kwzh@gnu.org>
parents: 6490
diff changeset
223 (rmail-show-message current-message)
16988
18b8f50567b2 (rmail-sort-messages): Preserve point
Richard M. Stallman <rms@gnu.org>
parents: 16348
diff changeset
224 (goto-char (+ point-offset (point-min)))
6583
363f38b4648a (rmail-sort-messages): Update summary buffer.
Karl Heuer <kwzh@gnu.org>
parents: 6490
diff changeset
225 (if (rmail-summary-exists)
363f38b4648a (rmail-sort-messages): Update summary buffer.
Karl Heuer <kwzh@gnu.org>
parents: 6490
diff changeset
226 (rmail-select-summary
363f38b4648a (rmail-sort-messages): Update summary buffer.
Karl Heuer <kwzh@gnu.org>
parents: 6490
diff changeset
227 (rmail-update-summary)))))))
3133
2c1553d7aad1 New version from Umeda. Needs detailed entry.
Richard M. Stallman <rms@gnu.org>
parents: 2851
diff changeset
228
90
92266e9b90bb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
229 (defun rmail-fetch-field (msg field)
3133
2c1553d7aad1 New version from Umeda. Needs detailed entry.
Richard M. Stallman <rms@gnu.org>
parents: 2851
diff changeset
230 "Return the value of the header FIELD of MSG.
90
92266e9b90bb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
231 Arguments are MSG and FIELD."
3133
2c1553d7aad1 New version from Umeda. Needs detailed entry.
Richard M. Stallman <rms@gnu.org>
parents: 2851
diff changeset
232 (save-restriction
2c1553d7aad1 New version from Umeda. Needs detailed entry.
Richard M. Stallman <rms@gnu.org>
parents: 2851
diff changeset
233 (widen)
2c1553d7aad1 New version from Umeda. Needs detailed entry.
Richard M. Stallman <rms@gnu.org>
parents: 2851
diff changeset
234 (let ((next (rmail-msgend msg)))
90
92266e9b90bb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
235 (goto-char (rmail-msgbeg msg))
92266e9b90bb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
236 (narrow-to-region (if (search-forward "\n*** EOOH ***\n" next t)
92266e9b90bb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
237 (point)
92266e9b90bb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
238 (forward-line 1)
92266e9b90bb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
239 (point))
92266e9b90bb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
240 (progn (search-forward "\n\n" nil t) (point)))
92266e9b90bb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
241 (mail-fetch-field field))))
92266e9b90bb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
242
3133
2c1553d7aad1 New version from Umeda. Needs detailed entry.
Richard M. Stallman <rms@gnu.org>
parents: 2851
diff changeset
243 (defun rmail-make-date-sortable (date)
2c1553d7aad1 New version from Umeda. Needs detailed entry.
Richard M. Stallman <rms@gnu.org>
parents: 2851
diff changeset
244 "Make DATE sortable using the function string-lessp."
2c1553d7aad1 New version from Umeda. Needs detailed entry.
Richard M. Stallman <rms@gnu.org>
parents: 2851
diff changeset
245 ;; Assume the default time zone is GMT.
2c1553d7aad1 New version from Umeda. Needs detailed entry.
Richard M. Stallman <rms@gnu.org>
parents: 2851
diff changeset
246 (timezone-make-date-sortable date "GMT" "GMT"))
90
92266e9b90bb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
247
584
4cd7543be581 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 150
diff changeset
248 (provide 'rmailsort)
658
7cbd4fcd8b0f *** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 584
diff changeset
249
52401
695cf19ef79e Add arch taglines
Miles Bader <miles@gnu.org>
parents: 49598
diff changeset
250 ;;; arch-tag: 0d90896b-0c35-46ac-b240-38be5ada2360
658
7cbd4fcd8b0f *** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 584
diff changeset
251 ;;; rmailsort.el ends here