From: Lars Magne Ingebrigtsen <larsi@gnus.org>
To: Stefan Monnier <monnier@iro.umontreal.ca>
Cc: Wolfgang Jenkner <wjenkner@inode.at>, Chong Yidong <cyd@gnu.org>,
emacs devel <emacs-devel@gnu.org>
Subject: Re: `add-face'
Date: Mon, 17 Jun 2013 09:54:26 +0200 [thread overview]
Message-ID: <m3mwqptbnx.fsf@stories.gnus.org> (raw)
In-Reply-To: <jwvehmajase.fsf-monnier+emacs@gnu.org> (Stefan Monnier's message of "Mon, 10 Sep 2012 08:57:52 -0400")
[-- Attachment #1: Type: text/plain, Size: 1510 bytes --]
Stefan Monnier <monnier@iro.umontreal.ca> writes:
>> This is too vague. What does "add the text properties" mean? If the
>> current value of a property is nil, and the argument to
>> add-text-properties specifies a value `foo', does the new value become
>> `foo' or `(foo)'? If the current value is `1', does the new value
>> become `(foo 1)' or something else?
>> And, specifically for face properties, what if the current value is a
>> list specifying an anonymous face, like `(:foreground "black")'?
>
> Yup, it's much better to provide a dedicated add-face-text-property.
I totally dropped the ball on this one, but was reminded when I
re-discovered that most of the time spent in shr.el when rendering
Wikipedia pages is doing manual face/overlay stuff.
I looked for the code for quite a while until I remembered that it was
on a laptop. I've now re-spun the code, and there is a dedicated
`add-face-text-property' function and anonymous face properties are
handled correctly.
But I'd still like to have the extended `add-text-properties' function,
because then shr.el can say
(add-text-properties start end
'(face underline shr-data :foo widget-stuff :blah)
nil t)
instead of splitting stuff up. For some reason or other, that speeds
stuff up by 20%...
But if the `add-text-properties' extension is a no-no, I can re-spin the
patch to not include that, but it'll entail a bit more code-change,
since the body of `add-text-properties' will have to be split up for
reuse.
Here's the patch:
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: prop2.patch --]
[-- Type: text/x-diff, Size: 7174 bytes --]
=== modified file 'src/editfns.c'
--- src/editfns.c 2013-05-18 05:32:17 +0000
+++ src/editfns.c 2013-06-17 07:15:47 +0000
@@ -3563,7 +3563,7 @@
Fadd_text_properties (make_number (0),
make_number (SCHARS (string)),
- properties, string);
+ properties, string, Qnil);
RETURN_UNGCPRO (string);
}
=== modified file 'src/minibuf.c'
--- src/minibuf.c 2013-05-04 19:27:41 +0000
+++ src/minibuf.c 2013-06-17 07:15:47 +0000
@@ -649,7 +649,7 @@
Fput_text_property (make_number (BEG), make_number (PT),
Qfield, Qt, Qnil);
Fadd_text_properties (make_number (BEG), make_number (PT),
- Vminibuffer_prompt_properties, Qnil);
+ Vminibuffer_prompt_properties, Qnil, Qnil);
}
unbind_to (count1, Qnil);
}
=== modified file 'src/textprop.c'
--- src/textprop.c 2013-06-17 06:03:19 +0000
+++ src/textprop.c 2013-06-17 07:43:38 +0000
@@ -370,7 +370,8 @@
are actually added to I's plist) */
static bool
-add_properties (Lisp_Object plist, INTERVAL i, Lisp_Object object)
+add_properties (Lisp_Object plist, INTERVAL i, Lisp_Object object,
+ bool replace)
{
Lisp_Object tail1, tail2, sym1, val1;
bool changed = 0;
@@ -416,7 +417,17 @@
}
/* I's property has a different value -- change it */
- Fsetcar (this_cdr, val1);
+ if (replace)
+ Fsetcar (this_cdr, val1);
+ else {
+ if (CONSP (Fcar (this_cdr)) &&
+ /* Special-case anonymous face properties. */
+ (! EQ (sym1, Qface) ||
+ NILP (Fkeywordp (Fcar (Fcar (this_cdr))))))
+ Fsetcar (this_cdr, Fcons (val1, Fcar (this_cdr)));
+ else
+ Fsetcar (this_cdr, Fcons (val1, Fcons (Fcar (this_cdr), Qnil)));
+ }
changed = 1;
break;
}
@@ -1127,20 +1138,24 @@
/* Callers note, this can GC when OBJECT is a buffer (or nil). */
DEFUN ("add-text-properties", Fadd_text_properties,
- Sadd_text_properties, 3, 4, 0,
+ Sadd_text_properties, 3, 5, 0,
doc: /* Add properties to the text from START to END.
The third argument PROPERTIES is a property list
specifying the property values to add. If the optional fourth argument
OBJECT is a buffer (or nil, which means the current buffer),
START and END are buffer positions (integers or markers).
If OBJECT is a string, START and END are 0-based indices into it.
+If NOREPLACE, add the text properties instead of replacing any
+existing ones. This is mainly useful for faces.
Return t if any property value actually changed, nil otherwise. */)
- (Lisp_Object start, Lisp_Object end, Lisp_Object properties, Lisp_Object object)
+ (Lisp_Object start, Lisp_Object end, Lisp_Object properties,
+ Lisp_Object object, Lisp_Object noreplace)
{
INTERVAL i, unchanged;
ptrdiff_t s, len;
bool modified = 0;
struct gcpro gcpro1;
+ bool replace = NILP (noreplace);
bool first_time = 1;
properties = validate_plist (properties);
@@ -1230,7 +1245,7 @@
if (LENGTH (i) == len)
{
- add_properties (properties, i, object);
+ add_properties (properties, i, object, replace);
if (BUFFERP (object))
signal_after_change (XINT (start), XINT (end) - XINT (start),
XINT (end) - XINT (start));
@@ -1241,7 +1256,7 @@
unchanged = i;
i = split_interval_left (unchanged, len);
copy_properties (unchanged, i);
- add_properties (properties, i, object);
+ add_properties (properties, i, object, replace);
if (BUFFERP (object))
signal_after_change (XINT (start), XINT (end) - XINT (start),
XINT (end) - XINT (start));
@@ -1249,7 +1264,7 @@
}
len -= LENGTH (i);
- modified |= add_properties (properties, i, object);
+ modified |= add_properties (properties, i, object, replace);
i = next_interval (i);
}
}
@@ -1268,7 +1283,7 @@
{
Fadd_text_properties (start, end,
Fcons (property, Fcons (value, Qnil)),
- object);
+ object, Qnil);
return Qnil;
}
@@ -1287,6 +1302,23 @@
}
+DEFUN ("add-face-text-property", Fadd_face_text_property,
+ Sadd_face_text_property, 3, 4, 0,
+ doc: /* Add the face property to the text from START to END.
+The third argument FACE specifies the face to add.
+If any text in the region already has any face properties, this new
+face property will be added to the front of the face property list.
+If the optional fourth argument OBJECT is a buffer (or nil, which means
+the current buffer), START and END are buffer positions (integers or
+markers). If OBJECT is a string, START and END are 0-based indices into it. */)
+ (Lisp_Object start, Lisp_Object end, Lisp_Object face, Lisp_Object object)
+{
+ Fadd_text_properties (start, end,
+ Fcons (Qface, Fcons (face, Qnil)),
+ object, Qt);
+ return Qnil;
+}
+
/* Replace properties of text from START to END with new list of
properties PROPERTIES. OBJECT is the buffer or string containing
the text. OBJECT nil means use the current buffer.
@@ -1893,7 +1925,7 @@
{
res = Fcar (stuff);
res = Fadd_text_properties (Fcar (res), Fcar (Fcdr (res)),
- Fcar (Fcdr (Fcdr (res))), dest);
+ Fcar (Fcdr (Fcdr (res))), dest, Qnil);
if (! NILP (res))
modified = 1;
stuff = Fcdr (stuff);
@@ -1984,7 +2016,7 @@
end = make_number (XINT (XCAR (XCDR (item))) + XINT (delta));
plist = XCAR (XCDR (XCDR (item)));
- Fadd_text_properties (start, end, plist, object);
+ Fadd_text_properties (start, end, plist, object, Qnil);
}
UNGCPRO;
@@ -2292,6 +2324,7 @@
DEFSYM (Qforeground, "foreground");
DEFSYM (Qbackground, "background");
DEFSYM (Qfont, "font");
+ DEFSYM (Qface, "face");
DEFSYM (Qstipple, "stipple");
DEFSYM (Qunderline, "underline");
DEFSYM (Qread_only, "read-only");
@@ -2326,6 +2359,7 @@
defsubr (&Sadd_text_properties);
defsubr (&Sput_text_property);
defsubr (&Sset_text_properties);
+ defsubr (&Sadd_face_text_property);
defsubr (&Sremove_text_properties);
defsubr (&Sremove_list_of_text_properties);
defsubr (&Stext_property_any);
=== modified file 'src/xdisp.c'
--- src/xdisp.c 2013-06-15 09:34:20 +0000
+++ src/xdisp.c 2013-06-17 07:15:47 +0000
@@ -11692,7 +11692,7 @@
else
end = i + 1;
Fadd_text_properties (make_number (i), make_number (end),
- props, f->desired_tool_bar_string);
+ props, f->desired_tool_bar_string, Qnil);
#undef PROP
}
@@ -20886,7 +20886,7 @@
props = Fplist_put (props, Qface, face);
}
Fadd_text_properties (make_number (0), make_number (len),
- props, lisp_string);
+ props, lisp_string, Qnil);
}
else
{
@@ -20913,7 +20913,7 @@
}
if (!NILP (props))
Fadd_text_properties (make_number (0), make_number (len),
- props, lisp_string);
+ props, lisp_string, Qnil);
}
if (len > 0)
@@ -20928,7 +20928,7 @@
lisp_string = Fmake_string (make_number (field_width), make_number (' '));
if (!NILP (props))
Fadd_text_properties (make_number (0), make_number (field_width),
- props, lisp_string);
+ props, lisp_string, Qnil);
mode_line_string_list = Fcons (lisp_string, mode_line_string_list);
n += field_width;
}
[-- Attachment #3: Type: text/plain, Size: 103 bytes --]
--
(domestic pets only, the antidote for overdose, milk.)
bloggy blog http://lars.ingebrigtsen.no/
next prev parent reply other threads:[~2013-06-17 7:54 UTC|newest]
Thread overview: 18+ messages / expand[flat|nested] mbox.gz Atom feed top
2012-09-06 15:51 `add-face' Lars Ingebrigtsen
2012-09-07 4:17 ` `add-face' Chong Yidong
2012-09-07 12:41 ` `add-face' Lars Ingebrigtsen
2012-09-07 13:31 ` `add-face' Chong Yidong
2012-09-07 13:46 ` `add-face' Lars Ingebrigtsen
2012-09-07 14:13 ` `add-face' Lars Ingebrigtsen
2012-09-09 6:47 ` `add-face' Chong Yidong
2012-09-09 17:31 ` `add-face' Lars Ingebrigtsen
2012-09-10 3:07 ` `add-face' Chong Yidong
2012-09-10 12:57 ` `add-face' Stefan Monnier
2012-10-24 18:56 ` `add-face' Lars Magne Ingebrigtsen
2013-06-17 7:54 ` Lars Magne Ingebrigtsen [this message]
2013-06-17 9:12 ` `add-face' Lars Magne Ingebrigtsen
2013-06-17 9:51 ` `add-face' Lars Magne Ingebrigtsen
2013-06-17 14:43 ` `add-face' Stefan Monnier
2013-06-17 15:29 ` `add-face' Lars Magne Ingebrigtsen
2012-10-24 18:54 ` `add-face' Lars Magne Ingebrigtsen
2012-09-07 20:10 ` `add-face' Johan Bockgård
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
List information: https://www.gnu.org/software/emacs/
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=m3mwqptbnx.fsf@stories.gnus.org \
--to=larsi@gnus.org \
--cc=cyd@gnu.org \
--cc=emacs-devel@gnu.org \
--cc=monnier@iro.umontreal.ca \
--cc=wjenkner@inode.at \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
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).