X-Git-Url: http://cgit.sxemacs.org/?p=gnus;a=blobdiff_plain;f=lisp%2Fgnus-art.el;h=8287815f4446aac066d9d27e10518e720558441b;hp=0b552e7bc2f586b74eeadc2e3da68f33b1940348;hb=f0bddc315ea0e052416bdd68b1b3166a9e1e9d22;hpb=18dc18f512e4bc1a934ac57ceb761de7ed176cff diff --git a/lisp/gnus-art.el b/lisp/gnus-art.el index 0b552e7bc..8287815f4 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) - 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 @@ -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. @@ -5636,43 +5676,74 @@ all parts." "Display HANDLE and fix MIME button." (let ((id (get-text-property (point) 'gnus-part)) (point (point)) - (inhibit-read-only t)) - (forward-line 1) - (prog1 - (let ((window (selected-window)) - (mail-parse-charset gnus-newsgroup-charset) - (mail-parse-ignored-charsets - (if (gnus-buffer-live-p gnus-summary-buffer) - (with-current-buffer gnus-summary-buffer - gnus-newsgroup-ignored-charsets) - nil))) - (save-excursion - (unwind-protect - (let ((win (gnus-get-buffer-window (current-buffer) t)) - (beg (point))) - (when win - (select-window win)) - (goto-char point) - (forward-line) - (if (mm-handle-displayed-p handle) - ;; This will remove the part. - (mm-display-part handle) - (save-window-excursion - (save-restriction - (narrow-to-region (point) - (if (eobp) (point) (1+ (point)))) - (gnus-bind-safe-url-regexp (mm-display-part handle)) - ;; We narrow to the part itself and - ;; then call the treatment functions. - (goto-char (point-min)) - (forward-line 1) - (narrow-to-region (point) (point-max)) - (gnus-treat-article - nil id - (gnus-article-mime-total-parts) - (mm-handle-media-type handle)))))) - (if (window-live-p window) - (select-window window)))))))) + (inhibit-read-only t) + (window (selected-window)) + (mail-parse-charset gnus-newsgroup-charset) + (mail-parse-ignored-charsets + (if (gnus-buffer-live-p gnus-summary-buffer) + (with-current-buffer gnus-summary-buffer + gnus-newsgroup-ignored-charsets) + nil)) + retval) + (unwind-protect + (progn + (let ((win (gnus-get-buffer-window (current-buffer) t))) + (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. + (setq retval (mm-display-part handle)) + (save-window-excursion + (save-restriction + ;; FIXME: nothing is displayed in the article buffer + ;; while prompting a user for a file name. + (narrow-to-region (point) + (if (eobp) (point) (1+ (point)))) + (gnus-bind-safe-url-regexp + (setq retval (mm-display-part handle))) + ;; We narrow to the part itself and + ;; then call the treatment functions. + (goto-char (point-min)) + (forward-line 1) + (narrow-to-region (point) (point-max)) + (gnus-treat-article + nil id + (gnus-article-mime-total-parts) + (mm-handle-media-type handle)))))) + (goto-char point) + ;; Toggle the button appearance between `[button]...' and `[button]'. + (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))) + retval)) (defun gnus-article-goto-part (n) "Go to MIME part N."