;;; gnus-start.el --- startup functions for Gnus
-;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002
+;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003
;; Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
:type 'boolean)
(defcustom gnus-auto-subscribed-groups
- "^nnml\\|^nnfolder\\|^nnmbox\\|^nnmh\\|^nnbabyl"
+ "^nnml\\|^nnfolder\\|^nnmbox\\|^nnmh\\|^nnbabyl\\|^nnmaildir"
"*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.
:group 'gnus-start
:type 'hook)
-(defcustom gnus-setup-news-hook nil
+(defcustom gnus-setup-news-hook
+ '(gnus-fixup-nnimap-unread-after-getting-new-news)
"A hook after reading the .newsrc file, but before generating the buffer."
:group 'gnus-start
:type 'hook)
:type 'hook)
(defcustom gnus-after-getting-new-news-hook
- '(gnus-display-time-event-handler)
+ '(gnus-display-time-event-handler
+ gnus-fixup-nnimap-unread-after-getting-new-news)
"A hook run after Gnus checks for new news when Gnus is already running."
:group 'gnus-group-new
:type 'hook)
(condition-case var
(load file nil t)
(error
- (error "Error in %s: %s" file var)))))))))
+ (error "Error in %s: %s" file (cadr var))))))))))
;; For subscribing new newsgroup
(kill-buffer (get-file-buffer (gnus-newsgroup-kill-file nil))))
(gnus-kill-buffer nntp-server-buffer)
;; Kill Gnus buffers.
- (let ((buffers (gnus-buffers)))
- (when buffers
- (mapcar 'kill-buffer buffers)))
+ (dolist (buffer (gnus-buffers))
+ (gnus-kill-buffer buffer))
;; Remove Gnus frames.
(gnus-kill-gnus-frames))
(nnheader-init-server-buffer)
(setq gnus-slave slave)
(gnus-read-init-file)
+ (if gnus-agent
+ (gnus-agentize))
(when gnus-simple-splash
(setq gnus-simple-splash nil)
(add-hook 'gnus-summary-mode-hook 'gnus-grouplens-mode))
;; Do the actual startup.
+ (if gnus-agent
+ (gnus-request-create-group "queue" '(nndraft "")))
+ (gnus-request-create-group "drafts" '(nndraft ""))
(gnus-setup-news nil level dont-connect)
(gnus-run-hooks 'gnus-setup-news-hook)
(gnus-start-draft-setup)
(set-buffer gnus-dribble-buffer)
(goto-char (point-max))
(insert string "\n")
- (set-window-point (get-buffer-window (current-buffer)) (point-max))
+ ;; This has been commented by Josh Huber <huber@alum.wpi.edu>
+ ;; It causes problems with both XEmacs and Emacs 21, and doesn't
+ ;; seem to be of much value. (FIXME: remove this after we make sure
+ ;; it's not needed).
+ ;; (set-window-point (get-buffer-window (current-buffer)) (point-max))
(bury-buffer gnus-dribble-buffer)
(save-excursion
(set-buffer gnus-group-buffer)
;; Go though `gnus-newsrc-alist' and compare with `gnus-active-hashtb'
;; and compute how many unread articles there are in each 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)))
(foreign-level
(t 0))
level))
scanned-methods info group active method retrieve-groups)
- (gnus-message 5 "Checking new news...")
+ (gnus-message 6 "Checking new news...")
(while newsrc
(setq active (gnus-active (setq group (gnus-info-group
(gnus-set-active group nil)
(setcar (gnus-gethash group gnus-newsrc-hashtb) t)))))))
- (gnus-message 5 "Checking new news...done")))
+ (gnus-message 6 "Checking new news...done")))
;; Create a hash table out of the newsrc alist. The `car's of the
;; alist elements are used as keys.
(setq article (pop articles)) ranges)
(push article news)))
(when news
+ ;; Enter this list into the group info.
(gnus-info-set-read
info (gnus-remove-from-range (gnus-info-read info) (nreverse news)))
+
+ ;; Set the number of unread articles in gnus-newsrc-hashtb.
+ (gnus-get-unread-articles-in-group info (gnus-active group))
+
+ ;; Insert the change into the group buffer and the dribble file.
+ (gnus-group-update-group group t))))
+
+(defun gnus-make-ascending-articles-unread (group articles)
+ "Mark ascending ARTICLES in GROUP as unread."
+ (let* ((entry (or (gnus-gethash group gnus-newsrc-hashtb)
+ (gnus-gethash (gnus-group-real-name group)
+ gnus-newsrc-hashtb)))
+ (info (nth 2 entry))
+ (ranges (gnus-info-read info))
+ (r ranges)
+ modified)
+
+ (while articles
+ (let ((article (pop articles))) ; get the next article to remove from ranges
+ (while (let ((range (car ranges))) ; note the current range
+ (if (atom range) ; single value range
+ (cond ((not range)
+ ;; the articles extend past the end of the ranges
+ ;; OK - I'm done
+ (setq articles nil))
+ ((< range article)
+ ;; this range preceeds the article. Leave the range unmodified.
+ (pop ranges)
+ ranges)
+ ((= range article)
+ ;; this range exactly matches the article; REMOVE THE RANGE.
+ ;; NOTE: When the range being removed is the last range, the list is corrupted by inserting null at its end.
+ (setcar ranges (cadr ranges))
+ (setcdr ranges (cddr ranges))
+ (setq modified (if (car ranges) t 'remove-null))
+ nil))
+ (let ((min (car range))
+ (max (cdr range)))
+ ;; I have a min/max range to consider
+ (cond ((> min max) ; invalid range introduced by splitter
+ (setcar ranges (cadr ranges))
+ (setcdr ranges (cddr ranges))
+ (setq modified (if (car ranges) t 'remove-null))
+ ranges)
+ ((= min max)
+ ;; replace min/max range with a single-value range
+ (setcar ranges min)
+ ranges)
+ ((< max article)
+ ;; this range preceeds the article. Leave the range unmodified.
+ (pop ranges)
+ ranges)
+ ((< article min)
+ ;; this article preceeds the range. Return null to move to the
+ ;; next article
+ nil)
+ (t
+ ;; this article splits the range into two parts
+ (setcdr ranges (cons (cons (1+ article) max) (cdr ranges)))
+ (setcdr range (1- article))
+ (setq modified t)
+ ranges))))))))
+
+ (when modified
+ (when (eq modified 'remove-null)
+ (setq r (delq nil r)))
+ ;; Enter this list into the group info.
+ (gnus-info-set-read info r)
+
+ ;; Set the number of unread articles in gnus-newsrc-hashtb.
+ (gnus-get-unread-articles-in-group info (gnus-active group))
+
+ ;; Insert the change into the group buffer and the dribble file.
(gnus-group-update-group group t))))
;; Enter all dead groups into the hashtb.
(goto-char (point-min))
(let (group max min)
(while (not (eobp))
- (condition-case err
+ (condition-case ()
(progn
(narrow-to-region (point) (gnus-point-at-eol))
;; group gets set to a symbol interned in the hash table
(kill-buffer (current-buffer))
(gnus-message 5 "Reading %s...done" newsrc-file))))))
+(defun gnus-load (file &optional coding-system)
+ "Load FILE, but in such a way that read errors can be reported."
+ (with-temp-buffer
+ (if coding-system
+ (insert-file-contents-as-coding-system coding-system file)
+ (insert-file-contents file))
+ (while (not (eobp))
+ (condition-case type
+ (let ((form (read (current-buffer))))
+ (eval form))
+ (error
+ (unless (eq (car type) 'end-of-file)
+ (let ((error (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)))))))))
+
(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)
- (when (file-exists-p ding-file)
- (with-temp-buffer
- (if (or debug-on-error debug-on-quit)
- (progn
- (insert-file-contents-as-coding-system
- gnus-ding-file-coding-system ding-file)
- (eval-region (point-min) (point-max)))
- (condition-case nil
- (progn
- (insert-file-contents-as-coding-system
- gnus-ding-file-coding-system ding-file)
- (eval-region (point-min) (point-max)))
- (error
- (ding)
- (or (not (or (zerop (buffer-size))
- (eq 'binary gnus-ding-file-coding-system)
- (gnus-re-read-newsrc-el-file ding-file)))
- (gnus-yes-or-no-p
- (format "Error in %s; continue? " ding-file))
- (error "Error in %s" ding-file))))))
+ (when (file-exists-p ding-file)
+ ;; We always, always read the .eld file.
+ (gnus-message 5 "Reading %s..." ding-file)
+ (let (gnus-newsrc-assoc)
+ (gnus-load ding-file gnus-ding-file-coding-system)
+;; ;; Older versions of `gnus-format-specs' are no longer valid
+;; ;; in Oort Gnus 0.01.
+;; (let ((version
+;; (and gnus-newsrc-file-version
+;; (gnus-continuum-version gnus-newsrc-file-version))))
+;; (when (or (not version)
+;; (< version 5.090009))
+;; (setq gnus-format-specs gnus-default-format-specs)))
(when gnus-newsrc-assoc
(setq gnus-newsrc-alist gnus-newsrc-assoc))))
(gnus-make-hashtable-from-newsrc-alist)
(apply 'gnus-product-read-variable-file-1 (car list))
(setq list (cdr list))))))
-(defun gnus-re-read-newsrc-el-file (file)
- "Attempt to re-read .newsrc.eld file. Returns `nil' if successful.
-The backup file \".newsrc.eld_\" will be created before re-reading."
- (message "Error in %s; retrying..." file)
- (if (and
- (condition-case nil
- (let ((backup (concat file "_")))
- (copy-file file backup 'ok-if-already-exists 'keep-time)
- (message " (The backup file %s has been created)" backup)
- t)
- (error nil))
- (progn
- (insert-file-contents-as-binary file nil nil nil 'replace)
- (goto-char (point-min))
- (when (re-search-forward
- "^[\t ]*([\t\n\r ]*setq[\t\n\r ]+gnus-format-specs" nil t)
- (delete-region (goto-char (match-beginning 0)) (forward-list 1))
- (decode-coding-region (point-min) (point-max)
- gnus-ding-file-coding-system)
- (condition-case nil
- (progn
- (eval-region (point-min) (point-max))
- t)
- (error nil)))))
- (prog1
- nil
- (message "Error in %s; retrying...done" file))
- (message "Error in %s; retrying...failed" file)
- t))
+;;(defun gnus-re-read-newsrc-el-file (file)
+;; "Attempt to re-read .newsrc.eld file. Returns `nil' if successful.
+;;The backup file \".newsrc.eld_\" will be created before re-reading."
+;; (message "Error in %s; retrying..." file)
+;; (if (and
+;; (condition-case nil
+;; (let ((backup (concat file "_")))
+;; (copy-file file backup 'ok-if-already-exists 'keep-time)
+;; (message " (The backup file %s has been created)" backup)
+;; t)
+;; (error nil))
+;; (progn
+;; (insert-file-contents-as-binary file nil nil nil 'replace)
+;; (goto-char (point-min))
+;; (when (re-search-forward
+;; "^[\t ]*([\t\n\r ]*setq[\t\n\r ]+gnus-format-specs" nil t)
+;; (delete-region (goto-char (match-beginning 0)) (forward-list 1))
+;; (decode-coding-region (point-min) (point-max)
+;; gnus-ding-file-coding-system)
+;; (condition-case nil
+;; (progn
+;; (eval-region (point-min) (point-max))
+;; t)
+;; (error nil)))))
+;; (prog1
+;; nil
+;; (message "Error in %s; retrying...done" file))
+;; (message "Error in %s; retrying...failed" file)
+;; t))
(defun gnus-product-read-variable-file-1 (file checking-methods coding
&rest variables)
(gnus-gnus-to-quick-newsrc-format)
(gnus-run-hooks 'gnus-save-quick-newsrc-hook)
(save-buffer-as-coding-system gnus-ding-file-coding-system)
- (kill-buffer (current-buffer))
+ (gnus-kill-buffer (current-buffer))
(gnus-message
5 "Saving %s.eld...done" gnus-current-startup-file))
(gnus-dribble-delete-file)
(save-excursion
(set-buffer gnus-dribble-buffer)
(let ((slave-name
- (make-temp-name (concat gnus-current-startup-file "-slave-")))
+ (mm-make-temp-file (concat gnus-current-startup-file "-slave-")))
(modes (ignore-errors
(file-modes (concat gnus-current-startup-file ".eld")))))
(gnus-write-buffer-as-coding-system gnus-ding-file-coding-system
(name (symbol-name group))
(charset
(or (gnus-group-name-charset method name)
- (gnus-parameter-charset name))))
+ (gnus-parameter-charset name)
+ gnus-default-charset)))
(when (and str charset (featurep 'mule))
(setq str (decode-coding-string str charset)))
(set group str)))
(when (gnus-boundp 'display-time-timer)
(display-time-event-handler)))
+;;;###autoload
+(defun gnus-fixup-nnimap-unread-after-getting-new-news ()
+ (let (server group info)
+ (mapatoms
+ (lambda (sym)
+ (when (and (setq group (symbol-name sym))
+ (gnus-group-entry group)
+ (setq info (symbol-value sym)))
+ (gnus-sethash group (cons (nth 2 info) (cdr (gnus-group-entry group)))
+ gnus-newsrc-hashtb)))
+ (if (boundp 'nnimap-mailbox-info)
+ (symbol-value 'nnimap-mailbox-info)
+ (make-vector 1 0)))))
+
+
(provide 'gnus-start)
;;; gnus-start.el ends here
projects / elisp / gnus.git- / blobdiff