*** empty log message ***
[gnus] / lisp / gnus.el
index 2d0e98e..3dbff5c 100644 (file)
@@ -31,9 +31,9 @@
 (require 'mail-utils)
 (require 'timezone)
 (require 'nnheader)
-(require 'message)
 (require 'nnmail)
 (require 'backquote)
+(require 'nnoo)
 
 (eval-when-compile (require 'cl))
 
@@ -149,6 +149,27 @@ It's probably not a very effective to change this variable once you've
 run Gnus once.  After doing that, you must edit this server from the
 server buffer.")
 
+(defvar gnus-message-archive-group nil
+  "*Name of the group in which to save the messages you've written.
+This can either be a string, a list of strings; or an alist
+of regexps/functions/forms to be evaluated to return a string (or a list
+of strings).  The functions are called with the name of the current
+group (or nil) as a parameter.
+
+If you want to save your mail in one group and the news articles you
+write in another group, you could say something like:
+
+ \(setq gnus-message-archive-group 
+        '((if (message-news-p)
+              \"misc-news\" 
+            \"misc-mail\")))
+
+Normally the group names returned by this variable should be
+unprefixed -- which implictly means \"store on the archive server\".
+However, you may wish to store the message on some other server.  In
+that case, just return a fully prefixed name of the group --
+\"nnml+private:mail.misc\", for instance.")
+
 (defvar gnus-refer-article-method nil
   "*Preferred method for fetching an article by Message-ID.
 If you are reading news from the local spool (with nnspool), fetching
@@ -204,8 +225,8 @@ This will most commonly be on a remote machine, and the file will be
 fetched by ange-ftp.
 
 This variable can also be a list of directories.  In that case, the
-first element in the list will be used by default, and the others will
-be used as backup sites.
+first element in the list will be used by default.  The others can
+be used when being prompted for a site.
 
 Note that Gnus uses an aol machine as the default directory.  If this
 feels fundamentally unclean, just think of it as a way to finally get
@@ -486,7 +507,7 @@ If this variable is `fuzzy', Gnus will use a fuzzy algorithm when
 comparing subjects.")
 
 (defvar gnus-simplify-ignored-prefixes nil
-  "*Regexp, matches for which are removed from subject lines when simplifying.")
+  "*Regexp, matches for which are removed from subject lines when simplifying fuzzily.")
 
 (defvar gnus-build-sparse-threads nil
   "*If non-nil, fill in the gaps in threads.
@@ -864,7 +885,6 @@ beginning of a line.")
        '(vertical 1.0
                 (summary 0.25 point)
                 (if gnus-carpal '(summary-carpal 4))
-                (if gnus-use-trees '(tree 0.25))
                 (article 1.0)))))
     (server
      (vertical 1.0
@@ -1314,12 +1334,20 @@ See `gnus-thread-score-function' for en explanation of what a
   "^nnml\\|^nnfolder\\|^nnmbox\\|^nnmh\\|^nnbabyl"
   "*All new groups that match this regexp will be subscribed automatically.
 Note that this variable only deals with new groups.  It has no effect
-whatsoever on old groups.")
+whatsoever on old groups.
+
+New groups that match this regexp will not be handled by
+`gnus-subscribe-newsgroup-method'.  Instead, they will
+be subscribed using `gnus-subscribe-options-newsgroup-method'.")
 
 (defvar gnus-options-subscribe nil
   "*All new groups matching this regexp will be subscribed unconditionally.
 Note that this variable deals only with new newsgroups.         This variable
-does not affect old newsgroups.")
+does not affect old newsgroups.
+
+New groups that match this regexp will not be handled by
+`gnus-subscribe-newsgroup-method'.  Instead, they will
+be subscribed using `gnus-subscribe-options-newsgroup-method'.")
 
 (defvar gnus-options-not-subscribe nil
   "*All new groups matching this regexp will be ignored.
@@ -1369,6 +1397,9 @@ It calls `gnus-summary-expire-articles' by default.")
 (defvar gnus-summary-exit-hook nil
   "*A hook called on exit from the summary buffer.")
 
+(defvar gnus-check-bogus-groups-hook nil
+  "A hook run after removing bogus groups.")
+
 (defvar gnus-group-catchup-group-hook nil
   "*A hook run when catching up a group from the group buffer.")
 
@@ -1730,7 +1761,7 @@ variable (string, integer, character, etc).")
   "gnus-bug@ifi.uio.no (The Gnus Bugfixing Girls + Boys)"
   "The mail address of the Gnus maintainers.")
 
-(defconst gnus-version-number "5.2.25"
+(defconst gnus-version-number "5.2.32"
   "Version number for this version of Gnus.")
 
 (defconst gnus-version (format "Gnus v%s" gnus-version-number)
@@ -2013,7 +2044,7 @@ Thank you for your help in stamping out bugs.
       gnus-group-brew-soup gnus-brew-soup gnus-soup-add-article
       gnus-soup-send-replies gnus-soup-save-areas gnus-soup-pack-packet)
      ("nnsoup" nnsoup-pack-replies)
-     ("gnus-scomo" :interactive t gnus-score-mode)
+     ("score-mode" :interactive t gnus-score-mode)
      ("gnus-mh" gnus-mh-mail-setup gnus-summary-save-article-folder
       gnus-Folder-save-name gnus-folder-save-name)
      ("gnus-mh" :interactive t gnus-summary-save-in-folder)
@@ -2096,7 +2127,8 @@ Thank you for your help in stamping out bugs.
       gnus-summary-mail-forward gnus-summary-mail-other-window
       gnus-bug)
      ("gnus-picon" :interactive t gnus-article-display-picons
-      gnus-group-display-picons gnus-picons-article-display-x-face)
+      gnus-group-display-picons gnus-picons-article-display-x-face
+      gnus-picons-display-x-face)
      ("gnus-gl" bbb-login bbb-logout bbb-grouplens-group-p 
       gnus-grouplens-mode)
      ("smiley" :interactive t gnus-smiley-display)
@@ -3013,7 +3045,8 @@ If variable `gnus-use-long-file-name' is non-nil, it is
        (setq groupkey
              (if (string-match "^\\(.*\\)\\.[^.]+$" groupkey)
                  (substring groupkey (match-beginning 1) (match-end 1)))))
-      (gnus-subscribe-newsgroup newgroup before))))
+      (gnus-subscribe-newsgroup newgroup before))
+    (kill-buffer (current-buffer))))
 
 (defun gnus-subscribe-interactively (group)
   "Subscribe the new GROUP interactively.
@@ -3212,6 +3245,10 @@ If RE-ONLY is non-nil, strip leading `Re:'s only."
        gnus-server-alist nil
        gnus-group-list-mode nil
        gnus-opened-servers nil
+       gnus-group-mark-positions nil
+       gnus-newsgroup-data nil
+       gnus-newsgroup-unreads nil
+       nnoo-state-alist nil
        gnus-current-select-method nil)
   (gnus-shutdown 'gnus)
   ;; Kill the startup file.
@@ -3801,7 +3838,7 @@ simple-first is t, first argument is already simplified."
     (apply 'format args)))
 
 (defun gnus-error (level &rest args)
-  "Beep an error if `gnus-verbose' is on LEVEL or less."
+  "Beep an error if LEVEL is equal to or less than `gnus-verbose'."
   (when (<= (floor level) gnus-verbose)
     (apply 'message args)
     (ding)
@@ -4187,7 +4224,7 @@ Note: LIST has to be sorted over `<'."
     "V" gnus-version
     "s" gnus-group-save-newsrc
     "z" gnus-group-suspend
-    "Z" gnus-group-clear-dribble
+;    "Z" gnus-group-clear-dribble
     "q" gnus-group-exit
     "Q" gnus-group-quit
     "?" gnus-group-describe-briefly
@@ -4465,7 +4502,8 @@ prompt the user for the name of an NNTP server to use."
            (setcar (cddr entry) (gnus-byte-code 'gnus-tmp-func)))))
 
       (push (cons 'version emacs-version) gnus-format-specs)
-
+      ;; Mark the .newsrc.eld file as "dirty".
+      (gnus-dribble-enter " ")
       (gnus-message 7 "Compiling user specs...done"))))
 
 (defun gnus-indent-rigidly (start end arg)
@@ -4751,6 +4789,20 @@ If REGEXP, only list groups matching REGEXP."
       (pop opened))
     out))
 
+(defun gnus-archive-server-wanted-p ()
+  "Say whether the user wants to use the archive server."
+  (cond 
+   ((or (not gnus-message-archive-method)
+       (not gnus-message-archive-group))
+    nil)
+   ((and gnus-message-archive-method gnus-message-archive-group)
+    t)
+   (t
+    (let ((active (cadr (assq 'nnfolder-active-file
+                             gnus-message-archive-method))))
+      (and active
+          (file-exists-p active))))))
+
 (defun gnus-group-prefixed-name (group method)
   "Return the whole name from GROUP and METHOD."
   (and (stringp method) (setq method (gnus-server-to-method method)))
@@ -5462,15 +5514,15 @@ Returns whether the fetching was successful or not."
                                             group gnus-active-hashtb))))
       (and b (goto-char b)))))
 
-(defun gnus-group-next-group (n)
+(defun gnus-group-next-group (n &optional silent)
   "Go to next N'th newsgroup.
 If N is negative, search backward instead.
 Returns the difference between N and the number of skips actually
 done."
   (interactive "p")
-  (gnus-group-next-unread-group n t))
+  (gnus-group-next-unread-group n t nil silent))
 
-(defun gnus-group-next-unread-group (n &optional all level)
+(defun gnus-group-next-unread-group (n &optional all level silent)
   "Go to next N'th unread newsgroup.
 If N is negative, search backward instead.
 If ALL is non-nil, choose any newsgroup, unread or not.
@@ -5486,8 +5538,10 @@ made."
                (gnus-group-search-forward
                 backward (or (not gnus-group-goto-unread) all) level))
       (setq n (1- n)))
-    (if (/= 0 n) (gnus-message 7 "No more%s newsgroups%s" (if all "" " unread")
-                              (if level " on this level or higher" "")))
+    (when (and (/= 0 n)
+              (not silent))
+      (gnus-message 7 "No more%s newsgroups%s" (if all "" " unread")
+                   (if level " on this level or higher" "")))
     n))
 
 (defun gnus-group-prev-group (n)
@@ -6404,8 +6458,10 @@ is returned."
     (let* ((prev gnus-newsrc-alist)
           (alist (cdr prev)))
       (while alist
-       (if (= (gnus-info-level level) level)
-           (setcdr prev (cdr alist))
+       (if (= (gnus-info-level (car alist)) level)
+           (progn
+             (push (gnus-info-group (car alist)) gnus-killed-list)
+             (setcdr prev (cdr alist)))
          (setq prev alist))
        (setq alist (cdr alist)))
       (gnus-make-hashtable-from-newsrc-alist)
@@ -6526,7 +6582,10 @@ If N is negative, this group and the N-1 previous groups will be checked."
            (unless (gnus-virtual-group-p group)
              (gnus-close-group group))
            (gnus-group-update-group group))
-       (gnus-error 3 "%s error: %s" group (gnus-status-message group))))
+       (if (eq (gnus-server-status (gnus-find-method-for-group group))
+               'denied)
+           (gnus-error "Server denied access")
+         (gnus-error 3 "%s error: %s" group (gnus-status-message group)))))
     (when beg (goto-char beg))
     (when gnus-goto-next-group-when-activating
       (gnus-group-next-unread-group 1 t))
@@ -6558,18 +6617,17 @@ If N is negative, this group and the N-1 previous groups will be checked."
 (defun gnus-group-describe-group (force &optional group)
   "Display a description of the current newsgroup."
   (interactive (list current-prefix-arg (gnus-group-group-name)))
-  (when (and force
-            gnus-description-hashtb)
-    (gnus-sethash group nil gnus-description-hashtb))
-  (let ((method (gnus-find-method-for-group group))
-       desc)
+  (let* ((method (gnus-find-method-for-group group))
+        (mname (gnus-group-prefixed-name "" method))
+        desc)
+    (when (and force
+              gnus-description-hashtb)
+      (gnus-sethash mname nil gnus-description-hashtb))
     (or group (error "No group name given"))
     (and (or (and gnus-description-hashtb
                  ;; We check whether this group's method has been
                  ;; queried for a description file.
-                 (gnus-gethash
-                  (gnus-group-prefixed-name "" method)
-                  gnus-description-hashtb))
+                 (gnus-gethash mname gnus-description-hashtb))
             (setq desc (gnus-group-get-description group))
             (gnus-read-descriptions-file method))
         (gnus-message 1
@@ -7199,6 +7257,8 @@ The following commands are available:
   (make-local-variable 'gnus-summary-line-format)
   (make-local-variable 'gnus-summary-line-format-spec)
   (make-local-variable 'gnus-summary-mark-positions)
+  (gnus-make-local-hook 'post-command-hook)
+  (gnus-add-hook 'post-command-hook 'gnus-clear-inboxes-moved nil t)
   (run-hooks 'gnus-summary-mode-hook))
 
 (defun gnus-summary-make-local-variables ()
@@ -7815,7 +7875,7 @@ If NO-DISPLAY, don't generate a summary buffer."
        (cond (gnus-newsgroup-dormant
               (gnus-summary-limit-include-dormant))
              ((and gnus-newsgroup-scored show-all)
-              (gnus-summary-limit-include-expunged))))
+              (gnus-summary-limit-include-expunged t))))
       ;; Function `gnus-apply-kill-file' must be called in this hook.
       (run-hooks 'gnus-apply-kill-hook)
       (if (and (zerop (buffer-size))
@@ -8426,11 +8486,16 @@ Unscored articles will be counted as having a score of zero."
   ;; This function find the total score of the thread below ROOT.
   (setq root (car root))
   (apply gnus-thread-score-function
-        (or (cdr (assq (mail-header-number root) gnus-newsgroup-scored))
-            gnus-summary-default-score 0)
-        (mapcar 'gnus-thread-total-score
-                (cdr (gnus-gethash (mail-header-id root)
-                                   gnus-newsgroup-dependencies)))))
+        (or (append
+             (mapcar 'gnus-thread-total-score
+                     (cdr (gnus-gethash (mail-header-id root)
+                                        gnus-newsgroup-dependencies)))
+                (if (> (mail-header-number root) 0)
+                    (list (or (cdr (assq (mail-header-number root) 
+                                         gnus-newsgroup-scored))
+                              gnus-summary-default-score 0))))
+            (list gnus-summary-default-score)
+            '(0))))
 
 ;; Added by Per Abrahamsen <amanda@iesd.auc.dk>.
 (defvar gnus-tmp-prev-subject nil)
@@ -8555,7 +8620,8 @@ or a straight list of headers."
           ;; If the article lies outside the current limit,
           ;; then we do not display it.
           ((and (not (memq number gnus-newsgroup-limit))
-                (not gnus-tmp-dummy-line))
+                ;(not gnus-tmp-dummy-line)
+                )
            (setq gnus-tmp-gathered
                  (nconc (mapcar
                          (lambda (h) (mail-header-number (car h)))
@@ -8936,7 +9002,7 @@ If READ-ALL is non-nil, all articles in the group are selected."
         (min (car active))
         (max (cdr active))
         (types gnus-article-mark-lists)
-        (uncompressed '(score bookmark))
+        (uncompressed '(score bookmark killed))
         marks var articles article mark)
 
     (while marked-lists
@@ -8952,12 +9018,12 @@ If READ-ALL is non-nil, all articles in the group are selected."
       ;; All articles have to be subsets of the active articles.
       (cond
        ;; Adjust "simple" lists.
-       ((memq mark '(tick dormant expirable reply killed save))
+       ((memq mark '(tick dormant expirable reply save))
        (while articles
          (when (or (< (setq article (pop articles)) min) (> article max))
            (set var (delq article (symbol-value var))))))
        ;; Adjust assocs.
-       ((memq mark '(score bookmark))
+       ((memq mark uncompressed)
        (while articles
          (when (or (not (consp (setq article (pop articles))))
                    (< (car article) min)
@@ -10400,8 +10466,7 @@ If BACKWARD, the previous article is selected instead of the next."
    ;; If not, we try the first unread, if that is wanted.
    ((and subject
         gnus-auto-select-same
-        (or (gnus-summary-first-unread-article)
-            (eq (gnus-summary-article-mark) gnus-canceled-mark)))
+        (gnus-summary-first-unread-article))
     (gnus-summary-position-point)
     (gnus-message 6 "Wrapped"))
    ;; Try to get next/previous article not displayed in this group.
@@ -10872,6 +10937,7 @@ If ALL, mark even excluded ticked and dormants as read."
   (setq gnus-newsgroup-limit articles)
   (let ((total (length gnus-newsgroup-data))
        (data (gnus-data-find-list (gnus-summary-article-number)))
+       (gnus-summary-mark-below nil)   ; Inhibit this.
        found)
     ;; This will do all the work of generating the new summary buffer
     ;; according to the new limit.
@@ -11840,9 +11906,11 @@ groups."
   (interactive)
   (if (gnus-group-read-only-p)
       (progn
-       (gnus-summary-edit-article-postpone)
-       (gnus-error
-        1 "The current newsgroup does not support article editing."))
+       (let ((beep (not (eq major-mode 'text-mode))))
+         (gnus-summary-edit-article-postpone)
+         (when beep
+           (gnus-error
+            3 "The current newsgroup does not support article editing."))))
     (let ((buf (format "%s" (buffer-string))))
       (erase-buffer)
       (insert buf)
@@ -12442,7 +12510,7 @@ even ticked and dormant ones."
 
 ;; Suggested by Daniel Quinlan <quinlan@best.com>.
 (defalias 'gnus-summary-show-all-expunged 'gnus-summary-limit-include-expunged)
-(defun gnus-summary-limit-include-expunged ()
+(defun gnus-summary-limit-include-expunged (&optional no-error)
   "Display all the hidden articles that were expunged for low scores."
   (interactive)
   (gnus-set-global-variables)
@@ -12455,11 +12523,14 @@ even ticked and dormant ones."
                 (< (cdar scored) gnus-summary-expunge-below)
                 (setq headers (cons h headers))))
        (setq scored (cdr scored)))
-      (or headers (error "No expunged articles hidden."))
-      (goto-char (point-min))
-      (gnus-summary-prepare-unthreaded (nreverse headers)))
-    (goto-char (point-min))
-    (gnus-summary-position-point)))
+      (if (not headers)
+         (when (not no-error)
+           (error "No expunged articles hidden."))
+       (goto-char (point-min))
+       (gnus-summary-prepare-unthreaded (nreverse headers))
+       (goto-char (point-min))
+       (gnus-summary-position-point)
+       t))))
 
 (defun gnus-summary-catchup (&optional all quietly to-here not-mark)
   "Mark all articles not marked as unread in this newsgroup as read.
@@ -13481,6 +13552,7 @@ The directory to save in defaults to `gnus-article-save-directory'."
     "\M-\t" gnus-article-prev-button
     "<" beginning-of-buffer
     ">" end-of-buffer
+    "\C-c\C-i" gnus-info-find-node
     "\C-c\C-b" gnus-bug)
 
   (substitute-key-definition
@@ -14729,7 +14801,7 @@ Argument LINES specifies lines to be scrolled down."
   "Describe article mode commands briefly."
   (interactive)
   (gnus-message 6
-               (substitute-command-keys "\\<gnus-article-mode-map>\\[gnus-article-next-page]:Next page  \\[gnus-article-prev-page]:Prev page  \\[gnus-article-show-summary]:Show summary  \\[gnus-info-find-node]:Run Info  \\[gnus-article-describe-briefly]:This help")))
+               (substitute-command-keys "\\<gnus-article-mode-map>\\[gnus-article-goto-next-page]:Next page     \\[gnus-article-goto-prev-page]:Prev page  \\[gnus-article-show-summary]:Show summary  \\[gnus-info-find-node]:Run Info  \\[gnus-article-describe-briefly]:This help")))
 
 (defun gnus-article-summary-command ()
   "Execute the last keystroke in the summary buffer."
@@ -14759,6 +14831,8 @@ Argument LINES specifies lines to be scrolled down."
         '("q" "Q"  "c" "r" "R" "\C-c\C-f" "m"  "a" "f" "F"
           "Zc" "ZC" "ZE" "ZQ" "ZZ" "Zn" "ZR" "ZG" "ZN" "ZP"
           "=" "^" "\M-^" "|"))
+       (nosave-but-article
+        '("A\r"))
        keys)
     (save-excursion
       (set-buffer gnus-summary-buffer)
@@ -14766,12 +14840,18 @@ Argument LINES specifies lines to be scrolled down."
       (setq keys (read-key-sequence nil)))
     (message "")
 
-    (if (member keys nosaves)
+    (if (or (member keys nosaves)
+           (member keys nosave-but-article))
        (let (func)
-         (pop-to-buffer gnus-summary-buffer 'norecord)
-         (if (setq func (lookup-key (current-local-map) keys))
-             (call-interactively func)
-           (ding)))
+         (save-window-excursion
+           (pop-to-buffer gnus-summary-buffer 'norecord)
+           (setq func (lookup-key (current-local-map) keys)))
+         (if (not func)
+             (ding)
+           (set-buffer gnus-summary-buffer)
+           (call-interactively func))
+         (when (member keys nosave-but-article)
+           (pop-to-buffer gnus-article-buffer 'norecord)))
       (let ((obuf (current-buffer))
            (owin (current-window-configuration))
            (opoint (point))
@@ -14906,6 +14986,7 @@ If NEWSGROUP is nil, return the global kill file name instead."
        (set-buffer gnus-dribble-buffer)
        (insert string "\n")
        (set-window-point (get-buffer-window (current-buffer)) (point-max))
+       (bury-buffer gnus-dribble-buffer)
        (set-buffer obuf))))
 
 (defun gnus-dribble-read-file ()
@@ -15365,6 +15446,10 @@ If GROUP is nil, all groups on METHOD are scanned."
     (setcar (cdr entry) (concat (nth 1 entry) "+" group))
     (nconc entry (cdr method))))
 
+(defun gnus-server-status (method)
+  "Return the status of METHOD."
+  (nth 1 (assoc method gnus-opened-servers)))
+
 (defun gnus-group-name-to-method (group)
   "Return a select method suitable for GROUP."
   (if (string-match ":" group)
@@ -15435,7 +15520,7 @@ If LEVEL is non-nil, the news will be set up at level LEVEL."
       (gnus-read-newsrc-file rawfile))
 
     (when (and (not (assoc "archive" gnus-server-alist))
-              gnus-message-archive-method)
+              (gnus-archive-server-wanted-p))
       (push (cons "archive" gnus-message-archive-method)
            gnus-server-alist))
 
@@ -15585,7 +15670,7 @@ the server for new groups."
   (let* ((date (or gnus-newsrc-last-checked-date (current-time-string)))
         (methods (cons gnus-select-method
                        (nconc
-                        (when gnus-message-archive-method
+                        (when (gnus-archive-server-wanted-p)
                           (list "archive"))
                         (append
                          (and (consp gnus-check-new-newsgroups)
@@ -15860,6 +15945,7 @@ newsgroup."
              (set (car dead-lists)
                   (delete group (symbol-value (car dead-lists))))))
          (setq dead-lists (cdr dead-lists))))
+      (run-hooks 'gnus-check-bogus-groups-hook)
       (gnus-message 5 "Checking bogus newsgroups...done"))))
 
 (defun gnus-check-duplicate-killed-groups ()
@@ -16184,7 +16270,7 @@ Returns whether the updating was successful."
            ;; secondary ones.
            gnus-secondary-select-methods)
          ;; Also read from the archive server.
-         (when gnus-message-archive-method
+         (when (gnus-archive-server-wanted-p)
            (list "archive"))))
        list-type)
     (setq gnus-have-read-active-file nil)
@@ -16996,7 +17082,7 @@ If FORCE is non-nil, the .newsrc file is read."
 (defun gnus-read-all-descriptions-files ()
   (let ((methods (cons gnus-select-method 
                       (nconc
-                       (when gnus-message-archive-method
+                       (when (gnus-archive-server-wanted-p)
                          (list "archive"))
                        gnus-secondary-select-methods))))
     (while methods