Article View: gnu.emacs.vm.bug
Article #8810VM 5.33 -> 5.33.L patch
From: Jamie Zawinski
Date: Thu, 15 Apr 1993 18:53
Date: Thu, 15 Apr 1993 18:53
1082 lines
42787 bytes
42787 bytes
Here are patches to VM 5.33 to include the features/fixes I've been
maintaining for the last couple of years. Hey Kyle. Dude. In 5.34?
Pretty please?
-- Jamie
diff -cr vm-5.33/Makefile vm/Makefile
*** vm-5.33/Makefile Tue Aug 18 20:53:05 1992
--- vm/Makefile Thu Apr 15 11:40:02 1993
***************
*** 1,8 ****
- EMACS=emacs
! VM:
! $(EMACS) -batch -q -l ./vm-message.el -l ./vm-misc.el -f batch-byte-compile *.el
! cat vm-*.elc > vm.elc
vm: vm.texinfo
$(EMACS) -batch -q vm.texinfo -f texinfo-format-buffer -f save-buffer
--- 1,25 ----
! EMACS=emacs
!
! .SUFFIXES: .elc .el
!
! STD= vm-delete.elc vm-digest.elc vm-edit.elc vm-folder.elc vm-group.elc \
! vm-license.elc vm-mark.elc vm-message.elc vm-misc.elc vm-motion.elc \
! vm-page.elc vm-reply.elc vm-save.elc vm-search.elc vm-summary.elc \
! vm-undo.elc vm-vars.elc vm-version.elc vm-virtual.elc vm-window.elc
! EXTRA= vm-sort.elc vm-lucid.elc
!
! BINS= $(STD) $(EXTRA)
!
! VM: vm.elc
!
! DEPS= -l ./vm-vars.el -l ./vm-message.el -l ./vm-misc.el
!
! .el.elc:
! $(EMACS) -batch -q $(DEPS) -f batch-byte-compile $(@:.elc=.el)
!
! vm.elc: $(BINS)
! cat $(BINS) > $@
vm: vm.texinfo
$(EMACS) -batch -q vm.texinfo -f texinfo-format-buffer -f save-buffer
diff -cr vm-5.33/README vm/README
*** vm-5.33/README Sun Apr 21 20:06:24 1991
--- vm/README Mon Jun 29 15:29:12 1992
***************
*** 11,13 ****
--- 11,15 ----
entry for VM.
Mail bug reports to bug-vm@uunet.uu.net or post them to gnu.emacs.vm.bug.
+
+ Note: this version of VM has been hacked by Lucid.
diff -cr vm-5.33/vm-edit.el vm/vm-edit.el
*** vm-5.33/vm-edit.el Sat Apr 6 17:32:49 1991
--- vm/vm-edit.el Thu Jul 2 14:24:06 1992
***************
*** 94,100 ****
(t
(define-key dest-map (char-to-string i) src-b)))
(vm-decrement i))))
! (t
(let (src-b dest-b)
(setq src-map (cdr src-map))
(while src-map
--- 94,100 ----
(t
(define-key dest-map (char-to-string i) src-b)))
(vm-decrement i))))
! ((consp src-map)
(let (src-b dest-b)
(setq src-map (cdr src-map))
(while src-map
***************
*** 111,117 ****
(t
(define-key dest-map (char-to-string (car (car src-map)))
src-b)))
! (setq src-map (cdr src-map)))))))
(use-local-map old-local-map))))
(defun vm-discard-cached-data (&optional count)
--- 111,131 ----
(t
(define-key dest-map (char-to-string (car (car src-map)))
src-b)))
! (setq src-map (cdr src-map)))))
! ((fboundp 'map-keymap)
! (let (src-b dest-b)
! (map-keymap
! (function
! (lambda (key src-b)
! (cond ((keymapp src-b)
! (setq dest-b (local-key-binding (vector key)))
! (if (not (keymapp dest-b))
! (define-key dest-map key
! (setq dest-b (make-sparse-keymap))))
! (vm-overlay-keymap src-b dest-b))
! (t
! (define-key dest-map key src-b)))))
! src-map)))))
(use-local-map old-local-map))))
(defun vm-discard-cached-data (&optional count)
diff -cr vm-5.33/vm-folder.el vm/vm-folder.el
*** vm-5.33/vm-folder.el Sun Apr 11 20:13:15 1993
--- vm/vm-folder.el Thu Apr 15 01:30:18 1993
***************
*** 75,81 ****
(save-excursion
(vm-build-visible-header-alist)
(let (tail-cons message prev-message case-fold-search list marker
! start-regexp sep-pattern trailer-length)
(if (eq vm-folder-type 'mmdf)
(setq start-regexp "^\001\001\001\001\n"
separator-string "\n\001\001\001\001\n\001\001\001\001"
--- 75,82 ----
(save-excursion
(vm-build-visible-header-alist)
(let (tail-cons message prev-message case-fold-search list marker
! start-regexp sep-pattern trailer-length
! separator-string)
(if (eq vm-folder-type 'mmdf)
(setq start-regexp "^\001\001\001\001\n"
separator-string "\n\001\001\001\001\n\001\001\001\001"
***************
*** 600,606 ****
(insert-before-markers (vm-number-of (car mp)))
(setq n (1+ n) mp (cdr mp))
(and mp (insert-before-markers
! (if (zerop (mod n 15))
"\n\t "
" "))))
(insert-before-markers ")\n")
--- 601,607 ----
(insert-before-markers (vm-number-of (car mp)))
(setq n (1+ n) mp (cdr mp))
(and mp (insert-before-markers
! (if (zerop (% n 15))
"\n\t "
" "))))
(insert-before-markers ")\n")
***************
*** 976,983 ****
(t (describe-mode)))))
(defun vm-move-mail (source destination)
! (call-process vm-movemail-program nil nil nil
! (expand-file-name source) (expand-file-name destination)))
(defun vm-gobble-crash-box ()
(save-excursion
--- 977,989 ----
(t (describe-mode)))))
(defun vm-move-mail (source destination)
! (let ((status
! (call-process vm-movemail-program nil nil nil
! (expand-file-name source)
! (expand-file-name destination))))
! (if (not (= 0 status))
! (error "vm: %s exited with code %s" vm-movemail-program status))
! status))
(defun vm-gobble-crash-box ()
(save-excursion
***************
*** 987,993 ****
(old-buffer-modified-p (buffer-modified-p))
;; crash box could contain a letter bomb...
;; force user notification of file variables.
! (inhibit-local-variables t))
(setq crash-buf (find-file-noselect vm-crash-box))
(goto-char (point-max))
(insert-buffer-substring crash-buf
--- 993,1000 ----
(old-buffer-modified-p (buffer-modified-p))
;; crash box could contain a letter bomb...
;; force user notification of file variables.
! (inhibit-local-variables t)
! (enable-local-variables nil))
(setq crash-buf (find-file-noselect vm-crash-box))
(goto-char (point-max))
(insert-buffer-substring crash-buf
***************
*** 1230,1235 ****
--- 1237,1243 ----
;; set inhibit-local-variables non-nil to protect
;; against letter bombs.
(let ((inhibit-local-variables t)
+ (enable-local-variables nil)
(full-startup (not (bufferp folder)))
mail-buffer already-existed)
(setq mail-buffer
Only in vm: vm-lucid.el
diff -cr vm-5.33/vm-mark.el vm/vm-mark.el
*** vm-5.33/vm-mark.el Sun Apr 21 14:19:13 1991
--- vm/vm-mark.el Thu Jul 2 14:24:10 1992
***************
*** 100,106 ****
on the marked messages in the current folder."
(interactive)
(message "Next command uses marks...")
! (setq unread-command-char (read-char)))
(defun vm-marked-messages ()
(let (list (mp vm-message-list))
--- 100,108 ----
on the marked messages in the current folder."
(interactive)
(message "Next command uses marks...")
! (if (fboundp 'next-command-event)
! (setq unread-command-event (next-command-event (allocate-event)))
! (setq unread-command-char (read-char))))
(defun vm-marked-messages ()
(let (list (mp vm-message-list))
diff -cr vm-5.33/vm-misc.el vm/vm-misc.el
*** vm-5.33/vm-misc.el Wed Apr 10 13:32:56 1991
--- vm/vm-misc.el Thu Apr 15 01:13:38 1993
***************
*** 30,36 ****
(let (work-buffer)
(save-excursion
(unwind-protect
! (let (list start s)
(setq work-buffer (generate-new-buffer "*VM parse*"))
(set-buffer work-buffer)
(insert string)
--- 30,36 ----
(let (work-buffer)
(save-excursion
(unwind-protect
! (let (list start s char)
(setq work-buffer (generate-new-buffer "*VM parse*"))
(set-buffer work-buffer)
(insert string)
***************
*** 69,75 ****
(if (and (null (string-match "^[\t\f\n\r ]+$" s))
(not (string= s "")))
(setq list (cons s list)))
! list )
(and work-buffer (kill-buffer work-buffer)))))))
(defmacro vm-marker (pos &optional buffer)
--- 69,75 ----
(if (and (null (string-match "^[\t\f\n\r ]+$" s))
(not (string= s "")))
(setq list (cons s list)))
! (nreverse list)) ; jwz: fixed order
(and work-buffer (kill-buffer work-buffer)))))))
(defmacro vm-marker (pos &optional buffer)
diff -cr vm-5.33/vm-page.el vm/vm-page.el
*** vm-5.33/vm-page.el Sun Apr 11 20:04:50 1993
--- vm/vm-page.el Tue Jan 26 16:03:40 1993
***************
*** 154,159 ****
--- 154,161 ----
(eq major-mode 'vm-virtual-mode)
(not (one-window-p t)))
(vm-display-current-message-buffer t))
+ (if (null vm-message-pointer) ; don't lose on empty folder -- jwz
+ nil
(let ((vmp vm-message-pointer))
(vm-within-current-message-buffer
(let ((vm-message-pointer vmp))
***************
*** 185,195 ****
(not (vm-new-flag (car vm-message-pointer)))
(not (vm-unread-flag (car vm-message-pointer)))))
(vm-show-current-message)
! (vm-update-summary-and-mode-line)))
(defun vm-show-current-message ()
(setq vm-system-state 'showing)
! (let ((vmp vm-message-pointer))
(vm-within-current-message-buffer
(let ((vm-message-pointer vmp))
(save-excursion
--- 187,201 ----
(not (vm-new-flag (car vm-message-pointer)))
(not (vm-unread-flag (car vm-message-pointer)))))
(vm-show-current-message)
! (vm-update-summary-and-mode-line)
! (run-hooks 'vm-preview-message-hook) ; jwz
! )))
(defun vm-show-current-message ()
(setq vm-system-state 'showing)
! (let ((vmp vm-message-pointer)
! (newp nil)
! (unreadp nil))
(vm-within-current-message-buffer
(let ((vm-message-pointer vmp))
(save-excursion
***************
*** 200,211 ****
(progn
(if (looking-at page-delimiter)
(forward-page 1))
! (vm-narrow-to-page))))))
(cond ((vm-new-flag (car vm-message-pointer))
(vm-set-new-flag (car vm-message-pointer) nil))
((vm-unread-flag (car vm-message-pointer))
(vm-set-unread-flag (car vm-message-pointer) nil)))
! (vm-update-summary-and-mode-line))
(defun vm-expose-hidden-headers ()
"Toggle exposing and hiding message headers that are normally not visible."
--- 206,223 ----
(progn
(if (looking-at page-delimiter)
(forward-page 1))
! (vm-narrow-to-page)))))
(cond ((vm-new-flag (car vm-message-pointer))
+ (setq newp t) ; jwz: for vm-show-new-message-hook.
(vm-set-new-flag (car vm-message-pointer) nil))
((vm-unread-flag (car vm-message-pointer))
+ (setq unreadp t) ; jwz: for vm-show-unread-message-hook.
(vm-set-unread-flag (car vm-message-pointer) nil)))
! (vm-update-summary-and-mode-line)
! (cond (newp (run-hooks 'vm-show-new-message-hook))
! (unreadp (run-hooks 'vm-show-unread-message-hook)))
! (run-hooks 'vm-show-message-hook)
! ))
(defun vm-expose-hidden-headers ()
"Toggle exposing and hiding message headers that are normally not visible."
diff -cr vm-5.33/vm-reply.el vm/vm-reply.el
*** vm-5.33/vm-reply.el Wed Oct 16 11:47:27 1991
--- vm/vm-reply.el Thu Jul 2 14:24:10 1992
***************
*** 127,133 ****
(defun vm-strip-ignored-addresses (addresses)
(setq addresses (copy-sequence addresses))
! (let (re-list list)
(setq re-list vm-reply-ignored-addresses)
(while re-list
(setq addr-list addresses)
--- 127,133 ----
(defun vm-strip-ignored-addresses (addresses)
(setq addresses (copy-sequence addresses))
! (let (re-list list addr-list)
(setq re-list vm-reply-ignored-addresses)
(while re-list
(setq addr-list addresses)
***************
*** 143,150 ****
(delete-region (point) (progn (search-forward "\n\n") (point)))
(if vm-included-text-attribution-format
(insert (vm-sprintf 'vm-included-text-attribution-format message)))
! (while (and (re-search-forward "^" nil t) (< (point) (mark)))
! (replace-match vm-included-text-prefix t t))))
(defun vm-yank-message-other-folder (folder &optional prefix-argument)
"Like vm-yank-message except the message is yanked from a folder other
--- 143,151 ----
(delete-region (point) (progn (search-forward "\n\n") (point)))
(if vm-included-text-attribution-format
(insert (vm-sprintf 'vm-included-text-attribution-format message)))
! (let ((zmacs-regions nil))
! (while (and (re-search-forward "^" nil t) (< (point) (mark)))
! (replace-match vm-included-text-prefix t t)))))
(defun vm-yank-message-other-folder (folder &optional prefix-argument)
"Like vm-yank-message except the message is yanked from a folder other
***************
*** 296,302 ****
(let (recipients)
(cond ((not (zerop (length (setq recipients (mail-fetch-field "To"))))))
((not (zerop (length (setq recipients (mail-fetch-field "Cc"))))))
! (t (setq recipient "the horse with no name")))
(setq prefix (format "sent mail to %s" recipients))))
(setq name prefix n 1)
(while (get-buffer name)
--- 297,303 ----
(let (recipients)
(cond ((not (zerop (length (setq recipients (mail-fetch-field "To"))))))
((not (zerop (length (setq recipients (mail-fetch-field "Cc"))))))
! (t (setq recipients "the horse with no name")))
(setq prefix (format "sent mail to %s" recipients))))
(setq name prefix n 1)
(while (get-buffer name)
***************
*** 706,716 ****
(auto-save-mode auto-save-default)
(mail-mode)
(switch-to-buffer (current-buffer))
! (if (eq mail-aliases t)
! (progn
! (setq mail-aliases nil)
! (if (file-exists-p "~/.mailrc")
! (build-mail-aliases))))
(if (stringp vm-mail-header-from)
(insert "From: " vm-mail-header-from "\n"))
(insert "To: " (or to "") "\n")
--- 707,719 ----
(auto-save-mode auto-save-default)
(mail-mode)
(switch-to-buffer (current-buffer))
! (if (fboundp 'mail-aliases-setup)
! (mail-aliases-setup)
! (if (eq mail-aliases t)
! (progn
! (setq mail-aliases nil)
! (if (file-exists-p "~/.mailrc")
! (build-mail-aliases)))))
(if (stringp vm-mail-header-from)
(insert "From: " vm-mail-header-from "\n"))
(insert "To: " (or to "") "\n")
Only in vm: vm-sort.el
diff -cr vm-5.33/vm-summary.el vm/vm-summary.el
*** vm-5.33/vm-summary.el Mon Oct 21 21:04:31 1991
--- vm/vm-summary.el Thu Apr 15 01:36:00 1993
***************
*** 25,31 ****
buffer-read-only t
vm-summary-pointer nil
truncate-lines t)
! (use-local-map vm-mode-map))
(put 'vm-summary-mode 'mode-class 'special)
--- 25,32 ----
buffer-read-only t
vm-summary-pointer nil
truncate-lines t)
! (use-local-map vm-mode-map)
! (run-hooks 'vm-summary-mode-hooks))
(put 'vm-summary-mode 'mode-class 'special)
***************
*** 220,226 ****
(defun vm-follow-summary-cursor ()
(and vm-follow-summary-cursor (eq major-mode 'vm-summary-mode)
(let ((point (point))
! message-pointer message-list)
(save-excursion
(set-buffer vm-mail-buffer)
(setq message-pointer vm-message-pointer
--- 221,227 ----
(defun vm-follow-summary-cursor ()
(and vm-follow-summary-cursor (eq major-mode 'vm-summary-mode)
(let ((point (point))
! message-pointer message-list mp)
(save-excursion
(set-buffer vm-mail-buffer)
(setq message-pointer vm-message-pointer
***************
*** 256,270 ****
(eval (get format-variable 'vm-format-sexp))))
(defun vm-compile-format (format-variable)
(let ((format (symbol-value format-variable))
sexp sexp-fmt conv-spec last-match-end case-fold-search)
(store-match-data nil)
! (while (string-match
! "%\\(-\\)?\\([0-9]\\)*\\(\\.\\([0-9]+\\)\\)?\\([aAcdfFhilmMnstTwyz*%]\\)"
format (match-end 0))
(setq conv-spec (aref format (match-beginning 5)))
! (if (memq conv-spec '(?a ?A ?c ?d ?f ?F ?h ?i ?l ?M
! ?m ?n ?s ?t ?T ?w ?y ?z ?*))
(progn
(cond ((= conv-spec ?a)
(setq sexp (cons (list 'vm-su-attribute-indicators
--- 257,273 ----
(eval (get format-variable 'vm-format-sexp))))
(defun vm-compile-format (format-variable)
+ (if (null vm-uninteresting-senders) ; jwz: added this.
+ (setq vm-uninteresting-senders (concat "\\b" (user-login-name) "\\b")))
(let ((format (symbol-value format-variable))
sexp sexp-fmt conv-spec last-match-end case-fold-search)
(store-match-data nil)
! (while (string-match ; jwz: added "uUH".
! "%\\(-\\)?\\([0-9]+\\)?\\(\\.\\([0-9]+\\)\\)?\\([aAcdfFhHilmMnstTuUwyz*%]\\)"
format (match-end 0))
(setq conv-spec (aref format (match-beginning 5)))
! (if (memq conv-spec '(?a ?A ?c ?d ?f ?F ?h ?H ?i ?l ?M
! ?m ?n ?s ?t ?T ?u ?U ?w ?y ?z ?*)) ; jwz: ?[uUH]
(progn
(cond ((= conv-spec ?a)
(setq sexp (cons (list 'vm-su-attribute-indicators
***************
*** 287,292 ****
--- 290,299 ----
((= conv-spec ?h)
(setq sexp (cons (list 'vm-su-hour
'vm-su-message) sexp)))
+ ;; jwz: added this.
+ ((= conv-spec ?H)
+ (setq sexp (cons (list 'vm-su-hour-short
+ 'vm-su-message) sexp)))
((= conv-spec ?i)
(setq sexp (cons (list 'vm-su-message-id
'vm-su-message) sexp)))
***************
*** 303,309 ****
(setq sexp (cons (list 'vm-su-message-number
'vm-su-message) sexp)))
((= conv-spec ?s)
! (setq sexp (cons (list 'vm-su-subject
'vm-su-message) sexp)))
((= conv-spec ?T)
(setq sexp (cons (list 'vm-su-to-names
--- 310,318 ----
(setq sexp (cons (list 'vm-su-message-number
'vm-su-message) sexp)))
((= conv-spec ?s)
! (setq sexp (cons (list (if vm-summary-no-newlines-in-subject
! 'vm-su-subject-no-newlines
! 'vm-su-subject)
'vm-su-message) sexp)))
((= conv-spec ?T)
(setq sexp (cons (list 'vm-su-to-names
***************
*** 311,316 ****
--- 320,333 ----
((= conv-spec ?t)
(setq sexp (cons (list 'vm-su-to
'vm-su-message) sexp)))
+ ;; jwz: added this.
+ ((= conv-spec ?U)
+ (setq sexp (cons (list 'vm-su-dwim-user-name
+ 'vm-su-message) sexp)))
+ ;; jwz: added this.
+ ((= conv-spec ?u)
+ (setq sexp (cons (list 'vm-su-dwim-user
+ 'vm-su-message) sexp)))
((= conv-spec ?w)
(setq sexp (cons (list 'vm-su-weekday
'vm-su-message) sexp)))
***************
*** 446,458 ****
(progn (vm-su-do-date m) (vm-month-number-of m))))
(defun vm-su-year (m)
! (or (vm-year-of m)
! (progn (vm-su-do-date m) (vm-year-of m))))
(defun vm-su-hour (m)
(or (vm-hour-of m)
(progn (vm-su-do-date m) (vm-hour-of m))))
(defun vm-su-zone (m)
(or (vm-zone-of m)
(progn (vm-su-do-date m) (vm-zone-of m))))
--- 463,487 ----
(progn (vm-su-do-date m) (vm-month-number-of m))))
(defun vm-su-year (m)
! ;; always return a 2-digit year
! (let ((year (or (vm-year-of m)
! (progn (vm-su-do-date m) (vm-year-of m)))))
! (if (string-match "\\`[0-9][0-9][0-9][0-9]\\'" year)
! (substring year 2 4)
! year)))
(defun vm-su-hour (m)
(or (vm-hour-of m)
(progn (vm-su-do-date m) (vm-hour-of m))))
+ (defun vm-su-hour-short (m)
+ (let ((string (vm-su-hour m)))
+ (cond ((eq 8 (length string))
+ (substring string 0 5))
+ ((eq 7 (length string))
+ (concat "0" (substring string 0 4)))
+ (t string))))
+
(defun vm-su-zone (m)
(or (vm-zone-of m)
(progn (vm-su-do-date m) (vm-zone-of m))))
***************
*** 473,479 ****
(buffer-substring (match-beginning 1) (match-end 1)))))))
(defun vm-su-do-date (m)
! (let (date)
(setq date (or (vm-get-header-contents m "Date") (vm-grok-From_-date m)))
(cond
((null date)
--- 502,509 ----
(buffer-substring (match-beginning 1) (match-end 1)))))))
(defun vm-su-do-date (m)
! (let (date
! (case-fold-search t))
(setq date (or (vm-get-header-contents m "Date") (vm-grok-From_-date m)))
(cond
((null date)
***************
*** 483,508 ****
(vm-set-month-number-of m "")
(vm-set-year-of m "")
(vm-set-hour-of m "")
! (vm-set-zone-of m ""))
((string-match
;; The date format recognized here is the one specified in RFC 822.
;; Some slop is allowed e.g. dashes between the monthday, month and year
;; because such malformed headers have been observed.
! "\\(\\([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]\\)"
date)
(if (match-beginning 2)
(vm-set-weekday-of m (substring date (match-beginning 2)
(match-end 2)))
! (vm-set-weekday-of m ""))
(vm-set-monthday-of m (substring date (match-beginning 3) (match-end 3)))
(vm-su-do-month m (substring date (match-beginning 4) (match-end 4)))
(vm-set-year-of m (substring date (match-beginning 5) (match-end 5)))
(vm-set-hour-of m (substring date (match-beginning 6) (match-end 6)))
! (vm-set-zone-of m (substring date (match-beginning 7) (match-end 7))))
((string-match
;; UNIX ctime(3) format, with slop allowed in the whitespace, and we allow for
;; the possibility of a timezone at the end.
! "\\([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]\\)?"
date)
(vm-set-weekday-of m (substring date (match-beginning 1) (match-end 1)))
(vm-su-do-month m (substring date (match-beginning 2) (match-end 2)))
--- 513,557 ----
(vm-set-month-number-of m "")
(vm-set-year-of m "")
(vm-set-hour-of m "")
! (vm-set-zone-of m "")
! nil)
((string-match
;; The date format recognized here is the one specified in RFC 822.
;; Some slop is allowed e.g. dashes between the monthday, month and year
;; because such malformed headers have been observed.
! ;; jwz: added some more slop - dashes between time and zone.
! ;; Also allow DOTW to be at end, optionally in parens.
! ;;
! ;; Handles:
! ;; Mon, 3 dec 90 15:25:36 PST
! ;; Mon 3 dec 90 15:25:36 PST
! ;; 03-dec-90 15:25:36 PST
! ;; Mon, 3 dec 90 15:25:36-PST
! ;; 3 Dec 90 15:25 PST (Mon)
! "\\(\\([a-z][a-z][a-z]\\),?\\)?[ \t\n]*0?\\([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]\\)[ \t\n]*(?\\([a-z][a-z][a-z]\\)?)?"
date)
(if (match-beginning 2)
(vm-set-weekday-of m (substring date (match-beginning 2)
(match-end 2)))
! (if (match-beginning 8)
! (vm-set-weekday-of m (substring date (match-beginning 8)
! (match-end 8)))
! (vm-set-weekday-of m "")))
(vm-set-monthday-of m (substring date (match-beginning 3) (match-end 3)))
(vm-su-do-month m (substring date (match-beginning 4) (match-end 4)))
(vm-set-year-of m (substring date (match-beginning 5) (match-end 5)))
(vm-set-hour-of m (substring date (match-beginning 6) (match-end 6)))
! (vm-set-zone-of m (substring date (match-beginning 7) (match-end 7)))
! t)
((string-match
;; UNIX ctime(3) format, with slop allowed in the whitespace, and we allow for
;; the possibility of a timezone at the end.
! ;; jwz: more slop - allow a comma after the weekday.
! ;; Handles:
! ;; Tue Dec 11 00:13:13 1990
! ;; Mon Sep 2 10:42:17 1991
! ;; Tue, Dec 11 00:13:13 90 PST
! "\\([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]\\)?"
date)
(vm-set-weekday-of m (substring date (match-beginning 1) (match-end 1)))
(vm-su-do-month m (substring date (match-beginning 2) (match-end 2)))
***************
*** 509,518 ****
(vm-set-monthday-of m (substring date (match-beginning 3) (match-end 3)))
(vm-set-hour-of m (substring date (match-beginning 4) (match-end 4)))
(vm-set-year-of m (substring date (match-beginning 5) (match-end 5)))
! (if (match-beginning 6)
! (vm-set-zone-of m (substring date (match-beginning 6)
! (match-end 6)))))
(t
(vm-set-weekday-of m "")
(vm-set-monthday-of m "")
(vm-set-month-of m "")
--- 558,631 ----
(vm-set-monthday-of m (substring date (match-beginning 3) (match-end 3)))
(vm-set-hour-of m (substring date (match-beginning 4) (match-end 4)))
(vm-set-year-of m (substring date (match-beginning 5) (match-end 5)))
! ;; jwz: don't allow nil in the zone slot.
! (vm-set-zone-of m (if (match-beginning 6)
! (substring date (match-beginning 6)
! (match-end 6))
! ""))
! t)
! ((string-match
! ;; This piece of crap handles:
! ;; Aug 29, 1991 08:51 EDT
! ;; Aug 29 1991, 08:51-EDT
! "\\`[ \t]*\\([a-z][a-z][a-z]\\)[ \t\n]+\\([0-9][0-9]?\\)[ \t\n,]*\\([0-9]?[0-9]?[0-9][0-9]\\)[- \t,]*\\([0-9:]+\\)[- \t]*\\([a-z][a-z][a-z]\\)?"
! date)
! (vm-su-do-month m (substring date (match-beginning 1) (match-end 1)))
! (vm-set-monthday-of m (substring date (match-beginning 2) (match-end 2)))
! (vm-set-year-of m (substring date (match-beginning 3) (match-end 3)))
! (vm-set-hour-of m (substring date (match-beginning 4) (match-end 4)))
! (vm-set-zone-of m (if (match-beginning 5)
! (substring date (match-beginning 5)
! (match-end 5))
! ""))
! t)
! ((string-match
! ;; YASTF: Yet Another Sucky Time Format. Dan Jacobson found this one.
! ;; Handles:
! ;; Tue, Dec 11 12:11:45 CST 1990
! ;; Tue Dec 11 12:11 CST 1990
! "\\`[ \t]*\\([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]*\\([a-z][a-z][a-z]\\|[-+]?[0-9][0-9][0-9][0-9]\\)[ \t\n]*\\([0-9]?[0-9]?[0-9][0-9]\\)?"
! date)
! (vm-set-weekday-of m (substring date (match-beginning 1) (match-end 1)))
! (vm-su-do-month m (substring date (match-beginning 2) (match-end 2)))
! (vm-set-monthday-of m (substring date (match-beginning 3) (match-end 3)))
! (vm-set-hour-of m (substring date (match-beginning 4) (match-end 4)))
! (vm-set-zone-of m (if (match-beginning 5)
! (substring date (match-beginning 5)
! (match-end 5))
! ""))
! (vm-set-year-of m (if (match-beginning 6)
! (substring date (match-beginning 6) (match-end 6))
! ""))
! t)
! ((string-match
! ;; jwz: this one is for
! ;; Tue, 7 Jan 08:46:34 1992
! "\\`[ \t]*\\([a-z][a-z][a-z]\\)[ \t\n,]+\\([0-9][0-9]?\\)[ \t\n]+\\([a-z][a-z][a-z]\\)[ \t\n]+\\([0-9:]+\\)[ \t\n]*\\([0-9]?[0-9]?[0-9][0-9]\\)?"
! date)
! (vm-set-weekday-of m (substring date (match-beginning 1) (match-end 1)))
! (vm-set-monthday-of m (substring date (match-beginning 2) (match-end 2)))
! (vm-su-do-month m (substring date (match-beginning 3) (match-end 3)))
! (vm-set-hour-of m (substring date (match-beginning 4) (match-end 4)))
! (vm-set-year-of m (if (match-beginning 5)
! (substring date (match-beginning 5)
! (match-end 5))
! ""))
! (vm-set-zone-of m "")
! t)
! ((string-match
! ;; jwz: I've seen dates of the form "13-AUG-1990 16:11:21.26" from VMS.
! "\\`[ \t]*\\([0-9]+\\)[- \t]*\\([A-Z][A-Z][A-Z]+\\)[- \t]*\\([0-9][0-9][0-9]?[0-9]?\\)[ \t]+\\([0-9:]+\\)\\(\\.[0-9]+\\)?"
! date)
! (vm-set-weekday-of m "")
! (vm-set-monthday-of m (substring date (match-beginning 1) (match-end 1)))
! (vm-su-do-month m (substring date (match-beginning 2) (match-end 2)))
! (vm-set-year-of m (substring date (match-beginning 3) (match-end 3)))
! (vm-set-hour-of m (substring date (match-beginning 4) (match-end 4)))
! (vm-set-zone-of m "")
! t)
(t
+ ;; otherwise, punt.
(vm-set-weekday-of m "")
(vm-set-monthday-of m "")
(vm-set-month-of m "")
***************
*** 519,540 ****
(vm-set-month-number-of m "")
(vm-set-year-of m "")
(vm-set-hour-of m "")
! (vm-set-zone-of m "")))))
(defun vm-su-do-month (m month-abbrev)
- (if (not (boundp 'vm-su-month-sym-jan))
- (setq vm-su-month-sym-jan '("January" "1")
- vm-su-month-sym-feb '("February" "2")
- vm-su-month-sym-mar '("March" "3")
- vm-su-month-sym-apr '("April" "4")
- vm-su-month-sym-may '("May" "5")
- vm-su-month-sym-jun '("June" "6")
- vm-su-month-sym-jul '("July" "7")
- vm-su-month-sym-aug '("August" "8")
- vm-su-month-sym-sep '("September" "9")
- vm-su-month-sym-oct '("October" "10")
- vm-su-month-sym-nov '("November" "11")
- vm-su-month-sym-dec '("December" "12")))
(condition-case ()
(let ((val (symbol-value (intern (concat "vm-su-month-sym-"
(downcase month-abbrev))))))
--- 632,654 ----
(vm-set-month-number-of m "")
(vm-set-year-of m "")
(vm-set-hour-of m "")
! (vm-set-zone-of m "")
! nil))))
+ (defconst vm-su-month-sym-jan '("January" "1"))
+ (defconst vm-su-month-sym-feb '("February" "2"))
+ (defconst vm-su-month-sym-mar '("March" "3"))
+ (defconst vm-su-month-sym-apr '("April" "4"))
+ (defconst vm-su-month-sym-may '("May" "5"))
+ (defconst vm-su-month-sym-jun '("June" "6"))
+ (defconst vm-su-month-sym-jul '("July" "7"))
+ (defconst vm-su-month-sym-aug '("August" "8"))
+ (defconst vm-su-month-sym-sep '("September" "9"))
+ (defconst vm-su-month-sym-oct '("October" "10"))
+ (defconst vm-su-month-sym-nov '("November" "11"))
+ (defconst vm-su-month-sym-dec '("December" "12"))
+
(defun vm-su-do-month (m month-abbrev)
(condition-case ()
(let ((val (symbol-value (intern (concat "vm-su-month-sym-"
(downcase month-abbrev))))))
***************
*** 565,570 ****
--- 679,700 ----
(if (looking-at "From \\([^ \t\n]+\\)")
(buffer-substring (match-beginning 1) (match-end 1)))))))
+ ;;; There are many systems where the user's real name is encoded in the
+ ;;; user id. This version of vm-su-do-author parses the user-id to extract
+ ;;; the real name, so that the %F directive does what you want more of the
+ ;;; time. It handles the following forms of addresses:
+ ;;;
+ ;;; Jamie.Zawinski@somehost --> "Jamie Zawinski"
+ ;;; Jamie_Zawinski@somehost --> "Jamie Zawinski"
+ ;;; Jamie_W._Zawinski@somehost --> "Jamie W. Zawinski"
+ ;;; Jamie.W.Zawinski@somehost --> "Jamie W Zawinski"
+ ;;; "Jamie Zawinski"@somehost --> "Jamie Zawinski"
+ ;;; also
+ ;;; jwz ("Jamie Zawinski") --> "Jamie Zawinski"
+ ;;; jwz (Jamie Zawinski (comment)) --> "Jamie Zawinski"
+ ;;; jwz (Jamie Zawinski -- comment) --> "Jamie Zawinski"
+ ;;; and likewise in the "name <uid>" form.
+
(defun vm-su-do-author (m)
(let (full-name from)
(setq full-name (vm-get-header-contents m "Full-Name"))
***************
*** 575,585 ****
(setq full-name "???")))
((string-match "^\\([^< \t\n]+\\([ \t\n]+[^< \t\n]+\\)*\\)?[ \t\n]*\\(<\\([^>]+\\)>\\)"
from)
(if (and (match-beginning 1) (null full-name))
(setq full-name
(substring from (match-beginning 1) (match-end 1))))
(setq from (substring from (match-beginning 4) (match-end 4))))
! ((string-match "[\000-\177]*(\\([^)]+\\))[\000-\177]*" from)
(if (null full-name)
(setq full-name (substring from (match-beginning 1)
(match-end 1))))
--- 705,718 ----
(setq full-name "???")))
((string-match "^\\([^< \t\n]+\\([ \t\n]+[^< \t\n]+\\)*\\)?[ \t\n]*\\(<\\([^>]+\\)>\\)"
from)
+ ;; Matches "Real Name <uid>"
(if (and (match-beginning 1) (null full-name))
(setq full-name
(substring from (match-beginning 1) (match-end 1))))
(setq from (substring from (match-beginning 4) (match-end 4))))
! ((string-match "^[^(]*(\\(.*\\))[^)]*$" from)
! ;; Matches "uid (Real Name)" as well as "uid (real (really) name)"
! ;; and "uid (real name (comment))"
(if (null full-name)
(setq full-name (substring from (match-beginning 1)
(match-end 1))))
***************
*** 602,612 ****
(substring from (match-beginning 1)
(or (match-end 2) (match-end 1)))
(if (match-end 2) "" ".UUCP"))))
! (if (or (null full-name) (string-match "^[ \t\n]*$" full-name))
(setq full-name from))
(vm-set-full-name-of m full-name)
(vm-set-from-of m from)))
(autoload 'rfc822-addresses "rfc822")
(defun vm-su-do-recipients (m)
--- 735,780 ----
(substring from (match-beginning 1)
(or (match-end 2) (match-end 1)))
(if (match-end 2) "" ".UUCP"))))
! (if (or (null full-name) (string-match "^[ \t]*$" full-name))
(setq full-name from))
+ ;; derive username from address if address is of the form "User.Name@Host"
+ ;; or "User_Name@Host" or "\"User Name\"@Host".
+ (if (or (string-match "^[^!@%]+[._][^._%@]*[^@%][@%]" full-name)
+ (string-match "^[^!@%]*\"[^!@%]+ [^ %@]*[^@%][@%]" full-name))
+ (setq full-name (substring full-name 0 (1- (match-end 0)))))
+ (setq full-name (vm-clean-username full-name))
(vm-set-full-name-of m full-name)
(vm-set-from-of m from)))
+ (defun vm-clean-username (string)
+ "Strips garbage from the user full name string."
+ (if (string-match "[%@!]" string) ; this ain't no user name! It's an address!
+ string
+ (let ((case-fold-search t))
+ ;; take off leading and trailing non-alpha chars (quotes, parens, digits, etc)
+ (if (string-match "\\`[^a-z]+" string)
+ (setq string (substring string (match-end 0))))
+ (if (string-match "[^a-z]+\\'" string)
+ (setq string (substring string 0 (match-beginning 0))))
+ ;; replace tabs, multiple spaces, dots, and underscores with a single space.
+ ;; but don't replace ". " with " " because that could be an initial.
+ (while (string-match "\\(\t\\| +\\|\\(\\.\\)[^ \t_]\\|_+\\)" string)
+ (setq string (concat (substring string 0
+ (or (match-beginning 2)
+ (match-beginning 1)))
+ " "
+ (substring string (or (match-end 2)
+ (match-end 1))))))
+ ;; If the string contains trailing parenthesized comments, nuke 'em.
+ ;; (As in "John Doe -- Pinhead" or "John Doe (Pinhead)".)
+ (if (string-match "[^ \t]\\([ \t]*\\((\\| --\\)\\)" string)
+ (progn
+ (setq string (substring string 0 (match-beginning 1)))
+ ;; lose any non-alpha rubbish this may have exposed.
+ (if (string-match "[^a-z]+\\'" string)
+ (setq string (substring string 0 (match-beginning 0))))))
+ string)))
+
(autoload 'rfc822-addresses "rfc822")
(defun vm-su-do-recipients (m)
***************
*** 642,647 ****
--- 810,816 ----
names)))
(t (setq names (cons (car list) names))))
(setq list (cdr list)))
+ (setq names (nreverse names)) ; added by jwz for fixed vm-parse-addresses
(if vm-gargle-uucp
(while list
(if (string-match
***************
*** 672,677 ****
--- 841,867 ----
(defun vm-su-to-names (m)
(or (vm-to-names-of m) (progn (vm-su-do-recipients m) (vm-to-names-of m))))
+ (defun vm-su-dwim-user (m)
+ (let ((from (vm-su-from m)))
+ (if (string-match vm-uninteresting-senders from)
+ (concat vm-uninteresting-arrow
+ (let ((to (vm-su-to m)))
+ (if (string= to (user-login-name)) ; vm-do-recipients returns this
+ (or (vm-get-header-contents m "Newsgroups") ; if there's no To:
+ to)
+ to)))
+ from)))
+
+ (defun vm-su-dwim-user-name (m)
+ (if (string-match vm-uninteresting-senders (vm-su-from m))
+ (concat vm-uninteresting-arrow
+ (let ((to (vm-su-to-names m)))
+ (if (string= to (user-login-name)) ;; vm-do-recipients returns this
+ (or (vm-get-header-contents m "Newsgroups") ;; if there's no To:
+ to)
+ to)))
+ (vm-su-full-name m)))
+
(defun vm-su-message-id (m)
(or (vm-message-id-of m)
(vm-set-message-id-of m
***************
*** 695,697 ****
--- 885,894 ----
(or (vm-subject-of m)
(vm-set-subject-of m
(or (vm-get-header-contents m "Subject") ""))))
+
+ (defun vm-su-subject-no-newlines (m)
+ (let ((s (vm-su-subject m)))
+ (while (string-match "[ \t]*\n[ \t\n]*" s)
+ (setq s (concat (substring s 0 (match-beginning 0)) " "
+ (substring s (match-end 0)))))
+ s))
diff -cr vm-5.33/vm-vars.el vm/vm-vars.el
*** vm-5.33/vm-vars.el Sun Apr 11 17:22:49 1993
--- vm/vm-vars.el Thu Apr 15 00:56:15 1993
***************
*** 386,391 ****
--- 386,406 ----
the arrow. A value that is not nil and not t causes VM to center the
arrow only if the summary window is not the only existing window.")
+ (defvar vm-summary-no-newlines-in-subject t
+ "*If true, then any newlines in the subject of a message will be replaced
+ with spaces in the summary buffer.")
+
+ (defvar vm-uninteresting-senders nil
+ "*A regular expression matching those user-ids which are considered
+ \"uninteresting\" in the VM summary buffer; messages whose From: field
+ contains addresses which match this will have their recipient displayed
+ in the summary buffer rather than the sender if the \"%u\" or \"%U\"
+ format directive is used. See also variable vm-uninteresting-arrow.")
+
+ (defvar vm-uninteresting-arrow "=> "
+ "*The string used when the \"%u\" or \"%U\" format directive is
+ indicating the recipient of a message rather than the sender.")
+
(defvar vm-mail-window-percentage 75
"*Percentage of the screen that should be used to show mail messages.
The rest of the screen will be used by the summary buffer, if displayed.")
***************
*** 503,508 ****
--- 518,529 ----
and local variables. Mucking about in the folder buffer is certainly
possible but it is not encouraged.")
+ (defvar vm-summary-mode-hooks nil
+ "*List of hook functions to run when a buffer enters vm-summary-mode.
+ These hook functions should generally be used to set key bindings
+ and local variables. Mucking about in the folder buffer is certainly
+ possible but it is not encouraged.")
+
(defvar vm-berkeley-mail-compatibility
(memq system-type '(berkeley-unix))
"*Non-nil means to read and write BSD Mail(1) style Status: headers.
***************
*** 534,539 ****
--- 555,592 ----
(defvar mail-yank-hooks nil
"*List of hook functions called after yanking a message into a *mail*
buffer. See the documentation for the function vm-yank-message for details.")
+
+ (defvar vm-show-message-hook nil
+ "*List of hook functions called when a VM message is selected.
+ See also vm-preview-message-hook.")
+
+ (defvar vm-preview-message-hook nil
+ "*List of hook functions called when a VM message is previewed,
+ if and only if vm-preview-lines is non-nil. See also vm-show-message-hook.")
+
+ (defvar vm-show-new-message-hook nil
+ "*List of hook functions called when VM selects a new message,
+ that is, just after the ``message new'' flag has been set to false.
+
+ This is subtly different from the vm-show-unread-message-hook: a `new'
+ message is one that has been added to this folder in this session, before
+ vm-quit has been executed. An `unread' message is one that has simply
+ never been selected before; most likely this is because the message was
+ added to the folder by something other than VM.
+
+ The vm-show-message-hook will be run immediately after this hook.")
+
+ (defvar vm-show-unread-message-hook nil
+ "*List of hook functions called when VM selects a message for the first time,
+ that is, just after the ``message new'' flag has been set to false. The
+
+ This is subtly different from the vm-show-unread-message-hook: a `new'
+ message is one that has been added to this folder in this session, before
+ vm-quit has been executed. An `unread' message is one that has simply
+ never been selected before; most likely this is because the message was
+ added to the folder by something other than VM.
+
+ vm-show-message-hook will be run immediately after this hook.")
(defvar vm-movemail-program "movemail"
"*Name of program to use to move mail from the system spool
diff -cr vm-5.33/vm-version.el vm/vm-version.el
*** vm-5.33/vm-version.el Wed Dec 16 15:18:26 1992
--- vm/vm-version.el Thu Apr 15 11:46:44 1993
***************
*** 1,8 ****
(provide 'vm)
! (defconst vm-version "5.33 (beta)"
"Version number of VM.")
(defun vm-version ()
! "Returns the value of the variable vm-version."
! vm-version)
--- 1,11 ----
(provide 'vm)
! (defconst vm-version "5.33.L (beta)"
"Version number of VM.")
(defun vm-version ()
! "Returns the version numbers of VM and Emacs."
! (interactive)
! (if (interactive-p)
! (message "%s" (vm-version))
! (format "VM %s, %s" vm-version (emacs-version))))
Technical Details
Message-ID:
<9304151853.AA01696@thalidomide.lucid.com>Path:
arc1-ca.pugleaf.net!gmd.de!newsserver.jvnc.net!howland.reston.ans.net!spool.mu.edu!uunet!wendy-fate.uu.net!bug-vmReferences:
<9304151220.AA00253@crystal.wonderworks.com>Show Full Headers
Complete Article Headers
X-Google-Language: ENGLISH,ASCII-7-bit X-Google-Thread: f6829,c05f3ba6a4a2b30e X-Google-Attributes: gidf6829,public X-Google-ArrivalTime: 1993-04-15 16:37:31 PST x-gateway: rodan.UU.NET from bug-vm to gnu.emacs.vm.bug; Thu, 15 Apr 1993 19:33:24 EDT Date: Thu, 15 Apr 1993 11:53:43 PDT Message-ID: <9304151853.AA01696@thalidomide.lucid.com> X-Windows: The joke that kills. From: jwz@lucid.com (Jamie Zawinski) Sender: jwz@lucid.com Subject: VM 5.33 -> 5.33.L patch References: <9304151220.AA00253@crystal.wonderworks.com> Newsgroups: gnu.emacs.vm.bug Path: arc1-ca.pugleaf.net!gmd.de!newsserver.jvnc.net!howland.reston.ans.net!spool.mu.edu!uunet!wendy-fate.uu.net!bug-vm Lines: 1082