[elpa] externals/consult 4555cf3d34 2/3: Revert "Refactor consult-compile-error to precompute markers early"

[ELPA Syncer]

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

    Revert "Refactor consult-compile-error to precompute markers early"
    
    This reverts commit 096e895dc51457b27107627d6fef66e91268fac1.
---
 consult-compile.el | 61 ++++++++++++++++++++++++++++++------------------------
 consult.el         |  2 +-
 2 files changed, 35 insertions(+), 28 deletions(-)

diff --git a/consult-compile.el b/consult-compile.el
index 1290d7c4c9..3abf9ccaee 100644
--- a/consult-compile.el
+++ b/consult-compile.el
@@ -48,33 +48,39 @@
 (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)
-            (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)))))
+            (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))))
       (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
@@ -87,12 +93,13 @@
 (defun consult-compile--state ()
   "Like `consult--jump-state', also setting the current compilation error."
   (let ((state (consult--jump-state 'consult-preview-error)))
-    (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))))
+    (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)))))
 
 ;;;###autoload
 (defun consult-compile-error ()
diff --git a/consult.el b/consult.el
index 2299c336ef..21e5b442ee 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
+  '(category cursor cursor-intangible cursor-sensor-functions field 
follow-link font-lock-face
     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.")