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: 
    5: This file is part of GNU Emacs.
    6: 
    7: GNU Emacs is free software; you can redistribute it and/or modify
    8: it under the terms of the GNU General Public License as published by
    9: the Free Software Foundation; either version 2, or (at your option)
   10: any later version.
   11: 
   12: GNU Emacs is distributed in the hope that it will be useful,
   13: but WITHOUT ANY WARRANTY; without even the implied warranty of
   14: MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
   15: GNU General Public License for more details.
   16: 
   17: You should have received a copy of the GNU General Public License
   18: along with GNU Emacs; see the file COPYING.  If not, write to
   19: the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
   20: Boston, 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: 
   56: Lisp_Object merge_properties_sticky ();
   57: static INTERVAL reproduce_tree P_ ((INTERVAL, INTERVAL));
   58: static INTERVAL reproduce_tree_obj P_ ((INTERVAL, Lisp_Object));
   59: ^L
   60: /* Utility functions for intervals.  */
   61: 
   62: 
   63: /* Create the root interval of some object, a buffer or string.  */
   64: 
   65: INTERVAL
   66: create_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: 
   98: void
   99: copy_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: 
  113: static void
  114: merge_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: 
  152: int
  153: intervals_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: ^L
  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: 
  209: void
  210: traverse_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: 
  232: void
  233: traverse_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: ^L
  249: #if 0
  250: 
  251: static int icount;
  252: static int idepth;
  253: static int zero_length;
  254: 
  255: /* These functions are temporary, for debugging purposes only.  */
  256: 
  257: INTERVAL search_interval, found_interval;
  258: 
  259: void
  260: check_for_interval (i)
  261:      register INTERVAL i;
  262: {
  263:   if (i == search_interval)
  264:     {
  265:       found_interval = i;
  266:       icount++;
  267:     }
  268: }
  269: 
  270: INTERVAL
  271: search_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: 
  281: static void
  282: inc_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: 
  292: int
  293: count_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: 
  304: static INTERVAL
  305: root_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: ^L
  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: 
  326: static INLINE INTERVAL
  327: rotate_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: 
  374: static INLINE INTERVAL
  375: rotate_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: ^L
  413: /* Balance an interval tree with the assumption that the subtrees
  414:    themselves are already balanced.  */
  415: 
  416: static INTERVAL
  417: balance_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: 
  454: static INLINE INTERVAL
  455: balance_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: 
  485: static INTERVAL
  486: balance_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: 
  499: INTERVAL
  500: balance_intervals (tree)
  501:      INTERVAL tree;
  502: {
  503:   if (tree == NULL_INTERVAL)
  504:     return NULL_INTERVAL;
  505: 
  506:   return balance_intervals_internal (tree);
  507: }
  508: ^L
  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: 
  522: INTERVAL
  523: split_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: 
  569: INTERVAL
  570: split_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: ^L
  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: 
  611: int
  612: interval_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: </