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