Mercurial > emacs
comparison lisp/mail/rmailsort.el @ 90:92266e9b90bb
Initial revision
author | Richard M. Stallman <rms@gnu.org> |
---|---|
date | Mon, 10 Sep 1990 02:16:19 +0000 |
parents | |
children | 2b8bcdcca3a1 |
comparison
equal
deleted
inserted
replaced
89:a2753c39509b | 90:92266e9b90bb |
---|---|
1 ;;; Rmail: sort messages. | |
2 ;; Copyright (C) 1990 Masanobu UMEDA | |
3 | |
4 ;; This file is part of GNU Emacs. | |
5 | |
6 ;; GNU Emacs is distributed in the hope that it will be useful, | |
7 ;; but WITHOUT ANY WARRANTY. No author or distributor | |
8 ;; accepts responsibility to anyone for the consequences of using it | |
9 ;; or for whether it serves any particular purpose or works at all, | |
10 ;; unless he says so in writing. Refer to the GNU Emacs General Public | |
11 ;; License for full details. | |
12 | |
13 ;; Everyone is granted permission to copy, modify and redistribute | |
14 ;; GNU Emacs, but only under the conditions described in the | |
15 ;; GNU Emacs General Public License. A copy of this license is | |
16 ;; supposed to have been given to you along with GNU Emacs so you | |
17 ;; can know your rights and responsibilities. It should be in a | |
18 ;; file named COPYING. Among other things, the copyright notice | |
19 ;; and this notice must be preserved on all copies. | |
20 | |
21 (provide 'rmailsort) | |
22 (require 'rmail) | |
23 (require 'sort) | |
24 | |
25 ;; GNUS compatible key bindings. | |
26 (define-key rmail-mode-map "\C-c\C-s\C-d" 'rmail-sort-by-date) | |
27 (define-key rmail-mode-map "\C-c\C-s\C-s" 'rmail-sort-by-subject) | |
28 (define-key rmail-mode-map "\C-c\C-s\C-a" 'rmail-sort-by-author) | |
29 (define-key rmail-mode-map "\C-c\C-s\C-r" 'rmail-sort-by-recipient) | |
30 | |
31 (defun rmail-sort-by-date (reverse) | |
32 "Sort messages of current Rmail file by date. | |
33 If prefix argument REVERSE is non-nil, sort them in reverse order." | |
34 (interactive "P") | |
35 (rmail-sort-messages reverse | |
36 (function | |
37 (lambda (msg) | |
38 (rmail-sortable-date-string | |
39 (rmail-fetch-field msg "Date")))))) | |
40 | |
41 (defun rmail-sort-by-subject (reverse) | |
42 "Sort messages of current Rmail file by subject. | |
43 If prefix argument REVERSE is non-nil, sort them in reverse order." | |
44 (interactive "P") | |
45 (rmail-sort-messages reverse | |
46 (function | |
47 (lambda (msg) | |
48 (let ((key (or (rmail-fetch-field msg "Subject") "")) | |
49 (case-fold-search t)) | |
50 ;; Remove `Re:' | |
51 (if (string-match "^\\(re:[ \t]+\\)*" key) | |
52 (substring key (match-end 0)) key)))))) | |
53 | |
54 (defun rmail-sort-by-author (reverse) | |
55 "Sort messages of current Rmail file by author. | |
56 If prefix argument REVERSE is non-nil, sort them in reverse order." | |
57 (interactive "P") | |
58 (rmail-sort-messages reverse | |
59 (function | |
60 (lambda (msg) | |
61 (mail-strip-quoted-names | |
62 (or (rmail-fetch-field msg "From") | |
63 (rmail-fetch-field msg "Sender") "")))))) | |
64 | |
65 (defun rmail-sort-by-recipient (reverse) | |
66 "Sort messages of current Rmail file by recipient. | |
67 If prefix argument REVERSE is non-nil, sort them in reverse order." | |
68 (interactive "P") | |
69 (rmail-sort-messages reverse | |
70 (function | |
71 (lambda (msg) | |
72 (mail-strip-quoted-names | |
73 (or (rmail-fetch-field msg "To") | |
74 (rmail-fetch-field msg "Apparently-To") "") | |
75 ))))) | |
76 | |
77 | |
78 | |
79 (defun rmail-sort-messages (reverse keyfunc) | |
80 "Sort messages of current Rmail file. | |
81 1st argument REVERSE is non-nil, sort them in reverse order. | |
82 2nd argument KEYFUNC is called with message number, and should return a key." | |
83 (let ((buffer-read-only nil) | |
84 (sort-lists nil)) | |
85 (message "Finding sort keys...") | |
86 (widen) | |
87 (let ((msgnum 1)) | |
88 (while (>= rmail-total-messages msgnum) | |
89 (setq sort-lists | |
90 (cons (cons (funcall keyfunc msgnum) ;A sort key. | |
91 (buffer-substring | |
92 (rmail-msgbeg msgnum) (rmail-msgend msgnum))) | |
93 sort-lists)) | |
94 (setq msgnum (1+ msgnum)))) | |
95 (or reverse (setq sort-lists (nreverse sort-lists))) | |
96 (setq sort-lists | |
97 (sort sort-lists | |
98 (function | |
99 (lambda (a b) | |
100 (string-lessp (car a) (car b)))))) | |
101 (if reverse (setq sort-lists (nreverse sort-lists))) | |
102 (message "Reordering buffer...") | |
103 (delete-region (rmail-msgbeg 1) (rmail-msgend rmail-total-messages)) | |
104 (while sort-lists | |
105 (insert (cdr (car sort-lists))) | |
106 (setq sort-lists (cdr sort-lists))) | |
107 (rmail-set-message-counters) | |
108 (rmail-show-message) | |
109 )) | |
110 | |
111 (defun rmail-fetch-field (msg field) | |
112 "Return the value of the header field FIELD of MSG. | |
113 Arguments are MSG and FIELD." | |
114 (let ((next (rmail-msgend msg))) | |
115 (save-restriction | |
116 (goto-char (rmail-msgbeg msg)) | |
117 (narrow-to-region (if (search-forward "\n*** EOOH ***\n" next t) | |
118 (point) | |
119 (forward-line 1) | |
120 (point)) | |
121 (progn (search-forward "\n\n" nil t) (point))) | |
122 (mail-fetch-field field)))) | |
123 | |
124 ;; Copy of the function gnus-comparable-date in gnus.el | |
125 | |
126 (defun rmail-sortable-date-string (date) | |
127 "Make sortable string by string-lessp from DATE." | |
128 (let ((month '(("JAN" . " 1")("FEB" . " 2")("MAR" . " 3") | |
129 ("APR" . " 4")("MAY" . " 5")("JUN" . " 6") | |
130 ("JUL" . " 7")("AUG" . " 8")("SEP" . " 9") | |
131 ("OCT" . "10")("NOV" . "11")("DEC" . "12"))) | |
132 (date (or date ""))) | |
133 ;; Can understand the following styles: | |
134 ;; (1) 14 Apr 89 03:20:12 GMT | |
135 ;; (2) Fri, 17 Mar 89 4:01:33 GMT | |
136 (if (string-match | |
137 "\\([0-9]+\\) \\([^ ,]+\\) \\([0-9]+\\) \\([0-9:]+\\)" date) | |
138 (concat | |
139 ;; Year | |
140 (substring date (match-beginning 3) (match-end 3)) | |
141 ;; Month | |
142 (cdr | |
143 (assoc | |
144 (upcase (substring date (match-beginning 2) (match-end 2))) month)) | |
145 ;; Day | |
146 (format "%2d" (string-to-int | |
147 (substring date | |
148 (match-beginning 1) (match-end 1)))) | |
149 ;; Time | |
150 (substring date (match-beginning 4) (match-end 4))) | |
151 ;; Cannot understand DATE string. | |
152 date | |
153 ) | |
154 )) |