code.delx.au - gnu-emacs/blob - 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 void
 197 unchain_marker (marker)
 198      register Lisp_Object marker;
 199 {
 200   register Lisp_Object tail, prev, next;
 201   register EMACS_INT omark;
 202   register struct buffer *b;
 203
 204   b = XMARKER (marker)->buffer;
 205   if (b == 0)
 206     return;
 207
 208   if (EQ (b->name, Qnil))
 209     abort ();
 210
 211   tail = BUF_MARKERS (b);
 212   prev = Qnil;
 213   while (XSYMBOL (tail) != XSYMBOL (Qnil))
 214     {
 215       next = XMARKER (tail)->chain;
 216       XUNMARK (next);
 217
 218       if (XMARKER (marker) == XMARKER (tail))
 219         {
 220           if (NILP (prev))
 221             {
 222               BUF_MARKERS (b) = next;
 223               /* Deleting first marker from the buffer's chain.  Crash
 224                  if new first marker in chain does not say it belongs
 225                  to the same buffer, or at least that they have the same
 226                  base buffer.  */
 227               if (!NILP (next) && b->text != XMARKER (next)->buffer->text)
 228                 abort ();
 229             }
 230           else
 231             {
 232               omark = XMARKBIT (XMARKER (prev)->chain);
 233               XMARKER (prev)->chain = next;
 234               XSETMARKBIT (XMARKER (prev)->chain, omark);
 235             }
 236           break;
 237         }
 238       else
 239         prev = tail;
 240       tail = next;
 241     }
 242   XMARKER (marker)->buffer = 0;
 243 }
 244
 245 /* Return the buffer position of marker MARKER, as a C integer.  */
 246
 247 int
 248 marker_position (marker)
 249      Lisp_Object marker;
 250 {
 251   register struct Lisp_Marker *m = XMARKER (marker);
 252   register struct buffer *buf = m->buffer;
 253   register int i = m->bufpos;
 254
 255   if (!buf)
 256     error ("Marker does not point anywhere");
 257
 258   if (i > BUF_GPT (buf) + BUF_GAP_SIZE (buf))
 259     i -= BUF_GAP_SIZE (buf);
 260   else if (i > BUF_GPT (buf))
 261     i = BUF_GPT (buf);
 262
 263   if (i < BUF_BEG (buf) || i > BUF_Z (buf))
 264     abort ();
 265
 266   return i;
 267 }
 268 \f
 269 DEFUN ("copy-marker", Fcopy_marker, Scopy_marker, 1, 2, 0,
 270   "Return a new marker pointing at the same place as MARKER.\n\
 271 If argument is a number, makes a new marker pointing\n\
 272 at that position in the current buffer.\n\
 273 The optional argument TYPE specifies the insertion type of the new marker;\n\
 274 see `marker-insertion-type'.")
 275   (marker, type)
 276      register Lisp_Object marker, type;
 277 {
 278   register Lisp_Object new;
 279
 280   if (INTEGERP (marker) || MARKERP (marker))
 281     {
 282       new = Fmake_marker ();
 283       Fset_marker (new, marker,
 284                    (MARKERP (marker) ? Fmarker_buffer (marker) : Qnil));
 285       XMARKER (new)->insertion_type = !NILP (type);
 286       return new;
 287     }
 288   else
 289     marker = wrong_type_argument (Qinteger_or_marker_p, marker);
 290 }
 291
 292 DEFUN ("marker-insertion-type", Fmarker_insertion_type,
 293        Smarker_insertion_type, 1, 1, 0,
 294   "Return insertion type of MARKER: t if it stays after inserted text.\n\
 295 nil means the marker stays before text inserted there.")
 296   (marker)
 297      register Lisp_Object marker;
 298 {
 299   register Lisp_Object buf;
 300   CHECK_MARKER (marker, 0);
 301   return XMARKER (marker)->insertion_type ? Qt : Qnil;
 302 }
 303
 304 DEFUN ("set-marker-insertion-type", Fset_marker_insertion_type,
 305        Sset_marker_insertion_type, 2, 2, 0,
 306   "Set the insertion-type of MARKER to TYPE.\n\
 307 If TYPE is t, it means the marker advances when you insert text at it.\n\
 308 If TYPE is nil, it means the marker stays behind when you insert text at it.")
 309   (marker, type)
 310      Lisp_Object marker, type;
 311 {
 312   CHECK_MARKER (marker, 0);
 313
 314   XMARKER (marker)->insertion_type = ! NILP (type);
 315   return type;
 316 }
 317
 318 DEFUN ("buffer-has-markers-at", Fbuffer_has_markers_at, Sbuffer_has_markers_at,
 319   1, 1, 0,
 320   "Return t if there are markers pointing at POSITION in the currentbuffer.")
 321   (position)
 322       Lisp_Object position;
 323 {
 324   register Lisp_Object tail;
 325   register int charno;
 326
 327   charno = XINT (position);
 328
 329   if (charno < BEG)
 330     charno = BEG;
 331   if (charno > Z)
 332     charno = Z;
 333   if (charno > GPT) charno += GAP_SIZE;
 334
 335   for (tail = BUF_MARKERS (current_buffer);
 336        XSYMBOL (tail) != XSYMBOL (Qnil);
 337        tail = XMARKER (tail)->chain)
 338     if (XMARKER (tail)->bufpos == charno)
 339       return Qt;
 340
 341   return Qnil;
 342 }
 343 \f
 344 void
 345 syms_of_marker ()
 346 {
 347   defsubr (&Smarker_position);
 348   defsubr (&Smarker_buffer);
 349   defsubr (&Sset_marker);
 350   defsubr (&Scopy_marker);
 351   defsubr (&Smarker_insertion_type);
 352   defsubr (&Sset_marker_insertion_type);
 353   defsubr (&Sbuffer_has_markers_at);
 354 }