Add devdocs-grep command

Author: astoff

README.org

@@ -22,10 +22,13 @@ devdocs-install=.  This will query https://devdocs.io for the
 available documents and save the selected one to disk.  To read the
 installed documentation, there are two options:
 
-- =devdocs-peruse=: Select a document and display its first page.
 - =devdocs-lookup=: Select an index entry and display it.
+- =devdocs-peruse=: Select a document and display its first page.
+- =devdocs-grep=: Do full-text search on a collection of documents.
+  This feature is experimental, and somewhat slow.  You are usually
+  better served by an index lookup.
 
-It's handy to have a keybinding for the latter command.  One
+It's handy to have a keybinding for the lookup command.  One
 possibility, in analogy to =C-h S= (=info-lookup-symbol=), is
 
 #+begin_src elisp
@@ -39,7 +42,7 @@ in subsequent calls to =devdocs-lookup=, unless a prefix argument is
 given; in this case you can select a new list of documents.
 
 In the =*devdocs*= buffer, navigation keys similar to Info and
-=*Help*= buffers are available; press =C-h m= for details.  Internal
+=*Help*= buffers are available; press =?= for details.  Internal
 hyperlinks are opened in the same viewing buffer, and external links
 are opened as =browse-url= normally would.
 

devdocs.el

@@ -90,6 +90,8 @@ name and a count."
 Fontification is done using the `org-src' library, which see."
   :type 'boolean)
 
+(defvar devdocs-buffer-name "*devdocs*")
+
 (defvar devdocs-history nil
   "History of documentation entries.")
 
@@ -432,7 +434,7 @@ Interactively, read a page name with completion."
 ENTRY is an alist like those in the entry index of the document,
 possibly with an additional ENTRY.fragment which overrides the
 fragment part of ENTRY.path."
-  (with-current-buffer (get-buffer-create "*devdocs*")
+  (with-current-buffer (get-buffer-create devdocs-buffer-name)
     (unless (eq major-mode 'devdocs-mode)
       (devdocs-mode))
     (let-alist entry
@@ -567,6 +569,74 @@ If INITIAL-INPUT is not nil, insert it into the minibuffer."
   (interactive (list (devdocs--read-document "Peruse documentation: ")))
   (pop-to-buffer (devdocs-goto-page doc 0)))
 
+(defun devdocs--next-error-function (n &optional reset)
+  "A `next-error-function' suitable for *devdocs-grep* buffers."
+  (cl-letf (((symbol-function 'compilation-find-file)
+             (lambda (_marker filename &rest _)
+               (string-match "\\([^/]*\\)/\\(.*\\)" filename)
+               ;; TODO: use goto-page
+               (devdocs--render
+                `((doc . ,(devdocs--doc-metadata (match-string 1 filename)))
+                  (path . ,(match-string 2 filename)))))))
+    (compilation-next-error-function n reset)))
+
+;;;###autoload
+(defun devdocs-grep (docs regexp)
+  "Perform full-text search in a collection of documents."
+  (interactive (list (devdocs--relevant-docs current-prefix-arg)
+                     (read-regexp "Search for regexp: ")))
+  (let* ((slugs (mapcar (lambda (doc) (alist-get 'slug doc)) docs))
+         (outbuf (get-buffer-create "*devdocs-grep*"))
+         (pages (mapcan (lambda (doc)
+                          (mapcar (lambda (path) `((doc . ,doc) (path . ,path)))
+                                  (devdocs--index doc 'pages)))
+                        docs))
+         (npages (length pages))
+         (nmatches 0)
+         (progress (make-progress-reporter "Searching" 0 npages)))
+    (pop-to-buffer outbuf)
+    (let ((inhibit-read-only t))
+      (erase-buffer)
+      (grep-mode)
+      (buffer-disable-undo)
+      (setq-local next-error-function #'devdocs--next-error-function)
+      (insert (format "Search results for ‘%s’ in the following documents: %s.\n\n"
+                      regexp (string-join slugs ", "))))
+    (letrec ((worker (pcase-lambda (`(,page . ,rest))
+                       (unless (buffer-live-p outbuf)
+                         (user-error "Grep buffer killed"))
+                       (progress-reporter-update progress (- npages (length rest) 1))
+                       (with-temp-buffer
+                         (let ((devdocs-buffer-name (current-buffer))
+                               (devdocs-fontify-code-blocks nil))
+                           (devdocs--render page))
+                         (while (re-search-forward regexp nil t)
+                           (setq nmatches (1+ nmatches))
+                           (goto-char (match-beginning 0))
+                           (end-of-line)
+                           (let* ((text (buffer-substring (line-beginning-position)
+                                                          (point)))
+                                  (result (let-alist page
+                                            (format "%s/%s:%s:%s\n"
+                                                    .doc.slug .path
+                                                    (line-number-at-pos)
+                                                    text))))
+                             (with-current-buffer outbuf
+                               (save-excursion
+                                 (goto-char (point-max))
+                                 (let ((inhibit-read-only t))
+                                   (insert result)))))))
+                       (if rest
+                           (run-with-idle-timer 0.2 nil worker rest)
+                         (progress-reporter-done progress)
+                         (with-current-buffer outbuf
+                           (save-excursion
+                             (goto-char (point-max))
+                             (let ((inhibit-read-only t))
+                               (insert (format "\nSearch finished with %s results.\n"
+                                               nmatches)))))))))
+      (funcall worker pages))))
+
 ;;; Compatibility with the old devdocs package
 
 ;;;###autoload