unofficial mirror of bug-gnu-emacs@gnu.org 
 help / color / mirror / code / Atom feed
* bug#35476: [PATCH] 27.0.50; font-lock-{append,prepend}-text-property and anonymous faces
@ 2019-04-28 17:11 Kévin Le Gouguec
  2019-04-30  6:08 ` bug#35476: Test suite Kévin Le Gouguec
  0 siblings, 1 reply; 9+ messages in thread
From: Kévin Le Gouguec @ 2019-04-28 17:11 UTC (permalink / raw)
  To: 35476; +Cc: Stefan Monnier, Nicolas Goaziou

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

Hello,

This is a follow-up to the mails I sent to emacs-orgmode[1] and
help-gnu-emacs[2].

tl;dr I believe font-lock-{append,prepend}-text-property do not handle
anonymous faces correctly: they splice their attributes, producing
lists mixing keyword attributes and named faces such as this one:

    (:strike-through t org-level-1)

The patch I attach changes this to:

    ((:strike-through t) org-level-1)

To summarize my findings:

1. With org.el from Emacs's master branch (commit 88c91f53df), in an
   Org buffer with a heading such as this one:

        * *foo* /bar/ _baz_ +quux+
  
   foo (resp. bar and baz) show both the heading face and the bold
   (resp. italic and underline) decoration, whereas quux only shows
   the strike-through decoration, without the heading face.

2. C-u C-x = on quux says:

    > face        (:strike-through t org-level-1)

   A hasty look at org.el showed that it used
   `font-lock-prepend-text-property`.  I sent a trivial patch to
   emacs-orgmode which uses `font-lock-append-text-property` instead,
   although I wasn't sure that it was sound.  With this patch, C-u
   C-x = says instead:
   
    > face        (org-level-1 :strike-through t)

   … and quux shows both the org-level-1 foreground and the
   strike-through decoration.

3. On help-gnu-emacs, Stefan confirmed that my patch relies on
   undefined behavior.

4. Meanwhile, Nicolas applied it to the org-mode repository (commit
   42abf5c69).

I have now come to the conclusion that a patch such as the one I
attached in this report might be more appropriate.

[-- Attachment #2: 0001-Refrain-from-splicing-anonymous-faces-in-text-proper.patch --]
[-- Type: text/x-diff, Size: 3710 bytes --]

From 7990c65193473784bae6769ae9a2baf233234269 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?K=C3=A9vin=20Le=20Gouguec?= <kevin.legouguec@gmail.com>
Date: Sun, 28 Apr 2019 18:48:36 +0200
Subject: [PATCH] Refrain from splicing anonymous faces in text properties
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

Otherwise named faces that follow are not displayed anymore.  E.g. in
an Org buffer with this content:

    * /foo/ *bar* _baz_ +quux+

Before this commit, the 'face property on quux was:

    (:strike-through t org-level-1)

… and the org-level-1 foreground was not displayed.  This commit makes
the 'face property become:

    ((:strike-through t) org-level-1)

… which lets quux display both the strike-through decoration and the
org-level-1 foreground.

* lisp/font-lock.el (font-lock-append-text-property)
(font-lock-prepend-text-property): Wrap anonymous faces in a
single-elemnt list so that `append' does not splice them.
---
 lisp/font-lock.el | 22 ++++++++++++++++++----
 1 file changed, 18 insertions(+), 4 deletions(-)

diff --git a/lisp/font-lock.el b/lisp/font-lock.el
index 1475911195..e0e55d859d 100644
--- a/lisp/font-lock.el
+++ b/lisp/font-lock.el
@@ -1392,16 +1392,23 @@ font-lock-prepend-text-property
 Arguments PROP and VALUE specify the property and value to prepend to the value
 already in place.  The resulting property values are always lists.
 Optional argument OBJECT is the string or buffer containing the text."
-  (let ((val (if (listp value) value (list value))) next prev)
+  (let ((val (if (listp value) value (list value)))
+        (is-face-prop (memq prop '(face font-lock-face)))
+        next prev)
     (while (/= start end)
       (setq next (next-single-property-change start prop object end)
 	    prev (get-text-property start prop object))
       ;; Canonicalize old forms of face property.
-      (and (memq prop '(face font-lock-face))
+      (and is-face-prop
 	   (listp prev)
 	   (or (keywordp (car prev))
 	       (memq (car prev) '(foreground-color background-color)))
 	   (setq prev (list prev)))
+      ;; Wrap an anonymous face into a single-element list, so that
+      ;; `append' does not splice it.
+      (and is-face-prop
+           (keywordp (car val))
+           (setq val (list val)))
       (put-text-property start next prop
 			 (append val (if (listp prev) prev (list prev)))
 			 object)
@@ -1412,16 +1419,23 @@ font-lock-append-text-property
 Arguments PROP and VALUE specify the property and value to append to the value
 already in place.  The resulting property values are always lists.
 Optional argument OBJECT is the string or buffer containing the text."
-  (let ((val (if (listp value) value (list value))) next prev)
+  (let ((val (if (listp value) value (list value)))
+        (is-face-prop (memq prop '(face font-lock-face)))
+        next prev)
     (while (/= start end)
       (setq next (next-single-property-change start prop object end)
 	    prev (get-text-property start prop object))
       ;; Canonicalize old forms of face property.
-      (and (memq prop '(face font-lock-face))
+      (and is-face-prop
 	   (listp prev)
 	   (or (keywordp (car prev))
 	       (memq (car prev) '(foreground-color background-color)))
 	   (setq prev (list prev)))
+      ;; Wrap an anonymous face into a single-element list, so that
+      ;; `append' does not splice it.
+      (and is-face-prop
+           (keywordp (car val))
+           (setq val (list val)))
       (put-text-property start next prop
 			 (append (if (listp prev) prev (list prev)) val)
 			 object)
-- 
2.20.1


[-- Attachment #3: Type: text/plain, Size: 7033 bytes --]


I am not an expert on font-lock though, so this patch might not be
correct.  <excuses>Also, since I'm on a laptop running on battery
power, I don't intend to run make check right now.</excuses>  I am
sharing this patch in case someone well-versed in font-lock finds it
"obviously correct".

If that is the case, I have two more questions for additional patches:

1. Would it make sense to stuff most of these two functions's code
   into a third function called e.g.

        font-lock--add-text-property (start end prop value object append)

   in order to reduce duplication?

2. I guess some new automated tests would be appreciated?


Thank you for your time.

Kévin


[1]: http://lists.gnu.org/archive/html/emacs-orgmode/2019-04/msg00101.html
[2]: http://lists.gnu.org/archive/html/help-gnu-emacs/2019-04/msg00240.html



In GNU Emacs 27.0.50 (build 1, i686-pc-linux-gnu, GTK+ Version 3.22.11)
 of 2019-04-18 built on nc10-laptop
Repository revision: a18336a8dc754fa1c68e16dd8009466cf409271b
Repository branch: master
Windowing system distributor 'The X.Org Foundation', version 11.0.11902000
System Description: BunsenLabs GNU/Linux 9.8 (Helium)

Recent messages:
Saving file /home/peniblec/drafts/font-lock.md...
Wrote /home/peniblec/drafts/font-lock.md
Saving file /home/peniblec/drafts/font-lock.md...
Wrote /home/peniblec/drafts/font-lock.md
Mark set
Saving file /home/peniblec/drafts/font-lock.md...
Wrote /home/peniblec/drafts/font-lock.md
next-line: End of buffer [4 times]
Mark set [3 times]
Undo!

Configured using:
 'configure --with-xwidgets'

Configured features:
XPM JPEG TIFF GIF PNG RSVG IMAGEMAGICK SOUND GPM DBUS GSETTINGS GLIB
NOTIFY INOTIFY ACL LIBSELINUX GNUTLS LIBXML2 FREETYPE M17N_FLT LIBOTF
XFT ZLIB TOOLKIT_SCROLL_BARS GTK3 X11 XDBE XIM THREADS XWIDGETS JSON
PDUMPER LCMS2 GMP

Important settings:
  value of $LANG: en_US.UTF-8
  locale-coding-system: utf-8-unix

Major mode: Markdown

Minor modes in effect:
  global-magit-file-mode: t
  magit-file-mode: t
  magit-auto-revert-mode: t
  global-git-commit-mode: t
  async-bytecomp-package-mode: t
  shell-dirtrack-mode: t
  show-paren-mode: t
  minibuffer-depth-indicate-mode: t
  icomplete-mode: t
  global-page-break-lines-mode: t
  page-break-lines-mode: t
  electric-pair-mode: t
  diff-hl-flydiff-mode: t
  global-diff-hl-mode: t
  diff-hl-mode: t
  delete-selection-mode: t
  tooltip-mode: t
  global-eldoc-mode: t
  eldoc-mode: t
  electric-indent-mode: t
  mouse-wheel-mode: t
  file-name-shadow-mode: t
  global-font-lock-mode: t
  font-lock-mode: t
  blink-cursor-mode: t
  auto-composition-mode: t
  auto-encryption-mode: t
  auto-compression-mode: t
  column-number-mode: t
  line-number-mode: t
  auto-fill-function: do-auto-fill
  visual-line-mode: t
  transient-mark-mode: t

Load-path shadows:
None found.

Features:
(shadow emacsbug dired-aux help-fns radix-tree cl-print debug backtrace
flyspell ediff-merg ediff-wind ediff-diff ediff-mult ediff-help
ediff-init ediff-util ediff vc-mtn vc-hg org-indent org-rmail org-mhe
org-irc org-info org-gnus org-docview doc-view jka-compr image-mode
org-bibtex bibtex org-bbdb org-w3m org-element avl-tree generator org
org-macro org-footnote org-pcomplete org-list org-faces org-entities
org-version ob-emacs-lisp ob ob-tangle org-src ob-ref ob-lob ob-table
ob-keys ob-exp ob-comint ob-core ob-eval org-compat org-macs
org-loaddefs find-func cal-menu calendar cal-loaddefs ispell magit-patch
cus-edit whitespace bug-reference diff-hl-dired mailalias smtpmail
sendmail nnir markdown-mode rx color thingatpt noutline outline misearch
multi-isearch magit-extras executable magit-submodule magit-obsolete
magit-blame magit-stash magit-bisect magit-push magit-pull magit-fetch
magit-clone magit-remote magit-commit magit-sequence magit-notes
magit-worktree magit-tag magit-merge magit-branch magit-reset
magit-files magit-refs magit-status magit magit-repos magit-apply
magit-wip magit-log which-func imenu magit-diff smerge-mode magit-core
magit-autorevert autorevert filenotify magit-margin magit-transient
magit-process magit-mode transient git-commit magit-git magit-section
magit-utils crm log-edit pcvs-util add-log with-editor async-bytecomp
async shell pcomplete server dash sort gnus-cite mail-extr gnus-async
gnus-bcklg qp gnus-ml nndraft nnmh nnfolder utf-7 epa-file gnutls
network-stream nsm gnus-agent gnus-srvr gnus-score score-mode nnvirtual
gnus-msg gnus-art mm-uu mml2015 mm-view mml-smime smime dig mailcap nntp
gnus-cache gnus-sum gnus-group gnus-undo gnus-start gnus-cloud nnimap
nnmail mail-source utf7 netrc nnoo parse-time gnus-spec gnus-int
gnus-range message rmc puny dired dired-loaddefs format-spec rfc822 mml
mml-sec epa derived epg mm-decode mm-bodies mm-encode mail-parse rfc2231
mailabbrev gmm-utils mailheader gnus-win gnus nnheader gnus-util rmail
rmail-loaddefs rfc2047 rfc2045 ietf-drums text-property-search time-date
mail-utils mm-util mail-prsvr wid-edit vc-git vc-bzr vc-src vc-sccs
vc-svn vc-cvs vc-rcs project delight advice eighters-theme quail
cl-extra help-mode rg rg-ibuffer rg-result wgrep-rg wgrep s rg-history
rg-header rg-compat ibuf-ext ibuffer ibuffer-loaddefs grep compile
comint ansi-color ring edmacro kmacro disp-table paren mb-depth
icomplete page-break-lines elec-pair diff-hl-flydiff diff diff-hl vc-dir
ewoc vc vc-dispatcher diff-mode easy-mmode delsel cus-start cus-load
mule-util tex-site info package easymenu epg-config url-handlers
url-parse auth-source cl-seq eieio eieio-core cl-macs eieio-loaddefs
password-cache json subr-x map url-vars seq byte-opt gv bytecomp
byte-compile cconv cl-loaddefs cl-lib tooltip eldoc electric uniquify
ediff-hook vc-hooks lisp-float-type mwheel term/x-win x-win
term/common-win x-dnd tool-bar dnd fontset image regexp-opt fringe
tabulated-list replace newcomment text-mode elisp-mode lisp-mode
prog-mode register page menu-bar rfn-eshadow isearch timer select
scroll-bar mouse jit-lock font-lock syntax facemenu font-core
term/tty-colors frame cl-generic cham georgian utf-8-lang misc-lang
vietnamese tibetan thai tai-viet lao korean japanese eucjp-ms cp51932
hebrew greek romanian slovak czech european ethiopic indian cyrillic
chinese composite charscript charprop case-table epa-hook jka-cmpr-hook
help simple abbrev obarray minibuffer cl-preloaded nadvice loaddefs
button faces cus-face macroexp files text-properties overlay sha1 md5
base64 format env code-pages mule custom widget hashtable-print-readable
backquote threads dbusbind inotify lcms2 dynamic-setting
system-font-setting font-render-setting xwidget-internal move-toolbar
gtk x-toolkit x multi-tty make-network-process emacs)

Memory information:
((conses 8 340103 79587)
 (symbols 24 31862 1)
 (strings 16 105392 12481)
 (string-bytes 1 3497604)
 (vectors 8 55552)
 (vector-slots 4 1313923 80148)
 (floats 8 495 324)
 (intervals 28 3532 1391)
 (buffers 564 52))

^ permalink raw reply related	[flat|nested] 9+ messages in thread
end of thread, other threads:[~2019-05-14  6:01 UTC | newest]

Thread overview: 9+ messages (download: mbox.gz follow: Atom feed
-- links below jump to the message on this page --
2019-04-28 17:11 bug#35476: [PATCH] 27.0.50; font-lock-{append,prepend}-text-property and anonymous faces Kévin Le Gouguec
2019-04-30  6:08 ` bug#35476: Test suite Kévin Le Gouguec
2019-05-07  5:24   ` bug#35476: [BUMP] Some questions before closing Kévin Le Gouguec
2019-05-12 12:28     ` bug#35476: font-lock-{append, prepend}-text-property and anonymous faces Noam Postavsky
2019-05-12 17:34       ` Kévin Le Gouguec
2019-05-12 19:09         ` Noam Postavsky
2019-05-12 21:51           ` Kévin Le Gouguec
2019-05-14  1:01         ` Noam Postavsky
2019-05-14  6:01           ` Kévin Le Gouguec

Code repositories for project(s) associated with this public inbox

	https://git.savannah.gnu.org/cgit/emacs.git

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).