Annotation of 43BSDReno/contrib/emacs-18.55/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 distributed in the hope that it will be useful,
        !             7: but WITHOUT ANY WARRANTY.  No author or distributor
        !             8: accepts responsibility to anyone for the consequences of using it
        !             9: or for whether it serves any particular purpose or works at all,
        !            10: unless he says so in writing.  Refer to the GNU Emacs General Public
        !            11: License for full details.
        !            12: 
        !            13: Everyone is granted permission to copy, modify and redistribute
        !            14: GNU Emacs, but only under the conditions described in the
        !            15: GNU Emacs General Public License.   A copy of this license is
        !            16: supposed to have been given to you along with GNU Emacs so you
        !            17: can know your rights and responsibilities.  It should be in a
        !            18: file named COPYING.  Among other things, the copyright notice
        !            19: and this notice must be preserved on all copies.  */
        !            20: 
        !            21: 
        !            22: #include "config.h"
        !            23: #include "lisp.h"
        !            24: #include "buffer.h"
        !            25: 
        !            26: /* Operations on markers. */
        !            27: 
        !            28: DEFUN ("marker-buffer", Fmarker_buffer, Smarker_buffer, 1, 1, 0,
        !            29:   "Return the buffer that MARKER points into, or nil if none.\n\
        !            30: Returns nil if MARKER points into a dead buffer.")
        !            31:   (marker)
        !            32:      register Lisp_Object marker;
        !            33: {
        !            34:   register Lisp_Object buf;
        !            35:   CHECK_MARKER (marker, 0);
        !            36:   if (XMARKER (marker)->buffer)
        !            37:     {
        !            38:       XSET (buf, Lisp_Buffer, XMARKER (marker)->buffer);
        !            39:       /* Return marker's buffer only if it is not dead.  */
        !            40:       if (!NULL (XBUFFER (buf)->name))
        !            41:        return buf;
        !            42:     }
        !            43:   return Qnil;
        !            44: }
        !            45: 
        !            46: DEFUN ("marker-position", Fmarker_position, Smarker_position, 1, 1, 0,
        !            47:   "Return the position MARKER points at, as a character number.")
        !            48:   (marker)
        !            49:      Lisp_Object marker;
        !            50: {
        !            51:   register Lisp_Object pos;
        !            52:   register int i;
        !            53:   register struct buffer *buf;
        !            54:   register struct buffer_text *text;
        !            55: 
        !            56:   CHECK_MARKER (marker, 0);
        !            57:   if (XMARKER (marker)->buffer)
        !            58:     {
        !            59:       buf = XMARKER (marker)->buffer;
        !            60:       i = XMARKER (marker)->bufpos;
        !            61:       text = (buf == bf_cur) ? &bf_text : &buf->text;
        !            62: 
        !            63:       if (i > text->size1 + text->gap + 1)
        !            64:        i -= text->gap;
        !            65:       else if (i > text->size1 + 1)
        !            66:        i = text->size1 + 1;
        !            67: 
        !            68:       if (i < 1 || i > text->size1 + text->size2 + 1)
        !            69:        abort ();
        !            70: 
        !            71:       XFASTINT (pos) = i;
        !            72:       return pos;
        !            73:     }
        !            74:   return Qnil;
        !            75: }
        !            76: 
        !            77: DEFUN ("set-marker", Fset_marker, Sset_marker, 2, 3, 0,
        !            78:   "Position MARKER before character number NUMBER in BUFFER.\n\
        !            79: BUFFER defaults to the current buffer.\n\
        !            80: If NUMBER is nil, makes marker point nowhere.\n\
        !            81: Then it no longer slows down editing in any buffer.\n\
        !            82: Returns MARKER.")
        !            83:   (marker, pos, buffer)
        !            84:      Lisp_Object marker, pos, buffer;
        !            85: {
        !            86:   register int charno;
        !            87:   register struct buffer *b;
        !            88:   register struct buffer_text *text;
        !            89:   register struct Lisp_Marker *m;
        !            90: 
        !            91:   CHECK_MARKER (marker, 0);
        !            92:   /* If position is nil or a marker that points nowhere,
        !            93:      make this marker point nowhere.  */
        !            94:   if (NULL (pos) ||
        !            95:       (XTYPE (pos) == Lisp_Marker && !XMARKER (pos)->buffer))
        !            96:     {
        !            97:       unchain_marker (marker);
        !            98:       XMARKER (marker)->buffer = 0;
        !            99:       return marker;
        !           100:     }
        !           101: 
        !           102:   CHECK_NUMBER_COERCE_MARKER (pos, 1);
        !           103:   if (NULL (buffer))
        !           104:     b = bf_cur;
        !           105:   else
        !           106:     {
        !           107:       CHECK_BUFFER (buffer, 1);
        !           108:       b = XBUFFER (buffer);
        !           109:       /* If buffer is dead, set marker to point nowhere.  */
        !           110:       if (EQ (b->name, Qnil))
        !           111:        {
        !           112:          unchain_marker (marker);
        !           113:          return marker;
        !           114:        }
        !           115:     }
        !           116: 
        !           117:   charno = XINT (pos);
        !           118:   m = XMARKER (marker);
        !           119: 
        !           120:   if (bf_cur == b)
        !           121:     text = &bf_text;
        !           122:   else
        !           123:     text = &b->text;
        !           124: 
        !           125:   if (charno < text->head_clip) charno = text->head_clip;
        !           126:   if (charno > text->size1 + text->size2 + 1 - text->tail_clip)
        !           127:     charno = text->size1 + text->size2 + 1 - text->tail_clip;
        !           128:   if (charno > text->size1 + 1) charno += text->gap;
        !           129:   m->bufpos = charno;
        !           130: 
        !           131:   if (m->buffer != b)
        !           132:     {
        !           133:       unchain_marker (marker);
        !           134:       m->chain = b->markers;
        !           135:       b->markers = marker;
        !           136:       m->buffer = b;
        !           137:     }
        !           138:   
        !           139:   return marker;
        !           140: }
        !           141: 
        !           142: /* This is called during garbage collection,
        !           143:  so we must be careful to ignore and preserve mark bits,
        !           144:  including those in chain fields of markers.  */
        !           145: 
        !           146: unchain_marker (marker)
        !           147:      register Lisp_Object marker;
        !           148: {
        !           149:   register Lisp_Object tail, prev, next;
        !           150:   register int omark;
        !           151:   register struct buffer *b;
        !           152: 
        !           153:   b = XMARKER (marker)->buffer;
        !           154:   if (b == 0)
        !           155:     return;
        !           156: 
        !           157:   if (EQ (b->name, Qnil))
        !           158:     abort ();
        !           159: 
        !           160:   tail = b->markers;
        !           161:   prev = Qnil;
        !           162:   while (XSYMBOL (tail) != XSYMBOL (Qnil))
        !           163:     {
        !           164:       next = XMARKER (tail)->chain;
        !           165:       XUNMARK (next);
        !           166: 
        !           167:       if (XMARKER (marker) == XMARKER (tail))
        !           168:        {
        !           169:          if (NULL (prev))
        !           170:            {
        !           171:              b->markers = next;
        !           172:              /* Deleting first marker from the buffer's chain.
        !           173:                 Crash if new first marker in chain does not say
        !           174:                 it belongs to this buffer.  */
        !           175:              if (!EQ (next, Qnil) && b != XMARKER (next)->buffer)
        !           176:                abort ();
        !           177:            }
        !           178:          else
        !           179:            {
        !           180:              omark = XMARKBIT (XMARKER (prev)->chain);
        !           181:              XMARKER (prev)->chain = next;
        !           182:              XSETMARKBIT (XMARKER (prev)->chain, omark);
        !           183:            }
        !           184:          break;
        !           185:        }
        !           186:       else
        !           187:        prev = tail;
        !           188:       tail = next;
        !           189:     }
        !           190:   XMARKER (marker)->buffer = 0;
        !           191: }
        !           192: 
        !           193: marker_position (marker)
        !           194:      Lisp_Object marker;
        !           195: {
        !           196:   register struct Lisp_Marker *m = XMARKER (marker);
        !           197:   register struct buffer *buf = m->buffer;
        !           198:   register int i = m->bufpos;
        !           199:   register struct buffer_text *text
        !           200:     = (buf == bf_cur) ? &bf_text : &buf->text;
        !           201: 
        !           202:   if (!buf)
        !           203:     error ("Marker does not point anywhere");
        !           204: 
        !           205:   if (i > text->size1 + text->gap + 1)
        !           206:     i -= text->gap;
        !           207:   else if (i > text->size1 + 1)
        !           208:     i = text->size1 + 1;
        !           209: 
        !           210:   if (i < 1 || i > text->size1 + text->size2 + 1)
        !           211:     abort ();
        !           212: 
        !           213:   return i;
        !           214: }
        !           215: 
        !           216: DEFUN ("copy-marker", Fcopy_marker, Scopy_marker, 1, 1, 0,
        !           217:   "Return a new marker pointing at the same place as MARKER.\n\
        !           218: If argument is a number, makes a new marker pointing\n\
        !           219: at that position in the current buffer.")
        !           220:   (marker)
        !           221:      register Lisp_Object marker;
        !           222: {
        !           223:   register Lisp_Object new;
        !           224: 
        !           225:   while (1)
        !           226:     {
        !           227:       if (XTYPE (marker) == Lisp_Int ||
        !           228:          XTYPE (marker) == Lisp_Marker)
        !           229:        {
        !           230:          new = Fmake_marker ();
        !           231:          Fset_marker (new, marker,
        !           232:                       ((XTYPE (marker) == Lisp_Marker)
        !           233:                        ? Fmarker_buffer (marker)
        !           234:                        : Qnil));
        !           235:          return new;
        !           236:        }
        !           237:       else
        !           238:        marker = wrong_type_argument (Qinteger_or_marker_p, marker);
        !           239:     }
        !           240: }
        !           241: 
        !           242: syms_of_marker ()
        !           243: {
        !           244:   defsubr (&Smarker_position);
        !           245:   defsubr (&Smarker_buffer);
        !           246:   defsubr (&Sset_marker);
        !           247:   defsubr (&Scopy_marker);
        !           248: }

unix.superglobalmegacorp.com

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