[elpa] externals/consult 0923786304: consult-outline: New prefix argument for initial narrowing level (Fix #839)

[ELPA Syncer]

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

    consult-outline: New prefix argument for initial narrowing level (Fix #839)
---
 CHANGELOG.org |  3 ++-
 consult.el    | 19 ++++++++++++-------
 2 files changed, 14 insertions(+), 8 deletions(-)

diff --git a/CHANGELOG.org b/CHANGELOG.org
index 241b114b21..960fb2c2b2 100644
--- a/CHANGELOG.org
+++ b/CHANGELOG.org
@@ -4,7 +4,8 @@
 
 * Development
 
-- Add =consult-fd= based on the fast =fd/fdfind= search utility.
+- =consult-fd=: New command based on the fast =fd/fdfind= search utility.
+- =consult-outline=: New prefix argument to specify initial narrowing level.
 
 * Version 0.35 (2023-07-02)
 
diff --git a/consult.el b/consult.el
index 7c7581f415..489c628f89 100644
--- a/consult.el
+++ b/consult.el
@@ -1891,7 +1891,9 @@ to make it available for commands with narrowing."
       (define-key map (vconcat key (vector (car pair)))
                   (cons (cdr pair) #'consult-narrow))))
   (when-let ((widen (consult--widen-key)))
-    (define-key map widen (cons "All" #'consult-narrow))))
+    (define-key map widen (cons "All" #'consult-narrow)))
+  (when-let ((init (and (memq :keys settings) (plist-get settings :initial))))
+    (consult-narrow init)))
 
 ;; Emacs 28: hide in M-X
 (put #'consult-narrow-help 'completion-predicate #'ignore)
@@ -3091,12 +3093,14 @@ These configuration options are supported:
     (nreverse candidates)))
 
 ;;;###autoload
-(defun consult-outline ()
+(defun consult-outline (&optional level)
   "Jump to an outline heading, obtained by matching against `outline-regexp'.
 
-This command supports narrowing to a heading level and candidate preview.
-The symbol at point is added to the future history."
-  (interactive)
+This command supports narrowing to a heading level and candidate
+preview.  The initial narrowing LEVEL can be given as prefix
+argument.  The symbol at point is added to the future history."
+  (interactive
+   (list (and current-prefix-arg (prefix-numeric-value current-prefix-arg))))
   (let* ((candidates (consult--slow-operation
                          "Collecting headings..."
                        (consult--outline-candidates)))
@@ -3107,7 +3111,8 @@ The symbol at point is added to the future history."
                         (<= (get-text-property 0 'consult--outline-level cand)
                             (+ consult--narrow min-level))))
          (narrow-keys (mapcar (lambda (c) (cons c (format "Level %c" c)))
-                              (number-sequence ?1 ?9))))
+                              (number-sequence ?1 ?9)))
+         (narrow-init (and level (max ?1 (min ?9 (+ level ?0))))))
     (consult--read
      candidates
      :prompt "Go to heading: "
@@ -3116,7 +3121,7 @@ The symbol at point is added to the future history."
      :sort nil
      :require-match t
      :lookup #'consult--line-match
-     :narrow `(:predicate ,narrow-pred :keys ,narrow-keys)
+     :narrow `(:predicate ,narrow-pred :keys ,narrow-keys :initial 
,narrow-init)
      :history '(:input consult--line-history)
      :add-history (thing-at-point 'symbol)
      :state (consult--location-state candidates))))