@@ -569,54 +569,73 @@ If INITIAL-INPUT is not nil, insert it into the minibuffer."
569
569
(interactive (list (devdocs--read-document " Peruse documentation: " )))
570
570
(pop-to-buffer (devdocs-goto-page doc 0 )))
571
571
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
+
572
583
;;;### autoload
573
584
(defun devdocs-grep (docs regexp )
574
585
" Perform full-text search in a collection of documents."
575
586
(interactive (list (devdocs--relevant-docs current-prefix-arg)
576
587
(read-regexp " Search for regexp: " )))
577
- (let* ((inhibit-read-only t )
588
+ (let* ((slugs ( mapcar ( lambda ( doc ) ( alist-get 'slug doc)) docs) )
578
589
(outbuf (get-buffer-create " *devdocs-grep*" ))
579
590
(pages (mapcan (lambda (doc )
580
591
(mapcar (lambda (path ) `((doc . , doc ) (path . , path )))
581
- (alist-get 'pages ( devdocs--index doc) )))
592
+ (devdocs--index doc 'pages )))
582
593
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)))
585
597
(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 " \n Search finished with %s results.\n "
637
+ nmatches)))))))))
638
+ (funcall worker pages))))
620
639
621
640
; ;; Compatibility with the old devdocs package
622
641
0 commit comments