kjones@talos.UUCP (Kyle Jones) (05/24/89)
This is the first of three messages containing the Emacs-Lisp source and
documentation for the VM (View Mail) mail reader.
Those of you who've wanted to read mail under Emacs but didn't want to
expose your mail folders to RMAIL will be cheered to hear that VM works
with UNIX style mail folders in their original format.
Thanks go to my faithful beta-testers, Tad Guy, Mike Walker, and Scott
Yelich who cheerfully abused VM and imperiled their mail in VM's
unstable early days.
`M-x vm' gets you going. Type a ? for help. There's an Info document
if you care to go that route, but the help should be enough for most.
Send suggestions and bug reports to the e-mail addresses below.
kyle jones <kyle@cs.odu.edu> ...!uunet!talos!kjones
----------
#!/bin/sh
# shar: Shell Archiver (v1.22)
#
# Run the following text with /bin/sh to create:
# vm.el
#
sed 's/^X//' << 'SHAR_EOF' > vm.el &&
X;;; UNIX style mail reader for GNU Emacs
X;;; Copyright (C) 1989 Kyle E. Jones
X;;;
X;;; This program is free software; you can redistribute it and/or modify
X;;; it under the terms of the GNU General Public License as published by
X;;; the Free Software Foundation; either version 1, or (at your option)
X;;; any later version.
X;;;
X;;; This program is distributed in the hope that it will be useful,
X;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
X;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
X;;; GNU General Public License for more details.
X;;;
X;;; You should have received a copy of the GNU General Public License
X;;; along with this program; if not, write to the Free Software
X;;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
X
X;; This is a set of Emacs-Lisp commands and support functions for
X;; reading mail. While a mail reader (RMAIL) is distributed with GNU
X;; Emacs it converts a user's mailbox to BABYL format, a behavior I
X;; find quite unpalatable.
X;;
X;; VM is similar to RMAIL in that it scoops mail from the system mailbox
X;; into a primary inbox for reading, but the similarity ends there.
X;; VM does not reformat the mailbox beyond reordering the headers
X;; according to user preference, and adding a header used internally to
X;; store message attributes.
X;;
X;; Entry points to VM are the commands vm and vm-visit-folder.
X;;
X;; If autoloading then the lines:
X;; (autoload 'vm "vm" nil t)
X;; (autoload 'vm-visit-folder "vm" nil t)
X;; should appear in a user's .emacs or in default.el in the lisp
X;; directory of the Emacs distribution.
X;;
X;; VM requires Emacs' etc/movemail to work on your system.
X
X(provide 'vm)
X
X(defvar vm-primary-inbox "~/INBOX"
X "*Mail is moved from the system mailbox to this file for reading.")
X
X(defvar vm-crash-box "~/INBOX.CRASH"
X "*File in which to store mail temporarily while it is transferrred from
Xthe system mailbox to the primary inbox. If the something happens
Xduring this mail transfer, any missing mail will be found in this file.
XVM will do crash recovery from this file automatically at startup, as
Xnecessary.")
X
X(defvar vm-visible-headers
X '("From:" "Sender:" "To:" "Apparently-To:" "Cc:" "Subject:" "Date:")
X "*List of headers that should be visible when VM first displays a message.
XThese should be listed in the order you wish them presented.
XRegular expressions are allowed.")
X
X(defvar vm-highlighted-header-regexp nil
X "*Regular expression that matches the beginnings of headers that should
Xbe highlighted when a message is first presented. For exmaple setting
Xthis variable to \"^From\\\\|^Subject\" causes the From: and Subject:
Xheaders to be highlighted.")
X
X(defvar vm-preview-lines 0
X "*Non-nil value N causes VM to display the visible headers + N lines of text
Xfrom a message when it is first presented. The message is not actually marked
Xas read until the message is exposed in its entirety. Nil causes VM not to
Xpreview a message at all; it is displayed in its entirety when first
Xpresented and is marked as read.")
X
X(defvar vm-folder-directory nil
X "*Directory where folders of mail are kept.")
X
X(defvar vm-included-text-prefix " > "
X "*String used to prefix included text in replies.")
X
X(defvar vm-auto-folder-alist nil
X "*Non-nil value should be an alist that VM will use to choose a default
Xfolder name when messages are saved. The alist should be of the form
X\((HEADER-NAME
X (REGEXP . FOLDER-NAME) ...
X ...))
Xwhere HEADER-NAME, REGEXP, and FOLDER-NAME are all strings.
X
XIf any part of the contents of the message header named by HEADER-NAME
Xis matched by the regular expression REGEXP, VM will use the
Xcorresponding FOLDER-NAME as the default when prompting for a folder to
Xsave the message in. If FOLDER-NAME is a relative pathname it resolves
Xto the directory named by vm-folder-directory, or the default-directory
Xof the currently visited folder if vm-folder-directory is nil.
X
XMatching is case sensitive.")
X
X(defvar vm-visit-when-saving nil
X "*Non-nil causes VM to visit folders when saving messages. This means
XVM will read the folder into Emacs and append the message to the buffer
Xinstead of appending to the folder file directly. This behavior is
Xideal when folders are encrypted or compressed since appending plaintext
Xto such files is a ghastly mistake.
X
XNote the setting of this variable does not affect how the primary inbox
Xis accessed, i.e. the primary inbox must be a plaintext file.")
X
X(defvar vm-included-text-attribution-format "%F writes:\n"
X "*String which specifies the format of the attribution that precedes the
Xincluded text from a message in a reply. See the documentation for the
Xvaraible vm-summary-format for information on what this string may contain.
XNil means don't attribute included text in replies.")
X
X(defvar vm-summary-format "%2n %a %-17.17F %3m %2d %3l/%-5c \"%s\"\n"
X "*String which specifies the message summary line format.
XThe string may contain the printf-like `%' conversion specifiers which
Xsubstitute information about the message into the final summary line.
X
XRecognized specifiers are:
X a - attribute indicators (always three characters wide)
X The first char is `D', `N', `U' or ` ' for deleted, new, unread
X and read message respectively.
X The second char is `F' for filed (saved) messages.
X The third char is `R' if the message has been replied to.
X c - number of characters in message (ignoring headers)
X d - date of month message sent
X f - author's address
X F - author's full name (same as f if full name not found)
X h - hour message sent
X i - message ID
X l - number of lines in message (ignoring headers)
X m - month message sent
X n - message number
X s - message subject
X w - day of the week message sent
X y - year message sent
X z - timezone of date when the message was sent
X
XUse %% to get a single %.
X
XA numeric field width may be specified between the `%' and the specifier;
Xthis causes right justification of the substituted string. A negative field
Xwidth causes left justification.
X
XThe field width may be followed by a `.' and a number specifying the maximum
Xallowed length of the substituted string. If the string is longer than this
Xvalue it is truncated.
X
XThe summary format need not be one line per message but it must end with
Xa newline, otherwise the message pointer will not be displayed correctly
Xin the summary window.")
X
X(defvar vm-mail-window-percentage 75
X "*Percentage of the screen that should be used to show mail messages.
XThe rest of the screen will be used by the summary buffer, if displayed.")
X
X(defvar vm-startup-with-summary nil
X "*Value tells VM what to display when a folder is visited.
XNil means display folder only, t means display the summary only. A
Xvalue that is neither t not nil means to display both folder and summary.
XSee the documentation for vm-mail-window-percentage to see how to change how
Xthe screeen is apportioned between the folder and summary windows.")
X
X(defvar vm-group-by nil
X "*Non-nil value tells VM how to group message presentation.
XCurrently, the valid non-nil values for this variable are
X \"subject\", which causes messages with the same subject (ignoring
X Re:'s) to be presented together,
X \"author\", which causes messages with the same author to be presented
X together, and
X \"date-sent\", which causes message sent on the same day to be
X presented together.
X \"arrival-time\" which appears only for completeness, this is the
X default behavior and is the same as nil.
X
XThe ordering of the messages in the mailbox itself is not altered, messages
Xare simply numbered and ordered differently internally.")
X
X(defvar vm-skip-deleted-messages t
X "*Non-nil value causes VM's `n' and 'p' commands to skip over
Xdeleted messages. If all messages are marked deleted then this variable
Xis, of course, ignored.")
X
X(defvar vm-skip-read-messages nil
X "*Non-nil value causes VM's `n' and `p' commands to skip over
Xmessage that have already been read in favor of new or unread messages.
XIf there are no unread message then this variable is, of course, ignored.")
X
X(defvar vm-search-using-regexps nil
X "*Non-nil value causes VM's search command will interpret user input as a
Xregular expression instead of as a literal string.")
X
X(defvar vm-mode-hooks nil
X "*List of hook functions to run when a buffer enters vm-mode.
XThese hook functions should generally be used to set key bindings
Xand local variables. Mucking about in the folder buffer is certainly
Xpossible but it is not encouraged.")
X
X(defvar vm-berkeley-mail-compatibility
X (memq system-type '(berkeley-unix))
X "*Non-nil means to read and write BSD Mail(1) style Status: headers.
XThis makes sense if you plan to use VM to read mail archives created by
XMail.")
X
X(defvar vm-gargle-uucp nil
X "*Non-nil value means to use a crufty regular expression that does
Xsurprisingly well at beautifying UUCP addresses that are substitued for
X%f as part of summary and attribution formats.")
X
X(defvar vm-rfc934-forwarding t
X "*Non-nil value causes VM to use char stuffing as described in RFC 934
Xwhen packaging a message to be forwarded. This will allow the recipient
Xto use a standard bursting agent on the message and act upon it as if it
Xwere sent directly.")
X
X(defvar vm-inhibit-startup-message nil
X "*Non-nil causes VM not to display its copyright notice, disclaimers
Xetc. when started in the usual way.")
X
X(defvar vm-mode-map nil
X "Keymap for VM mode and VM Summary mode.")
X
X(defconst vm-version "4.10"
X "Version number of VM.")
X
X;; internal vars
X(defvar vm-message-list nil)
X(make-variable-buffer-local 'vm-message-list)
X(defvar vm-message-pointer nil)
X(make-variable-buffer-local 'vm-message-pointer)
X(defvar vm-last-message-pointer nil)
X(make-variable-buffer-local 'vm-last-message-pointer)
X(defvar vm-primary-inbox-p nil)
X(make-variable-buffer-local 'vm-primary-inbox-p)
X(defvar vm-visible-header-alist nil)
X(make-variable-buffer-local 'vm-visible-header-alist)
X(defvar vm-mail-buffer nil)
X(make-variable-buffer-local 'vm-mail-buffer)
X(defvar vm-summary-buffer nil)
X(make-variable-buffer-local 'vm-summary-buffer)
X(defvar vm-system-state nil)
X(make-variable-buffer-local 'vm-system-state)
X(defvar vm-undo-record-list nil)
X(make-variable-buffer-local 'vm-undo-record-list)
X(defvar vm-undo-record-pointer nil)
X(make-variable-buffer-local 'vm-undo-record-pointer)
X(defvar vm-messages-needing-display-update nil)
X(make-variable-buffer-local 'vm-messages-needing-display-update)
X(defvar vm-current-grouping nil)
X(make-variable-buffer-local 'vm-current-grouping)
X(defvar vm-inhibit-write-file-hook nil)
X(defvar vm-session-beginning t)
X(defvar vm-compiled-summary-format nil)
X(defvar vm-compiled-summary-sexp nil)
X(defvar vm-compiled-included-text-attribution-format nil)
X(defvar vm-compiled-included-text-attribution-sexp nil)
X(defconst vm-spool-directory
X (or (and (boundp 'rmail-spool-directory) rmail-spool-directory)
X "/usr/spool/mail"))
X(defconst vm-attributes-header-regexp
X "^X-VM-Attributes:\\(.*\n\\([ \t]+.*\n\\)*\\)")
X(defconst vm-attributes-header "X-VM-Attributes:")
X(defconst vm-berkeley-mail-status-header "Status: ")
X(defconst vm-berkeley-mail-status-header-regexp "^Status: ..?\n")
X(defconst vm-generic-header-regexp "^[^:\n]+:\\(.*\n\\([ \t]+.*\n\\)*\\)")
X(defconst vm-header-regexp-format "^%s:[ \t]*\\(.*\\(\n[ \t]+.*\\)*\\)")
X(defconst vm-supported-groupings-alist
X '(("arrival-time") ("subject") ("author") ("date-sent")))
X(defconst vm-total-count 0)
X(defconst vm-new-count 0)
X(defconst vm-unread-count 0)
X;; for the mode line
X(defvar vm-ml-message-number nil)
X(make-variable-buffer-local 'vm-ml-message-number)
X(defvar vm-ml-highest-message-number nil)
X(make-variable-buffer-local 'vm-ml-highest-message-number)
X(defvar vm-ml-attributes-string nil)
X(make-variable-buffer-local 'vm-ml-attributes-string)
X
X;; general purpose macros and functions
X(defmacro vm-marker (pos &optional buffer)
X (list 'set-marker '(make-marker) pos buffer))
X
X(defmacro vm-increment (variable)
X (list 'setq variable (list '1+ variable)))
X
X(defmacro vm-decrement (variable)
X (list 'setq variable (list '1- variable)))
X
X(defun vm-abs (n) (if (< n 0) (- n) n))
X
X;; save-restriction flubs restoring the clipping region if you modify
X;; (widen) and modify text outside the old region.
X;; This should do it right.
X(defmacro vm-save-restriction (&rest forms)
X (list 'let '((vm-sr-min (set-marker (make-marker) (point-min)))
X (vm-sr-max (set-marker (make-marker) (point-max))))
X (list 'unwind-protect (cons 'progn forms)
X '(widen)
X '(narrow-to-region vm-sr-min vm-sr-max))))
X
X;; macros and functions dealing with accessing messages struct fields
X(defun vm-make-message () (make-vector 20 nil))
X
X;; where message begins (From_ line)
X(defmacro vm-start-of (message) (list 'aref message 0))
X;; where visible headers start
X(defun vm-vheaders-of (message)
X (or (aref message 1)
X (progn (vm-reorder-message-headers message)
X (aref message 1))))
X;; where text section starts
X(defmacro vm-text-of (message) (list 'aref message 2))
X;; where message ends
X(defmacro vm-end-of (message) (list 'aref message 3))
X;; message number
X(defmacro vm-number-of (message) (list 'aref message 4))
X;; message attribute vector
X(defmacro vm-attributes-of (message) (list 'aref message 5))
X(defmacro vm-new-flag (message) (list 'aref (list 'aref message 5) 0))
X(defmacro vm-unread-flag (message) (list 'aref (list 'aref message 5) 1))
X(defmacro vm-deleted-flag (message) (list 'aref (list 'aref message 5) 2))
X(defmacro vm-filed-flag (message) (list 'aref (list 'aref message 5) 3))
X(defmacro vm-replied-flag (message) (list 'aref (list 'aref message 5) 4))
X;; message size in bytes (as a string)
X(defmacro vm-byte-count-of (message) (list 'aref message 6))
X;; weekday sent
X(defmacro vm-weekday-of (message) (list 'aref message 7))
X;; month day
X(defmacro vm-monthday-of (message) (list 'aref message 8))
X;; month sent
X(defmacro vm-month-of (message) (list 'aref message 9))
X;; year sent
X(defmacro vm-year-of (message) (list 'aref message 10))
X;; hour sent
X(defmacro vm-hour-of (message) (list 'aref message 11))
X;; timezone
X(defmacro vm-zone-of (message) (list 'aref message 12))
X;; message author's full name (Full-Name: or gouged from From:)
X(defmacro vm-full-name-of (message) (list 'aref message 13))
X;; message author address (gouged from From:)
X(defmacro vm-from-of (message) (list 'aref message 14))
X;; message ID (Message-Id:)
X(defmacro vm-message-id-of (message) (list 'aref message 15))
X;; number of lines in message (as a string)
X(defmacro vm-line-count-of (message) (list 'aref message 16))
X;; message subject (Subject:)
X(defmacro vm-subject-of (message) (list 'aref message 17))
X(defmacro vm-su-start-of (message) (list 'aref message 18))
X(defmacro vm-su-end-of (message) (list 'aref message 19))
X
X(defmacro vm-set-start-of (message start) (list 'aset message 0 start))
X(defmacro vm-set-vheaders-of (message vh) (list 'aset message 1 vh))
X(defmacro vm-set-text-of (message text) (list 'aset message 2 text))
X(defmacro vm-set-end-of (message end) (list 'aset message 3 end))
X(defmacro vm-set-number-of (message n) (list 'aset message 4 n))
X(defmacro vm-set-attributes-of (message attrs) (list 'aset message 5 attrs))
X(defmacro vm-set-byte-count-of (message count) (list 'aset message 6 count))
X(defmacro vm-set-weekday-of (message val) (list 'aset message 7 val))
X(defmacro vm-set-monthday-of (message val) (list 'aset message 8 val))
X(defmacro vm-set-month-of (message val) (list 'aset message 9 val))
X(defmacro vm-set-year-of (message val) (list 'aset message 10 val))
X(defmacro vm-set-hour-of (message val) (list 'aset message 11 val))
X(defmacro vm-set-zone-of (message val) (list 'aset message 12 val))
X(defmacro vm-set-full-name-of (message author) (list 'aset message 13 author))
X(defmacro vm-set-from-of (message author) (list 'aset message 14 author))
X(defmacro vm-set-message-id-of (message id) (list 'aset message 15 id))
X(defmacro vm-set-line-count-of (message count) (list 'aset message 16 count))
X(defmacro vm-set-subject-of (message subject) (list 'aset message 17 subject))
X(defmacro vm-set-su-start-of (message start) (list 'aset message 18 start))
X(defmacro vm-set-su-end-of (message end) (list 'aset message 19 end))
X
X;; The remaining routines in this group are part of the undo system.
X
X;; init
X(if vm-mode-map
X ()
X (setq vm-mode-map (make-keymap))
X (suppress-keymap vm-mode-map)
X (define-key vm-mode-map "h" 'vm-summarize)
X (define-key vm-mode-map "\M-n" 'vm-next-unread-message)
X (define-key vm-mode-map "\M-p" 'vm-previous-unread-message)
X (define-key vm-mode-map "n" 'vm-next-message)
X (define-key vm-mode-map "p" 'vm-previous-message)
X (define-key vm-mode-map "N" 'vm-Next-message)
X (define-key vm-mode-map "P" 'vm-Previous-message)
X (define-key vm-mode-map "\t" 'vm-goto-message-last-seen)
X (define-key vm-mode-map "\r" 'vm-goto-message)
X (define-key vm-mode-map "t" 'vm-expose-hidden-headers)
X (define-key vm-mode-map " " 'vm-scroll-forward)
X (define-key vm-mode-map "b" 'vm-scroll-backward)
X (define-key vm-mode-map "d" 'vm-delete-message)
X (define-key vm-mode-map "u" 'vm-undelete-message)
X (define-key vm-mode-map "k" 'vm-kill-subject)
X (define-key vm-mode-map "f" 'vm-followup)
X (define-key vm-mode-map "F" 'vm-followup-include-text)
X (define-key vm-mode-map "r" 'vm-reply)
X (define-key vm-mode-map "R" 'vm-reply-include-text)
X (define-key vm-mode-map "z" 'vm-forward-message)
X (define-key vm-mode-map "@" 'vm-send-digest)
X (define-key vm-mode-map "*" 'vm-burst-digest)
X (define-key vm-mode-map "m" 'vm-mail)
X (define-key vm-mode-map "g" 'vm-get-new-mail)
X (define-key vm-mode-map "G" 'vm-group-messages)
X (define-key vm-mode-map "v" 'vm-visit-folder)
X (define-key vm-mode-map "s" 'vm-save-message)
X (define-key vm-mode-map "w" 'vm-save-message-sans-headers)
X (define-key vm-mode-map "A" 'vm-auto-archive-messages)
X (define-key vm-mode-map "S" 'vm-save-folder)
X (define-key vm-mode-map "|" 'vm-pipe-message-to-command)
X (define-key vm-mode-map "#" 'vm-expunge-folder)
X (define-key vm-mode-map "q" 'vm-quit)
X (define-key vm-mode-map "x" 'vm-quit-no-change)
X (define-key vm-mode-map "?" 'vm-help)
X (define-key vm-mode-map "\C-_" 'vm-undo)
X (define-key vm-mode-map "\C-xu" 'vm-undo)
X (define-key vm-mode-map "!" 'shell-command)
X (define-key vm-mode-map "<" 'beginning-of-buffer)
X (define-key vm-mode-map ">" 'vm-end-of-message)
X (define-key vm-mode-map "\M-s" 'vm-isearch-forward)
X (define-key vm-mode-map "=" 'vm-summarize)
X (define-key vm-mode-map "\M-C" 'vm-show-copying-restrictions)
X (define-key vm-mode-map "\M-W" 'vm-show-no-warranty))
X
X(defun vm-mark-for-display-update (message)
X (if (not (memq message vm-messages-needing-display-update))
X (setq vm-messages-needing-display-update
X (cons message vm-messages-needing-display-update))))
X
X(defun vm-last (list) (while (cdr-safe list) (setq list (cdr list))) list)
X
X(put 'mailbox-empty 'error-conditions '(mailbox-empty error))
X(put 'mailbox-empty 'error-message "Mailbox is empty")
X
X(defun vm-error-if-mailbox-empty ()
X (while (null vm-message-list)
X (signal 'mailbox-empty nil)))
X
X(defun vm-proportion-windows ()
X (if vm-mail-buffer
X (set-buffer vm-mail-buffer))
X (if (not (one-window-p t))
X (let ((mail-w (get-buffer-window (current-buffer)))
X (n (- (window-height (get-buffer-window (current-buffer)))
X (/ (* vm-mail-window-percentage
X (- (screen-height)
X (window-height (minibuffer-window))))
X 100)))
X (old-w (selected-window)))
X (if mail-w
X (save-excursion
X (select-window mail-w)
X (shrink-window n)
X (select-window old-w))))))
X
X(defun vm-number-messages ()
X (let ((n 1) (message-list vm-message-list))
X (while message-list
X (vm-set-number-of (car message-list) (int-to-string n))
X (setq n (1+ n) message-list (cdr message-list)))
X (setq vm-ml-highest-message-number (int-to-string (1- n)))))
X
X(defun vm-match-visible-header (alist)
X (catch 'match
X (while alist
X (if (looking-at (car (car alist)))
X (throw 'match (car alist)))
X (setq alist (cdr alist)))
X nil))
X
X(defun vm-delete-header ()
X (if (looking-at vm-generic-header-regexp)
X (delete-region (match-beginning 0) (match-end 0))))
X
X;; Build a chain of message structures.
X;; Find the start and end of each message and fill end the relevant
X;; fields in the message structures.
X
X(defun vm-build-message-list ()
X (save-excursion
X (vm-build-visible-header-alist)
X (let (tail-cons message prev-message case-fold-search marker)
X (if vm-message-list
X (let ((mp vm-message-list)
X (end (point-min)))
X (while mp
X (if (< end (vm-end-of (car mp)))
X (setq end (vm-end-of (car mp))))
X (setq mp (cdr mp)))
X ;; the -2 is for the \n\n before the "From "
X (goto-char (- end 2))
X (setq tail-cons (vm-last vm-message-list)))
X (goto-char (point-min))
X (if (looking-at "^From ")
X (progn
X (setq message (vm-make-message) prev-message message)
X (vm-set-start-of message (vm-marker (match-beginning 0)))
X (setq vm-message-list (list message)
X tail-cons vm-message-list))))
X (while (search-forward "\n\nFrom " nil t)
X (setq marker (vm-marker (+ 2 (match-beginning 0)))
X message (vm-make-message))
X (vm-set-start-of message marker)
X (if prev-message
X (vm-set-end-of prev-message marker))
X (if tail-cons
X (progn
X (setcdr tail-cons (list message))
X (setq tail-cons (cdr tail-cons)
X prev-message message))
X (setq vm-message-list (list message)
X tail-cons vm-message-list
X prev-message message)))
X (if prev-message
X (vm-set-end-of prev-message (vm-marker (point-max)))))))
X
X(defun vm-build-visible-header-alist ()
X (let ((header-alist (cons nil nil))
X (vheaders vm-visible-headers)
X list)
X (setq list header-alist)
X (while vheaders
X (setcdr list (cons (cons (car vheaders) nil) nil))
X (setq list (cdr list) vheaders (cdr vheaders)))
X (setq vm-visible-header-alist (cdr header-alist))))
X
X;; Group the headers that the user wants to see at the end of the headers
X;; section so we can narrow to them. The vheaders field of the
X;; message struct is set. This function is called on demand whenever
X;; a vheaders field is discovered to be nil for a particular message.
X
X(defun vm-reorder-message-headers (message)
X (save-excursion
X (vm-save-restriction
X (let ((header-alist vm-visible-header-alist) list buffer-read-only
X (inhibit-quit t)
X (old-buffer-modified-p (buffer-modified-p)))
X (goto-char (vm-start-of message))
X (forward-line)
X (while (not (= (following-char) ?\n))
X (setq list (vm-match-visible-header header-alist))
X ;; cannot fail, looking-at used to set match data
X (looking-at vm-generic-header-regexp)
X (if (null list)
X (goto-char (match-end 0))
X (if (cdr list)
X (setcdr list
X (concat
X (cdr list)
X (buffer-substring (match-beginning 0)
X (match-end 0))))
X (setcdr list (buffer-substring (match-beginning 0)
X (match-end 0))))
X (delete-region (match-beginning 0) (match-end 0))))
X (vm-set-vheaders-of message (point-marker))
X (setq list header-alist)
X (while list
X (if (cdr (car list))
X (progn
X (insert (cdr (car list)))
X (setcdr (car list) nil)))
X (setq list (cdr list)))
X (set-buffer-modified-p old-buffer-modified-p)))))
X
X;; Read the attribute headers from the messages and store their contents
X;; in attributes fields of the message structures. If a message has no
X;; attributes header assume it is new. If a message already has
X;; attributes don't bother checking the headers.
X;;
X;; Stores the position where the message text begins in the message struct.
X
X(defun vm-read-attributes ()
X (save-excursion
X (let ((mp vm-message-list))
X (setq vm-new-count 0
X vm-unread-count 0
X vm-total-count 0)
X (while mp
X (vm-increment vm-total-count)
X (if (vm-attributes-of (car mp))
X ()
X (goto-char (vm-start-of (car mp)))
X (search-forward "\n\n" (vm-end-of (car mp)) 0)
X (vm-set-text-of (car mp) (point-marker))
X (goto-char (vm-start-of (car mp)))
X (cond ((re-search-forward vm-attributes-header-regexp
X (vm-text-of (car mp)) t)
X (goto-char (match-beginning 1))
X (vm-set-attributes-of (car mp)
X (condition-case ()
X (read (current-buffer))
X (error (vector t nil nil nil nil))))
X ;; If attributes are unrecogniable just assume the
X ;; message is new.
X (cond ((or (not (vectorp (vm-attributes-of (car mp))))
X (not (= (length (vm-attributes-of (car mp)))
X 5)))
X (vm-set-attributes-of (car mp)
X (vector t nil nil nil nil)))))
X ((and vm-berkeley-mail-compatibility
X (re-search-forward vm-berkeley-mail-status-header-regexp
X (vm-text-of (car mp)) t))
X (vm-set-attributes-of (car mp) (vector nil (looking-at "R")
X nil nil nil)))
X (t
X (vm-set-attributes-of (car mp) (vector t nil nil nil nil)))))
X (cond ((vm-deleted-flag (car mp))) ; don't count deleted messages
X ((vm-new-flag (car mp))
X (vm-increment vm-new-count))
X ((vm-unread-flag (car mp))
X (vm-increment vm-unread-count)))
X (setq mp (cdr mp))))))
X
X;; Stuff the messages attributes back into the messages as headers.
X(defun vm-stuff-attributes ()
X (save-excursion
X (vm-save-restriction
X (widen)
X (let ((mp vm-message-list) attributes buffer-read-only
X (old-buffer-modified-p (buffer-modified-p)))
X (while mp
X (setq attributes (vm-attributes-of (car mp)))
X (goto-char (vm-start-of (car mp)))
X (if (re-search-forward vm-attributes-header-regexp
X (vm-text-of (car mp)) t)
X (delete-region (match-beginning 0) (match-end 0)))
X (cond (vm-berkeley-mail-compatibility
X (goto-char (vm-start-of (car mp)))
X (if (re-search-forward vm-berkeley-mail-status-header-regexp
X (vm-text-of (car mp)) t)
X (delete-region (match-beginning 0) (match-end 0)))
X (cond ((not (vm-new-flag (car mp)))
X (goto-char (vm-start-of (car mp)))
X (forward-line)
X (insert-before-markers
X vm-berkeley-mail-status-header
X (if (vm-unread-flag (car mp)) "" "R")
X "O\n")))))
X (goto-char (vm-start-of (car mp)))
X (forward-line)
X (insert-before-markers vm-attributes-header " "
X (prin1-to-string attributes) "\n")
X (setq mp (cdr mp)))
X (set-buffer-modified-p old-buffer-modified-p)))))
X
X;; Remove any message marked for deletion from the buffer and the
X;; message list.
X(defun vm-gobble-deleted-messages ()
X (save-excursion
X (vm-save-restriction
X (widen)
X (let ((mp vm-message-list) prev buffer-read-only)
X (while mp
X (if (not (vm-deleted-flag (car mp)))
X (setq prev mp)
X (delete-region (vm-start-of (car mp))
X (vm-end-of (car mp)))
X (if (null prev)
X (setq vm-message-list (cdr vm-message-list))
X (setcdr prev (cdr mp))))
X (setq mp (cdr mp))))))
X (vm-clear-expunge-invalidated-undos)
X (if (null vm-message-list)
X (setq overlay-arrow-position nil))
X (cond ((and vm-last-message-pointer
X (vm-deleted-flag (car vm-last-message-pointer)))
X (setq vm-last-message-pointer nil)))
X (cond ((and vm-message-pointer (vm-deleted-flag (car vm-message-pointer)))
X (setq vm-system-state nil)
X (setq vm-message-pointer nil))))
X
X(defun vm-change-all-new-to-unread ()
X (let ((mp vm-message-list))
X (while mp
X (if (vm-new-flag (car mp))
X (progn
X (vm-set-new-flag (car mp) nil)
X (vm-set-unread-flag (car mp) t)))
X (setq mp (cdr mp)))))
X
X(defun vm-update-summary-and-mode-line ()
X (setq vm-ml-message-number (vm-number-of (car vm-message-pointer)))
X (cond ((vm-new-flag (car vm-message-pointer))
X (setq vm-ml-attributes-string "new"))
X ((vm-unread-flag (car vm-message-pointer))
X (setq vm-ml-attributes-string "unread"))
X (t (setq vm-ml-attributes-string "read")))
X (cond ((vm-filed-flag (car vm-message-pointer))
X (setq vm-ml-attributes-string
X (concat vm-ml-attributes-string " filed"))))
X (cond ((vm-replied-flag (car vm-message-pointer))
X (setq vm-ml-attributes-string
X (concat vm-ml-attributes-string " replied"))))
X (cond ((vm-deleted-flag (car vm-message-pointer))
X (setq vm-ml-attributes-string
X (concat vm-ml-attributes-string " deleted"))))
X (while vm-messages-needing-display-update
X (vm-update-message-summary vm-messages-needing-display-update)
X (setq vm-messages-needing-display-update
X (cdr vm-messages-needing-display-update)))
X (save-excursion
X (set-buffer (other-buffer))
X (set-buffer-modified-p (buffer-modified-p))))
X
X(defun vm-goto-message (n)
X "Go to the message numbered N.
XInteractively N is the prefix argument. If no prefix arg is provided
XN is prompted for in the minibuffer."
X (interactive "NGo to message: ")
X (if vm-mail-buffer
X (set-buffer vm-mail-buffer))
X (vm-error-if-mailbox-empty)
X (let ((cons (nthcdr (1- n) vm-message-list)))
X (if (null cons)
X (error "No such message."))
X (if (eq vm-message-pointer cons)
X (vm-preview-current-message)
X (setq vm-last-message-pointer vm-message-pointer
X vm-message-pointer cons)
X (vm-set-summary-pointer (car vm-message-pointer))
X (vm-preview-current-message))))
X
X(defun vm-goto-message-last-seen ()
X "Go to the message last previewed."
X (interactive)
X (if vm-mail-buffer
X (set-buffer vm-mail-buffer))
X (vm-error-if-mailbox-empty)
X (if vm-last-message-pointer
X (let (tmp)
X (setq tmp vm-message-pointer
X vm-message-pointer vm-last-message-pointer
X vm-last-message-pointer tmp)
X (vm-set-summary-pointer (car vm-message-pointer))
X (vm-preview-current-message))))
X
X(defun vm-move-message-pointer (direction)
X (let ((mp vm-message-pointer))
X (if (eq direction 'forward)
X (progn
X (setq mp (cdr mp))
X (if (null mp)
X (setq mp vm-message-list)))
X (if (eq mp vm-message-list)
X (setq mp (vm-last vm-message-list))
X (setq mp (let ((curr vm-message-list))
X (while (not (eq (cdr curr) mp))
X (setq curr (cdr curr)))
X curr))))
X (setq vm-message-pointer mp)))
X
X(defun vm-next-message (count)
X "Go forward one message and preview it.
XWith prefix arg COUNT, go forward COUNT messages. A negative COUNT
Xmeans go backward. If at last message wrap around to the first message.
XIf the absolute value of COUNT > 1 the values of the variables
Xvm-skip-deleted-messages and vm-skip-read-messages are ignored."
X (interactive "p")
X (if vm-mail-buffer
X (set-buffer vm-mail-buffer))
X (vm-error-if-mailbox-empty)
X (let ((oldmp vm-message-pointer)
X (direction (if (> count 0) 'forward 'backward))
X (count (vm-abs count)))
X (cond ((> count 1)
X (while (not (zerop count))
X (vm-move-message-pointer direction)
X (vm-decrement count)))
X (t
X (vm-move-message-pointer direction)
X (while
X (and
X (not (eq oldmp vm-message-pointer))
X (or
X (and vm-skip-deleted-messages
X (vm-deleted-flag (car vm-message-pointer)))
X (and vm-skip-read-messages
X (or
X (vm-deleted-flag (car vm-message-pointer))
X (not (or
X (vm-new-flag (car vm-message-pointer))
X (vm-unread-flag (car vm-message-pointer))))))))
X (vm-move-message-pointer direction))
X (and
X (eq oldmp vm-message-pointer)
X (or
X (and vm-skip-deleted-messages
X (vm-deleted-flag (car vm-message-pointer)))
X (and vm-skip-read-messages
X (or
X (vm-deleted-flag (car vm-message-pointer))
X (not (or
X (vm-new-flag (car vm-message-pointer))
X (vm-unread-flag (car vm-message-pointer)))))))
X (vm-move-message-pointer direction))))
X (setq vm-last-message-pointer oldmp)
X (vm-set-summary-pointer (car vm-message-pointer))
X (vm-preview-current-message)))
X
X(defun vm-previous-message (count)
X "Go back one message and preview it.
XWith prefix arg COUNT, go backward COUNT messages. A negative COUNT
Xmeans go forward. If at first message wrap around to the last message.
XIf the absolute value of COUNT > 1 the values of the variables
Xvm-skip-deleted-messages and vm-skip-read-messages are ignored."
X (interactive "p")
X (vm-next-message (- count)))
X
X(defun vm-Next-message (count)
X "Like vm-next-message but will not skip messages."
X (interactive "p")
X (let (vm-skip-deleted-messages vm-skip-read-messages)
X (vm-next-message count)))
X
X(defun vm-Previous-message (count)
X "Like vm-previous-message but will not skip messages."
X (interactive "p")
X (let (vm-skip-deleted-messages vm-skip-read-messages)
X (vm-previous-message count)))
X
X(defun vm-next-unread-message ()
X "Move forward to the nearest new or unread message, if there is one.
XOtherwise behave like vm-next-message."
X (interactive)
X (let ((vm-skip-read-messages t))
X (vm-next-message 1)))
X
X(defun vm-previous-unread-message ()
X "Move backward to the nearest new or unread message, if there is one.
XOtherwise behave like vm-previous-message."
X (interactive)
X (let ((vm-skip-read-messages t))
X (vm-previous-message 1)))
X
X(defun vm-preview-current-message ()
X (setq vm-system-state 'previewing)
X (widen)
X (narrow-to-region
X (vm-vheaders-of (car vm-message-pointer))
X (if vm-preview-lines
X (save-excursion
X (goto-char (vm-text-of (car vm-message-pointer)))
X (forward-line (if (natnump vm-preview-lines) vm-preview-lines 0))
X (point))
X (vm-text-of (car vm-message-pointer))))
X (let ((w (get-buffer-window (current-buffer))))
X (and w (progn (set-window-start w (point-min))
X (set-window-point w (point-max))))
X (and w vm-highlighted-header-regexp
X (progn
X (save-restriction
X (narrow-to-region (point) (point))
X (sit-for 0))
X (goto-char (point-min))
X (while (re-search-forward vm-highlighted-header-regexp nil t)
X (save-restriction
X (goto-char (match-beginning 0))
X (looking-at vm-generic-header-regexp)
X (goto-char (match-beginning 1))
X (narrow-to-region (point-min) (point))
X (sit-for 0)
X (setq inverse-video t)
X (widen)
X (narrow-to-region (point-min) (match-end 1))
X (sit-for 0)
X (setq inverse-video nil)
X (goto-char (match-end 0)))))))
X (goto-char (point-max))
X (if (null vm-preview-lines)
X (vm-show-current-message t)
X (vm-update-summary-and-mode-line)))
X
X(defun vm-show-current-message (&optional sit-and-howl)
X (setq vm-system-state 'reading)
X (save-excursion
X (goto-char (point-min))
X (widen)
X (narrow-to-region (point) (vm-end-of (car vm-message-pointer))))
X (cond ((vm-new-flag (car vm-message-pointer))
X (vm-set-new-flag (car vm-message-pointer) nil))
X ((vm-unread-flag (car vm-message-pointer))
X (vm-set-unread-flag (car vm-message-pointer) nil)))
X (vm-update-summary-and-mode-line)
X (cond (sit-and-howl
X (sit-for 0)
X (vm-howl-if-eom-visible))))
X
X(defun vm-expose-hidden-headers ()
X "Expose headers omitted from vm-visible-headers."
X (interactive)
X (if vm-mail-buffer
X (set-buffer vm-mail-buffer))
X (vm-error-if-mailbox-empty)
X (save-excursion
X (goto-char (point-max))
X (widen)
X (narrow-to-region (point) (vm-start-of (car vm-message-pointer)))
X (let (w)
X (and (setq w (get-buffer-window (current-buffer)))
X (= (window-start w) (vm-vheaders-of (car vm-message-pointer)))
X (set-window-start w (vm-start-of (car vm-message-pointer)))))))
X
X(defun vm-howl-if-eom-visible ()
X (let ((w (get-buffer-window (current-buffer))))
X (and w (pos-visible-in-window-p (point-max) w)
X (message "End of message %s from %s"
X (vm-number-of (car vm-message-pointer))
X (vm-su-full-name (car vm-message-pointer))))))
X
X(defun vm-scroll-forward (&optional arg)
X "Scroll forward a screenful of text.
XIf the current message is being previewed, the message body is revealed.
XIf at the end of the current message, move to the next message."
X (interactive "P")
X (if vm-mail-buffer
X (set-buffer vm-mail-buffer))
X (vm-error-if-mailbox-empty)
X (if (null (get-buffer-window (current-buffer)))
X (progn
X (display-buffer (current-buffer))
X (if (and vm-summary-buffer (get-buffer-window vm-summary-buffer))
X (vm-proportion-windows))))
X (if (eq vm-system-state 'previewing)
X (vm-show-current-message t)
X (let ((w (get-buffer-window (current-buffer)))
X (old-w (selected-window)))
X (unwind-protect
X (progn
X (select-window w)
X (if (not (eq (condition-case () (scroll-up arg)
X (end-of-buffer (if (null arg)
X (progn
X (vm-next-message 1)
X 'next-message))))
X 'next-message))
X (vm-howl-if-eom-visible)))
X (select-window old-w)))))
X
X(defun vm-scroll-backward (&optional arg)
X "Scroll backward a screenful of text."
X (interactive "P")
X (if vm-mail-buffer
X (set-buffer vm-mail-buffer))
X (vm-error-if-mailbox-empty)
X (if (null (get-buffer-window (current-buffer)))
X (progn
X (display-buffer (current-buffer))
X (if (and vm-summary-buffer (get-buffer-window vm-summary-buffer))
X (vm-proportion-windows))))
X (let ((w (get-buffer-window (current-buffer)))
X (old-w (selected-window)))
X (unwind-protect
X (progn
X (select-window w)
X (scroll-down arg))
X (select-window old-w))))
X
X(defun vm-end-of-message ()
X "Displays the end of the current message, exposing and marking it read
Xas necessary."
X (interactive)
X (if vm-mail-buffer
X (set-buffer vm-mail-buffer))
X (vm-error-if-mailbox-empty)
X (if (eq vm-system-state 'previewing)
X (vm-show-current-message))
X (goto-char (point-max))
X (vm-howl-if-eom-visible))
X
X(defun vm-delete-message (count)
X "Mark the current message for deletion.
XWith a prefix arg mark the next COUNT messages for deletion. A negative
Xarg means the previous COUNT messages are marked."
X (interactive "p")
X (if vm-mail-buffer
X (set-buffer vm-mail-buffer))
X (vm-error-if-mailbox-empty)
X (let ((direction (if (< count 0) 'backward 'forward))
X (count (vm-abs count))
X (oldmp vm-message-pointer)
X (vm-message-pointer vm-message-pointer))
X (while (not (zerop count))
X (if (not (vm-deleted-flag (car vm-message-pointer)))
X (vm-set-deleted-flag (car vm-message-pointer) t))
X (vm-move-message-pointer direction)
X (vm-decrement count)))
X (vm-update-summary-and-mode-line))
X
X(defun vm-undelete-message (count)
X "Remove the deletion mark from the current message.
XWith a prefix arg unmark the next COUNT messages. A negative arg means
Xthe previous COUNT messages are unmarked."
X (interactive "p")
X (if vm-mail-buffer
X (set-buffer vm-mail-buffer))
X (vm-error-if-mailbox-empty)
X (let ((direction (if (< count 0) 'backward 'forward))
X (count (vm-abs count))
X (oldmp vm-message-pointer)
X (vm-message-pointer vm-message-pointer))
X (while (not (zerop count))
X (if (vm-deleted-flag (car vm-message-pointer))
X (vm-set-deleted-flag (car vm-message-pointer) nil))
X (vm-move-message-pointer direction)
X (vm-decrement count)))
X (vm-update-summary-and-mode-line))
X
X(defun vm-kill-subject ()
X "Mark all mesages with the same subject as the current message
X\(ignoring re:'s) for deletion."
X (interactive)
X (if vm-mail-buffer
X (set-buffer vm-mail-buffer))
X (vm-error-if-mailbox-empty)
X (let ((subject (vm-subject-of (car vm-message-pointer)))
X (mp vm-message-list))
X (if (string-match "^\\(re: +\\)+" subject)
X (setq subject (substring subject (match-end 0))))
X (setq subject (concat "^\\(re: +\\)*" (regexp-quote subject)))
X (while mp
X (if (and (not (vm-deleted-flag (car mp)))
X (string-match subject (vm-subject-of (car mp))))
X (vm-set-deleted-flag (car mp) t))
X (setq mp (cdr mp))))
X (vm-update-summary-and-mode-line))
X
X(defun vm-expunge-folder (&optional quitting shaddap)
X "Expunge deleted messages, but don't save folder to disk or exit VM."
X (interactive)
X (if vm-mail-buffer
X (set-buffer vm-mail-buffer))
X (if (not (buffer-modified-p))
X (error "No messages are marked for deletion."))
X (let ((inhibit-quit t))
X (vm-gobble-deleted-messages)
X (if (not quitting)
X (progn
X (if (not shaddap)
X (message "Deleted messages expunged."))
X (vm-number-messages)
X (if vm-summary-buffer
X (vm-do-summary))
X (if (and vm-message-pointer vm-summary-buffer)
X (vm-set-summary-pointer (car vm-message-pointer)))
X (if (null vm-message-pointer)
X (vm-next-message 1)
X (vm-update-summary-and-mode-line))))))
X
X(defun vm-quit-no-change ()
X "Exit VM without saving changes made to the folder."
X (interactive)
X (vm-quit t))
X
X(defun vm-quit (&optional no-change)
X "Quit VM, saving changes and expunging messages marked for deletion.
XNew messages are changed to unread."
X (interactive)
X (if vm-mail-buffer
X (set-buffer vm-mail-buffer))
X (let ((inhibit-quit t))
X (if (not no-change)
X (vm-change-all-new-to-unread))
X (if (and (buffer-modified-p) (not no-change))
X (vm-save-folder t))
X (let ((summary-buffer vm-summary-buffer)
X (mail-buffer (current-buffer)))
X (if summary-buffer
X (progn
X (setq overlay-arrow-position nil)
X (delete-windows-on vm-summary-buffer)
X (kill-buffer summary-buffer)))
X (set-buffer mail-buffer)
X (set-buffer-modified-p nil)
X (kill-buffer (current-buffer)))
X ;; If we land on a buffer that VM knows about
X ;; do some nice things for the user.
X (cond ((and (eq major-mode 'vm-mode)
X vm-summary-buffer
X vm-startup-with-summary)
X (condition-case () (vm-summarize t) (error nil))
X (and (eq vm-startup-with-summary t) (not (one-window-p t))
X (delete-window)))
X ((eq major-mode 'vm-summary-mode)
X (cond ((eq vm-startup-with-summary nil)
X (switch-to-buffer vm-mail-buffer))
X ((not (eq vm-startup-with-summary t))
X (display-buffer vm-mail-buffer)
X (vm-proportion-windows)))))))
X
X;; This allows C-x C-s to do the right thing for VM mail buffers.
X;; Note that deleted messages are not expunged.
X(defun vm-write-file-hook ()
X (if (not (eq major-mode 'vm-mode))
X ()
X (if vm-inhibit-write-file-hook
X ()
X ;; The vm-save-restriction isn't really necessary here (since
X ;; vm-stuff-atributes cleans up after itself) but should remain
X ;; as a safeguard against the time when other stuff is added here.
X (vm-save-restriction
X (let ((inhibit-quit t)
X (buffer-read-only))
X (vm-stuff-attributes)
X nil )))))
X
X(defun vm-save-folder (&optional quitting)
X "Save current folder to disk."
X (interactive)
X (if vm-mail-buffer
X (set-buffer vm-mail-buffer))
X (if (buffer-modified-p)
X (let ((inhibit-quit t))
X ;; may get error if mailbox is emptied by the expunge.
X (condition-case ()
X (vm-expunge-folder quitting t)
X (error nil))
X (vm-stuff-attributes)
X (let ((vm-inhibit-write-file-hook t))
X (save-buffer))
X (if (not quitting)
X (if vm-message-pointer
X (vm-update-summary-and-mode-line)
X (vm-next-message 1))))))
X
X(defun vm-visit-folder (folder)
X "Visit a mail file.
XVM will parse and present its messages to you in the usual way."
X (interactive
X (list (read-file-name
X "Visit folder: " (if vm-folder-directory
X (expand-file-name vm-folder-directory)
X default-directory) nil t)))
X (if vm-mail-buffer
X (set-buffer vm-mail-buffer))
X (vm folder))
X
X(defun vm-help ()
X "Display VM command and variable information."
X (interactive)
X (if (and vm-mail-buffer (get-buffer-window vm-mail-buffer))
X (set-buffer vm-mail-buffer))
X (cond
X ((eq last-command 'vm-help)
X (describe-mode))
X ((eq vm-system-state 'previewing)
X (message "Type SPC to read message, n previews next message (? gives more help)"))
X ((eq vm-system-state 'reading)
X (message "SPC and b scroll, (d)elete, (s)ave, (n)ext, (r)eply (? gives more help)"))
X (t (describe-mode))))
X
X(defun vm-move-mail (source destination)
X (call-process "movemail" nil nil nil (expand-file-name source)
X (expand-file-name destination)))
X
X(defun vm-gobble-crash-box ()
X (save-excursion
X (vm-save-restriction
X (widen)
X (let ((opoint-max (point-max)) crash-buf buffer-read-only
X (old-buffer-modified-p (buffer-modified-p)))
X (setq crash-buf (find-file-noselect vm-crash-box))
X (goto-char (point-max))
X (insert-buffer-substring crash-buf
X 1 (1+ (save-excursion
X (set-buffer crash-buf)
X (widen)
X (buffer-size))))
X (write-region opoint-max (point-max) buffer-file-name t t)
X ;; make sure primary inbox is private. 384 = octal 600
X (condition-case () (set-file-modes buffer-file-name 384) (error nil))
X (set-buffer-modified-p old-buffer-modified-p)
X (kill-buffer crash-buf)
X (condition-case () (delete-file vm-crash-box)
X (error nil))))))
X
X(defun vm-get-spooled-mail ()
X (let ((spool-file (concat vm-spool-directory (user-login-name)))
X (inhibit-quit t)
X (got-mail))
X (if (file-exists-p vm-crash-box)
X (progn
X (message "Recovering messages from crash box...")
X (vm-gobble-crash-box)
X (message "Recovering messages from crash box... done")
X (setq got-mail t)))
X (if (file-readable-p spool-file)
X (progn
X (message "Getting new mail from %s..." spool-file)
X (vm-move-mail spool-file vm-crash-box)
X (vm-gobble-crash-box)
X (message "Getting new mail from %s... done" spool-file)
X (setq got-mail t)))
X got-mail ))
X
X(defun vm-get-new-mail ()
X "Move any new mail that has arrived in the system mailbox into the
Xprimary inbox. New mail is appended to the disk and buffer copies of
Xthe primary inbox.
X
XThis command is valid only from the primary inbox buffer."
X (interactive)
X (if vm-mail-buffer
X (set-buffer vm-mail-buffer))
X (if (not vm-primary-inbox-p)
X (error "This is not your primary inbox."))
X (if (not (and (vm-get-spooled-mail) (vm-assimilate-new-messages)))
X (message "No new mail.")
X (vm-emit-totals-blurb)
X (vm-thoughtfully-select-message)
X (if vm-summary-buffer
X (progn
X (vm-do-summary)
X (vm-set-summary-pointer (car vm-message-pointer))))))
X
X(defun vm-emit-totals-blurb ()
X (message "%d message%s, %d new, %d unread."
X vm-total-count (if (= vm-total-count 1) "" "s")
X vm-new-count vm-unread-count))
X
X(defun vm-find-first-unread-message ()
X (let (mp unread-mp)
X (setq mp vm-message-list)
X (while mp
X (if (and (vm-new-flag (car mp)) (not (vm-deleted-flag (car mp))))
X (setq unread-mp mp mp nil)
X (setq mp (cdr mp))))
X (if (null unread-mp)
X (progn
X (setq mp vm-message-list)
X (while mp
X (if (and (vm-unread-flag (car mp))
X (not (vm-deleted-flag (car mp))))
X (setq unread-mp mp mp nil)
X (setq mp (cdr mp))))))
X unread-mp))
X
X;; returns non-nil if there were any new messages
X(defun vm-assimilate-new-messages ()
X (let ((tail-cons (vm-last vm-message-list))
X (new-messages-p (null vm-message-pointer)))
X (vm-save-restriction
X (widen)
X (vm-build-message-list)
X (vm-read-attributes)
X (setq new-messages-p (or new-messages-p (cdr tail-cons)))
X (if (and vm-current-grouping new-messages-p)
X (condition-case data
X (vm-group-messages vm-current-grouping)
X ;; presumably an unsupported grouping
X (error (message (car (cdr data)))
X (sleep-for 2)
X (vm-number-messages)))
X (vm-number-messages)))
X new-messages-p ))
X
X(defun vm-thoughtfully-select-message ()
X (if (not (and vm-message-pointer (eq vm-system-state 'reading)))
X (let ((mp (vm-find-first-unread-message)))
X (if mp
X (progn
X (if vm-message-pointer
X (setq vm-last-message-pointer vm-message-pointer
X vm-message-pointer mp)
X (setq vm-message-pointer mp))
X (vm-preview-current-message))
X (if (null vm-message-pointer)
X (vm-Next-message 1))))))
X
X(defun vm-display-startup-message ()
X (if (sit-for 5)
X (let ((lines
X '(
X"You may give out copies of VM. Type \\[vm-show-copying-restrictions] to see the conditions"
X"VM comes with ABSOLUTELY NO WARRANTY; type \\[vm-show-no-warranty] for full details"
X )))
X (message "VM %s, Copyright (C) 1989 Kyle E. Jones; type ? for help"
X vm-version)
X (while (and (sit-for 4) lines)
X (message (substitute-command-keys (car lines)))
X (setq lines (cdr lines)))))
X (message ""))
X
X(defun vm (&optional mailbox)
X "Read mail under Emacs.
XOptional first arg MAILBOX specifies the mailbox to visit. It defaults
Xto the value of vm-primary-inbox. The mailbox buffer is put into VM
Xmode, a major mode for reading mail.
X
XVisiting the primary inbox causes any contents of the system mailbox to
Xbe moved and appended to the resulting buffer.
X
XAll the messages can be read by repeatedly pressing SPC. Messages are
Xmarked for deletion with `d', and saved to a folder with `s'. Quitting
XVM with `q' expunges messages marked for deletion and saves the buffered
Xmailbox to disk.
X
XSee the documentation for vm-mode for more information."
X (interactive)
X (if vm-session-beginning
X (progn
X (load "vm-undo")
X (load "vm-summary")))
X (if vm-mail-buffer
X (set-buffer vm-mail-buffer))
X (find-file (or mailbox (expand-file-name vm-primary-inbox)))
X (delete-other-windows)
X (let ((first-time (not (eq major-mode 'vm-mode)))
X (inhibit-quit t))
X (if first-time
X (progn
X (buffer-flush-undo (current-buffer))
X (auto-save-mode 0)
X (abbrev-mode 0)
X (auto-fill-mode 0)
X (vm-mode)))
X (if (or (and vm-primary-inbox-p (vm-get-spooled-mail)) first-time)
X (progn
X (vm-assimilate-new-messages)
X ;; Can't allow a mailbox-empty error here because execution
X ;; abort before the session startup code below.
X (if (null vm-message-list)
X (message "Mailbox is empty.")
X (vm-emit-totals-blurb)
X (vm-thoughtfully-select-message))))
X (if (and vm-message-list vm-startup-with-summary)
X (progn
X (vm-summarize)
X (and (eq vm-startup-with-summary t) (delete-window))))
X (if vm-session-beginning
X (progn
X (setq vm-session-beginning nil)
X (or vm-inhibit-startup-message mailbox
X (vm-display-startup-message))
X (if (and vm-message-list (not (input-pending-p)))
X (vm-emit-totals-blurb))))))
X
X(defun vm-mode ()
X "Major mode for reading mail.
X
XCommands:
X h - summarize folder contents
X
X n - go to next message
X p - go to previous message
X N - like `n' but ignores skip-variable settings
X P - like `p' but ignores skip-variable settings
X M-n - go to next unread message
X M-p - go to previous unread message
X RET - go to numbered message (uses prefix arg or prompts in minibuffer)
X TAB - go to last message seen
X M-s - incremental search through the folder
X
X t - display hidden headers
X SPC - scroll forward a page (if at end of message, then display next message)
X b - scroll backward a page
X > - go to end of current message
X
X d - delete current message (mark as deleted)
X u - undelete
X k - mark for deletion all messages with same subject as the current message
X
X r - reply (only to the sender of the message)
X R - reply with included text for current message
X f - followup (reply to all recipients of message)
X F - followup with included text from the current message
X z - forward the current message
X m - send a message
X
X @ - digestify and mail entire folder contents (the folder is not modified)
X * - burst a digest into indivdual messages, and append and assimilate these
X message into the current folder.
X
X G - group messages according to some criteria
X
X g - get any new mail that has arrived in the system mailbox
X (new mail is appended to the disk and buffer copies of the
X primary inbox.)
X v - visit another mail folder
X
X s - save current message in a folder (appends if folder already exists)
X w - write current message to a file without its headers (appends if exists)
X S - save entire folder to disk, without quitting VM
X A - save unfiled messages to their vm-auto-folder-alist specified folders
X # - expunge deleted messages (without saving folder)
X q - quit VM, deleted messages are expunged, folder saved to disk
X x - exit VM with no change to the folder
X
X C-_ - undo, special undo that retracts the most recent
X changes in message attributes. Expunges and saves
X cannot be undone.
X
X ? - help
X
X ! - run a shell command
X | - run a shell command with the current message as input
X
X M-c - view conditions under which youmay redistribute of VM
X M-w - view the details of VM's lack of a warranty
X
XVariables:
X vm-auto-folder-alist
X vm-berkeley-mail-compatibility
X vm-crash-box
X vm-folder-directory
X vm-gargle-uucp
X vm-group-by
X vm-highlighted-header-regexp
X vm-included-text-attribution-format
X vm-included-text-prefix
X vm-inhibit-startup-message
X vm-mail-window-percentage
X vm-mode-hooks
X vm-preview-lines
X vm-primary-inbox
X vm-rfc934-forwarding
X vm-search-using-regexps
X vm-skip-deleted-messages
X vm-skip-read-messages
X vm-startup-with-summary
X vm-summary-format
X vm-visible-headers
X vm-visit-when-saving"
X (widen)
X (setq
X buffer-read-only nil
X case-fold-search t
X major-mode 'vm-mode
X mode-line-format
X '("" mode-line-modified mode-line-buffer-identification " "
X global-mode-string
X (vm-message-list
X (" %[(" vm-ml-attributes-string ")%]----")
X (" %[()%]----"))
X (-3 . "%p") "-%-")
X mode-line-buffer-identification
X '("VM " vm-version ": %b"
X (vm-message-list
X (" " vm-ml-message-number
X " (of " vm-ml-highest-message-number ")")
X " (no messages)"))
X mode-name "VM"
X require-final-newline nil
X vm-current-grouping vm-group-by
X vm-primary-inbox-p (equal buffer-file-name
X (expand-file-name vm-primary-inbox)))
X (use-local-map vm-mode-map)
X (run-hooks 'vm-mode-hooks))
X
X(put 'vm-mode 'mode-class 'special)
X
X(autoload 'vm-group-messages "vm-group" nil t)
X
X(autoload 'vm-reply "vm-reply" nil t)
X(autoload 'vm-reply-include-text "vm-reply" nil t)
X(autoload 'vm-followup "vm-reply" nil t)
X(autoload 'vm-followup-include-text "vm-reply" nil t)
X(autoload 'vm-mail "vm-reply" nil t)
X(autoload 'vm-forward-message "vm-reply" nil t)
X(autoload 'vm-send-digest "vm-reply" nil t)
X
X(autoload 'vm-isearch-forward "vm-search" nil t)
X
X(autoload 'vm-burst-digest "vm-digest" nil t)
X(autoload 'vm-rfc934-char-stuff-region "vm-digest")
X(autoload 'vm-digestify-region "vm-digest")
X
X(autoload 'vm-show-no-warranty "vm-license" nil t)
X(autoload 'vm-show-copying-restrictions "vm-license" nil t)
X
X(autoload 'vm-auto-archive-messages "vm-save" nil t)
X(autoload 'vm-save-message "vm-save" nil t)
X(autoload 'vm-save-message-sans-headers "vm-save" nil t)
X(autoload 'vm-pipe-message-to-command "vm-save" nil t)
X
X(if (not (memq 'vm-write-file-hook write-file-hooks))
X (setq write-file-hooks
X (cons 'vm-write-file-hook write-file-hooks)))
SHAR_EOF
chmod 0664 vm.el || echo "restore of vm.el fails"
exit 0