![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to marker.c CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [Apple XNU] / GNUtools / emacs / src|
Return to marker.c CVS log | Up to [Apple XNU] / GNUtools / emacs / src |
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 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 1, 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, 675 Mass Ave, Cambridge, MA 02139, USA. */
19:
20:
21: #include "config.h"
22: #include "lisp.h"
23: #include "buffer.h"
24:
25: /* Operations on markers. */
26:
27: DEFUN ("marker-buffer", Fmarker_buffer, Smarker_buffer, 1, 1, 0,
28: "Return the buffer that MARKER points into, or nil if none.\n\
29: Returns nil if MARKER points into a dead buffer.")
30: (marker)
31: register Lisp_Object marker;
32: {
33: register Lisp_Object buf;
34: CHECK_MARKER (marker, 0);
35: if (XMARKER (marker)->buffer)
36: {
37: XSET (buf, Lisp_Buffer, XMARKER (marker)->buffer);
38: /* Return marker's buffer only if it is not dead. */
39: if (!NULL (XBUFFER (buf)->name))
40: return buf;
41: }
42: return Qnil;
43: }
44:
45: DEFUN ("marker-position", Fmarker_position, Smarker_position, 1, 1, 0,
46: "Return the position MARKER points at, as a character number.")
47: (marker)
48: Lisp_Object marker;
49: {
50: register Lisp_Object pos;
51: register int i;
52: register struct buffer *buf;
53:
54: CHECK_MARKER (marker, 0);
55: if (XMARKER (marker)->buffer)
56: {
57: buf = XMARKER (marker)->buffer;
58: i = XMARKER (marker)->bufpos;
59:
60: if (i > BUF_GPT (buf) + BUF_GAP_SIZE (buf))
61: i -= BUF_GAP_SIZE (buf);
62: else if (i > BUF_GPT (buf))
63: i = BUF_GPT (buf);
64:
65: if (i < BUF_BEG (buf) || i > BUF_Z (buf))
66: abort ();
67:
68: XFASTINT (pos) = i;
69: return pos;
70: }
71: return Qnil;
72: }
73:
74: DEFUN ("set-marker", Fset_marker, Sset_marker, 2, 3, 0,
75: "Position MARKER before character number NUMBER in BUFFER.\n\
76: BUFFER defaults to the current buffer.\n\
77: If NUMBER is nil, makes marker point nowhere.\n\
78: Then it no longer slows down editing in any buffer.\n\
79: Returns MARKER.")
80: (marker, pos, buffer)
81: Lisp_Object marker, pos, buffer;
82: {
83: register int charno;
84: register struct buffer *b;
85: register struct Lisp_Marker *m;
86:
87: CHECK_MARKER (marker, 0);
88: /* If position is nil or a marker that points nowhere,
89: make this marker point nowhere. */
90: if (NULL (pos) ||
91: (XTYPE (pos) == Lisp_Marker && !XMARKER (pos)->buffer))
92: {
93: if (XMARKER (marker)->buffer)
94: unchain_marker (marker);
95: return marker;
96: }
97:
98: CHECK_NUMBER_COERCE_MARKER (pos, 1);
99: if (NULL (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: if (XMARKER (marker)->buffer)
109: unchain_marker (marker);
110: return marker;
111: }
112: }
113:
114: charno = XINT (pos);
115: m = XMARKER (marker);
116:
117: if (charno < BUF_BEG (b))
118: charno = BUF_BEG (b);
119: if (charno > BUF_Z (b))
120: charno = BUF_Z (b);
121: if (charno > BUF_GPT (b)) charno += BUF_GAP_SIZE (b);
122: m->bufpos = charno;
123:
124: if (m->buffer != b)
125: {
126: if (m->buffer != 0)
127: unchain_marker (marker);
128: m->chain = b->markers;
129: b->markers = marker;
130: m->buffer = b;
131: }
132:
133: return marker;
134: }
135:
136: /* This version of Fset_marker won't let the position be outside the visible part. */
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 (NULL (pos) ||
149: (XTYPE (pos) == Lisp_Marker && !XMARKER (pos)->buffer))
150: {
151: if (XMARKER (marker)->buffer)
152: unchain_marker (marker);
153: return marker;
154: }
155:
156: CHECK_NUMBER_COERCE_MARKER (pos, 1);
157: if (NULL (buffer))
158: b = current_buffer;
159: else
160: {
161: CHECK_BUFFER (buffer, 1);
162: b = XBUFFER (buffer);
163: /* If buffer is dead, set marker to point nowhere. */
164: if (EQ (b->name, Qnil))
165: {
166: if (XMARKER (marker)->buffer)
167: unchain_marker (marker);
168: return marker;
169: }
170: }
171:
172: charno = XINT (pos);
173: m = XMARKER (marker);
174:
175: if (charno < BUF_BEGV (b))
176: charno = BUF_BEGV (b);
177: if (charno > BUF_ZV (b))
178: charno = BUF_ZV (b);
179: if (charno > BUF_GPT (b))
180: charno += BUF_GAP_SIZE (b);
181: m->bufpos = charno;
182:
183: if (m->buffer != b)
184: {
185: if (m->buffer != 0)
186: unchain_marker (marker);
187: m->chain = b->markers;
188: b->markers = marker;
189: m->buffer = b;
190: }
191:
192: return marker;
193: }
194:
195: /* This is called during garbage collection,
196: so we must be careful to ignore and preserve mark bits,
197: including those in chain fields of markers. */
198:
199: unchain_marker (marker)
200: register Lisp_Object marker;
201: {
202: register Lisp_Object tail, prev, next;
203: register int omark;
204: register struct buffer *b;
205:
206: b = XMARKER (marker)->buffer;
207:
208: if (EQ (b->name, Qnil))
209: abort ();
210:
211: tail = b->markers;
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 (NULL (prev))
221: {
222: b->markers = next;
223: /* Deleting first marker from the buffer's chain.
224: Crash if new first marker in chain does not say
225: it belongs to this buffer. */
226: if (!EQ (next, Qnil) && b != XMARKER (next)->buffer)
227: abort ();
228: }
229: else
230: {
231: omark = XMARKBIT (XMARKER (prev)->chain);
232: XMARKER (prev)->chain = next;
233: XSETMARKBIT (XMARKER (prev)->chain, omark);
234: }
235: break;
236: }
237: else
238: prev = tail;
239: tail = next;
240: }
241: XMARKER (marker)->buffer = 0;
242: }
243:
244: marker_position (marker)
245: Lisp_Object marker;
246: {
247: register struct Lisp_Marker *m = XMARKER (marker);
248: register struct buffer *buf = m->buffer;
249: register int i = m->bufpos;
250:
251: if (!buf)
252: error ("Marker does not point anywhere");
253:
254: if (i > BUF_GPT (buf) + BUF_GAP_SIZE (buf))
255: i -= BUF_GAP_SIZE (buf);
256: else if (i > BUF_GPT (buf))
257: i = BUF_GPT (buf);
258:
259: if (i < BUF_BEG (buf) || i > BUF_Z (buf))
260: abort ();
261:
262: return i;
263: }
264:
265: DEFUN ("copy-marker", Fcopy_marker, Scopy_marker, 1, 1, 0,
266: "Return a new marker pointing at the same place as MARKER.\n\
267: If argument is a number, makes a new marker pointing\n\
268: at that position in the current buffer.")
269: (marker)
270: register Lisp_Object marker;
271: {
272: register Lisp_Object new;
273:
274: while (1)
275: {
276: if (XTYPE (marker) == Lisp_Int ||
277: XTYPE (marker) == Lisp_Marker)
278: {
279: new = Fmake_marker ();
280: Fset_marker (new, marker,
281: ((XTYPE (marker) == Lisp_Marker)
282: ? Fmarker_buffer (marker)
283: : Qnil));
284: return new;
285: }
286: else
287: marker = wrong_type_argument (Qinteger_or_marker_p, marker);
288: }
289: }
290:
291: syms_of_marker ()
292: {
293: defsubr (&Smarker_position);
294: defsubr (&Smarker_buffer);
295: defsubr (&Sset_marker);
296: defsubr (&Scopy_marker);
297: }
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.