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 11:51:01 +0200 Organization: Programmerer Ingebrigtsen 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 1371462692 25418 80.91.229.3 (17 Jun 2013 09:51:32 GMT) X-Complaints-To: usenet@ger.gmane.org NNTP-Posting-Date: Mon, 17 Jun 2013 09:51:32 +0000 (UTC) To: emacs-devel@gnu.org Original-X-From: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Mon Jun 17 11:51:33 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 1UoW5z-0002X0-6E for ged-emacs-devel@m.gmane.org; Mon, 17 Jun 2013 11:51:31 +0200 Original-Received: from localhost ([::1]:52998 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1UoW5y-0005Dn-Q7 for ged-emacs-devel@m.gmane.org; Mon, 17 Jun 2013 05:51:30 -0400 Original-Received: from eggs.gnu.org ([2001:4830:134:3::10]:57549) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1UoW5q-0005Bg-UD for emacs-devel@gnu.org; Mon, 17 Jun 2013 05:51:28 -0400 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1UoW5k-0000SP-Di for emacs-devel@gnu.org; Mon, 17 Jun 2013 05:51:22 -0400 Original-Received: from plane.gmane.org ([80.91.229.3]:44818) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1UoW5k-0000S5-3M for emacs-devel@gnu.org; Mon, 17 Jun 2013 05:51:16 -0400 Original-Received: from list by plane.gmane.org with local (Exim 4.69) (envelope-from ) id 1UoW5e-0001sd-5z for emacs-devel@gnu.org; Mon, 17 Jun 2013 11:51:10 +0200 Original-Received: from cm-84.215.51.58.getinternet.no ([84.215.51.58]) by main.gmane.org with esmtp (Gmexim 0.1 (Debian)) id 1AlnuQ-0007hv-00 for ; Mon, 17 Jun 2013 11:51:10 +0200 Original-Received: from larsi by cm-84.215.51.58.getinternet.no with local (Gmexim 0.1 (Debian)) id 1AlnuQ-0007hv-00 for ; Mon, 17 Jun 2013 11:51:10 +0200 X-Injected-Via-Gmane: http://gmane.org/ Mail-Followup-To: emacs-devel@gnu.org Original-Lines: 202 Original-X-Complaints-To: usenet@ger.gmane.org X-Gmane-NNTP-Posting-Host: cm-84.215.51.58.getinternet.no Face: iVBORw0KGgoAAAANSUhEUgAAADAAAAAwBAMAAAClLOS0AAAAGFBMVEXr3tbrTDvicmDVqJv9 /fz5+fb////+//7yLuCGAAACLUlEQVQ4jW3TS3ObMBAA4DWKkisSdXvVI74LbdRePQ3QK2Os5OqZ YHH1TG3y9yuMH7iODgzoG620qwUCQfYzTEd7fEIgM1V9CYdcmtOS4gY2uZJHONTEVxNYrpSk67Lq VllqH6rwfoYGrdQyKzrQWbZwu19nKNe1wTjT/eacC5c8nCEGp5BlhlqdSs5Zur9A6JKMca50ppWy i+uKELyWWsk8R86kmKxoBTKuOD2UxHhRTEIRbqlP3kJYPnbmCNUIs4QQFGP6n/vQvZ0gzHKdgPd0 PRbmCgQ5lyxj8xHa6gStSRmXSvHnCXRFH3aiyRlT8gLD5svZ054SXSfGalysqwsom746n62xaIRB fBxgG0Ifq8SskspKFPOyqKsRuh5SzG2aScZy+31MpOzb0AVIjVbpsazJjxGqCG2AFYIQQuaWzebj lfvyEHyArTn1BsHxZRtLMEDX+3FiDycgvmxpH7+wNuVQpM8RDgC09R7CVmWcp/2l35YUX6oaIqSZ 1mICBul7TQfQQk1gh8SsNy6CIQJ1dYHagHkYoIXiT0EmQB2+7dzpjP4aylBAX5/hOjYQTwRwD6Eh QCh+AQReiUO4g5YYQgzWd7A1lDQOzT2AI7uvINSu+XCI4Mvido8G/h5B25f2iU5CreKK2C4Ai3rp xATQkM0AWxYb4Xmah4EPHEDJVH27Sd3EUBY28fr4fAqbCMZC45wbGnMyYCW0heEmlv9BMsDwj37e pggzo+0/Z49SUlok86QAAAAASUVORK5CYII= Mail-Copies-To: never X-Now-Playing: Boris's _The Thing Which Solomon Overlooked (chronicle) (4)_: "Howl Part 2" User-Agent: Gnus/5.130008 (Ma Gnus v0.8) Emacs/24.3.50 (gnu/linux) Cancel-Lock: sha1:g7ZsQucJ7Q7XWZVjM0lp1+Q+3wI= X-detected-operating-system: by eggs.gnu.org: Genre and OS details not recognized. X-Received-From: 80.91.229.3 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:160498 Archived-At: --=-=-= Content-Type: text/plain Here's the new version: --=-=-= Content-Type: text/x-diff Content-Disposition: inline; filename=props3.patch === modified file 'src/textprop.c' --- src/textprop.c 2013-06-17 06:03:19 +0000 +++ src/textprop.c 2013-06-17 09:49:56 +0000 @@ -60,6 +60,13 @@ static Lisp_Object Qread_only; Lisp_Object Qminibuffer_prompt; +enum property_set_type +{ + TEXT_PROPERTY_REPLACE, + TEXT_PROPERTY_PREPEND, + TEXT_PROPERTY_APPEND +}; + /* Sticky properties. */ Lisp_Object Qfront_sticky, Qrear_nonsticky; @@ -370,7 +377,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, + enum property_set_type set_type) { Lisp_Object tail1, tail2, sym1, val1; bool changed = 0; @@ -416,7 +424,30 @@ } /* I's property has a different value -- change it */ - Fsetcar (this_cdr, val1); + if (set_type == TEXT_PROPERTY_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)))))) + /* The previous value is a list, so prepend (or + append) the new value to this list. */ + if (set_type == TEXT_PROPERTY_PREPEND) + Fsetcar (this_cdr, Fcons (val1, Fcar (this_cdr))); + else + nconc2 (Fcar (this_cdr), Fcons (val1, Qnil)); + else { + /* The previous value is a single value, so make it + into a list. */ + if (set_type == TEXT_PROPERTY_PREPEND) + Fsetcar (this_cdr, + Fcons (val1, Fcons (Fcar (this_cdr), Qnil))); + else + Fsetcar (this_cdr, + Fcons (Fcar (this_cdr), Fcons (val1, Qnil))); + } + } changed = 1; break; } @@ -1124,19 +1155,12 @@ return make_number (previous->position + LENGTH (previous)); } -/* Callers note, this can GC when OBJECT is a buffer (or nil). */ +/* Used by add-text-properties and add-face-text-property. */ -DEFUN ("add-text-properties", Fadd_text_properties, - Sadd_text_properties, 3, 4, 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. -Return t if any property value actually changed, nil otherwise. */) - (Lisp_Object start, Lisp_Object end, Lisp_Object properties, Lisp_Object object) -{ +static Lisp_Object +add_text_properties_1 (Lisp_Object start, Lisp_Object end, + Lisp_Object properties, Lisp_Object object, + enum property_set_type set_type) { INTERVAL i, unchanged; ptrdiff_t s, len; bool modified = 0; @@ -1230,7 +1254,7 @@ if (LENGTH (i) == len) { - add_properties (properties, i, object); + add_properties (properties, i, object, set_type); if (BUFFERP (object)) signal_after_change (XINT (start), XINT (end) - XINT (start), XINT (end) - XINT (start)); @@ -1241,7 +1265,7 @@ unchanged = i; i = split_interval_left (unchanged, len); copy_properties (unchanged, i); - add_properties (properties, i, object); + add_properties (properties, i, object, set_type); if (BUFFERP (object)) signal_after_change (XINT (start), XINT (end) - XINT (start), XINT (end) - XINT (start)); @@ -1249,13 +1273,31 @@ } len -= LENGTH (i); - modified |= add_properties (properties, i, object); + modified |= add_properties (properties, i, object, set_type); i = next_interval (i); } } /* 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, + 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. +Return t if any property value actually changed, nil otherwise. */) + (Lisp_Object start, Lisp_Object end, Lisp_Object properties, + Lisp_Object object) +{ + return add_text_properties_1 (start, end, properties, object, + TEXT_PROPERTY_REPLACE); +} + +/* Callers note, this can GC when OBJECT is a buffer (or nil). */ + DEFUN ("put-text-property", Fput_text_property, Sput_text_property, 4, 5, 0, doc: /* Set one property of the text from START to END. @@ -1287,6 +1329,29 @@ } +DEFUN ("add-face-text-property", Fadd_face_text_property, + Sadd_face_text_property, 3, 5, 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 APPENDP is non-nil, append to the end +of the face property list instead. +If the optional fifth 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 appendp, Lisp_Object object) +{ + add_text_properties_1 (start, end, + Fcons (Qface, Fcons (face, Qnil)), + object, + NILP (appendp)? TEXT_PROPERTY_PREPEND: + TEXT_PROPERTY_APPEND); + 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. @@ -2292,6 +2357,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 +2392,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); --=-=-= Content-Type: text/plain -- (domestic pets only, the antidote for overdose, milk.) bloggy blog http://lars.ingebrigtsen.no/ --=-=-=--