src/marker.c

   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 2, 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, Inc., 59 Temple Place - Suite 330,
  19 Boston, MA 02111-1307, USA.  */
  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       XSETBUFFER (buf, XMARKER (marker)->buffer);
  39       /* Return marker's buffer only if it is not dead.  */
  40       if (!NILP (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
  55   CHECK_MARKER (marker, 0);
  56   if (XMARKER (marker)->buffer)
  57     {
  58       buf = XMARKER (marker)->buffer;
  59       i = XMARKER (marker)->bufpos;
  60
  61       if (i > BUF_GPT (buf) + BUF_GAP_SIZE (buf))
  62         i -= BUF_GAP_SIZE (buf);
  63       else if (i > BUF_GPT (buf))
  64         i = BUF_GPT (buf);
  65
  66       if (i < BUF_BEG (buf) || i > BUF_Z (buf))
  67         abort ();
  68
  69       XSETFASTINT (pos, i);
  70       return pos;
  71     }
  72   return Qnil;
  73 }
  74 \f
  75 DEFUN ("set-marker", Fset_marker, Sset_marker, 2, 3, 0,
  76   "Position MARKER before character number POSITION in BUFFER.\n\
  77 BUFFER defaults to the current buffer.\n\
  78 If POSITION is nil, makes marker point nowhere.\n\
  79 Then it no longer slows down editing in any buffer.\n\
  80 Returns MARKER.")
  81   (marker, position, buffer)
  82      Lisp_Object marker, position, buffer;
  83 {
  84   register int charno;
  85   register struct buffer *b;
  86   register struct Lisp_Marker *m;
  87
  88   CHECK_MARKER (marker, 0);
  89   /* If position is nil or a marker that points nowhere,
  90      make this marker point nowhere.  */
  91   if (NILP (position)
  92       || (MARKERP (position) && !XMARKER (position)->buffer))
  93     {
  94       unchain_marker (marker);
  95       return marker;
  96     }
  97
  98   CHECK_NUMBER_COERCE_MARKER (position, 1);
  99   if (NILP (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           unchain_marker (marker);
 109           return marker;
 110         }
 111     }
 112
 113   charno = XINT (position);
 114   m = XMARKER (marker);
 115
 116   if (charno < BUF_BEG (b))
 117     charno = BUF_BEG (b);
 118   if (charno > BUF_Z (b))
 119     charno = BUF_Z (b);
 120   if (charno > BUF_GPT (b)) charno += BUF_GAP_SIZE (b);
 121   m->bufpos = charno;
 122
 123   if (m->buffer != b)
 124     {
 125       unchain_marker (marker);
 126       m->buffer = b;
 127       m->chain = BUF_MARKERS (b);
 128       BUF_MARKERS (b) = marker;
 129     }
 130
 131   return marker;
 132 }
 133
 134 /* This version of Fset_marker won't let the position
 135    be outside the visible part.  */
 136
 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 (NILP (pos) ||
 149       (MARKERP (pos) && !XMARKER (pos)->buffer))
 150     {
 151       unchain_marker (marker);
 152       return marker;
 153     }
 154
 155   CHECK_NUMBER_COERCE_MARKER (pos, 1);
 156   if (NILP (buffer))
 157     b = current_buffer;
 158   else
 159     {
 160       CHECK_BUFFER (buffer, 1);
 161       b = XBUFFER (buffer);
 162       /* If buffer is dead, set marker to point nowhere.  */
 163       if (EQ (b->name, Qnil))
 164         {
 165           unchain_marker (marker);
 166           return marker;
 167         }
 168     }
 169
 170   charno = XINT (pos);
 171   m = XMARKER (marker);
 172
 173   if (charno < BUF_BEGV (b))
 174     charno = BUF_BEGV (b);
 175   if (charno > BUF_ZV (b))
 176     charno = BUF_ZV (b);
 177   if (charno > BUF_GPT (b))
 178     charno += BUF_GAP_SIZE (b);
 179   m->bufpos = charno;
 180
 181   if (m->buffer != b)
 182     {
 183       unchain_marker (marker);
 184       m->buffer = b;
 185       m->chain = BUF_MARKERS (b);
 186       BUF_MARKERS (b) = marker;
 187     }
 188
 189   return marker;
 190 }
 191
 192 /* This is called during garbage collection,
 193    so we must be careful to ignore and preserve mark bits,
 194    including those in chain fields of markers.  */
 195
 196 unchain_marker (marker)
 197      register Lisp_Object marker;
 198 {
 199   register Lisp_Object tail, prev, next;
 200   register EMACS_INT omark;
 201   register struct buffer *b;
 202
 203   b = XMARKER (marker)->buffer;
 204   if (b == 0)
 205     return;
 206
 207   if (EQ (b->name, Qnil))
 208     abort ();
 209
 210   tail = BUF_MARKERS (b);
 211   prev = Qnil;
 212   while (XSYMBOL (tail) != XSYMBOL (Qnil))
 213     {
 214       next = XMARKER (tail)->chain;
 215       XUNMARK (next);
 216
 217       if (XMARKER (marker) == XMARKER (tail))
 218         {
 219           if (NILP (prev))
 220             {
 221               BUF_MARKERS (b) = next;
 222               /* Deleting first marker from the buffer's chain.  Crash
 223                  if new first marker in chain does not say it belongs
 224                  to the same buffer, or at least that they have the same
 225                  base buffer.  */
 226               if (!NILP (next) && b->text != XMARKER (next)->buffer->text)
 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 /* Return the buffer position of marker MARKER, as a C integer.  */
 245
 246 int
 247 marker_position (marker)
 248      Lisp_Object marker;
 249 {
 250   register struct Lisp_Marker *m = XMARKER (marker);
 251   register struct buffer *buf = m->buffer;
 252   register int i = m->bufpos;
 253
 254   if (!buf)
 255     error ("Marker does not point anywhere");
 256
 257   if (i > BUF_GPT (buf) + BUF_GAP_SIZE (buf))
 258     i -= BUF_GAP_SIZE (buf);
 259   else if (i > BUF_GPT (buf))
 260     i = BUF_GPT (buf);
 261
 262   if (i < BUF_BEG (buf) || i > BUF_Z (buf))
 263     abort ();
 264
 265   return i;
 266 }
 267 \f
 268 DEFUN ("copy-marker", Fcopy_marker, Scopy_marker, 1, 2, 0,
 269   "Return a new marker pointing at the same place as MARKER.\n\
 270 If argument is a number, makes a new marker pointing\n\
 271 at that position in the current buffer.\n\
 272 The optional argument TYPE specifies the insertion type of the new marker;\n\
 273 see `marker-insertion-type'.")
 274   (marker, type)
 275      register Lisp_Object marker, type;
 276 {
 277   register Lisp_Object new;
 278
 279   if (INTEGERP (marker) || MARKERP (marker))
 280     {
 281       new = Fmake_marker ();
 282       Fset_marker (new, marker,
 283                    (MARKERP (marker) ? Fmarker_buffer (marker) : Qnil));
 284       XMARKER (new)->insertion_type = !NILP (type);
 285       return new;
 286     }
 287   else
 288     marker = wrong_type_argument (Qinteger_or_marker_p, marker);
 289 }
 290
 291 DEFUN ("marker-insertion-type", Fmarker_insertion_type,
 292        Smarker_insertion_type, 1, 1, 0,
 293   "Return insertion type of MARKER: t if it stays after inserted text.\n\
 294 nil means the marker stays before text inserted there.")
 295   (marker)
 296      register Lisp_Object marker;
 297 {
 298   register Lisp_Object buf;
 299   CHECK_MARKER (marker, 0);
 300   return XMARKER (marker)->insertion_type ? Qt : Qnil;
 301 }
 302
 303 DEFUN ("set-marker-insertion-type", Fset_marker_insertion_type,
 304        Sset_marker_insertion_type, 2, 2, 0,
 305   "Set the insertion-type of MARKER to TYPE.\n\
 306 If TYPE is t, it means the marker advances when you insert text at it.\n\
 307 If TYPE is nil, it means the marker stays behind when you insert text at it.")
 308   (marker, type)
 309      Lisp_Object marker, type;
 310 {
 311   CHECK_MARKER (marker, 0);
 312
 313   XMARKER (marker)->insertion_type = ! NILP (type);
 314   return type;
 315 }
 316
 317 DEFUN ("buffer-has-markers-at", Fbuffer_has_markers_at, Sbuffer_has_markers_at,
 318   1, 1, 0,
 319   "Return t if there are markers pointing at POSITION in the currentbuffer.")
 320   (position)
 321       Lisp_Object position;
 322 {
 323   register Lisp_Object tail;
 324   register int charno;
 325
 326   charno = XINT (position);
 327
 328   if (charno < BEG)
 329     charno = BEG;
 330   if (charno > Z)
 331     charno = Z;
 332   if (charno > GPT) charno += GAP_SIZE;
 333
 334   for (tail = BUF_MARKERS (current_buffer);
 335        XSYMBOL (tail) != XSYMBOL (Qnil);
 336        tail = XMARKER (tail)->chain)
 337     if (XMARKER (tail)->bufpos == charno)
 338       return Qt;
 339
 340   return Qnil;
 341 }
 342 \f
 343 syms_of_marker ()
 344 {
 345   defsubr (&Smarker_position);
 346   defsubr (&Smarker_buffer);
 347   defsubr (&Sset_marker);
 348   defsubr (&Scopy_marker);
 349   defsubr (&Smarker_insertion_type);
 350   defsubr (&Sset_marker_insertion_type);
 351   defsubr (&Sbuffer_has_markers_at);
 352 }