bug#66676: 29.1; Should some aspects of shr rendering be configurable

[Rahguzar via "Bug reports for GNU Emacs, the Swiss army knife of text editors" <bug-gnu-emacs@gnu.org>]

[-- Attachment #1: Type: text/plain, Size: 1172 bytes --]

Dear Emacs developers,

Please find attached 5 patches:

1) The first introduces and uses the options Eli agreed with. These
include options to not fill text, configurable raise properties for
super and subscripts and :ascent property for images. The default values
for these new options do not alter the current behavior.

2) The second introduces an option to allow displaying some images
inline. The default value again preserves the existing behavior.

3) The third patch added an outline-search function and outline-level to
shr.el. These can be set by modes such as eww to provide outline
support.

4) The fourth patch adds these to provide outline support to eww. It has
enables visual-line-mode if shr is configured not to use
visual-line-mode.

5) The fifth patch corrects some misbehavior that I observed but I am
not sure it is the right thing so please feel free to disregard it.
Before inserting a subscript it checks if the subscript in on a newline
and in that case removes the newline. The newlines seem to be coming
from <br> tags which seems to be there to provide vertical alignment of
subscript and superscript if both are present.

Thanks,
Rahguzar



[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-Make-some-aspects-of-shr-rendering-customizable.patch --]
[-- Type: text/x-patch, Size: 4669 bytes --]

From a46810e54ba2590cae88cde09445bfc34a5ac77b Mon Sep 17 00:00:00 2001
From: Rahguzar <rahguzar@zohomail.eu>
Date: Mon, 23 Oct 2023 21:23:53 +0200
Subject: [PATCH 1/5] Make some aspects of shr rendering customizable

* lisp/net/shr.el
(shr-fill-text): New custom variable
(shr-sup-raise-factor): New custom variable
(shr-sub-raise-factor): New custom variable
(shr-image-ascent): New custom variable
(shr-fill-lines): Only fill if shr-fill-text is non nil
(shr-put-image): Use shr-image-ascent as value of :ascent
(shr-rescale-image): Use shr-image-ascent
(shr-make-placeholder-image): Use shr-image-ascent
(shr-tag-sup): use shr-sup-raise-factor
(shr-tag-sub): use shr-sub-raise-factor
---
 lisp/net/shr.el | 42 +++++++++++++++++++++++++++++++++---------
 1 file changed, 33 insertions(+), 9 deletions(-)

diff --git a/lisp/net/shr.el b/lisp/net/shr.el
index 645e1cc51e5..185f2c0422d 100644
--- a/lisp/net/shr.el
+++ b/lisp/net/shr.el
@@ -163,6 +163,30 @@ shr-offer-extend-specpdl
   :version "28.1"
   :type 'boolean)
 
+(defcustom shr-fill-text t
+  "Non-nil means to fill the text according to the width of the window.
+If nil text is not filled and `visual-line-mode' can be used to reflow text."
+  :version "30.1"
+  :type 'boolean)
+
+
+(defcustom shr-sup-raise-factor 0.2
+  "The value of raise property for superscripts.
+Should be a number between 0 and 1."
+  :version "30.1"
+  :type 'float)
+
+(defcustom shr-sub-raise-factor -0.2
+  "The value of raise property for subscripts.
+Should be a number between 0 and -1."
+  :version "30.1"
+  :type 'float)
+
+(defcustom shr-image-ascent 100
+  "The value to be used for :ascent property when inserting images."
+  :version "30.1"
+  :type 'integer)
+
 (defvar shr-content-function nil
   "If bound, this should be a function that will return the content.
 This is used for cid: URLs, and the function is called with the
@@ -741,7 +765,7 @@ shr-insert
 			       (or shr-current-font 'shr-text)))))))))
 
 (defun shr-fill-lines (start end)
-  (if (<= shr-internal-width 0)
+  (if (or (not shr-fill-text) (<= shr-internal-width 0))
       nil
     (save-restriction
       (narrow-to-region start end)
@@ -1063,11 +1087,11 @@ shr-put-image
 	     (start (point))
 	     (image (cond
 		     ((eq size 'original)
-		      (create-image data nil t :ascent 100
+		      (create-image data nil t :ascent shr-image-ascent
 				    :format content-type))
 		     ((eq content-type 'image/svg+xml)
                       (when (image-type-available-p 'svg)
-		        (create-image data 'svg t :ascent 100)))
+		        (create-image data 'svg t :ascent shr-image-ascent)))
 		     ((eq size 'full)
 		      (ignore-errors
 			(shr-rescale-image data content-type
@@ -1114,7 +1138,7 @@ shr-rescale-image
 MAX-WIDTH/MAX-HEIGHT.  If not given, use the current window
 width/height instead."
   (if (not (get-buffer-window (current-buffer) t))
-      (create-image data nil t :ascent 100)
+      (create-image data nil t :ascent shr-image-ascent)
     (let* ((edges (window-inside-pixel-edges
                    (get-buffer-window (current-buffer))))
            (max-width (truncate (* shr-max-image-proportion
@@ -1135,13 +1159,13 @@ shr-rescale-image
                (< (* height scaling) max-height))
           (create-image
            data (shr--image-type) t
-           :ascent 100
+           :ascent shr-image-ascent
            :width width
            :height height
            :format content-type)
         (create-image
          data (shr--image-type) t
-         :ascent 100
+         :ascent shr-image-ascent
          :max-width max-width
          :max-height max-height
          :format content-type)))))
@@ -1381,13 +1405,13 @@ shr-tag-svg
 (defun shr-tag-sup (dom)
   (let ((start (point)))
     (shr-generic dom)
-    (put-text-property start (point) 'display '(raise 0.2))
+    (put-text-property start (point) 'display `(raise ,shr-sup-raise-factor))
     (add-face-text-property start (point) 'shr-sup)))
 
 (defun shr-tag-sub (dom)
   (let ((start (point)))
     (shr-generic dom)
-    (put-text-property start (point) 'display '(raise -0.2))
+    (put-text-property start (point) 'display `(raise ,shr-sub-raise-factor))
     (add-face-text-property start (point) 'shr-sup)))
 
 (defun shr-tag-p (dom)
@@ -1840,7 +1864,7 @@ shr-make-placeholder-image
     (svg-rectangle svg 0 0 width height :gradient "background"
                    :stroke-width 2 :stroke-color "black")
     (let ((image (svg-image svg :scale 1)))
-      (setf (image-property image :ascent) 100)
+      (setf (image-property image :ascent) shr-image-ascent)
       image)))
 
 (defun shr-tag-pre (dom)
-- 
2.42.0


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #3: 0002-Allow-displaying-images-inline.patch --]
[-- Type: text/x-patch, Size: 4902 bytes --]

From adbee20c0e8e486de06ea4de9d6e69394a2fef66 Mon Sep 17 00:00:00 2001
From: Rahguzar <rahguzar@zohomail.eu>
Date: Tue, 24 Oct 2023 20:30:23 +0200
Subject: [PATCH 2/5] Allow displaying images inline

* lisp/net/shr.el
(shr-max-inline-image-size): New custom variable
(shr-insert): Use the variable to determine whether to
insert newline before an image
(shr--inline-image-p): New function
(shr-put-image): Use variable and function
(shr-tag-img): Use variable
---
 lisp/net/shr.el | 65 +++++++++++++++++++++++++++++++++++++++----------
 1 file changed, 52 insertions(+), 13 deletions(-)

diff --git a/lisp/net/shr.el b/lisp/net/shr.el
index 185f2c0422d..adce66311f1 100644
--- a/lisp/net/shr.el
+++ b/lisp/net/shr.el
@@ -187,6 +187,24 @@ shr-image-ascent
   :version "30.1"
   :type 'integer)
 
+(defcustom shr-max-inline-image-size nil
+  "If non-nil determines when the images can be displayed inline.
+If nil images are never displayed inline.
+
+It non-nil it should be cons (WIDTH . HEIGHT).
+
+WIDTH can be an integer which is interpreted as number of pixels.  If the width
+of an image exceeds this amount, the image is displayed on a separate line.
+WIDTH can also be floating point number, in which case the image is displayed
+inline if it occupies less than this fraction of window width.
+
+HEIGHT can be also be an integer or a floating point number.  If it is an
+integer and the pixel height of an image exceeds it, the image image is
+displyed on a separate line.  If it is an floating point, the limit is
+interpreted as multiples of the height of default font."
+  :version "30.1"
+  :type '(choice (const nil) (cons number number)))
+
 (defvar shr-content-function nil
   "If bound, this should be a function that will return the content.
 This is used for cid: URLs, and the function is called with the
@@ -721,7 +739,8 @@ shr--translate-insertion-chars
     (replace-match " " t t)))
 
 (defun shr-insert (text)
-  (when (and (not (bolp))
+  (when (and (not shr-max-inline-image-size)
+	     (not (bolp))
 	     (get-text-property (1- (point)) 'image-url))
     (insert "\n"))
   (cond
@@ -1073,6 +1092,19 @@ shr-image-from-data
 (declare-function image-size "image.c" (spec &optional pixels frame))
 (declare-function image-animate "image" (image &optional index limit position))
 
+(defun shr--inline-image-p (image)
+  "Return non-nil if IMAGE should be displayed inline."
+  (when shr-max-inline-image-size
+    (let ((size (image-size image t))
+	  (max-width (car shr-max-inline-image-size))
+	  (max-height (cdr shr-max-inline-image-size)))
+      (unless (integerp max-width)
+	(setq max-width (* max-width (window-width nil t))))
+      (unless (integerp max-height)
+	(setq max-width (* max-width (frame-char-height))))
+      (and (< (car size) max-width)
+	   (< (cdr size) max-width)))))
+
 (defun shr-put-image (spec alt &optional flags)
   "Insert image SPEC with a string ALT.  Return image.
 SPEC is either an image data blob, or a list where the first
@@ -1103,19 +1135,25 @@ shr-put-image
                                            (plist-get flags :width)
                                            (plist-get flags :height)))))))
         (when image
+          ;; The trailing confuse can confuse shr-insert into not
+          ;; putting any space after inline images.
+	  (setq alt (string-trim alt))
 	  ;; When inserting big-ish pictures, put them at the
 	  ;; beginning of the line.
-	  (when (and (> (current-column) 0)
-		     (> (car (image-size image t)) 400))
-	    (insert "\n"))
-          (let ((image-pos (point)))
-	    (if (eq size 'original)
-	        (insert-sliced-image image (or alt "*") nil 20 1)
-	      (insert-image image (or alt "*")))
-	    (put-text-property start (point) 'image-size size)
-	    (when (and shr-image-animate
-                       (cdr (image-multi-frame-p image)))
-              (image-animate image nil 60 image-pos))))
+	  (let ((inline (shr--inline-image-p image)))
+	    (when (and (> (current-column) 0)
+		     (not inline))
+		(insert "\n"))
+	    (let ((image-pos (point)))
+	      (if (eq size 'original)
+		  (insert-sliced-image image (or alt "*") nil 20 1)
+		(insert-image image (or alt "*")))
+	      (put-text-property start (point) 'image-size size)
+	      (when (and (not inline) shr-max-inline-image-size)
+		(insert "\n"))
+	      (when (and shr-image-animate
+			 (cdr (image-multi-frame-p image)))
+		(image-animate image nil 60 image-pos)))))
 	image)
     (insert (or alt ""))))
 
@@ -1676,7 +1714,8 @@ shr-tag-img
 	    (and dom
 		 (or (> (length (dom-attr dom 'src)) 0)
                      (> (length (dom-attr dom 'srcset)) 0))))
-    (when (> (current-column) 0)
+    (when (and (not shr-max-inline-image-size)
+	       (> (current-column) 0))
       (insert "\n"))
     (let ((alt (dom-attr dom 'alt))
           (width (shr-string-number (dom-attr dom 'width)))
-- 
2.42.0


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #4: 0003-Outline-support-for-shr-rendered-documents.patch --]
[-- Type: text/x-patch, Size: 2599 bytes --]

From 86bb59a9eafbe646689cdd4d593a9477082a2883 Mon Sep 17 00:00:00 2001
From: Rahguzar <rahguzar@zohomail.eu>
Date: Tue, 24 Oct 2023 22:07:51 +0200
Subject: [PATCH 3/5] Outline support for shr rendered documents

* lisp/net/shr.el
(shr-heading): Propertize heading with level
(shr-outline-search): outline-search-function that finds
headings using text property search
(shr-outline-level): outline level for shr-outline-search
---
 lisp/net/shr.el | 41 ++++++++++++++++++++++++++++++++++++++++-
 1 file changed, 40 insertions(+), 1 deletion(-)

diff --git a/lisp/net/shr.el b/lisp/net/shr.el
index adce66311f1..38a79107f68 100644
--- a/lisp/net/shr.el
+++ b/lisp/net/shr.el
@@ -1272,7 +1272,11 @@ shr-image-displayer
 
 (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)
@@ -2063,6 +2067,41 @@ shr-tag-bdi
   (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
-- 
2.42.0


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #5: 0004-Optionally-turn-on-visual-line-mode-outline-support.patch --]
[-- Type: text/x-patch, Size: 1305 bytes --]

From 4de3b0766550f5e308010a885397a72a26d40dee Mon Sep 17 00:00:00 2001
From: Rahguzar <rahguzar@zohomail.eu>
Date: Tue, 24 Oct 2023 23:35:44 +0200
Subject: [PATCH 4/5] Optionally turn on visual-line-mode + outline support

* lisp/net/eww.el
(eww-render): Turn on visual-line-mode in absence of filling
(eww-mode): set outline-regexp and outline-level
---
 lisp/net/eww.el | 4 ++++
 1 file changed, 4 insertions(+)

diff --git a/lisp/net/eww.el b/lisp/net/eww.el
index e43ef2bfe8b..3224c382d53 100644
--- a/lisp/net/eww.el
+++ b/lisp/net/eww.el
@@ -657,6 +657,8 @@ eww-render
 	      (setq eww-history-position 0)
 	      (and last-coding-system-used
 		   (set-buffer-file-coding-system last-coding-system-used))
+              (unless shr-fill-text
+                (visual-line-mode))
 	      (run-hooks 'eww-after-render-hook)
               ;; Enable undo again so that undo works in text input
               ;; boxes.
@@ -1217,6 +1219,8 @@ eww-mode
   (setq-local shr-url-transformer #'eww--transform-url)
   ;; Also rescale images when rescaling the text.
   (add-hook 'text-scale-mode-hook #'eww--rescale-images nil t)
+  (setq-local outline-search-function 'shr-outline-search
+              outline-level 'shr-outline-level)
   (setq buffer-read-only t))
 
 (defvar text-scale-mode)
-- 
2.42.0


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #6: 0005-Don-t-insert-subscript-on-a-newline.patch --]
[-- Type: text/x-patch, Size: 1038 bytes --]

From 4ef6bfccf2db22374ed43aaa6feebc2a3af60d64 Mon Sep 17 00:00:00 2001
From: Rahguzar <rahguzar@zohomail.eu>
Date: Wed, 25 Oct 2023 15:20:29 +0200
Subject: [PATCH 5/5] Don't insert subscript on a newline

* lisp/net/shr.el (shr-tag-sub): see above
---
 lisp/net/shr.el | 7 +++++++
 1 file changed, 7 insertions(+)

diff --git a/lisp/net/shr.el b/lisp/net/shr.el
index 38a79107f68..3e022df236c 100644
--- a/lisp/net/shr.el
+++ b/lisp/net/shr.el
@@ -1451,6 +1451,13 @@ shr-tag-sup
     (add-face-text-property start (point) 'shr-sup)))
 
 (defun shr-tag-sub (dom)
+  ;; Why would a subscript be at the beginning of a line?  It does
+  ;; happen sometimes because of a <br> tag and the intent seems to be
+  ;; alignment of subscript and superscript but I don't think that is
+  ;; possible in Emacs. So we remove the newline in that case.
+  (when (bolp)
+    (forward-char -1)
+    (delete-char 1))
   (let ((start (point)))
     (shr-generic dom)
     (put-text-property start (point) 'display `(raise ,shr-sub-raise-factor))
-- 
2.42.0