(backup-extract-version-start): New variable.
[bpt/emacs.git] / src / buffer.c
CommitLineData
1ab256cb 1/* Buffer manipulation primitives for GNU Emacs.
99a8b2d2 2 Copyright (C) 1985, 1986, 1987, 1988, 1989, 1993, 1994, 1995, 1997
c922bc55 3 Free Software Foundation, Inc.
1ab256cb
RM
4
5This file is part of GNU Emacs.
6
7GNU Emacs is free software; you can redistribute it and/or modify
8it under the terms of the GNU General Public License as published by
c922bc55 9the Free Software Foundation; either version 2, or (at your option)
1ab256cb
RM
10any later version.
11
12GNU Emacs is distributed in the hope that it will be useful,
13but WITHOUT ANY WARRANTY; without even the implied warranty of
14MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15GNU General Public License for more details.
16
17You should have received a copy of the GNU General Public License
18along with GNU Emacs; see the file COPYING. If not, write to
3b7ad313
EN
19the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
20Boston, MA 02111-1307, USA. */
1ab256cb
RM
21
22
2381d133
JB
23#include <sys/types.h>
24#include <sys/stat.h>
1ab256cb
RM
25#include <sys/param.h>
26
27#ifndef MAXPATHLEN
28/* in 4.1, param.h fails to define this. */
29#define MAXPATHLEN 1024
30#endif /* not MAXPATHLEN */
31
18160b98 32#include <config.h>
1ab256cb 33#include "lisp.h"
21cf4cf8 34#include "intervals.h"
1ab256cb
RM
35#include "window.h"
36#include "commands.h"
37#include "buffer.h"
3b06f880 38#include "charset.h"
28e969dd 39#include "region-cache.h"
1ab256cb 40#include "indent.h"
d014bf88 41#include "blockinput.h"
1ab256cb
RM
42
43struct buffer *current_buffer; /* the current buffer */
44
45/* First buffer in chain of all buffers (in reverse order of creation).
46 Threaded through ->next. */
47
48struct buffer *all_buffers;
49
50/* This structure holds the default values of the buffer-local variables
51 defined with DEFVAR_PER_BUFFER, that have special slots in each buffer.
52 The default value occupies the same slot in this structure
53 as an individual buffer's value occupies in that buffer.
54 Setting the default value also goes through the alist of buffers
55 and stores into each buffer that does not say it has a local value. */
56
57struct buffer buffer_defaults;
58
59/* A Lisp_Object pointer to the above, used for staticpro */
60
61static Lisp_Object Vbuffer_defaults;
62
63/* This structure marks which slots in a buffer have corresponding
64 default values in buffer_defaults.
65 Each such slot has a nonzero value in this structure.
66 The value has only one nonzero bit.
67
68 When a buffer has its own local value for a slot,
69 the bit for that slot (found in the same slot in this structure)
70 is turned on in the buffer's local_var_flags slot.
71
72 If a slot in this structure is -1, then even though there may
73 be a DEFVAR_PER_BUFFER for the slot, there is no default value for it;
74 and the corresponding slot in buffer_defaults is not used.
75
76 If a slot is -2, then there is no DEFVAR_PER_BUFFER for it,
77 but there is a default value which is copied into each buffer.
78
79 If a slot in this structure is negative, then even though there may
80 be a DEFVAR_PER_BUFFER for the slot, there is no default value for it;
81 and the corresponding slot in buffer_defaults is not used.
82
83 If a slot in this structure corresponding to a DEFVAR_PER_BUFFER is
84 zero, that is a bug */
85
86struct buffer buffer_local_flags;
87
88/* This structure holds the names of symbols whose values may be
89 buffer-local. It is indexed and accessed in the same way as the above. */
90
91struct buffer buffer_local_symbols;
92/* A Lisp_Object pointer to the above, used for staticpro */
93static Lisp_Object Vbuffer_local_symbols;
94
0fa3ba92
JB
95/* This structure holds the required types for the values in the
96 buffer-local slots. If a slot contains Qnil, then the
97 corresponding buffer slot may contain a value of any type. If a
98 slot contains an integer, then prospective values' tags must be
99 equal to that integer. When a tag does not match, the function
100 buffer_slot_type_mismatch will signal an error. */
101struct buffer buffer_local_types;
102
13de9290
RS
103/* Flags indicating which built-in buffer-local variables
104 are permanent locals. */
105static int buffer_permanent_local_flags;
106
1ab256cb 107Lisp_Object Fset_buffer ();
01050cb5 108void set_buffer_internal ();
c7aa5005 109void set_buffer_internal_1 ();
173f2a64 110static void call_overlay_mod_hooks ();
2f3f993b 111static void swap_out_buffer_local_variables ();
13de9290 112static void reset_buffer_local_variables ();
1ab256cb
RM
113
114/* Alist of all buffer names vs the buffers. */
115/* This used to be a variable, but is no longer,
116 to prevent lossage due to user rplac'ing this alist or its elements. */
117Lisp_Object Vbuffer_alist;
118
119/* Functions to call before and after each text change. */
120Lisp_Object Vbefore_change_function;
121Lisp_Object Vafter_change_function;
5f079267
RS
122Lisp_Object Vbefore_change_functions;
123Lisp_Object Vafter_change_functions;
1ab256cb 124
c48f61ef
RS
125Lisp_Object Vtransient_mark_mode;
126
a96b68f1
RS
127/* t means ignore all read-only text properties.
128 A list means ignore such a property if its value is a member of the list.
129 Any non-nil value means ignore buffer-read-only. */
130Lisp_Object Vinhibit_read_only;
131
dcdffbf6
RS
132/* List of functions to call that can query about killing a buffer.
133 If any of these functions returns nil, we don't kill it. */
134Lisp_Object Vkill_buffer_query_functions;
135
dbc4e1c1
JB
136/* List of functions to call before changing an unmodified buffer. */
137Lisp_Object Vfirst_change_hook;
22378665 138
dbc4e1c1 139Lisp_Object Qfirst_change_hook;
22378665
RS
140Lisp_Object Qbefore_change_functions;
141Lisp_Object Qafter_change_functions;
1ab256cb
RM
142
143Lisp_Object Qfundamental_mode, Qmode_class, Qpermanent_local;
144
145Lisp_Object Qprotected_field;
146
147Lisp_Object QSFundamental; /* A string "Fundamental" */
148
149Lisp_Object Qkill_buffer_hook;
150
5fe0b67e
RS
151Lisp_Object Qget_file_buffer;
152
52f8ec73
JB
153Lisp_Object Qoverlayp;
154
bbbe9545 155Lisp_Object Qpriority, Qwindow, Qevaporate, Qbefore_string, Qafter_string;
5985d248 156
294d215f
RS
157Lisp_Object Qmodification_hooks;
158Lisp_Object Qinsert_in_front_hooks;
159Lisp_Object Qinsert_behind_hooks;
160
1ab256cb
RM
161/* For debugging; temporary. See set_buffer_internal. */
162/* Lisp_Object Qlisp_mode, Vcheck_symbol; */
163
164nsberror (spec)
165 Lisp_Object spec;
166{
a7a60ce9 167 if (STRINGP (spec))
1ab256cb
RM
168 error ("No buffer named %s", XSTRING (spec)->data);
169 error ("Invalid buffer argument");
170}
171\f
0dc88e60
RS
172DEFUN ("buffer-live-p", Fbuffer_live_p, Sbuffer_live_p, 1, 1, 0,
173 "Return non-nil if OBJECT is a buffer which has not been killed.\n\
174Value is nil if OBJECT is not a buffer or if it has been killed.")
175 (object)
176 Lisp_Object object;
177{
178 return ((BUFFERP (object) && ! NILP (XBUFFER (object)->name))
179 ? Qt : Qnil);
180}
181
1ab256cb
RM
182DEFUN ("buffer-list", Fbuffer_list, Sbuffer_list, 0, 0, 0,
183 "Return a list of all existing live buffers.")
184 ()
185{
186 return Fmapcar (Qcdr, Vbuffer_alist);
187}
188
04ae1b48
RS
189/* Like Fassoc, but use Fstring_equal to compare
190 (which ignores text properties),
191 and don't ever QUIT. */
192
193static Lisp_Object
194assoc_ignore_text_properties (key, list)
195 register Lisp_Object key;
196 Lisp_Object list;
197{
198 register Lisp_Object tail;
199 for (tail = list; !NILP (tail); tail = Fcdr (tail))
200 {
201 register Lisp_Object elt, tem;
202 elt = Fcar (tail);
203 tem = Fstring_equal (Fcar (elt), key);
204 if (!NILP (tem))
205 return elt;
206 }
207 return Qnil;
208}
209
1ab256cb
RM
210DEFUN ("get-buffer", Fget_buffer, Sget_buffer, 1, 1, 0,
211 "Return the buffer named NAME (a string).\n\
212If there is no live buffer named NAME, return nil.\n\
213NAME may also be a buffer; if so, the value is that buffer.")
214 (name)
215 register Lisp_Object name;
216{
a7a60ce9 217 if (BUFFERP (name))
1ab256cb
RM
218 return name;
219 CHECK_STRING (name, 0);
220
04ae1b48 221 return Fcdr (assoc_ignore_text_properties (name, Vbuffer_alist));
1ab256cb
RM
222}
223
224DEFUN ("get-file-buffer", Fget_file_buffer, Sget_file_buffer, 1, 1, 0,
225 "Return the buffer visiting file FILENAME (a string).\n\
92194d02 226The buffer's `buffer-file-name' must match exactly the expansion of FILENAME.\n\
11da5363
RS
227If there is no such live buffer, return nil.\n\
228See also `find-buffer-visiting'.")
1ab256cb
RM
229 (filename)
230 register Lisp_Object filename;
231{
232 register Lisp_Object tail, buf, tem;
5fe0b67e
RS
233 Lisp_Object handler;
234
1ab256cb
RM
235 CHECK_STRING (filename, 0);
236 filename = Fexpand_file_name (filename, Qnil);
237
5fe0b67e
RS
238 /* If the file name has special constructs in it,
239 call the corresponding file handler. */
a617e913 240 handler = Ffind_file_name_handler (filename, Qget_file_buffer);
5fe0b67e
RS
241 if (!NILP (handler))
242 return call2 (handler, Qget_file_buffer, filename);
243
1ab256cb
RM
244 for (tail = Vbuffer_alist; CONSP (tail); tail = XCONS (tail)->cdr)
245 {
246 buf = Fcdr (XCONS (tail)->car);
a7a60ce9
KH
247 if (!BUFFERP (buf)) continue;
248 if (!STRINGP (XBUFFER (buf)->filename)) continue;
1ab256cb 249 tem = Fstring_equal (XBUFFER (buf)->filename, filename);
265a9e55 250 if (!NILP (tem))
1ab256cb
RM
251 return buf;
252 }
253 return Qnil;
254}
255
52e01189
RS
256Lisp_Object
257get_truename_buffer (filename)
258 register Lisp_Object filename;
259{
260 register Lisp_Object tail, buf, tem;
261
262 for (tail = Vbuffer_alist; CONSP (tail); tail = XCONS (tail)->cdr)
263 {
264 buf = Fcdr (XCONS (tail)->car);
265 if (!BUFFERP (buf)) continue;
266 if (!STRINGP (XBUFFER (buf)->file_truename)) continue;
267 tem = Fstring_equal (XBUFFER (buf)->file_truename, filename);
268 if (!NILP (tem))
269 return buf;
270 }
271 return Qnil;
272}
273
1ab256cb
RM
274/* Incremented for each buffer created, to assign the buffer number. */
275int buffer_count;
276
277DEFUN ("get-buffer-create", Fget_buffer_create, Sget_buffer_create, 1, 1, 0,
278 "Return the buffer named NAME, or create such a buffer and return it.\n\
279A new buffer is created if there is no live buffer named NAME.\n\
b44895bc 280If NAME starts with a space, the new buffer does not keep undo information.\n\
1ab256cb
RM
281If NAME is a buffer instead of a string, then it is the value returned.\n\
282The value is never nil.")
283 (name)
284 register Lisp_Object name;
285{
a9ee7a59 286 register Lisp_Object buf;
1ab256cb
RM
287 register struct buffer *b;
288
289 buf = Fget_buffer (name);
265a9e55 290 if (!NILP (buf))
1ab256cb
RM
291 return buf;
292
31cd83e9
KH
293 if (XSTRING (name)->size == 0)
294 error ("Empty string for buffer name is not allowed");
295
9ac0d9e0 296 b = (struct buffer *) xmalloc (sizeof (struct buffer));
1ab256cb 297
336cd056
RS
298 b->size = sizeof (struct buffer) / sizeof (EMACS_INT);
299
300 /* An ordinary buffer uses its own struct buffer_text. */
301 b->text = &b->own_text;
302 b->base_buffer = 0;
303
1ab256cb 304 BUF_GAP_SIZE (b) = 20;
9ac0d9e0 305 BLOCK_INPUT;
3b06f880
KH
306 /* We allocate extra 1-byte at the tail and keep it always '\0' for
307 anchoring a search. */
308 BUFFER_ALLOC (BUF_BEG_ADDR (b), (BUF_GAP_SIZE (b) + 1));
9ac0d9e0 309 UNBLOCK_INPUT;
1ab256cb 310 if (! BUF_BEG_ADDR (b))
81841847 311 buffer_memory_full ();
1ab256cb
RM
312
313 BUF_PT (b) = 1;
314 BUF_GPT (b) = 1;
315 BUF_BEGV (b) = 1;
316 BUF_ZV (b) = 1;
317 BUF_Z (b) = 1;
318 BUF_MODIFF (b) = 1;
2509d356 319 BUF_OVERLAY_MODIFF (b) = 1;
336cd056
RS
320 BUF_SAVE_MODIFF (b) = 1;
321 BUF_INTERVALS (b) = 0;
3b06f880 322 *(BUF_GPT_ADDR (b)) = *(BUF_Z_ADDR (b)) = 0; /* Put an anchor '\0'. */
1ab256cb 323
28e969dd
JB
324 b->newline_cache = 0;
325 b->width_run_cache = 0;
326 b->width_table = Qnil;
327
1ab256cb
RM
328 /* Put this on the chain of all buffers including killed ones. */
329 b->next = all_buffers;
330 all_buffers = b;
331
336cd056
RS
332 /* An ordinary buffer normally doesn't need markers
333 to handle BEGV and ZV. */
334 b->pt_marker = Qnil;
335 b->begv_marker = Qnil;
336 b->zv_marker = Qnil;
04ae1b48
RS
337
338 name = Fcopy_sequence (name);
339 INITIALIZE_INTERVAL (XSTRING (name), NULL_INTERVAL);
1ab256cb 340 b->name = name;
04ae1b48 341
1ab256cb
RM
342 if (XSTRING (name)->data[0] != ' ')
343 b->undo_list = Qnil;
344 else
345 b->undo_list = Qt;
346
347 reset_buffer (b);
13de9290 348 reset_buffer_local_variables (b, 1);
1ab256cb
RM
349
350 /* Put this in the alist of all live buffers. */
67180c6a 351 XSETBUFFER (buf, b);
1ab256cb
RM
352 Vbuffer_alist = nconc2 (Vbuffer_alist, Fcons (Fcons (name, buf), Qnil));
353
354 b->mark = Fmake_marker ();
336cd056
RS
355 BUF_MARKERS (b) = Qnil;
356 b->name = name;
357 return buf;
358}
359
a2428fa2 360DEFUN ("make-indirect-buffer", Fmake_indirect_buffer, Smake_indirect_buffer, 2, 2,
193c3837 361 "bMake indirect buffer (to buffer): \nBName of indirect buffer: ",
a2428fa2
EN
362 "Create and return an indirect buffer for buffer BASE-BUFFER, named NAME.\n\
363BASE-BUFFER should be an existing buffer (or buffer name).\n\
9e552710
RS
364NAME should be a string which is not the name of an existing buffer.")
365 (base_buffer, name)
366 register Lisp_Object base_buffer, name;
336cd056
RS
367{
368 register Lisp_Object buf;
369 register struct buffer *b;
370
371 buf = Fget_buffer (name);
372 if (!NILP (buf))
373 error ("Buffer name `%s' is in use", XSTRING (name)->data);
374
375 base_buffer = Fget_buffer (base_buffer);
376 if (NILP (base_buffer))
377 error ("No such buffer: `%s'",
378 XSTRING (XBUFFER (base_buffer)->name)->data);
379
380 if (XSTRING (name)->size == 0)
381 error ("Empty string for buffer name is not allowed");
382
383 b = (struct buffer *) xmalloc (sizeof (struct buffer));
384
385 b->size = sizeof (struct buffer) / sizeof (EMACS_INT);
386
387 if (XBUFFER (base_buffer)->base_buffer)
388 b->base_buffer = XBUFFER (base_buffer)->base_buffer;
389 else
390 b->base_buffer = XBUFFER (base_buffer);
391
392 /* Use the base buffer's text object. */
393 b->text = b->base_buffer->text;
394
395 BUF_BEGV (b) = BUF_BEGV (b->base_buffer);
396 BUF_ZV (b) = BUF_ZV (b->base_buffer);
397 BUF_PT (b) = BUF_PT (b->base_buffer);
398
399 b->newline_cache = 0;
400 b->width_run_cache = 0;
401 b->width_table = Qnil;
402
403 /* Put this on the chain of all buffers including killed ones. */
404 b->next = all_buffers;
405 all_buffers = b;
406
407 name = Fcopy_sequence (name);
408 INITIALIZE_INTERVAL (XSTRING (name), NULL_INTERVAL);
409 b->name = name;
410
411 reset_buffer (b);
13de9290 412 reset_buffer_local_variables (b, 1);
336cd056
RS
413
414 /* Put this in the alist of all live buffers. */
415 XSETBUFFER (buf, b);
416 Vbuffer_alist = nconc2 (Vbuffer_alist, Fcons (Fcons (name, buf), Qnil));
417
418 b->mark = Fmake_marker ();
1ab256cb 419 b->name = name;
336cd056
RS
420
421 /* Make sure the base buffer has markers for its narrowing. */
422 if (NILP (b->base_buffer->pt_marker))
423 {
424 b->base_buffer->pt_marker = Fmake_marker ();
425 Fset_marker (b->base_buffer->pt_marker,
426 make_number (BUF_PT (b->base_buffer)), base_buffer);
427 }
428 if (NILP (b->base_buffer->begv_marker))
429 {
430 b->base_buffer->begv_marker = Fmake_marker ();
431 Fset_marker (b->base_buffer->begv_marker,
432 make_number (BUF_BEGV (b->base_buffer)), base_buffer);
433 }
434 if (NILP (b->base_buffer->zv_marker))
435 {
436 b->base_buffer->zv_marker = Fmake_marker ();
437 Fset_marker (b->base_buffer->zv_marker,
438 make_number (BUF_ZV (b->base_buffer)), base_buffer);
26d84681 439 XMARKER (b->base_buffer->zv_marker)->insertion_type = 1;
336cd056
RS
440 }
441
442 /* Give the indirect buffer markers for its narrowing. */
ea064aa0
RS
443 b->pt_marker = Fmake_marker ();
444 Fset_marker (b->pt_marker, make_number (BUF_PT (b)), buf);
445 b->begv_marker = Fmake_marker ();
446 Fset_marker (b->begv_marker, make_number (BUF_BEGV (b)), buf);
447 b->zv_marker = Fmake_marker ();
448 Fset_marker (b->zv_marker, make_number (BUF_ZV (b)), buf);
449
26d84681 450 XMARKER (b->zv_marker)->insertion_type = 1;
336cd056 451
a9ee7a59 452 return buf;
1ab256cb
RM
453}
454
bcd40520
RS
455/* Reinitialize everything about a buffer except its name and contents
456 and local variables. */
1ab256cb
RM
457
458void
459reset_buffer (b)
460 register struct buffer *b;
461{
462 b->filename = Qnil;
f6ed2e84 463 b->file_truename = Qnil;
1ab256cb
RM
464 b->directory = (current_buffer) ? current_buffer->directory : Qnil;
465 b->modtime = 0;
8d7a4592 466 XSETFASTINT (b->save_length, 0);
1ab256cb 467 b->last_window_start = 1;
8b264726
RS
468 /* It is more conservative to start out "changed" than "unchanged". */
469 b->clip_changed = 1;
1ab256cb
RM
470 b->backed_up = Qnil;
471 b->auto_save_modified = 0;
84f6bcba 472 b->auto_save_failure_time = -1;
1ab256cb
RM
473 b->auto_save_file_name = Qnil;
474 b->read_only = Qnil;
2eec3b4e
RS
475 b->overlays_before = Qnil;
476 b->overlays_after = Qnil;
8d7a4592 477 XSETFASTINT (b->overlay_center, 1);
dfda7a7f 478 b->mark_active = Qnil;
943e065b 479 b->point_before_scroll = Qnil;
be9aafdd 480 b->file_format = Qnil;
0dc6f165 481 b->last_selected_window = Qnil;
7962a441 482 XSETINT (b->display_count, 0);
fb2030e3
RS
483 b->extra2 = Qnil;
484 b->extra3 = Qnil;
1ab256cb
RM
485}
486
bcd40520
RS
487/* Reset buffer B's local variables info.
488 Don't use this on a buffer that has already been in use;
489 it does not treat permanent locals consistently.
13de9290
RS
490 Instead, use Fkill_all_local_variables.
491
492 If PERMANENT_TOO is 1, then we reset permanent built-in
493 buffer-local variables. If PERMANENT_TOO is 0,
494 we preserve those. */
bcd40520 495
13de9290
RS
496static void
497reset_buffer_local_variables (b, permanent_too)
1ab256cb 498 register struct buffer *b;
13de9290 499 int permanent_too;
1ab256cb
RM
500{
501 register int offset;
13de9290
RS
502 int dont_reset;
503
504 /* Decide which built-in local variables to reset. */
505 if (permanent_too)
506 dont_reset = 0;
507 else
508 dont_reset = buffer_permanent_local_flags;
1ab256cb
RM
509
510 /* Reset the major mode to Fundamental, together with all the
511 things that depend on the major mode.
512 default-major-mode is handled at a higher level.
513 We ignore it here. */
514 b->major_mode = Qfundamental_mode;
515 b->keymap = Qnil;
516 b->abbrev_table = Vfundamental_mode_abbrev_table;
517 b->mode_name = QSFundamental;
518 b->minor_modes = Qnil;
3446af9c
RS
519
520 /* If the standard case table has been altered and invalidated,
521 fix up its insides first. */
522 if (! (CHAR_TABLE_P (XCHAR_TABLE (Vascii_downcase_table)->extras[0])
523 && CHAR_TABLE_P (XCHAR_TABLE (Vascii_downcase_table)->extras[1])
524 && CHAR_TABLE_P (XCHAR_TABLE (Vascii_downcase_table)->extras[2])))
525 Fset_standard_case_table (Vascii_downcase_table);
526
1ab256cb 527 b->downcase_table = Vascii_downcase_table;
1e9b6335
RS
528 b->upcase_table = XCHAR_TABLE (Vascii_downcase_table)->extras[0];
529 b->case_canon_table = XCHAR_TABLE (Vascii_downcase_table)->extras[1];
530 b->case_eqv_table = XCHAR_TABLE (Vascii_downcase_table)->extras[2];
3cb719bd 531 b->invisibility_spec = Qt;
2e716096
RS
532#ifndef DOS_NT
533 b->buffer_file_type = Qnil;
534#endif
3cb719bd 535
1ab256cb
RM
536#if 0
537 b->sort_table = XSTRING (Vascii_sort_table);
538 b->folding_sort_table = XSTRING (Vascii_folding_sort_table);
539#endif /* 0 */
540
13de9290 541 /* Reset all (or most) per-buffer variables to their defaults. */
1ab256cb 542 b->local_var_alist = Qnil;
13de9290 543 b->local_var_flags &= dont_reset;
1ab256cb
RM
544
545 /* For each slot that has a default value,
546 copy that into the slot. */
547
548 for (offset = (char *)&buffer_local_flags.name - (char *)&buffer_local_flags;
549 offset < sizeof (struct buffer);
4d2f1389 550 offset += sizeof (Lisp_Object)) /* sizeof EMACS_INT == sizeof Lisp_Object */
aab80822
KH
551 {
552 int flag = XINT (*(Lisp_Object *)(offset + (char *)&buffer_local_flags));
13de9290
RS
553 if ((flag > 0
554 /* Don't reset a permanent local. */
555 && ! (dont_reset & flag))
556 || flag == -2)
557 *(Lisp_Object *)(offset + (char *)b)
558 = *(Lisp_Object *)(offset + (char *)&buffer_defaults);
aab80822 559 }
1ab256cb
RM
560}
561
01050cb5
RM
562/* We split this away from generate-new-buffer, because rename-buffer
563 and set-visited-file-name ought to be able to use this to really
564 rename the buffer properly. */
565
566DEFUN ("generate-new-buffer-name", Fgenerate_new_buffer_name, Sgenerate_new_buffer_name,
c273e647 567 1, 2, 0,
01050cb5
RM
568 "Return a string that is the name of no existing buffer based on NAME.\n\
569If there is no live buffer named NAME, then return NAME.\n\
1ab256cb 570Otherwise modify name by appending `<NUMBER>', incrementing NUMBER\n\
c273e647 571until an unused name is found, and then return that name.\n\
03bdd54c 572Optional second argument IGNORE specifies a name that is okay to use\n\
c273e647 573\(if it is in the sequence to be tried)\n\
e8b3a22d 574even if a buffer with that name exists.")
c273e647
RS
575 (name, ignore)
576 register Lisp_Object name, ignore;
1ab256cb
RM
577{
578 register Lisp_Object gentemp, tem;
579 int count;
580 char number[10];
581
582 CHECK_STRING (name, 0);
583
584 tem = Fget_buffer (name);
265a9e55 585 if (NILP (tem))
01050cb5 586 return name;
1ab256cb
RM
587
588 count = 1;
589 while (1)
590 {
591 sprintf (number, "<%d>", ++count);
592 gentemp = concat2 (name, build_string (number));
638e4fc3 593 tem = Fstring_equal (gentemp, ignore);
c273e647
RS
594 if (!NILP (tem))
595 return gentemp;
1ab256cb 596 tem = Fget_buffer (gentemp);
265a9e55 597 if (NILP (tem))
01050cb5 598 return gentemp;
1ab256cb
RM
599 }
600}
601
602\f
603DEFUN ("buffer-name", Fbuffer_name, Sbuffer_name, 0, 1, 0,
604 "Return the name of BUFFER, as a string.\n\
01050cb5 605With no argument or nil as argument, return the name of the current buffer.")
1ab256cb
RM
606 (buffer)
607 register Lisp_Object buffer;
608{
265a9e55 609 if (NILP (buffer))
1ab256cb
RM
610 return current_buffer->name;
611 CHECK_BUFFER (buffer, 0);
612 return XBUFFER (buffer)->name;
613}
614
615DEFUN ("buffer-file-name", Fbuffer_file_name, Sbuffer_file_name, 0, 1, 0,
616 "Return name of file BUFFER is visiting, or nil if none.\n\
617No argument or nil as argument means use the current buffer.")
618 (buffer)
619 register Lisp_Object buffer;
620{
265a9e55 621 if (NILP (buffer))
1ab256cb
RM
622 return current_buffer->filename;
623 CHECK_BUFFER (buffer, 0);
624 return XBUFFER (buffer)->filename;
625}
626
336cd056
RS
627DEFUN ("buffer-base-buffer", Fbuffer_base_buffer, Sbuffer_base_buffer,
628 0, 1, 0,
629 "Return the base buffer of indirect buffer BUFFER.\n\
630If BUFFER is not indirect, return nil.")
631 (buffer)
632 register Lisp_Object buffer;
633{
634 struct buffer *base;
635 Lisp_Object base_buffer;
636
637 if (NILP (buffer))
638 base = current_buffer->base_buffer;
639 else
640 {
641 CHECK_BUFFER (buffer, 0);
642 base = XBUFFER (buffer)->base_buffer;
643 }
644
645 if (! base)
646 return Qnil;
647 XSETBUFFER (base_buffer, base);
648 return base_buffer;
649}
650
1ab256cb
RM
651DEFUN ("buffer-local-variables", Fbuffer_local_variables,
652 Sbuffer_local_variables, 0, 1, 0,
653 "Return an alist of variables that are buffer-local in BUFFER.\n\
553defa4
RS
654Most elements look like (SYMBOL . VALUE), describing one variable.\n\
655For a symbol that is locally unbound, just the symbol appears in the value.\n\
1ab256cb
RM
656Note that storing new VALUEs in these elements doesn't change the variables.\n\
657No argument or nil as argument means use current buffer as BUFFER.")
658 (buffer)
659 register Lisp_Object buffer;
660{
661 register struct buffer *buf;
553defa4 662 register Lisp_Object result;
1ab256cb 663
265a9e55 664 if (NILP (buffer))
1ab256cb
RM
665 buf = current_buffer;
666 else
667 {
668 CHECK_BUFFER (buffer, 0);
669 buf = XBUFFER (buffer);
670 }
671
553defa4
RS
672 result = Qnil;
673
1ab256cb 674 {
553defa4
RS
675 register Lisp_Object tail;
676 for (tail = buf->local_var_alist; CONSP (tail); tail = XCONS (tail)->cdr)
1ab256cb 677 {
553defa4
RS
678 Lisp_Object val, elt;
679
680 elt = XCONS (tail)->car;
681
e0585c64
RS
682 /* Reference each variable in the alist in buf.
683 If inquiring about the current buffer, this gets the current values,
684 so store them into the alist so the alist is up to date.
685 If inquiring about some other buffer, this swaps out any values
686 for that buffer, making the alist up to date automatically. */
687 val = find_symbol_value (XCONS (elt)->car);
688 /* Use the current buffer value only if buf is the current buffer. */
689 if (buf != current_buffer)
553defa4
RS
690 val = XCONS (elt)->cdr;
691
692 /* If symbol is unbound, put just the symbol in the list. */
693 if (EQ (val, Qunbound))
694 result = Fcons (XCONS (elt)->car, result);
695 /* Otherwise, put (symbol . value) in the list. */
696 else
697 result = Fcons (Fcons (XCONS (elt)->car, val), result);
1ab256cb
RM
698 }
699 }
700
1ab256cb
RM
701 /* Add on all the variables stored in special slots. */
702 {
703 register int offset, mask;
704
705 for (offset = (char *)&buffer_local_symbols.name - (char *)&buffer_local_symbols;
706 offset < sizeof (struct buffer);
4d2f1389 707 offset += (sizeof (EMACS_INT))) /* sizeof EMACS_INT == sizeof Lisp_Object */
1ab256cb 708 {
aab80822 709 mask = XINT (*(Lisp_Object *)(offset + (char *)&buffer_local_flags));
1ab256cb 710 if (mask == -1 || (buf->local_var_flags & mask))
aab80822
KH
711 if (SYMBOLP (*(Lisp_Object *)(offset
712 + (char *)&buffer_local_symbols)))
713 result = Fcons (Fcons (*((Lisp_Object *)
714 (offset + (char *)&buffer_local_symbols)),
553defa4
RS
715 *(Lisp_Object *)(offset + (char *)buf)),
716 result);
1ab256cb
RM
717 }
718 }
553defa4
RS
719
720 return result;
1ab256cb
RM
721}
722
723\f
724DEFUN ("buffer-modified-p", Fbuffer_modified_p, Sbuffer_modified_p,
725 0, 1, 0,
726 "Return t if BUFFER was modified since its file was last read or saved.\n\
727No argument or nil as argument means use current buffer as BUFFER.")
728 (buffer)
729 register Lisp_Object buffer;
730{
731 register struct buffer *buf;
265a9e55 732 if (NILP (buffer))
1ab256cb
RM
733 buf = current_buffer;
734 else
735 {
736 CHECK_BUFFER (buffer, 0);
737 buf = XBUFFER (buffer);
738 }
739
336cd056 740 return BUF_SAVE_MODIFF (buf) < BUF_MODIFF (buf) ? Qt : Qnil;
1ab256cb
RM
741}
742
743DEFUN ("set-buffer-modified-p", Fset_buffer_modified_p, Sset_buffer_modified_p,
744 1, 1, 0,
745 "Mark current buffer as modified or unmodified according to FLAG.\n\
746A non-nil FLAG means mark the buffer modified.")
747 (flag)
748 register Lisp_Object flag;
749{
750 register int already;
751 register Lisp_Object fn;
752
753#ifdef CLASH_DETECTION
754 /* If buffer becoming modified, lock the file.
755 If buffer becoming unmodified, unlock the file. */
756
60f4dd23 757 fn = current_buffer->file_truename;
265a9e55 758 if (!NILP (fn))
1ab256cb 759 {
336cd056 760 already = SAVE_MODIFF < MODIFF;
265a9e55 761 if (!already && !NILP (flag))
1ab256cb 762 lock_file (fn);
265a9e55 763 else if (already && NILP (flag))
1ab256cb
RM
764 unlock_file (fn);
765 }
766#endif /* CLASH_DETECTION */
767
336cd056 768 SAVE_MODIFF = NILP (flag) ? MODIFF : 0;
1ab256cb
RM
769 update_mode_lines++;
770 return flag;
771}
772
773DEFUN ("buffer-modified-tick", Fbuffer_modified_tick, Sbuffer_modified_tick,
774 0, 1, 0,
775 "Return BUFFER's tick counter, incremented for each change in text.\n\
776Each buffer has a tick counter which is incremented each time the text in\n\
777that buffer is changed. It wraps around occasionally.\n\
778No argument or nil as argument means use current buffer as BUFFER.")
779 (buffer)
780 register Lisp_Object buffer;
781{
782 register struct buffer *buf;
265a9e55 783 if (NILP (buffer))
1ab256cb
RM
784 buf = current_buffer;
785 else
786 {
787 CHECK_BUFFER (buffer, 0);
788 buf = XBUFFER (buffer);
789 }
790
791 return make_number (BUF_MODIFF (buf));
792}
793\f
01050cb5 794DEFUN ("rename-buffer", Frename_buffer, Srename_buffer, 1, 2,
4c7e5f09 795 "sRename buffer (to new name): \nP",
1ab256cb 796 "Change current buffer's name to NEWNAME (a string).\n\
3bd779aa 797If second arg UNIQUE is nil or omitted, it is an error if a\n\
01050cb5 798buffer named NEWNAME already exists.\n\
3bd779aa 799If UNIQUE is non-nil, come up with a new name using\n\
01050cb5 800`generate-new-buffer-name'.\n\
3bd779aa
RS
801Interactively, you can set UNIQUE with a prefix argument.\n\
802We return the name we actually gave the buffer.\n\
1ab256cb 803This does not change the name of the visited file (if any).")
489c043a
RS
804 (newname, unique)
805 register Lisp_Object newname, unique;
1ab256cb
RM
806{
807 register Lisp_Object tem, buf;
808
489c043a 809 CHECK_STRING (newname, 0);
d59698c4 810
489c043a 811 if (XSTRING (newname)->size == 0)
d59698c4
RS
812 error ("Empty string is invalid as a buffer name");
813
489c043a 814 tem = Fget_buffer (newname);
c059b5ea
RM
815 /* Don't short-circuit if UNIQUE is t. That is a useful way to rename
816 the buffer automatically so you can create another with the original name.
817 It makes UNIQUE equivalent to
489c043a 818 (rename-buffer (generate-new-buffer-name NEWNAME)). */
c059b5ea 819 if (NILP (unique) && XBUFFER (tem) == current_buffer)
fb5eba9c 820 return current_buffer->name;
265a9e55 821 if (!NILP (tem))
01050cb5 822 {
3bd779aa 823 if (!NILP (unique))
489c043a 824 newname = Fgenerate_new_buffer_name (newname, current_buffer->name);
01050cb5 825 else
489c043a 826 error ("Buffer name `%s' is in use", XSTRING (newname)->data);
01050cb5 827 }
1ab256cb 828
489c043a 829 current_buffer->name = newname;
76f590d7
JB
830
831 /* Catch redisplay's attention. Unless we do this, the mode lines for
832 any windows displaying current_buffer will stay unchanged. */
833 update_mode_lines++;
834
67180c6a 835 XSETBUFFER (buf, current_buffer);
489c043a 836 Fsetcar (Frassq (buf, Vbuffer_alist), newname);
cf058e49
KH
837 if (NILP (current_buffer->filename)
838 && !NILP (current_buffer->auto_save_file_name))
1ab256cb 839 call0 (intern ("rename-auto-save-file"));
fb5eba9c
RS
840 /* Refetch since that last call may have done GC. */
841 return current_buffer->name;
1ab256cb
RM
842}
843
a0ebb746 844DEFUN ("other-buffer", Fother_buffer, Sother_buffer, 0, 2, 0,
1ab256cb 845 "Return most recently selected buffer other than BUFFER.\n\
a0ebb746
JB
846Buffers not visible in windows are preferred to visible buffers,\n\
847unless optional second argument VISIBLE-OK is non-nil.\n\
1ab256cb
RM
848If no other buffer exists, the buffer `*scratch*' is returned.\n\
849If BUFFER is omitted or nil, some interesting buffer is returned.")
a0ebb746
JB
850 (buffer, visible_ok)
851 register Lisp_Object buffer, visible_ok;
1ab256cb 852{
89132f25 853 Lisp_Object Fset_buffer_major_mode ();
7962a441 854 register Lisp_Object tail, buf, notsogood, tem, pred, add_ons;
1ab256cb
RM
855 notsogood = Qnil;
856
7962a441
RS
857 tail = Vbuffer_alist;
858 pred = frame_buffer_predicate ();
859
860 /* Consider buffers that have been seen in the selected frame
861 before other buffers. */
862
863 tem = frame_buffer_list ();
864 add_ons = Qnil;
865 while (CONSP (tem))
866 {
867 if (BUFFERP (XCONS (tem)->car))
868 add_ons = Fcons (Fcons (Qnil, XCONS (tem)->car), add_ons);
869 tem = XCONS (tem)->cdr;
870 }
871 tail = nconc2 (Fnreverse (add_ons), tail);
872
873 for (; !NILP (tail); tail = Fcdr (tail))
1ab256cb
RM
874 {
875 buf = Fcdr (Fcar (tail));
876 if (EQ (buf, buffer))
877 continue;
878 if (XSTRING (XBUFFER (buf)->name)->data[0] == ' ')
879 continue;
04ae1b48
RS
880 /* If the selected frame has a buffer_predicate,
881 disregard buffers that don't fit the predicate. */
7962a441 882 if (!NILP (pred))
04ae1b48 883 {
7962a441 884 tem = call1 (pred, buf);
04ae1b48
RS
885 if (NILP (tem))
886 continue;
887 }
04ae1b48 888
a0ebb746 889 if (NILP (visible_ok))
db732e5a 890 tem = Fget_buffer_window (buf, Qt);
a0ebb746
JB
891 else
892 tem = Qnil;
265a9e55 893 if (NILP (tem))
1ab256cb 894 return buf;
265a9e55 895 if (NILP (notsogood))
1ab256cb
RM
896 notsogood = buf;
897 }
265a9e55 898 if (!NILP (notsogood))
1ab256cb 899 return notsogood;
89132f25
KH
900 buf = Fget_buffer_create (build_string ("*scratch*"));
901 Fset_buffer_major_mode (buf);
902 return buf;
1ab256cb
RM
903}
904\f
316784fb
KH
905DEFUN ("buffer-disable-undo", Fbuffer_disable_undo, Sbuffer_disable_undo,
906 0, 1, "",
5b8bcf48
RS
907 "Make BUFFER stop keeping undo information.\n\
908No argument or nil as argument means do this for the current buffer.")
ffd56f97
JB
909 (buffer)
910 register Lisp_Object buffer;
1ab256cb 911{
ffd56f97
JB
912 Lisp_Object real_buffer;
913
914 if (NILP (buffer))
67180c6a 915 XSETBUFFER (real_buffer, current_buffer);
ffd56f97
JB
916 else
917 {
918 real_buffer = Fget_buffer (buffer);
919 if (NILP (real_buffer))
920 nsberror (buffer);
921 }
922
923 XBUFFER (real_buffer)->undo_list = Qt;
924
1ab256cb
RM
925 return Qnil;
926}
927
928DEFUN ("buffer-enable-undo", Fbuffer_enable_undo, Sbuffer_enable_undo,
929 0, 1, "",
930 "Start keeping undo information for buffer BUFFER.\n\
931No argument or nil as argument means do this for the current buffer.")
ffd56f97
JB
932 (buffer)
933 register Lisp_Object buffer;
1ab256cb 934{
ffd56f97 935 Lisp_Object real_buffer;
1ab256cb 936
ffd56f97 937 if (NILP (buffer))
67180c6a 938 XSETBUFFER (real_buffer, current_buffer);
1ab256cb
RM
939 else
940 {
ffd56f97
JB
941 real_buffer = Fget_buffer (buffer);
942 if (NILP (real_buffer))
943 nsberror (buffer);
1ab256cb
RM
944 }
945
ffd56f97
JB
946 if (EQ (XBUFFER (real_buffer)->undo_list, Qt))
947 XBUFFER (real_buffer)->undo_list = Qnil;
1ab256cb
RM
948
949 return Qnil;
950}
951
952/*
953 DEFVAR_LISP ("kill-buffer-hook", no_cell, "\
954Hook to be run (by `run-hooks', which see) when a buffer is killed.\n\
955The buffer being killed will be current while the hook is running.\n\
956See `kill-buffer'."
957 */
958DEFUN ("kill-buffer", Fkill_buffer, Skill_buffer, 1, 1, "bKill buffer: ",
959 "Kill the buffer BUFFER.\n\
960The argument may be a buffer or may be the name of a buffer.\n\
961An argument of nil means kill the current buffer.\n\n\
962Value is t if the buffer is actually killed, nil if user says no.\n\n\
963The value of `kill-buffer-hook' (which may be local to that buffer),\n\
964if not void, is a list of functions to be called, with no arguments,\n\
965before the buffer is actually killed. The buffer to be killed is current\n\
966when the hook functions are called.\n\n\
967Any processes that have this buffer as the `process-buffer' are killed\n\
b64d7442 968with SIGHUP.")
a25f13ae
KH
969 (buffer)
970 Lisp_Object buffer;
1ab256cb
RM
971{
972 Lisp_Object buf;
973 register struct buffer *b;
974 register Lisp_Object tem;
975 register struct Lisp_Marker *m;
976 struct gcpro gcpro1, gcpro2;
977
a25f13ae 978 if (NILP (buffer))
1ab256cb
RM
979 buf = Fcurrent_buffer ();
980 else
a25f13ae 981 buf = Fget_buffer (buffer);
265a9e55 982 if (NILP (buf))
a25f13ae 983 nsberror (buffer);
1ab256cb
RM
984
985 b = XBUFFER (buf);
986
4a4a9db5
KH
987 /* Avoid trouble for buffer already dead. */
988 if (NILP (b->name))
989 return Qnil;
990
1ab256cb 991 /* Query if the buffer is still modified. */
265a9e55 992 if (INTERACTIVE && !NILP (b->filename)
336cd056 993 && BUF_MODIFF (b) > BUF_SAVE_MODIFF (b))
1ab256cb 994 {
a25f13ae 995 GCPRO1 (buf);
1ab256cb
RM
996 tem = do_yes_or_no_p (format1 ("Buffer %s modified; kill anyway? ",
997 XSTRING (b->name)->data));
998 UNGCPRO;
265a9e55 999 if (NILP (tem))
1ab256cb
RM
1000 return Qnil;
1001 }
1002
dcdffbf6 1003 /* Run hooks with the buffer to be killed the current buffer. */
1ab256cb
RM
1004 {
1005 register Lisp_Object val;
1006 int count = specpdl_ptr - specpdl;
dcdffbf6 1007 Lisp_Object list;
1ab256cb
RM
1008
1009 record_unwind_protect (save_excursion_restore, save_excursion_save ());
1010 set_buffer_internal (b);
dcdffbf6
RS
1011
1012 /* First run the query functions; if any query is answered no,
1013 don't kill the buffer. */
1014 for (list = Vkill_buffer_query_functions; !NILP (list); list = Fcdr (list))
1015 {
1016 tem = call0 (Fcar (list));
1017 if (NILP (tem))
1018 return unbind_to (count, Qnil);
1019 }
1020
1021 /* Then run the hooks. */
fd186f07
RS
1022 if (!NILP (Vrun_hooks))
1023 call1 (Vrun_hooks, Qkill_buffer_hook);
1ab256cb
RM
1024 unbind_to (count, Qnil);
1025 }
1026
1027 /* We have no more questions to ask. Verify that it is valid
1028 to kill the buffer. This must be done after the questions
1029 since anything can happen within do_yes_or_no_p. */
1030
1031 /* Don't kill the minibuffer now current. */
1032 if (EQ (buf, XWINDOW (minibuf_window)->buffer))
1033 return Qnil;
1034
265a9e55 1035 if (NILP (b->name))
1ab256cb
RM
1036 return Qnil;
1037
336cd056
RS
1038 /* When we kill a base buffer, kill all its indirect buffers.
1039 We do it at this stage so nothing terrible happens if they
1040 ask questions or their hooks get errors. */
1041 if (! b->base_buffer)
1042 {
1043 struct buffer *other;
1044
1045 GCPRO1 (buf);
1046
1047 for (other = all_buffers; other; other = other->next)
4a4a9db5
KH
1048 /* all_buffers contains dead buffers too;
1049 don't re-kill them. */
1050 if (other->base_buffer == b && !NILP (other->name))
336cd056
RS
1051 {
1052 Lisp_Object buf;
1053 XSETBUFFER (buf, other);
1054 Fkill_buffer (buf);
1055 }
1056
1057 UNGCPRO;
1058 }
1059
1ab256cb
RM
1060 /* Make this buffer not be current.
1061 In the process, notice if this is the sole visible buffer
1062 and give up if so. */
1063 if (b == current_buffer)
1064 {
172a9c1f 1065 tem = Fother_buffer (buf, Qnil);
1ab256cb
RM
1066 Fset_buffer (tem);
1067 if (b == current_buffer)
1068 return Qnil;
1069 }
1070
1071 /* Now there is no question: we can kill the buffer. */
1072
1073#ifdef CLASH_DETECTION
1074 /* Unlock this buffer's file, if it is locked. */
1075 unlock_buffer (b);
1076#endif /* CLASH_DETECTION */
1077
1ab256cb 1078 kill_buffer_processes (buf);
1ab256cb
RM
1079
1080 tem = Vinhibit_quit;
1081 Vinhibit_quit = Qt;
00550f94 1082 replace_buffer_in_all_windows (buf);
b26dd9cb 1083 Vbuffer_alist = Fdelq (Frassq (buf, Vbuffer_alist), Vbuffer_alist);
7962a441 1084 frames_discard_buffer (buf);
1ab256cb
RM
1085 Vinhibit_quit = tem;
1086
9b59d6d0 1087 /* Delete any auto-save file, if we saved it in this session. */
a7a60ce9 1088 if (STRINGP (b->auto_save_file_name)
e95a0b39
RS
1089 && b->auto_save_modified != 0
1090 && SAVE_MODIFF < b->auto_save_modified)
1ab256cb
RM
1091 {
1092 Lisp_Object tem;
1093 tem = Fsymbol_value (intern ("delete-auto-save-files"));
265a9e55 1094 if (! NILP (tem))
cbb6a418 1095 internal_delete_file (b->auto_save_file_name);
1ab256cb
RM
1096 }
1097
4a4a9db5
KH
1098 if (b->base_buffer)
1099 {
1100 /* Unchain all markers that belong to this indirect buffer.
1101 Don't unchain the markers that belong to the base buffer
1102 or its other indirect buffers. */
1103 for (tem = BUF_MARKERS (b); !NILP (tem); )
1104 {
1105 Lisp_Object next;
1106 m = XMARKER (tem);
1107 next = m->chain;
1108 if (m->buffer == b)
1109 unchain_marker (tem);
1110 tem = next;
1111 }
1112 }
1113 else
1ab256cb 1114 {
4a4a9db5 1115 /* Unchain all markers of this buffer and its indirect buffers.
336cd056 1116 and leave them pointing nowhere. */
4a4a9db5 1117 for (tem = BUF_MARKERS (b); !NILP (tem); )
336cd056
RS
1118 {
1119 m = XMARKER (tem);
1120 m->buffer = 0;
1121 tem = m->chain;
1122 m->chain = Qnil;
1123 }
1124 BUF_MARKERS (b) = Qnil;
1ab256cb 1125
336cd056
RS
1126#ifdef USE_TEXT_PROPERTIES
1127 BUF_INTERVALS (b) = NULL_INTERVAL;
1128#endif
1129
1130 /* Perhaps we should explicitly free the interval tree here... */
1131 }
33f7013e 1132
2f3f993b
RS
1133 /* Reset the local variables, so that this buffer's local values
1134 won't be protected from GC. They would be protected
1135 if they happened to remain encached in their symbols.
1136 This gets rid of them for certain. */
1137 swap_out_buffer_local_variables (b);
13de9290 1138 reset_buffer_local_variables (b, 1);
2f3f993b 1139
1ab256cb 1140 b->name = Qnil;
336cd056 1141
9ac0d9e0 1142 BLOCK_INPUT;
336cd056
RS
1143 if (! b->base_buffer)
1144 BUFFER_FREE (BUF_BEG_ADDR (b));
1145
28e969dd
JB
1146 if (b->newline_cache)
1147 {
1148 free_region_cache (b->newline_cache);
1149 b->newline_cache = 0;
1150 }
1151 if (b->width_run_cache)
1152 {
1153 free_region_cache (b->width_run_cache);
1154 b->width_run_cache = 0;
1155 }
1156 b->width_table = Qnil;
9ac0d9e0 1157 UNBLOCK_INPUT;
1ab256cb
RM
1158 b->undo_list = Qnil;
1159
1160 return Qt;
1161}
1162\f
36a8c287
JB
1163/* Move the assoc for buffer BUF to the front of buffer-alist. Since
1164 we do this each time BUF is selected visibly, the more recently
1165 selected buffers are always closer to the front of the list. This
1166 means that other_buffer is more likely to choose a relevant buffer. */
1ab256cb
RM
1167
1168record_buffer (buf)
1169 Lisp_Object buf;
1170{
1171 register Lisp_Object link, prev;
1172
1173 prev = Qnil;
1174 for (link = Vbuffer_alist; CONSP (link); link = XCONS (link)->cdr)
1175 {
1176 if (EQ (XCONS (XCONS (link)->car)->cdr, buf))
1177 break;
1178 prev = link;
1179 }
1180
36a8c287
JB
1181 /* Effectively do Vbuffer_alist = Fdelq (link, Vbuffer_alist);
1182 we cannot use Fdelq itself here because it allows quitting. */
1ab256cb 1183
265a9e55 1184 if (NILP (prev))
1ab256cb
RM
1185 Vbuffer_alist = XCONS (Vbuffer_alist)->cdr;
1186 else
1187 XCONS (prev)->cdr = XCONS (XCONS (prev)->cdr)->cdr;
1188
7962a441 1189 XCONS (link)->cdr = Vbuffer_alist;
1ab256cb 1190 Vbuffer_alist = link;
7962a441
RS
1191
1192 /* Now move this buffer to the front of frame_buffer_list also. */
1193
1194 prev = Qnil;
1195 for (link = frame_buffer_list (); CONSP (link); link = XCONS (link)->cdr)
1196 {
1197 if (EQ (XCONS (link)->car, buf))
1198 break;
1199 prev = link;
1200 }
1201
1202 /* Effectively do delq. */
1203
1204 if (CONSP (link))
1205 {
1206 if (NILP (prev))
1207 set_frame_buffer_list (XCONS (frame_buffer_list ())->cdr);
1208 else
1209 XCONS (prev)->cdr = XCONS (XCONS (prev)->cdr)->cdr;
1210
1211 XCONS (link)->cdr = frame_buffer_list ();
1212 set_frame_buffer_list (link);
1213 }
1214 else
1215 set_frame_buffer_list (Fcons (buf, frame_buffer_list ()));
1ab256cb
RM
1216}
1217
a9ee7a59
KH
1218DEFUN ("set-buffer-major-mode", Fset_buffer_major_mode, Sset_buffer_major_mode, 1, 1, 0,
1219 "Set an appropriate major mode for BUFFER, according to `default-major-mode'.\n\
1220Use this function before selecting the buffer, since it may need to inspect\n\
1221the current buffer's major mode.")
a2428fa2
EN
1222 (buffer)
1223 Lisp_Object buffer;
a9ee7a59
KH
1224{
1225 int count;
1226 Lisp_Object function;
1227
1228 function = buffer_defaults.major_mode;
1229 if (NILP (function) && NILP (Fget (current_buffer->major_mode, Qmode_class)))
1230 function = current_buffer->major_mode;
1231
1232 if (NILP (function) || EQ (function, Qfundamental_mode))
1233 return Qnil;
1234
1235 count = specpdl_ptr - specpdl;
1236
1237 /* To select a nonfundamental mode,
1238 select the buffer temporarily and then call the mode function. */
1239
1240 record_unwind_protect (save_excursion_restore, save_excursion_save ());
1241
a2428fa2 1242 Fset_buffer (buffer);
a9ee7a59
KH
1243 call0 (function);
1244
1245 return unbind_to (count, Qnil);
1246}
1247
1ab256cb
RM
1248DEFUN ("switch-to-buffer", Fswitch_to_buffer, Sswitch_to_buffer, 1, 2, "BSwitch to buffer: ",
1249 "Select buffer BUFFER in the current window.\n\
1250BUFFER may be a buffer or a buffer name.\n\
1251Optional second arg NORECORD non-nil means\n\
1252do not put this buffer at the front of the list of recently selected ones.\n\
1253\n\
1254WARNING: This is NOT the way to work on another buffer temporarily\n\
1255within a Lisp program! Use `set-buffer' instead. That avoids messing with\n\
1256the window-buffer correspondences.")
a25f13ae
KH
1257 (buffer, norecord)
1258 Lisp_Object buffer, norecord;
1ab256cb
RM
1259{
1260 register Lisp_Object buf;
1261 Lisp_Object tem;
1262
1263 if (EQ (minibuf_window, selected_window))
1264 error ("Cannot switch buffers in minibuffer window");
1265 tem = Fwindow_dedicated_p (selected_window);
265a9e55 1266 if (!NILP (tem))
1ab256cb
RM
1267 error ("Cannot switch buffers in a dedicated window");
1268
a25f13ae 1269 if (NILP (buffer))
172a9c1f 1270 buf = Fother_buffer (Fcurrent_buffer (), Qnil);
1ab256cb 1271 else
a9ee7a59 1272 {
a25f13ae 1273 buf = Fget_buffer (buffer);
a9ee7a59
KH
1274 if (NILP (buf))
1275 {
a25f13ae 1276 buf = Fget_buffer_create (buffer);
a9ee7a59
KH
1277 Fset_buffer_major_mode (buf);
1278 }
1279 }
1ab256cb 1280 Fset_buffer (buf);
265a9e55 1281 if (NILP (norecord))
1ab256cb
RM
1282 record_buffer (buf);
1283
1284 Fset_window_buffer (EQ (selected_window, minibuf_window)
5fcd022d
JB
1285 ? Fnext_window (minibuf_window, Qnil, Qnil)
1286 : selected_window,
1ab256cb
RM
1287 buf);
1288
cd0c235a 1289 return buf;
1ab256cb
RM
1290}
1291
cd0c235a 1292DEFUN ("pop-to-buffer", Fpop_to_buffer, Spop_to_buffer, 1, 3, 0,
1ab256cb
RM
1293 "Select buffer BUFFER in some window, preferably a different one.\n\
1294If BUFFER is nil, then some other buffer is chosen.\n\
1295If `pop-up-windows' is non-nil, windows can be split to do this.\n\
1296If optional second arg OTHER-WINDOW is non-nil, insist on finding another\n\
405615e5
RS
1297window even if BUFFER is already visible in the selected window.\n\
1298This uses the function `display-buffer' as a subroutine; see the documentation\n\
6d12711f
RS
1299of `display-buffer' for additional customization information.\n\
1300\n\
1301Optional third arg NORECORD non-nil means\n\
1302do not put this buffer at the front of the list of recently selected ones.")
1303 (buffer, other_window, norecord)
1304 Lisp_Object buffer, other_window, norecord;
1ab256cb
RM
1305{
1306 register Lisp_Object buf;
a25f13ae 1307 if (NILP (buffer))
172a9c1f 1308 buf = Fother_buffer (Fcurrent_buffer (), Qnil);
1ab256cb 1309 else
7c2087ee 1310 {
a25f13ae 1311 buf = Fget_buffer (buffer);
7c2087ee
RS
1312 if (NILP (buf))
1313 {
a25f13ae 1314 buf = Fget_buffer_create (buffer);
7c2087ee
RS
1315 Fset_buffer_major_mode (buf);
1316 }
1317 }
1ab256cb 1318 Fset_buffer (buf);
6d12711f
RS
1319 if (NILP (norecord))
1320 record_buffer (buf);
a2428fa2 1321 Fselect_window (Fdisplay_buffer (buf, other_window));
e8b3a22d 1322 return buf;
1ab256cb
RM
1323}
1324
1325DEFUN ("current-buffer", Fcurrent_buffer, Scurrent_buffer, 0, 0, 0,
1326 "Return the current buffer as a Lisp object.")
1327 ()
1328{
1329 register Lisp_Object buf;
67180c6a 1330 XSETBUFFER (buf, current_buffer);
1ab256cb
RM
1331 return buf;
1332}
1333\f
c7aa5005 1334/* Set the current buffer to B. */
1ab256cb
RM
1335
1336void
1337set_buffer_internal (b)
1338 register struct buffer *b;
1339{
1340 register struct buffer *old_buf;
1341 register Lisp_Object tail, valcontents;
a7a60ce9 1342 Lisp_Object tem;
1ab256cb
RM
1343
1344 if (current_buffer == b)
1345 return;
1346
1347 windows_or_buffers_changed = 1;
c7aa5005
KH
1348 set_buffer_internal_1 (b);
1349}
1350
1351/* Set the current buffer to B, and do not set windows_or_buffers_changed.
1352 This is used by redisplay. */
1353
1354void
1355set_buffer_internal_1 (b)
1356 register struct buffer *b;
1357{
1358 register struct buffer *old_buf;
1359 register Lisp_Object tail, valcontents;
1360 Lisp_Object tem;
1361
1362 if (current_buffer == b)
1363 return;
1364
1ab256cb
RM
1365 old_buf = current_buffer;
1366 current_buffer = b;
1367 last_known_column_point = -1; /* invalidate indentation cache */
1368
336cd056
RS
1369 if (old_buf)
1370 {
1371 /* Put the undo list back in the base buffer, so that it appears
1372 that an indirect buffer shares the undo list of its base. */
1373 if (old_buf->base_buffer)
1374 old_buf->base_buffer->undo_list = old_buf->undo_list;
1375
1376 /* If the old current buffer has markers to record PT, BEGV and ZV
1377 when it is not current, update them now. */
1378 if (! NILP (old_buf->pt_marker))
1379 {
1380 Lisp_Object obuf;
1381 XSETBUFFER (obuf, old_buf);
1382 Fset_marker (old_buf->pt_marker, BUF_PT (old_buf), obuf);
1383 }
1384 if (! NILP (old_buf->begv_marker))
1385 {
1386 Lisp_Object obuf;
1387 XSETBUFFER (obuf, old_buf);
1388 Fset_marker (old_buf->begv_marker, BUF_BEGV (old_buf), obuf);
1389 }
1390 if (! NILP (old_buf->zv_marker))
1391 {
1392 Lisp_Object obuf;
1393 XSETBUFFER (obuf, old_buf);
1394 Fset_marker (old_buf->zv_marker, BUF_ZV (old_buf), obuf);
1395 }
1396 }
1397
1398 /* Get the undo list from the base buffer, so that it appears
1399 that an indirect buffer shares the undo list of its base. */
1400 if (b->base_buffer)
1401 b->undo_list = b->base_buffer->undo_list;
1402
1403 /* If the new current buffer has markers to record PT, BEGV and ZV
1404 when it is not current, fetch them now. */
1405 if (! NILP (b->pt_marker))
1406 BUF_PT (b) = marker_position (b->pt_marker);
1407 if (! NILP (b->begv_marker))
1408 BUF_BEGV (b) = marker_position (b->begv_marker);
1409 if (! NILP (b->zv_marker))
1410 BUF_ZV (b) = marker_position (b->zv_marker);
1411
1ab256cb
RM
1412 /* Look down buffer's list of local Lisp variables
1413 to find and update any that forward into C variables. */
1414
265a9e55 1415 for (tail = b->local_var_alist; !NILP (tail); tail = XCONS (tail)->cdr)
1ab256cb
RM
1416 {
1417 valcontents = XSYMBOL (XCONS (XCONS (tail)->car)->car)->value;
a7a60ce9
KH
1418 if ((BUFFER_LOCAL_VALUEP (valcontents)
1419 || SOME_BUFFER_LOCAL_VALUEP (valcontents))
fdc6e516 1420 && (tem = XBUFFER_LOCAL_VALUE (valcontents)->car,
a7a60ce9 1421 (BOOLFWDP (tem) || INTFWDP (tem) || OBJFWDP (tem))))
1ab256cb
RM
1422 /* Just reference the variable
1423 to cause it to become set for this buffer. */
1424 Fsymbol_value (XCONS (XCONS (tail)->car)->car);
1425 }
1426
1427 /* Do the same with any others that were local to the previous buffer */
1428
1429 if (old_buf)
265a9e55 1430 for (tail = old_buf->local_var_alist; !NILP (tail); tail = XCONS (tail)->cdr)
1ab256cb
RM
1431 {
1432 valcontents = XSYMBOL (XCONS (XCONS (tail)->car)->car)->value;
a7a60ce9
KH
1433 if ((BUFFER_LOCAL_VALUEP (valcontents)
1434 || SOME_BUFFER_LOCAL_VALUEP (valcontents))
fdc6e516 1435 && (tem = XBUFFER_LOCAL_VALUE (valcontents)->car,
a7a60ce9 1436 (BOOLFWDP (tem) || INTFWDP (tem) || OBJFWDP (tem))))
1ab256cb
RM
1437 /* Just reference the variable
1438 to cause it to become set for this buffer. */
1439 Fsymbol_value (XCONS (XCONS (tail)->car)->car);
1440 }
1441}
1442
336cd056 1443/* Switch to buffer B temporarily for redisplay purposes.
bbbe9545 1444 This avoids certain things that don't need to be done within redisplay. */
336cd056
RS
1445
1446void
1447set_buffer_temp (b)
1448 struct buffer *b;
1449{
1450 register struct buffer *old_buf;
1451
1452 if (current_buffer == b)
1453 return;
1454
1455 old_buf = current_buffer;
1456 current_buffer = b;
1457
1458 if (old_buf)
1459 {
1460 /* If the old current buffer has markers to record PT, BEGV and ZV
1461 when it is not current, update them now. */
1462 if (! NILP (old_buf->pt_marker))
1463 {
1464 Lisp_Object obuf;
1465 XSETBUFFER (obuf, old_buf);
1466 Fset_marker (old_buf->pt_marker, BUF_PT (old_buf), obuf);
1467 }
1468 if (! NILP (old_buf->begv_marker))
1469 {
1470 Lisp_Object obuf;
1471 XSETBUFFER (obuf, old_buf);
1472 Fset_marker (old_buf->begv_marker, BUF_BEGV (old_buf), obuf);
1473 }
1474 if (! NILP (old_buf->zv_marker))
1475 {
1476 Lisp_Object obuf;
1477 XSETBUFFER (obuf, old_buf);
1478 Fset_marker (old_buf->zv_marker, BUF_ZV (old_buf), obuf);
1479 }
1480 }
1481
1482 /* If the new current buffer has markers to record PT, BEGV and ZV
1483 when it is not current, fetch them now. */
1484 if (! NILP (b->pt_marker))
1485 BUF_PT (b) = marker_position (b->pt_marker);
1486 if (! NILP (b->begv_marker))
1487 BUF_BEGV (b) = marker_position (b->begv_marker);
1488 if (! NILP (b->zv_marker))
1489 BUF_ZV (b) = marker_position (b->zv_marker);
1490}
1491
1ab256cb
RM
1492DEFUN ("set-buffer", Fset_buffer, Sset_buffer, 1, 1, 0,
1493 "Make the buffer BUFFER current for editing operations.\n\
1494BUFFER may be a buffer or the name of an existing buffer.\n\
1495See also `save-excursion' when you want to make a buffer current temporarily.\n\
1496This function does not display the buffer, so its effect ends\n\
1497when the current command terminates.\n\
1498Use `switch-to-buffer' or `pop-to-buffer' to switch buffers permanently.")
a25f13ae
KH
1499 (buffer)
1500 register Lisp_Object buffer;
1ab256cb 1501{
a25f13ae
KH
1502 register Lisp_Object buf;
1503 buf = Fget_buffer (buffer);
1504 if (NILP (buf))
1505 nsberror (buffer);
1506 if (NILP (XBUFFER (buf)->name))
1ab256cb 1507 error ("Selecting deleted buffer");
a25f13ae
KH
1508 set_buffer_internal (XBUFFER (buf));
1509 return buf;
1ab256cb
RM
1510}
1511\f
1512DEFUN ("barf-if-buffer-read-only", Fbarf_if_buffer_read_only,
1513 Sbarf_if_buffer_read_only, 0, 0, 0,
1514 "Signal a `buffer-read-only' error if the current buffer is read-only.")
1515 ()
1516{
a96b68f1
RS
1517 if (!NILP (current_buffer->read_only)
1518 && NILP (Vinhibit_read_only))
1ab256cb
RM
1519 Fsignal (Qbuffer_read_only, (Fcons (Fcurrent_buffer (), Qnil)));
1520 return Qnil;
1521}
1522
1523DEFUN ("bury-buffer", Fbury_buffer, Sbury_buffer, 0, 1, "",
1524 "Put BUFFER at the end of the list of all buffers.\n\
1525There it is the least likely candidate for `other-buffer' to return;\n\
528415e7 1526thus, the least likely buffer for \\[switch-to-buffer] to select by default.\n\
a5611885
JB
1527If BUFFER is nil or omitted, bury the current buffer.\n\
1528Also, if BUFFER is nil or omitted, remove the current buffer from the\n\
1529selected window if it is displayed there.")
a2428fa2
EN
1530 (buffer)
1531 register Lisp_Object buffer;
1ab256cb 1532{
b271272a 1533 /* Figure out what buffer we're going to bury. */
a2428fa2 1534 if (NILP (buffer))
a5611885 1535 {
a2428fa2 1536 XSETBUFFER (buffer, current_buffer);
a5611885
JB
1537
1538 /* If we're burying the current buffer, unshow it. */
a2428fa2 1539 Fswitch_to_buffer (Fother_buffer (buffer, Qnil), Qnil);
a5611885 1540 }
1ab256cb
RM
1541 else
1542 {
1543 Lisp_Object buf1;
1544
a2428fa2 1545 buf1 = Fget_buffer (buffer);
265a9e55 1546 if (NILP (buf1))
a2428fa2
EN
1547 nsberror (buffer);
1548 buffer = buf1;
b271272a
JB
1549 }
1550
a2428fa2 1551 /* Move buffer to the end of the buffer list. */
b271272a
JB
1552 {
1553 register Lisp_Object aelt, link;
1554
a2428fa2 1555 aelt = Frassq (buffer, Vbuffer_alist);
b271272a
JB
1556 link = Fmemq (aelt, Vbuffer_alist);
1557 Vbuffer_alist = Fdelq (aelt, Vbuffer_alist);
1558 XCONS (link)->cdr = Qnil;
1559 Vbuffer_alist = nconc2 (Vbuffer_alist, link);
1560 }
1ab256cb 1561
dcb26650 1562 frames_bury_buffer (buffer);
dec989eb 1563
1ab256cb
RM
1564 return Qnil;
1565}
1566\f
c922bc55 1567DEFUN ("erase-buffer", Ferase_buffer, Serase_buffer, 0, 0, "*",
1ab256cb 1568 "Delete the entire contents of the current buffer.\n\
2950a20e 1569Any narrowing restriction in effect (see `narrow-to-region') is removed,\n\
1ab256cb
RM
1570so the buffer is truly empty after this.")
1571 ()
1572{
1573 Fwiden ();
1574 del_range (BEG, Z);
1575 current_buffer->last_window_start = 1;
1576 /* Prevent warnings, or suspension of auto saving, that would happen
1577 if future size is less than past size. Use of erase-buffer
1578 implies that the future text is not really related to the past text. */
8d7a4592 1579 XSETFASTINT (current_buffer->save_length, 0);
1ab256cb
RM
1580 return Qnil;
1581}
1582
1583validate_region (b, e)
1584 register Lisp_Object *b, *e;
1585{
1ab256cb
RM
1586 CHECK_NUMBER_COERCE_MARKER (*b, 0);
1587 CHECK_NUMBER_COERCE_MARKER (*e, 1);
1588
1589 if (XINT (*b) > XINT (*e))
1590 {
03192067
KH
1591 Lisp_Object tem;
1592 tem = *b; *b = *e; *e = tem;
1ab256cb
RM
1593 }
1594
1595 if (!(BEGV <= XINT (*b) && XINT (*b) <= XINT (*e)
1596 && XINT (*e) <= ZV))
1597 args_out_of_range (*b, *e);
1598}
1599\f
1ab256cb
RM
1600DEFUN ("kill-all-local-variables", Fkill_all_local_variables, Skill_all_local_variables,
1601 0, 0, 0,
1602 "Switch to Fundamental mode by killing current buffer's local variables.\n\
1603Most local variable bindings are eliminated so that the default values\n\
1604become effective once more. Also, the syntax table is set from\n\
1605`standard-syntax-table', the local keymap is set to nil,\n\
1606and the abbrev table from `fundamental-mode-abbrev-table'.\n\
1607This function also forces redisplay of the mode line.\n\
1608\n\
1609Every function to select a new major mode starts by\n\
1610calling this function.\n\n\
1611As a special exception, local variables whose names have\n\
c5a15222
RS
1612a non-nil `permanent-local' property are not eliminated by this function.\n\
1613\n\
1614The first thing this function does is run\n\
1615the normal hook `change-major-mode-hook'.")
1ab256cb
RM
1616 ()
1617{
1618 register Lisp_Object alist, sym, tem;
1619 Lisp_Object oalist;
7410477a 1620
fd186f07
RS
1621 if (!NILP (Vrun_hooks))
1622 call1 (Vrun_hooks, intern ("change-major-mode-hook"));
1ab256cb
RM
1623 oalist = current_buffer->local_var_alist;
1624
2f3f993b
RS
1625 /* Make sure none of the bindings in oalist
1626 remain swapped in, in their symbols. */
1ab256cb 1627
2f3f993b 1628 swap_out_buffer_local_variables (current_buffer);
1ab256cb
RM
1629
1630 /* Actually eliminate all local bindings of this buffer. */
1631
13de9290 1632 reset_buffer_local_variables (current_buffer, 0);
1ab256cb
RM
1633
1634 /* Redisplay mode lines; we are changing major mode. */
1635
1636 update_mode_lines++;
1637
1638 /* Any which are supposed to be permanent,
1639 make local again, with the same values they had. */
1640
265a9e55 1641 for (alist = oalist; !NILP (alist); alist = XCONS (alist)->cdr)
1ab256cb
RM
1642 {
1643 sym = XCONS (XCONS (alist)->car)->car;
1644 tem = Fget (sym, Qpermanent_local);
265a9e55 1645 if (! NILP (tem))
01050cb5
RM
1646 {
1647 Fmake_local_variable (sym);
1648 Fset (sym, XCONS (XCONS (alist)->car)->cdr);
1649 }
1ab256cb
RM
1650 }
1651
1652 /* Force mode-line redisplay. Useful here because all major mode
1653 commands call this function. */
1654 update_mode_lines++;
1655
1656 return Qnil;
1657}
2f3f993b
RS
1658
1659/* Make sure no local variables remain set up with buffer B
1660 for their current values. */
1661
1662static void
1663swap_out_buffer_local_variables (b)
1664 struct buffer *b;
1665{
1666 Lisp_Object oalist, alist, sym, tem, buffer;
1667
1668 XSETBUFFER (buffer, b);
1669 oalist = b->local_var_alist;
1670
1671 for (alist = oalist; !NILP (alist); alist = XCONS (alist)->cdr)
1672 {
1673 sym = XCONS (XCONS (alist)->car)->car;
1674
1675 /* Need not do anything if some other buffer's binding is now encached. */
1676 tem = XCONS (XBUFFER_LOCAL_VALUE (XSYMBOL (sym)->value)->cdr)->car;
1677 if (XBUFFER (tem) == current_buffer)
1678 {
1679 /* Symbol is set up for this buffer's old local value.
1680 Set it up for the current buffer with the default value. */
1681
1682 tem = XCONS (XBUFFER_LOCAL_VALUE (XSYMBOL (sym)->value)->cdr)->cdr;
1683 /* Store the symbol's current value into the alist entry
1684 it is currently set up for. This is so that, if the
1685 local is marked permanent, and we make it local again
1686 later in Fkill_all_local_variables, we don't lose the value. */
1687 XCONS (XCONS (tem)->car)->cdr
1688 = do_symval_forwarding (XBUFFER_LOCAL_VALUE (XSYMBOL (sym)->value)->car);
1689 /* Switch to the symbol's default-value alist entry. */
1690 XCONS (tem)->car = tem;
1691 /* Mark it as current for buffer B. */
1692 XCONS (XBUFFER_LOCAL_VALUE (XSYMBOL (sym)->value)->cdr)->car
1693 = buffer;
1694 /* Store the current value into any forwarding in the symbol. */
1695 store_symval_forwarding (sym, XBUFFER_LOCAL_VALUE (XSYMBOL (sym)->value)->car,
1696 XCONS (tem)->cdr);
1697 }
1698 }
1699}
1ab256cb 1700\f
2eec3b4e
RS
1701/* Find all the overlays in the current buffer that contain position POS.
1702 Return the number found, and store them in a vector in *VEC_PTR.
1703 Store in *LEN_PTR the size allocated for the vector.
52f8ec73
JB
1704 Store in *NEXT_PTR the next position after POS where an overlay starts,
1705 or ZV if there are no more overlays.
bbbe9545 1706 Store in *PREV_PTR the previous position before POS where an overlay ends,
239c932b
RS
1707 or BEGV if there are no previous overlays.
1708 NEXT_PTR and/or PREV_PTR may be 0, meaning don't store that info.
2eec3b4e
RS
1709
1710 *VEC_PTR and *LEN_PTR should contain a valid vector and size
61d54cd5
RS
1711 when this function is called.
1712
1713 If EXTEND is non-zero, we make the vector bigger if necessary.
1714 If EXTEND is zero, we never extend the vector,
1715 and we store only as many overlays as will fit.
1716 But we still return the total number of overlays. */
2eec3b4e
RS
1717
1718int
239c932b 1719overlays_at (pos, extend, vec_ptr, len_ptr, next_ptr, prev_ptr)
2eec3b4e 1720 int pos;
61d54cd5 1721 int extend;
2eec3b4e
RS
1722 Lisp_Object **vec_ptr;
1723 int *len_ptr;
1724 int *next_ptr;
239c932b 1725 int *prev_ptr;
1ab256cb 1726{
2eec3b4e
RS
1727 Lisp_Object tail, overlay, start, end, result;
1728 int idx = 0;
1729 int len = *len_ptr;
1730 Lisp_Object *vec = *vec_ptr;
1731 int next = ZV;
239c932b 1732 int prev = BEGV;
61d54cd5
RS
1733 int inhibit_storing = 0;
1734
2eec3b4e 1735 for (tail = current_buffer->overlays_before;
8fc0589a 1736 GC_CONSP (tail);
2eec3b4e
RS
1737 tail = XCONS (tail)->cdr)
1738 {
239c932b 1739 int startpos, endpos;
52f8ec73 1740
2eec3b4e 1741 overlay = XCONS (tail)->car;
1ab256cb 1742
2eec3b4e
RS
1743 start = OVERLAY_START (overlay);
1744 end = OVERLAY_END (overlay);
239c932b
RS
1745 endpos = OVERLAY_POSITION (end);
1746 if (endpos < pos)
1747 {
1748 if (prev < endpos)
1749 prev = endpos;
1750 break;
1751 }
1752 if (endpos == pos)
1753 continue;
2eec3b4e
RS
1754 startpos = OVERLAY_POSITION (start);
1755 if (startpos <= pos)
1756 {
1757 if (idx == len)
1758 {
61d54cd5
RS
1759 /* The supplied vector is full.
1760 Either make it bigger, or don't store any more in it. */
1761 if (extend)
1762 {
1763 *len_ptr = len *= 2;
1764 vec = (Lisp_Object *) xrealloc (vec, len * sizeof (Lisp_Object));
1765 *vec_ptr = vec;
1766 }
1767 else
1768 inhibit_storing = 1;
2eec3b4e 1769 }
61d54cd5
RS
1770
1771 if (!inhibit_storing)
1772 vec[idx] = overlay;
1773 /* Keep counting overlays even if we can't return them all. */
1774 idx++;
2eec3b4e
RS
1775 }
1776 else if (startpos < next)
1777 next = startpos;
1778 }
1779
1780 for (tail = current_buffer->overlays_after;
8fc0589a 1781 GC_CONSP (tail);
2eec3b4e 1782 tail = XCONS (tail)->cdr)
1ab256cb 1783 {
239c932b 1784 int startpos, endpos;
52f8ec73 1785
2eec3b4e 1786 overlay = XCONS (tail)->car;
2eec3b4e
RS
1787
1788 start = OVERLAY_START (overlay);
1789 end = OVERLAY_END (overlay);
1790 startpos = OVERLAY_POSITION (start);
52f8ec73 1791 if (pos < startpos)
2eec3b4e
RS
1792 {
1793 if (startpos < next)
1794 next = startpos;
1795 break;
1796 }
239c932b
RS
1797 endpos = OVERLAY_POSITION (end);
1798 if (pos < endpos)
2eec3b4e
RS
1799 {
1800 if (idx == len)
1801 {
61d54cd5
RS
1802 if (extend)
1803 {
1804 *len_ptr = len *= 2;
1805 vec = (Lisp_Object *) xrealloc (vec, len * sizeof (Lisp_Object));
1806 *vec_ptr = vec;
1807 }
1808 else
1809 inhibit_storing = 1;
2eec3b4e 1810 }
61d54cd5
RS
1811
1812 if (!inhibit_storing)
1813 vec[idx] = overlay;
1814 idx++;
2eec3b4e 1815 }
239c932b
RS
1816 else if (endpos < pos && endpos > prev)
1817 prev = endpos;
1ab256cb
RM
1818 }
1819
239c932b
RS
1820 if (next_ptr)
1821 *next_ptr = next;
1822 if (prev_ptr)
1823 *prev_ptr = prev;
2eec3b4e
RS
1824 return idx;
1825}
74514898
RS
1826\f
1827/* Find all the overlays in the current buffer that overlap the range BEG-END
2a3eeee7
RS
1828 or are empty at BEG.
1829
74514898
RS
1830 Return the number found, and store them in a vector in *VEC_PTR.
1831 Store in *LEN_PTR the size allocated for the vector.
1832 Store in *NEXT_PTR the next position after POS where an overlay starts,
1833 or ZV if there are no more overlays.
1834 Store in *PREV_PTR the previous position before POS where an overlay ends,
1835 or BEGV if there are no previous overlays.
1836 NEXT_PTR and/or PREV_PTR may be 0, meaning don't store that info.
1837
1838 *VEC_PTR and *LEN_PTR should contain a valid vector and size
1839 when this function is called.
1840
1841 If EXTEND is non-zero, we make the vector bigger if necessary.
1842 If EXTEND is zero, we never extend the vector,
1843 and we store only as many overlays as will fit.
1844 But we still return the total number of overlays. */
1845
1846int
1847overlays_in (beg, end, extend, vec_ptr, len_ptr, next_ptr, prev_ptr)
1848 int beg, end;
1849 int extend;
1850 Lisp_Object **vec_ptr;
1851 int *len_ptr;
1852 int *next_ptr;
1853 int *prev_ptr;
1854{
1855 Lisp_Object tail, overlay, ostart, oend, result;
1856 int idx = 0;
1857 int len = *len_ptr;
1858 Lisp_Object *vec = *vec_ptr;
1859 int next = ZV;
1860 int prev = BEGV;
1861 int inhibit_storing = 0;
1862
1863 for (tail = current_buffer->overlays_before;
1864 GC_CONSP (tail);
1865 tail = XCONS (tail)->cdr)
1866 {
1867 int startpos, endpos;
1868
1869 overlay = XCONS (tail)->car;
1870
1871 ostart = OVERLAY_START (overlay);
1872 oend = OVERLAY_END (overlay);
1873 endpos = OVERLAY_POSITION (oend);
1874 if (endpos < beg)
1875 {
1876 if (prev < endpos)
1877 prev = endpos;
1878 break;
1879 }
1880 startpos = OVERLAY_POSITION (ostart);
1881 /* Count an interval if it either overlaps the range
2a3eeee7 1882 or is empty at the start of the range. */
74514898 1883 if ((beg < endpos && startpos < end)
2a3eeee7 1884 || (startpos == endpos && beg == endpos))
74514898
RS
1885 {
1886 if (idx == len)
1887 {
1888 /* The supplied vector is full.
1889 Either make it bigger, or don't store any more in it. */
1890 if (extend)
1891 {
1892 *len_ptr = len *= 2;
1893 vec = (Lisp_Object *) xrealloc (vec, len * sizeof (Lisp_Object));
1894 *vec_ptr = vec;
1895 }
1896 else
1897 inhibit_storing = 1;
1898 }
1899
1900 if (!inhibit_storing)
1901 vec[idx] = overlay;
1902 /* Keep counting overlays even if we can't return them all. */
1903 idx++;
1904 }
1905 else if (startpos < next)
1906 next = startpos;
1907 }
1908
1909 for (tail = current_buffer->overlays_after;
1910 GC_CONSP (tail);
1911 tail = XCONS (tail)->cdr)
1912 {
1913 int startpos, endpos;
1914
1915 overlay = XCONS (tail)->car;
1916
1917 ostart = OVERLAY_START (overlay);
1918 oend = OVERLAY_END (overlay);
1919 startpos = OVERLAY_POSITION (ostart);
1920 if (end < startpos)
1921 {
1922 if (startpos < next)
1923 next = startpos;
1924 break;
1925 }
1926 endpos = OVERLAY_POSITION (oend);
2a3eeee7
RS
1927 /* Count an interval if it either overlaps the range
1928 or is empty at the start of the range. */
74514898 1929 if ((beg < endpos && startpos < end)
2a3eeee7 1930 || (startpos == endpos && beg == endpos))
74514898
RS
1931 {
1932 if (idx == len)
1933 {
1934 if (extend)
1935 {
1936 *len_ptr = len *= 2;
1937 vec = (Lisp_Object *) xrealloc (vec, len * sizeof (Lisp_Object));
1938 *vec_ptr = vec;
1939 }
1940 else
1941 inhibit_storing = 1;
1942 }
1943
1944 if (!inhibit_storing)
1945 vec[idx] = overlay;
1946 idx++;
1947 }
1948 else if (endpos < beg && endpos > prev)
1949 prev = endpos;
1950 }
fc04fa47 1951
74514898
RS
1952 if (next_ptr)
1953 *next_ptr = next;
1954 if (prev_ptr)
1955 *prev_ptr = prev;
1956 return idx;
1957}
1958\f
fc04fa47
KH
1959/* Fast function to just test if we're at an overlay boundary. */
1960int
1961overlay_touches_p (pos)
1962 int pos;
1963{
1964 Lisp_Object tail, overlay;
1965
1966 for (tail = current_buffer->overlays_before; GC_CONSP (tail);
1967 tail = XCONS (tail)->cdr)
1968 {
1969 int endpos;
1970
1971 overlay = XCONS (tail)->car;
1972 if (!GC_OVERLAYP (overlay))
1973 abort ();
1974
1975 endpos = OVERLAY_POSITION (OVERLAY_END (overlay));
1976 if (endpos < pos)
1977 break;
1978 if (endpos == pos || OVERLAY_POSITION (OVERLAY_START (overlay)) == pos)
1979 return 1;
1980 }
1981
1982 for (tail = current_buffer->overlays_after; GC_CONSP (tail);
1983 tail = XCONS (tail)->cdr)
1984 {
1985 int startpos;
1986
1987 overlay = XCONS (tail)->car;
1988 if (!GC_OVERLAYP (overlay))
1989 abort ();
1990
1991 startpos = OVERLAY_POSITION (OVERLAY_START (overlay));
1992 if (pos < startpos)
1993 break;
1994 if (startpos == pos || OVERLAY_POSITION (OVERLAY_END (overlay)) == pos)
1995 return 1;
1996 }
1997 return 0;
1998}
2eec3b4e 1999\f
5985d248
KH
2000struct sortvec
2001{
2002 Lisp_Object overlay;
2003 int beg, end;
2004 int priority;
2005};
2006
2007static int
2008compare_overlays (s1, s2)
2009 struct sortvec *s1, *s2;
2010{
2011 if (s1->priority != s2->priority)
2012 return s1->priority - s2->priority;
2013 if (s1->beg != s2->beg)
2014 return s1->beg - s2->beg;
2015 if (s1->end != s2->end)
2016 return s2->end - s1->end;
2017 return 0;
2018}
2019
2020/* Sort an array of overlays by priority. The array is modified in place.
2021 The return value is the new size; this may be smaller than the original
2022 size if some of the overlays were invalid or were window-specific. */
2023int
2024sort_overlays (overlay_vec, noverlays, w)
2025 Lisp_Object *overlay_vec;
2026 int noverlays;
2027 struct window *w;
2028{
2029 int i, j;
2030 struct sortvec *sortvec;
2031 sortvec = (struct sortvec *) alloca (noverlays * sizeof (struct sortvec));
2032
2033 /* Put the valid and relevant overlays into sortvec. */
2034
2035 for (i = 0, j = 0; i < noverlays; i++)
2036 {
0fa767e7 2037 Lisp_Object tem;
c99fc30f 2038 Lisp_Object overlay;
5985d248 2039
c99fc30f 2040 overlay = overlay_vec[i];
5985d248
KH
2041 if (OVERLAY_VALID (overlay)
2042 && OVERLAY_POSITION (OVERLAY_START (overlay)) > 0
2043 && OVERLAY_POSITION (OVERLAY_END (overlay)) > 0)
2044 {
0fa767e7
KH
2045 /* If we're interested in a specific window, then ignore
2046 overlays that are limited to some other window. */
2047 if (w)
5985d248 2048 {
0fa767e7
KH
2049 Lisp_Object window;
2050
2051 window = Foverlay_get (overlay, Qwindow);
a7a60ce9 2052 if (WINDOWP (window) && XWINDOW (window) != w)
0fa767e7 2053 continue;
5985d248 2054 }
0fa767e7
KH
2055
2056 /* This overlay is good and counts: put it into sortvec. */
2057 sortvec[j].overlay = overlay;
2058 sortvec[j].beg = OVERLAY_POSITION (OVERLAY_START (overlay));
2059 sortvec[j].end = OVERLAY_POSITION (OVERLAY_END (overlay));
2060 tem = Foverlay_get (overlay, Qpriority);
2061 if (INTEGERP (tem))
2062 sortvec[j].priority = XINT (tem);
2063 else
2064 sortvec[j].priority = 0;
2065 j++;
5985d248
KH
2066 }
2067 }
2068 noverlays = j;
2069
2070 /* Sort the overlays into the proper order: increasing priority. */
2071
2072 if (noverlays > 1)
2073 qsort (sortvec, noverlays, sizeof (struct sortvec), compare_overlays);
2074
2075 for (i = 0; i < noverlays; i++)
2076 overlay_vec[i] = sortvec[i].overlay;
2077 return (noverlays);
2078}
2079\f
bbbe9545
KH
2080struct sortstr
2081{
cb26008f 2082 Lisp_Object string, string2;
bbbe9545
KH
2083 int size;
2084 int priority;
2085};
2086
e8185fa8
KH
2087struct sortstrlist
2088{
2089 struct sortstr *buf; /* An array that expands as needed; never freed. */
2090 int size; /* Allocated length of that array. */
2091 int used; /* How much of the array is currently in use. */
2092 int bytes; /* Total length of the strings in buf. */
2093};
2094
2095/* Buffers for storing information about the overlays touching a given
2096 position. These could be automatic variables in overlay_strings, but
2097 it's more efficient to hold onto the memory instead of repeatedly
2098 allocating and freeing it. */
2099static struct sortstrlist overlay_heads, overlay_tails;
2100static char *overlay_str_buf;
2101
2102/* Allocated length of overlay_str_buf. */
2103static int overlay_str_len;
2104
bbbe9545
KH
2105/* A comparison function suitable for passing to qsort. */
2106static int
2107cmp_for_strings (as1, as2)
2108 char *as1, *as2;
2109{
2110 struct sortstr *s1 = (struct sortstr *)as1;
2111 struct sortstr *s2 = (struct sortstr *)as2;
2112 if (s1->size != s2->size)
2113 return s2->size - s1->size;
2114 if (s1->priority != s2->priority)
2115 return s1->priority - s2->priority;
2116 return 0;
2117}
2118
e8185fa8 2119static void
cb26008f 2120record_overlay_string (ssl, str, str2, pri, size)
e8185fa8 2121 struct sortstrlist *ssl;
cb26008f 2122 Lisp_Object str, str2, pri;
e8185fa8
KH
2123 int size;
2124{
2125 if (ssl->used == ssl->size)
2126 {
2127 if (ssl->buf)
2128 ssl->size *= 2;
2129 else
2130 ssl->size = 5;
2131 ssl->buf = ((struct sortstr *)
2132 xrealloc (ssl->buf, ssl->size * sizeof (struct sortstr)));
2133 }
2134 ssl->buf[ssl->used].string = str;
cb26008f 2135 ssl->buf[ssl->used].string2 = str2;
e8185fa8
KH
2136 ssl->buf[ssl->used].size = size;
2137 ssl->buf[ssl->used].priority = (INTEGERP (pri) ? XINT (pri) : 0);
2138 ssl->used++;
2139 ssl->bytes += XSTRING (str)->size;
cb26008f
KH
2140 if (STRINGP (str2))
2141 ssl->bytes += XSTRING (str2)->size;
e8185fa8 2142}
bbbe9545
KH
2143
2144/* Return the concatenation of the strings associated with overlays that
2145 begin or end at POS, ignoring overlays that are specific to a window
2146 other than W. The strings are concatenated in the appropriate order:
2147 shorter overlays nest inside longer ones, and higher priority inside
cb26008f
KH
2148 lower. Normally all of the after-strings come first, but zero-sized
2149 overlays have their after-strings ride along with the before-strings
2150 because it would look strange to print them inside-out.
2151
2152 Returns the string length, and stores the contents indirectly through
2153 PSTR, if that variable is non-null. The string may be overwritten by
2154 subsequent calls. */
6b5d3b89 2155
bbbe9545
KH
2156int
2157overlay_strings (pos, w, pstr)
2158 int pos;
2159 struct window *w;
6b5d3b89 2160 unsigned char **pstr;
bbbe9545 2161{
e8185fa8 2162 Lisp_Object ov, overlay, window, str;
bbbe9545
KH
2163 int startpos, endpos;
2164
e8185fa8
KH
2165 overlay_heads.used = overlay_heads.bytes = 0;
2166 overlay_tails.used = overlay_tails.bytes = 0;
bbbe9545
KH
2167 for (ov = current_buffer->overlays_before; CONSP (ov); ov = XCONS (ov)->cdr)
2168 {
2169 overlay = XCONS (ov)->car;
2170 if (!OVERLAYP (overlay))
2171 abort ();
2172
2173 startpos = OVERLAY_POSITION (OVERLAY_START (overlay));
2174 endpos = OVERLAY_POSITION (OVERLAY_END (overlay));
2175 if (endpos < pos)
2176 break;
2177 if (endpos != pos && startpos != pos)
2178 continue;
2179 window = Foverlay_get (overlay, Qwindow);
2180 if (WINDOWP (window) && XWINDOW (window) != w)
2181 continue;
e8185fa8
KH
2182 if (startpos == pos
2183 && (str = Foverlay_get (overlay, Qbefore_string), STRINGP (str)))
2184 record_overlay_string (&overlay_heads, str,
cb26008f
KH
2185 (startpos == endpos
2186 ? Foverlay_get (overlay, Qafter_string)
2187 : Qnil),
2188 Foverlay_get (overlay, Qpriority),
2189 endpos - startpos);
2190 else if (endpos == pos
2191 && (str = Foverlay_get (overlay, Qafter_string), STRINGP (str)))
2192 record_overlay_string (&overlay_tails, str, Qnil,
e8185fa8
KH
2193 Foverlay_get (overlay, Qpriority),
2194 endpos - startpos);
bbbe9545
KH
2195 }
2196 for (ov = current_buffer->overlays_after; CONSP (ov); ov = XCONS (ov)->cdr)
2197 {
2198 overlay = XCONS (ov)->car;
2199 if (!OVERLAYP (overlay))
2200 abort ();
2201
2202 startpos = OVERLAY_POSITION (OVERLAY_START (overlay));
2203 endpos = OVERLAY_POSITION (OVERLAY_END (overlay));
2204 if (startpos > pos)
2205 break;
e8185fa8
KH
2206 if (endpos != pos && startpos != pos)
2207 continue;
2208 window = Foverlay_get (overlay, Qwindow);
2209 if (WINDOWP (window) && XWINDOW (window) != w)
2210 continue;
e8185fa8
KH
2211 if (startpos == pos
2212 && (str = Foverlay_get (overlay, Qbefore_string), STRINGP (str)))
2213 record_overlay_string (&overlay_heads, str,
cb26008f
KH
2214 (startpos == endpos
2215 ? Foverlay_get (overlay, Qafter_string)
2216 : Qnil),
2217 Foverlay_get (overlay, Qpriority),
2218 endpos - startpos);
2219 else if (endpos == pos
2220 && (str = Foverlay_get (overlay, Qafter_string), STRINGP (str)))
2221 record_overlay_string (&overlay_tails, str, Qnil,
e8185fa8
KH
2222 Foverlay_get (overlay, Qpriority),
2223 endpos - startpos);
bbbe9545 2224 }
e8185fa8
KH
2225 if (overlay_tails.used > 1)
2226 qsort (overlay_tails.buf, overlay_tails.used, sizeof (struct sortstr),
2227 cmp_for_strings);
2228 if (overlay_heads.used > 1)
2229 qsort (overlay_heads.buf, overlay_heads.used, sizeof (struct sortstr),
2230 cmp_for_strings);
2231 if (overlay_heads.bytes || overlay_tails.bytes)
bbbe9545 2232 {
e8185fa8 2233 Lisp_Object tem;
bbbe9545
KH
2234 int i;
2235 char *p;
e8185fa8 2236 int total = overlay_heads.bytes + overlay_tails.bytes;
bbbe9545
KH
2237
2238 if (total > overlay_str_len)
e8185fa8
KH
2239 overlay_str_buf = (char *)xrealloc (overlay_str_buf,
2240 overlay_str_len = total);
bbbe9545 2241 p = overlay_str_buf;
e8185fa8 2242 for (i = overlay_tails.used; --i >= 0;)
bbbe9545 2243 {
e8185fa8 2244 tem = overlay_tails.buf[i].string;
bbbe9545
KH
2245 bcopy (XSTRING (tem)->data, p, XSTRING (tem)->size);
2246 p += XSTRING (tem)->size;
2247 }
e8185fa8 2248 for (i = 0; i < overlay_heads.used; ++i)
bbbe9545 2249 {
e8185fa8 2250 tem = overlay_heads.buf[i].string;
bbbe9545
KH
2251 bcopy (XSTRING (tem)->data, p, XSTRING (tem)->size);
2252 p += XSTRING (tem)->size;
cb26008f
KH
2253 tem = overlay_heads.buf[i].string2;
2254 if (STRINGP (tem))
2255 {
2256 bcopy (XSTRING (tem)->data, p, XSTRING (tem)->size);
2257 p += XSTRING (tem)->size;
2258 }
bbbe9545 2259 }
cb26008f
KH
2260 if (p != overlay_str_buf + total)
2261 abort ();
bbbe9545
KH
2262 if (pstr)
2263 *pstr = overlay_str_buf;
e8185fa8 2264 return total;
bbbe9545 2265 }
e8185fa8 2266 return 0;
bbbe9545
KH
2267}
2268\f
5c4f68f1 2269/* Shift overlays in BUF's overlay lists, to center the lists at POS. */
1ab256cb 2270
2eec3b4e 2271void
5c4f68f1
JB
2272recenter_overlay_lists (buf, pos)
2273 struct buffer *buf;
2eec3b4e
RS
2274 int pos;
2275{
2276 Lisp_Object overlay, tail, next, prev, beg, end;
2277
2278 /* See if anything in overlays_before should move to overlays_after. */
2279
2280 /* We don't strictly need prev in this loop; it should always be nil.
2281 But we use it for symmetry and in case that should cease to be true
2282 with some future change. */
2283 prev = Qnil;
5c4f68f1 2284 for (tail = buf->overlays_before;
2eec3b4e
RS
2285 CONSP (tail);
2286 prev = tail, tail = next)
1ab256cb 2287 {
2eec3b4e
RS
2288 next = XCONS (tail)->cdr;
2289 overlay = XCONS (tail)->car;
2290
2291 /* If the overlay is not valid, get rid of it. */
2292 if (!OVERLAY_VALID (overlay))
52f8ec73
JB
2293#if 1
2294 abort ();
2295#else
2eec3b4e
RS
2296 {
2297 /* Splice the cons cell TAIL out of overlays_before. */
2298 if (!NILP (prev))
2299 XCONS (prev)->cdr = next;
2300 else
5c4f68f1 2301 buf->overlays_before = next;
2eec3b4e
RS
2302 tail = prev;
2303 continue;
2304 }
52f8ec73 2305#endif
1ab256cb 2306
2eec3b4e
RS
2307 beg = OVERLAY_START (overlay);
2308 end = OVERLAY_END (overlay);
1ab256cb 2309
2eec3b4e 2310 if (OVERLAY_POSITION (end) > pos)
1ab256cb 2311 {
2eec3b4e
RS
2312 /* OVERLAY needs to be moved. */
2313 int where = OVERLAY_POSITION (beg);
2314 Lisp_Object other, other_prev;
2315
2316 /* Splice the cons cell TAIL out of overlays_before. */
2317 if (!NILP (prev))
2318 XCONS (prev)->cdr = next;
2319 else
5c4f68f1 2320 buf->overlays_before = next;
2eec3b4e
RS
2321
2322 /* Search thru overlays_after for where to put it. */
2323 other_prev = Qnil;
5c4f68f1 2324 for (other = buf->overlays_after;
2eec3b4e
RS
2325 CONSP (other);
2326 other_prev = other, other = XCONS (other)->cdr)
1ab256cb 2327 {
2eec3b4e
RS
2328 Lisp_Object otherbeg, otheroverlay, follower;
2329 int win;
2330
2331 otheroverlay = XCONS (other)->car;
2332 if (! OVERLAY_VALID (otheroverlay))
52f8ec73 2333 abort ();
2eec3b4e
RS
2334
2335 otherbeg = OVERLAY_START (otheroverlay);
2336 if (OVERLAY_POSITION (otherbeg) >= where)
2337 break;
1ab256cb 2338 }
2eec3b4e
RS
2339
2340 /* Add TAIL to overlays_after before OTHER. */
2341 XCONS (tail)->cdr = other;
2342 if (!NILP (other_prev))
2343 XCONS (other_prev)->cdr = tail;
1ab256cb 2344 else
5c4f68f1 2345 buf->overlays_after = tail;
2eec3b4e 2346 tail = prev;
1ab256cb 2347 }
2eec3b4e
RS
2348 else
2349 /* We've reached the things that should stay in overlays_before.
2350 All the rest of overlays_before must end even earlier,
2351 so stop now. */
2352 break;
2353 }
2354
2355 /* See if anything in overlays_after should be in overlays_before. */
2356 prev = Qnil;
5c4f68f1 2357 for (tail = buf->overlays_after;
2eec3b4e
RS
2358 CONSP (tail);
2359 prev = tail, tail = next)
2360 {
2361 next = XCONS (tail)->cdr;
2362 overlay = XCONS (tail)->car;
2363
2364 /* If the overlay is not valid, get rid of it. */
2365 if (!OVERLAY_VALID (overlay))
52f8ec73
JB
2366#if 1
2367 abort ();
2368#else
2eec3b4e
RS
2369 {
2370 /* Splice the cons cell TAIL out of overlays_after. */
2371 if (!NILP (prev))
2372 XCONS (prev)->cdr = next;
2373 else
5c4f68f1 2374 buf->overlays_after = next;
2eec3b4e
RS
2375 tail = prev;
2376 continue;
2377 }
52f8ec73 2378#endif
2eec3b4e
RS
2379
2380 beg = OVERLAY_START (overlay);
2381 end = OVERLAY_END (overlay);
2382
2383 /* Stop looking, when we know that nothing further
2384 can possibly end before POS. */
2385 if (OVERLAY_POSITION (beg) > pos)
2386 break;
2387
2388 if (OVERLAY_POSITION (end) <= pos)
2389 {
2390 /* OVERLAY needs to be moved. */
2391 int where = OVERLAY_POSITION (end);
2392 Lisp_Object other, other_prev;
2393
2394 /* Splice the cons cell TAIL out of overlays_after. */
2395 if (!NILP (prev))
2396 XCONS (prev)->cdr = next;
2397 else
5c4f68f1 2398 buf->overlays_after = next;
2eec3b4e
RS
2399
2400 /* Search thru overlays_before for where to put it. */
2401 other_prev = Qnil;
5c4f68f1 2402 for (other = buf->overlays_before;
2eec3b4e
RS
2403 CONSP (other);
2404 other_prev = other, other = XCONS (other)->cdr)
2405 {
2406 Lisp_Object otherend, otheroverlay;
2407 int win;
2408
2409 otheroverlay = XCONS (other)->car;
2410 if (! OVERLAY_VALID (otheroverlay))
52f8ec73 2411 abort ();
2eec3b4e
RS
2412
2413 otherend = OVERLAY_END (otheroverlay);
2414 if (OVERLAY_POSITION (otherend) <= where)
2415 break;
2416 }
2417
2418 /* Add TAIL to overlays_before before OTHER. */
2419 XCONS (tail)->cdr = other;
2420 if (!NILP (other_prev))
2421 XCONS (other_prev)->cdr = tail;
2422 else
5c4f68f1 2423 buf->overlays_before = tail;
2eec3b4e
RS
2424 tail = prev;
2425 }
2426 }
2427
8d7a4592 2428 XSETFASTINT (buf->overlay_center, pos);
2eec3b4e 2429}
2b1bdf65 2430
423cdb46
KH
2431void
2432adjust_overlays_for_insert (pos, length)
2433 int pos;
2434 int length;
2435{
2436 /* After an insertion, the lists are still sorted properly,
2437 but we may need to update the value of the overlay center. */
2438 if (XFASTINT (current_buffer->overlay_center) >= pos)
2439 XSETFASTINT (current_buffer->overlay_center,
2440 XFASTINT (current_buffer->overlay_center) + length);
2441}
2442
2443void
2444adjust_overlays_for_delete (pos, length)
2445 int pos;
2446 int length;
2447{
2448 if (XFASTINT (current_buffer->overlay_center) < pos)
2449 /* The deletion was to our right. No change needed; the before- and
2450 after-lists are still consistent. */
2451 ;
2452 else if (XFASTINT (current_buffer->overlay_center) > pos + length)
2453 /* The deletion was to our left. We need to adjust the center value
2454 to account for the change in position, but the lists are consistent
2455 given the new value. */
2456 XSETFASTINT (current_buffer->overlay_center,
2457 XFASTINT (current_buffer->overlay_center) - length);
2458 else
2459 /* We're right in the middle. There might be things on the after-list
2460 that now belong on the before-list. Recentering will move them,
2461 and also update the center point. */
2462 recenter_overlay_lists (current_buffer, pos);
2463}
2464
2b1bdf65
KH
2465/* Fix up overlays that were garbled as a result of permuting markers
2466 in the range START through END. Any overlay with at least one
2467 endpoint in this range will need to be unlinked from the overlay
2468 list and reinserted in its proper place.
2469 Such an overlay might even have negative size at this point.
2470 If so, we'll reverse the endpoints. Can you think of anything
2471 better to do in this situation? */
2472void
2473fix_overlays_in_range (start, end)
2474 register int start, end;
2475{
2476 Lisp_Object tem, overlay;
2477 Lisp_Object before_list, after_list;
2478 Lisp_Object *ptail, *pbefore = &before_list, *pafter = &after_list;
2479 int startpos, endpos;
2480
2481 /* This algorithm shifts links around instead of consing and GCing.
2482 The loop invariant is that before_list (resp. after_list) is a
2483 well-formed list except that its last element, the one that
2484 *pbefore (resp. *pafter) points to, is still uninitialized.
2485 So it's not a bug that before_list isn't initialized, although
2486 it may look strange. */
2487 for (ptail = &current_buffer->overlays_before; CONSP (*ptail);)
2488 {
2489 overlay = XCONS (*ptail)->car;
2490 endpos = OVERLAY_POSITION (OVERLAY_END (overlay));
2491 if (endpos < start)
2492 break;
2493 startpos = OVERLAY_POSITION (OVERLAY_START (overlay));
2494 if (endpos < end
2495 || (startpos >= start && startpos < end))
2496 {
2497 /* If the overlay is backwards, fix that now. */
2498 if (startpos > endpos)
2499 {
2500 int tem;
2501 Fset_marker (OVERLAY_START (overlay), endpos, Qnil);
2502 Fset_marker (OVERLAY_END (overlay), startpos, Qnil);
2503 tem = startpos; startpos = endpos; endpos = tem;
2504 }
2505 /* Add it to the end of the wrong list. Later on,
2506 recenter_overlay_lists will move it to the right place. */
2507 if (endpos < XINT (current_buffer->overlay_center))
2508 {
2509 *pafter = *ptail;
2510 pafter = &XCONS (*ptail)->cdr;
2511 }
2512 else
2513 {
2514 *pbefore = *ptail;
2515 pbefore = &XCONS (*ptail)->cdr;
2516 }
2517 *ptail = XCONS (*ptail)->cdr;
2518 }
2519 else
2520 ptail = &XCONS (*ptail)->cdr;
2521 }
2522 for (ptail = &current_buffer->overlays_after; CONSP (*ptail);)
2523 {
2524 overlay = XCONS (*ptail)->car;
2525 startpos = OVERLAY_POSITION (OVERLAY_START (overlay));
2526 if (startpos >= end)
2527 break;
2528 endpos = OVERLAY_POSITION (OVERLAY_END (overlay));
2529 if (startpos >= start
2530 || (endpos >= start && endpos < end))
2531 {
2532 if (startpos > endpos)
2533 {
2534 int tem;
2535 Fset_marker (OVERLAY_START (overlay), endpos, Qnil);
2536 Fset_marker (OVERLAY_END (overlay), startpos, Qnil);
2537 tem = startpos; startpos = endpos; endpos = tem;
2538 }
2539 if (endpos < XINT (current_buffer->overlay_center))
2540 {
2541 *pafter = *ptail;
2542 pafter = &XCONS (*ptail)->cdr;
2543 }
2544 else
2545 {
2546 *pbefore = *ptail;
2547 pbefore = &XCONS (*ptail)->cdr;
2548 }
2549 *ptail = XCONS (*ptail)->cdr;
2550 }
2551 else
2552 ptail = &XCONS (*ptail)->cdr;
2553 }
2554
2555 /* Splice the constructed (wrong) lists into the buffer's lists,
2556 and let the recenter function make it sane again. */
2557 *pbefore = current_buffer->overlays_before;
2558 current_buffer->overlays_before = before_list;
2559 recenter_overlay_lists (current_buffer,
2560 XINT (current_buffer->overlay_center));
2561
2562 *pafter = current_buffer->overlays_after;
2563 current_buffer->overlays_after = after_list;
2564 recenter_overlay_lists (current_buffer,
2565 XINT (current_buffer->overlay_center));
2566}
3b06f880
KH
2567
2568/* We have two types of overlay: the one whose ending marker is
2569 after-insertion-marker (this is the usual case) and the one whose
2570 ending marker is before-insertion-marker. When `overlays_before'
2571 contains overlays of the latter type and the former type in this
2572 order and both overlays end at inserting position, inserting a text
2573 increases only the ending marker of the latter type, which results
2574 in incorrect ordering of `overlays_before'.
2575
2576 This function fixes ordering of overlays in the slot
2577 `overlays_before' of the buffer *BP. Before the insertion, `point'
2578 was at PREV, and now is at POS. */
2579
2580fix_overlays_before (bp, prev, pos)
2581 struct buffer *bp;
2582 int prev, pos;
2583{
2584 Lisp_Object *tailp = &bp->overlays_before;
2585 Lisp_Object *right_place;
2586 int end;
2587
2588 /* After the insertion, the several overlays may be in incorrect
2589 order. The possibility is that, in the list `overlays_before',
2590 an overlay which ends at POS appears after an overlay which ends
2591 at PREV. Since POS is greater than PREV, we must fix the
2592 ordering of these overlays, by moving overlays ends at POS before
2593 the overlays ends at PREV. */
2594
2595 /* At first, find a place where disordered overlays should be linked
2596 in. It is where an overlay which end before POS exists. (i.e. an
2597 overlay whose ending marker is after-insertion-marker if disorder
2598 exists). */
2599 while (!NILP (*tailp)
2600 && ((end = OVERLAY_POSITION (OVERLAY_END (XCONS (*tailp)->car)))
2601 >= pos))
2602 tailp = &XCONS (*tailp)->cdr;
2603
2604 /* If we don't find such an overlay,
2605 or the found one ends before PREV,
2606 or the found one is the last one in the list,
2607 we don't have to fix anything. */
2608 if (NILP (*tailp)
2609 || end < prev
2610 || NILP (XCONS (*tailp)->cdr))
2611 return;
2612
2613 right_place = tailp;
2614 tailp = &XCONS (*tailp)->cdr;
2615
2616 /* Now, end position of overlays in the list *TAILP should be before
2617 or equal to PREV. In the loop, an overlay which ends at POS is
2618 moved ahead to the place pointed by RIGHT_PLACE. If we found an
2619 overlay which ends before PREV, the remaining overlays are in
2620 correct order. */
2621 while (!NILP (*tailp))
2622 {
2623 end = OVERLAY_POSITION (OVERLAY_END (XCONS (*tailp)->car));
2624
2625 if (end == pos)
2626 { /* This overlay is disordered. */
2627 Lisp_Object found = *tailp;
2628
2629 /* Unlink the found overlay. */
2630 *tailp = XCONS (found)->cdr;
2631 /* Move an overlay at RIGHT_PLACE to the next of the found one. */
2632 XCONS (found)->cdr = *right_place;
2633 /* Link it into the right place. */
2634 *right_place = found;
2635 }
2636 else if (end == prev)
2637 tailp = &XCONS (*tailp)->cdr;
2638 else /* No more disordered overlay. */
2639 break;
2640 }
2641}
2eec3b4e 2642\f
52f8ec73
JB
2643DEFUN ("overlayp", Foverlayp, Soverlayp, 1, 1, 0,
2644 "Return t if OBJECT is an overlay.")
2645 (object)
2646 Lisp_Object object;
2647{
2648 return (OVERLAYP (object) ? Qt : Qnil);
2649}
2650
acac2700 2651DEFUN ("make-overlay", Fmake_overlay, Smake_overlay, 2, 5, 0,
5c4f68f1
JB
2652 "Create a new overlay with range BEG to END in BUFFER.\n\
2653If omitted, BUFFER defaults to the current buffer.\n\
acac2700
RS
2654BEG and END may be integers or markers.\n\
2655The fourth arg FRONT-ADVANCE, if non-nil, makes the\n\
2656front delimiter advance when text is inserted there.\n\
2657The fifth arg REAR-ADVANCE, if non-nil, makes the\n\
2658rear delimiter advance when text is inserted there.")
2659 (beg, end, buffer, front_advance, rear_advance)
5c4f68f1 2660 Lisp_Object beg, end, buffer;
acac2700 2661 Lisp_Object front_advance, rear_advance;
2eec3b4e
RS
2662{
2663 Lisp_Object overlay;
5c4f68f1 2664 struct buffer *b;
2eec3b4e 2665
5c4f68f1 2666 if (NILP (buffer))
67180c6a 2667 XSETBUFFER (buffer, current_buffer);
883047b9
JB
2668 else
2669 CHECK_BUFFER (buffer, 2);
2670 if (MARKERP (beg)
2671 && ! EQ (Fmarker_buffer (beg), buffer))
2672 error ("Marker points into wrong buffer");
2673 if (MARKERP (end)
2674 && ! EQ (Fmarker_buffer (end), buffer))
2675 error ("Marker points into wrong buffer");
2eec3b4e 2676
883047b9
JB
2677 CHECK_NUMBER_COERCE_MARKER (beg, 1);
2678 CHECK_NUMBER_COERCE_MARKER (end, 1);
5c4f68f1 2679
883047b9 2680 if (XINT (beg) > XINT (end))
5c4f68f1 2681 {
c99fc30f
KH
2682 Lisp_Object temp;
2683 temp = beg; beg = end; end = temp;
5c4f68f1 2684 }
883047b9
JB
2685
2686 b = XBUFFER (buffer);
2687
2688 beg = Fset_marker (Fmake_marker (), beg, buffer);
2689 end = Fset_marker (Fmake_marker (), end, buffer);
5c4f68f1 2690
acac2700
RS
2691 if (!NILP (front_advance))
2692 XMARKER (beg)->insertion_type = 1;
2693 if (!NILP (rear_advance))
2694 XMARKER (end)->insertion_type = 1;
597dd755 2695
48e2e3ba 2696 overlay = allocate_misc ();
89ca3e1b 2697 XMISCTYPE (overlay) = Lisp_Misc_Overlay;
48e2e3ba
KH
2698 XOVERLAY (overlay)->start = beg;
2699 XOVERLAY (overlay)->end = end;
2700 XOVERLAY (overlay)->plist = Qnil;
2eec3b4e
RS
2701
2702 /* Put the new overlay on the wrong list. */
2703 end = OVERLAY_END (overlay);
5c4f68f1
JB
2704 if (OVERLAY_POSITION (end) < XINT (b->overlay_center))
2705 b->overlays_after = Fcons (overlay, b->overlays_after);
2eec3b4e 2706 else
5c4f68f1 2707 b->overlays_before = Fcons (overlay, b->overlays_before);
2eec3b4e
RS
2708
2709 /* This puts it in the right list, and in the right order. */
5c4f68f1 2710 recenter_overlay_lists (b, XINT (b->overlay_center));
2eec3b4e 2711
b61982dd
JB
2712 /* We don't need to redisplay the region covered by the overlay, because
2713 the overlay has no properties at the moment. */
2714
2eec3b4e
RS
2715 return overlay;
2716}
876aa27c
RS
2717\f
2718/* Mark a section of BUF as needing redisplay because of overlays changes. */
2719
2720static void
2721modify_overlay (buf, start, end)
2722 struct buffer *buf;
2723 int start, end;
2724{
2725 if (start == end)
2726 return;
2727
2728 if (start > end)
2729 {
2730 int temp = start;
2731 start = end; end = temp;
2732 }
2733
2734 /* If this is a buffer not in the selected window,
2735 we must do other windows. */
2736 if (buf != XBUFFER (XWINDOW (selected_window)->buffer))
2737 windows_or_buffers_changed = 1;
2738 /* If it's not current, we can't use beg_unchanged, end_unchanged for it. */
2739 else if (buf != current_buffer)
2740 windows_or_buffers_changed = 1;
2741 /* If multiple windows show this buffer, we must do other windows. */
2742 else if (buffer_shared > 1)
2743 windows_or_buffers_changed = 1;
2744 else
2745 {
2746 if (unchanged_modified == MODIFF
2747 && overlay_unchanged_modified == OVERLAY_MODIFF)
2748 {
2749 beg_unchanged = start - BEG;
2750 end_unchanged = Z - end;
2751 }
2752 else
2753 {
2754 if (Z - end < end_unchanged)
2755 end_unchanged = Z - end;
2756 if (start - BEG < beg_unchanged)
2757 beg_unchanged = start - BEG;
2758 }
2759 }
2760
2761 ++OVERLAY_MODIFF;
2762}
2eec3b4e 2763
876aa27c 2764\f\f
5c4f68f1
JB
2765DEFUN ("move-overlay", Fmove_overlay, Smove_overlay, 3, 4, 0,
2766 "Set the endpoints of OVERLAY to BEG and END in BUFFER.\n\
3ece337a
JB
2767If BUFFER is omitted, leave OVERLAY in the same buffer it inhabits now.\n\
2768If BUFFER is omitted, and OVERLAY is in no buffer, put it in the current\n\
2769buffer.")
5c4f68f1
JB
2770 (overlay, beg, end, buffer)
2771 Lisp_Object overlay, beg, end, buffer;
2eec3b4e 2772{
0a4469c9
RS
2773 struct buffer *b, *ob;
2774 Lisp_Object obuffer;
2775 int count = specpdl_ptr - specpdl;
5c4f68f1 2776
52f8ec73 2777 CHECK_OVERLAY (overlay, 0);
5c4f68f1
JB
2778 if (NILP (buffer))
2779 buffer = Fmarker_buffer (OVERLAY_START (overlay));
3ece337a 2780 if (NILP (buffer))
67180c6a 2781 XSETBUFFER (buffer, current_buffer);
5c4f68f1 2782 CHECK_BUFFER (buffer, 3);
883047b9
JB
2783
2784 if (MARKERP (beg)
2785 && ! EQ (Fmarker_buffer (beg), buffer))
2786 error ("Marker points into wrong buffer");
2787 if (MARKERP (end)
2788 && ! EQ (Fmarker_buffer (end), buffer))
2789 error ("Marker points into wrong buffer");
2790
b61982dd
JB
2791 CHECK_NUMBER_COERCE_MARKER (beg, 1);
2792 CHECK_NUMBER_COERCE_MARKER (end, 1);
2793
9d7608b7
KH
2794 if (XINT (beg) == XINT (end) && ! NILP (Foverlay_get (overlay, Qevaporate)))
2795 return Fdelete_overlay (overlay);
0a4469c9 2796
b61982dd
JB
2797 if (XINT (beg) > XINT (end))
2798 {
c99fc30f
KH
2799 Lisp_Object temp;
2800 temp = beg; beg = end; end = temp;
b61982dd
JB
2801 }
2802
9d7608b7
KH
2803 specbind (Qinhibit_quit, Qt);
2804
0a4469c9 2805 obuffer = Fmarker_buffer (OVERLAY_START (overlay));
5c4f68f1 2806 b = XBUFFER (buffer);
0a4469c9 2807 ob = XBUFFER (obuffer);
2eec3b4e 2808
c82ed728 2809 /* If the overlay has changed buffers, do a thorough redisplay. */
0a4469c9 2810 if (!EQ (buffer, obuffer))
50760c4a
RS
2811 {
2812 /* Redisplay where the overlay was. */
2813 if (!NILP (obuffer))
2814 {
2815 Lisp_Object o_beg;
2816 Lisp_Object o_end;
2817
2818 o_beg = OVERLAY_START (overlay);
2819 o_end = OVERLAY_END (overlay);
2820 o_beg = OVERLAY_POSITION (o_beg);
2821 o_end = OVERLAY_POSITION (o_end);
2822
876aa27c 2823 modify_overlay (ob, XINT (o_beg), XINT (o_end));
50760c4a
RS
2824 }
2825
2826 /* Redisplay where the overlay is going to be. */
876aa27c 2827 modify_overlay (b, XINT (beg), XINT (end));
50760c4a 2828 }
c82ed728
JB
2829 else
2830 /* Redisplay the area the overlay has just left, or just enclosed. */
2831 {
be8b1c6b
RS
2832 Lisp_Object o_beg;
2833 Lisp_Object o_end;
c82ed728
JB
2834 int change_beg, change_end;
2835
be8b1c6b
RS
2836 o_beg = OVERLAY_START (overlay);
2837 o_end = OVERLAY_END (overlay);
c82ed728
JB
2838 o_beg = OVERLAY_POSITION (o_beg);
2839 o_end = OVERLAY_POSITION (o_end);
2840
2841 if (XINT (o_beg) == XINT (beg))
876aa27c 2842 modify_overlay (b, XINT (o_end), XINT (end));
c82ed728 2843 else if (XINT (o_end) == XINT (end))
876aa27c 2844 modify_overlay (b, XINT (o_beg), XINT (beg));
c82ed728
JB
2845 else
2846 {
2847 if (XINT (beg) < XINT (o_beg)) o_beg = beg;
2848 if (XINT (end) > XINT (o_end)) o_end = end;
876aa27c 2849 modify_overlay (b, XINT (o_beg), XINT (o_end));
c82ed728
JB
2850 }
2851 }
b61982dd 2852
0a4469c9
RS
2853 if (!NILP (obuffer))
2854 {
2855 ob->overlays_before = Fdelq (overlay, ob->overlays_before);
2856 ob->overlays_after = Fdelq (overlay, ob->overlays_after);
2857 }
5c4f68f1
JB
2858
2859 Fset_marker (OVERLAY_START (overlay), beg, buffer);
2860 Fset_marker (OVERLAY_END (overlay), end, buffer);
2eec3b4e
RS
2861
2862 /* Put the overlay on the wrong list. */
2863 end = OVERLAY_END (overlay);
5c4f68f1
JB
2864 if (OVERLAY_POSITION (end) < XINT (b->overlay_center))
2865 b->overlays_after = Fcons (overlay, b->overlays_after);
2eec3b4e 2866 else
5c4f68f1 2867 b->overlays_before = Fcons (overlay, b->overlays_before);
2eec3b4e
RS
2868
2869 /* This puts it in the right list, and in the right order. */
5c4f68f1 2870 recenter_overlay_lists (b, XINT (b->overlay_center));
2eec3b4e 2871
0a4469c9 2872 return unbind_to (count, overlay);
2eec3b4e
RS
2873}
2874
2875DEFUN ("delete-overlay", Fdelete_overlay, Sdelete_overlay, 1, 1, 0,
5c4f68f1 2876 "Delete the overlay OVERLAY from its buffer.")
2eec3b4e 2877 (overlay)
5c4f68f1 2878 Lisp_Object overlay;
2eec3b4e 2879{
0a4469c9 2880 Lisp_Object buffer;
5c4f68f1 2881 struct buffer *b;
0a4469c9 2882 int count = specpdl_ptr - specpdl;
5c4f68f1 2883
52f8ec73
JB
2884 CHECK_OVERLAY (overlay, 0);
2885
0a4469c9
RS
2886 buffer = Fmarker_buffer (OVERLAY_START (overlay));
2887 if (NILP (buffer))
2888 return Qnil;
2889
2890 b = XBUFFER (buffer);
2891
2892 specbind (Qinhibit_quit, Qt);
5c4f68f1
JB
2893
2894 b->overlays_before = Fdelq (overlay, b->overlays_before);
2895 b->overlays_after = Fdelq (overlay, b->overlays_after);
2896
876aa27c 2897 modify_overlay (b,
a927f5c9
RS
2898 marker_position (OVERLAY_START (overlay)),
2899 marker_position (OVERLAY_END (overlay)));
b61982dd 2900
3ece337a
JB
2901 Fset_marker (OVERLAY_START (overlay), Qnil, Qnil);
2902 Fset_marker (OVERLAY_END (overlay), Qnil, Qnil);
2903
0a4469c9 2904 return unbind_to (count, Qnil);
2eec3b4e
RS
2905}
2906\f
8ebafa8d
JB
2907/* Overlay dissection functions. */
2908
2909DEFUN ("overlay-start", Foverlay_start, Soverlay_start, 1, 1, 0,
2910 "Return the position at which OVERLAY starts.")
2911 (overlay)
2912 Lisp_Object overlay;
2913{
2914 CHECK_OVERLAY (overlay, 0);
2915
2916 return (Fmarker_position (OVERLAY_START (overlay)));
2917}
2918
2919DEFUN ("overlay-end", Foverlay_end, Soverlay_end, 1, 1, 0,
2920 "Return the position at which OVERLAY ends.")
2921 (overlay)
2922 Lisp_Object overlay;
2923{
2924 CHECK_OVERLAY (overlay, 0);
2925
2926 return (Fmarker_position (OVERLAY_END (overlay)));
2927}
2928
2929DEFUN ("overlay-buffer", Foverlay_buffer, Soverlay_buffer, 1, 1, 0,
2930 "Return the buffer OVERLAY belongs to.")
2931 (overlay)
2932 Lisp_Object overlay;
2933{
2934 CHECK_OVERLAY (overlay, 0);
2935
2936 return Fmarker_buffer (OVERLAY_START (overlay));
2937}
2938
2939DEFUN ("overlay-properties", Foverlay_properties, Soverlay_properties, 1, 1, 0,
2940 "Return a list of the properties on OVERLAY.\n\
2941This is a copy of OVERLAY's plist; modifying its conses has no effect on\n\
2942OVERLAY.")
2943 (overlay)
2944 Lisp_Object overlay;
2945{
2946 CHECK_OVERLAY (overlay, 0);
2947
48e2e3ba 2948 return Fcopy_sequence (XOVERLAY (overlay)->plist);
8ebafa8d
JB
2949}
2950
2951\f
2eec3b4e 2952DEFUN ("overlays-at", Foverlays_at, Soverlays_at, 1, 1, 0,
eb8c3be9 2953 "Return a list of the overlays that contain position POS.")
2eec3b4e
RS
2954 (pos)
2955 Lisp_Object pos;
2956{
2957 int noverlays;
2eec3b4e
RS
2958 Lisp_Object *overlay_vec;
2959 int len;
2960 Lisp_Object result;
2961
2962 CHECK_NUMBER_COERCE_MARKER (pos, 0);
2963
2964 len = 10;
2965 overlay_vec = (Lisp_Object *) xmalloc (len * sizeof (Lisp_Object));
2966
2967 /* Put all the overlays we want in a vector in overlay_vec.
2968 Store the length in len. */
2a77a7d7
RS
2969 noverlays = overlays_at (XINT (pos), 1, &overlay_vec, &len,
2970 (int *) 0, (int *) 0);
2eec3b4e
RS
2971
2972 /* Make a list of them all. */
2973 result = Flist (noverlays, overlay_vec);
2974
9ac0d9e0 2975 xfree (overlay_vec);
2eec3b4e
RS
2976 return result;
2977}
2978
74514898 2979DEFUN ("overlays-in", Foverlays_in, Soverlays_in, 2, 2, 0,
2a3eeee7
RS
2980 "Return a list of the overlays that overlap the region BEG ... END.\n\
2981Overlap means that at least one character is contained within the overlay\n\
2982and also contained within the specified region.\n\
2983Empty overlays are included in the result if they are located at BEG\n\
2984or between BEG and END.")
74514898
RS
2985 (beg, end)
2986 Lisp_Object beg, end;
2987{
2988 int noverlays;
2989 Lisp_Object *overlay_vec;
2990 int len;
2991 Lisp_Object result;
2992
2993 CHECK_NUMBER_COERCE_MARKER (beg, 0);
2994 CHECK_NUMBER_COERCE_MARKER (end, 0);
2995
2996 len = 10;
2997 overlay_vec = (Lisp_Object *) xmalloc (len * sizeof (Lisp_Object));
2998
2999 /* Put all the overlays we want in a vector in overlay_vec.
3000 Store the length in len. */
3001 noverlays = overlays_in (XINT (beg), XINT (end), 1, &overlay_vec, &len,
3002 (int *) 0, (int *) 0);
3003
3004 /* Make a list of them all. */
3005 result = Flist (noverlays, overlay_vec);
3006
3007 xfree (overlay_vec);
3008 return result;
3009}
3010
2eec3b4e
RS
3011DEFUN ("next-overlay-change", Fnext_overlay_change, Snext_overlay_change,
3012 1, 1, 0,
bbe20e81
KH
3013 "Return the next position after POS where an overlay starts or ends.\n\
3014If there are no more overlay boundaries after POS, return (point-max).")
2eec3b4e
RS
3015 (pos)
3016 Lisp_Object pos;
3017{
3018 int noverlays;
3019 int endpos;
3020 Lisp_Object *overlay_vec;
3021 int len;
2eec3b4e
RS
3022 int i;
3023
3024 CHECK_NUMBER_COERCE_MARKER (pos, 0);
3025
3026 len = 10;
3027 overlay_vec = (Lisp_Object *) xmalloc (len * sizeof (Lisp_Object));
3028
3029 /* Put all the overlays we want in a vector in overlay_vec.
3030 Store the length in len.
3031 endpos gets the position where the next overlay starts. */
2a77a7d7
RS
3032 noverlays = overlays_at (XINT (pos), 1, &overlay_vec, &len,
3033 &endpos, (int *) 0);
2eec3b4e
RS
3034
3035 /* If any of these overlays ends before endpos,
3036 use its ending point instead. */
3037 for (i = 0; i < noverlays; i++)
3038 {
3039 Lisp_Object oend;
3040 int oendpos;
3041
3042 oend = OVERLAY_END (overlay_vec[i]);
3043 oendpos = OVERLAY_POSITION (oend);
3044 if (oendpos < endpos)
3045 endpos = oendpos;
1ab256cb
RM
3046 }
3047
9ac0d9e0 3048 xfree (overlay_vec);
2eec3b4e
RS
3049 return make_number (endpos);
3050}
239c932b
RS
3051
3052DEFUN ("previous-overlay-change", Fprevious_overlay_change,
3053 Sprevious_overlay_change, 1, 1, 0,
3054 "Return the previous position before POS where an overlay starts or ends.\n\
624bbdc4 3055If there are no more overlay boundaries before POS, return (point-min).")
239c932b
RS
3056 (pos)
3057 Lisp_Object pos;
3058{
3059 int noverlays;
3060 int prevpos;
3061 Lisp_Object *overlay_vec;
3062 int len;
3063 int i;
624bbdc4 3064 Lisp_Object tail;
239c932b
RS
3065
3066 CHECK_NUMBER_COERCE_MARKER (pos, 0);
3067
3068 len = 10;
3069 overlay_vec = (Lisp_Object *) xmalloc (len * sizeof (Lisp_Object));
3070
624bbdc4
RS
3071 /* At beginning of buffer, we know the answer;
3072 avoid bug subtracting 1 below. */
3073 if (XINT (pos) == BEGV)
3074 return pos;
3075
239c932b
RS
3076 /* Put all the overlays we want in a vector in overlay_vec.
3077 Store the length in len.
3078 prevpos gets the position of an overlay end. */
2a77a7d7
RS
3079 noverlays = overlays_at (XINT (pos), 1, &overlay_vec, &len,
3080 (int *) 0, &prevpos);
239c932b 3081
624bbdc4 3082 /* If any of these overlays starts after prevpos,
239c932b
RS
3083 maybe use its starting point instead. */
3084 for (i = 0; i < noverlays; i++)
3085 {
3086 Lisp_Object ostart;
3087 int ostartpos;
3088
3089 ostart = OVERLAY_START (overlay_vec[i]);
3090 ostartpos = OVERLAY_POSITION (ostart);
3091 if (ostartpos > prevpos && ostartpos < XINT (pos))
3092 prevpos = ostartpos;
3093 }
3094
624bbdc4
RS
3095 /* If any overlay ends at pos, consider its starting point too. */
3096 for (tail = current_buffer->overlays_before;
3097 GC_CONSP (tail);
3098 tail = XCONS (tail)->cdr)
3099 {
3100 Lisp_Object overlay, ostart;
3101 int ostartpos;
3102
3103 overlay = XCONS (tail)->car;
3104
3105 ostart = OVERLAY_START (overlay);
3106 ostartpos = OVERLAY_POSITION (ostart);
3107 if (ostartpos > prevpos && ostartpos < XINT (pos))
3108 prevpos = ostartpos;
3109 }
3110
239c932b
RS
3111 xfree (overlay_vec);
3112 return make_number (prevpos);
3113}
2eec3b4e
RS
3114\f
3115/* These functions are for debugging overlays. */
3116
3117DEFUN ("overlay-lists", Foverlay_lists, Soverlay_lists, 0, 0, 0,
3118 "Return a pair of lists giving all the overlays of the current buffer.\n\
3119The car has all the overlays before the overlay center;\n\
bbe20e81 3120the cdr has all the overlays after the overlay center.\n\
2eec3b4e
RS
3121Recentering overlays moves overlays between these lists.\n\
3122The lists you get are copies, so that changing them has no effect.\n\
3123However, the overlays you get are the real objects that the buffer uses.")
3124 ()
3125{
3126 Lisp_Object before, after;
3127 before = current_buffer->overlays_before;
3128 if (CONSP (before))
3129 before = Fcopy_sequence (before);
3130 after = current_buffer->overlays_after;
3131 if (CONSP (after))
3132 after = Fcopy_sequence (after);
3133
3134 return Fcons (before, after);
3135}
3136
3137DEFUN ("overlay-recenter", Foverlay_recenter, Soverlay_recenter, 1, 1, 0,
3138 "Recenter the overlays of the current buffer around position POS.")
3139 (pos)
3140 Lisp_Object pos;
3141{
3142 CHECK_NUMBER_COERCE_MARKER (pos, 0);
3143
5c4f68f1 3144 recenter_overlay_lists (current_buffer, XINT (pos));
2eec3b4e
RS
3145 return Qnil;
3146}
3147\f
3148DEFUN ("overlay-get", Foverlay_get, Soverlay_get, 2, 2, 0,
a2428fa2 3149 "Get the property of overlay OVERLAY with property name PROP.")
2eec3b4e
RS
3150 (overlay, prop)
3151 Lisp_Object overlay, prop;
3152{
cab4777e 3153 Lisp_Object plist, fallback;
52f8ec73
JB
3154
3155 CHECK_OVERLAY (overlay, 0);
3156
cab4777e
RS
3157 fallback = Qnil;
3158
48e2e3ba 3159 for (plist = XOVERLAY (overlay)->plist;
2eec3b4e
RS
3160 CONSP (plist) && CONSP (XCONS (plist)->cdr);
3161 plist = XCONS (XCONS (plist)->cdr)->cdr)
3162 {
3163 if (EQ (XCONS (plist)->car, prop))
3164 return XCONS (XCONS (plist)->cdr)->car;
cab4777e
RS
3165 else if (EQ (XCONS (plist)->car, Qcategory))
3166 {
3167 Lisp_Object tem;
3168 tem = Fcar (Fcdr (plist));
3169 if (SYMBOLP (tem))
3170 fallback = Fget (tem, prop);
3171 }
2eec3b4e 3172 }
52f8ec73 3173
cab4777e 3174 return fallback;
2eec3b4e
RS
3175}
3176
3177DEFUN ("overlay-put", Foverlay_put, Soverlay_put, 3, 3, 0,
3178 "Set one property of overlay OVERLAY: give property PROP value VALUE.")
3179 (overlay, prop, value)
3180 Lisp_Object overlay, prop, value;
3181{
48e2e3ba 3182 Lisp_Object tail, buffer;
9d7608b7 3183 int changed;
2eec3b4e 3184
52f8ec73 3185 CHECK_OVERLAY (overlay, 0);
b61982dd 3186
274a9425
RS
3187 buffer = Fmarker_buffer (OVERLAY_START (overlay));
3188
48e2e3ba 3189 for (tail = XOVERLAY (overlay)->plist;
2eec3b4e
RS
3190 CONSP (tail) && CONSP (XCONS (tail)->cdr);
3191 tail = XCONS (XCONS (tail)->cdr)->cdr)
274a9425
RS
3192 if (EQ (XCONS (tail)->car, prop))
3193 {
9d7608b7
KH
3194 changed = !EQ (XCONS (XCONS (tail)->cdr)->car, value);
3195 XCONS (XCONS (tail)->cdr)->car = value;
3196 goto found;
274a9425 3197 }
9d7608b7
KH
3198 /* It wasn't in the list, so add it to the front. */
3199 changed = !NILP (value);
48e2e3ba
KH
3200 XOVERLAY (overlay)->plist
3201 = Fcons (prop, Fcons (value, XOVERLAY (overlay)->plist));
9d7608b7
KH
3202 found:
3203 if (! NILP (buffer))
3204 {
3205 if (changed)
876aa27c 3206 modify_overlay (XBUFFER (buffer),
9d7608b7
KH
3207 marker_position (OVERLAY_START (overlay)),
3208 marker_position (OVERLAY_END (overlay)));
3209 if (EQ (prop, Qevaporate) && ! NILP (value)
3210 && (OVERLAY_POSITION (OVERLAY_START (overlay))
3211 == OVERLAY_POSITION (OVERLAY_END (overlay))))
3212 Fdelete_overlay (overlay);
3213 }
2eec3b4e 3214 return value;
1ab256cb
RM
3215}
3216\f
9115729e
KH
3217/* Subroutine of report_overlay_modification. */
3218
3219/* Lisp vector holding overlay hook functions to call.
3220 Vector elements come in pairs.
3221 Each even-index element is a list of hook functions.
3222 The following odd-index element is the overlay they came from.
3223
3224 Before the buffer change, we fill in this vector
3225 as we call overlay hook functions.
3226 After the buffer change, we get the functions to call from this vector.
3227 This way we always call the same functions before and after the change. */
3228static Lisp_Object last_overlay_modification_hooks;
3229
3230/* Number of elements actually used in last_overlay_modification_hooks. */
3231static int last_overlay_modification_hooks_used;
3232
3233/* Add one functionlist/overlay pair
3234 to the end of last_overlay_modification_hooks. */
3235
3236static void
3237add_overlay_mod_hooklist (functionlist, overlay)
3238 Lisp_Object functionlist, overlay;
3239{
3240 int oldsize = XVECTOR (last_overlay_modification_hooks)->size;
3241
3242 if (last_overlay_modification_hooks_used == oldsize)
3243 {
3244 Lisp_Object old;
3245 old = last_overlay_modification_hooks;
3246 last_overlay_modification_hooks
3247 = Fmake_vector (make_number (oldsize * 2), Qnil);
0b1f1b09
RS
3248 bcopy (XVECTOR (old)->contents,
3249 XVECTOR (last_overlay_modification_hooks)->contents,
9115729e
KH
3250 sizeof (Lisp_Object) * oldsize);
3251 }
3252 XVECTOR (last_overlay_modification_hooks)->contents[last_overlay_modification_hooks_used++] = functionlist;
3253 XVECTOR (last_overlay_modification_hooks)->contents[last_overlay_modification_hooks_used++] = overlay;
3254}
3255\f
173f2a64
RS
3256/* Run the modification-hooks of overlays that include
3257 any part of the text in START to END.
9115729e
KH
3258 If this change is an insertion, also
3259 run the insert-before-hooks of overlay starting at END,
930a9140
RS
3260 and the insert-after-hooks of overlay ending at START.
3261
3262 This is called both before and after the modification.
3263 AFTER is nonzero when we call after the modification.
3264
9115729e
KH
3265 ARG1, ARG2, ARG3 are arguments to pass to the hook functions.
3266 When AFTER is nonzero, they are the start position,
3267 the position after the inserted new text,
3268 and the length of deleted or replaced old text. */
173f2a64
RS
3269
3270void
930a9140 3271report_overlay_modification (start, end, after, arg1, arg2, arg3)
173f2a64 3272 Lisp_Object start, end;
930a9140
RS
3273 int after;
3274 Lisp_Object arg1, arg2, arg3;
173f2a64
RS
3275{
3276 Lisp_Object prop, overlay, tail;
9115729e
KH
3277 /* 1 if this change is an insertion. */
3278 int insertion = (after ? XFASTINT (arg3) == 0 : EQ (start, end));
55b48893 3279 int tail_copied;
930a9140 3280 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
55b48893
RS
3281
3282 overlay = Qnil;
3283 tail = Qnil;
930a9140 3284 GCPRO5 (overlay, tail, arg1, arg2, arg3);
173f2a64 3285
9115729e
KH
3286 if (after)
3287 {
3288 /* Call the functions recorded in last_overlay_modification_hooks
3289 rather than scanning the overlays again.
3290 First copy the vector contents, in case some of these hooks
3291 do subsequent modification of the buffer. */
3292 int size = last_overlay_modification_hooks_used;
3293 Lisp_Object *copy = (Lisp_Object *) alloca (size * sizeof (Lisp_Object));
3294 int i;
3295
3296 bcopy (XVECTOR (last_overlay_modification_hooks)->contents,
3297 copy, size * sizeof (Lisp_Object));
3298 gcpro1.var = copy;
3299 gcpro1.nvars = size;
3300
3301 for (i = 0; i < size;)
3302 {
3303 Lisp_Object prop, overlay;
3304 prop = copy[i++];
3305 overlay = copy[i++];
3306 call_overlay_mod_hooks (prop, overlay, after, arg1, arg2, arg3);
3307 }
3308 UNGCPRO;
3309 return;
3310 }
3311
3312 /* We are being called before a change.
3313 Scan the overlays to find the functions to call. */
3314 last_overlay_modification_hooks_used = 0;
55b48893 3315 tail_copied = 0;
173f2a64
RS
3316 for (tail = current_buffer->overlays_before;
3317 CONSP (tail);
3318 tail = XCONS (tail)->cdr)
3319 {
3320 int startpos, endpos;
be8b1c6b 3321 Lisp_Object ostart, oend;
173f2a64
RS
3322
3323 overlay = XCONS (tail)->car;
3324
3325 ostart = OVERLAY_START (overlay);
3326 oend = OVERLAY_END (overlay);
3327 endpos = OVERLAY_POSITION (oend);
3328 if (XFASTINT (start) > endpos)
3329 break;
3330 startpos = OVERLAY_POSITION (ostart);
9115729e
KH
3331 if (insertion && (XFASTINT (start) == startpos
3332 || XFASTINT (end) == startpos))
173f2a64
RS
3333 {
3334 prop = Foverlay_get (overlay, Qinsert_in_front_hooks);
5fb5aa33
RS
3335 if (!NILP (prop))
3336 {
3337 /* Copy TAIL in case the hook recenters the overlay lists. */
55b48893
RS
3338 if (!tail_copied)
3339 tail = Fcopy_sequence (tail);
3340 tail_copied = 1;
930a9140 3341 call_overlay_mod_hooks (prop, overlay, after, arg1, arg2, arg3);
5fb5aa33 3342 }
173f2a64 3343 }
9115729e
KH
3344 if (insertion && (XFASTINT (start) == endpos
3345 || XFASTINT (end) == endpos))
173f2a64
RS
3346 {
3347 prop = Foverlay_get (overlay, Qinsert_behind_hooks);
5fb5aa33
RS
3348 if (!NILP (prop))
3349 {
55b48893
RS
3350 if (!tail_copied)
3351 tail = Fcopy_sequence (tail);
3352 tail_copied = 1;
930a9140 3353 call_overlay_mod_hooks (prop, overlay, after, arg1, arg2, arg3);
5fb5aa33 3354 }
173f2a64 3355 }
3bd13e92
KH
3356 /* Test for intersecting intervals. This does the right thing
3357 for both insertion and deletion. */
3358 if (XFASTINT (end) > startpos && XFASTINT (start) < endpos)
173f2a64
RS
3359 {
3360 prop = Foverlay_get (overlay, Qmodification_hooks);
5fb5aa33
RS
3361 if (!NILP (prop))
3362 {
55b48893
RS
3363 if (!tail_copied)
3364 tail = Fcopy_sequence (tail);
3365 tail_copied = 1;
930a9140 3366 call_overlay_mod_hooks (prop, overlay, after, arg1, arg2, arg3);
5fb5aa33 3367 }
173f2a64
RS
3368 }
3369 }
3370
55b48893 3371 tail_copied = 0;
173f2a64
RS
3372 for (tail = current_buffer->overlays_after;
3373 CONSP (tail);
3374 tail = XCONS (tail)->cdr)
3375 {
3376 int startpos, endpos;
be8b1c6b 3377 Lisp_Object ostart, oend;
173f2a64
RS
3378
3379 overlay = XCONS (tail)->car;
3380
3381 ostart = OVERLAY_START (overlay);
3382 oend = OVERLAY_END (overlay);
3383 startpos = OVERLAY_POSITION (ostart);
cdf0b096 3384 endpos = OVERLAY_POSITION (oend);
173f2a64
RS
3385 if (XFASTINT (end) < startpos)
3386 break;
9115729e
KH
3387 if (insertion && (XFASTINT (start) == startpos
3388 || XFASTINT (end) == startpos))
173f2a64
RS
3389 {
3390 prop = Foverlay_get (overlay, Qinsert_in_front_hooks);
5fb5aa33
RS
3391 if (!NILP (prop))
3392 {
55b48893
RS
3393 if (!tail_copied)
3394 tail = Fcopy_sequence (tail);
3395 tail_copied = 1;
930a9140 3396 call_overlay_mod_hooks (prop, overlay, after, arg1, arg2, arg3);
5fb5aa33 3397 }
173f2a64 3398 }
9115729e
KH
3399 if (insertion && (XFASTINT (start) == endpos
3400 || XFASTINT (end) == endpos))
173f2a64
RS
3401 {
3402 prop = Foverlay_get (overlay, Qinsert_behind_hooks);
5fb5aa33
RS
3403 if (!NILP (prop))
3404 {
55b48893
RS
3405 if (!tail_copied)
3406 tail = Fcopy_sequence (tail);
3407 tail_copied = 1;
930a9140 3408 call_overlay_mod_hooks (prop, overlay, after, arg1, arg2, arg3);
5fb5aa33 3409 }
173f2a64 3410 }
3bd13e92
KH
3411 /* Test for intersecting intervals. This does the right thing
3412 for both insertion and deletion. */
3413 if (XFASTINT (end) > startpos && XFASTINT (start) < endpos)
173f2a64
RS
3414 {
3415 prop = Foverlay_get (overlay, Qmodification_hooks);
5fb5aa33
RS
3416 if (!NILP (prop))
3417 {
55b48893
RS
3418 if (!tail_copied)
3419 tail = Fcopy_sequence (tail);
3420 tail_copied = 1;
930a9140 3421 call_overlay_mod_hooks (prop, overlay, after, arg1, arg2, arg3);
5fb5aa33 3422 }
173f2a64
RS
3423 }
3424 }
55b48893
RS
3425
3426 UNGCPRO;
173f2a64
RS
3427}
3428
3429static void
930a9140
RS
3430call_overlay_mod_hooks (list, overlay, after, arg1, arg2, arg3)
3431 Lisp_Object list, overlay;
3432 int after;
3433 Lisp_Object arg1, arg2, arg3;
173f2a64 3434{
930a9140 3435 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
9115729e 3436
930a9140 3437 GCPRO4 (list, arg1, arg2, arg3);
9115729e
KH
3438 if (! after)
3439 add_overlay_mod_hooklist (list, overlay);
3440
173f2a64
RS
3441 while (!NILP (list))
3442 {
930a9140
RS
3443 if (NILP (arg3))
3444 call4 (Fcar (list), overlay, after ? Qt : Qnil, arg1, arg2);
3445 else
3446 call5 (Fcar (list), overlay, after ? Qt : Qnil, arg1, arg2, arg3);
173f2a64
RS
3447 list = Fcdr (list);
3448 }
3449 UNGCPRO;
3450}
9d7608b7
KH
3451
3452/* Delete any zero-sized overlays at position POS, if the `evaporate'
3453 property is set. */
3454void
3455evaporate_overlays (pos)
3456 int pos;
3457{
3458 Lisp_Object tail, overlay, hit_list;
3459
3460 hit_list = Qnil;
3461 if (pos <= XFASTINT (current_buffer->overlay_center))
3462 for (tail = current_buffer->overlays_before; CONSP (tail);
3463 tail = XCONS (tail)->cdr)
3464 {
3465 int endpos;
3466 overlay = XCONS (tail)->car;
3467 endpos = OVERLAY_POSITION (OVERLAY_END (overlay));
3468 if (endpos < pos)
3469 break;
3470 if (endpos == pos && OVERLAY_POSITION (OVERLAY_START (overlay)) == pos
c3935f9d 3471 && ! NILP (Foverlay_get (overlay, Qevaporate)))
9d7608b7
KH
3472 hit_list = Fcons (overlay, hit_list);
3473 }
3474 else
3475 for (tail = current_buffer->overlays_after; CONSP (tail);
3476 tail = XCONS (tail)->cdr)
3477 {
3478 int startpos;
889bf329 3479 overlay = XCONS (tail)->car;
9d7608b7
KH
3480 startpos = OVERLAY_POSITION (OVERLAY_START (overlay));
3481 if (startpos > pos)
3482 break;
3483 if (startpos == pos && OVERLAY_POSITION (OVERLAY_END (overlay)) == pos
c3935f9d 3484 && ! NILP (Foverlay_get (overlay, Qevaporate)))
9d7608b7
KH
3485 hit_list = Fcons (overlay, hit_list);
3486 }
3487 for (; CONSP (hit_list); hit_list = XCONS (hit_list)->cdr)
3488 Fdelete_overlay (XCONS (hit_list)->car);
3489}
173f2a64 3490\f
54dfdeb0
KH
3491/* Somebody has tried to store a value with an unacceptable type
3492 into the buffer-local slot with offset OFFSET. */
0fa3ba92 3493void
54dfdeb0
KH
3494buffer_slot_type_mismatch (offset)
3495 int offset;
0fa3ba92 3496{
54dfdeb0 3497 Lisp_Object sym;
0fa3ba92 3498 char *type_name;
54dfdeb0 3499 sym = *(Lisp_Object *)(offset + (char *)&buffer_local_symbols);
0fa3ba92
JB
3500 switch (XINT (*(Lisp_Object *)(offset + (char *)&buffer_local_types)))
3501 {
3502 case Lisp_Int: type_name = "integers"; break;
3503 case Lisp_String: type_name = "strings"; break;
0fa3ba92 3504 case Lisp_Symbol: type_name = "symbols"; break;
0fa3ba92
JB
3505 default:
3506 abort ();
3507 }
3508
3509 error ("only %s should be stored in the buffer-local variable %s",
54dfdeb0 3510 type_name, XSYMBOL (sym)->name->data);
0fa3ba92
JB
3511}
3512\f
1ab256cb
RM
3513init_buffer_once ()
3514{
3515 register Lisp_Object tem;
3516
13de9290
RS
3517 buffer_permanent_local_flags = 0;
3518
1ab256cb
RM
3519 /* Make sure all markable slots in buffer_defaults
3520 are initialized reasonably, so mark_buffer won't choke. */
3521 reset_buffer (&buffer_defaults);
13de9290 3522 reset_buffer_local_variables (&buffer_defaults, 1);
1ab256cb 3523 reset_buffer (&buffer_local_symbols);
13de9290 3524 reset_buffer_local_variables (&buffer_local_symbols, 1);
336cd056
RS
3525 /* Prevent GC from getting confused. */
3526 buffer_defaults.text = &buffer_defaults.own_text;
3527 buffer_local_symbols.text = &buffer_local_symbols.own_text;
3528#ifdef USE_TEXT_PROPERTIES
3529 BUF_INTERVALS (&buffer_defaults) = 0;
3530 BUF_INTERVALS (&buffer_local_symbols) = 0;
3531#endif
67180c6a
KH
3532 XSETBUFFER (Vbuffer_defaults, &buffer_defaults);
3533 XSETBUFFER (Vbuffer_local_symbols, &buffer_local_symbols);
1ab256cb
RM
3534
3535 /* Set up the default values of various buffer slots. */
3536 /* Must do these before making the first buffer! */
3537
3538 /* real setup is done in loaddefs.el */
3539 buffer_defaults.mode_line_format = build_string ("%-");
3540 buffer_defaults.abbrev_mode = Qnil;
3541 buffer_defaults.overwrite_mode = Qnil;
3542 buffer_defaults.case_fold_search = Qt;
3543 buffer_defaults.auto_fill_function = Qnil;
3544 buffer_defaults.selective_display = Qnil;
3545#ifndef old
3546 buffer_defaults.selective_display_ellipses = Qt;
3547#endif
3548 buffer_defaults.abbrev_table = Qnil;
3549 buffer_defaults.display_table = Qnil;
1ab256cb 3550 buffer_defaults.undo_list = Qnil;
c48f61ef 3551 buffer_defaults.mark_active = Qnil;
be9aafdd 3552 buffer_defaults.file_format = Qnil;
2eec3b4e
RS
3553 buffer_defaults.overlays_before = Qnil;
3554 buffer_defaults.overlays_after = Qnil;
bbbe9545 3555 XSETFASTINT (buffer_defaults.overlay_center, BEG);
1ab256cb 3556
8d7a4592 3557 XSETFASTINT (buffer_defaults.tab_width, 8);
1ab256cb
RM
3558 buffer_defaults.truncate_lines = Qnil;
3559 buffer_defaults.ctl_arrow = Qt;
3b06f880 3560 buffer_defaults.direction_reversed = Qnil;
1ab256cb 3561
f7975d07 3562#ifdef DOS_NT
0776cb1b 3563 buffer_defaults.buffer_file_type = Qnil; /* TEXT */
54ad07d3 3564#endif
a1a17b61 3565 buffer_defaults.enable_multibyte_characters = Qt;
8d7a4592
KH
3566 XSETFASTINT (buffer_defaults.fill_column, 70);
3567 XSETFASTINT (buffer_defaults.left_margin, 0);
28e969dd 3568 buffer_defaults.cache_long_line_scans = Qnil;
f6ed2e84 3569 buffer_defaults.file_truename = Qnil;
7962a441 3570 XSETFASTINT (buffer_defaults.display_count, 0);
1ab256cb
RM
3571
3572 /* Assign the local-flags to the slots that have default values.
3573 The local flag is a bit that is used in the buffer
3574 to say that it has its own local value for the slot.
3575 The local flag bits are in the local_var_flags slot of the buffer. */
3576
3577 /* Nothing can work if this isn't true */
4d2f1389 3578 if (sizeof (EMACS_INT) != sizeof (Lisp_Object)) abort ();
1ab256cb
RM
3579
3580 /* 0 means not a lisp var, -1 means always local, else mask */
3581 bzero (&buffer_local_flags, sizeof buffer_local_flags);
aab80822
KH
3582 XSETINT (buffer_local_flags.filename, -1);
3583 XSETINT (buffer_local_flags.directory, -1);
3584 XSETINT (buffer_local_flags.backed_up, -1);
3585 XSETINT (buffer_local_flags.save_length, -1);
3586 XSETINT (buffer_local_flags.auto_save_file_name, -1);
3587 XSETINT (buffer_local_flags.read_only, -1);
3588 XSETINT (buffer_local_flags.major_mode, -1);
3589 XSETINT (buffer_local_flags.mode_name, -1);
3590 XSETINT (buffer_local_flags.undo_list, -1);
3591 XSETINT (buffer_local_flags.mark_active, -1);
943e065b 3592 XSETINT (buffer_local_flags.point_before_scroll, -1);
f6ed2e84 3593 XSETINT (buffer_local_flags.file_truename, -1);
3cb719bd 3594 XSETINT (buffer_local_flags.invisibility_spec, -1);
55ac8536 3595 XSETINT (buffer_local_flags.file_format, -1);
7962a441 3596 XSETINT (buffer_local_flags.display_count, -1);
8d7a4592
KH
3597
3598 XSETFASTINT (buffer_local_flags.mode_line_format, 1);
3599 XSETFASTINT (buffer_local_flags.abbrev_mode, 2);
3600 XSETFASTINT (buffer_local_flags.overwrite_mode, 4);
3601 XSETFASTINT (buffer_local_flags.case_fold_search, 8);
3602 XSETFASTINT (buffer_local_flags.auto_fill_function, 0x10);
3603 XSETFASTINT (buffer_local_flags.selective_display, 0x20);
1ab256cb 3604#ifndef old
8d7a4592 3605 XSETFASTINT (buffer_local_flags.selective_display_ellipses, 0x40);
1ab256cb 3606#endif
8d7a4592
KH
3607 XSETFASTINT (buffer_local_flags.tab_width, 0x80);
3608 XSETFASTINT (buffer_local_flags.truncate_lines, 0x100);
3609 XSETFASTINT (buffer_local_flags.ctl_arrow, 0x200);
3610 XSETFASTINT (buffer_local_flags.fill_column, 0x400);
3611 XSETFASTINT (buffer_local_flags.left_margin, 0x800);
3612 XSETFASTINT (buffer_local_flags.abbrev_table, 0x1000);
3613 XSETFASTINT (buffer_local_flags.display_table, 0x2000);
f7975d07 3614#ifdef DOS_NT
8d7a4592 3615 XSETFASTINT (buffer_local_flags.buffer_file_type, 0x4000);
13de9290
RS
3616 /* Make this one a permanent local. */
3617 buffer_permanent_local_flags |= 0x4000;
54ad07d3 3618#endif
2e716096
RS
3619 XSETFASTINT (buffer_local_flags.syntax_table, 0x8000);
3620 XSETFASTINT (buffer_local_flags.cache_long_line_scans, 0x10000);
3b06f880
KH
3621 XSETFASTINT (buffer_local_flags.category_table, 0x20000);
3622 XSETFASTINT (buffer_local_flags.direction_reversed, 0x40000);
a1a17b61
KH
3623 XSETFASTINT (buffer_local_flags.enable_multibyte_characters, 0x80000);
3624 /* Make this one a permanent local. */
3625 buffer_permanent_local_flags |= 0x80000;
13de9290 3626
1ab256cb
RM
3627 Vbuffer_alist = Qnil;
3628 current_buffer = 0;
3629 all_buffers = 0;
3630
3631 QSFundamental = build_string ("Fundamental");
3632
3633 Qfundamental_mode = intern ("fundamental-mode");
3634 buffer_defaults.major_mode = Qfundamental_mode;
3635
3636 Qmode_class = intern ("mode-class");
3637
3638 Qprotected_field = intern ("protected-field");
3639
3640 Qpermanent_local = intern ("permanent-local");
3641
3642 Qkill_buffer_hook = intern ("kill-buffer-hook");
3643
3644 Vprin1_to_string_buffer = Fget_buffer_create (build_string (" prin1"));
000f8083 3645
1ab256cb
RM
3646 /* super-magic invisible buffer */
3647 Vbuffer_alist = Qnil;
3648
ffd56f97 3649 Fset_buffer (Fget_buffer_create (build_string ("*scratch*")));
1ab256cb
RM
3650}
3651
3652init_buffer ()
3653{
3654 char buf[MAXPATHLEN+1];
2381d133
JB
3655 char *pwd;
3656 struct stat dotstat, pwdstat;
136351b7 3657 Lisp_Object temp;
f7975d07 3658 int rc;
1ab256cb
RM
3659
3660 Fset_buffer (Fget_buffer_create (build_string ("*scratch*")));
2381d133
JB
3661
3662 /* If PWD is accurate, use it instead of calling getwd. This is faster
3663 when PWD is right, and may avoid a fatal error. */
f7975d07 3664 if ((pwd = getenv ("PWD")) != 0 && IS_DIRECTORY_SEP (*pwd)
2381d133
JB
3665 && stat (pwd, &pwdstat) == 0
3666 && stat (".", &dotstat) == 0
3667 && dotstat.st_ino == pwdstat.st_ino
3668 && dotstat.st_dev == pwdstat.st_dev
3669 && strlen (pwd) < MAXPATHLEN)
3670 strcpy (buf, pwd);
3671 else if (getwd (buf) == 0)
cf1e6391 3672 fatal ("`getwd' failed: %s\n", buf);
1ab256cb
RM
3673
3674#ifndef VMS
3675 /* Maybe this should really use some standard subroutine
3676 whose definition is filename syntax dependent. */
f7975d07
RS
3677 rc = strlen (buf);
3678 if (!(IS_DIRECTORY_SEP (buf[rc - 1])))
3679 {
3680 buf[rc] = DIRECTORY_SEP;
3681 buf[rc + 1] = '\0';
3682 }
1ab256cb 3683#endif /* not VMS */
0995fa35 3684
1ab256cb 3685 current_buffer->directory = build_string (buf);
136351b7 3686
0995fa35
RS
3687 /* Add /: to the front of the name
3688 if it would otherwise be treated as magic. */
3689 temp = Ffind_file_name_handler (current_buffer->directory, Qt);
3690 if (! NILP (temp))
3691 current_buffer->directory
3692 = concat2 (build_string ("/:"), current_buffer->directory);
3693
136351b7
RS
3694 temp = get_minibuffer (0);
3695 XBUFFER (temp)->directory = current_buffer->directory;
1ab256cb
RM
3696}
3697
3698/* initialize the buffer routines */
3699syms_of_buffer ()
3700{
188d4d11
RM
3701 extern Lisp_Object Qdisabled;
3702
9115729e
KH
3703 staticpro (&last_overlay_modification_hooks);
3704 last_overlay_modification_hooks
3705 = Fmake_vector (make_number (10), Qnil);
3706
1ab256cb
RM
3707 staticpro (&Vbuffer_defaults);
3708 staticpro (&Vbuffer_local_symbols);
3709 staticpro (&Qfundamental_mode);
3710 staticpro (&Qmode_class);
3711 staticpro (&QSFundamental);
3712 staticpro (&Vbuffer_alist);
3713 staticpro (&Qprotected_field);
3714 staticpro (&Qpermanent_local);
3715 staticpro (&Qkill_buffer_hook);
22378665 3716 Qoverlayp = intern ("overlayp");
52f8ec73 3717 staticpro (&Qoverlayp);
9d7608b7
KH
3718 Qevaporate = intern ("evaporate");
3719 staticpro (&Qevaporate);
294d215f 3720 Qmodification_hooks = intern ("modification-hooks");
22378665 3721 staticpro (&Qmodification_hooks);
294d215f 3722 Qinsert_in_front_hooks = intern ("insert-in-front-hooks");
22378665 3723 staticpro (&Qinsert_in_front_hooks);
294d215f 3724 Qinsert_behind_hooks = intern ("insert-behind-hooks");
22378665 3725 staticpro (&Qinsert_behind_hooks);
5fe0b67e 3726 Qget_file_buffer = intern ("get-file-buffer");
22378665 3727 staticpro (&Qget_file_buffer);
5985d248
KH
3728 Qpriority = intern ("priority");
3729 staticpro (&Qpriority);
3730 Qwindow = intern ("window");
3731 staticpro (&Qwindow);
bbbe9545
KH
3732 Qbefore_string = intern ("before-string");
3733 staticpro (&Qbefore_string);
3734 Qafter_string = intern ("after-string");
3735 staticpro (&Qafter_string);
22378665
RS
3736 Qfirst_change_hook = intern ("first-change-hook");
3737 staticpro (&Qfirst_change_hook);
3738 Qbefore_change_functions = intern ("before-change-functions");
3739 staticpro (&Qbefore_change_functions);
3740 Qafter_change_functions = intern ("after-change-functions");
3741 staticpro (&Qafter_change_functions);
1ab256cb
RM
3742
3743 Fput (Qprotected_field, Qerror_conditions,
3744 Fcons (Qprotected_field, Fcons (Qerror, Qnil)));
3745 Fput (Qprotected_field, Qerror_message,
3746 build_string ("Attempt to modify a protected field"));
3747
3748 /* All these use DEFVAR_LISP_NOPRO because the slots in
3749 buffer_defaults will all be marked via Vbuffer_defaults. */
3750
3751 DEFVAR_LISP_NOPRO ("default-mode-line-format",
3752 &buffer_defaults.mode_line_format,
3753 "Default value of `mode-line-format' for buffers that don't override it.\n\
3754This is the same as (default-value 'mode-line-format).");
3755
3756 DEFVAR_LISP_NOPRO ("default-abbrev-mode",
3757 &buffer_defaults.abbrev_mode,
3758 "Default value of `abbrev-mode' for buffers that do not override it.\n\
3759This is the same as (default-value 'abbrev-mode).");
3760
3761 DEFVAR_LISP_NOPRO ("default-ctl-arrow",
3762 &buffer_defaults.ctl_arrow,
3763 "Default value of `ctl-arrow' for buffers that do not override it.\n\
3764This is the same as (default-value 'ctl-arrow).");
3765
3b06f880
KH
3766 DEFVAR_LISP_NOPRO ("default-direction-reversed",
3767 &buffer_defaults.direction_reversed,
3768 "Default value of `direction_reversed' for buffers that do not override it.\n\
3769 This is the same as (default-value 'direction-reversed).");
3770
a1a17b61
KH
3771 DEFVAR_LISP_NOPRO ("default-enable-multibyte-characters",
3772 &buffer_defaults.enable_multibyte_characters,
3773 "Default value of `enable-multibyte-characters' for buffers not overriding it.\n\
3774 This is the same as (default-value 'enable-multibyte-characters).");
3775
1ab256cb
RM
3776 DEFVAR_LISP_NOPRO ("default-truncate-lines",
3777 &buffer_defaults.truncate_lines,
3778 "Default value of `truncate-lines' for buffers that do not override it.\n\
3779This is the same as (default-value 'truncate-lines).");
3780
3781 DEFVAR_LISP_NOPRO ("default-fill-column",
3782 &buffer_defaults.fill_column,
3783 "Default value of `fill-column' for buffers that do not override it.\n\
3784This is the same as (default-value 'fill-column).");
3785
3786 DEFVAR_LISP_NOPRO ("default-left-margin",
3787 &buffer_defaults.left_margin,
3788 "Default value of `left-margin' for buffers that do not override it.\n\
3789This is the same as (default-value 'left-margin).");
3790
3791 DEFVAR_LISP_NOPRO ("default-tab-width",
3792 &buffer_defaults.tab_width,
3793 "Default value of `tab-width' for buffers that do not override it.\n\
3794This is the same as (default-value 'tab-width).");
3795
3796 DEFVAR_LISP_NOPRO ("default-case-fold-search",
3797 &buffer_defaults.case_fold_search,
3798 "Default value of `case-fold-search' for buffers that don't override it.\n\
3799This is the same as (default-value 'case-fold-search).");
3800
f7975d07 3801#ifdef DOS_NT
54ad07d3
RS
3802 DEFVAR_LISP_NOPRO ("default-buffer-file-type",
3803 &buffer_defaults.buffer_file_type,
3804 "Default file type for buffers that do not override it.\n\
3805This is the same as (default-value 'buffer-file-type).\n\
3806The file type is nil for text, t for binary.");
3807#endif
3808
0fa3ba92
JB
3809 DEFVAR_PER_BUFFER ("mode-line-format", &current_buffer->mode_line_format,
3810 Qnil, 0);
1ab256cb
RM
3811
3812/* This doc string is too long for cpp; cpp dies if it isn't in a comment.
3813 But make-docfile finds it!
3814 DEFVAR_PER_BUFFER ("mode-line-format", &current_buffer->mode_line_format,
bec44fd6 3815 Qnil,
1ab256cb
RM
3816 "Template for displaying mode line for current buffer.\n\
3817Each buffer has its own value of this variable.\n\
3818Value may be a string, a symbol or a list or cons cell.\n\
3819For a symbol, its value is used (but it is ignored if t or nil).\n\
3820 A string appearing directly as the value of a symbol is processed verbatim\n\
3821 in that the %-constructs below are not recognized.\n\
3822For a list whose car is a symbol, the symbol's value is taken,\n\
3823 and if that is non-nil, the cadr of the list is processed recursively.\n\
3824 Otherwise, the caddr of the list (if there is one) is processed.\n\
3825For a list whose car is a string or list, each element is processed\n\
3826 recursively and the results are effectively concatenated.\n\
3827For a list whose car is an integer, the cdr of the list is processed\n\
3828 and padded (if the number is positive) or truncated (if negative)\n\
3829 to the width specified by that number.\n\
3830A string is printed verbatim in the mode line except for %-constructs:\n\
3831 (%-constructs are allowed when the string is the entire mode-line-format\n\
3832 or when it is found in a cons-cell or a list)\n\
3833 %b -- print buffer name. %f -- print visited file name.\n\
c2ff34f7
RS
3834 %* -- print %, * or hyphen. %+ -- print *, % or hyphen.\n\
3835 % means buffer is read-only and * means it is modified.\n\
3836 For a modified read-only buffer, %* gives % and %+ gives *.\n\
a97c374a 3837 %s -- print process status. %l -- print the current line number.\n\
07924294 3838 %c -- print the current column number (this makes editing slower).\n\
dd24e6a6 3839 %p -- print percent of buffer above top of window, or Top, Bot or All.\n\
9d130ffc 3840 %P -- print percent of buffer above bottom of window, perhaps plus Top,\n\
dd24e6a6 3841 or print Bottom or All.\n\
1ab256cb 3842 %n -- print Narrow if appropriate.\n\
b77087c5 3843 %t -- print T if file is text, B if binary.\n\
1ab256cb
RM
3844 %[ -- print one [ for each recursive editing level. %] similar.\n\
3845 %% -- print %. %- -- print infinitely many dashes.\n\
3846Decimal digits after the % specify field width to which to pad.");
3847*/
3848
3849 DEFVAR_LISP_NOPRO ("default-major-mode", &buffer_defaults.major_mode,
3850 "*Major mode for new buffers. Defaults to `fundamental-mode'.\n\
3851nil here means use current buffer's major mode.");
3852
3853 DEFVAR_PER_BUFFER ("major-mode", &current_buffer->major_mode,
0fa3ba92 3854 make_number (Lisp_Symbol),
1ab256cb
RM
3855 "Symbol for current buffer's major mode.");
3856
3857 DEFVAR_PER_BUFFER ("mode-name", &current_buffer->mode_name,
0fa3ba92 3858 make_number (Lisp_String),
1ab256cb
RM
3859 "Pretty name of current buffer's major mode (a string).");
3860
0fa3ba92 3861 DEFVAR_PER_BUFFER ("abbrev-mode", &current_buffer->abbrev_mode, Qnil,
1ab256cb
RM
3862 "Non-nil turns on automatic expansion of abbrevs as they are inserted.\n\
3863Automatically becomes buffer-local when set in any fashion.");
3864
3865 DEFVAR_PER_BUFFER ("case-fold-search", &current_buffer->case_fold_search,
0fa3ba92 3866 Qnil,
1ab256cb
RM
3867 "*Non-nil if searches should ignore case.\n\
3868Automatically becomes buffer-local when set in any fashion.");
3869
3870 DEFVAR_PER_BUFFER ("fill-column", &current_buffer->fill_column,
0fa3ba92 3871 make_number (Lisp_Int),
1ab256cb
RM
3872 "*Column beyond which automatic line-wrapping should happen.\n\
3873Automatically becomes buffer-local when set in any fashion.");
3874
3875 DEFVAR_PER_BUFFER ("left-margin", &current_buffer->left_margin,
0fa3ba92 3876 make_number (Lisp_Int),
1ab256cb
RM
3877 "*Column for the default indent-line-function to indent to.\n\
3878Linefeed indents to this column in Fundamental mode.\n\
3879Automatically becomes buffer-local when set in any fashion.");
3880
3881 DEFVAR_PER_BUFFER ("tab-width", &current_buffer->tab_width,
0fa3ba92 3882 make_number (Lisp_Int),
1ab256cb
RM
3883 "*Distance between tab stops (for display of tab characters), in columns.\n\
3884Automatically becomes buffer-local when set in any fashion.");
3885
0fa3ba92 3886 DEFVAR_PER_BUFFER ("ctl-arrow", &current_buffer->ctl_arrow, Qnil,
1ab256cb
RM
3887 "*Non-nil means display control chars with uparrow.\n\
3888Nil means use backslash and octal digits.\n\
3889Automatically becomes buffer-local when set in any fashion.\n\
3890This variable does not apply to characters whose display is specified\n\
3891in the current display table (if there is one).");
3892
3b06f880
KH
3893 DEFVAR_PER_BUFFER ("enable-multibyte-characters",
3894 &current_buffer->enable_multibyte_characters, Qnil,
3895 "Non-nil means the buffer contents are regarded as multi-byte form\n\
3896of characters, not a binary code. This affects the display, file I/O,\n\
3897and behaviors of various editing commands.");
3898
3899 DEFVAR_PER_BUFFER ("direction-reversed", &current_buffer->direction_reversed,
3900 Qnil,
3901 "*Non-nil means lines in the buffer are displayed right to left.");
3902
0fa3ba92 3903 DEFVAR_PER_BUFFER ("truncate-lines", &current_buffer->truncate_lines, Qnil,
1ab256cb
RM
3904 "*Non-nil means do not display continuation lines;\n\
3905give each line of text one screen line.\n\
3906Automatically becomes buffer-local when set in any fashion.\n\
3907\n\
3908Note that this is overridden by the variable\n\
3909`truncate-partial-width-windows' if that variable is non-nil\n\
502b9b64 3910and this buffer is not full-frame width.");
1ab256cb 3911
f7975d07 3912#ifdef DOS_NT
54ad07d3
RS
3913 DEFVAR_PER_BUFFER ("buffer-file-type", &current_buffer->buffer_file_type,
3914 Qnil,
006d3d34
RS
3915 "Non-nil if the visited file is a binary file.\n\
3916This variable is meaningful on MS-DOG and Windows NT.\n\
3917On those systems, it is automatically local in every buffer.\n\
e0585c64 3918On other systems, this variable is normally always nil.");
54ad07d3
RS
3919#endif
3920
1ab256cb 3921 DEFVAR_PER_BUFFER ("default-directory", &current_buffer->directory,
0fa3ba92 3922 make_number (Lisp_String),
1ab256cb
RM
3923 "Name of default directory of current buffer. Should end with slash.\n\
3924Each buffer has its own value of this variable.");
3925
3926 DEFVAR_PER_BUFFER ("auto-fill-function", &current_buffer->auto_fill_function,
0fa3ba92 3927 Qnil,
1ab256cb 3928 "Function called (if non-nil) to perform auto-fill.\n\
54158e68 3929It is called after self-inserting a space or newline.\n\
1ab256cb 3930Each buffer has its own value of this variable.\n\
54158e68
KH
3931NOTE: This variable is not a hook;\n\
3932its value may not be a list of functions.");
1ab256cb
RM
3933
3934 DEFVAR_PER_BUFFER ("buffer-file-name", &current_buffer->filename,
0fa3ba92 3935 make_number (Lisp_String),
1ab256cb
RM
3936 "Name of file visited in current buffer, or nil if not visiting a file.\n\
3937Each buffer has its own value of this variable.");
3938
f6ed2e84
RS
3939 DEFVAR_PER_BUFFER ("buffer-file-truename", &current_buffer->file_truename,
3940 make_number (Lisp_String),
bb4c204e 3941 "Abbreviated truename of file visited in current buffer, or nil if none.\n\
b1c03e64
RS
3942The truename of a file is calculated by `file-truename'\n\
3943and then abbreviated with `abbreviate-file-name'.\n\
f6ed2e84
RS
3944Each buffer has its own value of this variable.");
3945
1ab256cb 3946 DEFVAR_PER_BUFFER ("buffer-auto-save-file-name",
3f5fcd47 3947 &current_buffer->auto_save_file_name,
0fa3ba92 3948 make_number (Lisp_String),
1ab256cb
RM
3949 "Name of file for auto-saving current buffer,\n\
3950or nil if buffer should not be auto-saved.\n\
3951Each buffer has its own value of this variable.");
3952
0fa3ba92 3953 DEFVAR_PER_BUFFER ("buffer-read-only", &current_buffer->read_only, Qnil,
1ab256cb
RM
3954 "Non-nil if this buffer is read-only.\n\
3955Each buffer has its own value of this variable.");
3956
0fa3ba92 3957 DEFVAR_PER_BUFFER ("buffer-backed-up", &current_buffer->backed_up, Qnil,
1ab256cb
RM
3958 "Non-nil if this buffer's file has been backed up.\n\
3959Backing up is done before the first time the file is saved.\n\
3960Each buffer has its own value of this variable.");
3961
3962 DEFVAR_PER_BUFFER ("buffer-saved-size", &current_buffer->save_length,
0fa3ba92 3963 make_number (Lisp_Int),
1ab256cb
RM
3964 "Length of current buffer when last read in, saved or auto-saved.\n\
39650 initially.\n\
3966Each buffer has its own value of this variable.");
3967
3968 DEFVAR_PER_BUFFER ("selective-display", &current_buffer->selective_display,
0fa3ba92 3969 Qnil,
1ab256cb
RM
3970 "Non-nil enables selective display:\n\
3971Integer N as value means display only lines\n\
3972 that start with less than n columns of space.\n\
3973A value of t means, after a ^M, all the rest of the line is invisible.\n\
3974 Then ^M's in the file are written into files as newlines.\n\n\
3975Automatically becomes buffer-local when set in any fashion.");
3976
3977#ifndef old
3978 DEFVAR_PER_BUFFER ("selective-display-ellipses",
3979 &current_buffer->selective_display_ellipses,
0fa3ba92 3980 Qnil,
1ab256cb
RM
3981 "t means display ... on previous line when a line is invisible.\n\
3982Automatically becomes buffer-local when set in any fashion.");
3983#endif
3984
0fa3ba92 3985 DEFVAR_PER_BUFFER ("overwrite-mode", &current_buffer->overwrite_mode, Qnil,
1ab256cb 3986 "Non-nil if self-insertion should replace existing text.\n\
5e05d0a5
RS
3987The value should be one of `overwrite-mode-textual',\n\
3988`overwrite-mode-binary', or nil.\n\
3989If it is `overwrite-mode-textual', self-insertion still\n\
6bbb0d4a 3990inserts at the end of a line, and inserts when point is before a tab,\n\
2e94b813 3991until the tab is filled in.\n\
6bbb0d4a 3992If `overwrite-mode-binary', self-insertion replaces newlines and tabs too.\n\
1ab256cb
RM
3993Automatically becomes buffer-local when set in any fashion.");
3994
54939090
RS
3995#if 0 /* The doc string is too long for some compilers,
3996 but make-docfile can find it in this comment. */
1ab256cb 3997 DEFVAR_PER_BUFFER ("buffer-display-table", &current_buffer->display_table,
5d305367 3998 Qnil,
1ab256cb
RM
3999 "Display table that controls display of the contents of current buffer.\n\
4000Automatically becomes buffer-local when set in any fashion.\n\
6fdc249f
EN
4001The display table is a char-table created with `make-display-table'.\n\
4002The ordinary char-table elements control how to display each possible text\n\
4003character. Each value should be a vector of characters or nil;\n\
1ab256cb 4004nil means display the character in the default fashion.\n\
6fdc249f
EN
4005There are six extra slots to control the display of\n\
4006 the end of a truncated screen line (extra-slot 0, a single character);\n\
4007 the end of a continued line (extra-slot 1, a single character);\n\
6158b3b0 4008 the escape character used to display character codes in octal\n\
6fdc249f
EN
4009 (extra-slot 2, a single character);\n\
4010 the character used as an arrow for control characters (extra-slot 3,\n\
6158b3b0 4011 a single character);\n\
6fdc249f 4012 the decoration indicating the presence of invisible lines (extra-slot 4,\n\
a45e35e1
JB
4013 a vector of characters);\n\
4014 the character used to draw the border between side-by-side windows\n\
6fdc249f
EN
4015 (extra-slot 5, a single character).\n\
4016See also the functions `display-table-slot' and `set-display-table-slot'.\n\
1ab256cb
RM
4017If this variable is nil, the value of `standard-display-table' is used.\n\
4018Each window can have its own, overriding display table.");
54939090
RS
4019#endif
4020 DEFVAR_PER_BUFFER ("buffer-display-table", &current_buffer->display_table,
de15914a 4021 Qnil, 0);
1ab256cb 4022
1ab256cb
RM
4023/*DEFVAR_LISP ("debug-check-symbol", &Vcheck_symbol,
4024 "Don't ask.");
4025*/
01050cb5 4026 DEFVAR_LISP ("before-change-function", &Vbefore_change_function,
f0724bcb 4027 "If non-nil, a function to call before each text change (obsolete).\n\
1ab256cb
RM
4028Two arguments are passed to the function: the positions of\n\
4029the beginning and end of the range of old text to be changed.\n\
4030\(For an insertion, the beginning and end are at the same place.)\n\
4031No information is given about the length of the text after the change.\n\
1ab256cb 4032\n\
5f079267 4033Buffer changes made while executing the `before-change-function'\n\
b86344d0
RS
4034don't call any before-change or after-change functions.\n\
4035That's because these variables are temporarily set to nil.\n\
4036As a result, a hook function cannot straightforwardly alter the value of\n\
4037these variables. See the Emacs Lisp manual for a way of\n\
f0724bcb
RS
4038accomplishing an equivalent result by using other variables.\n\n\
4039This variable is obsolete; use `before-change-functions' instead.");
1ab256cb
RM
4040 Vbefore_change_function = Qnil;
4041
4042 DEFVAR_LISP ("after-change-function", &Vafter_change_function,
f0724bcb 4043 "If non-nil, a Function to call after each text change (obsolete).\n\
1ab256cb
RM
4044Three arguments are passed to the function: the positions of\n\
4045the beginning and end of the range of changed text,\n\
4046and the length of the pre-change text replaced by that range.\n\
4047\(For an insertion, the pre-change length is zero;\n\
4048for a deletion, that length is the number of characters deleted,\n\
4049and the post-change beginning and end are at the same place.)\n\
4050\n\
5f079267 4051Buffer changes made while executing the `after-change-function'\n\
b86344d0
RS
4052don't call any before-change or after-change functions.\n\
4053That's because these variables are temporarily set to nil.\n\
4054As a result, a hook function cannot straightforwardly alter the value of\n\
4055these variables. See the Emacs Lisp manual for a way of\n\
f0724bcb
RS
4056accomplishing an equivalent result by using other variables.\n\n\
4057This variable is obsolete; use `after-change-functions' instead.");
1ab256cb
RM
4058 Vafter_change_function = Qnil;
4059
5f079267
RS
4060 DEFVAR_LISP ("before-change-functions", &Vbefore_change_functions,
4061 "List of functions to call before each text change.\n\
4062Two arguments are passed to each function: the positions of\n\
4063the beginning and end of the range of old text to be changed.\n\
4064\(For an insertion, the beginning and end are at the same place.)\n\
4065No information is given about the length of the text after the change.\n\
5f079267
RS
4066\n\
4067Buffer changes made while executing the `before-change-functions'\n\
b86344d0
RS
4068don't call any before-change or after-change functions.\n\
4069That's because these variables are temporarily set to nil.\n\
4070As a result, a hook function cannot straightforwardly alter the value of\n\
4071these variables. See the Emacs Lisp manual for a way of\n\
d59698c4 4072accomplishing an equivalent result by using other variables.");
5f079267
RS
4073 Vbefore_change_functions = Qnil;
4074
4075 DEFVAR_LISP ("after-change-functions", &Vafter_change_functions,
4076 "List of function to call after each text change.\n\
4077Three arguments are passed to each function: the positions of\n\
4078the beginning and end of the range of changed text,\n\
4079and the length of the pre-change text replaced by that range.\n\
4080\(For an insertion, the pre-change length is zero;\n\
4081for a deletion, that length is the number of characters deleted,\n\
4082and the post-change beginning and end are at the same place.)\n\
4083\n\
4084Buffer changes made while executing the `after-change-functions'\n\
b86344d0
RS
4085don't call any before-change or after-change functions.\n\
4086That's because these variables are temporarily set to nil.\n\
4087As a result, a hook function cannot straightforwardly alter the value of\n\
4088these variables. See the Emacs Lisp manual for a way of\n\
d59698c4 4089accomplishing an equivalent result by using other variables.");
b86344d0 4090
5f079267
RS
4091 Vafter_change_functions = Qnil;
4092
dbc4e1c1
JB
4093 DEFVAR_LISP ("first-change-hook", &Vfirst_change_hook,
4094 "A list of functions to call before changing a buffer which is unmodified.\n\
4095The functions are run using the `run-hooks' function.");
4096 Vfirst_change_hook = Qnil;
1ab256cb 4097
54939090
RS
4098#if 0 /* The doc string is too long for some compilers,
4099 but make-docfile can find it in this comment. */
3f5fcd47 4100 DEFVAR_PER_BUFFER ("buffer-undo-list", &current_buffer->undo_list, Qnil,
1ab256cb
RM
4101 "List of undo entries in current buffer.\n\
4102Recent changes come first; older changes follow newer.\n\
4103\n\
630f4018
KH
4104An entry (BEG . END) represents an insertion which begins at\n\
4105position BEG and ends at position END.\n\
1ab256cb
RM
4106\n\
4107An entry (TEXT . POSITION) represents the deletion of the string TEXT\n\
4108from (abs POSITION). If POSITION is positive, point was at the front\n\
4109of the text being deleted; if negative, point was at the end.\n\
4110\n\
6c0df54a
RS
4111An entry (t HIGH . LOW) indicates that the buffer previously had\n\
4112\"unmodified\" status. HIGH and LOW are the high and low 16-bit portions\n\
4113of the visited file's modification time, as of that time. If the\n\
4114modification time of the most recent save is different, this entry is\n\
1ab256cb
RM
4115obsolete.\n\
4116\n\
6c0df54a
RS
4117An entry (nil PROPERTY VALUE BEG . END) indicates that a text property\n\
4118was modified between BEG and END. PROPERTY is the property name,\n\
4119and VALUE is the old value.\n\
483c1fd3 4120\n\
da1c183c
RS
4121An entry (MARKER . DISTANCE) indicates that the marker MARKER\n\
4122was adjusted in position by the offset DISTANCE (an integer).\n\
4123\n\
bec44fd6
JB
4124An entry of the form POSITION indicates that point was at the buffer\n\
4125location given by the integer. Undoing an entry of this form places\n\
4126point at POSITION.\n\
4127\n\
1ab256cb
RM
4128nil marks undo boundaries. The undo command treats the changes\n\
4129between two undo boundaries as a single step to be undone.\n\
4130\n\
bec44fd6 4131If the value of the variable is t, undo information is not recorded.");
54939090
RS
4132#endif
4133 DEFVAR_PER_BUFFER ("buffer-undo-list", &current_buffer->undo_list, Qnil,
de15914a 4134 0);
1ab256cb 4135
c48f61ef
RS
4136 DEFVAR_PER_BUFFER ("mark-active", &current_buffer->mark_active, Qnil,
4137 "Non-nil means the mark and region are currently active in this buffer.\n\
4138Automatically local in all buffers.");
4139
28e969dd 4140 DEFVAR_PER_BUFFER ("cache-long-line-scans", &current_buffer->cache_long_line_scans, Qnil,
f0c5b712
JB
4141 "Non-nil means that Emacs should use caches to handle long lines more quickly.\n\
4142This variable is buffer-local, in all buffers.\n\
28e969dd 4143\n\
f0c5b712
JB
4144Normally, the line-motion functions work by scanning the buffer for\n\
4145newlines. Columnar operations (like move-to-column and\n\
4146compute-motion) also work by scanning the buffer, summing character\n\
4147widths as they go. This works well for ordinary text, but if the\n\
28e969dd 4148buffer's lines are very long (say, more than 500 characters), these\n\
f0c5b712
JB
4149motion functions will take longer to execute. Emacs may also take\n\
4150longer to update the display.\n\
28e969dd 4151\n\
f0c5b712
JB
4152If cache-long-line-scans is non-nil, these motion functions cache the\n\
4153results of their scans, and consult the cache to avoid rescanning\n\
4154regions of the buffer until the text is modified. The caches are most\n\
4155beneficial when they prevent the most searching---that is, when the\n\
4156buffer contains long lines and large regions of characters with the\n\
4157same, fixed screen width.\n\
28e969dd 4158\n\
f0c5b712
JB
4159When cache-long-line-scans is non-nil, processing short lines will\n\
4160become slightly slower (because of the overhead of consulting the\n\
4161cache), and the caches will use memory roughly proportional to the\n\
4162number of newlines and characters whose screen width varies.\n\
4163\n\
4164The caches require no explicit maintenance; their accuracy is\n\
4165maintained internally by the Emacs primitives. Enabling or disabling\n\
4166the cache should not affect the behavior of any of the motion\n\
4167functions; it should only affect their performance.");
28e969dd 4168
943e065b
RS
4169 DEFVAR_PER_BUFFER ("point-before-scroll", &current_buffer->point_before_scroll, Qnil,
4170 "Value of point before the last series of scroll operations, or nil.");
4171
be9aafdd
BG
4172 DEFVAR_PER_BUFFER ("buffer-file-format", &current_buffer->file_format, Qnil,
4173 "List of formats to use when saving this buffer.\n\
4174Formats are defined by `format-alist'. This variable is\n\
4175set when a file is visited. Automatically local in all buffers.");
4176
3cb719bd
RS
4177 DEFVAR_PER_BUFFER ("buffer-invisibility-spec",
4178 &current_buffer->invisibility_spec, Qnil,
4179 "Invisibility spec of this buffer.\n\
4180The default is t, which means that text is invisible\n\
4181if it has a non-nil `invisible' property.\n\
4182If the value is a list, a text character is invisible if its `invisible'\n\
4183property is an element in that list.\n\
554216ad
KH
4184If an element is a cons cell of the form (PROP . ELLIPSIS),\n\
4185then characters with property value PROP are invisible,\n\
3cb719bd
RS
4186and they have an ellipsis as well if ELLIPSIS is non-nil.");
4187
7962a441
RS
4188 DEFVAR_PER_BUFFER ("buffer-display-count",
4189 &current_buffer->display_count, Qnil,
4190 "A number incremented each time the buffer is displayed in a window.");
4191
c48f61ef 4192 DEFVAR_LISP ("transient-mark-mode", &Vtransient_mark_mode,
319c537c
RS
4193 "*Non-nil means deactivate the mark when the buffer contents change.\n\
4194Non-nil also enables highlighting of the region whenever the mark is active.\n\
4195The variable `highlight-nonselected-windows' controls whether to highlight\n\
4196all windows or just the selected window.");
c48f61ef
RS
4197 Vtransient_mark_mode = Qnil;
4198
0a4469c9 4199 DEFVAR_LISP ("inhibit-read-only", &Vinhibit_read_only,
a96b68f1
RS
4200 "*Non-nil means disregard read-only status of buffers or characters.\n\
4201If the value is t, disregard `buffer-read-only' and all `read-only'\n\
4202text properties. If the value is a list, disregard `buffer-read-only'\n\
4203and disregard a `read-only' text property if the property value\n\
4204is a member of the list.");
4205 Vinhibit_read_only = Qnil;
4206
dcdffbf6
RS
4207 DEFVAR_LISP ("kill-buffer-query-functions", &Vkill_buffer_query_functions,
4208 "List of functions called with no args to query before killing a buffer.");
4209 Vkill_buffer_query_functions = Qnil;
4210
0dc88e60 4211 defsubr (&Sbuffer_live_p);
1ab256cb
RM
4212 defsubr (&Sbuffer_list);
4213 defsubr (&Sget_buffer);
4214 defsubr (&Sget_file_buffer);
4215 defsubr (&Sget_buffer_create);
336cd056 4216 defsubr (&Smake_indirect_buffer);
01050cb5 4217 defsubr (&Sgenerate_new_buffer_name);
1ab256cb
RM
4218 defsubr (&Sbuffer_name);
4219/*defsubr (&Sbuffer_number);*/
4220 defsubr (&Sbuffer_file_name);
336cd056 4221 defsubr (&Sbuffer_base_buffer);
1ab256cb
RM
4222 defsubr (&Sbuffer_local_variables);
4223 defsubr (&Sbuffer_modified_p);
4224 defsubr (&Sset_buffer_modified_p);
4225 defsubr (&Sbuffer_modified_tick);
4226 defsubr (&Srename_buffer);
4227 defsubr (&Sother_buffer);
4228 defsubr (&Sbuffer_disable_undo);
4229 defsubr (&Sbuffer_enable_undo);
4230 defsubr (&Skill_buffer);
4231 defsubr (&Serase_buffer);
a9ee7a59 4232 defsubr (&Sset_buffer_major_mode);
1ab256cb
RM
4233 defsubr (&Sswitch_to_buffer);
4234 defsubr (&Spop_to_buffer);
4235 defsubr (&Scurrent_buffer);
4236 defsubr (&Sset_buffer);
4237 defsubr (&Sbarf_if_buffer_read_only);
4238 defsubr (&Sbury_buffer);
1ab256cb 4239 defsubr (&Skill_all_local_variables);
2eec3b4e 4240
52f8ec73 4241 defsubr (&Soverlayp);
2eec3b4e
RS
4242 defsubr (&Smake_overlay);
4243 defsubr (&Sdelete_overlay);
4244 defsubr (&Smove_overlay);
8ebafa8d
JB
4245 defsubr (&Soverlay_start);
4246 defsubr (&Soverlay_end);
4247 defsubr (&Soverlay_buffer);
4248 defsubr (&Soverlay_properties);
2eec3b4e 4249 defsubr (&Soverlays_at);
74514898 4250 defsubr (&Soverlays_in);
2eec3b4e 4251 defsubr (&Snext_overlay_change);
239c932b 4252 defsubr (&Sprevious_overlay_change);
2eec3b4e
RS
4253 defsubr (&Soverlay_recenter);
4254 defsubr (&Soverlay_lists);
4255 defsubr (&Soverlay_get);
4256 defsubr (&Soverlay_put);
1ab256cb
RM
4257}
4258
4259keys_of_buffer ()
4260{
4261 initial_define_key (control_x_map, 'b', "switch-to-buffer");
4262 initial_define_key (control_x_map, 'k', "kill-buffer");
4158c17d
RM
4263
4264 /* This must not be in syms_of_buffer, because Qdisabled is not
4265 initialized when that function gets called. */
4266 Fput (intern ("erase-buffer"), Qdisabled, Qt);
1ab256cb 4267}