Function: consult--focus-lines-state

consult--focus-lines-state is a byte-compiled function defined in consult.el.

Signature

(consult--focus-lines-state FILTER)

Documentation

State function for consult-focus-lines with FILTER function.

Source Code

;; Defined in ~/.emacs.d/elpa/consult-20260805.1130/consult.el
;;;;; Command: consult-focus-lines

(defun consult--focus-lines-state (filter)
  "State function for `consult-focus-lines' with FILTER function."
  (let (lines overlays last-input pt-orig pt-min pt-max)
    (save-excursion
      (save-restriction
        (when (use-region-p)
          (narrow-to-region
           (region-beginning)
           ;; Behave the same as `keep-lines'.
           ;; Move to the next line.
           (save-excursion
             (goto-char (region-end))
             (unless (or (bolp) (eobp))
               (forward-line 0))
             (point))))
        (setq pt-orig (point) pt-min (point-min) pt-max (point-max))
        (let ((i 0))
          (consult--each-line beg end
            ;; Use "\n" for empty lines, since we need a non-empty string to
            ;; attach the text property to.
            (let ((line (if (eq beg end) (char-to-string ?\n)
                          (buffer-substring-no-properties beg end))))
              (put-text-property 0 1 'consult--focus-line (cons (incf i) beg) line)
              (push line lines)))
          (setq lines (nreverse lines)))))
    (lambda (action input)
      ;; New input provided -> Update
      (when (and input (not (equal input last-input)))
        (let (new-overlays)
          (pcase (while-no-input
                   (unless (string-match-p "\\`!? ?\\'" input) ;; Empty input.
                     (let* ((inhibit-quit (eq action 'return)) ;; Non interruptible, when quitting!
                            (not (string-prefix-p "! " input))
                            (stripped (string-remove-prefix "! " input))
                            (matches (funcall filter stripped lines))
                            (old-ind 0)
                            (block-beg pt-min)
                            (block-end pt-min))
                       (while old-ind
                         (let ((match (pop matches)) (ind nil) (beg pt-max) (end pt-max) prop)
                           (when match
                             (setq prop (get-text-property 0 'consult--focus-line match)
                                   ind (car prop)
                                   beg (cdr prop)
                                   ;; Check for empty lines, see above.
                                   end (+ 1 beg (if (equal match "\n") 0 (length match)))))
                           (unless (eq ind (1+ old-ind))
                             (let ((a (if not block-beg block-end))
                                   (b (if not block-end beg)))
                               (when (/= a b)
                                 (push (consult--make-overlay a b 'invisible t) new-overlays)))
                             (setq block-beg beg))
                           (setq block-end end old-ind ind)))))
                   'commit)
            ('commit
             (mapc #'delete-overlay overlays)
             (setq last-input input overlays new-overlays))
            (_ (mapc #'delete-overlay new-overlays)))))
      (when (eq action 'return)
        (cond
         ((not input)
          (mapc #'delete-overlay overlays)
          (goto-char pt-orig))
         ((equal input "")
          (consult-focus-lines nil 'show)
          (goto-char pt-orig))
         (t
          ;; Successfully terminated -> Remember invisible overlays
          (cl-callf nconc consult--focus-lines-overlays overlays)
          ;; move point past invisible
          (goto-char (if-let* ((ov (and (invisible-p pt-orig)
                                        (seq-find (lambda (ov) (overlay-get ov 'invisible))
                                                  (overlays-at pt-orig)))))
                         (overlay-end ov)
                       pt-orig))))))))