X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Fgnus-start.el;h=de4564ecec5dd185294da298f78852dd92e8b3fa;hb=d48c014e9def24a6c0de92967e489c06923343c0;hp=66bb1533fb5a9e33f1068bfdf5b1d10114b2a8e5;hpb=887498497d42d6527754913f771648a6a941324b;p=elisp%2Fgnus.git- diff --git a/lisp/gnus-start.el b/lisp/gnus-start.el index 66bb153..de4564e 100644 --- a/lisp/gnus-start.el +++ b/lisp/gnus-start.el @@ -1,7 +1,7 @@ ;;; gnus-start.el --- startup functions for Gnus ;; Copyright (C) 1996,97,98 Free Software Foundation, Inc. -;; Author: Lars Magne Ingebrigtsen +;; Author: Lars Magne Ingebrigtsen ;; Keywords: news ;; This file is part of GNU Emacs. @@ -35,13 +35,13 @@ (eval-when-compile (require 'cl)) (defcustom gnus-startup-file (nnheader-concat gnus-home-directory ".newsrc") - "*Your `.newsrc' file. + "Your `.newsrc' file. `.newsrc-SERVER' will be used instead if that exists." :group 'gnus-start :type 'file) (defcustom gnus-init-file (nnheader-concat gnus-home-directory ".gnus") - "*Your Gnus Emacs-Lisp startup file name. + "Your Gnus Emacs-Lisp startup file name. If a file with the `.el' or `.elc' suffixes exists, it will be read instead." :group 'gnus-start :type 'file) @@ -58,7 +58,7 @@ If a file with the `.el' or `.elc' suffixes exists, it will be read instead." :type '(choice file (const nil))) (defcustom gnus-default-subscribed-newsgroups nil - "*List of newsgroups to subscribe, when a user runs Gnus the first time. + "List of newsgroups to subscribe, when a user runs Gnus the first time. The value should be a list of strings. If it is t, Gnus will not do anything special the first time it is started; it'll just use the normal newsgroups subscription methods." @@ -254,8 +254,6 @@ for your decision; `gnus-subscribe-killed' kills all new groups; (function-item gnus-subscribe-zombies) function)) -;; Suggested by a bug report by Hallvard B Furuseth. -;; . (defcustom gnus-subscribe-options-newsgroup-method 'gnus-subscribe-alphabetically "*This function is called to subscribe newsgroups mentioned on \"options -n\" lines. @@ -289,7 +287,7 @@ hierarchy in its entirety." :type 'boolean) (defcustom gnus-auto-subscribed-groups - "^nnml\\|^nnfolder\\|^nnmbox\\|^nnmh\\|^nnbabyl" + "nnml\\|^nnfolder\\|^nnmbox\\|^nnmh\\|^nnbabyl" "*All new groups that match this regexp will be subscribed automatically. Note that this variable only deals with new groups. It has no effect whatsoever on old groups. @@ -328,34 +326,34 @@ disc." :type 'boolean) (defcustom gnus-check-bogus-groups-hook nil - "*A hook run after removing bogus groups." + "A hook run after removing bogus groups." :group 'gnus-start-server :type 'hook) (defcustom gnus-startup-hook nil - "*A hook called at startup. + "A hook called at startup. This hook is called after Gnus is connected to the NNTP server." :group 'gnus-start :type 'hook) (defcustom gnus-before-startup-hook nil - "*A hook called at before startup. + "A hook called at before startup. This hook is called as the first thing when Gnus is started." :group 'gnus-start :type 'hook) (defcustom gnus-started-hook nil - "*A hook called as the last thing after startup." + "A hook called as the last thing after startup." :group 'gnus-start :type 'hook) (defcustom gnus-setup-news-hook nil - "*A hook after reading the .newsrc file, but before generating the buffer." + "A hook after reading the .newsrc file, but before generating the buffer." :group 'gnus-start :type 'hook) (defcustom gnus-get-new-news-hook nil - "*A hook run just before Gnus checks for new news." + "A hook run just before Gnus checks for new news." :group 'gnus-group-new :type 'hook) @@ -367,26 +365,31 @@ This hook is called as the first thing when Gnus is started." :type 'hook) (defcustom gnus-save-newsrc-hook nil - "*A hook called before saving any of the newsrc files." + "A hook called before saving any of the newsrc files." :group 'gnus-newsrc :type 'hook) (defcustom gnus-save-quick-newsrc-hook nil - "*A hook called just before saving the quick newsrc file. + "A hook called just before saving the quick newsrc file. Can be used to turn version control on or off." :group 'gnus-newsrc :type 'hook) (defcustom gnus-save-standard-newsrc-hook nil - "*A hook called just before saving the standard newsrc file. + "A hook called just before saving the standard newsrc file. Can be used to turn version control on or off." :group 'gnus-newsrc :type 'hook) -;;; Internal variables +(defcustom gnus-always-read-dribble-file nil + "Uncoditionally read the dribble file." + :group 'gnus-newsrc + :type 'boolean) -(defvar gnus-always-read-dribble-file nil - "Uncoditionally read the dribble file.") +(defvar gnus-startup-file-coding-system 'ctext + "*Coding system for startup file.") + +;;; Internal variables (defvar gnus-newsrc-file-version nil) (defvar gnus-override-subscribe-method nil) @@ -579,6 +582,7 @@ the first newsgroup." (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. @@ -622,8 +626,9 @@ the first newsgroup." (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)) @@ -655,8 +660,8 @@ prompt the user for the name of an NNTP server to use." (> 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) @@ -706,6 +711,8 @@ prompt the user for the name of an NNTP server to use." (gnus-group-first-unread-group) (gnus-configure-windows 'group) (gnus-group-set-mode-line) + ;; For reading Info. + (set-language-info "Japanese" 'gnus-info "gnus-ja") (gnus-run-hooks 'gnus-started-hook)))))) (defun gnus-start-draft-setup () @@ -759,6 +766,9 @@ prompt the user for the name of an NNTP server to use." (insert string "\n") (set-window-point (get-buffer-window (current-buffer)) (point-max)) (bury-buffer gnus-dribble-buffer) + (save-excursion + (set-buffer gnus-group-buffer) + (gnus-group-set-mode-line)) (set-buffer obuf)))) (defun gnus-dribble-touch () @@ -770,13 +780,12 @@ prompt the user for the name of an NNTP server to use." (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)) @@ -932,13 +941,25 @@ If LEVEL is non-nil, the news will be set up at level LEVEL." "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)) @@ -1026,16 +1047,18 @@ for new groups." (new-date (current-time-string)) group new-newsgroups got-new method hashtb gnus-override-subscribe-method) + (unless gnus-killed-hashtb + (gnus-make-hashtable-from-killed)) ;; 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)) @@ -1071,16 +1094,16 @@ for new groups." hashtb)) (when new-newsgroups (gnus-subscribe-hierarchical-interactive new-newsgroups))) - (when (> groups 0) - (gnus-message 6 "%d new newsgroup%s arrived." - groups (if (> groups 1) "s have" " has"))) + (if (> groups 0) + (gnus-message 5 "%d new newsgroup%s arrived" + groups (if (> groups 1) "s have" " has")) + (gnus-message 5 "No new newsgroups")) (when got-new (setq gnus-newsrc-last-checked-date new-date)) got-new)) (defun gnus-check-first-time-used () - (if (or (> (length gnus-newsrc-alist) 1) - (file-exists-p gnus-startup-file) + (if (or (file-exists-p gnus-startup-file) (file-exists-p (concat gnus-startup-file ".el")) (file-exists-p (concat gnus-startup-file ".eld"))) nil @@ -1113,7 +1136,9 @@ for new groups." (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")))))) @@ -1365,6 +1390,7 @@ newsgroup." info (inline (gnus-find-method-for-group (gnus-info-group info))))) (gnus-activate-group (gnus-info-group info) nil t)) + (let* ((range (gnus-info-read info)) (num 0)) ;; If a cache is present, we may have to alter the active info. @@ -1476,6 +1502,10 @@ newsgroup." ;; These groups are foreign. Check the level. (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 active) + (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)) @@ -1674,13 +1704,11 @@ newsgroup." (gnus-message 5 "%sdone" mesg)))))) (setq methods (cdr methods)))))) - (defun gnus-ignored-newsgroups-has-to-p () - "T only when gnus-ignored-newsgroups includes \"^to\\\\.\" as an element." + "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)) + (string-match "\\^to\\\\\\.\\($\\|\\\\|\\)" gnus-ignored-newsgroups)) ;; Read an active file and place the results in `gnus-active-hashtb'. (defun gnus-active-to-gnus-format (&optional method hashtb ignore-errors @@ -1742,13 +1770,13 @@ newsgroup." (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 @@ -1806,7 +1834,7 @@ newsgroup." (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)) @@ -1847,7 +1875,7 @@ If FORCE is non-nil, the .newsrc file is read." (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))) @@ -1887,7 +1915,8 @@ If FORCE is non-nil, the .newsrc file is read." (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 @@ -1965,7 +1994,8 @@ If FORCE is non-nil, the .newsrc file is read." (if (or (file-exists-p real-file) (file-exists-p (concat real-file ".el")) (file-exists-p (concat real-file ".eld"))) - real-file file))) + real-file + file))) (defun gnus-newsrc-to-gnus-format () (setq gnus-newsrc-options "") @@ -2021,7 +2051,7 @@ If FORCE is non-nil, the .newsrc file is read." (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) @@ -2045,7 +2075,7 @@ If FORCE is non-nil, the .newsrc file is read." (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) @@ -2067,8 +2097,8 @@ If FORCE is non-nil, the .newsrc file is read." (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 @@ -2194,7 +2224,7 @@ If FORCE is non-nil, the .newsrc file is read." (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. @@ -2236,19 +2266,19 @@ If FORCE is non-nil, the .newsrc file is read." (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)) @@ -2306,7 +2336,7 @@ If FORCE is non-nil, the .newsrc file is read." 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 @@ -2358,6 +2388,13 @@ If FORCE is non-nil, the .newsrc file is read." ;;; 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) @@ -2384,8 +2421,7 @@ If FORCE is non-nil, the .newsrc file is read." () ; 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)) @@ -2491,8 +2527,8 @@ If FORCE is non-nil, the .newsrc file is read." 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 (decode-coding-string str (car coding)))) (set group str))) (forward-line 1)))) (gnus-message 5 "Reading descriptions file...done")