🚀 go-pugleaf

RetroBBS NetNews Server

Inspired by RockSolid Light RIP Retro Guy

Article View: gnu.emacs.vm.bug
Article #9685

VM 5.27 -> 5.28 patch

#9685
From: Kyle Jones
Date: Sat, 16 Mar 1991 17:18
314 lines
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-vm

Show 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