4.3BSD - /usr/src/new/emacs/src/marker.c

   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: }

Defined functions