Merge branch 'shadow-dom-hinting'

source/buffer.lisp

@@ -938,7 +938,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

source/changelog.lisp

@@ -796,6 +796,7 @@ buffers.")
   (:nsection :title "Features"
     (:ul
      (:li "Add new quick start tutorial.")
+     (:li "Add hinting support for pages using Shadow DOMs.")
      (:li "Add keybindings for command " (:nxref :command 'describe-any) ".")))
   ;; (:nsection :title "Bug fixes"
   ;;   (:ul))

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)

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))))
 

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)))

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))))