home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 2: Applications / Linux Cubed Series 2 - Applications.iso / editors / emacs / xemacs / xemacs-1.006 / xemacs-1 / lib / xemacs-19.13 / lisp / vm / vm-page.el < prev    next >
Encoding:
Text File  |  1995-08-08  |  21.0 KB  |  603 lines
  1. ;;; Commands to move around within a VM message
  2. ;;; Copyright (C) 1989, 1990, 1991, 1993, 1994 Kyle E. Jones
  3. ;;;
  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
  6. ;;; the Free Software Foundation; either version 1, or (at your option)
  7. ;;; any later version.
  8. ;;;
  9. ;;; This program is distributed in the hope that it will be useful,
  10. ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  11. ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  12. ;;; GNU General Public License for more details.
  13. ;;;
  14. ;;; You should have received a copy of the GNU General Public License
  15. ;;; along with this program; if not, write to the Free Software
  16. ;;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  17.  
  18. (provide 'vm-page)
  19.  
  20. (defun vm-scroll-forward (&optional arg)
  21.   "Scroll forward a screenful of text.
  22. If the current message is being previewed, the message body is revealed.
  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.
  25. Prefix argument N means scroll forward N lines."
  26.   (interactive "P")
  27.   (let ((mp-changed (vm-follow-summary-cursor))
  28.     (was-invisible nil))
  29.     (vm-select-folder-buffer)
  30.     (vm-check-for-killed-summary)
  31.     (vm-error-if-folder-empty)
  32.     (if (null (vm-get-visible-buffer-window (current-buffer)))
  33.     (let ((point (point)))
  34.       (vm-display (current-buffer) t
  35.               '(vm-scroll-forward vm-scroll-backward)
  36.               (list this-command 'reading-message))
  37.       ;; window start sticks to end of clip region when clip
  38.       ;; region moves back past it in the buffer.  fix it.
  39.       (let ((w (vm-get-visible-buffer-window (current-buffer))))
  40.         (if (= (window-start w) (point-max))
  41.         (set-window-start w (point-min))))
  42.       (setq was-invisible t)))
  43.     (if (or mp-changed was-invisible
  44.         (and (eq vm-system-state 'previewing)
  45.          (pos-visible-in-window-p
  46.           (point-max)
  47.           (vm-get-visible-buffer-window (current-buffer)))))
  48.     (progn
  49.       (if (not was-invisible)
  50.           (let ((w (vm-get-visible-buffer-window (current-buffer)))
  51.             old-w-start)
  52.         (setq old-w-start (window-start w))
  53.         (vm-display nil nil '(vm-scroll-forward vm-scroll-backward)
  54.                 (list this-command 'reading-message))
  55.         (setq w (vm-get-visible-buffer-window (current-buffer)))
  56.         (and w (set-window-start w old-w-start))))
  57.       (if (eq vm-system-state 'previewing)
  58.           (vm-show-current-message))
  59.       (vm-howl-if-eom))
  60.       (let ((vmp vm-message-pointer)
  61.         (msg-buf (current-buffer))
  62.         (h-diff 0)
  63.         w old-w old-w-height old-w-start result)
  64.     (if (eq vm-system-state 'previewing)
  65.         (vm-show-current-message))
  66.     (setq vm-system-state 'reading)
  67.     (setq old-w (vm-get-visible-buffer-window msg-buf)
  68.           old-w-height (window-height old-w)
  69.           old-w-start (window-start old-w))
  70.     (vm-display nil nil '(vm-scroll-forward vm-scroll-backward)
  71.             (list this-command 'reading-message))
  72.     (setq w (vm-get-visible-buffer-window msg-buf))
  73.     (if (null w)
  74.         (error "current window configuration hides the message buffer.")
  75.       (setq h-diff (- (window-height w) old-w-height)))
  76.     ;; must restore this since it gets clobbered by window
  77.     ;; teardown and rebuild done by the window config stuff.
  78.     (set-window-start w old-w-start)
  79.     (setq old-w (selected-window))
  80.     (unwind-protect
  81.         (progn
  82.           (select-window w)
  83.           (let ((next-screen-context-lines
  84.              (+ next-screen-context-lines h-diff)))
  85.         (while (eq (setq result (vm-scroll-forward-internal arg))
  86.                'tryagain))
  87.         (cond ((and (not (eq result 'next-message))
  88.                 vm-honor-page-delimiters)
  89.                (vm-narrow-to-page)
  90.                ;; This voodoo is required!  For some
  91.                ;; reason the 18.52 emacs display
  92.                ;; doesn't immediately reflect the
  93.                ;; clip region change that occurs
  94.                ;; above without this mantra. 
  95.                (scroll-up 0)))))
  96.       (select-window old-w))
  97.     (set-buffer msg-buf)
  98.     (cond ((eq result 'next-message)
  99.            (vm-next-message))
  100.           ((eq result 'end-of-message)
  101.            (let ((vm-message-pointer vmp))
  102.          (vm-emit-eom-blurb)))
  103.           (t
  104.            (and (> (prefix-numeric-value arg) 0)
  105.             (vm-howl-if-eom)))))))
  106.   (if (not (or vm-startup-message-displayed vm-inhibit-startup-message))
  107.       (vm-display-startup-message)))
  108.  
  109. (defun vm-scroll-forward-internal (arg)
  110.   (let ((direction (prefix-numeric-value arg))
  111.     (w (selected-window)))
  112.     (condition-case error-data
  113.     (progn (scroll-up arg) nil)
  114.       (error
  115.        (if (or (and (< direction 0)
  116.             (> (point-min) (vm-text-of (car vm-message-pointer))))
  117.            (and (>= direction 0)
  118.             (/= (point-max)
  119.             (vm-text-end-of (car vm-message-pointer)))))
  120.        (progn
  121.          (vm-widen-page)
  122.          (if (>= direction 0)
  123.          (progn
  124.            (forward-page 1)
  125.            (set-window-start w (point))
  126.            nil )
  127.            (if (or (bolp)
  128.                (not (save-excursion
  129.                   (beginning-of-line)
  130.                   (looking-at page-delimiter))))
  131.            (forward-page -1))
  132.            (beginning-of-line)
  133.            (set-window-start w (point))
  134.            'tryagain))
  135.      (if (eq (car error-data) 'end-of-buffer)
  136.          (if vm-auto-next-message
  137.          'next-message
  138.            (set-window-point w (point))
  139.            'end-of-message)))))))
  140.  
  141. ;; exploratory scrolling, what a concept.
  142. ;;
  143. ;; we do this because pos-visible-in-window-p checks the current
  144. ;; window configuration, while this exploratory scrolling forces
  145. ;; Emacs to recompute the display, giving us an up to the moment
  146. ;; answer about where the end of the message is going to be
  147. ;; visible when redisplay finally does occur.
  148. (defun vm-howl-if-eom ()
  149.   (let ((w (vm-get-visible-buffer-window (current-buffer))))
  150.     (and w
  151.      (save-excursion
  152.        (save-window-excursion
  153.          (condition-case ()
  154.          (let ((next-screen-context-lines 0))
  155.            (select-window w)
  156.            (save-excursion
  157.              (save-window-excursion
  158.                ;; scroll-fix.el replaces scroll-up and
  159.                ;; doesn't behave properly when it hits
  160.                ;; end of buffer.  It does this!
  161.                ;; (ding)
  162.                ;; (message (get 'beginning-of-buffer 'error-message))
  163.                (let ((scroll-in-place-replace-original nil))
  164.              (scroll-up nil))))
  165.            nil)
  166.            (error t))))
  167.      (= (vm-text-end-of (car vm-message-pointer)) (point-max))
  168.      (vm-emit-eom-blurb))))
  169.  
  170. (defun vm-emit-eom-blurb ()
  171.   (if (vm-full-name-of (car vm-message-pointer))
  172.       (vm-unsaved-message "End of message %s from %s"
  173.               (vm-number-of (car vm-message-pointer))
  174.               (vm-full-name-of (car vm-message-pointer)))
  175.     (vm-unsaved-message "End of message %s"
  176.             (vm-number-of (car vm-message-pointer)))))
  177.  
  178. (defun vm-scroll-backward (arg)
  179.   "Scroll backward a screenful of text.
  180. Prefix N scrolls backward N lines."
  181.   (interactive "P")
  182.   (vm-scroll-forward (cond ((null arg) '-)
  183.                ((consp arg) (list (- (car arg))))
  184.                ((numberp arg) (- arg))
  185.                ((symbolp arg) nil)
  186.                (t arg))))
  187.  
  188. (defun vm-highlight-headers ()
  189.   (cond
  190.    ((and (vm-xemacs-p) vm-use-lucid-highlighting)
  191.     (require 'highlight-headers)
  192.     ;; disable the url marking stuff, since VM has its own interface.
  193.     (let ((highlight-headers-mark-urls nil)
  194.       (highlight-headers-regexp (or vm-highlighted-header-regexp
  195.                     highlight-headers-regexp)))
  196.       (highlight-headers (point-min) (point-max) t)))
  197.    ((vm-xemacs-p)
  198.     (let (e)
  199.       (map-extents (function
  200.             (lambda (e ignore)
  201.               (if (extent-property e 'vm-highlight)
  202.               (delete-extent e))
  203.               nil))
  204.            (current-buffer) (point-min) (point-max))
  205.       (goto-char (point-min))
  206.       (while (vm-match-header)
  207.     (cond ((vm-match-header vm-highlighted-header-regexp)
  208.            (setq e (make-extent (vm-matched-header-contents-start)
  209.                     (vm-matched-header-contents-end)))
  210.            (set-extent-property e 'face vm-highlighted-header-face)
  211.            (set-extent-property e 'vm-highlight t)))
  212.     (goto-char (vm-matched-header-end)))))
  213.    ((fboundp 'overlay-put)
  214.     (let (o-lists p)
  215.       (setq o-lists (overlay-lists)
  216.         p (car o-lists))
  217.       (while p
  218.     (and (overlay-get (car p) 'vm-highlight)
  219.          (delete-overlay (car p)))
  220.     (setq p (cdr p)))
  221.       (setq p (cdr o-lists))
  222.       (while p
  223.     (and (overlay-get (car p) 'vm-highlight)
  224.          (delete-overlay (car p)))
  225.     (setq p (cdr p)))
  226.       (goto-char (point-min))
  227.       (while (vm-match-header)
  228.     (cond ((vm-match-header vm-highlighted-header-regexp)
  229.            (setq p (make-overlay (vm-matched-header-contents-start)
  230.                      (vm-matched-header-contents-end)))
  231.            (overlay-put p 'face vm-highlighted-header-face)
  232.            (overlay-put p 'vm-highlight t)))
  233.     (goto-char (vm-matched-header-end)))))))
  234.  
  235. (defun vm-energize-urls ()
  236.   ;; Don't search too long in large regions.  If the region is
  237.   ;; large, search just the head and the tail of the region since
  238.   ;; they tend to contain the interesting text.
  239.   (let ((search-limit vm-url-search-limit)
  240.     (search-pairs))
  241.     (if (and search-limit (> (- (point-max) (point-min)) search-limit))
  242.     (setq search-pairs (list (cons (point-min)
  243.                        (+ (point-min) (/ search-limit 2)))
  244.                  (cons (- (point-max) (/ search-limit 2))
  245.                        (point-max))))
  246.       (setq search-pairs (list (cons (point-min) (point-max)))))
  247.     (cond
  248.      ((vm-xemacs-p)
  249.       (let (e)
  250.     (map-extents (function
  251.               (lambda (e ignore)
  252.             (if (extent-property e 'vm-url)
  253.                 (delete-extent e))
  254.             nil))
  255.              (current-buffer) (point-min) (point-max))
  256.     (while search-pairs
  257.       (goto-char (car (car search-pairs)))
  258.       (while (re-search-forward vm-url-regexp (cdr (car search-pairs)) t)
  259.         (setq e (make-extent (match-beginning 0) (match-end 0)))
  260.         (set-extent-property e 'vm-url t)
  261.         (if vm-highlight-url-face
  262.         (set-extent-property e 'face vm-highlight-url-face))
  263.         (if vm-url-browser
  264.         (let ((keymap (make-sparse-keymap)))
  265.           (define-key keymap 'button2 'vm-mouse-send-url-at-event)
  266.           (define-key keymap 'button3 'vm-menu-popup-url-browser-menu)
  267.           (define-key keymap "\r"
  268.             (function (lambda () (interactive)
  269.                 (vm-mouse-send-url-at-position (point)))))
  270.           (set-extent-property e 'keymap keymap)
  271.           (set-extent-property e 'balloon-help 'vm-url-help)
  272.           (set-extent-property e 'highlight t))))
  273.       (setq search-pairs (cdr search-pairs)))))
  274.      ((and (vm-fsfemacs-19-p)
  275.        (fboundp 'overlay-put))
  276.       (let (o-lists o p)
  277.     (setq o-lists (overlay-lists)
  278.           p (car o-lists))
  279.     (while p
  280.       (and (overlay-get (car p) 'vm-url)
  281.            (delete-overlay (car p)))
  282.       (setq p (cdr p)))
  283.     (setq p (cdr o-lists))
  284.     (while p
  285.       (and (overlay-get (car p) 'vm-url)
  286.            (delete-overlay (car p)))
  287.       (setq p (cdr p)))
  288.     (while search-pairs
  289.       (goto-char (car (car search-pairs)))
  290.       (while (re-search-forward vm-url-regexp (cdr (car search-pairs)) t)
  291.         (setq o (make-overlay (match-beginning 0) (match-end 0)))
  292.         (overlay-put o 'vm-url t)
  293.         (if vm-highlight-url-face
  294.         (overlay-put o 'face vm-highlight-url-face))
  295.         (if vm-url-browser
  296.         (overlay-put o 'mouse-face 'highlight)))
  297.       (setq search-pairs (cdr search-pairs))))))))
  298.  
  299. (defun vm-energize-headers ()
  300.   (cond
  301.    ((vm-xemacs-p)
  302.     (let ((search-tuples '(("^From:" vm-menu-author-menu)
  303.                ("^Subject:" vm-menu-subject-menu)))
  304.       regexp menu keymap e)
  305.       (map-extents (function
  306.             (lambda (e ignore)
  307.               (if (extent-property e 'vm-header)
  308.               (delete-extent e))
  309.               nil))
  310.            (current-buffer) (point-min) (point-max))
  311.       (while search-tuples
  312.     (goto-char (point-min))
  313.     (setq regexp (nth 0 (car search-tuples))
  314.           menu (symbol-value (nth 1 (car search-tuples))))
  315.     (while (re-search-forward regexp nil t)
  316.       (save-excursion (goto-char (match-beginning 0)) (vm-match-header))
  317.       (setq e (make-extent (vm-matched-header-contents-start)
  318.                    (vm-matched-header-contents-end)))
  319.       (set-extent-property e 'vm-header t)
  320.       (setq keymap (make-sparse-keymap))
  321.       ;; Might as well make button2 do what button3 does in
  322.       ;; this case, since there is no default 'select'
  323.       ;; action.
  324.       (define-key keymap 'button2
  325.         (list 'lambda () '(interactive)
  326.           (list 'popup-menu (list 'quote menu))))
  327.       (define-key keymap 'button3
  328.         (list 'lambda () '(interactive)
  329.           (list 'popup-menu (list 'quote menu))))
  330.       (set-extent-property e 'keymap keymap)
  331.       (set-extent-property e 'balloon-help 'vm-mouse-3-help)
  332.       (set-extent-property e 'highlight t))
  333.     (setq search-tuples (cdr search-tuples)))))
  334.    ((and (vm-fsfemacs-19-p)
  335.      (fboundp 'overlay-put))
  336.     (let ((search-tuples '(("^From:" vm-menu-fsfemacs-author-menu)
  337.                ("^Subject:" vm-menu-fsfemacs-subject-menu)))
  338.       regexp menu
  339.       o-lists o p)
  340.       (setq o-lists (overlay-lists)
  341.         p (car o-lists))
  342.       (while p
  343.     (and (overlay-get (car p) 'vm-header)
  344.          (delete-overlay (car p)))
  345.     (setq p (cdr p)))
  346.       (setq p (cdr o-lists))
  347.       (while p
  348.     (and (overlay-get (car p) 'vm-header)
  349.          (delete-overlay (car p)))
  350.     (setq p (cdr p)))
  351.       (while search-tuples
  352.     (goto-char (point-min))
  353.     (setq regexp (nth 0 (car search-tuples))
  354.           menu (symbol-value (nth 1 (car search-tuples))))
  355.     (while (re-search-forward regexp nil t)
  356.       (goto-char (match-end 0))
  357.       (save-excursion (goto-char (match-beginning 0)) (vm-match-header))
  358.       (setq o (make-overlay (vm-matched-header-contents-start)
  359.                 (vm-matched-header-contents-end)))
  360.       (overlay-put o 'vm-header menu)
  361.       (overlay-put o 'mouse-face 'highlight))
  362.     (setq search-tuples (cdr search-tuples)))))))
  363.  
  364. (defun vm-display-xface ()
  365.   (let ((case-fold-search t) e g h)
  366.     (if (map-extents (function
  367.               (lambda (e ignore)
  368.             (if (extent-property e 'vm-xface)
  369.                 t
  370.               nil)))
  371.              (current-buffer) (point-min) (point-max))
  372.     nil
  373.       (goto-char (point-min))
  374.       (if (find-face 'vm-xface)
  375.       nil
  376.     (make-face 'vm-xface)
  377.     (set-face-background 'vm-xface "white")
  378.     (set-face-foreground 'vm-xface "black"))
  379.       (if (re-search-forward "^X-Face:" nil t)
  380.       (progn
  381.         (goto-char (match-beginning 0))
  382.         (vm-match-header)
  383.         (setq h (vm-matched-header))
  384.         (setq g (intern h vm-xface-cache))
  385.         (if (boundp g)
  386.         (setq g (symbol-value g))
  387.           (set g (make-glyph h))
  388.           (setq g (symbol-value g))
  389.           ;; XXX broken.  Gives extra pixel lines at the
  390.           ;; bottom of the glyph in 19.12
  391.           ;;(set-glyph-baseline g 100)
  392.           (set-glyph-face g 'vm-xface))
  393.         (setq e (make-extent (vm-vheaders-of (car vm-message-pointer))
  394.                  (vm-vheaders-of (car vm-message-pointer))))
  395.         (set-extent-property e 'vm-xface t)
  396.         (set-extent-begin-glyph e g))))))
  397.  
  398. (defun vm-url-help (object)
  399.   (format
  400.    "Use mouse button 2 to send the URL to %s.
  401. Use mouse button 3 to choose a Web browser for the URL."
  402.    (cond ((stringp vm-url-browser) vm-url-browser)
  403.      ((eq vm-url-browser 'w3-fetch)
  404.       "Emacs W3")
  405.      ((eq vm-url-browser 'w3-fetch-other-frame)
  406.       "Emacs W3")
  407.      ((eq vm-url-browser 'vm-mouse-send-url-to-mosaic)
  408.       "Mosaic")
  409.      ((eq vm-url-browser 'vm-mouse-send-url-to-netscape)
  410.       "Netscape")
  411.      (t (symbol-name vm-url-browser)))))
  412.  
  413. (defun vm-preview-current-message ()
  414.   (setq vm-system-state 'previewing)
  415.   (if vm-real-buffers
  416.       (vm-make-virtual-copy (car vm-message-pointer)))
  417.   (widen)
  418.   ;; hide as much of the message body as vm-preview-lines specifies
  419.   (narrow-to-region
  420.    (vm-vheaders-of (car vm-message-pointer))
  421.    (cond ((not (eq vm-preview-lines t))
  422.       (min
  423.        (vm-text-end-of (car vm-message-pointer))
  424.        (save-excursion
  425.          (goto-char (vm-text-of (car vm-message-pointer)))
  426.          (forward-line (if (natnump vm-preview-lines) vm-preview-lines 0))
  427.          (point))))
  428.       (t (vm-text-end-of (car vm-message-pointer)))))
  429.   ;; highlight the headers
  430.   (if (or vm-highlighted-header-regexp
  431.       (and (vm-xemacs-p) vm-use-lucid-highlighting))
  432.       (save-restriction
  433.     (widen)
  434.     (narrow-to-region (vm-headers-of (car vm-message-pointer))
  435.               (vm-text-end-of (car vm-message-pointer)))
  436.     (vm-highlight-headers)))
  437.   ;; energize the URLs
  438.   (if (or vm-highlight-url-face vm-url-browser)
  439.       (save-restriction
  440.     (widen)
  441.     (narrow-to-region (vm-headers-of (car vm-message-pointer))
  442.               (vm-text-end-of (car vm-message-pointer)))
  443.     (vm-energize-urls)))
  444.   ;; energize certain headers
  445.   (if (and vm-use-menus (vm-menu-support-possible-p))
  446.       (save-restriction
  447.     (widen)
  448.     (narrow-to-region (vm-headers-of (car vm-message-pointer))
  449.               (vm-text-of (car vm-message-pointer)))
  450.     (vm-energize-headers)))
  451.  
  452.   ;; display xfaces, if we can
  453.   (if (and vm-display-xfaces
  454.        (vm-xemacs-p)
  455.        (vm-multiple-frames-possible-p)
  456.        (featurep 'xface))
  457.       (save-restriction
  458.     (widen)
  459.     (narrow-to-region (vm-headers-of (car vm-message-pointer))
  460.               (vm-text-of (car vm-message-pointer)))
  461.     (vm-display-xface)))
  462.  
  463.   (vm-run-message-hook (car vm-message-pointer) 'vm-select-message-hook)
  464.   (and vm-select-new-message-hook (vm-new-flag (car vm-message-pointer))
  465.        (vm-run-message-hook (car vm-message-pointer)
  466.                 'vm-select-new-message-hook))
  467.   (and vm-select-unread-message-hook (vm-unread-flag (car vm-message-pointer))
  468.        (vm-run-message-hook (car vm-message-pointer)
  469.                 'vm-select-unread-message-hook))
  470.  
  471.   (if vm-honor-page-delimiters
  472.       (vm-narrow-to-page))
  473.   (goto-char (vm-text-of (car vm-message-pointer)))
  474.   ;; If we have a window, set window start appropriately.
  475.   (let ((w (vm-get-visible-buffer-window (current-buffer))))
  476.     (if w
  477.     (progn (set-window-start w (point-min))
  478.            (set-window-point w (vm-text-of (car vm-message-pointer))))))
  479.   (if (or (null vm-preview-lines)
  480.       (and (not vm-preview-read-messages)
  481.            (not (vm-new-flag (car vm-message-pointer)))
  482.            (not (vm-unread-flag (car vm-message-pointer)))))
  483.       (vm-show-current-message)
  484.     (vm-update-summary-and-mode-line)))
  485.  
  486. (defun vm-show-current-message ()
  487.   (save-excursion
  488.     (save-excursion
  489.       (goto-char (point-min))
  490.       (widen)
  491.       (narrow-to-region (point) (vm-text-end-of (car vm-message-pointer))))
  492.     (if vm-honor-page-delimiters
  493.     (progn
  494.       (if (looking-at page-delimiter)
  495.           (forward-page 1))
  496.       (vm-narrow-to-page))))
  497.   ;; don't mark the message as read if the user can't see it!
  498.   (if (vm-get-visible-buffer-window (current-buffer))
  499.       (progn
  500.     (setq vm-system-state 'showing)
  501.     (cond ((vm-new-flag (car vm-message-pointer))
  502.            (vm-set-new-flag (car vm-message-pointer) nil)))
  503.     (cond ((vm-unread-flag (car vm-message-pointer))
  504.            (vm-set-unread-flag (car vm-message-pointer) nil)))
  505.     (vm-update-summary-and-mode-line)
  506.     (vm-howl-if-eom))
  507.     (vm-update-summary-and-mode-line)))
  508.  
  509. (defun vm-expose-hidden-headers ()
  510.   "Toggle exposing and hiding message headers that are normally not visible."
  511.   (interactive)
  512.   (vm-follow-summary-cursor)
  513.   (vm-select-folder-buffer)
  514.   (vm-check-for-killed-summary)
  515.   (vm-error-if-folder-empty)
  516.   (vm-display (current-buffer) t '(vm-expose-hidden-headers)
  517.           '(vm-expose-hidden-headers reading-message))
  518.   (let* ((exposed (= (point-min) (vm-start-of (car vm-message-pointer)))))
  519.     (vm-widen-page)
  520.     (goto-char (point-max))
  521.     (widen)
  522.     (if exposed
  523.     (narrow-to-region (point) (vm-vheaders-of (car vm-message-pointer)))
  524.       (narrow-to-region (point) (vm-start-of (car vm-message-pointer))))
  525.     (goto-char (point-min))
  526.     (let (w)
  527.       (setq w (vm-get-visible-buffer-window (current-buffer)))
  528.       (and w (set-window-point w (point-min)))
  529.       (and w
  530.        (= (window-start w) (vm-vheaders-of (car vm-message-pointer)))
  531.        (not exposed)
  532.        (set-window-start w (vm-start-of (car vm-message-pointer)))))
  533.     (if vm-honor-page-delimiters
  534.     (vm-narrow-to-page))))
  535.  
  536. (defun vm-widen-page ()
  537.   (if (or (> (point-min) (vm-text-of (car vm-message-pointer)))
  538.       (/= (point-max) (vm-text-end-of (car vm-message-pointer))))
  539.       (narrow-to-region (vm-vheaders-of (car vm-message-pointer))
  540.             (if (or (vm-new-flag (car vm-message-pointer))
  541.                 (vm-unread-flag (car vm-message-pointer)))
  542.                 (vm-text-of (car vm-message-pointer))
  543.               (vm-text-end-of (car vm-message-pointer))))))
  544.  
  545. (defun vm-narrow-to-page ()
  546.   (save-excursion
  547.     (let (min max (omin (point-min)) (omax (point-max)))
  548.       (if (or (bolp) (not (save-excursion
  549.                 (beginning-of-line)
  550.                 (looking-at page-delimiter))))
  551.       (forward-page -1))
  552.       (setq min (point))
  553.       (forward-page 1)
  554.       (beginning-of-line)
  555.       (setq max (point))
  556.       (narrow-to-region min max))))
  557.  
  558. (defun vm-beginning-of-message ()
  559.   "Moves to the beginning of the current message."
  560.   (interactive)
  561.   (vm-follow-summary-cursor)
  562.   (vm-select-folder-buffer)
  563.   (vm-check-for-killed-summary)
  564.   (vm-error-if-folder-empty)
  565.   (vm-widen-page)
  566.   (push-mark)
  567.   (vm-display (current-buffer) t '(vm-beginning-of-message)
  568.           '(vm-beginning-of-message reading-message))
  569.   (let ((osw (selected-window)))
  570.     (unwind-protect
  571.     (progn
  572.       (select-window (vm-get-visible-buffer-window (current-buffer)))
  573.       (goto-char (point-min)))
  574.       (if (not (eq osw (selected-window)))
  575.       (select-window osw))))
  576.   (if vm-honor-page-delimiters
  577.       (vm-narrow-to-page)))
  578.  
  579. (defun vm-end-of-message ()
  580.   "Moves to the end of the current message, exposing and flagging it read
  581. as necessary."
  582.   (interactive)
  583.   (vm-follow-summary-cursor)
  584.   (vm-select-folder-buffer)
  585.   (vm-check-for-killed-summary)
  586.   (vm-error-if-folder-empty)
  587.   (if (eq vm-system-state 'previewing)
  588.       (vm-show-current-message))
  589.   (setq vm-system-state 'reading)
  590.   (vm-widen-page)
  591.   (push-mark)
  592.   (vm-display (current-buffer) t '(vm-end-of-message)
  593.           '(vm-end-of-message reading-message))
  594.   (let ((osw (selected-window)))
  595.     (unwind-protect
  596.     (progn
  597.       (select-window (vm-get-visible-buffer-window (current-buffer)))
  598.       (goto-char (point-max)))
  599.       (if (not (eq osw (selected-window)))
  600.       (select-window osw))))
  601.   (if vm-honor-page-delimiters
  602.       (vm-narrow-to-page)))
  603.