|
|
1.1 ! root 1: /* Markers: examining, setting and killing. ! 2: Copyright (C) 1985 Richard M. Stallman. ! 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: Lisp_Object marker; ! 33: { ! 34: 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: Lisp_Object pos; ! 52: int i; ! 53: struct buffer *buf; ! 54: 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: 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 (NULL (pos)) ! 93: { ! 94: unchain_marker (marker); ! 95: XMARKER (marker)->buffer = 0; ! 96: return marker; ! 97: } ! 98: ! 99: CHECK_NUMBER_COERCE_MARKER (pos, 1); ! 100: if (NULL (buffer)) ! 101: b = bf_cur; ! 102: else ! 103: { ! 104: CHECK_BUFFER (buffer, 1); ! 105: b = XBUFFER (buffer); ! 106: } ! 107: ! 108: charno = XINT (pos); ! 109: m = XMARKER (marker); ! 110: ! 111: if (bf_cur == b) ! 112: text = &bf_text; ! 113: else ! 114: text = &b->text; ! 115: ! 116: if (charno < text->head_clip) charno = text->head_clip; ! 117: if (charno > text->size1 + text->size2 + 1 - text->tail_clip) ! 118: charno = text->size1 + text->size2 + 1 - text->tail_clip; ! 119: if (charno > text->size1 + 1) charno += text->gap; ! 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 is called during garbage collection, ! 134: so we must be careful to ignore and preserve mark bits, ! 135: including those in chain fields of markers. */ ! 136: ! 137: unchain_marker (marker) ! 138: Lisp_Object marker; ! 139: { ! 140: Lisp_Object tail, prev, next; ! 141: register int omark; ! 142: ! 143: if (!XMARKER (marker)->buffer) ! 144: return; ! 145: ! 146: tail = XMARKER (marker)->buffer->markers; ! 147: prev = Qnil; ! 148: while (XSYMBOL (tail) != XSYMBOL (Qnil)) ! 149: { ! 150: next = XMARKER (tail)->chain; ! 151: XUNMARK (next); ! 152: ! 153: if (XMARKER (marker) == XMARKER (tail)) ! 154: { ! 155: if (NULL (prev)) ! 156: XMARKER (marker)->buffer->markers = next; ! 157: else ! 158: { ! 159: omark = XMARKBIT (XMARKER (prev)->chain); ! 160: XMARKER (prev)->chain = next; ! 161: XSETMARKBIT (XMARKER (prev)->chain, omark); ! 162: } ! 163: break; ! 164: } ! 165: else ! 166: prev = tail; ! 167: tail = next; ! 168: } ! 169: XMARKER (marker)->buffer = 0; ! 170: } ! 171: ! 172: marker_position (marker) ! 173: Lisp_Object marker; ! 174: { ! 175: register struct Lisp_Marker *m = XMARKER (marker); ! 176: register struct buffer *buf = m->buffer; ! 177: register int i = m->bufpos; ! 178: register struct buffer_text *text ! 179: = (buf == bf_cur) ? &bf_text : &buf->text; ! 180: ! 181: if (!buf) ! 182: error ("Marker does not point anywhere"); ! 183: ! 184: if (i > text->size1 + text->gap + 1) ! 185: i -= text->gap; ! 186: else if (i > text->size1 + 1) ! 187: i = text->size1 + 1; ! 188: ! 189: if (i < 1 || i > text->size1 + text->size2 + 1) ! 190: abort (); ! 191: ! 192: return i; ! 193: } ! 194: ! 195: DEFUN ("copy-marker", Fcopy_marker, Scopy_marker, 1, 1, 0, ! 196: "Return a new marker pointing at the same place as MARKER.\n\ ! 197: If argument is a number, makes a new marker pointing\n\ ! 198: at that position in the current buffer.") ! 199: (marker) ! 200: Lisp_Object marker; ! 201: { ! 202: Lisp_Object new; ! 203: ! 204: while (1) ! 205: { ! 206: if (XTYPE (marker) == Lisp_Int ! 207: || XTYPE (marker) == Lisp_Marker) ! 208: { ! 209: new = Fmake_marker (); ! 210: Fset_marker (new, marker, ! 211: XTYPE (marker) == Lisp_Marker ! 212: ? Fmarker_buffer (marker) ! 213: : Qnil); ! 214: return new; ! 215: } ! 216: else ! 217: marker = wrong_type_argument (Qinteger_or_marker_p, marker); ! 218: } ! 219: } ! 220: ! 221: syms_of_marker () ! 222: { ! 223: defsubr (&Smarker_position); ! 224: defsubr (&Smarker_buffer); ! 225: defsubr (&Sset_marker); ! 226: defalias (&Sset_marker, "move-marker"); ! 227: defsubr (&Scopy_marker); ! 228: }
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.