Function: message--yank-original-internal

message--yank-original-internal is a byte-compiled function defined in hsmail.el.

Signature

(message--yank-original-internal ARG)

Documentation

See message-yank-original.

If supercite is in use, header fields are never deleted. Use (setq sc-nuke-mail-headers 'all) to have them removed.

Source Code

;; Defined in ~/.emacs.d/elpa/hyperbole-20260414.325/hsmail.el
;; Redefine this function from "message.el" to include Hyperbole button
;; data when yanking in a message and to highlight buttons if possible.
(defun message--yank-original-internal (arg)
  "See `message-yank-original'.

If supercite is in use, header fields are never deleted.
Use (setq sc-nuke-mail-headers \\='all) to have them removed."
  (let ((modified (buffer-modified-p))
	body-text)
	(when (and message-reply-buffer
		   message-cite-function)
	  (when (equal message-cite-reply-position 'above)
	    (save-excursion
	      (setq body-text
		    (buffer-substring (message-goto-body)
				      (point-max)))
	      (delete-region (message-goto-body) (point-max))))
	  (when (bufferp message-reply-buffer)
	    (delete-windows-on message-reply-buffer t)
	    (with-current-buffer message-reply-buffer
	      ;; Hyperbole addition: Might be called from newsreader
	      ;; before any Hyperbole mail reader support has been autoloaded.
	      (cond ((fboundp 'rmail:msg-widen) (rmail:msg-widen))
		    ((eq major-mode 'news-reply-mode) (widen)))
	      (hmail:msg-narrow)
	      (when (fboundp 'hproperty:but-create)
		(hproperty:but-create))))
	  (push-mark (save-excursion
		       (cond
			((bufferp message-reply-buffer)
			 (insert-buffer-substring message-reply-buffer))
			((and (consp message-reply-buffer)
			      (functionp (car message-reply-buffer)))
			 (apply (car message-reply-buffer)
				(cdr message-reply-buffer))))
		       (unless (bolp)
			 (insert ?\n))
		       (point)))
	  (unless arg
	    (funcall message-cite-function)
	    (unless (eq (char-before (mark t)) ?\n)
	      (let ((pt (point)))
		(goto-char (mark t))
		(insert-before-markers ?\n)
		(goto-char pt))))
	  (pcase message-cite-reply-position
	    ('above
	     (message-goto-body)
	     (insert body-text)
	     (insert (if (bolp) "\n" "\n\n"))
	     (message-goto-body))
	    ('below
	     (message-goto-signature)))
	  ;; Hyperbole addition
	  (when (bufferp message-reply-buffer)
	    (with-current-buffer message-reply-buffer
	      (hmail:msg-narrow)))
	  ;; Add a `message-setup-very-last-hook' here?
	  ;; Add `gnus-article-highlight-citation' here?
	  (unless modified
            (setq message-checksum (message-checksum))))))