diff options
| author | Stefan Monnier | 2021-03-09 16:17:31 -0500 |
|---|---|---|
| committer | Stefan Monnier | 2021-03-09 16:17:51 -0500 |
| commit | e8f0a7b6c152116b1e87487f405dea67385e35fb (patch) | |
| tree | eb3d72cfe42764ed0d44ba2c8083efa78b2a0546 | |
| parent | f97e07ea807cc6d38774a3888a15091b20645ac6 (diff) | |
| download | emacs-e8f0a7b6c152116b1e87487f405dea67385e35fb.tar.gz emacs-e8f0a7b6c152116b1e87487f405dea67385e35fb.zip | |
* lisp/mail/rmailmm.el: Use `cl-defstruct` and `lexical-binding`
Remove redundant `:group` args.
(rmail-mime-entity): Make it a `cl-defstruct`.
(rmail-mime-entity-set-truncated): Mark as obsolete.
(rmail-mime-display): New `cl-defstruct`.
(rmail-mime-shown-mode, rmail-mime-hidden-mode, rmail-mime-raw-mode)
(rmail-mime-toggle-hidden, rmail-mime-update-tagline)
(rmail-mime-text-handler, rmail-mime-bulk-handler)
(rmail-mime-process-multipart, rmail-mime-handle, rmail-mime-process)
(rmail-mime-parse, rmail-mime-insert, rmail-show-mime): Adjust accordingly.
(rmail-mime-toggle-raw): Apply de Morgan.
(rmail-mime-insert-text): Remove unused var `tagline`.
(rmail-mime-insert-image): Remove unused var `content-type`.
(shr-inhibit-images, shr-width): Declare vars.
(rmail-mime-insert-multipart): Remove unused vars `tagline` and `body`.
(rmail-mime-insert): Remove unused var `tagline`.
(rmail-search-mime-message): Remove unused var `body-end`.
| -rw-r--r-- | lisp/mail/rmailmm.el | 194 |
1 files changed, 100 insertions, 94 deletions
diff --git a/lisp/mail/rmailmm.el b/lisp/mail/rmailmm.el index ab5b49aab92..cdb994a5c8e 100644 --- a/lisp/mail/rmailmm.el +++ b/lisp/mail/rmailmm.el | |||
| @@ -1,4 +1,4 @@ | |||
| 1 | ;;; rmailmm.el --- MIME decoding and display stuff for RMAIL | 1 | ;;; rmailmm.el --- MIME decoding and display stuff for RMAIL -*- lexical-binding: t; -*- |
| 2 | 2 | ||
| 3 | ;; Copyright (C) 2006-2021 Free Software Foundation, Inc. | 3 | ;; Copyright (C) 2006-2021 Free Software Foundation, Inc. |
| 4 | 4 | ||
| @@ -78,6 +78,7 @@ | |||
| 78 | (require 'rmail) | 78 | (require 'rmail) |
| 79 | (require 'mail-parse) | 79 | (require 'mail-parse) |
| 80 | (require 'message) | 80 | (require 'message) |
| 81 | (require 'cl-lib) | ||
| 81 | 82 | ||
| 82 | ;;; User options. | 83 | ;;; User options. |
| 83 | 84 | ||
| @@ -101,8 +102,7 @@ all others are handled by `rmail-mime-bulk-handler'. | |||
| 101 | Note also that this alist is ignored when the variable | 102 | Note also that this alist is ignored when the variable |
| 102 | `rmail-enable-mime' is non-nil." | 103 | `rmail-enable-mime' is non-nil." |
| 103 | :type '(alist :key-type regexp :value-type (repeat function)) | 104 | :type '(alist :key-type regexp :value-type (repeat function)) |
| 104 | :version "23.1" | 105 | :version "23.1") |
| 105 | :group 'rmail-mime) | ||
| 106 | 106 | ||
| 107 | (defcustom rmail-mime-attachment-dirs-alist | 107 | (defcustom rmail-mime-attachment-dirs-alist |
| 108 | `(("text/.*" "~/Documents") | 108 | `(("text/.*" "~/Documents") |
| @@ -114,8 +114,7 @@ The first item is a regular expression matching a content-type. | |||
| 114 | The remaining elements are directories, in order of decreasing preference. | 114 | The remaining elements are directories, in order of decreasing preference. |
| 115 | The first directory that exists is used." | 115 | The first directory that exists is used." |
| 116 | :type '(alist :key-type regexp :value-type (repeat directory)) | 116 | :type '(alist :key-type regexp :value-type (repeat directory)) |
| 117 | :version "23.1" | 117 | :version "23.1") |
| 118 | :group 'rmail-mime) | ||
| 119 | 118 | ||
| 120 | (defcustom rmail-mime-show-images 'button | 119 | (defcustom rmail-mime-show-images 'button |
| 121 | "What to do with image attachments that Emacs is capable of displaying. | 120 | "What to do with image attachments that Emacs is capable of displaying. |
| @@ -128,12 +127,11 @@ automatically display the image in the buffer." | |||
| 128 | (const :tag "No special treatment" nil) | 127 | (const :tag "No special treatment" nil) |
| 129 | (number :tag "Show if smaller than certain size") | 128 | (number :tag "Show if smaller than certain size") |
| 130 | (other :tag "Always show" show)) | 129 | (other :tag "Always show" show)) |
| 131 | :version "23.2" | 130 | :version "23.2") |
| 132 | :group 'rmail-mime) | ||
| 133 | 131 | ||
| 134 | (defcustom rmail-mime-render-html-function | 132 | (defcustom rmail-mime-render-html-function |
| 135 | (cond ((fboundp 'libxml-parse-html-region) 'rmail-mime-render-html-shr) | 133 | (cond ((fboundp 'libxml-parse-html-region) #'rmail-mime-render-html-shr) |
| 136 | ((executable-find "lynx") 'rmail-mime-render-html-lynx) | 134 | ((executable-find "lynx") #'rmail-mime-render-html-lynx) |
| 137 | (t nil)) | 135 | (t nil)) |
| 138 | "Function to convert HTML to text. | 136 | "Function to convert HTML to text. |
| 139 | Called with buffer containing HTML extracted from message in a | 137 | Called with buffer containing HTML extracted from message in a |
| @@ -177,9 +175,12 @@ operations such as HTML decoding") | |||
| 177 | 175 | ||
| 178 | ;;; MIME-entity object | 176 | ;;; MIME-entity object |
| 179 | 177 | ||
| 180 | (defun rmail-mime-entity (type disposition transfer-encoding | 178 | (cl-defstruct (rmail-mime-entity |
| 181 | display header tagline body children handler | 179 | (:copier nil) (:constructor nil) |
| 182 | &optional truncated) | 180 | (:constructor rmail-mime-entity |
| 181 | ( type disposition transfer-encoding | ||
| 182 | display header tagline body children handler | ||
| 183 | &optional truncated) | ||
| 183 | "Return a newly created MIME-entity object from arguments. | 184 | "Return a newly created MIME-entity object from arguments. |
| 184 | 185 | ||
| 185 | A MIME-entity is a vector of 10 elements: | 186 | A MIME-entity is a vector of 10 elements: |
| @@ -210,12 +211,7 @@ Content-Transfer-Encoding, and is a lower-case string. | |||
| 210 | DISPLAY is a vector [CURRENT NEW], where CURRENT indicates how | 211 | DISPLAY is a vector [CURRENT NEW], where CURRENT indicates how |
| 211 | the header, tag line, and body of the entity are displayed now, | 212 | the header, tag line, and body of the entity are displayed now, |
| 212 | and NEW indicates how their display should be updated. | 213 | and NEW indicates how their display should be updated. |
| 213 | Both elements are vectors [HEADER-DISPLAY TAGLINE-DISPLAY BODY-DISPLAY], | 214 | Both elements are `rmail-mime-display' objects. |
| 214 | where each constituent element is a symbol for the corresponding | ||
| 215 | item with these values: | ||
| 216 | nil: not displayed | ||
| 217 | t: displayed by the decoded presentation form | ||
| 218 | raw: displayed by the raw MIME data (for the header and body only) | ||
| 219 | 215 | ||
| 220 | HEADER and BODY are vectors [BEG END DISPLAY-FLAG], where BEG and | 216 | HEADER and BODY are vectors [BEG END DISPLAY-FLAG], where BEG and |
| 221 | END are markers that specify the region of the header or body lines | 217 | END are markers that specify the region of the header or body lines |
| @@ -236,24 +232,13 @@ has just one child. Any other entity has no child. | |||
| 236 | HANDLER is a function to insert the entity according to DISPLAY. | 232 | HANDLER is a function to insert the entity according to DISPLAY. |
| 237 | It is called with one argument ENTITY. | 233 | It is called with one argument ENTITY. |
| 238 | 234 | ||
| 239 | TRUNCATED is non-nil if the text of this entity was truncated." | 235 | TRUNCATED is non-nil if the text of this entity was truncated.")) |
| 240 | 236 | type disposition transfer-encoding | |
| 241 | (vector type disposition transfer-encoding | 237 | display header tagline body children handler truncated) |
| 242 | display header tagline body children handler truncated)) | 238 | |
| 243 | |||
| 244 | ;; Accessors for a MIME-entity object. | ||
| 245 | (defsubst rmail-mime-entity-type (entity) (aref entity 0)) | ||
| 246 | (defsubst rmail-mime-entity-disposition (entity) (aref entity 1)) | ||
| 247 | (defsubst rmail-mime-entity-transfer-encoding (entity) (aref entity 2)) | ||
| 248 | (defsubst rmail-mime-entity-display (entity) (aref entity 3)) | ||
| 249 | (defsubst rmail-mime-entity-header (entity) (aref entity 4)) | ||
| 250 | (defsubst rmail-mime-entity-tagline (entity) (aref entity 5)) | ||
| 251 | (defsubst rmail-mime-entity-body (entity) (aref entity 6)) | ||
| 252 | (defsubst rmail-mime-entity-children (entity) (aref entity 7)) | ||
| 253 | (defsubst rmail-mime-entity-handler (entity) (aref entity 8)) | ||
| 254 | (defsubst rmail-mime-entity-truncated (entity) (aref entity 9)) | ||
| 255 | (defsubst rmail-mime-entity-set-truncated (entity truncated) | 239 | (defsubst rmail-mime-entity-set-truncated (entity truncated) |
| 256 | (aset entity 9 truncated)) | 240 | (declare (obsolete (setf rmail-mime-entity-truncated) "28.1")) |
| 241 | (setf (rmail-mime-entity-truncated entity) truncated)) | ||
| 257 | 242 | ||
| 258 | ;;; Buttons | 243 | ;;; Buttons |
| 259 | 244 | ||
| @@ -303,9 +288,16 @@ TRUNCATED is non-nil if the text of this entity was truncated." | |||
| 303 | 288 | ||
| 304 | ;; Display options returned by rmail-mime-entity-display. | 289 | ;; Display options returned by rmail-mime-entity-display. |
| 305 | ;; Value is on of nil, t, raw. | 290 | ;; Value is on of nil, t, raw. |
| 306 | (defsubst rmail-mime-display-header (disp) (aref disp 0)) | 291 | (cl-defstruct (rmail-mime-display |
| 307 | (defsubst rmail-mime-display-tagline (disp) (aref disp 1)) | 292 | (:copier rmail-mime--copy-display) (:constructor nil) |
| 308 | (defsubst rmail-mime-display-body (disp) (aref disp 2)) | 293 | (:constructor rmail-mime--make-display (header tagline body) |
| 294 | "Make an object describing how to display. | ||
| 295 | Each field's value is a symbol for the corresponding | ||
| 296 | item with these values: | ||
| 297 | nil: not displayed | ||
| 298 | t: displayed by the decoded presentation form | ||
| 299 | raw: displayed by the raw MIME data (for the header and body only).")) | ||
| 300 | header tagline body) | ||
| 309 | 301 | ||
| 310 | (defun rmail-mime-entity-segment (pos &optional entity) | 302 | (defun rmail-mime-entity-segment (pos &optional entity) |
| 311 | "Return a vector describing the displayed region of a MIME-entity at POS. | 303 | "Return a vector describing the displayed region of a MIME-entity at POS. |
| @@ -371,27 +363,30 @@ The value is a vector [INDEX HEADER TAGLINE BODY END], where | |||
| 371 | (defun rmail-mime-shown-mode (entity) | 363 | (defun rmail-mime-shown-mode (entity) |
| 372 | "Make MIME-entity ENTITY display in the default way." | 364 | "Make MIME-entity ENTITY display in the default way." |
| 373 | (let ((new (aref (rmail-mime-entity-display entity) 1))) | 365 | (let ((new (aref (rmail-mime-entity-display entity) 1))) |
| 374 | (aset new 0 (aref (rmail-mime-entity-header entity) 2)) | 366 | (setf (rmail-mime-display-header new) |
| 375 | (aset new 1 (aref (rmail-mime-entity-tagline entity) 2)) | 367 | (aref (rmail-mime-entity-header entity) 2)) |
| 376 | (aset new 2 (aref (rmail-mime-entity-body entity) 2))) | 368 | (setf (rmail-mime-display-tagline new) |
| 369 | (aref (rmail-mime-entity-tagline entity) 2)) | ||
| 370 | (setf (rmail-mime-display-body new) | ||
| 371 | (aref (rmail-mime-entity-body entity) 2))) | ||
| 377 | (dolist (child (rmail-mime-entity-children entity)) | 372 | (dolist (child (rmail-mime-entity-children entity)) |
| 378 | (rmail-mime-shown-mode child))) | 373 | (rmail-mime-shown-mode child))) |
| 379 | 374 | ||
| 380 | (defun rmail-mime-hidden-mode (entity) | 375 | (defun rmail-mime-hidden-mode (entity) |
| 381 | "Make MIME-entity ENTITY display in hidden mode." | 376 | "Make MIME-entity ENTITY display in hidden mode." |
| 382 | (let ((new (aref (rmail-mime-entity-display entity) 1))) | 377 | (let ((new (aref (rmail-mime-entity-display entity) 1))) |
| 383 | (aset new 0 nil) | 378 | (setf (rmail-mime-display-header new) nil) |
| 384 | (aset new 1 t) | 379 | (setf (rmail-mime-display-tagline new) t) |
| 385 | (aset new 2 nil)) | 380 | (setf (rmail-mime-display-body new) nil)) |
| 386 | (dolist (child (rmail-mime-entity-children entity)) | 381 | (dolist (child (rmail-mime-entity-children entity)) |
| 387 | (rmail-mime-hidden-mode child))) | 382 | (rmail-mime-hidden-mode child))) |
| 388 | 383 | ||
| 389 | (defun rmail-mime-raw-mode (entity) | 384 | (defun rmail-mime-raw-mode (entity) |
| 390 | "Make MIME-entity ENTITY display in raw mode." | 385 | "Make MIME-entity ENTITY display in raw mode." |
| 391 | (let ((new (aref (rmail-mime-entity-display entity) 1))) | 386 | (let ((new (aref (rmail-mime-entity-display entity) 1))) |
| 392 | (aset new 0 'raw) | 387 | (setf (rmail-mime-display-header new) 'raw) |
| 393 | (aset new 1 nil) | 388 | (setf (rmail-mime-display-tagline new) nil) |
| 394 | (aset new 2 'raw)) | 389 | (setf (rmail-mime-display-body new) 'raw)) |
| 395 | (dolist (child (rmail-mime-entity-children entity)) | 390 | (dolist (child (rmail-mime-entity-children entity)) |
| 396 | (rmail-mime-raw-mode child))) | 391 | (rmail-mime-raw-mode child))) |
| 397 | 392 | ||
| @@ -404,8 +399,8 @@ Use `raw' for raw mode, and any other non-nil value for decoded mode." | |||
| 404 | (current (aref (rmail-mime-entity-display entity) 0)) | 399 | (current (aref (rmail-mime-entity-display entity) 0)) |
| 405 | (segment (rmail-mime-entity-segment pos entity))) | 400 | (segment (rmail-mime-entity-segment pos entity))) |
| 406 | (if (or (eq state 'raw) | 401 | (if (or (eq state 'raw) |
| 407 | (and (not state) | 402 | (not (or state |
| 408 | (not (eq (rmail-mime-display-header current) 'raw)))) | 403 | (eq (rmail-mime-display-header current) 'raw)))) |
| 409 | ;; Enter the raw mode. | 404 | ;; Enter the raw mode. |
| 410 | (rmail-mime-raw-mode entity) | 405 | (rmail-mime-raw-mode entity) |
| 411 | ;; Enter the shown mode. | 406 | ;; Enter the shown mode. |
| @@ -439,7 +434,7 @@ Use `raw' for raw mode, and any other non-nil value for decoded mode." | |||
| 439 | ;; header. | 434 | ;; header. |
| 440 | (if (and rmail-mime-mbox-buffer (= (aref segment 1) (point-min))) | 435 | (if (and rmail-mime-mbox-buffer (= (aref segment 1) (point-min))) |
| 441 | (let ((new (aref (rmail-mime-entity-display entity) 1))) | 436 | (let ((new (aref (rmail-mime-entity-display entity) 1))) |
| 442 | (aset new 0 t)))) | 437 | (setf (rmail-mime-display-header new) t)))) |
| 443 | ;; Query as a warning before showing if truncated. | 438 | ;; Query as a warning before showing if truncated. |
| 444 | (if (and (not (stringp entity)) | 439 | (if (and (not (stringp entity)) |
| 445 | (rmail-mime-entity-truncated entity)) | 440 | (rmail-mime-entity-truncated entity)) |
| @@ -448,7 +443,8 @@ Use `raw' for raw mode, and any other non-nil value for decoded mode." | |||
| 448 | ;; Enter the shown mode. | 443 | ;; Enter the shown mode. |
| 449 | (rmail-mime-shown-mode entity) | 444 | (rmail-mime-shown-mode entity) |
| 450 | ;; Force this body shown. | 445 | ;; Force this body shown. |
| 451 | (aset (aref (rmail-mime-entity-display entity) 1) 2 t)) | 446 | (let ((new (aref (rmail-mime-entity-display entity) 1))) |
| 447 | (setf (rmail-mime-display-body new) t))) | ||
| 452 | (let ((inhibit-read-only t) | 448 | (let ((inhibit-read-only t) |
| 453 | (modified (buffer-modified-p)) | 449 | (modified (buffer-modified-p)) |
| 454 | (rmail-mime-mbox-buffer rmail-view-buffer) | 450 | (rmail-mime-mbox-buffer rmail-view-buffer) |
| @@ -458,9 +454,9 @@ Use `raw' for raw mode, and any other non-nil value for decoded mode." | |||
| 458 | (rmail-mime-insert entity) | 454 | (rmail-mime-insert entity) |
| 459 | (restore-buffer-modified-p modified)))))) | 455 | (restore-buffer-modified-p modified)))))) |
| 460 | 456 | ||
| 461 | (define-key rmail-mode-map "\t" 'forward-button) | 457 | (define-key rmail-mode-map "\t" #'forward-button) |
| 462 | (define-key rmail-mode-map [backtab] 'backward-button) | 458 | (define-key rmail-mode-map [backtab] #'backward-button) |
| 463 | (define-key rmail-mode-map "\r" 'rmail-mime-toggle-hidden) | 459 | (define-key rmail-mode-map "\r" #'rmail-mime-toggle-hidden) |
| 464 | 460 | ||
| 465 | ;;; Handlers | 461 | ;;; Handlers |
| 466 | 462 | ||
| @@ -483,7 +479,7 @@ to the tag line." | |||
| 483 | (when item | 479 | (when item |
| 484 | (if (stringp item) | 480 | (if (stringp item) |
| 485 | (insert item) | 481 | (insert item) |
| 486 | (apply 'insert-button item)))) | 482 | (apply #'insert-button item)))) |
| 487 | ;; Follow the tagline by an empty line to make it a separate | 483 | ;; Follow the tagline by an empty line to make it a separate |
| 488 | ;; paragraph, so that the paragraph direction of the following text | 484 | ;; paragraph, so that the paragraph direction of the following text |
| 489 | ;; is determined based on that text. | 485 | ;; is determined based on that text. |
| @@ -495,8 +491,10 @@ to the tag line." | |||
| 495 | (modified (buffer-modified-p)) | 491 | (modified (buffer-modified-p)) |
| 496 | ;; If we are going to show the body, the new button label is | 492 | ;; If we are going to show the body, the new button label is |
| 497 | ;; "Hide". Otherwise, it's "Show". | 493 | ;; "Hide". Otherwise, it's "Show". |
| 498 | (label (if (aref (aref (rmail-mime-entity-display entity) 1) 2) "Hide" | 494 | (label |
| 499 | "Show")) | 495 | (if (rmail-mime-display-body |
| 496 | (aref (rmail-mime-entity-display entity) 1)) | ||
| 497 | "Hide" "Show")) | ||
| 500 | (button (next-button (point)))) | 498 | (button (next-button (point)))) |
| 501 | ;; Go to the second character of the button "Show" or "Hide". | 499 | ;; Go to the second character of the button "Show" or "Hide". |
| 502 | (goto-char (1+ (button-start button))) | 500 | (goto-char (1+ (button-start button))) |
| @@ -556,9 +554,10 @@ HEADER is a header component of a MIME-entity object (see | |||
| 556 | (rmail-mime-insert-text | 554 | (rmail-mime-insert-text |
| 557 | (rmail-mime-entity content-type content-disposition | 555 | (rmail-mime-entity content-type content-disposition |
| 558 | content-transfer-encoding | 556 | content-transfer-encoding |
| 559 | (vector (vector nil nil nil) (vector nil nil t)) | 557 | (vector (rmail-mime--make-display nil nil nil) |
| 558 | (rmail-mime--make-display nil nil t)) | ||
| 560 | (vector nil nil nil) (vector "" (cons nil nil) t) | 559 | (vector nil nil nil) (vector "" (cons nil nil) t) |
| 561 | (vector nil nil nil) nil 'rmail-mime-insert-text)) | 560 | (vector nil nil nil) nil #'rmail-mime-insert-text)) |
| 562 | t) | 561 | t) |
| 563 | 562 | ||
| 564 | (defun rmail-mime-insert-decoded-text (entity) | 563 | (defun rmail-mime-insert-decoded-text (entity) |
| @@ -592,7 +591,7 @@ HEADER is a header component of a MIME-entity object (see | |||
| 592 | (let ((current (aref (rmail-mime-entity-display entity) 0)) | 591 | (let ((current (aref (rmail-mime-entity-display entity) 0)) |
| 593 | (new (aref (rmail-mime-entity-display entity) 1)) | 592 | (new (aref (rmail-mime-entity-display entity) 1)) |
| 594 | (header (rmail-mime-entity-header entity)) | 593 | (header (rmail-mime-entity-header entity)) |
| 595 | (tagline (rmail-mime-entity-tagline entity)) | 594 | ;; (tagline (rmail-mime-entity-tagline entity)) |
| 596 | (body (rmail-mime-entity-body entity)) | 595 | (body (rmail-mime-entity-body entity)) |
| 597 | (beg (point)) | 596 | (beg (point)) |
| 598 | (segment (rmail-mime-entity-segment (point) entity))) | 597 | (segment (rmail-mime-entity-segment (point) entity))) |
| @@ -634,7 +633,7 @@ HEADER is a header component of a MIME-entity object (see | |||
| 634 | 633 | ||
| 635 | (defun rmail-mime-insert-image (entity) | 634 | (defun rmail-mime-insert-image (entity) |
| 636 | "Decode and insert the image body of MIME-entity ENTITY." | 635 | "Decode and insert the image body of MIME-entity ENTITY." |
| 637 | (let* ((content-type (car (rmail-mime-entity-type entity))) | 636 | (let* (;; (content-type (car (rmail-mime-entity-type entity))) |
| 638 | (bulk-data (aref (rmail-mime-entity-tagline entity) 1)) | 637 | (bulk-data (aref (rmail-mime-entity-tagline entity) 1)) |
| 639 | (body (rmail-mime-entity-body entity)) | 638 | (body (rmail-mime-entity-body entity)) |
| 640 | data) | 639 | data) |
| @@ -709,6 +708,9 @@ HEADER is a header component of a MIME-entity object (see | |||
| 709 | (declare-function libxml-parse-html-region "xml.c" | 708 | (declare-function libxml-parse-html-region "xml.c" |
| 710 | (start end &optional base-url discard-comments)) | 709 | (start end &optional base-url discard-comments)) |
| 711 | 710 | ||
| 711 | (defvar shr-inhibit-images) | ||
| 712 | (defvar shr-width) | ||
| 713 | |||
| 712 | (defun rmail-mime-render-html-shr (source-buffer) | 714 | (defun rmail-mime-render-html-shr (source-buffer) |
| 713 | (let ((dom (with-current-buffer source-buffer | 715 | (let ((dom (with-current-buffer source-buffer |
| 714 | (libxml-parse-html-region (point-min) (point-max)))) | 716 | (libxml-parse-html-region (point-min) (point-max)))) |
| @@ -759,7 +761,8 @@ For images that Emacs is capable of displaying, the behavior | |||
| 759 | depends upon the value of `rmail-mime-show-images'." | 761 | depends upon the value of `rmail-mime-show-images'." |
| 760 | (rmail-mime-insert-bulk | 762 | (rmail-mime-insert-bulk |
| 761 | (rmail-mime-entity content-type content-disposition content-transfer-encoding | 763 | (rmail-mime-entity content-type content-disposition content-transfer-encoding |
| 762 | (vector (vector nil nil nil) (vector nil t nil)) | 764 | (vector (rmail-mime--make-display nil nil nil) |
| 765 | (rmail-mime--make-display nil t nil)) | ||
| 763 | (vector nil nil nil) (vector "" (cons nil nil) t) | 766 | (vector nil nil nil) (vector "" (cons nil nil) t) |
| 764 | (vector nil nil nil) nil 'rmail-mime-insert-bulk))) | 767 | (vector nil nil nil) nil 'rmail-mime-insert-bulk))) |
| 765 | 768 | ||
| @@ -1024,9 +1027,10 @@ The other arguments are the same as `rmail-mime-multipart-handler'." | |||
| 1024 | nil (format "%s/%d" parse-tag index) | 1027 | nil (format "%s/%d" parse-tag index) |
| 1025 | content-type content-disposition))) | 1028 | content-type content-disposition))) |
| 1026 | ;; Display a tagline. | 1029 | ;; Display a tagline. |
| 1027 | (aset (aref (rmail-mime-entity-display child) 1) 1 | 1030 | (setf (rmail-mime-display-tagline |
| 1031 | (aref (rmail-mime-entity-display child) 1)) | ||
| 1028 | (aset (rmail-mime-entity-tagline child) 2 t)) | 1032 | (aset (rmail-mime-entity-tagline child) 2 t)) |
| 1029 | (rmail-mime-entity-set-truncated child truncated) | 1033 | (setf (rmail-mime-entity-truncated child) truncated) |
| 1030 | (push child entities))) | 1034 | (push child entities))) |
| 1031 | 1035 | ||
| 1032 | (delete-region end next) | 1036 | (delete-region end next) |
| @@ -1072,8 +1076,8 @@ The other arguments are the same as `rmail-mime-multipart-handler'." | |||
| 1072 | (let ((current (aref (rmail-mime-entity-display entity) 0)) | 1076 | (let ((current (aref (rmail-mime-entity-display entity) 0)) |
| 1073 | (new (aref (rmail-mime-entity-display entity) 1)) | 1077 | (new (aref (rmail-mime-entity-display entity) 1)) |
| 1074 | (header (rmail-mime-entity-header entity)) | 1078 | (header (rmail-mime-entity-header entity)) |
| 1075 | (tagline (rmail-mime-entity-tagline entity)) | 1079 | ;; (tagline (rmail-mime-entity-tagline entity)) |
| 1076 | (body (rmail-mime-entity-body entity)) | 1080 | ;; (body (rmail-mime-entity-body entity)) |
| 1077 | (beg (point)) | 1081 | (beg (point)) |
| 1078 | (segment (rmail-mime-entity-segment (point) entity))) | 1082 | (segment (rmail-mime-entity-segment (point) entity))) |
| 1079 | ;; header | 1083 | ;; header |
| @@ -1169,13 +1173,11 @@ The parsed header value: | |||
| 1169 | content-transfer-encoding)) | 1173 | content-transfer-encoding)) |
| 1170 | (save-restriction | 1174 | (save-restriction |
| 1171 | (widen) | 1175 | (widen) |
| 1172 | (let ((entity (get-text-property (1- (point)) 'rmail-mime-entity)) | 1176 | (let ((entity (get-text-property (1- (point)) 'rmail-mime-entity))) |
| 1173 | current new) | ||
| 1174 | (when entity | 1177 | (when entity |
| 1175 | (setq current (aref (rmail-mime-entity-display entity) 0) | 1178 | (let ((new (aref (rmail-mime-entity-display entity) 1))) |
| 1176 | new (aref (rmail-mime-entity-display entity) 1)) | 1179 | (setf (aref (rmail-mime-entity-display entity) 0) |
| 1177 | (dotimes (i 3) | 1180 | (rmail-mime--copy-display new))))))) |
| 1178 | (aset current i (aref new i))))))) | ||
| 1179 | 1181 | ||
| 1180 | (defun rmail-mime-show (&optional show-headers) | 1182 | (defun rmail-mime-show (&optional show-headers) |
| 1181 | "Handle the current buffer as a MIME message. | 1183 | "Handle the current buffer as a MIME message. |
| @@ -1240,13 +1242,15 @@ modified." | |||
| 1240 | (header (vector (point-min-marker) hdr-end nil)) | 1242 | (header (vector (point-min-marker) hdr-end nil)) |
| 1241 | (tagline (vector parse-tag (cons nil nil) t)) | 1243 | (tagline (vector parse-tag (cons nil nil) t)) |
| 1242 | (body (vector hdr-end (point-max-marker) is-inline)) | 1244 | (body (vector hdr-end (point-max-marker) is-inline)) |
| 1243 | (new (vector (aref header 2) (aref tagline 2) (aref body 2))) | 1245 | (new (rmail-mime--make-display |
| 1246 | (aref header 2) (aref tagline 2) (aref body 2))) | ||
| 1244 | children handler entity) | 1247 | children handler entity) |
| 1245 | (cond ((string-match "multipart/.*" (car content-type)) | 1248 | (cond ((string-match "multipart/.*" (car content-type)) |
| 1246 | (save-restriction | 1249 | (save-restriction |
| 1247 | (narrow-to-region (1- end) (point-max)) | 1250 | (narrow-to-region (1- end) (point-max)) |
| 1248 | (if (zerop (length parse-tag)) ; top level of message | 1251 | (if (zerop (length parse-tag)) ; top level of message |
| 1249 | (aset new 1 (aset tagline 2 nil))) ; don't show tagline | 1252 | (setf (rmail-mime-display-tagline new) |
| 1253 | (aset tagline 2 nil))) ; don't show tagline | ||
| 1250 | (setq children (rmail-mime-process-multipart | 1254 | (setq children (rmail-mime-process-multipart |
| 1251 | content-type | 1255 | content-type |
| 1252 | content-disposition | 1256 | content-disposition |
| @@ -1260,37 +1264,38 @@ modified." | |||
| 1260 | '("text/plain") '("inline"))) | 1264 | '("text/plain") '("inline"))) |
| 1261 | (msg-new (aref (rmail-mime-entity-display msg) 1))) | 1265 | (msg-new (aref (rmail-mime-entity-display msg) 1))) |
| 1262 | ;; Show header of the child. | 1266 | ;; Show header of the child. |
| 1263 | (aset msg-new 0 t) | 1267 | (setf (rmail-mime-display-header msg-new) t) |
| 1264 | (aset (rmail-mime-entity-header msg) 2 t) | 1268 | (aset (rmail-mime-entity-header msg) 2 t) |
| 1265 | ;; Hide tagline of the child. | 1269 | ;; Hide tagline of the child. |
| 1266 | (aset msg-new 1 nil) | 1270 | (setf (rmail-mime-display-tagline msg-new) nil) |
| 1267 | (aset (rmail-mime-entity-tagline msg) 2 nil) | 1271 | (aset (rmail-mime-entity-tagline msg) 2 nil) |
| 1268 | (setq children (list msg) | 1272 | (setq children (list msg) |
| 1269 | handler 'rmail-mime-insert-multipart)))) | 1273 | handler 'rmail-mime-insert-multipart)))) |
| 1270 | ((and is-inline (string-match "text/html" (car content-type))) | 1274 | ((and is-inline (string-match "text/html" (car content-type))) |
| 1271 | ;; Display tagline, so part can be detached | 1275 | ;; Display tagline, so part can be detached |
| 1272 | (aset new 1 (aset tagline 2 t)) | 1276 | (setf (rmail-mime-display-tagline new) (aset tagline 2 t)) |
| 1273 | (aset new 2 (aset body 2 t)) ; display body also. | 1277 | (setf (rmail-mime-display-body new) (aset body 2 t)) ; display body also. |
| 1274 | (setq handler 'rmail-mime-insert-bulk)) | 1278 | (setq handler 'rmail-mime-insert-bulk)) |
| 1275 | ;; Inline non-HTML text | 1279 | ;; Inline non-HTML text |
| 1276 | ((and is-inline (string-match "text/" (car content-type))) | 1280 | ((and is-inline (string-match "text/" (car content-type))) |
| 1277 | ;; Don't need a tagline. | 1281 | ;; Don't need a tagline. |
| 1278 | (aset new 1 (aset tagline 2 nil)) | 1282 | (setf (rmail-mime-display-tagline new) (aset tagline 2 nil)) |
| 1279 | (setq handler 'rmail-mime-insert-text)) | 1283 | (setq handler 'rmail-mime-insert-text)) |
| 1280 | (t | 1284 | (t |
| 1281 | ;; Force hidden mode. | 1285 | ;; Force hidden mode. |
| 1282 | (aset new 1 (aset tagline 2 t)) | 1286 | (setf (rmail-mime-display-tagline new) (aset tagline 2 t)) |
| 1283 | (aset new 2 (aset body 2 nil)) | 1287 | (setf (rmail-mime-display-body new) (aset body 2 nil)) |
| 1284 | (setq handler 'rmail-mime-insert-bulk))) | 1288 | (setq handler 'rmail-mime-insert-bulk))) |
| 1285 | (setq entity (rmail-mime-entity content-type | 1289 | (setq entity (rmail-mime-entity |
| 1286 | content-disposition | 1290 | content-type |
| 1287 | content-transfer-encoding | 1291 | content-disposition |
| 1288 | (vector (vector nil nil nil) new) | 1292 | content-transfer-encoding |
| 1289 | header tagline body children handler)) | 1293 | (vector (rmail-mime--make-display nil nil nil) new) |
| 1294 | header tagline body children handler)) | ||
| 1290 | (if (and (eq handler 'rmail-mime-insert-bulk) | 1295 | (if (and (eq handler 'rmail-mime-insert-bulk) |
| 1291 | (rmail-mime-set-bulk-data entity)) | 1296 | (rmail-mime-set-bulk-data entity)) |
| 1292 | ;; Show the body. | 1297 | ;; Show the body. |
| 1293 | (aset new 2 (aset body 2 t))) | 1298 | (setf (rmail-mime-display-body new) (aset body 2 t))) |
| 1294 | entity) | 1299 | entity) |
| 1295 | 1300 | ||
| 1296 | ;; Hide headers and handle the part. | 1301 | ;; Hide headers and handle the part. |
| @@ -1324,7 +1329,8 @@ If an error occurs, return an error message string." | |||
| 1324 | '("text/plain") '("inline"))) | 1329 | '("text/plain") '("inline"))) |
| 1325 | (new (aref (rmail-mime-entity-display entity) 1))) | 1330 | (new (aref (rmail-mime-entity-display entity) 1))) |
| 1326 | ;; Show header. | 1331 | ;; Show header. |
| 1327 | (aset new 0 (aset (rmail-mime-entity-header entity) 2 t)) | 1332 | (setf (rmail-mime-display-header new) |
| 1333 | (aset (rmail-mime-entity-header entity) 2 t)) | ||
| 1328 | entity))) | 1334 | entity))) |
| 1329 | (error (format "%s" err))))) | 1335 | (error (format "%s" err))))) |
| 1330 | 1336 | ||
| @@ -1339,7 +1345,7 @@ available." | |||
| 1339 | ;; Not a raw-mode. Each handler should handle it. | 1345 | ;; Not a raw-mode. Each handler should handle it. |
| 1340 | (funcall (rmail-mime-entity-handler entity) entity) | 1346 | (funcall (rmail-mime-entity-handler entity) entity) |
| 1341 | (let ((header (rmail-mime-entity-header entity)) | 1347 | (let ((header (rmail-mime-entity-header entity)) |
| 1342 | (tagline (rmail-mime-entity-tagline entity)) | 1348 | ;; (tagline (rmail-mime-entity-tagline entity)) |
| 1343 | (body (rmail-mime-entity-body entity)) | 1349 | (body (rmail-mime-entity-body entity)) |
| 1344 | (beg (point)) | 1350 | (beg (point)) |
| 1345 | (segment (rmail-mime-entity-segment (point) entity))) | 1351 | (segment (rmail-mime-entity-segment (point) entity))) |
| @@ -1370,15 +1376,15 @@ available." | |||
| 1370 | (aref body 0) (aref body 1)) | 1376 | (aref body 0) (aref body 1)) |
| 1371 | (or (bolp) (insert "\n"))) | 1377 | (or (bolp) (insert "\n"))) |
| 1372 | (put-text-property beg (point) 'rmail-mime-entity entity))))) | 1378 | (put-text-property beg (point) 'rmail-mime-entity entity))))) |
| 1373 | (dotimes (i 3) | 1379 | (setf (aref (rmail-mime-entity-display entity) 0) |
| 1374 | (aset current i (aref new i))))) | 1380 | (rmail-mime--copy-display new)))) |
| 1375 | 1381 | ||
| 1376 | (define-derived-mode rmail-mime-mode fundamental-mode "RMIME" | 1382 | (define-derived-mode rmail-mime-mode fundamental-mode "RMIME" |
| 1377 | "Major mode used in `rmail-mime' buffers." | 1383 | "Major mode used in `rmail-mime' buffers." |
| 1378 | (setq font-lock-defaults '(rmail-font-lock-keywords t t nil nil))) | 1384 | (setq font-lock-defaults '(rmail-font-lock-keywords t t nil nil))) |
| 1379 | 1385 | ||
| 1380 | ;;;###autoload | 1386 | ;;;###autoload |
| 1381 | (defun rmail-mime (&optional arg state) | 1387 | (defun rmail-mime (&optional _arg state) |
| 1382 | "Toggle the display of a MIME message. | 1388 | "Toggle the display of a MIME message. |
| 1383 | 1389 | ||
| 1384 | The actual behavior depends on the value of `rmail-enable-mime'. | 1390 | The actual behavior depends on the value of `rmail-enable-mime'. |
| @@ -1442,7 +1448,7 @@ The arguments ARG and STATE have no effect in this case." | |||
| 1442 | (rmail-mime-view-buffer rmail-view-buffer) | 1448 | (rmail-mime-view-buffer rmail-view-buffer) |
| 1443 | (rmail-mime-coding-system nil)) | 1449 | (rmail-mime-coding-system nil)) |
| 1444 | ;; If ENTITY is not a vector, it is a string describing an error. | 1450 | ;; If ENTITY is not a vector, it is a string describing an error. |
| 1445 | (if (vectorp entity) | 1451 | (if (rmail-mime-entity-p entity) |
| 1446 | (with-current-buffer rmail-mime-view-buffer | 1452 | (with-current-buffer rmail-mime-view-buffer |
| 1447 | (erase-buffer) | 1453 | (erase-buffer) |
| 1448 | ;; This condition-case is for catching an error in the | 1454 | ;; This condition-case is for catching an error in the |
| @@ -1530,7 +1536,7 @@ This is the usual value of `rmail-insert-mime-forwarded-message-function'." | |||
| 1530 | (rmail-mime-view-buffer rmail-view-buffer) | 1536 | (rmail-mime-view-buffer rmail-view-buffer) |
| 1531 | (header-end (save-excursion | 1537 | (header-end (save-excursion |
| 1532 | (re-search-forward "^$" nil 'move) (point))) | 1538 | (re-search-forward "^$" nil 'move) (point))) |
| 1533 | (body-end (point-max)) | 1539 | ;; (body-end (point-max)) |
| 1534 | (entity (rmail-mime-parse))) | 1540 | (entity (rmail-mime-parse))) |
| 1535 | (or | 1541 | (or |
| 1536 | ;; At first, just search the headers. | 1542 | ;; At first, just search the headers. |