X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Fgnus-start.el;h=f7c579d65b2aad7549ba6f873e0999437375eba7;hb=10e4b48203f204fd3608c07e21853ac081643c89;hp=068074db86d8bb40131b9db06b894a4818a5a0dd;hpb=3458caf416d88c373561f23f373a23a3856eb922;p=elisp%2Fgnus.git- diff --git a/lisp/gnus-start.el b/lisp/gnus-start.el index 068074d..f7c579d 100644 --- a/lisp/gnus-start.el +++ b/lisp/gnus-start.el @@ -1,6 +1,7 @@ ;;; gnus-start.el --- startup functions for Gnus -;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004 -;; Free Software Foundation, Inc. + +;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, +;; 2005 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Keywords: news @@ -19,8 +20,8 @@ ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. ;;; Commentary: @@ -60,6 +61,7 @@ "Whether to create backup files. This variable takes the same values as the `version-control' variable." + :version "22.1" :group 'gnus-start :type '(choice (const :tag "Never" never) (const :tag "If existing" nil) @@ -70,6 +72,7 @@ variable." the buffer or write directly to the file. The buffer is faster because all of the contents are written at once. The direct write uses considerably less memory." + :version "22.1" :group 'gnus-start :type '(choice (const :tag "Write via buffer" t) (const :tag "Write directly to file" nil))) @@ -262,7 +265,7 @@ not match this regexp will be removed before saving the list." (and value (not (stringp value)))) :value t) (const nil) - (regexp :format "%t: %v\n" :size 0))) + regexp)) (defcustom gnus-ignored-newsgroups (mapconcat 'identity @@ -303,6 +306,7 @@ claim them." (defcustom gnus-subscribe-newsgroup-hooks nil "*Hooks run after you subscribe to a new group. The hooks will be called with new group's name as argument." + :version "22.1" :group 'gnus-group-new :type 'hook) @@ -409,6 +413,7 @@ This hook is called as the first thing when Gnus is started." (defcustom gnus-get-top-new-news-hook nil "A hook run just before Gnus checks for new news globally." + :version "22.1" :group 'gnus-group-new :type 'hook) @@ -614,7 +619,7 @@ Can be used to turn version control on or off." "Subscribe the new GROUP interactively. It is inserted in hierarchical newsgroup order if subscribed. If not, it is killed." - (if (gnus-y-or-n-p (format "Subscribe new newsgroup: %s " group)) + (if (gnus-y-or-n-p (format "Subscribe new newsgroup %s? " group)) (gnus-subscribe-hierarchically group) (push group gnus-killed-list))) @@ -969,16 +974,28 @@ If LEVEL is non-nil, the news will be set up at level LEVEL." ;; Make sure the archive server is available to all and sundry. (when gnus-message-archive-method (unless (assoc "archive" gnus-server-alist) - (push `("archive" - nnfolder - "archive" - (nnfolder-directory - ,(nnheader-concat message-directory "archive")) - (nnfolder-active-file - ,(nnheader-concat message-directory "archive/active")) - (nnfolder-get-new-mail nil) - (nnfolder-inhibit-expiry t)) - gnus-server-alist))) + (let ((method (or (and (stringp gnus-message-archive-method) + (gnus-server-to-method + gnus-message-archive-method)) + gnus-message-archive-method))) + ;; Check whether the archive method is writable. + (unless (or (stringp method) + (memq 'respool (assoc (format "%s" (car method)) + gnus-valid-select-methods))) + (setq method "archive")) ;; The default. + (push (if (stringp method) + `("archive" + nnfolder + ,method + (nnfolder-directory + ,(nnheader-concat message-directory method)) + (nnfolder-active-file + ,(nnheader-concat message-directory + (concat method "/active"))) + (nnfolder-get-new-mail nil) + (nnfolder-inhibit-expiry t)) + (cons "archive" method)) + gnus-server-alist)))) ;; If we don't read the complete active file, we fill in the ;; hashtb here. @@ -1533,8 +1550,8 @@ If SCAN, request a scan of that group as well." ;; command may have responded with the `(0 . 0)'. We ;; ignore this if we already have an active entry ;; for the group. - (if (and (zerop (car active)) - (zerop (cdr active)) + (if (and (zerop (or (car active) 0)) + (zerop (or (cdr active) 0)) (gnus-active group)) (gnus-active group) @@ -1705,8 +1722,7 @@ If SCAN, request a scan of that group as well." (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))) + (when (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 @@ -1928,7 +1944,7 @@ If SCAN, request a scan of that group as well." (setcdr range (1- article)) (setq modified t) ranges)))))))) - + (when modified (when (eq modified 'remove-null) (setq r (delq nil r))) @@ -2256,9 +2272,10 @@ If FORCE is non-nil, the .newsrc file is read." (defun gnus-convert-old-newsrc () "Convert old newsrc formats into the current format, if needed." (let ((fcv (and gnus-newsrc-file-version - (gnus-continuum-version gnus-newsrc-file-version)))) + (gnus-continuum-version gnus-newsrc-file-version))) + (gcv (gnus-continuum-version))) (when fcv - ;; A .newsrc.eld file was loaded. + ;; A newsrc file was loaded. (let (prompt-displayed (converters (sort @@ -2274,13 +2291,13 @@ 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 + '(("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 v5.10.7" "legacy-gnus-agent" gnus-agent-unlist-expire-days) - ("No Gnus v0.2" "legacy-gnus-agent" + ("Gnus v5.10.7" "legacy-gnus-agent" gnus-agent-unhook-expire-days))) #'car-less-than-car))) ;; Skip converters older than the file version @@ -2289,7 +2306,8 @@ If FORCE is non-nil, the .newsrc file is read." ;; Perform converters to bring older version up to date. (when (and converters (< fcv (caar converters))) - (while (and converters (< fcv (caar converters))) + (while (and converters (< fcv (caar converters)) + (<= (caar converters) gcv)) (let* ((converter-spec (pop converters)) (convert-to (nth 1 converter-spec)) (load-from (nth 2 converter-spec)) @@ -2297,24 +2315,23 @@ If FORCE is non-nil, the .newsrc file is read." (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/?)" + (message "Convert gnus 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")) + (error "Can not start gnus without converting")) ((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.") + To be safe, you should backup your files before proceeding.") (sit-for 5) t) (t @@ -2323,20 +2340,22 @@ If FORCE is non-nil, the .newsrc file is read." t))))) (funcall func convert-to))) - (gnus-dribble-enter - (format ";Converted newsrc from version '%s' to '%s'? (n/y/?)" + (gnus-dribble-enter + (format ";Converted gnus from version '%s' to '%s'." 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)))) + "Indicate whether CONVERTER requires gnus-convert-old-newsrc to + display the conversion prompt. NO-PROMPT may be nil (prompt), + t (no prompt), or any form that can be called as a function. + The form should return either t or nil." + (put converter 'gnus-convert-no-prompt no-prompt)) (defun gnus-convert-converter-needs-prompt (converter) - (not (memq 'gnus-convert-no-prompt (symbol-plist converter)))) + (let ((no-prompt (get converter 'gnus-convert-no-prompt))) + (not (if (memq no-prompt '(t nil)) + no-prompt + (funcall no-prompt))))) (defun gnus-convert-old-ticks (converting-to) (let ((newsrc (cdr gnus-newsrc-alist)) @@ -2609,7 +2628,7 @@ If FORCE is non-nil, the .newsrc file is read." (cond ((looking-at "[0-9]+") ;; We narrow and read a number instead of buffer-substring/ - ;; string-to-int because it's faster. narrow/widen is + ;; string-to-number because it's faster. narrow/widen is ;; faster than save-restriction/narrow, and save-restriction ;; produces a garbage object. (setq num1 (progn @@ -3260,12 +3279,10 @@ If this variable is nil, don't do anything." (file-name-as-directory (expand-file-name gnus-default-directory)) default-directory))) -(eval-and-compile -(defalias 'gnus-display-time-event-handler - (if (gnus-boundp 'display-time-timer) - 'display-time-event-handler - (lambda () "Does nothing as `display-time-timer' is not bound. -Would otherwise be an alias for `display-time-event-handler'." nil)))) +(defun gnus-display-time-event-handler () + (if (and (fboundp 'display-time-event-handler) + (gnus-boundp 'display-time-timer)) + (display-time-event-handler))) ;;;###autoload (defun gnus-fixup-nnimap-unread-after-getting-new-news () @@ -3281,6 +3298,41 @@ Would otherwise be an alias for `display-time-event-handler'." nil)))) (symbol-value 'nnimap-mailbox-info) (make-vector 1 0))))) +(defun gnus-check-reasonable-setup () + ;; Check whether nnml and nnfolder share a directory. + (let ((display-warn + (if (fboundp 'display-warning) + 'display-warning + (lambda (type message) + (if noninteractive + (message "Warning (%s): %s" type message) + (let (window) + (with-current-buffer (get-buffer-create "*Warnings*") + (goto-char (point-max)) + (unless (bolp) + (insert "\n")) + (insert (format "Warning (%s): %s\n" type message)) + (setq window (display-buffer (current-buffer))) + (set-window-start + window + (prog2 + (forward-line (- 1 (window-height window))) + (point) + (goto-char (point-max)))))))))) + method active actives match) + (dolist (server gnus-server-alist) + (setq method (gnus-server-to-method server) + active (intern (format "%s-active-file" (car method)))) + (when (and (member (car method) '(nnml nnfolder)) + (gnus-server-opened method) + (boundp active)) + (when (setq match (assoc (symbol-value active) actives)) + (funcall display-warn 'gnus-server + (format "%s and %s share the same active file %s" + (car method) + (cadr match) + (car match)))) + (push (list (symbol-value active) method) actives))))) (provide 'gnus-start)