Lines Matching +defs:mm +defs:set +defs:handle +defs:multipart +defs:parameter
0 ;;; mm-decode.el --- Functions for decoding MIME things
31 (require 'mm-bodies)
37 (autoload 'mm-inline-partial "mm-partial")
38 (autoload 'mm-inline-external-body "mm-extern")
39 (autoload 'mm-extern-cache-contents "mm-extern")
40 (autoload 'mm-insert-inline "mm-view"))
44 (add-hook 'gnus-exit-gnus-hook 'mm-destroy-postponed-undisplay-list)
63 (defmacro mm-handle-buffer (handle)
64 `(nth 0 ,handle))
65 (defmacro mm-handle-type (handle)
66 `(nth 1 ,handle))
67 (defsubst mm-handle-media-type (handle)
68 (if (stringp (car handle))
69 (car handle)
70 (car (mm-handle-type handle))))
71 (defsubst mm-handle-media-supertype (handle)
72 (car (split-string (mm-handle-media-type handle) "/")))
73 (defsubst mm-handle-media-subtype (handle)
74 (cadr (split-string (mm-handle-media-type handle) "/")))
75 (defmacro mm-handle-encoding (handle)
76 `(nth 2 ,handle))
77 (defmacro mm-handle-undisplayer (handle)
78 `(nth 3 ,handle))
79 (defmacro mm-handle-set-undisplayer (handle function)
80 `(setcar (nthcdr 3 ,handle) ,function))
81 (defmacro mm-handle-disposition (handle)
82 `(nth 4 ,handle))
83 (defmacro mm-handle-description (handle)
84 `(nth 5 ,handle))
85 (defmacro mm-handle-cache (handle)
86 `(nth 6 ,handle))
87 (defmacro mm-handle-set-cache (handle contents)
88 `(setcar (nthcdr 6 ,handle) ,contents))
89 (defmacro mm-handle-id (handle)
90 `(nth 7 ,handle))
91 (defmacro mm-handle-multipart-original-buffer (handle)
92 `(get-text-property 0 'buffer (car ,handle)))
93 (defmacro mm-handle-multipart-from (handle)
94 `(get-text-property 0 'from (car ,handle)))
95 (defmacro mm-handle-multipart-ctl-parameter (handle parameter)
96 `(get-text-property 0 ,parameter (car ,handle)))
98 (defmacro mm-make-handle (&optional buffer type encoding undisplayer
104 (defcustom mm-text-html-renderer
133 (defvar mm-inline-text-html-renderer nil
135 It is suggested to customize `mm-text-html-renderer' instead.")
137 (defcustom mm-inline-text-html-with-images nil
140 documentation for the `mm-w3m-safe-url-regexp' variable."
145 (defcustom mm-w3m-safe-url-regexp "\\`cid:"
156 set this variable to nil if you consider all urls to be safe."
162 (defcustom mm-inline-text-html-with-w3m-keymap t
168 (defcustom mm-enable-external t
180 (defcustom mm-inline-media-tests
182 mm-inline-image
183 (lambda (handle)
184 (mm-valid-and-fit-image-p 'jpeg handle)))
186 mm-inline-image
187 (lambda (handle)
188 (mm-valid-and-fit-image-p 'png handle)))
190 mm-inline-image
191 (lambda (handle)
192 (mm-valid-and-fit-image-p 'gif handle)))
194 mm-inline-image
195 (lambda (handle)
196 (mm-valid-and-fit-image-p 'tiff handle)) )
198 mm-inline-image
199 (lambda (handle)
200 (mm-valid-and-fit-image-p 'xbm handle)))
202 mm-inline-image
203 (lambda (handle)
204 (mm-valid-and-fit-image-p 'xbm handle)))
206 mm-inline-image
207 (lambda (handle)
208 (mm-valid-and-fit-image-p 'xpm handle)))
210 mm-inline-image
211 (lambda (handle)
212 (mm-valid-and-fit-image-p 'xpm handle)))
214 mm-inline-image
215 (lambda (handle)
216 (mm-valid-and-fit-image-p 'bmp handle)))
218 mm-inline-image
219 (lambda (handle)
220 (mm-valid-and-fit-image-p 'pbm handle)))
221 ("text/plain" mm-inline-text identity)
222 ("text/enriched" mm-inline-text identity)
223 ("text/richtext" mm-inline-text identity)
224 ("text/x-patch" mm-display-patch-inline
225 (lambda (handle)
232 ("application/emacs-lisp" mm-display-elisp-inline identity)
233 ("application/x-emacs-lisp" mm-display-elisp-inline identity)
235 mm-inline-text-html
236 (lambda (handle)
237 (or mm-inline-text-html-renderer
238 mm-text-html-renderer)))
240 mm-inline-text-vcard
241 (lambda (handle)
244 ("message/delivery-status" mm-inline-text identity)
245 ("message/rfc822" mm-inline-message identity)
246 ("message/partial" mm-inline-partial identity)
247 ("message/external-body" mm-inline-external-body identity)
248 ("text/.*" mm-inline-text identity)
249 ("audio/wav" mm-inline-audio
250 (lambda (handle)
254 mm-inline-audio
255 (lambda (handle)
263 ("multipart/alternative" ignore identity)
264 ("multipart/mixed" ignore identity)
265 ("multipart/related" ignore identity)
270 (".*" mm-inline-text mm-readable-p))
277 (defcustom mm-inlined-types
287 See also `mm-inline-media-tests', which says how to display a media
292 (defcustom mm-keep-viewer-alive-types
301 (defcustom mm-automatic-display
303 "text/x-vcard" "image/.*" "message/delivery-status" "multipart/.*"
315 (defcustom mm-attachment-override-types '("text/x-vcard"
324 (defcustom mm-inline-override-types nil
329 (defcustom mm-automatic-external-display nil
334 (defcustom mm-discouraged-alternatives nil
335 "List of MIME types that are discouraged when viewing multipart/alternative.
340 somewhat unwanted, then the value of this variable should be set
346 prefered part of multipart/alternative messages. See also
347 `gnus-buttonized-mime-types', to which adding \"multipart/alternative\"
349 :type '(repeat regexp) ;; See `mm-preferred-alternative-precedence'.
352 (defcustom mm-tmp-directory
358 "Where mm will store its temporary files."
362 (defcustom mm-inline-large-images nil
367 (defvar mm-file-name-rewrite-functions
368 '(mm-file-name-delete-control mm-file-name-delete-gotchas)
373 `mm-file-name-delete-control'
374 `mm-file-name-delete-gotchas'
375 `mm-file-name-delete-whitespace',
376 `mm-file-name-trim-whitespace',
377 `mm-file-name-collapse-whitespace',
378 `mm-file-name-replace-whitespace',
382 (defvar mm-path-name-rewrite-functions nil
390 (defvar mm-file-name-replace-whitespace nil
393 (defcustom mm-default-directory nil
394 "The default directory where mm will save files.
395 If not set, `default-directory' will be used."
399 (defcustom mm-attachment-file-modes 384
405 (defcustom mm-external-terminal-program "xterm"
413 (defvar mm-last-shell-command "")
414 (defvar mm-content-id-alist nil)
415 (defvar mm-postponed-undisplay-list nil)
420 (defvar mm-dissect-default-type "text/plain")
427 (defvar mm-verify-function-alist
429 ("application/x-gnus-pgp-signature" mm-uu-pgp-signed-extract-1 "PGP"
430 mm-uu-pgp-signed-test)
436 (defcustom mm-verify-option 'never
450 (defvar mm-decrypt-function-alist
452 ("application/x-gnus-pgp-encrypted" mm-uu-pgp-encrypted-extract-1 "PGP"
453 mm-uu-pgp-encrypted-test)))
455 (defcustom mm-decrypt-option nil
466 (defvar mm-viewer-completion-map
467 (let ((map (make-sparse-keymap 'mm-viewer-completion-map)))
468 (set-keymap-parent map minibuffer-local-completion-map)
474 (defvar mm-viewer-completion-map
475 (let ((map (make-sparse-keymap 'mm-viewer-completion-map)))
476 (set-keymap-parent map minibuffer-local-completion-map)
484 (defun mm-alist-to-plist (alist)
502 (defun mm-keep-viewer-alive-p (handle)
504 (let ((types mm-keep-viewer-alive-types)
505 (type (mm-handle-media-type handle))
512 (defun mm-handle-set-external-undisplayer (handle function)
515 `mm-keep-viewer-alive-types'."
516 (if (mm-keep-viewer-alive-p handle)
517 (let ((new-handle (copy-sequence handle)))
518 (mm-handle-set-undisplayer new-handle function)
519 (mm-handle-set-undisplayer handle nil)
520 (push new-handle mm-postponed-undisplay-list))
521 (mm-handle-set-undisplayer handle function)))
523 (defun mm-destroy-postponed-undisplay-list ()
524 (when mm-postponed-undisplay-list
526 (mm-destroy-parts mm-postponed-undisplay-list)))
528 (defun mm-dissect-buffer (&optional no-strict-mime loose-mime from)
555 (mm-dissect-singlepart
556 (list mm-dissect-default-type)
569 ((equal type "multipart")
570 (let ((mm-dissect-default-type (if (equal subtype "digest")
575 (mm-alist-to-plist (cdr ctl)) (car ctl))
578 ;; MIME handle back to it's parent MIME handle (in a multilevel
580 ;; the mm-handle API so we simply store the multipart buffer
581 ;; name as a text property of the "multipart/whatever" string.
583 (list 'buffer (mm-copy-to-buffer)
587 (cons (car ctl) (mm-dissect-multipart ctl from))))
589 (mm-possibly-verify-or-decrypt
590 (mm-dissect-singlepart
602 (push (cons id result) mm-content-id-alist))
605 (defun mm-dissect-singlepart (ctl cte &optional force cdl description id)
610 (mm-make-handle
611 (mm-copy-to-buffer) ctl cte nil cdl description nil id)))
613 (defun mm-dissect-multipart (ctl from)
630 (setq parts (nconc (list (mm-dissect-buffer t nil from)) parts)))))
639 (setq parts (nconc (list (mm-dissect-buffer t nil from)) parts)))))
640 (mm-possibly-verify-or-decrypt (nreverse parts) ctl)))
642 (defun mm-copy-to-buffer ()
651 (let ((default-enable-multibyte-characters (mm-multibyte-p)))
652 (generate-new-buffer " *mm*"))
656 (defun mm-display-parts (handle &optional no-default)
657 (if (stringp (car handle))
658 (mapcar 'mm-display-parts (cdr handle))
659 (if (bufferp (car handle))
662 (mm-display-part handle)
664 (mapcar 'mm-display-parts handle))))
666 (defun mm-display-part (handle &optional no-default)
672 (if (mm-handle-displayed-p handle)
673 (mm-remove-part handle)
674 (let* ((ehandle (if (equal (mm-handle-media-type handle)
677 (unless (mm-handle-cache handle)
678 (mm-extern-cache-contents handle))
679 (mm-handle-cache handle))
680 handle))
681 (type (mm-handle-media-type ehandle))
684 (mm-handle-disposition handle) 'filename)
686 (mm-handle-type handle) 'name)
688 (external mm-enable-external))
689 (if (and (mm-inlinable-p ehandle)
690 (mm-inlined-p ehandle))
693 (mm-display-inline handle)
701 (mm-insert-inline handle (mm-get-part handle))
706 (or (eq mm-enable-external t)
707 (and (eq mm-enable-external 'ask)
719 (mm-display-external
720 handle (or method 'mailcap-save-binary-file))
721 (mm-display-external
722 handle 'mailcap-save-binary-file)))))))))
724 (defun mm-display-external (handle method)
727 (mm-with-unibyte-buffer
732 (set-buffer (generate-new-buffer " *mm*"))
734 (mm-insert-part handle)
738 (switch-to-buffer (generate-new-buffer " *mm*")))
740 (mm-set-buffer-file-coding-system mm-binary-coding-system)
745 (let ((mm (current-buffer))
748 (mm-handle-media-type handle) t))))
752 (mm-save-part handle))
755 (mm-handle-set-undisplayer handle mm)))))
757 (mm-insert-part handle)
758 (let* ((dir (mm-make-temp-file
759 (expand-file-name "emm." mm-tmp-directory) 'dir))
762 (mm-handle-disposition handle) 'filename)
764 (mm-handle-type handle) 'name)))
766 (mm-handle-media-type handle) t))
772 (set-file-modes dir 448)
775 (gnus-map-function mm-file-name-rewrite-functions
786 (setq suffix (car (rassoc (mm-handle-media-type handle)
788 (setq file (mm-make-temp-file (expand-file-name "mm." dir)
790 (let ((coding-system-for-write mm-binary-coding-system))
795 (let ((command (mm-mailcap-command
796 method file (mm-handle-type handle))))
800 mm-external-terminal-program
805 (set-buffer
813 (set-process-sentinel
820 (mm-handle-set-external-undisplayer handle (cons file buffer)))
826 (mm-insert-inline
827 handle
832 (generate-new-buffer " *mm*"))
835 (mm-mailcap-command
836 method file (mm-handle-type handle)))
850 (let ((command (mm-mailcap-command
851 method file (mm-handle-type handle))))
856 (generate-new-buffer " *mm*"))
859 (set-process-sentinel
877 (list 'mm-handle-set-undisplayer
878 (list 'quote handle)
890 (set-itimer-function timer fn)
897 (timer-set-function timer fn)
901 (mm-handle-set-external-undisplayer
902 handle (cons file buffer)))
906 (defun mm-mailcap-command (method file type-list)
925 (push (mm-quote-arg
926 (gnus-map-function mm-path-name-rewrite-functions file)) out))
928 (push (mm-quote-arg (car type-list)) out))
930 (push (mm-quote-arg (or (cdr (assq (intern sub) ctl)) "")) out))))
934 (push (mm-quote-arg
935 (gnus-map-function mm-path-name-rewrite-functions file))
939 (defun mm-remove-parts (handles)
943 (mm-remove-part handles)
944 (let (handle)
945 (while (setq handle (pop handles))
947 ((stringp handle)
948 (when (buffer-live-p (get-text-property 0 'buffer handle))
949 (kill-buffer (get-text-property 0 'buffer handle))))
950 ((and (listp handle)
951 (stringp (car handle)))
952 (mm-remove-parts (cdr handle)))
954 (mm-remove-part handle)))))))
956 (defun mm-destroy-parts (handles)
960 (mm-destroy-part handles)
961 (let (handle)
962 (while (setq handle (pop handles))
964 ((stringp handle)
965 (when (buffer-live-p (get-text-property 0 'buffer handle))
966 (kill-buffer (get-text-property 0 'buffer handle))))
967 ((and (listp handle)
968 (stringp (car handle)))
969 (mm-destroy-parts handle))
971 (mm-destroy-part handle)))))))
973 (defun mm-remove-part (handle)
975 (when (listp handle)
976 (let ((object (mm-handle-undisplayer handle)))
980 ((mm-annotationp object)
1003 (mm-handle-set-undisplayer handle nil))))
1005 (defun mm-display-inline (handle)
1006 (let* ((type (mm-handle-media-type handle))
1007 (function (cadr (mm-assoc-string-match mm-inline-media-tests type))))
1008 (funcall function handle)
1011 (defun mm-assoc-string-match (alist type)
1016 (defun mm-automatic-display-p (handle)
1018 (let ((methods mm-automatic-display)
1019 (type (mm-handle-media-type handle))
1022 (when (and (not (mm-inline-override-p handle))
1028 (defun mm-inlinable-p (handle &optional type)
1032 (unless type (setq type (mm-handle-media-type handle)))
1033 (let ((alist mm-inline-media-tests)
1039 (setq test (funcall test handle)))
1043 (defun mm-inlined-p (handle)
1045 (let ((methods mm-inlined-types)
1046 (type (mm-handle-media-type handle))
1049 (when (and (not (mm-inline-override-p handle))
1055 (defun mm-attachment-override-p (handle)
1057 (let ((types mm-attachment-override-types)
1058 (type (mm-handle-media-type handle))
1063 (mm-inlinable-p handle))
1066 (defun mm-inline-override-p (handle)
1068 (let ((types mm-inline-override-types)
1069 (type (mm-handle-media-type handle))
1076 (defun mm-automatic-external-display-p (type)
1078 (let ((methods mm-automatic-external-display)
1086 (defun mm-destroy-part (handle)
1088 (when (listp handle)
1089 (mm-remove-part handle)
1090 (when (buffer-live-p (mm-handle-buffer handle))
1091 (kill-buffer (mm-handle-buffer handle)))))
1093 (defun mm-handle-displayed-p (handle)
1095 (mm-handle-undisplayer handle))
1101 (defmacro mm-with-part (handle &rest forms)
1103 `(let* ((handle ,handle)
1109 (with-current-buffer (mm-handle-buffer handle)
1110 (mm-multibyte-p))))
1112 (insert-buffer-substring (mm-handle-buffer handle))
1113 (mm-disable-multibyte)
1114 (mm-decode-content-transfer-encoding
1115 (mm-handle-encoding handle)
1116 (mm-handle-media-type handle))
1118 (put 'mm-with-part 'lisp-indent-function 1)
1119 (put 'mm-with-part 'edebug-form-spec '(body))
1121 (defun mm-get-part (handle &optional no-cache)
1126 (equal (mm-handle-media-type handle) "message/external-body"))
1128 (unless (mm-handle-cache handle)
1129 (mm-extern-cache-contents handle))
1130 (with-current-buffer (mm-handle-buffer (mm-handle-cache handle))
1132 (mm-with-part handle
1135 (defun mm-insert-part (handle &optional no-cache)
1141 (cond ((eq (mail-content-type-get (mm-handle-type handle) 'charset)
1143 (with-current-buffer (mm-handle-buffer handle)
1145 ((mm-multibyte-p)
1146 (mm-string-to-multibyte (mm-get-part handle no-cache)))
1148 (mm-get-part handle no-cache))))))
1150 (defun mm-file-name-delete-whitespace (file-name)
1156 (defun mm-file-name-trim-whitespace (file-name)
1164 (defun mm-file-name-collapse-whitespace (file-name)
1170 (defun mm-file-name-replace-whitespace (file-name)
1172 Set the option `mm-file-name-replace-whitespace' to any other
1174 (let ((s (or mm-file-name-replace-whitespace "_")))
1179 (defun mm-file-name-delete-control (filename)
1183 (defun mm-file-name-delete-gotchas (filename)
1188 (defun mm-save-part (handle)
1191 (mm-handle-disposition handle) 'filename)
1193 (mm-handle-type handle) 'name)))
1196 (setq filename (gnus-map-function mm-file-name-rewrite-functions
1199 (mm-with-multibyte
1201 (or mm-default-directory default-directory)
1203 (setq mm-default-directory (file-name-directory file))
1208 (mm-save-part-to-file handle file)
1211 (defun mm-save-part-to-file (handle file)
1212 (mm-with-unibyte-buffer
1213 (mm-insert-part handle)
1222 (set-default-file-modes mm-attachment-file-modes)
1225 (set-default-file-modes current-file-modes)))))
1227 (defun mm-pipe-part (handle)
1229 (let* ((name (mail-content-type-get (mm-handle-type handle) 'name))
1231 (read-string "Shell command on MIME part: " mm-last-shell-command)))
1232 (mm-with-unibyte-buffer
1233 (mm-insert-part handle)
1237 (defun mm-interactively-view-part (handle)
1239 (let* ((type (mm-handle-media-type handle))
1244 mm-viewer-completion-map))
1250 (mm-display-external handle method)))
1252 (defun mm-preferred-alternative (handles &optional preferred)
1255 (mm-preferred-alternative-precedence handles)))
1256 p h result type handle)
1260 (setq handle (car h))
1261 (setq type (mm-handle-media-type handle))
1263 (mm-automatic-display-p handle)
1264 (or (stringp (car handle))
1265 (not (mm-handle-disposition handle))
1266 (equal (car (mm-handle-disposition handle))
1268 (setq result handle
1274 (defun mm-preferred-alternative-precedence (handles)
1275 "Return the precedence based on HANDLES and `mm-discouraged-alternatives'."
1276 (let ((seq (nreverse (mapcar #'mm-handle-media-type
1278 (dolist (disc (reverse mm-discouraged-alternatives))
1284 (defun mm-get-content-id (id)
1285 "Return the handle(s) referred to by ID."
1286 (cdr (assoc id mm-content-id-alist)))
1288 (defconst mm-image-type-regexps
1302 (defun mm-image-type-from-buffer ()
1306 (let ((types mm-image-type-regexps)
1317 (defun mm-get-image (handle)
1319 (let ((type (mm-handle-media-subtype handle))
1331 (or (mm-handle-cache handle)
1332 (mm-with-unibyte-buffer
1333 (mm-insert-part handle)
1341 (or (mm-image-type-from-buffer)
1344 (mm-create-image-xemacs type))))
1345 (mm-handle-set-cache handle spec))))))
1347 (defun mm-create-image-xemacs (type)
1355 (let ((file (mm-make-temp-file
1356 (expand-file-name "emm" mm-tmp-directory)
1367 (or (mm-image-type-from-buffer)
1371 (defun mm-image-fit-p (handle)
1373 (let ((image (mm-get-image handle)))
1377 (or mm-inline-large-images
1383 (or mm-inline-large-images
1387 (defun mm-valid-image-format-p (format)
1401 (defun mm-valid-and-fit-image-p (format handle)
1403 (and (mm-valid-image-format-p format)
1404 (mm-image-fit-p handle)))
1406 (defun mm-find-part-by-type (handles type &optional notp recursive)
1410 (let (handle)
1413 (if (setq handle (mm-find-part-by-type (cdar handles) type
1417 (not (equal (mm-handle-media-type (car handles)) type))
1418 (equal (mm-handle-media-type (car handles)) type))
1419 (setq handle (car handles)
1422 handle))
1424 (defun mm-find-raw-part-by-type (ctl type &optional notp)
1426 (let* ((boundary (concat "--" (mm-handle-multipart-ctl-parameter ctl
1464 (defvar mm-security-handle nil)
1466 (defsubst mm-set-handle-multipart-parameter (handle parameter value)
1468 (when handle
1469 (put-text-property 0 (length (car handle)) parameter value
1470 (car handle))))
1472 (defun mm-possibly-verify-or-decrypt (parts ctl)
1475 (mm-security-handle ctl) ;; (car CTL) is the type.
1482 ((eq mm-decrypt-option 'never) nil)
1483 ((eq mm-decrypt-option 'always) t)
1484 ((eq mm-decrypt-option 'known) t)
1487 (mm-view-pkcs7 parts))
1488 (setq parts (mm-dissect-buffer t)))))
1491 (mm-handle-multipart-ctl-parameter ctl 'protocol))
1492 (not (equal protocol "multipart/mixed")))
1494 (let ((protocols mm-verify-function-alist))
1498 (mm-find-part-by-type parts (caar protocols) nil t))
1502 (setq func (nth 1 (assoc protocol mm-verify-function-alist)))
1504 ((eq mm-verify-option 'never) nil)
1505 ((eq mm-verify-option 'always) t)
1506 ((eq mm-verify-option 'known)
1510 mm-verify-function-alist))))
1515 (or (nth 2 (assoc protocol mm-verify-function-alist))
1520 (mm-set-handle-multipart-parameter
1521 mm-security-handle 'gnus-details
1525 (mm-handle-multipart-ctl-parameter ctl 'protocol))
1529 (if (assoc (mm-handle-media-type (car parts))
1530 mm-decrypt-function-alist)
1531 (setq protocol (mm-handle-media-type (car parts))
1534 (setq func (nth 1 (assoc protocol mm-decrypt-function-alist)))
1536 ((eq mm-decrypt-option 'never) nil)
1537 ((eq mm-decrypt-option 'always) t)
1538 ((eq mm-decrypt-option 'known)
1542 mm-decrypt-function-alist))))
1547 (or (nth 2 (assoc protocol mm-decrypt-function-alist))
1552 (mm-set-handle-multipart-parameter
1553 mm-security-handle 'gnus-details
1558 (defun mm-multiple-handles (handles)
1564 (defun mm-complicated-handles (handles)
1568 (defun mm-merge-handles (handles1 handles2)
1577 (defun mm-readable-p (handle)
1579 (and (< (with-current-buffer (mm-handle-buffer handle)
1581 (mm-with-unibyte-buffer
1582 (mm-insert-part handle)
1583 (and (eq (mm-body-7-or-8) '7bit)
1584 (not (mm-long-lines-p 76))))))
1586 (provide 'mm-decode)
1589 ;;; mm-decode.el ends here