/[emacs]/emacs/lisp/gnus/gnus-start.el
ViewVC logotype

Diff of /emacs/lisp/gnus/gnus-start.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.21.6.4 by miles, Tue Sep 21 09:34:07 2004 UTC revision 1.21.6.5 by miles, Fri Oct 22 10:13:32 2004 UTC
# Line 1  Line 1 
1  ;;; gnus-start.el --- startup functions for Gnus  ;;; gnus-start.el --- startup functions for Gnus
2  ;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003  ;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004
3  ;;        Free Software Foundation, Inc.  ;;        Free Software Foundation, Inc.
4    
5  ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>  ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
# Line 34  Line 34 
34  (require 'gnus-util)  (require 'gnus-util)
35  (autoload 'message-make-date "message")  (autoload 'message-make-date "message")
36  (autoload 'gnus-agent-read-servers-validate "gnus-agent")  (autoload 'gnus-agent-read-servers-validate "gnus-agent")
37    (autoload 'gnus-agent-save-local "gnus-agent")
38  (autoload 'gnus-agent-possibly-alter-active "gnus-agent")  (autoload 'gnus-agent-possibly-alter-active "gnus-agent")
39  (eval-when-compile (require 'cl))  
40    (eval-when-compile
41      (require 'cl)
42    
43      (defvar gnus-agent-covered-methods nil)
44      (defvar gnus-agent-file-loading-local nil)
45      (defvar gnus-agent-file-loading-cache nil))
46    
47  (defcustom gnus-startup-file (nnheader-concat gnus-home-directory ".newsrc")  (defcustom gnus-startup-file (nnheader-concat gnus-home-directory ".newsrc")
48    "Your `.newsrc' file.    "Your `.newsrc' file.
# Line 665  the first newsgroup." Line 672  the first newsgroup."
672    (setq gnus-list-of-killed-groups nil    (setq gnus-list-of-killed-groups nil
673          gnus-have-read-active-file nil          gnus-have-read-active-file nil
674          gnus-agent-covered-methods nil          gnus-agent-covered-methods nil
675            gnus-agent-file-loading-local nil
676            gnus-agent-file-loading-cache nil
677          gnus-server-method-cache nil          gnus-server-method-cache nil
678          gnus-newsrc-alist nil          gnus-newsrc-alist nil
679          gnus-newsrc-hashtb nil          gnus-newsrc-hashtb nil
# Line 1481  newsgroup." Line 1490  newsgroup."
1490              (setcdr active (cdr cache-active))))))))              (setcdr active (cdr cache-active))))))))
1491    
1492  (defun gnus-activate-group (group &optional scan dont-check method)  (defun gnus-activate-group (group &optional scan dont-check method)
1493    ;; Check whether a group has been activated or not.    "Check whether a group has been activated or not.
1494    ;; If SCAN, request a scan of that group as well.  If SCAN, request a scan of that group as well."
1495    (let ((method (or method (inline (gnus-find-method-for-group group))))    (let ((method (or method (inline (gnus-find-method-for-group group))))
1496          active)          active)
1497      (and (inline (gnus-check-server method))      (and (inline (gnus-check-server method))
# Line 1513  newsgroup." Line 1522  newsgroup."
1522                      (gnus-active group))                      (gnus-active group))
1523                 (gnus-active group)                 (gnus-active group)
1524    
1525                 ;; If a cache is present, we may have to alter the active info.
1526                 (when gnus-use-cache
1527                   (inline (gnus-cache-possibly-alter-active
1528                            group active)))
1529    
1530                 ;; If the agent is enabled, we may have to alter the active info.
1531                 (when gnus-agent
1532                   (gnus-agent-possibly-alter-active group active))
1533    
1534               (gnus-set-active group active)               (gnus-set-active group active)
1535               ;; Return the new active info.               ;; Return the new active info.
1536               active)))))               active)))))
1537    
1538  (defun gnus-get-unread-articles-in-group (info active &optional update)  (defun gnus-get-unread-articles-in-group (info active &optional update)
1539    (when active    (when (and info active)
1540      ;; Allow the backend to update the info in the group.      ;; Allow the backend to update the info in the group.
1541      (when (and update      (when (and update
1542                 (gnus-request-update-info                 (gnus-request-update-info
# Line 1528  newsgroup." Line 1546  newsgroup."
1546    
1547      (let* ((range (gnus-info-read info))      (let* ((range (gnus-info-read info))
1548             (num 0))             (num 0))
1549    
1550          ;; These checks are present in gnus-activate-group but skipped
1551          ;; due to setting dont-check in the preceeding call.
1552    
1553        ;; If a cache is present, we may have to alter the active info.        ;; If a cache is present, we may have to alter the active info.
1554        (when (and gnus-use-cache info)        (when (and gnus-use-cache info)
1555          (inline (gnus-cache-possibly-alter-active          (inline (gnus-cache-possibly-alter-active
# Line 1535  newsgroup." Line 1557  newsgroup."
1557    
1558        ;; If the agent is enabled, we may have to alter the active info.        ;; If the agent is enabled, we may have to alter the active info.
1559        (when (and gnus-agent info)        (when (and gnus-agent info)
1560          (gnus-agent-possibly-alter-active          (gnus-agent-possibly-alter-active (gnus-info-group info) active info))
          (gnus-info-group info) active))  
1561    
1562        ;; Modify the list of read articles according to what articles        ;; Modify the list of read articles according to what articles
1563        ;; are available; then tally the unread articles and add the        ;; are available; then tally the unread articles and add the
# Line 1632  newsgroup." Line 1653  newsgroup."
1653    
1654      (while newsrc      (while newsrc
1655        (setq active (gnus-active (setq group (gnus-info-group        (setq active (gnus-active (setq group (gnus-info-group
1656                                               (setq info (pop newsrc))))))                                                    (setq info (pop newsrc))))))
1657    
1658        ;; Check newsgroups.  If the user doesn't want to check them, or        ;; Check newsgroups.  If the user doesn't want to check them, or
1659        ;; they can't be checked (for instance, if the news server can't        ;; they can't be checked (for instance, if the news server can't
# Line 1655  newsgroup." Line 1676  newsgroup."
1676        (when (and method        (when (and method
1677                   (not (setq method-type (cdr (assoc method type-cache)))))                   (not (setq method-type (cdr (assoc method type-cache)))))
1678          (setq method-type          (setq method-type
1679                (cond                     (cond
1680                 ((gnus-secondary-method-p method)                      ((gnus-secondary-method-p method)
1681                  'secondary)                       'secondary)
1682                 ((inline (gnus-server-equal gnus-select-method method))                      ((inline (gnus-server-equal gnus-select-method method))
1683                  'primary)                       'primary)
1684                 (t                      (t
1685                  'foreign)))                       'foreign)))
1686          (push (cons method method-type) type-cache))          (push (cons method method-type) type-cache))
1687        (if (and method  
1688                 (eq method-type 'foreign))        (cond ((and method (eq method-type 'foreign))
1689            ;; These groups are foreign.  Check the level.               ;; These groups are foreign.  Check the level.
1690            (when (and (<= (gnus-info-level info) foreign-level)               (when (and (<= (gnus-info-level info) foreign-level)
1691                       (setq active (gnus-activate-group group 'scan)))                          (setq active (gnus-activate-group group 'scan)))
1692              ;; Let the Gnus agent save the active file.                 ;; Let the Gnus agent save the active file.
1693              (when (and gnus-agent active (gnus-online method))                 (when (and gnus-agent active (gnus-online method))
1694                (gnus-agent-save-group-info                   (gnus-agent-save-group-info
1695                 method (gnus-group-real-name group) active))                    method (gnus-group-real-name group) active))
1696              (unless (inline (gnus-virtual-group-p group))                 (unless (inline (gnus-virtual-group-p group))
1697                (inline (gnus-close-group group)))                   (inline (gnus-close-group group)))
1698              (when (fboundp (intern (concat (symbol-name (car method))                 (when (fboundp (intern (concat (symbol-name (car method))
1699                                             "-request-update-info")))                                                "-request-update-info")))
1700                (inline (gnus-request-update-info info method))))                   (inline (gnus-request-update-info info method)))))
1701          ;; These groups are native or secondary.              ;; These groups are native or secondary.
1702          (cond              ((> (gnus-info-level info) level)
1703           ;; We don't want these groups.               ;; We don't want these groups.
1704           ((> (gnus-info-level info) level)               (setq active 'ignore))
1705            (setq active 'ignore))              ;; Activate groups.
1706           ;; Activate groups.              ((not gnus-read-active-file)
1707           ((not gnus-read-active-file)               (if (gnus-check-backend-function 'retrieve-groups group)
1708            (if (gnus-check-backend-function 'retrieve-groups group)                   ;; if server support gnus-retrieve-groups we push
1709                ;; if server support gnus-retrieve-groups we push                   ;; the group onto retrievegroups for later checking
1710                ;; the group onto retrievegroups for later checking                   (if (assoc method retrieve-groups)
1711                (if (assoc method retrieve-groups)                       (setcdr (assoc method retrieve-groups)
1712                    (setcdr (assoc method retrieve-groups)                               (cons group (cdr (assoc method retrieve-groups))))
1713                            (cons group (cdr (assoc method retrieve-groups))))                     (push (list method group) retrieve-groups))
1714                  (push (list method group) retrieve-groups))                 ;; hack: `nnmail-get-new-mail' changes the mail-source depending
1715              ;; hack: `nnmail-get-new-mail' changes the mail-source depending                 ;; on the group, so we must perform a scan for every group
1716              ;; on the group, so we must perform a scan for every group                 ;; if the users has any directory mail sources.
1717              ;; if the users has any directory mail sources.                 ;; hack: if `nnmail-scan-directory-mail-source-once' is non-nil,
1718              ;; hack: if `nnmail-scan-directory-mail-source-once' is non-nil,                 ;; for it scan all spool files even when the groups are
1719              ;; for it scan all spool files even when the groups are                 ;; not required.
1720              ;; not required.                 (if (and
1721              (if (and                      (or nnmail-scan-directory-mail-source-once
1722                   (or nnmail-scan-directory-mail-source-once                          (null (assq 'directory
1723                       (null (assq 'directory                                      (or mail-sources
1724                                   (or mail-sources                                          (if (listp nnmail-spool-file)
1725                                       (if (listp nnmail-spool-file)                                              nnmail-spool-file
1726                                           nnmail-spool-file                                            (list nnmail-spool-file))))))
1727                                         (list nnmail-spool-file))))))                      (member method scanned-methods))
1728                   (member method scanned-methods))                     (setq active (gnus-activate-group group))
1729                  (setq active (gnus-activate-group group))                   (setq active (gnus-activate-group group 'scan))
1730                (setq active (gnus-activate-group group 'scan))                   (push method scanned-methods))
1731                (push method scanned-methods))                 (when active
1732              (when active                   (gnus-close-group group)))))
               (gnus-close-group group))))))  
1733    
1734        ;; Get the number of unread articles in the group.        ;; Get the number of unread articles in the group.
1735        (cond        (cond
# Line 1736  newsgroup." Line 1756  newsgroup."
1756            (when (gnus-check-backend-function 'request-scan (car method))            (when (gnus-check-backend-function 'request-scan (car method))
1757              (gnus-request-scan nil method))              (gnus-request-scan nil method))
1758            (gnus-read-active-file-2            (gnus-read-active-file-2
1759             (mapcar (lambda (group) (gnus-group-real-name group)) groups)                  (mapcar (lambda (group) (gnus-group-real-name group)) groups)
1760             method)                  method)
1761            (dolist (group groups)            (dolist (group groups)
1762              (cond              (cond
1763               ((setq active (gnus-active (gnus-info-group               ((setq active (gnus-active (gnus-info-group
# Line 1982  newsgroup." Line 2002  newsgroup."
2002            (while (setq info (pop newsrc))            (while (setq info (pop newsrc))
2003              (when (inline              (when (inline
2004                      (gnus-server-equal                      (gnus-server-equal
2005                       (inline                            (inline
2006                         (gnus-find-method-for-group                              (gnus-find-method-for-group
2007                          (gnus-info-group info) info))                                    (gnus-info-group info) info))
2008                       gmethod))                            gmethod))
2009                (push (gnus-group-real-name (gnus-info-group info))                (push (gnus-group-real-name (gnus-info-group info))
2010                      groups)))                      groups)))
2011            (gnus-read-active-file-2 groups method)))            (gnus-read-active-file-2 groups method)))
# Line 2129  newsgroup." Line 2149  newsgroup."
2149               (gnus-online method)               (gnus-online method)
2150               (gnus-agent-method-p method))               (gnus-agent-method-p method))
2151          (progn          (progn
2152            (gnus-agent-save-groups method)            (gnus-agent-save-active method)
2153            (gnus-active-to-gnus-format method hashtb nil real-active))            (gnus-active-to-gnus-format method hashtb nil real-active))
2154    
2155        (goto-char (point-min))        (goto-char (point-min))
# Line 2205  If FORCE is non-nil, the .newsrc file is Line 2225  If FORCE is non-nil, the .newsrc file is
2225        (gnus-convert-old-newsrc))))        (gnus-convert-old-newsrc))))
2226    
2227  (defun gnus-convert-old-newsrc ()  (defun gnus-convert-old-newsrc ()
2228    "Convert old newsrc into the new format, if needed."    "Convert old newsrc formats into the current format, if needed."
2229    (let ((fcv (and gnus-newsrc-file-version    (let ((fcv (and gnus-newsrc-file-version
2230                    (gnus-continuum-version gnus-newsrc-file-version))))                    (gnus-continuum-version gnus-newsrc-file-version))))
2231      (cond      (when fcv
2232       ;; No .newsrc.eld file was loaded.        ;; A newsrc file was loaded.
2233       ((null fcv) nil)        (let (prompt-displayed
2234       ;; Gnus 5 .newsrc.eld was loaded.              (converters
2235       ((< fcv (gnus-continuum-version "September Gnus v0.1"))               (sort
2236        (gnus-convert-old-ticks)))))                (mapcar (lambda (date-func)
2237                            (cons (gnus-continuum-version (car date-func))
2238                                  date-func))
2239                          ;; This is a list of converters that must be run
2240                          ;; to bring the newsrc file up to the current
2241                          ;; version.  If you create an incompatibility
2242                          ;; with older versions, you should create an
2243                          ;; entry here.  The entry should consist of the
2244                          ;; current gnus version (hardcoded so that it
2245                          ;; doesn't change with each release) and the
2246                          ;; function that must be applied to convert the
2247                          ;; previous version into the current version.
2248                          '(("September Gnus v0.1" nil
2249                             gnus-convert-old-ticks)
2250                            ("Oort Gnus v0.08"     "legacy-gnus-agent"
2251                             gnus-agent-convert-to-compressed-agentview)
2252                            ("Gnus v5.11"          "legacy-gnus-agent"
2253                             gnus-agent-unlist-expire-days)
2254                            ("Gnus v5.11"          "legacy-gnus-agent"
2255                             gnus-agent-unhook-expire-days)))
2256                  #'car-less-than-car)))
2257            ;; Skip converters older than the file version
2258            (while (and converters (>= fcv (caar converters)))
2259              (pop converters))
2260    
2261            ;; Perform converters to bring older version up to date.
2262            (when (and converters (< fcv (caar converters)))
2263              (while (and converters (< fcv (caar converters))
2264                          (<= (caar converters) gnus-version))
2265                (let* ((converter-spec  (pop converters))
2266                       (convert-to      (nth 1 converter-spec))
2267                       (load-from       (nth 2 converter-spec))
2268                       (func            (nth 3 converter-spec)))
2269                  (when (and load-from
2270                             (not (fboundp func)))
2271                    (load load-from t))
2272                  
2273                  (or prompt-displayed
2274                      (not (gnus-convert-converter-needs-prompt func))
2275                      (while (let (c
2276                                   (cursor-in-echo-area t)
2277                                   (echo-keystrokes 0))
2278                               (message "Convert gnus from version '%s' to '%s'? (n/y/?)"
2279                                        gnus-newsrc-file-version gnus-version)
2280                               (setq c (read-char-exclusive))
2281    
2282                               (cond ((or (eq c ?n) (eq c ?N))
2283                                      (error "Can not start gnus without converting"))
2284                                     ((or (eq c ?y) (eq c ?Y))
2285                                      (setq prompt-displayed t)
2286                                      nil)
2287                                     ((eq c ?\?)
2288                                      (message "This conversion is irreversible. \
2289     To be safe, you should backup your files before proceeding.")
2290                                      (sit-for 5)
2291                                      t)
2292                                     (t
2293                                      (gnus-message 3 "Ignoring unexpected input")
2294                                      (sit-for 3)
2295                                      t)))))
2296    
2297                  (funcall func convert-to)))
2298              (gnus-dribble-enter
2299               (format ";Converted gnus from version '%s' to '%s'."
2300                       gnus-newsrc-file-version gnus-version)))))))
2301    
2302    (defun gnus-convert-mark-converter-prompt (converter no-prompt)
2303      "Indicate whether CONVERTER requires gnus-convert-old-newsrc to
2304      display the conversion prompt.  NO-PROMPT may be nil (prompt),
2305      t (no prompt), or any form that can be called as a function.
2306      The form should return either t or nil."
2307      (put converter 'gnus-convert-no-prompt no-prompt))
2308    
2309    (defun gnus-convert-converter-needs-prompt (converter)
2310      (let ((no-prompt (get converter 'gnus-convert-no-prompt)))
2311        (not (if (memq no-prompt '(t nil))
2312                 no-prompt
2313               (funcall no-prompt)))))
2314    
2315  (defun gnus-convert-old-ticks ()  (defun gnus-convert-old-ticks (converting-to)
2316    (let ((newsrc (cdr gnus-newsrc-alist))    (let ((newsrc (cdr gnus-newsrc-alist))
2317          marks info dormant ticked)          marks info dormant ticked)
2318      (while (setq info (pop newsrc))      (while (setq info (pop newsrc))
# Line 2594  If FORCE is non-nil, the .newsrc file is Line 2691  If FORCE is non-nil, the .newsrc file is
2691    ;; from the variable gnus-newsrc-alist.    ;; from the variable gnus-newsrc-alist.
2692    (when (and (or gnus-newsrc-alist gnus-killed-list)    (when (and (or gnus-newsrc-alist gnus-killed-list)
2693               gnus-current-startup-file)               gnus-current-startup-file)
2694        ;; Save agent range limits for the currently active method.
2695        (when gnus-agent
2696          (gnus-agent-save-local force))
2697    
2698      (save-excursion      (save-excursion
2699        (if (and (or gnus-use-dribble-file gnus-slave)        (if (and (or gnus-use-dribble-file gnus-slave)
2700                 (not force)                 (not force)
# Line 2611  If FORCE is non-nil, the .newsrc file is Line 2712  If FORCE is non-nil, the .newsrc file is
2712              (gnus-message 8 "Saving %s..." gnus-current-startup-file)              (gnus-message 8 "Saving %s..." gnus-current-startup-file)
2713              (gnus-gnus-to-newsrc-format)              (gnus-gnus-to-newsrc-format)
2714              (gnus-message 8 "Saving %s...done" gnus-current-startup-file))              (gnus-message 8 "Saving %s...done" gnus-current-startup-file))
2715    
2716            ;; Save .newsrc.eld.            ;; Save .newsrc.eld.
2717            (set-buffer (gnus-get-buffer-create " *Gnus-newsrc*"))            (set-buffer (gnus-get-buffer-create " *Gnus-newsrc*"))
2718            (make-local-variable 'version-control)            (make-local-variable 'version-control)

Legend:
Removed from v.1.21.6.4  
changed lines
  Added in v.1.21.6.5

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26