Annotation of 43BSDReno/contrib/emacs-18.55/src/marker.c, revision 1.1.1.1

1.1       root        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 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:      register Lisp_Object marker;
                     33: {
                     34:   register 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:   register Lisp_Object pos;
                     52:   register int i;
                     53:   register struct buffer *buf;
                     54:   register 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:   register 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 position is nil or a marker that points nowhere,
                     93:      make this marker point nowhere.  */
                     94:   if (NULL (pos) ||
                     95:       (XTYPE (pos) == Lisp_Marker && !XMARKER (pos)->buffer))
                     96:     {
                     97:       unchain_marker (marker);
                     98:       XMARKER (marker)->buffer = 0;
                     99:       return marker;
                    100:     }
                    101: 
                    102:   CHECK_NUMBER_COERCE_MARKER (pos, 1);
                    103:   if (NULL (buffer))
                    104:     b = bf_cur;
                    105:   else
                    106:     {
                    107:       CHECK_BUFFER (buffer, 1);
                    108:       b = XBUFFER (buffer);
                    109:       /* If buffer is dead, set marker to point nowhere.  */
                    110:       if (EQ (b->name, Qnil))
                    111:        {
                    112:          unchain_marker (marker);
                    113:          return marker;
                    114:        }
                    115:     }
                    116: 
                    117:   charno = XINT (pos);
                    118:   m = XMARKER (marker);
                    119: 
                    120:   if (bf_cur == b)
                    121:     text = &bf_text;
                    122:   else
                    123:     text = &b->text;
                    124: 
                    125:   if (charno < text->head_clip) charno = text->head_clip;
                    126:   if (charno > text->size1 + text->size2 + 1 - text->tail_clip)
                    127:     charno = text->size1 + text->size2 + 1 - text->tail_clip;
                    128:   if (charno > text->size1 + 1) charno += text->gap;
                    129:   m->bufpos = charno;
                    130: 
                    131:   if (m->buffer != b)
                    132:     {
                    133:       unchain_marker (marker);
                    134:       m->chain = b->markers;
                    135:       b->markers = marker;
                    136:       m->buffer = b;
                    137:     }
                    138:   
                    139:   return marker;
                    140: }
                    141: 
                    142: /* This is called during garbage collection,
                    143:  so we must be careful to ignore and preserve mark bits,
                    144:  including those in chain fields of markers.  */
                    145: 
                    146: unchain_marker (marker)
                    147:      register Lisp_Object marker;
                    148: {
                    149:   register Lisp_Object tail, prev, next;
                    150:   register int omark;
                    151:   register struct buffer *b;
                    152: 
                    153:   b = XMARKER (marker)->buffer;
                    154:   if (b == 0)
                    155:     return;
                    156: 
                    157:   if (EQ (b->name, Qnil))
                    158:     abort ();
                    159: 
                    160:   tail = b->markers;
                    161:   prev = Qnil;
                    162:   while (XSYMBOL (tail) != XSYMBOL (Qnil))
                    163:     {
                    164:       next = XMARKER (tail)->chain;
                    165:       XUNMARK (next);
                    166: 
                    167:       if (XMARKER (marker) == XMARKER (tail))
                    168:        {
                    169:          if (NULL (prev))
                    170:            {
                    171:              b->markers = next;
                    172:              /* Deleting first marker from the buffer's chain.
                    173:                 Crash if new first marker in chain does not say
                    174:                 it belongs to this buffer.  */
                    175:              if (!EQ (next, Qnil) && b != XMARKER (next)->buffer)
                    176:                abort ();
                    177:            }
                    178:          else
                    179:            {
                    180:              omark = XMARKBIT (XMARKER (prev)->chain);
                    181:              XMARKER (prev)->chain = next;
                    182:              XSETMARKBIT (XMARKER (prev)->chain, omark);
                    183:            }
                    184:          break;
                    185:        }
                    186:       else
                    187:        prev = tail;
                    188:       tail = next;
                    189:     }
                    190:   XMARKER (marker)->buffer = 0;
                    191: }
                    192: 
                    193: marker_position (marker)
                    194:      Lisp_Object marker;
                    195: {
                    196:   register struct Lisp_Marker *m = XMARKER (marker);
                    197:   register struct buffer *buf = m->buffer;
                    198:   register int i = m->bufpos;
                    199:   register struct buffer_text *text
                    200:     = (buf == bf_cur) ? &bf_text : &buf->text;
                    201: 
                    202:   if (!buf)
                    203:     error ("Marker does not point anywhere");
                    204: 
                    205:   if (i > text->size1 + text->gap + 1)
                    206:     i -= text->gap;
                    207:   else if (i > text->size1 + 1)
                    208:     i = text->size1 + 1;
                    209: 
                    210:   if (i < 1 || i > text->size1 + text->size2 + 1)
                    211:     abort ();
                    212: 
                    213:   return i;
                    214: }
                    215: 
                    216: DEFUN ("copy-marker", Fcopy_marker, Scopy_marker, 1, 1, 0,
                    217:   "Return a new marker pointing at the same place as MARKER.\n\
                    218: If argument is a number, makes a new marker pointing\n\
                    219: at that position in the current buffer.")
                    220:   (marker)
                    221:      register Lisp_Object marker;
                    222: {
                    223:   register Lisp_Object new;
                    224: 
                    225:   while (1)
                    226:     {
                    227:       if (XTYPE (marker) == Lisp_Int ||
                    228:          XTYPE (marker) == Lisp_Marker)
                    229:        {
                    230:          new = Fmake_marker ();
                    231:          Fset_marker (new, marker,
                    232:                       ((XTYPE (marker) == Lisp_Marker)
                    233:                        ? Fmarker_buffer (marker)
                    234:                        : Qnil));
                    235:          return new;
                    236:        }
                    237:       else
                    238:        marker = wrong_type_argument (Qinteger_or_marker_p, marker);
                    239:     }
                    240: }
                    241: 
                    242: syms_of_marker ()
                    243: {
                    244:   defsubr (&Smarker_position);
                    245:   defsubr (&Smarker_buffer);
                    246:   defsubr (&Sset_marker);
                    247:   defsubr (&Scopy_marker);
                    248: }

unix.superglobalmegacorp.com

This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.