From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.io!.POSTED.blaine.gmane.org!not-for-mail From: Eli Zaretskii Newsgroups: gmane.emacs.bugs Subject: bug#66676: 29.1; Should some aspects of shr rendering be configurable Date: Sat, 04 Nov 2023 10:10:14 +0200 Message-ID: <83lebe547t.fsf@gnu.org> References: <87v8azxek4.fsf@zohomail.eu> <83o7groufg.fsf@gnu.org> <87r0lnx7kx.fsf@zohomail.eu> <87zg06r7fk.fsf@zohomail.eu> Injection-Info: ciao.gmane.io; posting-host="blaine.gmane.org:116.202.254.214"; logging-data="22083"; mail-complaints-to="usenet@ciao.gmane.io" Cc: rahguzar@zohomail.eu, 66676@debbugs.gnu.org To: Lars Ingebrigtsen Original-X-From: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org Sat Nov 04 09:11:41 2023 Return-path: Envelope-to: geb-bug-gnu-emacs@m.gmane-mx.org Original-Received: from lists.gnu.org ([209.51.188.17]) by ciao.gmane.io with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.92) (envelope-from ) id 1qzBkq-0005aB-TV for geb-bug-gnu-emacs@m.gmane-mx.org; Sat, 04 Nov 2023 09:11:41 +0100 Original-Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1qzBkj-00035Z-72; Sat, 04 Nov 2023 04:11:34 -0400 Original-Received: from eggs.gnu.org ([2001:470:142:3::10]) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1qzBkc-00035A-Ad for bug-gnu-emacs@gnu.org; Sat, 04 Nov 2023 04:11:26 -0400 Original-Received: from debbugs.gnu.org ([2001:470:142:5::43]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1qzBkc-0001Xp-2U for bug-gnu-emacs@gnu.org; Sat, 04 Nov 2023 04:11:26 -0400 Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1qzBlC-00079O-2I for bug-gnu-emacs@gnu.org; Sat, 04 Nov 2023 04:12:02 -0400 X-Loop: help-debbugs@gnu.org Resent-From: Eli Zaretskii Original-Sender: "Debbugs-submit" Resent-CC: bug-gnu-emacs@gnu.org Resent-Date: Sat, 04 Nov 2023 08:12:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 66676 X-GNU-PR-Package: emacs Original-Received: via spool by 66676-submit@debbugs.gnu.org id=B66676.169908546327400 (code B ref 66676); Sat, 04 Nov 2023 08:12:02 +0000 Original-Received: (at 66676) by debbugs.gnu.org; 4 Nov 2023 08:11:03 +0000 Original-Received: from localhost ([127.0.0.1]:60402 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1qzBkD-00077g-Lx for submit@debbugs.gnu.org; Sat, 04 Nov 2023 04:11:02 -0400 Original-Received: from eggs.gnu.org ([2001:470:142:3::10]:36384) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1qzBkB-00077N-Lm for 66676@debbugs.gnu.org; Sat, 04 Nov 2023 04:11:00 -0400 Original-Received: from fencepost.gnu.org ([2001:470:142:3::e]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1qzBjV-0001O0-Ne; Sat, 04 Nov 2023 04:10:17 -0400 DKIM-Signature: v=1; a=rsa-sha256; q=dns/txt; c=relaxed/relaxed; d=gnu.org; s=fencepost-gnu-org; h=References:Subject:In-Reply-To:To:From:Date: mime-version; bh=pp6+Fhl8IGC2XEPBLrhGkEUrIRZU6EYdh855hTa7d/E=; b=MG06WZzqNIot p5QjhXNOEsJQBUj30NVNA7+OOYXNk4HtyLJmjczMPYch0LvROcZGroBCvJtElox49hRBsh7Yz3VNk FCgXx89P+n2K6GXGLpVnaZKn3SSqwDsQtcBLgfOUbbBogDRkUIvx1gVP5VADNoJz4finPAgHVvBrL g4aYsNHP9RuJf+C7zrK+HHJBfuoQn4RdPbnV/XVmo84yO8XxchaOGdRDqei7p0Ms2f9qf32uDTcSk 1xwDpLpV+N4FBpiplxYFDjMIggj8gYoA12DGHyJMmtPzd/jpmhOjc6sSMeEXK2mO6kLLEJnk5CVOA pv9+D3I5uhfUE6i6+iM6Vg==; In-Reply-To: <87zg06r7fk.fsf@zohomail.eu> (message from Rahguzar on Wed, 25 Oct 2023 18:18:06 +0200) X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-BeenThere: bug-gnu-emacs@gnu.org List-Id: "Bug reports for GNU Emacs, the Swiss army knife of text editors" List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org Original-Sender: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org Xref: news.gmane.io gmane.emacs.bugs:273748 Archived-At: Lars, anybody else? Any comments to these changes? > From: Rahguzar > Cc: Eli Zaretskii , 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
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 > 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 > 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 > 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 > 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 > 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
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 >