;;; gnus-art.el --- article mode commands for Gnus
-;; Copyright (C) 1996-2013 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)
(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)
:type 'string
:group 'mime-security)
+(defvar idna-program)
+
(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."
(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.
(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)
(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))
"Find CID content in HANDLES and save it in a file in DIRECTORY.
Return file name."
(save-match-data
- (let (file type)
+ (let (file)
(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))
((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))
+ (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))))))))
((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 "<div align=\"left\">\n")
(goto-char (point-max))
(insert "</div>\n<hr>\n")
(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)
(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
(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
[?\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)
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 (derived-mode-p 'gnus-article-mode)
- (gnus-article-mode))
- (setq truncate-lines gnus-article-truncate-lines)
- (current-buffer))
+ (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)
(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 (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."
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
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)
(gnus-article-edit-article
`(lambda ()