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

Legend:
Removed from v.1.20.2.4  
changed lines
  Added in v.1.20.2.5

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