🚀 go-pugleaf

RetroBBS NetNews Server

Inspired by RockSolid Light RIP Retro Guy

Article View: gnu.emacs.bug
Article #88003

major improvements to rmail-retry-failure

#88003
From: Jonathan I. Kamens
Date: Sat, 13 Aug 1994 03:26
253 lines
11026 bytes
In GNU Emacs 19.25.2 of Fri Aug 12 1994 on gza-client1 (sparc-sun-sunos4.1.3)

I've rewritten significant chunks of rmail-retry-failure so that it
has more useful and reliable behavior.  Below are ChangeLog entries
for the lisp directory, patches for the lisp directory, ChangeLog
entries for the man directory, and patches for the man directory.

Thu Aug 11 19:52:39 1994  Jonathan I. Kamens  (jik@cam.ov.com)

	* rmail.el (rmail-retry-ignored-headers): new variable,
	specifying the headers that should be removed by
	rmail-retry-failure.
	(rmail-retry-setup-hook): obsolete variable (see below), deleted.
	(rmail-clear-headers): updated to take an optional list of
	headers to clear; if list is not specified,
	rmail-ignored-headers is used.
	(rmail-retry-failure): allow user to explicitly request (via
	rmail-retry-ignored-headers) which headers to ignore when
	retrying a message, rather than hard-coding a list of headers
	to include in the message being retried; remove
	rmail-retry-setup-hook, which isn't necessary because
	rmail-retry failure has been enhanced; set mail-signature and
	mail-setup-hook to nil when composing retry buffer so that we
	only get the text from the original failed message; insert bcc
	or resent-bcc header in retry buffer if mail-self-blind is
	true.

Fri Aug 12 16:52:03 1994  Jonathan I. Kamens  (jik@cam.ov.com)

	* loaddefs.el (rmail-retry-setup-hook): obsolete variable,
	deleted.

*** rmail.el	1994/08/11 19:33:05	1.1.1.1
--- rmail.el	1994/08/11 19:52:08
***************
*** 68,73 ****
  *Regexp to match Header fields that rmail should normally hide.")
  
  ;;;###autoload
  (defvar rmail-highlighted-headers "^From:\\|^Subject:" "\
  *Regexp to match Header fields that rmail should normally highlight.")
  
--- 68,77 ----
  *Regexp to match Header fields that rmail should normally hide.")
  
  ;;;###autoload
+ (defvar rmail-retry-ignored-headers rmail-ignored-headers "\
+ *Headers that should be stripped when retrying a failed message.")
+ 
+ ;;;###autoload
  (defvar rmail-highlighted-headers "^From:\\|^Subject:" "\
  *Regexp to match Header fields that rmail should normally highlight.")
  
***************
*** 87,96 ****
    "*Non-nil means Rmail makes a new frame for composing outgoing mail.")
  
  ;;;###autoload
- (defvar rmail-retry-setup-hook nil
-   "Hook that `rmail-retry-failure' uses in place of `mail-setup-hook'.")
- 
- ;;;###autoload
  (defvar rmail-secondary-file-directory "~/"
    "*Directory for additional secondary Rmail files.")
  ;;;###autoload
--- 91,96 ----
***************
*** 1087,1100 ****
      (if rmail-ignored-headers (rmail-clear-headers))
      (if rmail-message-filter (funcall rmail-message-filter))))
  
! (defun rmail-clear-headers ()
    (if (search-forward "\n\n" nil t)
        (save-restriction
!         (narrow-to-region (point-min) (point))
  	(let ((buffer-read-only nil))
  	  (while (let ((case-fold-search t))
  		   (goto-char (point-min))
! 		   (re-search-forward rmail-ignored-headers nil t))
  	    (beginning-of-line)
  	    (delete-region (point)
  			   (progn (re-search-forward "\n[^ \t]")
--- 1087,1101 ----
      (if rmail-ignored-headers (rmail-clear-headers))
      (if rmail-message-filter (funcall rmail-message-filter))))
  
! (defun rmail-clear-headers (&optional ignored-headers)
!   (or ignored-headers (setq ignored-headers rmail-ignored-headers))
    (if (search-forward "\n\n" nil t)
        (save-restriction
! 	(narrow-to-region (point-min) (point))
  	(let ((buffer-read-only nil))
  	  (while (let ((case-fold-search t))
  		   (goto-char (point-min))
! 		   (re-search-forward ignored-headers nil t))
  	    (beginning-of-line)
  	    (delete-region (point)
  			   (progn (re-search-forward "\n[^ \t]")
***************
*** 2059,2100 ****
  
  (defun rmail-retry-failure ()
    "Edit a mail message which is based on the contents of the current message.
! For a message rejected by the mail system, extract the interesting headers and
! the body of the original message."
    (interactive)
    (require 'mail-utils)
!   (let (to subj irp2 cc orig-message)
      (save-excursion
        ;; Narrow down to just the quoted original message
        (rmail-beginning-of-message)
        (let ((case-fold-search t))
  	(or (re-search-forward mail-unsent-separator nil t)
  	    (error "Cannot parse this as a failure message")))
!       (save-restriction
! 	(narrow-to-region (point) (point-max))
! 	;; Now mail-fetch-field will get from headers of the original message,
! 	;; not from the headers of the rejection.
! 	(setq to   (mail-fetch-field "To")
! 	      subj (mail-fetch-field "Subject")
! 	      irp2 (mail-fetch-field "In-reply-to")
! 	      cc   (mail-fetch-field "Cc"))
! 	;; Get the entire text (not headers) of the original message.
! 	(setq orig-message
! 	      (buffer-substring
! 	       (progn (search-forward "\n\n") (point))
! 	       (point-max)))))
      ;; Start sending a new message; default header fields from the original.
      ;; Turn off the usual actions for initializing the message body
      ;; because we want to get only the text from the failure message.
!     (let (mail-signature
! 	  (mail-setup-hook rmail-retry-setup-hook))
!       (if (rmail-start-mail nil to subj irp2 cc (current-buffer))
  	  ;; Insert original text as initial text of new draft message.
  	  (progn
! 	    (goto-char (point-max))
! 	    (insert orig-message)
  	    (goto-char (point-min))
! 	    (end-of-line))))))
  
  (defun rmail-bury ()
    "Bury current Rmail buffer and its summary buffer."
--- 2061,2114 ----
  
  (defun rmail-retry-failure ()
    "Edit a mail message which is based on the contents of the current message.
! For a message rejected by the mail system.  The variable
! `rmail-retry-ignored-headers' (by default, equal to the default value of
! `rmail-ignored-headers') is a regular expression matching headers which should
! not be copied into the new message."
    (interactive)
    (require 'mail-utils)
!   (let (mail-buffer bounce-start bounce-end resending)
      (save-excursion
        ;; Narrow down to just the quoted original message
        (rmail-beginning-of-message)
+       (rmail-toggle-header)
        (let ((case-fold-search t))
  	(or (re-search-forward mail-unsent-separator nil t)
  	    (error "Cannot parse this as a failure message")))
!       (next-line 1)
!       (beginning-of-line)
!       (narrow-to-region (point) (point-max))
!       (setq mail-buffer (current-buffer)
! 	    bounce-start (point)
! 	    bounce-end (point-max))
!       (or (search-forward "\n\n" nil t)
! 	  (error "Cannot find end of header in failed message")))
      ;; Start sending a new message; default header fields from the original.
      ;; Turn off the usual actions for initializing the message body
      ;; because we want to get only the text from the failure message.
!     (let (mail-signature mail-setup-hook)
!       (if (rmail-start-mail nil nil nil nil nil mail-buffer)
  	  ;; Insert original text as initial text of new draft message.
  	  (progn
! 	    (delete-region (point-min) (point-max))
! 	    (insert-buffer-substring mail-buffer bounce-start bounce-end)
! 	    (goto-char (point-min))
! 	    (rmail-clear-headers rmail-retry-ignored-headers)
! 	    (rmail-clear-headers "^sender:")
  	    (goto-char (point-min))
! 	    (save-restriction
! 	      (search-forward "\n\n")
! 	      (previous-line 1)
! 	      (narrow-to-region (point-min) (point))
! 	      (setq resending (mail-fetch-field "resent-to"))
! 	      (if mail-self-blind
! 		  (if resending
! 		      (insert "Resent-Bcc: " (user-login-name) "\n")
! 		    (insert "BCC: " (user-login-name) "\n"))))
! 	    (insert mail-header-separator)
! 	    (mail-position-on-field (if resending "Resent-To" "To") t)
! 	    (set-buffer mail-buffer)
! 	    (rmail-beginning-of-message))))))
  
  (defun rmail-bury ()
    "Bury current Rmail buffer and its summary buffer."
*** loaddefs.el	1994/08/12 16:51:31	1.1
--- loaddefs.el	1994/08/12 16:51:56
***************
*** 4714,4722 ****
  (defvar rmail-mail-new-frame nil "\
  *Non-nil means Rmail makes a new frame for composing outgoing mail.")
  
- (defvar rmail-retry-setup-hook nil "\
- Hook that `rmail-retry-failure' uses in place of `mail-setup-hook'.")
- 
  (defvar rmail-secondary-file-directory "~/" "\
  *Directory for additional secondary Rmail files.")
  
--- 4714,4719 ----

Fri Aug 12 16:49:50 1994  Jonathan I. Kamens  (jik@gza-client1)

	* rmail.texi: Document the rmail-retry-ignored-headers
	variable.  Index rmail-retry-failure.

*** rmail.texi	1994/08/12 16:36:29	1.1
--- rmail.texi	1994/08/12 16:47:57
***************
*** 626,631 ****
--- 626,635 ----
  thus yanked.  You can also switch to the Rmail buffer, select a
  different message, switch back, and yank the new current message.
  
+ @kindex M-m
+ @findex rmail-retry-failure
+ @cindex retrying a failed message
+ @vindex rmail-retry-ignored-headers
    Sometimes a message does not reach its destination.  Mailers usually
  send the failed message back to you, enclosed in a @dfn{failure
  message}.  The Rmail command @kbd{M-m} (@code{rmail-retry-failure})
***************
*** 633,639 ****
  @samp{*mail*} buffer with the same text and header fields as before.  If
  you type @kbd{C-c C-c} right away, you send the message again exactly
  the same as the first time.  Alternatively, you can edit the text or
! headers and then send it.
  
  @kindex f @r{(Rmail)}
  @findex rmail-forward
--- 637,647 ----
  @samp{*mail*} buffer with the same text and header fields as before.  If
  you type @kbd{C-c C-c} right away, you send the message again exactly
  the same as the first time.  Alternatively, you can edit the text or
! headers and then send it.  The variable
! @code{rmail-retry-ignored-headers}, in the same format as
! @code{rmail-ignored-headers} (@pxref{Rmail Display}), controls which
! headers are stripped from the failed message when retrying it; it has
! the same default value as @code{rmail-ignored-headers}.
  
  @kindex f @r{(Rmail)}
  @findex rmail-forward
Technical Details
Message-ID: <199408121714.NAA12557@gza-client1.aktis.com>
Path: arc1-ca.pugleaf.net!bga.com!news.sprintlink.net!primenet!netnews.asu.edu !asuvax!cs.utexas.edu!swrinde!howland.reston.ans.net!math.ohio-state.edu!pacific.mps.ohio-state.edu!cis.ohio-state.edu!cam.ov.COM!jik

Show Full Headers
Complete Article Headers
X-Google-Language: ENGLISH,ASCII-7-bit
X-Google-Thread: fb2f1,e4108ff46fb32a4,start
X-Google-Attributes: gidfb2f1,public
X-Google-ArrivalTime: 1994-08-13 06:23:55 PST
Path: arc1-ca.pugleaf.net!bga.com!news.sprintlink.net!primenet!netnews.asu.edu      !asuvax!cs.utexas.edu!swrinde!howland.reston.ans.net!math.ohio-state.edu!pacific.mps.ohio-state.edu!cis.ohio-state.edu!cam.ov.COM!jik
From: jik@cam.ov.COM (Jonathan I. Kamens)
Newsgroups: gnu.emacs.bug
Subject: major improvements to rmail-retry-failure
Date: 12 Aug 1994 23:26:53 -0400
Organization: GNUs Not Usenet
Lines: 254
Sender: daemon@cis.ohio-state.edu
Approved: bug-gnu-emacs@prep.ai.mit.edu
Distribution: gnu
Message-ID: <199408121714.NAA12557@gza-client1.aktis.com>