[COMMIT] implement next-single-char-property-change and friends

NOTE: This patch has been committed. src/ChangeLog addition: 2005-01-25 Ben Wing <ben(a)xemacs.org&gt; * extents.c: * extents.c (next_previous_single_property_change): * extents.c (next_previous_single_property_change_fn): * extents.c (syms_of_extents): * extents.h: * indent.c (last_visible_position): * syntax.c (update_syntax_cache): Implement next/previous-single-char-property-change and make next/previous-single-property-change work like in FSF. splash-screen-change source patch: Diff command: bash -ci "cvs-diff --show-c-function -no-changelog " Files affected: src/syntax.c src/indent.c src/extents.h src/extents.c cvs server: Diffing . cvs server: Diffing dynodump cvs server: Diffing dynodump/i386 cvs server: Diffing dynodump/ppc cvs server: Diffing dynodump/sparc cvs server: Diffing etc cvs server: Diffing etc/custom cvs server: Diffing etc/custom/example-themes cvs server: Diffing etc/eos cvs server: Diffing etc/idd cvs server: Diffing etc/photos cvs server: Diffing etc/sparcworks cvs server: Diffing etc/tests cvs server: Diffing etc/tests/external-widget cvs server: Diffing etc/toolbar cvs server: Diffing etc/unicode cvs server: Diffing etc/unicode/ibm cvs server: Diffing etc/unicode/mule-ucs cvs server: Diffing etc/unicode/other cvs server: Diffing etc/unicode/unicode-consortium cvs server: Diffing info cvs server: Diffing lib-src cvs server: Diffing lisp cvs server: Diffing lisp/mule cvs server: Diffing lisp/term cvs server: Diffing lock cvs server: Diffing lwlib cvs server: Diffing man cvs server: Diffing man/internals cvs server: Diffing man/lispref cvs server: Diffing man/new-users-guide cvs server: Diffing man/xemacs cvs server: Diffing modules cvs server: Diffing modules/base64 cvs server: Diffing modules/common cvs server: Diffing modules/ldap cvs server: Diffing modules/postgresql cvs server: Diffing modules/sample cvs server: Diffing modules/sample/external cvs server: Diffing modules/sample/internal cvs server: Diffing modules/zlib cvs server: Diffing netinstall Index: src/extents.c =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/extents.c,v retrieving revision 1.54 diff -u -p -r1.54 extents.c --- src/extents.c 2005/01/24 23:33:53 1.54 +++ src/extents.c 2005/01/26 05:09:02 ＠＠ -1,6 +1,6 ＠＠ /* Copyright (c) 1994, 1995 Free Software Foundation, Inc. Copyright (c) 1995 Sun Microsystems, Inc. - Copyright (c) 1995, 1996, 2000, 2002, 2003 Ben Wing. + Copyright (c) 1995, 1996, 2000, 2002, 2003, 2004, 2005 Ben Wing. This file is part of XEmacs. ＠＠ -7081,21 +7081,28 ＠＠ Used as the `paste-function' property of } Bytexpos -next_single_property_change (Bytexpos pos, Lisp_Object prop, - Lisp_Object object, Bytexpos limit) +next_previous_single_property_change (Bytexpos pos, Lisp_Object prop, + Lisp_Object object, Bytexpos limit, + Boolint next, Boolint text_props_only) { Lisp_Object extent, value; int limit_was_nil; - + enum extent_at_flag at_flag = next ? EXTENT_AT_AFTER : EXTENT_AT_BEFORE; if (limit < 0) { - limit = buffer_or_string_accessible_end_byte (object); + limit = (next ? buffer_or_string_accessible_end_byte : + buffer_or_string_accessible_begin_byte) (object); limit_was_nil = 1; } else limit_was_nil = 0; - extent = extent_at (pos, object, prop, 0, EXTENT_AT_AFTER, 0); + /* Retrieve initial property value to compare against */ + extent = extent_at (pos, object, prop, 0, at_flag, 0); + /* If we only want text-prop extents, ignore all others */ + if (text_props_only && !NILP (extent) && + NILP (Fextent_property (extent, Qtext_prop, Qnil))) + extent = Qnil; if (!NILP (extent)) value = Fextent_property (extent, prop, Qnil); else ＠＠ -7103,10 +7110,15 ＠＠ next_single_property_change (Bytexpos po while (1) { - pos = extent_find_end_of_run (object, pos, 1); - if (pos >= limit) - break; /* property is the same all the way to the end */ - extent = extent_at (pos, object, prop, 0, EXTENT_AT_AFTER, 0); + pos = (next ? extent_find_end_of_run : extent_find_beginning_of_run) + (object, pos, 1); + if (next ? pos >= limit : pos <= limit) + break; /* property is the same all the way to the beginning/end */ + extent = extent_at (pos, object, prop, 0, at_flag, 0); + /* If we only want text-prop extents, ignore all others */ + if (text_props_only && !NILP (extent) && + NILP (Fextent_property (extent, Qtext_prop, Qnil))) + extent = Qnil; if ((NILP (extent) && !NILP (value)) || (!NILP (extent) && !EQ (value, Fextent_property (extent, prop, Qnil)))) ＠＠ -7119,43 +7131,24 ＠＠ next_single_property_change (Bytexpos po return limit; } -Bytexpos -previous_single_property_change (Bytexpos pos, Lisp_Object prop, - Lisp_Object object, Bytexpos limit) +static Lisp_Object +next_previous_single_property_change_fn (Lisp_Object pos, Lisp_Object prop, + Lisp_Object object, Lisp_Object limit, + Boolint next, Boolint text_props_only) { - Lisp_Object extent, value; - int limit_was_nil; - - if (limit < 0) - { - limit = buffer_or_string_accessible_begin_byte (object); - limit_was_nil = 1; - } - else - limit_was_nil = 0; - - extent = extent_at (pos, object, prop, 0, EXTENT_AT_BEFORE, 0); - if (!NILP (extent)) - value = Fextent_property (extent, prop, Qnil); - else - value = Qnil; + Bytexpos xpos; + Bytexpos blim; - while (1) - { - pos = extent_find_beginning_of_run (object, pos, 1); - if (pos <= limit) - break; /* property is the same all the way to the end */ - extent = extent_at (pos, object, prop, 0, EXTENT_AT_BEFORE, 0); - if ((NILP (extent) && !NILP (value)) || - (!NILP (extent) && !EQ (value, - Fextent_property (extent, prop, Qnil)))) - return pos; - } + object = decode_buffer_or_string (object); + xpos = get_buffer_or_string_pos_byte (object, pos, 0); + blim = !NILP (limit) ? get_buffer_or_string_pos_byte (object, limit, 0) : -1; + blim = next_previous_single_property_change (xpos, prop, object, blim, + next, text_props_only); - if (limit_was_nil) - return -1; + if (blim < 0) + return Qnil; else - return limit; + return make_int (buffer_or_string_bytexpos_to_charxpos (object, blim)); } DEFUN ("next-single-property-change", Fnext_single_property_change, ＠＠ -7175,22 +7168,14 ＠＠ If two or more extents with conflicting a particular character, it is undefined which value is considered to be the value of PROP. (Note that this situation will not happen if you always use the text-property primitives.) + +This function looks only at extents created using the text-property primitives. +To look at all extents, use `next-single-char-property-change'. */ (pos, prop, object, limit)) { - Bytexpos xpos; - Bytexpos blim; - - object = decode_buffer_or_string (object); - xpos = get_buffer_or_string_pos_byte (object, pos, 0); - blim = !NILP (limit) ? get_buffer_or_string_pos_byte (object, limit, 0) : -1; - - blim = next_single_property_change (xpos, prop, object, blim); - - if (blim < 0) - return Qnil; - else - return make_int (buffer_or_string_bytexpos_to_charxpos (object, blim)); + return next_previous_single_property_change_fn (pos, prop, object, limit, + 1, 1); } DEFUN ("previous-single-property-change", Fprevious_single_property_change, ＠＠ -7210,22 +7195,69 ＠＠ If two or more extents with conflicting a particular character, it is undefined which value is considered to be the value of PROP. (Note that this situation will not happen if you always use the text-property primitives.) + +This function looks only at extents created using the text-property primitives. +To look at all extents, use `next-single-char-property-change'. */ (pos, prop, object, limit)) { - Bytexpos xpos; - Bytexpos blim; + return next_previous_single_property_change_fn (pos, prop, object, limit, + 0, 1); +} - object = decode_buffer_or_string (object); - xpos = get_buffer_or_string_pos_byte (object, pos, 0); - blim = !NILP (limit) ? get_buffer_or_string_pos_byte (object, limit, 0) : -1; +DEFUN ("next-single-char-property-change", Fnext_single_char_property_change, + 2, 4, 0, /* +Return the position of next property change for a specific property. +Scans characters forward from POS till it finds a change in the PROP + property, then returns the position of the change. The optional third + argument OBJECT is the buffer or string to scan (defaults to the current + buffer). +The property values are compared with `eq'. +Return nil if the property is constant all the way to the end of OBJECT. +If the value is non-nil, it is a position greater than POS, never equal. - blim = previous_single_property_change (xpos, prop, object, blim); +If the optional fourth argument LIMIT is non-nil, don't search + past position LIMIT; return LIMIT if nothing is found before LIMIT. +If two or more extents with conflicting non-nil values for PROP overlap + a particular character, it is undefined which value is considered to be + the value of PROP. (Note that this situation will not happen if you always + use the text-property primitives.) - if (blim < 0) - return Qnil; - else - return make_int (buffer_or_string_bytexpos_to_charxpos (object, blim)); +This function looks at all extents. To look at only extents created using the +text-property primitives, use `next-single-char-property-change'. +*/ + (pos, prop, object, limit)) +{ + return next_previous_single_property_change_fn (pos, prop, object, limit, + 1, 0); +} + +DEFUN ("previous-single-char-property-change", + Fprevious_single_char_property_change, + 2, 4, 0, /* +Return the position of next property change for a specific property. +Scans characters backward from POS till it finds a change in the PROP + property, then returns the position of the change. The optional third + argument OBJECT is the buffer or string to scan (defaults to the current + buffer). +The property values are compared with `eq'. +Return nil if the property is constant all the way to the start of OBJECT. +If the value is non-nil, it is a position less than POS, never equal. + +If the optional fourth argument LIMIT is non-nil, don't search back + past position LIMIT; return LIMIT if nothing is found until LIMIT. +If two or more extents with conflicting non-nil values for PROP overlap + a particular character, it is undefined which value is considered to be + the value of PROP. (Note that this situation will not happen if you always + use the text-property primitives.) + +This function looks at all extents. To look at only extents created using the +text-property primitives, use `next-single-char-property-change'. +*/ + (pos, prop, object, limit)) +{ + return next_previous_single_property_change_fn (pos, prop, object, limit, + 0, 0); } #ifdef MEMORY_USAGE_STATS ＠＠ -7364,6 +7396,8 ＠＠ syms_of_extents (void) DEFSUBR (Ftext_prop_extent_paste_function); DEFSUBR (Fnext_single_property_change); DEFSUBR (Fprevious_single_property_change); + DEFSUBR (Fnext_single_char_property_change); + DEFSUBR (Fprevious_single_char_property_change); } void Index: src/extents.h =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/extents.h,v retrieving revision 1.18 diff -u -p -r1.18 extents.h --- src/extents.h 2002/06/20 21:18:30 1.18 +++ src/extents.h 2005/01/26 05:09:02 ＠＠ -110,7 +110,7 ＠＠ EXFUN (Fget_char_property, 4); EXFUN (Fmake_extent, 3); EXFUN (Fnext_extent_change, 2); EXFUN (Fprevious_extent_change, 2); -EXFUN (Fprevious_single_property_change, 4); +EXFUN (Fprevious_single_char_property_change, 4); EXFUN (Fset_extent_endpoints, 4); EXFUN (Fset_extent_parent, 2); EXFUN (Fset_extent_property, 3); ＠＠ -125,10 +125,11 ＠＠ enum extent_at_flag Bytexpos extent_endpoint_byte (EXTENT extent, int endp); Charxpos extent_endpoint_char (EXTENT extent, int endp); -Bytexpos next_single_property_change (Bytexpos pos, Lisp_Object prop, - Lisp_Object object, Bytexpos limit); -Bytexpos previous_single_property_change (Bytexpos pos, Lisp_Object prop, - Lisp_Object object, Bytexpos limit); +Bytexpos next_previous_single_property_change (Bytexpos pos, Lisp_Object prop, + Lisp_Object object, + Bytexpos limit, + Boolint next, + Boolint text_props_only); Lisp_Object get_char_property (Bytexpos position, Lisp_Object prop, Lisp_Object object, enum extent_at_flag fl, int text_props_only); Index: src/indent.c =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/indent.c,v retrieving revision 1.19 diff -u -p -r1.19 indent.c --- src/indent.c 2003/02/07 11:50:53 1.19 +++ src/indent.c 2005/01/26 05:09:02 ＠＠ -71,8 +71,8 ＠＠ last_visible_position (Charbpos pos, str Lisp_Object value; buffer = wrap_buffer (buf); - value = Fprevious_single_property_change (make_int (pos), Qinvisible, - buffer, Qnil); + value = Fprevious_single_char_property_change (make_int (pos), Qinvisible, + buffer, Qnil); if (NILP (value)) return 0; /* no visible position found */ else Index: src/syntax.c =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/syntax.c,v retrieving revision 1.22 diff -u -p -r1.22 syntax.c --- src/syntax.c 2004/09/22 02:06:51 1.22 +++ src/syntax.c 2005/01/26 05:09:03 ＠＠ -448,8 +448,8 ＠＠ update_syntax_cache (struct syntax_cache tmp_table = get_char_property (pos, Qsyntax_table, cache->object, EXTENT_AT_AFTER, 0); - lim = next_single_property_change (pos, Qsyntax_table, cache->object, - -1); + lim = next_previous_single_property_change (pos, Qsyntax_table, + cache->object, -1, 1, 0); if (lim < 0) { next = buffer_or_string_absolute_end_byte (cache->object); ＠＠ -460,8 +460,8 ＠＠ update_syntax_cache (struct syntax_cache if (pos < buffer_or_string_absolute_end_byte (cache->object)) pos = next_bytexpos (cache->object, pos); - lim = previous_single_property_change (pos, Qsyntax_table, cache->object, - -1); + lim = next_previous_single_property_change (pos, Qsyntax_table, + cache->object, -1, 0, 0); if (lim < 0) { prev = buffer_or_string_absolute_begin_byte (cache->object); cvs server: Diffing src/m cvs server: Diffing src/s cvs server: Diffing tests cvs server: Diffing tests/DLL cvs server: Diffing tests/Dnd cvs server: Diffing tests/automated cvs server: Diffing tests/gtk cvs server: Diffing tests/mule cvs server: Diffing tests/tooltalk