bug#58839: [Patch] Re: bug#58839: 29.0.50; project-kill-buffer fails when Eglot is running

[Philip Kaludercic <philipk@posteo.net>]

João Távora <joaotavora@gmail.com> writes:

> On Tue, Nov 1, 2022 at 11:27 AM Philip Kaludercic <philipk@posteo.net>
> wrote:
>
>
>> E.g. `display-buffer-alist' makes use of it to associate display-buffer
>> rules with buffers.  Now you can add
>>
>>       ((major-mode . help-mode) display-buffer-in-side-window)
>>
>> instead of trying to match being a regular expression to catch all
>> *Help* buffer names of a function along the lines of
>>
>>       (lambda (buf _alist)
>>         (with-current-buffer buf
>>           (derived-mode-p 'help-mode)))
>>
>
> If you really want to save up on this typing, it's better to define
> a reusable helper function, or even a higher order function.
>
>   (defun buffer-mode-matcher (mode)
>     (lambda (b _alist)
>       (with-current-buffer b (derived-mode-p 'help-mode))))
>
> You can add buffer-mode-matcher to the library if it becomes
> useful enough.  Then you add:
>
>   `(,(buffer-mode-matcher 'help-mode) display-buffer-in-side-window)
>
> to display-buffer-alist.
>
> But if you really want a new language your language, then I suggest
> a simple adapter buffer-matcher utility that merges the two.  That way one
> doesn't couple existing utilities to the new mini-language and
> simultaneously
> the new mini-language become useful in a much wider setting for those who
> appreciate such things.
>
>   (defun buffer-matcher (condition)
>      "Return unary predicate of a buffer matching the CONDITION
> mini-language."
>     (lambda (buf &rest _whatever) ; make it even more lax
>        (buffer-match-p condition)))
>
> Later on, you might even pass an (... &optional compiled) so that the
> return value
> is syntax checked and optimized in some way at compile time.
>
> IOW, (E)Lisp already gives you the tools for these composition without
> needing to invent new languages with the drawbacks I listed.

I was curious to try this out, and implemented something along the lines
of your suggestion.  The bad news is that it is at least 10 times slower
than the current implementation, that isn't even really optimised.
Perhaps I did something native and didn't see what is wrong, but here
are my notes:

--8<---------------cut here---------------start------------->8---
(defun translate-buffer-condition (condition)
  "Compile a CONDITION into a predicate function."
  (pcase-exhaustive condition
    ((or 't 'nil)
     (lambda (_buffer _arg)
       condition))
    ((pred stringp)
     (lambda (buffer _arg)
       (string-match-p condition (buffer-name buffer))))
    ((pred functionp)
     (if (eq 1 (cdr (func-arity condition)))
	 (lambda (buffer _arg)
	   (funcall condition buffer))
       condition))
    (`(major-mode . ,mode)
     (lambda (buffer _arg)
       (eq
	(buffer-local-value 'major-mode buffer)
	mode)))
    (`(derived-mode . ,mode)
     (lambda (buffer _arg)
       (provided-mode-derived-p
	(buffer-local-value 'major-mode buffer)
	mode)))
    (`(not . ,cond)
     (lambda (buffer arg)
       (not (funcall (translate-buffer-condition cond) buffer arg))))
    (`(or . ,conds)
     (lambda (buffer arg)
       (catch 'match
	 (dolist (cond conds)
	   (when (funcall (translate-buffer-condition cond) buffer arg)
	     (throw 'match t))))))
    (`(and . ,conds)
     (lambda (buffer arg)
       (catch 'match
	 (dolist (cond conds t)
	   (when (funcall (translate-buffer-condition cond) buffer arg)
	     (throw 'match nil))))))))

(defvar buffer-match-p-cache (make-hash-table :test 'eq))

(defun buffer-match-p/compiled (condition buffer-or-name &optional arg)
  "Return non-nil if BUFFER-OR-NAME matches CONDITION.
CONDITION is either:
- the symbol t, to always match,
- the symbol nil, which never matches,
- a regular expression, to match a buffer name,
- a predicate function that takes a buffer object and ARG as
  arguments, and returns non-nil if the buffer matches,
- a cons-cell, where the car describes how to interpret the cdr.
  The car can be one of the following:
  * `derived-mode': the buffer matches if the buffer's major mode
    is derived from the major mode in the cons-cell's cdr.
  * `major-mode': the buffer matches if the buffer's major mode
    is eq to the cons-cell's cdr.  Prefer using `derived-mode'
    instead when both can work.
  * `not': the cdr is interpreted as a negation of a condition.
  * `and': the cdr is a list of recursive conditions, that all have
    to be met.
  * `or': the cdr is a list of recursive condition, of which at
    least one has to be met."
  (funcall (or (gethash condition buffer-match-p-cache)
	       (puthash condition
			(byte-compile (translate-buffer-condition condition))
			buffer-match-p-cache))
	   (get-buffer buffer-or-name)
	   arg))

(defun match-buffers/compiled (condition &optional buffers arg)
  "Return a list of buffers that match CONDITION.
See `buffer-match' for details on CONDITION.  By default all
buffers are checked, this can be restricted by passing an
optional argument BUFFERS, set to a list of buffers to check.
ARG is passed to `buffer-match', for predicate conditions in
CONDITION."
  (let (bufs)
    (dolist (buf (or buffers (buffer-list)))
      (when (buffer-match-p/compiled condition (get-buffer buf) arg)
        (push buf bufs)))
    bufs))

;; Here we will test a moderately complicated condition and time how
;; long it takes with the current implementation and with the proposed
;; alternative.

(defvar sample-condition
  '(and (or buffer-file-name
	    (derived-mode . compilation-mode)
	    (derived-mode . dired-mode)
	    (derived-mode . diff-mode)
	    (derived-mode . comint-mode)
	    (derived-mode . eshell-mode)
	    (derived-mode . change-log-mode))
	"\\*.+\\*"
	(not . "\\` ")))

(benchmark-run 100
  (match-buffers sample-condition pr))
;; => (1.7045469830000002 20 1.1418286690000023)


(benchmark-run 1000
  (match-buffers/compiled project-buffer-conditions pr))
;; => (17.646938126000002 219 12.428946030999999)
--8<---------------cut here---------------end--------------->8---

I guess this just goes to show that one shouldn't underestimate the cost
of a function call...

    LISP programmers know the value of everything and the cost of nothing.
         --  Alan Perlis