Mercurial > hg > xemacs-beta

comparison lisp/gnus/gnus-start.el @ 32:e04119814345 r19-15b99

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r19-15b99
author cvs
date Mon, 13 Aug 2007 08:52:56 +0200
parents ec9a17fef872
children 1a767b41a199
comparison
equal deleted inserted replaced
31:b9328a10c56c 32:e04119814345
31 (require 'gnus-spec) 31 (require 'gnus-spec)
32 (require 'gnus-range) 32 (require 'gnus-range)
33 (require 'gnus-util) 33 (require 'gnus-util)
34 (require 'message) 34 (require 'message)
35 35
36 (defcustom gnus-startup-file "~/.newsrc" 36 (defcustom gnus-startup-file (nnheader-concat gnus-home-directory ".newsrc")
37 "Your `.newsrc' file. 37 "Your `.newsrc' file.
38 `.newsrc-SERVER' will be used instead if that exists." 38 `.newsrc-SERVER' will be used instead if that exists."
39 :group 'gnus-start 39 :group 'gnus-start
40 :type 'file) 40 :type 'file)
41 41
42 (defcustom gnus-init-file "~/.gnus" 42 (defcustom gnus-init-file (nnheader-concat gnus-home-directory ".gnus")
43 "Your Gnus elisp startup file. 43 "Your Gnus elisp startup file.
44 If a file with the .el or .elc suffixes exist, it will be read 44 If a file with the .el or .elc suffixes exist, it will be read
45 instead." 45 instead."
46 :group 'gnus-start 46 :group 'gnus-start
47 :type 'file) 47 :type 'file)
1288 (setcar active (car cache-active))) 1288 (setcar active (car cache-active)))
1289 (and cache-active 1289 (and cache-active
1290 (> (cdr cache-active) (cdr active)) 1290 (> (cdr cache-active) (cdr active))
1291 (setcdr active (cdr cache-active))))))) 1291 (setcdr active (cdr cache-active)))))))
1292 1292
1293 (defun gnus-activate-group (group &optional scan dont-check method)
1294 ;; Check whether a group has been activated or not.
1295 ;; If SCAN, request a scan of that group as well.
1296 (let ((method (or method (inline (gnus-find-method-for-group group))))
1297 active)
1298 (and (inline (gnus-check-server method))
1299 ;; We escape all bugs and quit here to make it possible to
1300 ;; continue if a group is so out-there that it reports bugs
1301 ;; and stuff.
1302 (progn
1303 (and scan
1304 (gnus-check-backend-function 'request-scan (car method))
1305 (gnus-request-scan group method))
1306 t)
1307 (condition-case ()
1308 (inline (gnus-request-group group dont-check method))
1309 (error nil)
1310 (quit nil))
1311 (gnus-set-active group (setq active (gnus-parse-active)))
1312 ;; Return the new active info.
1313 active)))
1314
1293 (defun gnus-get-unread-articles-in-group (info active &optional update) 1315 (defun gnus-get-unread-articles-in-group (info active &optional update)
1294 (when active 1316 (when active
1295 ;; Allow the backend to update the info in the group. 1317 ;; Allow the backend to update the info in the group.
1296 (when (and update 1318 (when (and update
1297 (gnus-request-update-info 1319 (gnus-request-update-info
1298 info (gnus-find-method-for-group (gnus-info-group info)))) 1320 info (inline (gnus-find-method-for-group
1321 (gnus-info-group info)))))
1299 (gnus-activate-group (gnus-info-group info) nil t)) 1322 (gnus-activate-group (gnus-info-group info) nil t))
1300 (let* ((range (gnus-info-read info)) 1323 (let* ((range (gnus-info-read info))
1301 (num 0)) 1324 (num 0))
1302 ;; If a cache is present, we may have to alter the active info. 1325 ;; If a cache is present, we may have to alter the active info.
1303 (when (and gnus-use-cache info) 1326 (when (and gnus-use-cache info)
1398 ;; they can't be checked (for instance, if the news server can't 1421 ;; they can't be checked (for instance, if the news server can't
1399 ;; be reached) we just set the number of unread articles in this 1422 ;; be reached) we just set the number of unread articles in this
1400 ;; newsgroup to t. This means that Gnus thinks that there are 1423 ;; newsgroup to t. This means that Gnus thinks that there are
1401 ;; unread articles, but it has no idea how many. 1424 ;; unread articles, but it has no idea how many.
1402 (if (and (setq method (gnus-info-method info)) 1425 (if (and (setq method (gnus-info-method info))
1403 (not (gnus-server-equal 1426 (not (inline
1404 gnus-select-method 1427 (gnus-server-equal
1405 (setq method (gnus-server-get-method nil method)))) 1428 gnus-select-method
1429 (setq method (gnus-server-get-method nil method)))))
1406 (not (gnus-secondary-method-p method))) 1430 (not (gnus-secondary-method-p method)))
1407 ;; These groups are foreign. Check the level. 1431 ;; These groups are foreign. Check the level.
1408 (when (<= (gnus-info-level info) foreign-level) 1432 (when (<= (gnus-info-level info) foreign-level)
1409 (setq active (gnus-activate-group group 'scan)) 1433 (setq active (gnus-activate-group group 'scan))
1410 (unless (inline (gnus-virtual-group-p group)) 1434 (unless (inline (gnus-virtual-group-p group))
1459 (+ (length gnus-killed-list) (length gnus-zombie-list)))) 1483 (+ (length gnus-killed-list) (length gnus-zombie-list))))
1460 (while lists 1484 (while lists
1461 (setq list (symbol-value (pop lists))) 1485 (setq list (symbol-value (pop lists)))
1462 (while list 1486 (while list
1463 (gnus-sethash (car list) (pop list) gnus-killed-hashtb))))) 1487 (gnus-sethash (car list) (pop list) gnus-killed-hashtb)))))
1464
1465 (defun gnus-activate-group (group &optional scan dont-check method)
1466 ;; Check whether a group has been activated or not.
1467 ;; If SCAN, request a scan of that group as well.
1468 (let ((method (or method (gnus-find-method-for-group group)))
1469 active)
1470 (and (gnus-check-server method)
1471 ;; We escape all bugs and quit here to make it possible to
1472 ;; continue if a group is so out-there that it reports bugs
1473 ;; and stuff.
1474 (progn
1475 (and scan
1476 (gnus-check-backend-function 'request-scan (car method))
1477 (gnus-request-scan group method))
1478 t)
1479 (condition-case ()
1480 (gnus-request-group group dont-check method)
1481 (error nil)
1482 (quit nil))
1483 (gnus-set-active group (setq active (gnus-parse-active)))
1484 ;; Return the new active info.
1485 active)))
1486 1488
1487 (defun gnus-parse-active () 1489 (defun gnus-parse-active ()
1488 "Parse active info in the nntp server buffer." 1490 "Parse active info in the nntp server buffer."
1489 (save-excursion 1491 (save-excursion
1490 (set-buffer nntp-server-buffer) 1492 (set-buffer nntp-server-buffer)
1587 (not force)) 1589 (not force))
1588 (let ((newsrc (cdr gnus-newsrc-alist)) 1590 (let ((newsrc (cdr gnus-newsrc-alist))
1589 (gmethod (gnus-server-get-method nil method)) 1591 (gmethod (gnus-server-get-method nil method))
1590 groups info) 1592 groups info)
1591 (while (setq info (pop newsrc)) 1593 (while (setq info (pop newsrc))
1592 (when (gnus-server-equal 1594 (when (inline
1593 (gnus-find-method-for-group 1595 (gnus-server-equal
1594 (gnus-info-group info) info) 1596 (inline
1595 gmethod) 1597 (gnus-find-method-for-group
1598 (gnus-info-group info) info))
1599 gmethod))
1596 (push (gnus-group-real-name (gnus-info-group info)) 1600 (push (gnus-group-real-name (gnus-info-group info))
1597 groups))) 1601 groups)))
1598 (when groups 1602 (when groups
1599 (gnus-check-server method) 1603 (gnus-check-server method)
1600 (setq list-type (gnus-retrieve-groups groups method)) 1604 (setq list-type (gnus-retrieve-groups groups method))
2251 ;; Write subscribed and unsubscribed. 2255 ;; Write subscribed and unsubscribed.
2252 (while (setq info (pop newsrc)) 2256 (while (setq info (pop newsrc))
2253 ;; Don't write foreign groups to .newsrc. 2257 ;; Don't write foreign groups to .newsrc.
2254 (when (or (null (setq method (gnus-info-method info))) 2258 (when (or (null (setq method (gnus-info-method info)))
2255 (equal method "native") 2259 (equal method "native")
2256 (gnus-server-equal method gnus-select-method)) 2260 (inline (gnus-server-equal method gnus-select-method)))
2257 (insert (gnus-info-group info) 2261 (insert (gnus-info-group info)
2258 (if (> (gnus-info-level info) gnus-level-subscribed) 2262 (if (> (gnus-info-level info) gnus-level-subscribed)
2259 "!" ":")) 2263 "!" ":"))
2260 (when (setq ranges (gnus-info-read info)) 2264 (when (setq ranges (gnus-info-read info))
2261 (insert " ") 2265 (insert " ")
2391 (goto-char (point-max))) 2395 (goto-char (point-max)))
2392 (beginning-of-line) 2396 (beginning-of-line)
2393 (narrow-to-region (point-min) (point))) 2397 (narrow-to-region (point-min) (point)))
2394 ;; If these are groups from a foreign select method, we insert the 2398 ;; If these are groups from a foreign select method, we insert the
2395 ;; group prefix in front of the group names. 2399 ;; group prefix in front of the group names.
2396 (and method (not (gnus-server-equal 2400 (and method (not (inline
2397 (gnus-server-get-method nil method) 2401 (gnus-server-equal
2398 (gnus-server-get-method nil gnus-select-method))) 2402 (gnus-server-get-method nil method)
2403 (gnus-server-get-method
2404 nil gnus-select-method))))
2399 (let ((prefix (gnus-group-prefixed-name "" method))) 2405 (let ((prefix (gnus-group-prefixed-name "" method)))
2400 (goto-char (point-min)) 2406 (goto-char (point-min))
2401 (while (and (not (eobp)) 2407 (while (and (not (eobp))
2402 (progn (insert prefix) 2408 (progn (insert prefix)
2403 (zerop (forward-line 1))))))) 2409 (zerop (forward-line 1)))))))