Article View: gnu.emacs.vm.bug
Article #9021bug fix for forwarding and digestifying
From: k p c
Date: Fri, 05 Jun 1992 09:27
Date: Fri, 05 Jun 1992 09:27
162 lines
6314 bytes
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!kpcShow 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