(query-replace-map): Bind f1 and help.
[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
5b8bcf48 810DEFUN ("buffer-disable-undo", Fbuffer_disable_undo, Sbuffer_disable_undo, 0, 1,
1ab256cb 8110,
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\
2666If there are no more overlay boundaries after POS, return (point-min).")
2667 (pos)
2668 Lisp_Object pos;
2669{
2670 int noverlays;
2671 int prevpos;
2672 Lisp_Object *overlay_vec;
2673 int len;
2674 int i;
2675
2676 CHECK_NUMBER_COERCE_MARKER (pos, 0);
2677
2678 len = 10;
2679 overlay_vec = (Lisp_Object *) xmalloc (len * sizeof (Lisp_Object));
2680
2681 /* Put all the overlays we want in a vector in overlay_vec.
2682 Store the length in len.
2683 prevpos gets the position of an overlay end. */
2a77a7d7
RS
2684 noverlays = overlays_at (XINT (pos), 1, &overlay_vec, &len,
2685 (int *) 0, &prevpos);
239c932b
RS
2686
2687 /* If any of these overlays starts before endpos,
2688 maybe use its starting point instead. */
2689 for (i = 0; i < noverlays; i++)
2690 {
2691 Lisp_Object ostart;
2692 int ostartpos;
2693
2694 ostart = OVERLAY_START (overlay_vec[i]);
2695 ostartpos = OVERLAY_POSITION (ostart);
2696 if (ostartpos > prevpos && ostartpos < XINT (pos))
2697 prevpos = ostartpos;
2698 }
2699
2700 xfree (overlay_vec);
2701 return make_number (prevpos);
2702}
2eec3b4e
RS
2703\f
2704/* These functions are for debugging overlays. */
2705
2706DEFUN ("overlay-lists", Foverlay_lists, Soverlay_lists, 0, 0, 0,
2707 "Return a pair of lists giving all the overlays of the current buffer.\n\
2708The car has all the overlays before the overlay center;\n\
bbe20e81 2709the cdr has all the overlays after the overlay center.\n\
2eec3b4e
RS
2710Recentering overlays moves overlays between these lists.\n\
2711The lists you get are copies, so that changing them has no effect.\n\
2712However, the overlays you get are the real objects that the buffer uses.")
2713 ()
2714{
2715 Lisp_Object before, after;
2716 before = current_buffer->overlays_before;
2717 if (CONSP (before))
2718 before = Fcopy_sequence (before);
2719 after = current_buffer->overlays_after;
2720 if (CONSP (after))
2721 after = Fcopy_sequence (after);
2722
2723 return Fcons (before, after);
2724}
2725
2726DEFUN ("overlay-recenter", Foverlay_recenter, Soverlay_recenter, 1, 1, 0,
2727 "Recenter the overlays of the current buffer around position POS.")
2728 (pos)
2729 Lisp_Object pos;
2730{
2731 CHECK_NUMBER_COERCE_MARKER (pos, 0);
2732
5c4f68f1 2733 recenter_overlay_lists (current_buffer, XINT (pos));
2eec3b4e
RS
2734 return Qnil;
2735}
2736\f
2737DEFUN ("overlay-get", Foverlay_get, Soverlay_get, 2, 2, 0,
2738 "Get the property of overlay OVERLAY with property name NAME.")
2739 (overlay, prop)
2740 Lisp_Object overlay, prop;
2741{
cab4777e 2742 Lisp_Object plist, fallback;
52f8ec73
JB
2743
2744 CHECK_OVERLAY (overlay, 0);
2745
cab4777e
RS
2746 fallback = Qnil;
2747
48e2e3ba 2748 for (plist = XOVERLAY (overlay)->plist;
2eec3b4e
RS
2749 CONSP (plist) && CONSP (XCONS (plist)->cdr);
2750 plist = XCONS (XCONS (plist)->cdr)->cdr)
2751 {
2752 if (EQ (XCONS (plist)->car, prop))
2753 return XCONS (XCONS (plist)->cdr)->car;
cab4777e
RS
2754 else if (EQ (XCONS (plist)->car, Qcategory))
2755 {
2756 Lisp_Object tem;
2757 tem = Fcar (Fcdr (plist));
2758 if (SYMBOLP (tem))
2759 fallback = Fget (tem, prop);
2760 }
2eec3b4e 2761 }
52f8ec73 2762
cab4777e 2763 return fallback;
2eec3b4e
RS
2764}
2765
2766DEFUN ("overlay-put", Foverlay_put, Soverlay_put, 3, 3, 0,
2767 "Set one property of overlay OVERLAY: give property PROP value VALUE.")
2768 (overlay, prop, value)
2769 Lisp_Object overlay, prop, value;
2770{
48e2e3ba 2771 Lisp_Object tail, buffer;
9d7608b7 2772 int changed;
2eec3b4e 2773
52f8ec73 2774 CHECK_OVERLAY (overlay, 0);
b61982dd 2775
274a9425
RS
2776 buffer = Fmarker_buffer (OVERLAY_START (overlay));
2777
48e2e3ba 2778 for (tail = XOVERLAY (overlay)->plist;
2eec3b4e
RS
2779 CONSP (tail) && CONSP (XCONS (tail)->cdr);
2780 tail = XCONS (XCONS (tail)->cdr)->cdr)
274a9425
RS
2781 if (EQ (XCONS (tail)->car, prop))
2782 {
9d7608b7
KH
2783 changed = !EQ (XCONS (XCONS (tail)->cdr)->car, value);
2784 XCONS (XCONS (tail)->cdr)->car = value;
2785 goto found;
274a9425 2786 }
9d7608b7
KH
2787 /* It wasn't in the list, so add it to the front. */
2788 changed = !NILP (value);
48e2e3ba
KH
2789 XOVERLAY (overlay)->plist
2790 = Fcons (prop, Fcons (value, XOVERLAY (overlay)->plist));
9d7608b7
KH
2791 found:
2792 if (! NILP (buffer))
2793 {
2794 if (changed)
2795 redisplay_region (XBUFFER (buffer),
2796 marker_position (OVERLAY_START (overlay)),
2797 marker_position (OVERLAY_END (overlay)));
2798 if (EQ (prop, Qevaporate) && ! NILP (value)
2799 && (OVERLAY_POSITION (OVERLAY_START (overlay))
2800 == OVERLAY_POSITION (OVERLAY_END (overlay))))
2801 Fdelete_overlay (overlay);
2802 }
2eec3b4e 2803 return value;
1ab256cb
RM
2804}
2805\f
173f2a64
RS
2806/* Run the modification-hooks of overlays that include
2807 any part of the text in START to END.
2808 Run the insert-before-hooks of overlay starting at END,
930a9140
RS
2809 and the insert-after-hooks of overlay ending at START.
2810
2811 This is called both before and after the modification.
2812 AFTER is nonzero when we call after the modification.
2813
2814 ARG1, ARG2, ARG3 are arguments to pass to the hook functions. */
173f2a64
RS
2815
2816void
930a9140 2817report_overlay_modification (start, end, after, arg1, arg2, arg3)
173f2a64 2818 Lisp_Object start, end;
930a9140
RS
2819 int after;
2820 Lisp_Object arg1, arg2, arg3;
173f2a64
RS
2821{
2822 Lisp_Object prop, overlay, tail;
2823 int insertion = EQ (start, end);
55b48893 2824 int tail_copied;
930a9140 2825 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
55b48893
RS
2826
2827 overlay = Qnil;
2828 tail = Qnil;
930a9140 2829 GCPRO5 (overlay, tail, arg1, arg2, arg3);
173f2a64 2830
55b48893 2831 tail_copied = 0;
173f2a64
RS
2832 for (tail = current_buffer->overlays_before;
2833 CONSP (tail);
2834 tail = XCONS (tail)->cdr)
2835 {
2836 int startpos, endpos;
be8b1c6b 2837 Lisp_Object ostart, oend;
173f2a64
RS
2838
2839 overlay = XCONS (tail)->car;
2840
2841 ostart = OVERLAY_START (overlay);
2842 oend = OVERLAY_END (overlay);
2843 endpos = OVERLAY_POSITION (oend);
2844 if (XFASTINT (start) > endpos)
2845 break;
2846 startpos = OVERLAY_POSITION (ostart);
2847 if (XFASTINT (end) == startpos && insertion)
2848 {
2849 prop = Foverlay_get (overlay, Qinsert_in_front_hooks);
5fb5aa33
RS
2850 if (!NILP (prop))
2851 {
2852 /* Copy TAIL in case the hook recenters the overlay lists. */
55b48893
RS
2853 if (!tail_copied)
2854 tail = Fcopy_sequence (tail);
2855 tail_copied = 1;
930a9140 2856 call_overlay_mod_hooks (prop, overlay, after, arg1, arg2, arg3);
5fb5aa33 2857 }
173f2a64
RS
2858 }
2859 if (XFASTINT (start) == endpos && insertion)
2860 {
2861 prop = Foverlay_get (overlay, Qinsert_behind_hooks);
5fb5aa33
RS
2862 if (!NILP (prop))
2863 {
55b48893
RS
2864 if (!tail_copied)
2865 tail = Fcopy_sequence (tail);
2866 tail_copied = 1;
930a9140 2867 call_overlay_mod_hooks (prop, overlay, after, arg1, arg2, arg3);
5fb5aa33 2868 }
173f2a64 2869 }
3bd13e92
KH
2870 /* Test for intersecting intervals. This does the right thing
2871 for both insertion and deletion. */
2872 if (XFASTINT (end) > startpos && XFASTINT (start) < endpos)
173f2a64
RS
2873 {
2874 prop = Foverlay_get (overlay, Qmodification_hooks);
5fb5aa33
RS
2875 if (!NILP (prop))
2876 {
55b48893
RS
2877 if (!tail_copied)
2878 tail = Fcopy_sequence (tail);
2879 tail_copied = 1;
930a9140 2880 call_overlay_mod_hooks (prop, overlay, after, arg1, arg2, arg3);
5fb5aa33 2881 }
173f2a64
RS
2882 }
2883 }
2884
55b48893 2885 tail_copied = 0;
173f2a64
RS
2886 for (tail = current_buffer->overlays_after;
2887 CONSP (tail);
2888 tail = XCONS (tail)->cdr)
2889 {
2890 int startpos, endpos;
be8b1c6b 2891 Lisp_Object ostart, oend;
173f2a64
RS
2892
2893 overlay = XCONS (tail)->car;
2894
2895 ostart = OVERLAY_START (overlay);
2896 oend = OVERLAY_END (overlay);
2897 startpos = OVERLAY_POSITION (ostart);
cdf0b096 2898 endpos = OVERLAY_POSITION (oend);
173f2a64
RS
2899 if (XFASTINT (end) < startpos)
2900 break;
2901 if (XFASTINT (end) == startpos && insertion)
2902 {
2903 prop = Foverlay_get (overlay, Qinsert_in_front_hooks);
5fb5aa33
RS
2904 if (!NILP (prop))
2905 {
55b48893
RS
2906 if (!tail_copied)
2907 tail = Fcopy_sequence (tail);
2908 tail_copied = 1;
930a9140 2909 call_overlay_mod_hooks (prop, overlay, after, arg1, arg2, arg3);
5fb5aa33 2910 }
173f2a64
RS
2911 }
2912 if (XFASTINT (start) == endpos && insertion)
2913 {
2914 prop = Foverlay_get (overlay, Qinsert_behind_hooks);
5fb5aa33
RS
2915 if (!NILP (prop))
2916 {
55b48893
RS
2917 if (!tail_copied)
2918 tail = Fcopy_sequence (tail);
2919 tail_copied = 1;
930a9140 2920 call_overlay_mod_hooks (prop, overlay, after, arg1, arg2, arg3);
5fb5aa33 2921 }
173f2a64 2922 }
3bd13e92
KH
2923 /* Test for intersecting intervals. This does the right thing
2924 for both insertion and deletion. */
2925 if (XFASTINT (end) > startpos && XFASTINT (start) < endpos)
173f2a64
RS
2926 {
2927 prop = Foverlay_get (overlay, Qmodification_hooks);
5fb5aa33
RS
2928 if (!NILP (prop))
2929 {
55b48893
RS
2930 if (!tail_copied)
2931 tail = Fcopy_sequence (tail);
2932 tail_copied = 1;
930a9140 2933 call_overlay_mod_hooks (prop, overlay, after, arg1, arg2, arg3);
5fb5aa33 2934 }
173f2a64
RS
2935 }
2936 }
55b48893
RS
2937
2938 UNGCPRO;
173f2a64
RS
2939}
2940
2941static void
930a9140
RS
2942call_overlay_mod_hooks (list, overlay, after, arg1, arg2, arg3)
2943 Lisp_Object list, overlay;
2944 int after;
2945 Lisp_Object arg1, arg2, arg3;
173f2a64 2946{
930a9140
RS
2947 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
2948 GCPRO4 (list, arg1, arg2, arg3);
173f2a64
RS
2949 while (!NILP (list))
2950 {
930a9140
RS
2951 if (NILP (arg3))
2952 call4 (Fcar (list), overlay, after ? Qt : Qnil, arg1, arg2);
2953 else
2954 call5 (Fcar (list), overlay, after ? Qt : Qnil, arg1, arg2, arg3);
173f2a64
RS
2955 list = Fcdr (list);
2956 }
2957 UNGCPRO;
2958}
9d7608b7
KH
2959
2960/* Delete any zero-sized overlays at position POS, if the `evaporate'
2961 property is set. */
2962void
2963evaporate_overlays (pos)
2964 int pos;
2965{
2966 Lisp_Object tail, overlay, hit_list;
2967
2968 hit_list = Qnil;
2969 if (pos <= XFASTINT (current_buffer->overlay_center))
2970 for (tail = current_buffer->overlays_before; CONSP (tail);
2971 tail = XCONS (tail)->cdr)
2972 {
2973 int endpos;
2974 overlay = XCONS (tail)->car;
2975 endpos = OVERLAY_POSITION (OVERLAY_END (overlay));
2976 if (endpos < pos)
2977 break;
2978 if (endpos == pos && OVERLAY_POSITION (OVERLAY_START (overlay)) == pos
c3935f9d 2979 && ! NILP (Foverlay_get (overlay, Qevaporate)))
9d7608b7
KH
2980 hit_list = Fcons (overlay, hit_list);
2981 }
2982 else
2983 for (tail = current_buffer->overlays_after; CONSP (tail);
2984 tail = XCONS (tail)->cdr)
2985 {
2986 int startpos;
889bf329 2987 overlay = XCONS (tail)->car;
9d7608b7
KH
2988 startpos = OVERLAY_POSITION (OVERLAY_START (overlay));
2989 if (startpos > pos)
2990 break;
2991 if (startpos == pos && OVERLAY_POSITION (OVERLAY_END (overlay)) == pos
c3935f9d 2992 && ! NILP (Foverlay_get (overlay, Qevaporate)))
9d7608b7
KH
2993 hit_list = Fcons (overlay, hit_list);
2994 }
2995 for (; CONSP (hit_list); hit_list = XCONS (hit_list)->cdr)
2996 Fdelete_overlay (XCONS (hit_list)->car);
2997}
173f2a64 2998\f
54dfdeb0
KH
2999/* Somebody has tried to store a value with an unacceptable type
3000 into the buffer-local slot with offset OFFSET. */
0fa3ba92 3001void
54dfdeb0
KH
3002buffer_slot_type_mismatch (offset)
3003 int offset;
0fa3ba92 3004{
54dfdeb0 3005 Lisp_Object sym;
0fa3ba92 3006 char *type_name;
54dfdeb0 3007 sym = *(Lisp_Object *)(offset + (char *)&buffer_local_symbols);
0fa3ba92
JB
3008 switch (XINT (*(Lisp_Object *)(offset + (char *)&buffer_local_types)))
3009 {
3010 case Lisp_Int: type_name = "integers"; break;
3011 case Lisp_String: type_name = "strings"; break;
0fa3ba92 3012 case Lisp_Symbol: type_name = "symbols"; break;
0fa3ba92
JB
3013 default:
3014 abort ();
3015 }
3016
3017 error ("only %s should be stored in the buffer-local variable %s",
54dfdeb0 3018 type_name, XSYMBOL (sym)->name->data);
0fa3ba92
JB
3019}
3020\f
1ab256cb
RM
3021init_buffer_once ()
3022{
3023 register Lisp_Object tem;
3024
3025 /* Make sure all markable slots in buffer_defaults
3026 are initialized reasonably, so mark_buffer won't choke. */
3027 reset_buffer (&buffer_defaults);
bcd40520 3028 reset_buffer_local_variables (&buffer_defaults);
1ab256cb 3029 reset_buffer (&buffer_local_symbols);
bcd40520 3030 reset_buffer_local_variables (&buffer_local_symbols);
336cd056
RS
3031 /* Prevent GC from getting confused. */
3032 buffer_defaults.text = &buffer_defaults.own_text;
3033 buffer_local_symbols.text = &buffer_local_symbols.own_text;
3034#ifdef USE_TEXT_PROPERTIES
3035 BUF_INTERVALS (&buffer_defaults) = 0;
3036 BUF_INTERVALS (&buffer_local_symbols) = 0;
3037#endif
67180c6a
KH
3038 XSETBUFFER (Vbuffer_defaults, &buffer_defaults);
3039 XSETBUFFER (Vbuffer_local_symbols, &buffer_local_symbols);
1ab256cb
RM
3040
3041 /* Set up the default values of various buffer slots. */
3042 /* Must do these before making the first buffer! */
3043
3044 /* real setup is done in loaddefs.el */
3045 buffer_defaults.mode_line_format = build_string ("%-");
3046 buffer_defaults.abbrev_mode = Qnil;
3047 buffer_defaults.overwrite_mode = Qnil;
3048 buffer_defaults.case_fold_search = Qt;
3049 buffer_defaults.auto_fill_function = Qnil;
3050 buffer_defaults.selective_display = Qnil;
3051#ifndef old
3052 buffer_defaults.selective_display_ellipses = Qt;
3053#endif
3054 buffer_defaults.abbrev_table = Qnil;
3055 buffer_defaults.display_table = Qnil;
1ab256cb 3056 buffer_defaults.undo_list = Qnil;
c48f61ef 3057 buffer_defaults.mark_active = Qnil;
be9aafdd 3058 buffer_defaults.file_format = Qnil;
2eec3b4e
RS
3059 buffer_defaults.overlays_before = Qnil;
3060 buffer_defaults.overlays_after = Qnil;
bbbe9545 3061 XSETFASTINT (buffer_defaults.overlay_center, BEG);
1ab256cb 3062
8d7a4592 3063 XSETFASTINT (buffer_defaults.tab_width, 8);
1ab256cb
RM
3064 buffer_defaults.truncate_lines = Qnil;
3065 buffer_defaults.ctl_arrow = Qt;
3066
f7975d07 3067#ifdef DOS_NT
0776cb1b 3068 buffer_defaults.buffer_file_type = Qnil; /* TEXT */
54ad07d3 3069#endif
8d7a4592
KH
3070 XSETFASTINT (buffer_defaults.fill_column, 70);
3071 XSETFASTINT (buffer_defaults.left_margin, 0);
28e969dd 3072 buffer_defaults.cache_long_line_scans = Qnil;
f6ed2e84 3073 buffer_defaults.file_truename = Qnil;
1ab256cb
RM
3074
3075 /* Assign the local-flags to the slots that have default values.
3076 The local flag is a bit that is used in the buffer
3077 to say that it has its own local value for the slot.
3078 The local flag bits are in the local_var_flags slot of the buffer. */
3079
3080 /* Nothing can work if this isn't true */
4d2f1389 3081 if (sizeof (EMACS_INT) != sizeof (Lisp_Object)) abort ();
1ab256cb
RM
3082
3083 /* 0 means not a lisp var, -1 means always local, else mask */
3084 bzero (&buffer_local_flags, sizeof buffer_local_flags);
aab80822
KH
3085 XSETINT (buffer_local_flags.filename, -1);
3086 XSETINT (buffer_local_flags.directory, -1);
3087 XSETINT (buffer_local_flags.backed_up, -1);
3088 XSETINT (buffer_local_flags.save_length, -1);
3089 XSETINT (buffer_local_flags.auto_save_file_name, -1);
3090 XSETINT (buffer_local_flags.read_only, -1);
3091 XSETINT (buffer_local_flags.major_mode, -1);
3092 XSETINT (buffer_local_flags.mode_name, -1);
3093 XSETINT (buffer_local_flags.undo_list, -1);
3094 XSETINT (buffer_local_flags.mark_active, -1);
943e065b 3095 XSETINT (buffer_local_flags.point_before_scroll, -1);
f6ed2e84 3096 XSETINT (buffer_local_flags.file_truename, -1);
3cb719bd 3097 XSETINT (buffer_local_flags.invisibility_spec, -1);
8d7a4592
KH
3098
3099 XSETFASTINT (buffer_local_flags.mode_line_format, 1);
3100 XSETFASTINT (buffer_local_flags.abbrev_mode, 2);
3101 XSETFASTINT (buffer_local_flags.overwrite_mode, 4);
3102 XSETFASTINT (buffer_local_flags.case_fold_search, 8);
3103 XSETFASTINT (buffer_local_flags.auto_fill_function, 0x10);
3104 XSETFASTINT (buffer_local_flags.selective_display, 0x20);
1ab256cb 3105#ifndef old
8d7a4592 3106 XSETFASTINT (buffer_local_flags.selective_display_ellipses, 0x40);
1ab256cb 3107#endif
8d7a4592
KH
3108 XSETFASTINT (buffer_local_flags.tab_width, 0x80);
3109 XSETFASTINT (buffer_local_flags.truncate_lines, 0x100);
3110 XSETFASTINT (buffer_local_flags.ctl_arrow, 0x200);
3111 XSETFASTINT (buffer_local_flags.fill_column, 0x400);
3112 XSETFASTINT (buffer_local_flags.left_margin, 0x800);
3113 XSETFASTINT (buffer_local_flags.abbrev_table, 0x1000);
3114 XSETFASTINT (buffer_local_flags.display_table, 0x2000);
3115 XSETFASTINT (buffer_local_flags.syntax_table, 0x8000);
28e969dd 3116 XSETFASTINT (buffer_local_flags.cache_long_line_scans, 0x10000);
be9aafdd 3117 XSETFASTINT (buffer_local_flags.file_format, 0x20000);
f7975d07 3118#ifdef DOS_NT
8d7a4592 3119 XSETFASTINT (buffer_local_flags.buffer_file_type, 0x4000);
54ad07d3 3120#endif
1ab256cb
RM
3121
3122 Vbuffer_alist = Qnil;
3123 current_buffer = 0;
3124 all_buffers = 0;
3125
3126 QSFundamental = build_string ("Fundamental");
3127
3128 Qfundamental_mode = intern ("fundamental-mode");
3129 buffer_defaults.major_mode = Qfundamental_mode;
3130
3131 Qmode_class = intern ("mode-class");
3132
3133 Qprotected_field = intern ("protected-field");
3134
3135 Qpermanent_local = intern ("permanent-local");
3136
3137 Qkill_buffer_hook = intern ("kill-buffer-hook");
3138
3139 Vprin1_to_string_buffer = Fget_buffer_create (build_string (" prin1"));
3140 /* super-magic invisible buffer */
3141 Vbuffer_alist = Qnil;
3142
ffd56f97 3143 Fset_buffer (Fget_buffer_create (build_string ("*scratch*")));
1ab256cb
RM
3144}
3145
3146init_buffer ()
3147{
3148 char buf[MAXPATHLEN+1];
2381d133
JB
3149 char *pwd;
3150 struct stat dotstat, pwdstat;
136351b7 3151 Lisp_Object temp;
f7975d07 3152 int rc;
1ab256cb
RM
3153
3154 Fset_buffer (Fget_buffer_create (build_string ("*scratch*")));
2381d133
JB
3155
3156 /* If PWD is accurate, use it instead of calling getwd. This is faster
3157 when PWD is right, and may avoid a fatal error. */
f7975d07 3158 if ((pwd = getenv ("PWD")) != 0 && IS_DIRECTORY_SEP (*pwd)
2381d133
JB
3159 && stat (pwd, &pwdstat) == 0
3160 && stat (".", &dotstat) == 0
3161 && dotstat.st_ino == pwdstat.st_ino
3162 && dotstat.st_dev == pwdstat.st_dev
3163 && strlen (pwd) < MAXPATHLEN)
3164 strcpy (buf, pwd);
3165 else if (getwd (buf) == 0)
cf1e6391 3166 fatal ("`getwd' failed: %s\n", buf);
1ab256cb
RM
3167
3168#ifndef VMS
3169 /* Maybe this should really use some standard subroutine
3170 whose definition is filename syntax dependent. */
f7975d07
RS
3171 rc = strlen (buf);
3172 if (!(IS_DIRECTORY_SEP (buf[rc - 1])))
3173 {
3174 buf[rc] = DIRECTORY_SEP;
3175 buf[rc + 1] = '\0';
3176 }
1ab256cb
RM
3177#endif /* not VMS */
3178 current_buffer->directory = build_string (buf);
136351b7
RS
3179
3180 temp = get_minibuffer (0);
3181 XBUFFER (temp)->directory = current_buffer->directory;
1ab256cb
RM
3182}
3183
3184/* initialize the buffer routines */
3185syms_of_buffer ()
3186{
188d4d11
RM
3187 extern Lisp_Object Qdisabled;
3188
1ab256cb
RM
3189 staticpro (&Vbuffer_defaults);
3190 staticpro (&Vbuffer_local_symbols);
3191 staticpro (&Qfundamental_mode);
3192 staticpro (&Qmode_class);
3193 staticpro (&QSFundamental);
3194 staticpro (&Vbuffer_alist);
3195 staticpro (&Qprotected_field);
3196 staticpro (&Qpermanent_local);
3197 staticpro (&Qkill_buffer_hook);
52f8ec73 3198 staticpro (&Qoverlayp);
9d7608b7
KH
3199 Qevaporate = intern ("evaporate");
3200 staticpro (&Qevaporate);
294d215f
RS
3201 staticpro (&Qmodification_hooks);
3202 Qmodification_hooks = intern ("modification-hooks");
3203 staticpro (&Qinsert_in_front_hooks);
3204 Qinsert_in_front_hooks = intern ("insert-in-front-hooks");
3205 staticpro (&Qinsert_behind_hooks);
3206 Qinsert_behind_hooks = intern ("insert-behind-hooks");
5fe0b67e
RS
3207 staticpro (&Qget_file_buffer);
3208 Qget_file_buffer = intern ("get-file-buffer");
5985d248
KH
3209 Qpriority = intern ("priority");
3210 staticpro (&Qpriority);
3211 Qwindow = intern ("window");
3212 staticpro (&Qwindow);
bbbe9545
KH
3213 Qbefore_string = intern ("before-string");
3214 staticpro (&Qbefore_string);
3215 Qafter_string = intern ("after-string");
3216 staticpro (&Qafter_string);
52f8ec73
JB
3217
3218 Qoverlayp = intern ("overlayp");
1ab256cb
RM
3219
3220 Fput (Qprotected_field, Qerror_conditions,
3221 Fcons (Qprotected_field, Fcons (Qerror, Qnil)));
3222 Fput (Qprotected_field, Qerror_message,
3223 build_string ("Attempt to modify a protected field"));
3224
3225 /* All these use DEFVAR_LISP_NOPRO because the slots in
3226 buffer_defaults will all be marked via Vbuffer_defaults. */
3227
3228 DEFVAR_LISP_NOPRO ("default-mode-line-format",
3229 &buffer_defaults.mode_line_format,
3230 "Default value of `mode-line-format' for buffers that don't override it.\n\
3231This is the same as (default-value 'mode-line-format).");
3232
3233 DEFVAR_LISP_NOPRO ("default-abbrev-mode",
3234 &buffer_defaults.abbrev_mode,
3235 "Default value of `abbrev-mode' for buffers that do not override it.\n\
3236This is the same as (default-value 'abbrev-mode).");
3237
3238 DEFVAR_LISP_NOPRO ("default-ctl-arrow",
3239 &buffer_defaults.ctl_arrow,
3240 "Default value of `ctl-arrow' for buffers that do not override it.\n\
3241This is the same as (default-value 'ctl-arrow).");
3242
3243 DEFVAR_LISP_NOPRO ("default-truncate-lines",
3244 &buffer_defaults.truncate_lines,
3245 "Default value of `truncate-lines' for buffers that do not override it.\n\
3246This is the same as (default-value 'truncate-lines).");
3247
3248 DEFVAR_LISP_NOPRO ("default-fill-column",
3249 &buffer_defaults.fill_column,
3250 "Default value of `fill-column' for buffers that do not override it.\n\
3251This is the same as (default-value 'fill-column).");
3252
3253 DEFVAR_LISP_NOPRO ("default-left-margin",
3254 &buffer_defaults.left_margin,
3255 "Default value of `left-margin' for buffers that do not override it.\n\
3256This is the same as (default-value 'left-margin).");
3257
3258 DEFVAR_LISP_NOPRO ("default-tab-width",
3259 &buffer_defaults.tab_width,
3260 "Default value of `tab-width' for buffers that do not override it.\n\
3261This is the same as (default-value 'tab-width).");
3262
3263 DEFVAR_LISP_NOPRO ("default-case-fold-search",
3264 &buffer_defaults.case_fold_search,
3265 "Default value of `case-fold-search' for buffers that don't override it.\n\
3266This is the same as (default-value 'case-fold-search).");
3267
f7975d07 3268#ifdef DOS_NT
54ad07d3
RS
3269 DEFVAR_LISP_NOPRO ("default-buffer-file-type",
3270 &buffer_defaults.buffer_file_type,
3271 "Default file type for buffers that do not override it.\n\
3272This is the same as (default-value 'buffer-file-type).\n\
3273The file type is nil for text, t for binary.");
3274#endif
3275
0fa3ba92
JB
3276 DEFVAR_PER_BUFFER ("mode-line-format", &current_buffer->mode_line_format,
3277 Qnil, 0);
1ab256cb
RM
3278
3279/* This doc string is too long for cpp; cpp dies if it isn't in a comment.
3280 But make-docfile finds it!
3281 DEFVAR_PER_BUFFER ("mode-line-format", &current_buffer->mode_line_format,
bec44fd6 3282 Qnil,
1ab256cb
RM
3283 "Template for displaying mode line for current buffer.\n\
3284Each buffer has its own value of this variable.\n\
3285Value may be a string, a symbol or a list or cons cell.\n\
3286For a symbol, its value is used (but it is ignored if t or nil).\n\
3287 A string appearing directly as the value of a symbol is processed verbatim\n\
3288 in that the %-constructs below are not recognized.\n\
3289For a list whose car is a symbol, the symbol's value is taken,\n\
3290 and if that is non-nil, the cadr of the list is processed recursively.\n\
3291 Otherwise, the caddr of the list (if there is one) is processed.\n\
3292For a list whose car is a string or list, each element is processed\n\
3293 recursively and the results are effectively concatenated.\n\
3294For a list whose car is an integer, the cdr of the list is processed\n\
3295 and padded (if the number is positive) or truncated (if negative)\n\
3296 to the width specified by that number.\n\
3297A string is printed verbatim in the mode line except for %-constructs:\n\
3298 (%-constructs are allowed when the string is the entire mode-line-format\n\
3299 or when it is found in a cons-cell or a list)\n\
3300 %b -- print buffer name. %f -- print visited file name.\n\
c2ff34f7
RS
3301 %* -- print %, * or hyphen. %+ -- print *, % or hyphen.\n\
3302 % means buffer is read-only and * means it is modified.\n\
3303 For a modified read-only buffer, %* gives % and %+ gives *.\n\
a97c374a 3304 %s -- print process status. %l -- print the current line number.\n\
dd24e6a6 3305 %p -- print percent of buffer above top of window, or Top, Bot or All.\n\
9d130ffc 3306 %P -- print percent of buffer above bottom of window, perhaps plus Top,\n\
dd24e6a6 3307 or print Bottom or All.\n\
1ab256cb 3308 %n -- print Narrow if appropriate.\n\
54ad07d3 3309 %t -- print T if files is text, B if binary.\n\
1ab256cb
RM
3310 %[ -- print one [ for each recursive editing level. %] similar.\n\
3311 %% -- print %. %- -- print infinitely many dashes.\n\
3312Decimal digits after the % specify field width to which to pad.");
3313*/
3314
3315 DEFVAR_LISP_NOPRO ("default-major-mode", &buffer_defaults.major_mode,
3316 "*Major mode for new buffers. Defaults to `fundamental-mode'.\n\
3317nil here means use current buffer's major mode.");
3318
3319 DEFVAR_PER_BUFFER ("major-mode", &current_buffer->major_mode,
0fa3ba92 3320 make_number (Lisp_Symbol),
1ab256cb
RM
3321 "Symbol for current buffer's major mode.");
3322
3323 DEFVAR_PER_BUFFER ("mode-name", &current_buffer->mode_name,
0fa3ba92 3324 make_number (Lisp_String),
1ab256cb
RM
3325 "Pretty name of current buffer's major mode (a string).");
3326
0fa3ba92 3327 DEFVAR_PER_BUFFER ("abbrev-mode", &current_buffer->abbrev_mode, Qnil,
1ab256cb
RM
3328 "Non-nil turns on automatic expansion of abbrevs as they are inserted.\n\
3329Automatically becomes buffer-local when set in any fashion.");
3330
3331 DEFVAR_PER_BUFFER ("case-fold-search", &current_buffer->case_fold_search,
0fa3ba92 3332 Qnil,
1ab256cb
RM
3333 "*Non-nil if searches should ignore case.\n\
3334Automatically becomes buffer-local when set in any fashion.");
3335
3336 DEFVAR_PER_BUFFER ("fill-column", &current_buffer->fill_column,
0fa3ba92 3337 make_number (Lisp_Int),
1ab256cb
RM
3338 "*Column beyond which automatic line-wrapping should happen.\n\
3339Automatically becomes buffer-local when set in any fashion.");
3340
3341 DEFVAR_PER_BUFFER ("left-margin", &current_buffer->left_margin,
0fa3ba92 3342 make_number (Lisp_Int),
1ab256cb
RM
3343 "*Column for the default indent-line-function to indent to.\n\
3344Linefeed indents to this column in Fundamental mode.\n\
3345Automatically becomes buffer-local when set in any fashion.");
3346
3347 DEFVAR_PER_BUFFER ("tab-width", &current_buffer->tab_width,
0fa3ba92 3348 make_number (Lisp_Int),
1ab256cb
RM
3349 "*Distance between tab stops (for display of tab characters), in columns.\n\
3350Automatically becomes buffer-local when set in any fashion.");
3351
0fa3ba92 3352 DEFVAR_PER_BUFFER ("ctl-arrow", &current_buffer->ctl_arrow, Qnil,
1ab256cb
RM
3353 "*Non-nil means display control chars with uparrow.\n\
3354Nil means use backslash and octal digits.\n\
3355Automatically becomes buffer-local when set in any fashion.\n\
3356This variable does not apply to characters whose display is specified\n\
3357in the current display table (if there is one).");
3358
0fa3ba92 3359 DEFVAR_PER_BUFFER ("truncate-lines", &current_buffer->truncate_lines, Qnil,
1ab256cb
RM
3360 "*Non-nil means do not display continuation lines;\n\
3361give each line of text one screen line.\n\
3362Automatically becomes buffer-local when set in any fashion.\n\
3363\n\
3364Note that this is overridden by the variable\n\
3365`truncate-partial-width-windows' if that variable is non-nil\n\
502b9b64 3366and this buffer is not full-frame width.");
1ab256cb 3367
f7975d07 3368#ifdef DOS_NT
54ad07d3
RS
3369 DEFVAR_PER_BUFFER ("buffer-file-type", &current_buffer->buffer_file_type,
3370 Qnil,
006d3d34
RS
3371 "Non-nil if the visited file is a binary file.\n\
3372This variable is meaningful on MS-DOG and Windows NT.\n\
3373On those systems, it is automatically local in every buffer.\n\
e0585c64 3374On other systems, this variable is normally always nil.");
54ad07d3
RS
3375#endif
3376
1ab256cb 3377 DEFVAR_PER_BUFFER ("default-directory", &current_buffer->directory,
0fa3ba92 3378 make_number (Lisp_String),
1ab256cb
RM
3379 "Name of default directory of current buffer. Should end with slash.\n\
3380Each buffer has its own value of this variable.");
3381
3382 DEFVAR_PER_BUFFER ("auto-fill-function", &current_buffer->auto_fill_function,
0fa3ba92 3383 Qnil,
1ab256cb
RM
3384 "Function called (if non-nil) to perform auto-fill.\n\
3385It is called after self-inserting a space at a column beyond `fill-column'.\n\
3386Each buffer has its own value of this variable.\n\
3387NOTE: This variable is not an ordinary hook;\n\
3388It may not be a list of functions.");
3389
3390 DEFVAR_PER_BUFFER ("buffer-file-name", &current_buffer->filename,
0fa3ba92 3391 make_number (Lisp_String),
1ab256cb
RM
3392 "Name of file visited in current buffer, or nil if not visiting a file.\n\
3393Each buffer has its own value of this variable.");
3394
f6ed2e84
RS
3395 DEFVAR_PER_BUFFER ("buffer-file-truename", &current_buffer->file_truename,
3396 make_number (Lisp_String),
3397 "Truename of file visited in current buffer, or nil if not visiting a file.\n\
b1c03e64
RS
3398The truename of a file is calculated by `file-truename'\n\
3399and then abbreviated with `abbreviate-file-name'.\n\
f6ed2e84
RS
3400Each buffer has its own value of this variable.");
3401
1ab256cb 3402 DEFVAR_PER_BUFFER ("buffer-auto-save-file-name",
3f5fcd47 3403 &current_buffer->auto_save_file_name,
0fa3ba92 3404 make_number (Lisp_String),
1ab256cb
RM
3405 "Name of file for auto-saving current buffer,\n\
3406or nil if buffer should not be auto-saved.\n\
3407Each buffer has its own value of this variable.");
3408
0fa3ba92 3409 DEFVAR_PER_BUFFER ("buffer-read-only", &current_buffer->read_only, Qnil,
1ab256cb
RM
3410 "Non-nil if this buffer is read-only.\n\
3411Each buffer has its own value of this variable.");
3412
0fa3ba92 3413 DEFVAR_PER_BUFFER ("buffer-backed-up", &current_buffer->backed_up, Qnil,
1ab256cb
RM
3414 "Non-nil if this buffer's file has been backed up.\n\
3415Backing up is done before the first time the file is saved.\n\
3416Each buffer has its own value of this variable.");
3417
3418 DEFVAR_PER_BUFFER ("buffer-saved-size", &current_buffer->save_length,
0fa3ba92 3419 make_number (Lisp_Int),
1ab256cb
RM
3420 "Length of current buffer when last read in, saved or auto-saved.\n\
34210 initially.\n\
3422Each buffer has its own value of this variable.");
3423
3424 DEFVAR_PER_BUFFER ("selective-display", &current_buffer->selective_display,
0fa3ba92 3425 Qnil,
1ab256cb
RM
3426 "Non-nil enables selective display:\n\
3427Integer N as value means display only lines\n\
3428 that start with less than n columns of space.\n\
3429A value of t means, after a ^M, all the rest of the line is invisible.\n\
3430 Then ^M's in the file are written into files as newlines.\n\n\
3431Automatically becomes buffer-local when set in any fashion.");
3432
3433#ifndef old
3434 DEFVAR_PER_BUFFER ("selective-display-ellipses",
3435 &current_buffer->selective_display_ellipses,
0fa3ba92 3436 Qnil,
1ab256cb
RM
3437 "t means display ... on previous line when a line is invisible.\n\
3438Automatically becomes buffer-local when set in any fashion.");
3439#endif
3440
0fa3ba92 3441 DEFVAR_PER_BUFFER ("overwrite-mode", &current_buffer->overwrite_mode, Qnil,
1ab256cb 3442 "Non-nil if self-insertion should replace existing text.\n\
5e05d0a5
RS
3443The value should be one of `overwrite-mode-textual',\n\
3444`overwrite-mode-binary', or nil.\n\
3445If it is `overwrite-mode-textual', self-insertion still\n\
6bbb0d4a 3446inserts at the end of a line, and inserts when point is before a tab,\n\
2e94b813 3447until the tab is filled in.\n\
6bbb0d4a 3448If `overwrite-mode-binary', self-insertion replaces newlines and tabs too.\n\
1ab256cb
RM
3449Automatically becomes buffer-local when set in any fashion.");
3450
54939090
RS
3451#if 0 /* The doc string is too long for some compilers,
3452 but make-docfile can find it in this comment. */
1ab256cb 3453 DEFVAR_PER_BUFFER ("buffer-display-table", &current_buffer->display_table,
5d305367 3454 Qnil,
1ab256cb
RM
3455 "Display table that controls display of the contents of current buffer.\n\
3456Automatically becomes buffer-local when set in any fashion.\n\
3457The display table is a vector created with `make-display-table'.\n\
3458The first 256 elements control how to display each possible text character.\n\
6158b3b0 3459Each value should be a vector of characters or nil;\n\
1ab256cb 3460nil means display the character in the default fashion.\n\
a45e35e1 3461The remaining six elements control the display of\n\
6158b3b0
JB
3462 the end of a truncated screen line (element 256, a single character);\n\
3463 the end of a continued line (element 257, a single character);\n\
3464 the escape character used to display character codes in octal\n\
3465 (element 258, a single character);\n\
3466 the character used as an arrow for control characters (element 259,\n\
3467 a single character);\n\
3468 the decoration indicating the presence of invisible lines (element 260,\n\
a45e35e1
JB
3469 a vector of characters);\n\
3470 the character used to draw the border between side-by-side windows\n\
3402827c 3471 (element 261, a single character).\n\
1ab256cb
RM
3472If this variable is nil, the value of `standard-display-table' is used.\n\
3473Each window can have its own, overriding display table.");
54939090
RS
3474#endif
3475 DEFVAR_PER_BUFFER ("buffer-display-table", &current_buffer->display_table,
de15914a 3476 Qnil, 0);
1ab256cb 3477
1ab256cb
RM
3478/*DEFVAR_LISP ("debug-check-symbol", &Vcheck_symbol,
3479 "Don't ask.");
3480*/
01050cb5 3481 DEFVAR_LISP ("before-change-function", &Vbefore_change_function,
1ab256cb
RM
3482 "Function to call before each text change.\n\
3483Two arguments are passed to the function: the positions of\n\
3484the beginning and end of the range of old text to be changed.\n\
3485\(For an insertion, the beginning and end are at the same place.)\n\
3486No information is given about the length of the text after the change.\n\
1ab256cb 3487\n\
5f079267 3488Buffer changes made while executing the `before-change-function'\n\
b86344d0
RS
3489don't call any before-change or after-change functions.\n\
3490That's because these variables are temporarily set to nil.\n\
3491As a result, a hook function cannot straightforwardly alter the value of\n\
3492these variables. See the Emacs Lisp manual for a way of\n\
d59698c4 3493accomplishing an equivalent result by using other variables.");
1ab256cb
RM
3494 Vbefore_change_function = Qnil;
3495
3496 DEFVAR_LISP ("after-change-function", &Vafter_change_function,
3497 "Function to call after each text change.\n\
3498Three arguments are passed to the function: the positions of\n\
3499the beginning and end of the range of changed text,\n\
3500and the length of the pre-change text replaced by that range.\n\
3501\(For an insertion, the pre-change length is zero;\n\
3502for a deletion, that length is the number of characters deleted,\n\
3503and the post-change beginning and end are at the same place.)\n\
3504\n\
5f079267 3505Buffer changes made while executing the `after-change-function'\n\
b86344d0
RS
3506don't call any before-change or after-change functions.\n\
3507That's because these variables are temporarily set to nil.\n\
3508As a result, a hook function cannot straightforwardly alter the value of\n\
3509these variables. See the Emacs Lisp manual for a way of\n\
d59698c4 3510accomplishing an equivalent result by using other variables.");
1ab256cb
RM
3511 Vafter_change_function = Qnil;
3512
5f079267
RS
3513 DEFVAR_LISP ("before-change-functions", &Vbefore_change_functions,
3514 "List of functions to call before each text change.\n\
3515Two arguments are passed to each function: the positions of\n\
3516the beginning and end of the range of old text to be changed.\n\
3517\(For an insertion, the beginning and end are at the same place.)\n\
3518No information is given about the length of the text after the change.\n\
5f079267
RS
3519\n\
3520Buffer changes made while executing the `before-change-functions'\n\
b86344d0
RS
3521don't call any before-change or after-change functions.\n\
3522That's because these variables are temporarily set to nil.\n\
3523As a result, a hook function cannot straightforwardly alter the value of\n\
3524these variables. See the Emacs Lisp manual for a way of\n\
d59698c4 3525accomplishing an equivalent result by using other variables.");
5f079267
RS
3526 Vbefore_change_functions = Qnil;
3527
3528 DEFVAR_LISP ("after-change-functions", &Vafter_change_functions,
3529 "List of function to call after each text change.\n\
3530Three arguments are passed to each function: the positions of\n\
3531the beginning and end of the range of changed text,\n\
3532and the length of the pre-change text replaced by that range.\n\
3533\(For an insertion, the pre-change length is zero;\n\
3534for a deletion, that length is the number of characters deleted,\n\
3535and the post-change beginning and end are at the same place.)\n\
3536\n\
3537Buffer changes made while executing the `after-change-functions'\n\
b86344d0
RS
3538don't call any before-change or after-change functions.\n\
3539That's because these variables are temporarily set to nil.\n\
3540As a result, a hook function cannot straightforwardly alter the value of\n\
3541these variables. See the Emacs Lisp manual for a way of\n\
d59698c4 3542accomplishing an equivalent result by using other variables.");
b86344d0 3543
5f079267
RS
3544 Vafter_change_functions = Qnil;
3545
dbc4e1c1
JB
3546 DEFVAR_LISP ("first-change-hook", &Vfirst_change_hook,
3547 "A list of functions to call before changing a buffer which is unmodified.\n\
3548The functions are run using the `run-hooks' function.");
3549 Vfirst_change_hook = Qnil;
3550 Qfirst_change_hook = intern ("first-change-hook");
3551 staticpro (&Qfirst_change_hook);
1ab256cb 3552
54939090
RS
3553#if 0 /* The doc string is too long for some compilers,
3554 but make-docfile can find it in this comment. */
3f5fcd47 3555 DEFVAR_PER_BUFFER ("buffer-undo-list", &current_buffer->undo_list, Qnil,
1ab256cb
RM
3556 "List of undo entries in current buffer.\n\
3557Recent changes come first; older changes follow newer.\n\
3558\n\
630f4018
KH
3559An entry (BEG . END) represents an insertion which begins at\n\
3560position BEG and ends at position END.\n\
1ab256cb
RM
3561\n\
3562An entry (TEXT . POSITION) represents the deletion of the string TEXT\n\
3563from (abs POSITION). If POSITION is positive, point was at the front\n\
3564of the text being deleted; if negative, point was at the end.\n\
3565\n\
6c0df54a
RS
3566An entry (t HIGH . LOW) indicates that the buffer previously had\n\
3567\"unmodified\" status. HIGH and LOW are the high and low 16-bit portions\n\
3568of the visited file's modification time, as of that time. If the\n\
3569modification time of the most recent save is different, this entry is\n\
1ab256cb
RM
3570obsolete.\n\
3571\n\
6c0df54a
RS
3572An entry (nil PROPERTY VALUE BEG . END) indicates that a text property\n\
3573was modified between BEG and END. PROPERTY is the property name,\n\
3574and VALUE is the old value.\n\
483c1fd3 3575\n\
bec44fd6
JB
3576An entry of the form POSITION indicates that point was at the buffer\n\
3577location given by the integer. Undoing an entry of this form places\n\
3578point at POSITION.\n\
3579\n\
1ab256cb
RM
3580nil marks undo boundaries. The undo command treats the changes\n\
3581between two undo boundaries as a single step to be undone.\n\
3582\n\
bec44fd6 3583If the value of the variable is t, undo information is not recorded.");
54939090
RS
3584#endif
3585 DEFVAR_PER_BUFFER ("buffer-undo-list", &current_buffer->undo_list, Qnil,
de15914a 3586 0);
1ab256cb 3587
c48f61ef
RS
3588 DEFVAR_PER_BUFFER ("mark-active", &current_buffer->mark_active, Qnil,
3589 "Non-nil means the mark and region are currently active in this buffer.\n\
3590Automatically local in all buffers.");
3591
28e969dd 3592 DEFVAR_PER_BUFFER ("cache-long-line-scans", &current_buffer->cache_long_line_scans, Qnil,
f0c5b712
JB
3593 "Non-nil means that Emacs should use caches to handle long lines more quickly.\n\
3594This variable is buffer-local, in all buffers.\n\
28e969dd 3595\n\
f0c5b712
JB
3596Normally, the line-motion functions work by scanning the buffer for\n\
3597newlines. Columnar operations (like move-to-column and\n\
3598compute-motion) also work by scanning the buffer, summing character\n\
3599widths as they go. This works well for ordinary text, but if the\n\
28e969dd 3600buffer's lines are very long (say, more than 500 characters), these\n\
f0c5b712
JB
3601motion functions will take longer to execute. Emacs may also take\n\
3602longer to update the display.\n\
28e969dd 3603\n\
f0c5b712
JB
3604If cache-long-line-scans is non-nil, these motion functions cache the\n\
3605results of their scans, and consult the cache to avoid rescanning\n\
3606regions of the buffer until the text is modified. The caches are most\n\
3607beneficial when they prevent the most searching---that is, when the\n\
3608buffer contains long lines and large regions of characters with the\n\
3609same, fixed screen width.\n\
28e969dd 3610\n\
f0c5b712
JB
3611When cache-long-line-scans is non-nil, processing short lines will\n\
3612become slightly slower (because of the overhead of consulting the\n\
3613cache), and the caches will use memory roughly proportional to the\n\
3614number of newlines and characters whose screen width varies.\n\
3615\n\
3616The caches require no explicit maintenance; their accuracy is\n\
3617maintained internally by the Emacs primitives. Enabling or disabling\n\
3618the cache should not affect the behavior of any of the motion\n\
3619functions; it should only affect their performance.");
28e969dd 3620
943e065b
RS
3621 DEFVAR_PER_BUFFER ("point-before-scroll", &current_buffer->point_before_scroll, Qnil,
3622 "Value of point before the last series of scroll operations, or nil.");
3623
be9aafdd
BG
3624 DEFVAR_PER_BUFFER ("buffer-file-format", &current_buffer->file_format, Qnil,
3625 "List of formats to use when saving this buffer.\n\
3626Formats are defined by `format-alist'. This variable is\n\
3627set when a file is visited. Automatically local in all buffers.");
3628
3cb719bd
RS
3629 DEFVAR_PER_BUFFER ("buffer-invisibility-spec",
3630 &current_buffer->invisibility_spec, Qnil,
3631 "Invisibility spec of this buffer.\n\
3632The default is t, which means that text is invisible\n\
3633if it has a non-nil `invisible' property.\n\
3634If the value is a list, a text character is invisible if its `invisible'\n\
3635property is an element in that list.\n\
554216ad
KH
3636If an element is a cons cell of the form (PROP . ELLIPSIS),\n\
3637then characters with property value PROP are invisible,\n\
3cb719bd
RS
3638and they have an ellipsis as well if ELLIPSIS is non-nil.");
3639
c48f61ef
RS
3640 DEFVAR_LISP ("transient-mark-mode", &Vtransient_mark_mode,
3641 "*Non-nil means deactivate the mark when the buffer contents change.");
3642 Vtransient_mark_mode = Qnil;
3643
0a4469c9 3644 DEFVAR_LISP ("inhibit-read-only", &Vinhibit_read_only,
a96b68f1
RS
3645 "*Non-nil means disregard read-only status of buffers or characters.\n\
3646If the value is t, disregard `buffer-read-only' and all `read-only'\n\
3647text properties. If the value is a list, disregard `buffer-read-only'\n\
3648and disregard a `read-only' text property if the property value\n\
3649is a member of the list.");
3650 Vinhibit_read_only = Qnil;
3651
dcdffbf6
RS
3652 DEFVAR_LISP ("kill-buffer-query-functions", &Vkill_buffer_query_functions,
3653 "List of functions called with no args to query before killing a buffer.");
3654 Vkill_buffer_query_functions = Qnil;
3655
1ab256cb
RM
3656 defsubr (&Sbuffer_list);
3657 defsubr (&Sget_buffer);
3658 defsubr (&Sget_file_buffer);
3659 defsubr (&Sget_buffer_create);
336cd056 3660 defsubr (&Smake_indirect_buffer);
01050cb5 3661 defsubr (&Sgenerate_new_buffer_name);
1ab256cb
RM
3662 defsubr (&Sbuffer_name);
3663/*defsubr (&Sbuffer_number);*/
3664 defsubr (&Sbuffer_file_name);
336cd056 3665 defsubr (&Sbuffer_base_buffer);
1ab256cb
RM
3666 defsubr (&Sbuffer_local_variables);
3667 defsubr (&Sbuffer_modified_p);
3668 defsubr (&Sset_buffer_modified_p);
3669 defsubr (&Sbuffer_modified_tick);
3670 defsubr (&Srename_buffer);
3671 defsubr (&Sother_buffer);
3672 defsubr (&Sbuffer_disable_undo);
3673 defsubr (&Sbuffer_enable_undo);
3674 defsubr (&Skill_buffer);
3675 defsubr (&Serase_buffer);
a9ee7a59 3676 defsubr (&Sset_buffer_major_mode);
1ab256cb
RM
3677 defsubr (&Sswitch_to_buffer);
3678 defsubr (&Spop_to_buffer);
3679 defsubr (&Scurrent_buffer);
3680 defsubr (&Sset_buffer);
3681 defsubr (&Sbarf_if_buffer_read_only);
3682 defsubr (&Sbury_buffer);
1ab256cb 3683 defsubr (&Skill_all_local_variables);
2eec3b4e 3684
52f8ec73 3685 defsubr (&Soverlayp);
2eec3b4e
RS
3686 defsubr (&Smake_overlay);
3687 defsubr (&Sdelete_overlay);
3688 defsubr (&Smove_overlay);
8ebafa8d
JB
3689 defsubr (&Soverlay_start);
3690 defsubr (&Soverlay_end);
3691 defsubr (&Soverlay_buffer);
3692 defsubr (&Soverlay_properties);
2eec3b4e
RS
3693 defsubr (&Soverlays_at);
3694 defsubr (&Snext_overlay_change);
239c932b 3695 defsubr (&Sprevious_overlay_change);
2eec3b4e
RS
3696 defsubr (&Soverlay_recenter);
3697 defsubr (&Soverlay_lists);
3698 defsubr (&Soverlay_get);
3699 defsubr (&Soverlay_put);
1ab256cb
RM
3700}
3701
3702keys_of_buffer ()
3703{
3704 initial_define_key (control_x_map, 'b', "switch-to-buffer");
3705 initial_define_key (control_x_map, 'k', "kill-buffer");
4158c17d
RM
3706
3707 /* This must not be in syms_of_buffer, because Qdisabled is not
3708 initialized when that function gets called. */
3709 Fput (intern ("erase-buffer"), Qdisabled, Qt);
1ab256cb 3710}