1
0
mirror of https://git.savannah.gnu.org/git/emacs.git synced 2025-01-07 15:21:46 +00:00

* lisp/gnus: Use with-current-buffer at a few more places

* lisp/gnus/nnmbox.el (nnmbox-request-scan, nnmbox-read-mbox):
* lisp/gnus/nnmairix.el (nnmairix-create-search-group):
* lisp/gnus/nnfolder.el (nnfolder-existing-articles):
* lisp/gnus/nndraft.el (nndraft-auto-save-file-name):
* lisp/gnus/nndoc.el (nndoc-request-article):
* lisp/gnus/nnbabyl.el (nnbabyl-read-mbox):
* lisp/gnus/gnus-score.el (gnus-score-body):
* lisp/gnus/gnus-start.el (gnus-dribble-enter)
(gnus-dribble-eval-file, gnus-ask-server-for-new-groups)
(gnus-read-newsrc-file, gnus-read-descriptions-file):
* lisp/gnus/gnus-spec.el (gnus-update-format-specifications):
* lisp/gnus/gnus-draft.el (gnus-draft-edit-message):
* lisp/gnus/gnus-art.el (gnus-request-article-this-buffer)
(gnus-article-edit-exit): Use `with-current-buffer`.
This commit is contained in:
Stefan Monnier 2021-01-30 14:12:10 -05:00
parent 8b3eb67be3
commit 8403b9a368
11 changed files with 126 additions and 145 deletions

View File

@ -7151,13 +7151,11 @@ If given a prefix, show the hidden text instead."
(when (and do-update-line
(or (numberp article)
(stringp article)))
(let ((buf (current-buffer)))
(set-buffer gnus-summary-buffer)
(with-current-buffer gnus-summary-buffer
(gnus-summary-update-article do-update-line sparse-header)
(gnus-summary-goto-subject do-update-line nil t)
(set-window-point (gnus-get-buffer-window (current-buffer) t)
(point))
(set-buffer buf))))))
(point)))))))
(defun gnus-block-private-groups (group)
"Allows images in newsgroups to be shown, blocks images in all
@ -7351,8 +7349,7 @@ groups."
(gnus-article-mode)
(set-window-configuration winconf)
;; Tippy-toe some to make sure that point remains where it was.
(save-current-buffer
(set-buffer curbuf)
(with-current-buffer curbuf
(set-window-start (get-buffer-window (current-buffer)) window-start)
(goto-char p))))
(gnus-summary-show-article)))

View File

@ -101,8 +101,7 @@
(push
`((lambda ()
(when (gnus-buffer-live-p ,gnus-summary-buffer)
(save-excursion
(set-buffer ,gnus-summary-buffer)
(with-current-buffer ,gnus-summary-buffer
(gnus-cache-possibly-remove-article ,article nil nil nil t)))))
message-send-actions)))

View File

@ -1818,45 +1818,44 @@ score in `gnus-newsgroup-scored' by SCORE."
handles))))
(defun gnus-score-body (scores header now expire &optional trace)
(if gnus-agent-fetching
nil
(save-excursion
(setq gnus-scores-articles
(sort gnus-scores-articles
(lambda (a1 a2)
(< (mail-header-number (car a1))
(mail-header-number (car a2))))))
(set-buffer nntp-server-buffer)
(save-restriction
(let* ((buffer-read-only nil)
(articles gnus-scores-articles)
(all-scores scores)
(request-func (cond ((string= "head" header)
'gnus-request-head)
((string= "body" header)
'gnus-request-body)
(t 'gnus-request-article)))
entries alist ofunc article last)
(when articles
(setq last (mail-header-number (caar (last articles))))
;; Not all backends support partial fetching. In that case,
;; we just fetch the entire article.
;; When scoring by body, we need to peek at the headers to detect
;; the content encoding
(unless (or (gnus-check-backend-function
(and (string-match "^gnus-" (symbol-name request-func))
(intern (substring (symbol-name request-func)
(match-end 0))))
gnus-newsgroup-name)
(string= "body" header))
(setq ofunc request-func)
(setq request-func 'gnus-request-article))
(while articles
(setq article (mail-header-number (caar articles)))
(gnus-message 7 "Scoring article %s of %s..." article last)
(widen)
(let (handles)
(when (funcall request-func article gnus-newsgroup-name)
(if gnus-agent-fetching
nil
(setq gnus-scores-articles
(sort gnus-scores-articles
(lambda (a1 a2)
(< (mail-header-number (car a1))
(mail-header-number (car a2))))))
(with-current-buffer nntp-server-buffer
(save-restriction
(let* ((buffer-read-only nil)
(articles gnus-scores-articles)
(all-scores scores)
(request-func (cond ((string= "head" header)
'gnus-request-head)
((string= "body" header)
'gnus-request-body)
(t 'gnus-request-article)))
entries alist ofunc article last)
(when articles
(setq last (mail-header-number (caar (last articles))))
;; Not all backends support partial fetching. In that case,
;; we just fetch the entire article.
;; When scoring by body, we need to peek at the headers to detect
;; the content encoding
(unless (or (gnus-check-backend-function
(and (string-match "^gnus-" (symbol-name request-func))
(intern (substring (symbol-name request-func)
(match-end 0))))
gnus-newsgroup-name)
(string= "body" header))
(setq ofunc request-func)
(setq request-func 'gnus-request-article))
(while articles
(setq article (mail-header-number (caar articles)))
(gnus-message 7 "Scoring article %s of %s..." article last)
(widen)
(let (handles)
(when (funcall request-func article gnus-newsgroup-name)
(when (string= "body" header)
(setq handles (gnus-score-decode-text-parts)))
(goto-char (point-min))
@ -1921,8 +1920,8 @@ score in `gnus-newsgroup-scored' by SCORE."
(setq rest entries))))
(setq entries rest))))
(when handles (mm-destroy-parts handles))))
(setq articles (cdr articles)))))))
nil))
(setq articles (cdr articles)))))))
nil))
(defun gnus-score-thread (scores header now expire &optional trace)
(gnus-score-followup scores header now expire trace t))

View File

@ -146,7 +146,7 @@ Return a list of updated types."
(while (setq type (pop types))
;; Jump to the proper buffer to find out the value of the
;; variable, if possible. (It may be buffer-local.)
(save-excursion
(save-current-buffer
(let ((buffer (intern (format "gnus-%s-buffer" type))))
(when (and (boundp buffer)
(setq val (symbol-value buffer))

View File

@ -843,8 +843,7 @@ prompt the user for the name of an NNTP server to use."
If REGEXP is given, lines that match it will be deleted."
(when (and (not gnus-dribble-ignore)
(buffer-live-p gnus-dribble-buffer))
(let ((obuf (current-buffer)))
(set-buffer gnus-dribble-buffer)
(with-current-buffer gnus-dribble-buffer
(when regexp
(goto-char (point-min))
(let (end)
@ -859,8 +858,7 @@ If REGEXP is given, lines that match it will be deleted."
(insert (replace-regexp-in-string "\n" "\\\\n" string) "\n")
(bury-buffer gnus-dribble-buffer)
(with-current-buffer gnus-group-buffer
(gnus-group-set-mode-line))
(set-buffer obuf))))
(gnus-group-set-mode-line)))))
(defun gnus-dribble-touch ()
"Touch the dribble buffer."
@ -916,9 +914,8 @@ If REGEXP is given, lines that match it will be deleted."
(defun gnus-dribble-eval-file ()
(when gnus-dribble-eval-file
(setq gnus-dribble-eval-file nil)
(save-excursion
(let ((gnus-dribble-ignore t))
(set-buffer gnus-dribble-buffer)
(let ((gnus-dribble-ignore t))
(with-current-buffer gnus-dribble-buffer
(eval-buffer (current-buffer))))))
(defun gnus-dribble-delete-file ()
@ -1187,10 +1184,9 @@ for new groups, and subscribe the new groups as zombies."
gnus-override-subscribe-method method)
(when (and (gnus-check-server method)
(gnus-request-newgroups date method))
(save-excursion
(setq got-new t
hashtb (gnus-make-hashtable 100))
(set-buffer nntp-server-buffer)
(setq got-new t
hashtb (gnus-make-hashtable 100))
(with-current-buffer nntp-server-buffer
;; Enter all the new groups into a hashtable.
(gnus-active-to-gnus-format method hashtb 'ignore))
;; Now all new groups from `method' are in `hashtb'.
@ -2250,9 +2246,8 @@ If FORCE is non-nil, the .newsrc file is read."
;; can find there for changing the data already read -
;; i. e., reading the .newsrc file will not trash the data
;; already read (except for read articles).
(save-excursion
(gnus-message 5 "Reading %s..." newsrc-file)
(set-buffer (nnheader-find-file-noselect newsrc-file))
(gnus-message 5 "Reading %s..." newsrc-file)
(with-current-buffer (nnheader-find-file-noselect newsrc-file)
(buffer-disable-undo)
(gnus-newsrc-to-gnus-format)
(kill-buffer (current-buffer))
@ -3102,50 +3097,49 @@ SPECIFIC-VARIABLES, or those in `gnus-variable-list'."
(gnus-message 1 "Couldn't read newsgroups descriptions")
nil)
(t
(save-excursion
;; FIXME: Shouldn't save-restriction be done after set-buffer?
(save-restriction
(set-buffer nntp-server-buffer)
(goto-char (point-min))
(when (or (search-forward "\n.\n" nil t)
(goto-char (point-max)))
(beginning-of-line)
(narrow-to-region (point-min) (point)))
;; If these are groups from a foreign select method, we insert the
;; group prefix in front of the group names.
(and method (not (inline
(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)))))))
(goto-char (point-min))
(while (not (eobp))
(setq group
(condition-case ()
(read nntp-server-buffer)
(error nil)))
(skip-chars-forward " \t")
(when group
(setq group (if (numberp group)
(number-to-string group)
(symbol-name group)))
(let* ((str (buffer-substring
(point) (progn (end-of-line) (point))))
(charset
(or (gnus-group-name-charset method group)
(gnus-parameter-charset group)
gnus-default-charset)))
;; Fixme: Don't decode in unibyte mode.
;; Double fixme: We're not in unibyte mode, are we?
(when (and str charset)
(setq str (decode-coding-string str charset)))
(puthash group str gnus-description-hashtb)))
(forward-line 1))))
(with-current-buffer nntp-server-buffer
(save-excursion ;;FIXME: Not sure if it's needed!
(save-restriction
(goto-char (point-min))
(when (or (search-forward "\n.\n" nil t)
(goto-char (point-max)))
(beginning-of-line)
(narrow-to-region (point-min) (point)))
;; If these are groups from a foreign select method, we insert the
;; group prefix in front of the group names.
(and method (not (inline
(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)))))))
(goto-char (point-min))
(while (not (eobp))
(setq group
(condition-case ()
(read nntp-server-buffer)
(error nil)))
(skip-chars-forward " \t")
(when group
(setq group (if (numberp group)
(number-to-string group)
(symbol-name group)))
(let* ((str (buffer-substring
(point) (progn (end-of-line) (point))))
(charset
(or (gnus-group-name-charset method group)
(gnus-parameter-charset group)
gnus-default-charset)))
;; Fixme: Don't decode in unibyte mode.
;; Double fixme: We're not in unibyte mode, are we?
(when (and str charset)
(setq str (decode-coding-string str charset)))
(puthash group str gnus-description-hashtb)))
(forward-line 1)))))
(gnus-message 5 "Reading descriptions file...done")
t))))

View File

@ -554,13 +554,12 @@
(with-current-buffer nnbabyl-mbox-buffer
(= (buffer-size) (nnheader-file-size nnbabyl-mbox-file))))
;; This buffer has changed since we read it last. Possibly.
(save-excursion
(let ((delim (concat "^" nnbabyl-mail-delimiter))
(alist nnbabyl-group-alist)
start end number)
(set-buffer (setq nnbabyl-mbox-buffer
(nnheader-find-file-noselect
nnbabyl-mbox-file nil t)))
(let ((delim (concat "^" nnbabyl-mail-delimiter))
(alist nnbabyl-group-alist)
start end number)
(with-current-buffer (setq nnbabyl-mbox-buffer
(nnheader-find-file-noselect
nnbabyl-mbox-file nil t))
;; Save previous buffer mode.
(setq nnbabyl-previous-buffer-mode
(cons (cons (point-min) (point-max))

View File

@ -256,11 +256,10 @@ from the document.")
(deffoo nndoc-request-article (article &optional newsgroup server buffer)
(nndoc-possibly-change-buffer newsgroup server)
(save-excursion
(let ((buffer (or buffer nntp-server-buffer))
(entry (cdr (assq article nndoc-dissection-alist)))
beg)
(set-buffer buffer)
(let ((buffer (or buffer nntp-server-buffer))
(entry (cdr (assq article nndoc-dissection-alist)))
beg)
(with-current-buffer buffer
(erase-buffer)
(when entry
(cond

View File

@ -322,12 +322,10 @@ are generated if and only if they are also in `message-draft-headers'."
args))
(defun nndraft-auto-save-file-name (file)
(save-excursion
(with-current-buffer (gnus-get-buffer-create " *draft tmp*")
(setq buffer-file-name file)
(prog1
(progn
(set-buffer (gnus-get-buffer-create " *draft tmp*"))
(setq buffer-file-name file)
(make-auto-save-file-name))
(make-auto-save-file-name)
(kill-buffer (current-buffer)))))
(defun nndraft-articles ()

View File

@ -383,9 +383,8 @@ all. This may very well take some time.")
;; current folder.
(defun nnfolder-existing-articles ()
(save-excursion
(when nnfolder-current-buffer
(set-buffer nnfolder-current-buffer)
(when nnfolder-current-buffer
(with-current-buffer nnfolder-current-buffer
(goto-char (point-min))
(let ((marker (concat "\n" nnfolder-article-marker))
(number "[0-9]+")

View File

@ -757,10 +757,9 @@ called interactively, user will be asked for parameters."
(when (not (listp query))
(setq query (list query)))
(when (and server group query)
(save-excursion
(let ((groupname (gnus-group-prefixed-name group server))
info)
(set-buffer gnus-group-buffer)
(let ((groupname (gnus-group-prefixed-name group server))
) ;; info
(with-current-buffer gnus-group-buffer
(gnus-group-make-group group server)
(gnus-group-set-parameter groupname 'query query)
(gnus-group-set-parameter groupname 'threads threads)

View File

@ -207,9 +207,8 @@
(file-name-directory nnmbox-mbox-file)
group
(lambda ()
(save-excursion
(let ((in-buf (current-buffer)))
(set-buffer nnmbox-mbox-buffer)
(let ((in-buf (current-buffer)))
(with-current-buffer nnmbox-mbox-buffer
(goto-char (point-max))
(insert-buffer-substring in-buf)))
(nnmbox-save-active nnmbox-group-alist nnmbox-active-file))))
@ -622,16 +621,15 @@
(with-current-buffer nnmbox-mbox-buffer
(= (buffer-size) (nnheader-file-size nnmbox-mbox-file))))
()
(save-excursion
(let ((delim (concat "^" message-unix-mail-delimiter))
(alist nnmbox-group-alist)
(nnmbox-group-building-active-articles t)
start end end-header number)
(set-buffer (setq nnmbox-mbox-buffer
(let ((nnheader-file-coding-system
nnmbox-file-coding-system))
(nnheader-find-file-noselect
nnmbox-mbox-file t t))))
(let ((delim (concat "^" message-unix-mail-delimiter))
(alist nnmbox-group-alist)
(nnmbox-group-building-active-articles t)
start end end-header number)
(with-current-buffer (setq nnmbox-mbox-buffer
(let ((nnheader-file-coding-system
nnmbox-file-coding-system))
(nnheader-find-file-noselect
nnmbox-mbox-file t t)))
(mm-enable-multibyte)
(buffer-disable-undo)
(gnus-add-buffer)