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

[Philip Kaludercic]

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

> On Tue, Nov 1, 2022 at 2:00 PM Philip Kaludercic <philipk@posteo.net> wrote:
>
>
>> > My idea of using the byte-compiler to do this is different: it entails
>> > translating the mini-language to elisp first and then byte-compiling
>> > that.  But it is a technique that I think your code isn't applying
>> > or at least not correctly (though I haven't read all of it: I will soon).
>>
>> What I am doing is translating it into lambda expressions, but I could
>> also try out translating it into an s-expression and passing that to
>> `eval'...
>>
>
> Yes, do that, but use byte-compile instead, not eval.

I have tried both, and it doesn't appear to be a particular advantage
one way or another.  That being said, this approach is *a lot* faster,
to the point that I first assumed it was broken:

--8<---------------cut here---------------start------------->8---
(benchmark-run 1000
  (match-buffers/compiled sample-condition))
;; (0.469515746 5 0.3328363100000047)
--8<---------------cut here---------------end--------------->8---

but it works:

--8<---------------cut here---------------start------------->8---
(equal (match-buffers sample-condition) (match-buffers/compiled 
sample-condition))
;; => t
--8<---------------cut here---------------end--------------->8---

So this is certainly something worth considering as a replacement!

Here is the implementation:

--8<---------------cut here---------------start------------->8---
(defvar translate-buffer-condition-buffer-sym (make-symbol "buffer"))
(defvar translate-buffer-condition-arg-sym (make-symbol "arg"))

(defun translate-buffer-condition (condition)
  "Compile a CONDITION into a predicate function."
  (pcase-exhaustive condition
    ((or 't 'nil)
     condition)
    ((pred stringp)
     `(string-match-p ,condition (buffer-name 
,translate-buffer-condition-buffer-sym)))
    ((pred functionp)
     (if (eq 1 (cdr (func-arity condition)))
         ;; FIXME: is `funcall' necessary here?
         `(funcall #',condition ,translate-buffer-condition-buffer-sym)
       `(funcall ,condition
                 ,translate-buffer-condition-buffer-sym
                 ,translate-buffer-condition-arg-sym)))
    (`(major-mode . ,mode)
     `(eq (buffer-local-value 'major-mode 
,translate-buffer-condition-buffer-sym)
          ',mode))
    (`(derived-mode . ,mode)
     `(provided-mode-derived-p
       (buffer-local-value 'major-mode ,translate-buffer-condition-buffer-sym)
       ',mode))
    (`(not . ,cond)
     `(not ,(translate-buffer-condition cond)))
    (`(or . ,conds)
     `(or ,@(mapcar #'translate-buffer-condition conds)))
    (`(and . ,conds)
     `(and ,@(mapcar #'translate-buffer-condition conds)))))

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

(defun buffer-match-p/evaled (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."
  (eval (or (gethash condition buffer-match-p-cache)
            (puthash condition
                     (translate-buffer-condition condition)
                     buffer-match-p-cache))
        `((,translate-buffer-condition-buffer-sym . ,(get-buffer 
buffer-or-name))
          (,translate-buffer-condition-arg-sym . ,arg))))

;; Alternative implementation using `byte-compile':
;;
;; (funcall (or (gethash condition buffer-match-p-cache)
;;             (puthash condition
;;                      (byte-compile
;;                       `(lambda (,translate-buffer-condition-buffer-sym
;;                                 ,translate-buffer-condition-arg-sym)
;;                          ,(translate-buffer-condition condition)))
;;                      buffer-match-p-cache))
;;         (get-buffer buffer-or-name) arg)
--8<---------------cut here---------------end--------------->8---

In the end, the second implementation using `byte-compile' might be
preferable as it avoids using `eval'.

> João Távora