T-gnus 6.16.4 revision 00.
[elisp/gnus.git-] / lisp / gnus-sum.el
index 9619691..4cf3076 100644 (file)
@@ -41,7 +41,6 @@
 (require 'gnus-undo)
 (require 'gnus-util)
 (require 'nnoo)
-(require 'mime-view)
 
 (eval-when-compile
   (require 'mime-play)
@@ -264,7 +263,12 @@ If threads are hidden, you have to run the command
 `gnus-summary-show-thread' by hand or use `gnus-select-article-hook'
 to expose hidden threads."
   :group 'gnus-thread
-  :type 'boolean)
+  :type '(radio (sexp :format "Non-nil\n"
+                     :match (lambda (widget value)
+                              (not (or (consp value) (functionp value))))
+                     :value t)
+               (const nil)
+               (sexp :tag "Predicate specifier" :size 0)))
 
 (defcustom gnus-thread-hide-killed t
   "*If non-nil, hide killed threads automatically."
@@ -977,7 +981,8 @@ default:      The default article score.
 default-high: The default score for high scored articles.
 default-low:  The default score for low scored articles.
 below:        The score below which articles are automatically marked as read.
-mark:         The articles mark."
+mark:         The article's mark.
+uncached:     Non-nil if the article is uncached."
   :group 'gnus-summary-visual
   :type '(repeat (cons (sexp :tag "Form" nil)
                       face)))
@@ -1108,7 +1113,7 @@ type of files to save."
 
 (defcustom gnus-read-all-available-headers nil
   "Whether Gnus should parse all headers made available to it.
-This is mostly relevant for slow backends where the user may
+This is mostly relevant for slow back ends where the user may
 wish to widen the summary buffer to include all headers
 that were fetched.  Say, for nnultimate groups."
   :group 'gnus-summary
@@ -2180,20 +2185,20 @@ gnus-summary-show-article-from-menu-as-charset-%s" cs))))
                gnus-article-outlook-deuglify-article t])
              )
             ("Output"
-             ["Save in default format" gnus-summary-save-article
+             ["Save in default format..." gnus-summary-save-article
               ,@(if (featurep 'xemacs) '(t)
                   '(:help "Save article using default method"))]
-             ["Save in file" gnus-summary-save-article-file
+             ["Save in file..." gnus-summary-save-article-file
               ,@(if (featurep 'xemacs) '(t)
                   '(:help "Save article in file"))]
-             ["Save in Unix mail format" gnus-summary-save-article-mail t]
-             ["Save in MH folder" gnus-summary-save-article-folder t]
-             ["Save in VM folder" gnus-summary-save-article-vm t]
-             ["Save in RMAIL mbox" gnus-summary-save-article-rmail t]
-             ["Save body in file" gnus-summary-save-article-body-file t]
-             ["Pipe through a filter" gnus-summary-pipe-output t]
+             ["Save in Unix mail format..." gnus-summary-save-article-mail t]
+             ["Save in MH folder..." gnus-summary-save-article-folder t]
+             ["Save in VM folder..." gnus-summary-save-article-vm t]
+             ["Save in RMAIL mbox..." gnus-summary-save-article-rmail t]
+             ["Save body in file..." gnus-summary-save-article-body-file t]
+             ["Pipe through a filter..." gnus-summary-pipe-output t]
              ["Add to SOUP packet" gnus-soup-add-article t]
-             ["Print with Muttprint" gnus-summary-muttprint t]
+             ["Print with Muttprint..." gnus-summary-muttprint t]
              ["Print" gnus-summary-print-article t])
             ("Backend"
              ["Respool article..." gnus-summary-respool-article t]
@@ -2627,7 +2632,7 @@ and backwards while displaying articles, type `\\[gnus-summary-next-unread-artic
 respectively.
 
 You can also post articles and send mail from this buffer.  To
-follow up an article, type `\\[gnus-summary-followup]'.         To mail a reply to the author
+follow up an article, type `\\[gnus-summary-followup]'.  To mail a reply to the author
 of an article, type `\\[gnus-summary-reply]'.
 
 There are approx. one gazillion commands you can execute in this
@@ -3274,7 +3279,7 @@ buffer that was in action when the last article was fetched."
                 gnus-unseen-mark)
                (t gnus-no-mark)))
         (gnus-tmp-downloaded
-         (cond (undownloaded 
+         (cond (undownloaded
                  gnus-undownloaded-mark)
                 (gnus-newsgroup-agentized
                  gnus-downloaded-mark)
@@ -3650,7 +3655,7 @@ If SHOW-ALL is non-nil, already read articles are also listed."
     (gnus-run-hooks 'gnus-summary-prepare-hook)))
 
 (defsubst gnus-general-simplify-subject (subject)
-  "Simply subject by the same rules as gnus-gather-threads-by-subject."
+  "Simplify subject by the same rules as `gnus-gather-threads-by-subject'."
   (setq subject
        (cond
         ;; Truncate the subject.
@@ -3977,6 +3982,13 @@ Returns HEADER if it was entered in the DEPENDENCIES.  Returns nil otherwise."
             (setq heads nil)))))
      gnus-newsgroup-dependencies)))
 
+(defsubst gnus-remove-odd-characters (string)
+  "Translate STRING into something that doesn't contain weird characters."
+  (mm-subst-char-in-string
+   ?\r ?\-
+   (mm-subst-char-in-string
+    ?\n ?\- string)))
+
 ;; This function has to be called with point after the article number
 ;; on the beginning of the line.
 (defsubst gnus-nov-parse-line (number dependencies &optional force-new)
@@ -4086,7 +4098,7 @@ the id of the parent article (if any)."
            (forward-line 1)))))))
 
 (defun gnus-summary-update-article-line (article header)
-  "Update the line for ARTICLE using HEADERS."
+  "Update the line for ARTICLE using HEADER."
   (let* ((id (mail-header-id header))
         (thread (gnus-id-to-thread id)))
     (unless thread
@@ -4102,7 +4114,7 @@ the id of the parent article (if any)."
       (let ((inserted (- (point)
                          (progn
                            (gnus-summary-insert-line
-                            header level nil 
+                            header level nil
                             (memq article gnus-newsgroup-undownloaded)
                             (gnus-article-mark article)
                             (memq article gnus-newsgroup-replied)
@@ -4129,7 +4141,7 @@ the id of the parent article (if any)."
                            (point)))))
         (when (cdr datal)
           (gnus-data-update-list
-           (cdr datal) 
+           (cdr datal)
            (- (gnus-data-pos data) (gnus-data-pos (cadr datal)) inserted)))))))
 
 (defun gnus-summary-update-article (article &optional iheader)
@@ -4527,10 +4539,10 @@ Unscored articles will be counted as having a score of zero."
           (mapcar
            (lambda (header)
              (setq previous-time
-                   (time-to-seconds
-                    (condition-case ()
-                        (mail-header-parse-date (mail-header-date header))
-                      (error previous-time)))))
+                   (condition-case ()
+                       (time-to-seconds (mail-header-parse-date
+                                         (mail-header-date header)))
+                     (error previous-time))))
            (sort
             (message-flatten-list thread)
             (lambda (h1 h2)
@@ -4568,17 +4580,17 @@ Unscored articles will be counted as having a score of zero."
 (defcustom gnus-sum-thread-tree-root "> "
   "With %B spec, used for the root of a thread.
 If nil, use subject instead."
-  :type 'string
+  :type '(radio (const :format "%v  " nil) (string :size 0))
   :group 'gnus-thread)
 (defcustom gnus-sum-thread-tree-false-root "> "
   "With %B spec, used for a false root of a thread.
 If nil, use subject instead."
-  :type 'string
+  :type '(radio (const :format "%v  " nil) (string :size 0))
   :group 'gnus-thread)
 (defcustom gnus-sum-thread-tree-single-indent ""
   "With %B spec, used for a thread with just one message.
 If nil, use subject instead."
-  :type 'string
+  :type '(radio (const :format "%v  " nil) (string :size 0))
   :group 'gnus-thread)
 (defcustom gnus-sum-thread-tree-vertical "| "
   "With %B spec, used for drawing a vertical line."
@@ -4821,7 +4833,7 @@ or a straight list of headers."
                    gnus-unseen-mark)
                   (t gnus-no-mark))
             gnus-tmp-downloaded
-             (cond ((memq number gnus-newsgroup-undownloaded) 
+             (cond ((memq number gnus-newsgroup-undownloaded)
                     gnus-undownloaded-mark)
                    (gnus-newsgroup-agentized
                     gnus-downloaded-mark)
@@ -5030,7 +5042,7 @@ If SELECT-ARTICLES, only select those articles from GROUP."
             (gnus-set-active group (cons (caar alist) (cdr active)))))
 
       (setq gnus-summary-use-undownloaded-faces
-            (not (gnus-agent-find-parameter 
+            (not (gnus-agent-find-parameter
                   group
                   'agent-disable-undownloaded-faces))))
 
@@ -5347,7 +5359,7 @@ If SELECT-ARTICLES, only select those articles from GROUP."
       'list))
 
 (defun gnus-article-unpropagatable-p (mark)
-  "Return whether MARK should be propagated to backend."
+  "Return whether MARK should be propagated to back end."
   (memq mark gnus-article-unpropagated-mark-lists))
 
 (defun gnus-adjust-marked-articles (info)
@@ -5714,6 +5726,7 @@ The resulting hash table is returned, or nil if no Xrefs were found."
       ;; Translate all TAB characters into SPACE characters.
       (subst-char-in-region (point-min) (point-max) ?\t ?  t)
       (subst-char-in-region (point-min) (point-max) ?\r ?  t)
+      (ietf-drums-unfold-fws)
       (gnus-run-hooks 'gnus-parse-headers-hook)
       (let ((case-fold-search t)
            in-reply-to header p lines chars ctype)
@@ -6113,7 +6126,7 @@ If EXCLUDE-GROUP, do not go to this group."
                  (if unread
                      (progn
                        (while data
-                          (unless (memq (gnus-data-number (car data)) 
+                          (unless (memq (gnus-data-number (car data))
                                         (cond
                                         ((eq gnus-auto-goto-ignores
                                              'always-undownloaded)
@@ -6363,7 +6376,7 @@ displayed, no centering will be performed."
 
 (defun gnus-summary-toggle-truncation (&optional arg)
   "Toggle truncation of summary lines.
-With arg, turn line truncation on if arg is positive."
+With ARG, turn line truncation on if ARG is positive."
   (interactive "P")
   (setq truncate-lines
        (if (null arg) (not truncate-lines)
@@ -6833,7 +6846,7 @@ If prefix argument NO-ARTICLE is non-nil, no article is selected initially."
   "Go to the first subject satisfying any non-nil constraint.
 If UNREAD is non-nil, the article should be unread.
 If UNDOWNLOADED is non-nil, the article should be undownloaded.
-If UNSEED is non-nil, the article should be unseen.
+If UNSEEN is non-nil, the article should be unseen.
 Returns the article selected or nil if there are no matching articles."
   (interactive "P")
   (cond
@@ -6858,7 +6871,7 @@ Returns the article selected or nil if there are no matching articles."
                                  (and unseen
                                       (memq num gnus-newsgroup-unseen)))))))
         (setq data (cdr data)))
-      (prog1 
+      (prog1
           (if data
               (progn
                 (goto-char (gnus-data-pos (car data)))
@@ -7038,6 +7051,7 @@ be displayed."
   (interactive)
   (let ((mm-verify-option 'known)
        (mm-decrypt-option 'known)
+       (gnus-article-emulate-mime t)
        (gnus-buttonized-mime-types (append (list "multipart/signed"
                                                  "multipart/encrypted")
                                            gnus-buttonized-mime-types)))
@@ -7433,7 +7447,7 @@ is a number, it is the line the article is to be displayed on."
     t))
   (prog1
       (if (and (stringp article)
-              (string-match "@" article))
+              (string-match "@\\|%40" article))
          (gnus-summary-refer-article article)
        (when (stringp article)
          (setq article (string-to-number article)))
@@ -7702,7 +7716,7 @@ article."
       (gnus-summary-position-point))))
 
 (defun gnus-summary-insert-dormant-articles ()
-  "Insert all the dormat articles for this group into the current buffer."
+  "Insert all the dormant articles for this group into the current buffer."
   (interactive)
   (let ((gnus-verbose (max 6 gnus-verbose)))
     (if (not gnus-newsgroup-dormant)
@@ -7855,7 +7869,7 @@ If ALL, mark even excluded ticked and dormants as read."
   thread)
 
 (defun gnus-cut-threads (threads)
-  "Cut off all uninteresting articles from the beginning of threads."
+  "Cut off all uninteresting articles from the beginning of THREADS."
   (when (or (eq gnus-fetch-old-headers 'some)
            (eq gnus-fetch-old-headers 'invisible)
            (numberp gnus-fetch-old-headers)
@@ -8025,7 +8039,8 @@ The difference between N and the number of articles fetched is returned."
            (set-buffer gnus-original-article-buffer)
            (nnheader-narrow-to-headers)
            (unless (setq ref (message-fetch-field "references"))
-             (setq ref (message-fetch-field "in-reply-to")))
+             (when (setq ref (message-fetch-field "in-reply-to"))
+               (setq ref (gnus-extract-message-id-from-in-reply-to ref))))
            (widen))
        (setq ref
              ;; It's not the current article, so we take a bet on
@@ -8088,7 +8103,7 @@ of what's specified by the `gnus-refer-thread-limit' variable."
                                       gnus-newsgroup-name limit))
              'nov)
          (gnus-build-all-threads)
-       (error "Can't fetch thread from backends that don't support NOV"))
+       (error "Can't fetch thread from back ends that don't support NOV"))
       (gnus-message 5 "Fetching headers for %s...done" gnus-newsgroup-name))
     (gnus-summary-limit-include-thread id)))
 
@@ -8097,12 +8112,16 @@ of what's specified by the `gnus-refer-thread-limit' variable."
   (interactive "sMessage-ID: ")
   (when (and (stringp message-id)
             (not (zerop (length message-id))))
+    (setq message-id (gnus-replace-in-string message-id " " ""))
     ;; Construct the correct Message-ID if necessary.
     ;; Suggested by tale@pawl.rpi.edu.
     (unless (string-match "^<" message-id)
       (setq message-id (concat "<" message-id)))
     (unless (string-match ">$" message-id)
       (setq message-id (concat message-id ">")))
+    ;; People often post MIDs from URLs, so unhex it:
+    (unless (string-match "@" message-id)
+      (setq message-id (gnus-url-unhex-string message-id)))
     (let* ((header (gnus-id-to-header message-id))
           (sparse (and header
                        (gnus-summary-article-sparse-p
@@ -8188,6 +8207,7 @@ to guess what the document format is."
           (ogroup gnus-newsgroup-name)
           (params (append (gnus-info-params (gnus-get-info ogroup))
                           (list (cons 'to-group ogroup))
+                          (list (cons 'parent-group ogroup))
                           (list (cons 'save-article-group ogroup))))
           (case-fold-search t)
           (buf (current-buffer))
@@ -8386,7 +8406,7 @@ If BACKWARD, search backward instead."
                       gnus-treat-highlight-citation
                       gnus-treat-highlight-signature
                       gnus-treat-overstrike
-                      gnus-treat-display-xface
+                      gnus-treat-display-x-face
                       gnus-treat-buttonize-head
                       gnus-treat-decode-article-as-default-mime-charset))
                    (static-if (featurep 'xemacs)
@@ -8394,8 +8414,8 @@ If BACKWARD, search backward instead."
                      (cons '(x-face-mule-delete-x-face-field
                              (quote never))
                            items))))
-                (gnus-treat-display-xface
-                 (when (, x-face) gnus-treat-display-xface)))
+                (gnus-treat-display-x-face
+                 (when (, x-face) gnus-treat-display-x-face)))
             (gnus-article-prepare-mime-display)))
         (goto-char (if (, backward) start end))
         (when (, x-face)
@@ -8603,7 +8623,7 @@ article.  If BACKWARD (the prefix) is non-nil, search backward instead."
   (gnus-eval-in-buffer-window gnus-article-buffer
     (widen)
     (goto-char (point-min))
-    (when gnus-page-broken
+    (when gnus-break-pages
       (gnus-narrow-to-page))))
 
 (defun gnus-summary-end-of-article ()
@@ -8615,7 +8635,9 @@ article.  If BACKWARD (the prefix) is non-nil, search backward instead."
     (widen)
     (goto-char (point-max))
     (recenter -3)
-    (when gnus-page-broken
+    (when gnus-break-pages
+      (when (re-search-backward page-delimiter nil t)
+       (narrow-to-region (match-end 0) (point-max)))
       (gnus-narrow-to-page))))
 
 (defun gnus-summary-print-truncate-and-quote (string &optional len)
@@ -8649,14 +8671,15 @@ to save in."
        (progn
          (copy-to-buffer buffer (point-min) (point-max))
          (set-buffer buffer)
-         (gnus-article-delete-invisible-text)
          (gnus-remove-text-with-property 'gnus-decoration)
          (when (gnus-visual-p 'article-highlight 'highlight)
            ;; Copy-to-buffer doesn't copy overlay.  So redo
            ;; highlight.
            (let ((gnus-article-buffer buffer))
              (gnus-article-highlight-citation t)
-             (gnus-article-highlight-signature)))
+             (gnus-article-highlight-signature)
+             (gnus-article-emphasize)
+             (gnus-article-delete-invisible-text)))
          (let ((ps-left-header
                 (list
                  (concat "("
@@ -8801,10 +8824,12 @@ If ARG is a negative number, hide the unwanted header lines."
        (widen)
        (if window
            (set-window-start window (goto-char (point-min))))
-       (setq gnus-page-broken
-             (when gnus-break-pages
-               (gnus-narrow-to-page)
-               t))
+       (if gnus-break-pages
+           (gnus-narrow-to-page)
+         (when (gnus-visual-p 'page-marker)
+           (let ((buffer-read-only nil))
+             (gnus-remove-text-with-property 'gnus-prev)
+             (gnus-remove-text-with-property 'gnus-next))))
        (gnus-set-mode-line 'article)))))
 
 (defun gnus-summary-show-all-headers ()
@@ -8916,9 +8941,6 @@ ACTION can be either `move' (the default), `crosspost' or `copy'."
                 (crosspost "Crosspost" "Crossposting")))
        (copy-buf (save-excursion
                    (nnheader-set-temp-buffer " *copy article*")))
-       (default-marks gnus-article-mark-lists)
-       (no-expire-marks (delete '(expirable . expire)
-                                (copy-sequence gnus-article-mark-lists)))
        art-group to-method new-xref article to-groups)
     (unless (assq action names)
       (error "Unknown action %s" action))
@@ -9049,8 +9071,9 @@ ACTION can be either `move' (the default), `crosspost' or `copy'."
 
            ;; See whether the article is to be put in the cache.
            (let ((marks (if (gnus-group-auto-expirable-p to-group)
-                            default-marks
-                          no-expire-marks))
+                            gnus-article-mark-lists
+                          (delete '(expirable . expire)
+                                  (copy-sequence gnus-article-mark-lists))))
                  (to-article (cdr art-group)))
 
              ;; Enter the article into the cache in the new group,
@@ -9113,9 +9136,9 @@ ACTION can be either `move' (the default), `crosspost' or `copy'."
               article gnus-newsgroup-name (current-buffer))))
 
          ;; run the move/copy/crosspost/respool hook
-         (run-hook-with-args 'gnus-summary-article-move-hook 
+         (run-hook-with-args 'gnus-summary-article-move-hook
                              action
-                             (gnus-data-header 
+                             (gnus-data-header
                               (assoc article (gnus-data-list nil)))
                              gnus-newsgroup-name
                              to-newsgroup
@@ -9402,7 +9425,7 @@ confirmation before the articles are deleted."
        (unless (memq (car articles) not-deleted)
          (gnus-summary-mark-article (car articles) gnus-canceled-mark))
        (let* ((article (car articles))
-              (id (mail-header-id (gnus-data-header 
+              (id (mail-header-id (gnus-data-header
                                    (assoc article (gnus-data-list nil))))))
          (run-hook-with-args 'gnus-summary-article-delete-hook
                              'delete id gnus-newsgroup-name nil
@@ -9548,15 +9571,13 @@ groups."
     (gnus-summary-select-article)
     (save-excursion
       (set-buffer gnus-original-article-buffer)
-      (save-restriction
-       (message-narrow-to-head)
-       (let ((groups (nnmail-article-group 'identity trace)))
-         (unless silent
-           (if groups
-               (message "This message would go to %s"
-                        (mapconcat 'car groups ", "))
-             (message "This message would go to no groups"))
-           groups))))))
+      (let ((groups (nnmail-article-group 'identity trace)))
+       (unless silent
+         (if groups
+             (message "This message would go to %s"
+                      (mapconcat 'car groups ", "))
+           (message "This message would go to no groups"))
+         groups)))))
 
 (defun gnus-summary-respool-trace ()
   "Trace where the respool algorithm would put this article.
@@ -9972,7 +9993,7 @@ If NO-EXPIRE, auto-expiry will be inhibited."
 (defun gnus-summary-update-download-mark (article)
   "Update the download mark."
   (gnus-summary-update-mark
-   (cond ((memq article gnus-newsgroup-undownloaded) 
+   (cond ((memq article gnus-newsgroup-undownloaded)
           gnus-undownloaded-mark)
          (gnus-newsgroup-agentized
           gnus-downloaded-mark)
@@ -11055,13 +11076,17 @@ If REVERSE, save parts that do not match TYPE."
              (not (string-match type (mm-handle-media-type handle)))
            (string-match type (mm-handle-media-type handle)))
       (let ((file (expand-file-name
-                  (file-name-nondirectory
-                   (or
-                    (mail-content-type-get
-                     (mm-handle-disposition handle) 'filename)
-                    (concat gnus-newsgroup-name
-                            "." (number-to-string
-                                 (cdr gnus-article-current)))))
+                  (gnus-map-function
+                   mm-file-name-rewrite-functions
+                   (file-name-nondirectory
+                    (or
+                     (mail-content-type-get
+                      (mm-handle-disposition handle) 'filename)
+                     (mail-content-type-get
+                      (mm-handle-type handle) 'name)
+                     (concat gnus-newsgroup-name
+                             "." (number-to-string
+                                  (cdr gnus-article-current))))))
                   dir)))
        (unless (file-exists-p file)
          (mm-save-part-to-file handle file))))))
@@ -11293,7 +11318,7 @@ If REVERSE, save parts that do not match TYPE."
 (defvar gnus-summary-highlight-line-trigger nil)
 
 (defun gnus-summary-highlight-line-0 ()
-  (if (and (eq gnus-summary-highlight-line-trigger 
+  (if (and (eq gnus-summary-highlight-line-trigger
                gnus-summary-highlight)
            gnus-summary-highlight-line-cached)
       gnus-summary-highlight-line-cached