Return to undo.c CVS log

Up to [Apple XNU] / GNUtools / emacs / src

Annotation of GNUtools/emacs/src/undo.c, revision 1.1

1.1     ! root        1: /* undo handling for GNU Emacs.
        !             2:    Copyright (C) 1990 Free Software Foundation, Inc.
        !             3: 
        !             4: This file is part of GNU Emacs.
        !             5: 
        !             6: GNU Emacs is free software; you can redistribute it and/or modify
        !             7: it under the terms of the GNU General Public License as published by
        !             8: the Free Software Foundation; either version 1, or (at your option)
        !             9: any later version.
        !            10: 
        !            11: GNU Emacs is distributed in the hope that it will be useful,
        !            12: but WITHOUT ANY WARRANTY; without even the implied warranty of
        !            13: MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
        !            14: GNU General Public License for more details.
        !            15: 
        !            16: You should have received a copy of the GNU General Public License
        !            17: along with GNU Emacs; see the file COPYING.  If not, write to
        !            18: the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.  */
        !            19: 
        !            20: 
        !            21: #include "config.h"
        !            22: #include "lisp.h"
        !            23: #include "buffer.h"
        !            24: 
        !            25: /* Last buffer for which undo information was recorded.  */
        !            26: Lisp_Object last_undo_buffer;
        !            27: 
        !            28: /* Record an insertion that just happened or is about to happen,
        !            29:    for LENGTH characters at position BEG.
        !            30:    (It is possible to record an insertion before or after the fact
        !            31:    because we don't need to record the contents.)  */
        !            32: 
        !            33: record_insert (beg, length)
        !            34:      Lisp_Object beg, length;
        !            35: {
        !            36:   Lisp_Object lbeg, lend;
        !            37: 
        !            38:   if (current_buffer != XBUFFER (last_undo_buffer))
        !            39:     Fundo_boundary ();
        !            40:   XSET (last_undo_buffer, Lisp_Buffer, current_buffer);
        !            41: 
        !            42:   if (EQ (current_buffer->undo_list, Qt))
        !            43:     return;
        !            44:   if (MODIFF <= current_buffer->save_modified)
        !            45:     record_first_change ();
        !            46: 
        !            47:   /* If this is following another insertion and consecutive with it
        !            48:      in the buffer, combine the two.  */
        !            49:   if (XTYPE (current_buffer->undo_list) == Lisp_Cons)
        !            50:     {
        !            51:       Lisp_Object elt;
        !            52:       elt = XCONS (current_buffer->undo_list)->car;
        !            53:       if (XTYPE (elt) == Lisp_Cons
        !            54:          && XTYPE (XCONS (elt)->car) == Lisp_Int
        !            55:          && XTYPE (XCONS (elt)->cdr) == Lisp_Int
        !            56:          && XINT (XCONS (elt)->cdr) == beg)
        !            57:        {
        !            58:          XSETINT (XCONS (elt)->cdr, beg + length);
        !            59:          return;
        !            60:        }
        !            61:     }
        !            62: 
        !            63:   XFASTINT (lbeg) = beg;
        !            64:   XFASTINT (lend) = beg + length;
        !            65:   current_buffer->undo_list = Fcons (Fcons (lbeg, lend), current_buffer->undo_list);
        !            66: }
        !            67: 
        !            68: /* Record that a deletion is about to take place,
        !            69:    for LENGTH characters at location BEG.  */
        !            70: 
        !            71: record_delete (beg, length)
        !            72:      int beg, length;
        !            73: {
        !            74:   Lisp_Object lbeg, llength, lend, sbeg;
        !            75: 
        !            76:   if (current_buffer != XBUFFER (last_undo_buffer))
        !            77:     Fundo_boundary ();
        !            78:   XSET (last_undo_buffer, Lisp_Buffer, current_buffer);
        !            79: 
        !            80:   if (EQ (current_buffer->undo_list, Qt))
        !            81:     return;
        !            82:   if (MODIFF <= current_buffer->save_modified)
        !            83:     record_first_change ();
        !            84: 
        !            85:   if (point == beg + length)
        !            86:     XSET (sbeg, Lisp_Int, -beg);
        !            87:   else
        !            88:     XFASTINT (sbeg) = beg;
        !            89:   XFASTINT (lbeg) = beg;
        !            90:   XFASTINT (llength) = length;
        !            91:   XFASTINT (lend) = beg + length;
        !            92:   current_buffer->undo_list = Fcons (Fcons (Fbuffer_substring (lbeg, lend), sbeg),
        !            93:                             current_buffer->undo_list);
        !            94: }
        !            95: 
        !            96: /* Record that a replacement is about to take place,
        !            97:    for LENGTH characters at location BEG.
        !            98:    The replacement does not change the number of characters.  */
        !            99: 
        !           100: record_change (beg, length)
        !           101:      int beg, length;
        !           102: {
        !           103:   record_delete (beg, length);
        !           104:   record_insert (beg, length);
        !           105: }
        !           106: 
        !           107: /* Record that an unmodified buffer is about to be changed.
        !           108:    Record the file modification date so that when undoing this entry
        !           109:    we can tell whether it is obsolete because the file was saved again.  */
        !           110: 
        !           111: record_first_change ()
        !           112: {
        !           113:   Lisp_Object high, low;
        !           114:   XFASTINT (high) = (current_buffer->modtime >> 16) & 0xffff;
        !           115:   XFASTINT (low) = current_buffer->modtime & 0xffff;
        !           116:   current_buffer->undo_list = Fcons (Fcons (Qt, Fcons (high, low)), current_buffer->undo_list);
        !           117: }
        !           118: 
        !           119: DEFUN ("undo-boundary", Fundo_boundary, Sundo_boundary, 0, 0, 0,
        !           120:   "Mark a boundary between units of undo.\n\
        !           121: An undo command will stop at this point,\n\
        !           122: but another undo command will undo to the previous boundary.")
        !           123:   ()
        !           124: {
        !           125:   Lisp_Object tem;
        !           126:   if (EQ (current_buffer->undo_list, Qt))
        !           127:     return Qnil;
        !           128:   tem = Fcar (current_buffer->undo_list);
        !           129:   if (!NULL (tem))
        !           130:     current_buffer->undo_list = Fcons (Qnil, current_buffer->undo_list);
        !           131:   return Qnil;
        !           132: }
        !           133: 
        !           134: /* At garbage collection time, make an undo list shorter at the end,
        !           135:    returning the truncated list.
        !           136:    MINSIZE and MAXSIZE are the limits on size allowed, as described below.
        !           137:    In practice, these are the values of undo-threshold and
        !           138:    undo-high-threshold.  */
        !           139: 
        !           140: Lisp_Object
        !           141: truncate_undo_list (list, minsize, maxsize)
        !           142:      Lisp_Object list;
        !           143:      int minsize, maxsize;
        !           144: {
        !           145:   Lisp_Object prev, next, save_prev;
        !           146:   int size_so_far = 0;
        !           147: 
        !           148:   prev = Qnil;
        !           149:   next = list;
        !           150:   save_prev = Qnil;
        !           151: 
        !           152:   while (XTYPE (next) == Lisp_Cons)
        !           153:     {
        !           154:       Lisp_Object elt;
        !           155:       elt = XCONS (next)->car;
        !           156: 
        !           157:       /* When we get to a boundary, decide whether to truncate
        !           158:         either before or after it.  The lower threshold, MINSIZE,
        !           159:         tells us to truncate after it.  If its size pushes past
        !           160:         the higher threshold MAXSIZE as well, we truncate before it.  */
        !           161:       if (NULL (elt))
        !           162:        {
        !           163:          if (size_so_far > maxsize)
        !           164:            break;
        !           165:          save_prev = prev;
        !           166:          if (size_so_far > minsize)
        !           167:            break;
        !           168:        }
        !           169: 
        !           170:       /* Add in the space occupied by this element and its chain link.  */
        !           171:       size_so_far += 8;
        !           172:       if (XTYPE (elt) == Lisp_Cons)
        !           173:        {
        !           174:          size_so_far += 8;
        !           175:          if (XTYPE (XCONS (elt)->car) == Lisp_String)
        !           176:            size_so_far += 6 + XSTRING (XCONS (elt)->car)->size;
        !           177:        }
        !           178: 
        !           179:       /* Advance to next element.  */
        !           180:       prev = next;
        !           181:       next = XCONS (next)->cdr;
        !           182:     }
        !           183: 
        !           184:   /* If we scanned the whole list, it is short enough; don't change it.  */
        !           185:   if (NULL (next))
        !           186:     return list;
        !           187: 
        !           188:   /* Truncate at the boundary where we decided to truncate.  */
        !           189:   if (!NULL (save_prev))
        !           190:     {
        !           191:       XCONS (save_prev)->cdr = Qnil;
        !           192:       return list;
        !           193:     }
        !           194:   else
        !           195:     return Qnil;
        !           196: }
        !           197: 
        !           198: DEFUN ("primitive-undo", Fprimitive_undo, Sprimitive_undo, 2, 2, 0,
        !           199:   "Undo N records from the front of the list LIST.\n\
        !           200: Return what remains of the list.")
        !           201:   (count, list)
        !           202:      Lisp_Object count, list;
        !           203: {
        !           204:   register int arg = XINT (count);
        !           205: #if 0  /* This is a good feature, but would make undo-start
        !           206:          unable to do what is expected.  */
        !           207:   Lisp_Object tem;
        !           208: 
        !           209:   /* If the head of the list is a boundary, it is the boundary
        !           210:      preceding this command.  Get rid of it and don't count it.  */
        !           211:   tem = Fcar (list);
        !           212:   if (NULL (tem))
        !           213:     list = Fcdr (list);
        !           214: #endif
        !           215: 
        !           216:   while (arg > 0)
        !           217:     {
        !           218:       while (1)
        !           219:        {
        !           220:          Lisp_Object next, car, cdr;
        !           221:          next = Fcar (list);
        !           222:          list = Fcdr (list);
        !           223:          if (NULL (next))
        !           224:            break;
        !           225:          car = Fcar (next);
        !           226:          cdr = Fcdr (next);
        !           227:          if (EQ (car, Qt))
        !           228:            {
        !           229:              Lisp_Object high, low;
        !           230:              int mod_time;
        !           231:              high = Fcar (cdr);
        !           232:              low = Fcdr (cdr);
        !           233:              mod_time = (high << 16) + low;
        !           234:              /* If this records an obsolete save
        !           235:                 (not matching the actual disk file)
        !           236:                 then don't mark unmodified.  */
        !           237:              if (mod_time != current_buffer->modtime)
        !           238:                break;
        !           239: #ifdef CLASH_DETECTION
        !           240:              Funlock_buffer ();
        !           241: #endif /* CLASH_DETECTION */
        !           242:              Fset_buffer_modified_p (Qnil);
        !           243:            }
        !           244:          else if (XTYPE (car) == Lisp_Int && XTYPE (cdr) == Lisp_Int)
        !           245:            {
        !           246:              Lisp_Object end;
        !           247:              if (XINT (car) < BEGV
        !           248:                  || XINT (cdr) > ZV)
        !           249:                error ("Changes to be undone are outside visible portion of buffer");
        !           250:              Fdelete_region (car, cdr);
        !           251:              Fgoto_char (car);
        !           252:            }
        !           253:          else if (XTYPE (car) == Lisp_String && XTYPE (cdr) == Lisp_Int)
        !           254:            {
        !           255:              Lisp_Object membuf;
        !           256:              int pos = XINT (cdr);
        !           257:              membuf = car;
        !           258:              if (pos < 0)
        !           259:                {
        !           260:                  if (-pos < BEGV || -pos > ZV)
        !           261:                    error ("Changes to be undone are outside visible portion of buffer");
        !           262:                  SET_PT (-pos);
        !           263:                  Finsert (1, &membuf);
        !           264:                }
        !           265:              else
        !           266:                {
        !           267:                  if (pos < BEGV || pos > ZV)
        !           268:                    error ("Changes to be undone are outside visible portion of buffer");
        !           269:                  SET_PT (pos);
        !           270:                  /* The idea here is to leave mark after this text,
        !           271:                     which will be the desirable thing if undoing C-w.  */
        !           272:                  Finsert_before_markers (1, &membuf);
        !           273:                  SET_PT (pos);
        !           274:                }
        !           275:            }
        !           276:        }
        !           277:       arg--;
        !           278:     }
        !           279: 
        !           280:   return list;
        !           281: }
        !           282: 
        !           283: syms_of_undo ()
        !           284: {
        !           285:   defsubr (&Sprimitive_undo);
        !           286:   defsubr (&Sundo_boundary);
        !           287: }

This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.