Mercurial > hg > xemacs-beta

comparison lisp/vm/vm-sort.el @ 26:441bb1e64a06 r19-15b96

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r19-15b96
author cvs
date Mon, 13 Aug 2007 08:51:32 +0200
parents 376386a54a3c
children 05472e90ae02
comparison
equal deleted inserted replaced
25:383a494979f8 26:441bb1e64a06
325 (setq key-funcs (cons 'vm-sort-compare-physical-order key-funcs))) 325 (setq key-funcs (cons 'vm-sort-compare-physical-order key-funcs)))
326 ((equal key "reversed-physical-order") 326 ((equal key "reversed-physical-order")
327 (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)))
328 (t (error "Unknown key: %s" key))) 328 (t (error "Unknown key: %s" key)))
329 (setq key-list (cdr key-list))) 329 (setq key-list (cdr key-list)))
330 (vm-unsaved-message "Sorting...") 330 (message "Sorting...")
331 (let ((vm-key-functions (nreverse key-funcs))) 331 (let ((vm-key-functions (nreverse key-funcs)))
332 (setq new-message-list (sort (copy-sequence old-message-list) 332 (setq new-message-list (sort (copy-sequence old-message-list)
333 'vm-sort-compare-xxxxxx)) 333 'vm-sort-compare-xxxxxx))
334 ;; 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
335 ;; move messages later. 335 ;; move messages later.
336 (if physical 336 (if physical
337 (setq vm-key-functions '(vm-sort-compare-physical-order) 337 (setq vm-key-functions '(vm-sort-compare-physical-order)
338 physical-order-list (sort (copy-sequence old-message-list) 338 physical-order-list (sort (copy-sequence old-message-list)
339 'vm-sort-compare-xxxxxx)))) 339 'vm-sort-compare-xxxxxx))))
340 (vm-unsaved-message "Sorting... done") 340 (message "Sorting... done")
341 (let ((inhibit-quit t)) 341 (let ((inhibit-quit t))
342 (setq mp-old old-message-list 342 (setq mp-old old-message-list
343 mp-new new-message-list) 343 mp-new new-message-list)
344 (while mp-new 344 (while mp-new
345 (if (eq (car mp-old) (car mp-new)) 345 (if (eq (car mp-old) (car mp-new))
375 ;; strip out any existing message order header and 375 ;; strip out any existing message order header and
376 ;; say there are no changes to prevent a message 376 ;; say there are no changes to prevent a message
377 ;; order header from being stuffed later. 377 ;; order header from being stuffed later.
378 (vm-remove-message-order) 378 (vm-remove-message-order)
379 (setq vm-message-order-changed nil) 379 (setq vm-message-order-changed nil)
380 (vm-unsaved-message "Moving messages... ") 380 (message "Moving messages... ")
381 (widen) 381 (widen)
382 (setq mp-old physical-order-list 382 (setq mp-old physical-order-list
383 mp-new new-message-list) 383 mp-new new-message-list)
384 (setq old-start (vm-start-of (car mp-old))) 384 (setq old-start (vm-start-of (car mp-old)))
385 (while mp-new 385 (while mp-new
398 (setq old-start (vm-start-of (car mp-old))) 398 (setq old-start (vm-start-of (car mp-old)))
399 ;; move mp-new but not mp-old because we moved 399 ;; move mp-new but not mp-old because we moved
400 ;; mp-old down one message by inserting a 400 ;; mp-old down one message by inserting a
401 ;; message in front of it. 401 ;; message in front of it.
402 (setq mp-new (cdr mp-new))))) 402 (setq mp-new (cdr mp-new)))))
403 (vm-unsaved-message "Moving messages... done") 403 (message "Moving messages... done")
404 (vm-set-buffer-modified-p t) 404 (vm-set-buffer-modified-p t)
405 (vm-clear-modification-flag-undos)) 405 (vm-clear-modification-flag-undos))
406 (if (and order-did-change (not vm-folder-read-only)) 406 (if (and order-did-change (not vm-folder-read-only))
407 (progn 407 (progn
408 (setq vm-message-order-changed t) 408 (setq vm-message-order-changed t)