From: Stefan Monnier Date: Sat, 30 Jan 2021 19:12:10 +0000 (-0500) Subject: * lisp/gnus: Use `with-current-buffer` at a few more places X-Git-Tag: emacs-28.0.90~3991^2~6 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=8403b9a36862f3e781cfd9c556a7e981d9ee5417;p=emacs.git * 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`. --- diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el index 7ae4e5836a4..7e5439a217e 100644 --- a/lisp/gnus/gnus-art.el +++ b/lisp/gnus/gnus-art.el @@ -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))) diff --git a/lisp/gnus/gnus-draft.el b/lisp/gnus/gnus-draft.el index 3b380f30c66..0752267e216 100644 --- a/lisp/gnus/gnus-draft.el +++ b/lisp/gnus/gnus-draft.el @@ -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))) diff --git a/lisp/gnus/gnus-score.el b/lisp/gnus/gnus-score.el index c6e08cee73a..254f0e548ce 100644 --- a/lisp/gnus/gnus-score.el +++ b/lisp/gnus/gnus-score.el @@ -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)) diff --git a/lisp/gnus/gnus-spec.el b/lisp/gnus/gnus-spec.el index a5228551396..0dfa9f99d35 100644 --- a/lisp/gnus/gnus-spec.el +++ b/lisp/gnus/gnus-spec.el @@ -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)) diff --git a/lisp/gnus/gnus-start.el b/lisp/gnus/gnus-start.el index cd438764133..a3159595c45 100644 --- a/lisp/gnus/gnus-start.el +++ b/lisp/gnus/gnus-start.el @@ -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)))) diff --git a/lisp/gnus/nnbabyl.el b/lisp/gnus/nnbabyl.el index 130f56ad92f..5149acc0e72 100644 --- a/lisp/gnus/nnbabyl.el +++ b/lisp/gnus/nnbabyl.el @@ -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)) diff --git a/lisp/gnus/nndoc.el b/lisp/gnus/nndoc.el index c68e2012713..dccf6c1ffb7 100644 --- a/lisp/gnus/nndoc.el +++ b/lisp/gnus/nndoc.el @@ -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 diff --git a/lisp/gnus/nndraft.el b/lisp/gnus/nndraft.el index 9e70bb62148..e636636a174 100644 --- a/lisp/gnus/nndraft.el +++ b/lisp/gnus/nndraft.el @@ -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 () diff --git a/lisp/gnus/nnfolder.el b/lisp/gnus/nnfolder.el index 405ab2f92f4..70e15c57130 100644 --- a/lisp/gnus/nnfolder.el +++ b/lisp/gnus/nnfolder.el @@ -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]+") diff --git a/lisp/gnus/nnmairix.el b/lisp/gnus/nnmairix.el index 54d6c5276e4..2bf50155430 100644 --- a/lisp/gnus/nnmairix.el +++ b/lisp/gnus/nnmairix.el @@ -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) diff --git a/lisp/gnus/nnmbox.el b/lisp/gnus/nnmbox.el index a4863c3e1fa..92c7dde9c8f 100644 --- a/lisp/gnus/nnmbox.el +++ b/lisp/gnus/nnmbox.el @@ -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)