Article View: gnu.emacs.vm.bug
Article #9685VM 5.27 -> 5.28 patch
From: Kyle Jones
Date: Sat, 16 Mar 1991 17:18
Date: Sat, 16 Mar 1991 17:18
314 lines
12111 bytes
12111 bytes
* vm-goto-message now tries to follow the summary cursor first;
if it does, then it doesn't try to move again.
* fixed another bookmark problem; problem really inside
vm-expunge-folder, some variables needed to be set even if
quitting.
* removed the expand-file-name loop from vm-save-message, since
it would loop endlessly if vm-folder-directory was a relative
path name.
* fixed code in vm-save-message that assumed some VM specific
local variables would have sane values in a non VM mode buffer.
* VM maintains the References header in replies.
*** vm-delete.el.dist Thu Mar 14 22:15:22 1991
--- vm-delete.el Fri Mar 15 18:09:39 1991
***************
*** 117,136 ****
(message "Expunging..."))
(let ((inhibit-quit t) did-gobble)
(if (setq did-gobble (vm-gobble-deleted-messages))
! (if (not quitting)
! (progn
! (setq vm-totals nil)
! (if (not shaddap)
! (vm-deferred-message "Deleted messages expunged."))
! (setq vm-numbering-redo-start-point did-gobble
! vm-summary-redo-start-point did-gobble)
! (if (null vm-message-pointer)
! (if (null vm-message-list)
! (vm-update-summary-and-mode-line)
! (vm-next-message))
! (if (null vm-system-state)
! (vm-preview-current-message)
! (vm-update-summary-and-mode-line)))))
(error "No messages are flagged for deletion."))))
;; Remove any message marked for deletion from the buffer and the
--- 117,137 ----
(message "Expunging..."))
(let ((inhibit-quit t) did-gobble)
(if (setq did-gobble (vm-gobble-deleted-messages))
! (progn
! (setq vm-numbering-redo-start-point did-gobble
! vm-summary-redo-start-point did-gobble
! vm-totals nil)
! (if (not quitting)
! (progn
! (if (not shaddap)
! (vm-deferred-message "Deleted messages expunged."))
! (if (null vm-message-pointer)
! (if (null vm-message-list)
! (vm-update-summary-and-mode-line)
! (vm-next-message))
! (if (null vm-system-state)
! (vm-preview-current-message)
! (vm-update-summary-and-mode-line))))))
(error "No messages are flagged for deletion."))))
;; Remove any message marked for deletion from the buffer and the
*** vm-motion.el.dist Thu Mar 14 22:15:24 1991
--- vm-motion.el Fri Mar 15 17:57:51 1991
***************
*** 25,43 ****
(defun vm-goto-message (n)
"Go to the message numbered N.
Interactively N is the prefix argument. If no prefix arg is provided
! N is prompted for in the minibuffer."
! (interactive "NGo to message: ")
! (vm-select-folder-buffer)
! (vm-check-for-killed-summary)
! (vm-error-if-folder-empty)
! (let ((cons (nthcdr (1- n) vm-message-list)))
! (if (null cons)
! (error "No such message."))
! (if (eq vm-message-pointer cons)
! (vm-preview-current-message)
! (vm-record-and-change-message-pointer vm-message-pointer cons)
! (setq vm-need-summary-pointer-update t)
! (vm-preview-current-message))))
(defun vm-goto-message-last-seen ()
"Go to the message last previewed."
--- 25,55 ----
(defun vm-goto-message (n)
"Go to the message numbered N.
Interactively N is the prefix argument. If no prefix arg is provided
! N is prompted for in the minibuffer.
!
! If vm-follow-summary-cursor is non-nil this command first tries
! to follow the summary cursor to a new message. If a new message
! is selected in this way, no further action is taken. I.e. you can move
! the cursor in the summary buffer, press RETURN and select a new
! message without typing in a message number."
! (interactive
! (list
! (cond ((vm-follow-summary-cursor) nil)
! (current-prefix-arg (prefix-numeric-value current-prefix-arg))
! (t (vm-read-number "Go to message: ")))))
! (if (null n)
! () ; nil means work has been done already
! (vm-select-folder-buffer)
! (vm-check-for-killed-summary)
! (vm-error-if-folder-empty)
! (let ((cons (nthcdr (1- n) vm-message-list)))
! (if (null cons)
! (error "No such message."))
! (if (eq vm-message-pointer cons)
! (vm-preview-current-message)
! (vm-record-and-change-message-pointer vm-message-pointer cons)
! (setq vm-need-summary-pointer-update t)
! (vm-preview-current-message)))))
(defun vm-goto-message-last-seen ()
"Go to the message last previewed."
*** vm-reply.el.dist Thu Mar 14 22:15:24 1991
--- vm-reply.el Sat Mar 16 00:36:55 1991
***************
*** 24,30 ****
(mlist (vm-select-marked-or-prefixed-messages count))
(dir default-directory)
(message-pointer vm-message-pointer)
! to cc subject mp in-reply-to tmp tmp2)
(setq mp mlist)
(while mp
(cond
--- 24,30 ----
(mlist (vm-select-marked-or-prefixed-messages count))
(dir default-directory)
(message-pointer vm-message-pointer)
! to cc subject mp in-reply-to references tmp tmp2)
(setq mp mlist)
(while mp
(cond
***************
*** 63,68 ****
--- 63,73 ----
(if cc
(setq cc (concat cc ",\n\t" tmp2))
(setq cc tmp2)))))
+ (setq references
+ (cons (vm-get-header-contents (car mp) "References")
+ (cons (vm-get-header-contents (car mp) "In-reply-to")
+ (cons (vm-su-message-id (car mp))
+ references))))
(setq mp (cdr mp)))
(if vm-strip-reply-headers
(let ((mail-use-rfc822 t))
***************
*** 80,85 ****
--- 85,96 ----
(vm-strip-ignored-addresses
(rfc822-addresses cc))
", ")))))
+ (setq references (delq nil references)
+ references (mapconcat 'identity references " ")
+ references (vm-parse references "[^<]*\\(<[^>]+>\\)")
+ tmp references
+ tmp (while (setq tmp (vm-delete (car tmp) (cdr tmp))))
+ references (mapconcat 'identity references "\n\t"))
(if (vm-mail-internal
(format "reply to %s%s" (vm-su-full-name (car mlist))
(if (cdr mlist) ", ..." ""))
***************
*** 97,102 ****
--- 108,121 ----
vm-message-pointer message-pointer
vm-reply-list mlist
default-directory dir)
+ (if references
+ (save-excursion
+ (let ((regexp (concat "^"
+ (regexp-quote mail-header-separator)
+ "$")))
+ (goto-char (point-min))
+ (re-search-forward regexp nil t)
+ (insert "References: " references "\n"))))
(if include-text
(save-excursion
(while mlist
***************
*** 268,282 ****
(vm-mark-forwarded))))
(defun vm-rename-current-mail-buffer ()
! (if (not (= ?* (aref (buffer-name) 0)))
! (if (not (string-match "^sent " (buffer-name)))
! (rename-buffer (format "sent %s" (buffer-name))))
! (require 'mail-utils)
! (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")))
! (rename-buffer (format "sent mail to %s" recipients)))))
(defun vm-mark-replied ()
(save-excursion
--- 287,307 ----
(vm-mark-forwarded))))
(defun vm-rename-current-mail-buffer ()
! (if (not (string-match "^sent " (buffer-name)))
! (let (prefix name n)
! (if (not (= ?* (aref (buffer-name) 0)))
! (setq prefix (format "sent %s" (buffer-name)))
! (require 'mail-utils)
! (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)
! (setq name (format "%s<%d>" prefix n))
! (vm-increment n))
! (rename-buffer name))))
(defun vm-mark-replied ()
(save-excursion
*** vm-save.el.dist Thu Mar 14 22:15:25 1991
--- vm-save.el Fri Mar 15 23:08:34 1991
***************
*** 153,163 ****
(vm-error-if-folder-empty)
(or count (setq count 1))
;; Expand the filename, forcing relative paths to resolve
! ;; into the folder directory. The while loop is required
! ;; because expand-file-name does not always completely expand
! ;; its argument.
! (let ((default-directory (or vm-folder-directory default-directory)))
! (while (not (equal folder (setq folder (expand-file-name folder))))))
;; Confirm new folders, if the user requested this.
(if (and vm-confirm-new-folders (interactive-p)
(not (file-exists-p folder))
--- 153,162 ----
(vm-error-if-folder-empty)
(or count (setq count 1))
;; Expand the filename, forcing relative paths to resolve
! ;; into the folder directory.
! (let ((default-directory
! (expand-file-name (or vm-folder-directory default-directory))))
! (setq folder (expand-file-name folder)))
;; Confirm new folders, if the user requested this.
(if (and vm-confirm-new-folders (interactive-p)
(not (file-exists-p folder))
***************
*** 198,206 ****
(insert-buffer-substring
(marker-buffer (vm-start-of (car mlist)))
start end))
! (vm-increment vm-messages-not-on-disk)
! (vm-set-buffer-modified-p (buffer-modified-p))
! (vm-clear-modification-flag-undos))))))
(if (null (vm-filed-flag (car mlist)))
(vm-set-filed-flag (car mlist) t))
(setq mlist (cdr mlist)))))
--- 197,208 ----
(insert-buffer-substring
(marker-buffer (vm-start-of (car mlist)))
start end))
! ;; vars should exist and be local
! ;; but they may have strange values
! (cond ((eq major-mode 'vm-mode)
! (vm-increment vm-messages-not-on-disk)
! (vm-set-buffer-modified-p (buffer-modified-p))
! (vm-clear-modification-flag-undos))))))))
(if (null (vm-filed-flag (car mlist)))
(vm-set-filed-flag (car mlist) t))
(setq mlist (cdr mlist)))))
*** vm-version.el.dist Thu Mar 14 22:15:26 1991
--- vm-version.el Fri Mar 15 11:02:28 1991
***************
*** 1,2 ****
! (defconst vm-version "5.27 (beta)"
"Version number of VM.")
--- 1,2 ----
! (defconst vm-version "5.28 (beta)"
"Version number of VM.")
*** vm.el.dist Thu Mar 14 22:15:27 1991
--- vm.el Fri Mar 15 23:47:10 1991
***************
*** 101,106 ****
--- 101,113 ----
(defun vm-abs (n) (if (< n 0) (- n) n))
+ (defun vm-read-number (prompt)
+ (let (result)
+ (while
+ (null
+ (string-match "^[ \t]*-?[0-9]+" (setq result (read-string prompt)))))
+ (string-to-int result)))
+
;; save-restriction flubs restoring the clipping region if you
;; (widen) and modify text outside the old region.
;; This should do it right.
***************
*** 349,354 ****
--- 356,372 ----
(setq arglist (mapcar 'car lists))
(apply function arglist)
(setq lists (mapcar 'cdr lists)))))
+
+ (defun vm-delete (obj list)
+ (let ((p list) prev)
+ (while p
+ (if (equal obj (car p))
+ (if (null prev)
+ (setq list (cdr list) p list)
+ (setcdr prev (cdr p))
+ (setq p (cdr p)))
+ (setq prev p p (cdr p))))
+ list ))
(defun vm-copy-local-variables (buffer &rest variables)
(let ((values (mapcar 'symbol-value variables)))
Technical Details
Message-ID:
<9103161718.AA23196@rodan.UU.NET>Path:
arc1-ca.pugleaf.net!gmdzi!unido!mcsun!sunic!uupsi!rpi!zaphod.mps.ohio-state.edu!swrinde!cs.utexas.edu!uunet!wendy-fate.uu.net!bug-vmShow Full Headers
Complete Article Headers
X-Google-Language: ENGLISH,ASCII-7-bit X-Google-Thread: f6829,52e0ce33c73881fe,start X-Google-Attributes: gidf6829,public X-Google-ArrivalTime: 1991-03-17 04:16:53 PST Path: arc1-ca.pugleaf.net!gmdzi!unido!mcsun!sunic!uupsi!rpi!zaphod.mps.ohio-state.edu!swrinde!cs.utexas.edu!uunet!wendy-fate.uu.net!bug-vm From: kyle@wendy-fate.uu.net (Kyle Jones) Newsgroups: gnu.emacs.vm.bug Subject: VM 5.27 -> 5.28 patch Message-ID: <9103161718.AA23196@rodan.UU.NET> Date: 16 Mar 91 17:18:58 GMT Sender: bug-vm-request@uunet.uu.net Lines: 314