(regexp :value ".*"))
:group 'gnus-article-signature)
-(defcustom gnus-hidden-properties '(invisible t intangible t)
+(defcustom gnus-hidden-properties
+ (if (featurep 'xemacs)
+ ;; `intangible' is evil, but I keep it here in case it's useful.
+ '(invisible t intangible t)
+ ;; Emacs's command loop moves point out of invisible text anyway, so
+ ;; `intangible' is clearly not needed there.
+ '(invisible t))
"Property list to use for hiding text."
:type 'sexp
:group 'gnus-article-hiding)
(defcustom gnus-use-idna (and (condition-case nil (require 'idna) (file-error))
(mm-coding-system-p 'utf-8)
+ idna-program
(executable-find idna-program))
"Whether IDNA decoding of headers is used when viewing messages.
This requires GNU Libidn, and by default only enabled if it is found."
(when (or (numberp article)
(stringp article))
(gnus-article-prepare-display)
- ;; Add attachment buttons to the header.
- (when gnus-mime-display-attachment-buttons-in-header
- (gnus-mime-buttonize-attachments-in-header))
;; Do page break.
(goto-char (point-min))
(when gnus-break-pages
gnus-article-image-alist nil)
(gnus-run-hooks 'gnus-tmp-internal-hook)
(when gnus-display-mime-function
- (funcall gnus-display-mime-function))))
+ (funcall gnus-display-mime-function))
+ ;; Add attachment buttons to the header.
+ (when gnus-mime-display-attachment-buttons-in-header
+ (gnus-mime-buttonize-attachments-in-header))))
;;;
;;; Gnus Sticky Article Mode
(gnus-article-edit-article
`(lambda ()
(buffer-disable-undo)
- (erase-buffer)
(let ((mail-parse-charset (or gnus-article-charset
',gnus-newsgroup-charset))
(mail-parse-ignored-charsets
',gnus-newsgroup-ignored-charsets))
(mbl mml-buffer-list))
(setq mml-buffer-list nil)
- (insert-buffer-substring gnus-original-article-buffer)
+ ;; A new text must be inserted before deleting existing ones
+ ;; at the end so as not to move existing markers of which
+ ;; the insertion type is t.
+ (delete-region
+ (point-min)
+ (prog1
+ (goto-char (point-max))
+ (insert-buffer-substring gnus-original-article-buffer)))
(mime-to-mml ',handles)
(setq gnus-article-mime-handles nil)
(let ((mbl1 mml-buffer-list))
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))
+ start contents charset coding-system)
+ (when handle
+ (when (= b (prog1
+ btn
+ (setq start (next-single-property-change btn 'gnus-data
+ nil (point-max))
+ btn (previous-single-property-change start
+ 'gnus-data))))
+ (setq b btn))
(if (and (not arg) (mm-handle-undisplayer handle))
(mm-remove-part handle)
(mm-with-unibyte-buffer
(mm-read-coding-system "Charset: "))))
((mm-handle-undisplayer handle)
(mm-remove-part handle)))
- (forward-line 1)
- (mm-display-inline handle)
- (goto-char b)))))
+ (goto-char start)
+ (unless (bolp)
+ ;; This is a header button.
+ (forward-line 1))
+ (mm-display-inline handle))
+ ;; Toggle the button appearance between `[button]...' and `[button]'.
+ (goto-char btn)
+ (let ((displayed-p (mm-handle-displayed-p handle)))
+ (gnus-insert-mime-button handle (get-text-property btn 'gnus-part)
+ (list displayed-p))
+ (if (featurep 'emacs)
+ (delete-region
+ (point)
+ (next-single-property-change (point) 'gnus-data nil (point-max)))
+ (let* ((end (next-single-property-change (point) 'gnus-data))
+ (annots (annotations-at (or end (point-max)))))
+ (delete-region (point)
+ (if end
+ (if annots (1+ end) end)
+ (point-max)))
+ (dolist (annot annots)
+ (set-extent-endpoints annot (point) (point)))))
+ (setq start (point))
+ (if (search-backward "\n\n" nil t)
+ (progn
+ (goto-char start)
+ (unless (or displayed-p (eolp))
+ ;; Add extra newline.
+ (insert (propertize (buffer-substring (1- start) start)
+ 'gnus-undeletable 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.
"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))
+ start retval)
+ (unwind-protect
+ (progn
+ (let ((win (gnus-get-buffer-window (current-buffer) t)))
+ (when win
+ (select-window win)
+ (goto-char point)))
+ (setq start (next-single-property-change point 'gnus-data
+ nil (point-max))
+ point (previous-single-property-change start 'gnus-data))
+ (if (mm-handle-displayed-p handle)
+ ;; This will remove the part.
+ (setq retval (mm-display-part handle))
+ (let ((part (or (and (mm-inlinable-p handle)
+ (mm-inlined-p handle)
+ t)
+ (with-temp-buffer
+ (gnus-bind-safe-url-regexp
+ (setq retval (mm-display-part handle)))
+ (unless (zerop (buffer-size))
+ (buffer-string))))))
+ (goto-char start)
+ (unless (bolp)
+ ;; This is a header button.
+ (forward-line 1))
+ (cond ((stringp part)
+ (save-restriction
+ (narrow-to-region (point)
+ (progn
+ (insert part)
+ (unless (bolp) (insert "\n"))
+ (point)))
+ (gnus-treat-article nil id
+ (gnus-article-mime-total-parts)
+ (mm-handle-media-type handle))
+ (mm-handle-set-undisplayer
+ handle
+ `(lambda ()
+ (let ((inhibit-read-only t))
+ (delete-region ,(copy-marker (point-min) t)
+ ,(point-max-marker)))))))
+ (part
+ (mm-display-inline handle))))))
+ (goto-char point)
+ ;; Toggle the button appearance between `[button]...' and `[button]'.
+ (let ((displayed-p (mm-handle-displayed-p handle)))
+ (gnus-insert-mime-button handle id (list displayed-p))
+ (if (featurep 'emacs)
+ (delete-region
+ (point)
+ (next-single-property-change (point) 'gnus-data nil (point-max)))
+ (let* ((end (next-single-property-change (point) 'gnus-data))
+ (annots (annotations-at (or end (point-max)))))
+ (delete-region (point)
+ (if end
+ (if annots (1+ end) end)
+ (point-max)))
+ (dolist (annot annots)
+ (set-extent-endpoints annot (point) (point)))))
+ (setq start (point))
+ (if (search-backward "\n\n" nil t)
+ (progn
+ (goto-char start)
+ (unless (or displayed-p (eolp))
+ ;; Add extra newline.
+ (insert (propertize (buffer-substring (1- start) start)
+ 'gnus-undeletable 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."
(when gnus-break-pages
(widen))
+ (article-goto-body)
(prog1
- (let ((start (text-property-any (point-min) (point-max) 'gnus-part n))
+ (let ((start (or (text-property-any (point) (point-max) 'gnus-part n)
+ ;; There may be header buttons.
+ (text-property-any (point-min) (point) 'gnus-part n)))
part handle end next handles)
(when start
(goto-char start)
overlook them if there is a huge body. This option offers you a copy
of all non-inlinable MIME parts as buttons shown in front of an article.
If nil, don't show those extra buttons."
- :version "24.5"
- :group 'gnus-article
+ :version "25.1"
+ :group 'gnus-article-mime
:type 'boolean)
(defun gnus-mime-display-part (handle)
(let ((type (mm-handle-media-type handle))
(ignored gnus-ignored-mime-types)
(not-attachment t)
- (move nil)
display text)
(catch 'ignored
(progn
(setq display t)
(when (equal (mm-handle-media-supertype handle) "text")
(setq text t)))
- (let ((id (1+ (length gnus-article-mime-handle-alist)))
+ (let ((id (car (rassq handle gnus-article-mime-handle-alist)))
beg)
- (push (cons id handle) gnus-article-mime-handle-alist)
+ (unless id
+ (setq id (1+ (length gnus-article-mime-handle-alist)))
+ (push (cons id handle) gnus-article-mime-handle-alist))
(when (and display
(equal (mm-handle-media-supertype handle) "message"))
(insert-char
(not (gnus-unbuttonized-mime-type-p type))
(eq id gnus-mime-buttonized-part-id))
(gnus-insert-mime-button
- handle id (list (or display (and not-attachment text))))
- (gnus-article-insert-newline)
- ;; Remember modify the number of forward lines.
- (setq move t))
+ handle id (list (or display (and not-attachment text)))))
(setq beg (point))
(cond
(display
- (when move
- (forward-line -1)
- (setq beg (point)))
(let ((mail-parse-charset gnus-newsgroup-charset)
(mail-parse-ignored-charsets
(save-excursion (condition-case ()
(set-buffer gnus-summary-buffer)
(error))
gnus-newsgroup-ignored-charsets)))
- (gnus-bind-safe-url-regexp (mm-display-part handle t)))
- (goto-char (point-max)))
+ (gnus-bind-safe-url-regexp (mm-display-part handle t))))
((and text not-attachment)
- (when move
- (forward-line -1)
- (setq beg (point)))
- (gnus-article-insert-newline)
- (mm-display-inline handle)
- (goto-char (point-max))))
+ (mm-display-inline handle)))
+ (goto-char (point-max))
+ (if (string-match "\\`image/" type)
+ (gnus-article-insert-newline)
+ (if (prog1
+ (= (skip-chars-backward "\n") -1)
+ (forward-char 1))
+ (gnus-article-insert-newline)
+ (put-text-property (point) (point-max) 'gnus-undeletable t))
+ (goto-char (point-max)))
;; Do highlighting.
(save-excursion
(save-restriction
(goto-char (point-max))
(setcdr begend (point-marker)))))
(when ibegend
- (goto-char point))))
+ (goto-char point)))
+ ;; Redraw attachment buttons in the header.
+ (when gnus-mime-display-attachment-buttons-in-header
+ (gnus-mime-buttonize-attachments-in-header)))
(defconst gnus-article-wash-status-strings
(let ((alist '((cite "c" "Possible hidden citation text"
in the body. Use `gnus-header-face-alist' to highlight buttons."
(interactive (list t))
(gnus-with-article-buffer
- (let ((case-fold-search t)
- buttons st nd handle marker)
- (save-excursion
- (save-restriction
- (widen)
- (article-narrow-to-head)
- ;; Header buttons exist?
- (while (and (not buttons)
- (re-search-forward "^attachments?:[\n ]+" nil t))
- (when (get-char-property (match-end 0)
- 'gnus-button-attachment-extra)
- (setq buttons (match-beginning 0))))
- (widen)
- (if (and interactive buttons)
+ (gmm-labels
+ ;; Function that returns a flattened version of
+ ;; `gnus-article-mime-handle-alist'.
+ ((flattened-alist
+ (&optional alist id all)
+ (if alist
+ (let ((i 1) newid flat)
+ (dolist (handle alist flat)
+ (setq newid (append id (list i))
+ i (1+ i))
+ (if (stringp (car handle))
+ (setq flat (nconc flat (flattened-alist (cdr handle)
+ newid all)))
+ (delq (rassq handle all) all)
+ (setq flat (nconc flat (list (cons newid handle)))))))
+ (let ((flat (list nil)))
+ ;; Assume that elements of `gnus-article-mime-handle-alist'
+ ;; are in the decreasing order, but unnumbered subsidiaries
+ ;; in each element are in the increasing order.
+ (dolist (handle (reverse gnus-article-mime-handle-alist))
+ (if (stringp (cadr handle))
+ (setq flat (nconc flat (flattened-alist (cddr handle)
+ (list (car handle))
+ flat)))
+ (delq (rassq (cdr handle) flat) flat)
+ (setq flat (nconc flat (list (cons (list (car handle))
+ (cdr handle)))))))
+ (setq flat (cdr flat))
+ (mapc (lambda (handle)
+ (if (cdar handle)
+ ;; This is a hidden (i.e. unnumbered) handle.
+ (progn
+ (setcar handle
+ (1+ (caar gnus-article-mime-handle-alist)))
+ (push handle gnus-article-mime-handle-alist))
+ (setcar handle (caar handle))))
+ flat)
+ flat))))
+ (let ((case-fold-search t) buttons handle type st)
+ (save-excursion
+ (save-restriction
+ (widen)
+ (article-narrow-to-head)
+ ;; Header buttons exist?
+ (while (and (not buttons)
+ (re-search-forward "^attachments?:[\n ]+" nil t))
+ (when (get-char-property (match-end 0)
+ 'gnus-button-attachment-extra)
+ (setq buttons (match-beginning 0))))
+ (widen)
+ (when buttons
;; Delete header buttons.
- (delete-region buttons
- (if (re-search-forward "^[^ ]" nil t)
- (match-beginning 0)
- (point-max)))
- (unless buttons
- (article-goto-body)
- (setq st (point))
- ;; Find buttons in the body.
- (while (setq st (text-property-not-all st (point-max)
- 'gnus-part nil))
- (setq nd (or (text-property-any st (point-max) 'gnus-part nil)
- (point-max)))
- (when (and (get-text-property st 'gnus-part)
- (setq handle (get-text-property st 'gnus-data))
- (not (and (mm-inlinable-p handle)
- (mm-inlined-p handle))))
- (goto-char nd)
- (skip-chars-backward "\t\n ")
- (when (> (point) st)
- (push (cons (buffer-substring st (point))
- (gnus-overlays-at st))
- buttons)))
- (setq st nd))
+ (delete-region buttons (if (re-search-forward "^[^ ]" nil t)
+ (match-beginning 0)
+ (point-max))))
+ (unless (and interactive buttons)
+ ;; Find buttons.
+ (setq buttons nil)
+ (dolist (button (flattened-alist))
+ (setq handle (cdr button)
+ type (mm-handle-media-type handle))
+ (when (or (and (if (gnus-buffer-live-p gnus-summary-buffer)
+ (with-current-buffer gnus-summary-buffer
+ gnus-inhibit-images)
+ gnus-inhibit-images)
+ (string-match "\\`image/" type))
+ (mm-inline-override-p handle)
+ (and (mm-handle-disposition handle)
+ (not (equal (car (mm-handle-disposition handle))
+ "inline"))
+ (not (mm-attachment-override-p handle)))
+ (not (mm-automatic-display-p handle))
+ (not (or (and (mm-inlinable-p handle)
+ (mm-inlined-p handle))
+ (mm-automatic-external-display-p type))))
+ (push button buttons)))
(when buttons
;; Add header buttons.
(article-goto-body)
(narrow-to-region (point) (point))
(insert "Attachment" (if (cdr buttons) "s" "") ":")
(dolist (button (nreverse buttons))
- (when (> (+ (current-column) 1 (string-width (car button)))
- (window-width))
- (insert "\n"))
- (insert " ")
(setq st (point))
- (insert (car button))
- (setq nd (point))
- ;; Make buttons uncatchable by the K-prefixed commands.
- (put-text-property
- st nd 'gnus-part
- (number-to-string (get-text-property st 'gnus-part)))
- (dolist (ovl (cdr button))
- (setq ovl (gnus-copy-overlay ovl))
- (when (setq marker
- (plist-get (cdr (gnus-overlay-get ovl 'button))
- :from))
- (set-marker marker st))
- (when (setq marker
- (plist-get (cdr (gnus-overlay-get ovl 'button))
- :to))
- (set-marker marker nd))
- (gnus-move-overlay ovl st nd)
- (setq st nd)
- (gnus-overlay-put ovl 'gnus-button-attachment-extra t)
- (gnus-overlay-put ovl 'face nil)))
+ (insert " ")
+ (mm-handle-set-undisplayer
+ (setq handle (copy-sequence (cdr button))) nil)
+ (gnus-insert-mime-button handle (car button))
+ (skip-chars-backward "\t\n ")
+ (delete-region (point) (point-max))
+ (when (> (current-column) (window-width))
+ (goto-char st)
+ (insert "\n")
+ (end-of-line)))
(insert "\n")
+ (dolist (ovl (gnus-overlays-in (point-min) (point)))
+ (gnus-overlay-put ovl 'gnus-button-attachment-extra t)
+ (gnus-overlay-put ovl 'face nil))
(let ((gnus-treatment-function-alist
'((gnus-treat-highlight-headers
gnus-article-highlight-headers))))
(when (eq obuf (current-buffer))
(set-buffer in-buffer)
t))
- (setq selected (gnus-summary-select-article))
+ (setq selected (ignore-errors (gnus-summary-select-article)))
(set-buffer obuf)
(unless not-restore-window
(set-window-configuration owin))
projects / gnus / blobdiff