|
0
|
1 ;;!emacs
|
|
|
2 ;;
|
|
|
3 ;; FILE: hvm.el
|
|
|
4 ;; SUMMARY: Support Hyperbole buttons in mail reader: Vm.
|
|
|
5 ;; USAGE: GNU Emacs Lisp Library
|
|
|
6 ;; KEYWORDS: hypermedia, mail
|
|
|
7 ;;
|
|
|
8 ;; AUTHOR: Bob Weiner
|
|
114
|
9 ;; ORG: InfoDock Associates
|
|
0
|
10 ;;
|
|
|
11 ;; ORIG-DATE: 10-Oct-91 at 01:51:12
|
|
114
|
12 ;; LAST-MOD: 20-Mar-97 at 14:52:54 by Bob Weiner
|
|
0
|
13 ;;
|
|
|
14 ;; This file is part of Hyperbole.
|
|
|
15 ;; Available for use and distribution under the same terms as GNU Emacs.
|
|
|
16 ;;
|
|
|
17 ;; Copyright (C) 1991-1995, Free Software Foundation, Inc.
|
|
|
18 ;; Developed with support from Motorola Inc.
|
|
|
19 ;;
|
|
|
20 ;; DESCRIPTION:
|
|
|
21 ;;
|
|
|
22 ;; Automatically configured for use in "hyperbole.el".
|
|
|
23 ;; If hsite loading fails prior to initializing Hyperbole Vm support,
|
|
|
24 ;;
|
|
100
|
25 ;; {M-x Vm-init RET}
|
|
0
|
26 ;;
|
|
|
27 ;; will do it.
|
|
|
28 ;;
|
|
|
29 ;; DESCRIP-END.
|
|
|
30
|
|
|
31 ;;; ************************************************************************
|
|
|
32 ;;; Other required Elisp libraries
|
|
|
33 ;;; ************************************************************************
|
|
|
34
|
|
|
35 (require 'hmail)
|
|
|
36 (load "hsmail")
|
|
|
37 (require 'vm)
|
|
|
38 (or (and (fboundp 'vm-edit-message) (fboundp 'vm-edit-message-end))
|
|
|
39 (load "vm-edit"))
|
|
|
40 (vm-session-initialization)
|
|
|
41
|
|
|
42 ;;; ************************************************************************
|
|
|
43 ;;; Public variables
|
|
|
44 ;;; ************************************************************************
|
|
|
45
|
|
|
46 ;;; Current versions of VM define this next variable in "vm-vars.el". We
|
|
|
47 ;;; define it here for earlier VM versions.
|
|
|
48 (defvar vm-edit-message-mode nil
|
|
|
49 "*Major mode to use when editing messages in VM.")
|
|
|
50
|
|
|
51 ;;; "hmail.el" procedures will branch improperly if a regular mode, like VM's
|
|
|
52 ;;; default 'text-mode', is used for editing.
|
|
|
53 (setq vm-edit-message-mode 'vm-edit-mode)
|
|
|
54
|
|
|
55 (defun vm-edit-mode ()
|
|
|
56 "Major mode for editing vm mail messages.
|
|
|
57 Special commands:\\{vm-edit-message-map}
|
|
|
58 Turning on vm-edit-mode calls the value of the variable vm-edit-message-hook,
|
|
|
59 if that value is non-nil."
|
|
|
60 (interactive)
|
|
|
61 (kill-all-local-variables)
|
|
|
62 (use-local-map vm-edit-message-map)
|
|
|
63 (setq mode-name "VM Edit")
|
|
|
64 (setq major-mode 'vm-edit-mode)
|
|
|
65 (setq local-abbrev-table text-mode-abbrev-table)
|
|
|
66 (set-syntax-table text-mode-syntax-table)
|
|
|
67 (run-hooks 'vm-edit-message-hook))
|
|
|
68
|
|
|
69 ;;; ************************************************************************
|
|
|
70 ;;; Public functions
|
|
|
71 ;;; ************************************************************************
|
|
|
72
|
|
|
73 (defun Vm-init ()
|
|
|
74 "Initializes Hyperbole support for Vm mail reading."
|
|
|
75 (interactive)
|
|
|
76 (setq hmail:composer 'mail-mode
|
|
|
77 hmail:lister 'vm-summary-mode
|
|
|
78 hmail:modifier 'vm-edit-mode
|
|
|
79 hmail:reader 'vm-mode)
|
|
|
80 ;;
|
|
|
81 ;; Setup public abstract interface to Hyperbole defined mail
|
|
|
82 ;; reader-specific functions used in "hmail.el".
|
|
|
83 ;;
|
|
|
84 (rmail:init)
|
|
|
85 ;;
|
|
|
86 ;; Setup private abstract interface to mail reader-specific functions
|
|
|
87 ;; used in "hmail.el".
|
|
|
88 ;;
|
|
|
89 (fset 'rmail:get-new 'vm-get-new-mail)
|
|
|
90 (fset 'rmail:msg-forward 'vm-forward-message)
|
|
|
91 (fset 'rmail:summ-msg-to 'vm-follow-summary-cursor)
|
|
|
92 (fset 'rmail:summ-new 'vm-summarize)
|
|
|
93 (if (interactive-p)
|
|
|
94 (message "Hyperbole VM mail reader support initialized."))
|
|
|
95 )
|
|
|
96
|
|
|
97 (defun Vm-msg-hdrs-full (toggled)
|
|
|
98 "If TOGGLED is non-nil, toggle full/hidden headers, else show full headers."
|
|
|
99 (save-excursion
|
|
|
100 (if (or toggled
|
|
|
101 (let ((exposed (= (point-min)
|
|
|
102 (vm-start-of (car vm-message-pointer)))))
|
|
|
103 (not exposed)))
|
|
|
104 (progn (vm-expose-hidden-headers)
|
|
|
105 (setq toggled t)))
|
|
|
106 toggled))
|
|
|
107
|
|
|
108 (defun Vm-msg-narrow ()
|
|
|
109 "Narrows mail reader buffer to current message.
|
|
|
110 This includes Hyperbole button data."
|
|
|
111 (save-excursion
|
|
|
112 (vm-select-folder-buffer)
|
|
|
113 (narrow-to-region (point-min) (Vm-msg-end))))
|
|
|
114
|
|
|
115 (defun Vm-msg-next () (vm-next-message 1))
|
|
|
116
|
|
|
117 (defun Vm-msg-num ()
|
|
|
118 "Returns number of vm mail message that point is within, in physical message order."
|
|
|
119 (interactive)
|
|
|
120 (let ((count 1)
|
|
|
121 (case-fold-search))
|
|
|
122 (save-excursion
|
|
|
123 (save-restriction
|
|
|
124 (widen)
|
|
|
125 (while (re-search-backward Vm-msg-start-regexp nil t)
|
|
|
126 (setq count (1+ count)))))
|
|
|
127 count))
|
|
|
128
|
|
|
129 (defun Vm-msg-prev () (vm-previous-message 1))
|
|
|
130
|
|
|
131 (defun Vm-msg-to-p (mail-msg-id mail-file)
|
|
|
132 "Sets current buffer to start of msg with MAIL-MSG-ID in MAIL-FILE.
|
|
|
133 Returns t if successful, else nil or signals error."
|
|
|
134 (if (not (file-readable-p mail-file))
|
|
|
135 nil
|
|
|
136 (vm-visit-folder mail-file)
|
|
|
137 (widen)
|
|
|
138 (goto-char 1)
|
|
|
139 (if (let ((case-fold-search))
|
|
|
140 (re-search-forward (concat rmail:msg-hdr-prefix
|
|
|
141 (regexp-quote mail-msg-id)) nil t))
|
|
|
142 ;; Found matching msg
|
|
|
143 (progn
|
|
|
144 (setq buffer-read-only t)
|
|
|
145 (vm-goto-message-at-point)
|
|
|
146 t))))
|
|
|
147
|
|
|
148 (defun Vm-msg-widen ()
|
|
|
149 "Widens buffer to full current message including Hyperbole button data."
|
|
|
150 (save-excursion
|
|
|
151 (vm-select-folder-buffer)
|
|
|
152 (narrow-to-region (point-min) (Vm-msg-end))))
|
|
|
153
|
|
|
154 (defun Vm-to ()
|
|
|
155 "Sets current buffer to a mail reader buffer."
|
|
|
156 (and (eq major-mode 'vm-summary-mode) (set-buffer vm-mail-buffer)))
|
|
|
157
|
|
|
158 (defun Vm-Summ-delete ()
|
|
|
159 (vm-follow-summary-cursor)
|
|
|
160 (vm-delete-message 1))
|
|
|
161
|
|
|
162 (fset 'Vm-Summ-expunge 'vm-expunge-folder)
|
|
|
163
|
|
|
164 (fset 'Vm-Summ-goto 'vm-follow-summary-cursor)
|
|
|
165
|
|
|
166 (defun Vm-Summ-to ()
|
|
|
167 "Sets current buffer to a mail listing buffer."
|
|
|
168 (and (eq major-mode 'vm-mode) (set-buffer vm-summary-buffer)))
|
|
|
169
|
|
|
170 (defun Vm-Summ-undelete-all ()
|
|
|
171 (message
|
|
|
172 "(Vm-Summ-undelete-all: Vm doesn't have an undelete all msgs function."))
|
|
|
173
|
|
|
174 ;;; ************************************************************************
|
|
|
175 ;;; Private functions
|
|
|
176 ;;; ************************************************************************
|
|
|
177
|
|
|
178 (defun Vm-msg-end ()
|
|
|
179 "Returns end point for current Vm message, including Hyperbole button data.
|
|
|
180 Has side-effect of widening buffer."
|
|
|
181 (save-excursion
|
|
|
182 (goto-char (point-min))
|
|
|
183 (widen)
|
|
|
184 (if (let ((case-fold-search))
|
|
|
185 (re-search-forward Vm-msg-start-regexp nil t))
|
|
|
186 (match-beginning 0)
|
|
|
187 (point-max))))
|
|
|
188
|
|
|
189 ;;; Overlay version of this function from "vm-page.el" to hide any
|
|
|
190 ;;; Hyperbole button data whenever a message is displayed in its entirety.
|
|
|
191 (defun vm-show-current-message ()
|
|
|
192 (save-excursion
|
|
|
193 (save-excursion
|
|
|
194 (goto-char (point-min))
|
|
|
195 (hmail:msg-narrow (point-min) (Vm-msg-end)))
|
|
|
196 (and vm-honor-page-delimiters
|
|
|
197 (save-excursion
|
|
|
198 (if (search-forward page-delimiter nil t)
|
|
|
199 (progn
|
|
|
200 (goto-char (match-beginning 0))
|
|
|
201 (not (looking-at (regexp-quote hmail:hbdata-sep))))))
|
|
|
202 (progn
|
|
|
203 (if (looking-at page-delimiter)
|
|
|
204 (forward-page 1))
|
|
|
205 (vm-narrow-to-page))))
|
|
|
206 ;; don't mark the message as read if the user can't see it!
|
|
|
207 (if (vm-get-buffer-window (current-buffer))
|
|
|
208 (progn
|
|
|
209 (setq vm-system-state 'showing)
|
|
|
210 (cond ((vm-new-flag (car vm-message-pointer))
|
|
|
211 (vm-set-new-flag (car vm-message-pointer) nil)))
|
|
|
212 (cond ((vm-unread-flag (car vm-message-pointer))
|
|
|
213 (vm-set-unread-flag (car vm-message-pointer) nil)))
|
|
|
214 (vm-update-summary-and-mode-line)
|
|
|
215 (vm-howl-if-eom))
|
|
|
216 (if (fboundp 'hproperty:but-create) (hproperty:but-create))
|
|
|
217 (vm-update-summary-and-mode-line)))
|
|
|
218
|
|
|
219 ;;; Overlay version of this function from "vm-page.el" to treat end of
|
|
|
220 ;;; text (excluding Hyperbole button data) as end of message.
|
|
|
221 (defun vm-scroll-forward-internal (arg)
|
|
|
222 (let ((direction (prefix-numeric-value arg))
|
|
|
223 (w (selected-window)))
|
|
|
224 (condition-case error-data
|
|
|
225 (progn (scroll-up arg) nil)
|
|
|
226 (error
|
|
|
227 (if (or (and (< direction 0)
|
|
|
228 (> (point-min) (vm-text-of (car vm-message-pointer))))
|
|
|
229 (and (>= direction 0)
|
|
|
230 (/= (point-max)
|
|
|
231 (save-restriction
|
|
|
232 (hmail:hbdata-start
|
|
|
233 (point-min)
|
|
|
234 (vm-text-end-of
|
|
|
235 (car vm-message-pointer)))))))
|
|
|
236 (progn
|
|
|
237 (vm-widen-page)
|
|
|
238 (if (>= direction 0)
|
|
|
239 (progn
|
|
|
240 (forward-page 1)
|
|
|
241 (set-window-start w (point))
|
|
|
242 nil )
|
|
|
243 (if (or (bolp)
|
|
|
244 (not (save-excursion
|
|
|
245 (beginning-of-line)
|
|
|
246 (looking-at page-delimiter))))
|
|
|
247 (forward-page -1))
|
|
|
248 (beginning-of-line)
|
|
|
249 (set-window-start w (point))
|
|
|
250 'tryagain))
|
|
|
251 (if (eq (car error-data) 'end-of-buffer)
|
|
|
252 (if vm-auto-next-message
|
|
|
253 'next-message
|
|
|
254 (set-window-point w (point))
|
|
|
255 'end-of-message)))))))
|
|
|
256
|
|
|
257 ;;; Overlay version of this function from "vm-page.el" (called by
|
|
|
258 ;;; vm-scroll-* functions). Make it keep Hyperbole button data hidden.
|
|
|
259 (defun vm-widen-page ()
|
|
|
260 (if (or (> (point-min) (vm-text-of (car vm-message-pointer)))
|
|
|
261 (/= (point-max) (vm-text-end-of (car vm-message-pointer))))
|
|
|
262 (hmail:msg-narrow (vm-vheaders-of (car vm-message-pointer))
|
|
|
263 (if (or (vm-new-flag (car vm-message-pointer))
|
|
|
264 (vm-unread-flag (car vm-message-pointer)))
|
|
|
265 (vm-text-of (car vm-message-pointer))
|
|
|
266 (vm-text-end-of (car vm-message-pointer))))))
|
|
|
267
|
|
|
268 ;;; Overlay version of this function from "vm-edit.el" to hide
|
|
|
269 ;;; Hyperbole button data when insert edited message from temporary buffer.
|
|
|
270 (hypb:function-overload 'vm-edit-message nil '(hmail:msg-narrow))
|
|
|
271
|
|
|
272 ;;; Overlay version of this function from "vm-edit.el" to hide
|
|
|
273 ;;; Hyperbole button data when insert edited message from temporary buffer.
|
|
|
274 (defun vm-edit-message-end ()
|
|
|
275 "End the edit of a message and copy the result to its folder."
|
|
|
276 (interactive)
|
|
|
277 (if (null vm-message-pointer)
|
|
|
278 (error "This is not a VM message edit buffer."))
|
|
|
279 (if (null (buffer-name (vm-buffer-of (car vm-message-pointer))))
|
|
|
280 (error "The folder buffer for this message has been killed."))
|
|
|
281 ;; make sure the message ends with a newline
|
|
|
282 (goto-char (point-max))
|
|
|
283 (and (/= (preceding-char) ?\n) (insert ?\n))
|
|
|
284 ;; munge message separators found in the edited message to
|
|
|
285 ;; prevent message from being split into several messages.
|
|
|
286 (vm-munge-message-separators (vm-message-type-of (car vm-message-pointer))
|
|
|
287 (point-min) (point-max))
|
|
|
288 ;; for From_-with-Content-Length recompute the Content-Length header
|
|
|
289 (if (eq (vm-message-type-of (car vm-message-pointer))
|
|
|
290 'From_-with-Content-Length)
|
|
|
291 (let ((buffer-read-only nil)
|
|
|
292 length)
|
|
|
293 (goto-char (point-min))
|
|
|
294 ;; first delete all copies of Content-Length
|
|
|
295 (while (and (re-search-forward vm-content-length-search-regexp nil t)
|
|
|
296 (null (match-beginning 1))
|
|
|
297 (progn (goto-char (match-beginning 0))
|
|
|
298 (vm-match-header vm-content-length-header)))
|
|
|
299 (delete-region (vm-matched-header-start) (vm-matched-header-end)))
|
|
|
300 ;; now compute the message body length
|
|
|
301 (goto-char (point-min))
|
|
|
302 (search-forward "\n\n" nil 0)
|
|
|
303 (setq length (- (point-max) (point)))
|
|
|
304 ;; insert the header
|
|
|
305 (goto-char (point-min))
|
|
|
306 (insert vm-content-length-header " " (int-to-string length) "\n")))
|
|
|
307 (let ((edit-buf (current-buffer))
|
|
|
308 (mp vm-message-pointer))
|
|
|
309 (if (buffer-modified-p)
|
|
|
310 (progn
|
|
|
311 (widen)
|
|
|
312 (save-excursion
|
|
|
313 (set-buffer (vm-buffer-of (vm-real-message-of (car mp))))
|
|
|
314 (if (not (memq (vm-real-message-of (car mp)) vm-message-list))
|
|
|
315 (error "The original copy of this message has been expunged."))
|
|
|
316 (vm-save-restriction
|
|
|
317 (widen)
|
|
|
318 (goto-char (vm-headers-of (vm-real-message-of (car mp))))
|
|
|
319 (let ((vm-message-pointer mp)
|
|
|
320 (buffer-read-only nil))
|
|
|
321 (insert-buffer-substring edit-buf)
|
|
|
322 (delete-region
|
|
|
323 (point) (vm-text-end-of (vm-real-message-of (car mp))))
|
|
|
324 (vm-discard-cached-data)
|
|
|
325 (hmail:msg-narrow))
|
|
|
326 (vm-set-edited-flag-of (car mp) t)
|
|
|
327 (vm-mark-for-summary-update (car mp))
|
|
|
328 (if (eq vm-flush-interval t)
|
|
|
329 (vm-stuff-virtual-attributes (car mp))
|
|
|
330 (vm-set-modflag-of (car mp) t))
|
|
|
331 (vm-set-buffer-modified-p t)
|
|
|
332 (vm-clear-modification-flag-undos)
|
|
|
333 (vm-set-edit-buffer-of (car mp) nil))
|
|
|
334 (set-buffer (vm-buffer-of (car mp)))
|
|
|
335 (if (eq (vm-real-message-of (car mp))
|
|
|
336 (vm-real-message-of (car vm-message-pointer)))
|
|
|
337 (vm-preview-current-message)
|
|
|
338 (vm-update-summary-and-mode-line))))
|
|
|
339 (message "No change."))
|
|
|
340 (vm-display edit-buf nil '(vm-edit-message-end)
|
|
|
341 '(vm-edit-message-end reading-message startup))
|
|
|
342 (set-buffer-modified-p nil)
|
|
|
343 (kill-buffer edit-buf)))
|
|
|
344
|
|
|
345 ;;; Define this function if VM version in use doesn't have it.
|
|
|
346 (or (fboundp 'vm-goto-message-at-point)
|
|
|
347 (defun vm-goto-message-at-point ()
|
|
|
348 "In a VM folder buffer, select the message that contains point."
|
|
|
349 (cond ((fboundp 'vm-update-search-position)
|
|
|
350 (vm-update-search-position t)
|
|
|
351 ;; vm-show-current-message only adjusts (point-max),
|
|
|
352 ;; it doesn't change (point-min).
|
|
|
353 (narrow-to-region
|
|
|
354 (vm-vheaders-of (car vm-message-pointer))
|
|
|
355 (point-max))
|
|
|
356 (vm-show-current-message)
|
|
|
357 (setq vm-system-state 'reading))
|
|
|
358 ((fboundp 'vm-isearch-update)
|
|
|
359 (vm-isearch-update)
|
|
|
360 (narrow-to-region
|
|
|
361 (vm-vheaders-of (car vm-message-pointer))
|
|
|
362 (point-max))
|
|
|
363 (vm-show-current-message)
|
|
|
364 (setq vm-system-state 'reading))
|
|
|
365 (t (error "vm search code is missing, can't continue"))))
|
|
|
366 )
|
|
|
367
|
|
|
368 ;;; Hide any Hyperbole button data when reply to or forward a message.
|
|
|
369 ;;; See "vm-reply.el".
|
|
|
370 (var:append 'vm-mail-mode-hook '(hmail:msg-narrow))
|
|
|
371
|
|
|
372 ;;; Overlay this function from "vm-folder.el" called whenever new mail is
|
|
|
373 ;;; incorporated so that it will highlight Hyperbole buttons when possible.
|
|
|
374 ;; Returns non-nil if there were any new messages.
|
|
114
|
375 (defun vm-assimilate-new-messages (&optional
|
|
|
376 dont-read-attributes
|
|
|
377 gobble-order
|
|
|
378 labels)
|
|
0
|
379 (let ((tail-cons (vm-last vm-message-list))
|
|
|
380 b-list new-messages)
|
|
|
381 (save-excursion
|
|
|
382 (vm-save-restriction
|
|
|
383 (widen)
|
|
|
384 (if (fboundp 'hproperty:but-create)
|
|
|
385 (hproperty:but-create))
|
|
|
386 (vm-build-message-list)
|
|
|
387 (if (or (null tail-cons) (cdr tail-cons))
|
|
|
388 (progn
|
|
|
389 (setq vm-ml-sort-keys nil)
|
|
|
390 (if dont-read-attributes
|
|
|
391 (vm-set-default-attributes (cdr tail-cons))
|
|
|
392 (vm-read-attributes (cdr tail-cons)))
|
|
|
393 ;; Yuck. This has to be done here instead of in the
|
|
|
394 ;; vm function because this needs to be done before
|
|
|
395 ;; any initial thread sort (so that if the thread
|
|
|
396 ;; sort matches the saved order the folder won't be
|
|
|
397 ;; modified) but after the message list is created.
|
|
|
398 ;; Since thread sorting is done here this has to be
|
|
|
399 ;; done here too.
|
|
|
400 (if gobble-order
|
|
|
401 (vm-gobble-message-order))
|
|
|
402 (if vm-thread-obarray
|
|
|
403 (vm-build-threads (cdr tail-cons))))))
|
|
|
404 (setq new-messages (if tail-cons (cdr tail-cons) vm-message-list))
|
|
|
405 (vm-set-numbering-redo-start-point new-messages)
|
|
|
406 (vm-set-summary-redo-start-point new-messages))
|
|
114
|
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)))))
|
|
0
|
420 (if vm-summary-show-threads
|
|
|
421 (progn
|
|
|
422 ;; get numbering and summary of new messages done now
|
|
|
423 ;; so that the sort code only has to worry about the
|
|
|
424 ;; changes it needs to make.
|
|
|
425 (vm-update-summary-and-mode-line)
|
|
|
426 (vm-sort-messages "thread")))
|
|
114
|
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)
|
|
0
|
450 (if (and new-messages vm-virtual-buffers)
|
|
|
451 (save-excursion
|
|
|
452 (setq b-list vm-virtual-buffers)
|
|
|
453 (while b-list
|
|
|
454 ;; buffer might be dead
|
|
|
455 (if (buffer-name (car b-list))
|
|
|
456 (let (tail-cons)
|
|
|
457 (set-buffer (car b-list))
|
|
|
458 (setq tail-cons (vm-last vm-message-list))
|
|
|
459 (vm-build-virtual-message-list new-messages)
|
|
|
460 (if (or (null tail-cons) (cdr tail-cons))
|
|
|
461 (progn
|
|
|
462 (setq vm-ml-sort-keys nil)
|
|
|
463 (if vm-thread-obarray
|
|
|
464 (vm-build-threads (cdr tail-cons)))
|
|
|
465 (vm-set-summary-redo-start-point
|
|
|
466 (or (cdr tail-cons) vm-message-list))
|
|
|
467 (vm-set-numbering-redo-start-point
|
|
|
468 (or (cdr tail-cons) vm-message-list))
|
|
|
469 (if (null vm-message-pointer)
|
|
|
470 (progn (setq vm-message-pointer vm-message-list
|
|
|
471 vm-need-summary-pointer-update t)
|
|
|
472 (if vm-message-pointer
|
|
|
473 (vm-preview-current-message))))
|
|
|
474 (if vm-summary-show-threads
|
|
|
475 (progn
|
|
|
476 (vm-update-summary-and-mode-line)
|
|
|
477 (vm-sort-messages "thread")))))))
|
|
|
478 (setq b-list (cdr b-list)))))
|
|
|
479 new-messages ))
|
|
|
480
|
|
|
481 ;;; Overlay version of 'vm-force-mode-line-update' from "vm-folder.el"
|
|
|
482 ;;; to highlight Hyperbole buttons in summary buffers.
|
|
|
483 (defun vm-force-mode-line-update ()
|
|
|
484 "Force a mode line update in all frames."
|
|
|
485 (if vm-summary-buffer
|
|
|
486 (save-excursion
|
|
|
487 (set-buffer vm-summary-buffer)
|
|
|
488 (if (fboundp 'hproperty:but-create) (hproperty:but-create))))
|
|
|
489 (if (fboundp 'force-mode-line-update)
|
|
|
490 (force-mode-line-update t)
|
|
|
491 (save-excursion
|
|
|
492 (set-buffer (other-buffer))
|
|
|
493 (set-buffer-modified-p (buffer-modified-p)))))
|
|
|
494
|
|
|
495 ;;; ************************************************************************
|
|
|
496 ;;; Private variables
|
|
|
497 ;;; ************************************************************************
|
|
|
498
|
|
|
499 (defvar Vm-msg-start-regexp "\n\nFrom \\|\n\001\001\001\001"
|
|
|
500 "Regular expression that begins a Vm mail message.")
|
|
|
501
|
|
|
502 (provide 'hvm)
|
