:group 'mime-view
:type '(repeat file))
+(defvar mime-view-automatic-conversion 'undecided)
+
;;; @ in raw-buffer (representation space)
;;;
(cons original-major-mode-cell default-situation)))
(mime-display-entity start nil default-situation)))
+(defun mime-view-entity-content (entity situation)
+ (mime-decode-string
+ (mime-entity-body entity)
+ (mime-view-guess-encoding entity situation)))
+
(defun mime-view-insert-text-content (entity situation)
- (insert
- (decode-mime-charset-string
- (mime-decode-string
- (mime-entity-body entity)
- (mime-view-default-content-transfer-encoding entity situation))
- (mime-view-default-charset entity situation)
- 'CRLF)))
+ (let (compression-info)
+ (cond
+ ((and (mime-entity-filename entity)
+ (featurep 'jka-compr)
+ (jka-compr-installed-p)
+ (setq compression-info (jka-compr-get-compression-info
+ (mime-entity-filename entity))))
+ (insert
+ (mime-view-filter-text-content
+ (mime-view-entity-content entity situation)
+ (jka-compr-info-uncompress-program compression-info)
+ (jka-compr-info-uncompress-args compression-info))))
+ ((or (assq '*encoding situation) ;should be specified by user
+ (assq '*charset situation)) ;should be specified by user
+ (insert
+ (decode-mime-charset-string
+ (mime-view-entity-content entity situation)
+ (mime-view-guess-charset entity situation)
+ 'CRLF)))
+ (t
+ (mime-insert-text-content entity)))))
+
+;;; stolen (and renamed) from `mime-display-gzipped' of EMY 1.13.
+(defun mime-view-filter-text-content (content program args)
+ (with-temp-buffer
+ (static-cond
+ ((featurep 'xemacs)
+ (insert content)
+ (apply #'binary-to-text-funcall
+ mime-view-automatic-conversion
+ #'call-process-region (point-min)(point-max)
+ program t t args))
+ (t
+ (if (not (multibyte-string-p content))
+ (set-buffer-multibyte nil))
+ (insert content)
+ (apply #'binary-funcall
+ #'call-process-region (point-min)(point-max)
+ program t t args)
+ (set-buffer-multibyte t)
+ (decode-coding-region (point-min)(point-max)
+ mime-view-automatic-conversion)))
+ (buffer-string)))
;;; stolen (and renamed) from mm-view.el.
(defun mime-view-insert-fontified-text-content (entity situation
;; on for buffers whose name begins with " ". That's why we use
;; save-current-buffer/get-buffer-create rather than
;; with-temp-buffer.
- (let ((buffer (get-buffer-create "*fontification*"))
+ (let ((buffer (generate-new-buffer "*fontification*"))
filename)
- (save-current-buffer
- (set-buffer buffer)
- (buffer-disable-undo)
- (kill-all-local-variables)
- (erase-buffer)
- (mime-view-insert-text-content entity situation)
- (unwind-protect
- (progn
+ (unwind-protect
+ (progn
+ (save-current-buffer
+ (set-buffer buffer)
+ (buffer-disable-undo)
+ (kill-all-local-variables)
+ (mime-view-insert-text-content entity situation)
(if mode
(funcall mode)
(if (setq filename (mime-entity-filename entity))
- (set-visited-file-name filename))
- (set-auto-mode))
+ (unwind-protect
+ (progn
+ (setq buffer-file-name filename)
+ (set-auto-mode))
+ (setq buffer-file-name nil))))
+ (require 'font-lock)
(let ((font-lock-verbose nil))
;; I find font-lock a bit too verbose.
(font-lock-fontify-buffer))
(set-extent-property ext 'duplicable t)
nil)
nil nil nil nil nil 'text-prop)))
- (set-visited-file-name nil)))
- (insert-buffer-substring buffer)))
+ (insert-buffer-substring buffer))
+ (kill-buffer buffer))))
(defun mime-display-application/emacs-lisp (entity situation)
(save-restriction
(when (boundp 'widget-keymap)
(set-keymap-parent (current-local-map) widget-keymap)))
-(add-hook 'mime-view-define-keymap-hook 'mime-view-maybe-inherit-widget-keymap)
+(add-hook 'mime-view-mode-hook 'mime-view-maybe-inherit-widget-keymap)
(defun mime-view-define-keymap (&optional default)
(let ((mime-view-mode-map (if (keymapp default)
;;; @@ utility
;;;
-(defun mime-preview-find-boundary-info (&optional get-mother)
+(defun mime-preview-find-boundary-info (&optional with-children)
+ "Return boundary information of current part.
+If WITH-CHILDREN, refer boundary surrounding current part and its branches."
(let (entity
p-beg p-end
entity-node-id len)
(setq p-end (point-max)))
((null entity-node-id)
(setq p-end (point-max)))
- (get-mother
+ (with-children
(save-excursion
- (goto-char p-end)
(catch 'tag
(let (e i)
(while (setq e
(point) 'mime-view-entity))
(goto-char e)
(let ((rc (mime-entity-node-id
- (get-text-property (1- (point))
+ (get-text-property (point)
'mime-view-entity))))
(or (and (>= (setq i (- (length rc) len)) 0)
(equal entity-node-id (nthcdr i rc)))
(throw 'tag nil)))
- (setq p-end e)))
+ (setq p-end (or (next-single-property-change
+ (point) 'mime-view-entity)
+ (point-max)))))
(setq p-end (point-max))))))
(vector p-beg p-end entity)))
;;; @@ display
;;;
-(defun mime-view-default-content-transfer-encoding (entity situation)
+(defun mime-view-guess-encoding (entity situation)
(or (cdr (assq '*encoding situation))
(cdr (assq 'encoding situation))
(mime-entity-encoding entity)
"7bit"))
-(defun mime-view-read-content-transfer-encoding (entity situation)
+(defun mime-view-read-encoding (entity situation)
(let* ((default-encoding
- (mime-view-default-content-transfer-encoding entity situation))
+ (mime-view-guess-encoding entity situation))
(encoding
(completing-read
"Content Transfer Encoding: "
(string= encoding default-encoding))
encoding)))
-(defun mime-view-default-charset (entity situation)
- (or (cdr (assq '*charset situation))
- (cdr (assq 'charset situation))
- (static-if (fboundp 'coding-system-to-mime-charset)
- ;; might be specified by `universal-coding-system-argument'.
+(defun mime-view-guess-charset (entity situation)
+ (or (static-if (fboundp 'coding-system-to-mime-charset)
+ ;; might be overridden by `universal-coding-system-argument'.
(and coding-system-for-read
(coding-system-to-mime-charset coding-system-for-read)))
- (let ((charset-param
- (mime-content-type-parameter
- (mime-entity-content-type entity)
- "charset")))
- (if charset-param
- (intern (downcase charset-param))))
+ (cdr (assq '*charset situation))
+ (cdr (assq 'charset situation))
+ (let ((charset (cdr (assoc "charset" (mime-entity-parameters entity)))))
+ (if charset
+ (intern (downcase charset))))
default-mime-charset))
(defun mime-view-read-charset (entity situation)
(static-if (featurep 'mule)
(let* ((default-charset
- (mime-view-default-charset entity situation))
+ (mime-view-guess-charset entity situation))
(charset
(intern (completing-read "MIME-charset: "
(mapcar
situation))
(when (and current-prefix-arg
(eq (cdr (assq sym situation)) 'visible))
- (if (setq encoding (mime-view-read-content-transfer-encoding
- entity situation))
+ (if (setq encoding (mime-view-read-encoding entity situation))
(setq situation (put-alist '*encoding encoding situation)))
(if (setq charset (mime-view-read-charset entity situation))
(setq situation (put-alist '*charset charset situation))))
projects / elisp / semi.git / blobdiff