Function: consult--keep-lines-state

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

Signature

(consult--keep-lines-state FILTER)

Documentation

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

Source Code

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

(defun consult--keep-lines-state (filter)
  "State function for `consult-keep-lines' with FILTER function."
  (let ((font-lock-orig font-lock-mode)
        (whitespace-orig (bound-and-true-p whitespace-mode))
        (hl-line-orig (bound-and-true-p hl-line-mode))
        (point-orig (point))
        lines content-orig replace last-input)
    (if (use-region-p)
        (save-restriction
          ;; Use the same behavior as `keep-lines'.
          (let ((rbeg (region-beginning))
                (rend (save-excursion
                        (goto-char (region-end))
                        (unless (or (bolp) (eobp))
                          (forward-line 0))
                        (point))))
            (consult--fontify-region rbeg rend)
            (narrow-to-region rbeg rend)
            (consult--each-line beg end
              (push (consult--buffer-substring beg end) lines))
            (setq content-orig (buffer-string)
                  replace (lambda (content &optional pos)
                            (delete-region rbeg rend)
                            (insert-before-markers content)
                            (goto-char (or pos rbeg))
                            (setq rend (+ rbeg (length content)))
                            (add-face-text-property rbeg rend 'region t)))))
      ;; Font-locking is lazy, i.e., if a line has not been looked at yet, the
      ;; line is not font-locked. Therefore we have to enforce slow font-locking
      ;; now.  In order to prevent is hang-up we check the region size against
      ;; `consult-fontify-max-size'.
      (when (< (- (point-max) (point-min)) consult-fontify-max-size)
        (consult--fontify-region (point-min) (point-max)))
      (setq content-orig (buffer-string)
            replace (lambda (content &optional pos)
                      (delete-region (point-min) (point-max))
                      (insert content)
                      (goto-char (or pos (point-min)))))
      (consult--each-line beg end
        (push (consult--buffer-substring beg end) lines)))
    (setq lines (nreverse lines))
    (lambda (action input)
      ;; Restoring content and point position
      (when (and (eq action 'return) last-input)
        ;; No undo recording, modification hooks, buffer modified-status
        (with-silent-modifications (funcall replace content-orig point-orig)))
      ;; Committing or new input provided -> Update
      (when (and input ;; Input has been provided
                 (or
                  ;; Committing, but not with empty input
                  (and (eq action 'return) (not (string-match-p "\\`!? ?\\'" input)))
                  ;; Input has changed
                  (not (equal input last-input))))
        (let ((filtered-content
               (if (string-match-p "\\`!? ?\\'" input)
                   ;; Special case the empty input for performance.
                   ;; Otherwise it could happen that the minibuffer is empty,
                   ;; but the buffer has not been updated.
                   content-orig
                 (if (eq action 'return)
                     (apply #'concat (mapcan (lambda (x) (list x "\n"))
                                             (funcall filter input lines)))
                   (while-no-input
                     ;; Heavy computation is interruptible if *not* committing!
                     ;; Allocate new string candidates since the matching function mutates!
                     (apply #'concat (mapcan (lambda (x) (list x "\n"))
                                             (funcall filter input (mapcar #'copy-sequence lines)))))))))
          (when (stringp filtered-content)
            (when font-lock-mode (font-lock-mode -1))
            (when (bound-and-true-p whitespace-mode) (whitespace-mode -1))
            (when (bound-and-true-p hl-line-mode) (hl-line-mode -1))
            (if (eq action 'return)
                (atomic-change-group
                  ;; Disable modification hooks for performance
                  (let ((inhibit-modification-hooks t))
                    (funcall replace filtered-content)))
              ;; No undo recording, modification hooks, buffer modified-status
              (with-silent-modifications
                (funcall replace filtered-content)
                (setq last-input input))))))
      ;; Restore modes
      (when (eq action 'return)
        (when hl-line-orig (hl-line-mode 1))
        (when whitespace-orig (whitespace-mode 1))
        (when font-lock-orig (font-lock-mode 1))))))