;;; gnus-art.el --- article mode commands for Gnus
-;; Copyright (C) 1996-2012 Free Software Foundation, Inc.
+;; Copyright (C) 1996-2015 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: news
;;; Code:
-;; For Emacs <22.2 and XEmacs.
-(eval-and-compile
- (unless (fboundp 'declare-function) (defmacro declare-function (&rest r))))
(eval-when-compile
(require 'cl))
(defvar tool-bar-map)
(defvar w3m-minor-mode-map)
(require 'gnus)
+(require 'gnus-util)
(require 'gnus-sum)
(require 'gnus-spec)
(require 'gnus-int)
(autoload 'ansi-color-apply-on-region "ansi-color")
(autoload 'mm-url-insert-file-contents-external "mm-url")
(autoload 'mm-extern-cache-contents "mm-extern")
+(autoload 'url-expand-file-name "url-expand")
(defgroup gnus-article nil
"Article display."
"Headers that are only to be displayed if they have interesting data.
Possible values in this list are:
- 'empty Headers with no content.
- 'newsgroups Newsgroup identical to Gnus group.
- 'to-address To identical to To-address.
- 'to-list To identical to To-list.
- 'cc-list CC identical to To-list.
- 'followup-to Followup-to identical to Newsgroups.
- 'reply-to Reply-to identical to From.
- 'date Date less than four days old.
- 'long-to To and/or Cc longer than 1024 characters.
- 'many-to Multiple To and/or Cc."
+ `empty' Headers with no content.
+ `newsgroups' Newsgroup identical to Gnus group.
+ `to-address' To identical to To-address.
+ `to-list' To identical to To-list.
+ `cc-list' CC identical to To-list.
+ `followup-to' Followup-to identical to Newsgroups.
+ `reply-to' Reply-to identical to From.
+ `date' Date less than four days old.
+ `long-to' To and/or Cc longer than 1024 characters.
+ `many-to' Multiple To and/or Cc."
:type '(set (const :tag "Headers with no content." empty)
(const :tag "Newsgroups identical to Gnus group." newsgroups)
(const :tag "To identical to To-address." to-address)
(regexp :value ".*"))
:group 'gnus-article-signature)
-(defcustom gnus-hidden-properties '(invisible t intangible t)
+(defcustom gnus-hidden-properties
+ ;; We use to have `intangible' here as well, but Emacs's command loop moves
+ ;; point out of invisible text anyway, so `intangible' is clearly not
+ ;; needed there. And XEmacs doesn't handle `intangible' anyway.
+ '(invisible t)
"Property list to use for hiding text."
:type 'sexp
:group 'gnus-article-hiding)
If ADDRESS matches author's mail address, it will remove things like
advertisements. For example:
-\((\"@yoo-hoo\\\\.co\\\\.jp\\\\'\" . \"\\n_+\\nDo You Yoo-hoo!\\\\?\\n.*\\n.*\\n\"))
+\((\"@yoo-hoo\\\\.co\\\\.jp\\\\\\='\" . \"\\n_+\\nDo You Yoo-hoo!\\\\?\\n.*\\n.*\\n\"))
"
:type '(repeat
(cons
"*Alist that says how to fontify certain phrases.
Each item looks like this:
- (\"_\\\\(\\\\w+\\\\)_\" 0 1 'underline)
+ (\"_\\\\(\\\\w+\\\\)_\" 0 1 \\='underline)
The first element is a regular expression to be matched. The second
is a number that says what regular expression grouping used to find
the file \"gnus-stuff\", and articles related to VM in \"vm-stuff\",
you could set this variable to something like:
- '((\"^Subject:.*gnus\\|^Newsgroups:.*gnus\" \"gnus-stuff\")
+ ((\"^Subject:.*gnus\\|^Newsgroups:.*gnus\" \"gnus-stuff\")
(\"^Subject:.*vm\\|^Xref:.*vm\" \"vm-stuff\"))
This variable is an alist where the key is the match and the
;; Specify the altitude of Face images in the From header.
\(setq gnus-face-properties-alist
- '((pbm . (:face gnus-x-face :ascent 80))
+ \\='((pbm . (:face gnus-x-face :ascent 80))
(png . (:ascent 80))))
;; Show Face images as pressed buttons.
\(setq gnus-face-properties-alist
- '((pbm . (:face gnus-x-face :relief -2))
+ \\='((pbm . (:face gnus-x-face :relief -2))
(png . (:relief -2))))
See the manual for the valid properties for various image types.
`gnus-article-update-date-headers' for details."
:version "24.1"
:group 'gnus-article-headers
- :type '(repeat
- (item :tag "Universal time (UT)" :value 'ut)
- (item :tag "Local time zone" :value 'local)
- (item :tag "Readable English" :value 'english)
- (item :tag "Elapsed time" :value 'lapsed)
- (item :tag "Original and elapsed time" :value 'combined-lapsed)
- (item :tag "Original date header" :value 'original)
- (item :tag "ISO8601 format" :value 'iso8601)
- (item :tag "User-defined" :value 'user-defined)))
+ :type '(set
+ (const :tag "Universal time (UT)" ut)
+ (const :tag "Local time zone" local)
+ (const :tag "Readable English" english)
+ (const :tag "Elapsed time" lapsed)
+ (const :tag "Original and elapsed time" combined-lapsed)
+ (const :tag "Original date header" original)
+ (const :tag "ISO8601 format" iso8601)
+ (const :tag "User-defined" user-defined)))
(defcustom gnus-article-update-date-headers nil
"A number that says how often to update the date header (in seconds).
(const :tag "Header" head)))
(defvar gnus-article-treat-types '("text/plain" "text/x-verbatim"
- "text/x-patch")
- "Parts to treat.")
+ "text/x-patch" "text/html")
+ "Part types eligible for treatment.")
(defvar gnus-inhibit-treatment nil
"Whether to inhibit treatment.")
:type gnus-article-treat-custom)
(put 'gnus-treat-highlight-signature 'highlight t)
-(defcustom gnus-treat-buttonize 100000
+(defcustom gnus-treat-buttonize '(and 100000 (typep "text/plain"))
"Add buttons.
Valid values are nil, t, `head', `first', `last', an integer or a
predicate. See Info node `(gnus)Customizing Articles'."
:type gnus-article-treat-custom)
(defcustom gnus-treat-strip-list-identifiers 'head
- "Strip list identifiers from `gnus-list-identifiers`.
+ "Strip list identifiers from `gnus-list-identifiers'.
Valid values are nil, t, `head', `first', `last', an integer or a
predicate. See Info node `(gnus)Customizing Articles'."
:version "21.1"
:type 'string
:group 'mime-security)
-(defcustom gnus-use-idna (and (condition-case nil (require 'idna) (file-error))
- (mm-coding-system-p 'utf-8)
+(defvar idna-program)
+
+(defcustom gnus-use-idna (and (mm-coding-system-p 'utf-8)
+ (condition-case nil
+ (require 'idna)
+ (file-error)
+ (invalid-operation))
+ 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."
regexp."
:version "24.1"
:group 'gnus-art
- :type 'regexp)
+ :type '(choice regexp function))
;;; Internal variables
(modify-syntax-entry ?` " " table)
table)
"Syntax table used in article mode buffers.
-Initialized from `text-mode-syntax-table.")
+Initialized from `text-mode-syntax-table'.")
(defvar gnus-save-article-buffer nil)
(re-search-forward (concat "^\\(" header "\\):") nil t))
(defsubst gnus-article-hide-text (b e props)
- "Set text PROPS on the B to E region, extending `intangible' 1 past B."
- (gnus-add-text-properties-when 'article-type nil b e props)
- (when (memq 'intangible props)
- (put-text-property
- (max (1- b) (point-min))
- b 'intangible (cddr (memq 'intangible props)))))
+ "Set text PROPS on the B to E region."
+ (gnus-add-text-properties-when 'article-type nil b e props))
(defsubst gnus-article-unhide-text (b e)
"Remove hidden text properties from region between B and E."
- (remove-text-properties b e gnus-hidden-properties)
- (when (memq 'intangible gnus-hidden-properties)
- (put-text-property (max (1- b) (point-min))
- b 'intangible nil)))
+ (remove-text-properties b e gnus-hidden-properties))
(defun gnus-article-hide-text-type (b e type)
"Hide text of TYPE between B and E."
"Unhide text of TYPE between B and E."
(gnus-delete-wash-type type)
(remove-text-properties
- b e (cons 'article-type (cons type gnus-hidden-properties)))
- (when (memq 'intangible gnus-hidden-properties)
- (put-text-property (max (1- b) (point-min))
- b 'intangible nil)))
-
-(defun gnus-article-hide-text-of-type (type)
- "Hide text of TYPE in the current buffer."
- (save-excursion
- (let ((b (point-min))
- (e (point-max)))
- (while (setq b (text-property-any b e 'article-type type))
- (add-text-properties b (incf b) gnus-hidden-properties)))))
+ b e (cons 'article-type (cons type gnus-hidden-properties))))
(defun gnus-article-delete-text-of-type (type)
"Delete text of TYPE in the current buffer."
b (or (text-property-not-all b (point-max) 'invisible t)
(point-max)))))))
-(defun gnus-article-text-type-exists-p (type)
- "Say whether any text of type TYPE exists in the buffer."
- (text-property-any (point-min) (point-max) 'article-type type))
-
(defsubst gnus-article-header-rank ()
"Give the rank of the string HEADER as given by `gnus-sorted-header-list'."
(let ((list gnus-sorted-header-list)
(incf i)))
i))
-(defun article-hide-headers (&optional arg delete)
+(defun article-hide-headers (&optional _arg _delete)
"Hide unwanted headers and possibly sort them as well."
(interactive)
;; This function might be inhibited.
props)
(insert replace)))))))))
-(defun article-translate-characters (from to)
- "Translate all characters in the body of the article according to FROM and TO.
-FROM is a string of characters to translate from; to is a string of
-characters to translate to."
- (save-excursion
- (when (article-goto-body)
- (let ((inhibit-read-only t)
- (x (make-string 225 ?x))
- (i -1))
- (while (< (incf i) (length x))
- (aset x i i))
- (setq i 0)
- (while (< i (length from))
- (aset x (aref from i) (aref to i))
- (incf i))
- (translate-region (point) (point-max) x)))))
-
(defun article-translate-strings (map)
"Translate all string in the body of the article according to MAP.
MAP is an alist where the elements are on the form (\"from\" \"to\")."
(unfoldable
(or (equal gnus-article-unfold-long-headers t)
(and (stringp gnus-article-unfold-long-headers)
- (string-match gnus-article-unfold-long-headers header)))))
+ (string-match gnus-article-unfold-long-headers
+ header)))))
(with-temp-buffer
(insert header)
(goto-char (point-min))
(goto-char (point-max))
(let ((start (point)))
(insert "X-Boundary: ")
- (gnus-add-text-properties start (point) '(invisible t intangible t))
+ (gnus-add-text-properties start (point) gnus-hidden-properties)
(insert (let (str (max (window-width)))
(if (featurep 'xemacs)
(setq max (1- max)))
(if (and wash-face-p (memq 'face gnus-article-wash-types))
(gnus-delete-images 'face)
(let ((from (message-fetch-field "from"))
- face faces)
+ faces)
(save-current-buffer
(when (and wash-face-p
(gnus-buffer-live-p gnus-original-article-buffer)
(unless (setq from (gnus-article-goto-header "from"))
(insert "From:")
(setq from (point))
- (insert " [no `from' set]\n"))
+ (insert " [no 'from' set]\n"))
(while faces
(when (setq png (gnus-convert-face-to-png (pop faces)))
(setq image
(apply 'gnus-create-image png 'png t
(cdr (assq 'png gnus-face-properties-alist))))
(goto-char from)
- (gnus-add-wash-type 'face)
- (gnus-add-image 'face image)
- (gnus-put-image image nil 'face))))))))))
+ (when image
+ (gnus-add-wash-type 'face)
+ (gnus-add-image 'face image)
+ (gnus-put-image image nil 'face)))))))))))
(defun article-display-x-face (&optional force)
"Look for an X-Face header and display it if present."
(gnus-delete-images 'xface)
;; Display X-Faces.
(let ((from (message-fetch-field "from"))
- x-faces face)
+ x-faces)
(save-current-buffer
(when (and wash-face-p
(gnus-buffer-live-p gnus-original-article-buffer)
(string-match "quoted-printable" type))))
(article-goto-body)
(quoted-printable-decode-region
- (point) (point-max) (mm-charset-to-coding-system charset))))))
+ (point) (point-max) (mm-charset-to-coding-system charset nil t))))))
(defun article-de-base64-unreadable (&optional force read-charset)
"Translate a base64 article.
(narrow-to-region (point) (point-max))
(base64-decode-region (point-min) (point-max))
(mm-decode-coding-region
- (point-min) (point-max) (mm-charset-to-coding-system charset)))))))
+ (point-min) (point-max)
+ (mm-charset-to-coding-system charset nil t)))))))
(eval-when-compile
(require 'rfc1843))
(while (re-search-forward
"\\(\\(https?\\|ftp\\)://\\S-+\\) *\n\\(\\S-+\\)" nil t)
(replace-match "\\1\\3" t)))
- (when (interactive-p)
+ (when (gmm-called-interactively-p 'any)
(gnus-treat-article nil))))
(defun article-wash-html ()
(let ((handles nil)
(buffer-read-only nil))
(when (gnus-buffer-live-p gnus-original-article-buffer)
- (setq handles (mm-dissect-buffer t t)))
+ (with-current-buffer gnus-original-article-buffer
+ (setq handles (mm-dissect-buffer t t))))
(article-goto-body)
(delete-region (point) (point-max))
(mm-enable-multibyte)
(or how (setq how gnus-article-browse-delete-temp))
(if (eq how 'ask)
(let ((files (length gnus-article-browse-html-temp-list)))
- (gnus-y-or-n-p
- (if (= files 1)
- "Delete the temporary HTML file? "
- (format "Delete all %s temporary HTML files? "
- files))))
+ (or (gnus-y-or-n-p
+ (if (= files 1)
+ "Delete the temporary HTML file? "
+ (format "Delete all %s temporary HTML files? "
+ files)))
+ (setq gnus-article-browse-html-temp-list nil)))
how)))
(dolist (file gnus-article-browse-html-temp-list)
(cond ((file-directory-p file)
(when (or (not (eq how 'file))
(gnus-y-or-n-p
- (format
+ (gnus-format-message
"Delete temporary HTML file(s) in directory `%s'? "
(file-name-as-directory file))))
(gnus-delete-directory file)))
(defun gnus-article-browse-html-save-cid-content (cid handles directory)
"Find CID content in HANDLES and save it in a file in DIRECTORY.
-Return file name."
+Return file name relative to the parent of DIRECTORY."
(save-match-data
- (let (file type)
+ (let (file afile)
(catch 'found
(dolist (handle handles)
(cond
((not (listp handle)))
+ ;; Exclude broken handles that `gnus-summary-enter-digest-group'
+ ;; may create.
+ ((not (or (bufferp (car handle)) (stringp (car handle)))))
((equal (mm-handle-media-supertype handle) "multipart")
(when (setq file (gnus-article-browse-html-save-cid-content
cid handle directory))
(throw 'found file)))
((equal (concat "<" cid ">") (mm-handle-id handle))
- (setq file
- (expand-file-name
- (or (mm-handle-filename handle)
- (concat
- (make-temp-name "cid")
- (car (rassoc (car (mm-handle-type handle)) mailcap-mime-extensions))))
- directory))
- (mm-save-part-to-file handle file)
- (throw 'found file))))))))
+ (setq file (or (mm-handle-filename handle)
+ (concat
+ (make-temp-name "cid")
+ (car (rassoc (car (mm-handle-type handle))
+ mailcap-mime-extensions))))
+ afile (expand-file-name file directory))
+ (mm-save-part-to-file handle afile)
+ (throw 'found (concat (file-name-nondirectory
+ (directory-file-name directory))
+ "/" file)))))))))
(defun gnus-article-browse-html-parts (list &optional header)
"View all \"text/html\" parts from LIST.
(insert content)
;; resolve cid contents
(let ((case-fold-search t)
- cid-file)
+ st base regexp cid-file)
(goto-char (point-min))
+ (when (and (re-search-forward "<head[\t\n >]" nil t)
+ (progn
+ (setq st (match-end 0))
+ (re-search-forward "</head[\t\n >]" nil t))
+ (re-search-backward "<base\
+\\(?:[\t\n ]+[^\t\n >]+\\)*[\t\n ]+href=\"\\([^\"]+\\)\"[^>]*>" st t))
+ (setq base (match-string 1))
+ (replace-match "<!--\\&-->")
+ (setq st (point))
+ (dolist (tag '(("a" . "href") ("form" . "action")
+ ("img" . "src")))
+ (setq regexp (concat "<" (car tag)
+ "\\(?:[\t\n ]+[^\t\n >]+\\)*[\t\n ]+"
+ (cdr tag) "=\"\\([^\"]+\\)"))
+ (while (re-search-forward regexp nil t)
+ (insert (prog1
+ (condition-case nil
+ (save-match-data
+ (url-expand-file-name (match-string 1)
+ base))
+ (error (match-string 1)))
+ (delete-region (match-beginning 1)
+ (match-end 1)))))
+ (goto-char st)))
(while (re-search-forward "\
<img[\t\n ]+\\(?:[^\t\n >]+[\t\n ]+\\)*src=\"\\(cid:\\([^\"]+\\)\\)\""
nil t)
(with-current-buffer gnus-article-buffer
gnus-article-mime-handles)
cid-dir))
- (when (eq system-type 'cygwin)
- (setq cid-file
- (concat "/" (substring
- (with-output-to-string
- (call-process "cygpath" nil
- standard-output
- nil "-m" cid-file))
- 0 -1))))
- (replace-match (concat "file://" cid-file)
- nil nil nil 1))))
+ (replace-match cid-file nil nil nil 1))))
(unless content (setq content (buffer-string))))
(when (or charset header (not file))
(setq tmp-file (mm-make-temp-file
;; Add a meta html tag to specify charset and a header.
(cond
(header
- (let (title eheader body hcharset coding force-charset)
+ (let (title eheader body hcharset coding)
(with-temp-buffer
(mm-enable-multibyte)
(setq case-fold-search t)
(insert header "\n")
(setq title (message-fetch-field "subject"))
(goto-char (point-min))
- (while (re-search-forward "\\(<\\)\\|\\(>\\)\\|&" nil t)
+ (while (re-search-forward "\\(<\\)\\|\\(>\\)\\|\\(&\\)\\|\n"
+ nil t)
(replace-match (cond ((match-beginning 1) "<")
((match-beginning 2) ">")
- (t "&"))))
+ ((match-beginning 3) "&")
+ (t "<br>\n"))))
+ (goto-char (point-min))
+ (while (re-search-forward "^[\t ]+" nil t)
+ (dotimes (i (prog1
+ (current-column)
+ (delete-region (match-beginning 0)
+ (match-end 0))))
+ (insert " ")))
(goto-char (point-min))
- (insert "<pre>\n")
+ (insert "<div align=\"left\">\n")
(goto-char (point-max))
- (insert "</pre>\n<hr>\n")
+ (insert "</div>\n<hr>\n")
;; We have to examine charset one by one since
;; charset specified in parts might be different.
(if (eq charset 'gnus-decoded)
charset)
title (when title
(mm-encode-coding-string title charset))
- body (mm-encode-coding-string content charset)
- force-charset t)
+ body (mm-encode-coding-string content charset))
(setq hcharset (mm-find-mime-charset-region (point-min)
(point-max)))
(cond ((= (length hcharset) 1)
(setq hcharset (car hcharset)
coding (mm-charset-to-coding-system
- hcharset)))
+ hcharset nil t)))
((> (length hcharset) 1)
(setq hcharset 'utf-8
coding hcharset)))
(if charset
(progn
(setq body
- (mm-charset-to-coding-system charset))
+ (mm-charset-to-coding-system charset
+ nil t))
(if (eq coding body)
(setq eheader (mm-encode-coding-string
(buffer-string) coding)
body (mm-encode-coding-string
(mm-decode-coding-string
content body)
- charset)
- force-charset t)))
+ charset))))
(setq charset hcharset
eheader (mm-encode-coding-string
(buffer-string) coding)
(mm-disable-multibyte)
(insert body)
(when charset
- (mm-add-meta-html-tag handle charset force-charset))
+ (mm-add-meta-html-tag handle charset t))
(when title
(goto-char (point-min))
(unless (search-forward "<title>" nil t)
(gnus-summary-show-article)))))
(defun article-hide-list-identifiers ()
- "Remove list identifies from the Subject header.
+ "Remove list identifiers from the Subject header.
The `gnus-list-identifiers' variable specifies what to do."
(interactive)
(let ((inhibit-point-motion-hooks t)
'hidden
nil)))
-(defun gnus-article-show-hidden-text (type &optional dummy)
+(defun gnus-article-show-hidden-text (type &optional _dummy)
"Show all hidden text of type TYPE.
Originally it is hide instead of DUMMY."
(let ((inhibit-read-only t)
gnus-article-date-headers)
t))
-(defun article-date-ut (&optional type highlight date-position)
+(defun article-date-ut (&optional type _highlight date-position)
"Convert DATE date to TYPE in the current article.
The default type is `ut'. See `gnus-article-date-headers' for
possible values."
(let* ((case-fold-search t)
(inhibit-read-only t)
(inhibit-point-motion-hooks t)
- (first t)
(visible-date (mail-fetch-field "Date"))
pos date bface eface)
(save-excursion
- (goto-char (point-min))
- (when (re-search-forward "^Date:" nil t)
- (setq bface (get-text-property (point-at-bol) 'face)
- eface (get-text-property (1- (point-at-eol)) 'face)))
- ;; Delete any old Date headers.
(if date-position
(progn
(goto-char date-position)
(setq date (get-text-property (point) 'original-date))
+ (when (looking-at "[^:]+:[\t ]*")
+ (setq bface (get-text-property (match-beginning 0) 'face)
+ eface (get-text-property (match-end 0) 'face)))
(delete-region (point)
(progn
(gnus-article-forward-header)
(narrow-to-region pos (if (search-forward "\n\n" nil t)
(1+ (match-beginning 0))
(point-max)))
- (goto-char (point-min))
- (while (re-search-forward "^Date:" nil t)
- (setq date (get-text-property (match-beginning 0) 'original-date))
- (delete-region (point-at-bol) (progn
- (gnus-article-forward-header)
- (point))))
+ (while (setq pos (text-property-not-all pos (point-max)
+ 'gnus-date-type nil))
+ (setq date (get-text-property pos 'original-date))
+ (goto-char pos)
+ (when (looking-at "[^:]+:[\t ]*")
+ (setq bface (get-text-property (match-beginning 0) 'face)
+ eface (get-text-property (match-end 0) 'face)))
+ (delete-region pos (or (text-property-any pos (point-max)
+ 'gnus-date-type nil)
+ (point-max))))
+ (unless date ;; the 1st time
+ (goto-char (point-min))
+ (while (re-search-forward "^Date:[\t ]*" nil t)
+ (setq date (get-text-property (match-beginning 0)
+ 'original-date)
+ bface (get-text-property (match-beginning 0) 'face)
+ eface (get-text-property (match-end 0) 'face))
+ (delete-region (point-at-bol) (progn
+ (gnus-article-forward-header)
+ (point)))))
(when (and (not date)
visible-date)
(setq date visible-date))
(list type))
(t
type)))
- (insert (article-make-date-line date (or this-type 'ut)) "\n")
- (forward-line -1)
- (beginning-of-line)
- (put-text-property (point) (1+ (point))
- 'original-date date)
- (put-text-property (point) (1+ (point))
- 'gnus-date-type this-type)
+ (goto-char
+ (prog1
+ (point)
+ (add-text-properties
+ (point)
+ (progn
+ (insert (article-make-date-line date (or this-type 'ut)) "\n")
+ (point))
+ (list 'original-date date 'gnus-date-type this-type))))
;; Do highlighting.
- (when (looking-at "\\([^:]+\\): *\\(.*\\)$")
- (put-text-property (match-beginning 1) (1+ (match-end 1))
- 'face bface)
- (put-text-property (match-beginning 2) (match-end 2)
- 'face eface))
- (forward-line 1)))
+ (when (looking-at
+ "\\([^:]+:\\)[\t ]*\\(\\(?:[^\t\n ]+[\t ]+\\)*[^\t\n ]+\\)?")
+ (put-text-property (match-beginning 1) (match-end 1) 'face bface)
+ (when (match-beginning 2)
+ (put-text-property (match-beginning 2) (match-end 2) 'face eface))
+ (while (and (zerop (forward-line 1))
+ (looking-at "[\t ]+\\(\\(?:[^\t\n ]+[\t ]+\\)*[^\t\n ]+\\)?"))
+ (when (match-beginning 1)
+ (put-text-property (match-beginning 1) (match-end 1) 'face eface))))))
(defun article-make-date-line (date type)
"Return a DATE line of TYPE."
(walk-windows
(lambda (w)
(set-buffer (window-buffer w))
- (when (eq major-mode 'gnus-article-mode)
+ (when (derived-mode-p 'gnus-article-mode)
(let ((old-line (count-lines (point-min) (point)))
(old-column (- (point) (line-beginning-position)))
- (window-start
- (window-start (get-buffer-window (current-buffer)))))
- (goto-char (point-min))
- (while (re-search-forward "^Date:" nil t)
- (let ((type (get-text-property (match-beginning 0)
- 'gnus-date-type)))
- (when (memq type '(lapsed combined-lapsed user-format))
- (when (and window-start
- (not (= window-start
- (save-excursion
- (forward-line 1)
- (point)))))
- (setq window-start nil))
- (save-excursion
- (article-date-ut type t (match-beginning 0)))
- (forward-line 1)
- (when window-start
- (set-window-start (get-buffer-window (current-buffer))
- (point))))))
+ (window-start (window-start w))
+ (pos (point-min))
+ type next end)
+ (while (setq pos (text-property-not-all pos (point-max)
+ 'gnus-date-type nil))
+ (setq next (or (next-single-property-change pos
+ 'gnus-date-type)
+ (point-max)))
+ (setq type (get-text-property pos 'gnus-date-type))
+ (when (memq type '(lapsed combined-lapsed user-defined))
+ (article-date-ut type t pos)
+ (setq end (or (next-single-property-change pos
+ 'gnus-date-type)
+ (point-max)))
+ (when window-start
+ (if (/= window-start next)
+ (setq window-start nil)
+ (set-window-start w end)))
+ (setq next end))
+ (setq pos next))
(goto-char (point-min))
(when (> old-column 0)
(setq old-line (1- old-line)))
(set dir-var (file-name-directory result)))
result))
-(defun gnus-article-archive-name (group)
+(defun gnus-article-archive-name (_group)
"Return the first instance of an \"Archive-name\" in the current buffer."
(let ((case-fold-search t))
(when (re-search-forward "archive-name: *\\([^ \n\t]+\\)[ \t]*$" nil t)
default
(or last-file default))))
-(defun gnus-plain-save-name (newsgroup headers &optional last-file)
+(defun gnus-plain-save-name (newsgroup _headers &optional last-file)
"Generate file name from NEWSGROUP, HEADERS, and optional LAST-FILE.
If variable `gnus-use-long-file-name' is non-nil, it is
~/News/news.group. Otherwise, it is like ~/News/news/group/news."
default-directory))
gnus-article-save-directory)))
-(defun gnus-sender-save-name (newsgroup headers &optional last-file)
+(defun gnus-sender-save-name (_newsgroup headers &optional _last-file)
"Generate file name from sender."
(let ((from (mail-header-from headers)))
(expand-file-name
(gnus-define-keys gnus-article-mode-map
" " gnus-article-goto-next-page
+ [?\S-\ ] gnus-article-goto-prev-page
"\177" gnus-article-goto-prev-page
[delete] gnus-article-goto-prev-page
- [backspace] gnus-article-goto-prev-page
"\C-c^" gnus-article-refer-article
"h" gnus-article-show-summary
"s" gnus-article-show-summary
(substitute-key-definition
'undefined 'gnus-article-read-summary-keys gnus-article-mode-map)
+(defvar gnus-article-send-map)
+
(gnus-define-keys (gnus-article-send-map "S" gnus-article-mode-map)
"W" gnus-article-wide-reply-with-original)
(if (featurep 'xemacs)
(defvar bookmark-make-record-function)
(defvar shr-put-image-function)
-(defun gnus-article-mode ()
+(define-derived-mode gnus-article-mode fundamental-mode "Article"
"Major mode for displaying an article.
All normal editing commands are switched off.
\\[gnus-article-mail]\t Send a reply to the address near point
\\[gnus-article-describe-briefly]\t Describe the current mode briefly
\\[gnus-info-find-node]\t Go to the Gnus info node"
- (interactive)
- (kill-all-local-variables)
(gnus-simplify-mode-line)
- (setq mode-name "Article")
- (setq major-mode 'gnus-article-mode)
(make-local-variable 'minor-mode-alist)
- (use-local-map gnus-article-mode-map)
(when (gnus-visual-p 'article-menu 'menu)
(gnus-article-make-menu-bar)
(when gnus-summary-tool-bar-map
(buffer-disable-undo)
(setq buffer-read-only t
show-trailing-whitespace nil)
- (set-syntax-table gnus-article-mode-syntax-table)
- (mm-enable-multibyte)
- (gnus-run-mode-hooks 'gnus-article-mode-hook))
+ (mm-enable-multibyte))
(defun gnus-article-setup-buffer ()
"Initialize the article buffer."
nil)
(error "Action aborted"))
t)))
- (with-current-buffer name
- (set (make-local-variable 'gnus-article-edit-mode) nil)
- (gnus-article-stop-animations)
- (when gnus-article-mime-handles
- (mm-destroy-parts gnus-article-mime-handles)
- (setq gnus-article-mime-handles nil))
- ;; Set it to nil in article-buffer!
- (setq gnus-article-mime-handle-alist nil)
- (buffer-disable-undo)
- (setq buffer-read-only t)
- (unless (eq major-mode 'gnus-article-mode)
- (gnus-article-mode))
+ (let ((summary gnus-summary-buffer))
+ (with-current-buffer name
+ (set (make-local-variable 'gnus-article-edit-mode) nil)
+ (gnus-article-stop-animations)
+ (when gnus-article-mime-handles
+ (mm-destroy-parts gnus-article-mime-handles)
+ (setq gnus-article-mime-handles nil))
+ ;; Set it to nil in article-buffer!
+ (setq gnus-article-mime-handle-alist nil)
+ (buffer-disable-undo)
+ (setq buffer-read-only t)
+ (unless (derived-mode-p 'gnus-article-mode)
+ (gnus-article-mode))
+ (set (make-local-variable 'gnus-summary-buffer) summary)
+ (setq truncate-lines gnus-article-truncate-lines)
+ (current-buffer)))
+ (let ((summary gnus-summary-buffer))
+ (with-current-buffer (gnus-get-buffer-create name)
+ (gnus-article-mode)
(setq truncate-lines gnus-article-truncate-lines)
- (current-buffer))
- (with-current-buffer (gnus-get-buffer-create name)
- (gnus-article-mode)
- (setq truncate-lines gnus-article-truncate-lines)
- (make-local-variable 'gnus-summary-buffer)
- (setq gnus-summary-buffer
- (gnus-summary-buffer-name gnus-newsgroup-name))
- (gnus-summary-set-local-parameters gnus-newsgroup-name)
- (when article-lapsed-timer
- (gnus-stop-date-timer))
- (when gnus-article-update-date-headers
- (gnus-start-date-timer gnus-article-update-date-headers))
- (current-buffer)))))
+ (set (make-local-variable 'gnus-summary-buffer) summary)
+ (gnus-summary-set-local-parameters gnus-newsgroup-name)
+ (when article-lapsed-timer
+ (gnus-stop-date-timer))
+ (when gnus-article-update-date-headers
+ (gnus-start-date-timer gnus-article-update-date-headers))
+ (current-buffer))))))
(defun gnus-article-stop-animations ()
(dolist (timer (and (boundp 'timer-list)
timer-list))
- (when (eq (elt timer 5) 'image-animate-timeout)
+ (when (eq (gnus-timer--function timer) 'image-animate-timeout)
(cancel-timer timer))))
(defun gnus-stop-downloads ()
(forward-line line)
(point)))))))
-(defun gnus-article-prepare (article &optional all-headers header)
+(defvar gnus-tmp-internal-hook)
+
+(defun gnus-article-prepare (article &optional all-headers _header)
"Prepare ARTICLE in article mode buffer.
ARTICLE should either be an article number or a Message-ID.
If ARTICLE is an id, HEADER should be the article headers.
If ALL-HEADERS is non-nil, no headers are hidden."
- (save-excursion
+ (save-excursion ;FIXME: Shouldn't that be save-current-buffer?
;; Make sure we start in a summary buffer.
- (unless (eq major-mode 'gnus-summary-mode)
+ (unless (derived-mode-p 'gnus-summary-mode)
(set-buffer gnus-summary-buffer))
(setq gnus-summary-buffer (current-buffer))
- (let* ((gnus-article (if header (mail-header-number header) article))
- (summary-buffer (current-buffer))
+ (let* ((summary-buffer (current-buffer))
(gnus-tmp-internal-hook gnus-article-internal-prepare-hook)
(group gnus-newsgroup-name)
result)
(gnus-run-hooks 'gnus-article-prepare-hook)
t))))))
+(defvar gnus-mime-display-attachment-buttons-in-header)
+
;;;###autoload
(defun gnus-article-prepare-display ()
"Make the current buffer look like a nice article."
(let ((gnus-article-buffer (current-buffer))
buffer-read-only
(inhibit-read-only t))
- (unless (eq major-mode 'gnus-article-mode)
+ (unless (derived-mode-p 'gnus-article-mode)
(gnus-article-mode))
(setq buffer-read-only nil
gnus-article-wash-types nil
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
"*"))
(if (and (gnus-buffer-live-p new-art-buf-name)
(with-current-buffer new-art-buf-name
- (eq major-mode 'gnus-sticky-article-mode)))
+ (derived-mode-p 'gnus-sticky-article-mode)))
(switch-to-buffer new-art-buf-name)
(setq new-art-buf-name (rename-buffer new-art-buf-name t)))
(gnus-sticky-article-mode))
(unless buffer
(setq buffer (current-buffer)))
(with-current-buffer buffer
- (when (eq major-mode 'gnus-sticky-article-mode)
+ (when (derived-mode-p 'gnus-sticky-article-mode)
(gnus-kill-buffer buffer))))
(defun gnus-kill-sticky-article-buffers (arg)
(interactive "P")
(dolist (buf (gnus-buffers))
(with-current-buffer buf
- (when (eq major-mode 'gnus-sticky-article-mode)
+ (when (derived-mode-p 'gnus-sticky-article-mode)
(if (not arg)
(gnus-kill-buffer buf)
(when (yes-or-no-p (concat "Kill buffer " (buffer-name buf) "? "))
General format specifiers can also be used. See Info node
`(gnus)Formatting Variables'.")
+(defvar gnus-tmp-type)
+(defvar gnus-tmp-type-long)
+(defvar gnus-tmp-name)
+(defvar gnus-tmp-description)
+(defvar gnus-tmp-id)
+(defvar gnus-tmp-length)
+(defvar gnus-tmp-dots)
+(defvar gnus-tmp-info)
+(defvar gnus-tmp-pressed-details)
+
(defvar gnus-mime-button-line-format-alist
'((?t gnus-tmp-type ?s)
(?T gnus-tmp-type-long ?s)
(defmacro gnus-bind-safe-url-regexp (&rest body)
"Bind `mm-w3m-safe-url-regexp' according to `gnus-safe-html-newsgroups'."
`(let ((mm-w3m-safe-url-regexp
- (let ((group (if (and (eq major-mode 'gnus-article-mode)
+ (let ((group (if (and (derived-mode-p 'gnus-article-mode)
(gnus-buffer-live-p
gnus-article-current-summary))
(with-current-buffer gnus-article-current-summary
(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))
(let ((gnus-mime-buttonized-part-id current-id))
(gnus-article-edit-done))
(gnus-configure-windows 'article)
+ (sit-for 0)
(when (and current-id (integerp gnus-auto-select-part))
(gnus-article-jump-to-part
(min (max (+ current-id gnus-auto-select-part) 1)
The current article has a complicated MIME structure, giving up..."))
(let* ((data (get-text-property (point) 'gnus-data))
(id (get-text-property (point) 'gnus-part))
- param
(handles gnus-article-mime-handles))
(unless file
(setq file
(switch-to-buffer (generate-new-buffer filename))
(if (or coding-system
(and charset
- (setq coding-system (mm-charset-to-coding-system charset))
+ (setq coding-system (mm-charset-to-coding-system
+ charset nil t))
(not (eq coding-system 'ascii))))
(progn
(mm-enable-multibyte)
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)
+ (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-insert-part handle)
- (setq contents
- (or (mm-decompress-buffer (mm-handle-filename handle) nil t)
- (buffer-string))))
+ (progn
+ (setq b (copy-marker b)
+ btn (copy-marker btn))
+ (mm-remove-part handle))
(cond
- ((not arg)
- (unless (setq charset (mail-content-type-get
- (mm-handle-type handle) 'charset))
- (unless (setq coding-system
- (mm-with-unibyte-buffer
- (insert contents)
- (mm-find-buffer-file-coding-system)))
- (setq charset gnus-newsgroup-charset))))
+ ((not arg) nil)
((numberp arg)
(if (mm-handle-undisplayer handle)
- (mm-remove-part handle))
- (setq charset
- (or (cdr (assq arg
- gnus-summary-show-article-charset-alist))
- (mm-read-coding-system "Charset: "))))
- (t
- (if (mm-handle-undisplayer handle)
- (mm-remove-part handle))))
- (forward-line 2)
- (mm-display-inline handle)
- (goto-char b)))))
+ (mm-remove-part handle)))
+ ((mm-handle-undisplayer handle)
+ (mm-remove-part handle)))
+ (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]'.
+ (when (markerp btn)
+ (setq btn (prog1 (marker-position btn)
+ (set-marker btn nil))))
+ (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 (overlays-in btn (point)))
+ (overlay-put ovl 'gnus-button-attachment-extra t)
+ (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)))))
+ (when (markerp b)
+ (setq b (prog1 (marker-position b)
+ (set-marker b nil))))
+ (goto-char b))))
(defun gnus-mime-set-charset-parameters (handle charset)
"Set CHARSET to parameters in HANDLE.
(interactive)
(gnus-article-check-buffer)
(let* ((handle (or handle (get-text-property (point) 'gnus-data)))
- (mm-user-display-methods nil)
(mm-inlined-types nil)
(mail-parse-charset gnus-newsgroup-charset)
(mail-parse-ignored-charsets
(gnus-mime-view-part-as-type
nil (lambda (type) (mm-inlinable-p handle type)))
(when handle
- (gnus-bind-safe-url-regexp (mm-display-part handle))))))
+ (gnus-bind-safe-url-regexp
+ (mm-display-part handle nil t))))))
(defun gnus-mime-action-on-part (&optional action)
"Do something with the MIME attachment at \(point\)."
(let ((handle (cdr (assq n gnus-article-mime-handle-alist))))
(when (gnus-article-goto-part n)
(if (equal (car handle) "multipart/alternative")
- (gnus-article-press-button)
+ (progn
+ (beginning-of-line) ;; Make it toggle subparts
+ (gnus-article-press-button))
(when (eq (gnus-mm-display-part handle) 'internal)
(gnus-set-window-start)))))))
"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-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 point (copy-marker point)
+ 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))))))
+ (when (markerp point)
+ (setq point (prog1 (marker-position point)
+ (set-marker point nil))))
(goto-char point)
- (gnus-delete-line)
- (gnus-insert-mime-button
- handle id (list (mm-handle-displayed-p 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 (overlays-in point (point)))
+ (overlay-put ovl 'gnus-button-attachment-extra t)
+ (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)
(when gnus-break-pages
(gnus-narrow-to-page))))
-(defun gnus-insert-mime-button (handle gnus-tmp-id &optional displayed)
+(defun gnus-insert-mime-button (handle id &optional displayed)
(let ((gnus-tmp-name
(or (mm-handle-filename handle)
(mail-content-type-get (mm-handle-type handle) 'url)
""))
+ (gnus-tmp-id id)
(gnus-tmp-type (mm-handle-media-type handle))
(gnus-tmp-description (or (mm-handle-description handle) ""))
(gnus-tmp-dots
(concat "; " gnus-tmp-name))))
(unless (equal gnus-tmp-description "")
(setq gnus-tmp-type-long (concat " --- " gnus-tmp-type-long)))
- (unless (bolp)
- (insert "\n"))
(setq b (point))
(gnus-eval-format
gnus-mime-button-line-format gnus-mime-button-line-format-alist
(1- (point))
(point)))
(when gnus-article-button-face
- (gnus-overlay-put (gnus-make-overlay b e nil t)
- 'face gnus-article-button-face))
+ (overlay-put (make-overlay b e nil t)
+ 'face gnus-article-button-face))
(widget-convert-button
'link b e
:mime-handle handle
"hide" "show")
(aref gnus-down-mouse-3 0))))))
-(defun gnus-widget-press-button (elems el)
+(defun gnus-widget-press-button (elems _el)
(goto-char (widget-get elems :from))
(gnus-article-press-button))
;; may change the point. So we set the window point.
(set-window-point window point)))
(let ((handles ihandles)
- (inhibit-read-only t)
- handle)
+ (inhibit-read-only t))
(cond (handles)
((setq handles (mm-dissect-buffer nil gnus-article-loose-mime))
(when gnus-article-emulate-mime
:group 'gnus-article-mime
:type 'boolean)
+(defcustom gnus-mime-display-attachment-buttons-in-header t
+ "Add attachment buttons in the end of the header of an article.
+Since MIME attachments tend to be put at the end of an article, we may
+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 "25.1"
+ :group 'gnus-article-mime
+ :type 'boolean)
+
(defun gnus-mime-display-part (handle)
(cond
;; Maybe a broken MIME message.
((and (equal (car handle) "multipart/related")
(not (or gnus-mime-display-multipart-as-mixed
gnus-mime-display-multipart-related-as-mixed)))
- ;;;!!!We should find the start part, but we just default
- ;;;!!!to the first part.
- ;;(gnus-mime-display-part (cadr handle))
- ;;;!!! Most multipart/related is an HTML message plus images.
- ;;;!!! Unfortunately we are unable to let W3 display those
- ;;;!!! included images, so we just display it as a mixed multipart.
- ;;(gnus-mime-display-mixed (cdr handle))
- ;;;!!! No, w3 can display everything just fine.
(gnus-mime-display-part (cadr handle)))
((equal (car handle) "multipart/signed")
(gnus-add-wash-type 'signed)
(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)
+ (unless (eobp) (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
(let* ((preferred (or preferred (mm-preferred-alternative handles)))
(ihandles handles)
(point (point))
- handle (inhibit-read-only t) from props begend not-pref)
+ handle (inhibit-read-only t) from begend not-pref)
(save-window-excursion
(save-restriction
(when ibegend
(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"
(not gnus-inhibit-hiding))
(gnus-article-hide-headers)))
-(declare-function shr-put-image "shr" (data alt))
+(declare-function shr-put-image "shr" (data alt &optional flags))
-(defun gnus-shr-put-image (data alt)
+(defun gnus-shr-put-image (data alt &optional flags)
"Put image DATA with a string ALT. Enable image to be deleted."
- (let ((image (shr-put-image data (propertize (or alt "*")
- 'gnus-image-category 'shr))))
+ (let ((image (if flags
+ (shr-put-image data (propertize (or alt "*")
+ 'gnus-image-category 'shr)
+ flags)
+ ;; Old `shr-put-image' doesn't take the optional `flags'
+ ;; argument.
+ (shr-put-image data (propertize (or alt "*")
+ 'gnus-image-category 'shr)))))
(when image
(gnus-add-image 'shr image))))
+(defun gnus-article-mime-handles (&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 (gnus-article-mime-handles
+ (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 (gnus-article-mime-handles
+ (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)))
+
+(defun gnus-mime-buttonize-attachments-in-header (&optional interactive)
+ "Show attachments as buttons in the end of the header of an article.
+This function toggles the display when called interactively. Note that
+buttons to be added to the header are only the ones that aren't inlined
+in the body. Use `gnus-header-face-alist' to highlight buttons."
+ (interactive (list t))
+ (gnus-with-article-buffer
+ (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 (and interactive buttons)
+ ;; Find buttons.
+ (setq buttons nil)
+ (dolist (button (gnus-article-mime-handles))
+ (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)
+ (forward-line -1)
+ (narrow-to-region (point) (point))
+ (insert "Attachment" (if (cdr buttons) "s" "") ":")
+ (dolist (button (nreverse buttons))
+ (setq st (point))
+ (insert " ")
+ (mm-handle-set-undisplayer (setq handle (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 (overlays-in (point-min) (point)))
+ (overlay-put ovl 'gnus-button-attachment-extra t)
+ (overlay-put ovl 'face nil))
+ (let ((gnus-treatment-function-alist
+ '((gnus-treat-highlight-headers
+ gnus-article-highlight-headers))))
+ (gnus-treat-article 'head)))))))))
+
;;; Article savers.
(defun gnus-output-to-file (file-name)
(if header-line-format 1 0)
2)))))))
+(defvar scroll-in-place)
+
(defun gnus-article-next-page-1 (lines)
(condition-case ()
(let ((scroll-in-place nil)
(defun gnus-article-check-buffer ()
"Beep if not in an article buffer."
- (unless (equal major-mode 'gnus-article-mode)
+ (unless (derived-mode-p 'gnus-article-mode)
(error "Command invoked outside of a Gnus article buffer")))
-(defun gnus-article-read-summary-keys (&optional arg key not-restore-window)
+(defvar gnus-pick-mode)
+
+(defun gnus-article-read-summary-keys (&optional _arg key not-restore-window)
"Read a summary buffer key sequence and execute it from the article buffer."
(interactive "P")
(gnus-article-check-buffer)
"An" "Ap" [?A (meta return)] [?A delete]))
(nosave-in-article
'("AS" "\C-d"))
- (up-to-top
- '("n" "Gn" "p" "Gp"))
keys new-sum-point)
(with-current-buffer gnus-article-current-summary
(let (gnus-pick-mode)
(ding)
(unless (member keys nosave-in-article)
(set-buffer gnus-article-current-summary))
- (when (get func 'disabled)
+ (when (and (symbolp func)
+ (get func 'disabled))
(error "Function %s disabled" func))
(call-interactively func)
(setq new-sum-point (point)))
(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))
new-sum-point
(window-live-p win)
(with-current-buffer (window-buffer win)
- (eq major-mode 'gnus-summary-mode)))
+ (derived-mode-p 'gnus-summary-mode)))
(set-window-point win new-sum-point)
(set-window-start win new-sum-start)
(set-window-hscroll win new-sum-hscroll))))
(with-current-buffer gnus-article-current-summary
(setq unread-command-events
(if (featurep 'xemacs)
- (append key nil)
- (mapcar (lambda (x) (if (and (integerp x) (>= x 128))
- (list 'meta (- x 128))
- x))
- key)))
+ (append key unread-command-events)
+ (nconc
+ (mapcar (lambda (x) (if (and (integerp x) (>= x 128))
+ (list 'meta (- x 128))
+ x))
+ key)
+ unread-command-events)))
(let ((cursor-in-echo-area t)
gnus-pick-mode)
(describe-key (read-key-sequence nil t))))
(with-current-buffer gnus-article-current-summary
(setq unread-command-events
(if (featurep 'xemacs)
- (append key nil)
- (mapcar (lambda (x) (if (and (integerp x) (>= x 128))
- (list 'meta (- x 128))
- x))
- key)))
+ (append key unread-command-events)
+ (nconc
+ (mapcar (lambda (x) (if (and (integerp x) (>= x 128))
+ (list 'meta (- x 128))
+ x))
+ key)
+ unread-command-events)))
(let ((cursor-in-echo-area t)
gnus-pick-mode)
(describe-key-briefly (read-key-sequence nil t) insert)))
;;`gnus-agent-mode' in gnus-agent.el will define it.
(defvar gnus-agent-summary-mode)
(defvar gnus-draft-mode)
-;; Calling help-buffer will autoload help-mode.
(defvar help-xref-stack-item)
-;; Emacs 22 doesn't load it in the batch mode.
-(eval-when-compile
- (autoload 'help-buffer "help-mode"))
+(defvar help-xref-following)
(defun gnus-article-describe-bindings (&optional prefix)
"Show a list of all defined keys, and their definitions.
(with-current-buffer ,(current-buffer)
(gnus-article-describe-bindings prefix)))
,prefix)))
+ ;; Loading `help-mode' here is necessary if `describe-bindings'
+ ;; is replaced with something, e.g. `helm-descbinds'.
+ (require 'help-mode)
(with-current-buffer (let (help-xref-following) (help-buffer))
(setq help-xref-stack-item item)))))
(gnus-article-hide-citation-maybe arg force)
(gnus-article-hide-signature arg))
-(defun gnus-article-maybe-highlight ()
- "Do some article highlighting if article highlighting is requested."
- (when (gnus-visual-p 'article-highlight 'highlight)
- (gnus-article-highlight-some)))
-
(defun gnus-check-group-server ()
;; Make sure the connection to the server is alive.
(unless (gnus-server-opened
(gnus-check-server (gnus-find-method-for-group gnus-newsgroup-name))
(gnus-request-group gnus-newsgroup-name t)))
-(eval-when-compile
- (autoload 'nneething-get-file-name "nneething"))
+(declare-function nneething-get-file-name "nneething" (id))
(defun gnus-request-article-this-buffer (article group)
"Get an article and insert it into this buffer."
(set-buffer buf))))))
(defun gnus-block-private-groups (group)
- (if (gnus-news-group-p group)
+ "Allows images in newsgroups to be shown, blocks images in all
+other groups."
+ (if (or (gnus-news-group-p group)
+ (gnus-member-of-valid 'global group))
;; Block nothing in news groups.
nil
;; Block everything anywhere else.
(let ((func gnus-article-edit-done-function)
(buf (current-buffer))
(start (window-start))
- (p (point))
(winconf gnus-prev-winconf))
(widen) ;; Widen it in case that users narrowed the buffer.
(funcall func arg)
"\\(?:"
;; Match paired parentheses, e.g. in Wikipedia URLs:
;; http://thread.gmane.org/47B4E3B2.3050402@gmail.com
- "[" chars punct "]+" "(" "[" chars punct "]+" "[" chars "]*)" "[" chars "]*"
+ "[" chars punct "]+" "(" "[" chars punct "]+" "[" chars "]*)"
+ "\\(?:" "[" chars punct "]+" "[" chars "]" "\\)?"
"\\|"
- "[" chars punct "]+" "[" chars "]"
+ "[" chars punct "]+" "[" chars "]"
"\\)"))
(concat ;; XEmacs 21.4 doesn't support POSIX.
"\\([-a-z0-9_=!?#$@~%&*+\\/:;.,]\\|\\w\\)+"
"\\([-a-z0-9_=#$@~%&*+\\/]\\|\\w\\)"))
"\\)")
"Regular expression that matches URLs."
+ :version "24.4"
:group 'gnus-article-buttons
:type 'regexp)
("/\\([a-z][-a-z0-9]+\\.el\\)\\>[^.?]"
;; Exclude [.?] for URLs in gmane.emacs.cvs
1 (>= gnus-button-emacs-level 8) gnus-button-handle-library 1)
- ("`\\([a-z][-a-z0-9]+\\.el\\)'"
+ ("['`‘]\\([a-z][-a-z0-9]+\\.el\\)['’]"
1 (>= gnus-button-emacs-level 8) gnus-button-handle-library 1)
- ("`\\([a-z][a-z0-9]+-[a-z0-9]+-[-a-z0-9]*[a-z]\\|\\(gnus\\|message\\)-[-a-z]+\\)'"
+ ("['`‘]\\([a-z][a-z0-9]+-[a-z0-9]+-[-a-z0-9]*[a-z]\\|\\(gnus\\|message\\)-[-a-z]+\\)['’]"
0 (>= gnus-button-emacs-level 8) gnus-button-handle-symbol 1)
- ("`\\([a-z][a-z0-9]+-[a-z]+\\)'"
+ ("['`‘]\\([a-z][a-z0-9]+-[a-z]+\\)['’]"
0 (>= gnus-button-emacs-level 9) gnus-button-handle-symbol 1)
("(setq[ \t\n]+\\([a-z][a-z0-9]+-[-a-z0-9]+\\)[ \t\n]+.+)"
1 (>= gnus-button-emacs-level 7) gnus-button-handle-describe-variable 1)
0 (>= gnus-button-emacs-level 1) gnus-button-handle-describe-function 2)
("\\b\\(C-h\\|<?[Ff]1>?\\)[ \t\n]+v[ \t\n]+\\([^ \t\n]+\\)[ \t\n]+RET\\>"
0 (>= gnus-button-emacs-level 1) gnus-button-handle-describe-variable 2)
- ("`\\(\\(C-h\\|<?[Ff]1>?\\)[ \t\n]+k[ \t\n]+\\([^']+\\)\\)'"
+ ("['`‘]\\(\\(C-h\\|<?[Ff]1>?\\)[ \t\n]+k[ \t\n]+\\([^'’]+\\)\\)['’]"
;; Unlike the other regexps we really have to require quoting
;; here to determine where it ends.
1 (>= gnus-button-emacs-level 1) gnus-button-handle-describe-key 3)
(gnus-article-add-buttons)
(gnus-article-add-buttons-to-head))
-(defun gnus-article-highlight-some (&optional force)
+(defun gnus-article-highlight-some (&optional _force)
"Highlight current article.
This function calls `gnus-article-highlight-headers',
`gnus-article-highlight-signature', and `gnus-article-add-buttons' to
(save-restriction
(when (and gnus-signature-face
(gnus-article-narrow-to-signature))
- (gnus-overlay-put (gnus-make-overlay (point-min) (point-max) nil t)
- 'face gnus-signature-face)
+ (overlay-put (make-overlay (point-min) (point-max) nil t)
+ 'face gnus-signature-face)
(widen)
(gnus-article-search-signature)
(let ((start (match-beginning 0))
(let (gnus-article-mouse-face widget-mouse-face)
(while points
(gnus-article-add-button (pop points) (pop points)
- 'gnus-button-push beg)))
- (let ((overlay (gnus-make-overlay start end)))
- (gnus-overlay-put overlay 'evaporate t)
- (gnus-overlay-put overlay 'gnus-button-url
- (list (mapconcat 'identity (nreverse url) "")))
+ 'gnus-button-push
+ (list beg (assq 'gnus-button-url-regexp
+ gnus-button-alist)))))
+ (let ((overlay (make-overlay start end)))
+ (overlay-put overlay 'evaporate t)
+ (overlay-put overlay 'gnus-button-url
+ (list (mapconcat 'identity (nreverse url) "")))
(when gnus-article-mouse-face
- (gnus-overlay-put overlay 'mouse-face gnus-article-mouse-face)))
+ (overlay-put overlay 'mouse-face gnus-article-mouse-face)))
t)
(goto-char opoint))))
(defun gnus-article-add-button (from to fun &optional data text)
"Create a button between FROM and TO with callback FUN and data DATA."
(when gnus-article-button-face
- (gnus-overlay-put (gnus-make-overlay from to nil t)
- 'face gnus-article-button-face))
+ (overlay-put (make-overlay from to nil t)
+ 'face gnus-article-button-face))
(gnus-add-text-properties
from to
(nconc (and gnus-article-mouse-face
(error "Unknown news URL syntax"))))
(list scheme server port group message-id articles)))
+(defvar nntp-port-number)
+
(defun gnus-button-handle-news (url)
"Fetch a news URL."
- (destructuring-bind (scheme server port group message-id articles)
+ (destructuring-bind (_scheme server port group message-id _articles)
(gnus-parse-news-url url)
(cond
(message-id
(with-current-buffer gnus-summary-buffer
(gnus-summary-refer-article message-id)))
-(defun gnus-button-fetch-group (address &rest ignore)
+(defun gnus-button-fetch-group (address &rest _ignore)
"Fetch GROUP specified by ADDRESS."
(when (string-match "\\`\\(nntp\\|news\\):\\(//\\)?\\(.*\\)\\'"
address)
(setq url (replace-regexp-in-string "\n" " " url))
(when (string-match "mailto:/*\\(.*\\)" url)
(setq url (substring url (match-beginning 1) nil)))
- (let (to args subject func)
- (setq args (gnus-url-parse-query-string
+ (let* ((args (gnus-url-parse-query-string
(if (string-match "^\\?" url)
(substring url 1)
(if (string-match "^\\([^?]+\\)\\?\\(.*\\)" url)
(concat "to=" (match-string 1 url) "&"
(match-string 2 url))
- (concat "to=" url))))
- subject (cdr-safe (assoc "subject" args)))
+ (concat "to=" url)))))
+ (subject (cdr-safe (assoc "subject" args)))
+ func)
(gnus-msg-mail)
(while args
(setq func (intern-soft (concat "message-goto-" (downcase (caar args)))))
(1- (point))
(point)))
(when gnus-article-button-face
- (gnus-overlay-put (gnus-make-overlay b e nil t)
- 'face gnus-article-button-face))
+ (overlay-put (make-overlay b e nil t)
+ 'face gnus-article-button-face))
(widget-convert-button
'link b e
:action 'gnus-button-prev-page
:button-keymap gnus-prev-page-map)))
-(defun gnus-button-next-page (&optional args more-args)
+(defun gnus-button-next-page (&optional _args _more-args)
"Go to the next page."
(interactive)
(let ((win (selected-window)))
(gnus-article-next-page)
(select-window win)))
-(defun gnus-button-prev-page (&optional args more-args)
+(defun gnus-button-prev-page (&optional _args _more-args)
"Go to the prev page."
(interactive)
(let ((win (selected-window)))
(1- (point))
(point)))
(when gnus-article-button-face
- (gnus-overlay-put (gnus-make-overlay b e nil t)
- 'face gnus-article-button-face))
+ (overlay-put (make-overlay b e nil t)
+ 'face gnus-article-button-face))
(widget-convert-button
'link b e
:action 'gnus-button-next-page
:button-keymap gnus-next-page-map)))
-(defun gnus-article-button-next-page (arg)
+(defun gnus-article-button-next-page (_arg)
"Go to the next page."
(interactive "P")
(let ((win (selected-window)))
(gnus-article-next-page)
(select-window win)))
-(defun gnus-article-button-prev-page (arg)
+(defun gnus-article-button-prev-page (_arg)
"Go to the prev page."
(interactive "P")
(let ((win (selected-window)))
(defvar gnus-inhibit-article-treatments nil)
-(defun gnus-treat-article (gnus-treat-condition
- &optional part-number total-parts gnus-treat-type)
- (let ((gnus-treat-length (- (point-max) (point-min)))
+;; Dynamic variables.
+(defvar part-number) ;FIXME: Lacks a "gnus-" prefix.
+(defvar total-parts) ;FIXME: Lacks a "gnus-" prefix.
+(defvar gnus-treat-type)
+(defvar gnus-treat-condition)
+(defvar gnus-treat-length)
+
+(defun gnus-treat-article (condition
+ &optional part-num total type)
+ (let ((gnus-treat-condition condition)
+ (part-number part-num)
+ (total-parts total)
+ (gnus-treat-type type)
+ (gnus-treat-length (- (point-max) (point-min)))
(alist gnus-treatment-function-alist)
(article-goto-body-goes-to-point-min-p t)
(treated-type
- (or (not gnus-treat-type)
+ (or (not type)
(catch 'found
(let ((list gnus-article-treat-types))
(while list
- (when (string-match (pop list) gnus-treat-type)
+ (when (string-match (pop list) type)
(throw 'found t)))))))
(highlightp (gnus-visual-p 'article-highlight 'highlight))
- val elem)
+ val)
(gnus-run-hooks 'gnus-part-display-hook)
(dolist (elem alist)
(setq val
(save-restriction
(funcall (cadr elem)))))))
-;; Dynamic variables.
-(defvar part-number)
-(defvar total-parts)
-(defvar gnus-treat-type)
-(defvar gnus-treat-condition)
-(defvar gnus-treat-length)
-
(defun gnus-treat-predicate (val)
(cond
((null val)
(not (gnus-treat-predicate (car val))))
((eq pred 'typep)
(equal (car val) gnus-treat-type))
+ ((functionp pred)
+ (funcall pred))
(t
(error "%S is not a valid predicate" pred)))))
((eq val t)
(gnus-mime-security-show-details handle)
(gnus-mime-security-verify-or-decrypt handle))))
-(defun gnus-insert-mime-security-button (handle &optional displayed)
+(defun gnus-insert-mime-security-button (handle &optional _displayed)
(let* ((protocol (mm-handle-multipart-ctl-parameter handle 'protocol))
(gnus-tmp-type
(concat
(1- (point))
(point)))
(when gnus-article-button-face
- (gnus-overlay-put (gnus-make-overlay b e nil t)
- 'face gnus-article-button-face))
+ (overlay-put (make-overlay b e nil t)
+ 'face gnus-article-button-face))
(widget-convert-button
'link b e
:mime-handle handle
:action 'gnus-widget-press-button
:button-keymap gnus-mime-security-button-map
:help-echo
- (lambda (widget)
+ (lambda (_widget)
;; Needed to properly clear the message due to a bug in
;; wid-edit (XEmacs only).
(when (boundp 'help-echo-owns-message)
gnus-mime-security-button-end-line-format))
(gnus-insert-mime-security-button handle)))
(mm-set-handle-multipart-parameter
- handle 'gnus-region
- (cons (set-marker (make-marker) (point-min))
- (set-marker (make-marker) (point-max))))
+ handle 'gnus-region (cons (point-min-marker) (point-max-marker)))
(goto-char (point-max))))
(defun gnus-mime-security-run-function (function)