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: 3999 bytes --]

Hi Eli,

Eli Zaretskii <eliz@gnu.org> writes:

> Thanks.  Rahguzar, any followup to these comments?

I replied to the comments. Please let me know what is the preferred way
of preferred way of proceeding in that case.

> Please also see my minor comments below:
>
>> * 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
>
> This doesn't follow our conventions:
>
>   . identical entries should be grouped if possible (see below)
>   . descriptions of changes should be complete sentences: start with a
>   capital letter and end with a period
>   . symbols should be quoted 'like this'
>
> In this case, here's how to format the above descriptions:
>
> * lisp/net/shr.el (shr-fill-text, shr-sup-raise-factor)
> (shr-sub-raise-factor, shr-image-ascent): New custom variables.
> (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, shr-make-placeholder-image): Use
> 'shr-image-ascent'.
> (shr-tag-sup, shr-tag-sub): Use 'shr-sub-raise-factor'.
>
> Similar changes are needed in your other log messages.

Thanks! I have reworded all log messages. Hopefully they confirm to the
standards better now.

>> +(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."
>          ^                  ^
> Two commas missing there.

Fixed.

>> +(defcustom shr-sup-raise-factor 0.2
>> +  "The value of raise property for superscripts.
>> +Should be a number between 0 and 1."
>
> This is better:
>
>   Should be a non-negative float number between 0 and 1.

Fixed.

>> +(defcustom shr-sub-raise-factor -0.2
>> +  "The value of raise property for subscripts.
>> +Should be a number between 0 and -1."
>
> Likewise here (but "non-positive" instead of "non-negative").
>
>> +(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.
>
> Commas missing after "nil" in both sentences.
>
>> +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
>                                           ^^^^^^^^^^^^^^^^^
> "a floating point number"

Fixed.

>> +interpreted as multiples of the height of default font."
>                ^^^^^^^^^^^^
> "as a multiple"
>
>> @@ -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.
>
> "The trailing confuse can confuse" sounds strange, and is probably a
> typo of sorts.  What did you mean to say there?

I meant 'trailing space'. Fixed now.

Sorry for the typos and thanks for catching them.

>> * lisp/net/shr.el (shr-tag-sub): see above
>
> This is not a proper change description.  Either repeat the heading or
> include the file and function in the heading line (if they fit; they
> don't fit in this case, I think).
>
>> +  ;; possible in Emacs. So we remove the newline in that case.
>                          ^^
> Our convention is to leave 2 spaces between sentences, not one.

Fixed.

> Thanks.

I have attached the updated patches.

Thank you,
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: 4611 bytes --]

From 8ee415986687b406676baa5652954fc485d8adfd 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, shr-sup-raise-factor)
(shr-sub-raise-factor, shr-image-ascent): New custom variables.
(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, shr-make-placeholder-image): Use
'shr-image-ascent'.
(shr-tag-sup, shr-tag-sub): Use 'shr-sup/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..4e551663e9d 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 non-negative float 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 non-positive float 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.1


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

From b319b012a3da125ed78869dbd4db695edc701033 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--inline-image-p): New helper function to decide if an
image should be inserted inline.
(shr-insert, shr-put-image, shr-tag-img): Use
'shr-max-inline-image-size' to insert some images inline.
(shr-tag-img): Insert placeholder image by calling
'shr-put-image-function'.
---
 lisp/net/shr.el | 67 ++++++++++++++++++++++++++++++++++++++-----------
 1 file changed, 53 insertions(+), 14 deletions(-)

diff --git a/lisp/net/shr.el b/lisp/net/shr.el
index 4e551663e9d..27828903945 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 a float number , the limit is
+interpreted as a multiple 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-height (* max-height (frame-char-height))))
+      (and (< (car size) max-width)
+	   (< (cdr size) max-height)))))
+
 (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 space 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)))
@@ -1725,7 +1764,7 @@ shr-tag-img
 	      (when (file-exists-p file)
 		(delete-file file))))
           (when (image-type-available-p 'svg)
-            (insert-image
+            (funcall shr-put-image-function
              (shr-make-placeholder-image dom)
              (or alt "")))
           (insert " ")
-- 
2.42.1


[-- 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: 2610 bytes --]

From f34b38deb1397d4f2a9476efa470b3e7e1f07dc0 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):  An '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 27828903945..e5c4a909c1a 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.1


[-- 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: 1313 bytes --]

From bae66312a44b656dd3cb95d9607855b258bad14d 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 d8a66b2ce32..77bb6be2904 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.1


[-- 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: 1039 bytes --]

From 454d2039bae290c14dd52310f43ad4db3db9bbac 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 e5c4a909c1a..c48457ba21c 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.1