;;; gnus-start.el --- startup functions for Gnus
-;; Copyright (C) 1996, 1997, 1998, 1999, 2000
+;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001
;; Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
(defcustom gnus-ignored-newsgroups
(mapconcat 'identity
'("^to\\." ; not "real" groups
- "^[0-9. \t]+ " ; all digits in name
+ "^[0-9. \t]+\\( \\|$\\)" ; all digits in name
"^[\"][]\"[#'()]" ; bogus characters
)
"\\|")
:type 'regexp)
(defcustom gnus-subscribe-newsgroup-method 'gnus-subscribe-zombies
- "*Function called with a group name when new group is detected.
+ "*Function(s) called with a group name when new group is detected.
A few pre-made functions are supplied: `gnus-subscribe-randomly'
inserts new groups at the beginning of the list of groups;
`gnus-subscribe-alphabetically' inserts new groups in strict
(function-item gnus-subscribe-killed)
(function-item gnus-subscribe-zombies)
(function-item gnus-subscribe-topics)
- function))
+ function
+ (repeat function)))
+
+(defcustom gnus-subscribe-newsgroup-hooks nil
+ "*Hooks run after you subscribe to a new group. The hooks will be called
+with new group's name as argument."
+ :group 'gnus-group-new
+ :type 'hook)
(defcustom gnus-subscribe-options-newsgroup-method
'gnus-subscribe-alphabetically
- "*This function is called to subscribe newsgroups mentioned on \"options -n\" lines.
+ "*Function(s) called to subscribe newsgroups mentioned on \"options -n\" lines.
If, for instance, you want to subscribe to all newsgroups in the
\"no\" and \"alt\" hierarchies, you'd put the following in your
.newsrc file:
(function-item gnus-subscribe-killed)
(function-item gnus-subscribe-zombies)
(function-item gnus-subscribe-topics)
- function))
+ function
+ (repeat function)))
(defcustom gnus-subscribe-hierarchical-interactive nil
"*If non-nil, Gnus will offer to subscribe hierarchically.
'ctext)
"*Coding system for startup file.")
+(defvar gnus-ding-file-coding-system gnus-startup-file-coding-system
+ "*Coding system for ding file.")
+;; Note that the ding file for T-gnus ought not to have byte-codes.
+
;;; Internal variables
(defvar gnus-newsrc-file-version nil)
;; Basic ideas by mike-w@cs.aukuni.ac.nz (Mike Williams)
(save-excursion
(set-buffer (nnheader-find-file-noselect gnus-current-startup-file))
- (let ((groupkey newgroup)
- before)
- (while (and (not before) groupkey)
- (goto-char (point-min))
- (let ((groupkey-re
- (concat "^\\(" (regexp-quote groupkey) ".*\\)[!:]")))
- (while (and (re-search-forward groupkey-re nil t)
- (progn
- (setq before (match-string 1))
- (string< before newgroup)))))
- ;; Remove tail of newsgroup name (eg. a.b.c -> a.b)
- (setq groupkey
- (when (string-match "^\\(.*\\)\\.[^.]+$" groupkey)
- (substring groupkey (match-beginning 1) (match-end 1)))))
- (gnus-subscribe-newsgroup newgroup before))
- (kill-buffer (current-buffer))))
+ (prog1
+ (let ((groupkey newgroup) before)
+ (while (and (not before) groupkey)
+ (goto-char (point-min))
+ (let ((groupkey-re
+ (concat "^\\(" (regexp-quote groupkey) ".*\\)[!:]")))
+ (while (and (re-search-forward groupkey-re nil t)
+ (progn
+ (setq before (match-string 1))
+ (string< before newgroup)))))
+ ;; Remove tail of newsgroup name (eg. a.b.c -> a.b)
+ (setq groupkey
+ (when (string-match "^\\(.*\\)\\.[^.]+$" groupkey)
+ (substring groupkey (match-beginning 1) (match-end 1)))))
+ (gnus-subscribe-newsgroup newgroup before))
+ (kill-buffer (current-buffer)))))
(defun gnus-subscribe-interactively (group)
"Subscribe the new GROUP interactively.
newsgroup gnus-level-default-subscribed
gnus-level-killed (gnus-gethash (or next "dummy.group")
gnus-newsrc-hashtb))
- (gnus-message 5 "Subscribe newsgroup: %s" newsgroup)))
+ (gnus-message 5 "Subscribe newsgroup: %s" newsgroup)
+ (run-hook-with-args 'gnus-subscribe-newsgroup-hooks newsgroup)
+ t))
(defun gnus-read-active-file-p ()
"Say whether the active file has been read from `gnus-select-method'."
(setq variables (cdr variables))))
(setq files (cdr files)))))
+(defun gnus-close-all-servers ()
+ "Close all servers."
+ (interactive)
+ (dolist (server gnus-opened-servers)
+ (gnus-close-server (car server))))
+
(defun gnus-clear-system ()
"Clear all variables and buffers."
;; Clear gnus variables.
(set-buffer-modified-p nil)
(let ((auto (make-auto-save-file-name))
(gnus-dribble-ignore t)
+ (purpose nil)
modes)
(when (or (file-exists-p auto) (file-exists-p dribble-file))
;; Load whichever file is newest -- the auto save file
(file-exists-p dribble-file)
(setq modes (file-modes gnus-current-startup-file)))
(set-file-modes dribble-file modes))
+ (goto-char (point-min))
+ (when (search-forward "Gnus was exited on purpose" nil t)
+ (setq purpose t))
;; Possibly eval the file later.
(when (or gnus-always-read-dribble-file
(gnus-y-or-n-p
- "Gnus auto-save file exists. Do you want to read it? "))
+ (if purpose
+ "Gnus exited on purpose without saving; read auto-save file anyway? "
+ "Gnus auto-save file exists. Do you want to read it? ")))
(setq gnus-dribble-eval-file t)))))))
(defun gnus-dribble-eval-file ()
;; 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))
+ (unless (assoc "archive" gnus-server-alist)
+ (push `("archive"
+ (nnfolder
+ "archive"
+ (nnfolder-directory
+ ,(nnheader-concat message-directory "archive"))
+ (nnfolder-active-file
+ ,(nnheader-concat message-directory "archive/active"))
+ (nnfolder-get-new-mail nil)
+ (nnfolder-inhibit-expiry t)))
+ gnus-server-alist)))
;; If we don't read the complete active file, we fill in the
;; hashtb here.
;; See whether we need to read the description file.
(when (and (boundp 'gnus-group-line-format)
+ (stringp gnus-group-line-format)
(let ((case-fold-search nil))
(string-match "%[-,0-9]*D" gnus-group-line-format))
(not gnus-description-hashtb)
gnus-plugged)
(gnus-find-new-newsgroups))
+ ;; Check and remove bogus newsgroups.
+ (when (and init gnus-check-bogus-newsgroups
+ gnus-read-active-file (not level)
+ (gnus-server-opened gnus-select-method))
+ (gnus-check-bogus-newsgroups))
+
;; We might read in new NoCeM messages here.
(when (and gnus-use-nocem
(not level)
;; Find the number of unread articles in each non-dead group.
(let ((gnus-read-active-file (and (not level) gnus-read-active-file)))
- (gnus-get-unread-articles level))
-
- (when (and init gnus-check-bogus-newsgroups
- gnus-read-active-file (not level)
- (gnus-server-opened gnus-select-method))
- (gnus-check-bogus-newsgroups))))
+ (gnus-get-unread-articles level))))
+
+(defun gnus-call-subscribe-functions (method group)
+ "Call METHOD to subscribe GROUP.
+If no function returns `non-nil', call `gnus-subscribe-zombies'."
+ (unless (cond
+ ((gnus-functionp method)
+ (funcall method group))
+ ((listp method)
+ (catch 'found
+ (dolist (func method)
+ (if (funcall func group)
+ (throw 'found t)))
+ nil))
+ (t nil))
+ (gnus-subscribe-zombies group)))
(defun gnus-find-new-newsgroups (&optional arg)
"Search for new newsgroups and add them.
(gnus-message 5 "Looking for new newsgroups...")
(unless gnus-have-read-active-file
(gnus-read-active-file))
- (setq gnus-newsrc-last-checked-date (current-time-string))
+ (setq gnus-newsrc-last-checked-date (message-make-date))
(unless gnus-killed-hashtb
(gnus-make-hashtable-from-killed))
;; Go though every newsgroup in `gnus-active-hashtb' and compare
((eq do-sub 'subscribe)
(setq groups (1+ groups))
(gnus-sethash group group gnus-killed-hashtb)
- (funcall gnus-subscribe-options-newsgroup-method group))
+ (gnus-call-subscribe-functions
+ gnus-subscribe-options-newsgroup-method group))
((eq do-sub 'ignore)
nil)
(t
(gnus-sethash group group gnus-killed-hashtb)
(if gnus-subscribe-hierarchical-interactive
(push group new-newsgroups)
- (funcall gnus-subscribe-newsgroup-method group)))))))
+ (gnus-call-subscribe-functions
+ gnus-subscribe-newsgroup-method group)))))))
gnus-active-hashtb)
(when new-newsgroups
(gnus-subscribe-hierarchical-interactive new-newsgroups))
(and regs (cdar regs))))))
(defun gnus-ask-server-for-new-groups ()
- (let* ((date (or gnus-newsrc-last-checked-date (current-time-string)))
+ (let* ((new-date (message-make-date))
+ (date (or gnus-newsrc-last-checked-date new-date))
(methods (cons gnus-select-method
(nconc
(when (gnus-archive-server-wanted-p)
gnus-check-new-newsgroups)
gnus-secondary-select-methods))))
(groups 0)
- (new-date (current-time-string))
group new-newsgroups got-new method hashtb
gnus-override-subscribe-method)
(unless gnus-killed-hashtb
((eq do-sub 'subscribe)
(incf groups)
(gnus-sethash group group gnus-killed-hashtb)
- (funcall gnus-subscribe-options-newsgroup-method group))
+ (gnus-call-subscribe-functions
+ gnus-subscribe-options-newsgroup-method group))
((eq do-sub 'ignore)
nil)
(t
(gnus-sethash group group gnus-killed-hashtb)
(if gnus-subscribe-hierarchical-interactive
(push group new-newsgroups)
- (funcall gnus-subscribe-newsgroup-method group)))))))
+ (gnus-call-subscribe-functions
+ gnus-subscribe-newsgroup-method group)))))))
hashtb))
(when new-newsgroups
(gnus-subscribe-hierarchical-interactive new-newsgroups)))
(unless (gnus-read-active-file-p)
(let ((gnus-read-active-file t))
(gnus-read-active-file)))
- (setq gnus-newsrc-last-checked-date (current-time-string))
+ (setq gnus-newsrc-last-checked-date (message-make-date))
;; Subscribe to the default newsgroups.
(let ((groups (or gnus-default-subscribed-newsgroups
gnus-backup-default-subscribed-newsgroups))
group)
- (when (eq groups t)
- ;; If t, we subscribe (or not) all groups as if they were new.
- (mapatoms
- (lambda (sym)
- (when (setq group (symbol-name sym))
- (let ((do-sub (gnus-matches-options-n group)))
- (cond
- ((eq do-sub 'subscribe)
- (gnus-sethash group group gnus-killed-hashtb)
- (funcall gnus-subscribe-options-newsgroup-method group))
- ((eq do-sub 'ignore)
- nil)
- (t
- (push group gnus-killed-list))))))
- gnus-active-hashtb)
+ (if (eq groups t)
+ ;; If t, we subscribe (or not) all groups as if they were new.
+ (mapatoms
+ (lambda (sym)
+ (when (setq group (symbol-name sym))
+ (let ((do-sub (gnus-matches-options-n group)))
+ (cond
+ ((eq do-sub 'subscribe)
+ (gnus-sethash group group gnus-killed-hashtb)
+ (gnus-call-subscribe-functions
+ gnus-subscribe-options-newsgroup-method group))
+ ((eq do-sub 'ignore)
+ nil)
+ (t
+ (push group gnus-killed-list))))))
+ gnus-active-hashtb)
(dolist (group groups)
;; Only subscribe the default groups that are activated.
(when (gnus-active group)
(setq info (pop newsrc)
group (gnus-info-group info))
(unless (or (gnus-active group) ; Active
- (gnus-info-method info)) ; Foreign
+ (and (gnus-info-method info)
+ (not (gnus-secondary-method-p
+ (gnus-info-method info))))) ; Foreign
;; Found a bogus newsgroup.
(push group bogus)))
(if confirm
(quit
(message "Quit activating %s" group)
nil))
- (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))))
+ (unless dont-check
+ (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
gnus-activate-foreign-newsgroups)
(t 0))
level))
- scanned-methods info group active method retrievegroups)
+ scanned-methods info group active method retrieve-groups)
(gnus-message 5 "Checking new news...")
(while newsrc
(not (gnus-secondary-method-p method)))
;; These groups are foreign. Check the level.
(when (and (<= (gnus-info-level info) foreign-level)
- (setq active (gnus-activate-group group 'scan)))
+ (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
(if (gnus-check-backend-function 'retrieve-groups group)
;; if server support gnus-retrieve-groups we push
;; the group onto retrievegroups for later checking
- (if (assoc method retrievegroups)
- (setcdr (assoc method retrievegroups)
- (cons group (cdr (assoc method retrievegroups))))
- (push (list method group) retrievegroups))
+ (if (assoc method retrieve-groups)
+ (setcdr (assoc method retrieve-groups)
+ (cons group (cdr (assoc method retrieve-groups))))
+ (push (list method group) retrieve-groups))
;; hack: `nnmail-get-new-mail' changes the mail-source depending
;; on the group, so we must perform a scan for every group
;; if the users has any directory mail sources.
(setq active (gnus-activate-group group))
(setq active (gnus-activate-group group 'scan))
(push method scanned-methods))
- (when active
- (gnus-close-group group))))))
+ (when active
+ (gnus-close-group group))))))
;; Get the number of unread articles in the group.
(cond
;; unread articles and stuff.
(gnus-set-active group nil)
(let ((tmp (gnus-gethash group gnus-newsrc-hashtb)))
- (if tmp (setcar tmp t))))))
+ (when tmp
+ (setcar tmp t))))))
;; iterate through groups on methods which support gnus-retrieve-groups
;; and fetch a partial active file and use it to find new news.
- (while retrievegroups
- (let* ((mg (pop retrievegroups))
- (method (or (car mg) gnus-select-method))
- (groups (cdr mg)))
+ (dolist (rg retrieve-groups)
+ (let ((method (or (car rg) gnus-select-method))
+ (groups (cdr rg)))
(when (gnus-check-server method)
- ;; Request that the backend scan its incoming messages.
- (when (gnus-check-backend-function 'request-scan (car method))
- (gnus-request-scan nil method))
- (gnus-read-active-file-2 (mapcar (lambda (group)
- (gnus-group-real-name group))
- groups) method)
- (dolist (group groups)
- (cond
- ((setq active (gnus-active (gnus-info-group
- (setq info (gnus-get-info group)))))
- (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)))))))
+ ;; Request that the backend scan its incoming messages.
+ (when (gnus-check-backend-function 'request-scan (car method))
+ (gnus-request-scan nil method))
+ (gnus-read-active-file-2
+ (mapcar (lambda (group) (gnus-group-real-name group)) groups)
+ method)
+ (dolist (group groups)
+ (cond
+ ((setq active (gnus-active (gnus-info-group
+ (setq info (gnus-get-info group)))))
+ (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)))))))
(gnus-message 5 "Checking new news...done")))
(condition-case nil
(progn
(insert-file-contents-as-coding-system
- gnus-startup-file-coding-system ding-file)
+ gnus-ding-file-coding-system ding-file)
(eval-region (point-min) (point-max)))
(error
(ding)
(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-as-coding-system gnus-startup-file-coding-system)
+ (save-buffer-as-coding-system gnus-ding-file-coding-system)
(kill-buffer (current-buffer))
(gnus-message
5 "Saving %s.eld...done" gnus-current-startup-file))
(while variables
(when (and (boundp (setq variable (pop variables)))
(symbol-value variable))
- (insert "(setq " (symbol-name variable) " '")
- (gnus-prin1 (symbol-value variable))
- (insert ")\n")))))
+ (insert "(setq " (symbol-name variable) " '")
+ (gnus-prin1 (symbol-value variable))
+ (insert ")\n")))))
(defun gnus-strip-killed-list ()
"Return the killed list minus the groups that match `gnus-save-killed-list'."
(make-temp-name (concat gnus-current-startup-file "-slave-")))
(modes (ignore-errors
(file-modes (concat gnus-current-startup-file ".eld")))))
- (gnus-write-buffer-as-coding-system
- gnus-startup-file-coding-system slave-name)
+ (gnus-write-buffer-as-coding-system gnus-ding-file-coding-system
+ slave-name)
(when modes
(set-file-modes slave-name modes)))))
(name (symbol-name group))
(charset
(or (gnus-group-name-charset method name)
- (let ((alist gnus-group-charset-alist)
- elem charset)
- (while (setq elem (pop alist))
- (when (and name (string-match (car elem) name))
- (setq alist nil
- charset (cadr elem))))
- charset))))
+ (gnus-parameter-charset name))))
(when (and str charset (featurep 'mule))
(setq str (decode-coding-string str charset)))
(set group str)))
projects / elisp / gnus.git- / blobdiff