X-Git-Url: http://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Fgnus-start.el;h=ff51530457fa28ac34fd1ea02b37332551368a21;hb=f129936b5f5743512e00459b1ebba068a1025fb9;hp=35ce7fc4d98cbe4f451ca9feedc51ea762cf36e5;hpb=08c43b22dab8f6e37dd6d727ddf277bedb4e364d;p=gnus diff --git a/lisp/gnus-start.el b/lisp/gnus-start.el index 35ce7fc4d..ff5153045 100644 --- a/lisp/gnus-start.el +++ b/lisp/gnus-start.el @@ -1,26 +1,25 @@ ;;; 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, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Keywords: news ;; This file is part of GNU Emacs. -;; GNU Emacs is free software; you can redistribute it and/or modify +;; GNU Emacs is free software: you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 2, or (at your option) -;; any later version. +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. ;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; 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. +;; along with GNU Emacs. If not, see . ;;; Commentary: @@ -38,11 +37,11 @@ (autoload 'gnus-agent-possibly-alter-active "gnus-agent") (eval-when-compile - (require 'cl) + (require 'cl)) - (defvar gnus-agent-covered-methods nil) - (defvar gnus-agent-file-loading-local nil) - (defvar gnus-agent-file-loading-cache nil)) +(defvar gnus-agent-covered-methods) +(defvar gnus-agent-file-loading-local) +(defvar gnus-agent-file-loading-cache) (defcustom gnus-startup-file (nnheader-concat gnus-home-directory ".newsrc") "Your `.newsrc' file. @@ -51,7 +50,7 @@ :type 'file) (defcustom gnus-backup-startup-file 'never - "Whether to create backup files. + "Control use of version numbers for backups of `gnus-startup-file'. This variable takes the same values as the `version-control' variable." :version "22.1" @@ -177,8 +176,13 @@ properly with all servers." (defconst gnus-level-unsubscribed 7 "Groups with levels less than or equal to this variable are unsubscribed. -Groups with levels less than `gnus-level-subscribed', which should be -less than this variable, are subscribed.") + +Groups with levels less than `gnus-level-subscribed', which +should be less than this variable, are subscribed. Groups with +levels from `gnus-level-subscribed' (exclusive) upto this +variable (inclusive) are unsubscribed. See also +`gnus-level-zombie', `gnus-level-killed' and the Info node `Group +Levels' for details.") (defconst gnus-level-zombie 8 "Groups with this level are zombie groups.") @@ -312,8 +316,8 @@ If, for instance, you want to subscribe to all newsgroups in the options -n no.all alt.all -Gnus will the subscribe all new newsgroups in these hierarchies with -the subscription method in this variable." +Gnus will then subscribe all new newsgroups in these hierarchies +with the subscription method in this variable." :group 'gnus-group-new :type '(radio (function-item gnus-subscribe-randomly) (function-item gnus-subscribe-alphabetically) @@ -351,7 +355,7 @@ be subscribed using `gnus-subscribe-options-newsgroup-method'." (defcustom gnus-options-subscribe nil "*All new groups matching this regexp will be subscribed unconditionally. -Note that this variable deals only with new newsgroups. This variable +Note that this variable deals only with new newsgroups. This variable does not affect old newsgroups. New groups that match this regexp will not be handled by @@ -363,7 +367,7 @@ be subscribed using `gnus-subscribe-options-newsgroup-method'." (defcustom gnus-options-not-subscribe nil "*All new groups matching this regexp will be ignored. -Note that this variable deals only with new newsgroups. This variable +Note that this variable deals only with new newsgroups. This variable does not affect old (already subscribed) newsgroups." :group 'gnus-group-new :type '(choice regexp @@ -388,7 +392,7 @@ This hook is called after Gnus is connected to the NNTP server." :type 'hook) (defcustom gnus-before-startup-hook nil - "A hook called at before startup. + "A hook called before startup. This hook is called as the first thing when Gnus is started." :group 'gnus-start :type 'hook) @@ -457,6 +461,8 @@ Can be used to turn version control on or off." ;;; Internal variables +;; Fixme: deal with old emacs-mule when mm-universal-coding-system is +;; utf-8-emacs. (defvar gnus-ding-file-coding-system mm-universal-coding-system "Coding system for ding file.") @@ -611,7 +617,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))) @@ -625,7 +631,7 @@ it is killed." (defun gnus-subscribe-newsgroup (newsgroup &optional next) "Subscribe new NEWSGROUP. -If NEXT is non-nil, it is inserted before NEXT. Otherwise it is made +If NEXT is non-nil, it is inserted before NEXT. Otherwise it is made the first newsgroup." (save-excursion (goto-char (point-min)) @@ -644,21 +650,20 @@ the first newsgroup." ;;; General various misc type functions. ;; Silence byte-compiler. -(eval-when-compile - (defvar gnus-current-headers) - (defvar gnus-thread-indent-array) - (defvar gnus-newsgroup-name) - (defvar gnus-newsgroup-headers) - (defvar gnus-group-list-mode) - (defvar gnus-group-mark-positions) - (defvar gnus-newsgroup-data) - (defvar gnus-newsgroup-unreads) - (defvar nnoo-state-alist) - (defvar gnus-current-select-method) - (defvar mail-sources) - (defvar nnmail-scan-directory-mail-source-once) - (defvar nnmail-split-history) - (defvar nnmail-spool-file)) +(defvar gnus-current-headers) +(defvar gnus-thread-indent-array) +(defvar gnus-newsgroup-name) +(defvar gnus-newsgroup-headers) +(defvar gnus-group-list-mode) +(defvar gnus-group-mark-positions) +(defvar gnus-newsgroup-data) +(defvar gnus-newsgroup-unreads) +(defvar nnoo-state-alist) +(defvar gnus-current-select-method) +(defvar mail-sources) +(defvar nnmail-scan-directory-mail-source-once) +(defvar nnmail-split-history) +(defvar nnmail-spool-file) (defun gnus-close-all-servers () "Close all servers." @@ -721,11 +726,12 @@ the first newsgroup." (defun gnus-no-server-1 (&optional arg slave) "Read network news. -If ARG is a positive number, Gnus will use that as the -startup level. If ARG is nil, Gnus will be started at level 2. -If ARG is non-nil and not a positive number, Gnus will -prompt the user for the name of an NNTP server to use. -As opposed to `gnus', this command will not connect to the local server." +If ARG is a positive number, Gnus will use that as the startup +level. If ARG is nil, Gnus will be started at level 2 +\(`gnus-level-default-subscribed' minus one). If ARG is non-nil +and not a positive number, Gnus will prompt the user for the name +of an NNTP server to use. As opposed to \\[gnus], this command +will not connect to the local server." (interactive "P") (let ((val (or arg (1- gnus-level-default-subscribed)))) (gnus val t slave) @@ -735,7 +741,7 @@ As opposed to `gnus', this command will not connect to the local server." (defun gnus-1 (&optional arg dont-connect slave) "Read network news. If ARG is non-nil and a positive number, Gnus will use that as the -startup level. If ARG is non-nil and not a positive number, Gnus will +startup level. If ARG is non-nil and not a positive number, Gnus will prompt the user for the name of an NNTP server to use." (interactive "P") @@ -753,6 +759,13 @@ prompt the user for the name of an NNTP server to use." (nnheader-init-server-buffer) (setq gnus-slave slave) (gnus-read-init-file) + + ;; Add "native" to gnus-predefined-server-alist just to have a + ;; name for the native select method. + (when gnus-select-method + (push (cons "native" gnus-select-method) + gnus-predefined-server-alist)) + (if gnus-agent (gnus-agentize)) @@ -761,8 +774,7 @@ prompt the user for the name of an NNTP server to use." (cond ((featurep 'xemacs) (gnus-xmas-splash)) - ((and window-system - (= (frame-height) (1+ (window-height)))) + (window-system (gnus-x-splash)))) (let ((level (and (numberp arg) (> arg 0) arg)) @@ -805,7 +817,10 @@ prompt the user for the name of an NNTP server to use." (gnus-request-create-group "drafts" '(nndraft "")) (unless (gnus-group-entry "nndraft:drafts") (let ((gnus-level-default-subscribed 1)) - (gnus-subscribe-group "nndraft:drafts" nil '(nndraft ""))) + (gnus-subscribe-group "nndraft:drafts" nil '(nndraft "")))) + (unless (equal (gnus-group-get-parameter "nndraft:drafts" 'gnus-dummy t) + '((gnus-draft-mode))) + (gnus-message 3 "Setting up drafts group") (gnus-group-set-parameter "nndraft:drafts" 'gnus-dummy '((gnus-draft-mode))))) @@ -857,6 +872,7 @@ prompt the user for the name of an NNTP server to use." (set-buffer (setq gnus-dribble-buffer (gnus-get-buffer-create (file-name-nondirectory dribble-file)))) + (set (make-local-variable 'file-precious-flag) t) (erase-buffer) (setq buffer-file-name dribble-file) (auto-save-mode t) @@ -950,30 +966,34 @@ If LEVEL is non-nil, the news will be set up at level LEVEL." (gnus-read-newsrc-file rawfile)) ;; Make sure the archive server is available to all and sundry. - (when gnus-message-archive-method - (unless (assoc "archive" 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)))) + (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 (not method) + (stringp method) + (memq 'respool (assoc (format "%s" (car method)) + gnus-valid-select-methods))) + (setq method "archive")) ;; The default. + (when (stringp method) + (setq method `(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)))) + (if (assoc "archive" gnus-server-alist) + (when gnus-update-message-archive-method + (if method + (setcdr (assoc "archive" gnus-server-alist) method) + (setq gnus-server-alist (delq (assoc "archive" gnus-server-alist) + gnus-server-alist)))) + (when method + (push (cons "archive" method) gnus-server-alist)))) ;; If we don't read the complete active file, we fill in the ;; hashtb here. @@ -1040,9 +1060,12 @@ If LEVEL is non-nil, the news will be set up at level LEVEL." (gnus-check-bogus-newsgroups)) ;; We might read in new NoCeM messages here. - (when (and gnus-use-nocem - (not level) - (not dont-connect)) + (when (and (not dont-connect) + gnus-use-nocem + (or (and (numberp gnus-use-nocem) + (numberp level) + (>= level gnus-use-nocem)) + (not level))) (gnus-nocem-scan-groups)) ;; Read any slave files. @@ -1488,8 +1511,8 @@ newsgroup." (setq killed (cdr killed))))) ;; We want to inline a function from gnus-cache, so we cheat here: +(defvar gnus-cache-active-hashtb) (eval-when-compile - (defvar gnus-cache-active-hashtb) (defun gnus-cache-possibly-alter-active (group active) "Alter the ACTIVE info for GROUP to reflect the articles in the cache." (when gnus-cache-active-hashtb @@ -1528,8 +1551,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) @@ -1646,7 +1669,7 @@ If SCAN, request a scan of that group as well." (defun gnus-get-unread-articles (&optional level) (setq gnus-server-method-cache nil) (let* ((newsrc (cdr gnus-newsrc-alist)) - (level (or level gnus-activate-level (1+ gnus-level-subscribed))) + (alevel (or level gnus-activate-level (1+ gnus-level-subscribed))) (foreign-level (min (cond ((and gnus-activate-foreign-newsgroups @@ -1655,11 +1678,11 @@ If SCAN, request a scan of that group as well." ((numberp gnus-activate-foreign-newsgroups) gnus-activate-foreign-newsgroups) (t 0)) - level)) + alevel)) (methods-cache nil) (type-cache nil) scanned-methods info group active method retrieve-groups cmethod - method-type ignore) + method-type) (gnus-message 6 "Checking new news...") (while newsrc @@ -1696,7 +1719,6 @@ If SCAN, request a scan of that group as well." 'foreign))) (push (cons method method-type) type-cache)) - (setq ignore nil) (cond ((and method (eq method-type 'foreign)) ;; These groups are foreign. Check the level. (if (<= (gnus-info-level info) foreign-level) @@ -1710,9 +1732,17 @@ If SCAN, request a scan of that group as well." (when (fboundp (intern (concat (symbol-name (car method)) "-request-update-info"))) (inline (gnus-request-update-info info method)))) - (setq ignore t))) + (if (and level + ;; If `active' is nil that means the group has + ;; never been read, the group should be marked + ;; as having never been checked (see below). + active + (> (gnus-info-level info) level)) + ;; Don't check groups of which levels are higher + ;; than the one that a user specified. + (setq active 'ignore)))) ;; These groups are native or secondary. - ((> (gnus-info-level info) level) + ((> (gnus-info-level info) alevel) ;; We don't want these groups. (setq active 'ignore)) ;; Activate groups. @@ -1732,11 +1762,7 @@ If SCAN, request a scan of that group as well." ;; 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)))))) + (null (assq 'directory mail-sources))) (member method scanned-methods)) (setq active (gnus-activate-group group)) (setq active (gnus-activate-group group 'scan)) @@ -1749,10 +1775,6 @@ If SCAN, request a scan of that group as well." ((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 @@ -1943,7 +1965,7 @@ If SCAN, request a scan of that group as well." (while lists (setq killed (car lists)) (while killed - (gnus-sethash (car killed) nil hashtb) + (gnus-sethash (mm-string-as-unibyte (car killed)) nil hashtb) (setq killed (cdr killed))) (setq lists (cdr lists))))) @@ -2080,7 +2102,8 @@ If SCAN, request a scan of that group as well." (if (equal method gnus-select-method) (gnus-make-hashtable (count-lines (point-min) (point-max))) - (gnus-make-hashtable 4096))))))) + (gnus-make-hashtable 4096)))))) + group max min) ;; Delete unnecessary lines. (goto-char (point-min)) (cond @@ -2115,8 +2138,12 @@ If SCAN, request a scan of that group as well." (insert prefix) (zerop (forward-line 1))))))) ;; Store the active file in a hash table. - (goto-char (point-min)) - (let (group max min) + ;; Use a unibyte buffer in order to make `read' read non-ASCII + ;; group names (which have been encoded) as unibyte strings. + (mm-with-unibyte-buffer + (insert-buffer-substring cur) + (setq cur (current-buffer)) + (goto-char (point-min)) (while (not (eobp)) (condition-case () (progn @@ -2365,11 +2392,11 @@ If FORCE is non-nil, the .newsrc file is read." (eval form)) (error (unless (eq (car type) 'end-of-file) - (let ((error (format "Error in %s line %d" file - (count-lines (point-min) (point))))) + (let ((errmsg (format "Error in %s line %d" file + (count-lines (point-min) (point))))) (ding) - (unless (gnus-yes-or-no-p (concat error "; continue? ")) - (error "%s" error))))))))) + (unless (gnus-yes-or-no-p (concat errmsg "; continue? ")) + (error "%s" errmsg))))))))) (defun gnus-read-newsrc-el-file (file) (let ((ding-file (concat file "d"))) @@ -2377,8 +2404,7 @@ If FORCE is non-nil, the .newsrc file is read." ;; We always, always read the .eld file. (gnus-message 5 "Reading %s..." ding-file) (let (gnus-newsrc-assoc) - (let ((coding-system-for-read gnus-ding-file-coding-system)) - (gnus-load ding-file)) + (gnus-load ding-file) ;; Older versions of `gnus-format-specs' are no longer valid ;; in Oort Gnus 0.01. (let ((version @@ -2389,6 +2415,8 @@ If FORCE is non-nil, the .newsrc file is read." (setq gnus-format-specs gnus-default-format-specs))) (when gnus-newsrc-assoc (setq gnus-newsrc-alist gnus-newsrc-assoc)))) + (dolist (elem gnus-newsrc-alist) + (setcar elem (mm-string-as-unibyte (car elem)))) (gnus-make-hashtable-from-newsrc-alist) (when (file-newer-than-file-p file ding-file) ;; Old format quick file @@ -2533,7 +2561,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 @@ -2771,9 +2799,7 @@ If FORCE is non-nil, the .newsrc file is read." (if (and (eq system-type 'ms-dos) (not (gnus-long-file-names))) "%s#%d.tm#" ; MSDOS limits files to 8+3 - (if (memq system-type '(vax-vms axp-vms)) - "%s$tmp$%d" - "%s#tmp#%d")) + "%s#tmp#%d") working-dir (setq i (1+ i)))) (file-exists-p working-file))) @@ -2808,7 +2834,8 @@ If FORCE is non-nil, the .newsrc file is read." (defun gnus-gnus-to-quick-newsrc-format (&optional minimal name &rest specific-variables) "Print Gnus variables such as `gnus-newsrc-alist' in Lisp format." - (princ ";; -*- emacs-lisp -*-\n") + (princ (format ";; -*- mode:emacs-lisp; coding: %s; -*-\n" + gnus-ding-file-coding-system)) (if name (princ (format ";; %s\n" name)) (princ ";; Gnus startup file.\n")) @@ -2827,6 +2854,7 @@ If FORCE is non-nil, the .newsrc file is read." (print-escape-nonascii t) (print-length nil) (print-level nil) + (print-circle nil) (print-escape-newlines t) (gnus-killed-list (if (and gnus-save-killed-list @@ -2846,7 +2874,7 @@ If FORCE is non-nil, the .newsrc file is read." (while variables (when (and (boundp (setq variable (pop variables))) (symbol-value variable)) - (princ "(setq ") + (princ "\n(setq ") (princ (symbol-name variable)) (princ " '") (prin1 (symbol-value variable)) @@ -2873,6 +2901,10 @@ If FORCE is non-nil, the .newsrc file is read." (setq default-directory (file-name-directory buffer-file-name)) (buffer-disable-undo) (erase-buffer) + ;; Use a unibyte buffer since group names are unibyte strings; + ;; in particular, non-ASCII group names are the ones encoded by + ;; a certain coding system. + (mm-disable-multibyte) ;; Write options. (when gnus-newsrc-options (insert gnus-newsrc-options)) @@ -2915,7 +2947,8 @@ If FORCE is non-nil, the .newsrc file is read." (delete-file gnus-startup-file) (clear-visited-file-modtime)) (gnus-run-hooks 'gnus-save-standard-newsrc-hook) - (save-buffer) + (let ((coding-system-for-write 'raw-text)) + (save-buffer)) (kill-buffer (current-buffer))))) @@ -2927,6 +2960,8 @@ If FORCE is non-nil, the .newsrc file is read." (defun gnus-slave-mode () "Minor mode for slave Gnusae." + ;; FIXME: gnus-slave-mode appears to never be set (i.e. it'll always be nil): + ;; Remove, or fix and use define-minor-mode. (add-minor-mode 'gnus-slave-mode " Slave" (make-sparse-keymap)) (gnus-run-hooks 'gnus-slave-mode-hook)) @@ -3025,6 +3060,7 @@ If FORCE is non-nil, the .newsrc file is read." nil) (t (save-excursion + ;; FIXME: Shouldn't save-restriction be done after set-buffer? (save-restriction (set-buffer nntp-server-buffer) (goto-char (point-min)) @@ -3099,12 +3135,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 () @@ -3158,7 +3192,7 @@ Would otherwise be an alias for `display-time-event-handler'." nil)))) (provide 'gnus-start) -;;; arch-tag: f4584a22-b7b7-4853-abfc-a637329af5d2 +;; arch-tag: f4584a22-b7b7-4853-abfc-a637329af5d2 ;;; gnus-start.el ends here