🚀 go-pugleaf

RetroBBS NetNews Server

Inspired by RockSolid Light RIP Retro Guy

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

bug fix for forwarding and digestifying

#9021
From: k p c
Date: Fri, 05 Jun 1992 09:27
162 lines
6314 bytes
these fixes put point at the end of the To line instead of at the end
of the first line.  i hope that these will be incorporated.

at the end of vm-forward-message and vm-send-digest, please replace
old with new.

old

      (goto-char (point-min))
      (end-of-line)

new

      (mail-position-on-field "To")

the following code is the modification applied to jwz's modification
to forwarding and digestifying.  jwz's modification reduces headers,
so this is interim code before kj adds a variable.

(provide 'vm-jwz-forwarding)

(defun vm-forward-message ()
  "Forward the current message to one or more third parties.
You will be placed in a Mail mode buffer as is usual with replies, but you
must fill in the To: and Subject: headers manually."
  (interactive)
  (vm-follow-summary-cursor)
  (vm-select-folder-buffer)
  (vm-check-for-killed-summary)
  (vm-error-if-folder-empty)
  (if (eq last-command 'vm-next-command-uses-marks)
      (progn (setq this-command 'vm-next-command-uses-marks)
	     (command-execute 'vm-send-digest))
    (let ((b (current-buffer))
	  (dir default-directory)
	  (mp vm-message-pointer)
	  (old-point-min (point-min))
	  start)
      (save-restriction
	(widen)
	(vm-mail-internal
	 (format "forward of %s:%s" (buffer-name)
		 (vm-number-of (car vm-message-pointer)))
	 nil
	 (and vm-forwarding-subject-format
	      (vm-sprintf 'vm-forwarding-subject-format
			  (car mp))))
	(use-local-map (copy-keymap (current-local-map)))
	(local-set-key "\C-c\C-y" 'vm-yank-message)
	(local-set-key "\C-cy" 'vm-yank-message-other-folder)
	(local-set-key "\C-c\C-s" 'vm-mail-send)
	(local-set-key "\C-c\C-c" 'vm-mail-send-and-exit)
	(local-set-key "\C-c\C-v" vm-mode-map)
	(make-local-variable 'vm-forward-list)
	(setq vm-mail-buffer b
	      vm-system-state 'forwarding
	      vm-forward-list (list (car mp))
	      vm-message-pointer mp
	      default-directory dir)
	(goto-char (point-max))
	(insert "------- Start of forwarded message -------\n")
	(setq start (point))
	(let (message-start)
	  (save-excursion
	    (set-buffer b)
	    (let ((exposed (= old-point-min (vm-start-of (car mp)))))
	      (if (not exposed)
		  (setq message-start (vm-vheaders-of (car mp)))
		(goto-char (vm-start-of (car mp)))
		(forward-line 1)
		(setq message-start (point)))))
	  (insert-buffer-substring b message-start
				   (vm-text-end-of (car mp))))
	(if vm-rfc934-forwarding
	    (vm-rfc934-char-stuff-region start (point)))
	(if (not (= (preceding-char) ?\n)) (insert "\n"))
	(if (not (= (save-excursion (forward-char -1) (preceding-char)) ?\n))
	    (insert "\n"))
	(insert "------- End of forwarded message -------\n")
	;;(goto-char (point-min))
	;;(end-of-line)
        (mail-position-on-field "To")
        ))))

(defun vm-send-digest (&optional prefix)
  "Send a digest of all messages in the current folder to recipients.
You will be placed in a *mail* buffer as is usual with replies, but you
must fill in the To: and Subject: headers manually.

Prefix arg means to insert a list of preamble lines at the beginning of
the digest.  One line is generated for each message being digestified.
The variable vm-digest-preamble-format determines the format of the
preamble lines.

If invoked on marked messages (via vm-next-command-uses-marks),
only marked messages will be put into the digest."
  (interactive "P")
  (vm-select-folder-buffer)
  (vm-check-for-killed-summary)
  (vm-error-if-folder-empty)
  (let ((b (current-buffer))
	(dir default-directory)
	(mp vm-message-pointer)
	;; prefix arg doesn't have "normal" meaning here, so only call
	;; vm-select-marked-or-prefixed-messages if we're using marks.
	(mlist (if (eq last-command 'vm-next-command-uses-marks)
		   (vm-select-marked-or-prefixed-messages 0)
		 vm-message-list))
	start)
    (save-restriction
      (widen)
      (vm-mail-internal (format "digest from %s" (buffer-name))
	nil
	(and vm-forwarding-subject-format
	     (vm-sprintf 'vm-forwarding-subject-format
			 (car mlist))))
      (use-local-map (copy-keymap (current-local-map)))
      (local-set-key "\C-c\C-y" 'vm-yank-message)
      (local-set-key "\C-cy" 'vm-yank-message-other-folder)
      (local-set-key "\C-c\C-s" 'vm-mail-send)
      (local-set-key "\C-c\C-c" 'vm-mail-send-and-exit)
      (local-set-key "\C-c\C-v" vm-mode-map)
      (make-local-variable 'vm-forward-list)
      (setq vm-mail-buffer b
	    vm-message-pointer mp
	    vm-system-state 'forwarding
	    vm-forward-list mlist
	    default-directory dir)
      (goto-char (point-max))
      (setq start (point)
	    mp mlist)
      (message "Building digest...")
      (while mp
	(insert "From \n")
	(insert-buffer-substring (marker-buffer (vm-start-of (car mp)))
				 ;; (vm-start-of (car mp))
				 (vm-vheaders-of (car mp))
				 (vm-end-of (car mp)))
	(setq mp (cdr mp)))
      (vm-digestify-region start (point))
      (goto-char start)
      (while (re-search-forward "^\\(---+\n\\)\n+" nil t)
	(delete-region (match-end 1) (match-end 0)))
      (goto-char start)
      (setq mp mlist)
      (if prefix
	  (progn
	    (message "Building digest preamble...")
	    (while mp
	      (insert (vm-sprintf 'vm-digest-preamble-format (car mp)) "\n")
	      (if vm-digest-center-preamble
		  (progn
		    (forward-char -1)
		    (center-line)
		    (forward-char 1)))
	      (setq mp (cdr mp)))))
      ;;(goto-char (point-min))
      ;;(end-of-line)
      (mail-position-on-field "To")
      (message "Building digest... done"))))
--
i am signature-challenged.
Technical Details
Message-ID: <KPC.92Jun5012750@zog.arc.nasa.gov>
Path: arc1-ca.pugleaf.net!sparky!uunet!sun-barr!ames!kronos.arc.nasa.gov!pluto.arc.nasa.gov!kpc

Show Full Headers
Complete Article Headers
X-Google-Language: ENGLISH,ASCII-7-bit
X-Google-Thread: f6829,e03f8bb5b7f9e591,start
X-Google-Attributes: gidf6829,public
X-Google-ArrivalTime: 1992-06-04 20:43:24 PST
Newsgroups: gnu.emacs.vm.bug
Path: arc1-ca.pugleaf.net!sparky!uunet!sun-barr!ames!kronos.arc.nasa.gov!pluto.arc.nasa.gov!kpc
From: kpc@pluto.arc.nasa.gov (k p c)
Subject: bug fix for forwarding and digestifying
Message-ID: <KPC.92Jun5012750@zog.arc.nasa.gov>
Sender: usenet@kronos.arc.nasa.gov (Will Edgington, wedgingt@ptolemy.arc.nasa.gov)
Nntp-Posting-Host: zog.arc.nasa.gov
Reply-To: kpc@ptolemy.arc.nasa.gov
Organization: NASA Ames Research Center (Sterling)
Date: Fri, 5 Jun 1992 09:27:50 GMT
Lines: 162