diff options
| author | Katsumi Yamaoka | 2014-05-14 08:50:51 +0000 |
|---|---|---|
| committer | Katsumi Yamaoka | 2014-05-14 08:50:51 +0000 |
| commit | c5aed7bd9330c2bde33abfe1724af820273b457a (patch) | |
| tree | 72847b6d54a4de1b7c64e6f935522c3314f6c936 | |
| parent | f0036ec2d210796144fb41381a0841130734e13a (diff) | |
| download | emacs-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/ChangeLog | 9 | ||||
| -rw-r--r-- | lisp/gnus/gnus-art.el | 42 | ||||
| -rw-r--r-- | 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 @@ | |||
| 1 | 2014-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 | |||
| 1 | 2014-05-09 Katsumi Yamaoka <yamaoka@jpl.org> | 10 | 2014-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 | ||