Commit 20a673b2 authored by Katsumi Yamaoka's avatar Katsumi Yamaoka

Merge changes made in Gnus trunk.

Reimplement nnimap, and do tweaks to the rest of the code to support that.

* gnus-int.el (gnus-finish-retrieve-group-infos)
(gnus-retrieve-group-data-early): New functions.

* gnus-range.el (gnus-range-nconcat): New function.

* gnus-start.el (gnus-get-unread-articles): Support early retrieval of
data.
(gnus-read-active-for-groups): Support finishing the early retrieval of
data.

* gnus-sum.el (gnus-summary-move-article): Pass the move-to group name
if the move is internal, so that nnimap can do fast internal moves.

* gnus.el (gnus-article-special-mark-lists): Add uid/active tuples, for
nnimap usage.

* nnimap.el: Rewritten.

* nnmail.el (nnmail-inhibit-default-split-group): New internal variable
to allow the mail splitting to not return a default group.  This is
useful for nnimap, which will leave unmatched mail in the inbox.

* utf7.el (utf7-encode): Autoload.


Implement shell connection.

* nnimap.el (nnimap-open-shell-stream): New function.
(nnimap-open-connection): Use it.


Get the number of lines by using BODYSTRUCTURE.

(nnimap-transform-headers): Get the number of lines in each message.
(nnimap-retrieve-headers): Query for BODYSTRUCTURE so that we get the
number of lines.


Not all servers return UIDNEXT.  Work past this problem.


Remove junk from end of file.


Fix typo in "bogus" section.


Make capabilties be case-insensitive.


Require cl when compiling.


Don't bug out if the LIST command doesn't have any parameters.

2010-09-17  Knut Anders Hatlen  <kahatlen@gmail.com>  (tiny change)

	    * nnimap.el (nnimap-get-groups): Don't bug out if the LIST command
	    doesn't have any parameters.


(mm-text-html-renderer): Document gnus-article-html.

2010-09-17  Julien Danjou  <julien@danjou.info>  (tiny fix)

	    * mm-decode.el (mm-text-html-renderer): Document gnus-article-html.


* dgnushack.el: Define netrc-credentials.


If the user doesn't have a /etc/services, supply some sensible port defaults.


Have `unseen-or-unread' select an unread unseen article first.


(nntp-open-server): Return whether the open was successful or not.


Throughout all files, replace (save-excursion (set-buffer ...)) with (with-current-buffer ... ).


Save result so that it doesn't say "failed" all the time.


Add ~/.authinfo to the default, since that's probably most useful for users.


Don't use the "finish" method when we're reading from the agent.


Add some more nnimap-relevant agent stuff to nnagent.el.


* nnimap.el (nnimap-with-process-buffer): Removed.


Revert one line that was changed by mistake in the last checkin.


(nnimap-open-connection): Don't error out when we can't make a connection


nnimap-related changes to avoid bugging out if we can't contact a server.
* gnus-start.el (gnus-get-unread-articles): Don't try to scan groups
 from methods that are denied.
* nnimap.el (nnimap-possibly-change-group): Return nil if we can't log
 in.
(nnimap-finish-retrieve-group-infos): Make sure we're not waiting for
 nothing.
* gnus-sum.el (gnus-select-newsgroup): Indent.
parent 71b961e8
......@@ -107,7 +107,8 @@ Only relevant if `auth-source-debug' is not nil."
:version "23.2" ;; No Gnus
:type `boolean)
(defcustom auth-sources '((:source "~/.authinfo.gpg"))
(defcustom auth-sources '((:source "~/.authinfo.gpg")
(:source "~/.authinfo"))
"List of authentication sources.
The default will get login and password information from a .gpg
......@@ -311,20 +312,23 @@ Return structure as specified by MODE."
(setq result
(mapcar
(lambda (m)
(if (equal "password" m)
(let ((passwd (read-passwd "Password: ")))
(cond
;; Secret Service API.
((consp source)
(apply
'secrets-create-item
(auth-get-source entry) name passwd spec))
(t)) ;; netrc not implemented yes.
passwd)
(or
;; the originally requested :user
user
"unknown-user")))
(cond
((equal "password" m)
(let ((passwd (read-passwd
(format "Password for %s on %s: " prot host))))
(cond
;; Secret Service API.
((consp source)
(apply
'secrets-create-item
(auth-get-source entry) name passwd spec))
(t)) ;; netrc not implemented yes.
passwd))
((equal "login" m)
(or user
(read-string (format "User name for %s on %s: " prot host))))
(t
"unknownuser")))
(if (consp mode) mode (list mode))))
(if (consp mode) result (car result))))
......
......@@ -151,8 +151,7 @@ If N is negative, move backward instead."
(defun earcon-button-push (marker)
;; Push button starting at MARKER.
(save-excursion
(set-buffer gnus-article-buffer)
(with-current-buffer gnus-article-buffer
(goto-char marker)
(let* ((entry (earcon-button-entry))
(inhibit-point-motion-hooks t)
......@@ -214,8 +213,7 @@ If N is negative, move backward instead."
(defun gnus-earcon-display ()
"Play sounds in message buffers."
(interactive)
(save-excursion
(set-buffer gnus-article-buffer)
(with-current-buffer gnus-article-buffer
(goto-char (point-min))
;; Skip headers
(unless (search-forward "\n\n" nil t)
......
......@@ -97,8 +97,7 @@ RFC 2646 suggests 66 characters for readability."
;;;###autoload
(defun fill-flowed (&optional buffer delete-space)
(save-excursion
(set-buffer (or (current-buffer) buffer))
(with-current-buffer (or (current-buffer) buffer)
(goto-char (point-min))
;; Remove space stuffing.
(while (re-search-forward "^\\( \\|>+ $\\)" nil t)
......
......@@ -305,8 +305,7 @@ buffer. Automatically blocks multiple updates due to recursion."
`(prog1 (let ((gnus-agent-inhibit-update-total-fetched-for t)) ,@body)
(when (and gnus-agent-need-update-total-fetched-for
(not gnus-agent-inhibit-update-total-fetched-for))
(save-excursion
(set-buffer gnus-group-buffer)
(with-current-buffer gnus-group-buffer
(setq gnus-agent-need-update-total-fetched-for nil)
(gnus-group-update-group ,group t)))))
......@@ -474,8 +473,7 @@ manipulated as follows:
(defun gnus-agent-stop-fetch ()
"Save all data structures and clean up."
(setq gnus-agent-spam-hashtb nil)
(save-excursion
(set-buffer nntp-server-buffer)
(with-current-buffer nntp-server-buffer
(widen)))
(defmacro gnus-agent-with-fetch (&rest forms)
......@@ -1608,8 +1606,7 @@ downloaded into the agent."
nntp-server-buffer (point-min) (point-max))
(setq pos (nreverse pos)))))
;; Then save these articles into the Agent.
(save-excursion
(set-buffer nntp-server-buffer)
(with-current-buffer nntp-server-buffer
(while pos
(narrow-to-region (cdar pos) (or (cdadr pos) (point-max)))
(goto-char (point-min))
......@@ -1693,8 +1690,7 @@ downloaded into the agent."
(setq date (or date t))
(let (gnus-agent-article-alist group alist beg end)
(save-excursion
(set-buffer gnus-agent-overview-buffer)
(with-current-buffer gnus-agent-overview-buffer
(when (nnheader-find-nov-line article)
(forward-word 1)
(setq beg (point))
......@@ -1705,9 +1701,8 @@ downloaded into the agent."
(push (setq alist (list group (gnus-agent-load-alist (caar crosses))))
gnus-agent-group-alist))
(setcdr alist (cons (cons (cdar crosses) date) (cdr alist)))
(save-excursion
(set-buffer (gnus-get-buffer-create (format " *Gnus agent overview %s*"
group)))
(with-current-buffer (gnus-get-buffer-create
(format " *Gnus agent overview %s*"group))
(when (= (point-max) (point-min))
(push (cons group (current-buffer)) gnus-agent-buffer-alist)
(ignore-errors
......@@ -1939,9 +1934,7 @@ article numbers will be returned."
10 "gnus-agent-fetch-headers: undownloaded articles are '%s'"
(gnus-compress-sequence articles t))
(save-excursion
(set-buffer nntp-server-buffer)
(with-current-buffer nntp-server-buffer
(if articles
(progn
(gnus-message 7 "Fetching headers for %s..."
......@@ -2767,8 +2760,7 @@ The following commands are available:
(defun gnus-category-setup-buffer ()
(unless (get-buffer gnus-category-buffer)
(save-excursion
(set-buffer (gnus-get-buffer-create gnus-category-buffer))
(with-current-buffer (gnus-get-buffer-create gnus-category-buffer)
(gnus-category-mode))))
(defun gnus-category-prepare ()
......
......@@ -145,8 +145,7 @@ that was fetched."
(when (and (gnus-buffer-live-p summary)
gnus-asynchronous
(gnus-group-asynchronous-p group))
(save-excursion
(set-buffer gnus-summary-buffer)
(with-current-buffer gnus-summary-buffer
(let ((next (caadr (gnus-data-find-list article))))
(when next
(if (not (fboundp 'run-with-idle-timer))
......@@ -205,8 +204,7 @@ that was fetched."
(when (and do-fetch article)
;; We want to fetch some more articles.
(save-excursion
(set-buffer summary)
(with-current-buffer summary
(let (mark)
(gnus-async-set-buffer)
(goto-char (point-max))
......
......@@ -40,8 +40,7 @@
(defun gnus-backlog-buffer ()
"Return the backlog buffer."
(or (get-buffer gnus-backlog-buffer)
(save-excursion
(set-buffer (gnus-get-buffer-create gnus-backlog-buffer))
(with-current-buffer (gnus-get-buffer-create gnus-backlog-buffer)
(buffer-disable-undo)
(setq buffer-read-only t)
(get-buffer gnus-backlog-buffer))))
......@@ -76,8 +75,7 @@
(gnus-backlog-remove-oldest-article))
(push ident gnus-backlog-articles)
;; Insert the new article.
(save-excursion
(set-buffer (gnus-backlog-buffer))
(with-current-buffer (gnus-backlog-buffer)
(let (buffer-read-only)
(goto-char (point-max))
(unless (bolp)
......@@ -90,8 +88,7 @@
(gnus-error 3 "Article %d is blank" number))))))))
(defun gnus-backlog-remove-oldest-article ()
(save-excursion
(set-buffer (gnus-backlog-buffer))
(with-current-buffer (gnus-backlog-buffer)
(goto-char (point-min))
(if (zerop (buffer-size))
() ; The buffer is empty.
......@@ -114,8 +111,7 @@
beg end)
(when (memq ident gnus-backlog-articles)
;; It was in the backlog.
(save-excursion
(set-buffer (gnus-backlog-buffer))
(with-current-buffer (gnus-backlog-buffer)
(let (buffer-read-only)
(when (setq beg (text-property-any
(point-min) (point-max) 'gnus-backlog
......@@ -138,8 +134,7 @@
beg end)
(when (memq ident gnus-backlog-articles)
;; It was in the backlog.
(save-excursion
(set-buffer (gnus-backlog-buffer))
(with-current-buffer (gnus-backlog-buffer)
(if (not (setq beg (text-property-any
(point-min) (point-max) 'gnus-backlog
ident)))
......@@ -150,8 +145,7 @@
(setq end
(next-single-property-change
(1+ beg) 'gnus-backlog (current-buffer) (point-max)))))
(save-excursion
(and buffer (set-buffer buffer))
(with-current-buffer (or (current-buffer) buffer)
(let ((buffer-read-only nil))
(erase-buffer)
(insert-buffer-substring gnus-backlog-buffer beg end)))
......
......@@ -180,8 +180,7 @@ it's not cached."
;; Save the article in the cache.
(if (file-exists-p file)
t ; The article already is saved.
(save-excursion
(set-buffer nntp-server-buffer)
(with-current-buffer nntp-server-buffer
(require 'gnus-art)
(let ((gnus-use-cache nil)
(gnus-article-decode-hook nil))
......@@ -554,8 +553,7 @@ system for example was used.")
(let ((cache-buf (gnus-get-buffer-create " *gnus-cache*"))
beg end)
(gnus-cache-save-buffers)
(save-excursion
(set-buffer cache-buf)
(with-current-buffer cache-buf
(erase-buffer)
(let ((coding-system-for-read gnus-cache-overview-coding-system)
(file-name-coding-system nnmail-pathname-coding-system))
......@@ -844,8 +842,7 @@ supported."
,@body)
(when (and gnus-cache-need-update-total-fetched-for
(not gnus-cache-inhibit-update-total-fetched-for))
(save-excursion
(set-buffer gnus-group-buffer)
(with-current-buffer gnus-group-buffer
(setq gnus-cache-need-update-total-fetched-for nil)
(gnus-group-update-group ,group t)))))
......
......@@ -291,11 +291,9 @@ minutes, the connection is closed."
(let ((win (current-window-configuration)))
(unwind-protect
(save-window-excursion
(save-excursion
(when (gnus-alive-p)
(save-excursion
(set-buffer gnus-group-buffer)
(gnus-group-get-new-news)))))
(when (gnus-alive-p)
(with-current-buffer gnus-group-buffer
(gnus-group-get-new-news))))
(set-window-configuration win))))
(defun gnus-demon-add-scan-timestamps ()
......
......@@ -179,10 +179,7 @@ If it is down, start it up (again)."
(format " on %s" (nth 1 method)))))
(gnus-run-hooks 'gnus-open-server-hook)
(prog1
(condition-case ()
(setq result (gnus-open-server method))
(quit (message "Quit gnus-check-server")
nil))
(setq result (gnus-open-server method))
(unless silent
(gnus-message 5 "Opening %s server%s...%s" (car method)
(if (equal (nth 1 method) "") ""
......@@ -225,6 +222,10 @@ If it is down, start it up (again)."
;;; Interface functions to the backends.
;;;
(defun gnus-method-denied-p (method)
(eq (nth 1 (assoc method gnus-opened-servers))
'denied))
(defun gnus-open-server (gnus-command-method)
"Open a connection to GNUS-COMMAND-METHOD."
(when (stringp gnus-command-method)
......@@ -319,6 +320,22 @@ If it is down, start it up (again)."
(funcall (gnus-get-function gnus-command-method 'request-list)
(nth 1 gnus-command-method)))
(defun gnus-finish-retrieve-group-infos (gnus-command-method infos data)
"Read and update infos from GNUS-COMMAND-METHOD."
(when (stringp gnus-command-method)
(setq gnus-command-method (gnus-server-to-method gnus-command-method)))
(funcall (gnus-get-function gnus-command-method 'finish-retrieve-group-infos)
(nth 1 gnus-command-method)
infos data))
(defun gnus-retrieve-group-data-early (gnus-command-method infos)
"Start early async retrival of data from GNUS-COMMAND-METHOD."
(when (stringp gnus-command-method)
(setq gnus-command-method (gnus-server-to-method gnus-command-method)))
(funcall (gnus-get-function gnus-command-method 'retrieve-group-data-early)
(nth 1 gnus-command-method)
infos))
(defun gnus-request-list-newsgroups (gnus-command-method)
"Request the newsgroups file from GNUS-COMMAND-METHOD."
(when (stringp gnus-command-method)
......@@ -490,8 +507,7 @@ If BUFFER, insert the article in that group."
(setq res (gnus-request-article article group)
clean-up t)))
(when clean-up
(save-excursion
(set-buffer nntp-server-buffer)
(with-current-buffer nntp-server-buffer
(goto-char (point-min))
(when (search-forward "\n\n" nil t)
(delete-region (1- (point)) (point-max)))
......@@ -523,8 +539,7 @@ If BUFFER, insert the article in that group."
(setq res (gnus-request-article article group)
clean-up t)))
(when clean-up
(save-excursion
(set-buffer nntp-server-buffer)
(with-current-buffer nntp-server-buffer
(goto-char (point-min))
(when (search-forward "\n\n" nil t)
(delete-region (point-min) (1- (point))))))
......
......@@ -349,8 +349,7 @@ If NEWSGROUP is nil, return the global kill file instead."
(defun gnus-expunge (marks)
"Remove lines marked with MARKS."
(save-excursion
(set-buffer gnus-summary-buffer)
(with-current-buffer gnus-summary-buffer
(gnus-summary-limit-to-marks marks 'reverse)))
(defun gnus-apply-kill-file-unless-scored ()
......@@ -442,8 +441,7 @@ Returns the number of articles marked as read."
(progn
(delete-region beg (point))
(insert (or (eval form) "")))
(save-excursion
(set-buffer gnus-summary-buffer)
(with-current-buffer gnus-summary-buffer
(ignore-errors (eval form)))))
(and (buffer-modified-p)
gnus-kill-save-kill-file
......@@ -555,8 +553,7 @@ COMMAND must be a Lisp expression or a string representing a key sequence."
(and (eq 'quote (car (nth 2 object)))
(not (consp (cdadr (nth 2 object))))))
(concat "\n" (gnus-prin1-to-string object))
(save-excursion
(set-buffer (gnus-get-buffer-create "*Gnus PP*"))
(with-current-buffer (gnus-get-buffer-create "*Gnus PP*")
(buffer-disable-undo)
(erase-buffer)
(insert (format "\n(%S %S\n '(" (nth 0 object) (nth 1 object)))
......@@ -610,8 +607,7 @@ COMMAND must be a Lisp expression or a string representing a key sequence."
6 "Searching for article: %d..." (mail-header-number header))
(gnus-article-setup-buffer)
(gnus-article-prepare (mail-header-number header) t)
(when (save-excursion
(set-buffer gnus-article-buffer)
(when (with-current-buffer gnus-article-buffer
(goto-char (point-min))
(setq did-kill (re-search-forward regexp nil t)))
(cond ((stringp form) ;Keyboard macro.
......
......@@ -179,8 +179,7 @@
(defun gnus-advanced-body (header match type)
(when (string= header "all")
(setq header "article"))
(save-excursion
(set-buffer nntp-server-buffer)
(with-current-buffer nntp-server-buffer
(let* ((request-func (cond ((string= "head" header)
'gnus-request-head)
((string= "body" header)
......
......@@ -59,6 +59,36 @@ If RANGE is a single range, return (RANGE). Otherwise, return RANGE."
(setq list2 (cdr list2)))
list1))
(defun gnus-range-nconcat (&rest ranges)
"Return a range comprising all the RANGES, which are pre-sorted.
RANGES will be destructively altered."
(setq ranges (delete nil ranges))
(let* ((result (gnus-range-normalize (pop ranges)))
(last (last result)))
(dolist (range ranges)
(setq range (gnus-range-normalize range))
;; Normalize the single-number case, so that we don't need to
;; special-case that so much.
(when (numberp (car last))
(setcar last (cons (car last) (car last))))
(when (numberp (car range))
(setcar range (cons (car range) (car range))))
(if (= (1+ (cdar last)) (caar range))
(progn
(setcdr (car last) (cdar range))
(setcdr last (cdr range)))
(setcdr last range)
;; Denormalize back, since we couldn't join the ranges up.
(when (= (caar range) (cdar range))
(setcar range (caar range)))
(when (= (caar last) (cdar last))
(setcar last (caar last))))
(setq last (last last)))
(if (and (consp (car result))
(= (length result) 1))
(car result)
result)))
(defun gnus-range-difference (range1 range2)
"Return the range of elements in RANGE1 that do not appear in RANGE2.
Both ranges must be in ascending order."
......
......@@ -241,8 +241,7 @@ considered precious) will not be trimmed."
"Save the registry cache file."
(interactive)
(let ((file gnus-registry-cache-file))
(save-excursion
(set-buffer (gnus-get-buffer-create " *Gnus-registry-cache*"))
(with-current-buffer (gnus-get-buffer-create " *Gnus-registry-cache*")
(make-local-variable 'version-control)
(setq version-control gnus-backup-startup-file)
(setq buffer-file-name file)
......@@ -674,8 +673,7 @@ Consults `gnus-registry-unfollowed-groups' and
word words)
(if (or (not (gnus-registry-fetch-extra id 'keywords))
force)
(save-excursion
(set-buffer gnus-article-buffer)
(with-current-buffer gnus-article-buffer
(article-goto-body)
(save-window-excursion
(save-restriction
......
......@@ -708,8 +708,7 @@ file for the command instead of the current score file."
;; Change score file to the "all.SCORE" file.
(when (eq symp 'a)
(save-excursion
(set-buffer gnus-summary-buffer)
(with-current-buffer gnus-summary-buffer
(gnus-score-load-file
;; This is a kludge; yes...
(cond
......@@ -735,14 +734,12 @@ file for the command instead of the current score file."
(when (eq symp 'a)
;; We change the score file back to the previous one.
(save-excursion
(set-buffer gnus-summary-buffer)
(with-current-buffer gnus-summary-buffer
(gnus-score-load-file current-score-file)))))
(defun gnus-score-insert-help (string alist idx)
(setq gnus-score-help-winconf (current-window-configuration))
(save-excursion
(set-buffer (gnus-get-buffer-create "*Score Help*"))
(with-current-buffer (gnus-get-buffer-create "*Score Help*")
(buffer-disable-undo)
(delete-windows-on (current-buffer))
(erase-buffer)
......@@ -1270,8 +1267,7 @@ If FORMAT, also format the current score file."
exclude-files))
gnus-scores-exclude-files))
(when local
(save-excursion
(set-buffer gnus-summary-buffer)
(with-current-buffer gnus-summary-buffer
(while local
(and (consp (car local))
(symbolp (caar local))
......@@ -1528,8 +1524,7 @@ If FORMAT, also format the current score file."
(cons (cons header (or gnus-summary-default-score 0))
gnus-scores-articles))))
(save-excursion
(set-buffer (gnus-get-buffer-create "*Headers*"))
(with-current-buffer (gnus-get-buffer-create "*Headers*")
(buffer-disable-undo)
(when (gnus-buffer-live-p gnus-summary-buffer)
(message-clone-locals gnus-summary-buffer))
......@@ -1854,8 +1849,7 @@ score in `gnus-newsgroup-scored' by SCORE."
;; Change score file to the adaptive score file. All entries that
;; this function makes will be put into this file.
(save-excursion
(set-buffer gnus-summary-buffer)
(with-current-buffer gnus-summary-buffer
(gnus-score-load-file
(or gnus-newsgroup-adaptive-score-file
(gnus-score-file-name
......@@ -1946,15 +1940,13 @@ score in `gnus-newsgroup-scored' by SCORE."
(setq rest entries)))
(setq entries rest))))
;; We change the score file back to the previous one.
(save-excursion
(set-buffer gnus-summary-buffer)
(with-current-buffer gnus-summary-buffer
(gnus-score-load-file current-score-file))
(list (cons "references" news)))))
(defun gnus-score-add-followups (header score scores &optional thread)
"Add a score entry to the adapt file."
(save-excursion
(set-buffer gnus-summary-buffer)
(with-current-buffer gnus-summary-buffer
(let* ((id (mail-header-id header))
(scores (car scores))
entry dont)
......@@ -2282,8 +2274,7 @@ score in `gnus-newsgroup-scored' by SCORE."
"Create adaptive score rules for this newsgroup."
(when gnus-newsgroup-adaptive
;; We change the score file to the adaptive score file.
(save-excursion
(set-buffer gnus-summary-buffer)
(with-current-buffer gnus-summary-buffer
(gnus-score-load-file
(or gnus-newsgroup-adaptive-score-file
(gnus-home-score-file gnus-newsgroup-name t)
......@@ -2697,8 +2688,7 @@ GROUP using BNews sys file syntax."
(trans (cdr (assq ?: nnheader-file-name-translation-alist)))
(group-trans (nnheader-translate-file-chars group t))
ofiles not-match regexp)
(save-excursion
(set-buffer (gnus-get-buffer-create "*gnus score files*"))
(with-current-buffer (gnus-get-buffer-create "*gnus score files*")
(buffer-disable-undo)
;; Go through all score file names and create regexp with them
;; as the source.
......
......@@ -594,8 +594,7 @@ Can be used to turn version control on or off."
(defun gnus-subscribe-hierarchically (newgroup)
"Subscribe new NEWGROUP and insert it in hierarchical newsgroup order."
;; Basic ideas by mike-w@cs.aukuni.ac.nz (Mike Williams)
(save-excursion
(set-buffer (nnheader-find-file-noselect gnus-current-startup-file))
(with-current-buffer (nnheader-find-file-noselect gnus-current-startup-file)
(prog1
(let ((groupkey newgroup) before)
(while (and (not before) groupkey)
......@@ -857,8 +856,7 @@ prompt the user for the name of an NNTP server to use."
;; 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)
(with-current-buffer gnus-group-buffer
(gnus-group-set-mode-line))
(set-buffer obuf))))
......@@ -871,10 +869,9 @@ prompt the user for the name of an NNTP server to use."
(let ((dribble-file (gnus-dribble-file-name)))
(unless (file-exists-p (file-name-directory dribble-file))
(make-directory (file-name-directory dribble-file) t))
(save-excursion
(set-buffer (setq gnus-dribble-buffer
(gnus-get-buffer-create
(file-name-nondirectory dribble-file))))
(with-current-buffer (setq gnus-dribble-buffer
(gnus-get-buffer-create
(file-name-nondirectory dribble-file)))
(set (make-local-variable 'file-precious-flag) t)
(erase-buffer)
(setq buffer-file-name dribble-file)
......@@ -923,8 +920,7 @@ prompt the user for the name of an NNTP server to use."
(when (file-exists-p (gnus-dribble-file-name))
(delete-file (gnus-dribble-file-name)))
(when gnus-dribble-buffer
(save-excursion
(set-buffer gnus-dribble-buffer)
(with-current-buffer gnus-dribble-buffer
(let ((auto (make-auto-save-file-name)))
(when (file-exists-p auto)
(delete-file auto))
......@@ -934,14 +930,12 @@ prompt the user for the name of an NNTP server to use."
(defun gnus-dribble-save ()
(when (and gnus-dribble-buffer
(buffer-name gnus-dribble-buffer))
(save-excursion
(set-buffer gnus-dribble-buffer)
(with-current-buffer gnus-dribble-buffer
(save-buffer))))
(defun gnus-dribble-clear ()
(when (gnus-buffer-exists-p gnus-dribble-buffer)
(save-excursion
(set-buffer gnus-dribble-buffer)
(with-current-buffer gnus-dribble-buffer
(erase-buffer)
(set-buffer-modified-p nil)
(setq buffer-saved-size (buffer-size)))))
......@@ -1302,8 +1296,7 @@ for new groups, and subscribe the new groups as zombies."
(when (gnus-active group)
(gnus-group-change-level
group gnus-level-default-subscribed gnus-level-killed)))
(save-excursion
(set-buffer gnus-group-buffer)
(with-current-buffer gnus-group-buffer
;; Don't error if the group already exists. This happens when a
;; first-time user types 'F'. -- didier
(gnus-group-make-help-group t))
......@@ -1734,7 +1727,7 @@ If SCAN, request a scan of that group as well."
'primary)
(t
'foreign)))
(push (setq method-group-list (list method method-type nil))
(push (setq method-group-list (list method method-type nil nil))
type-cache))
;; Only add groups that need updating.
(if (<= (gnus-info-level info)
......@@ -1760,19 +1753,28 @@ If SCAN, request a scan of that group as well."
(< (gnus-method-rank (cadr c1) (car c1))
(gnus-method-rank (cadr c2) (car c2))))))
(while type-cache
(setq method (nth 0 (car type-cache))
method-type (nth 1 (car type-cache))
infos (nth 2 (car type-cache)))
(pop type-cache)
(when (and method
infos)
;; See if any of the groups from this method require updating.
(gnus-read-active-for-groups method infos)
(dolist (info infos)
(inline (gnus-get-unread-articles-in-group
info (gnus-active (gnus-info-group info)))))))
;; Start early async retrieval of data.
(dolist (elem type-cache)
(destructuring-bind (method method-type infos dummy) elem