Mercurial > hg > xemacs-beta

comparison lisp/hyperbole/hvm.el @ 38:1a767b41a199 r19-15b102

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r19-15b102
author cvs
date Mon, 13 Aug 2007 08:54:01 +0200
parents 4103f0995bd7
children 131b0175ea99
comparison
equal deleted inserted replaced
37:ad40ac360d14 38:1a767b41a199
4 ;; SUMMARY: Support Hyperbole buttons in mail reader: Vm. 4 ;; SUMMARY: Support Hyperbole buttons in mail reader: Vm.
5 ;; USAGE: GNU Emacs Lisp Library 5 ;; USAGE: GNU Emacs Lisp Library
6 ;; KEYWORDS: hypermedia, mail 6 ;; KEYWORDS: hypermedia, mail
7 ;; 7 ;;
8 ;; AUTHOR: Bob Weiner 8 ;; AUTHOR: Bob Weiner
9 ;; ORG: Brown U. 9 ;; ORG: InfoDock Associates
10 ;; 10 ;;
11 ;; ORIG-DATE: 10-Oct-91 at 01:51:12 11 ;; ORIG-DATE: 10-Oct-91 at 01:51:12
12 ;; LAST-MOD: 31-Oct-96 at 22:36:19 by Bob Weiner 12 ;; LAST-MOD: 20-Mar-97 at 14:52:54 by Bob Weiner
13 ;; 13 ;;
14 ;; This file is part of Hyperbole. 14 ;; This file is part of Hyperbole.
15 ;; Available for use and distribution under the same terms as GNU Emacs. 15 ;; Available for use and distribution under the same terms as GNU Emacs.
16 ;; 16 ;;
17 ;; Copyright (C) 1991-1995, Free Software Foundation, Inc. 17 ;; Copyright (C) 1991-1995, Free Software Foundation, Inc.
370 (var:append 'vm-mail-mode-hook '(hmail:msg-narrow)) 370 (var:append 'vm-mail-mode-hook '(hmail:msg-narrow))
371 371
372 ;;; Overlay this function from "vm-folder.el" called whenever new mail is 372 ;;; Overlay this function from "vm-folder.el" called whenever new mail is
373 ;;; incorporated so that it will highlight Hyperbole buttons when possible. 373 ;;; incorporated so that it will highlight Hyperbole buttons when possible.
374 ;; Returns non-nil if there were any new messages. 374 ;; Returns non-nil if there were any new messages.
375 (defun vm-assimilate-new-messages (&optional dont-read-attributes gobble-order) 375 (defun vm-assimilate-new-messages (&optional
376 dont-read-attributes
377 gobble-order
378 labels)
376 (let ((tail-cons (vm-last vm-message-list)) 379 (let ((tail-cons (vm-last vm-message-list))
377 b-list new-messages) 380 b-list new-messages)
378 (save-excursion 381 (save-excursion
379 (vm-save-restriction 382 (vm-save-restriction
380 (widen) 383 (widen)
399 (if vm-thread-obarray 402 (if vm-thread-obarray
400 (vm-build-threads (cdr tail-cons)))))) 403 (vm-build-threads (cdr tail-cons))))))
401 (setq new-messages (if tail-cons (cdr tail-cons) vm-message-list)) 404 (setq new-messages (if tail-cons (cdr tail-cons) vm-message-list))
402 (vm-set-numbering-redo-start-point new-messages) 405 (vm-set-numbering-redo-start-point new-messages)
403 (vm-set-summary-redo-start-point new-messages)) 406 (vm-set-summary-redo-start-point new-messages))
407 ;; copy the new-messages list because sorting might scramble
408 ;; it. Also something the user does when
409 ;; vm-arrived-message-hook is run might affect it.
410 ;; vm-assimilate-new-messages returns this value so it must
411 ;; not be mangled.
412 (setq new-messages (copy-sequence new-messages))
413 ;; add the labels
414 (if (and labels (boundp 'vm-burst-digest-messages-inherit-labels)
415 vm-burst-digest-messages-inherit-labels)
416 (let ((mp new-messages))
417 (while mp
418 (vm-set-labels-of (car mp) (copy-sequence labels))
419 (setq mp (cdr mp)))))
404 (if vm-summary-show-threads 420 (if vm-summary-show-threads
405 (progn 421 (progn
406 ;; get numbering and summary of new messages done now 422 ;; get numbering and summary of new messages done now
407 ;; so that the sort code only has to worry about the 423 ;; so that the sort code only has to worry about the
408 ;; changes it needs to make. 424 ;; changes it needs to make.
409 (vm-update-summary-and-mode-line) 425 (vm-update-summary-and-mode-line)
410 ;; copy the new-messages list because sorting might
411 ;; scramble it. vm-assimilate-new-messages returns
412 ;; this value.
413 (setq new-messages (copy-sequence new-messages))
414 (vm-sort-messages "thread"))) 426 (vm-sort-messages "thread")))
427 (if (and vm-arrived-message-hook
428 new-messages
429 ;; tail-cons == nil means vm-message-list was empty.
430 ;; Thus new-messages == vm-message-list. In this
431 ;; case, run the hooks only if this is not the first
432 ;; time vm-assimilate-new-messages has been called
433 ;; in this folder. gobble-order non-nil is a good
434 ;; indicator that this is the first time because the
435 ;; order is gobbled only once per visit and always
436 ;; the first time vm-assimilate-new-messages is
437 ;; called.
438 (or tail-cons (null gobble-order)))
439 (let ((new-messages new-messages))
440 ;; seems wise to do this so that if the user runs VM
441 ;; command here they start with as much of a clean
442 ;; slate as we can provide, given we're currently deep
443 ;; in the guts of VM.
444 (vm-update-summary-and-mode-line)
445 (while new-messages
446 (vm-run-message-hook (car new-messages) 'vm-arrived-message-hook)
447 (setq new-messages (cdr new-messages)))))
448 (vm-update-summary-and-mode-line)
449 (run-hooks 'vm-arrived-messages-hook)
415 (if (and new-messages vm-virtual-buffers) 450 (if (and new-messages vm-virtual-buffers)
416 (save-excursion 451 (save-excursion
417 (setq b-list vm-virtual-buffers) 452 (setq b-list vm-virtual-buffers)
418 (while b-list 453 (while b-list
419 ;; buffer might be dead 454 ;; buffer might be dead