annotate lisp/mail/rmailsort.el @ 40704:b2731291b2d0

*** empty log message ***
author Pavel Janík <Pavel@Janik.cz>
date Sun, 04 Nov 2001 10:28:01 +0000
parents 253f761ad37b
children 0d8b17d428b5
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
37591
0858ec0fee79 (rmail-sort-by-labels): Renamed from
Gerd Moellmann <gerd@gnu.org>
parents: 16988
diff changeset
3 ;; Copyright (C) 1990, 1993, 1994, 2001 Free Software Foundation, Inc.
845
213978acbc1e entered into RCS
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 814
diff changeset
4
3133
2c1553d7aad1 New version from Umeda. Needs detailed entry.
Richard M. Stallman <rms@gnu.org>
parents: 2851
diff changeset
5 ;; 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
6 ;; Maintainer: FSF
814
38b2499cb3e9 *** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 807
diff changeset
7 ;; Keywords: mail
807
4f28bd14272c *** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 767
diff changeset
8
767
02bfc9709961 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 658
diff changeset
9 ;; This file is part of GNU Emacs.
90
92266e9b90bb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
10
767
02bfc9709961 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 658
diff changeset
11 ;; 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
12 ;; 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
13 ;; 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
14 ;; any later version.
90
92266e9b90bb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
15
92266e9b90bb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
16 ;; 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
17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
02bfc9709961 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 658
diff changeset
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
02bfc9709961 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 658
diff changeset
19 ;; GNU General Public License for more details.
90
92266e9b90bb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
20
767
02bfc9709961 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 658
diff changeset
21 ;; 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
22 ;; along with GNU Emacs; see the file COPYING. If not, write to the
e8e99446ef2c Comment fixes.
Karl Heuer <kwzh@gnu.org>
parents: 7298
diff changeset
23 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
e8e99446ef2c Comment fixes.
Karl Heuer <kwzh@gnu.org>
parents: 7298
diff changeset
24 ;; Boston, MA 02111-1307, USA.
767
02bfc9709961 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 658
diff changeset
25
38412
253f761ad37b Some fixes to follow coding conventions in files maintained by FSF.
Pavel Janík <Pavel@Janik.cz>
parents: 37591
diff changeset
26 ;;; Commentary:
253f761ad37b Some fixes to follow coding conventions in files maintained by FSF.
Pavel Janík <Pavel@Janik.cz>
parents: 37591
diff changeset
27
807
4f28bd14272c *** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 767
diff changeset
28 ;;; Code:
90
92266e9b90bb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
29
92266e9b90bb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
30 (require 'sort)
92266e9b90bb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
31
14235
48efd0c5b5dc (rmail): Add (require 'rmail).
Karl Heuer <kwzh@gnu.org>
parents: 14171
diff changeset
32 ;; For rmail-select-summary
48efd0c5b5dc (rmail): Add (require 'rmail).
Karl Heuer <kwzh@gnu.org>
parents: 14171
diff changeset
33 (require 'rmail)
48efd0c5b5dc (rmail): Add (require 'rmail).
Karl Heuer <kwzh@gnu.org>
parents: 14171
diff changeset
34
3133
2c1553d7aad1 New version from Umeda. Needs detailed entry.
Richard M. Stallman <rms@gnu.org>
parents: 2851
diff changeset
35 (autoload 'timezone-make-date-sortable "timezone")
2c1553d7aad1 New version from Umeda. Needs detailed entry.
Richard M. Stallman <rms@gnu.org>
parents: 2851
diff changeset
36
2c1553d7aad1 New version from Umeda. Needs detailed entry.
Richard M. Stallman <rms@gnu.org>
parents: 2851
diff changeset
37 ;; Sorting messages in Rmail buffer
90
92266e9b90bb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
38
16348
2cf33d3c5540 Add many autoload cookies.
Richard M. Stallman <rms@gnu.org>
parents: 14235
diff changeset
39 ;;;###autoload
90
92266e9b90bb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
40 (defun rmail-sort-by-date (reverse)
92266e9b90bb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
41 "Sort messages of current Rmail file by date.
92266e9b90bb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
42 If prefix argument REVERSE is non-nil, sort them in reverse order."
92266e9b90bb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
43 (interactive "P")
92266e9b90bb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
44 (rmail-sort-messages reverse
92266e9b90bb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
45 (function
92266e9b90bb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
46 (lambda (msg)
3133
2c1553d7aad1 New version from Umeda. Needs detailed entry.
Richard M. Stallman <rms@gnu.org>
parents: 2851
diff changeset
47 (rmail-make-date-sortable
90
92266e9b90bb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
48 (rmail-fetch-field msg "Date"))))))
92266e9b90bb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
49
16348
2cf33d3c5540 Add many autoload cookies.
Richard M. Stallman <rms@gnu.org>
parents: 14235
diff changeset
50 ;;;###autoload
90
92266e9b90bb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
51 (defun rmail-sort-by-subject (reverse)
92266e9b90bb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
52 "Sort messages of current Rmail file by subject.
92266e9b90bb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
53 If prefix argument REVERSE is non-nil, sort them in reverse order."
92266e9b90bb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
54 (interactive "P")
92266e9b90bb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
55 (rmail-sort-messages reverse
92266e9b90bb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
56 (function
92266e9b90bb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
57 (lambda (msg)
92266e9b90bb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
58 (let ((key (or (rmail-fetch-field msg "Subject") ""))
92266e9b90bb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
59 (case-fold-search t))
92266e9b90bb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
60 ;; Remove `Re:'
6490
8c6205143fb1 (rmail-sort-by-subject): Fix `Re:' regexp.
Karl Heuer <kwzh@gnu.org>
parents: 6315
diff changeset
61 (if (string-match "^\\(re:[ \t]*\\)*" key)
8c6205143fb1 (rmail-sort-by-subject): Fix `Re:' regexp.
Karl Heuer <kwzh@gnu.org>
parents: 6315
diff changeset
62 (substring key (match-end 0))
8c6205143fb1 (rmail-sort-by-subject): Fix `Re:' regexp.
Karl Heuer <kwzh@gnu.org>
parents: 6315
diff changeset
63 key))))))
90
92266e9b90bb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
64
16348
2cf33d3c5540 Add many autoload cookies.
Richard M. Stallman <rms@gnu.org>
parents: 14235
diff changeset
65 ;;;###autoload
90
92266e9b90bb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
66 (defun rmail-sort-by-author (reverse)
92266e9b90bb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
67 "Sort messages of current Rmail file by author.
92266e9b90bb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
68 If prefix argument REVERSE is non-nil, sort them in reverse order."
92266e9b90bb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
69 (interactive "P")
92266e9b90bb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
70 (rmail-sort-messages reverse
92266e9b90bb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
71 (function
92266e9b90bb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
72 (lambda (msg)
3133
2c1553d7aad1 New version from Umeda. Needs detailed entry.
Richard M. Stallman <rms@gnu.org>
parents: 2851
diff changeset
73 (downcase ;Canonical name
2c1553d7aad1 New version from Umeda. Needs detailed entry.
Richard M. Stallman <rms@gnu.org>
parents: 2851
diff changeset
74 (mail-strip-quoted-names
2c1553d7aad1 New version from Umeda. Needs detailed entry.
Richard M. Stallman <rms@gnu.org>
parents: 2851
diff changeset
75 (or (rmail-fetch-field msg "From")
2c1553d7aad1 New version from Umeda. Needs detailed entry.
Richard M. Stallman <rms@gnu.org>
parents: 2851
diff changeset
76 (rmail-fetch-field msg "Sender") "")))))))
90
92266e9b90bb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
77
16348
2cf33d3c5540 Add many autoload cookies.
Richard M. Stallman <rms@gnu.org>
parents: 14235
diff changeset
78 ;;;###autoload
90
92266e9b90bb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
79 (defun rmail-sort-by-recipient (reverse)
92266e9b90bb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
80 "Sort messages of current Rmail file by recipient.
92266e9b90bb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
81 If prefix argument REVERSE is non-nil, sort them in reverse order."
92266e9b90bb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
82 (interactive "P")
92266e9b90bb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
83 (rmail-sort-messages reverse
92266e9b90bb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
84 (function
92266e9b90bb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
85 (lambda (msg)
3133
2c1553d7aad1 New version from Umeda. Needs detailed entry.
Richard M. Stallman <rms@gnu.org>
parents: 2851
diff changeset
86 (downcase ;Canonical name
2c1553d7aad1 New version from Umeda. Needs detailed entry.
Richard M. Stallman <rms@gnu.org>
parents: 2851
diff changeset
87 (mail-strip-quoted-names
2c1553d7aad1 New version from Umeda. Needs detailed entry.
Richard M. Stallman <rms@gnu.org>
parents: 2851
diff changeset
88 (or (rmail-fetch-field msg "To")
2c1553d7aad1 New version from Umeda. Needs detailed entry.
Richard M. Stallman <rms@gnu.org>
parents: 2851
diff changeset
89 (rmail-fetch-field msg "Apparently-To") "")
2c1553d7aad1 New version from Umeda. Needs detailed entry.
Richard M. Stallman <rms@gnu.org>
parents: 2851
diff changeset
90 ))))))
90
92266e9b90bb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
91
16348
2cf33d3c5540 Add many autoload cookies.
Richard M. Stallman <rms@gnu.org>
parents: 14235
diff changeset
92 ;;;###autoload
131
d4c523560fe8 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 92
diff changeset
93 (defun rmail-sort-by-correspondent (reverse)
d4c523560fe8 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 92
diff changeset
94 "Sort messages of current Rmail file by other correspondent.
d4c523560fe8 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 92
diff changeset
95 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
96 (interactive "P")
d4c523560fe8 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 92
diff changeset
97 (rmail-sort-messages reverse
d4c523560fe8 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 92
diff changeset
98 (function
d4c523560fe8 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 92
diff changeset
99 (lambda (msg)
d4c523560fe8 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 92
diff changeset
100 (rmail-select-correspondent
d4c523560fe8 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 92
diff changeset
101 msg
d4c523560fe8 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 92
diff changeset
102 '("From" "Sender" "To" "Apparently-To"))))))
d4c523560fe8 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 92
diff changeset
103
d4c523560fe8 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 92
diff changeset
104 (defun rmail-select-correspondent (msg fields)
d4c523560fe8 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 92
diff changeset
105 (let ((ans ""))
3133
2c1553d7aad1 New version from Umeda. Needs detailed entry.
Richard M. Stallman <rms@gnu.org>
parents: 2851
diff changeset
106 (while (and fields (string= ans ""))
2c1553d7aad1 New version from Umeda. Needs detailed entry.
Richard M. Stallman <rms@gnu.org>
parents: 2851
diff changeset
107 (setq ans
2c1553d7aad1 New version from Umeda. Needs detailed entry.
Richard M. Stallman <rms@gnu.org>
parents: 2851
diff changeset
108 (rmail-dont-reply-to
2c1553d7aad1 New version from Umeda. Needs detailed entry.
Richard M. Stallman <rms@gnu.org>
parents: 2851
diff changeset
109 (mail-strip-quoted-names
2c1553d7aad1 New version from Umeda. Needs detailed entry.
Richard M. Stallman <rms@gnu.org>
parents: 2851
diff changeset
110 (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
111 (setq fields (cdr fields)))
2c1553d7aad1 New version from Umeda. Needs detailed entry.
Richard M. Stallman <rms@gnu.org>
parents: 2851
diff changeset
112 ans))
148
a099f0c77321 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 131
diff changeset
113
16348
2cf33d3c5540 Add many autoload cookies.
Richard M. Stallman <rms@gnu.org>
parents: 14235
diff changeset
114 ;;;###autoload
3133
2c1553d7aad1 New version from Umeda. Needs detailed entry.
Richard M. Stallman <rms@gnu.org>
parents: 2851
diff changeset
115 (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
116 "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
117 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
118 (interactive "P")
a099f0c77321 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 131
diff changeset
119 (rmail-sort-messages reverse
a099f0c77321 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 131
diff changeset
120 (function
a099f0c77321 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 131
diff changeset
121 (lambda (msg)
6315
f6a596a8a248 (rmail-sort-by-lines): msgnum variable should be msg.
Karl Heuer <kwzh@gnu.org>
parents: 5159
diff changeset
122 (count-lines (rmail-msgbeg msg)
f6a596a8a248 (rmail-sort-by-lines): msgnum variable should be msg.
Karl Heuer <kwzh@gnu.org>
parents: 5159
diff changeset
123 (rmail-msgend msg))))))
6718
c13953896b24 (rmail-sort-by-keywords): New function.
Karl Heuer <kwzh@gnu.org>
parents: 6584
diff changeset
124
16348
2cf33d3c5540 Add many autoload cookies.
Richard M. Stallman <rms@gnu.org>
parents: 14235
diff changeset
125 ;;;###autoload
37591
0858ec0fee79 (rmail-sort-by-labels): Renamed from
Gerd Moellmann <gerd@gnu.org>
parents: 16988
diff changeset
126 (defun rmail-sort-by-labels (reverse labels)
6718
c13953896b24 (rmail-sort-by-keywords): New function.
Karl Heuer <kwzh@gnu.org>
parents: 6584
diff changeset
127 "Sort messages of current Rmail file by labels.
c13953896b24 (rmail-sort-by-keywords): New function.
Karl Heuer <kwzh@gnu.org>
parents: 6584
diff changeset
128 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
129 KEYWORDS is a comma-separated list of labels."
c13953896b24 (rmail-sort-by-keywords): New function.
Karl Heuer <kwzh@gnu.org>
parents: 6584
diff changeset
130 (interactive "P\nsSort by labels: ")
c13953896b24 (rmail-sort-by-keywords): New function.
Karl Heuer <kwzh@gnu.org>
parents: 6584
diff changeset
131 (or (string-match "[^ \t]" labels)
c13953896b24 (rmail-sort-by-keywords): New function.
Karl Heuer <kwzh@gnu.org>
parents: 6584
diff changeset
132 (error "No labels specified"))
c13953896b24 (rmail-sort-by-keywords): New function.
Karl Heuer <kwzh@gnu.org>
parents: 6584
diff changeset
133 (setq labels (concat (substring labels (match-beginning 0)) ","))
c13953896b24 (rmail-sort-by-keywords): New function.
Karl Heuer <kwzh@gnu.org>
parents: 6584
diff changeset
134 (let (labelvec)
c13953896b24 (rmail-sort-by-keywords): New function.
Karl Heuer <kwzh@gnu.org>
parents: 6584
diff changeset
135 (while (string-match "[ \t]*,[ \t]*" labels)
c13953896b24 (rmail-sort-by-keywords): New function.
Karl Heuer <kwzh@gnu.org>
parents: 6584
diff changeset
136 (setq labelvec (cons
c13953896b24 (rmail-sort-by-keywords): New function.
Karl Heuer <kwzh@gnu.org>
parents: 6584
diff changeset
137 (concat ", ?\\("
c13953896b24 (rmail-sort-by-keywords): New function.
Karl Heuer <kwzh@gnu.org>
parents: 6584
diff changeset
138 (substring labels 0 (match-beginning 0))
c13953896b24 (rmail-sort-by-keywords): New function.
Karl Heuer <kwzh@gnu.org>
parents: 6584
diff changeset
139 "\\),")
c13953896b24 (rmail-sort-by-keywords): New function.
Karl Heuer <kwzh@gnu.org>
parents: 6584
diff changeset
140 labelvec))
c13953896b24 (rmail-sort-by-keywords): New function.
Karl Heuer <kwzh@gnu.org>
parents: 6584
diff changeset
141 (setq labels (substring labels (match-end 0))))
c13953896b24 (rmail-sort-by-keywords): New function.
Karl Heuer <kwzh@gnu.org>
parents: 6584
diff changeset
142 (setq labelvec (apply 'vector (nreverse labelvec)))
c13953896b24 (rmail-sort-by-keywords): New function.
Karl Heuer <kwzh@gnu.org>
parents: 6584
diff changeset
143 (rmail-sort-messages reverse
c13953896b24 (rmail-sort-by-keywords): New function.
Karl Heuer <kwzh@gnu.org>
parents: 6584
diff changeset
144 (function
c13953896b24 (rmail-sort-by-keywords): New function.
Karl Heuer <kwzh@gnu.org>
parents: 6584
diff changeset
145 (lambda (msg)
c13953896b24 (rmail-sort-by-keywords): New function.
Karl Heuer <kwzh@gnu.org>
parents: 6584
diff changeset
146 (let ((n 0))
c13953896b24 (rmail-sort-by-keywords): New function.
Karl Heuer <kwzh@gnu.org>
parents: 6584
diff changeset
147 (while (and (< n (length labelvec))
c13953896b24 (rmail-sort-by-keywords): New function.
Karl Heuer <kwzh@gnu.org>
parents: 6584
diff changeset
148 (not (rmail-message-labels-p
c13953896b24 (rmail-sort-by-keywords): New function.
Karl Heuer <kwzh@gnu.org>
parents: 6584
diff changeset
149 msg (aref labelvec n))))
c13953896b24 (rmail-sort-by-keywords): New function.
Karl Heuer <kwzh@gnu.org>
parents: 6584
diff changeset
150 (setq n (1+ n)))
c13953896b24 (rmail-sort-by-keywords): New function.
Karl Heuer <kwzh@gnu.org>
parents: 6584
diff changeset
151 n))))))
90
92266e9b90bb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
152
3133
2c1553d7aad1 New version from Umeda. Needs detailed entry.
Richard M. Stallman <rms@gnu.org>
parents: 2851
diff changeset
153 ;; Basic functions
2c1553d7aad1 New version from Umeda. Needs detailed entry.
Richard M. Stallman <rms@gnu.org>
parents: 2851
diff changeset
154
2c1553d7aad1 New version from Umeda. Needs detailed entry.
Richard M. Stallman <rms@gnu.org>
parents: 2851
diff changeset
155 (defun rmail-sort-messages (reverse keyfun)
90
92266e9b90bb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
156 "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
157 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
158 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
159 (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
160 ;; 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
161 (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
162 (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
163 (let ((buffer-read-only nil)
16988
18b8f50567b2 (rmail-sort-messages): Preserve point
Richard M. Stallman <rms@gnu.org>
parents: 16348
diff changeset
164 (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
165 (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
166 (sort-lists nil))
484e65abfdea (rmail-sort-messages): In summary buf, go to rmail buf.
Richard M. Stallman <rms@gnu.org>
parents: 3878
diff changeset
167 (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
168 (widen)
484e65abfdea (rmail-sort-messages): In summary buf, go to rmail buf.
Richard M. Stallman <rms@gnu.org>
parents: 3878
diff changeset
169 (let ((msgnum 1))
484e65abfdea (rmail-sort-messages): In summary buf, go to rmail buf.
Richard M. Stallman <rms@gnu.org>
parents: 3878
diff changeset
170 (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
171 (setq sort-lists
484e65abfdea (rmail-sort-messages): In summary buf, go to rmail buf.
Richard M. Stallman <rms@gnu.org>
parents: 3878
diff changeset
172 (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
173 (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
174 (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
175 (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
176 sort-lists))
484e65abfdea (rmail-sort-messages): In summary buf, go to rmail buf.
Richard M. Stallman <rms@gnu.org>
parents: 3878
diff changeset
177 (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
178 (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
179 (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
180 (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
181 ;; 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
182 (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
183 (setq predicate (function <))
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 string-lessp)))
484e65abfdea (rmail-sort-messages): In summary buf, go to rmail buf.
Richard M. Stallman <rms@gnu.org>
parents: 3878
diff changeset
185 (setq sort-lists
484e65abfdea (rmail-sort-messages): In summary buf, go to rmail buf.
Richard M. Stallman <rms@gnu.org>
parents: 3878
diff changeset
186 (sort sort-lists
484e65abfdea (rmail-sort-messages): In summary buf, go to rmail buf.
Richard M. Stallman <rms@gnu.org>
parents: 3878
diff changeset
187 (function
484e65abfdea (rmail-sort-messages): In summary buf, go to rmail buf.
Richard M. Stallman <rms@gnu.org>
parents: 3878
diff changeset
188 (lambda (a b)
484e65abfdea (rmail-sort-messages): In summary buf, go to rmail buf.
Richard M. Stallman <rms@gnu.org>
parents: 3878
diff changeset
189 (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
190 (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
191 ;; 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
192 (message "Reordering messages...")
484e65abfdea (rmail-sort-messages): In summary buf, go to rmail buf.
Richard M. Stallman <rms@gnu.org>
parents: 3878
diff changeset
193 (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
194 (current-message nil)
484e65abfdea (rmail-sort-messages): In summary buf, go to rmail buf.
Richard M. Stallman <rms@gnu.org>
parents: 3878
diff changeset
195 (msgnum 1)
484e65abfdea (rmail-sort-messages): In summary buf, go to rmail buf.
Richard M. Stallman <rms@gnu.org>
parents: 3878
diff changeset
196 (msginfo nil))
484e65abfdea (rmail-sort-messages): In summary buf, go to rmail buf.
Richard M. Stallman <rms@gnu.org>
parents: 3878
diff changeset
197 ;; 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
198 (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
199 (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
200 ;; 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
201 (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
202 (backward-char 1)
484e65abfdea (rmail-sort-messages): In summary buf, go to rmail buf.
Richard M. Stallman <rms@gnu.org>
parents: 3878
diff changeset
203 ;; Now reorder messages.
484e65abfdea (rmail-sort-messages): In summary buf, go to rmail buf.
Richard M. Stallman <rms@gnu.org>
parents: 3878
diff changeset
204 (while sort-lists
484e65abfdea (rmail-sort-messages): In summary buf, go to rmail buf.
Richard M. Stallman <rms@gnu.org>
parents: 3878
diff changeset
205 (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
206 ;; Swap two messages.
484e65abfdea (rmail-sort-messages): In summary buf, go to rmail buf.
Richard M. Stallman <rms@gnu.org>
parents: 3878
diff changeset
207 (insert-buffer-substring
484e65abfdea (rmail-sort-messages): In summary buf, go to rmail buf.
Richard M. Stallman <rms@gnu.org>
parents: 3878
diff changeset
208 (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
209 (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
210 ;; Is current message?
484e65abfdea (rmail-sort-messages): In summary buf, go to rmail buf.
Richard M. Stallman <rms@gnu.org>
parents: 3878
diff changeset
211 (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
212 (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
213 (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
214 (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
215 (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
216 (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
217 ;; 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
218 (delete-char 1)
484e65abfdea (rmail-sort-messages): In summary buf, go to rmail buf.
Richard M. Stallman <rms@gnu.org>
parents: 3878
diff changeset
219 (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
220 (buffer-enable-undo)
484e65abfdea (rmail-sort-messages): In summary buf, go to rmail buf.
Richard M. Stallman <rms@gnu.org>
parents: 3878
diff changeset
221 (rmail-set-message-counters)
6583
363f38b4648a (rmail-sort-messages): Update summary buffer.
Karl Heuer <kwzh@gnu.org>
parents: 6490
diff changeset
222 (rmail-show-message current-message)
16988
18b8f50567b2 (rmail-sort-messages): Preserve point
Richard M. Stallman <rms@gnu.org>
parents: 16348
diff changeset
223 (goto-char (+ point-offset (point-min)))
6583
363f38b4648a (rmail-sort-messages): Update summary buffer.
Karl Heuer <kwzh@gnu.org>
parents: 6490
diff changeset
224 (if (rmail-summary-exists)
363f38b4648a (rmail-sort-messages): Update summary buffer.
Karl Heuer <kwzh@gnu.org>
parents: 6490
diff changeset
225 (rmail-select-summary
363f38b4648a (rmail-sort-messages): Update summary buffer.
Karl Heuer <kwzh@gnu.org>
parents: 6490
diff changeset
226 (rmail-update-summary)))))))
3133
2c1553d7aad1 New version from Umeda. Needs detailed entry.
Richard M. Stallman <rms@gnu.org>
parents: 2851
diff changeset
227
90
92266e9b90bb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
228 (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
229 "Return the value of the header FIELD of MSG.
90
92266e9b90bb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
230 Arguments are MSG and FIELD."
3133
2c1553d7aad1 New version from Umeda. Needs detailed entry.
Richard M. Stallman <rms@gnu.org>
parents: 2851
diff changeset
231 (save-restriction
2c1553d7aad1 New version from Umeda. Needs detailed entry.
Richard M. Stallman <rms@gnu.org>
parents: 2851
diff changeset
232 (widen)
2c1553d7aad1 New version from Umeda. Needs detailed entry.
Richard M. Stallman <rms@gnu.org>
parents: 2851
diff changeset
233 (let ((next (rmail-msgend msg)))
90
92266e9b90bb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
234 (goto-char (rmail-msgbeg msg))
92266e9b90bb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
235 (narrow-to-region (if (search-forward "\n*** EOOH ***\n" next t)
92266e9b90bb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
236 (point)
92266e9b90bb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
237 (forward-line 1)
92266e9b90bb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
238 (point))
92266e9b90bb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
239 (progn (search-forward "\n\n" nil t) (point)))
92266e9b90bb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
240 (mail-fetch-field field))))
92266e9b90bb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
241
3133
2c1553d7aad1 New version from Umeda. Needs detailed entry.
Richard M. Stallman <rms@gnu.org>
parents: 2851
diff changeset
242 (defun rmail-make-date-sortable (date)
2c1553d7aad1 New version from Umeda. Needs detailed entry.
Richard M. Stallman <rms@gnu.org>
parents: 2851
diff changeset
243 "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
244 ;; 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
245 (timezone-make-date-sortable date "GMT" "GMT"))
90
92266e9b90bb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
246
584
4cd7543be581 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 150
diff changeset
247 (provide 'rmailsort)
658
7cbd4fcd8b0f *** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 584
diff changeset
248
7cbd4fcd8b0f *** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 584
diff changeset
249 ;;; rmailsort.el ends here