|
|
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: }
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.