`(nth 0 ,handle))
(defmacro mm-handle-type (handle)
`(nth 1 ,handle))
+(defsubst mm-handle-media-type (handle)
+ (if (stringp (car handle))
+ (car handle)
+ (car (mm-handle-type handle))))
+(defsubst mm-handle-media-supertype (handle)
+ (car (split-string (mm-handle-media-type handle) "/")))
+(defsubst mm-handle-media-subtype (handle)
+ (cadr (split-string (mm-handle-media-type handle) "/")))
(defmacro mm-handle-encoding (handle)
`(nth 2 ,handle))
(defmacro mm-handle-undisplayer (handle)
(mailcap-parse-mailcaps)
(if (mm-handle-displayed-p handle)
(mm-remove-part handle)
- (let* ((type (car (mm-handle-type handle)))
+ (let* ((type (mm-handle-media-type handle))
(method (mailcap-mime-info type)))
(if (mm-inlined-p handle)
(progn
(let ((mm (current-buffer))
(non-viewer (assoc "non-viewer"
(mailcap-mime-info
- (car (mm-handle-type handle)) t))))
+ (mm-handle-media-type handle) t))))
(unwind-protect
(if method
(funcall method)
(let* ((dir (make-temp-name (expand-file-name "emm." mm-tmp-directory)))
(filename (mail-content-type-get
(mm-handle-disposition handle) 'filename))
- (needsterm (assoc "needsterm"
- (mailcap-mime-info
- (car (mm-handle-type handle)) t)))
+ (mime-info (mailcap-mime-info
+ (mm-handle-media-type handle) t))
+ (needsterm (or (assoc "needsterm" mime-info)
+ (assoc "needsterminal" mime-info)))
process file buffer)
;; We create a private sub-directory where we store our files.
(make-directory dir)
(start-process "*display*" nil
"xterm"
"-e" shell-file-name "-c"
- (format method
- (mm-quote-arg file)))
+ (mm-mailcap-command
+ method file (mm-handle-type handle)))
(start-process "*display*"
(setq buffer (generate-new-buffer "*mm*"))
shell-file-name
- "-c" (format method
- (mm-quote-arg file)))))
+ "-c"
+ (mm-mailcap-command
+ method file (mm-handle-type handle)))))
(mm-handle-set-undisplayer handle (cons file buffer)))
(message "Displaying %s..." (format method file))))))
+(defun mm-mailcap-command (method file type-list)
+ (let ((ctl (cdr type-list))
+ (beg 0)
+ out sub total)
+ (while (string-match "%{\\([^}]+\\)}\\|%s\\|%t" method beg)
+ (push (substring method beg (match-beginning 0)) out)
+ (setq beg (match-end 0)
+ total (match-string 0 method)
+ sub (match-string 1 method))
+ (cond
+ ((string= total "%s")
+ (push (mm-quote-arg file) out))
+ ((string= total "%t")
+ (push (mm-quote-arg (car type-list)) out))
+ (t
+ (push (mm-quote-arg (or (cdr (assq (intern sub) ctl)) "")) out))))
+ (push (substring method beg (length method)) out)
+ (mapconcat 'identity (nreverse out) "")))
+
(defun mm-remove-parts (handles)
"Remove the displayed MIME parts represented by HANDLE."
(if (and (listp handles)
(mm-handle-set-undisplayer handle nil))))
(defun mm-display-inline (handle)
- (let* ((type (car (mm-handle-type handle)))
+ (let* ((type (mm-handle-media-type handle))
(function (cadr (assoc type mm-inline-media-tests))))
(funcall function handle)
(goto-char (point-min))))
(defun mm-inlinable-p (handle)
"Say whether HANDLE can be displayed inline."
(let ((alist mm-inline-media-tests)
- (type (car (mm-handle-type handle)))
+ (type (mm-handle-media-type handle))
test)
(while alist
(when (equal type (caar alist))
(defun mm-automatic-display-p (handle)
"Say whether the user wants HANDLE to be displayed automatically."
(let ((methods mm-automatic-display)
- (type (car (mm-handle-type handle)))
+ (type (mm-handle-media-type handle))
method result)
(while (setq method (pop methods))
(when (and (string-match method type)
(defun mm-inlined-p (handle)
"Say whether the user wants HANDLE to be displayed automatically."
(let ((methods mm-inlined-types)
- (type (car (mm-handle-type handle)))
+ (type (mm-handle-media-type handle))
method result)
(while (setq method (pop methods))
(when (and (string-match method type)
(defun mm-attachment-override-p (handle)
"Say whether HANDLE should have attachment behavior overridden."
(let ((types mm-attachment-override-types)
- (type (car (mm-handle-type handle)))
+ (type (mm-handle-media-type handle))
ty)
(catch 'found
(while (setq ty (pop types))
"Insert the contents of HANDLE in the current buffer."
(let ((cur (current-buffer)))
(save-excursion
- (if (member (car (split-string (car (mm-handle-type handle)) "/"))
- '("text" "message"))
+ (if (member (mm-handle-media-supertype handle) '("text" "message"))
(with-temp-buffer
(insert-buffer-substring (mm-handle-buffer handle))
(mm-decode-content-transfer-encoding
(mm-handle-encoding handle)
- (car (mm-handle-type handle)))
+ (mm-handle-media-type handle))
(let ((temp (current-buffer)))
(set-buffer cur)
(insert-buffer-substring temp)))
(insert-buffer-substring (mm-handle-buffer handle))
(mm-decode-content-transfer-encoding
(mm-handle-encoding handle)
- (car (mm-handle-type handle)))
+ (mm-handle-media-type handle))
(let ((temp (current-buffer)))
(set-buffer cur)
(insert-buffer-substring temp)))))))
;; Now every coding system is 100% binary within mm-with-unibyte-buffer
;; Is text still special?
(let ((coding-system-for-write
- (if (equal "text" (car (split-string
- (car (mm-handle-type handle)) "/")))
+ (if (equal "text" (mm-handle-media-supertype handle))
buffer-file-coding-system
'binary))
;; Don't re-compress .gz & al. Arguably we should make
;; ange-ftp which it's reasonable to use here.
(inhibit-file-name-operation 'write-region)
(inhibit-file-name-handlers
- (if (equal (car (mm-handle-type handle))
+ (if (equal (mm-handle-media-type handle)
"application/octet-stream")
(cons 'jka-compr-handler inhibit-file-name-handlers)
inhibit-file-name-handlers)))
(defun mm-interactively-view-part (handle)
"Display HANDLE using METHOD."
- (let* ((type (car (mm-handle-type handle)))
+ (let* ((type (mm-handle-media-type handle))
(methods
(mapcar (lambda (i) (list (cdr (assoc 'viewer i))))
(mailcap-mime-info type 'all)))
(while (setq p (pop prec))
(setq h handles)
(while h
- (setq type
- (if (stringp (caar h))
- (caar h)
- (car (mm-handle-type (car h)))))
(setq handle (car h))
+ (setq type (mm-handle-media-type handle))
(when (and (equal p type)
- (mm-automatic-display-p (car h))
- (or (stringp (caar h))
- (not (mm-handle-disposition (car h)))
- (equal (car (mm-handle-disposition (car h)))
+ (mm-automatic-display-p handle)
+ (or (stringp (car handle))
+ (not (mm-handle-disposition handle))
+ (equal (car (mm-handle-disposition handle))
"inline")))
- (setq result (car h)
+ (setq result handle
h nil
prec nil))
(pop h)))
(defun mm-preferred-alternative-precedence (handles)
"Return the precedence based on HANDLES and mm-discouraged-alternatives."
(let ((seq (nreverse (mapcar (lambda (h)
- (car (mm-handle-type h))) handles))))
+ (mm-handle-media-type h))
+ handles))))
(dolist (disc (reverse mm-discouraged-alternatives))
(dolist (elem (copy-sequence seq))
(when (string-match disc elem)
(defun mm-get-image (handle)
"Return an image instance based on HANDLE."
- (let ((type (cadr (split-string (car (mm-handle-type handle)) "/")))
+ (let ((type (mm-handle-media-subtype handle))
spec)
;; Allow some common translations.
(setq type
projects / elisp / gnus.git- / blobdiff