(require 'gnus-range)
(require 'gnus-util)
(require 'message)
+(eval-when-compile (require 'cl))
(defcustom gnus-startup-file (nnheader-concat gnus-home-directory ".newsrc")
"Your `.newsrc' file.
:type 'file)
(defcustom gnus-init-file (nnheader-concat gnus-home-directory ".gnus")
- "Your Gnus elisp startup file.
-If a file with the .el or .elc suffixes exist, it will be read
-instead."
+ "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)
(defcustom gnus-site-init-file
- (ignore-errors
- (concat (file-name-directory
- (directory-file-name installation-directory))
- "site-lisp/gnus-init"))
- "The site-wide Gnus elisp startup file.
-If a file with the .el or .elc suffixes exist, it will be read
-instead."
+ (condition-case nil
+ (concat (file-name-directory
+ (directory-file-name installation-directory))
+ "site-lisp/gnus-init")
+ (error nil))
+ "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
- :type 'file)
+ :type '(choice file (const nil)))
(defcustom gnus-default-subscribed-newsgroups nil
- "This variable lists what newsgroups should be subscribed the first time Gnus is used.
-It should be a list of strings.
-If it is `t', Gnus will not do anything special the first time it is
+ "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."
:group 'gnus-start
- :type '(repeat string))
+ :type '(choice (repeat string) (const :tag "Nothing special" t)))
(defcustom gnus-use-dribble-file t
"*Non-nil means that Gnus will use a dribble file to store user updates.
:group 'gnus-dribble-file
:type '(choice directory (const nil)))
-(defcustom gnus-check-new-newsgroups t
+(defcustom gnus-check-new-newsgroups 'ask-server
"*Non-nil means that Gnus will run gnus-find-new-newsgroups at startup.
This normally finds new newsgroups by comparing the active groups the
servers have already reported with those Gnus already knows, either alive
:group 'gnus-start-server
:type 'boolean)
-(defcustom gnus-read-active-file t
+(defcustom gnus-read-active-file 'some
"*Non-nil means that Gnus will read the entire active file at startup.
If this variable is nil, Gnus will only know about the groups in your
`.newsrc' file.
:group 'gnus-start
:type 'hook)
+(defcustom gnus-before-startup-hook nil
+ "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."
:group 'gnus-start
:type 'hook)
+(defcustom gnus-setup-news-hook nil
+ "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."
:group 'gnus-group-new
(push prefix prefixes)
(message "Descend hierarchy %s? ([y]nsq): "
(substring prefix 1 (1- (length prefix))))
- (while (not (memq (setq ans (read-char)) '(?y ?\n ?\r ?n ?s ?q)))
+ (while (not (memq (setq ans (read-char-exclusive))
+ '(?y ?\n ?\r ?n ?s ?q)))
(ding)
(message "Descend hierarchy %s? ([y]nsq): "
(substring prefix 1 (1- (length prefix)))))
(setq groups (cdr groups))))
(t nil)))
(message "Subscribe %s? ([n]yq)" (car groups))
- (while (not (memq (setq ans (read-char)) '(?y ?\n ?\r ?q ?n)))
+ (while (not (memq (setq ans (read-char-exclusive))
+ '(?y ?\n ?\r ?q ?n)))
(ding)
(message "Subscribe %s? ([n]yq)" (car groups)))
(setq group (car groups))
(gnus-splash)
(gnus-clear-system)
+ (run-hooks 'gnus-before-startup-hook)
(nnheader-init-server-buffer)
- (gnus-read-init-file)
(setq gnus-slave slave)
+ (gnus-read-init-file)
- (when (and (string-match "XEmacs" (emacs-version))
- gnus-simple-splash)
+ (when gnus-simple-splash
(setq gnus-simple-splash nil)
- (gnus-xmas-splash))
+ (cond
+ (gnus-xemacs
+ (gnus-xmas-splash))
+ ((and (eq window-system 'x)
+ (= (frame-height) (1+ (window-height))))
+ (gnus-x-splash))))
(let ((level (and (numberp arg) (> arg 0) arg))
did-connect)
;; Do the actual startup.
(gnus-setup-news nil level dont-connect)
+ (run-hooks 'gnus-setup-news-hook)
+ (gnus-start-draft-setup)
;; Generate the group buffer.
(gnus-group-list-groups level)
(gnus-group-first-unread-group)
(gnus-group-set-mode-line)
(run-hooks 'gnus-started-hook))))))
+(defun gnus-start-draft-setup ()
+ "Make sure the draft group exists."
+ (gnus-request-create-group "drafts" '(nndraft ""))
+ (unless (gnus-gethash "nndraft:drafts" gnus-newsrc-hashtb)
+ (let ((gnus-level-default-subscribed 1))
+ (gnus-subscribe-group "nndraft:drafts" nil '(nndraft "")))
+ (gnus-group-set-parameter
+ "nndraft:drafts" 'gnus-dummy '((gnus-draft-mode)))))
+
;;;###autoload
(defun gnus-unload ()
"Unload all Gnus features."
(interactive)
(unless (boundp 'load-history)
- (error "Sorry, `gnus-unload' is not implemented in this Emacs version."))
+ (error "Sorry, `gnus-unload' is not implemented in this Emacs version"))
(let ((history load-history)
feature)
(while history
;; Set the file modes to reflect the .newsrc file modes.
(save-buffer)
(when (and (file-exists-p gnus-current-startup-file)
+ (file-exists-p dribble-file)
(setq modes (file-modes gnus-current-startup-file)))
(set-file-modes dribble-file modes))
;; Possibly eval the file later.
;; Read the newsrc file and create `gnus-newsrc-hashtb'.
(gnus-read-newsrc-file rawfile))
- (when (and (not (assoc "archive" gnus-server-alist))
- (gnus-archive-server-wanted-p))
+ ;; Make sure the archive server is available to all and sundry.
+ (when gnus-message-archive-method
+ (setq gnus-server-alist (delq (assoc "archive" gnus-server-alist)
+ gnus-server-alist))
(push (cons "archive" gnus-message-archive-method)
gnus-server-alist))
;; done in `gnus-get-unread-articles'.
(and gnus-read-active-file
(not level)
- (gnus-read-active-file))
+ (gnus-read-active-file nil dont-connect))
(unless gnus-active-hashtb
(setq gnus-active-hashtb (gnus-make-hashtable 4096)))
;; See whether we need to read the description file.
(when (and (boundp 'gnus-group-line-format)
- (string-match "%[-,0-9]*D" gnus-group-line-format)
+ (let ((case-fold-search nil))
+ (string-match "%[-,0-9]*D" gnus-group-line-format))
(not gnus-description-hashtb)
(not dont-connect)
gnus-read-active-file)
"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."
+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)
hashtb))
(when new-newsgroups
(gnus-subscribe-hierarchical-interactive new-newsgroups)))
- ;; Suggested by Per Abrahamsen <amanda@iesd.auc.dk>.
(when (> groups 0)
(gnus-message 6 "%d new newsgroup%s arrived."
groups (if (> groups 1) "s have" " has")))
nil
(gnus-message 6 "First time user; subscribing you to default groups")
(unless (gnus-read-active-file-p)
- (gnus-read-active-file))
+ (let ((gnus-read-active-file t))
+ (gnus-read-active-file)))
(setq gnus-newsrc-last-checked-date (current-time-string))
(let ((groups gnus-default-subscribed-newsgroups)
group)
(format
"(gnus-group-set-info '%S)" info)))))
(when gnus-group-change-level-function
- (funcall gnus-group-change-level-function group level oldlevel)))))
+ (funcall gnus-group-change-level-function
+ group level oldlevel previous)))))
(defun gnus-kill-newsgroup (newsgroup)
"Obsolete function. Kills a newsgroup."
(when (setq entry (gnus-gethash group gnus-newsrc-hashtb))
(gnus-group-change-level entry gnus-level-killed)
(setq gnus-killed-list (delete group gnus-killed-list))))
- bogus)
+ bogus '("group" "groups" "remove"))
(while (setq group (pop bogus))
;; Remove all bogus subscribed groups by first killing them, and
;; then removing them from the list of killed groups.
"Alter the ACTIVE info for GROUP to reflect the articles in the cache."
(when gnus-cache-active-hashtb
(let ((cache-active (gnus-gethash group gnus-cache-active-hashtb)))
- (and cache-active
- (< (car cache-active) (car active))
- (setcar active (car cache-active)))
- (and cache-active
- (> (cdr cache-active) (cdr active))
- (setcdr active (cdr cache-active)))))))
+ (when cache-active
+ (when (< (car cache-active) (car active))
+ (setcar active (car cache-active)))
+ (when (> (cdr cache-active) (cdr active))
+ (setcdr active (cdr cache-active))))))))
(defun gnus-activate-group (group &optional scan dont-check method)
;; Check whether a group has been activated or not.
(inline (gnus-request-group group dont-check method))
(error nil)
(quit nil))
- (gnus-set-active group (setq active (gnus-parse-active)))
- ;; Return the new active info.
- active)))
+ (setq active (gnus-parse-active))
+ ;; If there are no articles in the group, the GROUP
+ ;; 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))
+ (gnus-active group))
+ (gnus-active group)
+ (gnus-set-active group active)
+ ;; Return the new active info.
+ active))))
(defun gnus-get-unread-articles-in-group (info active &optional update)
(when active
(while alist
(gnus-sethash
(caar alist)
+ ;; Preserve number of unread articles in groups.
(cons (and ohashtb (car (gnus-gethash (caar alist) ohashtb)))
prev)
gnus-newsrc-hashtb)
(gnus-dribble-touch))
;; Get the active file(s) from the backend(s).
-(defun gnus-read-active-file (&optional force)
+(defun gnus-read-active-file (&optional force not-native)
(gnus-group-set-mode-line)
(let ((methods
(append
- (if (gnus-check-server gnus-select-method)
+ (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
1.2 "Cannot read partial active file from %s server."
(car method)))
((eq list-type 'active)
- (gnus-active-to-gnus-format method gnus-active-hashtb))
+ (gnus-active-to-gnus-format
+ method gnus-active-hashtb nil t))
(t
- (gnus-groups-to-gnus-format method gnus-active-hashtb))))))
+ (gnus-groups-to-gnus-format
+ method gnus-active-hashtb t))))))
((null method)
t)
(t
(if (not (gnus-request-list method))
(unless (equal method gnus-message-archive-method)
- (gnus-error 1 "Cannot read active file from %s server."
+ (gnus-error 1 "Cannot read active file from %s server"
(car method)))
(gnus-message 5 mesg)
- (gnus-active-to-gnus-format method gnus-active-hashtb)
+ (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))))))
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)
+(defun gnus-active-to-gnus-format (&optional method hashtb ignore-errors
+ real-active)
(unless method
(setq method gnus-select-method))
(let ((cur (current-buffer))
(gnus-make-hashtable
(count-lines (point-min) (point-max)))
(gnus-make-hashtable 4096)))))))
- ;; Delete unnecessary lines, cleaned up dmoore@ucsd.edu 31.10.1996
+ ;; Delete unnecessary lines.
(goto-char (point-min))
(cond ((gnus-ignored-newsgroups-has-to-p)
(delete-matching-lines gnus-ignored-newsgroups))
;; Make the group names readable as a lisp expression even if they
;; contain special characters.
- ;; Fix by Luc Van Eycken <Luc.VanEycken@esat.kuleuven.ac.be>.
(goto-char (point-max))
(while (re-search-backward "[][';?()#]" nil t)
(insert ?\\))
+ ;; Let the Gnus agent save the active file.
+ (when (and gnus-agent real-active)
+ (gnus-agent-save-active method))
+
;; If these are groups from a foreign select method, we insert the
;; group prefix in front of the group names.
- (and method (not (gnus-server-equal
- (gnus-server-get-method nil method)
- (gnus-server-get-method nil gnus-select-method)))
- (let ((prefix (gnus-group-prefixed-name "" method)))
- (goto-char (point-min))
- (while (and (not (eobp))
- (progn (insert prefix)
- (zerop (forward-line 1)))))))
+ (when (not (gnus-server-equal
+ (gnus-server-get-method nil method)
+ (gnus-server-get-method nil gnus-select-method)))
+ (let ((prefix (gnus-group-prefixed-name "" method)))
+ (goto-char (point-min))
+ (while (and (not (eobp))
+ (progn (insert prefix)
+ (zerop (forward-line 1)))))))
;; Store the active file in a hash table.
(goto-char (point-min))
(let (group max min)
(widen)
(forward-line 1)))))
-(defun gnus-groups-to-gnus-format (method &optional hashtb)
+(defun gnus-groups-to-gnus-format (method &optional hashtb real-active)
;; Parse a "groups" active file.
(let ((cur (current-buffer))
(hashtb (or hashtb
(gnus-server-get-method nil gnus-select-method)))
(gnus-group-prefixed-name "" method))))
+ ;; 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.
(push (cons (concat
"^" (buffer-substring
(1+ (match-beginning 0))
- (match-end 0)))
+ (match-end 0))
+ "\\($\\|\\.\\)")
'ignore)
out)
;; There was no bang, so this is a "yes" spec.
- (push (cons (concat "^" (match-string 0))
+ (push (cons (concat "^" (match-string 0) "\\($\\|\\.\\)")
'subscribe)
out))))
(gnus-slave-save-newsrc)
;; Save .newsrc.
(when gnus-save-newsrc-file
- (gnus-message 5 "Saving %s..." gnus-current-startup-file)
+ (gnus-message 8 "Saving %s..." gnus-current-startup-file)
(gnus-gnus-to-newsrc-format)
- (gnus-message 5 "Saving %s...done" gnus-current-startup-file))
+ (gnus-message 8 "Saving %s...done" gnus-current-startup-file))
;; Save .newsrc.eld.
(set-buffer (get-buffer-create " *Gnus-newsrc*"))
(make-local-variable 'version-control)
(defun gnus-gnus-to-quick-newsrc-format ()
"Insert Gnus variables such as gnus-newsrc-alist in lisp format."
- (let ((print-quoted t))
+ (let ((print-quoted t)
+ (print-escape-newlines t))
(insert ";; -*- emacs-lisp -*-\n")
(insert ";; Gnus startup file.\n")
- (insert
- ";; Never delete this file - touch .newsrc instead to force Gnus\n")
- (insert ";; to read .newsrc.\n")
+ (insert "\
+;; Never delete this file -- if you want to force Gnus to read the
+;; .newsrc file (if you have one), touch .newsrc instead.\n")
(insert "(setq gnus-newsrc-file-version "
(prin1-to-string gnus-version) ")\n")
(let* ((gnus-killed-list
(skip-chars-forward " \t")
;; ... which leads to this line being effectively ignored.
(when (symbolp group)
- (set group (buffer-substring
- (point) (progn (end-of-line) (point)))))
+ (let ((str (buffer-substring
+ (point) (progn (end-of-line) (point))))
+ (coding
+ (and (boundp 'enable-multibyte-characters)
+ enable-multibyte-characters
+ (gnus-mule-get-coding-system (symbol-name group)))))
+ (if coding
+ (setq str (decode-coding-string str (car coding))))
+ (set group str)))
(forward-line 1))))
(gnus-message 5 "Reading descriptions file...done")
t))))
projects / gnus / blobdiff