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