Mercurial > hg > xemacs-beta
comparison src/extents.c @ 173:8eaf7971accc r20-3b13
Import from CVS: tag r20-3b13
author | cvs |
---|---|
date | Mon, 13 Aug 2007 09:49:09 +0200 |
parents | 929b76928fce |
children | 2d532a89d707 |
comparison
equal
deleted
inserted
replaced
172:a38aed19690b | 173:8eaf7971accc |
---|---|
131 necessarily consistent with the extents that `map-extents' | 131 necessarily consistent with the extents that `map-extents' |
132 maps over, since `map-extents' sometimes pays attention to | 132 maps over, since `map-extents' sometimes pays attention to |
133 whether the endpoints of an extents are open or closed. | 133 whether the endpoints of an extents are open or closed. |
134 But for our purposes, it greatly simplifies things to treat | 134 But for our purposes, it greatly simplifies things to treat |
135 all extents as having closed endpoints. | 135 all extents as having closed endpoints. |
136 | 136 |
137 First, define >, <, <=, etc. as applied to extents to mean | 137 First, define >, <, <=, etc. as applied to extents to mean |
138 comparison according to the display order. Comparison between an | 138 comparison according to the display order. Comparison between an |
139 extent E and an index I means comparison between E and the range | 139 extent E and an index I means comparison between E and the range |
140 [I, I]. | 140 [I, I]. |
141 Also define e>, e<, e<=, etc. to mean comparison according to the | 141 Also define e>, e<, e<=, etc. to mean comparison according to the |
153 Now: | 153 Now: |
154 | 154 |
155 Let R be a range. | 155 Let R be a range. |
156 Let F be the first extent overlapping R. | 156 Let F be the first extent overlapping R. |
157 Let L be the last extent overlapping R. | 157 Let L be the last extent overlapping R. |
158 | 158 |
159 Theorem 1: R(1) lies between L and L(next), i.e. L <= R(1) < L(next). | 159 Theorem 1: R(1) lies between L and L(next), i.e. L <= R(1) < L(next). |
160 | 160 |
161 This follows easily from the definition of display order. The | 161 This follows easily from the definition of display order. The |
162 basic reason that this theorem applies is that the display order | 162 basic reason that this theorem applies is that the display order |
163 sorts by increasing starting index. | 163 sorts by increasing starting index. |
212 */ | 212 */ |
213 | 213 |
214 #include <config.h> | 214 #include <config.h> |
215 #include "lisp.h" | 215 #include "lisp.h" |
216 | 216 |
217 #include "buffer.h" | 217 #include "buffer.h" |
218 #include "debug.h" | 218 #include "debug.h" |
219 #include "device.h" | 219 #include "device.h" |
220 #include "elhash.h" | 220 #include "elhash.h" |
221 #include "extents.h" | 221 #include "extents.h" |
222 #include "faces.h" | 222 #include "faces.h" |
745 { | 745 { |
746 /* RIGHT might not point to a valid extent (i.e. it's at the end | 746 /* RIGHT might not point to a valid extent (i.e. it's at the end |
747 of the list), so NEWPOS must round down. */ | 747 of the list), so NEWPOS must round down. */ |
748 unsigned int newpos = (left + right) >> 1; | 748 unsigned int newpos = (left + right) >> 1; |
749 e = EXTENT_GAP_ARRAY_AT (ga, newpos); | 749 e = EXTENT_GAP_ARRAY_AT (ga, newpos); |
750 | 750 |
751 if (endp ? EXTENT_E_LESS (e, extent) : EXTENT_LESS (e, extent)) | 751 if (endp ? EXTENT_E_LESS (e, extent) : EXTENT_LESS (e, extent)) |
752 left = newpos+1; | 752 left = newpos+1; |
753 else | 753 else |
754 right = newpos; | 754 right = newpos; |
755 } | 755 } |
934 ((markobj) (data->end_glyph)); | 934 ((markobj) (data->end_glyph)); |
935 ((markobj) (data->invisible)); | 935 ((markobj) (data->invisible)); |
936 ((markobj) (data->children)); | 936 ((markobj) (data->children)); |
937 ((markobj) (data->read_only)); | 937 ((markobj) (data->read_only)); |
938 ((markobj) (data->mouse_face)); | 938 ((markobj) (data->mouse_face)); |
939 return (data->parent); | 939 return data->parent; |
940 } | 940 } |
941 | 941 |
942 void | 942 void |
943 allocate_extent_auxiliary (EXTENT ext) | 943 allocate_extent_auxiliary (EXTENT ext) |
944 { | 944 { |
1092 if (NILP (object)) | 1092 if (NILP (object)) |
1093 XSETBUFFER (object, current_buffer); | 1093 XSETBUFFER (object, current_buffer); |
1094 else | 1094 else |
1095 CHECK_LIVE_BUFFER_OR_STRING (object); | 1095 CHECK_LIVE_BUFFER_OR_STRING (object); |
1096 return object; | 1096 return object; |
1097 } | 1097 } |
1098 | 1098 |
1099 EXTENT | 1099 EXTENT |
1100 extent_ancestor_1 (EXTENT e) | 1100 extent_ancestor_1 (EXTENT e) |
1101 { | 1101 { |
1102 while (e->flags.has_parent) | 1102 while (e->flags.has_parent) |
1145 | 1145 |
1146 static struct extent_info * | 1146 static struct extent_info * |
1147 buffer_or_string_extent_info_force (Lisp_Object object) | 1147 buffer_or_string_extent_info_force (Lisp_Object object) |
1148 { | 1148 { |
1149 struct extent_info *info = buffer_or_string_extent_info (object); | 1149 struct extent_info *info = buffer_or_string_extent_info (object); |
1150 | 1150 |
1151 if (!info) | 1151 if (!info) |
1152 { | 1152 { |
1153 Lisp_Object extent_info; | 1153 Lisp_Object extent_info; |
1154 | 1154 |
1155 assert (STRINGP (object)); /* should never happen for buffers -- | 1155 assert (STRINGP (object)); /* should never happen for buffers -- |
1545 /* Return the start (endp == 0) or end (endp == 1) of an extent as | 1545 /* Return the start (endp == 0) or end (endp == 1) of an extent as |
1546 a byte index. If you want the value as a memory index, use | 1546 a byte index. If you want the value as a memory index, use |
1547 extent_endpoint(). If you want the value as a buffer position, | 1547 extent_endpoint(). If you want the value as a buffer position, |
1548 use extent_endpoint_bufpos(). */ | 1548 use extent_endpoint_bufpos(). */ |
1549 | 1549 |
1550 static Bytind | 1550 static Bytind |
1551 extent_endpoint_bytind (EXTENT extent, int endp) | 1551 extent_endpoint_bytind (EXTENT extent, int endp) |
1552 { | 1552 { |
1553 assert (EXTENT_LIVE_P (extent)); | 1553 assert (EXTENT_LIVE_P (extent)); |
1554 assert (!extent_detached_p (extent)); | 1554 assert (!extent_detached_p (extent)); |
1555 { | 1555 { |
1602 invisibility_change); | 1602 invisibility_change); |
1603 } | 1603 } |
1604 } | 1604 } |
1605 | 1605 |
1606 /* now mark the extent itself. */ | 1606 /* now mark the extent itself. */ |
1607 | 1607 |
1608 object = extent_object (extent); | 1608 object = extent_object (extent); |
1609 | 1609 |
1610 if (!BUFFERP (object) || extent_detached_p (extent)) | 1610 if (!BUFFERP (object) || extent_detached_p (extent)) |
1611 /* #### Can changes to string extents affect redisplay? | 1611 /* #### Can changes to string extents affect redisplay? |
1612 I will have to think about this. What about string glyphs? | 1612 I will have to think about this. What about string glyphs? |
1803 !NILP (extent_invisible (extent))); | 1803 !NILP (extent_invisible (extent))); |
1804 } | 1804 } |
1805 | 1805 |
1806 static void | 1806 static void |
1807 extent_detach (EXTENT extent) | 1807 extent_detach (EXTENT extent) |
1808 { | 1808 { |
1809 Extent_List *el; | 1809 Extent_List *el; |
1810 | 1810 |
1811 if (extent_detached_p (extent)) | 1811 if (extent_detached_p (extent)) |
1812 return; | 1812 return; |
1813 el = extent_extent_list (extent); | 1813 el = extent_extent_list (extent); |
1909 }; | 1909 }; |
1910 | 1910 |
1911 static Lisp_Object | 1911 static Lisp_Object |
1912 map_extents_unwind (Lisp_Object obj) | 1912 map_extents_unwind (Lisp_Object obj) |
1913 { | 1913 { |
1914 struct map_extents_struct *closure = | 1914 struct map_extents_struct *closure = |
1915 (struct map_extents_struct *) get_opaque_ptr (obj); | 1915 (struct map_extents_struct *) get_opaque_ptr (obj); |
1916 free_opaque_ptr (obj); | 1916 free_opaque_ptr (obj); |
1917 if (closure->range) | 1917 if (closure->range) |
1918 extent_detach (closure->range); | 1918 extent_detach (closure->range); |
1919 if (closure->mkr) | 1919 if (closure->mkr) |
2092 range_start_type = 2; | 2092 range_start_type = 2; |
2093 range_start_pos = 0; | 2093 range_start_pos = 0; |
2094 #else | 2094 #else |
2095 Stack_Of_Extents *soe = buffer_or_string_stack_of_extents_force (obj); | 2095 Stack_Of_Extents *soe = buffer_or_string_stack_of_extents_force (obj); |
2096 int numsoe; | 2096 int numsoe; |
2097 | 2097 |
2098 /* Move the SOE to the closer end of the range. This dictates | 2098 /* Move the SOE to the closer end of the range. This dictates |
2099 whether we map over start positions or end positions. */ | 2099 whether we map over start positions or end positions. */ |
2100 range_endp = 0; | 2100 range_endp = 0; |
2101 soe_move (obj, st); | 2101 soe_move (obj, st); |
2102 numsoe = extent_list_num_els (soe->extents); | 2102 numsoe = extent_list_num_els (soe->extents); |
2127 ME_START_IN_REGION or ME_END_IN_REGION was specified. | 2127 ME_START_IN_REGION or ME_END_IN_REGION was specified. |
2128 RANGE_ENDP already specified so no need to do anything else. */ | 2128 RANGE_ENDP already specified so no need to do anything else. */ |
2129 } | 2129 } |
2130 } | 2130 } |
2131 #endif | 2131 #endif |
2132 | 2132 |
2133 /* ---------- Now loop over the extents. ---------- */ | 2133 /* ---------- Now loop over the extents. ---------- */ |
2134 | 2134 |
2135 /* We combine the code for the two stages because much of it | 2135 /* We combine the code for the two stages because much of it |
2136 overlaps. */ | 2136 overlaps. */ |
2137 for (stage = 0; stage < 2; stage++) | 2137 for (stage = 0; stage < 2; stage++) |
2393 { | 2393 { |
2394 struct adjust_extents_for_deletion_arg closure; | 2394 struct adjust_extents_for_deletion_arg closure; |
2395 int i; | 2395 int i; |
2396 Memind adjust_to = (Memind) (to + gapsize); | 2396 Memind adjust_to = (Memind) (to + gapsize); |
2397 Bytecount amount = - numdel - movegapsize; | 2397 Bytecount amount = - numdel - movegapsize; |
2398 Memind oldsoe, newsoe; | 2398 Memind oldsoe = 0, newsoe = 0; |
2399 Stack_Of_Extents *soe = buffer_or_string_stack_of_extents (object); | 2399 Stack_Of_Extents *soe = buffer_or_string_stack_of_extents (object); |
2400 | 2400 |
2401 #ifdef ERROR_CHECK_EXTENTS | 2401 #ifdef ERROR_CHECK_EXTENTS |
2402 sledgehammer_extent_check (object); | 2402 sledgehammer_extent_check (object); |
2403 #endif | 2403 #endif |
2624 { | 2624 { |
2625 CONST EXTENT foo = * (CONST EXTENT *) humpty; | 2625 CONST EXTENT foo = * (CONST EXTENT *) humpty; |
2626 CONST EXTENT bar = * (CONST EXTENT *) dumpty; | 2626 CONST EXTENT bar = * (CONST EXTENT *) dumpty; |
2627 if (extent_priority (foo) < extent_priority (bar)) | 2627 if (extent_priority (foo) < extent_priority (bar)) |
2628 return -1; | 2628 return -1; |
2629 return (extent_priority (foo) > extent_priority (bar)); | 2629 return extent_priority (foo) > extent_priority (bar); |
2630 } | 2630 } |
2631 | 2631 |
2632 static void | 2632 static void |
2633 extent_fragment_sort_by_priority (extent_dynarr *extarr) | 2633 extent_fragment_sort_by_priority (extent_dynarr *extarr) |
2634 { | 2634 { |
2799 EXTENT e = extent_list_at (sel, i, 0); | 2799 EXTENT e = extent_list_at (sel, i, 0); |
2800 if (extent_start (e) == mempos && !NILP (extent_begin_glyph (e))) | 2800 if (extent_start (e) == mempos && !NILP (extent_begin_glyph (e))) |
2801 { | 2801 { |
2802 Lisp_Object glyph = extent_begin_glyph (e); | 2802 Lisp_Object glyph = extent_begin_glyph (e); |
2803 struct glyph_block gb; | 2803 struct glyph_block gb; |
2804 | 2804 |
2805 gb.glyph = glyph; | 2805 gb.glyph = glyph; |
2806 gb.extent = Qnil; | 2806 gb.extent = Qnil; |
2807 XSETEXTENT (gb.extent, e); | 2807 XSETEXTENT (gb.extent, e); |
2808 Dynarr_add (ef->begin_glyphs, gb); | 2808 Dynarr_add (ef->begin_glyphs, gb); |
2809 } | 2809 } |
2810 } | 2810 } |
2811 | 2811 |
2812 /* Determine the end glyphs at POS. */ | 2812 /* Determine the end glyphs at POS. */ |
2813 for (i = 0; i < extent_list_num_els (sel); i++) | 2813 for (i = 0; i < extent_list_num_els (sel); i++) |
2814 { | 2814 { |
2815 EXTENT e = extent_list_at (sel, i, 1); | 2815 EXTENT e = extent_list_at (sel, i, 1); |
2816 if (extent_end (e) == mempos && !NILP (extent_end_glyph (e))) | 2816 if (extent_end (e) == mempos && !NILP (extent_end_glyph (e))) |
2817 { | 2817 { |
2818 Lisp_Object glyph = extent_end_glyph (e); | 2818 Lisp_Object glyph = extent_end_glyph (e); |
2819 struct glyph_block gb; | 2819 struct glyph_block gb; |
2820 | 2820 |
2821 gb.glyph = glyph; | 2821 gb.glyph = glyph; |
2822 gb.extent = Qnil; | 2822 gb.extent = Qnil; |
2823 XSETEXTENT (gb.extent, e); | 2823 XSETEXTENT (gb.extent, e); |
2824 Dynarr_add (ef->end_glyphs, gb); | 2824 Dynarr_add (ef->end_glyphs, gb); |
2825 } | 2825 } |
2892 extent_fragment_sort_by_priority (ef->extents); | 2892 extent_fragment_sort_by_priority (ef->extents); |
2893 | 2893 |
2894 /* Now merge the faces together into a single face. The code to | 2894 /* Now merge the faces together into a single face. The code to |
2895 do this is in faces.c because it involves manipulating faces. */ | 2895 do this is in faces.c because it involves manipulating faces. */ |
2896 return get_extent_fragment_face_cache_index (w, ef); | 2896 return get_extent_fragment_face_cache_index (w, ef); |
2897 } | 2897 } |
2898 | 2898 |
2899 | 2899 |
2900 /************************************************************************/ | 2900 /************************************************************************/ |
2901 /* extent-object methods */ | 2901 /* extent-object methods */ |
2902 /************************************************************************/ | 2902 /************************************************************************/ |
2934 { | 2934 { |
2935 struct extent *extent = XEXTENT (obj); | 2935 struct extent *extent = XEXTENT (obj); |
2936 | 2936 |
2937 ((markobj) (extent_object (extent))); | 2937 ((markobj) (extent_object (extent))); |
2938 ((markobj) (extent_no_chase_normal_field (extent, face))); | 2938 ((markobj) (extent_no_chase_normal_field (extent, face))); |
2939 return (extent->plist); | 2939 return extent->plist; |
2940 } | 2940 } |
2941 | 2941 |
2942 static char * | 2942 static char * |
2943 print_extent_1 (char *buf, Lisp_Object extent_obj) | 2943 print_extent_1 (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag) |
2944 { | 2944 { |
2945 EXTENT ext = XEXTENT (extent_obj); | 2945 EXTENT ext = XEXTENT (obj); |
2946 EXTENT anc = extent_ancestor (ext); | 2946 EXTENT anc = extent_ancestor (ext); |
2947 char *bp = buf; | |
2948 Lisp_Object tail; | 2947 Lisp_Object tail; |
2948 char buf[64], *bp = buf; | |
2949 | 2949 |
2950 /* Retrieve the ancestor and use it, for faster retrieval of properties */ | 2950 /* Retrieve the ancestor and use it, for faster retrieval of properties */ |
2951 | 2951 |
2952 if (!NILP (extent_begin_glyph (anc))) *bp++ = '*'; | 2952 if (!NILP (extent_begin_glyph (anc))) *bp++ = '*'; |
2953 *bp++ = (extent_start_open_p (anc) ? '(': '['); | 2953 *bp++ = (extent_start_open_p (anc) ? '(': '['); |
2954 if (extent_detached_p (ext)) | 2954 if (extent_detached_p (ext)) |
2955 sprintf (bp, "detached"); | 2955 sprintf (bp, "detached"); |
2956 else | 2956 else |
2957 { | 2957 { |
2958 Bufpos from = XINT (Fextent_start_position (extent_obj)); | 2958 Bufpos from = XINT (Fextent_start_position (obj)); |
2959 Bufpos to = XINT (Fextent_end_position (extent_obj)); | 2959 Bufpos to = XINT (Fextent_end_position (obj)); |
2960 sprintf (bp, "%d, %d", from, to); | 2960 sprintf (bp, "%d, %d", from, to); |
2961 } | 2961 } |
2962 bp += strlen (bp); | 2962 bp += strlen (bp); |
2963 *bp++ = (extent_end_open_p (anc) ? ')': ']'); | 2963 *bp++ = (extent_end_open_p (anc) ? ')': ']'); |
2964 if (!NILP (extent_end_glyph (anc))) *bp++ = '*'; | 2964 if (!NILP (extent_end_glyph (anc))) *bp++ = '*'; |
2972 | 2972 |
2973 if (!NILP (extent_read_only (anc)) || !NILP (extent_mouse_face (anc)) || | 2973 if (!NILP (extent_read_only (anc)) || !NILP (extent_mouse_face (anc)) || |
2974 extent_unique_p (anc) || | 2974 extent_unique_p (anc) || |
2975 extent_duplicable_p (anc) || !NILP (extent_invisible (anc))) | 2975 extent_duplicable_p (anc) || !NILP (extent_invisible (anc))) |
2976 *bp++ = ' '; | 2976 *bp++ = ' '; |
2977 *bp = '\0'; | |
2978 write_c_string (buf, printcharfun); | |
2977 | 2979 |
2978 tail = extent_plist_slot (anc); | 2980 tail = extent_plist_slot (anc); |
2979 | 2981 |
2980 for (; !NILP (tail); tail = Fcdr (Fcdr (tail))) | 2982 for (; !NILP (tail); tail = Fcdr (Fcdr (tail))) |
2981 { | 2983 { |
2982 struct Lisp_String *k; | |
2983 Lisp_Object v = XCAR (XCDR (tail)); | 2984 Lisp_Object v = XCAR (XCDR (tail)); |
2984 if (NILP (v)) continue; | 2985 if (NILP (v)) continue; |
2985 if (!SYMBOLP (XCAR (tail))) | 2986 print_internal (XCAR (tail), printcharfun, escapeflag); |
2986 { | 2987 write_c_string (" ", printcharfun); |
2987 /* ### Fix this! */ | 2988 } |
2988 strcpy (bp, "non-symbol "); | 2989 |
2989 bp += 11; | 2990 sprintf (buf, "0x%lx", (long) ext); |
2990 continue; | 2991 write_c_string (buf, printcharfun); |
2991 } | |
2992 k = XSYMBOL (XCAR (tail))->name; | |
2993 memcpy (bp, (char *) string_data (k), string_length (k)); | |
2994 bp += string_length (k); | |
2995 *bp++ = ' '; | |
2996 } | |
2997 | |
2998 sprintf (bp, "0x%lx", (long) ext); | |
2999 bp += strlen (bp); | |
3000 | |
3001 *bp++ = 0; | |
3002 return buf; | |
3003 } | 2992 } |
3004 | 2993 |
3005 static void | 2994 static void |
3006 print_extent (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag) | 2995 print_extent (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag) |
3007 { | 2996 { |
3008 char buf2[256]; | |
3009 | |
3010 if (escapeflag) | 2997 if (escapeflag) |
3011 { | 2998 { |
3012 CONST char *title = ""; | 2999 CONST char *title = ""; |
3013 CONST char *name = ""; | 3000 CONST char *name = ""; |
3014 CONST char *posttitle = ""; | 3001 CONST char *posttitle = ""; |
3015 Lisp_Object obj2 = Qnil; | 3002 Lisp_Object obj2 = Qnil; |
3016 | 3003 |
3017 /* Destroyed extents have 't' in the object field, causing | 3004 /* Destroyed extents have 't' in the object field, causing |
3018 extent_object() to abort (maybe). */ | 3005 extent_object() to abort (maybe). */ |
3019 if (EXTENT_LIVE_P (XEXTENT (obj))) | 3006 if (EXTENT_LIVE_P (XEXTENT (obj))) |
3020 obj2 = extent_object (XEXTENT (obj)); | 3007 obj2 = extent_object (XEXTENT (obj)); |
3021 | 3008 |
3022 if (NILP (obj2)) | 3009 if (NILP (obj2)) |
3023 title = "no buffer"; | 3010 title = "no buffer"; |
3024 else if (BUFFERP (obj2)) | 3011 else if (BUFFERP (obj2)) |
3025 { | 3012 { |
3026 if (BUFFER_LIVE_P (XBUFFER (obj2))) | 3013 if (BUFFER_LIVE_P (XBUFFER (obj2))) |
3039 assert (STRINGP (obj2)); | 3026 assert (STRINGP (obj2)); |
3040 title = "string \""; | 3027 title = "string \""; |
3041 posttitle = "\""; | 3028 posttitle = "\""; |
3042 name = (char *) XSTRING_DATA (obj2); | 3029 name = (char *) XSTRING_DATA (obj2); |
3043 } | 3030 } |
3044 | 3031 |
3045 if (print_readably) | 3032 if (print_readably) |
3046 { | 3033 { |
3047 if (!EXTENT_LIVE_P (XEXTENT (obj))) | 3034 if (!EXTENT_LIVE_P (XEXTENT (obj))) |
3048 error ("printing unreadable object #<destroyed extent>"); | 3035 error ("printing unreadable object #<destroyed extent>"); |
3049 else | 3036 else |
3050 error ("printing unreadable object #<extent %s>", | 3037 error ("printing unreadable object #<extent 0x%lx>", |
3051 print_extent_1 (buf2, obj)); | 3038 (long)XEXTENT (obj)); |
3052 } | 3039 } |
3053 | 3040 |
3054 if (!EXTENT_LIVE_P (XEXTENT (obj))) | 3041 if (!EXTENT_LIVE_P (XEXTENT (obj))) |
3055 write_c_string ("#<destroyed extent", printcharfun); | 3042 write_c_string ("#<destroyed extent", printcharfun); |
3056 else | 3043 else |
3057 { | 3044 { |
3058 char buf[256]; | 3045 char *buf = alloca (strlen (title) + strlen (name) |
3046 + strlen (posttitle)); | |
3059 write_c_string ("#<extent ", printcharfun); | 3047 write_c_string ("#<extent ", printcharfun); |
3060 if (extent_detached_p (XEXTENT (obj))) | 3048 print_extent_1 (obj, printcharfun, escapeflag); |
3061 sprintf (buf, "%s from %s%s%s", | 3049 write_c_string (extent_detached_p (XEXTENT (obj)) |
3062 print_extent_1 (buf2, obj), title, name, posttitle); | 3050 ? " from " : " in ", printcharfun); |
3063 else | 3051 sprintf (buf, "%s%s%s", title, name, posttitle); |
3064 sprintf (buf, "%s in %s%s%s", | |
3065 print_extent_1 (buf2, obj), | |
3066 title, name, posttitle); | |
3067 write_c_string (buf, printcharfun); | 3052 write_c_string (buf, printcharfun); |
3068 } | 3053 } |
3069 } | 3054 } |
3070 else | 3055 else |
3071 { | 3056 { |
3105 if (value) | 3090 if (value) |
3106 return 0; | 3091 return 0; |
3107 } | 3092 } |
3108 | 3093 |
3109 /* compare the random elements of the plists. */ | 3094 /* compare the random elements of the plists. */ |
3110 return (!plists_differ (extent_no_chase_plist (e1), | 3095 return !plists_differ (extent_no_chase_plist (e1), |
3111 extent_no_chase_plist (e2), | 3096 extent_no_chase_plist (e2), |
3112 0, 0, depth + 1)); | 3097 0, 0, depth + 1); |
3113 } | 3098 } |
3114 | 3099 |
3115 static int | 3100 static int |
3116 extent_equal (Lisp_Object o1, Lisp_Object o2, int depth) | 3101 extent_equal (Lisp_Object o1, Lisp_Object o2, int depth) |
3117 { | 3102 { |
3213 if (NILP (obj) && (flags & DE_MUST_HAVE_BUFFER)) | 3198 if (NILP (obj) && (flags & DE_MUST_HAVE_BUFFER)) |
3214 { | 3199 { |
3215 signal_simple_error ("extent doesn't belong to a buffer or string", | 3200 signal_simple_error ("extent doesn't belong to a buffer or string", |
3216 extent_obj); | 3201 extent_obj); |
3217 } | 3202 } |
3218 | 3203 |
3219 if (extent_detached_p (extent) && (flags & DE_MUST_BE_ATTACHED)) | 3204 if (extent_detached_p (extent) && (flags & DE_MUST_BE_ATTACHED)) |
3220 { | 3205 { |
3221 signal_simple_error ("extent cannot be detached", extent_obj); | 3206 signal_simple_error ("extent cannot be detached", extent_obj); |
3222 } | 3207 } |
3223 | 3208 |
3244 { | 3229 { |
3245 if (EXTENTP (object)) | 3230 if (EXTENTP (object)) |
3246 return Qt; | 3231 return Qt; |
3247 return Qnil; | 3232 return Qnil; |
3248 } | 3233 } |
3249 | 3234 |
3250 DEFUN ("extent-live-p", Fextent_live_p, 1, 1, 0, /* | 3235 DEFUN ("extent-live-p", Fextent_live_p, 1, 1, 0, /* |
3251 T if OBJECT is an extent and the extent has not been destroyed. | 3236 T if OBJECT is an extent and the extent has not been destroyed. |
3252 */ | 3237 */ |
3253 (object)) | 3238 (object)) |
3254 { | 3239 { |
3324 next = extent_next (decode_extent (extent, DE_MUST_BE_ATTACHED)); | 3309 next = extent_next (decode_extent (extent, DE_MUST_BE_ATTACHED)); |
3325 else | 3310 else |
3326 next = extent_first (decode_buffer_or_string (extent)); | 3311 next = extent_first (decode_buffer_or_string (extent)); |
3327 | 3312 |
3328 if (!next) | 3313 if (!next) |
3329 return (Qnil); | 3314 return Qnil; |
3330 XSETEXTENT (val, next); | 3315 XSETEXTENT (val, next); |
3331 return (val); | 3316 return val; |
3332 } | 3317 } |
3333 | 3318 |
3334 DEFUN ("previous-extent", Fprevious_extent, 1, 1, 0, /* | 3319 DEFUN ("previous-extent", Fprevious_extent, 1, 1, 0, /* |
3335 Find last extent before EXTENT. | 3320 Find last extent before EXTENT. |
3336 If EXTENT is a buffer return the last extent in the buffer; likewise | 3321 If EXTENT is a buffer return the last extent in the buffer; likewise |
3346 prev = extent_previous (decode_extent (extent, DE_MUST_BE_ATTACHED)); | 3331 prev = extent_previous (decode_extent (extent, DE_MUST_BE_ATTACHED)); |
3347 else | 3332 else |
3348 prev = extent_last (decode_buffer_or_string (extent)); | 3333 prev = extent_last (decode_buffer_or_string (extent)); |
3349 | 3334 |
3350 if (!prev) | 3335 if (!prev) |
3351 return (Qnil); | 3336 return Qnil; |
3352 XSETEXTENT (val, prev); | 3337 XSETEXTENT (val, prev); |
3353 return (val); | 3338 return val; |
3354 } | 3339 } |
3355 | 3340 |
3356 #ifdef DEBUG_XEMACS | 3341 #ifdef DEBUG_XEMACS |
3357 | 3342 |
3358 DEFUN ("next-e-extent", Fnext_e_extent, 1, 1, 0, /* | 3343 DEFUN ("next-e-extent", Fnext_e_extent, 1, 1, 0, /* |
3369 next = extent_e_next (decode_extent (extent, DE_MUST_BE_ATTACHED)); | 3354 next = extent_e_next (decode_extent (extent, DE_MUST_BE_ATTACHED)); |
3370 else | 3355 else |
3371 next = extent_e_first (decode_buffer_or_string (extent)); | 3356 next = extent_e_first (decode_buffer_or_string (extent)); |
3372 | 3357 |
3373 if (!next) | 3358 if (!next) |
3374 return (Qnil); | 3359 return Qnil; |
3375 XSETEXTENT (val, next); | 3360 XSETEXTENT (val, next); |
3376 return (val); | 3361 return val; |
3377 } | 3362 } |
3378 | 3363 |
3379 DEFUN ("previous-e-extent", Fprevious_e_extent, 1, 1, 0, /* | 3364 DEFUN ("previous-e-extent", Fprevious_e_extent, 1, 1, 0, /* |
3380 Find last extent before EXTENT using the \"e\" order. | 3365 Find last extent before EXTENT using the \"e\" order. |
3381 If EXTENT is a buffer return the last extent in the buffer; likewise | 3366 If EXTENT is a buffer return the last extent in the buffer; likewise |
3391 prev = extent_e_previous (decode_extent (extent, DE_MUST_BE_ATTACHED)); | 3376 prev = extent_e_previous (decode_extent (extent, DE_MUST_BE_ATTACHED)); |
3392 else | 3377 else |
3393 prev = extent_e_last (decode_buffer_or_string (extent)); | 3378 prev = extent_e_last (decode_buffer_or_string (extent)); |
3394 | 3379 |
3395 if (!prev) | 3380 if (!prev) |
3396 return (Qnil); | 3381 return Qnil; |
3397 XSETEXTENT (val, prev); | 3382 XSETEXTENT (val, prev); |
3398 return (val); | 3383 return val; |
3399 } | 3384 } |
3400 | 3385 |
3401 #endif | 3386 #endif |
3402 | 3387 |
3403 DEFUN ("next-extent-change", Fnext_extent_change, 1, 2, 0, /* | 3388 DEFUN ("next-extent-change", Fnext_extent_change, 1, 2, 0, /* |
3628 | 3613 |
3629 static EXTENT | 3614 static EXTENT |
3630 make_extent_internal (Lisp_Object object, Bytind from, Bytind to) | 3615 make_extent_internal (Lisp_Object object, Bytind from, Bytind to) |
3631 { | 3616 { |
3632 EXTENT extent; | 3617 EXTENT extent; |
3633 | 3618 |
3634 extent = make_extent_detached (object); | 3619 extent = make_extent_detached (object); |
3635 set_extent_endpoints (extent, from, to, Qnil); | 3620 set_extent_endpoints (extent, from, to, Qnil); |
3636 return extent; | 3621 return extent; |
3637 } | 3622 } |
3638 | 3623 |
3668 Lisp_Object extent; | 3653 Lisp_Object extent; |
3669 XSETEXTENT (extent, e); | 3654 XSETEXTENT (extent, e); |
3670 add_extent_to_children_list (XEXTENT (parent), extent); | 3655 add_extent_to_children_list (XEXTENT (parent), extent); |
3671 } | 3656 } |
3672 } | 3657 } |
3673 | 3658 |
3674 /* #### it's still unclear to me that this Energize-specific junk | 3659 /* #### it's still unclear to me that this Energize-specific junk |
3675 needs to be in here. Just use the general mechanisms, or fix | 3660 needs to be in here. Just use the general mechanisms, or fix |
3676 them up! --ben */ | 3661 them up! --ben */ |
3677 #ifdef ENERGIZE | 3662 #ifdef ENERGIZE |
3678 if (energize_extent_data (original)) | 3663 if (energize_extent_data (original)) |
3683 #endif | 3668 #endif |
3684 | 3669 |
3685 return e; | 3670 return e; |
3686 } | 3671 } |
3687 | 3672 |
3688 static void | 3673 static void |
3689 destroy_extent (EXTENT extent) | 3674 destroy_extent (EXTENT extent) |
3690 { | 3675 { |
3691 Lisp_Object rest, nextrest, children; | 3676 Lisp_Object rest, nextrest, children; |
3692 Lisp_Object extent_obj = Qnil; | 3677 Lisp_Object extent_obj = Qnil; |
3693 | 3678 |
3694 if (!extent_detached_p (extent)) | 3679 if (!extent_detached_p (extent)) |
3826 else | 3811 else |
3827 buffer_or_string = decode_buffer_or_string (buffer_or_string); | 3812 buffer_or_string = decode_buffer_or_string (buffer_or_string); |
3828 | 3813 |
3829 if (NILP (start) && NILP (end)) | 3814 if (NILP (start) && NILP (end)) |
3830 return Fdetach_extent (extent); | 3815 return Fdetach_extent (extent); |
3831 | 3816 |
3832 get_buffer_or_string_range_byte (buffer_or_string, start, end, &s, &e, | 3817 get_buffer_or_string_range_byte (buffer_or_string, start, end, &s, &e, |
3833 GB_ALLOW_PAST_ACCESSIBLE); | 3818 GB_ALLOW_PAST_ACCESSIBLE); |
3834 | 3819 |
3835 set_extent_endpoints (ext, s, e, buffer_or_string); | 3820 set_extent_endpoints (ext, s, e, buffer_or_string); |
3836 return extent; | 3821 return extent; |
4226 | 4211 |
4227 /* ------------------------------- */ | 4212 /* ------------------------------- */ |
4228 /* extent-at */ | 4213 /* extent-at */ |
4229 /* ------------------------------- */ | 4214 /* ------------------------------- */ |
4230 | 4215 |
4231 /* find "smallest" matching extent containing pos -- (flag == 0) means | 4216 /* find "smallest" matching extent containing pos -- (flag == 0) means |
4232 all extents match, else (EXTENT_FLAGS (extent) & flag) must be true; | 4217 all extents match, else (EXTENT_FLAGS (extent) & flag) must be true; |
4233 for more than one matching extent with precisely the same endpoints, | 4218 for more than one matching extent with precisely the same endpoints, |
4234 we choose the last extent in the extents_list. | 4219 we choose the last extent in the extents_list. |
4235 The search stops just before "before", if that is non-null. | 4220 The search stops just before "before", if that is non-null. |
4236 */ | 4221 */ |
4343 return Qnil; | 4328 return Qnil; |
4344 | 4329 |
4345 closure.best_match = 0; | 4330 closure.best_match = 0; |
4346 closure.prop = property; | 4331 closure.prop = property; |
4347 closure.before = before; | 4332 closure.before = before; |
4348 | 4333 |
4349 map_extents_bytind (at_flag == EXTENT_AT_BEFORE ? position - 1 : position, | 4334 map_extents_bytind (at_flag == EXTENT_AT_BEFORE ? position - 1 : position, |
4350 at_flag == EXTENT_AT_AFTER ? position + 1 : position, | 4335 at_flag == EXTENT_AT_AFTER ? position + 1 : position, |
4351 extent_at_mapper, (void *) &closure, object, 0, | 4336 extent_at_mapper, (void *) &closure, object, 0, |
4352 ME_START_OPEN | ME_ALL_EXTENTS_CLOSED); | 4337 ME_START_OPEN | ME_ALL_EXTENTS_CLOSED); |
4353 | 4338 |
4489 { | 4474 { |
4490 Bytind opoint; | 4475 Bytind opoint; |
4491 int length; | 4476 int length; |
4492 Lisp_Object object; | 4477 Lisp_Object object; |
4493 }; | 4478 }; |
4494 | 4479 |
4495 /* A region of length LENGTH was just inserted at OPOINT. Modify all | 4480 /* A region of length LENGTH was just inserted at OPOINT. Modify all |
4496 of the extents as required for the insertion, based on their | 4481 of the extents as required for the insertion, based on their |
4497 start-open/end-open properties. | 4482 start-open/end-open properties. |
4498 */ | 4483 */ |
4499 | 4484 |
4500 static int | 4485 static int |
4501 process_extents_for_insertion_mapper (EXTENT extent, void *arg) | 4486 process_extents_for_insertion_mapper (EXTENT extent, void *arg) |
4502 { | 4487 { |
4503 struct process_extents_for_insertion_arg *closure = | 4488 struct process_extents_for_insertion_arg *closure = |
4504 (struct process_extents_for_insertion_arg *) arg; | 4489 (struct process_extents_for_insertion_arg *) arg; |
4505 Memind indecks = buffer_or_string_bytind_to_memind (closure->object, | 4490 Memind indice = buffer_or_string_bytind_to_memind (closure->object, |
4506 closure->opoint); | 4491 closure->opoint); |
4507 | 4492 |
4508 /* When this function is called, one end of the newly-inserted text should | 4493 /* When this function is called, one end of the newly-inserted text should |
4509 be adjacent to some endpoint of the extent, or disjoint from it. If | 4494 be adjacent to some endpoint of the extent, or disjoint from it. If |
4510 the insertion overlaps any existing extent, something is wrong. | 4495 the insertion overlaps any existing extent, something is wrong. |
4511 */ | 4496 */ |
4512 #ifdef ERROR_CHECK_EXTENTS | 4497 #ifdef ERROR_CHECK_EXTENTS |
4513 if (extent_start (extent) > indecks && | 4498 if (extent_start (extent) > indice && |
4514 extent_start (extent) < indecks + closure->length) | 4499 extent_start (extent) < indice + closure->length) |
4515 abort (); | 4500 abort (); |
4516 if (extent_end (extent) > indecks && | 4501 if (extent_end (extent) > indice && |
4517 extent_end (extent) < indecks + closure->length) | 4502 extent_end (extent) < indice + closure->length) |
4518 abort (); | 4503 abort (); |
4519 #endif | 4504 #endif |
4520 | 4505 |
4521 /* The extent-adjustment code adjusted the extent's endpoints as if | 4506 /* The extent-adjustment code adjusted the extent's endpoints as if |
4522 they were markers -- endpoints at the gap (i.e. the insertion | 4507 they were markers -- endpoints at the gap (i.e. the insertion |
4532 { | 4517 { |
4533 Memind new_start, new_end; | 4518 Memind new_start, new_end; |
4534 | 4519 |
4535 new_start = extent_start (extent); | 4520 new_start = extent_start (extent); |
4536 new_end = extent_end (extent); | 4521 new_end = extent_end (extent); |
4537 if (indecks == extent_start (extent) && extent_start_open_p (extent) && | 4522 if (indice == extent_start (extent) && extent_start_open_p (extent) && |
4538 /* coerce zero-length () extents to [) */ | 4523 /* coerce zero-length () extents to [) */ |
4539 new_start != new_end) | 4524 new_start != new_end) |
4540 new_start += closure->length; | 4525 new_start += closure->length; |
4541 if (indecks == extent_end (extent) && !extent_end_open_p (extent)) | 4526 if (indice == extent_end (extent) && !extent_end_open_p (extent)) |
4542 new_end += closure->length; | 4527 new_end += closure->length; |
4543 set_extent_endpoints_1 (extent, new_start, new_end); | 4528 set_extent_endpoints_1 (extent, new_start, new_end); |
4544 } | 4529 } |
4545 | 4530 |
4546 return 0; | 4531 return 0; |
4553 struct process_extents_for_insertion_arg closure; | 4538 struct process_extents_for_insertion_arg closure; |
4554 | 4539 |
4555 closure.opoint = opoint; | 4540 closure.opoint = opoint; |
4556 closure.length = length; | 4541 closure.length = length; |
4557 closure.object = object; | 4542 closure.object = object; |
4558 | 4543 |
4559 map_extents_bytind (opoint, opoint + length, | 4544 map_extents_bytind (opoint, opoint + length, |
4560 process_extents_for_insertion_mapper, | 4545 process_extents_for_insertion_mapper, |
4561 (void *) &closure, object, 0, | 4546 (void *) &closure, object, 0, |
4562 ME_END_CLOSED | ME_MIGHT_MODIFY_EXTENTS | | 4547 ME_END_CLOSED | ME_MIGHT_MODIFY_EXTENTS | |
4563 ME_INCLUDE_INTERNAL); | 4548 ME_INCLUDE_INTERNAL); |
4578 if they're detachable or open-open. */ | 4563 if they're detachable or open-open. */ |
4579 | 4564 |
4580 static int | 4565 static int |
4581 process_extents_for_deletion_mapper (EXTENT extent, void *arg) | 4566 process_extents_for_deletion_mapper (EXTENT extent, void *arg) |
4582 { | 4567 { |
4583 struct process_extents_for_deletion_arg *closure = | 4568 struct process_extents_for_deletion_arg *closure = |
4584 (struct process_extents_for_deletion_arg *) arg; | 4569 (struct process_extents_for_deletion_arg *) arg; |
4585 | 4570 |
4586 /* If the extent lies completely within the range that | 4571 /* If the extent lies completely within the range that |
4587 is being deleted, then nuke the extent if it's detachable | 4572 is being deleted, then nuke the extent if it's detachable |
4588 (otherwise, it will become a zero-length extent). */ | 4573 (otherwise, it will become a zero-length extent). */ |
4684 | 4669 |
4685 /* We canonicalize the given list into another list. | 4670 /* We canonicalize the given list into another list. |
4686 We try to avoid consing except when necessary, so we have | 4671 We try to avoid consing except when necessary, so we have |
4687 a reusable list. | 4672 a reusable list. |
4688 */ | 4673 */ |
4689 | 4674 |
4690 if (thelen < len) | 4675 if (thelen < len) |
4691 { | 4676 { |
4692 cons = Vextent_face_reusable_list; | 4677 cons = Vextent_face_reusable_list; |
4693 while (!NILP (XCDR (cons))) | 4678 while (!NILP (XCDR (cons))) |
4694 cons = XCDR (cons); | 4679 cons = XCDR (cons); |
5033 the `extent-property' function. | 5018 the `extent-property' function. |
5034 The following symbols have predefined meanings: | 5019 The following symbols have predefined meanings: |
5035 | 5020 |
5036 detached Removes the extent from its buffer; setting this is | 5021 detached Removes the extent from its buffer; setting this is |
5037 the same as calling `detach-extent'. | 5022 the same as calling `detach-extent'. |
5038 | 5023 |
5039 destroyed Removes the extent from its buffer, and makes it | 5024 destroyed Removes the extent from its buffer, and makes it |
5040 unusable in the future; this is the same calling | 5025 unusable in the future; this is the same calling |
5041 `delete-extent'. | 5026 `delete-extent'. |
5042 | 5027 |
5043 priority Change redisplay priority; same as `set-extent-priority'. | 5028 priority Change redisplay priority; same as `set-extent-priority'. |
5044 | 5029 |
5045 start-open Whether the set of characters within the extent is | 5030 start-open Whether the set of characters within the extent is |
5046 treated being open on the left, that is, whether | 5031 treated being open on the left, that is, whether |
5047 the start position is an exclusive, rather than | 5032 the start position is an exclusive, rather than |
5048 inclusive, boundary. If true, then characters | 5033 inclusive, boundary. If true, then characters |
5049 inserted exactly at the beginning of the extent | 5034 inserted exactly at the beginning of the extent |
5050 will remain outside of the extent; otherwise they | 5035 will remain outside of the extent; otherwise they |
5051 will go into the extent, extending it. | 5036 will go into the extent, extending it. |
5052 | 5037 |
5053 end-open Whether the set of characters within the extent is | 5038 end-open Whether the set of characters within the extent is |
5054 treated being open on the right, that is, whether | 5039 treated being open on the right, that is, whether |
5055 the end position is an exclusive, rather than | 5040 the end position is an exclusive, rather than |
5056 inclusive, boundary. If true, then characters | 5041 inclusive, boundary. If true, then characters |
5057 inserted exactly at the end of the extent will | 5042 inserted exactly at the end of the extent will |
5058 remain outside of the extent; otherwise they will | 5043 remain outside of the extent; otherwise they will |
5059 go into the extent, extending it. | 5044 go into the extent, extending it. |
5060 | 5045 |
5061 By default, extents have the `end-open' but not the | 5046 By default, extents have the `end-open' but not the |
5062 `start-open' property set. | 5047 `start-open' property set. |
5063 | 5048 |
5064 read-only Text within this extent will be unmodifiable. | 5049 read-only Text within this extent will be unmodifiable. |
5065 | 5050 |
5066 detachable Whether the extent gets detached (as with | 5051 detachable Whether the extent gets detached (as with |
5067 `detach-extent') when all the text within the | 5052 `detach-extent') when all the text within the |
5068 extent is deleted. This is true by default. If | 5053 extent is deleted. This is true by default. If |
5069 this property is not set, the extent becomes a | 5054 this property is not set, the extent becomes a |
5070 zero-length extent when its text is deleted. (In | 5055 zero-length extent when its text is deleted. (In |
5071 such a case, the `start-open' property is | 5056 such a case, the `start-open' property is |
5072 automatically removed if both the `start-open' and | 5057 automatically removed if both the `start-open' and |
5073 `end-open' properties are set, since zero-length | 5058 `end-open' properties are set, since zero-length |
5074 extents open on both ends are not allowed.) | 5059 extents open on both ends are not allowed.) |
5075 | 5060 |
5076 face The face in which to display the text. Setting | 5061 face The face in which to display the text. Setting |
5077 this is the same as calling `set-extent-face'. | 5062 this is the same as calling `set-extent-face'. |
5078 | 5063 |
5079 mouse-face If non-nil, the extent will be highlighted in this | 5064 mouse-face If non-nil, the extent will be highlighted in this |
5080 face when the mouse moves over it. | 5065 face when the mouse moves over it. |
5084 | 5069 |
5085 highlight Obsolete: Setting this property is equivalent to | 5070 highlight Obsolete: Setting this property is equivalent to |
5086 setting a `mouse-face' property of `highlight'. | 5071 setting a `mouse-face' property of `highlight'. |
5087 Reading this property returns non-nil if | 5072 Reading this property returns non-nil if |
5088 the extent has a non-nil `mouse-face' property. | 5073 the extent has a non-nil `mouse-face' property. |
5089 | 5074 |
5090 duplicable Whether this extent should be copied into strings, | 5075 duplicable Whether this extent should be copied into strings, |
5091 so that kill, yank, and undo commands will restore | 5076 so that kill, yank, and undo commands will restore |
5092 or copy it. `duplicable' extents are copied from | 5077 or copy it. `duplicable' extents are copied from |
5093 an extent into a string when `buffer-substring' or | 5078 an extent into a string when `buffer-substring' or |
5094 a similar function creates a string. The extents | 5079 a similar function creates a string. The extents |
5095 in a string are copied into other strings created | 5080 in a string are copied into other strings created |
5096 from the string using `concat' or `substring'. | 5081 from the string using `concat' or `substring'. |
5097 When `insert' or a similar function inserts the | 5082 When `insert' or a similar function inserts the |
5098 string into a buffer, the extents are copied back | 5083 string into a buffer, the extents are copied back |
5099 into the buffer. | 5084 into the buffer. |
5100 | 5085 |
5101 unique Meaningful only in conjunction with `duplicable'. | 5086 unique Meaningful only in conjunction with `duplicable'. |
5102 When this is set, there may be only one instance | 5087 When this is set, there may be only one instance |
5103 of this extent attached at a time: if it is copied | 5088 of this extent attached at a time: if it is copied |
5104 to the kill ring and then yanked, the extent is | 5089 to the kill ring and then yanked, the extent is |
5105 not copied. If, however, it is killed (removed | 5090 not copied. If, however, it is killed (removed |
5106 from the buffer) and then yanked, it will be | 5091 from the buffer) and then yanked, it will be |
5107 re-attached at the new position. | 5092 re-attached at the new position. |
5108 | 5093 |
5109 invisible If the value is non-nil, text under this extent | 5094 invisible If the value is non-nil, text under this extent |
5110 may be treated as not present for the purpose of | 5095 may be treated as not present for the purpose of |
5111 redisplay, or may be displayed using an ellipsis | 5096 redisplay, or may be displayed using an ellipsis |
5112 or other marker; see `buffer-invisibility-spec' | 5097 or other marker; see `buffer-invisibility-spec' |
5113 and `invisible-text-glyph'. In all cases, | 5098 and `invisible-text-glyph'. In all cases, |
5114 however, the text is still visible to other | 5099 however, the text is still visible to other |
5115 functions that examine a buffer's text. | 5100 functions that examine a buffer's text. |
5116 | 5101 |
5117 keymap This keymap is consulted for mouse clicks on this | 5102 keymap This keymap is consulted for mouse clicks on this |
5118 extent, or keypresses made while point is within the | 5103 extent, or keypresses made while point is within the |
5119 extent. | 5104 extent. |
5120 | 5105 |
5121 copy-function This is a hook that is run when a duplicable extent | 5106 copy-function This is a hook that is run when a duplicable extent |
5122 is about to be copied from a buffer to a string (or | 5107 is about to be copied from a buffer to a string (or |
5123 the kill ring). It is called with three arguments, | 5108 the kill ring). It is called with three arguments, |
5124 the extent, and the buffer-positions within it | 5109 the extent, and the buffer-positions within it |
5125 which are being copied. If this function returns | 5110 which are being copied. If this function returns |
5126 nil, then the extent will not be copied; otherwise | 5111 nil, then the extent will not be copied; otherwise |
5127 it will. | 5112 it will. |
5128 | 5113 |
5129 paste-function This is a hook that is run when a duplicable extent is | 5114 paste-function This is a hook that is run when a duplicable extent is |
5130 about to be copied from a string (or the kill ring) | 5115 about to be copied from a string (or the kill ring) |
5131 into a buffer. It is called with three arguments, | 5116 into a buffer. It is called with three arguments, |
5132 the original extent, and the buffer positions which | 5117 the original extent, and the buffer positions which |
5133 the copied extent will occupy. (This hook is run | 5118 the copied extent will occupy. (This hook is run |
5135 inserted into the buffer.) Note that the extent | 5120 inserted into the buffer.) Note that the extent |
5136 argument may be detached when this function is run. | 5121 argument may be detached when this function is run. |
5137 If this function returns nil, no extent will be | 5122 If this function returns nil, no extent will be |
5138 inserted. Otherwise, there will be an extent | 5123 inserted. Otherwise, there will be an extent |
5139 covering the range in question. | 5124 covering the range in question. |
5140 | 5125 |
5141 If the original extent is not attached to a buffer, | 5126 If the original extent is not attached to a buffer, |
5142 then it will be re-attached at this range. | 5127 then it will be re-attached at this range. |
5143 Otherwise, a copy will be made, and that copy | 5128 Otherwise, a copy will be made, and that copy |
5144 attached here. | 5129 attached here. |
5145 | 5130 |
5146 The copy-function and paste-function are meaningful | 5131 The copy-function and paste-function are meaningful |
5147 only for extents with the `duplicable' flag set, | 5132 only for extents with the `duplicable' flag set, |
5148 and if they are not specified, behave as if `t' was | 5133 and if they are not specified, behave as if `t' was |
5149 the returned value. When these hooks are invoked, | 5134 the returned value. When these hooks are invoked, |
5150 the current buffer is the buffer which the extent | 5135 the current buffer is the buffer which the extent |
5151 is being copied from/to, respectively. | 5136 is being copied from/to, respectively. |
5152 | 5137 |
5153 begin-glyph A glyph to be displayed at the beginning of the extent, | 5138 begin-glyph A glyph to be displayed at the beginning of the extent, |
5154 or nil. | 5139 or nil. |
5155 | 5140 |
5156 end-glyph A glyph to be displayed at the end of the extent, | 5141 end-glyph A glyph to be displayed at the end of the extent, |
5157 or nil. | 5142 or nil. |
5158 | 5143 |
5159 begin-glyph-layout The layout policy (one of `text', `whitespace', | 5144 begin-glyph-layout The layout policy (one of `text', `whitespace', |
5160 `inside-margin', or `outside-margin') of the extent's | 5145 `inside-margin', or `outside-margin') of the extent's |
5196 Fset_extent_face (extent, value); | 5181 Fset_extent_face (extent, value); |
5197 else if (EQ (property, Qmouse_face)) | 5182 else if (EQ (property, Qmouse_face)) |
5198 Fset_extent_mouse_face (extent, value); | 5183 Fset_extent_mouse_face (extent, value); |
5199 /* Obsolete: */ | 5184 /* Obsolete: */ |
5200 else if (EQ (property, Qhighlight)) | 5185 else if (EQ (property, Qhighlight)) |
5201 Fset_extent_mouse_face (extent, Qhighlight); | 5186 Fset_extent_mouse_face (extent, Qhighlight); |
5202 else if (EQ (property, Qbegin_glyph_layout)) | 5187 else if (EQ (property, Qbegin_glyph_layout)) |
5203 Fset_extent_begin_glyph_layout (extent, value); | 5188 Fset_extent_begin_glyph_layout (extent, value); |
5204 else if (EQ (property, Qend_glyph_layout)) | 5189 else if (EQ (property, Qend_glyph_layout)) |
5205 Fset_extent_end_glyph_layout (extent, value); | 5190 Fset_extent_end_glyph_layout (extent, value); |
5206 /* For backwards compatibility. We use begin glyph because it is by | 5191 /* For backwards compatibility. We use begin glyph because it is by |
5242 | 5227 |
5243 DEFUN ("extent-property", Fextent_property, 2, 3, 0, /* | 5228 DEFUN ("extent-property", Fextent_property, 2, 3, 0, /* |
5244 Return EXTENT's value for property PROPERTY. | 5229 Return EXTENT's value for property PROPERTY. |
5245 See `set-extent-property' for the built-in property names. | 5230 See `set-extent-property' for the built-in property names. |
5246 */ | 5231 */ |
5247 (extent, property, defalt)) | 5232 (extent, property, default_)) |
5248 { | 5233 { |
5249 EXTENT e = decode_extent (extent, 0); | 5234 EXTENT e = decode_extent (extent, 0); |
5250 | 5235 |
5251 if (EQ (property, Qdetached)) | 5236 if (EQ (property, Qdetached)) |
5252 return (extent_detached_p (e) ? Qt : Qnil); | 5237 return extent_detached_p (e) ? Qt : Qnil; |
5253 else if (EQ (property, Qdestroyed)) | 5238 else if (EQ (property, Qdestroyed)) |
5254 return (!EXTENT_LIVE_P (e) ? Qt : Qnil); | 5239 return !EXTENT_LIVE_P (e) ? Qt : Qnil; |
5255 #define RETURN_FLAG(flag) \ | 5240 #define RETURN_FLAG(flag) return extent_normal_field (e, flag) ? Qt : Qnil |
5256 return (extent_normal_field (e, flag) ? Qt : Qnil) | |
5257 else if (EQ (property, Qstart_open)) RETURN_FLAG (start_open); | 5241 else if (EQ (property, Qstart_open)) RETURN_FLAG (start_open); |
5258 else if (EQ (property, Qend_open)) RETURN_FLAG (end_open); | 5242 else if (EQ (property, Qend_open)) RETURN_FLAG (end_open); |
5259 else if (EQ (property, Qunique)) RETURN_FLAG (unique); | 5243 else if (EQ (property, Qunique)) RETURN_FLAG (unique); |
5260 else if (EQ (property, Qduplicable)) RETURN_FLAG (duplicable); | 5244 else if (EQ (property, Qduplicable)) RETURN_FLAG (duplicable); |
5261 else if (EQ (property, Qdetachable)) RETURN_FLAG (detachable); | 5245 else if (EQ (property, Qdetachable)) RETURN_FLAG (detachable); |
5262 #undef RETURN_FLAG | 5246 #undef RETURN_FLAG |
5263 /* Support (but don't document...) the obvious antonyms. */ | 5247 /* Support (but don't document...) the obvious antonyms. */ |
5264 else if (EQ (property, Qstart_closed)) | 5248 else if (EQ (property, Qstart_closed)) |
5265 return (extent_start_open_p (e) ? Qnil : Qt); | 5249 return extent_start_open_p (e) ? Qnil : Qt; |
5266 else if (EQ (property, Qend_closed)) | 5250 else if (EQ (property, Qend_closed)) |
5267 return (extent_end_open_p (e) ? Qnil : Qt); | 5251 return extent_end_open_p (e) ? Qnil : Qt; |
5268 else if (EQ (property, Qpriority)) | 5252 else if (EQ (property, Qpriority)) |
5269 return make_int (extent_priority (e)); | 5253 return make_int (extent_priority (e)); |
5270 else if (EQ (property, Qread_only)) | 5254 else if (EQ (property, Qread_only)) |
5271 return extent_read_only (e); | 5255 return extent_read_only (e); |
5272 else if (EQ (property, Qinvisible)) | 5256 else if (EQ (property, Qinvisible)) |
5295 Lisp_Object value; | 5279 Lisp_Object value; |
5296 | 5280 |
5297 value = external_plist_get (extent_plist_addr (e), property, 0, | 5281 value = external_plist_get (extent_plist_addr (e), property, 0, |
5298 ERROR_ME); | 5282 ERROR_ME); |
5299 if (UNBOUNDP (value)) | 5283 if (UNBOUNDP (value)) |
5300 return defalt; | 5284 return default_; |
5301 return value; | 5285 return value; |
5302 } | 5286 } |
5303 } | 5287 } |
5304 | 5288 |
5305 DEFUN ("extent-properties", Fextent_properties, 1, 1, 0, /* | 5289 DEFUN ("extent-properties", Fextent_properties, 1, 1, 0, /* |
5375 | 5359 |
5376 /************************************************************************/ | 5360 /************************************************************************/ |
5377 /* highlighting */ | 5361 /* highlighting */ |
5378 /************************************************************************/ | 5362 /************************************************************************/ |
5379 | 5363 |
5380 /* The display code looks into the Vlast_highlighted_extent variable to | 5364 /* The display code looks into the Vlast_highlighted_extent variable to |
5381 correctly display highlighted extents. This updates that variable, | 5365 correctly display highlighted extents. This updates that variable, |
5382 and marks the appropriate buffers as needing some redisplay. | 5366 and marks the appropriate buffers as needing some redisplay. |
5383 */ | 5367 */ |
5384 static void | 5368 static void |
5385 do_highlight (Lisp_Object extent_obj, int highlight_p) | 5369 do_highlight (Lisp_Object extent_obj, int highlight_p) |
5430 (extent_obj, highlight_p)) | 5414 (extent_obj, highlight_p)) |
5431 { | 5415 { |
5432 if (EXTENTP (extent_obj) && NILP (extent_mouse_face (XEXTENT (extent_obj)))) | 5416 if (EXTENTP (extent_obj) && NILP (extent_mouse_face (XEXTENT (extent_obj)))) |
5433 return Qnil; | 5417 return Qnil; |
5434 else | 5418 else |
5435 return (Fforce_highlight_extent (extent_obj, highlight_p)); | 5419 return Fforce_highlight_extent (extent_obj, highlight_p); |
5436 } | 5420 } |
5437 | 5421 |
5438 | 5422 |
5439 /************************************************************************/ | 5423 /************************************************************************/ |
5440 /* strings and extents */ | 5424 /* strings and extents */ |
5489 (e, buffer_or_string_bytind_to_bufpos (object, from), | 5473 (e, buffer_or_string_bytind_to_bufpos (object, from), |
5490 buffer_or_string_bytind_to_bufpos (object, to), object, | 5474 buffer_or_string_bytind_to_bufpos (object, to), object, |
5491 Qpaste_function); | 5475 Qpaste_function); |
5492 } | 5476 } |
5493 | 5477 |
5494 static void | 5478 static void |
5495 update_extent (EXTENT extent, Bytind from, Bytind to) | 5479 update_extent (EXTENT extent, Bytind from, Bytind to) |
5496 { | 5480 { |
5497 set_extent_endpoints (extent, from, to, Qnil); | 5481 set_extent_endpoints (extent, from, to, Qnil); |
5498 /* #### remove this crap */ | 5482 /* #### remove this crap */ |
5499 #ifdef ENERGIZE | 5483 #ifdef ENERGIZE |
5526 } | 5510 } |
5527 else | 5511 else |
5528 { | 5512 { |
5529 Bytind exstart = extent_endpoint_bytind (extent, 0); | 5513 Bytind exstart = extent_endpoint_bytind (extent, 0); |
5530 Bytind exend = extent_endpoint_bytind (extent, 1); | 5514 Bytind exend = extent_endpoint_bytind (extent, 1); |
5531 | 5515 |
5532 if (exend < new_start || exstart > new_end) | 5516 if (exend < new_start || exstart > new_end) |
5533 goto copy_it; | 5517 goto copy_it; |
5534 else | 5518 else |
5535 { | 5519 { |
5536 new_start = min (exstart, new_start); | 5520 new_start = min (exstart, new_start); |
5597 | 5581 |
5598 static int | 5582 static int |
5599 add_string_extents_mapper (EXTENT extent, void *arg) | 5583 add_string_extents_mapper (EXTENT extent, void *arg) |
5600 { | 5584 { |
5601 /* This function can GC */ | 5585 /* This function can GC */ |
5602 struct add_string_extents_arg *closure = | 5586 struct add_string_extents_arg *closure = |
5603 (struct add_string_extents_arg *) arg; | 5587 (struct add_string_extents_arg *) arg; |
5604 Bytecount start = extent_endpoint_bytind (extent, 0) - closure->from; | 5588 Bytecount start = extent_endpoint_bytind (extent, 0) - closure->from; |
5605 Bytecount end = extent_endpoint_bytind (extent, 1) - closure->from; | 5589 Bytecount end = extent_endpoint_bytind (extent, 1) - closure->from; |
5606 | 5590 |
5607 if (extent_duplicable_p (extent)) | 5591 if (extent_duplicable_p (extent)) |
5608 { | 5592 { |
5609 EXTENT e; | 5593 EXTENT e; |
5610 | 5594 |
5611 start = max (start, 0); | 5595 start = max (start, 0); |
5624 return 0; | 5608 return 0; |
5625 } | 5609 } |
5626 | 5610 |
5627 /* Add the extents in buffer BUF from OPOINT to OPOINT+LENGTH to | 5611 /* Add the extents in buffer BUF from OPOINT to OPOINT+LENGTH to |
5628 the string STRING. */ | 5612 the string STRING. */ |
5629 void | 5613 void |
5630 add_string_extents (Lisp_Object string, struct buffer *buf, Bytind opoint, | 5614 add_string_extents (Lisp_Object string, struct buffer *buf, Bytind opoint, |
5631 Bytecount length) | 5615 Bytecount length) |
5632 { | 5616 { |
5633 /* This function can GC */ | 5617 /* This function can GC */ |
5634 struct add_string_extents_arg closure; | 5618 struct add_string_extents_arg closure; |
5638 closure.from = opoint; | 5622 closure.from = opoint; |
5639 closure.length = length; | 5623 closure.length = length; |
5640 closure.string = string; | 5624 closure.string = string; |
5641 buffer = make_buffer (buf); | 5625 buffer = make_buffer (buf); |
5642 GCPRO2 (buffer, string); | 5626 GCPRO2 (buffer, string); |
5643 map_extents_bytind (opoint, opoint + length, add_string_extents_mapper, | 5627 map_extents_bytind (opoint, opoint + length, add_string_extents_mapper, |
5644 (void *) &closure, buffer, 0, | 5628 (void *) &closure, buffer, 0, |
5645 /* ignore extents that just abut the region */ | 5629 /* ignore extents that just abut the region */ |
5646 ME_END_CLOSED | ME_ALL_EXTENTS_OPEN | | 5630 ME_END_CLOSED | ME_ALL_EXTENTS_OPEN | |
5647 /* we are calling E-Lisp (the extent's copy function) | 5631 /* we are calling E-Lisp (the extent's copy function) |
5648 so anything might happen */ | 5632 so anything might happen */ |
5660 | 5644 |
5661 static int | 5645 static int |
5662 splice_in_string_extents_mapper (EXTENT extent, void *arg) | 5646 splice_in_string_extents_mapper (EXTENT extent, void *arg) |
5663 { | 5647 { |
5664 /* This function can GC */ | 5648 /* This function can GC */ |
5665 struct splice_in_string_extents_arg *closure = | 5649 struct splice_in_string_extents_arg *closure = |
5666 (struct splice_in_string_extents_arg *) arg; | 5650 (struct splice_in_string_extents_arg *) arg; |
5667 /* BASE_START and BASE_END are the limits in the buffer of the string | 5651 /* BASE_START and BASE_END are the limits in the buffer of the string |
5668 that was just inserted. | 5652 that was just inserted. |
5669 | 5653 |
5670 NEW_START and NEW_END are the prospective buffer positions of the | 5654 NEW_START and NEW_END are the prospective buffer positions of the |
5697 | 5681 |
5698 /* We have just inserted a section of STRING (starting at POS, of | 5682 /* We have just inserted a section of STRING (starting at POS, of |
5699 length LENGTH) into buffer BUF at OPOINT. Do whatever is necessary | 5683 length LENGTH) into buffer BUF at OPOINT. Do whatever is necessary |
5700 to get the string's extents into the buffer. */ | 5684 to get the string's extents into the buffer. */ |
5701 | 5685 |
5702 void | 5686 void |
5703 splice_in_string_extents (Lisp_Object string, struct buffer *buf, | 5687 splice_in_string_extents (Lisp_Object string, struct buffer *buf, |
5704 Bytind opoint, Bytecount length, Bytecount pos) | 5688 Bytind opoint, Bytecount length, Bytecount pos) |
5705 { | 5689 { |
5706 struct splice_in_string_extents_arg closure; | 5690 struct splice_in_string_extents_arg closure; |
5707 struct gcpro gcpro1, gcpro2; | 5691 struct gcpro gcpro1, gcpro2; |
5712 closure.pos = pos; | 5696 closure.pos = pos; |
5713 closure.length = length; | 5697 closure.length = length; |
5714 closure.buffer = buffer; | 5698 closure.buffer = buffer; |
5715 GCPRO2 (buffer, string); | 5699 GCPRO2 (buffer, string); |
5716 map_extents_bytind (pos, pos + length, | 5700 map_extents_bytind (pos, pos + length, |
5717 splice_in_string_extents_mapper, | 5701 splice_in_string_extents_mapper, |
5718 (void *) &closure, string, 0, | 5702 (void *) &closure, string, 0, |
5719 /* ignore extents that just abut the region */ | 5703 /* ignore extents that just abut the region */ |
5720 ME_END_CLOSED | ME_ALL_EXTENTS_OPEN | | 5704 ME_END_CLOSED | ME_ALL_EXTENTS_OPEN | |
5721 /* we are calling E-Lisp (the extent's copy function) | 5705 /* we are calling E-Lisp (the extent's copy function) |
5722 so anything might happen */ | 5706 so anything might happen */ |
5735 struct copy_string_extents_1_arg | 5719 struct copy_string_extents_1_arg |
5736 { | 5720 { |
5737 Lisp_Object parent_in_question; | 5721 Lisp_Object parent_in_question; |
5738 EXTENT found_extent; | 5722 EXTENT found_extent; |
5739 }; | 5723 }; |
5740 | 5724 |
5741 static int | 5725 static int |
5742 copy_string_extents_1_mapper (EXTENT extent, void *arg) | 5726 copy_string_extents_1_mapper (EXTENT extent, void *arg) |
5743 { | 5727 { |
5744 struct copy_string_extents_1_arg *closure = | 5728 struct copy_string_extents_1_arg *closure = |
5745 (struct copy_string_extents_1_arg *) arg; | 5729 (struct copy_string_extents_1_arg *) arg; |
5746 | 5730 |
5747 return 0; | 5731 return 0; |
5748 } | 5732 } |
5749 | 5733 |
5750 static int | 5734 static int |
5751 copy_string_extents_mapper (EXTENT extent, void *arg) | 5735 copy_string_extents_mapper (EXTENT extent, void *arg) |
5752 { | 5736 { |
5753 struct copy_string_extents_arg *closure = | 5737 struct copy_string_extents_arg *closure = |
5754 (struct copy_string_extents_arg *) arg; | 5738 (struct copy_string_extents_arg *) arg; |
5755 Bytecount old_start, old_end; | 5739 Bytecount old_start, old_end; |
5756 Bytecount new_start, new_end; | 5740 Bytecount new_start, new_end; |
5757 | 5741 |
5758 old_start = extent_endpoint_bytind (extent, 0); | 5742 old_start = extent_endpoint_bytind (extent, 0); |
5777 /* The string NEW_STRING was partially constructed from OLD_STRING. | 5761 /* The string NEW_STRING was partially constructed from OLD_STRING. |
5778 In particular, the section of length LEN starting at NEW_POS in | 5762 In particular, the section of length LEN starting at NEW_POS in |
5779 NEW_STRING came from the section of the same length starting at | 5763 NEW_STRING came from the section of the same length starting at |
5780 OLD_POS in OLD_STRING. Copy the extents as appropriate. */ | 5764 OLD_POS in OLD_STRING. Copy the extents as appropriate. */ |
5781 | 5765 |
5782 void | 5766 void |
5783 copy_string_extents (Lisp_Object new_string, Lisp_Object old_string, | 5767 copy_string_extents (Lisp_Object new_string, Lisp_Object old_string, |
5784 Bytecount new_pos, Bytecount old_pos, | 5768 Bytecount new_pos, Bytecount old_pos, |
5785 Bytecount length) | 5769 Bytecount length) |
5786 { | 5770 { |
5787 struct copy_string_extents_arg closure; | 5771 struct copy_string_extents_arg closure; |
5960 { | 5944 { |
5961 struct put_text_prop_arg *closure = (struct put_text_prop_arg *) arg; | 5945 struct put_text_prop_arg *closure = (struct put_text_prop_arg *) arg; |
5962 | 5946 |
5963 Lisp_Object object = closure->object; | 5947 Lisp_Object object = closure->object; |
5964 Lisp_Object value = closure->value; | 5948 Lisp_Object value = closure->value; |
5965 Bytind e_start, e_end; | 5949 Bytind e_start, e_end; |
5966 Bytind start = closure->start; | 5950 Bytind start = closure->start; |
5967 Bytind end = closure->end; | 5951 Bytind end = closure->end; |
5968 Lisp_Object extent, e_val; | 5952 Lisp_Object extent, e_val; |
5969 int is_eq; | 5953 int is_eq; |
5970 | 5954 |
6120 | 6104 |
6121 static int | 6105 static int |
6122 put_text_prop_openness_mapper (EXTENT e, void *arg) | 6106 put_text_prop_openness_mapper (EXTENT e, void *arg) |
6123 { | 6107 { |
6124 struct put_text_prop_arg *closure = (struct put_text_prop_arg *) arg; | 6108 struct put_text_prop_arg *closure = (struct put_text_prop_arg *) arg; |
6125 Bytind e_start, e_end; | 6109 Bytind e_start, e_end; |
6126 Bytind start = closure->start; | 6110 Bytind start = closure->start; |
6127 Bytind end = closure->end; | 6111 Bytind end = closure->end; |
6128 Lisp_Object extent; | 6112 Lisp_Object extent; |
6129 XSETEXTENT (extent, e); | 6113 XSETEXTENT (extent, e); |
6130 e_start = extent_endpoint_bytind (e, 0); | 6114 e_start = extent_endpoint_bytind (e, 0); |
6290 { | 6274 { |
6291 Lisp_Object prop = XCAR (props); | 6275 Lisp_Object prop = XCAR (props); |
6292 Lisp_Object value = Fcar (XCDR (props)); | 6276 Lisp_Object value = Fcar (XCDR (props)); |
6293 changed |= put_text_prop (s, e, object, prop, value, 1); | 6277 changed |= put_text_prop (s, e, object, prop, value, 1); |
6294 } | 6278 } |
6295 return (changed ? Qt : Qnil); | 6279 return changed ? Qt : Qnil; |
6296 } | 6280 } |
6297 | 6281 |
6298 | 6282 |
6299 DEFUN ("add-nonduplicable-text-properties", | 6283 DEFUN ("add-nonduplicable-text-properties", |
6300 Fadd_nonduplicable_text_properties, 3, 4, 0, /* | 6284 Fadd_nonduplicable_text_properties, 3, 4, 0, /* |
6318 { | 6302 { |
6319 Lisp_Object prop = XCAR (props); | 6303 Lisp_Object prop = XCAR (props); |
6320 Lisp_Object value = Fcar (XCDR (props)); | 6304 Lisp_Object value = Fcar (XCDR (props)); |
6321 changed |= put_text_prop (s, e, object, prop, value, 0); | 6305 changed |= put_text_prop (s, e, object, prop, value, 0); |
6322 } | 6306 } |
6323 return (changed ? Qt : Qnil); | 6307 return changed ? Qt : Qnil; |
6324 } | 6308 } |
6325 | 6309 |
6326 DEFUN ("remove-text-properties", Fremove_text_properties, 3, 4, 0, /* | 6310 DEFUN ("remove-text-properties", Fremove_text_properties, 3, 4, 0, /* |
6327 Remove the given properties from all characters in the specified region. | 6311 Remove the given properties from all characters in the specified region. |
6328 PROPS should be a plist, but the values in that plist are ignored (treated | 6312 PROPS should be a plist, but the values in that plist are ignored (treated |
6342 for (; !NILP (props); props = Fcdr (Fcdr (props))) | 6326 for (; !NILP (props); props = Fcdr (Fcdr (props))) |
6343 { | 6327 { |
6344 Lisp_Object prop = XCAR (props); | 6328 Lisp_Object prop = XCAR (props); |
6345 changed |= put_text_prop (s, e, object, prop, Qnil, 1); | 6329 changed |= put_text_prop (s, e, object, prop, Qnil, 1); |
6346 } | 6330 } |
6347 return (changed ? Qt : Qnil); | 6331 return changed ? Qt : Qnil; |
6348 } | 6332 } |
6349 | 6333 |
6350 /* Whenever a text-prop extent is pasted into a buffer (via `yank' or `insert' | 6334 /* Whenever a text-prop extent is pasted into a buffer (via `yank' or `insert' |
6351 or whatever) we attach the properties to the buffer by calling | 6335 or whatever) we attach the properties to the buffer by calling |
6352 `put-text-property' instead of by simply allowing the extent to be copied or | 6336 `put-text-property' instead of by simply allowing the extent to be copied or |
6354 again. By handing the insertion hackery in this way, we make kill/yank | 6338 again. By handing the insertion hackery in this way, we make kill/yank |
6355 behave consistently with put-text-property and not fragment the extents | 6339 behave consistently with put-text-property and not fragment the extents |
6356 (since text-prop extents must partition, not overlap). | 6340 (since text-prop extents must partition, not overlap). |
6357 | 6341 |
6358 The lisp implementation of this was probably fast enough, but since I moved | 6342 The lisp implementation of this was probably fast enough, but since I moved |
6359 the rest of the put-text-prop code here, I moved this as well for | 6343 the rest of the put-text-prop code here, I moved this as well for |
6360 completeness. | 6344 completeness. |
6361 */ | 6345 */ |
6362 DEFUN ("text-prop-extent-paste-function", | 6346 DEFUN ("text-prop-extent-paste-function", |
6363 Ftext_prop_extent_paste_function, 3, 3, 0, /* | 6347 Ftext_prop_extent_paste_function, 3, 3, 0, /* |
6364 Used as the `paste-function' property of `text-prop' extents. | 6348 Used as the `paste-function' property of `text-prop' extents. |
6365 */ | 6349 */ |
6511 if ((NILP (extent) && !NILP (value)) || | 6495 if ((NILP (extent) && !NILP (value)) || |
6512 (!NILP (extent) && !EQ (value, | 6496 (!NILP (extent) && !EQ (value, |
6513 Fextent_property (extent, prop, Qnil)))) | 6497 Fextent_property (extent, prop, Qnil)))) |
6514 return make_int (bpos); | 6498 return make_int (bpos); |
6515 } | 6499 } |
6516 | 6500 |
6517 /* I think it's more sensible for this function to return nil always | 6501 /* I think it's more sensible for this function to return nil always |
6518 in this situation and it used to do it this way, but it's been changed | 6502 in this situation and it used to do it this way, but it's been changed |
6519 for FSF compatibility. */ | 6503 for FSF compatibility. */ |
6520 if (limit_was_nil) | 6504 if (limit_was_nil) |
6521 return Qnil; | 6505 return Qnil; |