diff --git a/racket-company-doc.el b/racket-company-doc.el index 9df697de..1bc44347 100644 --- a/racket-company-doc.el +++ b/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))) diff --git a/racket-describe.el b/racket-describe.el index 0500597e..7a67e31e 100644 --- a/racket-describe.el +++ b/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,11 @@ 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) + (when (boundp 'imenu-auto-rescan) + (setq-local imenu-auto-rescan t))) ;;; Search and disambiguation using local docs diff --git a/racket-scribble.el b/racket-scribble.el index 5bce1a6b..31e3f4b4 100644 --- a/racket-scribble.el +++ b/racket-scribble.el @@ -8,12 +8,37 @@ ;; SPDX-License-Identifier: GPL-3.0-or-later +(require 'dom) (require 'seq) (require 'shr) (require 'subr-x) (require 'url-util) (require 'tramp) +(unless (fboundp 'dom-remove-node) ;added circa Emacs 27 + (defun dom-remove-node (dom node) + "Remove NODE from DOM." + ;; If we're removing the top level node, just return nil. + (dolist (child (dom-children dom)) + (cond + ((eq node child) + (delq node dom)) + ((not (stringp child)) + (dom-remove-node child node)))))) + +(unless (fboundp 'dom-search) ;added circa Emacs 27 + (defun dom-search (dom predicate) + "Return elements in DOM where PREDICATE is non-nil. +PREDICATE is called with the node as its only parameter." + (let ((matches (cl-loop for child in (dom-children dom) + for matches = (and (not (stringp child)) + (dom-search child predicate)) + when matches + append matches))) + (if (funcall predicate dom) + (cons dom matches) + matches)))) + (defconst racket--scribble-temp-nbsp #x2020 "Character we substitute for #xA0 non-breaking-space. @@ -38,7 +63,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 +74,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 +256,11 @@ In some cases we resort to returning custom elements for (`(span ((style . "font-style: italic")) . ,xs) `(i () ,@(mapcar #'racket--walk-dom xs))) + ;; 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)