Optimize partial doc retrieval

The key point is not to massage the entire DOM before finding the
subset we care about. Instead, find it first, massage only that.

Also when finding the extract, take the opportunity to use
`dom-search` more -- which isn't necessarily much faster, but avoids
some recursion, which isn't Emacs Lisp's strength.

racket-company-doc.el

@@ -32,46 +32,59 @@
          (current-buffer))))))
 
 (defun racket--scribble-path+anchor-insert (path anchor)
-  (with-temp-message (format "Getting and formatting documentation %s %s ..."
-                             path anchor)
-    (let* ((tramp-verbose 2)            ;avoid excessive messages
-           (dom (racket--scribble-path->shr-dom path))
-           (dom (racket--company-elements-for-anchor dom anchor)))
-      (ignore tramp-verbose)
-      (save-excursion
-        (let ((shr-use-fonts nil)
-              (shr-external-rendering-functions `((span . ,#'racket-render-tag-span)))
-              (shr-width 76)) ;for company-quickhelp-mode
-          (shr-insert-document dom)))
-      (while (re-search-forward (string racket--scribble-temp-nbsp) nil t)
-        (replace-match " " t t)))))
+  (let* ((tramp-verbose 2) ;avoid excessive tramp messages
+         (dom (with-temp-message (format "Getting %s..." path)
+                (racket--html-file->dom path)))
+         (dom (with-temp-message (format "Finding anchor %s..." anchor)
+                (racket--company-elements-for-anchor dom anchor)))
+         (dom (with-temp-message (format "Adjusting HTML...")
+                (racket--massage-scribble-dom path
+                                              (file-name-directory path)
+                                              dom))))
+    (ignore tramp-verbose)
+    (save-excursion
+      (let ((shr-use-fonts nil)
+            (shr-external-rendering-functions `((span . ,#'racket-render-tag-span)))
+            (shr-width 76)) ;for company-quickhelp-mode
+        (shr-insert-document dom)))
+    (while (re-search-forward (string racket--scribble-temp-nbsp) nil t)
+      (replace-match " " t t))))
 
 (defun racket--company-elements-for-anchor (dom anchor)
   "Return the subset of DOM elements pertaining to ANCHOR."
-  (cl-labels
-      ((heading-p (x)
-         (memq (dom-tag x) '(h1 h2 h3 h4 h5 h6)))
-       (anchor-p (x name)
-         (if (and (eq 'racket-anchor (dom-tag x))
-                  (or (not name) (equal name (dom-attr x 'name))))
-             t
-           (seq-some (lambda (v) (anchor-p v name))
-                     (dom-non-text-children x)))))
+  (cl-flet
+      ((anchor-p (node name)
+         (dom-search node
+                     (lambda (node)
+                       (and (eq 'a (dom-tag node))
+                            (equal name (dom-attr node 'name))))))
+       (boxed-p (node)
+         (dom-search node
+                     (lambda (node)
+                       (and (eq 'table (dom-tag node))
+                            (equal "boxed RBoxed" (dom-attr node 'class))))))
+       (heading-p (node)
+         (memq (dom-tag node) '(h1 h2 h3 h4 h5 h6))))
     ;; Consider immediate children of the "main" div.
     (let ((result nil)
-          (xs (dom-children (car (dom-by-class dom "main\\'")))))
+          (xs (dom-children
+               (dom-search (dom-child-by-tag dom 'body)
+                           (lambda (node)
+                             (and (eq 'div (dom-tag node))
+                                  (equal "main" (dom-attr node 'class))))))))
       ;; Discard elements before the one containing a matching anchor.
       (while (and xs (not (anchor-p (car xs) anchor)))
         (setq xs (cdr xs)))
-      ;; Accumulate result up to another anchor or a heading.
+      ;; Accumulate result up to an element containing an RBoxed table
+      ;; or heading.
       (when xs
         (push (car xs) result)
         (setq xs (cdr xs))
         (while (and xs (not (or (heading-p (car xs))
-                                (anchor-p (car xs) nil))))
+                                (boxed-p (car xs)))))
           (push (car xs) result)
           (setq xs (cdr xs))))
-      (racket--walk-dom `(div () ,@(reverse result))))))
+      `(div () ,@(reverse result)))))
 
 (provide 'racket-company-doc)