[gnus git] branch master updated: m0-11-2-g966e530 =1= Make gnus-mime-inline-part and gnus-mime-inline-part work similarly

Katsumi Yamaoka <[email protected]> Fri, 02 May 2014 11:44:28 +0200
Newsgroups gmane.emacs.gnus.cvs
Message-ID <[email protected]>
       via  966e53075079eae155c2a90ca1488f6983c902ed (commit)
      from  eff06b38110691c7c2828d250ae5dc6f8e44dd13 (commit)


- Log -----------------------------------------------------------------
commit 966e53075079eae155c2a90ca1488f6983c902ed
Author: Katsumi Yamaoka <[email protected]>
Date:   Fri May 2 09:44:11 2014 +0000

    Make gnus-mime-inline-part and gnus-mime-inline-part work similarly
    
    * gnus-art.el (gnus-mime-inline-part): Redisplay a button so as to show
    the displaying state of a part.
    (gnus-mime-inline-part): Don't insert a newline in the beginning of
    a part like gnus-mime-inline-part doesn't; work for XEmacs.
    
    * mm-decode.el (mm-display-part): Don't insert a newline in the top.
    (mm-shr): Make undisplayer unbreakable.
    
    * mm-view.el (mm-inline-image-emacs, mm-inline-image-xemacs): Don't
    insert excessive newline.
    (mm-inline-text-html-render-with-w3m, mm-inline-text)
    (mm-insert-inline): Make undisplayer unbreakable.

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 863bb5d..aa0e5eb 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,18 @@
+2014-05-02  Katsumi Yamaoka  <[email protected]>
+
+	* gnus-art.el (gnus-mime-inline-part): Redisplay a button so as to show
+	the displaying state of a part.
+	(gnus-mime-inline-part): Don't insert a newline in the beginning of
+	a part like gnus-mime-inline-part doesn't; work for XEmacs.
+
+	* mm-decode.el (mm-display-part): Don't insert a newline in the top.
+	(mm-shr): Make undisplayer unbreakable.
+
+	* mm-view.el (mm-inline-image-emacs, mm-inline-image-xemacs): Don't
+	insert excessive newline.
+	(mm-inline-text-html-render-with-w3m, mm-inline-text)
+	(mm-insert-inline): Make undisplayer unbreakable.
+
 2014-05-01  Lars Magne Ingebrigtsen  <[email protected]>
 
 	* gnus.el: Ma Gnus v0.11 is released.
@@ -10,7 +25,7 @@
 2014-04-30  Katsumi Yamaoka  <[email protected]>
 
 	* gnus-art.el (gnus-mm-display-part): Don't move point while toggling
-	a part; redisplay a button (enbugged in 2014-03-23).
+	a part; redisplay a button (enbugged in 2014-02-05).
 
 2014-04-27  Teodor Zlatanov  <[email protected]>
 
diff --git a/lisp/gnus-art.el b/lisp/gnus-art.el
index 94c414c..8287815 100644
--- a/lisp/gnus-art.el
+++ b/lisp/gnus-art.el
@@ -5301,12 +5301,25 @@ are decompressed."
 Compressed files like .gz and .bz2 are decompressed."
   (interactive (list nil current-prefix-arg))
   (gnus-article-check-buffer)
-  (unless handle
-    (setq handle (get-text-property (point) 'gnus-data)))
-  (when handle
-    (let ((b (point))
-	  (inhibit-read-only t)
+  (let* ((inhibit-read-only t)
+	 (b (point))
+	 (btn ;; position where the MIME button exists
+	  (if handle
+	      (if (eq handle (get-text-property b 'gnus-data))
+		  b
+		(article-goto-body)
+		(or (text-property-any (point) (point-max) 'gnus-data handle)
+		    (text-property-any (point-min) (point) 'gnus-data handle)))
+	    (setq handle (get-text-property b 'gnus-data))
+	    b))
 	 contents charset coding-system)
+    (when handle
+      (when (= b (prog1
+		     btn
+		   (setq btn (previous-single-property-change
+			      (next-single-property-change btn 'gnus-data)
+			      'gnus-data))))
+	(setq b btn))
       (if (and (not arg) (mm-handle-undisplayer handle))
 	  (mm-remove-part handle)
 	(mm-with-unibyte-buffer
@@ -5333,8 +5346,35 @@ Compressed files like .gz and .bz2 are decompressed."
 	 ((mm-handle-undisplayer handle)
 	  (mm-remove-part handle)))
 	(forward-line 1)
-        (mm-display-inline handle)
-	(goto-char b)))))
+	(mm-display-inline handle))
+      ;; Toggle the button appearance between `[button]...' and `[button]'.
+      (goto-char btn)
+      (gnus-insert-mime-button handle (get-text-property btn 'gnus-part)
+			       (list (mm-handle-displayed-p handle)))
+      (if (featurep 'emacs)
+	  (delete-region
+	   (point)
+	   (text-property-any (point) (point-max) 'gnus-data nil))
+	(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))
+	  (dolist (annot annots)
+	    (set-extent-endpoints annot (point) (point)))))
+      (unless (search-backward "\n\n" nil t)
+	;; We're in the article header.
+	(delete-char -1)
+	(dolist (ovl (gnus-overlays-in btn (point)))
+	  (gnus-overlay-put ovl 'gnus-button-attachment-extra t)
+	  (gnus-overlay-put ovl 'face nil))
+	(save-restriction
+	  (message-narrow-to-field)
+	  (let ((gnus-treatment-function-alist
+		 '((gnus-treat-highlight-headers
+		    gnus-article-highlight-headers))))
+	    (gnus-treat-article 'head))))
+      (goto-char b))))
 
 (defun gnus-mime-set-charset-parameters (handle charset)
   "Set CHARSET to parameters in HANDLE.
@@ -5651,6 +5691,9 @@ all parts."
 	    (when win
 	      (select-window win)
 	      (goto-char point)))
+	  (setq point (previous-single-property-change
+		       (next-single-property-change point 'gnus-data)
+		       'gnus-data))
 	  (forward-line)
 	  (if (mm-handle-displayed-p handle)
 	      ;; This will remove the part.
@@ -5674,19 +5717,21 @@ all parts."
 		 (mm-handle-media-type handle))))))
       (goto-char point)
       ;; Toggle the button appearance between `[button]...' and `[button]'.
-      (let ((end (next-single-property-change point 'gnus-data))
-	    start)
+      (gnus-insert-mime-button handle id (list (mm-handle-displayed-p handle)))
+      (if (featurep 'emacs)
 	  (delete-region
-	 (setq start (previous-single-property-change end 'gnus-data))
-	 end)
-	(gnus-insert-mime-button
-	 handle id (list (mm-handle-displayed-p handle)))
-	(setq end (point))
-	(if (search-backward "\n\n" nil t)
-	    (goto-char end)
+	   (point) (text-property-any (point) (point-max) 'gnus-data nil))
+	(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))
+	  (dolist (annot annots)
+	    (set-extent-endpoints annot (point) (point)))))
+      (unless (search-backward "\n\n" nil t)
 	;; We're in the article header.
 	(delete-char -1)
-	  (dolist (ovl (gnus-overlays-in start (1- end)))
+	(dolist (ovl (gnus-overlays-in point (point)))
 	  (gnus-overlay-put ovl 'gnus-button-attachment-extra t)
 	  (gnus-overlay-put ovl 'face nil))
 	(save-restriction
@@ -5694,7 +5739,7 @@ all parts."
 	  (let ((gnus-treatment-function-alist
 		 '((gnus-treat-highlight-headers
 		    gnus-article-highlight-headers))))
-	      (gnus-treat-article 'head)))))
+	    (gnus-treat-article 'head))))
       (goto-char point)
       (if (window-live-p window)
 	  (select-window window)))
diff --git a/lisp/mm-decode.el b/lisp/mm-decode.el
index a99e7a4..cde0af0 100644
--- a/lisp/mm-decode.el
+++ b/lisp/mm-decode.el
@@ -821,7 +821,6 @@ external if displayed external."
 	  'inline)
 	 ((and (mm-inlinable-p ehandle)
 	       (mm-inlined-p ehandle))
-	  (forward-line 1)
 	  (mm-display-inline handle)
 	  'inline)
 	 ((or method
@@ -1868,7 +1867,7 @@ If RECURSIVE, search recursively."
        handle
        `(lambda ()
 	  (let ((inhibit-read-only t))
-	    (delete-region ,(point-min-marker)
+	    (delete-region ,(copy-marker (point-min) t)
 			   ,(point-max-marker))))))))
 
 (defvar shr-map)
diff --git a/lisp/mm-view.el b/lisp/mm-view.el
index 27f772c..2bee260 100644
--- a/lisp/mm-view.el
+++ b/lisp/mm-view.el
@@ -96,19 +96,19 @@
 				 (- (nth 3 edges) (nth 1 edges)))))))
          image))
      b)
-    (insert "\n\n")
+    (insert "\n")
     (mm-handle-set-undisplayer
      handle
      `(lambda ()
 	(let ((b ,b)
 	      (inhibit-read-only t))
 	  (remove-images b b)
-	  (delete-region b (+ b 2)))))))
+	  (delete-region b (1+ b)))))))
 
 (defun mm-inline-image-xemacs (handle)
   (when (featurep 'xemacs)
-    (insert "\n\n")
-    (forward-char -2)
+    (insert "\n")
+    (forward-char -1)
     (let ((annot (make-annotation (mm-get-image handle) nil 'text))
 	(inhibit-read-only t))
       (mm-handle-set-undisplayer
@@ -117,7 +117,7 @@
 	  (let ((b ,(point-marker))
 	      (inhibit-read-only t))
 	    (delete-annotation ,annot)
-	    (delete-region (- b 2) b))))
+	    (delete-region (1- b) b))))
       (set-extent-property annot 'mm t)
       (set-extent-property annot 'duplicable t))))
 
@@ -217,7 +217,7 @@
 	 handle
 	 `(lambda ()
 	    (let ((inhibit-read-only t))
-	      (delete-region ,(point-min-marker)
+	      (delete-region ,(copy-marker (point-min) t)
 			     ,(point-max-marker)))))))))
 
 (defvar mm-w3m-standalone-supports-m17n-p (if (featurep 'mule) 'undecided)
@@ -391,7 +391,7 @@
        handle
        `(lambda ()
           (let ((inhibit-read-only t))
-	    (delete-region ,(point-min-marker)
+	    (delete-region ,(copy-marker (point-min) t)
 			   ,(point-max-marker))))))))
 
 (defun mm-insert-inline (handle text)
@@ -404,7 +404,7 @@
      handle
      `(lambda ()
 	(let ((inhibit-read-only t))
-	  (delete-region ,(copy-marker b)
+	  (delete-region ,(copy-marker b t)
 			 ,(copy-marker (point))))))))
 
 (defun mm-inline-audio (handle)

-----------------------------------------------------------------------
Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we listed those
revisions in full, above.

Summary of changes:
 lisp/ChangeLog    |   17 ++++++++-
 lisp/gnus-art.el  |  103 ++++++++++++++++++++++++++++++++++++++---------------
 lisp/mm-decode.el |    3 +-
 lisp/mm-view.el   |   16 ++++-----
 4 files changed, 99 insertions(+), 40 deletions(-)

This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "Gnus Project".

The branch, master has been updated


hooks/post-receive
-- 
Gnus Project