Mercurial > hg > xemacs-beta

comparison lisp/vm/vm-page.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 0d2f883870bc
comparison
equal deleted inserted replaced
69:804d1389bcd6 70:131b0175ea99
1 ;;; Commands to move around within a VM message 1 ;;; Commands to move around within a VM message
2 ;;; Copyright (C) 1989-1997 Kyle E. Jones 2 ;;; Copyright (C) 1989, 1990, 1991, 1993, 1994 Kyle E. Jones
3 ;;; 3 ;;;
4 ;;; This program is free software; you can redistribute it and/or modify 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 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) 6 ;;; the Free Software Foundation; either version 1, or (at your option)
7 ;;; any later version. 7 ;;; any later version.
23 If at the end of the current message, moves to the next message iff the 23 If at the end of the current message, moves to the next message iff the
24 value of vm-auto-next-message is non-nil. 24 value of vm-auto-next-message is non-nil.
25 Prefix argument N means scroll forward N lines." 25 Prefix argument N means scroll forward N lines."
26 (interactive "P") 26 (interactive "P")
27 (let ((mp-changed (vm-follow-summary-cursor)) 27 (let ((mp-changed (vm-follow-summary-cursor))
28 needs-decoding
29 (was-invisible nil)) 28 (was-invisible nil))
30 (vm-select-folder-buffer) 29 (vm-select-folder-buffer)
31 (vm-check-for-killed-summary) 30 (vm-check-for-killed-summary)
32 (vm-check-for-killed-presentation)
33 (vm-error-if-folder-empty) 31 (vm-error-if-folder-empty)
34 (setq needs-decoding (and vm-display-using-mime 32 (if (null (vm-get-visible-buffer-window (current-buffer)))
35 (not vm-mime-decoded) 33 (let ((point (point)))
36 (not (vm-mime-plain-message-p 34 (vm-display (current-buffer) t
37 (car vm-message-pointer))) 35 '(vm-scroll-forward vm-scroll-backward)
38 vm-auto-decode-mime-messages 36 (list this-command 'reading-message))
39 (eq vm-system-state 'previewing))) 37 ;; window start sticks to end of clip region when clip
40 (and vm-presentation-buffer 38 ;; region moves back past it in the buffer. fix it.
41 (set-buffer vm-presentation-buffer)) 39 (let ((w (vm-get-visible-buffer-window (current-buffer))))
42 (let ((point (point))
43 (w (vm-get-visible-buffer-window (current-buffer))))
44 (if (or (null w)
45 (not (vm-frame-totally-visible-p (vm-window-frame w))))
46 (progn
47 (vm-display (current-buffer) t
48 '(vm-scroll-forward vm-scroll-backward)
49 (list this-command 'reading-message))
50 ;; window start sticks to end of clip region when clip
51 ;; region moves back past it in the buffer. fix it.
52 (setq w (vm-get-visible-buffer-window (current-buffer)))
53 (if (= (window-start w) (point-max)) 40 (if (= (window-start w) (point-max))
54 (set-window-start w (point-min))) 41 (set-window-start w (point-min))))
55 (setq was-invisible t)))) 42 (setq was-invisible t)))
56 (if (or mp-changed was-invisible needs-decoding 43 (if (or mp-changed was-invisible
57 (and (eq vm-system-state 'previewing) 44 (and (eq vm-system-state 'previewing)
58 (pos-visible-in-window-p 45 (pos-visible-in-window-p
59 (point-max) 46 (point-max)
60 (vm-get-visible-buffer-window (current-buffer))))) 47 (vm-get-visible-buffer-window (current-buffer)))))
61 (progn 48 (progn
114 (let ((vm-message-pointer vmp)) 101 (let ((vm-message-pointer vmp))
115 (vm-emit-eom-blurb))) 102 (vm-emit-eom-blurb)))
116 (t 103 (t
117 (and (> (prefix-numeric-value arg) 0) 104 (and (> (prefix-numeric-value arg) 0)
118 (vm-howl-if-eom))))))) 105 (vm-howl-if-eom)))))))
119 (if (not vm-startup-message-displayed) 106 (if (not (or vm-startup-message-displayed vm-inhibit-startup-message))
120 (vm-display-startup-message))) 107 (vm-display-startup-message)))
121 108
122 (defun vm-scroll-forward-internal (arg) 109 (defun vm-scroll-forward-internal (arg)
123 (let ((direction (prefix-numeric-value arg)) 110 (let ((direction (prefix-numeric-value arg))
124 (w (selected-window))) 111 (w (selected-window)))
125 (condition-case error-data 112 (condition-case error-data
126 (progn (scroll-up arg) nil) 113 (progn (scroll-up arg) nil)
127 ;; this looks like it should work, but doesn't because the
128 ;; redisplay code is schizophrenic when it comes to updates. A
129 ;; window position may no longer be visible but
130 ;; pos-visible-in-window-p will still say it is because it was
131 ;; visible before some window size change happened.
132 ;; (progn
133 ;; (if (and (> direction 0)
134 ;; (pos-visible-in-window-p
135 ;; (vm-text-end-of (car vm-message-pointer))))
136 ;; (signal 'end-of-buffer nil)
137 ;; (scroll-up arg))
138 ;; nil )
139 (error 114 (error
140 (if (or (and (< direction 0) 115 (if (or (and (< direction 0)
141 (> (point-min) (vm-text-of (car vm-message-pointer)))) 116 (> (point-min) (vm-text-of (car vm-message-pointer))))
142 (and (>= direction 0) 117 (and (>= direction 0)
143 (/= (point-max) 118 (/= (point-max)
169 ;; window configuration, while this exploratory scrolling forces 144 ;; window configuration, while this exploratory scrolling forces
170 ;; Emacs to recompute the display, giving us an up to the moment 145 ;; Emacs to recompute the display, giving us an up to the moment
171 ;; answer about where the end of the message is going to be 146 ;; answer about where the end of the message is going to be
172 ;; visible when redisplay finally does occur. 147 ;; visible when redisplay finally does occur.
173 (defun vm-howl-if-eom () 148 (defun vm-howl-if-eom ()
174 (let ((w (get-buffer-window (current-buffer)))) 149 (let ((w (vm-get-visible-buffer-window (current-buffer))))
175 (and w 150 (and w
176 (save-excursion 151 (save-excursion
177 (save-window-excursion 152 (save-window-excursion
178 (condition-case () 153 (condition-case ()
179 (let ((next-screen-context-lines 0)) 154 (let ((next-screen-context-lines 0))
192 (= (vm-text-end-of (car vm-message-pointer)) (point-max)) 167 (= (vm-text-end-of (car vm-message-pointer)) (point-max))
193 (vm-emit-eom-blurb)))) 168 (vm-emit-eom-blurb))))
194 169
195 (defun vm-emit-eom-blurb () 170 (defun vm-emit-eom-blurb ()
196 (if (vm-full-name-of (car vm-message-pointer)) 171 (if (vm-full-name-of (car vm-message-pointer))
197 (message "End of message %s from %s" 172 (vm-unsaved-message "End of message %s from %s"
198 (vm-number-of (car vm-message-pointer)) 173 (vm-number-of (car vm-message-pointer))
199 (vm-full-name-of (car vm-message-pointer))) 174 (vm-full-name-of (car vm-message-pointer)))
200 (message "End of message %s" 175 (vm-unsaved-message "End of message %s"
201 (vm-number-of (car vm-message-pointer))))) 176 (vm-number-of (car vm-message-pointer)))))
202 177
203 (defun vm-scroll-backward (&optional arg) 178 (defun vm-scroll-backward (arg)
204 "Scroll backward a screenful of text. 179 "Scroll backward a screenful of text.
205 Prefix N scrolls backward N lines." 180 Prefix N scrolls backward N lines."
206 (interactive "P") 181 (interactive "P")
207 (vm-scroll-forward (cond ((null arg) '-) 182 (vm-scroll-forward (cond ((null arg) '-)
208 ((consp arg) (list (- (car arg)))) 183 ((consp arg) (list (- (car arg))))
210 ((symbolp arg) nil) 185 ((symbolp arg) nil)
211 (t arg)))) 186 (t arg))))
212 187
213 (defun vm-highlight-headers () 188 (defun vm-highlight-headers ()
214 (cond 189 (cond
215 ((and vm-xemacs-p vm-use-lucid-highlighting) 190 ((and (vm-xemacs-p) vm-use-lucid-highlighting)
216 (require 'highlight-headers) 191 (require 'highlight-headers)
217 ;; disable the url marking stuff, since VM has its own interface. 192 ;; disable the url marking stuff, since VM has its own interface.
218 (let ((highlight-headers-mark-urls nil) 193 (let ((highlight-headers-mark-urls nil)
219 (highlight-headers-regexp (or vm-highlighted-header-regexp 194 (highlight-headers-regexp (or vm-highlighted-header-regexp
220 highlight-headers-regexp))) 195 highlight-headers-regexp)))
221 (highlight-headers (point-min) (point-max) t))) 196 (highlight-headers (point-min) (point-max) t)))
222 (vm-xemacs-p 197 ((vm-xemacs-p)
223 (let (e) 198 (let (e)
224 (map-extents (function 199 (map-extents (function
225 (lambda (e ignore) 200 (lambda (e ignore)
226 (if (extent-property e 'vm-highlight) 201 (if (extent-property e 'vm-highlight)
227 (delete-extent e)) 202 (delete-extent e))
260 (defun vm-energize-urls () 235 (defun vm-energize-urls ()
261 ;; Don't search too long in large regions. If the region is 236 ;; Don't search too long in large regions. If the region is
262 ;; large, search just the head and the tail of the region since 237 ;; large, search just the head and the tail of the region since
263 ;; they tend to contain the interesting text. 238 ;; they tend to contain the interesting text.
264 (let ((search-limit vm-url-search-limit) 239 (let ((search-limit vm-url-search-limit)
265 search-pairs n) 240 (search-pairs))
266 (if (and search-limit (> (- (point-max) (point-min)) search-limit)) 241 (if (and search-limit (> (- (point-max) (point-min)) search-limit))
267 (setq search-pairs (list (cons (point-min) 242 (setq search-pairs (list (cons (point-min)
268 (+ (point-min) (/ search-limit 2))) 243 (+ (point-min) (/ search-limit 2)))
269 (cons (- (point-max) (/ search-limit 2)) 244 (cons (- (point-max) (/ search-limit 2))
270 (point-max)))) 245 (point-max))))
271 (setq search-pairs (list (cons (point-min) (point-max))))) 246 (setq search-pairs (list (cons (point-min) (point-max)))))
272 (cond 247 (cond
273 (vm-xemacs-p 248 ((vm-xemacs-p)
274 (let (e) 249 (let (e)
275 (map-extents (function 250 (map-extents (function
276 (lambda (e ignore) 251 (lambda (e ignore)
277 (if (extent-property e 'vm-url) 252 (if (extent-property e 'vm-url)
278 (delete-extent e)) 253 (delete-extent e))
279 nil)) 254 nil))
280 (current-buffer) (point-min) (point-max)) 255 (current-buffer) (point-min) (point-max))
281 (while search-pairs 256 (while search-pairs
282 (goto-char (car (car search-pairs))) 257 (goto-char (car (car search-pairs)))
283 (while (re-search-forward vm-url-regexp (cdr (car search-pairs)) t) 258 (while (re-search-forward vm-url-regexp (cdr (car search-pairs)) t)
284 (setq n 1) 259 (setq e (make-extent (match-beginning 0) (match-end 0)))
285 (while (null (match-beginning n))
286 (vm-increment n))
287 (setq e (make-extent (match-beginning n) (match-end n)))
288 (set-extent-property e 'vm-url t) 260 (set-extent-property e 'vm-url t)
289 (if vm-highlight-url-face 261 (if vm-highlight-url-face
290 (set-extent-property e 'face vm-highlight-url-face)) 262 (set-extent-property e 'face vm-highlight-url-face))
291 (if vm-url-browser 263 (if vm-url-browser
292 (let ((keymap (make-sparse-keymap)) 264 (let ((keymap (make-sparse-keymap)))
293 (popup-function
294 (if (save-excursion
295 (goto-char (match-beginning n))
296 (looking-at "mailto:"))
297 'vm-menu-popup-mailto-url-browser-menu
298 'vm-menu-popup-url-browser-menu)))
299 (define-key keymap 'button2 'vm-mouse-send-url-at-event) 265 (define-key keymap 'button2 'vm-mouse-send-url-at-event)
300 (if vm-popup-menu-on-mouse-3 266 (define-key keymap 'button3 'vm-menu-popup-url-browser-menu)
301 (define-key keymap 'button3 popup-function))
302 (define-key keymap "\r" 267 (define-key keymap "\r"
303 (function (lambda () (interactive) 268 (function (lambda () (interactive)
304 (vm-mouse-send-url-at-position (point))))) 269 (vm-mouse-send-url-at-position (point)))))
305 (set-extent-property e 'keymap keymap) 270 (set-extent-property e 'keymap keymap)
306 (set-extent-property e 'balloon-help 'vm-url-help) 271 (set-extent-property e 'balloon-help 'vm-url-help)
307 (set-extent-property e 'highlight t)))) 272 (set-extent-property e 'highlight t))))
308 (setq search-pairs (cdr search-pairs))))) 273 (setq search-pairs (cdr search-pairs)))))
309 ((and vm-fsfemacs-19-p 274 ((and (vm-fsfemacs-19-p)
310 (fboundp 'overlay-put)) 275 (fboundp 'overlay-put))
311 (let (o-lists o p) 276 (let (o-lists o p)
312 (setq o-lists (overlay-lists) 277 (setq o-lists (overlay-lists)
313 p (car o-lists)) 278 p (car o-lists))
314 (while p 279 (while p
321 (delete-overlay (car p))) 286 (delete-overlay (car p)))
322 (setq p (cdr p))) 287 (setq p (cdr p)))
323 (while search-pairs 288 (while search-pairs
324 (goto-char (car (car search-pairs))) 289 (goto-char (car (car search-pairs)))
325 (while (re-search-forward vm-url-regexp (cdr (car search-pairs)) t) 290 (while (re-search-forward vm-url-regexp (cdr (car search-pairs)) t)
326 (setq n 1) 291 (setq o (make-overlay (match-beginning 0) (match-end 0)))
327 (while (null (match-beginning n))
328 (vm-increment n))
329 (setq o (make-overlay (match-beginning n) (match-end n)))
330 (overlay-put o 'vm-url t) 292 (overlay-put o 'vm-url t)
331 (if vm-highlight-url-face 293 (if vm-highlight-url-face
332 (overlay-put o 'face vm-highlight-url-face)) 294 (overlay-put o 'face vm-highlight-url-face))
333 (if vm-url-browser 295 (if vm-url-browser
334 (let ((keymap (make-sparse-keymap)) 296 (overlay-put o 'mouse-face 'highlight)))
335 (popup-function
336 (if (save-excursion
337 (goto-char (match-beginning n))
338 (looking-at "mailto:"))
339 'vm-menu-popup-mailto-url-browser-menu
340 'vm-menu-popup-url-browser-menu)))
341 (overlay-put o 'mouse-face 'highlight)
342 (setq keymap (nconc keymap (current-local-map)))
343 (if vm-popup-menu-on-mouse-3
344 (define-key keymap [mouse-3] popup-function))
345 (define-key keymap "\r"
346 (function (lambda () (interactive)
347 (vm-mouse-send-url-at-position (point)))))
348 (overlay-put o 'local-map keymap))))
349 (setq search-pairs (cdr search-pairs)))))))) 297 (setq search-pairs (cdr search-pairs))))))))
350 298
351 (defun vm-energize-headers () 299 (defun vm-energize-headers ()
352 (cond 300 (cond
353 (vm-xemacs-p 301 ((vm-xemacs-p)
354 (let ((search-tuples '(("^From:" vm-menu-author-menu) 302 (let ((search-tuples '(("^From:" vm-menu-author-menu)
355 ("^Subject:" vm-menu-subject-menu))) 303 ("^Subject:" vm-menu-subject-menu)))
356 regexp menu keymap e) 304 regexp menu keymap e)
357 (map-extents (function 305 (map-extents (function
358 (lambda (e ignore) 306 (lambda (e ignore)
374 ;; this case, since there is no default 'select' 322 ;; this case, since there is no default 'select'
375 ;; action. 323 ;; action.
376 (define-key keymap 'button2 324 (define-key keymap 'button2
377 (list 'lambda () '(interactive) 325 (list 'lambda () '(interactive)
378 (list 'popup-menu (list 'quote menu)))) 326 (list 'popup-menu (list 'quote menu))))
379 (if vm-popup-menu-on-mouse-3 327 (define-key keymap 'button3
380 (define-key keymap 'button3 328 (list 'lambda () '(interactive)
381 (list 'lambda () '(interactive) 329 (list 'popup-menu (list 'quote menu))))
382 (list 'popup-menu (list 'quote menu)))))
383 (set-extent-property e 'keymap keymap) 330 (set-extent-property e 'keymap keymap)
384 (set-extent-property e 'balloon-help 'vm-mouse-3-help) 331 (set-extent-property e 'balloon-help 'vm-mouse-3-help)
385 (set-extent-property e 'highlight t)) 332 (set-extent-property e 'highlight t))
386 (setq search-tuples (cdr search-tuples))))) 333 (setq search-tuples (cdr search-tuples)))))
387 ((and vm-fsfemacs-19-p 334 ((and (vm-fsfemacs-19-p)
388 (fboundp 'overlay-put)) 335 (fboundp 'overlay-put))
389 (let ((search-tuples '(("^From:" vm-menu-fsfemacs-author-menu) 336 (let ((search-tuples '(("^From:" vm-menu-fsfemacs-author-menu)
390 ("^Subject:" vm-menu-fsfemacs-subject-menu))) 337 ("^Subject:" vm-menu-fsfemacs-subject-menu)))
391 regexp menu 338 regexp menu
392 o-lists o p) 339 o-lists o p)
431 (set-face-foreground 'vm-xface "black")) 378 (set-face-foreground 'vm-xface "black"))
432 (if (re-search-forward "^X-Face:" nil t) 379 (if (re-search-forward "^X-Face:" nil t)
433 (progn 380 (progn
434 (goto-char (match-beginning 0)) 381 (goto-char (match-beginning 0))
435 (vm-match-header) 382 (vm-match-header)
436 (setq h (concat "X-Face: " (vm-matched-header-contents))) 383 (setq h (vm-matched-header))
437 (setq g (intern h vm-xface-cache)) 384 (setq g (intern h vm-xface-cache))
438 (if (boundp g) 385 (if (boundp g)
439 (setq g (symbol-value g)) 386 (setq g (symbol-value g))
440 (set g (make-glyph 387 (set g (make-glyph h))
441 (list
442 (list 'global (cons '(tty) [nothing]))
443 (list 'global (cons '(win) (vector 'xface ':data h))))))
444 (setq g (symbol-value g)) 388 (setq g (symbol-value g))
445 ;; XXX broken. Gives extra pixel lines at the 389 ;; XXX broken. Gives extra pixel lines at the
446 ;; bottom of the glyph in 19.12 390 ;; bottom of the glyph in 19.12
447 ;;(set-glyph-baseline g 100) 391 ;;(set-glyph-baseline g 100)
448 (set-glyph-face g 'vm-xface)) 392 (set-glyph-face g 'vm-xface))
464 "Mosaic") 408 "Mosaic")
465 ((eq vm-url-browser 'vm-mouse-send-url-to-netscape) 409 ((eq vm-url-browser 'vm-mouse-send-url-to-netscape)
466 "Netscape") 410 "Netscape")
467 (t (symbol-name vm-url-browser))))) 411 (t (symbol-name vm-url-browser)))))
468 412
469 (defun vm-energize-urls-in-message-region (&optional start end) 413 (defun vm-preview-current-message ()
470 (save-excursion 414 (setq vm-system-state 'previewing)
471 (or start (setq start (vm-headers-of (car vm-message-pointer)))) 415 (if vm-real-buffers
472 (or end (setq end (vm-text-end-of (car vm-message-pointer)))) 416 (vm-make-virtual-copy (car vm-message-pointer)))
473 ;; energize the URLs
474 (if (or vm-highlight-url-face vm-url-browser)
475 (save-restriction
476 (widen)
477 (narrow-to-region start end)
478 (vm-energize-urls)))))
479
480 (defun vm-highlight-headers-maybe ()
481 ;; highlight the headers
482 (if (or vm-highlighted-header-regexp
483 (and vm-xemacs-p vm-use-lucid-highlighting))
484 (save-restriction
485 (widen)
486 (narrow-to-region (vm-headers-of (car vm-message-pointer))
487 (vm-text-end-of (car vm-message-pointer)))
488 (vm-highlight-headers))))
489
490 (defun vm-energize-headers-and-xfaces ()
491 ;; energize certain headers
492 (if (and vm-use-menus (vm-menu-support-possible-p))
493 (save-restriction
494 (widen)
495 (narrow-to-region (vm-headers-of (car vm-message-pointer))
496 (vm-text-of (car vm-message-pointer)))
497 (vm-energize-headers)))
498 ;; display xfaces, if we can
499 (if (and vm-display-xfaces
500 vm-xemacs-p
501 (featurep 'xface))
502 (save-restriction
503 (widen)
504 (narrow-to-region (vm-headers-of (car vm-message-pointer))
505 (vm-text-of (car vm-message-pointer)))
506 (vm-display-xface))))
507
508 (defun vm-narrow-for-preview ()
509 (widen) 417 (widen)
510 ;; hide as much of the message body as vm-preview-lines specifies 418 ;; hide as much of the message body as vm-preview-lines specifies
511 (narrow-to-region 419 (narrow-to-region
512 (vm-vheaders-of (car vm-message-pointer)) 420 (vm-vheaders-of (car vm-message-pointer))
513 (cond ((not (eq vm-preview-lines t)) 421 (cond ((not (eq vm-preview-lines t))
515 (vm-text-end-of (car vm-message-pointer)) 423 (vm-text-end-of (car vm-message-pointer))
516 (save-excursion 424 (save-excursion
517 (goto-char (vm-text-of (car vm-message-pointer))) 425 (goto-char (vm-text-of (car vm-message-pointer)))
518 (forward-line (if (natnump vm-preview-lines) vm-preview-lines 0)) 426 (forward-line (if (natnump vm-preview-lines) vm-preview-lines 0))
519 (point)))) 427 (point))))
520 (t (vm-text-end-of (car vm-message-pointer)))))) 428 (t (vm-text-end-of (car vm-message-pointer)))))
521 429 ;; highlight the headers
522 (defun vm-preview-current-message () 430 (if (or vm-highlighted-header-regexp
523 (vm-save-buffer-excursion 431 (and (vm-xemacs-p) vm-use-lucid-highlighting))
524 (setq vm-system-state 'previewing 432 (save-restriction
525 vm-mime-decoded nil) 433 (widen)
526 (if vm-real-buffers 434 (narrow-to-region (vm-headers-of (car vm-message-pointer))
527 (vm-make-virtual-copy (car vm-message-pointer))) 435 (vm-text-end-of (car vm-message-pointer)))
528 436 (vm-highlight-headers)))
529 ;; run the message select hooks. 437 ;; energize the URLs
530 (save-excursion 438 (if (or vm-highlight-url-face vm-url-browser)
531 (vm-select-folder-buffer) 439 (save-restriction
532 (vm-run-message-hook (car vm-message-pointer) 'vm-select-message-hook) 440 (widen)
533 (and vm-select-new-message-hook (vm-new-flag (car vm-message-pointer)) 441 (narrow-to-region (vm-headers-of (car vm-message-pointer))
534 (vm-run-message-hook (car vm-message-pointer) 442 (vm-text-end-of (car vm-message-pointer)))
535 'vm-select-new-message-hook)) 443 (vm-energize-urls)))
536 (and vm-select-unread-message-hook 444 ;; energize certain headers
537 (vm-unread-flag (car vm-message-pointer)) 445 (if (and vm-use-menus (vm-menu-support-possible-p))
538 (vm-run-message-hook (car vm-message-pointer) 446 (save-restriction
539 'vm-select-unread-message-hook))) 447 (widen)
540 448 (narrow-to-region (vm-headers-of (car vm-message-pointer))
541 (vm-narrow-for-preview) 449 (vm-text-of (car vm-message-pointer)))
542 (if (or vm-mime-display-function 450 (vm-energize-headers)))
543 (and vm-display-using-mime 451
544 (not (vm-mime-plain-message-p (car vm-message-pointer))))) 452 ;; display xfaces, if we can
545 (let ((layout (vm-mm-layout (car vm-message-pointer)))) 453 (if (and vm-display-xfaces
546 (vm-make-presentation-copy (car vm-message-pointer)) 454 (vm-xemacs-p)
547 (vm-save-buffer-excursion 455 (vm-multiple-frames-possible-p)
548 (vm-replace-buffer-in-windows (current-buffer) 456 (featurep 'xface))
549 vm-presentation-buffer)) 457 (save-restriction
550 (set-buffer vm-presentation-buffer) 458 (widen)
551 (setq vm-system-state 'previewing) 459 (narrow-to-region (vm-headers-of (car vm-message-pointer))
552 (vm-narrow-for-preview)) 460 (vm-text-of (car vm-message-pointer)))
553 (setq vm-presentation-buffer nil) 461 (vm-display-xface)))
554 (and vm-presentation-buffer-handle 462
555 (vm-replace-buffer-in-windows vm-presentation-buffer-handle 463 (vm-run-message-hook (car vm-message-pointer) 'vm-select-message-hook)
556 (current-buffer)))) 464 (and vm-select-new-message-hook (vm-new-flag (car vm-message-pointer))
557 465 (vm-run-message-hook (car vm-message-pointer)
558 ;; at this point the current buffer is the presentation buffer 466 'vm-select-new-message-hook))
559 ;; if we're using one for this message. 467 (and vm-select-unread-message-hook (vm-unread-flag (car vm-message-pointer))
560 468 (vm-run-message-hook (car vm-message-pointer)
561 (vm-unbury-buffer (current-buffer)) 469 'vm-select-unread-message-hook))
562 (vm-energize-urls-in-message-region) 470
563 (vm-highlight-headers-maybe) 471 (if vm-honor-page-delimiters
564 (vm-energize-headers-and-xfaces) 472 (vm-narrow-to-page))
565 473 (goto-char (vm-text-of (car vm-message-pointer)))
566 (if vm-honor-page-delimiters 474 ;; If we have a window, set window start appropriately.
567 (vm-narrow-to-page)) 475 (let ((w (vm-get-visible-buffer-window (current-buffer))))
568 (goto-char (vm-text-of (car vm-message-pointer))) 476 (if w
569 ;; If we have a window, set window start appropriately. 477 (progn (set-window-start w (point-min))
570 (let ((w (vm-get-visible-buffer-window (current-buffer)))) 478 (set-window-point w (vm-text-of (car vm-message-pointer))))))
571 (if w 479 (if (or (null vm-preview-lines)
572 (progn (set-window-start w (point-min)) 480 (and (not vm-preview-read-messages)
573 (set-window-point w (vm-text-of (car vm-message-pointer)))))) 481 (not (vm-new-flag (car vm-message-pointer)))
574 (if (or (null vm-preview-lines) 482 (not (vm-unread-flag (car vm-message-pointer)))))
575 (and (not vm-preview-read-messages) 483 (vm-show-current-message)
576 (not (vm-new-flag (car vm-message-pointer))) 484 (vm-update-summary-and-mode-line)))
577 (not (vm-unread-flag (car vm-message-pointer)))))
578 (vm-show-current-message)
579 (vm-update-summary-and-mode-line))))
580 485
581 (defun vm-show-current-message () 486 (defun vm-show-current-message ()
582 (and vm-display-using-mime 487 (save-excursion
583 vm-auto-decode-mime-messages 488 (save-excursion
584 (if vm-mail-buffer 489 (goto-char (point-min))
585 (not (vm-buffer-variable-value vm-mail-buffer 'vm-mime-decoded)) 490 (widen)
586 (not vm-mime-decoded)) 491 (narrow-to-region (point) (vm-text-end-of (car vm-message-pointer))))
587 (not (vm-mime-plain-message-p (car vm-message-pointer))) 492 (if vm-honor-page-delimiters
588 (condition-case data 493 (progn
589 (vm-decode-mime-message) 494 (if (looking-at page-delimiter)
590 (vm-mime-error (vm-set-mime-layout-of (car vm-message-pointer) 495 (forward-page 1))
591 (car (cdr data))) 496 (vm-narrow-to-page))))
592 (message "%s" (car (cdr data)))))) 497 ;; don't mark the message as read if the user can't see it!
593 (vm-save-buffer-excursion 498 (if (vm-get-visible-buffer-window (current-buffer))
594 (save-excursion 499 (progn
595 (save-excursion 500 (setq vm-system-state 'showing)
596 (goto-char (point-min)) 501 (cond ((vm-new-flag (car vm-message-pointer))
597 (widen) 502 (vm-set-new-flag (car vm-message-pointer) nil)))
598 (narrow-to-region (point) (vm-text-end-of (car vm-message-pointer)))) 503 (cond ((vm-unread-flag (car vm-message-pointer))
599 (if vm-honor-page-delimiters 504 (vm-set-unread-flag (car vm-message-pointer) nil)))
600 (progn 505 (vm-update-summary-and-mode-line)
601 (if (looking-at page-delimiter) 506 (vm-howl-if-eom))
602 (forward-page 1)) 507 (vm-update-summary-and-mode-line)))
603 (vm-narrow-to-page))))
604 ;; don't mark the message as read if the user can't see it!
605 (if (vm-get-visible-buffer-window (current-buffer))
606 (progn
607 (save-excursion
608 (setq vm-system-state 'showing)
609 (if vm-mail-buffer
610 (vm-set-buffer-variable vm-mail-buffer 'vm-system-state
611 'showing))
612 ;; We could be in the presentation buffer here. Since
613 ;; the presentation buffer's message pointer and sole
614 ;; message are a mockup, they will cause trouble if
615 ;; passed into the undo/update system. So we switch
616 ;; into the real message buffer to do attribute
617 ;; updates.
618 (vm-select-folder-buffer)
619 (cond ((vm-new-flag (car vm-message-pointer))
620 (vm-set-new-flag (car vm-message-pointer) nil)))
621 (cond ((vm-unread-flag (car vm-message-pointer))
622 (vm-set-unread-flag (car vm-message-pointer) nil))))
623 (vm-update-summary-and-mode-line)
624 (vm-howl-if-eom))
625 (vm-update-summary-and-mode-line))))
626 508
627 (defun vm-expose-hidden-headers () 509 (defun vm-expose-hidden-headers ()
628 "Toggle exposing and hiding message headers that are normally not visible." 510 "Toggle exposing and hiding message headers that are normally not visible."
629 (interactive) 511 (interactive)
630 (vm-follow-summary-cursor) 512 (vm-follow-summary-cursor)
631 (vm-select-folder-buffer) 513 (vm-select-folder-buffer)
632 (vm-check-for-killed-summary) 514 (vm-check-for-killed-summary)
633 (vm-check-for-killed-presentation)
634 (vm-error-if-folder-empty) 515 (vm-error-if-folder-empty)
635 (and vm-presentation-buffer
636 (set-buffer vm-presentation-buffer))
637 (vm-display (current-buffer) t '(vm-expose-hidden-headers) 516 (vm-display (current-buffer) t '(vm-expose-hidden-headers)
638 '(vm-expose-hidden-headers reading-message)) 517 '(vm-expose-hidden-headers reading-message))
639 (let* ((exposed (= (point-min) (vm-start-of (car vm-message-pointer))))) 518 (let* ((exposed (= (point-min) (vm-start-of (car vm-message-pointer)))))
640 (vm-widen-page) 519 (vm-widen-page)
641 (goto-char (point-max)) 520 (goto-char (point-max))
680 "Moves to the beginning of the current message." 559 "Moves to the beginning of the current message."
681 (interactive) 560 (interactive)
682 (vm-follow-summary-cursor) 561 (vm-follow-summary-cursor)
683 (vm-select-folder-buffer) 562 (vm-select-folder-buffer)
684 (vm-check-for-killed-summary) 563 (vm-check-for-killed-summary)
685 (vm-check-for-killed-presentation)
686 (vm-error-if-folder-empty) 564 (vm-error-if-folder-empty)
687 (and vm-presentation-buffer
688 (set-buffer vm-presentation-buffer))
689 (vm-widen-page) 565 (vm-widen-page)
690 (push-mark) 566 (push-mark)
691 (vm-display (current-buffer) t '(vm-beginning-of-message) 567 (vm-display (current-buffer) t '(vm-beginning-of-message)
692 '(vm-beginning-of-message reading-message)) 568 '(vm-beginning-of-message reading-message))
693 (let ((osw (selected-window))) 569 (let ((osw (selected-window)))
705 as necessary." 581 as necessary."
706 (interactive) 582 (interactive)
707 (vm-follow-summary-cursor) 583 (vm-follow-summary-cursor)
708 (vm-select-folder-buffer) 584 (vm-select-folder-buffer)
709 (vm-check-for-killed-summary) 585 (vm-check-for-killed-summary)
710 (vm-check-for-killed-presentation)
711 (vm-error-if-folder-empty) 586 (vm-error-if-folder-empty)
712 (and vm-presentation-buffer
713 (set-buffer vm-presentation-buffer))
714 (if (eq vm-system-state 'previewing) 587 (if (eq vm-system-state 'previewing)
715 (vm-show-current-message)) 588 (vm-show-current-message))
716 (setq vm-system-state 'reading) 589 (setq vm-system-state 'reading)
717 (vm-widen-page) 590 (vm-widen-page)
718 (push-mark) 591 (push-mark)