From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.io!.POSTED.blaine.gmane.org!not-for-mail From: Rahguzar via "Bug reports for GNU Emacs, the Swiss army knife of text editors" Newsgroups: gmane.emacs.bugs Subject: bug#66676: 29.1; Should some aspects of shr rendering be configurable Date: Wed, 25 Oct 2023 18:18:06 +0200 Message-ID: <87zg06r7fk.fsf@zohomail.eu> References: <87v8azxek4.fsf@zohomail.eu> <83o7groufg.fsf@gnu.org> <87r0lnx7kx.fsf@zohomail.eu> Reply-To: Rahguzar Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" Injection-Info: ciao.gmane.io; posting-host="blaine.gmane.org:116.202.254.214"; logging-data="23461"; mail-complaints-to="usenet@ciao.gmane.io" User-Agent: mu4e 1.10.7; emacs 29.1 Cc: Eli Zaretskii , 66676@debbugs.gnu.org To: Rahguzar Original-X-From: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org Wed Oct 25 18:31:57 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 1qvgnU-0005xG-LE for geb-bug-gnu-emacs@m.gmane-mx.org; Wed, 25 Oct 2023 18:31:56 +0200 Original-Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1qvgn8-00030S-Rq; Wed, 25 Oct 2023 12:31: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 1qvgn6-0002zy-R3 for bug-gnu-emacs@gnu.org; Wed, 25 Oct 2023 12:31:32 -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 1qvgn6-000203-It for bug-gnu-emacs@gnu.org; Wed, 25 Oct 2023 12:31:32 -0400 Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1qvgna-0004ZU-GB for bug-gnu-emacs@gnu.org; Wed, 25 Oct 2023 12:32:02 -0400 X-Loop: help-debbugs@gnu.org Resent-From: Rahguzar Original-Sender: "Debbugs-submit" Resent-CC: bug-gnu-emacs@gnu.org Resent-Date: Wed, 25 Oct 2023 16:32: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.169825147417514 (code B ref 66676); Wed, 25 Oct 2023 16:32:02 +0000 Original-Received: (at 66676) by debbugs.gnu.org; 25 Oct 2023 16:31:14 +0000 Original-Received: from localhost ([127.0.0.1]:59898 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1qvgmm-0004YP-Sf for submit@debbugs.gnu.org; Wed, 25 Oct 2023 12:31:13 -0400 Original-Received: from sender11-pp-o91.zoho.eu ([31.186.226.249]:25157) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1qvgmi-0004YD-KW for 66676@debbugs.gnu.org; Wed, 25 Oct 2023 12:31:11 -0400 ARC-Seal: i=1; a=rsa-sha256; t=1698251427; cv=none; d=zohomail.eu; s=zohoarc; b=kB34zn+98qQV3ZGgo+W9NsMX7/+6H+7mR5epGihnRdhk/oGGk+HvcU+h3kg6zektfC+3YyqaqPgfAubWRSkxzsRrK3JhvUXCD8Hdbh6XWYxijdxVfpzASUn5CUE2LNeWM5e8sUB0i2UYzhyPBhErr4sXyhOvsyZ/7QluAXPADIo= ARC-Message-Signature: i=1; a=rsa-sha256; c=relaxed/relaxed; d=zohomail.eu; s=zohoarc; t=1698251427; h=Content-Type:Cc:Cc:Date:Date:From:From:In-Reply-To:MIME-Version:Message-ID:References:Subject:Subject:To:To:Message-Id:Reply-To; bh=IJTCDvn/JMNE8N742tGdLphu0zloQiG0iHiAOAegxAc=; b=HZqTcbgo0zLq52SK3SAxROBFlg5fza/Z775NXzNNIjp07S2lv45OwTvMcVNTP45ZkmOEcbercpq4KKfdMntVf7eEveAYtx7xIZs4eMBvsQDz2k+f6UPtLZcepoEppOQilvciz14I7VDRC12+piEp/i+XJi0mxspeLaYxRsPXyfU= ARC-Authentication-Results: i=1; mx.zohomail.eu; dkim=pass header.i=zohomail.eu; spf=pass smtp.mailfrom=rahguzar@zohomail.eu; dmarc=pass header.from= DKIM-Signature: v=1; a=rsa-sha256; q=dns/txt; c=relaxed/relaxed; t=1698251427; s=zoho; d=zohomail.eu; i=rahguzar@zohomail.eu; h=References:From:From:To:To:Cc:Cc:Subject:Subject:Date:Date:In-reply-to:Message-ID:MIME-Version:Content-Type:Message-Id:Reply-To; bh=IJTCDvn/JMNE8N742tGdLphu0zloQiG0iHiAOAegxAc=; b=Hdtef13e+pxbm/j6YXqBRHAmAiRUkH90xBRgTTCnDGlGYyZ6BeObMSeiuoNwCOCq UoiCor8UGtnZe1n568N8DSU+yQF+T7HkqjCQeQUaSOGRB+sLOwxRpnlCKc4homiO4Gr r98Rm/8iciJs/wRdiAyMZREcpp25Yd2X03FiEDaE= Original-Received: from localhost (emp-94-58.eduroam.uu.se [130.238.94.58]) by mx.zoho.eu with SMTPS id 169825142423787.87242587962828; Wed, 25 Oct 2023 18:30:24 +0200 (CEST) In-reply-to: <87r0lnx7kx.fsf@zohomail.eu> X-Zoho-Virus-Status: 1 X-ZohoMailClient: External 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:273199 Archived-At: --=-=-= Content-Type: text/plain 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 --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0001-Make-some-aspects-of-shr-rendering-customizable.patch >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 --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0002-Allow-displaying-images-inline.patch >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 --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0003-Outline-support-for-shr-rendered-documents.patch >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 --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0004-Optionally-turn-on-visual-line-mode-outline-support.patch >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 --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0005-Don-t-insert-subscript-on-a-newline.patch >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 --=-=-=--