Mercurial > hg > xemacs-beta

comparison lisp/vm/vm-sort.el @ 70:131b0175ea99 r20-0b30

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-0b30
author cvs
date Mon, 13 Aug 2007 09:02:59 +0200
parents 05472e90ae02
children a145efe76779
comparison
equal deleted inserted replaced
69:804d1389bcd6 70:131b0175ea99
210 (defun vm-so-sortable-datestring (m) 210 (defun vm-so-sortable-datestring (m)
211 (or (vm-sortable-datestring-of m) 211 (or (vm-sortable-datestring-of m)
212 (progn 212 (progn
213 (vm-set-sortable-datestring-of 213 (vm-set-sortable-datestring-of
214 m 214 m
215 (condition-case nil 215 (timezone-make-date-sortable
216 (timezone-make-date-sortable 216 (or (vm-get-header-contents m "Date:")
217 (or (vm-get-header-contents m "Date:") 217 (vm-grok-From_-date m)
218 (vm-grok-From_-date m) 218 "Thu, 1 Jan 1970 00:00:00 GMT")
219 "Thu, 1 Jan 1970 00:00:00 GMT") 219 "GMT" "GMT"))
220 "GMT" "GMT")
221 (error "1970010100:00:00")))
222 (vm-sortable-datestring-of m)))) 220 (vm-sortable-datestring-of m))))
223 221
224 (defun vm-so-sortable-subject (m) 222 (defun vm-so-sortable-subject (m)
225 (or (vm-sortable-subject-of m) 223 (or (vm-sortable-subject-of m)
226 (progn 224 (progn
327 (setq key-funcs (cons 'vm-sort-compare-physical-order key-funcs))) 325 (setq key-funcs (cons 'vm-sort-compare-physical-order key-funcs)))
328 ((equal key "reversed-physical-order") 326 ((equal key "reversed-physical-order")
329 (setq key-funcs (cons 'vm-sort-compare-physical-order-r key-funcs))) 327 (setq key-funcs (cons 'vm-sort-compare-physical-order-r key-funcs)))
330 (t (error "Unknown key: %s" key))) 328 (t (error "Unknown key: %s" key)))
331 (setq key-list (cdr key-list))) 329 (setq key-list (cdr key-list)))
332 (message "Sorting...") 330 (vm-unsaved-message "Sorting...")
333 (let ((vm-key-functions (nreverse key-funcs))) 331 (let ((vm-key-functions (nreverse key-funcs)))
334 (setq new-message-list (sort (copy-sequence old-message-list) 332 (setq new-message-list (sort (copy-sequence old-message-list)
335 'vm-sort-compare-xxxxxx)) 333 'vm-sort-compare-xxxxxx))
336 ;; only need to do this sort if we're going to physically 334 ;; only need to do this sort if we're going to physically
337 ;; move messages later. 335 ;; move messages later.
338 (if physical 336 (if physical
339 (setq vm-key-functions '(vm-sort-compare-physical-order) 337 (setq vm-key-functions '(vm-sort-compare-physical-order)
340 physical-order-list (sort (copy-sequence old-message-list) 338 physical-order-list (sort (copy-sequence old-message-list)
341 'vm-sort-compare-xxxxxx)))) 339 'vm-sort-compare-xxxxxx))))
342 (message "Sorting... done") 340 (vm-unsaved-message "Sorting... done")
343 (let ((inhibit-quit t)) 341 (let ((inhibit-quit t))
344 (setq mp-old old-message-list 342 (setq mp-old old-message-list
345 mp-new new-message-list) 343 mp-new new-message-list)
346 (while mp-new 344 (while mp-new
347 (if (eq (car mp-old) (car mp-new)) 345 (if (eq (car mp-old) (car mp-new))
377 ;; strip out any existing message order header and 375 ;; strip out any existing message order header and
378 ;; say there are no changes to prevent a message 376 ;; say there are no changes to prevent a message
379 ;; order header from being stuffed later. 377 ;; order header from being stuffed later.
380 (vm-remove-message-order) 378 (vm-remove-message-order)
381 (setq vm-message-order-changed nil) 379 (setq vm-message-order-changed nil)
382 (message "Moving messages... ") 380 (vm-unsaved-message "Moving messages... ")
383 (widen) 381 (widen)
384 (setq mp-old physical-order-list 382 (setq mp-old physical-order-list
385 mp-new new-message-list) 383 mp-new new-message-list)
386 (setq old-start (vm-start-of (car mp-old))) 384 (setq old-start (vm-start-of (car mp-old)))
387 (while mp-new 385 (while mp-new
400 (setq old-start (vm-start-of (car mp-old))) 398 (setq old-start (vm-start-of (car mp-old)))
401 ;; move mp-new but not mp-old because we moved 399 ;; move mp-new but not mp-old because we moved
402 ;; mp-old down one message by inserting a 400 ;; mp-old down one message by inserting a
403 ;; message in front of it. 401 ;; message in front of it.
404 (setq mp-new (cdr mp-new))))) 402 (setq mp-new (cdr mp-new)))))
405 (message "Moving messages... done") 403 (vm-unsaved-message "Moving messages... done")
406 (vm-set-buffer-modified-p t) 404 (vm-set-buffer-modified-p t)
407 (vm-clear-modification-flag-undos)) 405 (vm-clear-modification-flag-undos))
408 (if (and order-did-change (not vm-folder-read-only)) 406 (if (and order-did-change (not vm-folder-read-only))
409 (progn 407 (progn
410 (setq vm-message-order-changed t) 408 (setq vm-message-order-changed t)