Function: message-send-mail-partially
message-send-mail-partially is a byte-compiled function defined in
message.el.gz.
Signature
(message-send-mail-partially)
Documentation
Send mail as message/partial.
Source Code
;; Defined in /usr/src/emacs/lisp/gnus/message.el.gz
(defun message-send-mail-partially ()
"Send mail as message/partial."
;; replace the header delimiter with a blank line
(goto-char (point-min))
(re-search-forward
(concat "^" (regexp-quote mail-header-separator) "\n"))
(replace-match "\n")
(run-hooks 'message-send-mail-hook)
(let ((p (goto-char (point-min)))
(tembuf (message-generate-new-buffer-clone-locals " message temp"))
(curbuf (current-buffer))
(id (message-make-message-id)) (n 1)
plist total header)
(while (not (eobp))
(if (< (point-max) (+ p message-send-mail-partially-limit))
(goto-char (point-max))
(goto-char (+ p message-send-mail-partially-limit))
(beginning-of-line)
(if (<= (point) p) (forward-line 1))) ;; In case of bad message.
(push p plist)
(setq p (point)))
(setq total (length plist))
(push (point-max) plist)
(setq plist (nreverse plist))
(unwind-protect
(save-excursion
(setq p (pop plist))
(while plist
(set-buffer curbuf)
(copy-to-buffer tembuf p (car plist))
(set-buffer tembuf)
(goto-char (point-min))
(if header
(progn
(goto-char (point-min))
(narrow-to-region (point) (point))
(insert header))
(message-goto-eoh)
(setq header (buffer-substring (point-min) (point)))
(goto-char (point-min))
(narrow-to-region (point) (point))
(insert header)
(message-remove-header "Mime-Version")
(message-remove-header "Content-Type")
(message-remove-header "Content-Transfer-Encoding")
(message-remove-header "Message-ID")
(message-remove-header "Lines")
(goto-char (point-max))
(insert "Mime-Version: 1.0\n")
(setq header (buffer-string)))
(goto-char (point-max))
(insert (format "Content-Type: message/partial; id=\"%s\"; number=%d; total=%d\n\n"
id n total))
(forward-char -1)
(let ((mail-header-separator ""))
(when (memq 'Message-ID message-required-mail-headers)
(insert "Message-ID: " (message-make-message-id) "\n"))
(when (memq 'Lines message-required-mail-headers)
(insert "Lines: " (message-make-lines) "\n"))
(message-goto-subject)
(end-of-line)
(insert (format " (%d/%d)" n total))
(widen)
(if message-send-mail-real-function
(funcall message-send-mail-real-function)
(message-multi-smtp-send-mail)))
(setq n (+ n 1))
(setq p (pop plist))
(erase-buffer)))
(kill-buffer tembuf))))