branch: externals/phpinspect
commit f9f3440850519e0366c1307ea6cffc4fb2f7b6da
Author: Hugo Thunnissen <de...@hugot.nl>
Commit: Hugo Thunnissen <de...@hugot.nl>

    Make file contents insertion asynchronous in background threads
    
    This allows for a more lenient pausing regime in the worker thread, as file
    content insertion, which is the longest running action while indexing, no 
longer
    makes the main thread wait.
    
    Implementation uses host system's cat program, but defers to
    insert-file-contents when this is not available.
---
 phpinspect-fs.el      | 58 +++++++++++++++++++++++++++++++++++++++++++++++----
 phpinspect-index.el   | 23 --------------------
 phpinspect-project.el | 46 ++++++++++++++++++++++++++++++++++++++++
 phpinspect-worker.el  |  7 ++++---
 phpinspect.el         | 20 ++++--------------
 5 files changed, 108 insertions(+), 46 deletions(-)

diff --git a/phpinspect-fs.el b/phpinspect-fs.el
index 2178f78d57..d87a025702 100644
--- a/phpinspect-fs.el
+++ b/phpinspect-fs.el
@@ -23,6 +23,9 @@
 
 ;;; Code:
 
+(defconst phpinspect--cat-executable (executable-find "cat")
+  "The executable used to read files asynchronously from the filesystem.")
+
 (cl-defstruct (phpinspect-fs (:constructor phpinspect-make-fs)))
 
 (cl-defstruct (phpinspect-virtual-fs (:constructor phpinspect-make-virtual-fs))
@@ -47,7 +50,14 @@
 (cl-defgeneric phpinspect-fs-file-exists-p (fs file))
 (cl-defgeneric phpinspect-fs-file-directory-p (fs file))
 (cl-defgeneric phpinspect-fs-file-modification-time (fs file))
-(cl-defgeneric phpinspect-fs-insert-file-contents (fs file))
+(cl-defgeneric phpinspect-fs-insert-file-contents (fs file &optional 
prefer-async)
+  "Insert file contents of FILE.
+
+When PREFER-ASYNC is set and FS supports it, effort is made to
+execute the insertion asynchronously in scenario's where this can
+prevent the main thread (or other running threads) from stalling
+while the current thread executes. When running in the main
+thread, PREFER-ASYNC has no effect.")
 (cl-defgeneric phpinspect-fs-directory-files (fs directory match))
 (cl-defgeneric phpinspect-fs-directory-files-recursively (fs directory match))
 
@@ -81,10 +91,50 @@
     (when attributes
       (file-attribute-modification-time attributes))))
 
-(cl-defmethod phpinspect-fs-insert-file-contents ((fs phpinspect-fs) file)
-  (insert-file-contents-literally file))
 
-(cl-defmethod phpinspect-fs-insert-file-contents ((fs phpinspect-virtual-fs) 
file)
+(defsubst phpinspect--insert-file-contents-asynchronously (file)
+  "Inserts FILE contents into the current buffer asynchronously, while 
blocking the current thread.
+
+Errors when executed in main thread, as it should be used to make
+background operations less invasive. Usage in the main thread can
+only be the result of a logic error."
+  (let* ((thread (current-thread))
+         (mx (make-mutex))
+         (condition (make-condition-variable mx))
+         (err)
+         (sentinel
+          (lambda (process event)
+            (with-mutex mx
+              (if (string-match-p 
"^\\(deleted\\|exited\\|failed\\|connection\\)" event)
+                  (progn
+                    (setq err (format "cat process %s failed with event: %s" 
process event))
+                    (condition-notify condition))
+                (when (string-match-p "^finished" event)
+                  (condition-notify condition)))))))
+    (when (not phpinspect--cat-executable)
+      (error
+       "ERROR: phpinspect--insert-file-contents-asynchronously called when 
cat-executable is not set"))
+
+    (when (eq thread main-thread)
+      (error "ERROR: phpinspect--insert-file-contents-asynchronously called 
from main-thread"))
+
+    (with-mutex mx
+      (make-process :name "phpinspect--insert-file-contents-asynchronously"
+                    :command `(,phpinspect--cat-executable ,file)
+                    :buffer (current-buffer)
+                    :sentinel sentinel)
+
+      (condition-wait condition)
+      (when err (error err)))))
+
+(cl-defmethod phpinspect-fs-insert-file-contents ((fs phpinspect-fs) file 
&optional prefer-async)
+  "Insert file contents from FILE. "
+  (if (and prefer-async (not (eq (current-thread) main-thread))
+           phpinspect--cat-executable)
+      (phpinspect--insert-file-contents-asynchronously file)
+    (insert-file-contents-literally file)))
+
+(cl-defmethod phpinspect-fs-insert-file-contents ((fs phpinspect-virtual-fs) 
file &optional _ignored)
   (let ((file-obj (gethash file (phpinspect-virtual-fs-files fs))))
     (when file (insert (or (phpinspect-virtual-file-contents file-obj) "")))))
 
diff --git a/phpinspect-index.el b/phpinspect-index.el
index d6188fc4a3..e247877843 100644
--- a/phpinspect-index.el
+++ b/phpinspect-index.el
@@ -454,9 +454,6 @@ Return value is a list of the types that are \"newed\"."
     ;; TODO: Implement function indexation
     ))
 
-(defun phpinspect-index-file (file-name)
-  (phpinspect--index-tokens (phpinspect-parse-file file-name)))
-
 (defun phpinspect-get-or-create-cached-project-class (project-root class-fqn)
   (when project-root
     (let ((project (phpinspect--cache-get-project-create
@@ -464,29 +461,9 @@ Return value is a list of the types that are \"newed\"."
                     project-root)))
       (phpinspect-project-get-class-create project class-fqn))))
 
-(defun phpinspect--index-current-buffer ()
-  (phpinspect--index-tokens (phpinspect-parse-current-buffer)))
-
 (defun phpinspect-index-current-buffer ()
   "Index a PHP file for classes and the methods they have"
   (phpinspect--index-tokens (phpinspect-parse-current-buffer)))
 
-(cl-defmethod phpinspect--index-type-file ((project phpinspect-project)
-                                           (type phpinspect--type))
-  (condition-case error
-      (let* ((class-file (with-temp-buffer
-                           (cd (phpinspect-project-root project))
-                           (phpinspect-type-filepath type)))
-             (visited-buffer (when class-file (find-buffer-visiting 
class-file)))
-             (new-index)
-             (class-index))
-        (when class-file
-          (if visited-buffer
-              (with-current-buffer visited-buffer 
(phpinspect--index-current-buffer))
-            (phpinspect-index-file class-file))))
-    (file-missing
-     (phpinspect--log "Failed to find file for type %s:  %s" type error)
-     nil)))
-
 (provide 'phpinspect-index)
 ;;; phpinspect-index.el ends here
diff --git a/phpinspect-project.el b/phpinspect-project.el
index 030116be86..f60a20cf8a 100644
--- a/phpinspect-project.el
+++ b/phpinspect-project.el
@@ -171,5 +171,51 @@ indexed by the absolute paths of the files they're 
watching."))
   (gethash (phpinspect--type-name-symbol class-fqn)
            (phpinspect-project-class-index project)))
 
+(cl-defmethod phpinspect-project-get-type-filepath
+  ((project phpinspect-project) (type phpinspect--type) &optional index-new)
+  "Retrieve filepath to TYPE definition file.
+
+when INDEX-NEW is non-nil, new files are added to the index
+before the search is executed."
+  (let* ((autoloader (phpinspect-project-autoload project)))
+    (when (eq index-new 'index-new)
+      (phpinspect-autoloader-refresh autoloader))
+    (let* ((result (phpinspect-autoloader-resolve
+                    autoloader (phpinspect--type-name-symbol type))))
+      (if (not result)
+          ;; Index new files and try again if not done already.
+          (if (eq index-new 'index-new)
+              nil
+            (when phpinspect-auto-reindex
+              (phpinspect--log "Failed finding filepath for type %s. Retrying 
with reindex."
+                               (phpinspect--type-name type))
+              (phpinspect-project-get-type-filepath project type 'index-new)))
+        result))))
+
+(cl-defmethod phpinspect-project-index-type-file
+  ((project phpinspect-project) (type phpinspect--type))
+  "Index the file that TYPE is expected to be defined in."
+
+  (condition-case error
+      (let* ((file (phpinspect-project-get-type-filepath project type))
+             (visited-buffer (when file (find-buffer-visiting file)))
+             (new-index)
+             (class-index))
+        (when file
+          (if visited-buffer
+              (with-current-buffer visited-buffer 
(phpinspect-index-current-buffer))
+            (with-temp-buffer (phpinspect-project-index-file project file)))))
+    (file-missing
+     (phpinspect--log "Failed to find file for type %s:  %s" type error)
+     nil)))
+
+(cl-defmethod phpinspect-project-index-file
+  ((project phpinspect-project) (filename string))
+  "Index "
+  (let ((fs (phpinspect-project-fs project)))
+    (with-temp-buffer
+      (phpinspect-fs-insert-file-contents fs filename 'prefer-async)
+      (phpinspect-index-current-buffer))))
+
 (provide 'phpinspect-project)
 ;;; phpinspect-project.el ends here
diff --git a/phpinspect-worker.el b/phpinspect-worker.el
index ecb428456a..e57776e3a6 100644
--- a/phpinspect-worker.el
+++ b/phpinspect-worker.el
@@ -162,7 +162,7 @@ BODY can be any form."
                     :type bool
                     :documentation
                     "Whether or not the thread should continue
-running. If this is nil, the thread isstopped.")
+running. If this is nil, the thread is stopped.")
   (skip-next-pause nil
                    :type bool
                    :documentation
@@ -274,7 +274,8 @@ CONTINUE must be a condition-variable"
 
           ;; Pause for a second after indexing something, to allow user input 
to
           ;; interrupt the thread.
-          (unless (phpinspect-worker-skip-next-pause worker)
+          (unless (or (not (input-pending-p))
+                      (phpinspect-worker-skip-next-pause worker))
             (phpinspect-thread-pause 1 mx continue))
           (setf (phpinspect-worker-skip-next-pause worker) nil))))
     (phpinspect--log "Worker thread exiting")
@@ -354,7 +355,7 @@ CONTINUE must be a condition-variable"
            (setf (phpinspect-worker-skip-next-pause worker) t))
           (t
            (let* ((type (phpinspect-index-task-type task))
-                  (root-index (phpinspect--index-type-file project type)))
+                  (root-index (phpinspect-project-index-type-file project 
type)))
              (when root-index
                (phpinspect-project-add-index project root-index)))))))
 
diff --git a/phpinspect.el b/phpinspect.el
index b5512cf7e1..537e3f3a6c 100644
--- a/phpinspect.el
+++ b/phpinspect.el
@@ -824,7 +824,7 @@ Assuming that files are only changed from within Emacs, this
 keeps the cache valid.  If changes are made outside of Emacs,
 users will have to use \\[phpinspect-purge-cache]."
   (when (and (boundp 'phpinspect-mode) phpinspect-mode)
-    (setq phpinspect--buffer-index (phpinspect--index-current-buffer))
+    (setq phpinspect--buffer-index (phpinspect-index-current-buffer))
     (let ((imports (alist-get 'imports phpinspect--buffer-index))
           (project (phpinspect--cache-get-project-create
                     (phpinspect--get-or-create-global-cache)
@@ -1298,21 +1298,9 @@ when INDEX-NEW is non-nil, new files are added to the 
index
 before the search is executed."
   (let* ((project (phpinspect--cache-get-project-create
                    (phpinspect--get-or-create-global-cache)
-                   (phpinspect-current-project-root)))
-         (autoloader (phpinspect-project-autoload project)))
-    (when (eq index-new 'index-new)
-      (phpinspect-autoloader-refresh autoloader))
-    (let* ((result (phpinspect-autoloader-resolve
-                    autoloader (phpinspect--type-name-symbol class))))
-      (if (not result)
-          ;; Index new files and try again if not done already.
-          (if (eq index-new 'index-new)
-              nil
-            (when phpinspect-auto-reindex
-              (phpinspect--log "Failed finding filepath for type %s. Retrying 
with reindex."
-                               (phpinspect--type-name class))
-              (phpinspect-get-class-filepath class 'index-new)))
-        result))))
+                   (phpinspect-current-project-root))))
+    (phpinspect-project-get-type-filepath project class index-new)))
+
 
 (defun phpinspect-unique-strings (strings)
   (seq-filter

Reply via email to