;;; 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 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; 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 <http://www.gnu.org/licenses/>.
;;; Commentary:
(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.
: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"
(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.")
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)
(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
(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
: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)
;;; 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.")
"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)))
(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))
;;; 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."
(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)
(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")
(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))
(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))
(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)))))
(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)
(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.
(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.
(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
;; 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)
(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
((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
'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)
(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.
;; 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))
((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
(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)))))
(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
(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
(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")))
;; 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
(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
(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
(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)))
(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"))
(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
(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))
(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))
(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)))))
\f
(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 ()
(provide 'gnus-start)
-;;; arch-tag: f4584a22-b7b7-4853-abfc-a637329af5d2
+;; arch-tag: f4584a22-b7b7-4853-abfc-a637329af5d2
;;; gnus-start.el ends here