|
|
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.