|
0
|
1 ;;; Sorting and moving messages inside VM
|
|
|
2 ;;; Copyright (C) 1993, 1994 Kyle E. Jones
|
|
|
3 ;;;
|
|
|
4 ;;; This program is free software; you can redistribute it and/or modify
|
|
|
5 ;;; it under the terms of the GNU General Public License as published by
|
|
|
6 ;;; the Free Software Foundation; either version 1, or (at your option)
|
|
|
7 ;;; any later version.
|
|
|
8 ;;;
|
|
|
9 ;;; This program is distributed in the hope that it will be useful,
|
|
|
10 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
|
11 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
|
12 ;;; GNU General Public License for more details.
|
|
|
13 ;;;
|
|
|
14 ;;; You should have received a copy of the GNU General Public License
|
|
|
15 ;;; along with this program; if not, write to the Free Software
|
|
|
16 ;;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
|
|
|
17
|
|
|
18 (provide 'vm-sort)
|
|
|
19
|
|
|
20 (defun vm-move-message-forward (count)
|
|
|
21 "Move a message forward in a VM folder.
|
|
|
22 Prefix arg COUNT causes the current message to be moved COUNT messages forward.
|
|
|
23 A negative COUNT causes movement to be backward instead of forward.
|
|
|
24 COUNT defaults to 1. The current message remains selected after being
|
|
|
25 moved.
|
|
|
26
|
|
|
27 If vm-move-messages-physically is non-nil, the physical copy of
|
|
|
28 the message in the folder is moved. A nil value means just
|
|
|
29 change the presentation order and leave the physical order of
|
|
|
30 the folder undisturbed."
|
|
|
31 (interactive "p")
|
|
|
32 (vm-follow-summary-cursor)
|
|
|
33 (vm-select-folder-buffer)
|
|
|
34 (vm-check-for-killed-summary)
|
|
|
35 (vm-error-if-folder-empty)
|
|
|
36 (if vm-move-messages-physically
|
|
|
37 (vm-error-if-folder-read-only))
|
|
|
38 (vm-display nil nil '(vm-move-message-forward
|
|
|
39 vm-move-message-backward
|
|
|
40 vm-move-message-forward-physically
|
|
|
41 vm-move-message-backward-physically)
|
|
|
42 (list this-command))
|
|
|
43 (let* ((ovmp vm-message-pointer) vmp-prev ovmp-prev
|
|
|
44 (vm-message-pointer vm-message-pointer)
|
|
|
45 (direction (if (> count 0) 'forward 'backward))
|
|
|
46 (count (vm-abs count)))
|
|
|
47 (while (not (zerop count))
|
|
|
48 (vm-move-message-pointer direction)
|
|
|
49 (vm-decrement count))
|
|
|
50 (if (> (string-to-int (vm-number-of (car vm-message-pointer)))
|
|
|
51 (string-to-int (vm-number-of (car ovmp))))
|
|
|
52 (setq vm-message-pointer (cdr vm-message-pointer)))
|
|
|
53 (if (eq vm-message-pointer ovmp)
|
|
|
54 ()
|
|
|
55 (if (null vm-message-pointer)
|
|
|
56 (setq vmp-prev (vm-last vm-message-list))
|
|
|
57 (setq vmp-prev (vm-reverse-link-of (car vm-message-pointer))))
|
|
|
58 (setq ovmp-prev (vm-reverse-link-of (car ovmp)))
|
|
|
59 ;; lock out interrupts to preserve message list integrity.
|
|
|
60 (let ((inhibit-quit t))
|
|
|
61 (if ovmp-prev
|
|
|
62 (progn
|
|
|
63 (setcdr ovmp-prev (cdr ovmp))
|
|
|
64 (and (cdr ovmp)
|
|
|
65 (vm-set-reverse-link-of (car (cdr ovmp)) ovmp-prev)))
|
|
|
66 (setq vm-message-list (cdr ovmp))
|
|
|
67 (vm-set-reverse-link-of (car vm-message-list) nil))
|
|
|
68 (if vmp-prev
|
|
|
69 (progn
|
|
|
70 (setcdr vmp-prev ovmp)
|
|
|
71 (vm-set-reverse-link-of (car ovmp) vmp-prev))
|
|
|
72 (setq vm-message-list ovmp)
|
|
|
73 (vm-set-reverse-link-of (car vm-message-list) nil))
|
|
|
74 (setcdr ovmp vm-message-pointer)
|
|
|
75 (and vm-message-pointer
|
|
|
76 (vm-set-reverse-link-of (car vm-message-pointer) ovmp))
|
|
|
77 (if (and vm-move-messages-physically
|
|
|
78 (not (eq major-mode 'vm-virtual-mode)))
|
|
|
79 (vm-physically-move-message (car ovmp) (car vm-message-pointer)))
|
|
|
80 (setq vm-ml-sort-keys nil)
|
|
|
81 (if (not vm-folder-read-only)
|
|
|
82 (progn
|
|
|
83 (setq vm-message-order-changed t)
|
|
|
84 (vm-set-buffer-modified-p t)
|
|
|
85 (vm-clear-modification-flag-undos))))
|
|
|
86 (cond ((null ovmp-prev)
|
|
|
87 (setq vm-numbering-redo-start-point vm-message-list
|
|
|
88 vm-numbering-redo-end-point vm-message-pointer
|
|
|
89 vm-summary-pointer (car vm-message-list)))
|
|
|
90 ((null vmp-prev)
|
|
|
91 (setq vm-numbering-redo-start-point vm-message-list
|
|
|
92 vm-numbering-redo-end-point (cdr ovmp-prev)
|
|
|
93 vm-summary-pointer (car ovmp-prev)))
|
|
|
94 ((or (not vm-message-pointer)
|
|
|
95 (< (string-to-int (vm-number-of (car ovmp-prev)))
|
|
|
96 (string-to-int (vm-number-of (car vm-message-pointer)))))
|
|
|
97 (setq vm-numbering-redo-start-point (cdr ovmp-prev)
|
|
|
98 vm-numbering-redo-end-point (cdr ovmp)
|
|
|
99 vm-summary-pointer (car (cdr ovmp-prev))))
|
|
|
100 (t
|
|
|
101 (setq vm-numbering-redo-start-point ovmp
|
|
|
102 vm-numbering-redo-end-point (cdr ovmp-prev)
|
|
|
103 vm-summary-pointer (car ovmp-prev))))
|
|
|
104 (if vm-summary-buffer
|
|
|
105 (let (list mp)
|
|
|
106 (vm-copy-local-variables vm-summary-buffer 'vm-summary-pointer)
|
|
|
107 (setq vm-need-summary-pointer-update t)
|
|
|
108 (setq mp vm-numbering-redo-start-point)
|
|
|
109 (while (not (eq mp vm-numbering-redo-end-point))
|
|
|
110 (vm-mark-for-summary-update (car mp))
|
|
|
111 (setq list (cons (car mp) list)
|
|
|
112 mp (cdr mp)))
|
|
|
113 (vm-mapc
|
|
|
114 (function
|
|
|
115 (lambda (m p)
|
|
|
116 (vm-set-su-start-of m (car p))
|
|
|
117 (vm-set-su-end-of m (car (cdr p)))))
|
|
|
118 (setq list (nreverse list))
|
|
|
119 (sort
|
|
|
120 (mapcar
|
|
|
121 (function
|
|
|
122 (lambda (p)
|
|
|
123 (list (vm-su-start-of p) (vm-su-end-of p))))
|
|
|
124 list)
|
|
|
125 (function
|
|
|
126 (lambda (p q)
|
|
|
127 (< (car p) (car q))))))))))
|
|
|
128 (if vm-move-messages-physically
|
|
|
129 ;; clip region is messed up
|
|
|
130 (vm-preview-current-message)
|
|
|
131 (vm-update-summary-and-mode-line)))
|
|
|
132
|
|
|
133 (defun vm-move-message-backward (count)
|
|
|
134 "Move a message backward in a VM folder.
|
|
|
135 Prefix arg COUNT causes the current message to be moved COUNT
|
|
|
136 messages backward. A negative COUNT causes movement to be
|
|
|
137 forward instead of backward. COUNT defaults to 1. The current
|
|
|
138 message remains selected after being moved.
|
|
|
139
|
|
|
140 If vm-move-messages-physically is non-nil, the physical copy of
|
|
|
141 the message in the folder is moved. A nil value means just
|
|
|
142 change the presentation order and leave the physical order of
|
|
|
143 the folder undisturbed."
|
|
|
144 (interactive "p")
|
|
|
145 (vm-move-message-forward (- count)))
|
|
|
146
|
|
|
147 (defun vm-move-message-forward-physically (count)
|
|
|
148 "Like vm-move-message-forward but always move the message physically."
|
|
|
149 (interactive "p")
|
|
|
150 (let ((vm-move-messages-physically t))
|
|
|
151 (vm-move-message-forward count)))
|
|
|
152
|
|
|
153 (defun vm-move-message-backward-physically (count)
|
|
|
154 "Like vm-move-message-backward but always move the message physically."
|
|
|
155 (interactive "p")
|
|
|
156 (let ((vm-move-messages-physically t))
|
|
|
157 (vm-move-message-backward count)))
|
|
|
158
|
|
|
159 ;; move message m to be before m-dest
|
|
|
160 ;; and fix up the location markers afterwards.
|
|
|
161 ;; m better not equal m-dest.
|
|
|
162 ;; of m-dest is nil, move m to the end of buffer.
|
|
|
163 ;;
|
|
|
164 ;; consider carefully the effects of insertion on markers
|
|
|
165 ;; and variables containg markers before you modify this code.
|
|
|
166 (defun vm-physically-move-message (m m-dest)
|
|
|
167 (save-excursion
|
|
|
168 (vm-save-restriction
|
|
|
169 (widen)
|
|
|
170
|
|
|
171 ;; Make sure vm-headers-of and vm-text-of are non-nil in
|
|
|
172 ;; their slots before we try to move them. (Simply
|
|
|
173 ;; referencing the slot with their slot function is
|
|
|
174 ;; sufficient to guarantee this.) Otherwise, they be
|
|
|
175 ;; initialized in the middle of the message move and get the
|
|
|
176 ;; offset applied to them twice by way of a relative offset
|
|
|
177 ;; from one of the other location markers that has already
|
|
|
178 ;; been moved.
|
|
|
179 ;;
|
|
|
180 ;; Also, and more importantly, vm-vheaders-of might run
|
|
|
181 ;; vm-reorder-message-headers, which can add text to
|
|
|
182 ;; message. This MUST NOT happen after offsets have been
|
|
|
183 ;; computed for the message move or varying levels of chaos
|
|
|
184 ;; will ensue. In the case of BABYL files, where
|
|
|
185 ;; vm-reorder-message-headers can add a lot of new text,
|
|
|
186 ;; folder curroption can be massive.
|
|
|
187 (vm-text-of m)
|
|
|
188 (vm-vheaders-of m)
|
|
|
189
|
|
|
190 (let ((dest-start (if m-dest (vm-start-of m-dest) (point-max)))
|
|
|
191 (buffer-read-only nil)
|
|
|
192 offset doomed-start doomed-end)
|
|
|
193 (goto-char dest-start)
|
|
|
194 (insert-buffer-substring (current-buffer) (vm-start-of m) (vm-end-of m))
|
|
|
195 (setq doomed-start (marker-position (vm-start-of m))
|
|
|
196 doomed-end (marker-position (vm-end-of m))
|
|
|
197 offset (- (vm-start-of m) dest-start))
|
|
|
198 (set-marker (vm-start-of m) (- (vm-start-of m) offset))
|
|
|
199 (set-marker (vm-headers-of m) (- (vm-headers-of m) offset))
|
|
|
200 (set-marker (vm-text-end-of m) (- (vm-text-end-of m) offset))
|
|
|
201 (set-marker (vm-end-of m) (- (vm-end-of m) offset))
|
|
|
202 (set-marker (vm-text-of m) (- (vm-text-of m) offset))
|
|
|
203 (set-marker (vm-vheaders-of m) (- (vm-vheaders-of m) offset))
|
|
|
204 ;; now fix the start of m-dest since it didn't
|
|
|
205 ;; move forward with its message.
|
|
|
206 (and m-dest (set-marker (vm-start-of m-dest) (vm-end-of m)))
|
|
|
207 ;; delete the old copy of the message
|
|
|
208 (delete-region doomed-start doomed-end)))))
|
|
|
209
|
|
|
210 (defun vm-so-sortable-datestring (m)
|
|
|
211 (or (vm-sortable-datestring-of m)
|
|
|
212 (progn
|
|
|
213 (vm-set-sortable-datestring-of
|
|
|
214 m
|
|
118
|
215 (condition-case nil
|
|
|
216 (timezone-make-date-sortable
|
|
|
217 (or (vm-get-header-contents m "Date:")
|
|
|
218 (vm-grok-From_-date m)
|
|
|
219 "Thu, 1 Jan 1970 00:00:00 GMT")
|
|
|
220 "GMT" "GMT")
|
|
|
221 (error "1970010100:00:00")))
|
|
0
|
222 (vm-sortable-datestring-of m))))
|
|
|
223
|
|
|
224 (defun vm-so-sortable-subject (m)
|
|
|
225 (or (vm-sortable-subject-of m)
|
|
|
226 (progn
|
|
|
227 (vm-set-sortable-subject-of
|
|
|
228 m
|
|
|
229 (let ((case-fold-search t)
|
|
|
230 (subject (vm-su-subject m)))
|
|
|
231 (if (and vm-subject-ignored-prefix
|
|
|
232 (string-match vm-subject-ignored-prefix subject)
|
|
|
233 (zerop (match-beginning 0)))
|
|
|
234 (setq subject (substring subject (match-end 0))))
|
|
|
235 (if (and vm-subject-ignored-suffix
|
|
|
236 (string-match vm-subject-ignored-suffix subject)
|
|
|
237 (= (match-end 0) (length subject)))
|
|
|
238 (setq subject (substring subject 0 (match-beginning 0))))
|
|
|
239 subject ))
|
|
|
240 (vm-sortable-subject-of m))))
|
|
|
241
|
|
|
242 (defun vm-sort-messages (keys &optional lets-get-physical)
|
|
|
243 "Sort message in a folder by the specified KEYS.
|
|
|
244 You may sort by more than one particular message key. If
|
|
|
245 messages compare equal by the first key, the second key will be
|
|
|
246 compared and so on. When called interactively the keys will be
|
|
|
247 read from the minibuffer. Valid keys are
|
|
|
248
|
|
|
249 \"date\" \"reversed-date\"
|
|
|
250 \"author\" \"reversed-author\"
|
|
|
251 \"subject\" \"reversed-subject\"
|
|
|
252 \"recipients\" \"reversed-recipients\"
|
|
|
253 \"line-count\" \"reversed-line-count\"
|
|
|
254 \"byte-count\" \"reversed-byte-count\"
|
|
|
255 \"physical-order\" \"reversed-physical-order\"
|
|
|
256
|
|
|
257 Optional second arg (prefix arg interactively) means the sort
|
|
|
258 should change the physical order of the messages in the folder.
|
|
|
259 Normally VM changes presentation order only, leaving the
|
|
|
260 folder in the order in which the messages arrived."
|
|
|
261 (interactive
|
|
|
262 (let ((last-command last-command)
|
|
|
263 (this-command this-command))
|
|
|
264 (list (vm-read-string (if (or current-prefix-arg
|
|
|
265 vm-move-messages-physically)
|
|
|
266 "Physically sort messages by: "
|
|
|
267 "Sort messages by: ")
|
|
|
268 vm-supported-sort-keys t)
|
|
|
269 current-prefix-arg)))
|
|
|
270 (vm-select-folder-buffer)
|
|
|
271 (vm-check-for-killed-summary)
|
|
|
272 ;; only squawk if interactive. The thread display uses this
|
|
|
273 ;; function and doesn't expect errors.
|
|
|
274 (if (interactive-p)
|
|
|
275 (vm-error-if-folder-empty))
|
|
|
276 ;; ditto
|
|
|
277 (if (and (interactive-p) (or vm-move-messages-physically lets-get-physical))
|
|
|
278 (vm-error-if-folder-read-only))
|
|
|
279 (vm-display nil nil '(vm-sort-messages) '(vm-sort-messages))
|
|
|
280 (let (key-list key-funcs key ml-keys
|
|
|
281 physical-order-list old-message-list new-message-list mp-old mp-new
|
|
|
282 old-start
|
|
|
283 doomed-start doomed-end offset
|
|
|
284 (order-did-change nil)
|
|
|
285 virtual
|
|
|
286 physical)
|
|
|
287 (setq key-list (vm-parse keys "[ \t]*\\([^ \t]+\\)")
|
|
|
288 ml-keys (and key-list (mapconcat (function identity) key-list "/"))
|
|
|
289 key-funcs nil
|
|
|
290 old-message-list vm-message-list
|
|
|
291 virtual (eq major-mode 'vm-virtual-mode)
|
|
|
292 physical (and (or lets-get-physical
|
|
|
293 vm-move-messages-physically)
|
|
|
294 (not vm-folder-read-only)
|
|
|
295 (not virtual)))
|
|
|
296 (or key-list (error "No sort keys specified."))
|
|
|
297 (while key-list
|
|
|
298 (setq key (car key-list))
|
|
|
299 (cond ((equal key "thread")
|
|
|
300 (vm-build-threads-if-unbuilt)
|
|
|
301 (setq key-funcs (cons 'vm-sort-compare-thread key-funcs)))
|
|
|
302 ((equal key "author")
|
|
|
303 (setq key-funcs (cons 'vm-sort-compare-author key-funcs)))
|
|
|
304 ((equal key "reversed-author")
|
|
|
305 (setq key-funcs (cons 'vm-sort-compare-author-r key-funcs)))
|
|
|
306 ((equal key "date")
|
|
|
307 (setq key-funcs (cons 'vm-sort-compare-date key-funcs)))
|
|
|
308 ((equal key "reversed-date")
|
|
|
309 (setq key-funcs (cons 'vm-sort-compare-date-r key-funcs)))
|
|
|
310 ((equal key "subject")
|
|
|
311 (setq key-funcs (cons 'vm-sort-compare-subject key-funcs)))
|
|
|
312 ((equal key "reversed-subject")
|
|
|
313 (setq key-funcs (cons 'vm-sort-compare-subject-r key-funcs)))
|
|
|
314 ((equal key "recipients")
|
|
|
315 (setq key-funcs (cons 'vm-sort-compare-recipients key-funcs)))
|
|
|
316 ((equal key "reversed-recipients")
|
|
|
317 (setq key-funcs (cons 'vm-sort-compare-recipients-r key-funcs)))
|
|
|
318 ((equal key "byte-count")
|
|
|
319 (setq key-funcs (cons 'vm-sort-compare-byte-count key-funcs)))
|
|
|
320 ((equal key "reversed-byte-count")
|
|
|
321 (setq key-funcs (cons 'vm-sort-compare-byte-count-r key-funcs)))
|
|
|
322 ((equal key "line-count")
|
|
|
323 (setq key-funcs (cons 'vm-sort-compare-line-count key-funcs)))
|
|
|
324 ((equal key "reversed-line-count")
|
|
|
325 (setq key-funcs (cons 'vm-sort-compare-line-count-r key-funcs)))
|
|
|
326 ((equal key "physical-order")
|
|
|
327 (setq key-funcs (cons 'vm-sort-compare-physical-order key-funcs)))
|
|
|
328 ((equal key "reversed-physical-order")
|
|
|
329 (setq key-funcs (cons 'vm-sort-compare-physical-order-r key-funcs)))
|
|
|
330 (t (error "Unknown key: %s" key)))
|
|
|
331 (setq key-list (cdr key-list)))
|
|
102
|
332 (message "Sorting...")
|
|
0
|
333 (let ((vm-key-functions (nreverse key-funcs)))
|
|
|
334 (setq new-message-list (sort (copy-sequence old-message-list)
|
|
|
335 'vm-sort-compare-xxxxxx))
|
|
|
336 ;; only need to do this sort if we're going to physically
|
|
|
337 ;; move messages later.
|
|
|
338 (if physical
|
|
|
339 (setq vm-key-functions '(vm-sort-compare-physical-order)
|
|
|
340 physical-order-list (sort (copy-sequence old-message-list)
|
|
|
341 'vm-sort-compare-xxxxxx))))
|
|
102
|
342 (message "Sorting... done")
|
|
0
|
343 (let ((inhibit-quit t))
|
|
|
344 (setq mp-old old-message-list
|
|
|
345 mp-new new-message-list)
|
|
|
346 (while mp-new
|
|
|
347 (if (eq (car mp-old) (car mp-new))
|
|
|
348 (setq mp-old (cdr mp-old)
|
|
|
349 mp-new (cdr mp-new))
|
|
|
350 (setq order-did-change t)
|
|
|
351 ;; unless a full redo has been requested, the numbering
|
|
|
352 ;; start point now points to a cons in the old message
|
|
|
353 ;; list. therefore we just change the variable
|
|
|
354 ;; directly to avoid the list scan that
|
|
|
355 ;; vm-set-numbering-redo-start-point does.
|
|
|
356 (cond ((not (eq vm-numbering-redo-start-point t))
|
|
|
357 (setq vm-numbering-redo-start-point mp-new
|
|
|
358 vm-numbering-redo-end-point nil)))
|
|
|
359 (if vm-summary-buffer
|
|
|
360 (progn
|
|
|
361 (setq vm-need-summary-pointer-update t)
|
|
|
362 ;; same logic as numbering reset above...
|
|
|
363 (cond ((not (eq vm-summary-redo-start-point t))
|
|
|
364 (setq vm-summary-redo-start-point mp-new)))
|
|
|
365 ;; start point of this message's summary is now
|
|
|
366 ;; wrong relative to where it is in the
|
|
|
367 ;; message list. fix it and the summary rebuild
|
|
|
368 ;; will take care of the rest.
|
|
|
369 (vm-set-su-start-of (car mp-new)
|
|
|
370 (vm-su-start-of (car mp-old)))))
|
|
|
371 (setq mp-new nil)))
|
|
|
372 (if (and order-did-change physical)
|
|
|
373 (let ((buffer-read-only nil))
|
|
|
374 ;; the folder is being physically ordered so we don't
|
|
|
375 ;; need a message order header to be stuffed, nor do
|
|
|
376 ;; we need to retain one in the folder buffer. so we
|
|
|
377 ;; strip out any existing message order header and
|
|
|
378 ;; say there are no changes to prevent a message
|
|
|
379 ;; order header from being stuffed later.
|
|
|
380 (vm-remove-message-order)
|
|
|
381 (setq vm-message-order-changed nil)
|
|
102
|
382 (message "Moving messages... ")
|
|
0
|
383 (widen)
|
|
|
384 (setq mp-old physical-order-list
|
|
|
385 mp-new new-message-list)
|
|
|
386 (setq old-start (vm-start-of (car mp-old)))
|
|
|
387 (while mp-new
|
|
|
388 (if (< (vm-start-of (car mp-old)) old-start)
|
|
|
389 ;; already moved this message
|
|
|
390 (setq mp-old (cdr mp-old))
|
|
|
391 (if (eq (car mp-old) (car mp-new))
|
|
|
392 (setq mp-old (cdr mp-old)
|
|
|
393 mp-new (cdr mp-new))
|
|
|
394 ;; move message
|
|
|
395 (vm-physically-move-message (car mp-new) (car mp-old))
|
|
|
396 ;; record start position. if vm-start-of
|
|
|
397 ;; mp-old ever becomes less than old-start
|
|
|
398 ;; we're running into messages that have
|
|
|
399 ;; already been moved.
|
|
|
400 (setq old-start (vm-start-of (car mp-old)))
|
|
|
401 ;; move mp-new but not mp-old because we moved
|
|
|
402 ;; mp-old down one message by inserting a
|
|
|
403 ;; message in front of it.
|
|
|
404 (setq mp-new (cdr mp-new)))))
|
|
102
|
405 (message "Moving messages... done")
|
|
0
|
406 (vm-set-buffer-modified-p t)
|
|
|
407 (vm-clear-modification-flag-undos))
|
|
|
408 (if (and order-did-change (not vm-folder-read-only))
|
|
|
409 (progn
|
|
|
410 (setq vm-message-order-changed t)
|
|
|
411 (vm-set-buffer-modified-p t)
|
|
|
412 (vm-clear-modification-flag-undos))))
|
|
|
413 (setq vm-ml-sort-keys ml-keys)
|
|
|
414 (intern (buffer-name) vm-buffers-needing-display-update)
|
|
|
415 (cond (order-did-change
|
|
|
416 (setq vm-message-list new-message-list)
|
|
|
417 (vm-reverse-link-messages)
|
|
|
418 (if vm-message-pointer
|
|
|
419 (setq vm-message-pointer
|
|
|
420 (or (cdr (vm-reverse-link-of (car vm-message-pointer)))
|
|
|
421 vm-message-list)))
|
|
|
422 (if vm-last-message-pointer
|
|
|
423 (setq vm-last-message-pointer
|
|
|
424 (or (cdr (vm-reverse-link-of
|
|
|
425 (car vm-last-message-pointer)))
|
|
|
426 vm-message-list))))))
|
|
|
427 (if (and vm-message-pointer
|
|
|
428 order-did-change
|
|
|
429 (or lets-get-physical vm-move-messages-physically))
|
|
|
430 ;; clip region is most likely messed up
|
|
|
431 (vm-preview-current-message)
|
|
|
432 (vm-update-summary-and-mode-line))))
|
|
|
433
|
|
|
434 (defun vm-sort-compare-xxxxxx (m1 m2)
|
|
|
435 (let ((key-funcs vm-key-functions) result)
|
|
|
436 (while (and key-funcs
|
|
|
437 (eq '= (setq result (funcall (car key-funcs) m1 m2))))
|
|
|
438 (setq key-funcs (cdr key-funcs)))
|
|
|
439 (and key-funcs result) ))
|
|
|
440
|
|
|
441 (defun vm-sort-compare-thread (m1 m2)
|
|
|
442 (let ((list1 (vm-th-thread-list m1))
|
|
|
443 (list2 (vm-th-thread-list m2)))
|
|
|
444 (catch 'done
|
|
|
445 (if (not (eq (car list1) (car list2)))
|
|
|
446 (let ((date1 (get (car list1) 'oldest-date))
|
|
|
447 (date2 (get (car list2) 'oldest-date)))
|
|
|
448 (cond ((string-lessp date1 date2) t)
|
|
|
449 ((string-equal date1 date2) '=)
|
|
|
450 (t nil)))
|
|
|
451 (while (and list1 list2)
|
|
|
452 (cond ((string-lessp (car list1) (car list2)) (throw 'done t))
|
|
|
453 ((not (string-equal (car list1) (car list2)))
|
|
|
454 (throw 'done nil)))
|
|
|
455 (setq list1 (cdr list1)
|
|
|
456 list2 (cdr list2)))
|
|
|
457 (cond ((and list1 (not list2)) nil)
|
|
|
458 ((and list2 (not list1)) t)
|
|
|
459 (t '=))))))
|
|
|
460
|
|
|
461 (defun vm-sort-compare-author (m1 m2)
|
|
|
462 (let ((s1 (vm-su-from m1))
|
|
|
463 (s2 (vm-su-from m2)))
|
|
|
464 (cond ((string-lessp s1 s2) t)
|
|
|
465 ((string-equal s1 s2) '=)
|
|
|
466 (t nil))))
|
|
|
467
|
|
|
468 (defun vm-sort-compare-author-r (m1 m2)
|
|
|
469 (let ((s1 (vm-su-from m1))
|
|
|
470 (s2 (vm-su-from m2)))
|
|
|
471 (cond ((string-lessp s1 s2) nil)
|
|
|
472 ((string-equal s1 s2) '=)
|
|
|
473 (t t))))
|
|
|
474
|
|
|
475 (defun vm-sort-compare-date (m1 m2)
|
|
|
476 (let ((s1 (vm-so-sortable-datestring m1))
|
|
|
477 (s2 (vm-so-sortable-datestring m2)))
|
|
|
478 (cond ((string-lessp s1 s2) t)
|
|
|
479 ((string-equal s1 s2) '=)
|
|
|
480 (t nil))))
|
|
|
481
|
|
|
482 (defun vm-sort-compare-date-r (m1 m2)
|
|
|
483 (let ((s1 (vm-so-sortable-datestring m1))
|
|
|
484 (s2 (vm-so-sortable-datestring m2)))
|
|
|
485 (cond ((string-lessp s1 s2) nil)
|
|
|
486 ((string-equal s1 s2) '=)
|
|
|
487 (t t))))
|
|
|
488
|
|
|
489 (defun vm-sort-compare-recipients (m1 m2)
|
|
|
490 (let ((s1 (vm-su-to m1))
|
|
|
491 (s2 (vm-su-to m2)))
|
|
|
492 (cond ((string-lessp s1 s2) t)
|
|
|
493 ((string-equal s1 s2) '=)
|
|
|
494 (t nil))))
|
|
|
495
|
|
|
496 (defun vm-sort-compare-recipients-r (m1 m2)
|
|
|
497 (let ((s1 (vm-su-to m1))
|
|
|
498 (s2 (vm-su-to m2)))
|
|
|
499 (cond ((string-lessp s1 s2) nil)
|
|
|
500 ((string-equal s1 s2) '=)
|
|
|
501 (t t))))
|
|
|
502
|
|
|
503 (defun vm-sort-compare-subject (m1 m2)
|
|
|
504 (let ((s1 (vm-so-sortable-subject m1))
|
|
|
505 (s2 (vm-so-sortable-subject m2)))
|
|
|
506 (cond ((string-lessp s1 s2) t)
|
|
|
507 ((string-equal s1 s2) '=)
|
|
|
508 (t nil))))
|
|
|
509
|
|
|
510 (defun vm-sort-compare-subject-r (m1 m2)
|
|
|
511 (let ((s1 (vm-so-sortable-subject m1))
|
|
|
512 (s2 (vm-so-sortable-subject m2)))
|
|
|
513 (cond ((string-lessp s1 s2) nil)
|
|
|
514 ((string-equal s1 s2) '=)
|
|
|
515 (t t))))
|
|
|
516
|
|
|
517 (defun vm-sort-compare-line-count (m1 m2)
|
|
|
518 (let ((n1 (string-to-int (vm-su-line-count m1)))
|
|
|
519 (n2 (string-to-int (vm-su-line-count m2))))
|
|
|
520 (cond ((< n1 n2) t)
|
|
|
521 ((= n1 n2) '=)
|
|
|
522 (t nil))))
|
|
|
523
|
|
|
524 (defun vm-sort-compare-line-count-r (m1 m2)
|
|
|
525 (let ((n1 (string-to-int (vm-su-line-count m1)))
|
|
|
526 (n2 (string-to-int (vm-su-line-count m2))))
|
|
|
527 (cond ((> n1 n2) t)
|
|
|
528 ((= n1 n2) '=)
|
|
|
529 (t nil))))
|
|
|
530
|
|
|
531 (defun vm-sort-compare-byte-count (m1 m2)
|
|
|
532 (let ((n1 (string-to-int (vm-su-byte-count m1)))
|
|
|
533 (n2 (string-to-int (vm-su-byte-count m2))))
|
|
|
534 (cond ((< n1 n2) t)
|
|
|
535 ((= n1 n2) '=)
|
|
|
536 (t nil))))
|
|
|
537
|
|
|
538 (defun vm-sort-compare-byte-count-r (m1 m2)
|
|
|
539 (let ((n1 (string-to-int (vm-su-byte-count m1)))
|
|
|
540 (n2 (string-to-int (vm-su-byte-count m2))))
|
|
|
541 (cond ((> n1 n2) t)
|
|
|
542 ((= n1 n2) '=)
|
|
|
543 (t nil))))
|
|
|
544
|
|
|
545 (defun vm-sort-compare-physical-order (m1 m2)
|
|
|
546 (let ((n1 (vm-start-of m1))
|
|
|
547 (n2 (vm-start-of m2)))
|
|
|
548 (cond ((< n1 n2) t)
|
|
|
549 ((= n1 n2) '=)
|
|
|
550 (t nil))))
|
|
|
551
|
|
|
552 (defun vm-sort-compare-physical-order-r (m1 m2)
|
|
|
553 (let ((n1 (vm-start-of m1))
|
|
|
554 (n2 (vm-start-of m2)))
|
|
|
555 (cond ((> n1 n2) t)
|
|
|
556 ((= n1 n2) '=)
|
|
|
557 (t nil))))
|
