From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!not-for-mail From: Lars Magne Ingebrigtsen Newsgroups: gmane.emacs.devel Subject: Re: `add-face' Date: Mon, 17 Jun 2013 09:54:26 +0200 Message-ID: References: <87harbgnez.fsf@gnus.org> <87wr06tqj9.fsf@gnu.org> <87wr06gg30.fsf@gnus.org> <87pq5yq7sb.fsf@gnu.org> <87r4qegd3w.fsf@gnus.org> <87pq5vvgjj.fsf@gnu.org> <87bohf14s2.fsf@gnus.org> <87zk4y379i.fsf@gnu.org> NNTP-Posting-Host: plane.gmane.org Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" X-Trace: ger.gmane.org 1371455697 16858 80.91.229.3 (17 Jun 2013 07:54:57 GMT) X-Complaints-To: usenet@ger.gmane.org NNTP-Posting-Date: Mon, 17 Jun 2013 07:54:57 +0000 (UTC) Cc: Wolfgang Jenkner , Chong Yidong , emacs devel To: Stefan Monnier Original-X-From: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Mon Jun 17 09:54:58 2013 Return-path: Envelope-to: ged-emacs-devel@m.gmane.org Original-Received: from lists.gnu.org ([208.118.235.17]) by plane.gmane.org with esmtp (Exim 4.69) (envelope-from ) id 1UoUH9-000106-JN for ged-emacs-devel@m.gmane.org; Mon, 17 Jun 2013 09:54:55 +0200 Original-Received: from localhost ([::1]:57175 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1UoUH8-0002Qf-W0 for ged-emacs-devel@m.gmane.org; Mon, 17 Jun 2013 03:54:54 -0400 Original-Received: from eggs.gnu.org ([2001:4830:134:3::10]:54625) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1UoUH0-0002QK-JG for emacs-devel@gnu.org; Mon, 17 Jun 2013 03:54:50 -0400 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1UoUGx-0000E3-57 for emacs-devel@gnu.org; Mon, 17 Jun 2013 03:54:46 -0400 Original-Received: from hermes.netfonds.no ([80.91.224.195]:43772) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1UoUGw-0000Dq-RI; Mon, 17 Jun 2013 03:54:43 -0400 Original-Received: from cm-84.215.51.58.getinternet.no ([84.215.51.58] helo=stories.gnus.org) by hermes.netfonds.no with esmtpsa (TLS1.0:DHE_RSA_AES_128_CBC_SHA1:16) (Exim 4.72) (envelope-from ) id 1UoUGg-0000jN-KI; Mon, 17 Jun 2013 09:54:26 +0200 Face: iVBORw0KGgoAAAANSUhEUgAAADAAAAAwBAMAAAClLOS0AAAAHlBMVEWgm4zc4+vu9PlXUk3j 6/MxMDBsZ18TExQiIiJDQ0KOXSsuAAACW0lEQVQ4jZWTy2rjMBSGFUIDs4uGMPuWPMDAoaJaJvgB CkKxvGsR1pB1yThZG9XybkD4oredI9lpp4VhmB9Hxufzuf0mBJhBgfkoDSSgOrykQ9kwSbqGqKo6 V9XlHm/OtRphuhDEN9vSSaExLx5RPCedxDIgBcM+Wgem8QaeD6QLUhxkAb1hnD0Zji8w7WNGJ+VD DRwYD/Ckj0EDsFhKolToQ4cdZa8ND/4NqELDGGdw0oPhHngEVkrLTOmcN7qz0vNjmICTynqjXDKg tILp4CfgXA1j009WPEiGtcIMDkX+cjXJCQPTgrg/yIo9kTml0JhQIFBF3Q+nd1ttb6YMNRa+eY0h VUSixBWoAzQ4knbocaqFQwX0SilWnjEwPBIyHIy5l6ATwPXusYV+WeFxMZpbdCRZ0ooBh/3xuKxe vuQMeOoee9gQQW7U2T0OdQI+9bAhr0GfmQPVjhcAiRk+gbIRAOdOhMLlJwCckifQQo6gygslVIVg FBMYWx8zqkaoOp/A3Lz1mKGrpuZeKZx3LNgMGLpg3GDhqG5wvk7MwJoRrZLi5Opav5LFCq576OEn LtgPLv9VPu/v7tZxD9zc+hELlMKow4p/3dLNZj0BFzr0ilg0cvmdkPVisewn28VYGUJuLgzYehW/ 5JEld8GwFUEdOSOUrCIw/jgQQVJ4kQ4az1hyORBKaYajvGub3WLsG9l8DCeS7RLIPoHsDez/lvH/ 4FOT7B+ARrLdpgpYdZ+leASoXXzKNongj9IrwOXpbkPpLU1b7/4An7WOYJuqf1DMmP98kMQMm5/C b9n0b1QC3X9HAAAAAElFTkSuQmCC X-Now-Playing: Boris's _Vein (2)_: "(untitled)" X-Hashcash: 1:23:130617:monnier@iro.umontreal.ca::xW+K5xOqeAKGjUuK:0000000000000000000000000000000000000CMNY X-Hashcash: 1:23:130617:wjenkner@inode.at::jmsxkftvbajxp0mn:00000000000000000000000000000000000000000000OGpA X-Hashcash: 1:23:130617:cyd@gnu.org::Qa4wAI+g6GN1DcL2:000000RGt5 In-Reply-To: (Stefan Monnier's message of "Mon, 10 Sep 2012 08:57:52 -0400") User-Agent: Gnus/5.130008 (Ma Gnus v0.8) Emacs/24.3.50 (gnu/linux) X-MailScanner-ID: 1UoUGg-0000jN-KI MailScanner-NULL-Check: 1372060467.66758@7vwZj+3GlY6UDUjxrVS1Bg X-detected-operating-system: by eggs.gnu.org: Genre and OS details not recognized. X-Received-From: 80.91.224.195 X-BeenThere: emacs-devel@gnu.org X-Mailman-Version: 2.1.14 Precedence: list List-Id: "Emacs development discussions." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Original-Sender: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Xref: news.gmane.org gmane.emacs.devel:160494 Archived-At: --=-=-= Content-Type: text/plain Stefan Monnier 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: --=-=-= Content-Type: text/x-diff Content-Disposition: inline; filename=prop2.patch === 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; } --=-=-= Content-Type: text/plain -- (domestic pets only, the antidote for overdose, milk.) bloggy blog http://lars.ingebrigtsen.no/ --=-=-=--