procyberian/emacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Improve performance of `find-buffer-visiting' (bug#66117)

Browse source 
* src/buffer.c (Fget_truename_buffer): Expose `get_truename_buffer' to
Elisp.
(Ffind_buffer): New subr searching for a live buffer with a given
value of buffer-local variable.
(syms_of_buffer): Register the new added subroutines.
* src/filelock.c (lock_file): Use the new `Fget_truename_buffer' name.
* src/lisp.h:
* test/manual/etags/c-src/emacs/src/lisp.h: Remove no-longer-necessary
extern declarations for `get_truename_buffer'.
* lisp/files.el (find-buffer-visiting): Refactor, using subroutines to
search for buffers instead of slow manual Elisp iterations.
This commit is contained in:
Ihor Radchenko 2023-10-08 11:48:42 +03:00 • committed by Eli Zaretskii
parent 0cb252cf21
commit b7a737ef49
5 changed files with 47 additions and 36 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

54
lisp/files.el
View file

@ -2208,37 +2208,29 @@ and others are ignored. PREDICATE is called with the buffer as
the only argument, but not with the buffer as the current buffer.
If there is no such live buffer, return nil."
(let ((predicate (or predicate #'identity))
(truename (abbreviate-file-name (file-truename filename))))
(or (let ((buf (get-file-buffer filename)))
(when (and buf (funcall predicate buf)) buf))
(let ((list (buffer-list)) found)
(while (and (not found) list)
(with-current-buffer (car list)
(if (and buffer-file-name
(string= buffer-file-truename truename)
(funcall predicate (current-buffer)))
(setq found (car list))))
(setq list (cdr list)))
found)
(let* ((attributes (file-attributes truename))
(number (file-attribute-file-identifier attributes))
(list (buffer-list)) found)
(and buffer-file-numbers-unique
(car-safe number) ;Make sure the inode is not just nil.
(while (and (not found) list)
(with-current-buffer (car list)
(if (and buffer-file-name
(equal buffer-file-number number)
;; Verify this buffer's file number
;; still belongs to its file.
(file-exists-p buffer-file-name)
(equal (file-attributes buffer-file-truename)
attributes)
(funcall predicate (current-buffer)))
(setq found (car list))))
(setq list (cdr list))))
found))))
(or (let ((buf (get-file-buffer filename)))
(when (and buf (or (not predicate) (funcall predicate buf))) buf))
(let ((truename (abbreviate-file-name (file-truename filename))))
(or
(let ((buf (get-truename-buffer truename)))
(when (and buf (buffer-local-value 'buffer-file-name buf)
(or (not predicate) (funcall predicate buf)))
buf))
(let* ((attributes (file-attributes truename))
(number (file-attribute-file-identifier attributes)))
(and buffer-file-numbers-unique
(car-safe number) ;Make sure the inode is not just nil.
(let ((buf (find-buffer 'buffer-file-number number)))
(when (and buf (buffer-local-value 'buffer-file-name buf)
;; Verify this buffer's file number
;; still belongs to its file.
(file-exists-p buffer-file-name)
(equal (file-attributes buffer-file-truename)
attributes)
(or (not predicate)
(funcall predicate (current-buffer))))
buf))))))))
(defcustom find-file-wildcards t
"Non-nil means file-visiting commands should handle wildcards.

25
src/buffer.c
View file

@ -519,8 +519,11 @@ See also `find-buffer-visiting'. */)
return Qnil;
}
Lisp_Object
get_truename_buffer (register Lisp_Object filename)
DEFUN ("get-truename-buffer", Fget_truename_buffer, Sget_truename_buffer, 1, 1, 0,
doc: /* Return the buffer with `file-truename' equal to FILENAME (a string).
If there is no such live buffer, return nil.
See also `find-buffer-visiting'. */)
(register Lisp_Object filename)
{
register Lisp_Object tail, buf;
@ -533,6 +536,22 @@ get_truename_buffer (register Lisp_Object filename)
return Qnil;
}
DEFUN ("find-buffer", Ffind_buffer, Sfind_buffer, 2, 2, 0,
doc: /* Return the buffer with buffer-local VARIABLE equal to VALUE.
If there is no such live buffer, return nil.
See also `find-buffer-visiting'. */)
(Lisp_Object variable, Lisp_Object value)
{
register Lisp_Object tail, buf;
FOR_EACH_LIVE_BUFFER (tail, buf)
{
if (!NILP (Fequal (value, Fbuffer_local_value(variable, buf))))
return buf;
}
return Qnil;
}
/* Run buffer-list-update-hook if Vrun_hooks is non-nil and BUF does
not have buffer hooks inhibited. */
@ -6010,6 +6029,8 @@ There is no reason to change that value except for debugging purposes. */);
defsubr (&Sbuffer_list);
defsubr (&Sget_buffer);
defsubr (&Sget_file_buffer);
defsubr (&Sget_truename_buffer);
defsubr (&Sfind_buffer);
defsubr (&Sget_buffer_create);
defsubr (&Smake_indirect_buffer);
defsubr (&Sgenerate_new_buffer_name);

2
src/filelock.c
View file

@ -563,7 +563,7 @@ lock_file (Lisp_Object fn)
/* See if this file is visited and has changed on disk since it was
visited. */
Lisp_Object subject_buf = get_truename_buffer (fn);
Lisp_Object subject_buf = Fget_truename_buffer (fn);
if (!NILP (subject_buf)
&& NILP (Fverify_visited_file_modtime (subject_buf))
&& !NILP (Ffile_exists_p (fn))

1
src/lisp.h
View file

@ -4664,7 +4664,6 @@ extern void report_overlay_modification (Lisp_Object, Lisp_Object, bool,
Lisp_Object, Lisp_Object, Lisp_Object);
extern bool overlay_touches_p (ptrdiff_t);
extern Lisp_Object other_buffer_safely (Lisp_Object);
extern Lisp_Object get_truename_buffer (Lisp_Object);
extern void init_buffer_once (void);
extern void init_buffer (void);
extern void syms_of_buffer (void);

1
test/manual/etags/c-src/emacs/src/lisp.h
View file

@ -4075,7 +4075,6 @@ extern void report_overlay_modification (Lisp_Object, Lisp_Object, bool,
Lisp_Object, Lisp_Object, Lisp_Object);
extern bool overlay_touches_p (ptrdiff_t);
extern Lisp_Object other_buffer_safely (Lisp_Object);
extern Lisp_Object get_truename_buffer (Lisp_Object);
extern void init_buffer_once (void);
extern void init_buffer (int);
extern void syms_of_buffer (void);