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