Synch with Oort Gnus.
[elisp/gnus.git-] / lisp / gnus-sum.el
index 2441e5b..7846ca6 100644 (file)
@@ -1046,6 +1046,11 @@ that were fetched.  Say, for nnultimate groups."
   :group 'gnus-summary
   :type '(choice boolean regexp))
 
+(defcustom gnus-summary-muttprint-program "muttprint"
+  "Command (and optional arguments) used to run Muttprint."
+  :group 'gnus-summary
+  :type 'string)
+
 ;;; Internal variables
 
 (defvar gnus-summary-display-cache nil)
@@ -1130,7 +1135,9 @@ that were fetched.  Say, for nnultimate groups."
        ?c)
     (?u gnus-tmp-user-defined ?s)
     (?P (gnus-pick-line-number) ?d)
-    (?B gnus-tmp-thread-tree-header-string ?s))
+    (?B gnus-tmp-thread-tree-header-string ?s)
+    (user-date (gnus-user-date
+               ,(macroexpand '(mail-header-date gnus-tmp-header))) ?s))
   "An alist of format specifications that can appear in summary lines.
 These are paired with what variables they correspond with, along with
 the type of the variable (string, integer, character, etc).")
@@ -1319,7 +1326,19 @@ end position and text.")
   "Variables that are buffer-local to the summary buffers.")
 
 (defvar gnus-newsgroup-variables nil
-  "Variables that have separate values in the newsgroups.")
+  "A list of variables that have separate values in different newsgroups.
+A list of newsgroup (summary buffer) local variables, or cons of
+variables and their default values (when the default values are not
+nil), that should be made global while the summary buffer is active.
+These variables can be used to set variables in the group parameters
+while still allowing them to affect operations done in other
+buffers. For example:
+
+\(setq gnus-newsgroup-variables
+     '(message-use-followup-to
+       (gnus-visible-headers .
+        \"^From:\\\\|^Newsgroups:\\\\|^Subject:\\\\|^Date:\\\\|^To:\")))
+")
 
 ;; Byte-compiler warning.
 (eval-when-compile (defvar gnus-article-mode-map))
@@ -1549,6 +1568,7 @@ increase the score of each group you read."
     gnus-mouse-2 gnus-mouse-pick-article
     "m" gnus-summary-mail-other-window
     "a" gnus-summary-post-news
+    "i" gnus-summary-news-other-window
     "x" gnus-summary-limit-to-unread
     "s" gnus-summary-isearch-article
     "t" gnus-article-toggle-headers
@@ -1723,8 +1743,7 @@ increase the score of each group you read."
     "m" gnus-summary-toggle-mime
     "a" gnus-article-strip-headers-in-body ;; mnemonic: wash archive
     "p" gnus-article-verify-x-pgp-sig
-    "d" gnus-article-treat-dumbquotes
-    "s" gnus-smiley-display)
+    "d" gnus-article-treat-dumbquotes)
 
   (gnus-define-keys (gnus-summary-wash-hide-map "W" gnus-summary-wash-map)
     "a" gnus-article-hide
@@ -1799,6 +1818,7 @@ increase the score of each group you read."
     "h" gnus-summary-save-article-folder
     "v" gnus-summary-save-article-vm
     "p" gnus-summary-pipe-output
+    "P" gnus-summary-muttprint
     "s" gnus-soup-add-article)
 
   (gnus-define-keys (gnus-summary-mime-map "K" gnus-summary-mode-map)
@@ -1917,6 +1937,7 @@ increase the score of each group you read."
              ["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" gnus-summary-print-article t])
             ("Backend"
              ["Respool article..." gnus-summary-respool-article t]
@@ -2001,7 +2022,7 @@ increase the score of each group you read."
     (easy-menu-define
      gnus-summary-post-menu gnus-summary-mode-map ""
      `("Post"
-       ["Post an article" gnus-summary-post-news
+       ["Send a message (mail or news)" gnus-summary-post-news
        ,@(if (featurep 'xemacs) '(t)
            '(:help "Post an article"))]
        ["Followup" gnus-summary-followup
@@ -2027,6 +2048,7 @@ increase the score of each group you read."
        ["Resend message" gnus-summary-resend-message t]
        ["Send bounced mail" gnus-summary-resend-bounced-mail t]
        ["Send a mail" gnus-summary-mail-other-window t]
+       ["Create a local message" gnus-summary-news-other-window t]
        ["Uuencode and post" gnus-uu-post-news
        ,@(if (featurep 'xemacs) '(t)
            '(:help "Post a uuencoded article"))]
@@ -2078,7 +2100,7 @@ increase the score of each group you read."
        ["Age..." gnus-summary-limit-to-age t]
        ["Extra..." gnus-summary-limit-to-extra t]
        ["Score" gnus-summary-limit-to-score t]
-       ["Score" gnus-summary-limit-to-display-predicate t]
+       ["Display Predicate" gnus-summary-limit-to-display-predicate t]
        ["Unread" gnus-summary-limit-to-unread t]
        ["Non-dormant" gnus-summary-limit-exclude-dormant t]
        ["Articles" gnus-summary-limit-to-articles t]
@@ -2766,7 +2788,7 @@ display only a single character."
 
 (defun gnus-summary-buffer-name (group)
   "Return the summary buffer name of GROUP."
-  (concat "*Summary " group "*"))
+  (concat "*Summary " (gnus-group-decoded-name group) "*"))
 
 (defun gnus-summary-setup-buffer (group)
   "Initialize summary buffer."
@@ -4567,10 +4589,32 @@ If SELECT-ARTICLES, only select those articles from GROUP."
     (let ((display (gnus-group-find-parameter group 'display)))
       (setq gnus-newsgroup-display
            (cond
+            ((not (zerop (or (car-safe read-all) 0)))
+             ;; The user entered the group with C-u SPC/RET, let's show
+             ;; all articles.
+             'gnus-not-ignore)
             ((eq display 'all)
              'gnus-not-ignore)
             ((arrayp display)
              (gnus-summary-display-make-predicate (mapcar 'identity display)))
+            ((numberp display)
+             ;; The following is probably the "correct" solution, but
+             ;; it makes Gnus fetch all headers and then limit the
+             ;; articles (which is slow), so instead we hack the
+             ;; select-articles parameter instead. -- Simon Josefsson
+             ;; <jas@kth.se>
+             ;;
+             ;; (gnus-byte-compile
+             ;;  `(lambda () (> number ,(- (cdr (gnus-active group))
+             ;;                         display)))))
+             (setq select-articles
+                   (gnus-uncompress-range
+                    (cons (let ((tmp (- (cdr (gnus-active group)) display)))
+                            (if (> tmp 0)
+                                tmp
+                              1))
+                          (cdr (gnus-active group)))))
+             nil)
             (t
              nil))))
 
@@ -5152,6 +5196,7 @@ The resulting hash table is returned, or nil if no Xrefs were found."
             (gnus-info-set-marks ',info ',(gnus-info-marks info) t)
             (gnus-info-set-read ',info ',(gnus-info-read info))
             (gnus-get-unread-articles-in-group ',info (gnus-active ,group))
+            (gnus-request-set-mark ,group (list (list ',range 'del '(read))))
             (gnus-group-update-group ,group t))))
       ;; Add the read articles to the range.
       (gnus-info-set-read info range)
@@ -6837,24 +6882,35 @@ If given a prefix, remove all limits."
       (gnus-summary-limit nil 'pop)
     (gnus-summary-position-point)))
 
-(defun gnus-summary-limit-to-subject (subject &optional header)
-  "Limit the summary buffer to articles that have subjects that match a regexp."
-  (interactive "sLimit to subject (regexp): ")
+(defun gnus-summary-limit-to-subject (subject &optional header not-matching)
+  "Limit the summary buffer to articles that have subjects that match a regexp.
+If NOT-MATCHING, excluding articles that have subjects that match a regexp."
+  (interactive
+   (list (read-string (if current-prefix-arg
+                         "Exclude subject (regexp): "
+                       "Limit to subject (regexp): "))
+        nil current-prefix-arg))
   (unless header
     (setq header "subject"))
   (when (not (equal "" subject))
     (prog1
        (let ((articles (gnus-summary-find-matching
-                        (or header "subject") subject 'all)))
+                        (or header "subject") subject 'all nil nil
+                        not-matching)))
          (unless articles
            (error "Found no matches for \"%s\"" subject))
          (gnus-summary-limit articles))
       (gnus-summary-position-point))))
 
-(defun gnus-summary-limit-to-author (from)
-  "Limit the summary buffer to articles that have authors that match a regexp."
-  (interactive "sLimit to author (regexp): ")
-  (gnus-summary-limit-to-subject from "from"))
+(defun gnus-summary-limit-to-author (from &optional not-matching)
+  "Limit the summary buffer to articles that have authors that match a regexp.
+If NOT-MATCHING, excluding articles that have authors that match a regexp."
+  (interactive
+   (list (read-string (if current-prefix-arg
+                         "Exclude author (regexp): "
+                       "Limit to author (regexp): "))
+        current-prefix-arg))
+  (gnus-summary-limit-to-subject from "from" not-matching))
 
 (defun gnus-summary-limit-to-age (age &optional younger-p)
   "Limit the summary buffer to articles that are older than (or equal) AGE days.
@@ -6894,25 +6950,31 @@ articles that are younger than AGE days."
        (gnus-summary-limit (nreverse articles)))
     (gnus-summary-position-point)))
 
-(defun gnus-summary-limit-to-extra (header regexp)
+(defun gnus-summary-limit-to-extra (header regexp &optional not-matching)
   "Limit the summary buffer to articles that match an 'extra' header."
   (interactive
    (let ((header
          (intern
           (gnus-completing-read
            (symbol-name (car gnus-extra-headers))
-           "Limit extra header:"
+           (if current-prefix-arg
+               "Exclude extra header:"
+             "Limit extra header:")
            (mapcar (lambda (x)
                      (cons (symbol-name x) x))
                    gnus-extra-headers)
            nil
            t))))
      (list header
-          (read-string (format "Limit to header %s (regexp): " header)))))
+          (read-string (format "%s header %s (regexp): "
+                               (if current-prefix-arg "Exclude" "Limit to")
+                               header))
+          current-prefix-arg)))
   (when (not (equal "" regexp))
     (prog1
        (let ((articles (gnus-summary-find-matching
-                        (cons 'extra header) regexp 'all)))
+                        (cons 'extra header) regexp 'all nil nil
+                        not-matching)))
          (unless articles
            (error "Found no matches for \"%s\"" regexp))
          (gnus-summary-limit articles))
@@ -6922,7 +6984,7 @@ articles that are younger than AGE days."
   "Limit the summary buffer to the predicated in the `display' group parameter."
   (interactive)
   (unless gnus-newsgroup-display
-    (error "There is no `diplay' group parameter"))
+    (error "There is no `display' group parameter"))
   (let (articles)
     (dolist (number gnus-newsgroup-articles)
       (when (funcall gnus-newsgroup-display)
@@ -6982,12 +7044,9 @@ Returns how many articles were removed."
        (gnus-summary-limit articles))
     (gnus-summary-position-point)))
 
-(defun gnus-summary-limit-to-score (&optional score)
+(defun gnus-summary-limit-to-score (score)
   "Limit to articles with score at or above SCORE."
-  (interactive "P")
-  (setq score (if score
-                 (prefix-numeric-value score)
-               (or gnus-summary-default-score 0)))
+  (interactive "NLimit to articles with score of at least: ")
   (let ((data gnus-newsgroup-data)
        articles)
     (while data
@@ -7814,13 +7873,14 @@ fetched headers for, whether they are displayed or not."
     (nreverse articles)))
 
 (defun gnus-summary-find-matching (header regexp &optional backward unread
-                                         not-case-fold)
+                                         not-case-fold not-matching)
   "Return a list of all articles that match REGEXP on HEADER.
 The search stars on the current article and goes forwards unless
 BACKWARD is non-nil.  If BACKWARD is `all', do all articles.
 If UNREAD is non-nil, only unread articles will
 be taken into consideration.  If NOT-CASE-FOLD, case won't be folded
-in the comparisons."
+in the comparisons. If NOT-MATCHING, return a list of all articles that
+not match REGEXP on HEADER."
   (let ((case-fold-search (not not-case-fold))
        articles d func)
     (if (consp header)
@@ -7841,8 +7901,12 @@ in the comparisons."
       (when (and (or (not unread)      ; We want all articles...
                     (gnus-data-unread-p d)) ; Or just unreads.
                 (vectorp (gnus-data-header d)) ; It's not a pseudo.
-                (string-match regexp
-                              (funcall func (gnus-data-header d)))) ; Match.
+                (if not-matching
+                    (not (string-match
+                          regexp
+                          (funcall func (gnus-data-header d))))
+                  (string-match regexp
+                                (funcall func (gnus-data-header d)))))
        (push (gnus-data-number d) articles))) ; Success!
     (nreverse articles)))
 
@@ -7900,6 +7964,13 @@ article.  If BACKWARD (the prefix) is non-nil, search backward instead."
     (when gnus-page-broken
       (gnus-narrow-to-page))))
 
+(defun gnus-summary-print-truncate-and-quote (string &optional len)
+  "Truncate to LEN and quote all \"(\"'s in STRING."
+  (gnus-replace-in-string (if (and len (> (length string) len))
+                             (substring string 0 len)
+                           string)
+                         "[()]" "\\\\\\&"))
+
 (defun gnus-summary-print-article (&optional filename n)
   "Generate and print a PostScript image of the N next (mail) articles.
 
@@ -7929,9 +8000,13 @@ to save in."
              (let ((ps-left-header
                     (list
                      (concat "("
-                             (mail-header-subject gnus-current-headers) ")")
+                             (gnus-summary-print-truncate-and-quote
+                              (mail-header-subject gnus-current-headers)
+                              66) ")")
                      (concat "("
-                             (mail-header-from gnus-current-headers) ")")))
+                             (gnus-summary-print-truncate-and-quote
+                              (mail-header-from gnus-current-headers)
+                              45) ")")))
                    (ps-right-header
                     (list
                      "/pagenumberstring load"
@@ -7947,12 +8022,13 @@ to save in."
   (ps-despool filename))
 
 (defun gnus-summary-show-article (&optional arg)
-  "Force re-fetching of the current article.
+  "Force redisplaying of the current article.
 If ARG (the prefix) is a number, show the article with the charset
 defined in `gnus-summary-show-article-charset-alist', or the charset
 input.
 If ARG (the prefix) is non-nil and not a number, show the raw article
-without any article massaging functions being run."
+without any article massaging functions being run.  Normally, the key strokes
+are `C-u g'."
   (interactive "P")
   (cond
    ((numberp arg)
@@ -7970,16 +8046,22 @@ without any article massaging functions being run."
          (gnus-newsgroup-ignored-charsets 'gnus-all))
       (gnus-summary-select-article nil 'force)
       (let ((deps gnus-newsgroup-dependencies)
-           head header)
+           head header lines)
        (save-excursion
          (set-buffer gnus-original-article-buffer)
          (save-restriction
            (message-narrow-to-head)
-           (setq head (buffer-string)))
+           (setq head (buffer-string))
+           (goto-char (point-min))
+           (unless (re-search-forward "^lines:[ \t]\\([0-9]+\\)" nil t)
+             (goto-char (point-max))
+             (widen)
+             (setq lines (1- (count-lines (point) (point-max))))))
          (with-temp-buffer
            (insert (format "211 %d Article retrieved.\n"
                            (cdr gnus-article-current)))
            (insert head)
+           (if lines (insert (format "Lines: %d\n" lines)))
            (insert ".\n")
            (let ((nntp-server-buffer (current-buffer)))
              (setq header (car (gnus-get-newsgroup-headers deps t))))))
@@ -8203,7 +8285,7 @@ ACTION can be either `move' (the default), `crosspost' or `copy'."
                      (mail-header-xref (gnus-summary-article-header article))
                      " ")))
           (setq new-xref (concat (gnus-group-real-name gnus-newsgroup-name)
-                                 ":" article))
+                                 ":" (number-to-string article)))
           (unless xref
             (setq xref (list (system-name))))
           (setq new-xref
@@ -8220,7 +8302,8 @@ ACTION can be either `move' (the default), `crosspost' or `copy'."
                                (gnus-request-accept-article
                                 to-newsgroup select-method (not articles))))
               (setq new-xref (concat new-xref " " (car art-group)
-                                     ":" (cdr art-group)))
+                                     ":"
+                                     (number-to-string (cdr art-group))))
               ;; Now we have the new Xrefs header, so we insert
               ;; it and replace the new article.
               (nnheader-replace-header "Xref" new-xref)
@@ -8330,12 +8413,10 @@ ACTION can be either `move' (the default), `crosspost' or `copy'."
          (gnus-summary-mark-article article gnus-canceled-mark))))
       (gnus-summary-remove-process-mark article))
     ;; Re-activate all groups that have been moved to.
-    (while to-groups
-      (save-excursion
-       (set-buffer gnus-group-buffer)
-       (when (gnus-group-goto-group (car to-groups) t)
-         (gnus-group-get-new-news-this-group 1 t))
-       (pop to-groups)))
+    (save-excursion
+      (set-buffer gnus-group-buffer)
+      (let ((gnus-group-marked to-groups))
+       (gnus-group-get-new-news-this-group nil t)))
 
     (gnus-kill-buffer copy-buf)
     (gnus-summary-position-point)
@@ -8355,10 +8436,9 @@ re-spool using this method."
   (gnus-summary-move-article n nil nil 'crosspost))
 
 (defcustom gnus-summary-respool-default-method nil
-  "Default method for respooling an article.
+  "Default method type for respooling an article.
 If nil, use to the current newsgroup method."
-  :type '(choice (gnus-select-method :value (nnml ""))
-                (const nil))
+  :type 'symbol
   :group 'gnus-summary-mail)
 
 (defun gnus-summary-respool-article (&optional n method)
@@ -9900,7 +9980,9 @@ The variable `gnus-default-article-saver' specifies the saver function."
            (gnus-message 1 "Article %d is unsaveable" article))
        ;; This is a real article.
        (save-window-excursion
-         (gnus-summary-select-article t nil nil article))
+         (let ((gnus-display-mime-function nil)
+               (gnus-article-prepare-hook nil))
+           (gnus-summary-select-article t nil nil article)))
        (save-excursion
          (set-buffer save-buffer)
          (erase-buffer)
@@ -9984,6 +10066,17 @@ save those articles instead."
   (let ((gnus-default-article-saver 'gnus-summary-save-body-in-file))
     (gnus-summary-save-article arg)))
 
+(defun gnus-summary-muttprint (&optional arg)
+  "Print the current article using Muttprint.
+If N is a positive number, save the N next articles.
+If N is a negative number, save the N previous articles.
+If N is nil and any articles have been marked with the process mark,
+save those articles instead."
+  (interactive "P")
+  (require 'gnus-art)
+  (let ((gnus-default-article-saver 'gnus-summary-pipe-to-muttprint))
+    (gnus-summary-save-article arg t)))
+
 (defun gnus-summary-pipe-message (program)
   "Pipe the current article through PROGRAM."
   (interactive "sProgram: ")