Function: gnus-article-encrypt-body

gnus-article-encrypt-body is an autoloaded, interactive and byte-compiled function defined in gnus-art.el.gz.

Signature

(gnus-article-encrypt-body PROTOCOL &optional N)

Documentation

Encrypt the article body.

Key Bindings

Source Code

;; Defined in /usr/src/emacs/lisp/gnus/gnus-art.el.gz
(defun gnus-article-encrypt-body (protocol &optional n)
  "Encrypt the article body."
  (interactive
   (list
    (or gnus-article-encrypt-protocol
	(gnus-completing-read "Encrypt protocol"
			      (mapcar #'car gnus-article-encrypt-protocol-alist)
			      t))
    current-prefix-arg)
   gnus-article-mode)
  ;; User might hit `K E' instead of `K e', so prompt once.
  (when (and gnus-article-encrypt-protocol
	     gnus-novice-user)
    (unless (gnus-y-or-n-p "Really encrypt article(s)? ")
      (error "Encrypt aborted")))
  (let ((func (cdr (assoc protocol gnus-article-encrypt-protocol-alist))))
    (unless func
      (error "Can't find the encrypt protocol %s" protocol))
    (if (member gnus-newsgroup-name '("nndraft:delayed"
				      "nndraft:drafts"
				      "nndraft:queue"))
	(error "Can't encrypt the article in group %s"
	       gnus-newsgroup-name))
    (gnus-summary-iterate n
      (with-current-buffer gnus-summary-buffer
	(let ((mail-parse-charset gnus-newsgroup-charset)
	      (mail-parse-ignored-charsets gnus-newsgroup-ignored-charsets)
	      (summary-buffer gnus-summary-buffer)
	      references point)
	  (gnus-set-global-variables)
	  (when (gnus-group-read-only-p)
	    (error "The current newsgroup does not support article encrypt"))
	  (gnus-summary-show-article t)
	  (setq references
	      (or (mail-header-references gnus-current-headers) ""))
	  (set-buffer gnus-article-buffer)
	  (let* ((inhibit-read-only t)
		 (headers
		  (mapcar (lambda (field)
			    (and (save-restriction
				   (message-narrow-to-head)
				   (goto-char (point-min))
				   (search-forward field nil t))
				 (prog2
				     (message-narrow-to-field)
				     (buffer-string)
				   (delete-region (point-min) (point-max))
				   (widen))))
			  '("Content-Type:" "Content-Transfer-Encoding:"
			    "Content-Disposition:"))))
	    (message-narrow-to-head)
	    (message-remove-header "MIME-Version")
	    (goto-char (point-max))
	    (setq point (point))
	    (insert (apply #'concat headers))
	    (widen)
	    (narrow-to-region point (point-max))
	    (let ((message-options message-options))
	      (message-options-set 'message-sender user-mail-address)
	      (message-options-set 'message-recipients user-mail-address)
	      (message-options-set 'message-sign-encrypt 'not)
	      (funcall func))
	    (goto-char (point-min))
	    (insert "MIME-Version: 1.0\n")
	    (widen)
	    (gnus-summary-edit-article-done
	     references nil summary-buffer t))
	  (when gnus-keep-backlog
	    (gnus-backlog-remove-article
	     (car gnus-article-current) (cdr gnus-article-current)))
	  (gnus-flush-original-article-buffer)
	  (when gnus-use-cache
	    (gnus-cache-update-article
	     (car gnus-article-current) (cdr gnus-article-current))))))))