Mercurial > emacs

comparison lisp/mail/rmailsort.el @ 148:a099f0c77321

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
*** empty log message ***
author Richard M. Stallman <rms@gnu.org>
date Thu, 27 Dec 1990 20:45:59 +0000
parents d4c523560fe8
children 00792257e669
comparison
equal deleted inserted replaced
147:0f50f1badd75 148:a099f0c77321
27 (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-d" 'rmail-sort-by-date)
28 (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-s" 'rmail-sort-by-subject)
29 (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-a" 'rmail-sort-by-author)
30 (define-key rmail-mode-map "\C-c\C-s\C-r" 'rmail-sort-by-recipient) 30 (define-key rmail-mode-map "\C-c\C-s\C-r" 'rmail-sort-by-recipient)
31 (define-key rmail-mode-map "\C-c\C-s\C-c" 'rmail-sort-by-correspondent) 31 (define-key rmail-mode-map "\C-c\C-s\C-c" 'rmail-sort-by-correspondent)
32 (define-key rmail-mode-map "\C-c\C-s\C-l" 'rmail-sort-by-size-lines)
32 33
33 (defun rmail-sort-by-date (reverse) 34 (defun rmail-sort-by-date (reverse)
34 "Sort messages of current Rmail file by date. 35 "Sort messages of current Rmail file by date.
35 If prefix argument REVERSE is non-nil, sort them in reverse order." 36 If prefix argument REVERSE is non-nil, sort them in reverse order."
36 (interactive "P") 37 (interactive "P")
94 (rmail-dont-reply-to 95 (rmail-dont-reply-to
95 (mail-strip-quoted-names 96 (mail-strip-quoted-names
96 (or (rmail-fetch-field msg (car fields)) "")))) 97 (or (rmail-fetch-field msg (car fields)) ""))))
97 (setq fields (cdr fields))) 98 (setq fields (cdr fields)))
98 ans)) 99 ans))
100
101 (defun rmail-sort-by-size-lines (reverse)
102 "Sort messages of current Rmail file by message size.
103 If prefix argument REVERSE is non-nil, sort them in reverse order."
104 (interactive "P")
105 (rmail-sort-messages reverse
106 (function
107 (lambda (msg)
108 (format "%9d"
109 (count-lines (rmail-msgbeg msgnum)
110 (rmail-msgend msgnum)))))))
99 111
100 112
101 (defun rmail-sort-messages (reverse keyfunc) 113 (defun rmail-sort-messages (reverse keyfunc)
102 "Sort messages of current Rmail file. 114 "Sort messages of current Rmail file.
103 1st argument REVERSE is non-nil, sort them in reverse order. 115 1st argument REVERSE is non-nil, sort them in reverse order.
111 (setq sort-lists 123 (setq sort-lists
112 (cons (cons (funcall keyfunc msgnum) ;A sort key. 124 (cons (cons (funcall keyfunc msgnum) ;A sort key.
113 (buffer-substring 125 (buffer-substring
114 (rmail-msgbeg msgnum) (rmail-msgend msgnum))) 126 (rmail-msgbeg msgnum) (rmail-msgend msgnum)))
115 sort-lists)) 127 sort-lists))
128 (if (zerop (% msgnum 10))
129 (message "Finding sort keys...%d" msgnum))
116 (setq msgnum (1+ msgnum)))) 130 (setq msgnum (1+ msgnum))))
117 (or reverse (setq sort-lists (nreverse sort-lists))) 131 (or reverse (setq sort-lists (nreverse sort-lists)))
118 (setq sort-lists 132 (setq sort-lists
119 (sort sort-lists 133 (sort sort-lists
120 (function 134 (function
121 (lambda (a b) 135 (lambda (a b)
122 (string-lessp (car a) (car b)))))) 136 (string-lessp (car a) (car b))))))
123 (if reverse (setq sort-lists (nreverse sort-lists))) 137 (if reverse (setq sort-lists (nreverse sort-lists)))
124 (message "Reordering buffer...") 138 (message "Reordering buffer...")
125 (delete-region (rmail-msgbeg 1) (rmail-msgend rmail-total-messages)) 139 (delete-region (rmail-msgbeg 1) (rmail-msgend rmail-total-messages))
126 (while sort-lists 140 (let ((msgnum 1))
127 (insert (cdr (car sort-lists))) 141 (while sort-lists
128 (setq sort-lists (cdr sort-lists))) 142 (insert (cdr (car sort-lists)))
143 (if (zerop (% msgnum 10))
144 (message "Reordering buffer...%d" msgnum))
145 (setq sort-lists (cdr sort-lists))
146 (setq msgnum (1+ msgnum))))
129 (rmail-set-message-counters) 147 (rmail-set-message-counters)
130 (rmail-show-message) 148 (rmail-show-message)))
131 ))
132 149
133 (defun rmail-fetch-field (msg field) 150 (defun rmail-fetch-field (msg field)
134 "Return the value of the header field FIELD of MSG. 151 "Return the value of the header field FIELD of MSG.
135 Arguments are MSG and FIELD." 152 Arguments are MSG and FIELD."
136 (let ((next (rmail-msgend msg))) 153 (let ((next (rmail-msgend msg)))
170 (substring date 187 (substring date
171 (match-beginning 1) (match-end 1)))) 188 (match-beginning 1) (match-end 1))))
172 ;; Time 189 ;; Time
173 (substring date (match-beginning 4) (match-end 4))) 190 (substring date (match-beginning 4) (match-end 4)))
174 ;; Cannot understand DATE string. 191 ;; Cannot understand DATE string.
175 date 192 date)))
176 )
177 ))
178 193
179 (defun rmail-date-full-year (year-string) 194 (defun rmail-date-full-year (year-string)
180 (if (<= (length year-string) 2) 195 (if (<= (length year-string) 2)
181 (concat "19" year-string) 196 (concat "19" year-string)
182 year-string)) 197 year-string))