nnimap.el (nnimap-find-expired-articles): nnimap `never' expiration fix
[gnus] / lisp / gnus-art.el
index bc164ca..533874d 100644 (file)
@@ -1,6 +1,6 @@
 ;;; 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
@@ -24,9 +24,6 @@
 
 ;;; 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)
@@ -257,7 +254,13 @@ This can also be a list of the above values."
                 (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)
@@ -1624,8 +1627,11 @@ It is a string, such as \"PGP\". If nil, ask user."
   :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."
@@ -1838,7 +1844,7 @@ Initialized from `text-mode-syntax-table.")
        (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.
@@ -2408,7 +2414,7 @@ long lines if and only if arg is positive."
       (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)
@@ -2458,7 +2464,7 @@ long lines if and only if arg is positive."
          (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)
@@ -2666,7 +2672,7 @@ If READ-CHARSET, ask for a coding system."
                            (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.
@@ -2697,7 +2703,8 @@ If READ-CHARSET, ask for a coding system."
          (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))
@@ -2790,11 +2797,14 @@ summary buffer."
   "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))
@@ -2802,11 +2812,12 @@ Return file name."
           ((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))))))))
 
@@ -2892,6 +2903,13 @@ message header will be added to the bodies of the \"text/html\" parts."
                                          ((match-beginning 3) "&amp;")
                                          (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 "&nbsp;")))
+                  (goto-char (point-min))
                   (insert "<div align=\"left\">\n")
                   (goto-char (point-max))
                   (insert "</div>\n<hr>\n")
@@ -2909,7 +2927,7 @@ message header will be added to the bodies of the \"text/html\" parts."
                     (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)))
@@ -2917,7 +2935,8 @@ message header will be added to the bodies of the \"text/html\" parts."
                         (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)
@@ -3066,7 +3085,7 @@ images if any to the browser, and deletes them when exiting the group
        (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)
@@ -3380,7 +3399,7 @@ means show, 0 means toggle."
        '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)
@@ -3419,7 +3438,7 @@ lines forward."
                     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."
@@ -3427,7 +3446,6 @@ 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
@@ -3966,7 +3984,7 @@ This format is defined by the `gnus-article-time-format' variable."
       (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)
@@ -4198,7 +4216,7 @@ If variable `gnus-use-long-file-name' is non-nil, it is
        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."
@@ -4211,7 +4229,7 @@ If variable `gnus-use-long-file-name' is non-nil, it is
          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
@@ -4383,7 +4401,6 @@ If variable `gnus-use-long-file-name' is non-nil, it is
   [?\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
@@ -4409,6 +4426,8 @@ If variable `gnus-use-long-file-name' is non-nil, it is
 (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)
@@ -4538,20 +4557,22 @@ commands:
                         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)
@@ -4590,18 +4611,19 @@ commands:
           (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)
@@ -4700,6 +4722,8 @@ If ALL-HEADERS is non-nil, no headers are hidden."
            (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."
@@ -4715,7 +4739,10 @@ If ALL-HEADERS is non-nil, no headers are hidden."
          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
@@ -4820,6 +4847,16 @@ Valid specifiers include:
 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)
@@ -4974,7 +5011,6 @@ and `gnus-mime-delete-part', and not provided at run-time normally."
     (gnus-article-edit-article
      `(lambda ()