Mercurial > emacs
annotate lisp/mail/rmailsort.el @ 88146:a64fe1ff909a
(rmail-make-summary-line): Function deleted.
(rmail-new-summary): Make it work once again as in old version.
(rmail-summary-get-summary): Call rmail-summary-line-decoder.
author | Richard M. Stallman <rms@gnu.org> |
---|---|
date | Mon, 27 Sep 2004 07:41:10 +0000 |
parents | 3c2c324caf38 |
children | d7ddb3e565de |
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 | 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 | 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 | 15 |
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 | 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 | 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. | |
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 | 29 |
88129
89e63d46028b
Attempt to minimize byte compilation warnings.
Paul Reilly <pmr@pajato.com>
parents:
49598
diff
changeset
|
30 (provide 'rmailsort) |
90 | 31 |
88129
89e63d46028b
Attempt to minimize byte compilation warnings.
Paul Reilly <pmr@pajato.com>
parents:
49598
diff
changeset
|
32 (eval-when-compile |
89e63d46028b
Attempt to minimize byte compilation warnings.
Paul Reilly <pmr@pajato.com>
parents:
49598
diff
changeset
|
33 (require 'mail-utils) |
89e63d46028b
Attempt to minimize byte compilation warnings.
Paul Reilly <pmr@pajato.com>
parents:
49598
diff
changeset
|
34 (require 'sort) |
89e63d46028b
Attempt to minimize byte compilation warnings.
Paul Reilly <pmr@pajato.com>
parents:
49598
diff
changeset
|
35 (require 'rmail)) |
14235 | 36 |
3133
2c1553d7aad1
New version from Umeda. Needs detailed entry.
Richard M. Stallman <rms@gnu.org>
parents:
2851
diff
changeset
|
37 (autoload 'timezone-make-date-sortable "timezone") |
2c1553d7aad1
New version from Umeda. Needs detailed entry.
Richard M. Stallman <rms@gnu.org>
parents:
2851
diff
changeset
|
38 |
2c1553d7aad1
New version from Umeda. Needs detailed entry.
Richard M. Stallman <rms@gnu.org>
parents:
2851
diff
changeset
|
39 ;; Sorting messages in Rmail buffer |
90 | 40 |
16348
2cf33d3c5540
Add many autoload cookies.
Richard M. Stallman <rms@gnu.org>
parents:
14235
diff
changeset
|
41 ;;;###autoload |
90 | 42 (defun rmail-sort-by-date (reverse) |
43 "Sort messages of current Rmail file by date. | |
44 If prefix argument REVERSE is non-nil, sort them in reverse order." | |
45 (interactive "P") | |
46 (rmail-sort-messages reverse | |
47 (function | |
48 (lambda (msg) | |
3133
2c1553d7aad1
New version from Umeda. Needs detailed entry.
Richard M. Stallman <rms@gnu.org>
parents:
2851
diff
changeset
|
49 (rmail-make-date-sortable |
90 | 50 (rmail-fetch-field msg "Date")))))) |
51 | |
16348
2cf33d3c5540
Add many autoload cookies.
Richard M. Stallman <rms@gnu.org>
parents:
14235
diff
changeset
|
52 ;;;###autoload |
90 | 53 (defun rmail-sort-by-subject (reverse) |
54 "Sort messages of current Rmail file by subject. | |
55 If prefix argument REVERSE is non-nil, sort them in reverse order." | |
56 (interactive "P") | |
57 (rmail-sort-messages reverse | |
58 (function | |
59 (lambda (msg) | |
60 (let ((key (or (rmail-fetch-field msg "Subject") "")) | |
61 (case-fold-search t)) | |
62 ;; Remove `Re:' | |
6490
8c6205143fb1
(rmail-sort-by-subject): Fix `Re:' regexp.
Karl Heuer <kwzh@gnu.org>
parents:
6315
diff
changeset
|
63 (if (string-match "^\\(re:[ \t]*\\)*" key) |
8c6205143fb1
(rmail-sort-by-subject): Fix `Re:' regexp.
Karl Heuer <kwzh@gnu.org>
parents:
6315
diff
changeset
|
64 (substring key (match-end 0)) |
8c6205143fb1
(rmail-sort-by-subject): Fix `Re:' regexp.
Karl Heuer <kwzh@gnu.org>
parents:
6315
diff
changeset
|
65 key)))))) |
90 | 66 |
16348
2cf33d3c5540
Add many autoload cookies.
Richard M. Stallman <rms@gnu.org>
parents:
14235
diff
changeset
|
67 ;;;###autoload |
90 | 68 (defun rmail-sort-by-author (reverse) |
69 "Sort messages of current Rmail file by author. | |
70 If prefix argument REVERSE is non-nil, sort them in reverse order." | |
71 (interactive "P") | |
72 (rmail-sort-messages reverse | |
73 (function | |
74 (lambda (msg) | |
3133
2c1553d7aad1
New version from Umeda. Needs detailed entry.
Richard M. Stallman <rms@gnu.org>
parents:
2851
diff
changeset
|
75 (downcase ;Canonical name |
2c1553d7aad1
New version from Umeda. Needs detailed entry.
Richard M. Stallman <rms@gnu.org>
parents:
2851
diff
changeset
|
76 (mail-strip-quoted-names |
2c1553d7aad1
New version from Umeda. Needs detailed entry.
Richard M. Stallman <rms@gnu.org>
parents:
2851
diff
changeset
|
77 (or (rmail-fetch-field msg "From") |
2c1553d7aad1
New version from Umeda. Needs detailed entry.
Richard M. Stallman <rms@gnu.org>
parents:
2851
diff
changeset
|
78 (rmail-fetch-field msg "Sender") ""))))))) |
90 | 79 |
16348
2cf33d3c5540
Add many autoload cookies.
Richard M. Stallman <rms@gnu.org>
parents:
14235
diff
changeset
|
80 ;;;###autoload |
90 | 81 (defun rmail-sort-by-recipient (reverse) |
82 "Sort messages of current Rmail file by recipient. | |
83 If prefix argument REVERSE is non-nil, sort them in reverse order." | |
84 (interactive "P") | |
85 (rmail-sort-messages reverse | |
86 (function | |
87 (lambda (msg) | |
3133
2c1553d7aad1
New version from Umeda. Needs detailed entry.
Richard M. Stallman <rms@gnu.org>
parents:
2851
diff
changeset
|
88 (downcase ;Canonical name |
2c1553d7aad1
New version from Umeda. Needs detailed entry.
Richard M. Stallman <rms@gnu.org>
parents:
2851
diff
changeset
|
89 (mail-strip-quoted-names |
2c1553d7aad1
New version from Umeda. Needs detailed entry.
Richard M. Stallman <rms@gnu.org>
parents:
2851
diff
changeset
|
90 (or (rmail-fetch-field msg "To") |
2c1553d7aad1
New version from Umeda. Needs detailed entry.
Richard M. Stallman <rms@gnu.org>
parents:
2851
diff
changeset
|
91 (rmail-fetch-field msg "Apparently-To") "") |
2c1553d7aad1
New version from Umeda. Needs detailed entry.
Richard M. Stallman <rms@gnu.org>
parents:
2851
diff
changeset
|
92 )))))) |
90 | 93 |
16348
2cf33d3c5540
Add many autoload cookies.
Richard M. Stallman <rms@gnu.org>
parents:
14235
diff
changeset
|
94 ;;;###autoload |
131 | 95 (defun rmail-sort-by-correspondent (reverse) |
96 "Sort messages of current Rmail file by other correspondent. | |
97 If prefix argument REVERSE is non-nil, sort them in reverse order." | |
98 (interactive "P") | |
99 (rmail-sort-messages reverse | |
100 (function | |
101 (lambda (msg) | |
102 (rmail-select-correspondent | |
103 msg | |
104 '("From" "Sender" "To" "Apparently-To")))))) | |
105 | |
106 (defun rmail-select-correspondent (msg fields) | |
107 (let ((ans "")) | |
3133
2c1553d7aad1
New version from Umeda. Needs detailed entry.
Richard M. Stallman <rms@gnu.org>
parents:
2851
diff
changeset
|
108 (while (and fields (string= ans "")) |
2c1553d7aad1
New version from Umeda. Needs detailed entry.
Richard M. Stallman <rms@gnu.org>
parents:
2851
diff
changeset
|
109 (setq ans |
2c1553d7aad1
New version from Umeda. Needs detailed entry.
Richard M. Stallman <rms@gnu.org>
parents:
2851
diff
changeset
|
110 (rmail-dont-reply-to |
2c1553d7aad1
New version from Umeda. Needs detailed entry.
Richard M. Stallman <rms@gnu.org>
parents:
2851
diff
changeset
|
111 (mail-strip-quoted-names |
2c1553d7aad1
New version from Umeda. Needs detailed entry.
Richard M. Stallman <rms@gnu.org>
parents:
2851
diff
changeset
|
112 (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
|
113 (setq fields (cdr fields))) |
2c1553d7aad1
New version from Umeda. Needs detailed entry.
Richard M. Stallman <rms@gnu.org>
parents:
2851
diff
changeset
|
114 ans)) |
148
a099f0c77321
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
131
diff
changeset
|
115 |
16348
2cf33d3c5540
Add many autoload cookies.
Richard M. Stallman <rms@gnu.org>
parents:
14235
diff
changeset
|
116 ;;;###autoload |
3133
2c1553d7aad1
New version from Umeda. Needs detailed entry.
Richard M. Stallman <rms@gnu.org>
parents:
2851
diff
changeset
|
117 (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
|
118 "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
|
119 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
|
120 (interactive "P") |
a099f0c77321
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
131
diff
changeset
|
121 (rmail-sort-messages reverse |
a099f0c77321
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
131
diff
changeset
|
122 (function |
a099f0c77321
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
131
diff
changeset
|
123 (lambda (msg) |
88135
3c2c324caf38
(rmail-sort-by-lines, rmail-fetch-field): Use the rmail message
Paul Reilly <pmr@pajato.com>
parents:
88129
diff
changeset
|
124 (count-lines (rmail-desc-get-start msg) |
3c2c324caf38
(rmail-sort-by-lines, rmail-fetch-field): Use the rmail message
Paul Reilly <pmr@pajato.com>
parents:
88129
diff
changeset
|
125 (rmail-desc-get-end msg)))))) |
6718
c13953896b24
(rmail-sort-by-keywords): New function.
Karl Heuer <kwzh@gnu.org>
parents:
6584
diff
changeset
|
126 |
16348
2cf33d3c5540
Add many autoload cookies.
Richard M. Stallman <rms@gnu.org>
parents:
14235
diff
changeset
|
127 ;;;###autoload |
37591
0858ec0fee79
(rmail-sort-by-labels): Renamed from
Gerd Moellmann <gerd@gnu.org>
parents:
16988
diff
changeset
|
128 (defun rmail-sort-by-labels (reverse labels) |
6718
c13953896b24
(rmail-sort-by-keywords): New function.
Karl Heuer <kwzh@gnu.org>
parents:
6584
diff
changeset
|
129 "Sort messages of current Rmail file by labels. |
c13953896b24
(rmail-sort-by-keywords): New function.
Karl Heuer <kwzh@gnu.org>
parents:
6584
diff
changeset
|
130 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
|
131 KEYWORDS is a comma-separated list of labels." |
c13953896b24
(rmail-sort-by-keywords): New function.
Karl Heuer <kwzh@gnu.org>
parents:
6584
diff
changeset
|
132 (interactive "P\nsSort by labels: ") |
c13953896b24
(rmail-sort-by-keywords): New function.
Karl Heuer <kwzh@gnu.org>
parents:
6584
diff
changeset
|
133 (or (string-match "[^ \t]" labels) |
c13953896b24
(rmail-sort-by-keywords): New function.
Karl Heuer <kwzh@gnu.org>
parents:
6584
diff
changeset
|
134 (error "No labels specified")) |
c13953896b24
(rmail-sort-by-keywords): New function.
Karl Heuer <kwzh@gnu.org>
parents:
6584
diff
changeset
|
135 (setq labels (concat (substring labels (match-beginning 0)) ",")) |
c13953896b24
(rmail-sort-by-keywords): New function.
Karl Heuer <kwzh@gnu.org>
parents:
6584
diff
changeset
|
136 (let (labelvec) |
c13953896b24
(rmail-sort-by-keywords): New function.
Karl Heuer <kwzh@gnu.org>
parents:
6584
diff
changeset
|
137 (while (string-match "[ \t]*,[ \t]*" labels) |
49598
0d8b17d428b5
Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
38412
diff
changeset
|
138 (setq labelvec (cons |
6718
c13953896b24
(rmail-sort-by-keywords): New function.
Karl Heuer <kwzh@gnu.org>
parents:
6584
diff
changeset
|
139 (concat ", ?\\(" |
c13953896b24
(rmail-sort-by-keywords): New function.
Karl Heuer <kwzh@gnu.org>
parents:
6584
diff
changeset
|
140 (substring labels 0 (match-beginning 0)) |
c13953896b24
(rmail-sort-by-keywords): New function.
Karl Heuer <kwzh@gnu.org>
parents:
6584
diff
changeset
|
141 "\\),") |
c13953896b24
(rmail-sort-by-keywords): New function.
Karl Heuer <kwzh@gnu.org>
parents:
6584
diff
changeset
|
142 labelvec)) |
c13953896b24
(rmail-sort-by-keywords): New function.
Karl Heuer <kwzh@gnu.org>
parents:
6584
diff
changeset
|
143 (setq labels (substring labels (match-end 0)))) |
c13953896b24
(rmail-sort-by-keywords): New function.
Karl Heuer <kwzh@gnu.org>
parents:
6584
diff
changeset
|
144 (setq labelvec (apply 'vector (nreverse labelvec))) |
c13953896b24
(rmail-sort-by-keywords): New function.
Karl Heuer <kwzh@gnu.org>
parents:
6584
diff
changeset
|
145 (rmail-sort-messages reverse |
c13953896b24
(rmail-sort-by-keywords): New function.
Karl Heuer <kwzh@gnu.org>
parents:
6584
diff
changeset
|
146 (function |
c13953896b24
(rmail-sort-by-keywords): New function.
Karl Heuer <kwzh@gnu.org>
parents:
6584
diff
changeset
|
147 (lambda (msg) |
c13953896b24
(rmail-sort-by-keywords): New function.
Karl Heuer <kwzh@gnu.org>
parents:
6584
diff
changeset
|
148 (let ((n 0)) |
c13953896b24
(rmail-sort-by-keywords): New function.
Karl Heuer <kwzh@gnu.org>
parents:
6584
diff
changeset
|
149 (while (and (< n (length labelvec)) |
c13953896b24
(rmail-sort-by-keywords): New function.
Karl Heuer <kwzh@gnu.org>
parents:
6584
diff
changeset
|
150 (not (rmail-message-labels-p |
c13953896b24
(rmail-sort-by-keywords): New function.
Karl Heuer <kwzh@gnu.org>
parents:
6584
diff
changeset
|
151 msg (aref labelvec n)))) |
c13953896b24
(rmail-sort-by-keywords): New function.
Karl Heuer <kwzh@gnu.org>
parents:
6584
diff
changeset
|
152 (setq n (1+ n))) |
c13953896b24
(rmail-sort-by-keywords): New function.
Karl Heuer <kwzh@gnu.org>
parents:
6584
diff
changeset
|
153 n)))))) |
90 | 154 |
3133
2c1553d7aad1
New version from Umeda. Needs detailed entry.
Richard M. Stallman <rms@gnu.org>
parents:
2851
diff
changeset
|
155 ;; Basic functions |
2c1553d7aad1
New version from Umeda. Needs detailed entry.
Richard M. Stallman <rms@gnu.org>
parents:
2851
diff
changeset
|
156 |
2c1553d7aad1
New version from Umeda. Needs detailed entry.
Richard M. Stallman <rms@gnu.org>
parents:
2851
diff
changeset
|
157 (defun rmail-sort-messages (reverse keyfun) |
90 | 158 "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
|
159 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
|
160 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
|
161 (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
|
162 ;; 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
|
163 (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
|
164 (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
|
165 (let ((buffer-read-only nil) |
16988
18b8f50567b2
(rmail-sort-messages): Preserve point
Richard M. Stallman <rms@gnu.org>
parents:
16348
diff
changeset
|
166 (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
|
167 (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
|
168 (sort-lists nil)) |
484e65abfdea
(rmail-sort-messages): In summary buf, go to rmail buf.
Richard M. Stallman <rms@gnu.org>
parents:
3878
diff
changeset
|
169 (message "Finding sort keys...") |
88135
3c2c324caf38
(rmail-sort-by-lines, rmail-fetch-field): Use the rmail message
Paul Reilly <pmr@pajato.com>
parents:
88129
diff
changeset
|
170 (rmail-header-show-headers) |
5159
484e65abfdea
(rmail-sort-messages): In summary buf, go to rmail buf.
Richard M. Stallman <rms@gnu.org>
parents:
3878
diff
changeset
|
171 (widen) |
484e65abfdea
(rmail-sort-messages): In summary buf, go to rmail buf.
Richard M. Stallman <rms@gnu.org>
parents:
3878
diff
changeset
|
172 (let ((msgnum 1)) |
484e65abfdea
(rmail-sort-messages): In summary buf, go to rmail buf.
Richard M. Stallman <rms@gnu.org>
parents:
3878
diff
changeset
|
173 (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
|
174 (setq sort-lists |
484e65abfdea
(rmail-sort-messages): In summary buf, go to rmail buf.
Richard M. Stallman <rms@gnu.org>
parents:
3878
diff
changeset
|
175 (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
|
176 (eq rmail-current-message msgnum) ;True if current |
88135
3c2c324caf38
(rmail-sort-by-lines, rmail-fetch-field): Use the rmail message
Paul Reilly <pmr@pajato.com>
parents:
88129
diff
changeset
|
177 (rmail-desc-get-marker-start msgnum) |
3c2c324caf38
(rmail-sort-by-lines, rmail-fetch-field): Use the rmail message
Paul Reilly <pmr@pajato.com>
parents:
88129
diff
changeset
|
178 (rmail-desc-get-marker-end msgnum)) |
5159
484e65abfdea
(rmail-sort-messages): In summary buf, go to rmail buf.
Richard M. Stallman <rms@gnu.org>
parents:
3878
diff
changeset
|
179 sort-lists)) |
484e65abfdea
(rmail-sort-messages): In summary buf, go to rmail buf.
Richard M. Stallman <rms@gnu.org>
parents:
3878
diff
changeset
|
180 (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
|
181 (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
|
182 (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
|
183 (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
|
184 ;; 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
|
185 (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
|
186 (setq predicate (function <)) |
484e65abfdea
(rmail-sort-messages): In summary buf, go to rmail buf.
Richard M. Stallman <rms@gnu.org>
parents:
3878
diff
changeset
|
187 (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
|
188 (setq sort-lists |
484e65abfdea
(rmail-sort-messages): In summary buf, go to rmail buf.
Richard M. Stallman <rms@gnu.org>
parents:
3878
diff
changeset
|
189 (sort sort-lists |
484e65abfdea
(rmail-sort-messages): In summary buf, go to rmail buf.
Richard M. Stallman <rms@gnu.org>
parents:
3878
diff
changeset
|
190 (function |
484e65abfdea
(rmail-sort-messages): In summary buf, go to rmail buf.
Richard M. Stallman <rms@gnu.org>
parents:
3878
diff
changeset
|
191 (lambda (a b) |
484e65abfdea
(rmail-sort-messages): In summary buf, go to rmail buf.
Richard M. Stallman <rms@gnu.org>
parents:
3878
diff
changeset
|
192 (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
|
193 (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
|
194 ;; 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
|
195 (message "Reordering messages...") |
484e65abfdea
(rmail-sort-messages): In summary buf, go to rmail buf.
Richard M. Stallman <rms@gnu.org>
parents:
3878
diff
changeset
|
196 (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
|
197 (current-message nil) |
484e65abfdea
(rmail-sort-messages): In summary buf, go to rmail buf.
Richard M. Stallman <rms@gnu.org>
parents:
3878
diff
changeset
|
198 (msgnum 1) |
484e65abfdea
(rmail-sort-messages): In summary buf, go to rmail buf.
Richard M. Stallman <rms@gnu.org>
parents:
3878
diff
changeset
|
199 (msginfo nil)) |
484e65abfdea
(rmail-sort-messages): In summary buf, go to rmail buf.
Richard M. Stallman <rms@gnu.org>
parents:
3878
diff
changeset
|
200 ;; 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
|
201 (buffer-disable-undo (current-buffer)) |
88135
3c2c324caf38
(rmail-sort-by-lines, rmail-fetch-field): Use the rmail message
Paul Reilly <pmr@pajato.com>
parents:
88129
diff
changeset
|
202 (goto-char (rmail-desc-get-start 1)) |
5159
484e65abfdea
(rmail-sort-messages): In summary buf, go to rmail buf.
Richard M. Stallman <rms@gnu.org>
parents:
3878
diff
changeset
|
203 ;; 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
|
204 (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
|
205 (backward-char 1) |
484e65abfdea
(rmail-sort-messages): In summary buf, go to rmail buf.
Richard M. Stallman <rms@gnu.org>
parents:
3878
diff
changeset
|
206 ;; Now reorder messages. |
484e65abfdea
(rmail-sort-messages): In summary buf, go to rmail buf.
Richard M. Stallman <rms@gnu.org>
parents:
3878
diff
changeset
|
207 (while sort-lists |
484e65abfdea
(rmail-sort-messages): In summary buf, go to rmail buf.
Richard M. Stallman <rms@gnu.org>
parents:
3878
diff
changeset
|
208 (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
|
209 ;; Swap two messages. |
484e65abfdea
(rmail-sort-messages): In summary buf, go to rmail buf.
Richard M. Stallman <rms@gnu.org>
parents:
3878
diff
changeset
|
210 (insert-buffer-substring |
484e65abfdea
(rmail-sort-messages): In summary buf, go to rmail buf.
Richard M. Stallman <rms@gnu.org>
parents:
3878
diff
changeset
|
211 (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
|
212 (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
|
213 ;; Is current message? |
484e65abfdea
(rmail-sort-messages): In summary buf, go to rmail buf.
Richard M. Stallman <rms@gnu.org>
parents:
3878
diff
changeset
|
214 (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
|
215 (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
|
216 (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
|
217 (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
|
218 (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
|
219 (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
|
220 ;; 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
|
221 (delete-char 1) |
484e65abfdea
(rmail-sort-messages): In summary buf, go to rmail buf.
Richard M. Stallman <rms@gnu.org>
parents:
3878
diff
changeset
|
222 (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
|
223 (buffer-enable-undo) |
88135
3c2c324caf38
(rmail-sort-by-lines, rmail-fetch-field): Use the rmail message
Paul Reilly <pmr@pajato.com>
parents:
88129
diff
changeset
|
224 (goto-char (point-min)) |
3c2c324caf38
(rmail-sort-by-lines, rmail-fetch-field): Use the rmail message
Paul Reilly <pmr@pajato.com>
parents:
88129
diff
changeset
|
225 (rmail-initialize-messages) |
6583
363f38b4648a
(rmail-sort-messages): Update summary buffer.
Karl Heuer <kwzh@gnu.org>
parents:
6490
diff
changeset
|
226 (rmail-show-message current-message) |
363f38b4648a
(rmail-sort-messages): Update summary buffer.
Karl Heuer <kwzh@gnu.org>
parents:
6490
diff
changeset
|
227 (if (rmail-summary-exists) |
363f38b4648a
(rmail-sort-messages): Update summary buffer.
Karl Heuer <kwzh@gnu.org>
parents:
6490
diff
changeset
|
228 (rmail-select-summary |
363f38b4648a
(rmail-sort-messages): Update summary buffer.
Karl Heuer <kwzh@gnu.org>
parents:
6490
diff
changeset
|
229 (rmail-update-summary))))))) |
3133
2c1553d7aad1
New version from Umeda. Needs detailed entry.
Richard M. Stallman <rms@gnu.org>
parents:
2851
diff
changeset
|
230 |
88135
3c2c324caf38
(rmail-sort-by-lines, rmail-fetch-field): Use the rmail message
Paul Reilly <pmr@pajato.com>
parents:
88129
diff
changeset
|
231 ;; mbox: ready |
90 | 232 (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
|
233 "Return the value of the header FIELD of MSG. |
90 | 234 Arguments are MSG and FIELD." |
3133
2c1553d7aad1
New version from Umeda. Needs detailed entry.
Richard M. Stallman <rms@gnu.org>
parents:
2851
diff
changeset
|
235 (save-restriction |
2c1553d7aad1
New version from Umeda. Needs detailed entry.
Richard M. Stallman <rms@gnu.org>
parents:
2851
diff
changeset
|
236 (widen) |
88135
3c2c324caf38
(rmail-sort-by-lines, rmail-fetch-field): Use the rmail message
Paul Reilly <pmr@pajato.com>
parents:
88129
diff
changeset
|
237 (narrow-to-region |
3c2c324caf38
(rmail-sort-by-lines, rmail-fetch-field): Use the rmail message
Paul Reilly <pmr@pajato.com>
parents:
88129
diff
changeset
|
238 (rmail-desc-get-start msg) |
3c2c324caf38
(rmail-sort-by-lines, rmail-fetch-field): Use the rmail message
Paul Reilly <pmr@pajato.com>
parents:
88129
diff
changeset
|
239 (rmail-desc-get-end msg)) |
3c2c324caf38
(rmail-sort-by-lines, rmail-fetch-field): Use the rmail message
Paul Reilly <pmr@pajato.com>
parents:
88129
diff
changeset
|
240 (rmail-header-get-header field))) |
90 | 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 | 246 |
658
7cbd4fcd8b0f
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
584
diff
changeset
|
247 ;;; rmailsort.el ends here |