[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
scratch/lexical-gnus-rc 8403b9a 1/6: * lisp/gnus: Use `with-current-buff
|
From: |
Stefan Monnier |
|
Subject: |
scratch/lexical-gnus-rc 8403b9a 1/6: * lisp/gnus: Use `with-current-buffer` at a few more places |
|
Date: |
Sat, 30 Jan 2021 18:57:39 -0500 (EST) |
branch: scratch/lexical-gnus-rc
commit 8403b9a36862f3e781cfd9c556a7e981d9ee5417
Author: Stefan Monnier <monnier@iro.umontreal.ca>
Commit: Stefan Monnier <monnier@iro.umontreal.ca>
* 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`.
---
lisp/gnus/gnus-art.el | 9 ++--
lisp/gnus/gnus-draft.el | 3 +-
lisp/gnus/gnus-score.el | 81 ++++++++++++++++++-----------------
lisp/gnus/gnus-spec.el | 2 +-
lisp/gnus/gnus-start.el | 110 +++++++++++++++++++++++-------------------------
lisp/gnus/nnbabyl.el | 13 +++---
lisp/gnus/nndoc.el | 9 ++--
lisp/gnus/nndraft.el | 8 ++--
lisp/gnus/nnfolder.el | 5 +--
lisp/gnus/nnmairix.el | 7 ++-
lisp/gnus/nnmbox.el | 24 +++++------
11 files changed, 126 insertions(+), 145 deletions(-)
diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el
index 7ae4e58..7e5439a 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 3b380f3..0752267 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 c6e08ce..254f0e5 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 a522855..0dfa9f9 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 cd43876..a315959 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 130f56a..5149acc 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 c68e201..dccf6c1 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 9e70bb6..e636636 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 405ab2f..70e15c5 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 54d6c52..2bf5015 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 a4863c3..92c7dde 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)
- branch scratch/lexical-gnus-rc created (now 12189ae), Stefan Monnier, 2021/01/30
- scratch/lexical-gnus-rc 8403b9a 1/6: * lisp/gnus: Use `with-current-buffer` at a few more places,
Stefan Monnier <=
- scratch/lexical-gnus-rc f0ca9ad 2/6: * lisp/gnus: Demote some macros and defsubsts, plus a fix, Stefan Monnier, 2021/01/30
- scratch/lexical-gnus-rc 12189ae 6/6: * lisp/gnus: Use closures now that we activated `lexical-binding`, Stefan Monnier, 2021/01/30
- scratch/lexical-gnus-rc 9be4f41 4/6: * lisp/gnus: Misc simplifications found during conversion to lexical, Stefan Monnier, 2021/01/30
- scratch/lexical-gnus-rc daa4e01 5/6: * lisp/gnus: Use lexical-binding in all the files, Stefan Monnier, 2021/01/30
- scratch/lexical-gnus-rc acf4ec2 3/6: * lisp/gnus: Remove redundant `:group` args, Stefan Monnier, 2021/01/30