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:
parent
8b3eb67be3
commit
8403b9a368
@ -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)))
|
||||
|
@ -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)))
|
||||
|
||||
|
@ -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))
|
||||
|
@ -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))
|
||||
|
@ -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))))
|
||||
|
||||
|
@ -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))
|
||||
|
@ -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
|
||||
|
@ -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 ()
|
||||
|
@ -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]+")
|
||||
|
@ -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)
|
||||
|
@ -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)
|
||||
|
Loading…
Reference in New Issue
Block a user