From 35b8e3551f1e85a8ceb29d60d7fb40e99539a62b Mon Sep 17 00:00:00 2001 From: Katsumi Yamaoka Date: Fri, 2 May 2014 09:44:34 +0000 Subject: [PATCH] Gnus: 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. --- lisp/gnus/ChangeLog | 17 +++++++- lisp/gnus/gnus-art.el | 103 +++++++++++++++++++++++++++++++++++-------------- lisp/gnus/mm-decode.el | 3 +- lisp/gnus/mm-view.el | 16 ++++---- 4 files changed, 99 insertions(+), 40 deletions(-) diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog index 234f976663e..1fc68411e2d 100644 --- a/lisp/gnus/ChangeLog +++ b/lisp/gnus/ChangeLog @@ -1,3 +1,18 @@ +2014-05-02 Katsumi Yamaoka + + * 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 Katsumi Yamaoka * gnus-art.el (gnus-mm-display-part): @@ -6,7 +21,7 @@ 2014-04-30 Katsumi Yamaoka * gnus-art.el (gnus-mm-display-part): Don't move point while toggling - a part; redisplay a button (enbugged in 2014-02-05). + a part; redisplay a button (enbugged in 2014-03-23). 2014-04-27 Teodor Zlatanov diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el index 44777f461e9..0fbac51d27c 100644 --- a/lisp/gnus/gnus-art.el +++ b/lisp/gnus/gnus-art.el @@ -5300,12 +5300,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) - contents charset coding-system) + (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 @@ -5332,8 +5345,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. @@ -5650,6 +5690,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. @@ -5673,27 +5716,29 @@ 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) - (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) - ;; We're in the article header. - (delete-char -1) - (dolist (ovl (gnus-overlays-in start (1- end))) - (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))))) + (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)) + (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 point (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 point) (if (window-live-p window) (select-window window))) diff --git a/lisp/gnus/mm-decode.el b/lisp/gnus/mm-decode.el index a99e7a43caa..cde0af036a5 100644 --- a/lisp/gnus/mm-decode.el +++ b/lisp/gnus/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/gnus/mm-view.el b/lisp/gnus/mm-view.el index 27f772cffa1..2bee260d8f2 100644 --- a/lisp/gnus/mm-view.el +++ b/lisp/gnus/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) -- 2.11.4.GIT