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> |
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. |
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 |
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)) |
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 |
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 |
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 |
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 |
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 |
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 |
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))) |
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)) |
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)) |
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) |
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) |