diff --git a/source/buffer.lisp b/source/buffer.lisp index ddc4b95053d..e03f06474ad 100644 --- a/source/buffer.lisp +++ b/source/buffer.lisp @@ -914,7 +914,14 @@ identifiers." (ps:chain node (set-attribute "nyxt-identifier" (ps:stringify nyxt-identifier-counter)))) (incf nyxt-identifier-counter) - (dolist (child (ps:chain node children)) (add-nyxt-identifiers child)) + (dolist (child (if (ps:chain node shadow-root) + (ps:chain *array + (from (ps:@ node shadow-root children)) + (concat (ps:chain *array (from (ps:@ node children))))) + (ps:chain node children))) + (add-nyxt-identifiers child)) + (when (ps:@ node shadow-root) + (ps:chain node (set-attribute "nyxt-shadow-root" ""))) nyxt-identifier-counter) (setf nyxt-identifier-counter (add-nyxt-identifiers (ps:chain document body)))) (alex:when-let ((body-json (with-current-buffer buffer diff --git a/source/changelog.lisp b/source/changelog.lisp index ef5c43436e6..6678a4b6221 100644 --- a/source/changelog.lisp +++ b/source/changelog.lisp @@ -751,4 +751,5 @@ color-picker support as an example application for this feature.") (:li "Add keybindings for commands " (:nxref :command 'nyxt:delete-panel-buffer) " and " (:nxref :command 'nyxt:delete-all-panel-buffers) ".") - (:li "Fix clipboard support for the Flatpak on Wayland."))) + (:li "Fix clipboard support for the Flatpak on Wayland.") + (:li "Add hinting support for pages using Shadow DOMs."))) diff --git a/source/dom.lisp b/source/dom.lisp index 37ee1a732ce..1205aea8146 100644 --- a/source/dom.lisp +++ b/source/dom.lisp @@ -129,6 +129,13 @@ The most useful functions are: (setf (ps:chain object :children) (loop for child in (ps:chain element child-nodes) collect (process-element child)))) + (when (and (ps:@ element shadow-root) + (ps:@ element shadow-root first-child)) + (setf (ps:chain object :children) + (loop for child in (ps:chain *array + (from (ps:@ element shadow-root children)) + (concat (ps:chain *array (from (ps:@ element children))))) + collect (process-element child)))) (when (or (equal (ps:@ element node-name) "#text") (equal (ps:@ element node-name) "#comment") (equal (ps:@ element node-name) "#cdata-section")) @@ -387,11 +394,11 @@ Return two values: (export-always 'click-element) (define-parenscript click-element (element) - (ps:chain (nyxt/ps:qs-nyxt-id document (ps:lisp (get-nyxt-id element))) (click))) + (ps:chain (nyxt/ps:rqs-nyxt-id document (ps:lisp (get-nyxt-id element))) (click))) (export-always 'focus-select-element) (define-parenscript focus-select-element (element) - (let ((element (nyxt/ps:qs-nyxt-id document (ps:lisp (get-nyxt-id element))))) + (let ((element (nyxt/ps:rqs-nyxt-id document (ps:lisp (get-nyxt-id element))))) (unless (nyxt/ps:element-in-view-port-p element) (ps:chain element (scroll-into-view))) (ps:chain element (focus)) @@ -400,14 +407,14 @@ Return two values: (export-always 'check-element) (define-parenscript check-element (element &key (value t)) - (let ((element (nyxt/ps:qs-nyxt-id document (ps:lisp (get-nyxt-id element))))) + (let ((element (nyxt/ps:rqs-nyxt-id document (ps:lisp (get-nyxt-id element))))) (unless (nyxt/ps:element-in-view-port-p element) (ps:chain element (scroll-into-view))) (ps:chain element (set-attribute "checked" (ps:lisp value))))) (export-always 'toggle-details-element) (define-parenscript toggle-details-element (element) - (ps:let ((element (nyxt/ps:qs-nyxt-id document (ps:lisp (get-nyxt-id element))))) + (ps:let ((element (nyxt/ps:rqs-nyxt-id document (ps:lisp (get-nyxt-id element))))) (unless (nyxt/ps:element-in-view-port-p element) (ps:chain element (scroll-into-view))) (if (ps:chain element (get-attribute "open")) @@ -416,8 +423,8 @@ Return two values: (export-always 'select-option-element) (define-parenscript select-option-element (element parent) - (ps:let* ((element (nyxt/ps:qs-nyxt-id document (ps:lisp (get-nyxt-id element)))) - (parent-select (nyxt/ps:qs-nyxt-id document (ps:lisp (get-nyxt-id parent))))) + (ps:let* ((element (nyxt/ps:rqs-nyxt-id document (ps:lisp (get-nyxt-id element)))) + (parent-select (nyxt/ps:rqs-nyxt-id document (ps:lisp (get-nyxt-id parent))))) (unless (nyxt/ps:element-in-view-port-p element) (ps:chain element (scroll-into-view))) (if (ps:chain element (get-attribute "multiple")) @@ -426,7 +433,7 @@ Return two values: (export-always 'scroll-to-element) (define-parenscript scroll-to-element (element) - (ps:chain (nyxt/ps:qs-nyxt-id document (ps:lisp (get-nyxt-id element))) + (ps:chain (nyxt/ps:rqs-nyxt-id document (ps:lisp (get-nyxt-id element))) (scroll-into-view))) (export-always 'set-caret-on-start) diff --git a/source/mode/document.lisp b/source/mode/document.lisp index e8b2a160a07..1e3eae44550 100644 --- a/source/mode/document.lisp +++ b/source/mode/document.lisp @@ -410,7 +410,7 @@ The inner-text must not be modified, so that we can jump to the anchor of the sa (ps-labels :buffer buffer ((heading-scroll-position :buffer buffer (element) - (ps:chain (nyxt/ps:qs-nyxt-id document (ps:lisp (nyxt/dom:get-nyxt-id element))) + (ps:chain (nyxt/ps:rqs-nyxt-id document (ps:lisp (nyxt/dom:get-nyxt-id element))) (get-bounding-client-rect) y))) (map 'list (lambda (e) @@ -441,9 +441,10 @@ The inner-text must not be modified, so that we can jump to the anchor of the sa "Scroll to the N adjacent heading of the BUFFER." (sera:and-let* ((headings (get-headings :buffer buffer)) (new-position (+ n - (position (element (current-heading buffer)) + (position (nyxt/dom:body (element (current-heading buffer))) headings - :key #'element))) + :key (compose #'nyxt/dom:body #'element) + :test #'equal))) (_ (<= 0 new-position (1- (length headings))))) (scroll-page-to-heading (elt headings new-position)))) diff --git a/source/mode/hint.lisp b/source/mode/hint.lisp index 4426420d042..b3ffc096583 100644 --- a/source/mode/hint.lisp +++ b/source/mode/hint.lisp @@ -97,7 +97,7 @@ For instance, to include images: "g f" 'follow-hint-nosave-buffer "g F" 'follow-hint-nosave-buffer-focus))))) -(define-parenscript-async hint-elements (hints) +(define-parenscript-async hint-elements (hints nyxt-identifiers) (defun create-hint-overlay (original-element hint) "Create a DOM element to be used as a hint." (ps:let* ((rect (ps:chain original-element (get-bounding-client-rect))) @@ -112,14 +112,15 @@ For instance, to include images: (let ((fragment (ps:chain document (create-document-fragment))) (hints (ps:lisp (list 'quote hints))) - (i 0)) - (dolist (element (nyxt/ps:qsa document "[nyxt-hintable]")) - (let ((hint (aref hints i))) + (nyxt-identifiers (ps:lisp (list 'quote nyxt-identifiers)))) + (dotimes (i (length hints)) + (let* ((hint (aref hints i)) + (nyxt-identifier (aref nyxt-identifiers i)) + (element (nyxt/ps:rqs-nyxt-id document nyxt-identifier))) (ps:chain element (set-attribute "nyxt-hint" hint)) (ps:chain fragment (append-child (create-hint-overlay element hint))) (when (ps:lisp (show-hint-scope-p (find-submode 'hint-mode))) - (ps:chain element class-list (add "nyxt-element-hint"))) - (setf i (1+ i)))) + (ps:chain element class-list (add "nyxt-element-hint"))))) (ps:chain document body (append-child fragment)) ;; Returning fragment makes WebKit choke. nil)) @@ -149,7 +150,7 @@ For instance, to include images: alphabet)))))) (define-parenscript set-hintable-attribute (selector) - (let ((elements (nyxt/ps:qsa document (ps:lisp selector))) + (let ((elements (nyxt/ps:rqsa document (ps:lisp selector))) (in-view-port-p (ps:lisp (eq :vi (hinting-type (find-submode 'hint-mode)))))) (ps:dolist (element elements) (if in-view-port-p @@ -158,7 +159,7 @@ For instance, to include images: (ps:chain element (set-attribute "nyxt-hintable" "")))))) (define-parenscript remove-hintable-attribute () - (ps:dolist (element (nyxt/ps:qsa document "[nyxt-hintable]")) + (ps:dolist (element (nyxt/ps:rqsa document "[nyxt-hintable]")) (ps:chain element (remove-attribute "nyxt-hintable")))) (defun add-hints (&key selector (buffer (current-buffer))) @@ -169,17 +170,19 @@ For instance, to include images: (update-document-model :buffer buffer) (let* ((hintable-elements (clss:select "[nyxt-hintable]" (document-model buffer))) (hints (generate-hints (length hintable-elements)))) - (hint-elements hints) (loop for elem across hintable-elements for hint in hints do (plump:set-attribute elem "nyxt-hint" hint) - collect elem))) + collect elem + finally (hint-elements hints (map 'list #'(lambda (elem) + (plump:attribute elem "nyxt-identifier")) + hintable-elements))))) (define-parenscript-async remove-hint-elements () - (ps:dolist (element (nyxt/ps:qsa document ":not(.nyxt-search-node) > .nyxt-hint")) + (ps:dolist (element (nyxt/ps:rqsa document ":not(.nyxt-search-node) > .nyxt-hint")) (ps:chain element (remove))) (when (ps:lisp (show-hint-scope-p (find-submode 'hint-mode))) - (ps:dolist (element (nyxt/ps:qsa document ".nyxt-element-hint")) + (ps:dolist (element (nyxt/ps:rqsa document ".nyxt-element-hint")) (ps:chain element class-list (remove "nyxt-element-hint"))))) (defun remove-hints (&key (buffer (current-buffer))) diff --git a/source/parenscript-macro.lisp b/source/parenscript-macro.lisp index f1476cc5320..141567682af 100644 --- a/source/parenscript-macro.lisp +++ b/source/parenscript-macro.lisp @@ -29,7 +29,25 @@ (export-always 'qs-nyxt-id) (defpsmacro qs-nyxt-id (context id) "context.querySelector() tailored for Nyxt IDs." - `(chain ,context (query-selector (lisp (format nil "[nyxt-identifier=\"~a\"]" ,id))))) + `(chain ,context (query-selector (stringify "[nyxt-identifier=\"" ,id "\"]")))) + +(export-always 'rqs-nyxt-id) +(defpsmacro rqs-nyxt-id (context id) + "Recursive version of `qs-nyxt-id` which goes through Shadow DOMs if there's +at least one." + `(flet ((recursive-query-selector (context selector) + (let ((node (qs context selector))) + (if node + node + (let ((node-iterator (chain document (create-node-iterator context (@ *node #:|ELEMENT_NODE|)))) + current-node) + (loop while (and (setf current-node (chain node-iterator (next-node))) (not node)) + do (when (@ current-node shadow-root) + (setf node (recursive-query-selector (@ current-node shadow-root) selector)))) + node))))) + (if (chain ,context (query-selector "[nyxt-shadow-root]")) + (recursive-query-selector ,context (stringify "[nyxt-identifier=\"" ,id "\"]")) + (qs-nyxt-id ,context ,id)))) (export-always 'active-element) (defpsmacro active-element (context) @@ -151,13 +169,15 @@ (radius (parse-float (chain computed-style border-top-left-radius))) (rounded-border-offset (ceiling (* radius (- 1 (sin (/ pi 4)))))) (offset (max coord-truncation-offset rounded-border-offset)) - (el (chain document (element-from-point (+ (chain rect left) offset) - (+ (chain rect top) offset))))) + (el (chain ,element (get-root-node) (element-from-point (+ (chain rect left) offset) + (+ (chain rect top) offset))))) (if (or (>= offset (chain rect width)) (>= offset (chain rect height))) t (progn (loop while (and el (not (eq el element))) - do (setf el (chain el parent-node))) + do (setf el (if (instanceof (chain el parent-node) *shadow-root) + (chain el parent-node host) + (chain el parent-node)))) (null el))))) (export-always 'element-invisible-p) @@ -179,3 +199,19 @@ "element.classList.remove(class) tailored for Nyxt IDs." `(let ((element (nyxt/ps:qs-nyxt-id document (ps:lisp ,id)))) (ps:chain element class-list (remove ,class)))) + +(export-always 'rqsa) +(defpsmacro rqsa (context selector) + "Recursive version of context.querySelectorAll() which goes through +Shadow DOMs if there's at least one." + `(flet ((recursive-query-selector-all (context selector) + (ps:let ((nodes (ps:chain *array (from (nyxt/ps:qsa context selector)))) + (node-iterator (ps:chain document (create-node-iterator context (ps:@ *node #:|ELEMENT_NODE|)))) + current-node) + (ps:loop while (ps:setf current-node (ps:chain node-iterator (next-node))) + do (ps:when (ps:@ current-node shadow-root) + (ps:chain *array prototype push (apply nodes (recursive-query-selector-all (ps:@ current-node shadow-root) selector))))) + nodes))) + (if (chain ,context (query-selector "[nyxt-shadow-root]")) + (recursive-query-selector-all ,context ,selector) + (qsa ,context ,selector))))