From: Julien Danjou Date: Tue, 22 Mar 2011 13:40:41 +0000 (+0000) Subject: mm-view.el (mm-display-inline-fontify): Make mode optional, and call normal-mode... X-Git-Tag: emacs-pretest-24.0.90~104^2~275^2~519 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=247c22e185554cfa49736f2e587539d6a92732ed;p=emacs.git mm-view.el (mm-display-inline-fontify): Make mode optional, and call normal-mode if not set. Set temp buffer unmodified to avoid kill-buffer query. (mm-inline-text): Render normal text with fontification whenever possible. gnus-sum.el (gnus-summary-save-parts-1): gnus-art.el (gnus-article-browse-html-save-cid-content) (gnus-article-browse-html-parts, gnus-mime-delete-part) (gnus-mime-copy-part, gnus-mime-inline-part, gnus-insert-mime-button): Use `mm-handle-filename'. mm-util.el (mm-handle-filename): New function, return the filename of an handle. --- diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog index 7eca03bd93b..d728d1957b1 100644 --- a/lisp/gnus/ChangeLog +++ b/lisp/gnus/ChangeLog @@ -1,3 +1,20 @@ +2011-03-21 Julien Danjou + + * mm-view.el (mm-display-inline-fontify): Make mode optional, and call + normal-mode if not set. Set temp buffer unmodified to avoid kill-buffer + query. + (mm-inline-text): Render normal text with fontification whenever + possible. + + * gnus-sum.el (gnus-summary-save-parts-1): + * gnus-art.el (gnus-article-browse-html-save-cid-content) + (gnus-article-browse-html-parts, gnus-mime-delete-part) + (gnus-mime-copy-part, gnus-mime-inline-part, gnus-insert-mime-button): + Use `mm-handle-filename'. + + * mm-util.el (mm-handle-filename): New function, return the filename of + an handle. + 2011-03-18 Julien Danjou * gnus-util.el (gnus-buffer-live-p): Simplify gnus-buffer-live-p. diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el index 7c7e0531926..97677988f0a 100644 --- a/lisp/gnus/gnus-art.el +++ b/lisp/gnus/gnus-art.el @@ -2811,14 +2811,11 @@ Return file name." ((equal (concat "<" cid ">") (mm-handle-id handle)) (setq file (expand-file-name - (or (mail-content-type-get - (mm-handle-disposition handle) 'filename) - (mail-content-type-get - (setq type (mm-handle-type handle)) 'name) - (concat - (make-temp-name "cid") - (car (rassoc (car type) mailcap-mime-extensions)))) - directory)) + (or (mm-handle-filename handle) + (concat + (make-temp-name "cid") + (car (rassoc (car (mm-handle-type handle)) mailcap-mime-extensions)))) + directory)) (mm-save-part-to-file handle file) (throw 'found file)))))))) @@ -2835,10 +2832,7 @@ message header will be added to the bodies of the \"text/html\" parts." ((or (equal (car (setq type (mm-handle-type handle))) "text/html") (and (equal (car type) "message/external-body") (or header - (setq file (or (mail-content-type-get type 'name) - (mail-content-type-get - (mm-handle-disposition handle) - 'filename)))) + (setq file (mm-handle-filename handle))) (or (mm-handle-cache handle) (condition-case code (progn (mm-extern-cache-contents handle) t) @@ -5043,14 +5037,11 @@ Deleting parts may malfunction or destroy the article; continue? ")) (let* ((data (get-text-property (point) 'gnus-data)) (id (get-text-property (point) 'gnus-part)) (handles gnus-article-mime-handles) - (none "(none)") (description (let ((desc (mm-handle-description data))) (when desc (mail-decode-encoded-word-string desc)))) - (filename - (or (mail-content-type-get (mm-handle-disposition data) 'filename) - none)) + (filename (or (mm-handle-filename (mm-handle-disposition data)) "(none)")) (type (mm-handle-media-type data))) (unless data (error "No MIME part under point")) @@ -5168,10 +5159,7 @@ are decompressed." (unless handle (setq handle (get-text-property (point) 'gnus-data))) (when handle - (let ((filename (or (mail-content-type-get (mm-handle-type handle) - 'name) - (mail-content-type-get (mm-handle-disposition handle) - 'filename))) + (let ((filename (mm-handle-filename handle)) contents dont-decode charset coding-system) (mm-with-unibyte-buffer (mm-insert-part handle) @@ -5261,12 +5249,7 @@ Compressed files like .gz and .bz2 are decompressed." (mm-with-unibyte-buffer (mm-insert-part handle) (setq contents - (or (mm-decompress-buffer - (or (mail-content-type-get (mm-handle-type handle) - 'name) - (mail-content-type-get (mm-handle-disposition handle) - 'filename)) - nil t) + (or (mm-decompress-buffer (mm-handle-filename handle) nil t) (buffer-string)))) (cond ((not arg) @@ -5671,8 +5654,7 @@ all parts." (defun gnus-insert-mime-button (handle gnus-tmp-id &optional displayed) (let ((gnus-tmp-name - (or (mail-content-type-get (mm-handle-type handle) 'name) - (mail-content-type-get (mm-handle-disposition handle) 'filename) + (or (mm-handle-filename handle) (mail-content-type-get (mm-handle-type handle) 'url) "")) (gnus-tmp-type (mm-handle-media-type handle)) diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el index 29a98b7d11d..9b22bbe39da 100644 --- a/lisp/gnus/gnus-sum.el +++ b/lisp/gnus/gnus-sum.el @@ -12142,10 +12142,7 @@ If REVERSE, save parts that do not match TYPE." mm-file-name-rewrite-functions (file-name-nondirectory (or - (mail-content-type-get - (mm-handle-disposition handle) 'filename) - (mail-content-type-get - (mm-handle-type handle) 'name) + (mm-handle-filename handle) (format "%s.%d.%d" gnus-newsgroup-name (cdr gnus-article-current) gnus-summary-save-parts-counter)))) diff --git a/lisp/gnus/mm-util.el b/lisp/gnus/mm-util.el index 435c3bba00f..d53784e8cc4 100644 --- a/lisp/gnus/mm-util.el +++ b/lisp/gnus/mm-util.el @@ -1667,6 +1667,13 @@ gzip, bzip2, etc. are allowed." (when decomp (kill-buffer (current-buffer))))))) +(defun mm-handle-filename (handle) + "Return filename of HANDLE if any." + (or (mail-content-type-get (mm-handle-type handle) + 'name) + (mail-content-type-get (mm-handle-disposition handle) + 'filename))) + (provide 'mm-util) ;;; mm-util.el ends here diff --git a/lisp/gnus/mm-view.el b/lisp/gnus/mm-view.el index d63d20239dc..39d49af0600 100644 --- a/lisp/gnus/mm-view.el +++ b/lisp/gnus/mm-view.el @@ -455,7 +455,7 @@ (narrow-to-region (point) (point)) (mm-insert-part handle) (goto-char (point-max))) - (insert (mm-decode-string (mm-get-part handle) charset))) + (mm-display-inline-fontify handle)) (when (and mm-fill-flowed (equal type "plain") (equal (cdr (assoc 'format (mm-handle-type handle))) @@ -565,15 +565,16 @@ (face-property 'default prop) (current-buffer)))) (delete-region ,(point-min-marker) ,(point-max-marker))))))))) -(defun mm-display-inline-fontify (handle mode) +(defun mm-display-inline-fontify (handle &optional mode) + "Insert HANDLE inline fontifying with MODE. +If MODE is not set, try to find mode automatically." (let ((charset (mail-content-type-get (mm-handle-type handle) 'charset)) text coding-system) (unless (eq charset 'gnus-decoded) (mm-with-unibyte-buffer (mm-insert-part handle) (mm-decompress-buffer - (or (mail-content-type-get (mm-handle-disposition handle) 'name) - (mail-content-type-get (mm-handle-disposition handle) 'filename)) + (mm-handle-filename handle) t t) (unless charset (setq coding-system (mm-find-buffer-file-coding-system))) @@ -601,7 +602,10 @@ (font-lock-support-mode nil) ;; I find font-lock a bit too verbose. (font-lock-verbose nil)) - (funcall mode) + (setq buffer-file-name (mm-handle-filename handle)) + (if mode + (funcall mode) + (normal-mode)) ;; The mode function might have already turned on font-lock. (unless (symbol-value 'font-lock-mode) (font-lock-fontify-buffer))) @@ -614,6 +618,9 @@ nil) nil nil nil nil nil 'text-prop)) (setq text (buffer-string)) + ;; Set buffer unmodified to avoid confirmation when killing the + ;; buffer. + (set-buffer-modified-p nil) (kill-buffer (current-buffer))) (mm-insert-inline handle text)))