1/* Code for doing intervals.
2   Copyright (C) 1993, 1994, 1995, 1997, 1998, 2001, 2002, 2003, 2004,
3                 2005, 2006, 2007  Free Software Foundation, Inc.
4
5This file is part of GNU Emacs.
6
7GNU Emacs is free software; you can redistribute it and/or modify
8it under the terms of the GNU General Public License as published by
9the Free Software Foundation; either version 2, or (at your option)
10any later version.
11
12GNU Emacs is distributed in the hope that it will be useful,
13but WITHOUT ANY WARRANTY; without even the implied warranty of
14MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
15GNU General Public License for more details.
16
17You should have received a copy of the GNU General Public License
18along with GNU Emacs; see the file COPYING.  If not, write to
19the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
20Boston, MA 02110-1301, USA.  */
21
22
23/* NOTES:
24
25   Have to ensure that we can't put symbol nil on a plist, or some
26   functions may work incorrectly.
27
28   An idea:  Have the owner of the tree keep count of splits and/or
29   insertion lengths (in intervals), and balance after every N.
30
31   Need to call *_left_hook when buffer is killed.
32
33   Scan for zero-length, or 0-length to see notes about handling
34   zero length interval-markers.
35
36   There are comments around about freeing intervals.  It might be
37   faster to explicitly free them (put them on the free list) than
38   to GC them.
39
40*/
41
42
43#include <config.h>
44#include "lisp.h"
45#include "intervals.h"
46#include "buffer.h"
47#include "puresize.h"
48#include "keyboard.h"
49#include "keymap.h"
50
51/* Test for membership, allowing for t (actually any non-cons) to mean the
52   universal set.  */
53
54#define TMEM(sym, set) (CONSP (set) ? ! NILP (Fmemq (sym, set)) : ! NILP (set))
55
56Lisp_Object merge_properties_sticky ();
57static INTERVAL reproduce_tree P_ ((INTERVAL, INTERVAL));
58static INTERVAL reproduce_tree_obj P_ ((INTERVAL, Lisp_Object));
59
60/* Utility functions for intervals.  */
61
62
63/* Create the root interval of some object, a buffer or string.  */
64
65INTERVAL
66create_root_interval (parent)
67     Lisp_Object parent;
68{
69  INTERVAL new;
70
71  CHECK_IMPURE (parent);
72
73  new = make_interval ();
74
75  if (BUFFERP (parent))
76    {
77      new->total_length = (BUF_Z (XBUFFER (parent))
78			   - BUF_BEG (XBUFFER (parent)));
79      CHECK_TOTAL_LENGTH (new);
80      BUF_INTERVALS (XBUFFER (parent)) = new;
81      new->position = BEG;
82    }
83  else if (STRINGP (parent))
84    {
85      new->total_length = SCHARS (parent);
86      CHECK_TOTAL_LENGTH (new);
87      STRING_SET_INTERVALS (parent, new);
88      new->position = 0;
89    }
90
91  SET_INTERVAL_OBJECT (new, parent);
92
93  return new;
94}
95
96/* Make the interval TARGET have exactly the properties of SOURCE */
97
98void
99copy_properties (source, target)
100     register INTERVAL source, target;
101{
102  if (DEFAULT_INTERVAL_P (source) && DEFAULT_INTERVAL_P (target))
103    return;
104
105  COPY_INTERVAL_CACHE (source, target);
106  target->plist = Fcopy_sequence (source->plist);
107}
108
109/* Merge the properties of interval SOURCE into the properties
110   of interval TARGET.  That is to say, each property in SOURCE
111   is added to TARGET if TARGET has no such property as yet.  */
112
113static void
114merge_properties (source, target)
115     register INTERVAL source, target;
116{
117  register Lisp_Object o, sym, val;
118
119  if (DEFAULT_INTERVAL_P (source) && DEFAULT_INTERVAL_P (target))
120    return;
121
122  MERGE_INTERVAL_CACHE (source, target);
123
124  o = source->plist;
125  while (CONSP (o))
126    {
127      sym = XCAR (o);
128      o = XCDR (o);
129      CHECK_CONS (o);
130
131      val = target->plist;
132      while (CONSP (val) && !EQ (XCAR (val), sym))
133	{
134	  val = XCDR (val);
135	  if (!CONSP (val))
136	    break;
137	  val = XCDR (val);
138	}
139
140      if (NILP (val))
141	{
142	  val = XCAR (o);
143	  target->plist = Fcons (sym, Fcons (val, target->plist));
144	}
145      o = XCDR (o);
146    }
147}
148
149/* Return 1 if the two intervals have the same properties,
150   0 otherwise.  */
151
152int
153intervals_equal (i0, i1)
154     INTERVAL i0, i1;
155{
156  register Lisp_Object i0_cdr, i0_sym;
157  register Lisp_Object i1_cdr, i1_val;
158
159  if (DEFAULT_INTERVAL_P (i0) && DEFAULT_INTERVAL_P (i1))
160    return 1;
161
162  if (DEFAULT_INTERVAL_P (i0) || DEFAULT_INTERVAL_P (i1))
163    return 0;
164
165  i0_cdr = i0->plist;
166  i1_cdr = i1->plist;
167  while (CONSP (i0_cdr) && CONSP (i1_cdr))
168    {
169      i0_sym = XCAR (i0_cdr);
170      i0_cdr = XCDR (i0_cdr);
171      if (!CONSP (i0_cdr))
172	return 0;		/* abort (); */
173      i1_val = i1->plist;
174      while (CONSP (i1_val) && !EQ (XCAR (i1_val), i0_sym))
175	{
176	  i1_val = XCDR (i1_val);
177	  if (!CONSP (i1_val))
178	    return 0;		/* abort (); */
179	  i1_val = XCDR (i1_val);
180	}
181
182      /* i0 has something i1 doesn't.  */
183      if (EQ (i1_val, Qnil))
184	return 0;
185
186      /* i0 and i1 both have sym, but it has different values in each.  */
187      if (!CONSP (i1_val)
188	  || (i1_val = XCDR (i1_val), !CONSP (i1_val))
189	  || !EQ (XCAR (i1_val), XCAR (i0_cdr)))
190	return 0;
191
192      i0_cdr = XCDR (i0_cdr);
193
194      i1_cdr = XCDR (i1_cdr);
195      if (!CONSP (i1_cdr))
196	return 0;		/* abort (); */
197      i1_cdr = XCDR (i1_cdr);
198    }
199
200  /* Lengths of the two plists were equal.  */
201  return (NILP (i0_cdr) && NILP (i1_cdr));
202}
203
204
205/* Traverse an interval tree TREE, performing FUNCTION on each node.
206   No guarantee is made about the order of traversal.
207   Pass FUNCTION two args: an interval, and ARG.  */
208
209void
210traverse_intervals_noorder (tree, function, arg)
211     INTERVAL tree;
212     void (* function) P_ ((INTERVAL, Lisp_Object));
213     Lisp_Object arg;
214{
215  /* Minimize stack usage.  */
216  while (!NULL_INTERVAL_P (tree))
217    {
218      (*function) (tree, arg);
219      if (NULL_INTERVAL_P (tree->right))
220	tree = tree->left;
221      else
222	{
223	  traverse_intervals_noorder (tree->left, function, arg);
224	  tree = tree->right;
225	}
226    }
227}
228
229/* Traverse an interval tree TREE, performing FUNCTION on each node.
230   Pass FUNCTION two args: an interval, and ARG.  */
231
232void
233traverse_intervals (tree, position, function, arg)
234     INTERVAL tree;
235     int position;
236     void (* function) P_ ((INTERVAL, Lisp_Object));
237     Lisp_Object arg;
238{
239  while (!NULL_INTERVAL_P (tree))
240    {
241      traverse_intervals (tree->left, position, function, arg);
242      position += LEFT_TOTAL_LENGTH (tree);
243      tree->position = position;
244      (*function) (tree, arg);
245      position += LENGTH (tree); tree = tree->right;
246    }
247}
248
249#if 0
250
251static int icount;
252static int idepth;
253static int zero_length;
254
255/* These functions are temporary, for debugging purposes only.  */
256
257INTERVAL search_interval, found_interval;
258
259void
260check_for_interval (i)
261     register INTERVAL i;
262{
263  if (i == search_interval)
264    {
265      found_interval = i;
266      icount++;
267    }
268}
269
270INTERVAL
271search_for_interval (i, tree)
272     register INTERVAL i, tree;
273{
274  icount = 0;
275  search_interval = i;
276  found_interval = NULL_INTERVAL;
277  traverse_intervals_noorder (tree, &check_for_interval, Qnil);
278  return found_interval;
279}
280
281static void
282inc_interval_count (i)
283     INTERVAL i;
284{
285  icount++;
286  if (LENGTH (i) == 0)
287    zero_length++;
288  if (depth > idepth)
289    idepth = depth;
290}
291
292int
293count_intervals (i)
294     register INTERVAL i;
295{
296  icount = 0;
297  idepth = 0;
298  zero_length = 0;
299  traverse_intervals_noorder (i, &inc_interval_count, Qnil);
300
301  return icount;
302}
303
304static INTERVAL
305root_interval (interval)
306     INTERVAL interval;
307{
308  register INTERVAL i = interval;
309
310  while (! ROOT_INTERVAL_P (i))
311    i = INTERVAL_PARENT (i);
312
313  return i;
314}
315#endif
316
317/* Assuming that a left child exists, perform the following operation:
318
319     A		  B
320    / \		 / \
321   B       =>       A
322  / \		   / \
323     c		  c
324*/
325
326static INLINE INTERVAL
327rotate_right (interval)
328     INTERVAL interval;
329{
330  INTERVAL i;
331  INTERVAL B = interval->left;
332  int old_total = interval->total_length;
333
334  /* Deal with any Parent of A;  make it point to B.  */
335  if (! ROOT_INTERVAL_P (interval))
336    {
337      if (AM_LEFT_CHILD (interval))
338	INTERVAL_PARENT (interval)->left = B;
339      else
340	INTERVAL_PARENT (interval)->right = B;
341    }
342  COPY_INTERVAL_PARENT (B, interval);
343
344  /* Make B the parent of A */
345  i = B->right;
346  B->right = interval;
347  SET_INTERVAL_PARENT (interval, B);
348
349  /* Make A point to c */
350  interval->left = i;
351  if (! NULL_INTERVAL_P (i))
352    SET_INTERVAL_PARENT (i, interval);
353
354  /* A's total length is decreased by the length of B and its left child.  */
355  interval->total_length -= B->total_length - LEFT_TOTAL_LENGTH (interval);
356  CHECK_TOTAL_LENGTH (interval);
357
358  /* B must have the same total length of A.  */
359  B->total_length = old_total;
360  CHECK_TOTAL_LENGTH (B);
361
362  return B;
363}
364
365/* Assuming that a right child exists, perform the following operation:
366
367    A               B
368   / \	           / \
369      B	   =>     A
370     / \         / \
371    c               c
372*/
373
374static INLINE INTERVAL
375rotate_left (interval)
376     INTERVAL interval;
377{
378  INTERVAL i;
379  INTERVAL B = interval->right;
380  int old_total = interval->total_length;
381
382  /* Deal with any parent of A;  make it point to B.  */
383  if (! ROOT_INTERVAL_P (interval))
384    {
385      if (AM_LEFT_CHILD (interval))
386	INTERVAL_PARENT (interval)->left = B;
387      else
388	INTERVAL_PARENT (interval)->right = B;
389    }
390  COPY_INTERVAL_PARENT (B, interval);
391
392  /* Make B the parent of A */
393  i = B->left;
394  B->left = interval;
395  SET_INTERVAL_PARENT (interval, B);
396
397  /* Make A point to c */
398  interval->right = i;
399  if (! NULL_INTERVAL_P (i))
400    SET_INTERVAL_PARENT (i, interval);
401
402  /* A's total length is decreased by the length of B and its right child.  */
403  interval->total_length -= B->total_length - RIGHT_TOTAL_LENGTH (interval);
404  CHECK_TOTAL_LENGTH (interval);
405
406  /* B must have the same total length of A.  */
407  B->total_length = old_total;
408  CHECK_TOTAL_LENGTH (B);
409
410  return B;
411}
412
413/* Balance an interval tree with the assumption that the subtrees
414   themselves are already balanced.  */
415
416static INTERVAL
417balance_an_interval (i)
418     INTERVAL i;
419{
420  register int old_diff, new_diff;
421
422  while (1)
423    {
424      old_diff = LEFT_TOTAL_LENGTH (i) - RIGHT_TOTAL_LENGTH (i);
425      if (old_diff > 0)
426	{
427	  /* Since the left child is longer, there must be one.  */
428	  new_diff = i->total_length - i->left->total_length
429	    + RIGHT_TOTAL_LENGTH (i->left) - LEFT_TOTAL_LENGTH (i->left);
430	  if (abs (new_diff) >= old_diff)
431	    break;
432	  i = rotate_right (i);
433	  balance_an_interval (i->right);
434	}
435      else if (old_diff < 0)
436	{
437	  /* Since the right child is longer, there must be one.  */
438	  new_diff = i->total_length - i->right->total_length
439	    + LEFT_TOTAL_LENGTH (i->right) - RIGHT_TOTAL_LENGTH (i->right);
440	  if (abs (new_diff) >= -old_diff)
441	    break;
442	  i = rotate_left (i);
443	  balance_an_interval (i->left);
444	}
445      else
446	break;
447    }
448  return i;
449}
450
451/* Balance INTERVAL, potentially stuffing it back into its parent
452   Lisp Object.  */
453
454static INLINE INTERVAL
455balance_possible_root_interval (interval)
456     register INTERVAL interval;
457{
458  Lisp_Object parent;
459  int have_parent = 0;
460
461  if (!INTERVAL_HAS_OBJECT (interval) && !INTERVAL_HAS_PARENT (interval))
462    return interval;
463
464  if (INTERVAL_HAS_OBJECT (interval))
465    {
466      have_parent = 1;
467      GET_INTERVAL_OBJECT (parent, interval);
468    }
469  interval = balance_an_interval (interval);
470
471  if (have_parent)
472    {
473      if (BUFFERP (parent))
474	BUF_INTERVALS (XBUFFER (parent)) = interval;
475      else if (STRINGP (parent))
476	STRING_SET_INTERVALS (parent, interval);
477    }
478
479  return interval;
480}
481
482/* Balance the interval tree TREE.  Balancing is by weight
483   (the amount of text).  */
484
485static INTERVAL
486balance_intervals_internal (tree)
487     register INTERVAL tree;
488{
489  /* Balance within each side.  */
490  if (tree->left)
491    balance_intervals_internal (tree->left);
492  if (tree->right)
493    balance_intervals_internal (tree->right);
494  return balance_an_interval (tree);
495}
496
497/* Advertised interface to balance intervals.  */
498
499INTERVAL
500balance_intervals (tree)
501     INTERVAL tree;
502{
503  if (tree == NULL_INTERVAL)
504    return NULL_INTERVAL;
505
506  return balance_intervals_internal (tree);
507}
508
509/* Split INTERVAL into two pieces, starting the second piece at
510   character position OFFSET (counting from 0), relative to INTERVAL.
511   INTERVAL becomes the left-hand piece, and the right-hand piece
512   (second, lexicographically) is returned.
513
514   The size and position fields of the two intervals are set based upon
515   those of the original interval.  The property list of the new interval
516   is reset, thus it is up to the caller to do the right thing with the
517   result.
518
519   Note that this does not change the position of INTERVAL;  if it is a root,
520   it is still a root after this operation.  */
521
522INTERVAL
523split_interval_right (interval, offset)
524     INTERVAL interval;
525     int offset;
526{
527  INTERVAL new = make_interval ();
528  int position = interval->position;
529  int new_length = LENGTH (interval) - offset;
530
531  new->position = position + offset;
532  SET_INTERVAL_PARENT (new, interval);
533
534  if (NULL_RIGHT_CHILD (interval))
535    {
536      interval->right = new;
537      new->total_length = new_length;
538      CHECK_TOTAL_LENGTH (new);
539    }
540  else
541    {
542      /* Insert the new node between INTERVAL and its right child.  */
543      new->right = interval->right;
544      SET_INTERVAL_PARENT (interval->right, new);
545      interval->right = new;
546      new->total_length = new_length + new->right->total_length;
547      CHECK_TOTAL_LENGTH (new);
548      balance_an_interval (new);
549    }
550
551  balance_possible_root_interval (interval);
552
553  return new;
554}
555
556/* Split INTERVAL into two pieces, starting the second piece at
557   character position OFFSET (counting from 0), relative to INTERVAL.
558   INTERVAL becomes the right-hand piece, and the left-hand piece
559   (first, lexicographically) is returned.
560
561   The size and position fields of the two intervals are set based upon
562   those of the original interval.  The property list of the new interval
563   is reset, thus it is up to the caller to do the right thing with the
564   result.
565
566   Note that this does not change the position of INTERVAL;  if it is a root,
567   it is still a root after this operation.  */
568
569INTERVAL
570split_interval_left (interval, offset)
571     INTERVAL interval;
572     int offset;
573{
574  INTERVAL new = make_interval ();
575  int new_length = offset;
576
577  new->position = interval->position;
578  interval->position = interval->position + offset;
579  SET_INTERVAL_PARENT (new, interval);
580
581  if (NULL_LEFT_CHILD (interval))
582    {
583      interval->left = new;
584      new->total_length = new_length;
585      CHECK_TOTAL_LENGTH (new);
586    }
587  else
588    {
589      /* Insert the new node between INTERVAL and its left child.  */
590      new->left = interval->left;
591      SET_INTERVAL_PARENT (new->left, new);
592      interval->left = new;
593      new->total_length = new_length + new->left->total_length;
594      CHECK_TOTAL_LENGTH (new);
595      balance_an_interval (new);
596    }
597
598  balance_possible_root_interval (interval);
599
600  return new;
601}
602
603/* Return the proper position for the first character
604   described by the interval tree SOURCE.
605   This is 1 if the parent is a buffer,
606   0 if the parent is a string or if there is no parent.
607
608   Don't use this function on an interval which is the child
609   of another interval!  */
610
611int
612interval_start_pos (source)
613     INTERVAL source;
614{
615  Lisp_Object parent;
616
617  if (NULL_INTERVAL_P (source))
618    return 0;
619
620  if (! INTERVAL_HAS_OBJECT (source))
621    return 0;
622  GET_INTERVAL_OBJECT (parent, source);
623  if (BUFFERP (parent))
624    return BUF_BEG (XBUFFER (parent));
625  return 0;
626}
627
628/* Find the interval containing text position POSITION in the text
629   represented by the interval tree TREE.  POSITION is a buffer
630   position (starting from 1) or a string index (starting from 0).
631   If POSITION is at the end of the buffer or string,
632   return the interval containing the last character.
633
634   The `position' field, which is a cache of an interval's position,
635   is updated in the interval found.  Other functions (e.g., next_interval)
636   will update this cache based on the result of find_interval.  */
637
638INTERVAL
639find_interval (tree, position)
640     register INTERVAL tree;
641     register int position;
642{
643  /* The distance from the left edge of the subtree at TREE
644                    to POSITION.  */
645  register int relative_position;
646
647  if (NULL_INTERVAL_P (tree))
648    return NULL_INTERVAL;
649
650  relative_position = position;
651  if (INTERVAL_HAS_OBJECT (tree))
652    {
653      Lisp_Object parent;
654      GET_INTERVAL_OBJECT (parent, tree);
655      if (BUFFERP (parent))
656	relative_position -= BUF_BEG (XBUFFER (parent));
657    }
658
659  if (relative_position > TOTAL_LENGTH (tree))
660    abort ();			/* Paranoia */
661
662  if (!handling_signal)
663    tree = balance_possible_root_interval (tree);
664
665  while (1)
666    {
667      if (relative_position < LEFT_TOTAL_LENGTH (tree))
668	{
669	  tree = tree->left;
670	}
671      else if (! NULL_RIGHT_CHILD (tree)
672	       && relative_position >= (TOTAL_LENGTH (tree)
673					- RIGHT_TOTAL_LENGTH (tree)))
674	{
675	  relative_position -= (TOTAL_LENGTH (tree)
676				- RIGHT_TOTAL_LENGTH (tree));
677	  tree = tree->right;
678	}
679      else
680	{
681	  tree->position
682	    = (position - relative_position /* left edge of *tree.  */
683	       + LEFT_TOTAL_LENGTH (tree)); /* left edge of this interval.  */
684
685	  return tree;
686	}
687    }
688}
689
690/* Find the succeeding interval (lexicographically) to INTERVAL.
691   Sets the `position' field based on that of INTERVAL (see
692   find_interval).  */
693
694INTERVAL
695next_interval (interval)
696     register INTERVAL interval;
697{
698  register INTERVAL i = interval;
699  register int next_position;
700
701  if (NULL_INTERVAL_P (i))
702    return NULL_INTERVAL;
703  next_position = interval->position + LENGTH (interval);
704
705  if (! NULL_RIGHT_CHILD (i))
706    {
707      i = i->right;
708      while (! NULL_LEFT_CHILD (i))
709	i = i->left;
710
711      i->position = next_position;
712      return i;
713    }
714
715  while (! NULL_PARENT (i))
716    {
717      if (AM_LEFT_CHILD (i))
718	{
719	  i = INTERVAL_PARENT (i);
720	  i->position = next_position;
721	  return i;
722	}
723
724      i = INTERVAL_PARENT (i);
725    }
726
727  return NULL_INTERVAL;
728}
729
730/* Find the preceding interval (lexicographically) to INTERVAL.
731   Sets the `position' field based on that of INTERVAL (see
732   find_interval).  */
733
734INTERVAL
735previous_interval (interval)
736     register INTERVAL interval;
737{
738  register INTERVAL i;
739
740  if (NULL_INTERVAL_P (interval))
741    return NULL_INTERVAL;
742
743  if (! NULL_LEFT_CHILD (interval))
744    {
745      i = interval->left;
746      while (! NULL_RIGHT_CHILD (i))
747	i = i->right;
748
749      i->position = interval->position - LENGTH (i);
750      return i;
751    }
752
753  i = interval;
754  while (! NULL_PARENT (i))
755    {
756      if (AM_RIGHT_CHILD (i))
757	{
758	  i = INTERVAL_PARENT (i);
759
760	  i->position = interval->position - LENGTH (i);
761	  return i;
762	}
763      i = INTERVAL_PARENT (i);
764    }
765
766  return NULL_INTERVAL;
767}
768
769/* Find the interval containing POS given some non-NULL INTERVAL
770   in the same tree.  Note that we need to update interval->position
771   if we go down the tree.
772   To speed up the process, we assume that the ->position of
773   I and all its parents is already uptodate.  */
774INTERVAL
775update_interval (i, pos)
776     register INTERVAL i;
777     int pos;
778{
779  if (NULL_INTERVAL_P (i))
780    return NULL_INTERVAL;
781
782  while (1)
783    {
784      if (pos < i->position)
785	{
786	  /* Move left. */
787	  if (pos >= i->position - TOTAL_LENGTH (i->left))
788	    {
789	      i->left->position = i->position - TOTAL_LENGTH (i->left)
790		+ LEFT_TOTAL_LENGTH (i->left);
791	      i = i->left;		/* Move to the left child */
792	    }
793	  else if (NULL_PARENT (i))
794	    error ("Point before start of properties");
795	  else
796	      i = INTERVAL_PARENT (i);
797	  continue;
798	}
799      else if (pos >= INTERVAL_LAST_POS (i))
800	{
801	  /* Move right. */
802	  if (pos < INTERVAL_LAST_POS (i) + TOTAL_LENGTH (i->right))
803	    {
804	      i->right->position = INTERVAL_LAST_POS (i)
805	        + LEFT_TOTAL_LENGTH (i->right);
806	      i = i->right;		/* Move to the right child */
807	    }
808	  else if (NULL_PARENT (i))
809	    error ("Point %d after end of properties", pos);
810	  else
811            i = INTERVAL_PARENT (i);
812	  continue;
813	}
814      else
815	return i;
816    }
817}
818
819
820#if 0
821/* Traverse a path down the interval tree TREE to the interval
822   containing POSITION, adjusting all nodes on the path for
823   an addition of LENGTH characters.  Insertion between two intervals
824   (i.e., point == i->position, where i is second interval) means
825   text goes into second interval.
826
827   Modifications are needed to handle the hungry bits -- after simply
828   finding the interval at position (don't add length going down),
829   if it's the beginning of the interval, get the previous interval
830   and check the hungry bits of both.  Then add the length going back up
831   to the root.  */
832
833static INTERVAL
834adjust_intervals_for_insertion (tree, position, length)
835     INTERVAL tree;
836     int position, length;
837{
838  register int relative_position;
839  register INTERVAL this;
840
841  if (TOTAL_LENGTH (tree) == 0)	/* Paranoia */
842    abort ();
843
844  /* If inserting at point-max of a buffer, that position
845     will be out of range */
846  if (position > TOTAL_LENGTH (tree))
847    position = TOTAL_LENGTH (tree);
848  relative_position = position;
849  this = tree;
850
851  while (1)
852    {
853      if (relative_position <= LEFT_TOTAL_LENGTH (this))
854	{
855	  this->total_length += length;
856	  CHECK_TOTAL_LENGTH (this);
857	  this = this->left;
858	}
859      else if (relative_position > (TOTAL_LENGTH (this)
860				    - RIGHT_TOTAL_LENGTH (this)))
861	{
862	  relative_position -= (TOTAL_LENGTH (this)
863				- RIGHT_TOTAL_LENGTH (this));
864	  this->total_length += length;
865	  CHECK_TOTAL_LENGTH (this);
866	  this = this->right;
867	}
868      else
869	{
870	  /* If we are to use zero-length intervals as buffer pointers,
871	     then this code will have to change.  */
872	  this->total_length += length;
873	  CHECK_TOTAL_LENGTH (this);
874	  this->position = LEFT_TOTAL_LENGTH (this)
875	                   + position - relative_position + 1;
876	  return tree;
877	}
878    }
879}
880#endif
881
882/* Effect an adjustment corresponding to the addition of LENGTH characters
883   of text.  Do this by finding the interval containing POSITION in the
884   interval tree TREE, and then adjusting all of its ancestors by adding
885   LENGTH to them.
886
887   If POSITION is the first character of an interval, meaning that point
888   is actually between the two intervals, make the new text belong to
889   the interval which is "sticky".
890
891   If both intervals are "sticky", then make them belong to the left-most
892   interval.  Another possibility would be to create a new interval for
893   this text, and make it have the merged properties of both ends.  */
894
895static INTERVAL
896adjust_intervals_for_insertion (tree, position, length)
897     INTERVAL tree;
898     int position, length;
899{
900  register INTERVAL i;
901  register INTERVAL temp;
902  int eobp = 0;
903  Lisp_Object parent;
904  int offset;
905
906  if (TOTAL_LENGTH (tree) == 0)	/* Paranoia */
907    abort ();
908
909  GET_INTERVAL_OBJECT (parent, tree);
910  offset = (BUFFERP (parent) ? BUF_BEG (XBUFFER (parent)) : 0);
911
912  /* If inserting at point-max of a buffer, that position will be out
913     of range.  Remember that buffer positions are 1-based.  */
914  if (position >= TOTAL_LENGTH (tree) + offset)
915    {
916      position = TOTAL_LENGTH (tree) + offset;
917      eobp = 1;
918    }
919
920  i = find_interval (tree, position);
921
922  /* If in middle of an interval which is not sticky either way,
923     we must not just give its properties to the insertion.
924     So split this interval at the insertion point.
925
926     Originally, the if condition here was this:
927	(! (position == i->position || eobp)
928	 && END_NONSTICKY_P (i)
929	 && FRONT_NONSTICKY_P (i))
930     But, these macros are now unreliable because of introduction of
931     Vtext_property_default_nonsticky.  So, we always check properties
932     one by one if POSITION is in middle of an interval.  */
933  if (! (position == i->position || eobp))
934    {
935      Lisp_Object tail;
936      Lisp_Object front, rear;
937
938      tail = i->plist;
939
940      /* Properties font-sticky and rear-nonsticky override
941         Vtext_property_default_nonsticky.  So, if they are t, we can
942         skip one by one checking of properties.  */
943      rear = textget (i->plist, Qrear_nonsticky);
944      if (! CONSP (rear) && ! NILP (rear))
945	{
946	  /* All properties are nonsticky.  We split the interval.  */
947	  goto check_done;
948	}
949      front = textget (i->plist, Qfront_sticky);
950      if (! CONSP (front) && ! NILP (front))
951	{
952	  /* All properties are sticky.  We don't split the interval.  */
953	  tail = Qnil;
954	  goto check_done;
955	}
956
957      /* Does any actual property pose an actual problem?  We break
958         the loop if we find a nonsticky property.  */
959      for (; CONSP (tail); tail = Fcdr (XCDR (tail)))
960	{
961	  Lisp_Object prop, tmp;
962	  prop = XCAR (tail);
963
964	  /* Is this particular property front-sticky?  */
965	  if (CONSP (front) && ! NILP (Fmemq (prop, front)))
966	    continue;
967
968	  /* Is this particular property rear-nonsticky?  */
969	  if (CONSP (rear) && ! NILP (Fmemq (prop, rear)))
970	    break;
971
972	  /* Is this particular property recorded as sticky or
973             nonsticky in Vtext_property_default_nonsticky?  */
974	  tmp = Fassq (prop, Vtext_property_default_nonsticky);
975	  if (CONSP (tmp))
976	    {
977	      if (NILP (tmp))
978		continue;
979	      break;
980	    }
981
982	  /* By default, a text property is rear-sticky, thus we
983	     continue the loop.  */
984	}
985
986    check_done:
987      /* If any property is a real problem, split the interval.  */
988      if (! NILP (tail))
989	{
990	  temp = split_interval_right (i, position - i->position);
991	  copy_properties (i, temp);
992	  i = temp;
993	}
994    }
995
996  /* If we are positioned between intervals, check the stickiness of
997     both of them.  We have to do this too, if we are at BEG or Z.  */
998  if (position == i->position || eobp)
999    {
1000      register INTERVAL prev;
1001
1002      if (position == BEG)
1003	prev = 0;
1004      else if (eobp)
1005	{
1006	  prev = i;
1007	  i = 0;
1008	}
1009      else
1010	prev = previous_interval (i);
1011
1012      /* Even if we are positioned between intervals, we default
1013	 to the left one if it exists.  We extend it now and split
1014	 off a part later, if stickiness demands it.  */
1015      for (temp = prev ? prev : i; temp; temp = INTERVAL_PARENT_OR_NULL (temp))
1016	{
1017	  temp->total_length += length;
1018	  CHECK_TOTAL_LENGTH (temp);
1019	  temp = balance_possible_root_interval (temp);
1020	}
1021
1022      /* If at least one interval has sticky properties,
1023	 we check the stickiness property by property.
1024
1025	 Originally, the if condition here was this:
1026		(END_NONSTICKY_P (prev) || FRONT_STICKY_P (i))
1027	 But, these macros are now unreliable because of introduction
1028	 of Vtext_property_default_nonsticky.  So, we always have to
1029	 check stickiness of properties one by one.  If cache of
1030	 stickiness is implemented in the future, we may be able to
1031	 use those macros again.  */
1032      if (1)
1033	{
1034	  Lisp_Object pleft, pright;
1035	  struct interval newi;
1036
1037	  pleft = NULL_INTERVAL_P (prev) ? Qnil : prev->plist;
1038	  pright = NULL_INTERVAL_P (i) ? Qnil : i->plist;
1039	  newi.plist = merge_properties_sticky (pleft, pright);
1040
1041	  if (! prev) /* i.e. position == BEG */
1042	    {
1043	      if (! intervals_equal (i, &newi))
1044		{
1045		  i = split_interval_left (i, length);
1046		  i->plist = newi.plist;
1047		}
1048	    }
1049	  else if (! intervals_equal (prev, &newi))
1050	    {
1051	      prev = split_interval_right (prev,
1052					   position - prev->position);
1053	      prev->plist = newi.plist;
1054	      if (! NULL_INTERVAL_P (i)
1055		  && intervals_equal (prev, i))
1056		merge_interval_right (prev);
1057	    }
1058
1059	  /* We will need to update the cache here later.  */
1060	}
1061      else if (! prev && ! NILP (i->plist))
1062        {
1063	  /* Just split off a new interval at the left.
1064	     Since I wasn't front-sticky, the empty plist is ok.  */
1065	  i = split_interval_left (i, length);
1066        }
1067    }
1068
1069  /* Otherwise just extend the interval.  */
1070  else
1071    {
1072      for (temp = i; temp; temp = INTERVAL_PARENT_OR_NULL (temp))
1073	{
1074	  temp->total_length += length;
1075	  CHECK_TOTAL_LENGTH (temp);
1076	  temp = balance_possible_root_interval (temp);
1077	}
1078    }
1079
1080  return tree;
1081}
1082
1083/* Any property might be front-sticky on the left, rear-sticky on the left,
1084   front-sticky on the right, or rear-sticky on the right; the 16 combinations
1085   can be arranged in a matrix with rows denoting the left conditions and
1086   columns denoting the right conditions:
1087      _  __  _
1088_     FR FR FR FR
1089FR__   0  1  2  3
1090 _FR   4  5  6  7
1091FR     8  9  A  B
1092  FR   C  D  E  F
1093
1094   left-props  = '(front-sticky (p8 p9 pa pb pc pd pe pf)
1095		   rear-nonsticky (p4 p5 p6 p7 p8 p9 pa pb)
1096		   p0 L p1 L p2 L p3 L p4 L p5 L p6 L p7 L
1097		   p8 L p9 L pa L pb L pc L pd L pe L pf L)
1098   right-props = '(front-sticky (p2 p3 p6 p7 pa pb pe pf)
1099		   rear-nonsticky (p1 p2 p5 p6 p9 pa pd pe)
1100		   p0 R p1 R p2 R p3 R p4 R p5 R p6 R p7 R
1101		   p8 R p9 R pa R pb R pc R pd R pe R pf R)
1102
1103   We inherit from whoever has a sticky side facing us.  If both sides
1104   do (cases 2, 3, E, and F), then we inherit from whichever side has a
1105   non-nil value for the current property.  If both sides do, then we take
1106   from the left.
1107
1108   When we inherit a property, we get its stickiness as well as its value.
1109   So, when we merge the above two lists, we expect to get this:
1110
1111   result      = '(front-sticky (p6 p7 pa pb pc pd pe pf)
1112		   rear-nonsticky (p6 pa)
1113		   p0 L p1 L p2 L p3 L p6 R p7 R
1114		   pa R pb R pc L pd L pe L pf L)
1115
1116   The optimizable special cases are:
1117       left rear-nonsticky = nil, right front-sticky = nil (inherit left)
1118       left rear-nonsticky = t,   right front-sticky = t   (inherit right)
1119       left rear-nonsticky = t,   right front-sticky = nil (inherit none)
1120*/
1121
1122Lisp_Object
1123merge_properties_sticky (pleft, pright)
1124     Lisp_Object pleft, pright;
1125{
1126  register Lisp_Object props, front, rear;
1127  Lisp_Object lfront, lrear, rfront, rrear;
1128  register Lisp_Object tail1, tail2, sym, lval, rval, cat;
1129  int use_left, use_right;
1130  int lpresent;
1131
1132  props = Qnil;
1133  front = Qnil;
1134  rear  = Qnil;
1135  lfront = textget (pleft, Qfront_sticky);
1136  lrear  = textget (pleft, Qrear_nonsticky);
1137  rfront = textget (pright, Qfront_sticky);
1138  rrear  = textget (pright, Qrear_nonsticky);
1139
1140  /* Go through each element of PRIGHT.  */
1141  for (tail1 = pright; CONSP (tail1); tail1 = Fcdr (XCDR (tail1)))
1142    {
1143      Lisp_Object tmp;
1144
1145      sym = XCAR (tail1);
1146
1147      /* Sticky properties get special treatment.  */
1148      if (EQ (sym, Qrear_nonsticky) || EQ (sym, Qfront_sticky))
1149	continue;
1150
1151      rval = Fcar (XCDR (tail1));
1152      for (tail2 = pleft; CONSP (tail2); tail2 = Fcdr (XCDR (tail2)))
1153	if (EQ (sym, XCAR (tail2)))
1154	  break;
1155
1156      /* Indicate whether the property is explicitly defined on the left.
1157	 (We know it is defined explicitly on the right
1158	 because otherwise we don't get here.)  */
1159      lpresent = ! NILP (tail2);
1160      lval = (NILP (tail2) ? Qnil : Fcar (Fcdr (tail2)));
1161
1162      /* Even if lrear or rfront say nothing about the stickiness of
1163	 SYM, Vtext_property_default_nonsticky may give default
1164	 stickiness to SYM.  */
1165      tmp = Fassq (sym, Vtext_property_default_nonsticky);
1166      use_left = (lpresent
1167		  && ! (TMEM (sym, lrear)
1168			|| (CONSP (tmp) && ! NILP (XCDR (tmp)))));
1169      use_right = (TMEM (sym, rfront)
1170		   || (CONSP (tmp) && NILP (XCDR (tmp))));
1171      if (use_left && use_right)
1172	{
1173	  if (NILP (lval))
1174	    use_left = 0;
1175	  else if (NILP (rval))
1176	    use_right = 0;
1177	}
1178      if (use_left)
1179	{
1180	  /* We build props as (value sym ...) rather than (sym value ...)
1181	     because we plan to nreverse it when we're done.  */
1182	  props = Fcons (lval, Fcons (sym, props));
1183	  if (TMEM (sym, lfront))
1184	    front = Fcons (sym, front);
1185	  if (TMEM (sym, lrear))
1186	    rear = Fcons (sym, rear);
1187	}
1188      else if (use_right)
1189	{
1190	  props = Fcons (rval, Fcons (sym, props));
1191	  if (TMEM (sym, rfront))
1192	    front = Fcons (sym, front);
1193	  if (TMEM (sym, rrear))
1194	    rear = Fcons (sym, rear);
1195	}
1196    }
1197
1198  /* Now go through each element of PLEFT.  */
1199  for (tail2 = pleft; CONSP (tail2); tail2 = Fcdr (XCDR (tail2)))
1200    {
1201      Lisp_Object tmp;
1202
1203      sym = XCAR (tail2);
1204
1205      /* Sticky properties get special treatment.  */
1206      if (EQ (sym, Qrear_nonsticky) || EQ (sym, Qfront_sticky))
1207	continue;
1208
1209      /* If sym is in PRIGHT, we've already considered it.  */
1210      for (tail1 = pright; CONSP (tail1); tail1 = Fcdr (XCDR (tail1)))
1211	if (EQ (sym, XCAR (tail1)))
1212	  break;
1213      if (! NILP (tail1))
1214	continue;
1215
1216      lval = Fcar (XCDR (tail2));
1217
1218      /* Even if lrear or rfront say nothing about the stickiness of
1219	 SYM, Vtext_property_default_nonsticky may give default
1220	 stickiness to SYM.  */
1221      tmp = Fassq (sym, Vtext_property_default_nonsticky);
1222
1223      /* Since rval is known to be nil in this loop, the test simplifies.  */
1224      if (! (TMEM (sym, lrear) || (CONSP (tmp) && ! NILP (XCDR (tmp)))))
1225	{
1226	  props = Fcons (lval, Fcons (sym, props));
1227	  if (TMEM (sym, lfront))
1228	    front = Fcons (sym, front);
1229	}
1230      else if (TMEM (sym, rfront) || (CONSP (tmp) && NILP (XCDR (tmp))))
1231	{
1232	  /* The value is nil, but we still inherit the stickiness
1233	     from the right.  */
1234	  front = Fcons (sym, front);
1235	  if (TMEM (sym, rrear))
1236	    rear = Fcons (sym, rear);
1237	}
1238    }
1239  props = Fnreverse (props);
1240  if (! NILP (rear))
1241    props = Fcons (Qrear_nonsticky, Fcons (Fnreverse (rear), props));
1242
1243  cat = textget (props, Qcategory);
1244  if (! NILP (front)
1245      &&
1246      /* If we have inherited a front-stick category property that is t,
1247	 we don't need to set up a detailed one.  */
1248      ! (! NILP (cat) && SYMBOLP (cat)
1249	 && EQ (Fget (cat, Qfront_sticky), Qt)))
1250    props = Fcons (Qfront_sticky, Fcons (Fnreverse (front), props));
1251  return props;
1252}
1253
1254
1255/* Delete a node I from its interval tree by merging its subtrees
1256   into one subtree which is then returned.  Caller is responsible for
1257   storing the resulting subtree into its parent.  */
1258
1259static INTERVAL
1260delete_node (i)
1261     register INTERVAL i;
1262{
1263  register INTERVAL migrate, this;
1264  register int migrate_amt;
1265
1266  if (NULL_INTERVAL_P (i->left))
1267    return i->right;
1268  if (NULL_INTERVAL_P (i->right))
1269    return i->left;
1270
1271  migrate = i->left;
1272  migrate_amt = i->left->total_length;
1273  this = i->right;
1274  this->total_length += migrate_amt;
1275  while (! NULL_INTERVAL_P (this->left))
1276    {
1277      this = this->left;
1278      this->total_length += migrate_amt;
1279    }
1280  CHECK_TOTAL_LENGTH (this);
1281  this->left = migrate;
1282  SET_INTERVAL_PARENT (migrate, this);
1283
1284  return i->right;
1285}
1286
1287/* Delete interval I from its tree by calling `delete_node'
1288   and properly connecting the resultant subtree.
1289
1290   I is presumed to be empty; that is, no adjustments are made
1291   for the length of I.  */
1292
1293void
1294delete_interval (i)
1295     register INTERVAL i;
1296{
1297  register INTERVAL parent;
1298  int amt = LENGTH (i);
1299
1300  if (amt > 0)			/* Only used on zero-length intervals now.  */
1301    abort ();
1302
1303  if (ROOT_INTERVAL_P (i))
1304    {
1305      Lisp_Object owner;
1306      GET_INTERVAL_OBJECT (owner, i);
1307      parent = delete_node (i);
1308      if (! NULL_INTERVAL_P (parent))
1309	SET_INTERVAL_OBJECT (parent, owner);
1310
1311      if (BUFFERP (owner))
1312	BUF_INTERVALS (XBUFFER (owner)) = parent;
1313      else if (STRINGP (owner))
1314	STRING_SET_INTERVALS (owner, parent);
1315      else
1316	abort ();
1317
1318      return;
1319    }
1320
1321  parent = INTERVAL_PARENT (i);
1322  if (AM_LEFT_CHILD (i))
1323    {
1324      parent->left = delete_node (i);
1325      if (! NULL_INTERVAL_P (parent->left))
1326	SET_INTERVAL_PARENT (parent->left, parent);
1327    }
1328  else
1329    {
1330      parent->right = delete_node (i);
1331      if (! NULL_INTERVAL_P (parent->right))
1332	SET_INTERVAL_PARENT (parent->right, parent);
1333    }
1334}
1335
1336/* Find the interval in TREE corresponding to the relative position
1337   FROM and delete as much as possible of AMOUNT from that interval.
1338   Return the amount actually deleted, and if the interval was
1339   zeroed-out, delete that interval node from the tree.
1340
1341   Note that FROM is actually origin zero, aka relative to the
1342   leftmost edge of tree.  This is appropriate since we call ourselves
1343   recursively on subtrees.
1344
1345   Do this by recursing down TREE to the interval in question, and
1346   deleting the appropriate amount of text.  */
1347
1348static int
1349interval_deletion_adjustment (tree, from, amount)
1350     register INTERVAL tree;
1351     register int from, amount;
1352{
1353  register int relative_position = from;
1354
1355  if (NULL_INTERVAL_P (tree))
1356    return 0;
1357
1358  /* Left branch */
1359  if (relative_position < LEFT_TOTAL_LENGTH (tree))
1360    {
1361      int subtract = interval_deletion_adjustment (tree->left,
1362						   relative_position,
1363						   amount);
1364      tree->total_length -= subtract;
1365      CHECK_TOTAL_LENGTH (tree);
1366      return subtract;
1367    }
1368  /* Right branch */
1369  else if (relative_position >= (TOTAL_LENGTH (tree)
1370				 - RIGHT_TOTAL_LENGTH (tree)))
1371    {
1372      int subtract;
1373
1374      relative_position -= (tree->total_length
1375			    - RIGHT_TOTAL_LENGTH (tree));
1376      subtract = interval_deletion_adjustment (tree->right,
1377					       relative_position,
1378					       amount);
1379      tree->total_length -= subtract;
1380      CHECK_TOTAL_LENGTH (tree);
1381      return subtract;
1382    }
1383  /* Here -- this node.  */
1384  else
1385    {
1386      /* How much can we delete from this interval?  */
1387      int my_amount = ((tree->total_length
1388			- RIGHT_TOTAL_LENGTH (tree))
1389		       - relative_position);
1390
1391      if (amount > my_amount)
1392	amount = my_amount;
1393
1394      tree->total_length -= amount;
1395      CHECK_TOTAL_LENGTH (tree);
1396      if (LENGTH (tree) == 0)
1397	delete_interval (tree);
1398
1399      return amount;
1400    }
1401
1402  /* Never reach here.  */
1403}
1404
1405/* Effect the adjustments necessary to the interval tree of BUFFER to
1406   correspond to the deletion of LENGTH characters from that buffer
1407   text.  The deletion is effected at position START (which is a
1408   buffer position, i.e. origin 1).  */
1409
1410static void
1411adjust_intervals_for_deletion (buffer, start, length)
1412     struct buffer *buffer;
1413     int start, length;
1414{
1415  register int left_to_delete = length;
1416  register INTERVAL tree = BUF_INTERVALS (buffer);
1417  Lisp_Object parent;
1418  int offset;
1419
1420  GET_INTERVAL_OBJECT (parent, tree);
1421  offset = (BUFFERP (parent) ? BUF_BEG (XBUFFER (parent)) : 0);
1422
1423  if (NULL_INTERVAL_P (tree))
1424    return;
1425
1426  if (start > offset + TOTAL_LENGTH (tree)
1427      || start + length > offset + TOTAL_LENGTH (tree))
1428    abort ();
1429
1430  if (length == TOTAL_LENGTH (tree))
1431    {
1432      BUF_INTERVALS (buffer) = NULL_INTERVAL;
1433      return;
1434    }
1435
1436  if (ONLY_INTERVAL_P (tree))
1437    {
1438      tree->total_length -= length;
1439      CHECK_TOTAL_LENGTH (tree);
1440      return;
1441    }
1442
1443  if (start > offset + TOTAL_LENGTH (tree))
1444    start = offset + TOTAL_LENGTH (tree);
1445  while (left_to_delete > 0)
1446    {
1447      left_to_delete -= interval_deletion_adjustment (tree, start - offset,
1448						      left_to_delete);
1449      tree = BUF_INTERVALS (buffer);
1450      if (left_to_delete == tree->total_length)
1451	{
1452	  BUF_INTERVALS (buffer) = NULL_INTERVAL;
1453	  return;
1454	}
1455    }
1456}
1457
1458/* Make the adjustments necessary to the interval tree of BUFFER to
1459   represent an addition or deletion of LENGTH characters starting
1460   at position START.  Addition or deletion is indicated by the sign
1461   of LENGTH.  */
1462
1463INLINE void
1464offset_intervals (buffer, start, length)
1465     struct buffer *buffer;
1466     int start, length;
1467{
1468  if (NULL_INTERVAL_P (BUF_INTERVALS (buffer)) || length == 0)
1469    return;
1470
1471  if (length > 0)
1472    adjust_intervals_for_insertion (BUF_INTERVALS (buffer), start, length);
1473  else
1474    adjust_intervals_for_deletion (buffer, start, -length);
1475}
1476
1477/* Merge interval I with its lexicographic successor. The resulting
1478   interval is returned, and has the properties of the original
1479   successor.  The properties of I are lost.  I is removed from the
1480   interval tree.
1481
1482   IMPORTANT:
1483   The caller must verify that this is not the last (rightmost)
1484   interval.  */
1485
1486INTERVAL
1487merge_interval_right (i)
1488     register INTERVAL i;
1489{
1490  register int absorb = LENGTH (i);
1491  register INTERVAL successor;
1492
1493  /* Zero out this interval.  */
1494  i->total_length -= absorb;
1495  CHECK_TOTAL_LENGTH (i);
1496
1497  /* Find the succeeding interval.  */
1498  if (! NULL_RIGHT_CHILD (i))      /* It's below us.  Add absorb
1499				      as we descend.  */
1500    {
1501      successor = i->right;
1502      while (! NULL_LEFT_CHILD (successor))
1503	{
1504	  successor->total_length += absorb;
1505	  CHECK_TOTAL_LENGTH (successor);
1506	  successor = successor->left;
1507	}
1508
1509      successor->total_length += absorb;
1510      CHECK_TOTAL_LENGTH (successor);
1511      delete_interval (i);
1512      return successor;
1513    }
1514
1515  successor = i;
1516  while (! NULL_PARENT (successor))	   /* It's above us.  Subtract as
1517					      we ascend.  */
1518    {
1519      if (AM_LEFT_CHILD (successor))
1520	{
1521	  successor = INTERVAL_PARENT (successor);
1522	  delete_interval (i);
1523	  return successor;
1524	}
1525
1526      successor = INTERVAL_PARENT (successor);
1527      successor->total_length -= absorb;
1528      CHECK_TOTAL_LENGTH (successor);
1529    }
1530
1531  /* This must be the rightmost or last interval and cannot
1532     be merged right.  The caller should have known.  */
1533  abort ();
1534}
1535
1536/* Merge interval I with its lexicographic predecessor. The resulting
1537   interval is returned, and has the properties of the original predecessor.
1538   The properties of I are lost.  Interval node I is removed from the tree.
1539
1540   IMPORTANT:
1541   The caller must verify that this is not the first (leftmost) interval.  */
1542
1543INTERVAL
1544merge_interval_left (i)
1545     register INTERVAL i;
1546{
1547  register int absorb = LENGTH (i);
1548  register INTERVAL predecessor;
1549
1550  /* Zero out this interval.  */
1551  i->total_length -= absorb;
1552  CHECK_TOTAL_LENGTH (i);
1553
1554  /* Find the preceding interval.  */
1555  if (! NULL_LEFT_CHILD (i))	/* It's below us. Go down,
1556				   adding ABSORB as we go.  */
1557    {
1558      predecessor = i->left;
1559      while (! NULL_RIGHT_CHILD (predecessor))
1560	{
1561	  predecessor->total_length += absorb;
1562	  CHECK_TOTAL_LENGTH (predecessor);
1563	  predecessor = predecessor->right;
1564	}
1565
1566      predecessor->total_length += absorb;
1567      CHECK_TOTAL_LENGTH (predecessor);
1568      delete_interval (i);
1569      return predecessor;
1570    }
1571
1572  predecessor = i;
1573  while (! NULL_PARENT (predecessor))	/* It's above us.  Go up,
1574				   subtracting ABSORB.  */
1575    {
1576      if (AM_RIGHT_CHILD (predecessor))
1577	{
1578	  predecessor = INTERVAL_PARENT (predecessor);
1579	  delete_interval (i);
1580	  return predecessor;
1581	}
1582
1583      predecessor = INTERVAL_PARENT (predecessor);
1584      predecessor->total_length -= absorb;
1585      CHECK_TOTAL_LENGTH (predecessor);
1586    }
1587
1588  /* This must be the leftmost or first interval and cannot
1589     be merged left.  The caller should have known.  */
1590  abort ();
1591}
1592
1593/* Make an exact copy of interval tree SOURCE which descends from
1594   PARENT.  This is done by recursing through SOURCE, copying
1595   the current interval and its properties, and then adjusting
1596   the pointers of the copy.  */
1597
1598static INTERVAL
1599reproduce_tree (source, parent)
1600     INTERVAL source, parent;
1601{
1602  register INTERVAL t = make_interval ();
1603
1604  bcopy (source, t, INTERVAL_SIZE);
1605  copy_properties (source, t);
1606  SET_INTERVAL_PARENT (t, parent);
1607  if (! NULL_LEFT_CHILD (source))
1608    t->left = reproduce_tree (source->left, t);
1609  if (! NULL_RIGHT_CHILD (source))
1610    t->right = reproduce_tree (source->right, t);
1611
1612  return t;
1613}
1614
1615static INTERVAL
1616reproduce_tree_obj (source, parent)
1617     INTERVAL source;
1618     Lisp_Object parent;
1619{
1620  register INTERVAL t = make_interval ();
1621
1622  bcopy (source, t, INTERVAL_SIZE);
1623  copy_properties (source, t);
1624  SET_INTERVAL_OBJECT (t, parent);
1625  if (! NULL_LEFT_CHILD (source))
1626    t->left = reproduce_tree (source->left, t);
1627  if (! NULL_RIGHT_CHILD (source))
1628    t->right = reproduce_tree (source->right, t);
1629
1630  return t;
1631}
1632
1633#if 0
1634/* Nobody calls this.  Perhaps it's a vestige of an earlier design.  */
1635
1636/* Make a new interval of length LENGTH starting at START in the
1637   group of intervals INTERVALS, which is actually an interval tree.
1638   Returns the new interval.
1639
1640   Generate an error if the new positions would overlap an existing
1641   interval.  */
1642
1643static INTERVAL
1644make_new_interval (intervals, start, length)
1645     INTERVAL intervals;
1646     int start, length;
1647{
1648  INTERVAL slot;
1649
1650  slot = find_interval (intervals, start);
1651  if (start + length > slot->position + LENGTH (slot))
1652    error ("Interval would overlap");
1653
1654  if (start == slot->position && length == LENGTH (slot))
1655    return slot;
1656
1657  if (slot->position == start)
1658    {
1659      /* New right node.  */
1660      split_interval_right (slot, length);
1661      return slot;
1662    }
1663
1664  if (slot->position + LENGTH (slot) == start + length)
1665    {
1666      /* New left node.  */
1667      split_interval_left (slot, LENGTH (slot) - length);
1668      return slot;
1669    }
1670
1671  /* Convert interval SLOT into three intervals.  */
1672  split_interval_left (slot, start - slot->position);
1673  split_interval_right (slot, length);
1674  return slot;
1675}
1676#endif
1677
1678/* Insert the intervals of SOURCE into BUFFER at POSITION.
1679   LENGTH is the length of the text in SOURCE.
1680
1681   The `position' field of the SOURCE intervals is assumed to be
1682   consistent with its parent; therefore, SOURCE must be an
1683   interval tree made with copy_interval or must be the whole
1684   tree of a buffer or a string.
1685
1686   This is used in insdel.c when inserting Lisp_Strings into the
1687   buffer.  The text corresponding to SOURCE is already in the buffer
1688   when this is called.  The intervals of new tree are a copy of those
1689   belonging to the string being inserted; intervals are never
1690   shared.
1691
1692   If the inserted text had no intervals associated, and we don't
1693   want to inherit the surrounding text's properties, this function
1694   simply returns -- offset_intervals should handle placing the
1695   text in the correct interval, depending on the sticky bits.
1696
1697   If the inserted text had properties (intervals), then there are two
1698   cases -- either insertion happened in the middle of some interval,
1699   or between two intervals.
1700
1701   If the text goes into the middle of an interval, then new
1702   intervals are created in the middle with only the properties of
1703   the new text, *unless* the macro MERGE_INSERTIONS is true, in
1704   which case the new text has the union of its properties and those
1705   of the text into which it was inserted.
1706
1707   If the text goes between two intervals, then if neither interval
1708   had its appropriate sticky property set (front_sticky, rear_sticky),
1709   the new text has only its properties.  If one of the sticky properties
1710   is set, then the new text "sticks" to that region and its properties
1711   depend on merging as above.  If both the preceding and succeeding
1712   intervals to the new text are "sticky", then the new text retains
1713   only its properties, as if neither sticky property were set.  Perhaps
1714   we should consider merging all three sets of properties onto the new
1715   text...  */
1716
1717void
1718graft_intervals_into_buffer (source, position, length, buffer, inherit)
1719     INTERVAL source;
1720     int position, length;
1721     struct buffer *buffer;
1722     int inherit;
1723{
1724  register INTERVAL under, over, this, prev;
1725  register INTERVAL tree;
1726  int over_used;
1727
1728  tree = BUF_INTERVALS (buffer);
1729
1730  /* If the new text has no properties, then with inheritance it
1731     becomes part of whatever interval it was inserted into.
1732     To prevent inheritance, we must clear out the properties
1733     of the newly inserted text.  */
1734  if (NULL_INTERVAL_P (source))
1735    {
1736      Lisp_Object buf;
1737      if (!inherit && !NULL_INTERVAL_P (tree) && length > 0)
1738	{
1739	  XSETBUFFER (buf, buffer);
1740	  set_text_properties_1 (make_number (position),
1741				 make_number (position + length),
1742				 Qnil, buf, 0);
1743	}
1744      if (! NULL_INTERVAL_P (BUF_INTERVALS (buffer)))
1745	/* Shouldn't be necessary.  -stef  */
1746	BUF_INTERVALS (buffer) = balance_an_interval (BUF_INTERVALS (buffer));
1747      return;
1748    }
1749
1750  if (NULL_INTERVAL_P (tree))
1751    {
1752      /* The inserted text constitutes the whole buffer, so
1753	 simply copy over the interval structure.  */
1754      if ((BUF_Z (buffer) - BUF_BEG (buffer)) == TOTAL_LENGTH (source))
1755	{
1756	  Lisp_Object buf;
1757	  XSETBUFFER (buf, buffer);
1758	  BUF_INTERVALS (buffer) = reproduce_tree_obj (source, buf);
1759	  BUF_INTERVALS (buffer)->position = BEG;
1760	  BUF_INTERVALS (buffer)->up_obj = 1;
1761
1762	  /* Explicitly free the old tree here?  */
1763
1764	  return;
1765	}
1766
1767      /* Create an interval tree in which to place a copy
1768	 of the intervals of the inserted string.  */
1769      {
1770	Lisp_Object buf;
1771	XSETBUFFER (buf, buffer);
1772	tree = create_root_interval (buf);
1773      }
1774    }
1775  else if (TOTAL_LENGTH (tree) == TOTAL_LENGTH (source))
1776    /* If the buffer contains only the new string, but
1777       there was already some interval tree there, then it may be
1778       some zero length intervals.  Eventually, do something clever
1779       about inserting properly.  For now, just waste the old intervals.  */
1780    {
1781      BUF_INTERVALS (buffer) = reproduce_tree (source, INTERVAL_PARENT (tree));
1782      BUF_INTERVALS (buffer)->position = BEG;
1783      BUF_INTERVALS (buffer)->up_obj = 1;
1784      /* Explicitly free the old tree here.  */
1785
1786      return;
1787    }
1788  /* Paranoia -- the text has already been added, so this buffer
1789     should be of non-zero length.  */
1790  else if (TOTAL_LENGTH (tree) == 0)
1791    abort ();
1792
1793  this = under = find_interval (tree, position);
1794  if (NULL_INTERVAL_P (under))	/* Paranoia */
1795    abort ();
1796  over = find_interval (source, interval_start_pos (source));
1797
1798  /* Here for insertion in the middle of an interval.
1799     Split off an equivalent interval to the right,
1800     then don't bother with it any more.  */
1801
1802  if (position > under->position)
1803    {
1804      INTERVAL end_unchanged
1805	= split_interval_left (this, position - under->position);
1806      copy_properties (under, end_unchanged);
1807      under->position = position;
1808    }
1809  else
1810    {
1811      /* This call may have some effect because previous_interval may
1812         update `position' fields of intervals.  Thus, don't ignore it
1813         for the moment.  Someone please tell me the truth (K.Handa).  */
1814      prev = previous_interval (under);
1815#if 0
1816      /* But, this code surely has no effect.  And, anyway,
1817         END_NONSTICKY_P is unreliable now.  */
1818      if (prev && !END_NONSTICKY_P (prev))
1819	prev = 0;
1820#endif /* 0 */
1821    }
1822
1823  /* Insertion is now at beginning of UNDER.  */
1824
1825  /* The inserted text "sticks" to the interval `under',
1826     which means it gets those properties.
1827     The properties of under are the result of
1828     adjust_intervals_for_insertion, so stickiness has
1829     already been taken care of.  */
1830
1831  /* OVER is the interval we are copying from next.
1832     OVER_USED says how many characters' worth of OVER
1833     have already been copied into target intervals.
1834     UNDER is the next interval in the target.  */
1835  over_used = 0;
1836  while (! NULL_INTERVAL_P (over))
1837    {
1838      /* If UNDER is longer than OVER, split it.  */
1839      if (LENGTH (over) - over_used < LENGTH (under))
1840	{
1841	  this = split_interval_left (under, LENGTH (over) - over_used);
1842	  copy_properties (under, this);
1843	}
1844      else
1845	this = under;
1846
1847      /* THIS is now the interval to copy or merge into.
1848	 OVER covers all of it.  */
1849      if (inherit)
1850	merge_properties (over, this);
1851      else
1852	copy_properties (over, this);
1853
1854      /* If THIS and OVER end at the same place,
1855	 advance OVER to a new source interval.  */
1856      if (LENGTH (this) == LENGTH (over) - over_used)
1857	{
1858	  over = next_interval (over);
1859	  over_used = 0;
1860	}
1861      else
1862	/* Otherwise just record that more of OVER has been used.  */
1863	over_used += LENGTH (this);
1864
1865      /* Always advance to a new target interval.  */
1866      under = next_interval (this);
1867    }
1868
1869  if (! NULL_INTERVAL_P (BUF_INTERVALS (buffer)))
1870    BUF_INTERVALS (buffer) = balance_an_interval (BUF_INTERVALS (buffer));
1871  return;
1872}
1873
1874/* Get the value of property PROP from PLIST,
1875   which is the plist of an interval.
1876   We check for direct properties, for categories with property PROP,
1877   and for PROP appearing on the default-text-properties list.  */
1878
1879Lisp_Object
1880textget (plist, prop)
1881     Lisp_Object plist;
1882     register Lisp_Object prop;
1883{
1884  return lookup_char_property (plist, prop, 1);
1885}
1886
1887Lisp_Object
1888lookup_char_property (plist, prop, textprop)
1889     Lisp_Object plist;
1890     register Lisp_Object prop;
1891     int textprop;
1892{
1893  register Lisp_Object tail, fallback = Qnil;
1894
1895  for (tail = plist; CONSP (tail); tail = Fcdr (XCDR (tail)))
1896    {
1897      register Lisp_Object tem;
1898      tem = XCAR (tail);
1899      if (EQ (prop, tem))
1900	return Fcar (XCDR (tail));
1901      if (EQ (tem, Qcategory))
1902	{
1903	  tem = Fcar (XCDR (tail));
1904	  if (SYMBOLP (tem))
1905	    fallback = Fget (tem, prop);
1906	}
1907    }
1908
1909  if (! NILP (fallback))
1910    return fallback;
1911  /* Check for alternative properties */
1912  tail = Fassq (prop, Vchar_property_alias_alist);
1913  if (! NILP (tail))
1914    {
1915      tail = XCDR (tail);
1916      for (; NILP (fallback) && CONSP (tail); tail = XCDR (tail))
1917	fallback = Fplist_get (plist, XCAR (tail));
1918    }
1919
1920  if (textprop && NILP (fallback) && CONSP (Vdefault_text_properties))
1921    fallback = Fplist_get (Vdefault_text_properties, prop);
1922  return fallback;
1923}
1924
1925
1926/* Set point "temporarily", without checking any text properties.  */
1927
1928INLINE void
1929temp_set_point (buffer, charpos)
1930     struct buffer *buffer;
1931     int charpos;
1932{
1933  temp_set_point_both (buffer, charpos,
1934		       buf_charpos_to_bytepos (buffer, charpos));
1935}
1936
1937/* Set point in BUFFER "temporarily" to CHARPOS, which corresponds to
1938   byte position BYTEPOS.  */
1939
1940INLINE void
1941temp_set_point_both (buffer, charpos, bytepos)
1942     int charpos, bytepos;
1943     struct buffer *buffer;
1944{
1945  /* In a single-byte buffer, the two positions must be equal.  */
1946  if (BUF_ZV (buffer) == BUF_ZV_BYTE (buffer)
1947      && charpos != bytepos)
1948    abort ();
1949
1950  if (charpos > bytepos)
1951    abort ();
1952
1953  if (charpos > BUF_ZV (buffer) || charpos < BUF_BEGV (buffer))
1954    abort ();
1955
1956  BUF_PT_BYTE (buffer) = bytepos;
1957  BUF_PT (buffer) = charpos;
1958}
1959
1960/* Set point in BUFFER to CHARPOS.  If the target position is
1961   before an intangible character, move to an ok place.  */
1962
1963void
1964set_point (buffer, charpos)
1965     register struct buffer *buffer;
1966     register int charpos;
1967{
1968  set_point_both (buffer, charpos, buf_charpos_to_bytepos (buffer, charpos));
1969}
1970
1971/* If there's an invisible character at position POS + TEST_OFFS in the
1972   current buffer, and the invisible property has a `stickiness' such that
1973   inserting a character at position POS would inherit the property it,
1974   return POS + ADJ, otherwise return POS.  If TEST_INTANG is non-zero,
1975   then intangibility is required as well as invisibleness.
1976
1977   TEST_OFFS should be either 0 or -1, and ADJ should be either 1 or -1.
1978
1979   Note that `stickiness' is determined by overlay marker insertion types,
1980   if the invisible property comes from an overlay.  */
1981
1982static int
1983adjust_for_invis_intang (pos, test_offs, adj, test_intang)
1984     int pos, test_offs, adj, test_intang;
1985{
1986  Lisp_Object invis_propval, invis_overlay;
1987  Lisp_Object test_pos;
1988
1989  if ((adj < 0 && pos + adj < BEGV) || (adj > 0 && pos + adj > ZV))
1990    /* POS + ADJ would be beyond the buffer bounds, so do no adjustment.  */
1991    return pos;
1992
1993  test_pos = make_number (pos + test_offs);
1994
1995  invis_propval
1996    = get_char_property_and_overlay (test_pos, Qinvisible, Qnil,
1997				     &invis_overlay);
1998
1999  if ((!test_intang
2000       || ! NILP (Fget_char_property (test_pos, Qintangible, Qnil)))
2001      && TEXT_PROP_MEANS_INVISIBLE (invis_propval)
2002      /* This next test is true if the invisible property has a stickiness
2003	 such that an insertion at POS would inherit it.  */
2004      && (NILP (invis_overlay)
2005	  /* Invisible property is from a text-property.  */
2006	  ? (text_property_stickiness (Qinvisible, make_number (pos), Qnil)
2007	     == (test_offs == 0 ? 1 : -1))
2008	  /* Invisible property is from an overlay.  */
2009	  : (test_offs == 0
2010	     ? XMARKER (OVERLAY_START (invis_overlay))->insertion_type == 0
2011	     : XMARKER (OVERLAY_END (invis_overlay))->insertion_type == 1)))
2012    pos += adj;
2013
2014  return pos;
2015}
2016
2017/* Set point in BUFFER to CHARPOS, which corresponds to byte
2018   position BYTEPOS.  If the target position is
2019   before an intangible character, move to an ok place.  */
2020
2021void
2022set_point_both (buffer, charpos, bytepos)
2023     register struct buffer *buffer;
2024     register int charpos, bytepos;
2025{
2026  register INTERVAL to, from, toprev, fromprev;
2027  int buffer_point;
2028  int old_position = BUF_PT (buffer);
2029  /* This ensures that we move forward past intangible text when the
2030     initial position is the same as the destination, in the rare
2031     instances where this is important, e.g. in line-move-finish
2032     (simple.el).  */
2033  int backwards = (charpos < old_position ? 1 : 0);
2034  int have_overlays;
2035  int original_position;
2036
2037  buffer->point_before_scroll = Qnil;
2038
2039  if (charpos == BUF_PT (buffer))
2040    return;
2041
2042  /* In a single-byte buffer, the two positions must be equal.  */
2043  if (BUF_ZV (buffer) == BUF_ZV_BYTE (buffer)
2044      && charpos != bytepos)
2045    abort ();
2046
2047  /* Check this now, before checking if the buffer has any intervals.
2048     That way, we can catch conditions which break this sanity check
2049     whether or not there are intervals in the buffer.  */
2050  if (charpos > BUF_ZV (buffer) || charpos < BUF_BEGV (buffer))
2051    abort ();
2052
2053  have_overlays = (buffer->overlays_before || buffer->overlays_after);
2054
2055  /* If we have no text properties and overlays,
2056     then we can do it quickly.  */
2057  if (NULL_INTERVAL_P (BUF_INTERVALS (buffer)) && ! have_overlays)
2058    {
2059      temp_set_point_both (buffer, charpos, bytepos);
2060      return;
2061    }
2062
2063  /* Set TO to the interval containing the char after CHARPOS,
2064     and TOPREV to the interval containing the char before CHARPOS.
2065     Either one may be null.  They may be equal.  */
2066  to = find_interval (BUF_INTERVALS (buffer), charpos);
2067  if (charpos == BUF_BEGV (buffer))
2068    toprev = 0;
2069  else if (to && to->position == charpos)
2070    toprev = previous_interval (to);
2071  else
2072    toprev = to;
2073
2074  buffer_point = (BUF_PT (buffer) == BUF_ZV (buffer)
2075		  ? BUF_ZV (buffer) - 1
2076		  : BUF_PT (buffer));
2077
2078  /* Set FROM to the interval containing the char after PT,
2079     and FROMPREV to the interval containing the char before PT.
2080     Either one may be null.  They may be equal.  */
2081  /* We could cache this and save time.  */
2082  from = find_interval (BUF_INTERVALS (buffer), buffer_point);
2083  if (buffer_point == BUF_BEGV (buffer))
2084    fromprev = 0;
2085  else if (from && from->position == BUF_PT (buffer))
2086    fromprev = previous_interval (from);
2087  else if (buffer_point != BUF_PT (buffer))
2088    fromprev = from, from = 0;
2089  else
2090    fromprev = from;
2091
2092  /* Moving within an interval.  */
2093  if (to == from && toprev == fromprev && INTERVAL_VISIBLE_P (to)
2094      && ! have_overlays)
2095    {
2096      temp_set_point_both (buffer, charpos, bytepos);
2097      return;
2098    }
2099
2100  original_position = charpos;
2101
2102  /* If the new position is between two intangible characters
2103     with the same intangible property value,
2104     move forward or backward until a change in that property.  */
2105  if (NILP (Vinhibit_point_motion_hooks)
2106      && ((! NULL_INTERVAL_P (to) && ! NULL_INTERVAL_P (toprev))
2107	  || have_overlays)
2108      /* Intangibility never stops us from positioning at the beginning
2109	 or end of the buffer, so don't bother checking in that case.  */
2110      && charpos != BEGV && charpos != ZV)
2111    {
2112      Lisp_Object pos;
2113      Lisp_Object intangible_propval;
2114
2115      if (backwards)
2116	{
2117	  /* If the preceding character is both intangible and invisible,
2118	     and the invisible property is `rear-sticky', perturb it so
2119	     that the search starts one character earlier -- this ensures
2120	     that point can never move to the end of an invisible/
2121	     intangible/rear-sticky region.  */
2122	  charpos = adjust_for_invis_intang (charpos, -1, -1, 1);
2123
2124	  XSETINT (pos, charpos);
2125
2126	  /* If following char is intangible,
2127	     skip back over all chars with matching intangible property.  */
2128
2129	  intangible_propval = Fget_char_property (pos, Qintangible, Qnil);
2130
2131	  if (! NILP (intangible_propval))
2132	    {
2133	      while (XINT (pos) > BUF_BEGV (buffer)
2134		     && EQ (Fget_char_property (make_number (XINT (pos) - 1),
2135						Qintangible, Qnil),
2136			    intangible_propval))
2137		pos = Fprevious_char_property_change (pos, Qnil);
2138
2139	      /* Set CHARPOS from POS, and if the final intangible character
2140		 that we skipped over is also invisible, and the invisible
2141		 property is `front-sticky', perturb it to be one character
2142		 earlier -- this ensures that point can never move to the
2143		 beginning of an invisible/intangible/front-sticky region.  */
2144	      charpos = adjust_for_invis_intang (XINT (pos), 0, -1, 0);
2145	    }
2146	}
2147      else
2148	{
2149	  /* If the following character is both intangible and invisible,
2150	     and the invisible property is `front-sticky', perturb it so
2151	     that the search starts one character later -- this ensures
2152	     that point can never move to the beginning of an
2153	     invisible/intangible/front-sticky region.  */
2154	  charpos = adjust_for_invis_intang (charpos, 0, 1, 1);
2155
2156	  XSETINT (pos, charpos);
2157
2158	  /* If preceding char is intangible,
2159	     skip forward over all chars with matching intangible property.  */
2160
2161	  intangible_propval = Fget_char_property (make_number (charpos - 1),
2162						   Qintangible, Qnil);
2163
2164	  if (! NILP (intangible_propval))
2165	    {
2166	      while (XINT (pos) < BUF_ZV (buffer)
2167		     && EQ (Fget_char_property (pos, Qintangible, Qnil),
2168			    intangible_propval))
2169		pos = Fnext_char_property_change (pos, Qnil);
2170
2171	      /* Set CHARPOS from POS, and if the final intangible character
2172		 that we skipped over is also invisible, and the invisible
2173		 property is `rear-sticky', perturb it to be one character
2174		 later -- this ensures that point can never move to the
2175		 end of an invisible/intangible/rear-sticky region.  */
2176	      charpos = adjust_for_invis_intang (XINT (pos), -1, 1, 0);
2177	    }
2178	}
2179
2180      bytepos = buf_charpos_to_bytepos (buffer, charpos);
2181    }
2182
2183  if (charpos != original_position)
2184    {
2185      /* Set TO to the interval containing the char after CHARPOS,
2186	 and TOPREV to the interval containing the char before CHARPOS.
2187	 Either one may be null.  They may be equal.  */
2188      to = find_interval (BUF_INTERVALS (buffer), charpos);
2189      if (charpos == BUF_BEGV (buffer))
2190	toprev = 0;
2191      else if (to && to->position == charpos)
2192	toprev = previous_interval (to);
2193      else
2194	toprev = to;
2195    }
2196
2197  /* Here TO is the interval after the stopping point
2198     and TOPREV is the interval before the stopping point.
2199     One or the other may be null.  */
2200
2201  temp_set_point_both (buffer, charpos, bytepos);
2202
2203  /* We run point-left and point-entered hooks here, iff the
2204     two intervals are not equivalent.  These hooks take
2205     (old_point, new_point) as arguments.  */
2206  if (NILP (Vinhibit_point_motion_hooks)
2207      && (! intervals_equal (from, to)
2208	  || ! intervals_equal (fromprev, toprev)))
2209    {
2210      Lisp_Object leave_after, leave_before, enter_after, enter_before;
2211
2212      if (fromprev)
2213	leave_before = textget (fromprev->plist, Qpoint_left);
2214      else
2215	leave_before = Qnil;
2216
2217      if (from)
2218	leave_after = textget (from->plist, Qpoint_left);
2219      else
2220	leave_after = Qnil;
2221
2222      if (toprev)
2223	enter_before = textget (toprev->plist, Qpoint_entered);
2224      else
2225	enter_before = Qnil;
2226
2227      if (to)
2228	enter_after = textget (to->plist, Qpoint_entered);
2229      else
2230	enter_after = Qnil;
2231
2232      if (! EQ (leave_before, enter_before) && !NILP (leave_before))
2233      	call2 (leave_before, make_number (old_position),
2234      	       make_number (charpos));
2235      if (! EQ (leave_after, enter_after) && !NILP (leave_after))
2236      	call2 (leave_after, make_number (old_position),
2237      	       make_number (charpos));
2238
2239      if (! EQ (enter_before, leave_before) && !NILP (enter_before))
2240      	call2 (enter_before, make_number (old_position),
2241      	       make_number (charpos));
2242      if (! EQ (enter_after, leave_after) && !NILP (enter_after))
2243      	call2 (enter_after, make_number (old_position),
2244      	       make_number (charpos));
2245    }
2246}
2247
2248/* Move point to POSITION, unless POSITION is inside an intangible
2249   segment that reaches all the way to point.  */
2250
2251void
2252move_if_not_intangible (position)
2253     int position;
2254{
2255  Lisp_Object pos;
2256  Lisp_Object intangible_propval;
2257
2258  XSETINT (pos, position);
2259
2260  if (! NILP (Vinhibit_point_motion_hooks))
2261    /* If intangible is inhibited, always move point to POSITION.  */
2262    ;
2263  else if (PT < position && XINT (pos) < ZV)
2264    {
2265      /* We want to move forward, so check the text before POSITION.  */
2266
2267      intangible_propval = Fget_char_property (pos,
2268					       Qintangible, Qnil);
2269
2270      /* If following char is intangible,
2271	 skip back over all chars with matching intangible property.  */
2272      if (! NILP (intangible_propval))
2273	while (XINT (pos) > BEGV
2274	       && EQ (Fget_char_property (make_number (XINT (pos) - 1),
2275					  Qintangible, Qnil),
2276		      intangible_propval))
2277	  pos = Fprevious_char_property_change (pos, Qnil);
2278    }
2279  else if (XINT (pos) > BEGV)
2280    {
2281      /* We want to move backward, so check the text after POSITION.  */
2282
2283      intangible_propval = Fget_char_property (make_number (XINT (pos) - 1),
2284					       Qintangible, Qnil);
2285
2286      /* If following char is intangible,
2287	 skip forward over all chars with matching intangible property.  */
2288      if (! NILP (intangible_propval))
2289	while (XINT (pos) < ZV
2290	       && EQ (Fget_char_property (pos, Qintangible, Qnil),
2291		      intangible_propval))
2292	  pos = Fnext_char_property_change (pos, Qnil);
2293
2294    }
2295  else if (position < BEGV)
2296    position = BEGV;
2297  else if (position > ZV)
2298    position = ZV;
2299
2300  /* If the whole stretch between PT and POSITION isn't intangible,
2301     try moving to POSITION (which means we actually move farther
2302     if POSITION is inside of intangible text).  */
2303
2304  if (XINT (pos) != PT)
2305    SET_PT (position);
2306}
2307
2308/* If text at position POS has property PROP, set *VAL to the property
2309   value, *START and *END to the beginning and end of a region that
2310   has the same property, and return 1.  Otherwise return 0.
2311
2312   OBJECT is the string or buffer to look for the property in;
2313   nil means the current buffer. */
2314
2315int
2316get_property_and_range (pos, prop, val, start, end, object)
2317     int pos;
2318     Lisp_Object prop, *val;
2319     int *start, *end;
2320     Lisp_Object object;
2321{
2322  INTERVAL i, prev, next;
2323
2324  if (NILP (object))
2325    i = find_interval (BUF_INTERVALS (current_buffer), pos);
2326  else if (BUFFERP (object))
2327    i = find_interval (BUF_INTERVALS (XBUFFER (object)), pos);
2328  else if (STRINGP (object))
2329    i = find_interval (STRING_INTERVALS (object), pos);
2330  else
2331    abort ();
2332
2333  if (NULL_INTERVAL_P (i) || (i->position + LENGTH (i) <= pos))
2334    return 0;
2335  *val = textget (i->plist, prop);
2336  if (NILP (*val))
2337    return 0;
2338
2339  next = i;			/* remember it in advance */
2340  prev = previous_interval (i);
2341  while (! NULL_INTERVAL_P (prev)
2342	 && EQ (*val, textget (prev->plist, prop)))
2343    i = prev, prev = previous_interval (prev);
2344  *start = i->position;
2345
2346  next = next_interval (i);
2347  while (! NULL_INTERVAL_P (next)
2348	 && EQ (*val, textget (next->plist, prop)))
2349    i = next, next = next_interval (next);
2350  *end = i->position + LENGTH (i);
2351
2352  return 1;
2353}
2354
2355/* Return the proper local keymap TYPE for position POSITION in
2356   BUFFER; TYPE should be one of `keymap' or `local-map'.  Use the map
2357   specified by the PROP property, if any.  Otherwise, if TYPE is
2358   `local-map' use BUFFER's local map.
2359
2360   POSITION must be in the accessible part of BUFFER.  */
2361
2362Lisp_Object
2363get_local_map (position, buffer, type)
2364     register int position;
2365     register struct buffer *buffer;
2366     Lisp_Object type;
2367{
2368  Lisp_Object prop, lispy_position, lispy_buffer;
2369  int old_begv, old_zv, old_begv_byte, old_zv_byte;
2370
2371  /* Perhaps we should just change `position' to the limit.  */
2372  if (position > BUF_ZV (buffer) || position < BUF_BEGV (buffer))
2373    abort ();
2374
2375  /* Ignore narrowing, so that a local map continues to be valid even if
2376     the visible region contains no characters and hence no properties.  */
2377  old_begv = BUF_BEGV (buffer);
2378  old_zv = BUF_ZV (buffer);
2379  old_begv_byte = BUF_BEGV_BYTE (buffer);
2380  old_zv_byte = BUF_ZV_BYTE (buffer);
2381  BUF_BEGV (buffer) = BUF_BEG (buffer);
2382  BUF_ZV (buffer) = BUF_Z (buffer);
2383  BUF_BEGV_BYTE (buffer) = BUF_BEG_BYTE (buffer);
2384  BUF_ZV_BYTE (buffer) = BUF_Z_BYTE (buffer);
2385
2386  XSETFASTINT (lispy_position, position);
2387  XSETBUFFER (lispy_buffer, buffer);
2388  /* First check if the CHAR has any property.  This is because when
2389     we click with the mouse, the mouse pointer is really pointing
2390     to the CHAR after POS.  */
2391  prop = Fget_char_property (lispy_position, type, lispy_buffer);
2392  /* If not, look at the POS's properties.  This is necessary because when
2393     editing a field with a `local-map' property, we want insertion at the end
2394     to obey the `local-map' property.  */
2395  if (NILP (prop))
2396    prop = get_pos_property (lispy_position, type, lispy_buffer);
2397
2398  BUF_BEGV (buffer) = old_begv;
2399  BUF_ZV (buffer) = old_zv;
2400  BUF_BEGV_BYTE (buffer) = old_begv_byte;
2401  BUF_ZV_BYTE (buffer) = old_zv_byte;
2402
2403  /* Use the local map only if it is valid.  */
2404  prop = get_keymap (prop, 0, 0);
2405  if (CONSP (prop))
2406    return prop;
2407
2408  if (EQ (type, Qkeymap))
2409    return Qnil;
2410  else
2411    return buffer->keymap;
2412}
2413
2414/* Produce an interval tree reflecting the intervals in
2415   TREE from START to START + LENGTH.
2416   The new interval tree has no parent and has a starting-position of 0.  */
2417
2418INTERVAL
2419copy_intervals (tree, start, length)
2420     INTERVAL tree;
2421     int start, length;
2422{
2423  register INTERVAL i, new, t;
2424  register int got, prevlen;
2425
2426  if (NULL_INTERVAL_P (tree) || length <= 0)
2427    return NULL_INTERVAL;
2428
2429  i = find_interval (tree, start);
2430  if (NULL_INTERVAL_P (i) || LENGTH (i) == 0)
2431    abort ();
2432
2433  /* If there is only one interval and it's the default, return nil.  */
2434  if ((start - i->position + 1 + length) < LENGTH (i)
2435      && DEFAULT_INTERVAL_P (i))
2436    return NULL_INTERVAL;
2437
2438  new = make_interval ();
2439  new->position = 0;
2440  got = (LENGTH (i) - (start - i->position));
2441  new->total_length = length;
2442  CHECK_TOTAL_LENGTH (new);
2443  copy_properties (i, new);
2444
2445  t = new;
2446  prevlen = got;
2447  while (got < length)
2448    {
2449      i = next_interval (i);
2450      t = split_interval_right (t, prevlen);
2451      copy_properties (i, t);
2452      prevlen = LENGTH (i);
2453      got += prevlen;
2454    }
2455
2456  return balance_an_interval (new);
2457}
2458
2459/* Give STRING the properties of BUFFER from POSITION to LENGTH.  */
2460
2461INLINE void
2462copy_intervals_to_string (string, buffer, position, length)
2463     Lisp_Object string;
2464     struct buffer *buffer;
2465     int position, length;
2466{
2467  INTERVAL interval_copy = copy_intervals (BUF_INTERVALS (buffer),
2468					   position, length);
2469  if (NULL_INTERVAL_P (interval_copy))
2470    return;
2471
2472  SET_INTERVAL_OBJECT (interval_copy, string);
2473  STRING_SET_INTERVALS (string, interval_copy);
2474}
2475
2476/* Return 1 if strings S1 and S2 have identical properties; 0 otherwise.
2477   Assume they have identical characters.  */
2478
2479int
2480compare_string_intervals (s1, s2)
2481     Lisp_Object s1, s2;
2482{
2483  INTERVAL i1, i2;
2484  int pos = 0;
2485  int end = SCHARS (s1);
2486
2487  i1 = find_interval (STRING_INTERVALS (s1), 0);
2488  i2 = find_interval (STRING_INTERVALS (s2), 0);
2489
2490  while (pos < end)
2491    {
2492      /* Determine how far we can go before we reach the end of I1 or I2.  */
2493      int len1 = (i1 != 0 ? INTERVAL_LAST_POS (i1) : end) - pos;
2494      int len2 = (i2 != 0 ? INTERVAL_LAST_POS (i2) : end) - pos;
2495      int distance = min (len1, len2);
2496
2497      /* If we ever find a mismatch between the strings,
2498	 they differ.  */
2499      if (! intervals_equal (i1, i2))
2500	return 0;
2501
2502      /* Advance POS till the end of the shorter interval,
2503	 and advance one or both interval pointers for the new position.  */
2504      pos += distance;
2505      if (len1 == distance)
2506	i1 = next_interval (i1);
2507      if (len2 == distance)
2508	i2 = next_interval (i2);
2509    }
2510  return 1;
2511}
2512
2513/* Recursively adjust interval I in the current buffer
2514   for setting enable_multibyte_characters to MULTI_FLAG.
2515   The range of interval I is START ... END in characters,
2516   START_BYTE ... END_BYTE in bytes.  */
2517
2518static void
2519set_intervals_multibyte_1 (i, multi_flag, start, start_byte, end, end_byte)
2520     INTERVAL i;
2521     int multi_flag;
2522     int start, start_byte, end, end_byte;
2523{
2524  /* Fix the length of this interval.  */
2525  if (multi_flag)
2526    i->total_length = end - start;
2527  else
2528    i->total_length = end_byte - start_byte;
2529  CHECK_TOTAL_LENGTH (i);
2530
2531  if (TOTAL_LENGTH (i) == 0)
2532    {
2533      delete_interval (i);
2534      return;
2535    }
2536
2537  /* Recursively fix the length of the subintervals.  */
2538  if (i->left)
2539    {
2540      int left_end, left_end_byte;
2541
2542      if (multi_flag)
2543	{
2544	  int temp;
2545	  left_end_byte = start_byte + LEFT_TOTAL_LENGTH (i);
2546	  left_end = BYTE_TO_CHAR (left_end_byte);
2547
2548	  temp = CHAR_TO_BYTE (left_end);
2549
2550	  /* If LEFT_END_BYTE is in the middle of a character,
2551	     adjust it and LEFT_END to a char boundary.  */
2552	  if (left_end_byte > temp)
2553	    {
2554	      left_end_byte = temp;
2555	    }
2556	  if (left_end_byte < temp)
2557	    {
2558	      left_end--;
2559	      left_end_byte = CHAR_TO_BYTE (left_end);
2560	    }
2561	}
2562      else
2563	{
2564	  left_end = start + LEFT_TOTAL_LENGTH (i);
2565	  left_end_byte = CHAR_TO_BYTE (left_end);
2566	}
2567
2568      set_intervals_multibyte_1 (i->left, multi_flag, start, start_byte,
2569				 left_end, left_end_byte);
2570    }
2571  if (i->right)
2572    {
2573      int right_start_byte, right_start;
2574
2575      if (multi_flag)
2576	{
2577	  int temp;
2578
2579	  right_start_byte = end_byte - RIGHT_TOTAL_LENGTH (i);
2580	  right_start = BYTE_TO_CHAR (right_start_byte);
2581
2582	  /* If RIGHT_START_BYTE is in the middle of a character,
2583	     adjust it and RIGHT_START to a char boundary.  */
2584	  temp = CHAR_TO_BYTE (right_start);
2585
2586	  if (right_start_byte < temp)
2587	    {
2588	      right_start_byte = temp;
2589	    }
2590	  if (right_start_byte > temp)
2591	    {
2592	      right_start++;
2593	      right_start_byte = CHAR_TO_BYTE (right_start);
2594	    }
2595	}
2596      else
2597	{
2598	  right_start = end - RIGHT_TOTAL_LENGTH (i);
2599	  right_start_byte = CHAR_TO_BYTE (right_start);
2600	}
2601
2602      set_intervals_multibyte_1 (i->right, multi_flag,
2603				 right_start, right_start_byte,
2604				 end, end_byte);
2605    }
2606
2607  /* Rounding to char boundaries can theoretically ake this interval
2608     spurious.  If so, delete one child, and copy its property list
2609     to this interval.  */
2610  if (LEFT_TOTAL_LENGTH (i) + RIGHT_TOTAL_LENGTH (i) >= TOTAL_LENGTH (i))
2611    {
2612      if ((i)->left)
2613	{
2614	  (i)->plist = (i)->left->plist;
2615	  (i)->left->total_length = 0;
2616	  delete_interval ((i)->left);
2617	}
2618      else
2619	{
2620	  (i)->plist = (i)->right->plist;
2621	  (i)->right->total_length = 0;
2622	  delete_interval ((i)->right);
2623	}
2624    }
2625}
2626
2627/* Update the intervals of the current buffer
2628   to fit the contents as multibyte (if MULTI_FLAG is 1)
2629   or to fit them as non-multibyte (if MULTI_FLAG is 0).  */
2630
2631void
2632set_intervals_multibyte (multi_flag)
2633     int multi_flag;
2634{
2635  if (BUF_INTERVALS (current_buffer))
2636    set_intervals_multibyte_1 (BUF_INTERVALS (current_buffer), multi_flag,
2637			       BEG, BEG_BYTE, Z, Z_BYTE);
2638}
2639
2640/* arch-tag: 3d402b60-083c-4271-b4a3-ebd9a74bfe27
2641   (do not change this comment) */
2642