diff options
| author | Rahguzar <rahguzar@zohomail.eu> | 2023-10-24 22:07:51 +0200 |
|---|---|---|
| committer | Eli Zaretskii <eliz@gnu.org> | 2023-11-25 12:55:37 +0200 |
| commit | d41a5e4b1bafbb974d2c886d3198d9bda7821591 (patch) | |
| tree | ff73b496ae2c28d0a381a870250e1ba6b98ddf3d | |
| parent | 42545444055d102deeb2e5513ca20a060dca00f3 (diff) | |
| download | emacs-d41a5e4b1bafbb974d2c886d3198d9bda7821591.tar.gz | |
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)
| -rw-r--r-- | lisp/net/shr.el | 41 |
1 files changed, 40 insertions, 1 deletions
diff --git a/lisp/net/shr.el b/lisp/net/shr.el index e54b1a6..71c16eb 100644 --- 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 |
