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       XSET (buf, Lisp_Buffer, XMARKER (marker)->buffer);
  38       /* Return marker's buffer only if it is not dead.  */
  39       if (!NULL (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       XFASTINT (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 (NULL (pos)
  91       || (XTYPE (pos) == Lisp_Marker && !XMARKER (pos)->buffer))
  92     {
  93       unchain_marker (marker);
  94       return marker;
  95     }
  96
  97   CHECK_NUMBER_COERCE_MARKER (pos, 1);
  98   if (NULL (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->chain = b->markers;
 126       b->markers = marker;
 127       m->buffer = b;
 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 (NULL (pos) ||
 148       (XTYPE (pos) == Lisp_Marker && !XMARKER (pos)->buffer))
 149     {
 150       unchain_marker (marker);
 151       return marker;
 152     }
 153
 154   CHECK_NUMBER_COERCE_MARKER (pos, 1);
 155   if (NULL (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->chain = b->markers;
 184       b->markers = marker;
 185       m->buffer = b;
 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 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 = b->markers;
 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 (NULL (prev))
 219             {
 220               b->markers = next;
 221               /* Deleting first marker from the buffer's chain.
 222                  Crash if new first marker in chain does not say
 223                  it belongs to this buffer.  */
 224               if (!EQ (next, Qnil) && 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 marker_position (marker)
 243      Lisp_Object marker;
 244 {
 245   register struct Lisp_Marker *m = XMARKER (marker);
 246   register struct buffer *buf = m->buffer;
 247   register int i = m->bufpos;
 248
 249   if (!buf)
 250     error ("Marker does not point anywhere");
 251
 252   if (i > BUF_GPT (buf) + BUF_GAP_SIZE (buf))
 253     i -= BUF_GAP_SIZE (buf);
 254   else if (i > BUF_GPT (buf))
 255     i = BUF_GPT (buf);
 256
 257   if (i < BUF_BEG (buf) || i > BUF_Z (buf))
 258     abort ();
 259
 260   return i;
 261 }
 262
 263 DEFUN ("copy-marker", Fcopy_marker, Scopy_marker, 1, 1, 0,
 264   "Return a new marker pointing at the same place as MARKER.\n\
 265 If argument is a number, makes a new marker pointing\n\
 266 at that position in the current buffer.")
 267   (marker)
 268      register Lisp_Object marker;
 269 {
 270   register Lisp_Object new;
 271
 272   while (1)
 273     {
 274       if (XTYPE (marker) == Lisp_Int
 275           || XTYPE (marker) == Lisp_Marker)
 276         {
 277           new = Fmake_marker ();
 278           Fset_marker (new, marker,
 279                        ((XTYPE (marker) == Lisp_Marker)
 280                         ? Fmarker_buffer (marker)
 281                         : 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 }