comparison lisp/mail/rmailsort.el @ 131:d4c523560fe8

*** empty log message ***
author Richard M. Stallman <rms@gnu.org>
date Mon, 03 Dec 1990 22:48:04 +0000
parents 2b8bcdcca3a1
children a099f0c77321
comparison
equal deleted inserted replaced
130:ad8219ab7a97 131:d4c523560fe8
26 ;; GNUS compatible key bindings. 26 ;; GNUS compatible key bindings.
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 32
32 (defun rmail-sort-by-date (reverse) 33 (defun rmail-sort-by-date (reverse)
33 "Sort messages of current Rmail file by date. 34 "Sort messages of current Rmail file by date.
34 If prefix argument REVERSE is non-nil, sort them in reverse order." 35 If prefix argument REVERSE is non-nil, sort them in reverse order."
35 (interactive "P") 36 (interactive "P")
73 (mail-strip-quoted-names 74 (mail-strip-quoted-names
74 (or (rmail-fetch-field msg "To") 75 (or (rmail-fetch-field msg "To")
75 (rmail-fetch-field msg "Apparently-To") "") 76 (rmail-fetch-field msg "Apparently-To") "")
76 ))))) 77 )))))
77 78
79 (defun rmail-sort-by-correspondent (reverse)
80 "Sort messages of current Rmail file by other correspondent.
81 If prefix argument REVERSE is non-nil, sort them in reverse order."
82 (interactive "P")
83 (rmail-sort-messages reverse
84 (function
85 (lambda (msg)
86 (rmail-select-correspondent
87 msg
88 '("From" "Sender" "To" "Apparently-To"))))))
89
90 (defun rmail-select-correspondent (msg fields)
91 (let ((ans ""))
92 (while (and fields (string= ans ""))
93 (setq ans
94 (rmail-dont-reply-to
95 (mail-strip-quoted-names
96 (or (rmail-fetch-field msg (car fields)) ""))))
97 (setq fields (cdr fields)))
98 ans))
78 99
79 100
80 (defun rmail-sort-messages (reverse keyfunc) 101 (defun rmail-sort-messages (reverse keyfunc)
81 "Sort messages of current Rmail file. 102 "Sort messages of current Rmail file.
82 1st argument REVERSE is non-nil, sort them in reverse order. 103 1st argument REVERSE is non-nil, sort them in reverse order.
135 ;; (1) 14 Apr 89 03:20:12 GMT 156 ;; (1) 14 Apr 89 03:20:12 GMT
136 ;; (2) Fri, 17 Mar 89 4:01:33 GMT 157 ;; (2) Fri, 17 Mar 89 4:01:33 GMT
137 (if (string-match 158 (if (string-match
138 "\\([0-9]+\\) +\\([^ ,]+\\) +\\([0-9]+\\) +\\([0-9:]+\\)" date) 159 "\\([0-9]+\\) +\\([^ ,]+\\) +\\([0-9]+\\) +\\([0-9:]+\\)" date)
139 (concat 160 (concat
140 ;; Year (discarding century) 161 ;; Year
141 (substring (substring date (match-beginning 3) (match-end 3)) -2) 162 (rmail-date-full-year
163 (substring date (match-beginning 3) (match-end 3)))
142 ;; Month 164 ;; Month
143 (cdr 165 (cdr
144 (assoc 166 (assoc
145 (upcase (substring date (match-beginning 2) (match-end 2))) month)) 167 (upcase (substring date (match-beginning 2) (match-end 2))) month))
146 ;; Day 168 ;; Day
151 (substring date (match-beginning 4) (match-end 4))) 173 (substring date (match-beginning 4) (match-end 4)))
152 ;; Cannot understand DATE string. 174 ;; Cannot understand DATE string.
153 date 175 date
154 ) 176 )
155 )) 177 ))
178
179 (defun rmail-date-full-year (year-string)
180 (if (<= (length year-string) 2)
181 (concat "19" year-string)
182 year-string))