Implement parser interruption on user input

phpinspect-buffer.el

@@ -55,6 +55,7 @@ linked with."
         (let* ((map (phpinspect-make-bmap))
                (buffer-map (phpinspect-buffer-map buffer))
                (ctx (phpinspect-make-pctx
+                     :interrupt-predicate #'input-pending-p
                      :bmap map
                      :incremental t
                      :previous-bmap buffer-map
@@ -81,6 +82,16 @@ linked with."
 
 (cl-defmethod phpinspect-buffer-register-edit
   ((buffer phpinspect-buffer) (start integer) (end integer) (pre-change-length integer))
+  "Mark a region of the buffer as edited."
+
+  ;; Take into account "atoms" (tokens without clear delimiters like words,
+  ;; variables and object attributes. The meaning of these tokens will change as
+  ;; they grow or shrink, so their ful regions need to be marked for a reparse).
+  (save-excursion
+    (goto-char start)
+    (when (looking-back "\\($->|::\\)?[^][)(}{[:blank:]\n;'\"]+" nil t)
+      (setq start (- start (length (match-string 0))))))
+
   (phpinspect-edtrack-register-edit
    (phpinspect-buffer-edit-tracker buffer) start end pre-change-length))
 

phpinspect-parser.el

@@ -37,6 +37,69 @@
   (define-inline phpinspect--word-end-regex ()
     (inline-quote "\\([[:blank:]]\\|[^0-9a-zA-Z_]\\)")))
 
+(defvar phpinspect-parse-context nil
+  "An instance of `phpinspect-pctx' that is used when
+parsing. Usually used in combination with
+`phpinspect-with-parse-context'")
+
+(defmacro phpinspect-with-parse-context (ctx &rest body)
+  (declare (indent 1))
+  (let ((old-ctx phpinspect-parse-context))
+    `(unwind-protect
+         (progn
+           (setq phpinspect-parse-context ,ctx)
+           ,@body)
+       (setq phpinspect-parse-context ,old-ctx))))
+
+(cl-defstruct (phpinspect-pctx (:constructor phpinspect-make-pctx))
+  "Parser Context"
+  (incremental nil)
+  (interrupt-threshold (time-convert '(2 . 1000))
+                       :documentation
+                       "After how much time `interrupt-predicate'
+should be polled. This is 2ms by default.")
+  (-start-time nil
+               :documentation "The time at which the parse started.
+This variable is for private use and not always set.")
+  (interrupt-predicate nil
+                      :documentation
+                      "A function that is called in intervals during parsing when
+set. If this function returns a non-nil value, the parse process
+is interrupted and the symbol `phpinspect-parse-interrupted' is
+thrown.")
+  (edtrack nil
+           :type phpinspect-edtrack)
+  (bmap (phpinspect-make-bmap)
+        :type phpinspect-bmap)
+  (previous-bmap nil
+                 :type phpinspect-bmap)
+  (whitespace-before ""
+                     :type string))
+
+(defsubst phpinspect-pctx-check-interrupt (pctx)
+  (unless (phpinspect-pctx--start-time pctx)
+    (setf (phpinspect-pctx--start-time pctx) (time-convert nil)))
+
+  ;; Interrupt when blocking too long while input is pending.
+  (when (and (time-less-p (phpinspect-pctx-interrupt-threshold pctx)
+                          (time-since (phpinspect-pctx--start-time pctx)))
+             (funcall (phpinspect-pctx-interrupt-predicate pctx)))
+    (throw 'phpinspect-parse-interrupted nil)))
+
+
+
+(defsubst phpinspect-pctx-register-token (pctx token start end)
+  (phpinspect-bmap-register
+   (phpinspect-pctx-bmap pctx) start end token (phpinspect-pctx-consume-whitespace pctx)))
+
+(defsubst phpinspect-pctx-register-whitespace (pctx whitespace)
+  (setf (phpinspect-pctx-whitespace-before pctx) whitespace))
+
+(defsubst phpinspect-pctx-consume-whitespace (pctx)
+  (let ((whitespace (phpinspect-pctx-whitespace-before pctx)))
+    (setf (phpinspect-pctx-whitespace-before pctx) "")
+    whitespace))
+
 (defun phpinspect-list-handlers ()
   (let ((handlers))
     (mapatoms (lambda (handler)
@@ -370,9 +433,14 @@ parser function is then returned in byte-compiled form."
 
     (if (and phpinspect-parse-context
              (phpinspect-pctx-incremental phpinspect-parse-context))
+
         (let ((func (phpinspect-parser-compile-incremental (symbol-value parser-symbol))))
+          (if (phpinspect-pctx-interrupt-predicate phpinspect-parse-context)
+              (lambda (&rest arguments)
+                (phpinspect-pctx-check-interrupt phpinspect-parse-context)
+                (apply func phpinspect-parse-context arguments))
             (lambda (&rest arguments)
-            (apply func phpinspect-parse-context arguments)))
+              (apply func phpinspect-parse-context arguments))))
       (or (symbol-function parser-symbol)
           (defalias parser-symbol
             (phpinspect-parser-compile (symbol-value parser-symbol)))))))
@@ -457,43 +525,6 @@ token is \";\", which marks the end of a statement in PHP."
            ;; Return
            tokens)))))
 
-(defvar phpinspect-parse-context nil
-  "An instance of `phpinspect-pctx' that is used when
-parsing. Usually used in combination with
-`phpinspect-with-parse-context'")
-
-(defmacro phpinspect-with-parse-context (ctx &rest body)
-  (declare (indent 1))
-  (let ((old-ctx phpinspect-parse-context))
-    `(unwind-protect
-         (progn
-           (setq phpinspect-parse-context ,ctx)
-           ,@body)
-       (setq phpinspect-parse-context ,old-ctx))))
-
-(cl-defstruct (phpinspect-pctx (:constructor phpinspect-make-pctx))
-  "Parser Context"
-  (incremental nil)
-  (edtrack nil
-           :type phpinspect-edtrack)
-  (bmap (phpinspect-make-bmap)
-        :type phpinspect-bmap)
-  (previous-bmap nil
-                 :type phpinspect-bmap)
-  (whitespace-before ""
-                     :type string))
-
-(defsubst phpinspect-pctx-register-token (pctx token start end)
-  (phpinspect-bmap-register
-   (phpinspect-pctx-bmap pctx) start end token (phpinspect-pctx-consume-whitespace pctx)))
-
-(defsubst phpinspect-pctx-register-whitespace (pctx whitespace)
-  (setf (phpinspect-pctx-whitespace-before pctx) whitespace))
-
-(defsubst phpinspect-pctx-consume-whitespace (pctx)
-  (let ((whitespace (phpinspect-pctx-whitespace-before pctx)))
-    (setf (phpinspect-pctx-whitespace-before pctx) "")
-    whitespace))
 
 (defun phpinspect-make-incremental-parser-function (tree-type handler-list &optional delimiter-predicate)
   "Like `phpinspect-make-parser-function', but returned function is able to reuse an already parsed tree."
@@ -516,6 +547,7 @@ parsing. Usually used in combination with
                 (previous-bmap (phpinspect-pctx-previous-bmap context))
                 (edtrack (phpinspect-pctx-edtrack context))
                 (taint-iterator (when edtrack (phpinspect-edtrack-make-taint-iterator edtrack)))
+                (check-interrupt (phpinspect-pctx-interrupt-predicate context))
 
                 ;; Loop variables
                 (start-position)
@@ -551,6 +583,9 @@ parsing. Usually used in combination with
 
                      (goto-char current-end-position)
 
+                     (when check-interrupt
+                       (phpinspect-pctx-check-interrupt context))
+
                      ;; Skip over whitespace after so that we don't do a full
                      ;; run down all of the handlers during the next iteration
                      (when (looking-at (phpinspect-handler-regexp 'whitespace))

phpinspect.el

@@ -282,6 +282,7 @@ TODO:
  - Respect `eldoc-echo-area-use-multiline-p`
  - This function is too big and has repetitive code. Split up and simplify.
 "
+  (catch 'phpinspect-parse-interrupted
     (let* ((token-map (phpinspect-buffer-parse-map phpinspect-current-buffer))
            (resolvecontext (phpinspect-get-resolvecontext token-map (point)))
            (parent-token (car (phpinspect--resolvecontext-enclosing-tokens
@@ -362,7 +363,7 @@ TODO:
                         ", ")
                        "): "
                        (phpinspect--format-type-name
-                      (phpinspect--function-return-type method)))))))))
+                        (phpinspect--function-return-type method))))))))))
 
 (cl-defstruct (phpinspect--assignment
                (:constructor phpinspect--make-assignment))
@@ -974,9 +975,6 @@ level of a token. Nested variables are ignored."
     (resolvecontext &optional static)
   "Suggest object or class attributes at point.
 
-TOKEN-TREE must be a syntax tree containing enough context to
-infer the types of the preceding statements
-
 RESOLVECONTEXT must be a structure of the type
 `phpinspect--resolvecontext'.  The PHP type of its subject is
 resolved to provide completion candidates.
@@ -1097,6 +1095,7 @@ static variables and static methods."
                           arg)))
       (insert "(")))
    ((eq command 'candidates)
+    (catch 'phpinspect-parse-interrupted
       (let ((completion-list (phpinspect--make-completion-list))
             (candidates))
         (dolist (completion (phpinspect--suggest-at-point))
@@ -1112,7 +1111,7 @@ static variables and static methods."
                           (phpinspect--completion-list-strings
                            completion-list)))
         (setq phpinspect--last-completion-list completion-list)
-      candidates))
+        candidates)))
    ((eq command 'annotation)
     (concat " " (phpinspect--completion-annotation
                  (phpinspect--completion-list-get-metadata