Add a ‘consult-info’ command.

Based on ‘selectrum-info’ from the Selectrum wiki.

consult.el

@@ -2374,6 +2374,84 @@ CMD is the find argument list."
   (interactive)
   (consult--find "Locate: " consult-locate-command))
 
+(defun consult--info-section-candidates (top-node)
+  "Return an alist of sections and candidates in the Info buffer TOP-NODE.
+
+Candidates are returned in the order that their links are listed
+in the Info buffer, which might be different from how the
+sections are actually ordered."
+  (let ((sub-topic-format
+         ;; Headers look like "* Some Thing::      Description",
+         ;; where descriptions are optional and might continue on
+         ;; the next line.
+         (rx "* " (group (+? (not ?:))) "::"
+             ;; Include the description, if one exists.
+             ;; If it doesn't, the line ends immediately.
+             (or "\n" (seq
+                       (0+ blank)
+                       (group (+? anychar))
+                       ;; Sometimes a heading follows on the next line,
+                       ;; and sometimes there's any empty blank line
+                       ;; (such as before a section title).  For now,
+                       ;; assume continuation lines use indentation and
+                       ;; other lines don't.
+                       "\n" (not blank))))))
+    (save-match-data
+      (save-selected-window
+        (with-temp-buffer
+          ;; Some nodes created from multiple files, so we need to create a
+          ;; buffer to make sure that we see everything.
+          (info top-node (current-buffer))
+          (goto-char (point-min))
+          (let ((candidates-alist))
+            (while (re-search-forward sub-topic-format nil t)
+              (forward-line 0)         ; Go back to start of line.
+              (let ((node-name (match-string 1)))
+                (push (cons (concat node-name
+                                    (if-let ((node-description (match-string 2)))
+                                        (propertize
+                                         (thread-last node-description
+                                           (replace-regexp-in-string "\n" "")
+                                           (replace-regexp-in-string " +" " ")
+                                           (concat " - "))
+                                         'face 'completions-annotations)))
+                            node-name)
+                      candidates-alist)))
+            (nreverse candidates-alist)))))))
+
+(defun consult--info-top-node-candidates ()
+  "Return a list of top-level Info nodes."
+  (save-match-data
+    (thread-last (append (or Info-directory-list Info-default-directory-list)
+                         Info-additional-directory-list)
+      (mapcan (lambda (directory)
+                (when (file-directory-p directory)
+                  (directory-files directory nil "\\.info" t))))
+      (mapcar (lambda (file)
+                (string-match "\\(.+?\\)\\." file)
+                (match-string 1 file)))
+      seq-uniq)))
+
+;;;###autoload
+(defun consult-info (&optional top-node)
+  "Use `completing-read' to jump to an Info topic.
+
+Select from the available Info top-level nodes, then one of the sub-nodes.
+If TOP-NODE is provided, then just select its sub-nodes."
+  (interactive)
+  (unless top-node
+    (setq top-node (completing-read "Info node: "
+                                    (consult--info-top-node-candidates))))
+  (let ((section-candidates-alist (consult--info-section-candidates top-node)))
+    (info (format "(%s)%s"
+                  top-node
+                  (consult--read "Info section: "
+                                 section-candidates-alist
+                                 :require-match t
+                                 :sort nil
+                                 :lookup #'consult--lookup-cdr
+                                 :category 'info)))))
+
 ;;;; default completion-system support
 
 (defun consult--default-completion-candidate ()