[elpa] externals/consult 096e895dc5 1/3: Refactor consult-compile-error to precompute markers early

[ELPA Syncer]

branch: externals/consult
commit 096e895dc51457b27107627d6fef66e91268fac1
Author: Daniel Mendler <mail@daniel-mendler.de>
Commit: Daniel Mendler <mail@daniel-mendler.de>

    Refactor consult-compile-error to precompute markers early
    
    See discussion in #526
---
 consult-compile.el | 61 ++++++++++++++++++++++++------------------------------
 consult.el         |  2 +-
 2 files changed, 28 insertions(+), 35 deletions(-)

diff --git a/consult-compile.el b/consult-compile.el
index 3abf9ccaee..1290d7c4c9 100644
--- a/consult-compile.el
+++ b/consult-compile.el
@@ -48,39 +48,33 @@
 (defun consult-compile--error-candidates (buffer)
   "Return alist of errors and positions in BUFFER, a compilation buffer."
   (with-current-buffer buffer
-    (let ((candidates)
-          (pos (point-min)))
+    (let (candidates (pos (point-min)))
       (save-excursion
         (while (setq pos (compilation-next-single-property-change pos 
'compilation-message))
           (when-let (msg (get-text-property pos 'compilation-message))
             (goto-char pos)
-            (push (propertize
-                   (consult-compile--font-lock (consult--buffer-substring pos 
(line-end-position)))
-                   'consult--type (pcase (compilation--message->type msg)
-                                    (0 ?i)
-                                    (1 ?w)
-                                    (_ ?e))
-                   'consult--candidate (point-marker))
-                  candidates))))
+            (let* ((marker (point-marker))
+                   (loc (compilation--message->loc msg))
+                   (dest (consult--position-marker
+                          ;; taken from compile.el
+                          (apply #'compilation-find-file
+                                 marker
+                                 (caar (compilation--loc->file-struct loc))
+                                 (cadar (compilation--loc->file-struct loc))
+                                 (compilation--file-struct->formats
+                                  (compilation--loc->file-struct loc)))
+                          (compilation--loc->line loc)
+                          (compilation--loc->col loc))))
+              (push (propertize
+                     (consult-compile--font-lock (consult--buffer-substring 
pos (line-end-position)))
+                     'consult--type (pcase (compilation--message->type msg)
+                                      (0 ?i)
+                                      (1 ?w)
+                                      (_ ?e))
+                     'consult--candidate (cons marker dest))
+                    candidates)))))
       (nreverse candidates))))
 
-(defun consult-compile--lookup (marker)
-  "Lookup error position given error MARKER."
-  (when-let ((buffer (and marker (marker-buffer marker)))
-             (msg (with-current-buffer buffer (get-text-property marker 
'compilation-message)))
-             (loc (compilation--message->loc msg))
-             (default-directory (buffer-local-value 'default-directory 
buffer)))
-    (consult--position-marker
-     ;; taken from compile.el
-     (apply #'compilation-find-file
-            marker
-            (caar (compilation--loc->file-struct loc))
-            (cadar (compilation--loc->file-struct loc))
-            (compilation--file-struct->formats
-             (compilation--loc->file-struct loc)))
-     (compilation--loc->line loc)
-     (compilation--loc->col loc))))
-
 (defun consult-compile--compilation-buffers (file)
   "Return a list of compilation buffers relevant to FILE."
   (consult--buffer-query
@@ -93,13 +87,12 @@
 (defun consult-compile--state ()
   "Like `consult--jump-state', also setting the current compilation error."
   (let ((state (consult--jump-state 'consult-preview-error)))
-    (lambda (marker restore)
-      (let ((pos (consult-compile--lookup marker)))
-        (when restore
-          (with-current-buffer (marker-buffer marker)
-            (setq compilation-current-error marker
-                  overlay-arrow-position marker)))
-        (funcall state pos restore)))))
+    (pcase-lambda (`(,marker . ,pos) restore)
+      (when-let (buffer (and restore marker (marker-buffer marker)))
+        (with-current-buffer buffer
+          (setq compilation-current-error marker
+                overlay-arrow-position marker)))
+      (funcall state pos restore))))
 
 ;;;###autoload
 (defun consult-compile-error ()
diff --git a/consult.el b/consult.el
index 21e5b442ee..2299c336ef 100644
--- a/consult.el
+++ b/consult.el
@@ -1058,7 +1058,7 @@ tofu-encoded MARKER suffix for disambiguation."
 ;; we cannot use it here since it excludes too much (e.g., invisible)
 ;; and at the same time not enough (e.g., cursor-sensor-functions).
 (defconst consult--remove-text-properties
-  '(category cursor cursor-intangible cursor-sensor-functions field 
follow-link font-lock-face
+  '(category cursor cursor-intangible cursor-sensor-functions field follow-link
     fontified front-sticky help-echo insert-behind-hooks insert-in-front-hooks 
intangible keymap
     local-map modification-hooks mouse-face pointer read-only rear-nonsticky 
yank-handler)
   "List of text properties to remove from buffer strings.")