From c5aed7bd9330c2bde33abfe1724af820273b457a Mon Sep 17 00:00:00 2001 From: Katsumi Yamaoka Date: Wed, 14 May 2014 08:50:51 +0000 Subject: [PATCH] gnus-art.el, mm-uu.el: Misc improvements for displaying MIME parts * gnus-art.el (gnus-mime-inline-part, gnus-mm-display-part): Work for the last MIME part in an article. (gnus-mime-display-single): Suppress excessive newlines between parts. * mm-uu.el (mm-uu-dissect): Assume that separators may be accompanied by leading or trailing newline. --- lisp/gnus/ChangeLog | 9 +++++++++ lisp/gnus/gnus-art.el | 42 ++++++++++++++++++++++++++---------------- lisp/gnus/mm-uu.el | 32 ++++++++++++++++++++++---------- 3 files changed, 57 insertions(+), 26 deletions(-) diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog index dad0444fcb2..275aa91eaeb 100644 --- a/lisp/gnus/ChangeLog +++ b/lisp/gnus/ChangeLog @@ -1,3 +1,12 @@ +2014-05-14 Katsumi Yamaoka + + * gnus-art.el (gnus-mime-inline-part, gnus-mm-display-part): + Work for the last MIME part in an article. + (gnus-mime-display-single): Suppress excessive newlines between parts. + + * mm-uu.el (mm-uu-dissect): Assume that separators may be accompanied + by leading or trailing newline. + 2014-05-09 Katsumi Yamaoka * gnus-art.el (gnus-mm-display-part): Don't put article out of sight diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el index a05507ead37..ccf7984c595 100644 --- a/lisp/gnus/gnus-art.el +++ b/lisp/gnus/gnus-art.el @@ -5316,7 +5316,8 @@ Compressed files like .gz and .bz2 are decompressed." (when (= b (prog1 btn (setq btn (previous-single-property-change - (next-single-property-change btn 'gnus-data) + (or (next-single-property-change btn 'gnus-data) + (point-max)) 'gnus-data)))) (setq b btn)) (if (and (not arg) (mm-handle-undisplayer handle)) @@ -5353,12 +5354,14 @@ Compressed files like .gz and .bz2 are decompressed." (if (featurep 'emacs) (delete-region (point) - (text-property-any (point) (point-max) 'gnus-data nil)) + (or (text-property-any (point) (point-max) 'gnus-data nil) + (point-max))) (let* ((end (text-property-any (point) (point-max) 'gnus-data nil)) (annots (annotations-at end))) (delete-region (point) - ;; FIXME: why isn't this simply `end'? - (if annots (1+ end) end)) + (if end + (if annots (1+ end) end) + (point-max))) (dolist (annot annots) (set-extent-endpoints annot (point) (point))))) (unless (search-backward "\n\n" nil t) @@ -5691,7 +5694,8 @@ all parts." (select-window win) (goto-char point))) (setq point (previous-single-property-change - (next-single-property-change point 'gnus-data) + (or (next-single-property-change point 'gnus-data) + (point-max)) 'gnus-data)) (if (mm-handle-displayed-p handle) ;; This will remove the part. @@ -5728,12 +5732,15 @@ all parts." (gnus-insert-mime-button handle id (list (mm-handle-displayed-p handle))) (if (featurep 'emacs) (delete-region - (point) (text-property-any (point) (point-max) 'gnus-data nil)) + (point) + (or (text-property-any (point) (point-max) 'gnus-data nil) + (point-max))) (let* ((end (text-property-any (point) (point-max) 'gnus-data nil)) (annots (annotations-at end))) (delete-region (point) - ;; FIXME: why isn't this simply `end'? - (if annots (1+ end) end)) + (if end + (if annots (1+ end) end) + (point-max))) (dolist (annot annots) (set-extent-endpoints annot (point) (point))))) (unless (search-backward "\n\n" nil t) @@ -6036,9 +6043,6 @@ If nil, don't show those extra buttons." (eq id gnus-mime-buttonized-part-id)) (gnus-insert-mime-button handle id (list (or display (and not-attachment text))))) - (gnus-article-insert-newline) - (when (or display (and text not-attachment)) - (forward-line -1)) (setq beg (point)) (cond (display @@ -6048,12 +6052,18 @@ If nil, don't show those extra buttons." (set-buffer gnus-summary-buffer) (error)) gnus-newsgroup-ignored-charsets))) - (gnus-bind-safe-url-regexp (mm-display-part handle t))) - (goto-char (point-max))) + (gnus-bind-safe-url-regexp (mm-display-part handle t)))) ((and text not-attachment) - (gnus-article-insert-newline) - (mm-display-inline handle) - (goto-char (point-max)))) + (mm-display-inline handle))) + (goto-char (point-max)) + (if (string-match "\\`image/" type) + (gnus-article-insert-newline) + (if (prog1 + (= (skip-chars-backward "\n") -1) + (forward-char 1)) + (gnus-article-insert-newline) + (put-text-property (point) (point-max) 'gnus-undeletable t)) + (goto-char (point-max))) ;; Do highlighting. (save-excursion (save-restriction diff --git a/lisp/gnus/mm-uu.el b/lisp/gnus/mm-uu.el index 423324a86f4..d91d2a41c8f 100644 --- a/lisp/gnus/mm-uu.el +++ b/lisp/gnus/mm-uu.el @@ -673,22 +673,34 @@ value of `mm-uu-text-plain-type'." (goto-char text-start) (re-search-forward "." start-point t))) (push - (mm-make-handle (mm-uu-copy-to-buffer text-start start-point) - mm-uu-text-plain-type) + (mm-make-handle + (mm-uu-copy-to-buffer + text-start + ;; A start-separator is likely accompanied by + ;; a leading newline. + (if (and (eq (char-before start-point) ?\n) + (eq (char-before (1- start-point)) ?\n)) + (1- start-point) + start-point)) + mm-uu-text-plain-type) result)) (push (funcall (mm-uu-function-extract entry)) result) (goto-char (setq text-start end-point)))) (when result - (if (and (> (point-max) (1+ text-start)) - (save-excursion - (goto-char text-start) - (re-search-forward "." nil t))) - (push - (mm-make-handle (mm-uu-copy-to-buffer text-start (point-max)) - mm-uu-text-plain-type) - result)) + (goto-char text-start) + (when (re-search-forward "." nil t) + (push (mm-make-handle + (mm-uu-copy-to-buffer + ;; An end-separator is likely accompanied by + ;; a trailing newline. + (if (eq (char-after text-start) ?\n) + (1+ text-start) + text-start) + (point-max)) + mm-uu-text-plain-type) + result)) (setq result (cons "multipart/mixed" (nreverse result)))) result))) -- 2.39.5