comparison src/extents.c @ 826:6728e641994e

[xemacs-hg @ 2002-05-05 11:30:15 by ben] syntax cache, 8-bit-format, lots of code cleanup README.packages: Update info about --package-path. i.c: Create an inheritable event and pass it on to XEmacs, so that ^C can be handled properly. Intercept ^C and signal the event. "Stop Build" in VC++ now works. bytecomp-runtime.el: Doc string changes. compat.el: Some attempts to redo this to make it truly useful and fix the "multiple versions interacting with each other" problem. Not yet done. Currently doesn't work. files.el: Use with-obsolete-variable to avoid warnings in new revert-buffer code. xemacs.mak: Split up CFLAGS into a version without flags specifying the C library. The problem seems to be that minitar depends on zlib, which depends specifically on libc.lib, not on any of the other C libraries. Unless you compile with libc.lib, you get errors -- specifically, no _errno in the other libraries, which must make it something other than an int. (#### But this doesn't seem to obtain in XEmacs, which also uses zlib, and can be linked with any of the C libraries. Maybe zlib is used differently and doesn't need errno, or maybe XEmacs provides an int errno; ... I don't understand. Makefile.in.in: Fix so that packages are around when testing. abbrev.c, alloc.c, buffer.c, buffer.h, bytecode.c, callint.c, casefiddle.c, casetab.c, casetab.h, charset.h, chartab.c, chartab.h, cmds.c, console-msw.h, console-stream.c, console-x.c, console.c, console.h, data.c, device-msw.c, device.c, device.h, dialog-msw.c, dialog-x.c, dired-msw.c, dired.c, doc.c, doprnt.c, dumper.c, editfns.c, elhash.c, emacs.c, eval.c, event-Xt.c, event-gtk.c, event-msw.c, event-stream.c, events.c, events.h, extents.c, extents.h, faces.c, file-coding.c, file-coding.h, fileio.c, fns.c, font-lock.c, frame-gtk.c, frame-msw.c, frame-x.c, frame.c, frame.h, glade.c, glyphs-gtk.c, glyphs-msw.c, glyphs-msw.h, glyphs-x.c, glyphs.c, glyphs.h, gui-msw.c, gui-x.c, gui.h, gutter.h, hash.h, indent.c, insdel.c, intl-win32.c, intl.c, keymap.c, lisp-disunion.h, lisp-union.h, lisp.h, lread.c, lrecord.h, lstream.c, lstream.h, marker.c, menubar-gtk.c, menubar-msw.c, menubar-x.c, menubar.c, minibuf.c, mule-ccl.c, mule-charset.c, mule-coding.c, mule-wnnfns.c, nas.c, objects-msw.c, objects-x.c, opaque.c, postgresql.c, print.c, process-nt.c, process-unix.c, process.c, process.h, profile.c, rangetab.c, redisplay-gtk.c, redisplay-msw.c, redisplay-output.c, redisplay-x.c, redisplay.c, redisplay.h, regex.c, regex.h, scrollbar-msw.c, search.c, select-x.c, specifier.c, specifier.h, symbols.c, symsinit.h, syntax.c, syntax.h, syswindows.h, tests.c, text.c, text.h, tooltalk.c, ui-byhand.c, ui-gtk.c, unicode.c, win32.c, window.c: Another big Ben patch. -- FUNCTIONALITY CHANGES: add partial support for 8-bit-fixed, 16-bit-fixed, and 32-bit-fixed formats. not quite done yet. (in particular, needs functions to actually convert the buffer.) NOTE: lots of changes to regex.c here. also, many new *_fmt() inline funs that take an Internal_Format argument. redo syntax cache code. make the cache per-buffer; keep the cache valid across calls to functions that use it. also keep it valid across insertions/deletions and extent changes, as much as is possible. eliminate the junky regex-reentrancy code by passing in the relevant lisp info to the regex routines as local vars. add general mechanism in extents code for signalling extent changes. fix numerous problems with the case-table implementation; yoshiki never properly transferred many algorithms from old-style to new-style case tables. redo char tables to support a default argument, so that mapping only occurs over changed args. change many chartab functions to accept Lisp_Object instead of Lisp_Char_Table *. comment out the code in font-lock.c by default, because font-lock.el no longer uses it. we should consider eliminating it entirely. Don't output bell as ^G in console-stream when not a TTY. add -mswindows-termination-handle to interface with i.c, so we can properly kill a build. add more error-checking to buffer/string macros. add some additional buffer_or_string_() funs. -- INTERFACE CHANGES AFFECTING MORE CODE: switch the arguments of write_c_string and friends to be consistent with write_fmt_string, which must have printcharfun first. change BI_* macros to BYTE_* for increased clarity; similarly for bi_* local vars. change VOID_TO_LISP to be a one-argument function. eliminate no-longer-needed CVOID_TO_LISP. -- char/string macro changes: rename MAKE_CHAR() to make_emchar() for slightly less confusion with make_char(). (The former generates an Emchar, the latter a Lisp object. Conceivably we should rename make_char() -> wrap_char() and similarly for make_int(), make_float().) Similar changes for other *CHAR* macros -- we now consistently use names with `emchar' whenever we are working with Emchars. Any remaining name with just `char' always refers to a Lisp object. rename macros with XSTRING_* to string_* except for those that reference actual fields in the Lisp_String object, following conventions used elsewhere. rename set_string_{data,length} macros (the only ones to work with a Lisp_String_* instead of a Lisp_Object) to set_lispstringp_* to make the difference clear. try to be consistent about caps vs. lowercase in macro/inline-fun names for chars and such, which wasn't the case before. we now reserve caps either for XFOO_ macros that reference object fields (e.g. XSTRING_DATA) or for things that have non-function semantics, e.g. directly modifying an arg (BREAKUP_EMCHAR) or evaluating an arg (any arg) more than once. otherwise, use lowercase. here is a summary of most of the macros/inline funs changed by all of the above changes: BYTE_*_P -> byte_*_p XSTRING_BYTE -> string_byte set_string_data/length -> set_lispstringp_data/length XSTRING_CHAR_LENGTH -> string_char_length XSTRING_CHAR -> string_emchar INTBYTE_FIRST_BYTE_P -> intbyte_first_byte_p INTBYTE_LEADING_BYTE_P -> intbyte_leading_byte_p charptr_copy_char -> charptr_copy_emchar LEADING_BYTE_* -> leading_byte_* CHAR_* -> EMCHAR_* *_CHAR_* -> *_EMCHAR_* *_CHAR -> *_EMCHAR CHARSET_BY_ -> charset_by_* BYTE_SHIFT_JIS* -> byte_shift_jis* BYTE_BIG5* -> byte_big5* REP_BYTES_BY_FIRST_BYTE -> rep_bytes_by_first_byte char_to_unicode -> emchar_to_unicode valid_char_p -> valid_emchar_p Change intbyte_strcmp -> qxestrcmp_c (duplicated functionality). -- INTERFACE CHANGES AFFECTING LESS CODE: use DECLARE_INLINE_HEADER in various places. remove '#ifdef emacs' from XEmacs-only files. eliminate CHAR_TABLE_VALUE(), which duplicated the functionality of get_char_table(). add BUFFER_TEXT_LOOP to simplify iterations over buffer text. define typedefs for signed and unsigned types of fixed sizes (INT_32_BIT, UINT_32_BIT, etc.). create ALIGN_FOR_TYPE as a higher-level interface onto ALIGN_SIZE; fix code to use it. add charptr_emchar_len to return the text length of the character pointed to by a ptr; use it in place of charcount_to_bytecount(..., 1). add emchar_len to return the text length of a given character. add types Bytexpos and Charxpos to generalize Bytebpos/Bytecount and Charbpos/Charcount, in code (particularly, the extents code and redisplay code) that works with either kind of index. rename redisplay struct params with names such as `charbpos' to e.g. `charpos' when they are e.g. a Charxpos, not a Charbpos. eliminate xxDEFUN in place of DEFUN; no longer necessary with changes awhile back to doc.c. split up big ugly combined list of EXFUNs in lisp.h on a file-by-file basis, since other prototypes are similarly split. rewrite some "*_UNSAFE" macros as inline funs and eliminate the _UNSAFE suffix. move most string code from lisp.h to text.h; the string code and text.h code is now intertwined in such a fashion that they need to be in the same place and partially interleaved. (you can't create forward references for inline funs) automated/lisp-tests.el, automated/symbol-tests.el, automated/test-harness.el: Fix test harness to output FAIL messages to stderr when in batch mode. Fix up some problems in lisp-tests/symbol-tests that were causing spurious failures.
author ben
date Sun, 05 May 2002 11:33:57 +0000
parents 6504113e7c2d
children 5d09ddada9ae
comparison
equal deleted inserted replaced
825:eb3bc15a6e0f 826:6728e641994e
263 263
264 static Gap_Array_Marker *gap_array_marker_freelist; 264 static Gap_Array_Marker *gap_array_marker_freelist;
265 265
266 /* Convert a "memory position" (i.e. taking the gap into account) into 266 /* Convert a "memory position" (i.e. taking the gap into account) into
267 the address of the element at (i.e. after) that position. "Memory 267 the address of the element at (i.e. after) that position. "Memory
268 positions" are only used internally and are of type Membpos. 268 positions" are only used internally and are of type Memxpos.
269 "Array positions" are used externally and are of type int. */ 269 "Array positions" are used externally and are of type int. */
270 #define GAP_ARRAY_MEMEL_ADDR(ga, memel) ((ga)->array + (ga)->elsize*(memel)) 270 #define GAP_ARRAY_MEMEL_ADDR(ga, memel) ((ga)->array + (ga)->elsize*(memel))
271 271
272 /* Number of elements currently in a gap array */ 272 /* Number of elements currently in a gap array */
273 #define GAP_ARRAY_NUM_ELS(ga) ((ga)->numels) 273 #define GAP_ARRAY_NUM_ELS(ga) ((ga)->numels)
356 /* ------------------------------- */ 356 /* ------------------------------- */
357 357
358 typedef struct stack_of_extents 358 typedef struct stack_of_extents
359 { 359 {
360 Extent_List *extents; 360 Extent_List *extents;
361 Membpos pos; /* Position of stack of extents. EXTENTS is the list of 361 Memxpos pos; /* Position of stack of extents. EXTENTS is the list of
362 all extents that overlap this position. This position 362 all extents that overlap this position. This position
363 can be -1 if the stack of extents is invalid (this 363 can be -1 if the stack of extents is invalid (this
364 happens when a buffer is first created or a string's 364 happens when a buffer is first created or a string's
365 stack of extents is created [a string's stack of extents 365 stack of extents is created [a string's stack of extents
366 is nuked when a GC occurs, to conserve memory]). */ 366 is nuked when a GC occurs, to conserve memory]). */
368 368
369 /* ------------------------------- */ 369 /* ------------------------------- */
370 /* map-extents */ 370 /* map-extents */
371 /* ------------------------------- */ 371 /* ------------------------------- */
372 372
373 typedef int (*map_extents_fun) (EXTENT extent, void *arg);
374
373 typedef int Endpoint_Index; 375 typedef int Endpoint_Index;
374 376
375 #define membpos_to_startind(x, start_open) \ 377 #define memxpos_to_startind(x, start_open) \
376 ((Endpoint_Index) (((x) << 1) + !!(start_open))) 378 ((Endpoint_Index) (((x) << 1) + !!(start_open)))
377 #define membpos_to_endind(x, end_open) \ 379 #define memxpos_to_endind(x, end_open) \
378 ((Endpoint_Index) (((x) << 1) - !!(end_open))) 380 ((Endpoint_Index) (((x) << 1) - !!(end_open)))
379
380 /* Combination macros */
381 #define bytebpos_to_startind(buf, x, start_open) \
382 membpos_to_startind (bytebpos_to_membpos (buf, x), start_open)
383 #define bytebpos_to_endind(buf, x, end_open) \
384 membpos_to_endind (bytebpos_to_membpos (buf, x), end_open)
385 381
386 /* ------------------------------- */ 382 /* ------------------------------- */
387 /* buffer-or-string primitives */ 383 /* buffer-or-string primitives */
388 /* ------------------------------- */ 384 /* ------------------------------- */
389 385
390 /* Similar for Bytebposs and start/end indices. */ 386 /* Similar for Bytebpos's and start/end indices. */
391 387
392 #define buffer_or_string_bytebpos_to_startind(obj, ind, start_open) \ 388 #define buffer_or_string_bytexpos_to_startind(obj, ind, start_open) \
393 membpos_to_startind (buffer_or_string_bytebpos_to_membpos (obj, ind), \ 389 memxpos_to_startind (buffer_or_string_bytexpos_to_memxpos (obj, ind), \
394 start_open) 390 start_open)
395 391
396 #define buffer_or_string_bytebpos_to_endind(obj, ind, end_open) \ 392 #define buffer_or_string_bytexpos_to_endind(obj, ind, end_open) \
397 membpos_to_endind (buffer_or_string_bytebpos_to_membpos (obj, ind), \ 393 memxpos_to_endind (buffer_or_string_bytexpos_to_memxpos (obj, ind), \
398 end_open) 394 end_open)
399 395
400 /* ------------------------------- */ 396 /* ------------------------------- */
401 /* Lisp-level functions */ 397 /* Lisp-level functions */
402 /* ------------------------------- */ 398 /* ------------------------------- */
446 /* Qtext defined in general.c */ 442 /* Qtext defined in general.c */
447 443
448 Lisp_Object Qcopy_function; 444 Lisp_Object Qcopy_function;
449 Lisp_Object Qpaste_function; 445 Lisp_Object Qpaste_function;
450 446
451 /* The idea here is that if we're given a list of faces, we
452 need to "memoize" this so that two lists of faces that are `equal'
453 turn into the same object. When `set-extent-face' is called, we
454 "memoize" into a list of actual faces; when `extent-face' is called,
455 we do a reverse lookup to get the list of symbols. */
456
457 static Lisp_Object canonicalize_extent_property (Lisp_Object prop, 447 static Lisp_Object canonicalize_extent_property (Lisp_Object prop,
458 Lisp_Object value); 448 Lisp_Object value);
449
450 typedef struct
451 {
452 Lisp_Object key, value;
453 } Lisp_Object_pair;
454 typedef struct
455 {
456 Dynarr_declare (Lisp_Object_pair);
457 } Lisp_Object_pair_dynarr;
458
459 static void extent_properties (EXTENT e, Lisp_Object_pair_dynarr *props);
460
459 Lisp_Object Vextent_face_memoize_hash_table; 461 Lisp_Object Vextent_face_memoize_hash_table;
460 Lisp_Object Vextent_face_reverse_memoize_hash_table; 462 Lisp_Object Vextent_face_reverse_memoize_hash_table;
461 Lisp_Object Vextent_face_reusable_list; 463 Lisp_Object Vextent_face_reusable_list;
462 /* FSFmacs bogosity */ 464 /* FSFmacs bogosity */
463 Lisp_Object Vdefault_text_properties; 465 Lisp_Object Vdefault_text_properties;
464 466
465 EXFUN (Fextent_properties, 1);
466 EXFUN (Fset_extent_property, 3);
467
468 /* if true, we don't want to set any redisplay flags on modeline extent 467 /* if true, we don't want to set any redisplay flags on modeline extent
469 changes */ 468 changes */
470 int in_modeline_generation; 469 int in_modeline_generation;
471 470
472 471
485 484
486 /* Adjust the gap array markers in the range (FROM, TO]. Parallel to 485 /* Adjust the gap array markers in the range (FROM, TO]. Parallel to
487 adjust_markers() in insdel.c. */ 486 adjust_markers() in insdel.c. */
488 487
489 static void 488 static void
490 gap_array_adjust_markers (Gap_Array *ga, Membpos from, 489 gap_array_adjust_markers (Gap_Array *ga, Memxpos from,
491 Membpos to, int amount) 490 Memxpos to, int amount)
492 { 491 {
493 Gap_Array_Marker *m; 492 Gap_Array_Marker *m;
494 493
495 for (m = ga->markers; m; m = m->next) 494 for (m = ga->markers; m; m = m->next)
496 m->pos = do_marker_adjustment (m->pos, from, to, amount); 495 m->pos = do_marker_adjustment (m->pos, from, to, amount);
509 if (pos < gap) 508 if (pos < gap)
510 { 509 {
511 memmove (GAP_ARRAY_MEMEL_ADDR (ga, pos + gapsize), 510 memmove (GAP_ARRAY_MEMEL_ADDR (ga, pos + gapsize),
512 GAP_ARRAY_MEMEL_ADDR (ga, pos), 511 GAP_ARRAY_MEMEL_ADDR (ga, pos),
513 (gap - pos)*ga->elsize); 512 (gap - pos)*ga->elsize);
514 gap_array_adjust_markers (ga, (Membpos) pos, (Membpos) gap, 513 gap_array_adjust_markers (ga, (Memxpos) pos, (Memxpos) gap,
515 gapsize); 514 gapsize);
516 } 515 }
517 else if (pos > gap) 516 else if (pos > gap)
518 { 517 {
519 memmove (GAP_ARRAY_MEMEL_ADDR (ga, gap), 518 memmove (GAP_ARRAY_MEMEL_ADDR (ga, gap),
520 GAP_ARRAY_MEMEL_ADDR (ga, gap + gapsize), 519 GAP_ARRAY_MEMEL_ADDR (ga, gap + gapsize),
521 (pos - gap)*ga->elsize); 520 (pos - gap)*ga->elsize);
522 gap_array_adjust_markers (ga, (Membpos) (gap + gapsize), 521 gap_array_adjust_markers (ga, (Memxpos) (gap + gapsize),
523 (Membpos) (pos + gapsize), - gapsize); 522 (Memxpos) (pos + gapsize), - gapsize);
524 } 523 }
525 ga->gap = pos; 524 ga->gap = pos;
526 } 525 }
527 526
528 /* Make the gap INCREMENT characters longer. Parallel to make_gap() in 527 /* Make the gap INCREMENT characters longer. Parallel to make_gap() in
773 772
774 An out-of-range value for POS is allowed, and guarantees that the 773 An out-of-range value for POS is allowed, and guarantees that the
775 position at the beginning or end of the extent list is returned. */ 774 position at the beginning or end of the extent list is returned. */
776 775
777 static int 776 static int
778 extent_list_locate_from_pos (Extent_List *el, Membpos pos, int endp) 777 extent_list_locate_from_pos (Extent_List *el, Memxpos pos, int endp)
779 { 778 {
780 struct extent fake_extent; 779 struct extent fake_extent;
781 /* 780 /*
782 781
783 Note that if we search for [POS, POS], then we get the following: 782 Note that if we search for [POS, POS], then we get the following:
797 } 796 }
798 797
799 /* Return the extent at POS. */ 798 /* Return the extent at POS. */
800 799
801 static EXTENT 800 static EXTENT
802 extent_list_at (Extent_List *el, Membpos pos, int endp) 801 extent_list_at (Extent_List *el, Memxpos pos, int endp)
803 { 802 {
804 Gap_Array *ga = endp ? el->end : el->start; 803 Gap_Array *ga = endp ? el->end : el->start;
805 804
806 assert (pos >= 0 && pos < GAP_ARRAY_NUM_ELS (ga)); 805 assert (pos >= 0 && pos < GAP_ARRAY_NUM_ELS (ga));
807 return EXTENT_GAP_ARRAY_AT (ga, pos); 806 return EXTENT_GAP_ARRAY_AT (ga, pos);
1297 { 1296 {
1298 printf ("No SOE"); 1297 printf ("No SOE");
1299 return; 1298 return;
1300 } 1299 }
1301 sel = soe->extents; 1300 sel = soe->extents;
1302 printf ("SOE pos is %d (membpos %d)\n", 1301 printf ("SOE pos is %d (memxpos %d)\n",
1303 soe->pos < 0 ? soe->pos : 1302 soe->pos < 0 ? soe->pos :
1304 buffer_or_string_membpos_to_bytebpos (obj, soe->pos), 1303 buffer_or_string_memxpos_to_bytexpos (obj, soe->pos),
1305 soe->pos); 1304 soe->pos);
1306 for (endp = 0; endp < 2; endp++) 1305 for (endp = 0; endp < 2; endp++)
1307 { 1306 {
1308 printf (endp ? "SOE end:" : "SOE start:"); 1307 printf (endp ? "SOE end:" : "SOE start:");
1309 for (i = 0; i < extent_list_num_els (sel); i++) 1308 for (i = 0; i < extent_list_num_els (sel); i++)
1374 } 1373 }
1375 1374
1376 /* Move OBJ's stack of extents to lie over the specified position. */ 1375 /* Move OBJ's stack of extents to lie over the specified position. */
1377 1376
1378 static void 1377 static void
1379 soe_move (Lisp_Object obj, Membpos pos) 1378 soe_move (Lisp_Object obj, Memxpos pos)
1380 { 1379 {
1381 Stack_Of_Extents *soe = buffer_or_string_stack_of_extents_force (obj); 1380 Stack_Of_Extents *soe = buffer_or_string_stack_of_extents_force (obj);
1382 Extent_List *sel = soe->extents; 1381 Extent_List *sel = soe->extents;
1383 int numsoe = extent_list_num_els (sel); 1382 int numsoe = extent_list_num_els (sel);
1384 Extent_List *bel = buffer_or_string_extent_list (obj); 1383 Extent_List *bel = buffer_or_string_extent_list (obj);
1388 #ifdef ERROR_CHECK_EXTENTS 1387 #ifdef ERROR_CHECK_EXTENTS
1389 assert (bel); 1388 assert (bel);
1390 #endif 1389 #endif
1391 1390
1392 #ifdef SOE_DEBUG 1391 #ifdef SOE_DEBUG
1393 printf ("Moving SOE from %d (membpos %d) to %d (membpos %d)\n", 1392 printf ("Moving SOE from %d (memxpos %d) to %d (memxpos %d)\n",
1394 soe->pos < 0 ? soe->pos : 1393 soe->pos < 0 ? soe->pos :
1395 buffer_or_string_membpos_to_bytebpos (obj, soe->pos), soe->pos, 1394 buffer_or_string_memxpos_to_bytexpos (obj, soe->pos), soe->pos,
1396 buffer_or_string_membpos_to_bytebpos (obj, pos), pos); 1395 buffer_or_string_memxpos_to_bytexpos (obj, pos), pos);
1397 #endif 1396 #endif
1398 if (soe->pos < pos) 1397 if (soe->pos < pos)
1399 { 1398 {
1400 direction = 1; 1399 direction = 1;
1401 endp = 0; 1400 endp = 0;
1532 /* ------------------------------- */ 1531 /* ------------------------------- */
1533 1532
1534 /* Return the start (endp == 0) or end (endp == 1) of an extent as 1533 /* Return the start (endp == 0) or end (endp == 1) of an extent as
1535 a byte index. If you want the value as a memory index, use 1534 a byte index. If you want the value as a memory index, use
1536 extent_endpoint(). If you want the value as a buffer position, 1535 extent_endpoint(). If you want the value as a buffer position,
1537 use extent_endpoint_charbpos(). */ 1536 use extent_endpoint_char(). */
1538 1537
1539 static Bytebpos 1538 Bytexpos
1540 extent_endpoint_bytebpos (EXTENT extent, int endp) 1539 extent_endpoint_byte (EXTENT extent, int endp)
1541 { 1540 {
1542 assert (EXTENT_LIVE_P (extent)); 1541 assert (EXTENT_LIVE_P (extent));
1543 assert (!extent_detached_p (extent)); 1542 assert (!extent_detached_p (extent));
1544 { 1543 {
1545 Membpos i = endp ? extent_end (extent) : extent_start (extent); 1544 Memxpos i = endp ? extent_end (extent) : extent_start (extent);
1546 Lisp_Object obj = extent_object (extent); 1545 Lisp_Object obj = extent_object (extent);
1547 return buffer_or_string_membpos_to_bytebpos (obj, i); 1546 return buffer_or_string_memxpos_to_bytexpos (obj, i);
1548 } 1547 }
1549 } 1548 }
1550 1549
1551 static Charbpos 1550 Charxpos
1552 extent_endpoint_charbpos (EXTENT extent, int endp) 1551 extent_endpoint_char (EXTENT extent, int endp)
1553 { 1552 {
1554 assert (EXTENT_LIVE_P (extent)); 1553 assert (EXTENT_LIVE_P (extent));
1555 assert (!extent_detached_p (extent)); 1554 assert (!extent_detached_p (extent));
1556 { 1555 {
1557 Membpos i = endp ? extent_end (extent) : extent_start (extent); 1556 Memxpos i = endp ? extent_end (extent) : extent_start (extent);
1558 Lisp_Object obj = extent_object (extent); 1557 Lisp_Object obj = extent_object (extent);
1559 return buffer_or_string_membpos_to_charbpos (obj, i); 1558 return buffer_or_string_memxpos_to_charxpos (obj, i);
1560 } 1559 }
1561 } 1560 }
1562 1561
1563 /* A change to an extent occurred that will change the display, so
1564 notify redisplay. Maybe also recurse over all the extent's
1565 descendants. */
1566
1567 static void 1562 static void
1568 extent_changed_for_redisplay (EXTENT extent, int descendants_too, 1563 signal_single_extent_changed (EXTENT extent, Lisp_Object property,
1569 int invisibility_change) 1564 Bytexpos old_start, Bytexpos old_end)
1570 { 1565 {
1571 Lisp_Object object; 1566 EXTENT anc = extent_ancestor (extent);
1572 Lisp_Object rest; 1567 /* Redisplay checks */
1573 1568 if (NILP (property) ?
1569 (!NILP (extent_face (anc)) ||
1570 !NILP (extent_begin_glyph (anc)) ||
1571 !NILP (extent_end_glyph (anc)) ||
1572 !NILP (extent_mouse_face (anc)) ||
1573 !NILP (extent_invisible (anc)) ||
1574 !NILP (extent_initial_redisplay_function (anc))) :
1575 EQ (property, Qface) ||
1576 EQ (property, Qmouse_face) ||
1577 EQ (property, Qbegin_glyph) ||
1578 EQ (property, Qend_glyph) ||
1579 EQ (property, Qbegin_glyph_layout) ||
1580 EQ (property, Qend_glyph_layout) ||
1581 EQ (property, Qinvisible) ||
1582 EQ (property, Qinitial_redisplay_function) ||
1583 EQ (property, Qpriority))
1584 {
1585 Lisp_Object object = extent_object (extent);
1586
1587 if (extent_detached_p (extent))
1588 return;
1589
1590 else if (STRINGP (object))
1591 {
1592 /* #### Changes to string extents can affect redisplay if they are
1593 in the modeline or in the gutters.
1594
1595 If the extent is in some generated-modeline-string: when we
1596 change an extent in generated-modeline-string, this changes its
1597 parent, which is in `modeline-format', so we should force the
1598 modeline to be updated. But how to determine whether a string
1599 is a `generated-modeline-string'? Looping through all buffers
1600 is not very efficient. Should we add all
1601 `generated-modeline-string' strings to a hash table? Maybe
1602 efficiency is not the greatest concern here and there's no big
1603 loss in looping over the buffers.
1604
1605 If the extent is in a gutter we mark the gutter as
1606 changed. This means (a) we can update extents in the gutters
1607 when we need it. (b) we don't have to update the gutters when
1608 only extents attached to buffers have changed. */
1609
1610 if (!in_modeline_generation)
1611 MARK_EXTENTS_CHANGED;
1612 gutter_extent_signal_changed_region_maybe
1613 (object, extent_endpoint_char (extent, 0),
1614 extent_endpoint_char (extent, 1));
1615 }
1616 else if (BUFFERP (object))
1617 {
1618 struct buffer *b;
1619 b = XBUFFER (object);
1620 BUF_FACECHANGE (b)++;
1621 MARK_EXTENTS_CHANGED;
1622 if (NILP (property) ? !NILP (extent_invisible (anc)) :
1623 EQ (property, Qinvisible))
1624 MARK_CLIP_CHANGED;
1625 buffer_extent_signal_changed_region
1626 (b, extent_endpoint_char (extent, 0),
1627 extent_endpoint_char (extent, 1));
1628 }
1629 }
1630
1631 /* Check for syntax table property change */
1632 if (NILP (property) ? !NILP (Fextent_property (wrap_extent (extent),
1633 Qsyntax_table, Qnil)) :
1634 EQ (property, Qsyntax_table))
1635 signal_syntax_table_extent_changed (extent);
1636 }
1637
1638 /* Make note that a change has happened in EXTENT. The change was either
1639 to a property or to the endpoints (but not both at once). If PROPERTY
1640 is non-nil, the change happened to that property; otherwise, the change
1641 happened to the endpoints, and the old ones are given. Currently, all
1642 endpoints changes are in the form of two signals, a detach followed by
1643 an attach, and when detaching, we are signalled before the extent is
1644 detached. (You can distinguish a detach from an attach because the
1645 latter has old_start == -1 and old_end == -1.) (#### We don't currently
1646 give the old property. If someone needs that, this will have to
1647 change.) KLUDGE: If PROPERTY is Qt, all properties may have changed
1648 because the parent was changed. #### We need to handle this properly, by
1649 mapping over properties. */
1650
1651 static void
1652 signal_extent_changed (EXTENT extent, Lisp_Object property,
1653 Bytexpos old_start, Bytexpos old_end,
1654 int descendants_too)
1655 {
1574 /* we could easily encounter a detached extent while traversing the 1656 /* we could easily encounter a detached extent while traversing the
1575 children, but we should never be able to encounter a dead extent. */ 1657 children, but we should never be able to encounter a dead extent. */
1576 assert (EXTENT_LIVE_P (extent)); 1658 assert (EXTENT_LIVE_P (extent));
1577 1659
1578 if (descendants_too) 1660 if (descendants_too)
1579 { 1661 {
1580 Lisp_Object children = extent_children (extent); 1662 Lisp_Object children = extent_children (extent);
1581 1663
1582 if (!NILP (children)) 1664 if (!NILP (children))
1583 { 1665 {
1584 /* first mark all of the extent's children. We will lose big-time 1666 /* first process all of the extent's children. We will lose
1585 if there are any circularities here, so we sure as hell better 1667 big-time if there are any circularities here, so we sure as
1586 ensure that there aren't. */ 1668 hell better ensure that there aren't. */
1587 LIST_LOOP (rest, XWEAK_LIST_LIST (children)) 1669 LIST_LOOP_2 (rest, XWEAK_LIST_LIST (children))
1588 extent_changed_for_redisplay (XEXTENT (XCAR (rest)), 1, 1670 signal_extent_changed (extent, property, old_start, old_end,
1589 invisibility_change); 1671 descendants_too);
1590 } 1672 }
1591 } 1673 }
1592 1674
1593 /* now mark the extent itself. */ 1675 /* now process the extent itself. */
1594 1676 signal_single_extent_changed (extent, property, old_start, old_end);
1595 object = extent_object (extent); 1677 }
1596
1597 if (extent_detached_p (extent))
1598 return;
1599
1600 else if (STRINGP (object))
1601 {
1602 /* #### Changes to string extents can affect redisplay if they are
1603 in the modeline or in the gutters.
1604
1605 If the extent is in some generated-modeline-string: when we
1606 change an extent in generated-modeline-string, this changes its
1607 parent, which is in `modeline-format', so we should force the
1608 modeline to be updated. But how to determine whether a string
1609 is a `generated-modeline-string'? Looping through all buffers
1610 is not very efficient. Should we add all
1611 `generated-modeline-string' strings to a hash table? Maybe
1612 efficiency is not the greatest concern here and there's no big
1613 loss in looping over the buffers.
1614
1615 If the extent is in a gutter we mark the gutter as
1616 changed. This means (a) we can update extents in the gutters
1617 when we need it. (b) we don't have to update the gutters when
1618 only extents attached to buffers have changed. */
1619
1620 if (!in_modeline_generation)
1621 MARK_EXTENTS_CHANGED;
1622 gutter_extent_signal_changed_region_maybe (object,
1623 extent_endpoint_charbpos (extent, 0),
1624 extent_endpoint_charbpos (extent, 1));
1625 }
1626 else if (BUFFERP (object))
1627 {
1628 struct buffer *b;
1629 b = XBUFFER (object);
1630 BUF_FACECHANGE (b)++;
1631 MARK_EXTENTS_CHANGED;
1632 if (invisibility_change)
1633 MARK_CLIP_CHANGED;
1634 buffer_extent_signal_changed_region (b,
1635 extent_endpoint_charbpos (extent, 0),
1636 extent_endpoint_charbpos (extent, 1));
1637 }
1638 }
1639
1640 /* A change to an extent occurred that might affect redisplay.
1641 This is called when properties such as the endpoints, the layout,
1642 or the priority changes. Redisplay will be affected only if
1643 the extent has any displayable attributes. */
1644 1678
1645 static void 1679 static void
1646 extent_maybe_changed_for_redisplay (EXTENT extent, int descendants_too, 1680 signal_extent_property_changed (EXTENT extent, Lisp_Object property,
1647 int invisibility_change) 1681 int descendants_too)
1648 { 1682 {
1649 /* Retrieve the ancestor for efficiency */ 1683 signal_extent_changed (extent, property, 0, 0, descendants_too);
1650 EXTENT anc = extent_ancestor (extent);
1651 if (!NILP (extent_face (anc)) ||
1652 !NILP (extent_begin_glyph (anc)) ||
1653 !NILP (extent_end_glyph (anc)) ||
1654 !NILP (extent_mouse_face (anc)) ||
1655 !NILP (extent_invisible (anc)) ||
1656 !NILP (extent_initial_redisplay_function (anc)) ||
1657 invisibility_change)
1658 extent_changed_for_redisplay (extent, descendants_too,
1659 invisibility_change);
1660 } 1684 }
1661 1685
1662 static EXTENT 1686 static EXTENT
1663 make_extent_detached (Lisp_Object object) 1687 make_extent_detached (Lisp_Object object)
1664 { 1688 {
1794 Extent_List *el = extent_extent_list (extent); 1818 Extent_List *el = extent_extent_list (extent);
1795 1819
1796 extent_list_insert (el, extent); 1820 extent_list_insert (el, extent);
1797 soe_insert (extent_object (extent), extent); 1821 soe_insert (extent_object (extent), extent);
1798 /* only this extent changed */ 1822 /* only this extent changed */
1799 extent_maybe_changed_for_redisplay (extent, 0, 1823 signal_extent_changed (extent, Qnil, -1, -1, 0);
1800 !NILP (extent_invisible (extent)));
1801 } 1824 }
1802 1825
1803 static void 1826 static void
1804 extent_detach (EXTENT extent) 1827 extent_detach (EXTENT extent)
1805 { 1828 {
1808 if (extent_detached_p (extent)) 1831 if (extent_detached_p (extent))
1809 return; 1832 return;
1810 el = extent_extent_list (extent); 1833 el = extent_extent_list (extent);
1811 1834
1812 /* call this before messing with the extent. */ 1835 /* call this before messing with the extent. */
1813 extent_maybe_changed_for_redisplay (extent, 0, 1836 signal_extent_changed (extent, Qnil,
1814 !NILP (extent_invisible (extent))); 1837 extent_endpoint_byte (extent, 0),
1838 extent_endpoint_char (extent, 0),
1839 0);
1815 extent_list_delete (el, extent); 1840 extent_list_delete (el, extent);
1816 soe_delete (extent_object (extent), extent); 1841 soe_delete (extent_object (extent), extent);
1817 set_extent_start (extent, -1); 1842 set_extent_start (extent, -1);
1818 set_extent_end (extent, -1); 1843 set_extent_end (extent, -1);
1819 } 1844 }
1826 See the comments at map_extents() for info on the overlap rule. 1851 See the comments at map_extents() for info on the overlap rule.
1827 Assumes that all validation on the extent and buffer positions has 1852 Assumes that all validation on the extent and buffer positions has
1828 already been performed (see Fextent_in_region_p ()). 1853 already been performed (see Fextent_in_region_p ()).
1829 */ 1854 */
1830 static int 1855 static int
1831 extent_in_region_p (EXTENT extent, Bytebpos from, Bytebpos to, 1856 extent_in_region_p (EXTENT extent, Bytexpos from, Bytexpos to,
1832 unsigned int flags) 1857 unsigned int flags)
1833 { 1858 {
1834 Lisp_Object obj = extent_object (extent); 1859 Lisp_Object obj = extent_object (extent);
1835 Endpoint_Index start, end, exs, exe; 1860 Endpoint_Index start, end, exs, exe;
1836 int start_open, end_open; 1861 int start_open, end_open;
1862 case ME_ALL_EXTENTS_CLOSED_OPEN: start_open = 0, end_open = 1; break; 1887 case ME_ALL_EXTENTS_CLOSED_OPEN: start_open = 0, end_open = 1; break;
1863 case ME_ALL_EXTENTS_OPEN_CLOSED: start_open = 1, end_open = 0; break; 1888 case ME_ALL_EXTENTS_OPEN_CLOSED: start_open = 1, end_open = 0; break;
1864 default: abort(); return 0; 1889 default: abort(); return 0;
1865 } 1890 }
1866 1891
1867 start = buffer_or_string_bytebpos_to_startind (obj, from, 1892 start = buffer_or_string_bytexpos_to_startind (obj, from,
1868 flags & ME_START_OPEN); 1893 flags & ME_START_OPEN);
1869 end = buffer_or_string_bytebpos_to_endind (obj, to, ! (flags & ME_END_CLOSED)); 1894 end = buffer_or_string_bytexpos_to_endind (obj, to,
1870 exs = membpos_to_startind (extent_start (extent), start_open); 1895 ! (flags & ME_END_CLOSED));
1871 exe = membpos_to_endind (extent_end (extent), end_open); 1896 exs = memxpos_to_startind (extent_start (extent), start_open);
1897 exe = memxpos_to_endind (extent_end (extent), end_open);
1872 1898
1873 /* It's easy to determine whether an extent lies *outside* the 1899 /* It's easy to determine whether an extent lies *outside* the
1874 region -- just determine whether it's completely before 1900 region -- just determine whether it's completely before
1875 or completely after the region. Reject all such extents, so 1901 or completely after the region. Reject all such extents, so
1876 we're now left with only the extents that overlap the region. 1902 we're now left with only the extents that overlap the region.
1946 Furthermore, the results might be a little less sensible than 1972 Furthermore, the results might be a little less sensible than
1947 the logic below. */ 1973 the logic below. */
1948 1974
1949 1975
1950 static void 1976 static void
1951 map_extents_bytebpos (Bytebpos from, Bytebpos to, map_extents_fun fn, void *arg, 1977 map_extents (Bytexpos from, Bytexpos to, map_extents_fun fn,
1952 Lisp_Object obj, EXTENT after, unsigned int flags) 1978 void *arg, Lisp_Object obj, EXTENT after,
1953 { 1979 unsigned int flags)
1954 Membpos st, en; /* range we're mapping over */ 1980 {
1981 Memxpos st, en; /* range we're mapping over */
1955 EXTENT range = 0; /* extent for this, if ME_MIGHT_MODIFY_TEXT */ 1982 EXTENT range = 0; /* extent for this, if ME_MIGHT_MODIFY_TEXT */
1956 Extent_List *el = 0; /* extent list we're iterating over */ 1983 Extent_List *el = 0; /* extent list we're iterating over */
1957 Extent_List_Marker *posm = 0; /* marker for extent list, 1984 Extent_List_Marker *posm = 0; /* marker for extent list,
1958 if ME_MIGHT_MODIFY_EXTENTS */ 1985 if ME_MIGHT_MODIFY_EXTENTS */
1959 /* count and struct for unwind-protect, if ME_MIGHT_THROW */ 1986 /* count and struct for unwind-protect, if ME_MIGHT_THROW */
1977 el = buffer_or_string_extent_list (obj); 2004 el = buffer_or_string_extent_list (obj);
1978 if (!el || !extent_list_num_els(el)) 2005 if (!el || !extent_list_num_els(el))
1979 return; 2006 return;
1980 el = 0; 2007 el = 0;
1981 2008
1982 st = buffer_or_string_bytebpos_to_membpos (obj, from); 2009 st = buffer_or_string_bytexpos_to_memxpos (obj, from);
1983 en = buffer_or_string_bytebpos_to_membpos (obj, to); 2010 en = buffer_or_string_bytexpos_to_memxpos (obj, to);
1984 2011
1985 if (flags & ME_MIGHT_MODIFY_TEXT) 2012 if (flags & ME_MIGHT_MODIFY_TEXT)
1986 { 2013 {
1987 /* The mapping function might change the text in the buffer, 2014 /* The mapping function might change the text in the buffer,
1988 so make an internal extent to hold the range we're mapping 2015 so make an internal extent to hold the range we're mapping
2247 2274
2248 /* ----- Now actually call the function ----- */ 2275 /* ----- Now actually call the function ----- */
2249 2276
2250 obj2 = extent_object (e); 2277 obj2 = extent_object (e);
2251 if (extent_in_region_p (e, 2278 if (extent_in_region_p (e,
2252 buffer_or_string_membpos_to_bytebpos (obj2, 2279 buffer_or_string_memxpos_to_bytexpos (obj2,
2253 st), 2280 st),
2254 buffer_or_string_membpos_to_bytebpos (obj2, 2281 buffer_or_string_memxpos_to_bytexpos (obj2,
2255 en), 2282 en),
2256 flags)) 2283 flags))
2257 { 2284 {
2258 if ((*fn)(e, arg)) 2285 if ((*fn)(e, arg))
2259 { 2286 {
2260 /* Function wants us to stop mapping. */ 2287 /* Function wants us to stop mapping. */
2278 if (posm) 2305 if (posm)
2279 extent_list_delete_marker (el, posm); 2306 extent_list_delete_marker (el, posm);
2280 } 2307 }
2281 } 2308 }
2282 2309
2283 void
2284 map_extents (Charbpos from, Charbpos to, map_extents_fun fn,
2285 void *arg, Lisp_Object obj, EXTENT after, unsigned int flags)
2286 {
2287 map_extents_bytebpos (buffer_or_string_charbpos_to_bytebpos (obj, from),
2288 buffer_or_string_charbpos_to_bytebpos (obj, to), fn, arg,
2289 obj, after, flags);
2290 }
2291
2292 /* ------------------------------- */ 2310 /* ------------------------------- */
2293 /* adjust_extents() */ 2311 /* adjust_extents() */
2294 /* ------------------------------- */ 2312 /* ------------------------------- */
2295 2313
2296 /* Add AMOUNT to all extent endpoints in the range (FROM, TO]. This 2314 /* Add AMOUNT to all extent endpoints in the range (FROM, TO]. This
2308 around with extent endpoints without detaching and reattaching 2326 around with extent endpoints without detaching and reattaching
2309 the extents (this is provably correct and saves lots of time), 2327 the extents (this is provably correct and saves lots of time),
2310 so for safety we make it just look at the extent lists directly. */ 2328 so for safety we make it just look at the extent lists directly. */
2311 2329
2312 void 2330 void
2313 adjust_extents (Lisp_Object obj, Membpos from, Membpos to, int amount) 2331 adjust_extents (Lisp_Object obj, Memxpos from, Memxpos to, int amount)
2314 { 2332 {
2315 int endp; 2333 int endp;
2316 int pos; 2334 int pos;
2317 int startpos[2]; 2335 int startpos[2];
2318 Extent_List *el; 2336 Extent_List *el;
2384 There is no string correspondent for this because you can't 2402 There is no string correspondent for this because you can't
2385 delete characters from a string. 2403 delete characters from a string.
2386 */ 2404 */
2387 2405
2388 void 2406 void
2389 adjust_extents_for_deletion (Lisp_Object object, Bytebpos from, 2407 adjust_extents_for_deletion (Lisp_Object object, Bytexpos from,
2390 Bytebpos to, int gapsize, int numdel, 2408 Bytexpos to, int gapsize, int numdel,
2391 int movegapsize) 2409 int movegapsize)
2392 { 2410 {
2393 struct adjust_extents_for_deletion_arg closure; 2411 struct adjust_extents_for_deletion_arg closure;
2394 int i; 2412 int i;
2395 Membpos adjust_to = (Membpos) (to + gapsize); 2413 Memxpos adjust_to = (Memxpos) (to + gapsize);
2396 Bytecount amount = - numdel - movegapsize; 2414 Bytecount amount = - numdel - movegapsize;
2397 Membpos oldsoe = 0, newsoe = 0; 2415 Memxpos oldsoe = 0, newsoe = 0;
2398 Stack_Of_Extents *soe = buffer_or_string_stack_of_extents (object); 2416 Stack_Of_Extents *soe = buffer_or_string_stack_of_extents (object);
2399 2417
2400 #ifdef ERROR_CHECK_EXTENTS 2418 #ifdef ERROR_CHECK_EXTENTS
2401 sledgehammer_extent_check (object); 2419 sledgehammer_extent_check (object);
2402 #endif 2420 #endif
2405 /* We're going to be playing weird games below with extents and the SOE 2423 /* We're going to be playing weird games below with extents and the SOE
2406 and such, so compute the list now of all the extents that we're going 2424 and such, so compute the list now of all the extents that we're going
2407 to muck with. If we do the mapping and adjusting together, things can 2425 to muck with. If we do the mapping and adjusting together, things can
2408 get all screwed up. */ 2426 get all screwed up. */
2409 2427
2410 map_extents_bytebpos (from, to, adjust_extents_for_deletion_mapper, 2428 map_extents (from, to, adjust_extents_for_deletion_mapper,
2411 (void *) &closure, object, 0, 2429 (void *) &closure, object, 0,
2412 /* extent endpoints move like markers regardless 2430 /* extent endpoints move like markers regardless
2413 of their open/closeness. */ 2431 of their open/closeness. */
2414 ME_ALL_EXTENTS_CLOSED | ME_END_CLOSED | 2432 ME_ALL_EXTENTS_CLOSED | ME_END_CLOSED |
2415 ME_START_OR_END_IN_REGION | ME_INCLUDE_INTERNAL); 2433 ME_START_OR_END_IN_REGION | ME_INCLUDE_INTERNAL);
2416 2434
2417 /* 2435 /*
2418 Old and new values for the SOE's position. (It gets adjusted 2436 Old and new values for the SOE's position. (It gets adjusted
2419 like a marker, just like extent endpoints.) 2437 like a marker, just like extent endpoints.)
2420 */ 2438 */
2431 } 2449 }
2432 2450
2433 for (i = 0; i < Dynarr_length (closure.list); i++) 2451 for (i = 0; i < Dynarr_length (closure.list); i++)
2434 { 2452 {
2435 EXTENT extent = Dynarr_at (closure.list, i); 2453 EXTENT extent = Dynarr_at (closure.list, i);
2436 Membpos new_start = extent_start (extent); 2454 Memxpos new_start = extent_start (extent);
2437 Membpos new_end = extent_end (extent); 2455 Memxpos new_end = extent_end (extent);
2438 2456
2439 /* do_marker_adjustment() will not adjust values that should not be 2457 /* do_marker_adjustment() will not adjust values that should not be
2440 adjusted. We're passing the same funky arguments to 2458 adjusted. We're passing the same funky arguments to
2441 do_marker_adjustment() as buffer_delete_range() does. */ 2459 do_marker_adjustment() as buffer_delete_range() does. */
2442 new_start = 2460 new_start =
2512 2530
2513 /* This function returns the position of the beginning of 2531 /* This function returns the position of the beginning of
2514 the first run that begins after POS, or returns POS if 2532 the first run that begins after POS, or returns POS if
2515 there are no such runs. */ 2533 there are no such runs. */
2516 2534
2517 static Bytebpos 2535 static Bytexpos
2518 extent_find_end_of_run (Lisp_Object obj, Bytebpos pos, int outside_accessible) 2536 extent_find_end_of_run (Lisp_Object obj, Bytexpos pos, int outside_accessible)
2519 { 2537 {
2520 Extent_List *sel; 2538 Extent_List *sel;
2521 Extent_List *bel = buffer_or_string_extent_list (obj); 2539 Extent_List *bel = buffer_or_string_extent_list (obj);
2522 Bytebpos pos1, pos2; 2540 Bytexpos pos1, pos2;
2523 int elind1, elind2; 2541 int elind1, elind2;
2524 Membpos mempos = buffer_or_string_bytebpos_to_membpos (obj, pos); 2542 Memxpos mempos = buffer_or_string_bytexpos_to_memxpos (obj, pos);
2525 Bytebpos limit = outside_accessible ? 2543 Bytexpos limit = outside_accessible ?
2526 buffer_or_string_absolute_end_byte (obj) : 2544 buffer_or_string_absolute_end_byte (obj) :
2527 buffer_or_string_accessible_end_byte (obj); 2545 buffer_or_string_accessible_end_byte (obj);
2528 2546
2529 if (!bel || !extent_list_num_els(bel)) 2547 if (!bel || !extent_list_num_els (bel))
2530 return limit; 2548 return limit;
2531 2549
2532 sel = buffer_or_string_stack_of_extents_force (obj)->extents; 2550 sel = buffer_or_string_stack_of_extents_force (obj)->extents;
2533 soe_move (obj, mempos); 2551 soe_move (obj, mempos);
2534 2552
2535 /* Find the first start position after POS. */ 2553 /* Find the first start position after POS. */
2536 elind1 = extent_list_locate_from_pos (bel, mempos+1, 0); 2554 elind1 = extent_list_locate_from_pos (bel, mempos+1, 0);
2537 if (elind1 < extent_list_num_els (bel)) 2555 if (elind1 < extent_list_num_els (bel))
2538 pos1 = buffer_or_string_membpos_to_bytebpos 2556 pos1 = buffer_or_string_memxpos_to_bytexpos
2539 (obj, extent_start (extent_list_at (bel, elind1, 0))); 2557 (obj, extent_start (extent_list_at (bel, elind1, 0)));
2540 else 2558 else
2541 pos1 = limit; 2559 pos1 = limit;
2542 2560
2543 /* Find the first end position after POS. The extent corresponding 2561 /* Find the first end position after POS. The extent corresponding
2544 to this position is either in the SOE or is greater than or 2562 to this position is either in the SOE or is greater than or
2545 equal to POS1, so we just have to look in the SOE. */ 2563 equal to POS1, so we just have to look in the SOE. */
2546 elind2 = extent_list_locate_from_pos (sel, mempos+1, 1); 2564 elind2 = extent_list_locate_from_pos (sel, mempos+1, 1);
2547 if (elind2 < extent_list_num_els (sel)) 2565 if (elind2 < extent_list_num_els (sel))
2548 pos2 = buffer_or_string_membpos_to_bytebpos 2566 pos2 = buffer_or_string_memxpos_to_bytexpos
2549 (obj, extent_end (extent_list_at (sel, elind2, 1))); 2567 (obj, extent_end (extent_list_at (sel, elind2, 1)));
2550 else 2568 else
2551 pos2 = limit; 2569 pos2 = limit;
2552 2570
2553 return min (min (pos1, pos2), limit); 2571 return min (min (pos1, pos2), limit);
2554 } 2572 }
2555 2573
2556 static Bytebpos 2574 static Bytexpos
2557 extent_find_beginning_of_run (Lisp_Object obj, Bytebpos pos, 2575 extent_find_beginning_of_run (Lisp_Object obj, Bytexpos pos,
2558 int outside_accessible) 2576 int outside_accessible)
2559 { 2577 {
2560 Extent_List *sel; 2578 Extent_List *sel;
2561 Extent_List *bel = buffer_or_string_extent_list (obj); 2579 Extent_List *bel = buffer_or_string_extent_list (obj);
2562 Bytebpos pos1, pos2; 2580 Bytexpos pos1, pos2;
2563 int elind1, elind2; 2581 int elind1, elind2;
2564 Membpos mempos = buffer_or_string_bytebpos_to_membpos (obj, pos); 2582 Memxpos mempos = buffer_or_string_bytexpos_to_memxpos (obj, pos);
2565 Bytebpos limit = outside_accessible ? 2583 Bytexpos limit = outside_accessible ?
2566 buffer_or_string_absolute_begin_byte (obj) : 2584 buffer_or_string_absolute_begin_byte (obj) :
2567 buffer_or_string_accessible_begin_byte (obj); 2585 buffer_or_string_accessible_begin_byte (obj);
2568 2586
2569 if (!bel || !extent_list_num_els(bel)) 2587 if (!bel || !extent_list_num_els(bel))
2570 return limit; 2588 return limit;
2571 2589
2572 sel = buffer_or_string_stack_of_extents_force (obj)->extents; 2590 sel = buffer_or_string_stack_of_extents_force (obj)->extents;
2573 soe_move (obj, mempos); 2591 soe_move (obj, mempos);
2574 2592
2575 /* Find the first end position before POS. */ 2593 /* Find the first end position before POS. */
2576 elind1 = extent_list_locate_from_pos (bel, mempos, 1); 2594 elind1 = extent_list_locate_from_pos (bel, mempos, 1);
2577 if (elind1 > 0) 2595 if (elind1 > 0)
2578 pos1 = buffer_or_string_membpos_to_bytebpos 2596 pos1 = buffer_or_string_memxpos_to_bytexpos
2579 (obj, extent_end (extent_list_at (bel, elind1 - 1, 1))); 2597 (obj, extent_end (extent_list_at (bel, elind1 - 1, 1)));
2580 else 2598 else
2581 pos1 = limit; 2599 pos1 = limit;
2582 2600
2583 /* Find the first start position before POS. The extent corresponding 2601 /* Find the first start position before POS. The extent corresponding
2584 to this position is either in the SOE or is less than or 2602 to this position is either in the SOE or is less than or
2585 equal to POS1, so we just have to look in the SOE. */ 2603 equal to POS1, so we just have to look in the SOE. */
2586 elind2 = extent_list_locate_from_pos (sel, mempos, 0); 2604 elind2 = extent_list_locate_from_pos (sel, mempos, 0);
2587 if (elind2 > 0) 2605 if (elind2 > 0)
2588 pos2 = buffer_or_string_membpos_to_bytebpos 2606 pos2 = buffer_or_string_memxpos_to_bytexpos
2589 (obj, extent_start (extent_list_at (sel, elind2 - 1, 0))); 2607 (obj, extent_start (extent_list_at (sel, elind2 - 1, 0)));
2590 else 2608 else
2591 pos2 = limit; 2609 pos2 = limit;
2592 2610
2593 return max (max (pos1, pos2), limit); 2611 return max (max (pos1, pos2), limit);
2752 return 0; 2770 return 0;
2753 } 2771 }
2754 2772
2755 face_index 2773 face_index
2756 extent_fragment_update (struct window *w, struct extent_fragment *ef, 2774 extent_fragment_update (struct window *w, struct extent_fragment *ef,
2757 Bytebpos pos, Lisp_Object last_glyph) 2775 Bytexpos pos, Lisp_Object last_glyph)
2758 { 2776 {
2759 int i; 2777 int i;
2760 int seen_glyph = NILP (last_glyph) ? 1 : 0; 2778 int seen_glyph = NILP (last_glyph) ? 1 : 0;
2761 Extent_List *sel = 2779 Extent_List *sel =
2762 buffer_or_string_stack_of_extents_force (ef->object)->extents; 2780 buffer_or_string_stack_of_extents_force (ef->object)->extents;
2763 EXTENT lhe = 0; 2781 EXTENT lhe = 0;
2764 struct extent dummy_lhe_extent; 2782 struct extent dummy_lhe_extent;
2765 Membpos mempos = buffer_or_string_bytebpos_to_membpos (ef->object, pos); 2783 Memxpos mempos = buffer_or_string_bytexpos_to_memxpos (ef->object, pos);
2766 2784
2767 #ifdef ERROR_CHECK_EXTENTS 2785 #ifdef ERROR_CHECK_EXTENTS
2768 assert (pos >= buffer_or_string_accessible_begin_byte (ef->object) 2786 assert (pos >= buffer_or_string_accessible_begin_byte (ef->object)
2769 && pos <= buffer_or_string_accessible_end_byte (ef->object)); 2787 && pos <= buffer_or_string_accessible_end_byte (ef->object));
2770 #endif 2788 #endif
2958 if (!NILP (extent_begin_glyph (anc))) *bp++ = '*'; 2976 if (!NILP (extent_begin_glyph (anc))) *bp++ = '*';
2959 *bp++ = (extent_start_open_p (anc) ? '(': '['); 2977 *bp++ = (extent_start_open_p (anc) ? '(': '[');
2960 if (extent_detached_p (ext)) 2978 if (extent_detached_p (ext))
2961 strcpy (bp, "detached"); 2979 strcpy (bp, "detached");
2962 else 2980 else
2963 sprintf (bp, "%d, %d", 2981 sprintf (bp, "%ld, %ld",
2964 XINT (Fextent_start_position (obj)), 2982 XINT (Fextent_start_position (obj)),
2965 XINT (Fextent_end_position (obj))); 2983 XINT (Fextent_end_position (obj)));
2966 bp += strlen (bp); 2984 bp += strlen (bp);
2967 *bp++ = (extent_end_open_p (anc) ? ')': ']'); 2985 *bp++ = (extent_end_open_p (anc) ? ')': ']');
2968 if (!NILP (extent_end_glyph (anc))) *bp++ = '*'; 2986 if (!NILP (extent_end_glyph (anc))) *bp++ = '*';
2977 if (!NILP (extent_read_only (anc)) || !NILP (extent_mouse_face (anc)) || 2995 if (!NILP (extent_read_only (anc)) || !NILP (extent_mouse_face (anc)) ||
2978 extent_unique_p (anc) || 2996 extent_unique_p (anc) ||
2979 extent_duplicable_p (anc) || !NILP (extent_invisible (anc))) 2997 extent_duplicable_p (anc) || !NILP (extent_invisible (anc)))
2980 *bp++ = ' '; 2998 *bp++ = ' ';
2981 *bp = '\0'; 2999 *bp = '\0';
2982 write_c_string (buf, printcharfun); 3000 write_c_string (printcharfun, buf);
2983 3001
2984 tail = extent_plist_slot (anc); 3002 tail = extent_plist_slot (anc);
2985 3003
2986 for (; !NILP (tail); tail = Fcdr (Fcdr (tail))) 3004 for (; !NILP (tail); tail = Fcdr (Fcdr (tail)))
2987 { 3005 {
3039 printing_unreadable_object ("#<extent 0x%lx>", 3057 printing_unreadable_object ("#<extent 0x%lx>",
3040 (long) XEXTENT (obj)); 3058 (long) XEXTENT (obj));
3041 } 3059 }
3042 3060
3043 if (!EXTENT_LIVE_P (XEXTENT (obj))) 3061 if (!EXTENT_LIVE_P (XEXTENT (obj)))
3044 write_c_string ("#<destroyed extent", printcharfun); 3062 write_c_string (printcharfun, "#<destroyed extent");
3045 else 3063 else
3046 { 3064 {
3047 write_c_string ("#<extent ", printcharfun); 3065 write_c_string (printcharfun, "#<extent ");
3048 print_extent_1 (obj, printcharfun, escapeflag); 3066 print_extent_1 (obj, printcharfun, escapeflag);
3049 write_c_string (extent_detached_p (XEXTENT (obj)) 3067 write_c_string (printcharfun, extent_detached_p (XEXTENT (obj))
3050 ? " from " : " in ", printcharfun); 3068 ? " from " : " in ");
3051 write_fmt_string (printcharfun, "%s%s%s", title, name, posttitle); 3069 write_fmt_string (printcharfun, "%s%s%s", title, name, posttitle);
3052 } 3070 }
3053 } 3071 }
3054 else 3072 else
3055 { 3073 {
3056 if (print_readably) 3074 if (print_readably)
3057 printing_unreadable_object ("#<extent>"); 3075 printing_unreadable_object ("#<extent>");
3058 write_c_string ("#<extent", printcharfun); 3076 write_c_string (printcharfun, "#<extent");
3059 } 3077 }
3060 write_c_string (">", printcharfun); 3078 write_c_string (printcharfun, ">");
3061 } 3079 }
3062 3080
3063 static int 3081 static int
3064 properties_equal (EXTENT e1, EXTENT e2, int depth) 3082 properties_equal (EXTENT e1, EXTENT e2, int depth)
3065 { 3083 {
3140 } 3158 }
3141 3159
3142 static int 3160 static int
3143 extent_remprop (Lisp_Object obj, Lisp_Object prop) 3161 extent_remprop (Lisp_Object obj, Lisp_Object prop)
3144 { 3162 {
3145 EXTENT ext = XEXTENT (obj); 3163 Lisp_Object retval = Fset_extent_property (obj, prop, Qunbound);
3146 3164 if (UNBOUNDP (retval))
3147 /* This list is taken from Fset_extent_property, and should be kept 3165 return -1;
3148 in synch. */ 3166 else if (!NILP (retval))
3149 if (EQ (prop, Qread_only) 3167 return 1;
3150 || EQ (prop, Qunique) 3168 else
3151 || EQ (prop, Qduplicable) 3169 return 0;
3152 || EQ (prop, Qinvisible)
3153 || EQ (prop, Qdetachable)
3154 || EQ (prop, Qdetached)
3155 || EQ (prop, Qdestroyed)
3156 || EQ (prop, Qpriority)
3157 || EQ (prop, Qface)
3158 || EQ (prop, Qinitial_redisplay_function)
3159 || EQ (prop, Qafter_change_functions)
3160 || EQ (prop, Qbefore_change_functions)
3161 || EQ (prop, Qmouse_face)
3162 || EQ (prop, Qhighlight)
3163 || EQ (prop, Qbegin_glyph_layout)
3164 || EQ (prop, Qend_glyph_layout)
3165 || EQ (prop, Qglyph_layout)
3166 || EQ (prop, Qbegin_glyph)
3167 || EQ (prop, Qend_glyph)
3168 || EQ (prop, Qstart_open)
3169 || EQ (prop, Qend_open)
3170 || EQ (prop, Qstart_closed)
3171 || EQ (prop, Qend_closed)
3172 || EQ (prop, Qkeymap))
3173 {
3174 /* #### Is this correct, anyway? */
3175 return -1;
3176 }
3177
3178 return external_remprop (extent_plist_addr (ext), prop, 0, ERROR_ME);
3179 } 3170 }
3180 3171
3181 static Lisp_Object 3172 static Lisp_Object
3182 extent_plist (Lisp_Object obj) 3173 extent_plist (Lisp_Object obj)
3183 { 3174 {
3255 } 3246 }
3256 3247
3257 return extent; 3248 return extent;
3258 } 3249 }
3259 3250
3260 /* Note that the returned value is a buffer position, not a byte index. */ 3251 /* Note that the returned value is a char position, not a byte position. */
3261 3252
3262 static Lisp_Object 3253 static Lisp_Object
3263 extent_endpoint_external (Lisp_Object extent_obj, int endp) 3254 extent_endpoint_external (Lisp_Object extent_obj, int endp)
3264 { 3255 {
3265 EXTENT extent = decode_extent (extent_obj, 0); 3256 EXTENT extent = decode_extent (extent_obj, 0);
3266 3257
3267 if (extent_detached_p (extent)) 3258 if (extent_detached_p (extent))
3268 return Qnil; 3259 return Qnil;
3269 else 3260 else
3270 return make_int (extent_endpoint_charbpos (extent, endp)); 3261 return make_int (extent_endpoint_char (extent, endp));
3271 } 3262 }
3272 3263
3273 DEFUN ("extentp", Fextentp, 1, 1, 0, /* 3264 DEFUN ("extentp", Fextentp, 1, 1, 0, /*
3274 Return t if OBJECT is an extent. 3265 Return t if OBJECT is an extent.
3275 */ 3266 */
3322 Return length of EXTENT in characters. 3313 Return length of EXTENT in characters.
3323 */ 3314 */
3324 (extent)) 3315 (extent))
3325 { 3316 {
3326 EXTENT e = decode_extent (extent, DE_MUST_BE_ATTACHED); 3317 EXTENT e = decode_extent (extent, DE_MUST_BE_ATTACHED);
3327 return make_int (extent_endpoint_charbpos (e, 1) 3318 return make_int (extent_endpoint_char (e, 1)
3328 - extent_endpoint_charbpos (e, 0)); 3319 - extent_endpoint_char (e, 0));
3329 } 3320 }
3330 3321
3331 DEFUN ("next-extent", Fnext_extent, 1, 1, 0, /* 3322 DEFUN ("next-extent", Fnext_extent, 1, 1, 0, /*
3332 Find next extent after EXTENT. 3323 Find next extent after EXTENT.
3333 If EXTENT is a buffer return the first extent in the buffer; likewise 3324 If EXTENT is a buffer return the first extent in the buffer; likewise
3426 If OBJECT is nil, the current buffer is assumed. 3417 If OBJECT is nil, the current buffer is assumed.
3427 */ 3418 */
3428 (pos, object)) 3419 (pos, object))
3429 { 3420 {
3430 Lisp_Object obj = decode_buffer_or_string (object); 3421 Lisp_Object obj = decode_buffer_or_string (object);
3431 Bytebpos bpos; 3422 Bytexpos xpos;
3432 3423
3433 bpos = get_buffer_or_string_pos_byte (obj, pos, GB_ALLOW_PAST_ACCESSIBLE); 3424 xpos = get_buffer_or_string_pos_byte (obj, pos, GB_ALLOW_PAST_ACCESSIBLE);
3434 bpos = extent_find_end_of_run (obj, bpos, 1); 3425 xpos = extent_find_end_of_run (obj, xpos, 1);
3435 return make_int (buffer_or_string_bytebpos_to_charbpos (obj, bpos)); 3426 return make_int (buffer_or_string_bytexpos_to_charxpos (obj, xpos));
3436 } 3427 }
3437 3428
3438 DEFUN ("previous-extent-change", Fprevious_extent_change, 1, 2, 0, /* 3429 DEFUN ("previous-extent-change", Fprevious_extent_change, 1, 2, 0, /*
3439 Return the last position before POS where an extent begins or ends. 3430 Return the last position before POS where an extent begins or ends.
3440 If POS is at the beginning of the buffer or string, POS will be returned; 3431 If POS is at the beginning of the buffer or string, POS will be returned;
3442 If OBJECT is nil, the current buffer is assumed. 3433 If OBJECT is nil, the current buffer is assumed.
3443 */ 3434 */
3444 (pos, object)) 3435 (pos, object))
3445 { 3436 {
3446 Lisp_Object obj = decode_buffer_or_string (object); 3437 Lisp_Object obj = decode_buffer_or_string (object);
3447 Bytebpos bpos; 3438 Bytexpos xpos;
3448 3439
3449 bpos = get_buffer_or_string_pos_byte (obj, pos, GB_ALLOW_PAST_ACCESSIBLE); 3440 xpos = get_buffer_or_string_pos_byte (obj, pos, GB_ALLOW_PAST_ACCESSIBLE);
3450 bpos = extent_find_beginning_of_run (obj, bpos, 1); 3441 xpos = extent_find_beginning_of_run (obj, xpos, 1);
3451 return make_int (buffer_or_string_bytebpos_to_charbpos (obj, bpos)); 3442 return make_int (buffer_or_string_bytexpos_to_charxpos (obj, xpos));
3452 } 3443 }
3453 3444
3454 3445
3455 /************************************************************************/ 3446 /************************************************************************/
3456 /* parent and children stuff */ 3447 /* parent and children stuff */
3512 3503
3513 #ifdef ERROR_CHECK_EXTENTS 3504 #ifdef ERROR_CHECK_EXTENTS
3514 assert (NILP (memq_no_quit (child, XWEAK_LIST_LIST (children)))); 3505 assert (NILP (memq_no_quit (child, XWEAK_LIST_LIST (children))));
3515 #endif 3506 #endif
3516 XWEAK_LIST_LIST (children) = Fcons (child, XWEAK_LIST_LIST (children)); 3507 XWEAK_LIST_LIST (children) = Fcons (child, XWEAK_LIST_LIST (children));
3508 }
3509
3510
3511 static int
3512 compare_key_value_pairs (const void *humpty, const void *dumpty)
3513 {
3514 Lisp_Object_pair *foo = (Lisp_Object_pair *) humpty;
3515 Lisp_Object_pair *bar = (Lisp_Object_pair *) dumpty;
3516 if (EQ (foo->key, bar->key))
3517 return 0;
3518 return !NILP (Fstring_lessp (foo->key, bar->key)) ? -1 : 1;
3517 } 3519 }
3518 3520
3519 DEFUN ("set-extent-parent", Fset_extent_parent, 2, 2, 0, /* 3521 DEFUN ("set-extent-parent", Fset_extent_parent, 2, 2, 0, /*
3520 Set the parent of EXTENT to PARENT (may be nil). 3522 Set the parent of EXTENT to PARENT (may be nil).
3521 See `extent-parent'. 3523 See `extent-parent'.
3548 set_extent_no_chase_aux_field (e, parent, parent); 3550 set_extent_no_chase_aux_field (e, parent, parent);
3549 e->flags.has_parent = 1; 3551 e->flags.has_parent = 1;
3550 } 3552 }
3551 /* changing the parent also changes the properties of all children. */ 3553 /* changing the parent also changes the properties of all children. */
3552 { 3554 {
3555 Lisp_Object_pair_dynarr *oldprops, *newprops;
3556 int i, orignewlength;
3557
3558 /* perhaps there's a smarter way, but the following will work,
3559 and it's O(N*log N):
3560
3561 (1) get the old props.
3562 (2) get the new props.
3563 (3) sort both.
3564 (4) loop through old props; if key not in new, add it, with value
3565 Qunbound.
3566 (5) vice-versa for new props.
3567 (6) sort both again.
3568 (7) now we have identical lists of keys; we run through and compare
3569 the values.
3570
3571 Of course in reality the number of properties will be low, so
3572 an N^2 algorithm wouldn't be a problem, but the stuff below is just
3573 as easy to write given the existence of qsort and bsearch.
3574 */
3575
3576 oldprops = Dynarr_new (Lisp_Object_pair);
3577 newprops = Dynarr_new (Lisp_Object_pair);
3578 if (!NILP (cur_parent))
3579 extent_properties (XEXTENT (cur_parent), oldprops);
3580 if (!NILP (parent))
3581 extent_properties (XEXTENT (parent), newprops);
3582
3583 qsort (Dynarr_atp (oldprops, 0), Dynarr_length (oldprops),
3584 sizeof (Lisp_Object_pair), compare_key_value_pairs);
3585 qsort (Dynarr_atp (newprops, 0), Dynarr_length (newprops),
3586 sizeof (Lisp_Object_pair), compare_key_value_pairs);
3587 orignewlength = Dynarr_length (newprops);
3588 for (i = 0; i < Dynarr_length (oldprops); i++)
3589 {
3590 if (!bsearch (Dynarr_atp (oldprops, i), Dynarr_atp (newprops, 0),
3591 Dynarr_length (newprops), sizeof (Lisp_Object_pair),
3592 compare_key_value_pairs))
3593 {
3594 Lisp_Object_pair new;
3595 new.key = Dynarr_at (oldprops, i).key;
3596 new.value = Qunbound;
3597 Dynarr_add (newprops, new);
3598 }
3599 }
3600 for (i = 0; i < orignewlength; i++)
3601 {
3602 if (!bsearch (Dynarr_atp (newprops, i), Dynarr_atp (oldprops, 0),
3603 Dynarr_length (oldprops), sizeof (Lisp_Object_pair),
3604 compare_key_value_pairs))
3605 {
3606 Lisp_Object_pair new;
3607 new.key = Dynarr_at (newprops, i).key;
3608 new.value = Qunbound;
3609 Dynarr_add (oldprops, new);
3610 }
3611 }
3612 qsort (Dynarr_atp (oldprops, 0), Dynarr_length (oldprops),
3613 sizeof (Lisp_Object_pair), compare_key_value_pairs);
3614 qsort (Dynarr_atp (newprops, 0), Dynarr_length (newprops),
3615 sizeof (Lisp_Object_pair), compare_key_value_pairs);
3616 for (i = 0; i < Dynarr_length (oldprops); i++)
3617 {
3618 assert (EQ (Dynarr_at (oldprops, i).key, Dynarr_at (newprops, i).key));
3619 if (!EQ (Dynarr_at (oldprops, i).value, Dynarr_at (newprops, i).value))
3620 signal_extent_property_changed (e, Dynarr_at (oldprops, i).key, 1);
3621 }
3622
3623 Dynarr_free (oldprops);
3624 Dynarr_free (newprops);
3625 #if 0
3626 {
3553 int old_invis = (!NILP (cur_parent) && 3627 int old_invis = (!NILP (cur_parent) &&
3554 !NILP (extent_invisible (XEXTENT (cur_parent)))); 3628 !NILP (extent_invisible (XEXTENT (cur_parent))));
3555 int new_invis = (!NILP (parent) && 3629 int new_invis = (!NILP (parent) &&
3556 !NILP (extent_invisible (XEXTENT (parent)))); 3630 !NILP (extent_invisible (XEXTENT (parent))));
3557 3631
3558 extent_maybe_changed_for_redisplay (e, 1, new_invis != old_invis); 3632 extent_maybe_changed_for_redisplay (e, 1, new_invis != old_invis);
3559 } 3633 }
3560 3634 #endif /* 0 */
3635 }
3561 return Qnil; 3636 return Qnil;
3562 } 3637 }
3563 3638
3564 3639
3565 /************************************************************************/ 3640 /************************************************************************/
3570 undo records for transient extents via update-extent. 3645 undo records for transient extents via update-extent.
3571 For example, query-replace will do this. 3646 For example, query-replace will do this.
3572 */ 3647 */
3573 3648
3574 static void 3649 static void
3575 set_extent_endpoints_1 (EXTENT extent, Membpos start, Membpos end) 3650 set_extent_endpoints_1 (EXTENT extent, Memxpos start, Memxpos end)
3576 { 3651 {
3577 #ifdef ERROR_CHECK_EXTENTS 3652 #ifdef ERROR_CHECK_EXTENTS
3578 Lisp_Object obj = extent_object (extent); 3653 Lisp_Object obj = extent_object (extent);
3579 3654
3580 assert (start <= end); 3655 assert (start <= end);
3610 3685
3611 /* Set extent's endpoints to S and E, and put extent in buffer or string 3686 /* Set extent's endpoints to S and E, and put extent in buffer or string
3612 OBJECT. (If OBJECT is nil, do not change the extent's object.) */ 3687 OBJECT. (If OBJECT is nil, do not change the extent's object.) */
3613 3688
3614 void 3689 void
3615 set_extent_endpoints (EXTENT extent, Bytebpos s, Bytebpos e, Lisp_Object object) 3690 set_extent_endpoints (EXTENT extent, Bytexpos s, Bytexpos e,
3616 { 3691 Lisp_Object object)
3617 Membpos start, end; 3692 {
3693 Memxpos start, end;
3618 3694
3619 if (NILP (object)) 3695 if (NILP (object))
3620 { 3696 {
3621 object = extent_object (extent); 3697 object = extent_object (extent);
3622 assert (!NILP (object)); 3698 assert (!NILP (object));
3626 extent_detach (extent); 3702 extent_detach (extent);
3627 extent_object (extent) = object; 3703 extent_object (extent) = object;
3628 } 3704 }
3629 3705
3630 start = s < 0 ? extent_start (extent) : 3706 start = s < 0 ? extent_start (extent) :
3631 buffer_or_string_bytebpos_to_membpos (object, s); 3707 buffer_or_string_bytexpos_to_memxpos (object, s);
3632 end = e < 0 ? extent_end (extent) : 3708 end = e < 0 ? extent_end (extent) :
3633 buffer_or_string_bytebpos_to_membpos (object, e); 3709 buffer_or_string_bytexpos_to_memxpos (object, e);
3634 set_extent_endpoints_1 (extent, start, end); 3710 set_extent_endpoints_1 (extent, start, end);
3635 } 3711 }
3636 3712
3637 static void 3713 static void
3638 set_extent_openness (EXTENT extent, int start_open, int end_open) 3714 set_extent_openness (EXTENT extent, int start_open, int end_open)
3639 { 3715 {
3640 if (start_open != -1) 3716 if (start_open != -1)
3641 extent_start_open_p (extent) = start_open; 3717 {
3718 extent_start_open_p (extent) = start_open;
3719 signal_extent_property_changed (extent, Qstart_open, 1);
3720 }
3642 if (end_open != -1) 3721 if (end_open != -1)
3643 extent_end_open_p (extent) = end_open; 3722 {
3644 /* changing the open/closedness of an extent does not affect 3723 extent_end_open_p (extent) = end_open;
3645 redisplay. */ 3724 signal_extent_property_changed (extent, Qend_open, 1);
3725 }
3646 } 3726 }
3647 3727
3648 static EXTENT 3728 static EXTENT
3649 make_extent_internal (Lisp_Object object, Bytebpos from, Bytebpos to) 3729 make_extent (Lisp_Object object, Bytexpos from, Bytexpos to)
3650 { 3730 {
3651 EXTENT extent; 3731 EXTENT extent;
3652 3732
3653 extent = make_extent_detached (object); 3733 extent = make_extent_detached (object);
3654 set_extent_endpoints (extent, from, to, Qnil); 3734 set_extent_endpoints (extent, from, to, Qnil);
3655 return extent; 3735 return extent;
3656 } 3736 }
3657 3737
3738 /* Copy ORIGINAL, changing it to span FROM,TO in OBJECT. */
3739
3658 static EXTENT 3740 static EXTENT
3659 copy_extent (EXTENT original, Bytebpos from, Bytebpos to, Lisp_Object object) 3741 copy_extent (EXTENT original, Bytexpos from, Bytexpos to, Lisp_Object object)
3660 { 3742 {
3661 EXTENT e; 3743 EXTENT e;
3662 3744
3663 e = make_extent_detached (object); 3745 e = make_extent_detached (object);
3664 if (from >= 0) 3746 if (from >= 0)
3736 obj = Qnil; 3818 obj = Qnil;
3737 extent_obj = wrap_extent (make_extent_detached (obj)); 3819 extent_obj = wrap_extent (make_extent_detached (obj));
3738 } 3820 }
3739 else 3821 else
3740 { 3822 {
3741 Bytebpos start, end; 3823 Bytexpos start, end;
3742 3824
3743 get_buffer_or_string_range_byte (obj, from, to, &start, &end, 3825 get_buffer_or_string_range_byte (obj, from, to, &start, &end,
3744 GB_ALLOW_PAST_ACCESSIBLE); 3826 GB_ALLOW_PAST_ACCESSIBLE);
3745 extent_obj = wrap_extent (make_extent_internal (obj, start, end)); 3827 extent_obj = wrap_extent (make_extent (obj, start, end));
3746 } 3828 }
3747 return extent_obj; 3829 return extent_obj;
3748 } 3830 }
3749 3831
3750 DEFUN ("copy-extent", Fcopy_extent, 1, 2, 0, /* 3832 DEFUN ("copy-extent", Fcopy_extent, 1, 2, 0, /*
3818 See documentation on `detach-extent' for a discussion of undo recording. 3900 See documentation on `detach-extent' for a discussion of undo recording.
3819 */ 3901 */
3820 (extent, start, end, buffer_or_string)) 3902 (extent, start, end, buffer_or_string))
3821 { 3903 {
3822 EXTENT ext; 3904 EXTENT ext;
3823 Bytebpos s, e; 3905 Bytexpos s, e;
3824 3906
3825 ext = decode_extent (extent, 0); 3907 ext = decode_extent (extent, 0);
3826 3908
3827 if (NILP (buffer_or_string)) 3909 if (NILP (buffer_or_string))
3828 { 3910 {
3910 This is equivalent to whether `map-extents' would visit EXTENT when called 3992 This is equivalent to whether `map-extents' would visit EXTENT when called
3911 with these args. 3993 with these args.
3912 */ 3994 */
3913 (extent, from, to, flags)) 3995 (extent, from, to, flags))
3914 { 3996 {
3915 Bytebpos start, end; 3997 Bytexpos start, end;
3916 EXTENT ext = decode_extent (extent, DE_MUST_BE_ATTACHED); 3998 EXTENT ext = decode_extent (extent, DE_MUST_BE_ATTACHED);
3917 Lisp_Object obj = extent_object (ext); 3999 Lisp_Object obj = extent_object (ext);
3918 4000
3919 get_buffer_or_string_range_byte (obj, from, to, &start, &end, GB_ALLOW_NIL | 4001 get_buffer_or_string_range_byte (obj, from, to, &start, &end, GB_ALLOW_NIL |
3920 GB_ALLOW_PAST_ACCESSIBLE); 4002 GB_ALLOW_PAST_ACCESSIBLE);
4033 (function, object, from, to, maparg, flags, property, value)) 4115 (function, object, from, to, maparg, flags, property, value))
4034 { 4116 {
4035 /* This function can GC */ 4117 /* This function can GC */
4036 struct slow_map_extents_arg closure; 4118 struct slow_map_extents_arg closure;
4037 unsigned int me_flags; 4119 unsigned int me_flags;
4038 Bytebpos start, end; 4120 Bytexpos start, end;
4039 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5; 4121 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
4040 EXTENT after = 0; 4122 EXTENT after = 0;
4041 4123
4042 if (EXTENTP (object)) 4124 if (EXTENTP (object))
4043 { 4125 {
4068 closure.map_routine = function; 4150 closure.map_routine = function;
4069 closure.result = Qnil; 4151 closure.result = Qnil;
4070 closure.property = property; 4152 closure.property = property;
4071 closure.value = value; 4153 closure.value = value;
4072 4154
4073 map_extents_bytebpos (start, end, slow_map_extents_function, 4155 map_extents (start, end, slow_map_extents_function,
4074 (void *) &closure, object, after, 4156 (void *) &closure, object, after,
4075 /* You never know what the user might do ... */ 4157 /* You never know what the user might do ... */
4076 me_flags | ME_MIGHT_CALL_ELISP); 4158 me_flags | ME_MIGHT_CALL_ELISP);
4077 4159
4078 UNGCPRO; 4160 UNGCPRO;
4079 return closure.result; 4161 return closure.result;
4080 } 4162 }
4081 4163
4093 Lisp_Object map_arg; 4175 Lisp_Object map_arg;
4094 Lisp_Object map_routine; 4176 Lisp_Object map_routine;
4095 Lisp_Object result; 4177 Lisp_Object result;
4096 Lisp_Object property; 4178 Lisp_Object property;
4097 Lisp_Object value; 4179 Lisp_Object value;
4098 Bytebpos start_min; 4180 Bytexpos start_min;
4099 Bytebpos prev_start; 4181 Bytexpos prev_start;
4100 Bytebpos prev_end; 4182 Bytexpos prev_end;
4101 }; 4183 };
4102 4184
4103 static int 4185 static int
4104 slow_map_extent_children_function (EXTENT extent, void *arg) 4186 slow_map_extent_children_function (EXTENT extent, void *arg)
4105 { 4187 {
4106 /* This function can GC */ 4188 /* This function can GC */
4107 struct slow_map_extent_children_arg *closure = 4189 struct slow_map_extent_children_arg *closure =
4108 (struct slow_map_extent_children_arg *) arg; 4190 (struct slow_map_extent_children_arg *) arg;
4109 Lisp_Object extent_obj; 4191 Lisp_Object extent_obj;
4110 Bytebpos start = extent_endpoint_bytebpos (extent, 0); 4192 Bytexpos start = extent_endpoint_byte (extent, 0);
4111 Bytebpos end = extent_endpoint_bytebpos (extent, 1); 4193 Bytexpos end = extent_endpoint_byte (extent, 1);
4112 /* Make sure the extent starts inside the region of interest, 4194 /* Make sure the extent starts inside the region of interest,
4113 rather than just overlaps it. 4195 rather than just overlaps it.
4114 */ 4196 */
4115 if (start < closure->start_min) 4197 if (start < closure->start_min)
4116 return 0; 4198 return 0;
4149 4231
4150 /* Since the callback may change the buffer, compute all stored 4232 /* Since the callback may change the buffer, compute all stored
4151 buffer positions here. 4233 buffer positions here.
4152 */ 4234 */
4153 closure->start_min = -1; /* no need for this any more */ 4235 closure->start_min = -1; /* no need for this any more */
4154 closure->prev_start = extent_endpoint_bytebpos (extent, 0); 4236 closure->prev_start = extent_endpoint_byte (extent, 0);
4155 closure->prev_end = extent_endpoint_bytebpos (extent, 1); 4237 closure->prev_end = extent_endpoint_byte (extent, 1);
4156 4238
4157 return !NILP (closure->result); 4239 return !NILP (closure->result);
4158 } 4240 }
4159 4241
4160 DEFUN ("map-extent-children", Fmap_extent_children, 1, 8, 0, /* 4242 DEFUN ("map-extent-children", Fmap_extent_children, 1, 8, 0, /*
4174 (function, object, from, to, maparg, flags, property, value)) 4256 (function, object, from, to, maparg, flags, property, value))
4175 { 4257 {
4176 /* This function can GC */ 4258 /* This function can GC */
4177 struct slow_map_extent_children_arg closure; 4259 struct slow_map_extent_children_arg closure;
4178 unsigned int me_flags; 4260 unsigned int me_flags;
4179 Bytebpos start, end; 4261 Bytexpos start, end;
4180 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5; 4262 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
4181 EXTENT after = 0; 4263 EXTENT after = 0;
4182 4264
4183 if (EXTENTP (object)) 4265 if (EXTENTP (object))
4184 { 4266 {
4211 closure.property = property; 4293 closure.property = property;
4212 closure.value = value; 4294 closure.value = value;
4213 closure.start_min = start; 4295 closure.start_min = start;
4214 closure.prev_start = -1; 4296 closure.prev_start = -1;
4215 closure.prev_end = -1; 4297 closure.prev_end = -1;
4216 map_extents_bytebpos (start, end, slow_map_extent_children_function, 4298 map_extents (start, end, slow_map_extent_children_function,
4217 (void *) &closure, object, after, 4299 (void *) &closure, object, after,
4218 /* You never know what the user might do ... */ 4300 /* You never know what the user might do ... */
4219 me_flags | ME_MIGHT_CALL_ELISP); 4301 me_flags | ME_MIGHT_CALL_ELISP);
4220 4302
4221 UNGCPRO; 4303 UNGCPRO;
4222 return closure.result; 4304 return closure.result;
4223 } 4305 }
4224 4306
4234 */ 4316 */
4235 4317
4236 struct extent_at_arg 4318 struct extent_at_arg
4237 { 4319 {
4238 Lisp_Object best_match; /* or list of extents */ 4320 Lisp_Object best_match; /* or list of extents */
4239 Membpos best_start; 4321 Memxpos best_start;
4240 Membpos best_end; 4322 Memxpos best_end;
4241 Lisp_Object prop; 4323 Lisp_Object prop;
4242 EXTENT before; 4324 EXTENT before;
4243 int all_extents; 4325 int all_extents;
4244 };
4245
4246 enum extent_at_flag
4247 {
4248 EXTENT_AT_AFTER,
4249 EXTENT_AT_BEFORE,
4250 EXTENT_AT_AT
4251 }; 4326 };
4252 4327
4253 static enum extent_at_flag 4328 static enum extent_at_flag
4254 decode_extent_at_flag (Lisp_Object at_flag) 4329 decode_extent_at_flag (Lisp_Object at_flag)
4255 { 4330 {
4316 } 4391 }
4317 4392
4318 return 0; 4393 return 0;
4319 } 4394 }
4320 4395
4321 static Lisp_Object 4396 Lisp_Object
4322 extent_at_bytebpos (Bytebpos position, Lisp_Object object, Lisp_Object property, 4397 extent_at (Bytexpos position, Lisp_Object object,
4323 EXTENT before, enum extent_at_flag at_flag, int all_extents) 4398 Lisp_Object property, EXTENT before,
4399 enum extent_at_flag at_flag, int all_extents)
4324 { 4400 {
4325 struct extent_at_arg closure; 4401 struct extent_at_arg closure;
4326 struct gcpro gcpro1; 4402 struct gcpro gcpro1;
4327 4403
4328 /* it might be argued that invalid positions should cause 4404 /* it might be argued that invalid positions should cause
4345 closure.prop = property; 4421 closure.prop = property;
4346 closure.before = before; 4422 closure.before = before;
4347 closure.all_extents = all_extents; 4423 closure.all_extents = all_extents;
4348 4424
4349 GCPRO1 (closure.best_match); 4425 GCPRO1 (closure.best_match);
4350 map_extents_bytebpos (at_flag == EXTENT_AT_BEFORE ? position - 1 : position, 4426 map_extents (at_flag == EXTENT_AT_BEFORE ? prev_bytexpos (object, position) :
4351 at_flag == EXTENT_AT_AFTER ? position + 1 : position, 4427 position,
4352 extent_at_mapper, (void *) &closure, object, 0, 4428 at_flag == EXTENT_AT_AFTER ? next_bytexpos (object, position) :
4353 ME_START_OPEN | ME_ALL_EXTENTS_CLOSED); 4429 position,
4430 extent_at_mapper, (void *) &closure, object, 0,
4431 ME_START_OPEN | ME_ALL_EXTENTS_CLOSED);
4354 if (all_extents) 4432 if (all_extents)
4355 closure.best_match = Fnreverse (closure.best_match); 4433 closure.best_match = Fnreverse (closure.best_match);
4356 UNGCPRO; 4434 UNGCPRO;
4357 4435
4358 return closure.best_match; 4436 return closure.best_match;
4386 considered is ignored. If you want to pay attention to those properties, 4464 considered is ignored. If you want to pay attention to those properties,
4387 you should use `map-extents', which gives you more control. 4465 you should use `map-extents', which gives you more control.
4388 */ 4466 */
4389 (pos, object, property, before, at_flag)) 4467 (pos, object, property, before, at_flag))
4390 { 4468 {
4391 Bytebpos position; 4469 Bytexpos position;
4392 EXTENT before_extent; 4470 EXTENT before_extent;
4393 enum extent_at_flag fl; 4471 enum extent_at_flag fl;
4394 4472
4395 object = decode_buffer_or_string (object); 4473 object = decode_buffer_or_string (object);
4396 position = get_buffer_or_string_pos_byte (object, pos, GB_NO_ERROR_IF_BAD); 4474 position = get_buffer_or_string_pos_byte (object, pos, GB_NO_ERROR_IF_BAD);
4400 before_extent = decode_extent (before, DE_MUST_BE_ATTACHED); 4478 before_extent = decode_extent (before, DE_MUST_BE_ATTACHED);
4401 if (before_extent && !EQ (object, extent_object (before_extent))) 4479 if (before_extent && !EQ (object, extent_object (before_extent)))
4402 invalid_argument ("extent not in specified buffer or string", object); 4480 invalid_argument ("extent not in specified buffer or string", object);
4403 fl = decode_extent_at_flag (at_flag); 4481 fl = decode_extent_at_flag (at_flag);
4404 4482
4405 return extent_at_bytebpos (position, object, property, before_extent, fl, 0); 4483 return extent_at (position, object, property, before_extent, fl, 0);
4406 } 4484 }
4407 4485
4408 DEFUN ("extents-at", Fextents_at, 1, 5, 0, /* 4486 DEFUN ("extents-at", Fextents_at, 1, 5, 0, /*
4409 Find all extents at POS in OBJECT having PROPERTY set. 4487 Find all extents at POS in OBJECT having PROPERTY set.
4410 Normally, an extent is "at" POS if it overlaps the region (POS, POS+1); 4488 Normally, an extent is "at" POS if it overlaps the region (POS, POS+1);
4436 considered is ignored. If you want to pay attention to those properties, 4514 considered is ignored. If you want to pay attention to those properties,
4437 you should use `map-extents', which gives you more control. 4515 you should use `map-extents', which gives you more control.
4438 */ 4516 */
4439 (pos, object, property, before, at_flag)) 4517 (pos, object, property, before, at_flag))
4440 { 4518 {
4441 Bytebpos position; 4519 Bytexpos position;
4442 EXTENT before_extent; 4520 EXTENT before_extent;
4443 enum extent_at_flag fl; 4521 enum extent_at_flag fl;
4444 4522
4445 object = decode_buffer_or_string (object); 4523 object = decode_buffer_or_string (object);
4446 position = get_buffer_or_string_pos_byte (object, pos, GB_NO_ERROR_IF_BAD); 4524 position = get_buffer_or_string_pos_byte (object, pos, GB_NO_ERROR_IF_BAD);
4450 before_extent = decode_extent (before, DE_MUST_BE_ATTACHED); 4528 before_extent = decode_extent (before, DE_MUST_BE_ATTACHED);
4451 if (before_extent && !EQ (object, extent_object (before_extent))) 4529 if (before_extent && !EQ (object, extent_object (before_extent)))
4452 invalid_argument ("extent not in specified buffer or string", object); 4530 invalid_argument ("extent not in specified buffer or string", object);
4453 fl = decode_extent_at_flag (at_flag); 4531 fl = decode_extent_at_flag (at_flag);
4454 4532
4455 return extent_at_bytebpos (position, object, property, before_extent, fl, 1); 4533 return extent_at (position, object, property, before_extent, fl, 1);
4456 } 4534 }
4457 4535
4458 /* ------------------------------- */ 4536 /* ------------------------------- */
4459 /* verify_extent_modification() */ 4537 /* verify_extent_modification() */
4460 /* ------------------------------- */ 4538 /* ------------------------------- */
4465 */ 4543 */
4466 4544
4467 struct verify_extents_arg 4545 struct verify_extents_arg
4468 { 4546 {
4469 Lisp_Object object; 4547 Lisp_Object object;
4470 Membpos start; 4548 Memxpos start;
4471 Membpos end; 4549 Memxpos end;
4472 Lisp_Object iro; /* value of inhibit-read-only */ 4550 Lisp_Object iro; /* value of inhibit-read-only */
4473 }; 4551 };
4474 4552
4475 static int 4553 static int
4476 verify_extent_mapper (EXTENT extent, void *arg) 4554 verify_extent_mapper (EXTENT extent, void *arg)
4506 4584
4507 /* Value of Vinhibit_read_only is precomputed and passed in for 4585 /* Value of Vinhibit_read_only is precomputed and passed in for
4508 efficiency */ 4586 efficiency */
4509 4587
4510 void 4588 void
4511 verify_extent_modification (Lisp_Object object, Bytebpos from, Bytebpos to, 4589 verify_extent_modification (Lisp_Object object, Bytexpos from, Bytexpos to,
4512 Lisp_Object inhibit_read_only_value) 4590 Lisp_Object inhibit_read_only_value)
4513 { 4591 {
4514 int closed; 4592 int closed;
4515 struct verify_extents_arg closure; 4593 struct verify_extents_arg closure;
4516 4594
4521 changed range has zero length, and a deletion otherwise. This 4599 changed range has zero length, and a deletion otherwise. This
4522 fails if a change (i.e. non-insertion, non-deletion) is happening. 4600 fails if a change (i.e. non-insertion, non-deletion) is happening.
4523 As far as I know, this doesn't currently occur in XEmacs. --ben */ 4601 As far as I know, this doesn't currently occur in XEmacs. --ben */
4524 closed = (from==to); 4602 closed = (from==to);
4525 closure.object = object; 4603 closure.object = object;
4526 closure.start = buffer_or_string_bytebpos_to_membpos (object, from); 4604 closure.start = buffer_or_string_bytexpos_to_memxpos (object, from);
4527 closure.end = buffer_or_string_bytebpos_to_membpos (object, to); 4605 closure.end = buffer_or_string_bytexpos_to_memxpos (object, to);
4528 closure.iro = inhibit_read_only_value; 4606 closure.iro = inhibit_read_only_value;
4529 4607
4530 map_extents_bytebpos (from, to, verify_extent_mapper, (void *) &closure, 4608 map_extents (from, to, verify_extent_mapper, (void *) &closure,
4531 object, 0, closed ? ME_END_CLOSED : ME_START_OPEN); 4609 object, 0, closed ? ME_END_CLOSED : ME_START_OPEN);
4532 } 4610 }
4533 4611
4534 /* ------------------------------------ */ 4612 /* ------------------------------------ */
4535 /* process_extents_for_insertion() */ 4613 /* process_extents_for_insertion() */
4536 /* ------------------------------------ */ 4614 /* ------------------------------------ */
4537 4615
4538 struct process_extents_for_insertion_arg 4616 struct process_extents_for_insertion_arg
4539 { 4617 {
4540 Bytebpos opoint; 4618 Bytexpos opoint;
4541 int length; 4619 int length;
4542 Lisp_Object object; 4620 Lisp_Object object;
4543 }; 4621 };
4544 4622
4545 /* A region of length LENGTH was just inserted at OPOINT. Modify all 4623 /* A region of length LENGTH was just inserted at OPOINT. Modify all
4550 static int 4628 static int
4551 process_extents_for_insertion_mapper (EXTENT extent, void *arg) 4629 process_extents_for_insertion_mapper (EXTENT extent, void *arg)
4552 { 4630 {
4553 struct process_extents_for_insertion_arg *closure = 4631 struct process_extents_for_insertion_arg *closure =
4554 (struct process_extents_for_insertion_arg *) arg; 4632 (struct process_extents_for_insertion_arg *) arg;
4555 Membpos indice = buffer_or_string_bytebpos_to_membpos (closure->object, 4633 Memxpos indice = buffer_or_string_bytexpos_to_memxpos (closure->object,
4556 closure->opoint); 4634 closure->opoint);
4557 4635
4558 /* When this function is called, one end of the newly-inserted text should 4636 /* When this function is called, one end of the newly-inserted text should
4559 be adjacent to some endpoint of the extent, or disjoint from it. If 4637 be adjacent to some endpoint of the extent, or disjoint from it. If
4560 the insertion overlaps any existing extent, something is wrong. 4638 the insertion overlaps any existing extent, something is wrong.
4561 */ 4639 */
4586 Existence of zero-length open-open extents is unfortunately an 4664 Existence of zero-length open-open extents is unfortunately an
4587 inelegant part of the extent model, but there is no way around 4665 inelegant part of the extent model, but there is no way around
4588 it. */ 4666 it. */
4589 4667
4590 { 4668 {
4591 Membpos new_start = extent_start (extent); 4669 Memxpos new_start = extent_start (extent);
4592 Membpos new_end = extent_end (extent); 4670 Memxpos new_end = extent_end (extent);
4593 4671
4594 if (indice == extent_start (extent) && extent_start_open_p (extent) 4672 if (indice == extent_start (extent) && extent_start_open_p (extent)
4595 /* zero-length () extents are exempt; see comment above. */ 4673 /* zero-length () extents are exempt; see comment above. */
4596 && !(new_start == new_end && extent_end_open_p (extent)) 4674 && !(new_start == new_end && extent_end_open_p (extent))
4597 ) 4675 )
4604 4682
4605 return 0; 4683 return 0;
4606 } 4684 }
4607 4685
4608 void 4686 void
4609 process_extents_for_insertion (Lisp_Object object, Bytebpos opoint, 4687 process_extents_for_insertion (Lisp_Object object, Bytexpos opoint,
4610 Bytecount length) 4688 Bytecount length)
4611 { 4689 {
4612 struct process_extents_for_insertion_arg closure; 4690 struct process_extents_for_insertion_arg closure;
4613 4691
4614 closure.opoint = opoint; 4692 closure.opoint = opoint;
4615 closure.length = length; 4693 closure.length = length;
4616 closure.object = object; 4694 closure.object = object;
4617 4695
4618 map_extents_bytebpos (opoint, opoint + length, 4696 map_extents (opoint, opoint + length,
4619 process_extents_for_insertion_mapper, 4697 process_extents_for_insertion_mapper,
4620 (void *) &closure, object, 0, 4698 (void *) &closure, object, 0,
4621 ME_END_CLOSED | ME_MIGHT_MODIFY_EXTENTS | 4699 ME_END_CLOSED | ME_MIGHT_MODIFY_EXTENTS |
4622 ME_INCLUDE_INTERNAL); 4700 ME_INCLUDE_INTERNAL);
4623 } 4701 }
4624 4702
4625 /* ------------------------------------ */ 4703 /* ------------------------------------ */
4626 /* process_extents_for_deletion() */ 4704 /* process_extents_for_deletion() */
4627 /* ------------------------------------ */ 4705 /* ------------------------------------ */
4628 4706
4629 struct process_extents_for_deletion_arg 4707 struct process_extents_for_deletion_arg
4630 { 4708 {
4631 Membpos start, end; 4709 Memxpos start, end;
4632 int destroy_included_extents; 4710 int destroy_included_extents;
4633 }; 4711 };
4634 4712
4635 /* This function is called when we're about to delete the range [from, to]. 4713 /* This function is called when we're about to delete the range [from, to].
4636 Detach all of the extents that are completely inside the range [from, to], 4714 Detach all of the extents that are completely inside the range [from, to],
4664 /* DESTROY_THEM means destroy the extents instead of just deleting them. 4742 /* DESTROY_THEM means destroy the extents instead of just deleting them.
4665 It is unused currently, but perhaps might be used (there used to 4743 It is unused currently, but perhaps might be used (there used to
4666 be a function process_extents_for_destruction(), #if 0'd out, 4744 be a function process_extents_for_destruction(), #if 0'd out,
4667 that did the equivalent). */ 4745 that did the equivalent). */
4668 void 4746 void
4669 process_extents_for_deletion (Lisp_Object object, Bytebpos from, 4747 process_extents_for_deletion (Lisp_Object object, Bytexpos from,
4670 Bytebpos to, int destroy_them) 4748 Bytexpos to, int destroy_them)
4671 { 4749 {
4672 struct process_extents_for_deletion_arg closure; 4750 struct process_extents_for_deletion_arg closure;
4673 4751
4674 closure.start = buffer_or_string_bytebpos_to_membpos (object, from); 4752 closure.start = buffer_or_string_bytexpos_to_memxpos (object, from);
4675 closure.end = buffer_or_string_bytebpos_to_membpos (object, to); 4753 closure.end = buffer_or_string_bytexpos_to_memxpos (object, to);
4676 closure.destroy_included_extents = destroy_them; 4754 closure.destroy_included_extents = destroy_them;
4677 4755
4678 map_extents_bytebpos (from, to, process_extents_for_deletion_mapper, 4756 map_extents (from, to, process_extents_for_deletion_mapper,
4679 (void *) &closure, object, 0, 4757 (void *) &closure, object, 0,
4680 ME_END_CLOSED | ME_MIGHT_MODIFY_EXTENTS); 4758 ME_END_CLOSED | ME_MIGHT_MODIFY_EXTENTS);
4681 } 4759 }
4682 4760
4683 /* ------------------------------- */ 4761 /* ------------------------------- */
4684 /* report_extent_modification() */ 4762 /* report_extent_modification() */
4685 /* ------------------------------- */ 4763 /* ------------------------------- */
4686 struct report_extent_modification_closure { 4764
4765 struct report_extent_modification_closure
4766 {
4687 Lisp_Object buffer; 4767 Lisp_Object buffer;
4688 Charbpos start, end; 4768 Charxpos start, end;
4689 int afterp; 4769 int afterp;
4690 int speccount; 4770 int speccount;
4691 }; 4771 };
4692 4772
4693 static Lisp_Object 4773 static Lisp_Object
4719 the current buffer, in case we change it. Do the recording only 4799 the current buffer, in case we change it. Do the recording only
4720 once. 4800 once.
4721 4801
4722 One confusing thing here is that our caller never actually calls 4802 One confusing thing here is that our caller never actually calls
4723 unbind_to (closure.speccount). This is because 4803 unbind_to (closure.speccount). This is because
4724 map_extents_bytebpos() unbinds before, and with a smaller 4804 map_extents() unbinds before, and with a smaller
4725 speccount. The additional unbind_to_1() in 4805 speccount. The additional unbind_to_1() in
4726 report_extent_modification() would cause XEmacs to abort. */ 4806 report_extent_modification() would cause XEmacs to abort. */
4727 if (closure->speccount == -1) 4807 if (closure->speccount == -1)
4728 { 4808 {
4729 closure->speccount = specpdl_depth (); 4809 closure->speccount = specpdl_depth ();
4767 closure.start = start; 4847 closure.start = start;
4768 closure.end = end; 4848 closure.end = end;
4769 closure.afterp = afterp; 4849 closure.afterp = afterp;
4770 closure.speccount = -1; 4850 closure.speccount = -1;
4771 4851
4772 map_extents (start, end, report_extent_modification_mapper, (void *)&closure, 4852 map_extents (charbpos_to_bytebpos (XBUFFER (buffer), start),
4853 charbpos_to_bytebpos (XBUFFER (buffer), end),
4854 report_extent_modification_mapper, (void *)&closure,
4773 buffer, NULL, ME_MIGHT_CALL_ELISP); 4855 buffer, NULL, ME_MIGHT_CALL_ELISP);
4774 } 4856 }
4775 4857
4776 4858
4777 /************************************************************************/ 4859 /************************************************************************/
4782 set_extent_invisible (EXTENT extent, Lisp_Object value) 4864 set_extent_invisible (EXTENT extent, Lisp_Object value)
4783 { 4865 {
4784 if (!EQ (extent_invisible (extent), value)) 4866 if (!EQ (extent_invisible (extent), value))
4785 { 4867 {
4786 set_extent_invisible_1 (extent, value); 4868 set_extent_invisible_1 (extent, value);
4787 extent_changed_for_redisplay (extent, 1, 1); 4869 signal_extent_property_changed (extent, Qinvisible, 1);
4788 } 4870 }
4789 } 4871 }
4790 4872
4791 /* This function does "memoization" -- similar to the interning 4873 /* This function does "memoization" -- similar to the interning
4792 that happens with symbols. Given a list of faces, an equivalent 4874 that happens with symbols. Given a list of faces, an equivalent
4907 assert (!UNBOUNDP (face)); 4989 assert (!UNBOUNDP (face));
4908 return face; 4990 return face;
4909 } 4991 }
4910 } 4992 }
4911 4993
4994 /* The idea here is that if we're given a list of faces, we
4995 need to "memoize" this so that two lists of faces that are `equal'
4996 turn into the same object. When `set-extent-face' is called, we
4997 "memoize" into a list of actual faces; when `extent-face' is called,
4998 we do a reverse lookup to get the list of symbols. */
4999
4912 static Lisp_Object 5000 static Lisp_Object
4913 canonicalize_extent_property (Lisp_Object prop, Lisp_Object value) 5001 canonicalize_extent_property (Lisp_Object prop, Lisp_Object value)
4914 { 5002 {
4915 if (EQ (prop, Qface) || EQ (prop, Qmouse_face)) 5003 if (EQ (prop, Qface) || EQ (prop, Qmouse_face))
4916 value = (external_of_internal_memoized_face 5004 value = (external_of_internal_memoized_face
4917 (memoize_extent_face_internal (value))); 5005 (memoize_extent_face_internal (value)));
4918 return value; 5006 return value;
4919 } 5007 }
4920 5008
4921 /* Do we need a lisp-level function ? */ 5009 /* Do we need a lisp-level function ? */
4922 DEFUN ("set-extent-initial-redisplay-function", Fset_extent_initial_redisplay_function, 5010 DEFUN ("set-extent-initial-redisplay-function",
5011 Fset_extent_initial_redisplay_function,
4923 2,2,0, /* 5012 2,2,0, /*
4924 Note: This feature is experimental! 5013 Note: This feature is experimental!
4925 5014
4926 Set initial-redisplay-function of EXTENT to the function 5015 Set initial-redisplay-function of EXTENT to the function
4927 FUNCTION. 5016 FUNCTION.
4929 The first time the EXTENT is (re)displayed, an eval event will be 5018 The first time the EXTENT is (re)displayed, an eval event will be
4930 dispatched calling FUNCTION with EXTENT as its only argument. 5019 dispatched calling FUNCTION with EXTENT as its only argument.
4931 */ 5020 */
4932 (extent, function)) 5021 (extent, function))
4933 { 5022 {
4934 EXTENT e = decode_extent(extent, DE_MUST_BE_ATTACHED); 5023 /* #### This is totally broken. */
5024 EXTENT e = decode_extent (extent, DE_MUST_BE_ATTACHED);
4935 5025
4936 e = extent_ancestor (e); /* Is this needed? Macro also does chasing!*/ 5026 e = extent_ancestor (e); /* Is this needed? Macro also does chasing!*/
4937 set_extent_initial_redisplay_function(e,function); 5027 set_extent_initial_redisplay_function (e, function);
4938 extent_in_red_event_p(e) = 0; /* If the function changed we can spawn 5028 extent_in_red_event_p (e) = 0; /* If the function changed we can spawn
4939 new events */ 5029 new events */
4940 extent_changed_for_redisplay(e,1,0); /* Do we need to mark children too ?*/ 5030 signal_extent_property_changed (e, Qinitial_redisplay_function, 1);
4941
4942 return function; 5031 return function;
4943 } 5032 }
4944 5033
4945 DEFUN ("extent-face", Fextent_face, 1, 1, 0, /* 5034 DEFUN ("extent-face", Fextent_face, 1, 1, 0, /*
4946 Return the name of the face in which EXTENT is displayed, or nil 5035 Return the name of the face in which EXTENT is displayed, or nil
4972 e = extent_ancestor (e); 5061 e = extent_ancestor (e);
4973 5062
4974 face = memoize_extent_face_internal (face); 5063 face = memoize_extent_face_internal (face);
4975 5064
4976 extent_face (e) = face; 5065 extent_face (e) = face;
4977 extent_changed_for_redisplay (e, 1, 0); 5066 signal_extent_property_changed (e, Qface, 1);
4978 5067
4979 return orig_face; 5068 return orig_face;
4980 } 5069 }
4981 5070
4982 5071
5012 e = extent_ancestor (e); 5101 e = extent_ancestor (e);
5013 5102
5014 face = memoize_extent_face_internal (face); 5103 face = memoize_extent_face_internal (face);
5015 5104
5016 set_extent_mouse_face (e, face); 5105 set_extent_mouse_face (e, face);
5017 extent_changed_for_redisplay (e, 1, 0); 5106 signal_extent_property_changed (e, Qmouse_face, 1);
5018 5107
5019 return orig_face; 5108 return orig_face;
5020 } 5109 }
5021 5110
5022 void 5111 void
5027 5116
5028 if (!endp) 5117 if (!endp)
5029 { 5118 {
5030 set_extent_begin_glyph (extent, glyph); 5119 set_extent_begin_glyph (extent, glyph);
5031 set_extent_begin_glyph_layout (extent, layout); 5120 set_extent_begin_glyph_layout (extent, layout);
5121 signal_extent_property_changed (extent, Qbegin_glyph, 1);
5122 signal_extent_property_changed (extent, Qbegin_glyph_layout, 1);
5032 } 5123 }
5033 else 5124 else
5034 { 5125 {
5035 set_extent_end_glyph (extent, glyph); 5126 set_extent_end_glyph (extent, glyph);
5036 set_extent_end_glyph_layout (extent, layout); 5127 set_extent_end_glyph_layout (extent, layout);
5037 } 5128 signal_extent_property_changed (extent, Qend_glyph, 1);
5038 5129 signal_extent_property_changed (extent, Qend_glyph_layout, 1);
5039 extent_changed_for_redisplay (extent, 1, 0); 5130 }
5040 } 5131 }
5041 5132
5042 static Lisp_Object 5133 static Lisp_Object
5043 glyph_layout_to_symbol (glyph_layout layout) 5134 glyph_layout_to_symbol (glyph_layout layout)
5044 { 5135 {
5129 (extent, layout)) 5220 (extent, layout))
5130 { 5221 {
5131 EXTENT e = decode_extent (extent, 0); 5222 EXTENT e = decode_extent (extent, 0);
5132 e = extent_ancestor (e); 5223 e = extent_ancestor (e);
5133 set_extent_begin_glyph_layout (e, symbol_to_glyph_layout (layout)); 5224 set_extent_begin_glyph_layout (e, symbol_to_glyph_layout (layout));
5134 extent_maybe_changed_for_redisplay (e, 1, 0); 5225 signal_extent_property_changed (e, Qbegin_glyph_layout, 1);
5135 return layout; 5226 return layout;
5136 } 5227 }
5137 5228
5138 DEFUN ("set-extent-end-glyph-layout", Fset_extent_end_glyph_layout, 2, 2, 0, /* 5229 DEFUN ("set-extent-end-glyph-layout", Fset_extent_end_glyph_layout, 2, 2, 0, /*
5139 Set the layout policy of EXTENT's end glyph. 5230 Set the layout policy of EXTENT's end glyph.
5142 (extent, layout)) 5233 (extent, layout))
5143 { 5234 {
5144 EXTENT e = decode_extent (extent, 0); 5235 EXTENT e = decode_extent (extent, 0);
5145 e = extent_ancestor (e); 5236 e = extent_ancestor (e);
5146 set_extent_end_glyph_layout (e, symbol_to_glyph_layout (layout)); 5237 set_extent_end_glyph_layout (e, symbol_to_glyph_layout (layout));
5147 extent_maybe_changed_for_redisplay (e, 1, 0); 5238 signal_extent_property_changed (e, Qend_glyph_layout, 1);
5148 return layout; 5239 return layout;
5149 } 5240 }
5150 5241
5151 DEFUN ("extent-begin-glyph-layout", Fextent_begin_glyph_layout, 1, 1, 0, /* 5242 DEFUN ("extent-begin-glyph-layout", Fextent_begin_glyph_layout, 1, 1, 0, /*
5152 Return the layout policy associated with EXTENT's begin glyph. 5243 Return the layout policy associated with EXTENT's begin glyph.
5181 EXTENT e = decode_extent (extent, 0); 5272 EXTENT e = decode_extent (extent, 0);
5182 5273
5183 CHECK_INT (priority); 5274 CHECK_INT (priority);
5184 e = extent_ancestor (e); 5275 e = extent_ancestor (e);
5185 set_extent_priority (e, XINT (priority)); 5276 set_extent_priority (e, XINT (priority));
5186 extent_maybe_changed_for_redisplay (e, 1, 0); 5277 signal_extent_property_changed (e, Qpriority, 1);
5187 return priority; 5278 return priority;
5188 } 5279 }
5189 5280
5190 DEFUN ("extent-priority", Fextent_priority, 1, 1, 0, /* 5281 DEFUN ("extent-priority", Fextent_priority, 1, 1, 0, /*
5191 Return the display priority of EXTENT; see `set-extent-priority'. 5282 Return the display priority of EXTENT; see `set-extent-priority'.
5340 */ 5431 */
5341 (extent, property, value)) 5432 (extent, property, value))
5342 { 5433 {
5343 /* This function can GC if property is `keymap' */ 5434 /* This function can GC if property is `keymap' */
5344 EXTENT e = decode_extent (extent, 0); 5435 EXTENT e = decode_extent (extent, 0);
5436 int signal_change = 0;
5437
5438 /* If VALUE is unbound, the property is being removed through `remprop'.
5439 Return Qunbound if removal disallowed, Qt if anything removed,
5440 Qnil otherwise. */
5441
5442 /* Keep in synch with stuff below. */
5443 if (UNBOUNDP (value))
5444 {
5445 int retval;
5446
5447 if (EQ (property, Qread_only)
5448 || EQ (property, Qunique)
5449 || EQ (property, Qduplicable)
5450 || EQ (property, Qinvisible)
5451 || EQ (property, Qdetachable)
5452 || EQ (property, Qdetached)
5453 || EQ (property, Qdestroyed)
5454 || EQ (property, Qpriority)
5455 || EQ (property, Qface)
5456 || EQ (property, Qinitial_redisplay_function)
5457 || EQ (property, Qafter_change_functions)
5458 || EQ (property, Qbefore_change_functions)
5459 || EQ (property, Qmouse_face)
5460 || EQ (property, Qhighlight)
5461 || EQ (property, Qbegin_glyph_layout)
5462 || EQ (property, Qend_glyph_layout)
5463 || EQ (property, Qglyph_layout)
5464 || EQ (property, Qbegin_glyph)
5465 || EQ (property, Qend_glyph)
5466 || EQ (property, Qstart_open)
5467 || EQ (property, Qend_open)
5468 || EQ (property, Qstart_closed)
5469 || EQ (property, Qend_closed)
5470 || EQ (property, Qkeymap))
5471 return Qunbound;
5472
5473 retval = external_remprop (extent_plist_addr (e), property, 0,
5474 ERROR_ME);
5475 if (retval)
5476 signal_extent_property_changed (e, property, 1);
5477 return retval ? Qt : Qnil;
5478 }
5345 5479
5346 if (EQ (property, Qread_only)) 5480 if (EQ (property, Qread_only))
5347 set_extent_read_only (e, value); 5481 {
5482 set_extent_read_only (e, value);
5483 signal_change = 1;
5484 }
5348 else if (EQ (property, Qunique)) 5485 else if (EQ (property, Qunique))
5349 extent_unique_p (e) = !NILP (value); 5486 {
5487 extent_unique_p (e) = !NILP (value);
5488 signal_change = 1;
5489 }
5350 else if (EQ (property, Qduplicable)) 5490 else if (EQ (property, Qduplicable))
5351 extent_duplicable_p (e) = !NILP (value); 5491 {
5492 extent_duplicable_p (e) = !NILP (value);
5493 signal_change = 1;
5494 }
5352 else if (EQ (property, Qinvisible)) 5495 else if (EQ (property, Qinvisible))
5353 set_extent_invisible (e, value); 5496 set_extent_invisible (e, value);
5354 else if (EQ (property, Qdetachable)) 5497 else if (EQ (property, Qdetachable))
5355 extent_detachable_p (e) = !NILP (value); 5498 {
5356 5499 extent_detachable_p (e) = !NILP (value);
5500 signal_change = 1;
5501 }
5357 else if (EQ (property, Qdetached)) 5502 else if (EQ (property, Qdetached))
5358 { 5503 {
5359 if (NILP (value)) 5504 if (NILP (value))
5360 invalid_operation ("can only set `detached' to t", Qunbound); 5505 invalid_operation ("can only set `detached' to t", Qunbound);
5361 Fdetach_extent (extent); 5506 Fdetach_extent (extent);
5362 } 5507 }
5363 else if (EQ (property, Qdestroyed)) 5508 else if (EQ (property, Qdestroyed))
5364 { 5509 {
5365 if (NILP (value)) 5510 if (NILP (value))
5366 invalid_operation ("can only set `destroyed' to t", Qunbound); 5511 invalid_operation ("can only set `destroyed' to t", Qunbound);
5367 Fdelete_extent (extent); 5512 Fdelete_extent (extent);
5368 } 5513 }
5369 else if (EQ (property, Qpriority)) 5514 else if (EQ (property, Qpriority))
5370 Fset_extent_priority (extent, value); 5515 Fset_extent_priority (extent, value);
5371 else if (EQ (property, Qface)) 5516 else if (EQ (property, Qface))
5372 Fset_extent_face (extent, value); 5517 Fset_extent_face (extent, value);
5373 else if (EQ (property, Qinitial_redisplay_function)) 5518 else if (EQ (property, Qinitial_redisplay_function))
5374 Fset_extent_initial_redisplay_function (extent, value); 5519 Fset_extent_initial_redisplay_function (extent, value);
5375 else if (EQ (property, Qbefore_change_functions)) 5520 else if (EQ (property, Qbefore_change_functions))
5376 set_extent_before_change_functions (e, value); 5521 {
5522 set_extent_before_change_functions (e, value);
5523 signal_change = 1;
5524 }
5377 else if (EQ (property, Qafter_change_functions)) 5525 else if (EQ (property, Qafter_change_functions))
5378 set_extent_after_change_functions (e, value); 5526 {
5527 set_extent_after_change_functions (e, value);
5528 signal_change = 1;
5529 }
5379 else if (EQ (property, Qmouse_face)) 5530 else if (EQ (property, Qmouse_face))
5380 Fset_extent_mouse_face (extent, value); 5531 Fset_extent_mouse_face (extent, value);
5381 /* Obsolete: */ 5532 /* Obsolete: */
5382 else if (EQ (property, Qhighlight)) 5533 else if (EQ (property, Qhighlight))
5383 Fset_extent_mouse_face (extent, Qhighlight); 5534 Fset_extent_mouse_face (extent, Qhighlight);
5407 if (EQ (property, Qkeymap)) 5558 if (EQ (property, Qkeymap))
5408 while (!NILP (value) && NILP (Fkeymapp (value))) 5559 while (!NILP (value) && NILP (Fkeymapp (value)))
5409 value = wrong_type_argument (Qkeymapp, value); 5560 value = wrong_type_argument (Qkeymapp, value);
5410 5561
5411 external_plist_put (extent_plist_addr (e), property, value, 0, ERROR_ME); 5562 external_plist_put (extent_plist_addr (e), property, value, 0, ERROR_ME);
5412 } 5563 signal_change = 1;
5413 5564 }
5565
5566 if (signal_change)
5567 signal_extent_property_changed (e, property, 1);
5414 return value; 5568 return value;
5415 } 5569 }
5416 5570
5417 DEFUN ("set-extent-properties", Fset_extent_properties, 2, 2, 0, /* 5571 DEFUN ("set-extent-properties", Fset_extent_properties, 2, 2, 0, /*
5418 Change some properties of EXTENT. 5572 Change some properties of EXTENT.
5504 property, 0, ERROR_ME); 5658 property, 0, ERROR_ME);
5505 return UNBOUNDP (value) ? default_ : value; 5659 return UNBOUNDP (value) ? default_ : value;
5506 } 5660 }
5507 } 5661 }
5508 5662
5663 static void
5664 extent_properties (EXTENT e, Lisp_Object_pair_dynarr *props)
5665 {
5666 Lisp_Object face, anc_obj;
5667 glyph_layout layout;
5668 EXTENT anc;
5669
5670 #define ADD_PROP(miftaaH, maal) \
5671 do { \
5672 Lisp_Object_pair p; \
5673 p.key = miftaaH; \
5674 p.value = maal; \
5675 Dynarr_add (props, p); \
5676 } while (0)
5677
5678 if (!EXTENT_LIVE_P (e))
5679 {
5680 ADD_PROP (Qdestroyed, Qt);
5681 return;
5682 }
5683
5684 anc = extent_ancestor (e);
5685 anc_obj = wrap_extent (anc);
5686
5687 /* For efficiency, use the ancestor for all properties except detached */
5688 {
5689 EXTERNAL_PROPERTY_LIST_LOOP_3 (key, value, extent_plist_slot (anc))
5690 ADD_PROP (key, value);
5691 }
5692
5693 if (!NILP (face = Fextent_face (anc_obj)))
5694 ADD_PROP (Qface, face);
5695
5696 if (!NILP (face = Fextent_mouse_face (anc_obj)))
5697 ADD_PROP (Qmouse_face, face);
5698
5699 if ((layout = (glyph_layout) extent_begin_glyph_layout (anc)) != GL_TEXT)
5700 {
5701 Lisp_Object sym = glyph_layout_to_symbol (layout);
5702 ADD_PROP (Qglyph_layout, sym); /* compatibility */
5703 ADD_PROP (Qbegin_glyph_layout, sym);
5704 }
5705
5706 if ((layout = (glyph_layout) extent_end_glyph_layout (anc)) != GL_TEXT)
5707 ADD_PROP (Qend_glyph_layout, glyph_layout_to_symbol (layout));
5708
5709 if (!NILP (extent_end_glyph (anc)))
5710 ADD_PROP (Qend_glyph, extent_end_glyph (anc));
5711
5712 if (!NILP (extent_begin_glyph (anc)))
5713 ADD_PROP (Qbegin_glyph, extent_begin_glyph (anc));
5714
5715 if (extent_priority (anc) != 0)
5716 ADD_PROP (Qpriority, make_int (extent_priority (anc)));
5717
5718 if (!NILP (extent_initial_redisplay_function (anc)))
5719 ADD_PROP (Qinitial_redisplay_function,
5720 extent_initial_redisplay_function (anc));
5721
5722 if (!NILP (extent_before_change_functions (anc)))
5723 ADD_PROP (Qbefore_change_functions, extent_before_change_functions (anc));
5724
5725 if (!NILP (extent_after_change_functions (anc)))
5726 ADD_PROP (Qafter_change_functions, extent_after_change_functions (anc));
5727
5728 if (!NILP (extent_invisible (anc)))
5729 ADD_PROP (Qinvisible, extent_invisible (anc));
5730
5731 if (!NILP (extent_read_only (anc)))
5732 ADD_PROP (Qread_only, extent_read_only (anc));
5733
5734 if (extent_normal_field (anc, end_open))
5735 ADD_PROP (Qend_open, Qt);
5736
5737 if (extent_normal_field (anc, start_open))
5738 ADD_PROP (Qstart_open, Qt);
5739
5740 if (extent_normal_field (anc, detachable))
5741 ADD_PROP (Qdetachable, Qt);
5742
5743 if (extent_normal_field (anc, duplicable))
5744 ADD_PROP (Qduplicable, Qt);
5745
5746 if (extent_normal_field (anc, unique))
5747 ADD_PROP (Qunique, Qt);
5748
5749 /* detached is not an inherited property */
5750 if (extent_detached_p (e))
5751 ADD_PROP (Qdetached, Qt);
5752
5753 #undef ADD_PROP
5754 }
5755
5509 DEFUN ("extent-properties", Fextent_properties, 1, 1, 0, /* 5756 DEFUN ("extent-properties", Fextent_properties, 1, 1, 0, /*
5510 Return a property list of the attributes of EXTENT. 5757 Return a property list of the attributes of EXTENT.
5511 Do not modify this list; use `set-extent-property' instead. 5758 Do not modify this list; use `set-extent-property' instead.
5512 */ 5759 */
5513 (extent)) 5760 (extent))
5514 { 5761 {
5515 EXTENT e, anc; 5762 EXTENT e;
5516 Lisp_Object result, face, anc_obj; 5763 Lisp_Object result = Qnil;
5517 glyph_layout layout; 5764 Lisp_Object_pair_dynarr *props;
5765 int i;
5518 5766
5519 CHECK_EXTENT (extent); 5767 CHECK_EXTENT (extent);
5520 e = XEXTENT (extent); 5768 e = XEXTENT (extent);
5521 if (!EXTENT_LIVE_P (e)) 5769 props = Dynarr_new (Lisp_Object_pair);
5522 return cons3 (Qdestroyed, Qt, Qnil); 5770 extent_properties (e, props);
5523 5771
5524 anc = extent_ancestor (e); 5772 for (i = 0; i < Dynarr_length (props); i++)
5525 anc_obj = wrap_extent (anc); 5773 result = cons3 (Dynarr_at (props, i).key, Dynarr_at (props, i).value,
5526 5774 result);
5527 /* For efficiency, use the ancestor for all properties except detached */ 5775
5528 5776 Dynarr_free (props);
5529 result = extent_plist_slot (anc);
5530
5531 if (!NILP (face = Fextent_face (anc_obj)))
5532 result = cons3 (Qface, face, result);
5533
5534 if (!NILP (face = Fextent_mouse_face (anc_obj)))
5535 result = cons3 (Qmouse_face, face, result);
5536
5537 if ((layout = (glyph_layout) extent_begin_glyph_layout (anc)) != GL_TEXT)
5538 {
5539 Lisp_Object sym = glyph_layout_to_symbol (layout);
5540 result = cons3 (Qglyph_layout, sym, result); /* compatibility */
5541 result = cons3 (Qbegin_glyph_layout, sym, result);
5542 }
5543
5544 if ((layout = (glyph_layout) extent_end_glyph_layout (anc)) != GL_TEXT)
5545 result = cons3 (Qend_glyph_layout, glyph_layout_to_symbol (layout), result);
5546
5547 if (!NILP (extent_end_glyph (anc)))
5548 result = cons3 (Qend_glyph, extent_end_glyph (anc), result);
5549
5550 if (!NILP (extent_begin_glyph (anc)))
5551 result = cons3 (Qbegin_glyph, extent_begin_glyph (anc), result);
5552
5553 if (extent_priority (anc) != 0)
5554 result = cons3 (Qpriority, make_int (extent_priority (anc)), result);
5555
5556 if (!NILP (extent_initial_redisplay_function (anc)))
5557 result = cons3 (Qinitial_redisplay_function,
5558 extent_initial_redisplay_function (anc), result);
5559
5560 if (!NILP (extent_before_change_functions (anc)))
5561 result = cons3 (Qbefore_change_functions,
5562 extent_before_change_functions (anc), result);
5563
5564 if (!NILP (extent_after_change_functions (anc)))
5565 result = cons3 (Qafter_change_functions,
5566 extent_after_change_functions (anc), result);
5567
5568 if (!NILP (extent_invisible (anc)))
5569 result = cons3 (Qinvisible, extent_invisible (anc), result);
5570
5571 if (!NILP (extent_read_only (anc)))
5572 result = cons3 (Qread_only, extent_read_only (anc), result);
5573
5574 if (extent_normal_field (anc, end_open))
5575 result = cons3 (Qend_open, Qt, result);
5576
5577 if (extent_normal_field (anc, start_open))
5578 result = cons3 (Qstart_open, Qt, result);
5579
5580 if (extent_normal_field (anc, detachable))
5581 result = cons3 (Qdetachable, Qt, result);
5582
5583 if (extent_normal_field (anc, duplicable))
5584 result = cons3 (Qduplicable, Qt, result);
5585
5586 if (extent_normal_field (anc, unique))
5587 result = cons3 (Qunique, Qt, result);
5588
5589 /* detached is not an inherited property */
5590 if (extent_detached_p (e))
5591 result = cons3 (Qdetached, Qt, result);
5592
5593 return result; 5777 return result;
5594 } 5778 }
5595 5779
5596 5780
5597 /************************************************************************/ 5781 /************************************************************************/
5611 if (EXTENTP (Vlast_highlighted_extent) && 5795 if (EXTENTP (Vlast_highlighted_extent) &&
5612 EXTENT_LIVE_P (XEXTENT (Vlast_highlighted_extent))) 5796 EXTENT_LIVE_P (XEXTENT (Vlast_highlighted_extent)))
5613 { 5797 {
5614 /* do not recurse on descendants. Only one extent is highlighted 5798 /* do not recurse on descendants. Only one extent is highlighted
5615 at a time. */ 5799 at a time. */
5616 extent_changed_for_redisplay (XEXTENT (Vlast_highlighted_extent), 0, 0); 5800 /* A bit of a lie. */
5801 signal_extent_property_changed (XEXTENT (Vlast_highlighted_extent),
5802 Qface, 0);
5617 } 5803 }
5618 Vlast_highlighted_extent = Qnil; 5804 Vlast_highlighted_extent = Qnil;
5619 if (!NILP (extent_obj) 5805 if (!NILP (extent_obj)
5620 && BUFFERP (extent_object (XEXTENT (extent_obj))) 5806 && BUFFERP (extent_object (XEXTENT (extent_obj)))
5621 && highlight_p) 5807 && highlight_p)
5622 { 5808 {
5623 extent_changed_for_redisplay (XEXTENT (extent_obj), 0, 0); 5809 signal_extent_property_changed (XEXTENT (extent_obj), Qface, 0);
5624 Vlast_highlighted_extent = extent_obj; 5810 Vlast_highlighted_extent = extent_obj;
5625 } 5811 }
5626 } 5812 }
5627 5813
5628 DEFUN ("force-highlight-extent", Fforce_highlight_extent, 1, 2, 0, /* 5814 DEFUN ("force-highlight-extent", Fforce_highlight_extent, 1, 2, 0, /*
5662 /************************************************************************/ 5848 /************************************************************************/
5663 5849
5664 /* copy/paste hooks */ 5850 /* copy/paste hooks */
5665 5851
5666 static int 5852 static int
5667 run_extent_copy_paste_internal (EXTENT e, Charbpos from, Charbpos to, 5853 run_extent_copy_paste_internal (EXTENT e, Charxpos from, Charxpos to,
5668 Lisp_Object object, 5854 Lisp_Object object,
5669 Lisp_Object prop) 5855 Lisp_Object prop)
5670 { 5856 {
5671 /* This function can GC */ 5857 /* This function can GC */
5672 Lisp_Object extent; 5858 Lisp_Object extent;
5689 } 5875 }
5690 return 1; 5876 return 1;
5691 } 5877 }
5692 5878
5693 static int 5879 static int
5694 run_extent_copy_function (EXTENT e, Bytebpos from, Bytebpos to) 5880 run_extent_copy_function (EXTENT e, Bytexpos from, Bytexpos to)
5695 { 5881 {
5696 Lisp_Object object = extent_object (e); 5882 Lisp_Object object = extent_object (e);
5697 /* This function can GC */ 5883 /* This function can GC */
5698 return run_extent_copy_paste_internal 5884 return run_extent_copy_paste_internal
5699 (e, buffer_or_string_bytebpos_to_charbpos (object, from), 5885 (e, buffer_or_string_bytexpos_to_charxpos (object, from),
5700 buffer_or_string_bytebpos_to_charbpos (object, to), object, 5886 buffer_or_string_bytexpos_to_charxpos (object, to), object,
5701 Qcopy_function); 5887 Qcopy_function);
5702 } 5888 }
5703 5889
5704 static int 5890 static int
5705 run_extent_paste_function (EXTENT e, Bytebpos from, Bytebpos to, 5891 run_extent_paste_function (EXTENT e, Bytexpos from, Bytexpos to,
5706 Lisp_Object object) 5892 Lisp_Object object)
5707 { 5893 {
5708 /* This function can GC */ 5894 /* This function can GC */
5709 return run_extent_copy_paste_internal 5895 return run_extent_copy_paste_internal
5710 (e, buffer_or_string_bytebpos_to_charbpos (object, from), 5896 (e, buffer_or_string_bytexpos_to_charxpos (object, from),
5711 buffer_or_string_bytebpos_to_charbpos (object, to), object, 5897 buffer_or_string_bytexpos_to_charxpos (object, to), object,
5712 Qpaste_function); 5898 Qpaste_function);
5713 } 5899 }
5714 5900
5715 static void 5901 static int
5716 update_extent (EXTENT extent, Bytebpos from, Bytebpos to) 5902 run_extent_paste_function_char (EXTENT e, Charxpos from, Charxpos to,
5717 { 5903 Lisp_Object object)
5718 set_extent_endpoints (extent, from, to, Qnil); 5904 {
5719 } 5905 /* This function can GC */
5720 5906 return run_extent_copy_paste_internal (e, from, to, object, Qpaste_function);
5721 /* Insert an extent, usually from the dup_list of a string which 5907 }
5722 has just been inserted. 5908
5723 This code does not handle the case of undo.
5724 */
5725 static Lisp_Object 5909 static Lisp_Object
5726 insert_extent (EXTENT extent, Bytebpos new_start, Bytebpos new_end, 5910 insert_extent (EXTENT extent, Bytexpos new_start, Bytexpos new_end,
5727 Lisp_Object object, int run_hooks) 5911 Lisp_Object object, int run_hooks)
5728 { 5912 {
5729 /* This function can GC */ 5913 /* This function can GC */
5730 if (!EQ (extent_object (extent), object)) 5914 if (!EQ (extent_object (extent), object))
5731 goto copy_it; 5915 goto copy_it;
5735 if (run_hooks && 5919 if (run_hooks &&
5736 !run_extent_paste_function (extent, new_start, new_end, object)) 5920 !run_extent_paste_function (extent, new_start, new_end, object))
5737 /* The paste-function said don't re-attach this extent here. */ 5921 /* The paste-function said don't re-attach this extent here. */
5738 return Qnil; 5922 return Qnil;
5739 else 5923 else
5740 update_extent (extent, new_start, new_end); 5924 set_extent_endpoints (extent, new_start, new_end, Qnil);
5741 } 5925 }
5742 else 5926 else
5743 { 5927 {
5744 Bytebpos exstart = extent_endpoint_bytebpos (extent, 0); 5928 Bytexpos exstart = extent_endpoint_byte (extent, 0);
5745 Bytebpos exend = extent_endpoint_bytebpos (extent, 1); 5929 Bytexpos exend = extent_endpoint_byte (extent, 1);
5746 5930
5747 if (exend < new_start || exstart > new_end) 5931 if (exend < new_start || exstart > new_end)
5748 goto copy_it; 5932 goto copy_it;
5749 else 5933 else
5750 { 5934 {
5751 new_start = min (exstart, new_start); 5935 new_start = min (exstart, new_start);
5752 new_end = max (exend, new_end); 5936 new_end = max (exend, new_end);
5753 if (exstart != new_start || exend != new_end) 5937 if (exstart != new_start || exend != new_end)
5754 update_extent (extent, new_start, new_end); 5938 set_extent_endpoints (extent, new_start, new_end, Qnil);
5755 } 5939 }
5756 } 5940 }
5757 5941
5758 return wrap_extent (extent); 5942 return wrap_extent (extent);
5759 5943
5767 } 5951 }
5768 5952
5769 DEFUN ("insert-extent", Finsert_extent, 1, 5, 0, /* 5953 DEFUN ("insert-extent", Finsert_extent, 1, 5, 0, /*
5770 Insert EXTENT from START to END in BUFFER-OR-STRING. 5954 Insert EXTENT from START to END in BUFFER-OR-STRING.
5771 BUFFER-OR-STRING defaults to the current buffer if omitted. 5955 BUFFER-OR-STRING defaults to the current buffer if omitted.
5772 This operation does not insert any characters, 5956 If EXTENT is already on the same object, and overlaps or is adjacent to
5773 but otherwise acts as if there were a replicating extent whose 5957 the given range, its range is merely extended to include the new range.
5774 parent is EXTENT in some string that was just inserted. 5958 Otherwise, a copy is made of the extent at the new position and object.
5775 Returns the newly-inserted extent. 5959 When a copy is made, the new extent is returned, copy/paste hooks are run,
5960 and the change is noted for undo recording. When no copy is made, nil is
5961 returned. See documentation on `detach-extent' for a discussion of undo
5962 recording.
5963
5776 The fourth arg, NO-HOOKS, can be used to inhibit the running of the 5964 The fourth arg, NO-HOOKS, can be used to inhibit the running of the
5777 extent's `paste-function' property if it has one. 5965 extent's `paste-function' property if it has one.
5778 See documentation on `detach-extent' for a discussion of undo recording. 5966
5967 It's not really clear why this function exists any more. It was a holdover
5968 from a much older implementation of extents, before extents could really
5969 exist on strings.
5779 */ 5970 */
5780 (extent, start, end, no_hooks, buffer_or_string)) 5971 (extent, start, end, no_hooks, buffer_or_string))
5781 { 5972 {
5782 EXTENT ext = decode_extent (extent, 0); 5973 EXTENT ext = decode_extent (extent, 0);
5783 Lisp_Object copy; 5974 Lisp_Object copy;
5784 Bytebpos s, e; 5975 Bytexpos s, e;
5785 5976
5786 buffer_or_string = decode_buffer_or_string (buffer_or_string); 5977 buffer_or_string = decode_buffer_or_string (buffer_or_string);
5787 get_buffer_or_string_range_byte (buffer_or_string, start, end, &s, &e, 5978 get_buffer_or_string_range_byte (buffer_or_string, start, end, &s, &e,
5788 GB_ALLOW_PAST_ACCESSIBLE); 5979 GB_ALLOW_PAST_ACCESSIBLE);
5789 5980
5799 5990
5800 /* adding buffer extents to a string */ 5991 /* adding buffer extents to a string */
5801 5992
5802 struct add_string_extents_arg 5993 struct add_string_extents_arg
5803 { 5994 {
5804 Bytebpos from; 5995 Bytexpos from;
5805 Bytecount length; 5996 Bytecount length;
5806 Lisp_Object string; 5997 Lisp_Object string;
5807 }; 5998 };
5808 5999
5809 static int 6000 static int
5810 add_string_extents_mapper (EXTENT extent, void *arg) 6001 add_string_extents_mapper (EXTENT extent, void *arg)
5811 { 6002 {
5812 /* This function can GC */ 6003 /* This function can GC */
5813 struct add_string_extents_arg *closure = 6004 struct add_string_extents_arg *closure =
5814 (struct add_string_extents_arg *) arg; 6005 (struct add_string_extents_arg *) arg;
5815 Bytecount start = extent_endpoint_bytebpos (extent, 0) - closure->from; 6006 Bytecount start = extent_endpoint_byte (extent, 0) - closure->from;
5816 Bytecount end = extent_endpoint_bytebpos (extent, 1) - closure->from; 6007 Bytecount end = extent_endpoint_byte (extent, 1) - closure->from;
5817 6008
5818 if (extent_duplicable_p (extent)) 6009 if (extent_duplicable_p (extent))
5819 { 6010 {
5820 start = max (start, 0); 6011 start = max (start, 0);
5821 end = min (end, closure->length); 6012 end = min (end, closure->length);
5831 } 6022 }
5832 6023
5833 return 0; 6024 return 0;
5834 } 6025 }
5835 6026
6027 struct add_string_extents_the_hard_way_arg
6028 {
6029 Charxpos from;
6030 Charcount length;
6031 Lisp_Object string;
6032 };
6033
6034 static int
6035 add_string_extents_the_hard_way_mapper (EXTENT extent, void *arg)
6036 {
6037 /* This function can GC */
6038 struct add_string_extents_arg *closure =
6039 (struct add_string_extents_arg *) arg;
6040 Charcount start = extent_endpoint_char (extent, 0) - closure->from;
6041 Charcount end = extent_endpoint_char (extent, 1) - closure->from;
6042
6043 if (extent_duplicable_p (extent))
6044 {
6045 start = max (start, 0);
6046 end = min (end, closure->length);
6047
6048 /* Run the copy-function to give an extent the option of
6049 not being copied into the string (or kill ring).
6050 */
6051 if (extent_duplicable_p (extent) &&
6052 !run_extent_copy_function (extent, start + closure->from,
6053 end + closure->from))
6054 return 0;
6055 copy_extent (extent,
6056 string_index_char_to_byte (closure->string, start),
6057 string_index_char_to_byte (closure->string, end),
6058 closure->string);
6059 }
6060
6061 return 0;
6062 }
6063
5836 /* Add the extents in buffer BUF from OPOINT to OPOINT+LENGTH to 6064 /* Add the extents in buffer BUF from OPOINT to OPOINT+LENGTH to
5837 the string STRING. */ 6065 the string STRING. */
5838 void 6066 void
5839 add_string_extents (Lisp_Object string, struct buffer *buf, Bytebpos opoint, 6067 add_string_extents (Lisp_Object string, struct buffer *buf, Bytexpos opoint,
5840 Bytecount length) 6068 Bytecount length)
5841 { 6069 {
5842 /* This function can GC */ 6070 /* This function can GC */
5843 struct add_string_extents_arg closure;
5844 struct gcpro gcpro1, gcpro2; 6071 struct gcpro gcpro1, gcpro2;
5845 Lisp_Object buffer; 6072 Lisp_Object buffer;
5846 6073
5847 closure.from = opoint;
5848 closure.length = length;
5849 closure.string = string;
5850 buffer = wrap_buffer (buf); 6074 buffer = wrap_buffer (buf);
5851 GCPRO2 (buffer, string); 6075 GCPRO2 (buffer, string);
5852 map_extents_bytebpos (opoint, opoint + length, add_string_extents_mapper, 6076
5853 (void *) &closure, buffer, 0, 6077 if (XSTRING_FORMAT (string) == BUF_FORMAT (buf))
5854 /* ignore extents that just abut the region */ 6078 {
5855 ME_END_CLOSED | ME_ALL_EXTENTS_OPEN | 6079 struct add_string_extents_arg closure;
5856 /* we are calling E-Lisp (the extent's copy function) 6080 closure.from = opoint;
5857 so anything might happen */ 6081 closure.length = length;
5858 ME_MIGHT_CALL_ELISP); 6082 closure.string = string;
6083 map_extents (opoint, opoint + length, add_string_extents_mapper,
6084 (void *) &closure, buffer, 0,
6085 /* ignore extents that just abut the region */
6086 ME_END_CLOSED | ME_ALL_EXTENTS_OPEN |
6087 /* we are calling E-Lisp (the extent's copy function)
6088 so anything might happen */
6089 ME_MIGHT_CALL_ELISP);
6090 }
6091 else
6092 {
6093 struct add_string_extents_the_hard_way_arg closure;
6094 closure.from = bytebpos_to_charbpos (buf, opoint);
6095 closure.length = (bytebpos_to_charbpos (buf, opoint + length) -
6096 closure.from);
6097 closure.string = string;
6098
6099 /* If the string and buffer are in different formats, things get
6100 tricky; the only reasonable way to do the operation is entirely in
6101 char offsets, which are invariant to format changes. In practice,
6102 this won't be time-consuming because the byte/char conversions are
6103 mostly in the buffer, which will be in a fixed-width format. */
6104 map_extents (opoint, opoint + length,
6105 add_string_extents_the_hard_way_mapper,
6106 (void *) &closure, buffer, 0,
6107 /* ignore extents that just abut the region */
6108 ME_END_CLOSED | ME_ALL_EXTENTS_OPEN |
6109 /* we are calling E-Lisp (the extent's copy function)
6110 so anything might happen */
6111 ME_MIGHT_CALL_ELISP);
6112
6113 }
6114
5859 UNGCPRO; 6115 UNGCPRO;
5860 } 6116 }
5861 6117
5862 struct splice_in_string_extents_arg 6118 struct splice_in_string_extents_arg
5863 { 6119 {
5864 Bytecount pos; 6120 Bytecount pos;
5865 Bytecount length; 6121 Bytecount length;
5866 Bytebpos opoint; 6122 Bytexpos opoint;
5867 Lisp_Object buffer; 6123 Lisp_Object buffer;
5868 }; 6124 };
5869 6125
5870 static int 6126 static int
5871 splice_in_string_extents_mapper (EXTENT extent, void *arg) 6127 splice_in_string_extents_mapper (EXTENT extent, void *arg)
5873 /* This function can GC */ 6129 /* This function can GC */
5874 struct splice_in_string_extents_arg *closure = 6130 struct splice_in_string_extents_arg *closure =
5875 (struct splice_in_string_extents_arg *) arg; 6131 (struct splice_in_string_extents_arg *) arg;
5876 /* BASE_START and BASE_END are the limits in the buffer of the string 6132 /* BASE_START and BASE_END are the limits in the buffer of the string
5877 that was just inserted. 6133 that was just inserted.
5878 6134
5879 NEW_START and NEW_END are the prospective buffer positions of the 6135 NEW_START and NEW_END are the prospective buffer positions of the
5880 extent that is going into the buffer. */ 6136 extent that is going into the buffer. */
5881 Bytebpos base_start = closure->opoint; 6137 Bytexpos base_start = closure->opoint;
5882 Bytebpos base_end = base_start + closure->length; 6138 Bytexpos base_end = base_start + closure->length;
5883 Bytebpos new_start = (base_start + extent_endpoint_bytebpos (extent, 0) - 6139 Bytexpos new_start = (base_start + extent_endpoint_byte (extent, 0) -
6140 closure->pos);
6141 Bytexpos new_end = (base_start + extent_endpoint_byte (extent, 1) -
5884 closure->pos); 6142 closure->pos);
5885 Bytebpos new_end = (base_start + extent_endpoint_bytebpos (extent, 1) -
5886 closure->pos);
5887 6143
5888 if (new_start < base_start) 6144 if (new_start < base_start)
5889 new_start = base_start; 6145 new_start = base_start;
5890 if (new_end > base_end) 6146 if (new_end > base_end)
5891 new_end = base_end; 6147 new_end = base_end;
5902 copy_extent (extent, new_start, new_end, closure->buffer); 6158 copy_extent (extent, new_start, new_end, closure->buffer);
5903 6159
5904 return 0; 6160 return 0;
5905 } 6161 }
5906 6162
6163 struct splice_in_string_extents_the_hard_way_arg
6164 {
6165 Charcount pos;
6166 Charcount length;
6167 Charxpos opoint;
6168 Lisp_Object buffer;
6169 };
6170
6171 static int
6172 splice_in_string_extents_the_hard_way_mapper (EXTENT extent, void *arg)
6173 {
6174 /* This function can GC */
6175 struct splice_in_string_extents_arg *closure =
6176 (struct splice_in_string_extents_arg *) arg;
6177 /* BASE_START and BASE_END are the limits in the buffer of the string
6178 that was just inserted.
6179
6180 NEW_START and NEW_END are the prospective buffer positions of the
6181 extent that is going into the buffer. */
6182 Charxpos base_start = closure->opoint;
6183 Charxpos base_end = base_start + closure->length;
6184 Charxpos new_start = (base_start + extent_endpoint_char (extent, 0) -
6185 closure->pos);
6186 Charxpos new_end = (base_start + extent_endpoint_char (extent, 1) -
6187 closure->pos);
6188
6189 if (new_start < base_start)
6190 new_start = base_start;
6191 if (new_end > base_end)
6192 new_end = base_end;
6193 if (new_end <= new_start)
6194 return 0;
6195
6196 if (!extent_duplicable_p (extent))
6197 return 0;
6198
6199 if (!inside_undo &&
6200 !run_extent_paste_function_char (extent, new_start, new_end,
6201 closure->buffer))
6202 return 0;
6203 copy_extent (extent,
6204 charbpos_to_bytebpos (XBUFFER (closure->buffer), new_start),
6205 charbpos_to_bytebpos (XBUFFER (closure->buffer), new_end),
6206 closure->buffer);
6207
6208 return 0;
6209 }
6210
5907 /* We have just inserted a section of STRING (starting at POS, of 6211 /* We have just inserted a section of STRING (starting at POS, of
5908 length LENGTH) into buffer BUF at OPOINT. Do whatever is necessary 6212 length LENGTH) into buffer BUF at OPOINT. Do whatever is necessary
5909 to get the string's extents into the buffer. */ 6213 to get the string's extents into the buffer. */
5910 6214
5911 void 6215 void
5912 splice_in_string_extents (Lisp_Object string, struct buffer *buf, 6216 splice_in_string_extents (Lisp_Object string, struct buffer *buf,
5913 Bytebpos opoint, Bytecount length, Bytecount pos) 6217 Bytexpos opoint, Bytecount length, Bytecount pos)
5914 { 6218 {
5915 struct splice_in_string_extents_arg closure;
5916 struct gcpro gcpro1, gcpro2; 6219 struct gcpro gcpro1, gcpro2;
5917 Lisp_Object buffer = wrap_buffer (buf); 6220 Lisp_Object buffer = wrap_buffer (buf);
5918 6221
5919 closure.opoint = opoint;
5920 closure.pos = pos;
5921 closure.length = length;
5922 closure.buffer = buffer;
5923 GCPRO2 (buffer, string); 6222 GCPRO2 (buffer, string);
5924 map_extents_bytebpos (pos, pos + length, 6223 if (XSTRING_FORMAT (string) == BUF_FORMAT (buf))
5925 splice_in_string_extents_mapper, 6224 {
5926 (void *) &closure, string, 0, 6225 struct splice_in_string_extents_arg closure;
5927 /* ignore extents that just abut the region */ 6226 closure.opoint = opoint;
5928 ME_END_CLOSED | ME_ALL_EXTENTS_OPEN | 6227 closure.pos = pos;
5929 /* we are calling E-Lisp (the extent's copy function) 6228 closure.length = length;
5930 so anything might happen */ 6229 closure.buffer = buffer;
5931 ME_MIGHT_CALL_ELISP); 6230 map_extents (pos, pos + length,
6231 splice_in_string_extents_mapper,
6232 (void *) &closure, string, 0,
6233 /* ignore extents that just abut the region */
6234 ME_END_CLOSED | ME_ALL_EXTENTS_OPEN |
6235 /* we are calling E-Lisp (the extent's copy function)
6236 so anything might happen */
6237 ME_MIGHT_CALL_ELISP);
6238 }
6239 else
6240 {
6241 struct splice_in_string_extents_the_hard_way_arg closure;
6242 closure.opoint = bytebpos_to_charbpos (buf, opoint);
6243 closure.pos = string_index_byte_to_char (string, pos);
6244 closure.length = string_offset_byte_to_char_len (string, pos, length);
6245 closure.buffer = buffer;
6246
6247 /* If the string and buffer are in different formats, things get
6248 tricky; the only reasonable way to do the operation is entirely in
6249 char offsets, which are invariant to format changes. In practice,
6250 this won't be time-consuming because the byte/char conversions are
6251 mostly in the buffer, which will be in a fixed-width format. */
6252 map_extents (pos, pos + length,
6253 splice_in_string_extents_the_hard_way_mapper,
6254 (void *) &closure, string, 0,
6255 /* ignore extents that just abut the region */
6256 ME_END_CLOSED | ME_ALL_EXTENTS_OPEN |
6257 /* we are calling E-Lisp (the extent's copy function)
6258 so anything might happen */
6259 ME_MIGHT_CALL_ELISP);
6260
6261 }
5932 UNGCPRO; 6262 UNGCPRO;
5933 } 6263 }
5934 6264
5935 struct copy_string_extents_arg 6265 struct copy_string_extents_arg
5936 { 6266 {
5951 { 6281 {
5952 struct copy_string_extents_arg *closure = 6282 struct copy_string_extents_arg *closure =
5953 (struct copy_string_extents_arg *) arg; 6283 (struct copy_string_extents_arg *) arg;
5954 Bytecount old_start, old_end, new_start, new_end; 6284 Bytecount old_start, old_end, new_start, new_end;
5955 6285
5956 old_start = extent_endpoint_bytebpos (extent, 0); 6286 old_start = extent_endpoint_byte (extent, 0);
5957 old_end = extent_endpoint_bytebpos (extent, 1); 6287 old_end = extent_endpoint_byte (extent, 1);
5958 6288
5959 old_start = max (closure->old_pos, old_start); 6289 old_start = max (closure->old_pos, old_start);
5960 old_end = min (closure->old_pos + closure->length, old_end); 6290 old_end = min (closure->old_pos + closure->length, old_end);
5961 6291
5962 if (old_start >= old_end) 6292 if (old_start >= old_end)
5985 closure.new_pos = new_pos; 6315 closure.new_pos = new_pos;
5986 closure.old_pos = old_pos; 6316 closure.old_pos = old_pos;
5987 closure.new_string = new_string; 6317 closure.new_string = new_string;
5988 closure.length = length; 6318 closure.length = length;
5989 GCPRO2 (new_string, old_string); 6319 GCPRO2 (new_string, old_string);
5990 map_extents_bytebpos (old_pos, old_pos + length, 6320 map_extents (old_pos, old_pos + length,
5991 copy_string_extents_mapper, 6321 copy_string_extents_mapper,
5992 (void *) &closure, old_string, 0, 6322 (void *) &closure, old_string, 0,
5993 /* ignore extents that just abut the region */ 6323 /* ignore extents that just abut the region */
5994 ME_END_CLOSED | ME_ALL_EXTENTS_OPEN | 6324 ME_END_CLOSED | ME_ALL_EXTENTS_OPEN |
5995 /* we are calling E-Lisp (the extent's copy function) 6325 /* we are calling E-Lisp (the extent's copy function)
5996 so anything might happen */ 6326 so anything might happen */
5997 ME_MIGHT_CALL_ELISP); 6327 ME_MIGHT_CALL_ELISP);
5998 UNGCPRO; 6328 UNGCPRO;
5999 } 6329 }
6000 6330
6001 /* Checklist for sanity checking: 6331 /* Checklist for sanity checking:
6002 - {kill, yank, copy} at {open, closed} {start, end} of {writable, read-only} extent 6332 - {kill, yank, copy} at {open, closed} {start, end} of {writable, read-only} extent
6014 */ 6344 */
6015 6345
6016 Lisp_Object Qtext_prop; 6346 Lisp_Object Qtext_prop;
6017 Lisp_Object Qtext_prop_extent_paste_function; 6347 Lisp_Object Qtext_prop_extent_paste_function;
6018 6348
6019 static Lisp_Object 6349 /* Retrieve the value of the property PROP of the text at position POSITION
6020 get_text_property_bytebpos (Bytebpos position, Lisp_Object prop, 6350 in OBJECT. TEXT-PROPS-ONLY means only look at extents with the
6021 Lisp_Object object, enum extent_at_flag fl, 6351 `text-prop' property, i.e. extents created by the text property
6022 int text_props_only) 6352 routines. Otherwise, all extents are examined. &&#### finish Note that
6353 the default extent_at_flag is EXTENT_AT_DEFAULT (same as
6354 EXTENT_AT_AFTER). */
6355 Lisp_Object
6356 get_char_property (Bytexpos position, Lisp_Object prop,
6357 Lisp_Object object, enum extent_at_flag fl,
6358 int text_props_only)
6023 { 6359 {
6024 Lisp_Object extent; 6360 Lisp_Object extent;
6025 6361
6026 /* text_props_only specifies whether we only consider text-property 6362 /* text_props_only specifies whether we only consider text-property
6027 extents (those with the 'text-prop property set) or all extents. */ 6363 extents (those with the 'text-prop property set) or all extents. */
6028 if (!text_props_only) 6364 if (!text_props_only)
6029 extent = extent_at_bytebpos (position, object, prop, 0, fl, 0); 6365 extent = extent_at (position, object, prop, 0, fl, 0);
6030 else 6366 else
6031 { 6367 {
6032 EXTENT prior = 0; 6368 EXTENT prior = 0;
6033 while (1) 6369 while (1)
6034 { 6370 {
6035 extent = extent_at_bytebpos (position, object, Qtext_prop, prior, 6371 extent = extent_at (position, object, Qtext_prop, prior, fl, 0);
6036 fl, 0);
6037 if (NILP (extent)) 6372 if (NILP (extent))
6038 return Qnil; 6373 return Qnil;
6039 if (EQ (prop, Fextent_property (extent, Qtext_prop, Qnil))) 6374 if (EQ (prop, Fextent_property (extent, Qtext_prop, Qnil)))
6040 break; 6375 break;
6041 prior = XEXTENT (extent); 6376 prior = XEXTENT (extent);
6048 return Fplist_get (Vdefault_text_properties, prop, Qnil); 6383 return Fplist_get (Vdefault_text_properties, prop, Qnil);
6049 return Qnil; 6384 return Qnil;
6050 } 6385 }
6051 6386
6052 static Lisp_Object 6387 static Lisp_Object
6053 get_text_property_1 (Lisp_Object pos, Lisp_Object prop, Lisp_Object object, 6388 get_char_property_char (Lisp_Object pos, Lisp_Object prop, Lisp_Object object,
6054 Lisp_Object at_flag, int text_props_only) 6389 Lisp_Object at_flag, int text_props_only)
6055 { 6390 {
6056 Bytebpos position; 6391 Bytexpos position;
6057 int invert = 0; 6392 int invert = 0;
6058 6393
6059 object = decode_buffer_or_string (object); 6394 object = decode_buffer_or_string (object);
6060 position = get_buffer_or_string_pos_byte (object, pos, GB_NO_ERROR_IF_BAD); 6395 position = get_buffer_or_string_pos_byte (object, pos, GB_NO_ERROR_IF_BAD);
6061 6396
6075 invert = 1; 6410 invert = 1;
6076 } 6411 }
6077 6412
6078 { 6413 {
6079 Lisp_Object val = 6414 Lisp_Object val =
6080 get_text_property_bytebpos (position, prop, object, 6415 get_char_property (position, prop, object,
6081 decode_extent_at_flag (at_flag), 6416 decode_extent_at_flag (at_flag),
6082 text_props_only); 6417 text_props_only);
6083 if (invert) 6418 if (invert)
6084 val = NILP (val) ? Qt : Qnil; 6419 val = NILP (val) ? Qt : Qnil;
6085 return val; 6420 return val;
6086 } 6421 }
6087 } 6422 }
6095 This examines only those properties added with `put-text-property'. 6430 This examines only those properties added with `put-text-property'.
6096 See also `get-char-property'. 6431 See also `get-char-property'.
6097 */ 6432 */
6098 (pos, prop, object, at_flag)) 6433 (pos, prop, object, at_flag))
6099 { 6434 {
6100 return get_text_property_1 (pos, prop, object, at_flag, 1); 6435 return get_char_property_char (pos, prop, object, at_flag, 1);
6101 } 6436 }
6102 6437
6103 DEFUN ("get-char-property", Fget_char_property, 2, 4, 0, /* 6438 DEFUN ("get-char-property", Fget_char_property, 2, 4, 0, /*
6104 Return the value of the PROP property at the given position. 6439 Return the value of the PROP property at the given position.
6105 Optional arg OBJECT specifies the buffer or string to look in, and 6440 Optional arg OBJECT specifies the buffer or string to look in, and
6109 This examines properties on all extents. 6444 This examines properties on all extents.
6110 See also `get-text-property'. 6445 See also `get-text-property'.
6111 */ 6446 */
6112 (pos, prop, object, at_flag)) 6447 (pos, prop, object, at_flag))
6113 { 6448 {
6114 return get_text_property_1 (pos, prop, object, at_flag, 0); 6449 return get_char_property_char (pos, prop, object, at_flag, 0);
6115 } 6450 }
6116 6451
6117 /* About start/end-open/closed: 6452 /* About start/end-open/closed:
6118 6453
6119 These properties have to be handled specially because of their 6454 These properties have to be handled specially because of their
6141 */ 6476 */
6142 6477
6143 struct put_text_prop_arg 6478 struct put_text_prop_arg
6144 { 6479 {
6145 Lisp_Object prop, value; /* The property and value we are storing */ 6480 Lisp_Object prop, value; /* The property and value we are storing */
6146 Bytebpos start, end; /* The region into which we are storing it */ 6481 Bytexpos start, end; /* The region into which we are storing it */
6147 Lisp_Object object; 6482 Lisp_Object object;
6148 Lisp_Object the_extent; /* Our chosen extent; this is used for 6483 Lisp_Object the_extent; /* Our chosen extent; this is used for
6149 communication between subsequent passes. */ 6484 communication between subsequent passes. */
6150 int changed_p; /* Output: whether we have modified anything */ 6485 int changed_p; /* Output: whether we have modified anything */
6151 }; 6486 };
6155 { 6490 {
6156 struct put_text_prop_arg *closure = (struct put_text_prop_arg *) arg; 6491 struct put_text_prop_arg *closure = (struct put_text_prop_arg *) arg;
6157 6492
6158 Lisp_Object object = closure->object; 6493 Lisp_Object object = closure->object;
6159 Lisp_Object value = closure->value; 6494 Lisp_Object value = closure->value;
6160 Bytebpos e_start, e_end; 6495 Bytexpos e_start, e_end;
6161 Bytebpos start = closure->start; 6496 Bytexpos start = closure->start;
6162 Bytebpos end = closure->end; 6497 Bytexpos end = closure->end;
6163 Lisp_Object extent, e_val; 6498 Lisp_Object extent, e_val;
6164 int is_eq; 6499 int is_eq;
6165 6500
6166 extent = wrap_extent (e); 6501 extent = wrap_extent (e);
6167 6502
6171 openness later on in put_text_prop_openness_mapper(). */ 6506 openness later on in put_text_prop_openness_mapper(). */
6172 if (!EQ (Fextent_property (extent, Qtext_prop, Qnil), closure->prop)) 6507 if (!EQ (Fextent_property (extent, Qtext_prop, Qnil), closure->prop))
6173 /* It's not for this property; do nothing. */ 6508 /* It's not for this property; do nothing. */
6174 return 0; 6509 return 0;
6175 6510
6176 e_start = extent_endpoint_bytebpos (e, 0); 6511 e_start = extent_endpoint_byte (e, 0);
6177 e_end = extent_endpoint_bytebpos (e, 1); 6512 e_end = extent_endpoint_byte (e, 1);
6178 e_val = Fextent_property (extent, closure->prop, Qnil); 6513 e_val = Fextent_property (extent, closure->prop, Qnil);
6179 is_eq = EQ (value, e_val); 6514 is_eq = EQ (value, e_val);
6180 6515
6181 if (!NILP (value) && NILP (closure->the_extent) && is_eq) 6516 if (!NILP (value) && NILP (closure->the_extent) && is_eq)
6182 { 6517 {
6186 side-effecting the kill ring (that is, we never change the property 6521 side-effecting the kill ring (that is, we never change the property
6187 on an extent after it has been created.) 6522 on an extent after it has been created.)
6188 */ 6523 */
6189 if (e_start != start || e_end != end) 6524 if (e_start != start || e_end != end)
6190 { 6525 {
6191 Bytebpos new_start = min (e_start, start); 6526 Bytexpos new_start = min (e_start, start);
6192 Bytebpos new_end = max (e_end, end); 6527 Bytexpos new_end = max (e_end, end);
6193 set_extent_endpoints (e, new_start, new_end, Qnil); 6528 set_extent_endpoints (e, new_start, new_end, Qnil);
6194 /* If we changed the endpoint, then we need to set its 6529 /* If we changed the endpoint, then we need to set its
6195 openness. */ 6530 openness. */
6196 set_extent_openness (e, new_start != e_start 6531 set_extent_openness (e, new_start != e_start
6197 ? !NILP (get_text_property_bytebpos 6532 ? !NILP (get_char_property
6198 (start, Qstart_open, object, 6533 (start, Qstart_open, object,
6199 EXTENT_AT_AFTER, 1)) : -1, 6534 EXTENT_AT_AFTER, 1)) : -1,
6200 new_end != e_end 6535 new_end != e_end
6201 ? NILP (get_text_property_bytebpos 6536 ? NILP (get_char_property
6202 (end - 1, Qend_closed, object, 6537 (prev_bytexpos (object, end),
6538 Qend_closed, object,
6203 EXTENT_AT_AFTER, 1)) 6539 EXTENT_AT_AFTER, 1))
6204 : -1); 6540 : -1);
6205 closure->changed_p = 1; 6541 closure->changed_p = 1;
6206 } 6542 }
6207 closure->the_extent = extent; 6543 closure->the_extent = extent;
6238 decided to reuse, so we can remove this existing extent as well (the 6574 decided to reuse, so we can remove this existing extent as well (the
6239 whole thing, even the part outside of the region) and extend 6575 whole thing, even the part outside of the region) and extend
6240 the-extent to cover it, resulting in the minimum number of extents in 6576 the-extent to cover it, resulting in the minimum number of extents in
6241 the buffer. 6577 the buffer.
6242 */ 6578 */
6243 Bytebpos the_start = extent_endpoint_bytebpos (te, 0); 6579 Bytexpos the_start = extent_endpoint_byte (te, 0);
6244 Bytebpos the_end = extent_endpoint_bytebpos (te, 1); 6580 Bytexpos the_end = extent_endpoint_byte (te, 1);
6245 if (e_start != the_start && /* note AND not OR -- hmm, why is this 6581 if (e_start != the_start && /* note AND not OR -- hmm, why is this
6246 the case? I think it's because the 6582 the case? I think it's because the
6247 assumption that the text-property 6583 assumption that the text-property
6248 extents don't overlap makes it 6584 extents don't overlap makes it
6249 OK; changing it to an OR would 6585 OK; changing it to an OR would
6250 result in changed_p sometimes getting 6586 result in changed_p sometimes getting
6251 falsely marked. Is this bad? */ 6587 falsely marked. Is this bad? */
6252 e_end != the_end) 6588 e_end != the_end)
6253 { 6589 {
6254 Bytebpos new_start = min (e_start, the_start); 6590 Bytexpos new_start = min (e_start, the_start);
6255 Bytebpos new_end = max (e_end, the_end); 6591 Bytexpos new_end = max (e_end, the_end);
6256 set_extent_endpoints (te, new_start, new_end, Qnil); 6592 set_extent_endpoints (te, new_start, new_end, Qnil);
6257 /* If we changed the endpoint, then we need to set its 6593 /* If we changed the endpoint, then we need to set its
6258 openness. We are setting the endpoint to be the same as 6594 openness. We are setting the endpoint to be the same as
6259 that of the extent we're about to remove, and we assume 6595 that of the extent we're about to remove, and we assume
6260 (the invariant mentioned above) that extent has the 6596 (the invariant mentioned above) that extent has the
6273 decrease its end position. 6609 decrease its end position.
6274 */ 6610 */
6275 if (e_end != start) 6611 if (e_end != start)
6276 { 6612 {
6277 set_extent_endpoints (e, e_start, start, Qnil); 6613 set_extent_endpoints (e, e_start, start, Qnil);
6278 set_extent_openness (e, -1, NILP (get_text_property_bytebpos 6614 set_extent_openness (e, -1,
6279 (start - 1, Qend_closed, object, 6615 NILP (get_char_property
6280 EXTENT_AT_AFTER, 1))); 6616 (prev_bytexpos (object, start),
6617 Qend_closed, object,
6618 EXTENT_AT_AFTER, 1)));
6281 closure->changed_p = 1; 6619 closure->changed_p = 1;
6282 } 6620 }
6283 } 6621 }
6284 else if (e_start >= start) 6622 else if (e_start >= start)
6285 { 6623 {
6287 increase its start position. 6625 increase its start position.
6288 */ 6626 */
6289 if (e_start != end) 6627 if (e_start != end)
6290 { 6628 {
6291 set_extent_endpoints (e, end, e_end, Qnil); 6629 set_extent_endpoints (e, end, e_end, Qnil);
6292 set_extent_openness (e, !NILP (get_text_property_bytebpos 6630 set_extent_openness (e, !NILP (get_char_property
6293 (end, Qstart_open, object, 6631 (end, Qstart_open, object,
6294 EXTENT_AT_AFTER, 1)), -1); 6632 EXTENT_AT_AFTER, 1)), -1);
6295 closure->changed_p = 1; 6633 closure->changed_p = 1;
6296 } 6634 }
6297 } 6635 }
6298 else 6636 else
6299 { 6637 {
6300 /* Otherwise, `extent' straddles the region. We need to split it. 6638 /* Otherwise, `extent' straddles the region. We need to split it.
6301 */ 6639 */
6302 set_extent_endpoints (e, e_start, start, Qnil); 6640 set_extent_endpoints (e, e_start, start, Qnil);
6303 set_extent_openness (e, -1, NILP (get_text_property_bytebpos 6641 set_extent_openness (e, -1, NILP (get_char_property
6304 (start - 1, Qend_closed, object, 6642 (prev_bytexpos (object, start),
6643 Qend_closed, object,
6305 EXTENT_AT_AFTER, 1))); 6644 EXTENT_AT_AFTER, 1)));
6306 set_extent_openness (copy_extent (e, end, e_end, extent_object (e)), 6645 set_extent_openness (copy_extent (e, end, e_end, extent_object (e)),
6307 !NILP (get_text_property_bytebpos 6646 !NILP (get_char_property
6308 (end, Qstart_open, object, 6647 (end, Qstart_open, object,
6309 EXTENT_AT_AFTER, 1)), -1); 6648 EXTENT_AT_AFTER, 1)), -1);
6310 closure->changed_p = 1; 6649 closure->changed_p = 1;
6311 } 6650 }
6312 6651
6315 6654
6316 static int 6655 static int
6317 put_text_prop_openness_mapper (EXTENT e, void *arg) 6656 put_text_prop_openness_mapper (EXTENT e, void *arg)
6318 { 6657 {
6319 struct put_text_prop_arg *closure = (struct put_text_prop_arg *) arg; 6658 struct put_text_prop_arg *closure = (struct put_text_prop_arg *) arg;
6320 Bytebpos e_start, e_end; 6659 Bytexpos e_start, e_end;
6321 Bytebpos start = closure->start; 6660 Bytexpos start = closure->start;
6322 Bytebpos end = closure->end; 6661 Bytexpos end = closure->end;
6323 Lisp_Object extent = wrap_extent (e); 6662 Lisp_Object extent = wrap_extent (e);
6324 6663
6325 e_start = extent_endpoint_bytebpos (e, 0); 6664 e_start = extent_endpoint_byte (e, 0);
6326 e_end = extent_endpoint_bytebpos (e, 1); 6665 e_end = extent_endpoint_byte (e, 1);
6327 6666
6328 if (NILP (Fextent_property (extent, Qtext_prop, Qnil))) 6667 if (NILP (Fextent_property (extent, Qtext_prop, Qnil)))
6329 { 6668 {
6330 /* It's not a text-property extent; do nothing. */ 6669 /* It's not a text-property extent; do nothing. */
6331 ; 6670 ;
6340 6679
6341 return 0; /* to continue mapping. */ 6680 return 0; /* to continue mapping. */
6342 } 6681 }
6343 6682
6344 static int 6683 static int
6345 put_text_prop (Bytebpos start, Bytebpos end, Lisp_Object object, 6684 put_text_prop (Bytexpos start, Bytexpos end, Lisp_Object object,
6346 Lisp_Object prop, Lisp_Object value, 6685 Lisp_Object prop, Lisp_Object value,
6347 int duplicable_p) 6686 int duplicable_p)
6348 { 6687 {
6349 /* This function can GC */ 6688 /* This function can GC */
6350 struct put_text_prop_arg closure; 6689 struct put_text_prop_arg closure;
6373 closure.end = end; 6712 closure.end = end;
6374 closure.object = object; 6713 closure.object = object;
6375 closure.changed_p = 0; 6714 closure.changed_p = 0;
6376 closure.the_extent = Qnil; 6715 closure.the_extent = Qnil;
6377 6716
6378 map_extents_bytebpos (start, end, 6717 map_extents (start, end,
6379 put_text_prop_mapper, 6718 put_text_prop_mapper,
6380 (void *) &closure, object, 0, 6719 (void *) &closure, object, 0,
6381 /* get all extents that abut the region */ 6720 /* get all extents that abut the region */
6382 ME_ALL_EXTENTS_CLOSED | ME_END_CLOSED | 6721 ME_ALL_EXTENTS_CLOSED | ME_END_CLOSED |
6383 /* it might QUIT or error if the user has 6722 #if 0
6384 fucked with the extent plist. */ 6723 /* it might move the SOE because the callback function calls
6385 /* #### dmoore - I think this should include 6724 get_char_property(), which calls extent_at(), which calls
6386 ME_MIGHT_MOVE_SOE, since the callback function 6725 map_extents()
6387 might recurse back into map_extents_bytebpos. */ 6726
6388 ME_MIGHT_THROW | 6727 #### this was comment out before, and nothing seemed broken;
6389 ME_MIGHT_MODIFY_EXTENTS); 6728 #### but when I added the above comment and uncommented it,
6729 #### text property operations (e.g. font-lock) suddenly
6730 #### became *WAY* slow, and dominated font-lock, when a
6731 #### single extent spanning the entire buffer
6732 #### existed. --ben */
6733 ME_MIGHT_MOVE_SOE |
6734 #endif
6735 /* it might QUIT or error if the user has
6736 fucked with the extent plist. */
6737 ME_MIGHT_THROW |
6738 ME_MIGHT_MODIFY_EXTENTS);
6390 6739
6391 /* If we made it through the loop without reusing an extent 6740 /* If we made it through the loop without reusing an extent
6392 (and we want there to be one) make it now. 6741 (and we want there to be one) make it now.
6393 */ 6742 */
6394 if (!NILP (value) && NILP (closure.the_extent)) 6743 if (!NILP (value) && NILP (closure.the_extent))
6395 { 6744 {
6396 Lisp_Object extent = wrap_extent (make_extent_internal (object, start, end)); 6745 Lisp_Object extent =
6746 wrap_extent (make_extent (object, start, end));
6397 6747
6398 closure.changed_p = 1; 6748 closure.changed_p = 1;
6399 Fset_extent_property (extent, Qtext_prop, prop); 6749 Fset_extent_property (extent, Qtext_prop, prop);
6400 Fset_extent_property (extent, prop, value); 6750 Fset_extent_property (extent, prop, value);
6401 if (duplicable_p) 6751 if (duplicable_p)
6403 extent_duplicable_p (XEXTENT (extent)) = 1; 6753 extent_duplicable_p (XEXTENT (extent)) = 1;
6404 Fset_extent_property (extent, Qpaste_function, 6754 Fset_extent_property (extent, Qpaste_function,
6405 Qtext_prop_extent_paste_function); 6755 Qtext_prop_extent_paste_function);
6406 } 6756 }
6407 set_extent_openness (XEXTENT (extent), 6757 set_extent_openness (XEXTENT (extent),
6408 !NILP (get_text_property_bytebpos 6758 !NILP (get_char_property
6409 (start, Qstart_open, object, 6759 (start, Qstart_open, object,
6410 EXTENT_AT_AFTER, 1)), 6760 EXTENT_AT_AFTER, 1)),
6411 NILP (get_text_property_bytebpos 6761 NILP (get_char_property
6412 (end - 1, Qend_closed, object, 6762 (prev_bytexpos (object, end),
6763 Qend_closed, object,
6413 EXTENT_AT_AFTER, 1))); 6764 EXTENT_AT_AFTER, 1)));
6414 } 6765 }
6415 6766
6416 if (EQ (prop, Qstart_open) || EQ (prop, Qend_closed)) 6767 if (EQ (prop, Qstart_open) || EQ (prop, Qend_closed))
6417 { 6768 {
6418 map_extents_bytebpos (start, end, 6769 map_extents (start, end, put_text_prop_openness_mapper,
6419 put_text_prop_openness_mapper, 6770 (void *) &closure, object, 0,
6420 (void *) &closure, object, 0, 6771 /* get all extents that abut the region */
6421 /* get all extents that abut the region */ 6772 ME_ALL_EXTENTS_CLOSED | ME_END_CLOSED |
6422 ME_ALL_EXTENTS_CLOSED | ME_END_CLOSED | 6773 ME_MIGHT_MODIFY_EXTENTS);
6423 ME_MIGHT_MODIFY_EXTENTS);
6424 } 6774 }
6425 6775
6426 return closure.changed_p; 6776 return closure.changed_p;
6427 } 6777 }
6428 6778
6434 defaults to the current buffer. 6784 defaults to the current buffer.
6435 */ 6785 */
6436 (start, end, prop, value, object)) 6786 (start, end, prop, value, object))
6437 { 6787 {
6438 /* This function can GC */ 6788 /* This function can GC */
6439 Bytebpos s, e; 6789 Bytexpos s, e;
6440 6790
6441 object = decode_buffer_or_string (object); 6791 object = decode_buffer_or_string (object);
6442 get_buffer_or_string_range_byte (object, start, end, &s, &e, 0); 6792 get_buffer_or_string_range_byte (object, start, end, &s, &e, 0);
6443 put_text_prop (s, e, object, prop, value, 1); 6793 put_text_prop (s, e, object, prop, value, 1);
6444 return prop; 6794 return prop;
6454 defaults to the current buffer. 6804 defaults to the current buffer.
6455 */ 6805 */
6456 (start, end, prop, value, object)) 6806 (start, end, prop, value, object))
6457 { 6807 {
6458 /* This function can GC */ 6808 /* This function can GC */
6459 Bytebpos s, e; 6809 Bytexpos s, e;
6460 6810
6461 object = decode_buffer_or_string (object); 6811 object = decode_buffer_or_string (object);
6462 get_buffer_or_string_range_byte (object, start, end, &s, &e, 0); 6812 get_buffer_or_string_range_byte (object, start, end, &s, &e, 0);
6463 put_text_prop (s, e, object, prop, value, 0); 6813 put_text_prop (s, e, object, prop, value, 0);
6464 return prop; 6814 return prop;
6473 */ 6823 */
6474 (start, end, props, object)) 6824 (start, end, props, object))
6475 { 6825 {
6476 /* This function can GC */ 6826 /* This function can GC */
6477 int changed = 0; 6827 int changed = 0;
6478 Bytebpos s, e; 6828 Bytexpos s, e;
6479 6829
6480 object = decode_buffer_or_string (object); 6830 object = decode_buffer_or_string (object);
6481 get_buffer_or_string_range_byte (object, start, end, &s, &e, 0); 6831 get_buffer_or_string_range_byte (object, start, end, &s, &e, 0);
6482 CHECK_LIST (props); 6832 CHECK_LIST (props);
6483 for (; !NILP (props); props = Fcdr (Fcdr (props))) 6833 for (; !NILP (props); props = Fcdr (Fcdr (props)))
6501 */ 6851 */
6502 (start, end, props, object)) 6852 (start, end, props, object))
6503 { 6853 {
6504 /* This function can GC */ 6854 /* This function can GC */
6505 int changed = 0; 6855 int changed = 0;
6506 Bytebpos s, e; 6856 Bytexpos s, e;
6507 6857
6508 object = decode_buffer_or_string (object); 6858 object = decode_buffer_or_string (object);
6509 get_buffer_or_string_range_byte (object, start, end, &s, &e, 0); 6859 get_buffer_or_string_range_byte (object, start, end, &s, &e, 0);
6510 CHECK_LIST (props); 6860 CHECK_LIST (props);
6511 for (; !NILP (props); props = Fcdr (Fcdr (props))) 6861 for (; !NILP (props); props = Fcdr (Fcdr (props)))
6526 */ 6876 */
6527 (start, end, props, object)) 6877 (start, end, props, object))
6528 { 6878 {
6529 /* This function can GC */ 6879 /* This function can GC */
6530 int changed = 0; 6880 int changed = 0;
6531 Bytebpos s, e; 6881 Bytexpos s, e;
6532 6882
6533 object = decode_buffer_or_string (object); 6883 object = decode_buffer_or_string (object);
6534 get_buffer_or_string_range_byte (object, start, end, &s, &e, 0); 6884 get_buffer_or_string_range_byte (object, start, end, &s, &e, 0);
6535 CHECK_LIST (props); 6885 CHECK_LIST (props);
6536 for (; !NILP (props); props = Fcdr (Fcdr (props))) 6886 for (; !NILP (props); props = Fcdr (Fcdr (props)))
6579 #endif 6929 #endif
6580 Fput_text_property (from, to, prop, val, Qnil); 6930 Fput_text_property (from, to, prop, val, Qnil);
6581 return Qnil; /* important! */ 6931 return Qnil; /* important! */
6582 } 6932 }
6583 6933
6584 /* This function could easily be written in Lisp but the C code wants 6934 Bytexpos
6585 to use it in connection with invisible extents (at least currently). 6935 next_single_property_change (Bytexpos pos, Lisp_Object prop,
6586 If this changes, consider moving this back into Lisp. */ 6936 Lisp_Object object, Bytexpos limit)
6937 {
6938 Lisp_Object extent, value;
6939 int limit_was_nil;
6940
6941 if (limit < 0)
6942 {
6943 limit = buffer_or_string_accessible_end_byte (object);
6944 limit_was_nil = 1;
6945 }
6946 else
6947 limit_was_nil = 0;
6948
6949 extent = extent_at (pos, object, prop, 0, EXTENT_AT_AFTER, 0);
6950 if (!NILP (extent))
6951 value = Fextent_property (extent, prop, Qnil);
6952 else
6953 value = Qnil;
6954
6955 while (1)
6956 {
6957 pos = extent_find_end_of_run (object, pos, 1);
6958 if (pos >= limit)
6959 break; /* property is the same all the way to the end */
6960 extent = extent_at (pos, object, prop, 0, EXTENT_AT_AFTER, 0);
6961 if ((NILP (extent) && !NILP (value)) ||
6962 (!NILP (extent) && !EQ (value,
6963 Fextent_property (extent, prop, Qnil))))
6964 return pos;
6965 }
6966
6967 if (limit_was_nil)
6968 return -1;
6969 else
6970 return limit;
6971 }
6972
6973 Bytexpos
6974 previous_single_property_change (Bytexpos pos, Lisp_Object prop,
6975 Lisp_Object object, Bytexpos limit)
6976 {
6977 Lisp_Object extent, value;
6978 int limit_was_nil;
6979
6980 if (limit < 0)
6981 {
6982 limit = buffer_or_string_accessible_begin_byte (object);
6983 limit_was_nil = 1;
6984 }
6985 else
6986 limit_was_nil = 0;
6987
6988 extent = extent_at (pos, object, prop, 0, EXTENT_AT_BEFORE, 0);
6989 if (!NILP (extent))
6990 value = Fextent_property (extent, prop, Qnil);
6991 else
6992 value = Qnil;
6993
6994 while (1)
6995 {
6996 pos = extent_find_beginning_of_run (object, pos, 1);
6997 if (pos <= limit)
6998 break; /* property is the same all the way to the end */
6999 extent = extent_at (pos, object, prop, 0, EXTENT_AT_BEFORE, 0);
7000 if ((NILP (extent) && !NILP (value)) ||
7001 (!NILP (extent) && !EQ (value,
7002 Fextent_property (extent, prop, Qnil))))
7003 return pos;
7004 }
7005
7006 if (limit_was_nil)
7007 return -1;
7008 else
7009 return limit;
7010 }
6587 7011
6588 DEFUN ("next-single-property-change", Fnext_single_property_change, 7012 DEFUN ("next-single-property-change", Fnext_single_property_change,
6589 2, 4, 0, /* 7013 2, 4, 0, /*
6590 Return the position of next property change for a specific property. 7014 Return the position of next property change for a specific property.
6591 Scans characters forward from POS till it finds a change in the PROP 7015 Scans characters forward from POS till it finds a change in the PROP
6603 the value of PROP. (Note that this situation will not happen if you always 7027 the value of PROP. (Note that this situation will not happen if you always
6604 use the text-property primitives.) 7028 use the text-property primitives.)
6605 */ 7029 */
6606 (pos, prop, object, limit)) 7030 (pos, prop, object, limit))
6607 { 7031 {
6608 Charbpos bpos; 7032 Bytexpos xpos;
6609 Charbpos blim; 7033 Bytexpos blim;
6610 Lisp_Object extent, value;
6611 int limit_was_nil;
6612 7034
6613 object = decode_buffer_or_string (object); 7035 object = decode_buffer_or_string (object);
6614 bpos = get_buffer_or_string_pos_char (object, pos, 0); 7036 xpos = get_buffer_or_string_pos_byte (object, pos, 0);
6615 if (NILP (limit)) 7037 blim = !NILP (limit) ? get_buffer_or_string_pos_byte (object, limit, 0) : -1;
6616 { 7038
6617 blim = buffer_or_string_accessible_end_char (object); 7039 blim = next_single_property_change (xpos, prop, object, blim);
6618 limit_was_nil = 1; 7040
6619 } 7041 if (blim < 0)
6620 else
6621 {
6622 blim = get_buffer_or_string_pos_char (object, limit, 0);
6623 limit_was_nil = 0;
6624 }
6625
6626 extent = Fextent_at (make_int (bpos), object, prop, Qnil, Qnil);
6627 if (!NILP (extent))
6628 value = Fextent_property (extent, prop, Qnil);
6629 else
6630 value = Qnil;
6631
6632 while (1)
6633 {
6634 bpos = XINT (Fnext_extent_change (make_int (bpos), object));
6635 if (bpos >= blim)
6636 break; /* property is the same all the way to the end */
6637 extent = Fextent_at (make_int (bpos), object, prop, Qnil, Qnil);
6638 if ((NILP (extent) && !NILP (value)) ||
6639 (!NILP (extent) && !EQ (value,
6640 Fextent_property (extent, prop, Qnil))))
6641 return make_int (bpos);
6642 }
6643
6644 /* I think it's more sensible for this function to return nil always
6645 in this situation and it used to do it this way, but it's been changed
6646 for FSF compatibility. */
6647 if (limit_was_nil)
6648 return Qnil; 7042 return Qnil;
6649 else 7043 else
6650 return make_int (blim); 7044 return make_int (buffer_or_string_bytexpos_to_charxpos (object, blim));
6651 } 7045 }
6652
6653 /* See comment on previous function about why this is written in C. */
6654 7046
6655 DEFUN ("previous-single-property-change", Fprevious_single_property_change, 7047 DEFUN ("previous-single-property-change", Fprevious_single_property_change,
6656 2, 4, 0, /* 7048 2, 4, 0, /*
6657 Return the position of next property change for a specific property. 7049 Return the position of next property change for a specific property.
6658 Scans characters backward from POS till it finds a change in the PROP 7050 Scans characters backward from POS till it finds a change in the PROP
6670 the value of PROP. (Note that this situation will not happen if you always 7062 the value of PROP. (Note that this situation will not happen if you always
6671 use the text-property primitives.) 7063 use the text-property primitives.)
6672 */ 7064 */
6673 (pos, prop, object, limit)) 7065 (pos, prop, object, limit))
6674 { 7066 {
6675 Charbpos bpos; 7067 Bytexpos xpos;
6676 Charbpos blim; 7068 Bytexpos blim;
6677 Lisp_Object extent, value;
6678 int limit_was_nil;
6679 7069
6680 object = decode_buffer_or_string (object); 7070 object = decode_buffer_or_string (object);
6681 bpos = get_buffer_or_string_pos_char (object, pos, 0); 7071 xpos = get_buffer_or_string_pos_byte (object, pos, 0);
6682 if (NILP (limit)) 7072 blim = !NILP (limit) ? get_buffer_or_string_pos_byte (object, limit, 0) : -1;
6683 { 7073
6684 blim = buffer_or_string_accessible_begin_char (object); 7074 blim = previous_single_property_change (xpos, prop, object, blim);
6685 limit_was_nil = 1; 7075
6686 } 7076 if (blim < 0)
6687 else
6688 {
6689 blim = get_buffer_or_string_pos_char (object, limit, 0);
6690 limit_was_nil = 0;
6691 }
6692
6693 /* extent-at refers to the character AFTER bpos, but we want the
6694 character before bpos. Thus the - 1. extent-at simply
6695 returns nil on bogus positions, so not to worry. */
6696 extent = Fextent_at (make_int (bpos - 1), object, prop, Qnil, Qnil);
6697 if (!NILP (extent))
6698 value = Fextent_property (extent, prop, Qnil);
6699 else
6700 value = Qnil;
6701
6702 while (1)
6703 {
6704 bpos = XINT (Fprevious_extent_change (make_int (bpos), object));
6705 if (bpos <= blim)
6706 break; /* property is the same all the way to the beginning */
6707 extent = Fextent_at (make_int (bpos - 1), object, prop, Qnil, Qnil);
6708 if ((NILP (extent) && !NILP (value)) ||
6709 (!NILP (extent) && !EQ (value,
6710 Fextent_property (extent, prop, Qnil))))
6711 return make_int (bpos);
6712 }
6713
6714 /* I think it's more sensible for this function to return nil always
6715 in this situation and it used to do it this way, but it's been changed
6716 for FSF compatibility. */
6717 if (limit_was_nil)
6718 return Qnil; 7077 return Qnil;
6719 else 7078 else
6720 return make_int (blim); 7079 return make_int (buffer_or_string_bytexpos_to_charxpos (object, blim));
6721 } 7080 }
6722 7081
6723 #ifdef MEMORY_USAGE_STATS 7082 #ifdef MEMORY_USAGE_STATS
6724 7083
6725 int 7084 int