aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorKatsumi Yamaoka2014-05-14 08:50:51 +0000
committerKatsumi Yamaoka2014-05-14 08:50:51 +0000
commitc5aed7bd9330c2bde33abfe1724af820273b457a (patch)
tree72847b6d54a4de1b7c64e6f935522c3314f6c936
parentf0036ec2d210796144fb41381a0841130734e13a (diff)
downloademacs-c5aed7bd9330c2bde33abfe1724af820273b457a.tar.gz
emacs-c5aed7bd9330c2bde33abfe1724af820273b457a.zip
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.
-rw-r--r--lisp/gnus/ChangeLog9
-rw-r--r--lisp/gnus/gnus-art.el42
-rw-r--r--lisp/gnus/mm-uu.el32
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 @@
12014-05-14 Katsumi Yamaoka <yamaoka@jpl.org>
2
3 * gnus-art.el (gnus-mime-inline-part, gnus-mm-display-part):
4 Work for the last MIME part in an article.
5 (gnus-mime-display-single): Suppress excessive newlines between parts.
6
7 * mm-uu.el (mm-uu-dissect): Assume that separators may be accompanied
8 by leading or trailing newline.
9
12014-05-09 Katsumi Yamaoka <yamaoka@jpl.org> 102014-05-09 Katsumi Yamaoka <yamaoka@jpl.org>
2 11
3 * gnus-art.el (gnus-mm-display-part): Don't put article out of sight 12 * 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."
5316 (when (= b (prog1 5316 (when (= b (prog1
5317 btn 5317 btn
5318 (setq btn (previous-single-property-change 5318 (setq btn (previous-single-property-change
5319 (next-single-property-change btn 'gnus-data) 5319 (or (next-single-property-change btn 'gnus-data)
5320 (point-max))
5320 'gnus-data)))) 5321 'gnus-data))))
5321 (setq b btn)) 5322 (setq b btn))
5322 (if (and (not arg) (mm-handle-undisplayer handle)) 5323 (if (and (not arg) (mm-handle-undisplayer handle))
@@ -5353,12 +5354,14 @@ Compressed files like .gz and .bz2 are decompressed."
5353 (if (featurep 'emacs) 5354 (if (featurep 'emacs)
5354 (delete-region 5355 (delete-region
5355 (point) 5356 (point)
5356 (text-property-any (point) (point-max) 'gnus-data nil)) 5357 (or (text-property-any (point) (point-max) 'gnus-data nil)
5358 (point-max)))
5357 (let* ((end (text-property-any (point) (point-max) 'gnus-data nil)) 5359 (let* ((end (text-property-any (point) (point-max) 'gnus-data nil))
5358 (annots (annotations-at end))) 5360 (annots (annotations-at end)))
5359 (delete-region (point) 5361 (delete-region (point)
5360 ;; FIXME: why isn't this simply `end'? 5362 (if end
5361 (if annots (1+ end) end)) 5363 (if annots (1+ end) end)
5364 (point-max)))
5362 (dolist (annot annots) 5365 (dolist (annot annots)
5363 (set-extent-endpoints annot (point) (point))))) 5366 (set-extent-endpoints annot (point) (point)))))
5364 (unless (search-backward "\n\n" nil t) 5367 (unless (search-backward "\n\n" nil t)
@@ -5691,7 +5694,8 @@ all parts."
5691 (select-window win) 5694 (select-window win)
5692 (goto-char point))) 5695 (goto-char point)))
5693 (setq point (previous-single-property-change 5696 (setq point (previous-single-property-change
5694 (next-single-property-change point 'gnus-data) 5697 (or (next-single-property-change point 'gnus-data)
5698 (point-max))
5695 'gnus-data)) 5699 'gnus-data))
5696 (if (mm-handle-displayed-p handle) 5700 (if (mm-handle-displayed-p handle)
5697 ;; This will remove the part. 5701 ;; This will remove the part.
@@ -5728,12 +5732,15 @@ all parts."
5728 (gnus-insert-mime-button handle id (list (mm-handle-displayed-p handle))) 5732 (gnus-insert-mime-button handle id (list (mm-handle-displayed-p handle)))
5729 (if (featurep 'emacs) 5733 (if (featurep 'emacs)
5730 (delete-region 5734 (delete-region
5731 (point) (text-property-any (point) (point-max) 'gnus-data nil)) 5735 (point)
5736 (or (text-property-any (point) (point-max) 'gnus-data nil)
5737 (point-max)))
5732 (let* ((end (text-property-any (point) (point-max) 'gnus-data nil)) 5738 (let* ((end (text-property-any (point) (point-max) 'gnus-data nil))
5733 (annots (annotations-at end))) 5739 (annots (annotations-at end)))
5734 (delete-region (point) 5740 (delete-region (point)
5735 ;; FIXME: why isn't this simply `end'? 5741 (if end
5736 (if annots (1+ end) end)) 5742 (if annots (1+ end) end)
5743 (point-max)))
5737 (dolist (annot annots) 5744 (dolist (annot annots)
5738 (set-extent-endpoints annot (point) (point))))) 5745 (set-extent-endpoints annot (point) (point)))))
5739 (unless (search-backward "\n\n" nil t) 5746 (unless (search-backward "\n\n" nil t)
@@ -6036,9 +6043,6 @@ If nil, don't show those extra buttons."
6036 (eq id gnus-mime-buttonized-part-id)) 6043 (eq id gnus-mime-buttonized-part-id))
6037 (gnus-insert-mime-button 6044 (gnus-insert-mime-button
6038 handle id (list (or display (and not-attachment text))))) 6045 handle id (list (or display (and not-attachment text)))))
6039 (gnus-article-insert-newline)
6040 (when (or display (and text not-attachment))
6041 (forward-line -1))
6042 (setq beg (point)) 6046 (setq beg (point))
6043 (cond 6047 (cond
6044 (display 6048 (display
@@ -6048,12 +6052,18 @@ If nil, don't show those extra buttons."
6048 (set-buffer gnus-summary-buffer) 6052 (set-buffer gnus-summary-buffer)
6049 (error)) 6053 (error))
6050 gnus-newsgroup-ignored-charsets))) 6054 gnus-newsgroup-ignored-charsets)))
6051 (gnus-bind-safe-url-regexp (mm-display-part handle t))) 6055 (gnus-bind-safe-url-regexp (mm-display-part handle t))))
6052 (goto-char (point-max)))
6053 ((and text not-attachment) 6056 ((and text not-attachment)
6054 (gnus-article-insert-newline) 6057 (mm-display-inline handle)))
6055 (mm-display-inline handle) 6058 (goto-char (point-max))
6056 (goto-char (point-max)))) 6059 (if (string-match "\\`image/" type)
6060 (gnus-article-insert-newline)
6061 (if (prog1
6062 (= (skip-chars-backward "\n") -1)
6063 (forward-char 1))
6064 (gnus-article-insert-newline)
6065 (put-text-property (point) (point-max) 'gnus-undeletable t))
6066 (goto-char (point-max)))
6057 ;; Do highlighting. 6067 ;; Do highlighting.
6058 (save-excursion 6068 (save-excursion
6059 (save-restriction 6069 (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'."
673 (goto-char text-start) 673 (goto-char text-start)
674 (re-search-forward "." start-point t))) 674 (re-search-forward "." start-point t)))
675 (push 675 (push
676 (mm-make-handle (mm-uu-copy-to-buffer text-start start-point) 676 (mm-make-handle
677 mm-uu-text-plain-type) 677 (mm-uu-copy-to-buffer
678 text-start
679 ;; A start-separator is likely accompanied by
680 ;; a leading newline.
681 (if (and (eq (char-before start-point) ?\n)
682 (eq (char-before (1- start-point)) ?\n))
683 (1- start-point)
684 start-point))
685 mm-uu-text-plain-type)
678 result)) 686 result))
679 (push 687 (push
680 (funcall (mm-uu-function-extract entry)) 688 (funcall (mm-uu-function-extract entry))
681 result) 689 result)
682 (goto-char (setq text-start end-point)))) 690 (goto-char (setq text-start end-point))))
683 (when result 691 (when result
684 (if (and (> (point-max) (1+ text-start)) 692 (goto-char text-start)
685 (save-excursion 693 (when (re-search-forward "." nil t)
686 (goto-char text-start) 694 (push (mm-make-handle
687 (re-search-forward "." nil t))) 695 (mm-uu-copy-to-buffer
688 (push 696 ;; An end-separator is likely accompanied by
689 (mm-make-handle (mm-uu-copy-to-buffer text-start (point-max)) 697 ;; a trailing newline.
690 mm-uu-text-plain-type) 698 (if (eq (char-after text-start) ?\n)
691 result)) 699 (1+ text-start)
700 text-start)
701 (point-max))
702 mm-uu-text-plain-type)
703 result))
692 (setq result (cons "multipart/mixed" (nreverse result)))) 704 (setq result (cons "multipart/mixed" (nreverse result))))
693 result))) 705 result)))
694 706