Function: embark-consult-export-location-occur

embark-consult-export-location-occur is a natively compiled function defined in embark-consult.el.

Signature

(embark-consult-export-location-occur LINES)

Documentation

Create an occur mode buffer listing LINES.

The elements of LINES should be completion candidates with category consult-line.

Source Code

;; Defined in /nix/store/9j1lpwknj0cd46jf87pww3rp6rcmnk70-emacs-packages-deps/share/emacs/site-lisp/elpa/embark-consult-20260503.118/embark-consult.el
(defun embark-consult-export-location-occur (lines)
  "Create an occur mode buffer listing LINES.
The elements of LINES should be completion candidates with
category `consult-line'."
  (let ((buf (generate-new-buffer "*Embark Export Occur*"))
        (mouse-msg "mouse-2: go to this occurrence")
        (inhibit-read-only t)
        (affixator (embark--get-affixator 'consult-location))
        last-buf)
    ;; Run affixator for lazy highlighting
    (setq lines (mapcar #'car (funcall affixator lines)))
    (with-current-buffer buf
      (dolist (line lines)
        (pcase-let*
            ((`(,loc . ,num) (consult--get-location line))
             ;; the text properties added to the following strings are
             ;; taken from occur-engine
             (lineno (propertize
                      (format "%7d:" num)
                      'occur-prefix t
                      ;; Allow insertion of text at the end
                      ;; of the prefix (for Occur Edit mode).
                      'front-sticky t
                      'rear-nonsticky t
                      'read-only t
                      'occur-target loc
                      'follow-link t
                      'help-echo mouse-msg
                      'font-lock-face list-matching-lines-prefix-face
                      'mouse-face 'highlight))
             (contents (propertize (embark-consult--strip line)
                                   'occur-target loc
                                   'occur-match t
                                   'follow-link t
                                   'help-echo mouse-msg
                                   'mouse-face 'highlight))
             (nl (propertize "\n" 'occur-target loc))
             (this-buf (marker-buffer loc)))
          (unless (eq this-buf last-buf)
            (insert (propertize
                     (format "lines from buffer: %s\n" this-buf)
                     'face list-matching-lines-buffer-name-face
                     'read-only t))
            (setq last-buf this-buf))
          (insert lineno contents nl)))
      (goto-char (point-min))
      ;; Make this buffer current for next/previous-error
      (setq next-error-last-buffer buf)
      (occur-mode))
    (pop-to-buffer buf)))