Return to marker.c CVS log

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

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

1.1     ! root        1: /* Markers: examining, setting and killing.
        !             2:    Copyright (C) 1985 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: /* Operations on markers. */
        !            26: 
        !            27: DEFUN ("marker-buffer", Fmarker_buffer, Smarker_buffer, 1, 1, 0,
        !            28:   "Return the buffer that MARKER points into, or nil if none.\n\
        !            29: Returns nil if MARKER points into a dead buffer.")
        !            30:   (marker)
        !            31:      register Lisp_Object marker;
        !            32: {
        !            33:   register Lisp_Object buf;
        !            34:   CHECK_MARKER (marker, 0);
        !            35:   if (XMARKER (marker)->buffer)
        !            36:     {
        !            37:       XSET (buf, Lisp_Buffer, XMARKER (marker)->buffer);
        !            38:       /* Return marker's buffer only if it is not dead.  */
        !            39:       if (!NULL (XBUFFER (buf)->name))
        !            40:        return buf;
        !            41:     }
        !            42:   return Qnil;
        !            43: }
        !            44: 
        !            45: DEFUN ("marker-position", Fmarker_position, Smarker_position, 1, 1, 0,
        !            46:   "Return the position MARKER points at, as a character number.")
        !            47:   (marker)
        !            48:      Lisp_Object marker;
        !            49: {
        !            50:   register Lisp_Object pos;
        !            51:   register int i;
        !            52:   register struct buffer *buf;
        !            53: 
        !            54:   CHECK_MARKER (marker, 0);
        !            55:   if (XMARKER (marker)->buffer)
        !            56:     {
        !            57:       buf = XMARKER (marker)->buffer;
        !            58:       i = XMARKER (marker)->bufpos;
        !            59: 
        !            60:       if (i > BUF_GPT (buf) + BUF_GAP_SIZE (buf))
        !            61:        i -= BUF_GAP_SIZE (buf);
        !            62:       else if (i > BUF_GPT (buf))
        !            63:        i = BUF_GPT (buf);
        !            64: 
        !            65:       if (i < BUF_BEG (buf) || i > BUF_Z (buf))
        !            66:        abort ();
        !            67: 
        !            68:       XFASTINT (pos) = i;
        !            69:       return pos;
        !            70:     }
        !            71:   return Qnil;
        !            72: }
        !            73: 
        !            74: DEFUN ("set-marker", Fset_marker, Sset_marker, 2, 3, 0,
        !            75:   "Position MARKER before character number NUMBER in BUFFER.\n\
        !            76: BUFFER defaults to the current buffer.\n\
        !            77: If NUMBER is nil, makes marker point nowhere.\n\
        !            78: Then it no longer slows down editing in any buffer.\n\
        !            79: Returns MARKER.")
        !            80:   (marker, pos, buffer)
        !            81:      Lisp_Object marker, pos, buffer;
        !            82: {
        !            83:   register int charno;
        !            84:   register struct buffer *b;
        !            85:   register struct Lisp_Marker *m;
        !            86: 
        !            87:   CHECK_MARKER (marker, 0);
        !            88:   /* If position is nil or a marker that points nowhere,
        !            89:      make this marker point nowhere.  */
        !            90:   if (NULL (pos) ||
        !            91:       (XTYPE (pos) == Lisp_Marker && !XMARKER (pos)->buffer))
        !            92:     {
        !            93:       if (XMARKER (marker)->buffer)
        !            94:        unchain_marker (marker);
        !            95:       return marker;
        !            96:     }
        !            97: 
        !            98:   CHECK_NUMBER_COERCE_MARKER (pos, 1);
        !            99:   if (NULL (buffer))
        !           100:     b = current_buffer;
        !           101:   else
        !           102:     {
        !           103:       CHECK_BUFFER (buffer, 1);
        !           104:       b = XBUFFER (buffer);
        !           105:       /* If buffer is dead, set marker to point nowhere.  */
        !           106:       if (EQ (b->name, Qnil))
        !           107:        {
        !           108:          if (XMARKER (marker)->buffer)
        !           109:            unchain_marker (marker);
        !           110:          return marker;
        !           111:        }
        !           112:     }
        !           113: 
        !           114:   charno = XINT (pos);
        !           115:   m = XMARKER (marker);
        !           116: 
        !           117:   if (charno < BUF_BEG (b))
        !           118:     charno = BUF_BEG (b);
        !           119:   if (charno > BUF_Z (b))
        !           120:     charno = BUF_Z (b);
        !           121:   if (charno > BUF_GPT (b)) charno += BUF_GAP_SIZE (b);
        !           122:   m->bufpos = charno;
        !           123: 
        !           124:   if (m->buffer != b)
        !           125:     {
        !           126:       if (m->buffer != 0)
        !           127:        unchain_marker (marker);
        !           128:       m->chain = b->markers;
        !           129:       b->markers = marker;
        !           130:       m->buffer = b;
        !           131:     }
        !           132:   
        !           133:   return marker;
        !           134: }
        !           135: 
        !           136: /* This version of Fset_marker won't let the position be outside the visible part.  */
        !           137: Lisp_Object 
        !           138: set_marker_restricted (marker, pos, buffer)
        !           139:      Lisp_Object marker, pos, buffer;
        !           140: {
        !           141:   register int charno;
        !           142:   register struct buffer *b;
        !           143:   register struct Lisp_Marker *m;
        !           144: 
        !           145:   CHECK_MARKER (marker, 0);
        !           146:   /* If position is nil or a marker that points nowhere,
        !           147:      make this marker point nowhere.  */
        !           148:   if (NULL (pos) ||
        !           149:       (XTYPE (pos) == Lisp_Marker && !XMARKER (pos)->buffer))
        !           150:     {
        !           151:       if (XMARKER (marker)->buffer)
        !           152:        unchain_marker (marker);
        !           153:       return marker;
        !           154:     }
        !           155: 
        !           156:   CHECK_NUMBER_COERCE_MARKER (pos, 1);
        !           157:   if (NULL (buffer))
        !           158:     b = current_buffer;
        !           159:   else
        !           160:     {
        !           161:       CHECK_BUFFER (buffer, 1);
        !           162:       b = XBUFFER (buffer);
        !           163:       /* If buffer is dead, set marker to point nowhere.  */
        !           164:       if (EQ (b->name, Qnil))
        !           165:        {
        !           166:          if (XMARKER (marker)->buffer)
        !           167:            unchain_marker (marker);
        !           168:          return marker;
        !           169:        }
        !           170:     }
        !           171: 
        !           172:   charno = XINT (pos);
        !           173:   m = XMARKER (marker);
        !           174: 
        !           175:   if (charno < BUF_BEGV (b))
        !           176:     charno = BUF_BEGV (b);
        !           177:   if (charno > BUF_ZV (b))
        !           178:     charno = BUF_ZV (b);
        !           179:   if (charno > BUF_GPT (b))
        !           180:     charno += BUF_GAP_SIZE (b);
        !           181:   m->bufpos = charno;
        !           182: 
        !           183:   if (m->buffer != b)
        !           184:     {
        !           185:       if (m->buffer != 0)
        !           186:        unchain_marker (marker);
        !           187:       m->chain = b->markers;
        !           188:       b->markers = marker;
        !           189:       m->buffer = b;
        !           190:     }
        !           191:   
        !           192:   return marker;
        !           193: }
        !           194: 
        !           195: /* This is called during garbage collection,
        !           196:  so we must be careful to ignore and preserve mark bits,
        !           197:  including those in chain fields of markers.  */
        !           198: 
        !           199: unchain_marker (marker)
        !           200:      register Lisp_Object marker;
        !           201: {
        !           202:   register Lisp_Object tail, prev, next;
        !           203:   register int omark;
        !           204:   register struct buffer *b;
        !           205: 
        !           206:   b = XMARKER (marker)->buffer;
        !           207: 
        !           208:   if (EQ (b->name, Qnil))
        !           209:     abort ();
        !           210: 
        !           211:   tail = b->markers;
        !           212:   prev = Qnil;
        !           213:   while (XSYMBOL (tail) != XSYMBOL (Qnil))
        !           214:     {
        !           215:       next = XMARKER (tail)->chain;
        !           216:       XUNMARK (next);
        !           217: 
        !           218:       if (XMARKER (marker) == XMARKER (tail))
        !           219:        {
        !           220:          if (NULL (prev))
        !           221:            {
        !           222:              b->markers = next;
        !           223:              /* Deleting first marker from the buffer's chain.
        !           224:                 Crash if new first marker in chain does not say
        !           225:                 it belongs to this buffer.  */
        !           226:              if (!EQ (next, Qnil) && b != XMARKER (next)->buffer)
        !           227:                abort ();
        !           228:            }
        !           229:          else
        !           230:            {
        !           231:              omark = XMARKBIT (XMARKER (prev)->chain);
        !           232:              XMARKER (prev)->chain = next;
        !           233:              XSETMARKBIT (XMARKER (prev)->chain, omark);
        !           234:            }
        !           235:          break;
        !           236:        }
        !           237:       else
        !           238:        prev = tail;
        !           239:       tail = next;
        !           240:     }
        !           241:   XMARKER (marker)->buffer = 0;
        !           242: }
        !           243: 
        !           244: marker_position (marker)
        !           245:      Lisp_Object marker;
        !           246: {
        !           247:   register struct Lisp_Marker *m = XMARKER (marker);
        !           248:   register struct buffer *buf = m->buffer;
        !           249:   register int i = m->bufpos;
        !           250: 
        !           251:   if (!buf)
        !           252:     error ("Marker does not point anywhere");
        !           253: 
        !           254:   if (i > BUF_GPT (buf) + BUF_GAP_SIZE (buf))
        !           255:     i -= BUF_GAP_SIZE (buf);
        !           256:   else if (i > BUF_GPT (buf))
        !           257:     i = BUF_GPT (buf);
        !           258: 
        !           259:   if (i < BUF_BEG (buf) || i > BUF_Z (buf))
        !           260:     abort ();
        !           261: 
        !           262:   return i;
        !           263: }
        !           264: 
        !           265: DEFUN ("copy-marker", Fcopy_marker, Scopy_marker, 1, 1, 0,
        !           266:   "Return a new marker pointing at the same place as MARKER.\n\
        !           267: If argument is a number, makes a new marker pointing\n\
        !           268: at that position in the current buffer.")
        !           269:   (marker)
        !           270:      register Lisp_Object marker;
        !           271: {
        !           272:   register Lisp_Object new;
        !           273: 
        !           274:   while (1)
        !           275:     {
        !           276:       if (XTYPE (marker) == Lisp_Int ||
        !           277:          XTYPE (marker) == Lisp_Marker)
        !           278:        {
        !           279:          new = Fmake_marker ();
        !           280:          Fset_marker (new, marker,
        !           281:                       ((XTYPE (marker) == Lisp_Marker)
        !           282:                        ? Fmarker_buffer (marker)
        !           283:                        : Qnil));
        !           284:          return new;
        !           285:        }
        !           286:       else
        !           287:        marker = wrong_type_argument (Qinteger_or_marker_p, marker);
        !           288:     }
        !           289: }
        !           290: 
        !           291: syms_of_marker ()
        !           292: {
        !           293:   defsubr (&Smarker_position);
        !           294:   defsubr (&Smarker_buffer);
        !           295:   defsubr (&Sset_marker);
        !           296:   defsubr (&Scopy_marker);
        !           297: }

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