|
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
|
|
|
215 (timezone-make-date-sortable
|
|
|
216 (or (vm-get-header-contents m "Date:")
|
|
|
217 (vm-grok-From_-date m)
|
|
|
218 "Thu, 1 Jan 1970 00:00:00 GMT")
|
|
|
219 "GMT" "GMT"))
|
|
|
220 (vm-sortable-datestring-of m))))
|
|
|
221
|
|
|
222 (defun vm-so-sortable-subject (m)
|
|
|
223 (or (vm-sortable-subject-of m)
|
|
|
224 (progn
|
|
|
225 (vm-set-sortable-subject-of
|
|
|
226 m
|
|
|
227 (let ((case-fold-search t)
|
|
|
228 (subject (vm-su-subject m)))
|
|
|
229 (if (and vm-subject-ignored-prefix
|
|
|
230 (string-match vm-subject-ignored-prefix subject)
|
|
|
231 (zerop (match-beginning 0)))
|
|
|
232 (setq subject (substring subject (match-end 0))))
|
|
|
233 (if (and vm-subject-ignored-suffix
|
|
|
234 (string-match vm-subject-ignored-suffix subject)
|
|
|
235 (= (match-end 0) (length subject)))
|
|
|
236 (setq subject (substring subject 0 (match-beginning 0))))
|
|
|
237 subject ))
|
|
|
238 (vm-sortable-subject-of m))))
|
|
|
239
|
|
|
240 (defun vm-sort-messages (keys &optional lets-get-physical)
|
|
|
241 "Sort message in a folder by the specified KEYS.
|
|
|
242 You may sort by more than one particular message key. If
|
|
|
243 messages compare equal by the first key, the second key will be
|
|
|
244 compared and so on. When called interactively the keys will be
|
|
|
245 read from the minibuffer. Valid keys are
|
|
|
246
|
|
|
247 \"date\" \"reversed-date\"
|
|
|
248 \"author\" \"reversed-author\"
|
|
|
249 \"subject\" \"reversed-subject\"
|
|
|
250 \"recipients\" \"reversed-recipients\"
|
|
|
251 \"line-count\" \"reversed-line-count\"
|
|
|
252 \"byte-count\" \"reversed-byte-count\"
|
|
|
253 \"physical-order\" \"reversed-physical-order\"
|
|
|
254
|
|
|
255 Optional second arg (prefix arg interactively) means the sort
|
|
|
256 should change the physical order of the messages in the folder.
|
|
|
257 Normally VM changes presentation order only, leaving the
|
|
|
258 folder in the order in which the messages arrived."
|
|
|
259 (interactive
|
|
|
260 (let ((last-command last-command)
|
|
|
261 (this-command this-command))
|
|
|
262 (list (vm-read-string (if (or current-prefix-arg
|
|
|
263 vm-move-messages-physically)
|
|
|
264 "Physically sort messages by: "
|
|
|
265 "Sort messages by: ")
|
|
|
266 vm-supported-sort-keys t)
|
|
|
267 current-prefix-arg)))
|
|
|
268 (vm-select-folder-buffer)
|
|
|
269 (vm-check-for-killed-summary)
|
|
|
270 ;; only squawk if interactive. The thread display uses this
|
|
|
271 ;; function and doesn't expect errors.
|
|
|
272 (if (interactive-p)
|
|
|
273 (vm-error-if-folder-empty))
|
|
|
274 ;; ditto
|
|
|
275 (if (and (interactive-p) (or vm-move-messages-physically lets-get-physical))
|
|
|
276 (vm-error-if-folder-read-only))
|
|
|
277 (vm-display nil nil '(vm-sort-messages) '(vm-sort-messages))
|
|
|
278 (let (key-list key-funcs key ml-keys
|
|
|
279 physical-order-list old-message-list new-message-list mp-old mp-new
|
|
|
280 old-start
|
|
|
281 doomed-start doomed-end offset
|
|
|
282 (order-did-change nil)
|
|
|
283 virtual
|
|
|
284 physical)
|
|
|
285 (setq key-list (vm-parse keys "[ \t]*\\([^ \t]+\\)")
|
|
|
286 ml-keys (and key-list (mapconcat (function identity) key-list "/"))
|
|
|
287 key-funcs nil
|
|
|
288 old-message-list vm-message-list
|
|
|
289 virtual (eq major-mode 'vm-virtual-mode)
|
|
|
290 physical (and (or lets-get-physical
|
|
|
291 vm-move-messages-physically)
|
|
|
292 (not vm-folder-read-only)
|
|
|
293 (not virtual)))
|
|
|
294 (or key-list (error "No sort keys specified."))
|
|
|
295 (while key-list
|
|
|
296 (setq key (car key-list))
|
|
|
297 (cond ((equal key "thread")
|
|
|
298 (vm-build-threads-if-unbuilt)
|
|
|
299 (setq key-funcs (cons 'vm-sort-compare-thread key-funcs)))
|
|
|
300 ((equal key "author")
|
|
|
301 (setq key-funcs (cons 'vm-sort-compare-author key-funcs)))
|
|
|
302 ((equal key "reversed-author")
|
|
|
303 (setq key-funcs (cons 'vm-sort-compare-author-r key-funcs)))
|
|
|
304 ((equal key "date")
|
|
|
305 (setq key-funcs (cons 'vm-sort-compare-date key-funcs)))
|
|
|
306 ((equal key "reversed-date")
|
|
|
307 (setq key-funcs (cons 'vm-sort-compare-date-r key-funcs)))
|
|
|
308 ((equal key "subject")
|
|
|
309 (setq key-funcs (cons 'vm-sort-compare-subject key-funcs)))
|
|
|
310 ((equal key "reversed-subject")
|
|
|
311 (setq key-funcs (cons 'vm-sort-compare-subject-r key-funcs)))
|
|
|
312 ((equal key "recipients")
|
|
|
313 (setq key-funcs (cons 'vm-sort-compare-recipients key-funcs)))
|
|
|
314 ((equal key "reversed-recipients")
|
|
|
315 (setq key-funcs (cons 'vm-sort-compare-recipients-r key-funcs)))
|
|
|
316 ((equal key "byte-count")
|
|
|
317 (setq key-funcs (cons 'vm-sort-compare-byte-count key-funcs)))
|
|
|
318 ((equal key "reversed-byte-count")
|
|
|
319 (setq key-funcs (cons 'vm-sort-compare-byte-count-r key-funcs)))
|
|
|
320 ((equal key "line-count")
|
|
|
321 (setq key-funcs (cons 'vm-sort-compare-line-count key-funcs)))
|
|
|
322 ((equal key "reversed-line-count")
|
|
|
323 (setq key-funcs (cons 'vm-sort-compare-line-count-r key-funcs)))
|
|
|
324 ((equal key "physical-order")
|
|
|
325 (setq key-funcs (cons 'vm-sort-compare-physical-order key-funcs)))
|
|
|
326 ((equal key "reversed-physical-order")
|
|
|
327 (setq key-funcs (cons 'vm-sort-compare-physical-order-r key-funcs)))
|
|
|
328 (t (error "Unknown key: %s" key)))
|
|
|
329 (setq key-list (cdr key-list)))
|
|
|
330 (vm-unsaved-message "Sorting...")
|
|
|
331 (let ((vm-key-functions (nreverse key-funcs)))
|
|
|
332 (setq new-message-list (sort (copy-sequence old-message-list)
|
|
|
333 'vm-sort-compare-xxxxxx))
|
|
|
334 ;; only need to do this sort if we're going to physically
|
|
|
335 ;; move messages later.
|
|
|
336 (if physical
|
|
|
337 (setq vm-key-functions '(vm-sort-compare-physical-order)
|
|
|
338 physical-order-list (sort (copy-sequence old-message-list)
|
|
|
339 'vm-sort-compare-xxxxxx))))
|
|
|
340 (vm-unsaved-message "Sorting... done")
|
|
|
341 (let ((inhibit-quit t))
|
|
|
342 (setq mp-old old-message-list
|
|
|
343 mp-new new-message-list)
|
|
|
344 (while mp-new
|
|
|
345 (if (eq (car mp-old) (car mp-new))
|
|
|
346 (setq mp-old (cdr mp-old)
|
|
|
347 mp-new (cdr mp-new))
|
|
|
348 (setq order-did-change t)
|
|
|
349 ;; unless a full redo has been requested, the numbering
|
|
|
350 ;; start point now points to a cons in the old message
|
|
|
351 ;; list. therefore we just change the variable
|
|
|
352 ;; directly to avoid the list scan that
|
|
|
353 ;; vm-set-numbering-redo-start-point does.
|
|
|
354 (cond ((not (eq vm-numbering-redo-start-point t))
|
|
|
355 (setq vm-numbering-redo-start-point mp-new
|
|
|
356 vm-numbering-redo-end-point nil)))
|
|
|
357 (if vm-summary-buffer
|
|
|
358 (progn
|
|
|
359 (setq vm-need-summary-pointer-update t)
|
|
|
360 ;; same logic as numbering reset above...
|
|
|
361 (cond ((not (eq vm-summary-redo-start-point t))
|
|
|
362 (setq vm-summary-redo-start-point mp-new)))
|
|
|
363 ;; start point of this message's summary is now
|
|
|
364 ;; wrong relative to where it is in the
|
|
|
365 ;; message list. fix it and the summary rebuild
|
|
|
366 ;; will take care of the rest.
|
|
|
367 (vm-set-su-start-of (car mp-new)
|
|
|
368 (vm-su-start-of (car mp-old)))))
|
|
|
369 (setq mp-new nil)))
|
|
|
370 (if (and order-did-change physical)
|
|
|
371 (let ((buffer-read-only nil))
|
|
|
372 ;; the folder is being physically ordered so we don't
|
|
|
373 ;; need a message order header to be stuffed, nor do
|
|
|
374 ;; we need to retain one in the folder buffer. so we
|
|
|
375 ;; strip out any existing message order header and
|
|
|
376 ;; say there are no changes to prevent a message
|
|
|
377 ;; order header from being stuffed later.
|
|
|
378 (vm-remove-message-order)
|
|
|
379 (setq vm-message-order-changed nil)
|
|
|
380 (vm-unsaved-message "Moving messages... ")
|
|
|
381 (widen)
|
|
|
382 (setq mp-old physical-order-list
|
|
|
383 mp-new new-message-list)
|
|
|
384 (setq old-start (vm-start-of (car mp-old)))
|
|
|
385 (while mp-new
|
|
|
386 (if (< (vm-start-of (car mp-old)) old-start)
|
|
|
387 ;; already moved this message
|
|
|
388 (setq mp-old (cdr mp-old))
|
|
|
389 (if (eq (car mp-old) (car mp-new))
|
|
|
390 (setq mp-old (cdr mp-old)
|
|
|
391 mp-new (cdr mp-new))
|
|
|
392 ;; move message
|
|
|
393 (vm-physically-move-message (car mp-new) (car mp-old))
|
|
|
394 ;; record start position. if vm-start-of
|
|
|
395 ;; mp-old ever becomes less than old-start
|
|
|
396 ;; we're running into messages that have
|
|
|
397 ;; already been moved.
|
|
|
398 (setq old-start (vm-start-of (car mp-old)))
|
|
|
399 ;; move mp-new but not mp-old because we moved
|
|
|
400 ;; mp-old down one message by inserting a
|
|
|
401 ;; message in front of it.
|
|
|
402 (setq mp-new (cdr mp-new)))))
|
|
|
403 (vm-unsaved-message "Moving messages... done")
|
|
|
404 (vm-set-buffer-modified-p t)
|
|
|
405 (vm-clear-modification-flag-undos))
|
|
|
406 (if (and order-did-change (not vm-folder-read-only))
|
|
|
407 (progn
|
|
|
408 (setq vm-message-order-changed t)
|
|
|
409 (vm-set-buffer-modified-p t)
|
|
|
410 (vm-clear-modification-flag-undos))))
|
|
|
411 (setq vm-ml-sort-keys ml-keys)
|
|
|
412 (intern (buffer-name) vm-buffers-needing-display-update)
|
|
|
413 (cond (order-did-change
|
|
|
414 (setq vm-message-list new-message-list)
|
|
|
415 (vm-reverse-link-messages)
|
|
|
416 (if vm-message-pointer
|
|
|
417 (setq vm-message-pointer
|
|
|
418 (or (cdr (vm-reverse-link-of (car vm-message-pointer)))
|
|
|
419 vm-message-list)))
|
|
|
420 (if vm-last-message-pointer
|
|
|
421 (setq vm-last-message-pointer
|
|
|
422 (or (cdr (vm-reverse-link-of
|
|
|
423 (car vm-last-message-pointer)))
|
|
|
424 vm-message-list))))))
|
|
|
425 (if (and vm-message-pointer
|
|
|
426 order-did-change
|
|
|
427 (or lets-get-physical vm-move-messages-physically))
|
|
|
428 ;; clip region is most likely messed up
|
|
|
429 (vm-preview-current-message)
|
|
|
430 (vm-update-summary-and-mode-line))))
|
|
|
431
|
|
|
432 (defun vm-sort-compare-xxxxxx (m1 m2)
|
|
|
433 (let ((key-funcs vm-key-functions) result)
|
|
|
434 (while (and key-funcs
|
|
|
435 (eq '= (setq result (funcall (car key-funcs) m1 m2))))
|
|
|
436 (setq key-funcs (cdr key-funcs)))
|
|
|
437 (and key-funcs result) ))
|
|
|
438
|
|
|
439 (defun vm-sort-compare-thread (m1 m2)
|
|
|
440 (let ((list1 (vm-th-thread-list m1))
|
|
|
441 (list2 (vm-th-thread-list m2)))
|
|
|
442 (catch 'done
|
|
|
443 (if (not (eq (car list1) (car list2)))
|
|
|
444 (let ((date1 (get (car list1) 'oldest-date))
|
|
|
445 (date2 (get (car list2) 'oldest-date)))
|
|
|
446 (cond ((string-lessp date1 date2) t)
|
|
|
447 ((string-equal date1 date2) '=)
|
|
|
448 (t nil)))
|
|
|
449 (while (and list1 list2)
|
|
|
450 (cond ((string-lessp (car list1) (car list2)) (throw 'done t))
|
|
|
451 ((not (string-equal (car list1) (car list2)))
|
|
|
452 (throw 'done nil)))
|
|
|
453 (setq list1 (cdr list1)
|
|
|
454 list2 (cdr list2)))
|
|
|
455 (cond ((and list1 (not list2)) nil)
|
|
|
456 ((and list2 (not list1)) t)
|
|
|
457 (t '=))))))
|
|
|
458
|
|
|
459 (defun vm-sort-compare-author (m1 m2)
|
|
|
460 (let ((s1 (vm-su-from m1))
|
|
|
461 (s2 (vm-su-from m2)))
|
|
|
462 (cond ((string-lessp s1 s2) t)
|
|
|
463 ((string-equal s1 s2) '=)
|
|
|
464 (t nil))))
|
|
|
465
|
|
|
466 (defun vm-sort-compare-author-r (m1 m2)
|
|
|
467 (let ((s1 (vm-su-from m1))
|
|
|
468 (s2 (vm-su-from m2)))
|
|
|
469 (cond ((string-lessp s1 s2) nil)
|
|
|
470 ((string-equal s1 s2) '=)
|
|
|
471 (t t))))
|
|
|
472
|
|
|
473 (defun vm-sort-compare-date (m1 m2)
|
|
|
474 (let ((s1 (vm-so-sortable-datestring m1))
|
|
|
475 (s2 (vm-so-sortable-datestring m2)))
|
|
|
476 (cond ((string-lessp s1 s2) t)
|
|
|
477 ((string-equal s1 s2) '=)
|
|
|
478 (t nil))))
|
|
|
479
|
|
|
480 (defun vm-sort-compare-date-r (m1 m2)
|
|
|
481 (let ((s1 (vm-so-sortable-datestring m1))
|
|
|
482 (s2 (vm-so-sortable-datestring m2)))
|
|
|
483 (cond ((string-lessp s1 s2) nil)
|
|
|
484 ((string-equal s1 s2) '=)
|
|
|
485 (t t))))
|
|
|
486
|
|
|
487 (defun vm-sort-compare-recipients (m1 m2)
|
|
|
488 (let ((s1 (vm-su-to m1))
|
|
|
489 (s2 (vm-su-to m2)))
|
|
|
490 (cond ((string-lessp s1 s2) t)
|
|
|
491 ((string-equal s1 s2) '=)
|
|
|
492 (t nil))))
|
|
|
493
|
|
|
494 (defun vm-sort-compare-recipients-r (m1 m2)
|
|
|
495 (let ((s1 (vm-su-to m1))
|
|
|
496 (s2 (vm-su-to m2)))
|
|
|
497 (cond ((string-lessp s1 s2) nil)
|
|
|
498 ((string-equal s1 s2) '=)
|
|
|
499 (t t))))
|
|
|
500
|
|
|
501 (defun vm-sort-compare-subject (m1 m2)
|
|
|
502 (let ((s1 (vm-so-sortable-subject m1))
|
|
|
503 (s2 (vm-so-sortable-subject m2)))
|
|
|
504 (cond ((string-lessp s1 s2) t)
|
|
|
505 ((string-equal s1 s2) '=)
|
|
|
506 (t nil))))
|
|
|
507
|
|
|
508 (defun vm-sort-compare-subject-r (m1 m2)
|
|
|
509 (let ((s1 (vm-so-sortable-subject m1))
|
|
|
510 (s2 (vm-so-sortable-subject m2)))
|
|
|
511 (cond ((string-lessp s1 s2) nil)
|
|
|
512 ((string-equal s1 s2) '=)
|
|
|
513 (t t))))
|
|
|
514
|
|
|
515 (defun vm-sort-compare-line-count (m1 m2)
|
|
|
516 (let ((n1 (string-to-int (vm-su-line-count m1)))
|
|
|
517 (n2 (string-to-int (vm-su-line-count m2))))
|
|
|
518 (cond ((< n1 n2) t)
|
|
|
519 ((= n1 n2) '=)
|
|
|
520 (t nil))))
|
|
|
521
|
|
|
522 (defun vm-sort-compare-line-count-r (m1 m2)
|
|
|
523 (let ((n1 (string-to-int (vm-su-line-count m1)))
|
|
|
524 (n2 (string-to-int (vm-su-line-count m2))))
|
|
|
525 (cond ((> n1 n2) t)
|
|
|
526 ((= n1 n2) '=)
|
|
|
527 (t nil))))
|
|
|
528
|
|
|
529 (defun vm-sort-compare-byte-count (m1 m2)
|
|
|
530 (let ((n1 (string-to-int (vm-su-byte-count m1)))
|
|
|
531 (n2 (string-to-int (vm-su-byte-count m2))))
|
|
|
532 (cond ((< n1 n2) t)
|
|
|
533 ((= n1 n2) '=)
|
|
|
534 (t nil))))
|
|
|
535
|
|
|
536 (defun vm-sort-compare-byte-count-r (m1 m2)
|
|
|
537 (let ((n1 (string-to-int (vm-su-byte-count m1)))
|
|
|
538 (n2 (string-to-int (vm-su-byte-count m2))))
|
|
|
539 (cond ((> n1 n2) t)
|
|
|
540 ((= n1 n2) '=)
|
|
|
541 (t nil))))
|
|
|
542
|
|
|
543 (defun vm-sort-compare-physical-order (m1 m2)
|
|
|
544 (let ((n1 (vm-start-of m1))
|
|
|
545 (n2 (vm-start-of m2)))
|
|
|
546 (cond ((< n1 n2) t)
|
|
|
547 ((= n1 n2) '=)
|
|
|
548 (t nil))))
|
|
|
549
|
|
|
550 (defun vm-sort-compare-physical-order-r (m1 m2)
|
|
|
551 (let ((n1 (vm-start-of m1))
|
|
|
552 (n2 (vm-start-of m2)))
|
|
|
553 (cond ((> n1 n2) t)
|
|
|
554 ((= n1 n2) '=)
|
|
|
555 (t nil))))
|
