Annotation of 43BSD/contrib/emacs/src/marker.c, revision 1.1

1.1     ! root        1: /* Markers: examining, setting and killing.
        !             2:    Copyright (C) 1985 Richard M. Stallman.
        !             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:      Lisp_Object marker;
        !            33: {
        !            34:   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:   Lisp_Object pos;
        !            52:   int i;
        !            53:   struct buffer *buf;
        !            54:   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:   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 (NULL (pos))
        !            93:     {
        !            94:       unchain_marker (marker);
        !            95:       XMARKER (marker)->buffer = 0;
        !            96:       return marker;
        !            97:     }
        !            98: 
        !            99:   CHECK_NUMBER_COERCE_MARKER (pos, 1);
        !           100:   if (NULL (buffer))
        !           101:     b = bf_cur;
        !           102:   else
        !           103:     {
        !           104:       CHECK_BUFFER (buffer, 1);
        !           105:       b = XBUFFER (buffer);
        !           106:     }
        !           107: 
        !           108:   charno = XINT (pos);
        !           109:   m = XMARKER (marker);
        !           110: 
        !           111:   if (bf_cur == b)
        !           112:     text = &bf_text;
        !           113:   else
        !           114:     text = &b->text;
        !           115: 
        !           116:   if (charno < text->head_clip) charno = text->head_clip;
        !           117:   if (charno > text->size1 + text->size2 + 1 - text->tail_clip)
        !           118:     charno = text->size1 + text->size2 + 1 - text->tail_clip;
        !           119:   if (charno > text->size1 + 1) charno += text->gap;
        !           120:   m->bufpos = charno;
        !           121: 
        !           122:   if (m->buffer != b)
        !           123:     {
        !           124:       unchain_marker (marker);
        !           125:       m->chain = b->markers;
        !           126:       b->markers = marker;
        !           127:       m->buffer = b;
        !           128:     }
        !           129:   
        !           130:   return marker;
        !           131: }
        !           132: 
        !           133: /* This is called during garbage collection,
        !           134:  so we must be careful to ignore and preserve mark bits,
        !           135:  including those in chain fields of markers.  */
        !           136: 
        !           137: unchain_marker (marker)
        !           138:      Lisp_Object marker;
        !           139: {
        !           140:   Lisp_Object tail, prev, next;
        !           141:   register int omark;
        !           142: 
        !           143:   if (!XMARKER (marker)->buffer)
        !           144:     return;
        !           145: 
        !           146:   tail = XMARKER (marker)->buffer->markers;
        !           147:   prev = Qnil;
        !           148:   while (XSYMBOL (tail) != XSYMBOL (Qnil))
        !           149:     {
        !           150:       next = XMARKER (tail)->chain;
        !           151:       XUNMARK (next);
        !           152: 
        !           153:       if (XMARKER (marker) == XMARKER (tail))
        !           154:        {
        !           155:          if (NULL (prev))
        !           156:            XMARKER (marker)->buffer->markers = next;
        !           157:          else
        !           158:            {
        !           159:              omark = XMARKBIT (XMARKER (prev)->chain);
        !           160:              XMARKER (prev)->chain = next;
        !           161:              XSETMARKBIT (XMARKER (prev)->chain, omark);
        !           162:            }
        !           163:          break;
        !           164:        }
        !           165:       else
        !           166:        prev = tail;
        !           167:       tail = next;
        !           168:     }
        !           169:   XMARKER (marker)->buffer = 0;
        !           170: }
        !           171: 
        !           172: marker_position (marker)
        !           173:      Lisp_Object marker;
        !           174: {
        !           175:   register struct Lisp_Marker *m = XMARKER (marker);
        !           176:   register struct buffer *buf = m->buffer;
        !           177:   register int i = m->bufpos;
        !           178:   register struct buffer_text *text
        !           179:     = (buf == bf_cur) ? &bf_text : &buf->text;
        !           180: 
        !           181:   if (!buf)
        !           182:     error ("Marker does not point anywhere");
        !           183: 
        !           184:   if (i > text->size1 + text->gap + 1)
        !           185:     i -= text->gap;
        !           186:   else if (i > text->size1 + 1)
        !           187:     i = text->size1 + 1;
        !           188: 
        !           189:   if (i < 1 || i > text->size1 + text->size2 + 1)
        !           190:     abort ();
        !           191: 
        !           192:   return i;
        !           193: }
        !           194: 
        !           195: DEFUN ("copy-marker", Fcopy_marker, Scopy_marker, 1, 1, 0,
        !           196:   "Return a new marker pointing at the same place as MARKER.\n\
        !           197: If argument is a number, makes a new marker pointing\n\
        !           198: at that position in the current buffer.")
        !           199:   (marker)
        !           200:      Lisp_Object marker;
        !           201: {
        !           202:   Lisp_Object new;
        !           203: 
        !           204:   while (1)
        !           205:     {
        !           206:       if (XTYPE (marker) == Lisp_Int
        !           207:          || XTYPE (marker) == Lisp_Marker)
        !           208:        {
        !           209:          new = Fmake_marker ();
        !           210:          Fset_marker (new, marker,
        !           211:                       XTYPE (marker) == Lisp_Marker
        !           212:                       ? Fmarker_buffer (marker)
        !           213:                       : Qnil);
        !           214:          return new;
        !           215:        }
        !           216:       else
        !           217:        marker = wrong_type_argument (Qinteger_or_marker_p, marker);
        !           218:     }
        !           219: }
        !           220: 
        !           221: syms_of_marker ()
        !           222: {
        !           223:   defsubr (&Smarker_position);
        !           224:   defsubr (&Smarker_buffer);
        !           225:   defsubr (&Sset_marker);
        !           226:   defalias (&Sset_marker, "move-marker");
        !           227:   defsubr (&Scopy_marker);
        !           228: }

unix.superglobalmegacorp.com

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