-;;; rmailmm.el --- MIME decoding and display stuff for RMAIL
+;;; rmailmm.el --- MIME decoding and display stuff for RMAIL -*- lexical-binding: t; -*-
;; Copyright (C) 2006-2021 Free Software Foundation, Inc.
(require 'rmail)
(require 'mail-parse)
(require 'message)
+(require 'cl-lib)
;;; User options.
Note also that this alist is ignored when the variable
`rmail-enable-mime' is non-nil."
:type '(alist :key-type regexp :value-type (repeat function))
- :version "23.1"
- :group 'rmail-mime)
+ :version "23.1")
(defcustom rmail-mime-attachment-dirs-alist
`(("text/.*" "~/Documents")
The remaining elements are directories, in order of decreasing preference.
The first directory that exists is used."
:type '(alist :key-type regexp :value-type (repeat directory))
- :version "23.1"
- :group 'rmail-mime)
+ :version "23.1")
(defcustom rmail-mime-show-images 'button
"What to do with image attachments that Emacs is capable of displaying.
(const :tag "No special treatment" nil)
(number :tag "Show if smaller than certain size")
(other :tag "Always show" show))
- :version "23.2"
- :group 'rmail-mime)
+ :version "23.2")
(defcustom rmail-mime-render-html-function
- (cond ((fboundp 'libxml-parse-html-region) 'rmail-mime-render-html-shr)
- ((executable-find "lynx") 'rmail-mime-render-html-lynx)
+ (cond ((fboundp 'libxml-parse-html-region) #'rmail-mime-render-html-shr)
+ ((executable-find "lynx") #'rmail-mime-render-html-lynx)
(t nil))
"Function to convert HTML to text.
Called with buffer containing HTML extracted from message in a
;;; MIME-entity object
-(defun rmail-mime-entity (type disposition transfer-encoding
- display header tagline body children handler
- &optional truncated)
+(cl-defstruct (rmail-mime-entity
+ (:copier nil) (:constructor nil)
+ (:constructor rmail-mime-entity
+ ( type disposition transfer-encoding
+ display header tagline body children handler
+ &optional truncated)
"Return a newly created MIME-entity object from arguments.
A MIME-entity is a vector of 10 elements:
DISPLAY is a vector [CURRENT NEW], where CURRENT indicates how
the header, tag line, and body of the entity are displayed now,
and NEW indicates how their display should be updated.
-Both elements are vectors [HEADER-DISPLAY TAGLINE-DISPLAY BODY-DISPLAY],
-where each constituent element is a symbol for the corresponding
-item with these values:
- nil: not displayed
- t: displayed by the decoded presentation form
- raw: displayed by the raw MIME data (for the header and body only)
+Both elements are `rmail-mime-display' objects.
HEADER and BODY are vectors [BEG END DISPLAY-FLAG], where BEG and
END are markers that specify the region of the header or body lines
HANDLER is a function to insert the entity according to DISPLAY.
It is called with one argument ENTITY.
-TRUNCATED is non-nil if the text of this entity was truncated."
-
- (vector type disposition transfer-encoding
- display header tagline body children handler truncated))
-
-;; Accessors for a MIME-entity object.
-(defsubst rmail-mime-entity-type (entity) (aref entity 0))
-(defsubst rmail-mime-entity-disposition (entity) (aref entity 1))
-(defsubst rmail-mime-entity-transfer-encoding (entity) (aref entity 2))
-(defsubst rmail-mime-entity-display (entity) (aref entity 3))
-(defsubst rmail-mime-entity-header (entity) (aref entity 4))
-(defsubst rmail-mime-entity-tagline (entity) (aref entity 5))
-(defsubst rmail-mime-entity-body (entity) (aref entity 6))
-(defsubst rmail-mime-entity-children (entity) (aref entity 7))
-(defsubst rmail-mime-entity-handler (entity) (aref entity 8))
-(defsubst rmail-mime-entity-truncated (entity) (aref entity 9))
+TRUNCATED is non-nil if the text of this entity was truncated."))
+ type disposition transfer-encoding
+ display header tagline body children handler truncated)
+
(defsubst rmail-mime-entity-set-truncated (entity truncated)
- (aset entity 9 truncated))
+ (declare (obsolete (setf rmail-mime-entity-truncated) "28.1"))
+ (setf (rmail-mime-entity-truncated entity) truncated))
;;; Buttons
;; Display options returned by rmail-mime-entity-display.
;; Value is on of nil, t, raw.
-(defsubst rmail-mime-display-header (disp) (aref disp 0))
-(defsubst rmail-mime-display-tagline (disp) (aref disp 1))
-(defsubst rmail-mime-display-body (disp) (aref disp 2))
+(cl-defstruct (rmail-mime-display
+ (:copier rmail-mime--copy-display) (:constructor nil)
+ (:constructor rmail-mime--make-display (header tagline body)
+ "Make an object describing how to display.
+Each field's value is a symbol for the corresponding
+item with these values:
+ nil: not displayed
+ t: displayed by the decoded presentation form
+ raw: displayed by the raw MIME data (for the header and body only)."))
+ header tagline body)
(defun rmail-mime-entity-segment (pos &optional entity)
"Return a vector describing the displayed region of a MIME-entity at POS.
(defun rmail-mime-shown-mode (entity)
"Make MIME-entity ENTITY display in the default way."
(let ((new (aref (rmail-mime-entity-display entity) 1)))
- (aset new 0 (aref (rmail-mime-entity-header entity) 2))
- (aset new 1 (aref (rmail-mime-entity-tagline entity) 2))
- (aset new 2 (aref (rmail-mime-entity-body entity) 2)))
+ (setf (rmail-mime-display-header new)
+ (aref (rmail-mime-entity-header entity) 2))
+ (setf (rmail-mime-display-tagline new)
+ (aref (rmail-mime-entity-tagline entity) 2))
+ (setf (rmail-mime-display-body new)
+ (aref (rmail-mime-entity-body entity) 2)))
(dolist (child (rmail-mime-entity-children entity))
(rmail-mime-shown-mode child)))
(defun rmail-mime-hidden-mode (entity)
"Make MIME-entity ENTITY display in hidden mode."
(let ((new (aref (rmail-mime-entity-display entity) 1)))
- (aset new 0 nil)
- (aset new 1 t)
- (aset new 2 nil))
+ (setf (rmail-mime-display-header new) nil)
+ (setf (rmail-mime-display-tagline new) t)
+ (setf (rmail-mime-display-body new) nil))
(dolist (child (rmail-mime-entity-children entity))
(rmail-mime-hidden-mode child)))
(defun rmail-mime-raw-mode (entity)
"Make MIME-entity ENTITY display in raw mode."
(let ((new (aref (rmail-mime-entity-display entity) 1)))
- (aset new 0 'raw)
- (aset new 1 nil)
- (aset new 2 'raw))
+ (setf (rmail-mime-display-header new) 'raw)
+ (setf (rmail-mime-display-tagline new) nil)
+ (setf (rmail-mime-display-body new) 'raw))
(dolist (child (rmail-mime-entity-children entity))
(rmail-mime-raw-mode child)))
(current (aref (rmail-mime-entity-display entity) 0))
(segment (rmail-mime-entity-segment pos entity)))
(if (or (eq state 'raw)
- (and (not state)
- (not (eq (rmail-mime-display-header current) 'raw))))
+ (not (or state
+ (eq (rmail-mime-display-header current) 'raw))))
;; Enter the raw mode.
(rmail-mime-raw-mode entity)
;; Enter the shown mode.
;; header.
(if (and rmail-mime-mbox-buffer (= (aref segment 1) (point-min)))
(let ((new (aref (rmail-mime-entity-display entity) 1)))
- (aset new 0 t))))
+ (setf (rmail-mime-display-header new) t))))
;; Query as a warning before showing if truncated.
(if (and (not (stringp entity))
(rmail-mime-entity-truncated entity))
;; Enter the shown mode.
(rmail-mime-shown-mode entity)
;; Force this body shown.
- (aset (aref (rmail-mime-entity-display entity) 1) 2 t))
+ (let ((new (aref (rmail-mime-entity-display entity) 1)))
+ (setf (rmail-mime-display-body new) t)))
(let ((inhibit-read-only t)
(modified (buffer-modified-p))
(rmail-mime-mbox-buffer rmail-view-buffer)
(rmail-mime-insert entity)
(restore-buffer-modified-p modified))))))
-(define-key rmail-mode-map "\t" 'forward-button)
-(define-key rmail-mode-map [backtab] 'backward-button)
-(define-key rmail-mode-map "\r" 'rmail-mime-toggle-hidden)
+(define-key rmail-mode-map "\t" #'forward-button)
+(define-key rmail-mode-map [backtab] #'backward-button)
+(define-key rmail-mode-map "\r" #'rmail-mime-toggle-hidden)
;;; Handlers
(when item
(if (stringp item)
(insert item)
- (apply 'insert-button item))))
+ (apply #'insert-button item))))
;; Follow the tagline by an empty line to make it a separate
;; paragraph, so that the paragraph direction of the following text
;; is determined based on that text.
(modified (buffer-modified-p))
;; If we are going to show the body, the new button label is
;; "Hide". Otherwise, it's "Show".
- (label (if (aref (aref (rmail-mime-entity-display entity) 1) 2) "Hide"
- "Show"))
+ (label
+ (if (rmail-mime-display-body
+ (aref (rmail-mime-entity-display entity) 1))
+ "Hide" "Show"))
(button (next-button (point))))
;; Go to the second character of the button "Show" or "Hide".
(goto-char (1+ (button-start button)))
(rmail-mime-insert-text
(rmail-mime-entity content-type content-disposition
content-transfer-encoding
- (vector (vector nil nil nil) (vector nil nil t))
+ (vector (rmail-mime--make-display nil nil nil)
+ (rmail-mime--make-display nil nil t))
(vector nil nil nil) (vector "" (cons nil nil) t)
- (vector nil nil nil) nil 'rmail-mime-insert-text))
+ (vector nil nil nil) nil #'rmail-mime-insert-text))
t)
(defun rmail-mime-insert-decoded-text (entity)
(let ((current (aref (rmail-mime-entity-display entity) 0))
(new (aref (rmail-mime-entity-display entity) 1))
(header (rmail-mime-entity-header entity))
- (tagline (rmail-mime-entity-tagline entity))
+ ;; (tagline (rmail-mime-entity-tagline entity))
(body (rmail-mime-entity-body entity))
(beg (point))
(segment (rmail-mime-entity-segment (point) entity)))
(defun rmail-mime-insert-image (entity)
"Decode and insert the image body of MIME-entity ENTITY."
- (let* ((content-type (car (rmail-mime-entity-type entity)))
+ (let* (;; (content-type (car (rmail-mime-entity-type entity)))
(bulk-data (aref (rmail-mime-entity-tagline entity) 1))
(body (rmail-mime-entity-body entity))
data)
(declare-function libxml-parse-html-region "xml.c"
(start end &optional base-url discard-comments))
+(defvar shr-inhibit-images)
+(defvar shr-width)
+
(defun rmail-mime-render-html-shr (source-buffer)
(let ((dom (with-current-buffer source-buffer
(libxml-parse-html-region (point-min) (point-max))))
depends upon the value of `rmail-mime-show-images'."
(rmail-mime-insert-bulk
(rmail-mime-entity content-type content-disposition content-transfer-encoding
- (vector (vector nil nil nil) (vector nil t nil))
+ (vector (rmail-mime--make-display nil nil nil)
+ (rmail-mime--make-display nil t nil))
(vector nil nil nil) (vector "" (cons nil nil) t)
(vector nil nil nil) nil 'rmail-mime-insert-bulk)))
nil (format "%s/%d" parse-tag index)
content-type content-disposition)))
;; Display a tagline.
- (aset (aref (rmail-mime-entity-display child) 1) 1
+ (setf (rmail-mime-display-tagline
+ (aref (rmail-mime-entity-display child) 1))
(aset (rmail-mime-entity-tagline child) 2 t))
- (rmail-mime-entity-set-truncated child truncated)
+ (setf (rmail-mime-entity-truncated child) truncated)
(push child entities)))
(delete-region end next)
(let ((current (aref (rmail-mime-entity-display entity) 0))
(new (aref (rmail-mime-entity-display entity) 1))
(header (rmail-mime-entity-header entity))
- (tagline (rmail-mime-entity-tagline entity))
- (body (rmail-mime-entity-body entity))
+ ;; (tagline (rmail-mime-entity-tagline entity))
+ ;; (body (rmail-mime-entity-body entity))
(beg (point))
(segment (rmail-mime-entity-segment (point) entity)))
;; header
content-transfer-encoding))
(save-restriction
(widen)
- (let ((entity (get-text-property (1- (point)) 'rmail-mime-entity))
- current new)
+ (let ((entity (get-text-property (1- (point)) 'rmail-mime-entity)))
(when entity
- (setq current (aref (rmail-mime-entity-display entity) 0)
- new (aref (rmail-mime-entity-display entity) 1))
- (dotimes (i 3)
- (aset current i (aref new i)))))))
+ (let ((new (aref (rmail-mime-entity-display entity) 1)))
+ (setf (aref (rmail-mime-entity-display entity) 0)
+ (rmail-mime--copy-display new)))))))
(defun rmail-mime-show (&optional show-headers)
"Handle the current buffer as a MIME message.
(header (vector (point-min-marker) hdr-end nil))
(tagline (vector parse-tag (cons nil nil) t))
(body (vector hdr-end (point-max-marker) is-inline))
- (new (vector (aref header 2) (aref tagline 2) (aref body 2)))
+ (new (rmail-mime--make-display
+ (aref header 2) (aref tagline 2) (aref body 2)))
children handler entity)
(cond ((string-match "multipart/.*" (car content-type))
(save-restriction
(narrow-to-region (1- end) (point-max))
(if (zerop (length parse-tag)) ; top level of message
- (aset new 1 (aset tagline 2 nil))) ; don't show tagline
+ (setf (rmail-mime-display-tagline new)
+ (aset tagline 2 nil))) ; don't show tagline
(setq children (rmail-mime-process-multipart
content-type
content-disposition
'("text/plain") '("inline")))
(msg-new (aref (rmail-mime-entity-display msg) 1)))
;; Show header of the child.
- (aset msg-new 0 t)
+ (setf (rmail-mime-display-header msg-new) t)
(aset (rmail-mime-entity-header msg) 2 t)
;; Hide tagline of the child.
- (aset msg-new 1 nil)
+ (setf (rmail-mime-display-tagline msg-new) nil)
(aset (rmail-mime-entity-tagline msg) 2 nil)
(setq children (list msg)
handler 'rmail-mime-insert-multipart))))
((and is-inline (string-match "text/html" (car content-type)))
;; Display tagline, so part can be detached
- (aset new 1 (aset tagline 2 t))
- (aset new 2 (aset body 2 t)) ; display body also.
+ (setf (rmail-mime-display-tagline new) (aset tagline 2 t))
+ (setf (rmail-mime-display-body new) (aset body 2 t)) ; display body also.
(setq handler 'rmail-mime-insert-bulk))
;; Inline non-HTML text
((and is-inline (string-match "text/" (car content-type)))
;; Don't need a tagline.
- (aset new 1 (aset tagline 2 nil))
+ (setf (rmail-mime-display-tagline new) (aset tagline 2 nil))
(setq handler 'rmail-mime-insert-text))
(t
;; Force hidden mode.
- (aset new 1 (aset tagline 2 t))
- (aset new 2 (aset body 2 nil))
+ (setf (rmail-mime-display-tagline new) (aset tagline 2 t))
+ (setf (rmail-mime-display-body new) (aset body 2 nil))
(setq handler 'rmail-mime-insert-bulk)))
- (setq entity (rmail-mime-entity content-type
- content-disposition
- content-transfer-encoding
- (vector (vector nil nil nil) new)
- header tagline body children handler))
+ (setq entity (rmail-mime-entity
+ content-type
+ content-disposition
+ content-transfer-encoding
+ (vector (rmail-mime--make-display nil nil nil) new)
+ header tagline body children handler))
(if (and (eq handler 'rmail-mime-insert-bulk)
(rmail-mime-set-bulk-data entity))
;; Show the body.
- (aset new 2 (aset body 2 t)))
+ (setf (rmail-mime-display-body new) (aset body 2 t)))
entity)
;; Hide headers and handle the part.
'("text/plain") '("inline")))
(new (aref (rmail-mime-entity-display entity) 1)))
;; Show header.
- (aset new 0 (aset (rmail-mime-entity-header entity) 2 t))
+ (setf (rmail-mime-display-header new)
+ (aset (rmail-mime-entity-header entity) 2 t))
entity)))
(error (format "%s" err)))))
;; Not a raw-mode. Each handler should handle it.
(funcall (rmail-mime-entity-handler entity) entity)
(let ((header (rmail-mime-entity-header entity))
- (tagline (rmail-mime-entity-tagline entity))
+ ;; (tagline (rmail-mime-entity-tagline entity))
(body (rmail-mime-entity-body entity))
(beg (point))
(segment (rmail-mime-entity-segment (point) entity)))
(aref body 0) (aref body 1))
(or (bolp) (insert "\n")))
(put-text-property beg (point) 'rmail-mime-entity entity)))))
- (dotimes (i 3)
- (aset current i (aref new i)))))
+ (setf (aref (rmail-mime-entity-display entity) 0)
+ (rmail-mime--copy-display new))))
(define-derived-mode rmail-mime-mode fundamental-mode "RMIME"
"Major mode used in `rmail-mime' buffers."
(setq font-lock-defaults '(rmail-font-lock-keywords t t nil nil)))
;;;###autoload
-(defun rmail-mime (&optional arg state)
+(defun rmail-mime (&optional _arg state)
"Toggle the display of a MIME message.
The actual behavior depends on the value of `rmail-enable-mime'.
(rmail-mime-view-buffer rmail-view-buffer)
(rmail-mime-coding-system nil))
;; If ENTITY is not a vector, it is a string describing an error.
- (if (vectorp entity)
+ (if (rmail-mime-entity-p entity)
(with-current-buffer rmail-mime-view-buffer
(erase-buffer)
;; This condition-case is for catching an error in the
(rmail-mime-view-buffer rmail-view-buffer)
(header-end (save-excursion
(re-search-forward "^$" nil 'move) (point)))
- (body-end (point-max))
+ ;; (body-end (point-max))
(entity (rmail-mime-parse)))
(or
;; At first, just search the headers.