Skip to content

Commit 4be803f

Browse files
committed
Make it asynchronous (but still single-threaded)
1 parent a795557 commit 4be803f

File tree

1 file changed

+57
-38
lines changed

1 file changed

+57
-38
lines changed

devdocs.el

Lines changed: 57 additions & 38 deletions
Original file line numberDiff line numberDiff line change
@@ -569,54 +569,73 @@ If INITIAL-INPUT is not nil, insert it into the minibuffer."
569569
(interactive (list (devdocs--read-document "Peruse documentation: ")))
570570
(pop-to-buffer (devdocs-goto-page doc 0)))
571571

572+
(defun devdocs--next-error-function (n &optional reset)
573+
"A `next-error-function' suitable for *devdocs-grep* buffers."
574+
(cl-letf (((symbol-function 'compilation-find-file)
575+
(lambda (_marker filename &rest _)
576+
(string-match "\\([^/]*\\)/\\(.*\\)" filename)
577+
;; TODO: use goto-page
578+
(devdocs--render
579+
`((doc . ,(devdocs--doc-metadata (match-string 1 filename)))
580+
(path . ,(match-string 2 filename)))))))
581+
(compilation-next-error-function n reset)))
582+
572583
;;;###autoload
573584
(defun devdocs-grep (docs regexp)
574585
"Perform full-text search in a collection of documents."
575586
(interactive (list (devdocs--relevant-docs current-prefix-arg)
576587
(read-regexp "Search for regexp: ")))
577-
(let* ((inhibit-read-only t)
588+
(let* ((slugs (mapcar (lambda (doc) (alist-get 'slug doc)) docs))
578589
(outbuf (get-buffer-create "*devdocs-grep*"))
579590
(pages (mapcan (lambda (doc)
580591
(mapcar (lambda (path) `((doc . ,doc) (path . ,path)))
581-
(alist-get 'pages (devdocs--index doc))))
592+
(devdocs--index doc 'pages)))
582593
docs))
583-
(progress (make-progress-reporter "Searching" 0 (length pages)))
584-
(inhibit-read-only t))
594+
(npages (length pages))
595+
(nmatches 0)
596+
(progress (make-progress-reporter "Searching" 0 npages)))
585597
(pop-to-buffer outbuf)
586-
(erase-buffer)
587-
(grep-mode)
588-
(setq-local next-error-function
589-
(lambda (n &optional reset)
590-
(cl-letf (((symbol-function 'compilation-find-file)
591-
(lambda (_marker filename &rest _)
592-
(string-match "\\([^/]*\\)/\\(.*\\)" filename)
593-
(devdocs--render
594-
`((doc . ,(devdocs--doc-metadata
595-
(match-string 1 filename)))
596-
(path . ,(match-string 2 filename)))))))
597-
(compilation-next-error-function n reset))))
598-
(insert "Search results for ‘" regexp "’ in the following documents: "
599-
(string-join (mapcar (lambda (doc) (alist-get 'slug doc)) docs) ", ")
600-
".\n\n")
601-
(with-temp-buffer
602-
(dolist (page pages)
603-
(progress-reporter-update progress (seq-position pages page))
604-
(let ((devdocs-buffer-name (current-buffer))
605-
(devdocs-fontify-code-blocks nil))
606-
(devdocs--render page))
607-
(while (re-search-forward regexp nil t)
608-
(let ((result (let-alist (car devdocs--stack)
609-
(format "%s/%s:%s:%s\n"
610-
.doc.slug .path
611-
(line-number-at-pos)
612-
(buffer-substring (line-beginning-position)
613-
(line-end-position))))))
614-
(with-current-buffer outbuf
615-
(save-excursion
616-
(goto-char (point-max))
617-
(insert result)))
618-
(end-of-line)))))
619-
(progress-reporter-done progress)))
598+
(let ((inhibit-read-only t))
599+
(erase-buffer)
600+
(grep-mode)
601+
(buffer-disable-undo)
602+
(setq-local next-error-function #'devdocs--next-error-function)
603+
(insert (format "Search results for ‘%s’ in the following documents: %s.\n\n"
604+
regexp (string-join slugs ", "))))
605+
(letrec ((worker (pcase-lambda (`(,page . ,rest))
606+
(unless (buffer-live-p outbuf)
607+
(user-error "Grep buffer killed"))
608+
(progress-reporter-update progress (- npages (length rest) 1))
609+
(with-temp-buffer
610+
(let ((devdocs-buffer-name (current-buffer))
611+
(devdocs-fontify-code-blocks nil))
612+
(devdocs--render page))
613+
(while (re-search-forward regexp nil t)
614+
(setq nmatches (1+ nmatches))
615+
(goto-char (match-beginning 0))
616+
(end-of-line)
617+
(let* ((text (buffer-substring (line-beginning-position)
618+
(point)))
619+
(result (let-alist page
620+
(format "%s/%s:%s:%s\n"
621+
.doc.slug .path
622+
(line-number-at-pos)
623+
text))))
624+
(with-current-buffer outbuf
625+
(save-excursion
626+
(goto-char (point-max))
627+
(let ((inhibit-read-only t))
628+
(insert result)))))))
629+
(if rest
630+
(run-with-idle-timer 0.2 nil worker rest)
631+
(progress-reporter-done progress)
632+
(with-current-buffer outbuf
633+
(save-excursion
634+
(goto-char (point-max))
635+
(let ((inhibit-read-only t))
636+
(insert (format "\nSearch finished with %s results.\n"
637+
nmatches)))))))))
638+
(funcall worker pages))))
620639

621640
;;; Compatibility with the old devdocs package
622641

0 commit comments

Comments
 (0)