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