[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
bug#66676: 29.1; Should some aspects of shr rendering be configurable
|
From: |
Eli Zaretskii |
|
Subject: |
bug#66676: 29.1; Should some aspects of shr rendering be configurable |
|
Date: |
Sat, 04 Nov 2023 10:10:14 +0200 |
Lars, anybody else? Any comments to these changes?
> From: Rahguzar <rahguzar@zohomail.eu>
> Cc: Eli Zaretskii <eliz@gnu.org>, 66676@debbugs.gnu.org
> Date: Wed, 25 Oct 2023 18:18:06 +0200
>
> 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
>
>
>
> >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
>
>
> >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
>
>
> >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
>
>
> >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
>
>
>
> >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
>