X-Git-Url: http://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Fgnus-start.el;h=d324023da08ecae4f4b201ac9c8e31efc98c7ed1;hb=4724093b5726d891e49e07191b52a14db1b93ecd;hp=3d62b896869beda83e146c38adf3a04f7e9e8889;hpb=8c5920bae3428e75881d20f6ea8893ed79cea7cc;p=gnus diff --git a/lisp/gnus-start.el b/lisp/gnus-start.el index 3d62b8968..d324023da 100644 --- a/lisp/gnus-start.el +++ b/lisp/gnus-start.el @@ -1,5 +1,5 @@ ;;; gnus-start.el --- startup functions for Gnus -;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003 +;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004 ;; Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen @@ -496,19 +496,23 @@ Can be used to turn version control on or off." (defun gnus-subscribe-hierarchical-interactive (groups) (let ((groups (sort groups 'string<)) - prefixes prefix start ans group starts) + prefixes prefix start ans group starts real-group) (while groups (setq prefixes (list "^")) (while (and groups prefixes) - (while (not (string-match (car prefixes) (car groups))) + (while (not (string-match (car prefixes) + (gnus-group-real-name (car groups)))) (setq prefixes (cdr prefixes))) (setq prefix (car prefixes)) (setq start (1- (length prefix))) - (if (and (string-match "[^\\.]\\." (car groups) start) + (if (and (string-match "[^\\.]\\." (gnus-group-real-name (car groups)) + start) (cdr groups) (setq prefix - (concat "^" (substring (car groups) 0 (match-end 0)))) - (string-match prefix (cadr groups))) + (concat "^" (substring + (gnus-group-real-name (car groups)) + 0 (match-end 0)))) + (string-match prefix (gnus-group-real-name (cadr groups)))) (progn (push prefix prefixes) (message "Descend hierarchy %s? ([y]nsq): " @@ -520,16 +524,18 @@ Can be used to turn version control on or off." (substring prefix 1 (1- (length prefix))))) (cond ((= ans ?n) (while (and groups - (string-match prefix - (setq group (car groups)))) + (setq group (car groups) + real-group (gnus-group-real-name group)) + (string-match prefix real-group)) (push group gnus-killed-list) (gnus-sethash group group gnus-killed-hashtb) (setq groups (cdr groups))) (setq starts (cdr starts))) ((= ans ?s) (while (and groups - (string-match prefix - (setq group (car groups)))) + (setq group (car groups) + real-group (gnus-group-real-name group)) + (string-match prefix real-group)) (gnus-sethash group group gnus-killed-hashtb) (gnus-subscribe-alphabetically (car groups)) (setq groups (cdr groups))) @@ -776,11 +782,6 @@ prompt the user for the name of an NNTP server to use." (when (or gnus-slave gnus-use-dribble-file) (gnus-dribble-read-file)) - ;; Allow using GroupLens predictions. - (when gnus-use-grouplens - (bbb-login) - (add-hook 'gnus-summary-mode-hook 'gnus-grouplens-mode)) - ;; Do the actual startup. (if gnus-agent (gnus-request-create-group "queue" '(nndraft ""))) @@ -875,7 +876,7 @@ prompt the user for the name of an NNTP server to use." (when (and (file-exists-p gnus-current-startup-file) (file-exists-p dribble-file) (setq modes (file-modes gnus-current-startup-file))) - (set-file-modes dribble-file modes)) + (gnus-set-file-modes dribble-file modes)) (goto-char (point-min)) (when (search-forward "Gnus was exited on purpose" nil t) (setq purpose t)) @@ -1530,7 +1531,7 @@ newsgroup." active))))) (defun gnus-get-unread-articles-in-group (info active &optional update) - (when active + (when (and info active) ;; Allow the backend to update the info in the group. (when (and update (gnus-request-update-info @@ -1642,7 +1643,7 @@ newsgroup." (methods-cache nil) (type-cache nil) scanned-methods info group active method retrieve-groups cmethod - method-type) + method-type ignore) (gnus-message 6 "Checking new news...") (while newsrc @@ -1678,59 +1679,65 @@ newsgroup." (t 'foreign))) (push (cons method method-type) type-cache)) - (if (and method - (eq method-type 'foreign)) - ;; These groups are foreign. Check the level. - (when (and (<= (gnus-info-level info) foreign-level) - (setq active (gnus-activate-group group 'scan))) - ;; Let the Gnus agent save the active file. - (when (and gnus-agent active (gnus-online method)) - (gnus-agent-save-group-info - method (gnus-group-real-name group) active)) - (unless (inline (gnus-virtual-group-p group)) - (inline (gnus-close-group group))) - (when (fboundp (intern (concat (symbol-name (car method)) - "-request-update-info"))) - (inline (gnus-request-update-info info method)))) - ;; These groups are native or secondary. - (cond - ;; We don't want these groups. - ((> (gnus-info-level info) level) - (setq active 'ignore)) - ;; Activate groups. - ((not gnus-read-active-file) - (if (gnus-check-backend-function 'retrieve-groups group) - ;; if server support gnus-retrieve-groups we push - ;; the group onto retrievegroups for later checking - (if (assoc method retrieve-groups) - (setcdr (assoc method retrieve-groups) - (cons group (cdr (assoc method retrieve-groups)))) - (push (list method group) retrieve-groups)) - ;; hack: `nnmail-get-new-mail' changes the mail-source depending - ;; on the group, so we must perform a scan for every group - ;; if the users has any directory mail sources. - ;; hack: if `nnmail-scan-directory-mail-source-once' is non-nil, - ;; for it scan all spool files even when the groups are - ;; not required. - (if (and - (or nnmail-scan-directory-mail-source-once - (null (assq 'directory - (or mail-sources - (if (listp nnmail-spool-file) - nnmail-spool-file - (list nnmail-spool-file)))))) - (member method scanned-methods)) - (setq active (gnus-activate-group group)) - (setq active (gnus-activate-group group 'scan)) - (push method scanned-methods)) - (when active - (gnus-close-group group)))))) + + (setq ignore nil) + (cond ((and method (eq method-type 'foreign)) + ;; These groups are foreign. Check the level. + (if (<= (gnus-info-level info) foreign-level) + (when (and (<= (gnus-info-level info) foreign-level) + (setq active (gnus-activate-group group 'scan))) + ;; Let the Gnus agent save the active file. + (when (and gnus-agent active (gnus-online method)) + (gnus-agent-save-group-info + method (gnus-group-real-name group) active)) + (unless (inline (gnus-virtual-group-p group)) + (inline (gnus-close-group group))) + (when (fboundp (intern (concat (symbol-name (car method)) + "-request-update-info"))) + (inline (gnus-request-update-info info method)))) + (setq ignore t))) + ;; These groups are native or secondary. + ((> (gnus-info-level info) level) + ;; We don't want these groups. + (setq active 'ignore)) + ;; Activate groups. + ((not gnus-read-active-file) + (if (gnus-check-backend-function 'retrieve-groups group) + ;; if server support gnus-retrieve-groups we push + ;; the group onto retrievegroups for later checking + (if (assoc method retrieve-groups) + (setcdr (assoc method retrieve-groups) + (cons group (cdr (assoc method retrieve-groups)))) + (push (list method group) retrieve-groups)) + ;; hack: `nnmail-get-new-mail' changes the mail-source depending + ;; on the group, so we must perform a scan for every group + ;; if the users has any directory mail sources. + ;; hack: if `nnmail-scan-directory-mail-source-once' is non-nil, + ;; for it scan all spool files even when the groups are + ;; not required. + (if (and + (or nnmail-scan-directory-mail-source-once + (null (assq 'directory + (or mail-sources + (if (listp nnmail-spool-file) + nnmail-spool-file + (list nnmail-spool-file)))))) + (member method scanned-methods)) + (setq active (gnus-activate-group group)) + (setq active (gnus-activate-group group 'scan)) + (push method scanned-methods)) + (when active + (gnus-close-group group))))) ;; Get the number of unread articles in the group. (cond ((eq active 'ignore) ;; Don't do anything. ) + ((and active ignore) + ;; The level of the foreign group is higher than the specified + ;; value. + ) (active (inline (gnus-get-unread-articles-in-group info active t))) (t @@ -1996,10 +2003,10 @@ newsgroup." (while (setq info (pop newsrc)) (when (inline (gnus-server-equal - (inline - (gnus-find-method-for-group - (gnus-info-group info) info)) - gmethod)) + (inline + (gnus-find-method-for-group + (gnus-info-group info) info)) + gmethod)) (push (gnus-group-real-name (gnus-info-group info)) groups))) (gnus-read-active-file-2 groups method))) @@ -2224,7 +2231,8 @@ If FORCE is non-nil, the .newsrc file is read." (gnus-continuum-version gnus-newsrc-file-version)))) (when fcv ;; A .newsrc.eld file was loaded. - (let ((converters + (let (prompt-displayed + (converters (sort (mapcar (lambda (date-func) (cons (gnus-continuum-version (car date-func)) @@ -2238,48 +2246,70 @@ If FORCE is non-nil, the .newsrc file is read." ;; doesn't change with each release) and the ;; function that must be applied to convert the ;; previous version into the current version. - '(("September Gnus v0.1" nil gnus-convert-old-ticks))) + '(("September Gnus v0.1" nil + gnus-convert-old-ticks) + ("Oort Gnus v0.08" "legacy-gnus-agent" + gnus-agent-convert-to-compressed-agentview) + ("No Gnus v0.2" "legacy-gnus-agent" + gnus-agent-unlist-expire-days) + ("No Gnus v0.2" "legacy-gnus-agent" + gnus-agent-unhook-expire-days))) #'car-less-than-car))) ;; Skip converters older than the file version (while (and converters (>= fcv (caar converters))) (pop converters)) ;; Perform converters to bring older version up to date. - (when (and converters - (< fcv (caar converters))) - (while (let (c - (cursor-in-echo-area t) - (echo-keystrokes 0)) - (message "Convert newsrc from version '%s' to '%s'? (n/y/?)" - gnus-newsrc-file-version gnus-version) - (setq c (read-char-exclusive)) - - (cond ((or (eq c ?n) (eq c ?N)) - (error "Can not start gnus using old (unconverted) newsrc")) - ((or (eq c ?y) (eq c ?Y)) - nil) - ((eq c ?\?) - (message "This conversion is irreversible. \ - You should backup your files before proceeding.") - (sit-for 5) - t) - (t - (gnus-message 3 "Ignoring unexpected input") - (sit-for 3) - t)))) - (while (and converters (< fcv (caar converters))) - (let* ((converter (pop converters)) - (convert-to (nth 1 converter)) - (load-from (nth 2 converter)) - (func (nth 3 converter))) + (when (and converters (< fcv (caar converters))) + (while (and converters (< fcv (caar converters))) + (let* ((converter-spec (pop converters)) + (convert-to (nth 1 converter-spec)) + (load-from (nth 2 converter-spec)) + (func (nth 3 converter-spec))) (when (and load-from (not (fboundp func))) (load load-from t)) + + (or prompt-displayed + (not (gnus-convert-converter-needs-prompt func)) + (while (let (c + (cursor-in-echo-area t) + (echo-keystrokes 0)) + (message "Convert newsrc from version '%s' to '%s'? (n/y/?)" + gnus-newsrc-file-version gnus-version) + (setq c (read-char-exclusive)) + + (cond ((or (eq c ?n) (eq c ?N)) + (error "Can not start gnus using old (unconverted) newsrc")) + ((or (eq c ?y) (eq c ?Y)) + (setq prompt-displayed t) + nil) + ((eq c ?\?) + (message "This conversion is irreversible. \ + You should backup your files before proceeding.") + (sit-for 5) + t) + (t + (gnus-message 3 "Ignoring unexpected input") + (sit-for 3) + t))))) + (funcall func convert-to))) (gnus-dribble-enter (format ";Converted newsrc from version '%s' to '%s'? (n/y/?)" gnus-newsrc-file-version gnus-version))))))) +(defun gnus-convert-mark-converter-prompt (converter no-prompt) + (setplist converter + (let* ((symbol 'gnus-convert-no-prompt) + (value (delq symbol (symbol-plist converter)))) + (if no-prompt + (cons symbol value) + value)))) + +(defun gnus-convert-converter-needs-prompt (converter) + (not (memq 'gnus-convert-no-prompt (symbol-plist converter)))) + (defun gnus-convert-old-ticks (converting-to) (let ((newsrc (cdr gnus-newsrc-alist)) marks info dormant ticked) @@ -2447,7 +2477,7 @@ If FORCE is non-nil, the .newsrc file is read." (point-at-bol) ;; Options may continue on the next line. (or (and (re-search-forward "^[^ \t]" nil 'move) - (progn (beginning-of-line) (point))) + (point-at-bol)) (point))))) (forward-line -1)) (symbol @@ -2735,7 +2765,7 @@ If FORCE is non-nil, the .newsrc file is read." ;; Replace the existing startup file with the temp file. (rename-file working-file startup-file t) - (set-file-modes startup-file setmodes))) + (gnus-set-file-modes startup-file setmodes))) (condition-case nil (delete-file working-file) (file-error nil))))) @@ -2880,7 +2910,7 @@ If FORCE is non-nil, the .newsrc file is read." (let ((coding-system-for-write gnus-ding-file-coding-system)) (gnus-write-buffer slave-name)) (when modes - (set-file-modes slave-name modes))))) + (gnus-set-file-modes slave-name modes))))) (defun gnus-master-read-slave-newsrc () (let ((slave-files @@ -3063,6 +3093,7 @@ Would otherwise be an alias for `display-time-event-handler'." nil)))) (provide 'gnus-start) +;;; arch-tag: f4584a22-b7b7-4853-abfc-a637329af5d2 ;;; gnus-start.el ends here