From: CRDGW2::CRDGW2::MRGATE::"SMTP::PREP.AI.MIT.EDU::INFO-GNU-EMACS-REQUEST" 13-JUL-1989 11:23 To: MRGATE::"ARISIA::EVERHART" Subj: VM 4.37 (part 2 of 4) Received: by life.ai.mit.edu (4.1/AI-4.10) id AB02084; Wed, 12 Jul 89 18:12:53 EDT Return-Path: Received: from uunet.uu.net by life.ai.mit.edu (4.1/AI-4.10) id AA01698; Wed, 12 Jul 89 17:55:43 EDT Received: from talos.UUCP by uunet.uu.net (5.61/1.14) with UUCP id AA03269; Wed, 12 Jul 89 17:55:31 -0400 Date: Wed, 12 Jul 89 17:30:08 EDT From: talos!kjones@uunet.uu.net (Kyle Jones) Message-Id: <8907122130.AA02123@talos.uucp> To: info-gnu-emacs@prep.ai.mit.edu Reply-To: kyle@cs.odu.edu Subject: VM 4.37 (part 2 of 4) #!/bin/sh # this is part 2 of a multipart archive # do not concatenate these parts, unpack them in order with /bin/sh # file vm-search.el continued # CurArch=2 if test ! -r s2_seq_.tmp then echo "Please unpack part 1 first!" exit 1; fi ( read Scheck if test "$Scheck" != $CurArch then echo "Please unpack part $Scheck next!" exit 1; else exit 0; fi ) < s2_seq_.tmp || exit 1 echo "x - Continuing file vm-search.el" sed 's/^X//' << 'SHAR_EOF' >> vm-search.el X (setq barrier (point)) ; For subsequent \| if regexp. X (setq success t) X (or (equal search-string "") X (vm-isearch-search)) X (vm-isearch-push-state)) X ((= char search-delete-char) X ;; Rubout means discard last input item and move point X ;; back. If buffer is empty, just beep. X (if (null (cdr cmds)) X (ding) X (vm-isearch-pop))) X (t X (cond ((or (eq char search-yank-word-char) X (eq char search-yank-line-char)) X ;; ^W means gobble next word from buffer. X ;; ^Y means gobble rest of line from buffer. X (let ((word (save-excursion X (and (not forward) other-end X (goto-char other-end)) X (buffer-substring X (point) X (save-excursion X (if (eq char search-yank-line-char) X (end-of-line) X (forward-word 1)) X (point)))))) X (setq search-string (concat search-string word) X search-message X (concat search-message X (mapconcat 'text-char-description X word ""))))) X ;; Any other control char => X ;; unread it and exit the search normally. X ((and search-exit-option X (/= char search-quote-char) X (or (= char ?\177) X (and (< char ? ) (/= char ?\t) (/= char ?\r)))) X (setq unread-command-char char) X (throw 'search-done t)) X (t X ;; Any other character => add it to the X ;; search string and search. X (cond ((= char search-quote-char) X (setq char (read-quoted-char X (vm-isearch-message t)))) X ((= char ?\r) X ;; unix braindeath X (setq char ?\n))) X (setq search-string (concat search-string X (char-to-string char)) X search-message (concat search-message X (text-char-description char))))) X (if (and (not success) X ;; unsuccessful regexp search may become X ;; successful by addition of characters which X ;; make search-string valid X (not regexp)) X nil X ;; If a regexp search may have been made more X ;; liberal, retreat the search start. X ;; Go back to place last successful search started X ;; or to the last ^S/^R (barrier), whichever is nearer. X (and regexp success cmds X (cond ((memq char '(?* ??)) X (setq adjusted t) X (let ((cs (nth (if forward X 5 ; other-end X 2) ; saved (point) X (car (cdr cmds))))) X ;; (car cmds) is after last search; X ;; (car (cdr cmds)) is from before it. X (setq cs (or cs barrier)) X (goto-char X (if forward X (max cs barrier) X (min cs barrier))))) X ((eq char ?\|) X (setq adjusted t) X (goto-char barrier)))) X ;; In reverse regexp search, adding a character at X ;; the end may cause zero or many more chars to be X ;; matched, in the string following point. X ;; Allow all those possibiities without moving point as X ;; long as the match does not extend past search origin. X (if (and regexp (not forward) (not adjusted) X (condition-case () X (looking-at search-string) X (error nil)) X (<= (match-end 0) (min opoint barrier))) X (setq success t invalid-regexp nil X other-end (match-end 0)) X ;; Not regexp, not reverse, or no match at point. X (if (and other-end (not adjusted)) X (goto-char (if forward other-end X (min opoint barrier (1+ other-end))))) X (vm-isearch-search))) X (vm-isearch-push-state)))))) X (setq found-start (window-start (selected-window))) X (setq found-point (point))) X (if (> (length search-string) 0) X (if regexp X (setq search-last-regexp search-string) X (setq search-last-string search-string))) X (message "") X (if small-window X (goto-char found-point) X ;; Exiting the save-window-excursion clobbers this; restore it. X (set-window-start (selected-window) found-start t)))) X X(defun vm-isearch-message (&optional c-q-hack ellipsis) X ;; If about to search, and previous search regexp was invalid, X ;; check that it still is. If it is valid now, X ;; let the message we display while searching say that it is valid. X (and invalid-regexp ellipsis X (condition-case () X (progn (re-search-forward search-string (point) t) X (setq invalid-regexp nil)) X (error nil))) X ;; If currently failing, display no ellipsis. X (or success (setq ellipsis nil)) X (let ((m (concat (if success "" "failing ") X (if wrapped "wrapped ") X (if regexp "regexp " "") X "VM I-search" X (if forward ": " " backward: ") X search-message X (if c-q-hack "^Q" "") X (if invalid-regexp X (concat " [" invalid-regexp "]") X "")))) X (aset m 0 (upcase (aref m 0))) X (let ((cursor-in-echo-area ellipsis)) X (if c-q-hack m (message "%s" m))))) X X(defun vm-isearch-pop () X (setq cmds (cdr cmds)) X (let ((cmd (car cmds))) X (setq search-string (car cmd) X search-message (car (cdr cmd)) X success (nth 3 cmd) X forward (nth 4 cmd) X other-end (nth 5 cmd) X invalid-regexp (nth 6 cmd) X wrapped (nth 7 cmd) X barrier (nth 8 cmd) X vm-ml-attributes-string (nth 9 cmd) X vm-ml-message-number (nth 10 cmd) X vm-message-pointer (nth 11 cmd)) X (goto-char (car (cdr (cdr cmd)))) X (vm-set-summary-pointer (car vm-message-pointer)))) X X(defun vm-isearch-push-state () X (setq cmds (cons (list search-string search-message (point) X success forward other-end invalid-regexp X wrapped barrier X vm-ml-attributes-string vm-ml-message-number X vm-message-pointer) X cmds))) X X(defun vm-isearch-search () X (vm-isearch-message nil t) X (condition-case lossage X (let ((inhibit-quit nil)) X (if regexp (setq invalid-regexp nil)) X (setq success X (funcall X (if regexp X (if forward 're-search-forward 're-search-backward) X (if forward 'search-forward 'search-backward)) X search-string nil t)) X (if success X (setq other-end X (if forward (match-beginning 0) (match-end 0))))) X (quit (setq unread-command-char ?\C-g) X (setq success nil)) X (invalid-regexp (setq invalid-regexp (car (cdr lossage))) X (if (string-match "\\`Premature \\|\\`Unmatched \\|\\`Invalid " X invalid-regexp) X (setq invalid-regexp "incomplete input")))) X (if success X (vm-update-search-position) X ;; Ding if failed this time after succeeding last time. X (and (nth 3 (car cmds)) X (ding)) X (goto-char (nth 2 (car cmds))))) X X;; This is called from incremental-search X;; if the first input character is the exit character. X;; The interactive-arg-reader uses free variables `forward' and `regexp' X;; which are bound by `incremental-search'. X X;; We store the search string in `search-string' X;; which has been bound already by `incremental-search' X;; so that, when we exit, it is copied into `search-last-string'. X X(defun vm-nonincremental-search (forward regexp) X (let (message char function string inhibit-quit X (cursor-in-echo-area t)) X ;; Prompt assuming not word search, X (setq message (if regexp X (if forward "VM Regexp search: " X "VM Regexp search backward: ") X (if forward "VM Search: " "VM Search backward: "))) X (message "%s" message) X ;; Read 1 char and switch to word search if it is ^W. X (setq char (read-char)) X (if (eq char search-yank-word-char) X (setq message (if forward "VM Word search: " "VM Word search backward: ")) X ;; Otherwise let that 1 char be part of the search string. X (setq unread-command-char char)) X (setq function X (if (eq char search-yank-word-char) X (if forward 'word-search-forward 'word-search-backward) X (if regexp X (if forward 're-search-forward 're-search-backward) X (if forward 'search-forward 'search-backward)))) X ;; Read the search string with corrected prompt. X (setq string (read-string message)) X ;; Empty means use default. X (if (= 0 (length string)) X (setq string search-last-string) X ;; Set last search string now so it is set even if we fail. X (setq search-last-string string)) X ;; Since we used the minibuffer, we should be available for redo. X (setq command-history (cons (list function string) command-history)) X ;; Go ahead and search. X (funcall function string))) X X(defun vm-update-search-position (&optional record-change) X (if (and (>= (point) (vm-start-of (car vm-message-pointer))) X (<= (point) (vm-end-of (car vm-message-pointer)))) X nil X (let ((mp vm-message-list) X (point (point))) X (while mp X (if (and (>= point (vm-start-of (car mp))) X (<= point (vm-end-of (car mp)))) X (if record-change X (setq vm-last-message-pointer vm-message-pointer X vm-message-pointer mp mp nil) X (setq vm-message-pointer mp mp nil)) X (setq mp (cdr mp)))) X (vm-update-summary-and-mode-line) X (vm-set-summary-pointer (car vm-message-pointer))))) X X(defun vm-isearch-forward () X "Incrementally search forward through the current folder's messages. XUsage is identical to the standard Emacs incremental search. XWhen the search terminates the message containing point will be selected." X (interactive) X (vm-follow-summary-cursor) X (if vm-mail-buffer X (set-buffer vm-mail-buffer)) X (if (null (get-buffer-window (current-buffer))) X (progn X (display-buffer (current-buffer)) X (vm-proportion-windows))) X (vm-error-if-folder-empty) X (let ((clip-head (point-min)) X (clip-tail (point-max)) X (old-w (selected-window))) X (unwind-protect X (progn (select-window (get-buffer-window (current-buffer))) X (widen) X (vm-isearch t vm-search-using-regexps) X (vm-update-search-position t) X ;; vm-show-current-message only adjusts (point-max) X (narrow-to-region X (if (< (point) (vm-vheaders-of (car vm-message-pointer))) X (vm-start-of (car vm-message-pointer)) X (vm-vheaders-of (car vm-message-pointer))) X (point-max)) X (save-excursion X (vm-show-current-message)) X (vm-howl-if-eom-visible) X ;; make the clipping unwind a noop X (setq clip-head (point-min)) X (setq clip-tail (point-max))) X (narrow-to-region clip-head clip-tail) X (select-window old-w)))) SHAR_EOF echo "File vm-search.el is complete" chmod 0664 vm-search.el || echo "restore of vm-search.el fails" echo "x - extracting vm-summary.el (Text)" sed 's/^X//' << 'SHAR_EOF' > vm-summary.el && X;;; Summary gathering and formatting routines for VM 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(require 'vm) X X(defun vm-summary-mode () X "Major mode for VM folder summaries. XThis major mode use the same keymap as vm-mode. See the vm-mode documentation Xfor a list of available commands." X (setq mode-name "VM Summary" X major-mode 'vm-summary-mode X mode-line-buffer-identification '("VM " vm-version ": %b") X buffer-read-only t X overlay-arrow-string "->" X overlay-arrow-position nil X truncate-lines t) X (use-local-map vm-mode-map) X (save-excursion X (set-buffer vm-mail-buffer) X (vm-set-summary-pointer (car vm-message-pointer)))) X X(put 'vm-summary-mode 'mode-class 'special) X X(defun vm-summarize (&optional dont-redo) X "Summarize the contents of the folder in a summary buffer. XThe format is as described by the variable vm-summary-format. Generally Xone line per message is most pleasing to the eye but this is not Xmandatory." X (interactive "p") X (if vm-mail-buffer X (set-buffer vm-mail-buffer)) X (vm-error-if-folder-empty) X (if (or (null vm-summary-buffer) (not dont-redo)) X (let ((b (current-buffer)) X (inhibit-quit t)) X (setq vm-summary-buffer X (get-buffer-create (format "%s Summary" (buffer-name)))) X (save-excursion X (set-buffer vm-summary-buffer) X (abbrev-mode 0) X (auto-fill-mode 0) X (setq vm-mail-buffer b)) X (vm-do-summary) X (save-excursion X (set-buffer vm-summary-buffer) X (vm-summary-mode)))) X (if vm-mutable-windows X (let ((pop-up-windows (and pop-up-windows (eq vm-mutable-windows t)))) X (display-buffer vm-summary-buffer)) X (switch-to-buffer vm-summary-buffer)) X (if (eq vm-mutable-windows t) X (vm-proportion-windows)) X (if vm-mail-buffer X (set-buffer vm-mail-buffer)) X (vm-set-summary-pointer (car vm-message-pointer))) X X(defun vm-do-summary () X (let ((mp vm-message-list) X (n 0) X ;; Just for laughs, make the update interval variable. X (modulus (+ (% (vm-abs (random)) 7) 10)) X summary) X (message "Generating summary...") X (save-excursion X (set-buffer vm-summary-buffer) X (let ((buffer-read-only nil)) X (erase-buffer) X (while mp X (set-buffer vm-mail-buffer) X (setq summary (vm-sprintf 'vm-summary-format (car mp))) X (set-buffer vm-summary-buffer) X (vm-set-su-start-of (car mp) (point-marker)) X ;; the leading spaces are to make room for the overlay-arrow-string X (insert " " summary) X (vm-set-su-end-of (car mp) (point-marker)) X (setq mp (cdr mp) n (1+ n)) X (if (zerop (% n modulus)) X (message "Generating summary... %d" n))))) X (message "Generating summary... done"))) X X(defun vm-update-message-summary (mp) X (if vm-summary-buffer X (let ((summary (vm-sprintf 'vm-summary-format (car mp)))) X (save-excursion X (set-buffer vm-summary-buffer) X (let ((inhibit-quit t) buffer-read-only) X (goto-char (vm-su-start-of (car mp))) X ;; We insert a char here and delete it later to avoid X ;; markers clumping at the beginning of the summary, X (insert "*") X (delete-region (point) (vm-su-end-of (car mp))) X (insert-before-markers " " summary) X (goto-char (vm-su-start-of (car mp))) X (delete-char 1)))))) X X(defun vm-set-summary-pointer (m) X (setq overlay-arrow-position (vm-su-start-of m)) X (cond (vm-summary-buffer X (let ((w (get-buffer-window vm-summary-buffer))) X (save-excursion X (set-buffer vm-summary-buffer) X (goto-char overlay-arrow-position) X (and w (set-window-point w overlay-arrow-position))))))) X X(defun vm-follow-summary-cursor () X (and vm-follow-summary-cursor (eq major-mode 'vm-summary-mode) X (let ((point (point)) X message-pointer message-list) X (save-excursion X (set-buffer vm-mail-buffer) X (setq message-pointer vm-message-pointer X message-list vm-message-list)) X (if (or (null message-pointer) X (and (>= point (vm-su-start-of (car message-pointer))) X (< point (vm-su-end-of (car message-pointer))))) X () X (if (< point (vm-su-start-of (car message-pointer))) X (setq mp message-list) X (setq mp (cdr message-pointer) message-pointer nil)) X (while (and (not (eq mp message-pointer)) X (>= point (vm-su-end-of (car mp)))) X (setq mp (cdr mp))) X (if (not (eq mp message-pointer)) X (save-excursion X (set-buffer vm-mail-buffer) X (setq vm-last-message-pointer vm-message-pointer X vm-message-pointer mp) X (vm-set-summary-pointer (car vm-message-pointer)) X (vm-preview-current-message) X ;; return non-nil so the caller will know the X ;; a new message was selected. X t )))))) X X(defun vm-sprintf (format-variable message) X (if (not (eq (get format-variable 'vm-compiled-format) X (symbol-value format-variable))) X (vm-compile-format format-variable)) X ;; The local variable name `vm-su-message' is mandatory here for X ;; the format s-expression to work. X (let ((vm-su-message message)) X (eval (get format-variable 'vm-format-sexp)))) X X(defun vm-compile-format (format-variable) X (let ((format (symbol-value format-variable)) X sexp sexp-fmt conv-spec last-match-end case-fold-search) X (store-match-data nil) X (while (string-match X"%\\(-\\)?\\([0-9]\\)*\\(\\.\\([0-9]+\\)\\)?\\([acdfFhilmnswyz%]\\)" X format (match-end 0)) X (setq conv-spec (aref format (match-beginning 5))) X (if (memq conv-spec '(?a ?c ?d ?f ?F ?h ?i ?l ?m ?n ?s ?w ?y ?z)) X (progn X (cond ((= conv-spec ?a) X (setq sexp (cons (list 'vm-su-attribute-indicators X 'vm-su-message) sexp))) X ((= conv-spec ?c) X (setq sexp (cons (list 'vm-su-byte-count X 'vm-su-message) sexp))) X ((= conv-spec ?d) X (setq sexp (cons (list 'vm-su-monthday X 'vm-su-message) sexp))) X ((= conv-spec ?f) X (setq sexp (cons (list 'vm-su-from X 'vm-su-message) sexp))) X ((= conv-spec ?F) X (setq sexp (cons (list 'vm-su-full-name X 'vm-su-message) sexp))) X ((= conv-spec ?h) X (setq sexp (cons (list 'vm-su-hour X 'vm-su-message) sexp))) X ((= conv-spec ?i) X (setq sexp (cons (list 'vm-su-message-id X 'vm-su-message) sexp))) X ((= conv-spec ?l) X (setq sexp (cons (list 'vm-su-line-count X 'vm-su-message) sexp))) X ((= conv-spec ?m) X (setq sexp (cons (list 'vm-su-month X 'vm-su-message) sexp))) X ((= conv-spec ?n) X (setq sexp (cons (list 'vm-su-message-number X 'vm-su-message) sexp))) X ((= conv-spec ?s) X (setq sexp (cons (list 'vm-su-subject X 'vm-su-message) sexp))) X ((= conv-spec ?w) X (setq sexp (cons (list 'vm-su-weekday X 'vm-su-message) sexp))) X ((= conv-spec ?y) X (setq sexp (cons (list 'vm-su-year X 'vm-su-message) sexp))) X ((= conv-spec ?z) X (setq sexp (cons (list 'vm-su-zone X 'vm-su-message) sexp)))) X (cond ((match-beginning 1) X (setcar sexp X (list 'vm-left-justify-string (car sexp) X (string-to-int (substring format X (match-beginning 2) X (match-end 2)))))) X ((match-beginning 2) X (setcar sexp X (list 'vm-right-justify-string (car sexp) X (string-to-int (substring format X (match-beginning 2) X (match-end 2))))))) X (cond ((match-beginning 3) X (setcar sexp X (list 'vm-truncate-string (car sexp) X (string-to-int (substring format X (match-beginning 4) X (match-end 4))))))) X (setq sexp-fmt X (cons "%s" X (cons (substring format X (or last-match-end 0) X (match-beginning 0)) X sexp-fmt)))) X (setq sexp-fmt X (cons "%%" X (cons (substring format X (or last-match-end 0) X (match-beginning 0)) X sexp-fmt)))) X (setq last-match-end (match-end 0))) X (setq sexp-fmt X (cons (substring format X (or last-match-end 0) X (length format)) X sexp-fmt) X sexp-fmt (apply 'concat (nreverse sexp-fmt)) X sexp (cons 'format (cons sexp-fmt (nreverse sexp)))) X (put format-variable 'vm-format-sexp sexp) X (put format-variable 'vm-compiled-format format))) X X(defun vm-get-header-contents (message header-name) X (let (contents regexp) X (setq regexp (format vm-header-regexp-format header-name)) X (save-excursion X (set-buffer (marker-buffer (vm-start-of message))) X (save-restriction X (widen) X (goto-char (vm-start-of message)) X (while (re-search-forward regexp (vm-text-of message) t) X (if contents X (setq contents X (concat X contents ",\n\t" X (buffer-substring (match-beginning 1) (match-end 1)))) X (setq contents X (buffer-substring (match-beginning 1) (match-end 1))))) X contents)))) X X(defun vm-left-justify-string (string width) X (if (>= (length string) width) X string X (concat string (make-string (- width (length string)) ?\ )))) X X(defun vm-right-justify-string (string width) X (if (>= (length string) width) X string X (concat (make-string (- width (length string)) ?\ ) string))) X X(defun vm-truncate-string (string width) X (if (<= (length string) width) X string X (substring string 0 width))) X X(defun vm-su-attribute-indicators (m) X (concat X (cond ((vm-deleted-flag m) "D") X ((vm-new-flag m) "N") X ((vm-unread-flag m) "U") X (t " ")) X (cond ((vm-filed-flag m) "F") X (t " ")) X (cond ((vm-replied-flag m) "R") X (t " ")))) X X(defun vm-su-byte-count (m) X (or (vm-byte-count-of m) X (vm-set-byte-count-of m (int-to-string X (- (vm-text-end-of m) (vm-text-of m)))))) X X(defun vm-su-weekday (m) X (or (vm-weekday-of m) X (progn (vm-su-do-date m) (vm-weekday-of m)))) X X(defun vm-su-monthday (m) X (or (vm-monthday-of m) X (progn (vm-su-do-date m) (vm-monthday-of m)))) X X(defun vm-su-month (m) X (or (vm-month-of m) X (progn (vm-su-do-date m) (vm-month-of m)))) X X(defun vm-su-year (m) X (or (vm-year-of m) X (progn (vm-su-do-date m) (vm-year-of m)))) X X(defun vm-su-hour (m) X (or (vm-hour-of m) X (progn (vm-su-do-date m) (vm-hour-of m)))) X X(defun vm-su-zone (m) X (or (vm-zone-of m) X (progn (vm-su-do-date m) (vm-zone-of m)))) X X;; Some yogurt-headed delivery agents don't even provide a Date: header. X(defun vm-grok-From_-date (message) X ;; If this is MMDF, forget it. X (if (eq vm-folder-type 'mmdf) X nil X (save-excursion X (set-buffer (marker-buffer (vm-start-of message))) X (save-restriction X (widen) X (goto-char (vm-start-of message)) X (if (looking-at "From [^ \t\n]+[ \t]+\\([^ \t\n].*\\)") X (buffer-substring (match-beginning 1) (match-end 1))))))) X X(defun vm-su-do-date (m) X (let (date) X (setq date (or (vm-get-header-contents m "Date") (vm-grok-From_-date m))) X (cond X ((null date) X (vm-set-weekday-of m "") X (vm-set-monthday-of m "") X (vm-set-month-of m "") X (vm-set-year-of m "") X (vm-set-hour-of m "") X (vm-set-zone-of m "")) X ((string-match X;; The date format recognized here is the one specified in RFC 822. X;; Some slop is allowed e.g. dashes between the monthday, month and year X;; because such malformed headers headers have been observed. X"\\(\\([a-z][a-z][a-z]\\),\\)?[ \t\n]*\\([0-9][0-9]?\\)[ \t\n---]*\\([a-z][a-z][a-z]\\)[ \t\n---]*[0-9]*\\([0-9][0-9]\\)[ \t\n]*\\([0-9:]+\\)[ \t\n]*\\([a-z][a-z]?[a-z]?\\|[---+][0-9][0-9][0-9][0-9]\\)" X date) X (if (match-beginning 2) X (vm-set-weekday-of m (substring date (match-beginning 2) X (match-end 2))) X (vm-set-weekday-of m "")) X (vm-set-monthday-of m (substring date (match-beginning 3) (match-end 3))) X (vm-set-month-of m (substring date (match-beginning 4) (match-end 4))) X (vm-set-year-of m (substring date (match-beginning 5) (match-end 5))) X (vm-set-hour-of m (substring date (match-beginning 6) (match-end 6))) X (vm-set-zone-of m (substring date (match-beginning 7) (match-end 7)))) X ((string-match X;; UNIX ctime(3) format with slop allowed in the whitespace and we allow for X;; the possibility of a timezone at the end. X"\\([a-z][a-z][a-z]\\)[ \t\n]*\\([a-z][a-z][a-z]\\)[ \t\n]*\\([0-9][0-9]?\\)[ \t\n]*\\([0-9:]+\\)[ \t\n]*[0-9][0-9]\\([0-9][0-9]\\)[ \t\n]*\\([a-z][a-z]?[a-z]?\\|[---+][0-9][0-9][0-9][0-9]\\)?" X date) X (vm-set-weekday-of m (substring date (match-beginning 1) (match-end 1))) X (vm-set-month-of m (substring date (match-beginning 2) (match-end 2))) X (vm-set-monthday-of m (substring date (match-beginning 3) (match-end 3))) X (vm-set-hour-of m (substring date (match-beginning 4) (match-end 4))) X (vm-set-year-of m (substring date (match-beginning 5) (match-end 5))) X (if (match-beginning 6) X (vm-set-zone-of m (substring date (match-beginning 6) X (match-end 6))))) X (t X (vm-set-weekday-of m "") X (vm-set-monthday-of m "") X (vm-set-month-of m "") X (vm-set-year-of m "") X (vm-set-hour-of m "") X (vm-set-zone-of m ""))))) X X(defun vm-su-full-name (m) X (or (vm-full-name-of m) X (progn (vm-su-do-author m) (vm-full-name-of m)))) X X(defun vm-su-from (m) X (or (vm-from-of m) X (progn (vm-su-do-author m) (vm-from-of m)))) X X;; Some yogurt-headed delivery agents don't even provide a From: header. X(defun vm-grok-From_-author (message) X ;; If this is MMDF, forget it. X (if (eq vm-folder-type 'mmdf) X nil X (save-excursion X (set-buffer (marker-buffer (vm-start-of message))) X (save-restriction X (widen) X (goto-char (vm-start-of message)) X (if (looking-at "From \\([^ \t\n]+\\)") X (buffer-substring (match-beginning 1) (match-end 1))))))) X X(defun vm-su-do-author (m) X (let (full-name from) X (setq full-name (vm-get-header-contents m "Full-Name")) X (setq from (or (vm-get-header-contents m "From") (vm-grok-From_-author m))) X (cond ((null from) X (setq from "???") X (if (null full-name) X (setq full-name "???"))) X ((string-match "^\\(\\([^<]+[^ \t\n]\\)[ \t\n]+\\)?<\\([^>]+\\)>" X from) X (if (and (match-beginning 2) (null full-name)) X (setq full-name X (substring from (match-beginning 2) (match-end 2)))) X (setq from (substring from (match-beginning 3) (match-end 3)))) X ((string-match "[\000-\177]*(\\([^)]+\\))[\000-\177]*" from) X (if (null full-name) X (setq full-name (substring from (match-beginning 1) X (match-end 1)))) X (setq from X (concat X (substring from (match-beginning 0) (1- (match-beginning 1))) X (substring from (1+ (match-end 1)) (match-end 0)))))) X ;; ewe ewe see pee... X (if (and vm-gargle-uucp (string-match X"\\([^!@:.]+\\)\\(\\.[^!@:]+\\)?!\\([^!@: \t\n]+\\)\\(@\\([^!@:. \t\n]+\\)\\(.[^ \t\n]+\\)?\\)?[ \t\n]*$" X from)) X (setq from X (concat X (substring from (match-beginning 3) (match-end 3)) "@" X (if (and (match-beginning 5) (match-beginning 2) X (not (match-beginning 6))) X (concat (substring from (match-beginning 5) (match-end 5)) X ".") X "") X (substring from (match-beginning 1) X (or (match-end 2) (match-end 1))) X (if (match-end 2) "" ".UUCP")))) X (if (or (null full-name) (string-match "^[ \t\n]*$" full-name)) X (setq full-name from)) X (vm-set-full-name-of m full-name) X (vm-set-from-of m from))) X X(defun vm-su-message-id (m) X (or (vm-message-id-of m) X (vm-set-message-id-of m X (or (vm-get-header-contents m "Message-Id") X "")))) X X(defun vm-su-line-count (m) X (or (vm-line-count-of m) X (vm-set-line-count-of X m X (save-restriction X (widen) X (int-to-string X (count-lines (vm-text-of m) (vm-text-end-of m))))))) X X(defun vm-su-message-number (m) X (vm-number-of m)) X X(defun vm-su-subject (m) X (or (vm-subject-of m) X (vm-set-subject-of m X (or (vm-get-header-contents m "Subject") "")))) SHAR_EOF chmod 0664 vm-summary.el || echo "restore of vm-summary.el fails" echo "x - extracting vm-undo.el (Text)" sed 's/^X//' << 'SHAR_EOF' > vm-undo.el && X;;; Commands to undo message attribute changes in VM 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(require 'vm) X X(defun vm-undo-boundary () X (if (car vm-undo-record-list) X (setq vm-undo-record-list (cons nil vm-undo-record-list)))) X X(defun vm-clear-expunge-invalidated-undos () X (let ((udp vm-undo-record-list) udp-prev) X (while udp X (cond ((null (car udp)) X (setq udp-prev udp)) X ((and (not (eq (car (car udp)) 'set-buffer-modified-p)) X (vm-deleted-flag (car (cdr (car udp))))) X (cond (udp-prev (setcdr udp-prev (cdr udp))) X (t (setq vm-undo-record-list (cdr udp))))) X (t (setq udp-prev udp))) X (setq udp (cdr udp))) X (vm-clear-modification-flag-undos)) X (vm-squeeze-consecutive-undo-boundaries)) X X(defun vm-clear-modification-flag-undos () X (let ((udp vm-undo-record-list) udp-prev) X (while udp X (cond ((null (car udp)) X (setq udp-prev udp)) X ((eq (car (car udp)) 'set-buffer-modified-p) X (cond (udp-prev (setcdr udp-prev (cdr udp))) X (t (setq vm-undo-record-list (cdr udp))))) X (t (setq udp-prev udp))) X (setq udp (cdr udp)))) X (vm-squeeze-consecutive-undo-boundaries)) X X;; squeeze out consecutive record separators left by the deletions X(defun vm-squeeze-consecutive-undo-boundaries () X (let ((udp vm-undo-record-list) udp-prev) X (while udp X (cond ((and (null (car udp)) udp-prev (null (car udp-prev))) X (setcdr udp-prev (cdr udp))) X (t (setq udp-prev udp))) X (setq udp (cdr udp))) X (if (equal '(nil) vm-undo-record-list) X (setq vm-undo-record-list nil)))) X X(defun vm-undo-record (sexp) X (setq vm-undo-record-list (cons sexp vm-undo-record-list))) X X(defun vm-undo () X "Undo last change to message attributes in the current folder. XConsecutive invocations of this command cause sequentially earlier Xchanges to be undone. After an intervening command between undos, Xthe undos themselves become undoable." X (interactive) X (if vm-mail-buffer X (set-buffer vm-mail-buffer)) X (let ((inhibit-quit t)) X (if (not (eq last-command 'vm-undo)) X (setq vm-undo-record-pointer vm-undo-record-list)) X (if (not vm-undo-record-pointer) X (error "No further VM undo information available")) X ;; skip current record boundary X (setq vm-undo-record-pointer (cdr vm-undo-record-pointer)) X (while (car vm-undo-record-pointer) X (eval (car vm-undo-record-pointer)) X (setq vm-undo-record-pointer (cdr vm-undo-record-pointer))) X (message "VM Undo!") X (vm-update-summary-and-mode-line))) X X(defun vm-set-new-flag (m flag) X (let ((inhibit-quit t)) X (cond ((not (buffer-modified-p)) X (set-buffer-modified-p t) X (vm-undo-record (list 'set-buffer-modified-p nil)))) X (vm-undo-record (list 'vm-set-new-flag m (not flag))) X (vm-undo-boundary) X (aset (aref m 5) 0 flag) X (vm-mark-for-display-update m))) X X(defun vm-set-unread-flag (m flag) X (let ((inhibit-quit t)) X (cond ((not (buffer-modified-p)) X (set-buffer-modified-p t) X (vm-undo-record (list 'set-buffer-modified-p nil)))) X (vm-undo-record (list 'vm-set-unread-flag m (not flag))) X (vm-undo-boundary) X (aset (aref m 5) 1 flag) X (vm-mark-for-display-update m))) X X(defun vm-set-deleted-flag (m flag) X (let ((inhibit-quit t)) X (cond ((not (buffer-modified-p)) X (set-buffer-modified-p t) X (vm-undo-record (list 'set-buffer-modified-p nil)))) X (vm-undo-record (list 'vm-set-deleted-flag m (not flag))) X (vm-undo-boundary) X (aset (aref m 5) 2 flag) X (vm-mark-for-display-update m))) X X(defun vm-set-filed-flag (m flag) X (let ((inhibit-quit t)) X (cond ((not (buffer-modified-p)) X (set-buffer-modified-p t) X (vm-undo-record (list 'set-buffer-modified-p nil)))) X (vm-undo-record (list 'vm-set-filed-flag m (not flag))) X (vm-undo-boundary) X (aset (aref m 5) 3 flag) X (vm-mark-for-display-update m))) X X(defun vm-set-replied-flag (m flag) X (let ((inhibit-quit t)) X (cond ((not (buffer-modified-p)) X (set-buffer-modified-p t) X (vm-undo-record (list 'set-buffer-modified-p nil)))) X (vm-undo-record (list 'vm-set-replied-flag m (not flag))) X (vm-undo-boundary) X (aset (aref m 5) 4 flag) X (vm-mark-for-display-update m))) SHAR_EOF chmod 0664 vm-undo.el || echo "restore of vm-undo.el fails" echo "x - extracting vm.el (Text)" 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-spool-files nil X "*If non-nil this variable's value should be a list of strings naming files Xthat VM will check for incoming mail instead of the where VM thinks your Xsystem mailbox is. This variable can be used to specify multiple spool files Xor to point VM in the right direction if its notion of your system mailbox is Xincorrect.") 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-preview-read-messages t X "*Non-nil value means to preview messages, even if they've already been read. XA nil value causes VM to preview messages only if new or unread.") X X(defvar vm-folder-type nil X "*Value specifies the type of mail folder VM should expect to read and Xwrite. Nil means expect the UNIX style folders characterized by the X\"\\n\\nFrom \" message separators. The only other supported value for Xthis variable is the symbol `mmdf' which causes VM to use X\"^A^A^A^A\\n\" MMDF style leaders and trailers.") X X(defvar vm-folder-directory nil X "*Directory where folders of mail are kept.") X X(defvar vm-confirm-new-folders nil X "*Non-nil value causes interactive calls to vm-save-message Xto ask for confirmation before creating a new folder.") X X(defvar vm-delete-empty-folders t X "*Non-nil value causes VM to remove empty (zero length) folder files Xafter saving them.") 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 and REGEXP are strings, and FOLDER-NAME is a string or an s-expression that evaluates to a string. X XIf any part of the contents of the message header named by HEADER-NAME Xis matched by the regular expression REGEXP, VM will evaluate the Xcorresponding FOLDER-NAME and use the result as the default when Xprompting for a folder to save the message in. If trhe resulting folder Xname is a relative pathname, then it will resolve to the directory named by Xvm-folder-directory, or the default-directory of the currently visited Xfolder if vm-folder-directory is nil. X XWhen FOLDER-NAME is evaluated, the current buffer will contain only the Xcontents of the header named by HEADER-NAME. It is safe to modify this Xbuffer. You can use the match data from any \\( ... \\) grouping Xconstructs in REGEXP along with the function buffer-substring to build a Xfolder name based on the header information. 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-in-reply-to-format "%i" X "*String which specifies the format of the contents of the In-Reply-To Xheader that is generated for replies. See the documentation for the Xvariable vm-summary-format for information on what this string may Xcontain. The format should *not* end with a newline. XNil means don't put an In-Reply-To: header in replies.") 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 Xvariable vm-summary-format for information on what this string may contain. XNil means don't attribute included text in replies.") X X(defvar vm-forwarding-subject-format "forwarded message from %F" X "*String which specifies the format of the contents of the Subject Xheader that is generated for a forwarded message. See the documentation Xfor the variable vm-summary-format for information on what this string Xmay contain. The format should *not* end with a newline. Nil means Xleave the Subject header empty when forwarding.") 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-mutable-windows t X "*This variable's value controls VM's window usage. X XA value of t gives VM free run of the Emacs display; it will commandeer Xthe entire screen for its purposes. X XA value of nil restricts VM's window usage to the window from which Xit was invoked. VM will not create, delete, or use any other windows, Xnor will it resize it's own window. X XA value that is neither t nor nil allows VM to use other windows, but it Xwill not create new ones, or resize or delete the current ones.") 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. XThe latter only works if the variable pop-up-windows's value is non-nil. XSee the documentation for vm-mail-window-percentage to see how to change how Xthe screen is apportioned between the folder and summary windows.") X X(defvar vm-follow-summary-cursor nil X "*Non-nil value causes VM to select the message under the cursor in the Xsummary window before executing commands that operate on the current message. XThis occurs only when the summary buffer window is the selected window.") 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 folder 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-move-after-deleting nil X "*Non-nil value causes VM's `d' command to automatically invoke Xvm-next-message or vm-previous-message after deleting, to move Xpast the deleted messages.") X X(defvar vm-delete-after-saving nil X "*Non-nil value causes VM automatically to mark messages for deletion Xafter successfully saving them to a folder.") X X(defvar vm-circular-folders 0 X "*Value determines whether VM folders will be considered circular by Xvarious commands. `Circular' means VM will wrap from the end of the folder Xto the start and vice versa when moving the message pointer or deleting, Xundeleting or saving messages before or after the current message. X XA value of t causes all VM commands to consider folders circular. X XA value of nil causes all of VM commands to signal an error if the start Xor end of the folder would have to be passed to complete the command. XFor movement commands, this occurs after the message pointer has been Xmoved as far it can go. For other commands the error occurs before any Xpart of the command has been executed, i.e. no moves, saves, etc. will Xbe done unless they can be done in their entirety. X XA value that is not nil and not t causes only VM's movement commands to Xconsider folders circular. Saves, deletes and undeleted command will Xbehave the same as if the value is nil.") 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-strip-reply-headers nil X "*Non-nil value causes VM to strip away all comments and extraneous text Xfrom the headers generated in reply messages. If you use the \"fakemail\" Xprogram as distributed with Emacs, you probably want to set this variable to Xto t, because as of Emacs v18.52 \"fakemail\" could not handle unstripped Xheaders.") 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 mail-yank-hooks nil X "*List of hooks functions called after yanking a message into a *mail* Xbuffer.") X X(defvar vm-mode-map nil X "Keymap for VM mode and VM Summary mode.") X X(defconst vm-version "4.37" 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-last-save-folder nil) X(make-variable-buffer-local 'vm-last-save-folder) X(defvar vm-last-pipe-command nil) X(make-variable-buffer-local 'vm-last-pipe-command) X(defvar vm-messages-not-on-disk 0) X(make-variable-buffer-local 'vm-messages-not-on-disk) X(defvar vm-inhibit-write-file-hook nil) X(defvar vm-session-beginning t) 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 X;; (widen) and modify text outside the old region. X;; This should do it right. X(defmacro vm-save-restriction (&rest forms) X (let ((vm-sr-clip (make-symbol "vm-sr-clip")) X (vm-sr-min (make-symbol "vm-sr-min")) X (vm-sr-max (make-symbol "vm-sr-max"))) X (list 'let (list (list vm-sr-clip '(> (buffer-size) X (- (point-max) (point-min))))) X (list 'and vm-sr-clip X (list 'setq vm-sr-min '(set-marker (make-marker) (point-min))) X (list 'setq vm-sr-max '(set-marker (make-marker) (point-max)))) X (list 'unwind-protect (cons 'progn forms) X '(widen) X (list 'and vm-sr-clip X (list 'progn X (list 'narrow-to-region vm-sr-min vm-sr-max) X (list 'set-marker vm-sr-min nil) X (list 'set-marker vm-sr-max nil))))))) 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)) SHAR_EOF echo "End of part 2" echo "File vm.el is continued in part 3" echo "3" > s2_seq_.tmp exit 0