feature/android f33f3b973a4: Merge remote-tracking branch 'origin/master' into feature/android

[Po Lu]

branch: feature/android
commit f33f3b973a413e51d3f69e9e1efdd3227a5975f3
Merge: 6d86ded5442 c9c0d1cf7f6
Author: Po Lu <luangruo@yahoo.com>
Commit: Po Lu <luangruo@yahoo.com>

    Merge remote-tracking branch 'origin/master' into feature/android
---
 etc/EGLOT-NEWS              | 10 ++++++++++
 lisp/emacs-lisp/bytecomp.el | 24 ++----------------------
 lisp/progmodes/eglot.el     | 38 +++++++++++++++++++++++++-------------
 3 files changed, 37 insertions(+), 35 deletions(-)

diff --git a/etc/EGLOT-NEWS b/etc/EGLOT-NEWS
index 569481a8dc1..6a2e9051ddc 100644
--- a/etc/EGLOT-NEWS
+++ b/etc/EGLOT-NEWS
@@ -18,6 +18,16 @@ to look up issue github#1234, go to
 https://github.com/joaotavora/eglot/issues/1234.
 
 
+* Changes in upcoming Eglot
+
+** Optimized file-watching capability
+
+Some servers, like the Pyright language server, issue too many file
+watching requests.  This change slightly reduces the number of file
+watcher objects requested from the operating system, which can be a
+problem, particularly on Mac OS.  See github#1228 and github#1226.
+
+
 * Changes in Eglot 1.15 (29/4/2023)
 
 ** Fix LSP "languageId" detection
diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el
index 384a357ee51..4cf244aedbf 100644
--- a/lisp/emacs-lisp/bytecomp.el
+++ b/lisp/emacs-lisp/bytecomp.el
@@ -3560,7 +3560,7 @@ lambda-expression."
          ;; These functions are side-effect-free except for the
          ;; behaviour of functions passed as argument.
          mapcar mapcan mapconcat
-         assoc assoc-string plist-get plist-member
+         assoc plist-get plist-member
 
          ;; It's safe to ignore the value of `sort' and `nreverse'
          ;; when used on arrays, but most calls pass lists.
@@ -3962,6 +3962,7 @@ If it is nil, then the handler is 
\"byte-compile-SYMBOL.\""
 (byte-defop-compiler cons              2)
 (byte-defop-compiler aref              2)
 (byte-defop-compiler set               2)
+(byte-defop-compiler fset              2)
 (byte-defop-compiler (= byte-eqlsign)  2-cmp)
 (byte-defop-compiler (< byte-lss)      2-cmp)
 (byte-defop-compiler (> byte-gtr)      2-cmp)
@@ -4226,7 +4227,6 @@ This function is never called when `lexical-binding' is 
nil."
 (byte-defop-compiler backward-word)
 (byte-defop-compiler list)
 (byte-defop-compiler concat)
-(byte-defop-compiler fset)
 (byte-defop-compiler (indent-to-column byte-indent-to) byte-compile-indent-to)
 (byte-defop-compiler indent-to)
 (byte-defop-compiler insert)
@@ -4323,26 +4323,6 @@ This function is never called when `lexical-binding' is 
nil."
             (byte-compile-form (car form))
             (byte-compile-out 'byte-nconc 0))))))
 
-(defun byte-compile-fset (form)
-  ;; warn about forms like (fset 'foo '(lambda () ...))
-  ;; (where the lambda expression is non-trivial...)
-  (let ((fn (nth 2 form))
-       body)
-    (if (and (eq (car-safe fn) 'quote)
-            (eq (car-safe (setq fn (nth 1 fn))) 'lambda))
-       (progn
-         (setq body (cdr (cdr fn)))
-         (if (stringp (car body)) (setq body (cdr body)))
-         (if (eq 'interactive (car-safe (car body))) (setq body (cdr body)))
-         (if (and (consp (car body))
-                  (not (eq 'byte-code (car (car body)))))
-             (byte-compile-warn-x
-               (nth 2 form)
-      "A quoted lambda form is the second argument of `fset'.  This is probably
-     not what you want, as that lambda cannot be compiled.  Consider using
-     the syntax #'(lambda (...) ...) instead.")))))
-  (byte-compile-two-args form))
-
 ;; (function foo) must compile like 'foo, not like (symbol-function 'foo).
 ;; Otherwise it will be incompatible with the interpreter,
 ;; and (funcall (function foo)) will lose with autoloads.
diff --git a/lisp/progmodes/eglot.el b/lisp/progmodes/eglot.el
index 0140db0c4b3..c5a58d7ace6 100644
--- a/lisp/progmodes/eglot.el
+++ b/lisp/progmodes/eglot.el
@@ -888,7 +888,7 @@ ACTION is an LSP object of either `CodeAction' or `Command' 
type."
     :documentation "Generalized boolean inhibiting auto-reconnection if true."
     :accessor eglot--inhibit-autoreconnect)
    (file-watches
-    :documentation "Map ID to list of WATCHES for `didChangeWatchedFiles'."
+    :documentation "Map (DIR -> (WATCH ID1 ID2...)) for 
`didChangeWatchedFiles'."
     :initform (make-hash-table :test #'equal) :accessor eglot--file-watches)
    (managed-buffers
     :documentation "List of buffers managed by server."
@@ -959,8 +959,8 @@ PRESERVE-BUFFERS as in `eglot-shutdown', which see."
           (eglot-autoshutdown nil))
       (eglot--when-live-buffer buffer (eglot--managed-mode-off))))
   ;; Kill any expensive watches
-  (maphash (lambda (_id watches)
-             (mapcar #'file-notify-rm-watch watches))
+  (maphash (lambda (_dir watch-and-ids)
+             (file-notify-rm-watch (car watch-and-ids)))
            (eglot--file-watches server))
   ;; Kill any autostarted inferior processes
   (when-let (proc (eglot--inferior-process server))
@@ -3543,8 +3543,7 @@ at point.  With prefix argument, prompt for ACTION-KIND."
                                (project-files
                                 (eglot--project server))))))
     (cl-labels
-        ((handle-event
-           (event)
+        ((handle-event (event)
            (pcase-let* ((`(,desc ,action ,file ,file1) event)
                         (action-type (cl-case action
                                        (created 1) (changed 2) (deleted 3)))
@@ -3558,16 +3557,24 @@ at point.  With prefix argument, prompt for 
ACTION-KIND."
                (jsonrpc-notify
                 server :workspace/didChangeWatchedFiles
                 `(:changes ,(vector `(:uri ,(eglot--path-to-uri file)
-                                           :type ,action-type)))))
+                                           :type ,action-type))))
+               (when (and (eq action 'created)
+                          (file-directory-p file))
+                 (watch-dir file)))
               ((eq action 'renamed)
                (handle-event `(,desc 'deleted ,file))
-               (handle-event `(,desc 'created ,file1)))))))
+               (handle-event `(,desc 'created ,file1))))))
+         (watch-dir (dir)
+           (when-let ((probe
+                       (and (file-readable-p dir)
+                            (or (gethash dir (eglot--file-watches server))
+                                (puthash dir (list (file-notify-add-watch
+                                                    dir '(change) 
#'handle-event))
+                                         (eglot--file-watches server))))))
+             (push id (cdr probe)))))
       (unwind-protect
           (progn
-            (dolist (dir dirs-to-watch)
-              (when (file-readable-p dir)
-                (push (file-notify-add-watch dir '(change) #'handle-event)
-                      (gethash id (eglot--file-watches server)))))
+            (mapc #'watch-dir dirs-to-watch)
             (setq
              success
              `(:message ,(format "OK, watching %s directories in %s watchers"
@@ -3578,8 +3585,13 @@ at point.  With prefix argument, prompt for ACTION-KIND."
 (cl-defmethod eglot-unregister-capability
   (server (_method (eql workspace/didChangeWatchedFiles)) id)
   "Handle dynamic unregistration of workspace/didChangeWatchedFiles."
-  (mapc #'file-notify-rm-watch (gethash id (eglot--file-watches server)))
-  (remhash id (eglot--file-watches server))
+  (maphash (lambda (dir watch-and-ids)
+             (when (member id (cdr watch-and-ids))
+               (setcdr watch-and-ids (delete id (cdr watch-and-ids)))
+               (when (null (cdr watch-and-ids))
+                 (file-notify-rm-watch (car watch-and-ids))
+                 (remhash dir (eglot--file-watches server)))))
+           (eglot--file-watches server))
   (list t "OK"))