racket-describe: Surface "On this page" links via imenu

racket-company-doc.el

@@ -35,7 +35,9 @@
                              path anchor)
     (let* ((tramp-verbose 2)            ;avoid excessive messages
            (dom   (racket--html-file->dom path))
-           (body  (racket--scribble-body dom))
+           (body  (racket--scribble-path->shr-dom path))
+           (_     (pcase (dom-by-class dom "tocset")
+                    (`(,node . ,_) (dom-remove-node body node))))
            (elems (racket--company-elements-for-anchor body anchor))
            (dom   `(div () ,@elems))
            (dom   (racket--walk-dom dom)))

racket-describe.el

@@ -151,7 +151,8 @@ anchor. If numberp, move to that position."
              (racket-ext-link   . ,#'racket-render-tag-racket-ext-link)
              (racket-anchor     . ,#'racket-render-tag-racket-anchor)
              (racket-nav        . ,#'racket-render-tag-racket-nav))))
-      (shr-insert-document dom))
+      (shr-insert-document
+       (racket--describe-handle-toc-nodes dom)))
     ;; See doc string for `racket--scribble-temp-nbsp'.
     (goto-char (point-min))
     (while (re-search-forward (string racket--scribble-temp-nbsp) nil t)
@@ -177,19 +178,57 @@ text. We want point left where `racket-search-describe' can use
     ((numberp goto)
      goto)
     ((stringp goto)
-     (or (let ((i nil)) ;silence byte-compiler warning...
-           i            ;...on all versions of emacs
-           (cl-loop for i being the intervals
-                    if (equal (get-text-property (car i) 'racket-anchor)
-                              goto)
-                    return (cl-loop for j from (car i) to (point-max)
-                                    if (not (get-text-property j 'racket-anchor))
-                                    return j)))
+     (or (racket--describe-anchor->position goto)
          (point-min)))
     (t (point-min))))
   (setq racket--describe-here
         (cons (car racket--describe-here) (point))))
 
+(defun racket--describe-anchor->position (anchor)
+  (let ((i nil)) ;silence byte-compiler warning...
+    i            ;...on all versions of emacs
+    (cl-loop for i being the intervals
+             if (equal (get-text-property (car i) 'racket-anchor)
+                       anchor)
+             return (cl-loop for j from (car i) to (point-max)
+                             if (not (get-text-property j 'racket-anchor))
+                             return j))))
+
+(defvar-local racket--describe-on-this-page nil)
+
+(defun racket--describe-handle-toc-nodes (dom)
+  "Handle nodes that render as a \"left nav panel\" in a web browser.
+
+These aren't effective in a shr buffer, due to window width and
+lack of independent scrolling columns. Instead:
+
+- \"tocview\": Just delete it. User can nav up to see.
+
+- \"tocsub\" a.k.a. \"On this page:\": Useful, but present via
+  `imenu'.
+
+Both are children of a \"tocscet\" div."
+  (setq-local
+   racket--describe-on-this-page
+   (pcase (dom-by-class dom "tocsub")
+     (`(,node . ,_)
+      (dom-remove-node dom node)
+      (seq-map (lambda (node)
+                 (cons (dom-texts node "")
+                       (dom-attr node 'anchor)))
+               (dom-search node
+                           (lambda (node)
+                             (eq 'racket-doc-link (dom-tag node))))))))
+  (pcase (dom-by-class dom "tocset")
+    (`(,node . ,_) (dom-remove-node dom node)))
+  dom)
+
+(defun racket--describe-imenu-create-index ()
+  (seq-map (lambda (v)
+             (cons (car v)
+                   (racket--describe-anchor->position (cdr v))))
+           racket--describe-on-this-page))
+
 (defconst racket--shr-faces
   '(("RktSym"                . font-lock-keyword-face)
     ("RktVal"                . font-lock-constant-face)
@@ -474,7 +513,10 @@ browser program -- are given `racket-describe-ext-link-face'.
 \\{racket-describe-mode-map}"
   (setq show-trailing-whitespace nil)
   (setq-local revert-buffer-function #'racket-describe-mode-revert-buffer)
-  (buffer-disable-undo))
+  (buffer-disable-undo)
+  (setq-local imenu-create-index-function
+              #'racket--describe-imenu-create-index)
+  (setq-local imenu-auto-rescan t))
 
 ;;; Search and disambiguation using local docs
 

racket-scribble.el

@@ -38,7 +38,7 @@ the effect of being non-breaking.")
     (let* ((tramp-verbose 2) ;avoid excessive messages
            (base (file-name-directory path))
            (dom  (racket--html-file->dom path))
-           (body (racket--scribble-body dom))
+           (body (dom-child-by-tag dom 'body))
            (body (racket--massage-scribble-dom path base body)))
       `(html ()
              (head () (base ((href . ,base))))
@@ -49,26 +49,6 @@ the effect of being non-breaking.")
     (insert-file-contents-literally path)
     (libxml-parse-html-region (point-min) (point-max))))
 
-(defun racket--scribble-body (dom)
-  "Return a body with the interesting elements in DOM.
-
-With a normal Racket documentation page produced by Scribble,
-these are only elements from the maincolumn/main div -- not the
-tocset sibling.
-
-With other doc pages, e.g. from r5rs, these are simply all the
-body elements."
-  (pcase (seq-some (lambda (v)
-                     (pcase v (`(body . ,_) v)))
-                   dom)
-    (`(body ,_
-            (div ((class . "tocset")) . ,_)
-            (div ((class . "maincolumn"))
-                 (div ((class . "main")) . ,xs))
-            . ,_)
-     `(body () ,@xs))
-    (body body)))
-
 ;; Dynamically bound (like Racket parameters).
 (defvar racket--scribble-file nil)
 (defvar racket--scribble-base nil)
@@ -251,6 +231,11 @@ In some cases we resort to returning custom elements for
     (`(span ((style . "font-style: italic")) . ,xs)
      `(i () ,@(mapcar #'racket--walk-dom xs)))
 
+    ;; <span class="mywbr"> </span> added in e.g. "tocsub" for
+    ;; "case/equal". As render in shr, undesired space.
+    (`(span ((class . "mywbr")) ,_)
+     "")
+
     ;; Delete some things that produce unwanted blank lines and/or
     ;; indents.
     (`(blockquote ((class . ,(or "SVInsetFlow" "SubFlow"))) . ,xs)