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 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       XSETBUFFER (buf, XMARKER (marker)->buffer);
  38       /* Return marker's buffer only if it is not dead.  */
  39       if (!NILP (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       XSETFASTINT (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 (NILP (pos)
  91       || (MARKERP (pos) && !XMARKER (pos)->buffer))
  92     {
  93       unchain_marker (marker);
  94       return marker;
  95     }
  96
  97   CHECK_NUMBER_COERCE_MARKER (pos, 1);
  98   if (NILP (buffer))
  99     b = current_buffer;
 100   else
 101     {
 102       CHECK_BUFFER (buffer, 1);
 103       b = XBUFFER (buffer);
 104       /* If buffer is dead, set marker to point nowhere.  */
 105       if (EQ (b->name, Qnil))
 106         {
 107           unchain_marker (marker);
 108           return marker;
 109         }
 110     }
 111
 112   charno = XINT (pos);
 113   m = XMARKER (marker);
 114
 115   if (charno < BUF_BEG (b))
 116     charno = BUF_BEG (b);
 117   if (charno > BUF_Z (b))
 118     charno = BUF_Z (b);
 119   if (charno > BUF_GPT (b)) charno += BUF_GAP_SIZE (b);
 120   m->bufpos = charno;
 121
 122   if (m->buffer != b)
 123     {
 124       unchain_marker (marker);
 125       m->buffer = b;
 126       m->chain = BUF_MARKERS (b);
 127       BUF_MARKERS (b) = marker;
 128     }
 129
 130   return marker;
 131 }
 132
 133 /* This version of Fset_marker won't let the position
 134    be outside the visible part.  */
 135
 136 Lisp_Object
 137 set_marker_restricted (marker, pos, buffer)
 138      Lisp_Object marker, pos, buffer;
 139 {
 140   register int charno;
 141   register struct buffer *b;
 142   register struct Lisp_Marker *m;
 143
 144   CHECK_MARKER (marker, 0);
 145   /* If position is nil or a marker that points nowhere,
 146      make this marker point nowhere.  */
 147   if (NILP (pos) ||
 148       (MARKERP (pos) && !XMARKER (pos)->buffer))
 149     {
 150       unchain_marker (marker);
 151       return marker;
 152     }
 153
 154   CHECK_NUMBER_COERCE_MARKER (pos, 1);
 155   if (NILP (buffer))
 156     b = current_buffer;
 157   else
 158     {
 159       CHECK_BUFFER (buffer, 1);
 160       b = XBUFFER (buffer);
 161       /* If buffer is dead, set marker to point nowhere.  */
 162       if (EQ (b->name, Qnil))
 163         {
 164           unchain_marker (marker);
 165           return marker;
 166         }
 167     }
 168
 169   charno = XINT (pos);
 170   m = XMARKER (marker);
 171
 172   if (charno < BUF_BEGV (b))
 173     charno = BUF_BEGV (b);
 174   if (charno > BUF_ZV (b))
 175     charno = BUF_ZV (b);
 176   if (charno > BUF_GPT (b))
 177     charno += BUF_GAP_SIZE (b);
 178   m->bufpos = charno;
 179
 180   if (m->buffer != b)
 181     {
 182       unchain_marker (marker);
 183       m->buffer = b;
 184       m->chain = BUF_MARKERS (b);
 185       BUF_MARKERS (b) = marker;
 186     }
 187
 188   return marker;
 189 }
 190
 191 /* This is called during garbage collection,
 192    so we must be careful to ignore and preserve mark bits,
 193    including those in chain fields of markers.  */
 194
 195 unchain_marker (marker)
 196      register Lisp_Object marker;
 197 {
 198   register Lisp_Object tail, prev, next;
 199   register EMACS_INT omark;
 200   register struct buffer *b;
 201
 202   b = XMARKER (marker)->buffer;
 203   if (b == 0)
 204     return;
 205
 206   if (EQ (b->name, Qnil))
 207     abort ();
 208
 209   tail = BUF_MARKERS (b);
 210   prev = Qnil;
 211   while (XSYMBOL (tail) != XSYMBOL (Qnil))
 212     {
 213       next = XMARKER (tail)->chain;
 214       XUNMARK (next);
 215
 216       if (XMARKER (marker) == XMARKER (tail))
 217         {
 218           if (NILP (prev))
 219             {
 220               BUF_MARKERS (b) = next;
 221               /* Deleting first marker from the buffer's chain.  Crash
 222                  if new first marker in chain does not say it belongs
 223                  to the same buffer (or one of its indirect buffers).  */
 224               if (!NILP (next) && b != XMARKER (next)->buffer)
 225                 abort ();
 226             }
 227           else
 228             {
 229               omark = XMARKBIT (XMARKER (prev)->chain);
 230               XMARKER (prev)->chain = next;
 231               XSETMARKBIT (XMARKER (prev)->chain, omark);
 232             }
 233           break;
 234         }
 235       else
 236         prev = tail;
 237       tail = next;
 238     }
 239   XMARKER (marker)->buffer = 0;
 240 }
 241
 242 /* Return the buffer position of marker MARKER, as a C integer.  */
 243
 244 int
 245 marker_position (marker)
 246      Lisp_Object marker;
 247 {
 248   register struct Lisp_Marker *m = XMARKER (marker);
 249   register struct buffer *buf = m->buffer;
 250   register int i = m->bufpos;
 251
 252   if (!buf)
 253     error ("Marker does not point anywhere");
 254
 255   if (i > BUF_GPT (buf) + BUF_GAP_SIZE (buf))
 256     i -= BUF_GAP_SIZE (buf);
 257   else if (i > BUF_GPT (buf))
 258     i = BUF_GPT (buf);
 259
 260   if (i < BUF_BEG (buf) || i > BUF_Z (buf))
 261     abort ();
 262
 263   return i;
 264 }
 265
 266 DEFUN ("copy-marker", Fcopy_marker, Scopy_marker, 1, 1, 0,
 267   "Return a new marker pointing at the same place as MARKER.\n\
 268 If argument is a number, makes a new marker pointing\n\
 269 at that position in the current buffer.")
 270   (marker)
 271      register Lisp_Object marker;
 272 {
 273   register Lisp_Object new;
 274
 275   while (1)
 276     {
 277       if (INTEGERP (marker) || MARKERP (marker))
 278         {
 279           new = Fmake_marker ();
 280           Fset_marker (new, marker,
 281                        (MARKERP (marker) ? Fmarker_buffer (marker) : Qnil));
 282           return new;
 283         }
 284       else
 285         marker = wrong_type_argument (Qinteger_or_marker_p, marker);
 286     }
 287 }
 288 \f
 289 syms_of_marker ()
 290 {
 291   defsubr (&Smarker_position);
 292   defsubr (&Smarker_buffer);
 293   defsubr (&Sset_marker);
 294   defsubr (&Scopy_marker);
 295 }