Outline support for shr rendered documents

* lisp/net/shr.el
(shr-heading): Propertize heading with level.
(shr-outline-search):  An 'outline-search-function' that finds
headings using text property search.
(shr-outline-level): Outline level for 'shr-outline-search'.
(Bug#66676)

diff --git a/lisp/net/shr.el b/lisp/net/shr.el
index e54b1a6578447d0e82b1b9c3eaaaaa37c1e17622..71c16ebd126651b976e8244e3bfe46ee99053413 100644 (file)
--- a/lisp/net/shr.el
+++ b/lisp/net/shr.el
@@ -1272,7 +1272,11 @@ START, and END.  Note that START and END should be markers."
 
 (defun shr-heading (dom &rest types)
   (shr-ensure-paragraph)
-  (apply #'shr-fontize-dom dom types)
+  (let ((start (point))
+       (level (string-to-number
+               (string-remove-prefix "shr-h" (symbol-name (car types))))))
+   (apply #'shr-fontize-dom dom types)
+   (put-text-property start (pos-eol) 'outline-level level))
   (shr-ensure-paragraph))
 
 (defun shr-urlify (start url &optional title)
@@ -2069,6 +2073,41 @@ BASE is the URL of the HTML being rendered."
   (shr-generic dom)
   (insert ?\N{POP DIRECTIONAL ISOLATE}))
 
+;;; Outline Support
+(defun shr-outline-search (&optional bound move backward looking-at)
+  "A function that can be used as `outline-search-function' for rendered html.
+See `outline-search-function' for BOUND, MOVE, BACKWARD and LOOKING-AT."
+  (if looking-at
+      (get-text-property (point) 'outline-level)
+    (let ((heading-found nil)
+         (bound (or bound
+                    (if backward (point-min) (point-max)))))
+      (save-excursion
+       (when (and (not (bolp))
+                  (get-text-property (point) 'outline-level))
+         (forward-line (if backward -1 1)))
+       (if backward
+           (unless (get-text-property (point) 'outline-level)
+             (goto-char (or (previous-single-property-change
+                             (point) 'outline-level nil bound)
+                            bound)))
+         (goto-char (or (text-property-not-all (point) bound 'outline-level nil)
+                        bound)))
+       (goto-char (pos-bol))
+       (when (get-text-property (point) 'outline-level)
+         (setq heading-found (point))))
+      (if heading-found
+         (progn
+           (set-match-data (list heading-found heading-found))
+           (goto-char heading-found))
+       (when move
+         (goto-char bound)
+         nil)))))
+
+(defun shr-outline-level ()
+  "Function to be used as `outline-level' with `shr-outline-search'."
+  (get-text-property (point) 'outline-level))
+
 ;;; Table rendering algorithm.
 
 ;; Table rendering is the only complicated thing here.  We do this by