;;; gnus-start.el --- startup functions for Gnus
-;; Copyright (C) 1996,97,98 Free Software Foundation, Inc.
+;; Copyright (C) 1996,97,98,99 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: news
:type 'file)
(defcustom gnus-site-init-file
- (condition-case nil
- (concat (file-name-directory
- (directory-file-name installation-directory))
- "site-lisp/gnus-init")
- (error nil))
+ (ignore-errors
+ (concat (file-name-directory
+ (directory-file-name installation-directory))
+ "site-lisp/gnus-init"))
"*The site-wide Gnus Emacs-Lisp startup file name, or nil if none.
If a file with the `.el' or `.elc' suffixes exists, it will be read instead."
:group 'gnus-start
(function-item gnus-subscribe-zombies)
function))
-;; Suggested by a bug report by Hallvard B Furuseth.
-;; <h.b.furuseth@usit.uio.no>.
(defcustom gnus-subscribe-options-newsgroup-method
'gnus-subscribe-alphabetically
"*This function is called to subscribe newsgroups mentioned on \"options -n\" lines.
:group 'gnus-newsrc
:type 'boolean)
+(defvar gnus-startup-file-coding-system 'binary
+ "*Coding system for startup file.")
+
;;; Internal variables
(defvar gnus-newsrc-file-version nil)
(file-exists-p (concat file ".el"))
(file-exists-p (concat file ".elc")))
(condition-case var
- (load file nil t)
+ (let ((coding-system-for-read
+ gnus-startup-file-coding-system))
+ (load file nil t))
(error
(error "Error in %s: %s" file var)))))))))
(defvar gnus-newsgroup-unreads)
(defvar nnoo-state-alist)
(defvar gnus-current-select-method)
+
(defun gnus-clear-system ()
"Clear all variables and buffers."
;; Clear Gnus variables.
(kill-buffer (get-file-buffer (gnus-newsgroup-kill-file nil))))
(gnus-kill-buffer nntp-server-buffer)
;; Kill Gnus buffers.
- (while gnus-buffer-list
- (gnus-kill-buffer (pop gnus-buffer-list)))
+ (let ((buffers (gnus-buffers)))
+ (when buffers
+ (mapcar 'kill-buffer buffers)))
;; Remove Gnus frames.
(gnus-kill-gnus-frames))
(> arg 0)
(max (car gnus-group-list-mode) arg))))
- (gnus-splash)
(gnus-clear-system)
+ (gnus-splash)
(gnus-run-hooks 'gnus-before-startup-hook)
(nnheader-init-server-buffer)
(setq gnus-slave slave)
(let ((dribble-file (gnus-dribble-file-name)))
(save-excursion
(set-buffer (setq gnus-dribble-buffer
- (get-buffer-create
+ (gnus-get-buffer-create
(file-name-nondirectory dribble-file))))
- (gnus-add-current-to-buffer-list)
(erase-buffer)
(setq buffer-file-name dribble-file)
(auto-save-mode t)
- (buffer-disable-undo (current-buffer))
+ (buffer-disable-undo)
(bury-buffer (current-buffer))
(set-buffer-modified-p nil)
(let ((auto (make-auto-save-file-name))
"Setup news information.
If RAWFILE is non-nil, the .newsrc file will also be read.
If LEVEL is non-nil, the news will be set up at level LEVEL."
- (let ((init (not (and gnus-newsrc-alist gnus-active-hashtb (not rawfile)))))
+ (require 'nnmail)
+ (let ((init (not (and gnus-newsrc-alist gnus-active-hashtb (not rawfile))))
+ ;; Binding this variable will inhibit multiple fetchings
+ ;; of the same mail source.
+ (nnmail-fetched-sources (list t)))
(when init
;; Clear some variables to re-initialize news information.
"Search for new newsgroups and add them.
Each new newsgroup will be treated with `gnus-subscribe-newsgroup-method.'
The `-n' option line from .newsrc is respected.
-If ARG (the prefix), use the `ask-server' method to query the server
-for new groups."
- (interactive "P")
- (let ((check (if (or (and arg (not (listp gnus-check-new-newsgroups)))
- (null gnus-read-active-file)
- (eq gnus-read-active-file 'some))
- 'ask-server gnus-check-new-newsgroups)))
+
+With 1 C-u, use the `ask-server' method to query the server for new
+groups.
+With 2 C-u's, use most complete method possible to query the server
+for new groups, and subscribe the new groups as zombies."
+ (interactive "p")
+ (let* ((gnus-subscribe-newsgroup-method
+ gnus-subscribe-newsgroup-method)
+ (check (cond
+ ((or (and (= (or arg 1) 4)
+ (not (listp gnus-check-new-newsgroups)))
+ (null gnus-read-active-file)
+ (eq gnus-read-active-file 'some))
+ 'ask-server)
+ ((= (or arg 1) 16)
+ (setq gnus-subscribe-newsgroup-method
+ 'gnus-subscribe-zombies)
+ t)
+ (t gnus-check-new-newsgroups))))
(unless (gnus-check-first-time-used)
(if (or (consp check)
(eq check 'ask-server))
;; Go through both primary and secondary select methods and
;; request new newsgroups.
(while (setq method (gnus-server-get-method nil (pop methods)))
- (setq new-newsgroups nil)
- (setq gnus-override-subscribe-method method)
+ (setq new-newsgroups nil
+ gnus-override-subscribe-method method)
(when (and (gnus-check-server method)
(gnus-request-newgroups date method))
(save-excursion
- (setq got-new t)
- (setq hashtb (gnus-make-hashtable 100))
+ (setq got-new t
+ hashtb (gnus-make-hashtable 100))
(set-buffer nntp-server-buffer)
;; Enter all the new groups into a hashtable.
(gnus-active-to-gnus-format method hashtb 'ignore))
got-new))
(defun gnus-check-first-time-used ()
- (if (or (> (length gnus-newsrc-alist) 1)
- (file-exists-p gnus-startup-file)
- (file-exists-p (concat gnus-startup-file ".el"))
- (file-exists-p (concat gnus-startup-file ".eld")))
- nil
+ (catch 'ended
+ (let ((files (list gnus-current-startup-file
+ (concat gnus-current-startup-file ".el")
+ (concat gnus-current-startup-file ".eld")
+ gnus-startup-file
+ (concat gnus-startup-file ".el")
+ (concat gnus-startup-file ".eld"))))
+ (while files
+ (when (file-exists-p (pop files))
+ (throw 'ended nil))))
(gnus-message 6 "First time user; subscribing you to default groups")
(unless (gnus-read-active-file-p)
(let ((gnus-read-active-file t))
(gnus-group-change-level
(car groups) gnus-level-default-subscribed gnus-level-killed))
(setq groups (cdr groups)))
- (gnus-group-make-help-group)
+ (save-excursion
+ (set-buffer gnus-group-buffer)
+ (gnus-group-make-help-group))
(when gnus-novice-user
(gnus-message 7 "`A k' to list killed groups"))))))
(setq active (gnus-active group))
(setq num
(if active (- (1+ (cdr active)) (car active)) t))
- ;; Check whether the group is foreign. If so, the
- ;; foreign select method has to be entered into the
- ;; info.
- (let ((method (or gnus-override-subscribe-method
- (gnus-group-method group))))
- (if (eq method gnus-select-method)
- (setq info (list group level nil))
- (setq info (list group level nil nil method)))))
+ ;; Shorten the select method if possible, if we need to
+ ;; store it at all (native groups).
+ (let ((method (gnus-method-simplify
+ (or gnus-override-subscribe-method
+ (gnus-group-method group)))))
+ (if method
+ (setq info (list group level nil nil method))
+ (setq info (list group level nil)))))
(unless previous
(setq previous
(let ((p gnus-newsrc-alist))
;; Then we want to peel off any elements that are higher
;; than the upper active limit.
(let ((srange range))
- ;; Go past all legal elements.
+ ;; Go past all valid elements.
(while (and (cdr srange)
(<= (or (and (atom (cadr srange))
(cadr srange))
(cdr active)))
(setq srange (cdr srange)))
(when (cdr srange)
- ;; Nuke all remaining illegal elements.
+ ;; Nuke all remaining invalid elements.
(setcdr srange nil))
;; Adjust the final element.
(when (<= (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 gnus-plugged)
+ (when (and gnus-agent gnus-plugged active)
(gnus-agent-save-group-info
method (gnus-group-real-name group) active))
(unless (inline (gnus-virtual-group-p group))
"-request-update-info")))
(inline (gnus-request-update-info info method))))
;; These groups are native or secondary.
- (when (and (<= (gnus-info-level info) level)
- (not gnus-read-active-file))
+ (cond
+ ;; We don't want these groups.
+ ((> (gnus-info-level info) level)
+ (setq active 'ignore))
+ ;; Activate groups.
+ ((not gnus-read-active-file)
(setq active (gnus-activate-group group 'scan))
- (inline (gnus-close-group group))))
+ (inline (gnus-close-group group)))))
;; Get the number of unread articles in the group.
- (if active
- (inline (gnus-get-unread-articles-in-group info active t))
+ (cond
+ ((eq active 'ignore)
+ ;; Don't do anything.
+ )
+ (active
+ (inline (gnus-get-unread-articles-in-group info active t)))
+ (t
;; The group couldn't be reached, so we nix out the number of
;; unread articles and stuff.
(gnus-set-active group nil)
- (setcar (gnus-gethash group gnus-newsrc-hashtb) t)))
+ (setcar (gnus-gethash group gnus-newsrc-hashtb) t))))
(gnus-message 5 "Checking new news...done")))
(defun gnus-read-active-file (&optional force not-native)
(gnus-group-set-mode-line)
(let ((methods
- (append
- (if (and (not not-native)
- (gnus-check-server gnus-select-method))
- ;; The native server is available.
- (cons gnus-select-method gnus-secondary-select-methods)
- ;; The native server is down, so we just do the
- ;; secondary ones.
- gnus-secondary-select-methods)
- ;; Also read from the archive server.
- (when (gnus-archive-server-wanted-p)
- (list "archive"))))
- list-type)
+ (mapcar
+ (lambda (m) (if (stringp m) (gnus-server-get-method nil m) m))
+ (append
+ (if (and (not not-native)
+ (gnus-check-server gnus-select-method))
+ ;; The native server is available.
+ (cons gnus-select-method gnus-secondary-select-methods)
+ ;; The native server is down, so we just do the
+ ;; secondary ones.
+ gnus-secondary-select-methods)
+ ;; Also read from the archive server.
+ (when (gnus-archive-server-wanted-p)
+ (list "archive")))))
+ method where mesg list-type)
(setq gnus-have-read-active-file nil)
(save-excursion
(set-buffer nntp-server-buffer)
- (while methods
- (let* ((method (if (stringp (car methods))
- (gnus-server-get-method nil (car methods))
- (car methods)))
- (where (nth 1 method))
- (mesg (format "Reading active file%s via %s..."
+ (while (setq method (pop methods))
+ (unless (member method methods)
+ (setq where (nth 1 method)
+ mesg (format "Reading active file%s via %s..."
(if (and where (not (zerop (length where))))
(concat " from " where) "")
- (car method))))
+ (car method)))
(gnus-message 5 mesg)
(when (gnus-check-server method)
;; Request that the backend scan its incoming messages.
(gnus-active-to-gnus-format method gnus-active-hashtb nil t)
;; We mark this active file as read.
(push method gnus-have-read-active-file)
- (gnus-message 5 "%sdone" mesg))))))
- (setq methods (cdr methods))))))
-
-
-(defun gnus-ignored-newsgroups-has-to-p ()
- "Non-nil iff gnus-ignored-newsgroups includes \"^to\\\\.\" as an element."
- ;; note this regexp is the same as:
- ;; (concat (regexp-quote "^to\\.") "\\($\\|" (regexp-quote "\\|") "\\)")
- (string-match "\\^to\\\\\\.\\($\\|\\\\|\\)" gnus-ignored-newsgroups))
+ (gnus-message 5 "%sdone" mesg))))))))))
;; Read an active file and place the results in `gnus-active-hashtb'.
(defun gnus-active-to-gnus-format (&optional method hashtb ignore-errors
(gnus-make-hashtable 4096)))))))
;; Delete unnecessary lines.
(goto-char (point-min))
- (cond ((gnus-ignored-newsgroups-has-to-p)
- (delete-matching-lines gnus-ignored-newsgroups))
- ((string= gnus-ignored-newsgroups "")
- (delete-matching-lines "^to\\."))
- (t
- (delete-matching-lines (concat "^to\\.\\|"
- gnus-ignored-newsgroups))))
+ (cond
+ ((string= gnus-ignored-newsgroups "")
+ (delete-matching-lines "^to\\."))
+ (t
+ (delete-matching-lines (concat "^to\\.\\|" gnus-ignored-newsgroups))))
;; Make the group names readable as a lisp expression even if they
;; contain special characters.
(progn
(skip-chars-forward " \t")
(not
- (or (= (following-char) ?=)
- (= (following-char) ?x)
- (= (following-char) ?j)))))
+ (or (eq (char-after) ?=)
+ (eq (char-after) ?x)
+ (eq (char-after) ?j)))))
(progn
(set group (cons min max))
;; if group is moderated, stick in moderation table
- (when (= (following-char) ?m)
+ (when (eq (char-after) ?m)
(unless gnus-moderated-hashtb
(setq gnus-moderated-hashtb (gnus-make-hashtable)))
(gnus-sethash (symbol-name group) t
(symbolp group)
(set group nil))
(unless ignore-errors
- (gnus-message 3 "Warning - illegal active: %s"
+ (gnus-message 3 "Warning - invalid active: %s"
(buffer-substring
(gnus-point-at-bol) (gnus-point-at-eol))))))
(widen)
;; Let the Gnus agent save the active file.
(when (and gnus-agent real-active)
(gnus-agent-save-groups method))
-
+
(goto-char (point-min))
;; We split this into to separate loops, one with the prefix
;; and one without to speed the reading up somewhat.
(let (min max group)
(while (not (eobp))
(condition-case ()
- (when (= (following-char) ?2)
+ (when (eq (char-after) ?2)
(read cur) (read cur)
(setq min (read cur)
max (read cur))
(save-excursion
(gnus-message 5 "Reading %s..." newsrc-file)
(set-buffer (nnheader-find-file-noselect newsrc-file))
- (buffer-disable-undo (current-buffer))
+ (buffer-disable-undo)
(gnus-newsrc-to-gnus-format)
(kill-buffer (current-buffer))
(gnus-message 5 "Reading %s...done" newsrc-file)))
(gnus-message 5 "Reading %s..." ding-file)
(let (gnus-newsrc-assoc)
(condition-case nil
- (load ding-file t t t)
+ (let ((coding-system-for-read gnus-startup-file-coding-system))
+ (load ding-file t t t))
(error
(ding)
(unless (gnus-yes-or-no-p
(unless (boundp symbol)
(set symbol nil))
;; It was a group name.
- (setq subscribed (= (following-char) ?:)
+ (setq subscribed (eq (char-after) ?:)
group (symbol-name symbol)
reads nil)
(if (eolp)
(read buf)))
(widen)
;; If the next character is a dash, then this is a range.
- (if (= (following-char) ?-)
+ (if (eq (char-after) ?-)
(progn
;; We read the upper bound of the range.
(forward-char 1)
(push num1 reads))
;; If the next char in ?\n, then we have reached the end
;; of the line and return nil.
- (/= (following-char) ?\n))
- ((= (following-char) ?\n)
+ (not (eq (char-after) ?\n)))
+ ((eq (char-after) ?\n)
;; End of line, so we end.
nil)
(t
(buffer-substring (gnus-point-at-bol)
(gnus-point-at-eol))))
nil))
- ;; Skip past ", ". Spaces are illegal in these ranges, but
+ ;; Skip past ", ". Spaces are invalid in these ranges, but
;; we allow them, because it's a common mistake to put a
;; space after the comma.
(skip-chars-forward ", "))
(gnus-point-at-eol)))
;; Search for all "words"...
(while (re-search-forward "[^ \t,\n]+" eol t)
- (if (= (char-after (match-beginning 0)) ?!)
+ (if (eq (char-after (match-beginning 0)) ?!)
;; If the word begins with a bang (!), this is a "not"
;; spec. We put this spec (minus the bang) and the
;; symbol `ignore' into the list.
(gnus-gnus-to-newsrc-format)
(gnus-message 8 "Saving %s...done" gnus-current-startup-file))
;; Save .newsrc.eld.
- (set-buffer (get-buffer-create " *Gnus-newsrc*"))
+ (set-buffer (gnus-get-buffer-create " *Gnus-newsrc*"))
(make-local-variable 'version-control)
(setq version-control 'never)
(setq buffer-file-name
(concat gnus-current-startup-file ".eld"))
(setq default-directory (file-name-directory buffer-file-name))
- (gnus-add-current-to-buffer-list)
- (buffer-disable-undo (current-buffer))
+ (buffer-disable-undo)
(erase-buffer)
(gnus-message 5 "Saving %s.eld..." gnus-current-startup-file)
(gnus-gnus-to-quick-newsrc-format)
(gnus-run-hooks 'gnus-save-quick-newsrc-hook)
- (save-buffer)
+ (let ((coding-system-for-write gnus-startup-file-coding-system))
+ (save-buffer))
(kill-buffer (current-buffer))
(gnus-message
5 "Saving %s.eld...done" gnus-current-startup-file))
info ranges range method)
(setq buffer-file-name gnus-current-startup-file)
(setq default-directory (file-name-directory buffer-file-name))
- (buffer-disable-undo (current-buffer))
+ (buffer-disable-undo)
(erase-buffer)
;; Write options.
(when gnus-newsrc-options
;;; Slave functions.
;;;
+(defvar gnus-slave-mode nil)
+
+(defun gnus-slave-mode ()
+ "Minor mode for slave Gnusae."
+ (gnus-add-minor-mode 'gnus-slave-mode " Slave" (make-sparse-keymap))
+ (gnus-run-hooks 'gnus-slave-mode-hook))
+
(defun gnus-slave-save-newsrc ()
(save-excursion
(set-buffer gnus-dribble-buffer)
() ; There are no slave files to read.
(gnus-message 7 "Reading slave newsrcs...")
(save-excursion
- (set-buffer (get-buffer-create " *gnus slave*"))
- (buffer-disable-undo (current-buffer))
+ (set-buffer (gnus-get-buffer-create " *gnus slave*"))
(setq slave-files
(sort (mapcar (lambda (file)
(list (nth 5 (file-attributes file)) file))
enable-multibyte-characters
(fboundp 'gnus-mule-get-coding-system)
(gnus-mule-get-coding-system (symbol-name group)))))
- (if coding
- (setq str (gnus-decode-coding-string str (car coding))))
+ (when coding
+ (setq str (mm-decode-coding-string str (car coding))))
(set group str)))
(forward-line 1))))
(gnus-message 5 "Reading descriptions file...done")
projects / elisp / gnus.git- / blobdiff