* coding.h (CODING_ATTR_FLUSHING): Remove; unused and wouldn't work.
[bpt/emacs.git] / src / buffer.c
CommitLineData
1ab256cb 1/* Buffer manipulation primitives for GNU Emacs.
66c6abf0 2
96a72ee9 3Copyright (C) 1985-1989, 1993-1995, 1997-2012 Free Software Foundation, Inc.
1ab256cb
RM
4
5This file is part of GNU Emacs.
6
9ec0b715 7GNU Emacs is free software: you can redistribute it and/or modify
1ab256cb 8it under the terms of the GNU General Public License as published by
9ec0b715
GM
9the Free Software Foundation, either version 3 of the License, or
10(at your option) any later version.
1ab256cb
RM
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
9ec0b715 18along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
1ab256cb 19
68c45bf0 20#include <config.h>
1ab256cb 21
2381d133
JB
22#include <sys/types.h>
23#include <sys/stat.h>
1ab256cb 24#include <sys/param.h>
9dde47f5 25#include <errno.h>
15e7873a 26#include <stdio.h>
d7306fe6 27#include <setjmp.h>
dfcf069d 28#include <unistd.h>
7ee72033 29
d6202519
PE
30#include <verify.h>
31
1ab256cb 32#include "lisp.h"
21cf4cf8 33#include "intervals.h"
1ab256cb
RM
34#include "window.h"
35#include "commands.h"
8f348ed5 36#include "character.h"
e5560ff7 37#include "buffer.h"
28e969dd 38#include "region-cache.h"
1ab256cb 39#include "indent.h"
d014bf88 40#include "blockinput.h"
2538fae4 41#include "keyboard.h"
e35f6ff7 42#include "keymap.h"
08460cd4 43#include "frame.h"
1ab256cb
RM
44
45struct buffer *current_buffer; /* the current buffer */
46
47/* First buffer in chain of all buffers (in reverse order of creation).
179dade4 48 Threaded through ->header.next.buffer. */
1ab256cb
RM
49
50struct buffer *all_buffers;
51
52/* This structure holds the default values of the buffer-local variables
53 defined with DEFVAR_PER_BUFFER, that have special slots in each buffer.
54 The default value occupies the same slot in this structure
55 as an individual buffer's value occupies in that buffer.
56 Setting the default value also goes through the alist of buffers
57 and stores into each buffer that does not say it has a local value. */
58
e32a5799 59struct buffer alignas (GCALIGNMENT) buffer_defaults;
1ab256cb
RM
60
61/* A Lisp_Object pointer to the above, used for staticpro */
62
63static Lisp_Object Vbuffer_defaults;
64
65/* This structure marks which slots in a buffer have corresponding
66 default values in buffer_defaults.
67 Each such slot has a nonzero value in this structure.
68 The value has only one nonzero bit.
69
70 When a buffer has its own local value for a slot,
7c02e886
GM
71 the entry for that slot (found in the same slot in this structure)
72 is turned on in the buffer's local_flags array.
1ab256cb
RM
73
74 If a slot in this structure is -1, then even though there may
75 be a DEFVAR_PER_BUFFER for the slot, there is no default value for it;
76 and the corresponding slot in buffer_defaults is not used.
77
1ab256cb
RM
78 If a slot in this structure corresponding to a DEFVAR_PER_BUFFER is
79 zero, that is a bug */
80
81struct buffer buffer_local_flags;
82
83/* This structure holds the names of symbols whose values may be
84 buffer-local. It is indexed and accessed in the same way as the above. */
85
e32a5799 86struct buffer alignas (GCALIGNMENT) buffer_local_symbols;
6b61353c 87
1ab256cb
RM
88/* A Lisp_Object pointer to the above, used for staticpro */
89static Lisp_Object Vbuffer_local_symbols;
90
ce5b453a
SM
91/* Return the symbol of the per-buffer variable at offset OFFSET in
92 the buffer structure. */
93
94#define PER_BUFFER_SYMBOL(OFFSET) \
95 (*(Lisp_Object *)((OFFSET) + (char *) &buffer_local_symbols))
96
21514da7
PE
97/* Maximum length of an overlay vector. */
98#define OVERLAY_COUNT_MAX \
99 ((ptrdiff_t) min (MOST_POSITIVE_FIXNUM, \
100 min (PTRDIFF_MAX, SIZE_MAX) / sizeof (Lisp_Object)))
101
13de9290
RS
102/* Flags indicating which built-in buffer-local variables
103 are permanent locals. */
7313acd0 104static char buffer_permanent_local_flags[MAX_PER_BUFFER_VARS];
7c02e886
GM
105
106/* Number of per-buffer variables used. */
107
7313acd0 108int last_per_buffer_idx;
13de9290 109
f57e2426
J
110static void call_overlay_mod_hooks (Lisp_Object list, Lisp_Object overlay,
111 int after, Lisp_Object arg1,
112 Lisp_Object arg2, Lisp_Object arg3);
113static void swap_out_buffer_local_variables (struct buffer *b);
114static void reset_buffer_local_variables (struct buffer *b, int permanent_too);
1ab256cb
RM
115
116/* Alist of all buffer names vs the buffers. */
117/* This used to be a variable, but is no longer,
118 to prevent lossage due to user rplac'ing this alist or its elements. */
119Lisp_Object Vbuffer_alist;
120
955cbe7b 121static Lisp_Object Qkill_buffer_query_functions;
dcdffbf6 122
43ed3b8d 123/* Hook run before changing a major mode. */
955cbe7b 124static Lisp_Object Qchange_major_mode_hook;
22378665 125
dbc4e1c1 126Lisp_Object Qfirst_change_hook;
22378665
RS
127Lisp_Object Qbefore_change_functions;
128Lisp_Object Qafter_change_functions;
1ab256cb 129
955cbe7b
PE
130static Lisp_Object Qfundamental_mode, Qmode_class, Qpermanent_local;
131static Lisp_Object Qpermanent_local_hook;
1ab256cb 132
955cbe7b 133static Lisp_Object Qprotected_field;
1ab256cb 134
955cbe7b 135static Lisp_Object QSFundamental; /* A string "Fundamental" */
1ab256cb 136
955cbe7b 137static Lisp_Object Qkill_buffer_hook;
9397e56f 138static Lisp_Object Qbuffer_list_update_hook;
1ab256cb 139
955cbe7b 140static Lisp_Object Qget_file_buffer;
5fe0b67e 141
955cbe7b 142static Lisp_Object Qoverlayp;
52f8ec73 143
955cbe7b 144Lisp_Object Qpriority, Qbefore_string, Qafter_string;
9397e56f 145
28545e04 146static Lisp_Object Qevaporate;
5985d248 147
294d215f
RS
148Lisp_Object Qmodification_hooks;
149Lisp_Object Qinsert_in_front_hooks;
150Lisp_Object Qinsert_behind_hooks;
151
fd05c7e9 152static void alloc_buffer_text (struct buffer *, ptrdiff_t);
f57e2426
J
153static void free_buffer_text (struct buffer *b);
154static struct Lisp_Overlay * copy_overlays (struct buffer *, struct Lisp_Overlay *);
d311d28c 155static void modify_overlay (struct buffer *, ptrdiff_t, ptrdiff_t);
8a05d57a 156static Lisp_Object buffer_lisp_local_variables (struct buffer *, int);
b86af064 157
1ab256cb
RM
158/* For debugging; temporary. See set_buffer_internal. */
159/* Lisp_Object Qlisp_mode, Vcheck_symbol; */
160
01136e9b 161void
d3da34e0 162nsberror (Lisp_Object spec)
1ab256cb 163{
a7a60ce9 164 if (STRINGP (spec))
d5db4077 165 error ("No buffer named %s", SDATA (spec));
1ab256cb
RM
166 error ("Invalid buffer argument");
167}
168\f
a7ca3326 169DEFUN ("buffer-live-p", Fbuffer_live_p, Sbuffer_live_p, 1, 1, 0,
7ee72033
MB
170 doc: /* Return non-nil if OBJECT is a buffer which has not been killed.
171Value is nil if OBJECT is not a buffer or if it has been killed. */)
5842a27b 172 (Lisp_Object object)
0dc88e60 173{
4b4deea2 174 return ((BUFFERP (object) && ! NILP (BVAR (XBUFFER (object), name)))
0dc88e60
RS
175 ? Qt : Qnil);
176}
177
08460cd4 178DEFUN ("buffer-list", Fbuffer_list, Sbuffer_list, 0, 1, 0,
7ee72033 179 doc: /* Return a list of all existing live buffers.
9397e56f
MR
180If the optional arg FRAME is a frame, we return the buffer list in the
181proper order for that frame: the buffers show in FRAME come first,
182followed by the rest of the buffers. */)
5842a27b 183 (Lisp_Object frame)
1ab256cb 184{
a18b8cb5 185 Lisp_Object general;
08460cd4
RS
186 general = Fmapcar (Qcdr, Vbuffer_alist);
187
188 if (FRAMEP (frame))
189 {
a18b8cb5
KL
190 Lisp_Object framelist, prevlist, tail;
191 Lisp_Object args[3];
08460cd4 192
b7826503 193 CHECK_FRAME (frame);
e34f7f79 194 framelist = Fcopy_sequence (FVAR (XFRAME (frame), buffer_list));
9397e56f 195 prevlist = Fnreverse (Fcopy_sequence
e34f7f79 196 (FVAR (XFRAME (frame), buried_buffer_list)));
08460cd4 197
a18b8cb5
KL
198 /* Remove from GENERAL any buffer that duplicates one in
199 FRAMELIST or PREVLIST. */
08460cd4 200 tail = framelist;
a18b8cb5 201 while (CONSP (tail))
08460cd4 202 {
7539e11f
KR
203 general = Fdelq (XCAR (tail), general);
204 tail = XCDR (tail);
08460cd4 205 }
a18b8cb5
KL
206 tail = prevlist;
207 while (CONSP (tail))
208 {
209 general = Fdelq (XCAR (tail), general);
210 tail = XCDR (tail);
211 }
212
213 args[0] = framelist;
214 args[1] = general;
215 args[2] = prevlist;
216 return Fnconc (3, args);
08460cd4 217 }
9397e56f
MR
218 else
219 return general;
1ab256cb
RM
220}
221
04ae1b48
RS
222/* Like Fassoc, but use Fstring_equal to compare
223 (which ignores text properties),
224 and don't ever QUIT. */
225
226static Lisp_Object
d3da34e0 227assoc_ignore_text_properties (register Lisp_Object key, Lisp_Object list)
04ae1b48
RS
228{
229 register Lisp_Object tail;
6d70a280 230 for (tail = list; CONSP (tail); tail = XCDR (tail))
04ae1b48
RS
231 {
232 register Lisp_Object elt, tem;
6d70a280 233 elt = XCAR (tail);
04ae1b48
RS
234 tem = Fstring_equal (Fcar (elt), key);
235 if (!NILP (tem))
236 return elt;
237 }
238 return Qnil;
239}
240
a7ca3326 241DEFUN ("get-buffer", Fget_buffer, Sget_buffer, 1, 1, 0,
c8804c4f
MR
242 doc: /* Return the buffer named BUFFER-OR-NAME.
243BUFFER-OR-NAME must be either a string or a buffer. If BUFFER-OR-NAME
244is a string and there is no buffer with that name, return nil. If
245BUFFER-OR-NAME is a buffer, return it as given. */)
5842a27b 246 (register Lisp_Object buffer_or_name)
1ab256cb 247{
c8804c4f
MR
248 if (BUFFERP (buffer_or_name))
249 return buffer_or_name;
250 CHECK_STRING (buffer_or_name);
1ab256cb 251
c8804c4f 252 return Fcdr (assoc_ignore_text_properties (buffer_or_name, Vbuffer_alist));
1ab256cb
RM
253}
254
255DEFUN ("get-file-buffer", Fget_file_buffer, Sget_file_buffer, 1, 1, 0,
7ee72033 256 doc: /* Return the buffer visiting file FILENAME (a string).
018ba359
PJ
257The buffer's `buffer-file-name' must match exactly the expansion of FILENAME.
258If there is no such live buffer, return nil.
7ee72033 259See also `find-buffer-visiting'. */)
5842a27b 260 (register Lisp_Object filename)
1ab256cb
RM
261{
262 register Lisp_Object tail, buf, tem;
5fe0b67e
RS
263 Lisp_Object handler;
264
b7826503 265 CHECK_STRING (filename);
1ab256cb
RM
266 filename = Fexpand_file_name (filename, Qnil);
267
5fe0b67e
RS
268 /* If the file name has special constructs in it,
269 call the corresponding file handler. */
a617e913 270 handler = Ffind_file_name_handler (filename, Qget_file_buffer);
5fe0b67e 271 if (!NILP (handler))
a59225b1
CY
272 {
273 Lisp_Object handled_buf = call2 (handler, Qget_file_buffer,
274 filename);
275 return BUFFERP (handled_buf) ? handled_buf : Qnil;
276 }
5fe0b67e 277
7539e11f 278 for (tail = Vbuffer_alist; CONSP (tail); tail = XCDR (tail))
1ab256cb 279 {
7539e11f 280 buf = Fcdr (XCAR (tail));
a7a60ce9 281 if (!BUFFERP (buf)) continue;
4b4deea2
TT
282 if (!STRINGP (BVAR (XBUFFER (buf), filename))) continue;
283 tem = Fstring_equal (BVAR (XBUFFER (buf), filename), filename);
265a9e55 284 if (!NILP (tem))
1ab256cb
RM
285 return buf;
286 }
287 return Qnil;
288}
289
52e01189 290Lisp_Object
d3da34e0 291get_truename_buffer (register Lisp_Object filename)
52e01189
RS
292{
293 register Lisp_Object tail, buf, tem;
294
7539e11f 295 for (tail = Vbuffer_alist; CONSP (tail); tail = XCDR (tail))
52e01189 296 {
7539e11f 297 buf = Fcdr (XCAR (tail));
52e01189 298 if (!BUFFERP (buf)) continue;
4b4deea2
TT
299 if (!STRINGP (BVAR (XBUFFER (buf), file_truename))) continue;
300 tem = Fstring_equal (BVAR (XBUFFER (buf), file_truename), filename);
52e01189
RS
301 if (!NILP (tem))
302 return buf;
303 }
304 return Qnil;
305}
306
a7ca3326 307DEFUN ("get-buffer-create", Fget_buffer_create, Sget_buffer_create, 1, 1, 0,
cd265ca6
MR
308 doc: /* Return the buffer specified by BUFFER-OR-NAME, creating a new one if needed.
309If BUFFER-OR-NAME is a string and a live buffer with that name exists,
310return that buffer. If no such buffer exists, create a new buffer with
311that name and return it. If BUFFER-OR-NAME starts with a space, the new
312buffer does not keep undo information.
313
314If BUFFER-OR-NAME is a buffer instead of a string, return it as given,
315even if it is dead. The return value is never nil. */)
5842a27b 316 (register Lisp_Object buffer_or_name)
1ab256cb 317{
cd265ca6 318 register Lisp_Object buffer, name;
1ab256cb
RM
319 register struct buffer *b;
320
cd265ca6
MR
321 buffer = Fget_buffer (buffer_or_name);
322 if (!NILP (buffer))
323 return buffer;
1ab256cb 324
cd265ca6 325 if (SCHARS (buffer_or_name) == 0)
31cd83e9
KH
326 error ("Empty string for buffer name is not allowed");
327
cc648cef 328 b = allocate_buffer ();
1ab256cb 329
336cd056
RS
330 /* An ordinary buffer uses its own struct buffer_text. */
331 b->text = &b->own_text;
9928463d
DA
332 b->base_buffer = NULL;
333 /* No one shares the text with us now. */
334 b->indirections = 0;
336cd056 335
1ab256cb 336 BUF_GAP_SIZE (b) = 20;
9ac0d9e0 337 BLOCK_INPUT;
3b06f880
KH
338 /* We allocate extra 1-byte at the tail and keep it always '\0' for
339 anchoring a search. */
b86af064 340 alloc_buffer_text (b, BUF_GAP_SIZE (b) + 1);
9ac0d9e0 341 UNBLOCK_INPUT;
1ab256cb 342 if (! BUF_BEG_ADDR (b))
531b0165 343 buffer_memory_full (BUF_GAP_SIZE (b) + 1);
1ab256cb 344
cffc6f3b
CY
345 b->pt = BEG;
346 b->begv = BEG;
347 b->zv = BEG;
348 b->pt_byte = BEG_BYTE;
349 b->begv_byte = BEG_BYTE;
350 b->zv_byte = BEG_BYTE;
351
6d70a280 352 BUF_GPT (b) = BEG;
6d70a280 353 BUF_GPT_BYTE (b) = BEG_BYTE;
cffc6f3b
CY
354
355 BUF_Z (b) = BEG;
6d70a280 356 BUF_Z_BYTE (b) = BEG_BYTE;
1ab256cb 357 BUF_MODIFF (b) = 1;
3e145152 358 BUF_CHARS_MODIFF (b) = 1;
2509d356 359 BUF_OVERLAY_MODIFF (b) = 1;
336cd056
RS
360 BUF_SAVE_MODIFF (b) = 1;
361 BUF_INTERVALS (b) = 0;
b5a225b4
GM
362 BUF_UNCHANGED_MODIFIED (b) = 1;
363 BUF_OVERLAY_UNCHANGED_MODIFIED (b) = 1;
364 BUF_END_UNCHANGED (b) = 0;
365 BUF_BEG_UNCHANGED (b) = 0;
3b06f880 366 *(BUF_GPT_ADDR (b)) = *(BUF_Z_ADDR (b)) = 0; /* Put an anchor '\0'. */
2941c447 367 b->text->inhibit_shrinking = 0;
1ab256cb 368
28e969dd
JB
369 b->newline_cache = 0;
370 b->width_run_cache = 0;
4b4deea2 371 BVAR (b, width_table) = Qnil;
b5a225b4 372 b->prevent_redisplay_optimizations_p = 1;
28e969dd 373
1ab256cb 374 /* Put this on the chain of all buffers including killed ones. */
eab3844f 375 b->header.next.buffer = all_buffers;
1ab256cb
RM
376 all_buffers = b;
377
336cd056
RS
378 /* An ordinary buffer normally doesn't need markers
379 to handle BEGV and ZV. */
4b4deea2
TT
380 BVAR (b, pt_marker) = Qnil;
381 BVAR (b, begv_marker) = Qnil;
382 BVAR (b, zv_marker) = Qnil;
04ae1b48 383
cd265ca6 384 name = Fcopy_sequence (buffer_or_name);
ab77f05c 385 STRING_SET_INTERVALS (name, NULL_INTERVAL);
4b4deea2 386 BVAR (b, name) = name;
04ae1b48 387
4b4deea2 388 BVAR (b, undo_list) = (SREF (name, 0) != ' ') ? Qnil : Qt;
1ab256cb
RM
389
390 reset_buffer (b);
13de9290 391 reset_buffer_local_variables (b, 1);
1ab256cb 392
4b4deea2 393 BVAR (b, mark) = Fmake_marker ();
65745fad 394 BUF_MARKERS (b) = NULL;
1f57cb74 395
1ab256cb 396 /* Put this in the alist of all live buffers. */
cd265ca6
MR
397 XSETBUFFER (buffer, b);
398 Vbuffer_alist = nconc2 (Vbuffer_alist, Fcons (Fcons (name, buffer), Qnil));
9397e56f
MR
399 /* And run buffer-list-update-hook. */
400 if (!NILP (Vrun_hooks))
401 call1 (Vrun_hooks, Qbuffer_list_update_hook);
1ab256cb 402
cd265ca6 403 return buffer;
336cd056
RS
404}
405
7e9d5818 406
04e4cb3a
GM
407/* Return a list of overlays which is a copy of the overlay list
408 LIST, but for buffer B. */
409
2410d73a 410static struct Lisp_Overlay *
d3da34e0 411copy_overlays (struct buffer *b, struct Lisp_Overlay *list)
04e4cb3a 412{
2410d73a 413 struct Lisp_Overlay *result = NULL, *tail = NULL;
04e4cb3a 414
2410d73a 415 for (; list; list = list->next)
04e4cb3a 416 {
fa691a83
DA
417 Lisp_Object overlay, start, end;
418 struct Lisp_Marker *m;
04e4cb3a 419
fa691a83
DA
420 eassert (MARKERP (list->start));
421 m = XMARKER (list->start);
422 start = build_marker (b, m->charpos, m->bytepos);
423 XMARKER (start)->insertion_type = m->insertion_type;
04e4cb3a 424
fa691a83
DA
425 eassert (MARKERP (list->end));
426 m = XMARKER (list->end);
427 end = build_marker (b, m->charpos, m->bytepos);
428 XMARKER (end)->insertion_type = m->insertion_type;
177c0ea7 429
fa691a83 430 overlay = build_overlay (start, end, Fcopy_sequence (list->plist));
2410d73a
SM
431 if (tail)
432 tail = tail->next = XOVERLAY (overlay);
433 else
434 result = tail = XOVERLAY (overlay);
04e4cb3a
GM
435 }
436
2410d73a 437 return result;
04e4cb3a 438}
177c0ea7 439
04e4cb3a 440
7e9d5818
GM
441/* Clone per-buffer values of buffer FROM.
442
443 Buffer TO gets the same per-buffer values as FROM, with the
444 following exceptions: (1) TO's name is left untouched, (2) markers
445 are copied and made to refer to TO, and (3) overlay lists are
446 copied. */
447
448static void
d3da34e0 449clone_per_buffer_values (struct buffer *from, struct buffer *to)
7e9d5818 450{
7e9d5818
GM
451 int offset;
452
52b852c7 453 FOR_EACH_PER_BUFFER_OBJECT_AT (offset)
7e9d5818
GM
454 {
455 Lisp_Object obj;
456
4b7cdc0e
SM
457 /* Don't touch the `name' which should be unique for every buffer. */
458 if (offset == PER_BUFFER_VAR_OFFSET (name))
459 continue;
460
7e9d5818 461 obj = PER_BUFFER_VALUE (from, offset);
ce5b453a 462 if (MARKERP (obj) && XMARKER (obj)->buffer == from)
7e9d5818
GM
463 {
464 struct Lisp_Marker *m = XMARKER (obj);
657924ff
DA
465
466 obj = build_marker (to, m->charpos, m->bytepos);
7e9d5818 467 XMARKER (obj)->insertion_type = m->insertion_type;
7e9d5818
GM
468 }
469
470 PER_BUFFER_VALUE (to, offset) = obj;
471 }
472
72af86bd 473 memcpy (to->local_flags, from->local_flags, sizeof to->local_flags);
177c0ea7 474
04e4cb3a
GM
475 to->overlays_before = copy_overlays (to, from->overlays_before);
476 to->overlays_after = copy_overlays (to, from->overlays_after);
02f28bbd 477
e1688f54
RS
478 /* Get (a copy of) the alist of Lisp-level local variables of FROM
479 and install that in TO. */
8a05d57a 480 BVAR (to, local_var_alist) = buffer_lisp_local_variables (from, 1);
7e9d5818
GM
481}
482
cffc6f3b
CY
483
484/* If buffer B has markers to record PT, BEGV and ZV when it is not
485 current, update these markers. */
486
487static void
488record_buffer_markers (struct buffer *b)
489{
490 if (! NILP (BVAR (b, pt_marker)))
491 {
492 Lisp_Object buffer;
493
494 eassert (!NILP (BVAR (b, begv_marker)));
495 eassert (!NILP (BVAR (b, zv_marker)));
496
497 XSETBUFFER (buffer, b);
498 set_marker_both (BVAR (b, pt_marker), buffer, b->pt, b->pt_byte);
499 set_marker_both (BVAR (b, begv_marker), buffer, b->begv, b->begv_byte);
500 set_marker_both (BVAR (b, zv_marker), buffer, b->zv, b->zv_byte);
501 }
502}
503
504
505/* If buffer B has markers to record PT, BEGV and ZV when it is not
506 current, fetch these values into B->begv etc. */
507
508static void
509fetch_buffer_markers (struct buffer *b)
510{
511 if (! NILP (BVAR (b, pt_marker)))
512 {
513 Lisp_Object m;
514
515 eassert (!NILP (BVAR (b, begv_marker)));
516 eassert (!NILP (BVAR (b, zv_marker)));
517
518 m = BVAR (b, pt_marker);
519 SET_BUF_PT_BOTH (b, marker_position (m), marker_byte_position (m));
520
521 m = BVAR (b, begv_marker);
522 SET_BUF_BEGV_BOTH (b, marker_position (m), marker_byte_position (m));
523
524 m = BVAR (b, zv_marker);
525 SET_BUF_ZV_BOTH (b, marker_position (m), marker_byte_position (m));
526 }
527}
528
529
7e9d5818
GM
530DEFUN ("make-indirect-buffer", Fmake_indirect_buffer, Smake_indirect_buffer,
531 2, 3,
193c3837 532 "bMake indirect buffer (to buffer): \nBName of indirect buffer: ",
7ee72033 533 doc: /* Create and return an indirect buffer for buffer BASE-BUFFER, named NAME.
6b61353c 534BASE-BUFFER should be a live buffer, or the name of an existing buffer.
018ba359
PJ
535NAME should be a string which is not the name of an existing buffer.
536Optional argument CLONE non-nil means preserve BASE-BUFFER's state,
537such as major and minor modes, in the indirect buffer.
7ee72033 538CLONE nil means the indirect buffer's state is reset to default values. */)
5842a27b 539 (Lisp_Object base_buffer, Lisp_Object name, Lisp_Object clone)
336cd056 540{
6b61353c 541 Lisp_Object buf, tem;
7e9d5818 542 struct buffer *b;
336cd056 543
6b61353c 544 CHECK_STRING (name);
336cd056
RS
545 buf = Fget_buffer (name);
546 if (!NILP (buf))
d5db4077 547 error ("Buffer name `%s' is in use", SDATA (name));
336cd056 548
6b61353c 549 tem = base_buffer;
336cd056
RS
550 base_buffer = Fget_buffer (base_buffer);
551 if (NILP (base_buffer))
6b61353c 552 error ("No such buffer: `%s'", SDATA (tem));
4b4deea2 553 if (NILP (BVAR (XBUFFER (base_buffer), name)))
6b61353c 554 error ("Base buffer has been killed");
336cd056 555
d5db4077 556 if (SCHARS (name) == 0)
336cd056
RS
557 error ("Empty string for buffer name is not allowed");
558
cc648cef 559 b = allocate_buffer ();
336cd056 560
9928463d
DA
561 /* No double indirection - if base buffer is indirect,
562 new buffer becomes an indirect to base's base. */
67ee9f6e
SM
563 b->base_buffer = (XBUFFER (base_buffer)->base_buffer
564 ? XBUFFER (base_buffer)->base_buffer
565 : XBUFFER (base_buffer));
336cd056
RS
566
567 /* Use the base buffer's text object. */
568 b->text = b->base_buffer->text;
9928463d
DA
569 /* We have no own text. */
570 b->indirections = -1;
571 /* Notify base buffer that we share the text now. */
572 b->base_buffer->indirections++;
336cd056 573
cffc6f3b
CY
574 b->pt = b->base_buffer->pt;
575 b->begv = b->base_buffer->begv;
576 b->zv = b->base_buffer->zv;
577 b->pt_byte = b->base_buffer->pt_byte;
578 b->begv_byte = b->base_buffer->begv_byte;
579 b->zv_byte = b->base_buffer->zv_byte;
336cd056
RS
580
581 b->newline_cache = 0;
582 b->width_run_cache = 0;
4b4deea2 583 BVAR (b, width_table) = Qnil;
336cd056
RS
584
585 /* Put this on the chain of all buffers including killed ones. */
eab3844f 586 b->header.next.buffer = all_buffers;
336cd056
RS
587 all_buffers = b;
588
589 name = Fcopy_sequence (name);
ab77f05c 590 STRING_SET_INTERVALS (name, NULL_INTERVAL);
4b4deea2 591 BVAR (b, name) = name;
336cd056
RS
592
593 reset_buffer (b);
13de9290 594 reset_buffer_local_variables (b, 1);
336cd056
RS
595
596 /* Put this in the alist of all live buffers. */
597 XSETBUFFER (buf, b);
598 Vbuffer_alist = nconc2 (Vbuffer_alist, Fcons (Fcons (name, buf), Qnil));
599
4b4deea2 600 BVAR (b, mark) = Fmake_marker ();
336cd056 601
abc9d959 602 /* The multibyte status belongs to the base buffer. */
4b4deea2 603 BVAR (b, enable_multibyte_characters) = BVAR (b->base_buffer, enable_multibyte_characters);
abc9d959 604
336cd056 605 /* Make sure the base buffer has markers for its narrowing. */
4b4deea2 606 if (NILP (BVAR (b->base_buffer, pt_marker)))
336cd056 607 {
2aa46d6c
CY
608 eassert (NILP (BVAR (b->base_buffer, begv_marker)));
609 eassert (NILP (BVAR (b->base_buffer, zv_marker)));
cffc6f3b 610
52b852c7 611 BVAR (b->base_buffer, pt_marker)
657924ff
DA
612 = build_marker (b->base_buffer, b->base_buffer->pt, b->base_buffer->pt_byte);
613
614 BVAR (b->base_buffer, begv_marker)
615 = build_marker (b->base_buffer, b->base_buffer->begv, b->base_buffer->begv_byte);
cffc6f3b 616
657924ff
DA
617 BVAR (b->base_buffer, zv_marker)
618 = build_marker (b->base_buffer, b->base_buffer->zv, b->base_buffer->zv_byte);
cffc6f3b 619
4b4deea2 620 XMARKER (BVAR (b->base_buffer, zv_marker))->insertion_type = 1;
336cd056
RS
621 }
622
7e9d5818
GM
623 if (NILP (clone))
624 {
625 /* Give the indirect buffer markers for its narrowing. */
657924ff
DA
626 BVAR (b, pt_marker) = build_marker (b, b->pt, b->pt_byte);
627 BVAR (b, begv_marker) = build_marker (b, b->begv, b->begv_byte);
628 BVAR (b, zv_marker) = build_marker (b, b->zv, b->zv_byte);
4b4deea2 629 XMARKER (BVAR (b, zv_marker))->insertion_type = 1;
7e9d5818
GM
630 }
631 else
7fa57e45
RS
632 {
633 struct buffer *old_b = current_buffer;
634
635 clone_per_buffer_values (b->base_buffer, b);
4b4deea2
TT
636 BVAR (b, filename) = Qnil;
637 BVAR (b, file_truename) = Qnil;
638 BVAR (b, display_count) = make_number (0);
639 BVAR (b, backed_up) = Qnil;
640 BVAR (b, auto_save_file_name) = Qnil;
7fa57e45
RS
641 set_buffer_internal_1 (b);
642 Fset (intern ("buffer-save-without-query"), Qnil);
643 Fset (intern ("buffer-file-number"), Qnil);
644 Fset (intern ("buffer-stale-function"), Qnil);
645 set_buffer_internal_1 (old_b);
646 }
336cd056 647
9397e56f
MR
648 /* Run buffer-list-update-hook. */
649 if (!NILP (Vrun_hooks))
650 call1 (Vrun_hooks, Qbuffer_list_update_hook);
651
a9ee7a59 652 return buf;
1ab256cb
RM
653}
654
041a49a6
DA
655/* Mark OV as no longer associated with B. */
656
657static void
658drop_overlay (struct buffer *b, struct Lisp_Overlay *ov)
659{
660 eassert (b == XBUFFER (Fmarker_buffer (ov->start)));
661 modify_overlay (b, marker_position (ov->start), marker_position (ov->end));
662 Fset_marker (ov->start, Qnil, Qnil);
663 Fset_marker (ov->end, Qnil, Qnil);
664
665}
666
667/* Delete all overlays of B and reset it's overlay lists. */
668
d4f5719a 669void
d3da34e0 670delete_all_overlays (struct buffer *b)
d4f5719a 671{
041a49a6 672 struct Lisp_Overlay *ov, *next;
d4f5719a 673
041a49a6 674 for (ov = b->overlays_before; ov; ov = next)
d4f5719a 675 {
041a49a6
DA
676 drop_overlay (b, ov);
677 next = ov->next;
678 ov->next = NULL;
d4f5719a 679 }
041a49a6
DA
680
681 for (ov = b->overlays_after; ov; ov = next)
d4f5719a 682 {
041a49a6
DA
683 drop_overlay (b, ov);
684 next = ov->next;
685 ov->next = NULL;
d4f5719a 686 }
041a49a6
DA
687
688 b->overlays_before = b->overlays_after = NULL;
d4f5719a
SM
689}
690
bcd40520 691/* Reinitialize everything about a buffer except its name and contents
6b61353c 692 and local variables.
d4f5719a
SM
693 If called on an already-initialized buffer, the list of overlays
694 should be deleted before calling this function, otherwise we end up
695 with overlays that claim to belong to the buffer but the buffer
696 claims it doesn't belong to it. */
1ab256cb
RM
697
698void
d3da34e0 699reset_buffer (register struct buffer *b)
1ab256cb 700{
4b4deea2
TT
701 BVAR (b, filename) = Qnil;
702 BVAR (b, file_truename) = Qnil;
703 BVAR (b, directory) = (current_buffer) ? BVAR (current_buffer, directory) : Qnil;
e9a9ae03 704 b->modtime = make_emacs_time (0, UNKNOWN_MODTIME_NSECS);
58b963f7 705 b->modtime_size = -1;
4b4deea2 706 XSETFASTINT (BVAR (b, save_length), 0);
1ab256cb 707 b->last_window_start = 1;
8b264726 708 /* It is more conservative to start out "changed" than "unchanged". */
b5a225b4
GM
709 b->clip_changed = 0;
710 b->prevent_redisplay_optimizations_p = 1;
4b4deea2 711 BVAR (b, backed_up) = Qnil;
0b5397c2 712 BUF_AUTOSAVE_MODIFF (b) = 0;
d311d28c 713 b->auto_save_failure_time = 0;
4b4deea2
TT
714 BVAR (b, auto_save_file_name) = Qnil;
715 BVAR (b, read_only) = Qnil;
2410d73a
SM
716 b->overlays_before = NULL;
717 b->overlays_after = NULL;
c2d5b10f 718 b->overlay_center = BEG;
4b4deea2
TT
719 BVAR (b, mark_active) = Qnil;
720 BVAR (b, point_before_scroll) = Qnil;
721 BVAR (b, file_format) = Qnil;
722 BVAR (b, auto_save_file_format) = Qt;
723 BVAR (b, last_selected_window) = Qnil;
724 XSETINT (BVAR (b, display_count), 0);
725 BVAR (b, display_time) = Qnil;
726 BVAR (b, enable_multibyte_characters) = BVAR (&buffer_defaults, enable_multibyte_characters);
727 BVAR (b, cursor_type) = BVAR (&buffer_defaults, cursor_type);
728 BVAR (b, extra_line_spacing) = BVAR (&buffer_defaults, extra_line_spacing);
0522997d
RS
729
730 b->display_error_modiff = 0;
1ab256cb
RM
731}
732
bcd40520
RS
733/* Reset buffer B's local variables info.
734 Don't use this on a buffer that has already been in use;
735 it does not treat permanent locals consistently.
13de9290
RS
736 Instead, use Fkill_all_local_variables.
737
3709505e 738 If PERMANENT_TOO is 1, then we reset permanent
13de9290
RS
739 buffer-local variables. If PERMANENT_TOO is 0,
740 we preserve those. */
bcd40520 741
13de9290 742static void
d3da34e0 743reset_buffer_local_variables (register struct buffer *b, int permanent_too)
1ab256cb
RM
744{
745 register int offset;
7c02e886 746 int i;
1ab256cb
RM
747
748 /* Reset the major mode to Fundamental, together with all the
749 things that depend on the major mode.
750 default-major-mode is handled at a higher level.
751 We ignore it here. */
4b4deea2
TT
752 BVAR (b, major_mode) = Qfundamental_mode;
753 BVAR (b, keymap) = Qnil;
754 BVAR (b, mode_name) = QSFundamental;
755 BVAR (b, minor_modes) = Qnil;
3446af9c
RS
756
757 /* If the standard case table has been altered and invalidated,
758 fix up its insides first. */
759 if (! (CHAR_TABLE_P (XCHAR_TABLE (Vascii_downcase_table)->extras[0])
760 && CHAR_TABLE_P (XCHAR_TABLE (Vascii_downcase_table)->extras[1])
761 && CHAR_TABLE_P (XCHAR_TABLE (Vascii_downcase_table)->extras[2])))
762 Fset_standard_case_table (Vascii_downcase_table);
763
4b4deea2
TT
764 BVAR (b, downcase_table) = Vascii_downcase_table;
765 BVAR (b, upcase_table) = XCHAR_TABLE (Vascii_downcase_table)->extras[0];
766 BVAR (b, case_canon_table) = XCHAR_TABLE (Vascii_downcase_table)->extras[1];
767 BVAR (b, case_eqv_table) = XCHAR_TABLE (Vascii_downcase_table)->extras[2];
768 BVAR (b, invisibility_spec) = Qt;
3cb719bd 769
13de9290 770 /* Reset all (or most) per-buffer variables to their defaults. */
3709505e 771 if (permanent_too)
4b4deea2 772 BVAR (b, local_var_alist) = Qnil;
3709505e
SM
773 else
774 {
2f7a359d 775 Lisp_Object tmp, prop, last = Qnil;
4b4deea2 776 for (tmp = BVAR (b, local_var_alist); CONSP (tmp); tmp = XCDR (tmp))
ce5b453a 777 if (!NILP (prop = Fget (XCAR (XCAR (tmp)), Qpermanent_local)))
2f7a359d
RS
778 {
779 /* If permanent-local, keep it. */
780 last = tmp;
781 if (EQ (prop, Qpermanent_local_hook))
782 {
783 /* This is a partially permanent hook variable.
784 Preserve only the elements that want to be preserved. */
785 Lisp_Object list, newlist;
786 list = XCDR (XCAR (tmp));
787 if (!CONSP (list))
788 newlist = list;
789 else
790 for (newlist = Qnil; CONSP (list); list = XCDR (list))
791 {
792 Lisp_Object elt = XCAR (list);
793 /* Preserve element ELT if it's t,
794 if it is a function with a `permanent-local-hook' property,
795 or if it's not a symbol. */
796 if (! SYMBOLP (elt)
797 || EQ (elt, Qt)
798 || !NILP (Fget (elt, Qpermanent_local_hook)))
799 newlist = Fcons (elt, newlist);
800 }
801 XSETCDR (XCAR (tmp), Fnreverse (newlist));
802 }
803 }
804 /* Delete this local variable. */
3709505e 805 else if (NILP (last))
4b4deea2 806 BVAR (b, local_var_alist) = XCDR (tmp);
3709505e
SM
807 else
808 XSETCDR (last, XCDR (tmp));
809 }
810
7313acd0 811 for (i = 0; i < last_per_buffer_idx; ++i)
7c02e886 812 if (permanent_too || buffer_permanent_local_flags[i] == 0)
7313acd0 813 SET_PER_BUFFER_VALUE_P (b, i, 0);
1ab256cb 814
36429c89 815 /* For each slot that has a default value, copy that into the slot. */
52b852c7 816 FOR_EACH_PER_BUFFER_OBJECT_AT (offset)
aab80822 817 {
7313acd0 818 int idx = PER_BUFFER_IDX (offset);
7c02e886
GM
819 if ((idx > 0
820 && (permanent_too
ce5b453a 821 || buffer_permanent_local_flags[idx] == 0)))
7313acd0 822 PER_BUFFER_VALUE (b, offset) = PER_BUFFER_DEFAULT (offset);
aab80822 823 }
1ab256cb
RM
824}
825
01050cb5
RM
826/* We split this away from generate-new-buffer, because rename-buffer
827 and set-visited-file-name ought to be able to use this to really
828 rename the buffer properly. */
829
a7ca3326 830DEFUN ("generate-new-buffer-name", Fgenerate_new_buffer_name,
16a97296 831 Sgenerate_new_buffer_name, 1, 2, 0,
7ee72033 832 doc: /* Return a string that is the name of no existing buffer based on NAME.
018ba359
PJ
833If there is no live buffer named NAME, then return NAME.
834Otherwise modify name by appending `<NUMBER>', incrementing NUMBER
6b61353c 835\(starting at 2) until an unused name is found, and then return that name.
2f064abf 836Optional second argument IGNORE specifies a name that is okay to use (if
8e4fd1e1
GM
837it is in the sequence to be tried) even if a buffer with that name exists.
838
839If NAME begins with a space (i.e., a buffer that is not normally
840visible to users), then if buffer NAME already exists a random number
841is first appended to NAME, to speed up finding a non-existent buffer. */)
5842a27b 842 (register Lisp_Object name, Lisp_Object ignore)
1ab256cb 843{
8e4fd1e1 844 register Lisp_Object gentemp, tem, tem2;
d311d28c
PE
845 ptrdiff_t count;
846 char number[INT_BUFSIZE_BOUND (ptrdiff_t) + sizeof "<>"];
1ab256cb 847
b7826503 848 CHECK_STRING (name);
1ab256cb 849
6b61353c
KH
850 tem = Fstring_equal (name, ignore);
851 if (!NILP (tem))
852 return name;
1ab256cb 853 tem = Fget_buffer (name);
265a9e55 854 if (NILP (tem))
01050cb5 855 return name;
1ab256cb 856
8e4fd1e1
GM
857 if (!strncmp (SSDATA (name), " ", 1)) /* see bug#1229 */
858 {
859 /* Note fileio.c:make_temp_name does random differently. */
a8290ec3 860 tem2 = concat2 (name, make_formatted_string
52b852c7 861 (number, "-%"pI"d",
a8290ec3 862 XFASTINT (Frandom (make_number (999999)))));
8e4fd1e1
GM
863 tem = Fget_buffer (tem2);
864 if (NILP (tem))
865 return tem2;
866 }
867 else
868 tem2 = name;
869
1ab256cb
RM
870 count = 1;
871 while (1)
872 {
a8290ec3
DA
873 gentemp = concat2 (tem2, make_formatted_string
874 (number, "<%"pD"d>", ++count));
638e4fc3 875 tem = Fstring_equal (gentemp, ignore);
c273e647
RS
876 if (!NILP (tem))
877 return gentemp;
1ab256cb 878 tem = Fget_buffer (gentemp);
265a9e55 879 if (NILP (tem))
01050cb5 880 return gentemp;
1ab256cb
RM
881 }
882}
883
884\f
a7ca3326 885DEFUN ("buffer-name", Fbuffer_name, Sbuffer_name, 0, 1, 0,
7ee72033 886 doc: /* Return the name of BUFFER, as a string.
35f5c1d2
JB
887BUFFER defaults to the current buffer.
888Return nil if BUFFER has been killed. */)
5842a27b 889 (register Lisp_Object buffer)
1ab256cb 890{
265a9e55 891 if (NILP (buffer))
4b4deea2 892 return BVAR (current_buffer, name);
b7826503 893 CHECK_BUFFER (buffer);
4b4deea2 894 return BVAR (XBUFFER (buffer), name);
1ab256cb
RM
895}
896
a7ca3326 897DEFUN ("buffer-file-name", Fbuffer_file_name, Sbuffer_file_name, 0, 1, 0,
7ee72033
MB
898 doc: /* Return name of file BUFFER is visiting, or nil if none.
899No argument or nil as argument means use the current buffer. */)
5842a27b 900 (register Lisp_Object buffer)
1ab256cb 901{
265a9e55 902 if (NILP (buffer))
4b4deea2 903 return BVAR (current_buffer, filename);
b7826503 904 CHECK_BUFFER (buffer);
4b4deea2 905 return BVAR (XBUFFER (buffer), filename);
1ab256cb
RM
906}
907
336cd056
RS
908DEFUN ("buffer-base-buffer", Fbuffer_base_buffer, Sbuffer_base_buffer,
909 0, 1, 0,
7ee72033 910 doc: /* Return the base buffer of indirect buffer BUFFER.
5a72efd4
LT
911If BUFFER is not indirect, return nil.
912BUFFER defaults to the current buffer. */)
5842a27b 913 (register Lisp_Object buffer)
336cd056
RS
914{
915 struct buffer *base;
916 Lisp_Object base_buffer;
917
918 if (NILP (buffer))
919 base = current_buffer->base_buffer;
920 else
921 {
b7826503 922 CHECK_BUFFER (buffer);
336cd056
RS
923 base = XBUFFER (buffer)->base_buffer;
924 }
925
926 if (! base)
927 return Qnil;
928 XSETBUFFER (base_buffer, base);
929 return base_buffer;
930}
931
a7ca3326 932DEFUN ("buffer-local-value", Fbuffer_local_value,
177c0ea7 933 Sbuffer_local_value, 2, 2, 0,
79aa712d
RS
934 doc: /* Return the value of VARIABLE in BUFFER.
935If VARIABLE does not have a buffer-local binding in BUFFER, the value
5e2ad10b 936is the default binding of the variable. */)
5842a27b 937 (register Lisp_Object variable, register Lisp_Object buffer)
5f2c76c6
CY
938{
939 register Lisp_Object result = buffer_local_value_1 (variable, buffer);
940
941 if (EQ (result, Qunbound))
942 xsignal1 (Qvoid_variable, variable);
943
944 return result;
945}
946
947
948/* Like Fbuffer_local_value, but return Qunbound if the variable is
949 locally unbound. */
950
951Lisp_Object
952buffer_local_value_1 (Lisp_Object variable, Lisp_Object buffer)
79aa712d
RS
953{
954 register struct buffer *buf;
955 register Lisp_Object result;
ad97b375 956 struct Lisp_Symbol *sym;
79aa712d 957
5e2ad10b 958 CHECK_SYMBOL (variable);
ae69175b 959 CHECK_BUFFER (buffer);
79aa712d 960 buf = XBUFFER (buffer);
ce5b453a 961 sym = XSYMBOL (variable);
79aa712d 962
ce5b453a
SM
963 start:
964 switch (sym->redirect)
f0bac7de 965 {
ce5b453a
SM
966 case SYMBOL_VARALIAS: sym = indirect_variable (sym); goto start;
967 case SYMBOL_PLAINVAL: result = SYMBOL_VAL (sym); break;
968 case SYMBOL_LOCALIZED:
969 { /* Look in local_var_alist. */
970 struct Lisp_Buffer_Local_Value *blv = SYMBOL_BLV (sym);
971 XSETSYMBOL (variable, sym); /* Update In case of aliasing. */
4b4deea2 972 result = Fassoc (variable, BVAR (buf, local_var_alist));
ce5b453a
SM
973 if (!NILP (result))
974 {
975 if (blv->fwd)
976 { /* What binding is loaded right now? */
977 Lisp_Object current_alist_element = blv->valcell;
f0bac7de 978
ce5b453a
SM
979 /* The value of the currently loaded binding is not
980 stored in it, but rather in the realvalue slot.
981 Store that value into the binding it belongs to
982 in case that is the one we are about to use. */
f0bac7de 983
ce5b453a
SM
984 XSETCDR (current_alist_element,
985 do_symval_forwarding (blv->fwd));
986 }
987 /* Now get the (perhaps updated) value out of the binding. */
988 result = XCDR (result);
989 }
990 else
991 result = Fdefault_value (variable);
992 break;
993 }
994 case SYMBOL_FORWARDED:
995 {
996 union Lisp_Fwd *fwd = SYMBOL_FWD (sym);
997 if (BUFFER_OBJFWDP (fwd))
998 result = PER_BUFFER_VALUE (buf, XBUFFER_OBJFWD (fwd)->offset);
999 else
1000 result = Fdefault_value (variable);
1001 break;
1002 }
1003 default: abort ();
f0bac7de 1004 }
79aa712d 1005
5f2c76c6 1006 return result;
79aa712d
RS
1007}
1008
e1688f54 1009/* Return an alist of the Lisp-level buffer-local bindings of
7fa57e45 1010 buffer BUF. That is, don't include the variables maintained
8a05d57a
AS
1011 in special slots in the buffer object.
1012 If CLONE is zero elements of the form (VAR . unbound) are replaced
1013 by VAR. */
e1688f54
RS
1014
1015static Lisp_Object
8a05d57a 1016buffer_lisp_local_variables (struct buffer *buf, int clone)
e1688f54
RS
1017{
1018 Lisp_Object result = Qnil;
1019 register Lisp_Object tail;
4b4deea2 1020 for (tail = BVAR (buf, local_var_alist); CONSP (tail); tail = XCDR (tail))
e1688f54
RS
1021 {
1022 Lisp_Object val, elt;
1023
1024 elt = XCAR (tail);
1025
1026 /* Reference each variable in the alist in buf.
1027 If inquiring about the current buffer, this gets the current values,
1028 so store them into the alist so the alist is up to date.
1029 If inquiring about some other buffer, this swaps out any values
1030 for that buffer, making the alist up to date automatically. */
1031 val = find_symbol_value (XCAR (elt));
1032 /* Use the current buffer value only if buf is the current buffer. */
1033 if (buf != current_buffer)
1034 val = XCDR (elt);
1035
8a05d57a 1036 result = Fcons (!clone && EQ (val, Qunbound)
0992bd9c
CY
1037 ? XCAR (elt)
1038 : Fcons (XCAR (elt), val),
1039 result);
e1688f54
RS
1040 }
1041
1042 return result;
1043}
1044
1ab256cb 1045DEFUN ("buffer-local-variables", Fbuffer_local_variables,
efc7e75f 1046 Sbuffer_local_variables, 0, 1, 0,
7ee72033 1047 doc: /* Return an alist of variables that are buffer-local in BUFFER.
018ba359
PJ
1048Most elements look like (SYMBOL . VALUE), describing one variable.
1049For a symbol that is locally unbound, just the symbol appears in the value.
1050Note that storing new VALUEs in these elements doesn't change the variables.
7ee72033 1051No argument or nil as argument means use current buffer as BUFFER. */)
5842a27b 1052 (register Lisp_Object buffer)
1ab256cb
RM
1053{
1054 register struct buffer *buf;
553defa4 1055 register Lisp_Object result;
1ab256cb 1056
265a9e55 1057 if (NILP (buffer))
1ab256cb
RM
1058 buf = current_buffer;
1059 else
1060 {
b7826503 1061 CHECK_BUFFER (buffer);
1ab256cb
RM
1062 buf = XBUFFER (buffer);
1063 }
1064
8a05d57a 1065 result = buffer_lisp_local_variables (buf, 0);
1ab256cb 1066
1ab256cb
RM
1067 /* Add on all the variables stored in special slots. */
1068 {
7c02e886 1069 int offset, idx;
1ab256cb 1070
52b852c7 1071 FOR_EACH_PER_BUFFER_OBJECT_AT (offset)
1ab256cb 1072 {
7313acd0
GM
1073 idx = PER_BUFFER_IDX (offset);
1074 if ((idx == -1 || PER_BUFFER_VALUE_P (buf, idx))
1075 && SYMBOLP (PER_BUFFER_SYMBOL (offset)))
0992bd9c
CY
1076 {
1077 Lisp_Object sym = PER_BUFFER_SYMBOL (offset);
1078 Lisp_Object val = PER_BUFFER_VALUE (buf, offset);
1079 result = Fcons (EQ (val, Qunbound) ? sym : Fcons (sym, val),
1080 result);
1081 }
1ab256cb
RM
1082 }
1083 }
553defa4
RS
1084
1085 return result;
1ab256cb 1086}
1ab256cb 1087\f
a7ca3326 1088DEFUN ("buffer-modified-p", Fbuffer_modified_p, Sbuffer_modified_p,
efc7e75f 1089 0, 1, 0,
7ee72033
MB
1090 doc: /* Return t if BUFFER was modified since its file was last read or saved.
1091No argument or nil as argument means use current buffer as BUFFER. */)
5842a27b 1092 (register Lisp_Object buffer)
1ab256cb
RM
1093{
1094 register struct buffer *buf;
265a9e55 1095 if (NILP (buffer))
1ab256cb
RM
1096 buf = current_buffer;
1097 else
1098 {
b7826503 1099 CHECK_BUFFER (buffer);
1ab256cb
RM
1100 buf = XBUFFER (buffer);
1101 }
1102
336cd056 1103 return BUF_SAVE_MODIFF (buf) < BUF_MODIFF (buf) ? Qt : Qnil;
1ab256cb
RM
1104}
1105
a7ca3326 1106DEFUN ("set-buffer-modified-p", Fset_buffer_modified_p, Sset_buffer_modified_p,
efc7e75f 1107 1, 1, 0,
7ee72033
MB
1108 doc: /* Mark current buffer as modified or unmodified according to FLAG.
1109A non-nil FLAG means mark the buffer modified. */)
5842a27b 1110 (register Lisp_Object flag)
1ab256cb
RM
1111{
1112 register int already;
1113 register Lisp_Object fn;
8ec01c70 1114 Lisp_Object buffer, window;
1ab256cb
RM
1115
1116#ifdef CLASH_DETECTION
1117 /* If buffer becoming modified, lock the file.
1118 If buffer becoming unmodified, unlock the file. */
1119
4b4deea2 1120 fn = BVAR (current_buffer, file_truename);
90d456d2 1121 /* Test buffer-file-name so that binding it to nil is effective. */
4b4deea2 1122 if (!NILP (fn) && ! NILP (BVAR (current_buffer, filename)))
1ab256cb 1123 {
336cd056 1124 already = SAVE_MODIFF < MODIFF;
265a9e55 1125 if (!already && !NILP (flag))
1ab256cb 1126 lock_file (fn);
265a9e55 1127 else if (already && NILP (flag))
1ab256cb
RM
1128 unlock_file (fn);
1129 }
1130#endif /* CLASH_DETECTION */
1131
0b5397c2
SM
1132 /* Here we have a problem. SAVE_MODIFF is used here to encode
1133 buffer-modified-p (as SAVE_MODIFF<MODIFF) as well as
1134 recent-auto-save-p (as SAVE_MODIFF<auto_save_modified). So if we
1135 modify SAVE_MODIFF to affect one, we may affect the other
1136 as well.
1137 E.g. if FLAG is nil we need to set SAVE_MODIFF to MODIFF, but
1138 if SAVE_MODIFF<auto_save_modified that means we risk changing
1139 recent-auto-save-p from t to nil.
1140 Vice versa, if FLAG is non-nil and SAVE_MODIFF>=auto_save_modified
1141 we risk changing recent-auto-save-p from nil to t. */
1142 SAVE_MODIFF = (NILP (flag)
1143 /* FIXME: This unavoidably sets recent-auto-save-p to nil. */
1144 ? MODIFF
1145 /* Let's try to preserve recent-auto-save-p. */
1146 : SAVE_MODIFF < MODIFF ? SAVE_MODIFF
1147 /* If SAVE_MODIFF == auto_save_modified == MODIFF,
1148 we can either decrease SAVE_MODIFF and auto_save_modified
1149 or increase MODIFF. */
1150 : MODIFF++);
177c0ea7 1151
8ec01c70
GM
1152 /* Set update_mode_lines only if buffer is displayed in some window.
1153 Packages like jit-lock or lazy-lock preserve a buffer's modified
1154 state by recording/restoring the state around blocks of code.
1155 Setting update_mode_lines makes redisplay consider all windows
1156 (on all frames). Stealth fontification of buffers not displayed
1157 would incur additional redisplay costs if we'd set
1158 update_modes_lines unconditionally.
1159
1160 Ideally, I think there should be another mechanism for fontifying
1161 buffers without "modifying" buffers, or redisplay should be
1162 smarter about updating the `*' in mode lines. --gerd */
1163 XSETBUFFER (buffer, current_buffer);
1164 window = Fget_buffer_window (buffer, Qt);
1165 if (WINDOWP (window))
d57b83b3
GM
1166 {
1167 ++update_mode_lines;
1168 current_buffer->prevent_redisplay_optimizations_p = 1;
1169 }
177c0ea7 1170
1ab256cb
RM
1171 return flag;
1172}
1173
a8c21b48
GM
1174DEFUN ("restore-buffer-modified-p", Frestore_buffer_modified_p,
1175 Srestore_buffer_modified_p, 1, 1, 0,
42f47086 1176 doc: /* Like `set-buffer-modified-p', with a difference concerning redisplay.
018ba359 1177It is not ensured that mode lines will be updated to show the modified
7ee72033 1178state of the current buffer. Use with care. */)
5842a27b 1179 (Lisp_Object flag)
a8c21b48
GM
1180{
1181#ifdef CLASH_DETECTION
1182 Lisp_Object fn;
177c0ea7 1183
a8c21b48
GM
1184 /* If buffer becoming modified, lock the file.
1185 If buffer becoming unmodified, unlock the file. */
1186
4b4deea2 1187 fn = BVAR (current_buffer, file_truename);
a8c21b48 1188 /* Test buffer-file-name so that binding it to nil is effective. */
4b4deea2 1189 if (!NILP (fn) && ! NILP (BVAR (current_buffer, filename)))
a8c21b48
GM
1190 {
1191 int already = SAVE_MODIFF < MODIFF;
1192 if (!already && !NILP (flag))
1193 lock_file (fn);
1194 else if (already && NILP (flag))
1195 unlock_file (fn);
1196 }
1197#endif /* CLASH_DETECTION */
177c0ea7 1198
a8c21b48
GM
1199 SAVE_MODIFF = NILP (flag) ? MODIFF : 0;
1200 return flag;
1201}
1202
1ab256cb 1203DEFUN ("buffer-modified-tick", Fbuffer_modified_tick, Sbuffer_modified_tick,
efc7e75f 1204 0, 1, 0,
7ee72033 1205 doc: /* Return BUFFER's tick counter, incremented for each change in text.
2f064abf
JB
1206Each buffer has a tick counter which is incremented each time the
1207text in that buffer is changed. It wraps around occasionally.
7ee72033 1208No argument or nil as argument means use current buffer as BUFFER. */)
5842a27b 1209 (register Lisp_Object buffer)
1ab256cb
RM
1210{
1211 register struct buffer *buf;
265a9e55 1212 if (NILP (buffer))
1ab256cb
RM
1213 buf = current_buffer;
1214 else
1215 {
b7826503 1216 CHECK_BUFFER (buffer);
1ab256cb
RM
1217 buf = XBUFFER (buffer);
1218 }
1219
1220 return make_number (BUF_MODIFF (buf));
1221}
3e145152
CY
1222
1223DEFUN ("buffer-chars-modified-tick", Fbuffer_chars_modified_tick,
1224 Sbuffer_chars_modified_tick, 0, 1, 0,
1225 doc: /* Return BUFFER's character-change tick counter.
1226Each buffer has a character-change tick counter, which is set to the
1227value of the buffer's tick counter \(see `buffer-modified-tick'), each
1228time text in that buffer is inserted or deleted. By comparing the
12bd42be 1229values returned by two individual calls of `buffer-chars-modified-tick',
3e145152
CY
1230you can tell whether a character change occurred in that buffer in
1231between these calls. No argument or nil as argument means use current
1232buffer as BUFFER. */)
5842a27b 1233 (register Lisp_Object buffer)
3e145152
CY
1234{
1235 register struct buffer *buf;
1236 if (NILP (buffer))
1237 buf = current_buffer;
1238 else
1239 {
1240 CHECK_BUFFER (buffer);
1241 buf = XBUFFER (buffer);
1242 }
1243
1244 return make_number (BUF_CHARS_MODIFF (buf));
1245}
1ab256cb 1246\f
01050cb5 1247DEFUN ("rename-buffer", Frename_buffer, Srename_buffer, 1, 2,
c7d97628
JL
1248 "(list (read-string \"Rename buffer (to new name): \" \
1249 nil 'buffer-name-history (buffer-name (current-buffer))) \
1250 current-prefix-arg)",
7ee72033 1251 doc: /* Change current buffer's name to NEWNAME (a string).
018ba359
PJ
1252If second arg UNIQUE is nil or omitted, it is an error if a
1253buffer named NEWNAME already exists.
1254If UNIQUE is non-nil, come up with a new name using
1255`generate-new-buffer-name'.
1256Interactively, you can set UNIQUE with a prefix argument.
1257We return the name we actually gave the buffer.
7ee72033 1258This does not change the name of the visited file (if any). */)
5842a27b 1259 (register Lisp_Object newname, Lisp_Object unique)
1ab256cb
RM
1260{
1261 register Lisp_Object tem, buf;
1262
b7826503 1263 CHECK_STRING (newname);
d59698c4 1264
d5db4077 1265 if (SCHARS (newname) == 0)
d59698c4
RS
1266 error ("Empty string is invalid as a buffer name");
1267
489c043a 1268 tem = Fget_buffer (newname);
265a9e55 1269 if (!NILP (tem))
01050cb5 1270 {
8801a864
KR
1271 /* Don't short-circuit if UNIQUE is t. That is a useful way to
1272 rename the buffer automatically so you can create another
1273 with the original name. It makes UNIQUE equivalent to
1274 (rename-buffer (generate-new-buffer-name NEWNAME)). */
1275 if (NILP (unique) && XBUFFER (tem) == current_buffer)
4b4deea2 1276 return BVAR (current_buffer, name);
3bd779aa 1277 if (!NILP (unique))
4b4deea2 1278 newname = Fgenerate_new_buffer_name (newname, BVAR (current_buffer, name));
01050cb5 1279 else
d5db4077 1280 error ("Buffer name `%s' is in use", SDATA (newname));
01050cb5 1281 }
1ab256cb 1282
4b4deea2 1283 BVAR (current_buffer, name) = newname;
76f590d7
JB
1284
1285 /* Catch redisplay's attention. Unless we do this, the mode lines for
1286 any windows displaying current_buffer will stay unchanged. */
1287 update_mode_lines++;
1288
67180c6a 1289 XSETBUFFER (buf, current_buffer);
489c043a 1290 Fsetcar (Frassq (buf, Vbuffer_alist), newname);
4b4deea2
TT
1291 if (NILP (BVAR (current_buffer, filename))
1292 && !NILP (BVAR (current_buffer, auto_save_file_name)))
1ab256cb 1293 call0 (intern ("rename-auto-save-file"));
9397e56f
MR
1294
1295 /* Run buffer-list-update-hook. */
1296 if (!NILP (Vrun_hooks))
1297 call1 (Vrun_hooks, Qbuffer_list_update_hook);
1298
fb5eba9c 1299 /* Refetch since that last call may have done GC. */
4b4deea2 1300 return BVAR (current_buffer, name);
1ab256cb
RM
1301}
1302
a7ca3326 1303DEFUN ("other-buffer", Fother_buffer, Sother_buffer, 0, 3, 0,
7ee72033 1304 doc: /* Return most recently selected buffer other than BUFFER.
9397e56f
MR
1305Buffers not visible in windows are preferred to visible buffers, unless
1306optional second argument VISIBLE-OK is non-nil. Ignore the argument
1307BUFFER unless it denotes a live buffer. If the optional third argument
1308FRAME is non-nil, use that frame's buffer list instead of the selected
1309frame's buffer list.
1310
1311The buffer is found by scanning the selected or specified frame's buffer
1312list first, followed by the list of all buffers. If no other buffer
1313exists, return the buffer `*scratch*' (creating it if necessary). */)
5842a27b 1314 (register Lisp_Object buffer, Lisp_Object visible_ok, Lisp_Object frame)
1ab256cb 1315{
9397e56f
MR
1316 Lisp_Object Fset_buffer_major_mode (Lisp_Object buffer);
1317 Lisp_Object tail, buf, pred;
1318 Lisp_Object notsogood = Qnil;
1ab256cb 1319
773fbdb9 1320 if (NILP (frame))
9ba9623d 1321 frame = selected_frame;
773fbdb9 1322
d234d13e
JL
1323 CHECK_FRAME (frame);
1324
773fbdb9 1325 pred = frame_buffer_predicate (frame);
9397e56f 1326 /* Consider buffers that have been seen in the frame first. */
e34f7f79 1327 tail = FVAR (XFRAME (frame), buffer_list);
9397e56f 1328 for (; CONSP (tail); tail = XCDR (tail))
7962a441 1329 {
9397e56f
MR
1330 buf = XCAR (tail);
1331 if (BUFFERP (buf) && !EQ (buf, buffer)
1332 && !NILP (BVAR (XBUFFER (buf), name))
1333 && (SREF (BVAR (XBUFFER (buf), name), 0) != ' ')
1334 /* If the frame has a buffer_predicate, disregard buffers that
1335 don't fit the predicate. */
1336 && (NILP (pred) || !NILP (call1 (pred, buf))))
1337 {
1338 if (!NILP (visible_ok)
1339 || NILP (Fget_buffer_window (buf, Qvisible)))
1340 return buf;
1341 else if (NILP (notsogood))
1342 notsogood = buf;
1343 }
7962a441 1344 }
7962a441 1345
9397e56f
MR
1346 /* Consider alist of all buffers next. */
1347 tail = Vbuffer_alist;
6d70a280 1348 for (; CONSP (tail); tail = XCDR (tail))
1ab256cb 1349 {
6d70a280 1350 buf = Fcdr (XCAR (tail));
9397e56f
MR
1351 if (BUFFERP (buf) && !EQ (buf, buffer)
1352 && !NILP (BVAR (XBUFFER (buf), name))
1353 && (SREF (BVAR (XBUFFER (buf), name), 0) != ' ')
1354 /* If the frame has a buffer_predicate, disregard buffers that
1355 don't fit the predicate. */
1356 && (NILP (pred) || !NILP (call1 (pred, buf))))
1357 {
1358 if (!NILP (visible_ok)
1359 || NILP (Fget_buffer_window (buf, Qvisible)))
1360 return buf;
1361 else if (NILP (notsogood))
1362 notsogood = buf;
1363 }
1364 }
1365
1366 if (!NILP (notsogood))
1367 return notsogood;
1368 else
1369 {
1370 buf = Fget_buffer (build_string ("*scratch*"));
6b61353c 1371 if (NILP (buf))
04ae1b48 1372 {
9397e56f
MR
1373 buf = Fget_buffer_create (build_string ("*scratch*"));
1374 Fset_buffer_major_mode (buf);
04ae1b48 1375 }
9397e56f
MR
1376 return buf;
1377 }
1378}
04ae1b48 1379
9397e56f
MR
1380/* The following function is a safe variant of Fother_buffer: It doesn't
1381 pay attention to any frame-local buffer lists, doesn't care about
1382 visibility of buffers, and doesn't evaluate any frame predicates. */
1383
1384Lisp_Object
1385other_buffer_safely (Lisp_Object buffer)
1386{
1387 Lisp_Object Fset_buffer_major_mode (Lisp_Object buffer);
1388 Lisp_Object tail, buf;
1389
1390 tail = Vbuffer_alist;
1391 for (; CONSP (tail); tail = XCDR (tail))
1392 {
1393 buf = Fcdr (XCAR (tail));
1394 if (BUFFERP (buf) && !EQ (buf, buffer)
1395 && !NILP (BVAR (XBUFFER (buf), name))
1396 && (SREF (BVAR (XBUFFER (buf), name), 0) != ' '))
1ab256cb 1397 return buf;
1ab256cb 1398 }
9397e56f 1399
dba1a30a
GM
1400 buf = Fget_buffer (build_string ("*scratch*"));
1401 if (NILP (buf))
1402 {
1403 buf = Fget_buffer_create (build_string ("*scratch*"));
1404 Fset_buffer_major_mode (buf);
1405 }
9397e56f 1406
89132f25 1407 return buf;
1ab256cb
RM
1408}
1409\f
a7ca3326 1410DEFUN ("buffer-enable-undo", Fbuffer_enable_undo, Sbuffer_enable_undo,
1ab256cb 1411 0, 1, "",
7ee72033
MB
1412 doc: /* Start keeping undo information for buffer BUFFER.
1413No argument or nil as argument means do this for the current buffer. */)
5842a27b 1414 (register Lisp_Object buffer)
1ab256cb 1415{
ffd56f97 1416 Lisp_Object real_buffer;
1ab256cb 1417
ffd56f97 1418 if (NILP (buffer))
67180c6a 1419 XSETBUFFER (real_buffer, current_buffer);
1ab256cb
RM
1420 else
1421 {
ffd56f97
JB
1422 real_buffer = Fget_buffer (buffer);
1423 if (NILP (real_buffer))
1424 nsberror (buffer);
1ab256cb
RM
1425 }
1426
4b4deea2
TT
1427 if (EQ (BVAR (XBUFFER (real_buffer), undo_list), Qt))
1428 BVAR (XBUFFER (real_buffer), undo_list) = Qnil;
1ab256cb
RM
1429
1430 return Qnil;
1431}
1432
9cd47b72
DA
1433/* Truncate undo list and shrink the gap of BUFFER. */
1434
1435int
1436compact_buffer (struct buffer *buffer)
1437{
9928463d
DA
1438 /* Verify indirection counters. */
1439 if (buffer->base_buffer)
1440 {
1441 eassert (buffer->indirections == -1);
1442 eassert (buffer->base_buffer->indirections > 0);
1443 }
1444 else
1445 eassert (buffer->indirections >= 0);
1446
9cd47b72
DA
1447 /* Skip dead buffers, indirect buffers and buffers
1448 which aren't changed since last compaction. */
e34f7f79 1449 if (!NILP (buffer->INTERNAL_FIELD (name))
9cd47b72
DA
1450 && (buffer->base_buffer == NULL)
1451 && (buffer->text->compact != buffer->text->modiff))
1452 {
1453 /* If a buffer's undo list is Qt, that means that undo is
1454 turned off in that buffer. Calling truncate_undo_list on
1455 Qt tends to return NULL, which effectively turns undo back on.
1456 So don't call truncate_undo_list if undo_list is Qt. */
e34f7f79 1457 if (!EQ (buffer->INTERNAL_FIELD (undo_list), Qt))
9cd47b72
DA
1458 truncate_undo_list (buffer);
1459
1460 /* Shrink buffer gaps. */
1461 if (!buffer->text->inhibit_shrinking)
1462 {
1463 /* If a buffer's gap size is more than 10% of the buffer
1464 size, or larger than 2000 bytes, then shrink it
1465 accordingly. Keep a minimum size of 20 bytes. */
1466 int size = min (2000, max (20, (buffer->text->z_byte / 10)));
1467
1468 if (buffer->text->gap_size > size)
1469 {
1470 struct buffer *save_current = current_buffer;
1471 current_buffer = buffer;
1472 make_gap (-(buffer->text->gap_size - size));
1473 current_buffer = save_current;
1474 }
1475 }
1476 buffer->text->compact = buffer->text->modiff;
1477 return 1;
1478 }
1479 return 0;
1480}
1481
a7ca3326 1482DEFUN ("kill-buffer", Fkill_buffer, Skill_buffer, 0, 1, "bKill buffer: ",
b7e8d081 1483 doc: /* Kill the buffer specified by BUFFER-OR-NAME.
c8804c4f
MR
1484The argument may be a buffer or the name of an existing buffer.
1485Argument nil or omitted means kill the current buffer. Return t if the
1486buffer is actually killed, nil otherwise.
1487
b7e8d081
MR
1488The functions in `kill-buffer-query-functions' are called with the
1489buffer to be killed as the current buffer. If any of them returns nil,
1490the buffer is not killed. The hook `kill-buffer-hook' is run before the
1491buffer is actually killed. The buffer being killed will be current
1492while the hook is running. Functions called by any of these hooks are
1493supposed to not change the current buffer.
018ba359
PJ
1494
1495Any processes that have this buffer as the `process-buffer' are killed
b7e8d081
MR
1496with SIGHUP. This function calls `replace-buffer-in-windows' for
1497cleaning up all windows currently displaying the buffer to be killed. */)
5842a27b 1498 (Lisp_Object buffer_or_name)
1ab256cb 1499{
c8804c4f 1500 Lisp_Object buffer;
1ab256cb
RM
1501 register struct buffer *b;
1502 register Lisp_Object tem;
1503 register struct Lisp_Marker *m;
6af718a4 1504 struct gcpro gcpro1;
1ab256cb 1505
c8804c4f
MR
1506 if (NILP (buffer_or_name))
1507 buffer = Fcurrent_buffer ();
1ab256cb 1508 else
c8804c4f
MR
1509 buffer = Fget_buffer (buffer_or_name);
1510 if (NILP (buffer))
1511 nsberror (buffer_or_name);
1ab256cb 1512
c8804c4f 1513 b = XBUFFER (buffer);
1ab256cb 1514
4a4a9db5 1515 /* Avoid trouble for buffer already dead. */
4b4deea2 1516 if (NILP (BVAR (b, name)))
4a4a9db5
KH
1517 return Qnil;
1518
1ab256cb 1519 /* Query if the buffer is still modified. */
4b4deea2 1520 if (INTERACTIVE && !NILP (BVAR (b, filename))
336cd056 1521 && BUF_MODIFF (b) > BUF_SAVE_MODIFF (b))
1ab256cb 1522 {
c8804c4f 1523 GCPRO1 (buffer);
5c4930b0 1524 tem = do_yes_or_no_p (format2 ("Buffer %s modified; kill anyway? ",
4b4deea2 1525 BVAR (b, name), make_number (0)));
1ab256cb 1526 UNGCPRO;
265a9e55 1527 if (NILP (tem))
1ab256cb
RM
1528 return Qnil;
1529 }
1530
dcdffbf6 1531 /* Run hooks with the buffer to be killed the current buffer. */
1ab256cb 1532 {
d311d28c 1533 ptrdiff_t count = SPECPDL_INDEX ();
5b20caf0 1534 Lisp_Object arglist[1];
1ab256cb
RM
1535
1536 record_unwind_protect (save_excursion_restore, save_excursion_save ());
1537 set_buffer_internal (b);
dcdffbf6
RS
1538
1539 /* First run the query functions; if any query is answered no,
1540 don't kill the buffer. */
5b20caf0 1541 arglist[0] = Qkill_buffer_query_functions;
09706e1f
KR
1542 tem = Frun_hook_with_args_until_failure (1, arglist);
1543 if (NILP (tem))
5b20caf0 1544 return unbind_to (count, Qnil);
dcdffbf6
RS
1545
1546 /* Then run the hooks. */
f1597a3a 1547 Frun_hooks (1, &Qkill_buffer_hook);
1ab256cb
RM
1548 unbind_to (count, Qnil);
1549 }
1550
b7e8d081
MR
1551 /* If the hooks have killed the buffer, exit now. */
1552 if (NILP (BVAR (b, name)))
1553 return Qt;
1554
1ab256cb
RM
1555 /* We have no more questions to ask. Verify that it is valid
1556 to kill the buffer. This must be done after the questions
1557 since anything can happen within do_yes_or_no_p. */
1558
1559 /* Don't kill the minibuffer now current. */
c8804c4f 1560 if (EQ (buffer, XWINDOW (minibuf_window)->buffer))
1ab256cb
RM
1561 return Qnil;
1562
9928463d
DA
1563 /* When we kill an ordinary buffer which shares it's buffer text
1564 with indirect buffer(s), we must kill indirect buffer(s) too.
336cd056
RS
1565 We do it at this stage so nothing terrible happens if they
1566 ask questions or their hooks get errors. */
9928463d 1567 if (!b->base_buffer && b->indirections > 0)
336cd056
RS
1568 {
1569 struct buffer *other;
1570
c8804c4f 1571 GCPRO1 (buffer);
336cd056 1572
52b852c7 1573 FOR_EACH_BUFFER (other)
d17337e5 1574 if (other->base_buffer == b)
336cd056 1575 {
8f54f30a
PE
1576 Lisp_Object buf;
1577 XSETBUFFER (buf, other);
1578 Fkill_buffer (buf);
336cd056
RS
1579 }
1580
1581 UNGCPRO;
b7e8d081
MR
1582
1583 /* Exit if we now have killed the base buffer (Bug#11665). */
1584 if (NILP (BVAR (b, name)))
1585 return Qt;
336cd056 1586 }
177c0ea7 1587
56e2e794
MR
1588 /* Run replace_buffer_in_windows before making another buffer current
1589 since set-window-buffer-start-and-point will refuse to make another
1590 buffer current if the selected window does not show the current
1591 buffer. (Bug#10114) */
1592 replace_buffer_in_windows (buffer);
1593
b7e8d081
MR
1594 /* Exit if replacing the buffer in windows has killed our buffer. */
1595 if (NILP (BVAR (b, name)))
1596 return Qt;
1597
1598 /* Make this buffer not be current. Exit if it is the sole visible
1599 buffer. */
1ab256cb
RM
1600 if (b == current_buffer)
1601 {
c8804c4f 1602 tem = Fother_buffer (buffer, Qnil, Qnil);
1ab256cb
RM
1603 Fset_buffer (tem);
1604 if (b == current_buffer)
1605 return Qnil;
1606 }
1607
b7e8d081
MR
1608 /* If the buffer now current is shown in the minibuffer and our buffer
1609 is the sole other buffer give up. */
77270fac 1610 XSETBUFFER (tem, current_buffer);
b7e8d081
MR
1611 if (EQ (tem, XWINDOW (minibuf_window)->buffer)
1612 && EQ (buffer, Fother_buffer (buffer, Qnil, Qnil)))
1613 return Qnil;
77270fac 1614
1ab256cb
RM
1615 /* Now there is no question: we can kill the buffer. */
1616
1617#ifdef CLASH_DETECTION
1618 /* Unlock this buffer's file, if it is locked. */
1619 unlock_buffer (b);
1620#endif /* CLASH_DETECTION */
1621
c8804c4f
MR
1622 GCPRO1 (buffer);
1623 kill_buffer_processes (buffer);
49da74e6
KS
1624 UNGCPRO;
1625
b7e8d081
MR
1626 /* Killing buffer processes may run sentinels which may have killed
1627 our buffer. */
4b4deea2 1628 if (NILP (BVAR (b, name)))
b7e8d081 1629 return Qt;
49da74e6 1630
9397e56f
MR
1631 /* These may run Lisp code and into infinite loops (if someone
1632 insisted on circular lists) so allow quitting here. */
9397e56f
MR
1633 frames_discard_buffer (buffer);
1634
b93fb365 1635 clear_charpos_cache (b);
1ab256cb
RM
1636
1637 tem = Vinhibit_quit;
1638 Vinhibit_quit = Qt;
9397e56f 1639 /* Remove the buffer from the list of all buffers. */
c8804c4f 1640 Vbuffer_alist = Fdelq (Frassq (buffer, Vbuffer_alist), Vbuffer_alist);
b7e8d081 1641 /* If replace_buffer_in_windows didn't do its job fix that now. */
9397e56f 1642 replace_buffer_in_windows_safely (buffer);
1ab256cb
RM
1643 Vinhibit_quit = tem;
1644
9cf712eb
RS
1645 /* Delete any auto-save file, if we saved it in this session.
1646 But not if the buffer is modified. */
4b4deea2 1647 if (STRINGP (BVAR (b, auto_save_file_name))
0b5397c2
SM
1648 && BUF_AUTOSAVE_MODIFF (b) != 0
1649 && BUF_SAVE_MODIFF (b) < BUF_AUTOSAVE_MODIFF (b)
6b61353c
KH
1650 && BUF_SAVE_MODIFF (b) < BUF_MODIFF (b)
1651 && NILP (Fsymbol_value (intern ("auto-save-visited-file-name"))))
1ab256cb 1652 {
8f54f30a
PE
1653 Lisp_Object delete;
1654 delete = Fsymbol_value (intern ("delete-auto-save-files"));
1655 if (! NILP (delete))
4b4deea2 1656 internal_delete_file (BVAR (b, auto_save_file_name));
1ab256cb
RM
1657 }
1658
b7e8d081
MR
1659 /* Deleting an auto-save file could have killed our buffer. */
1660 if (NILP (BVAR (b, name)))
1661 return Qt;
1662
4a4a9db5
KH
1663 if (b->base_buffer)
1664 {
1665 /* Unchain all markers that belong to this indirect buffer.
1666 Don't unchain the markers that belong to the base buffer
1667 or its other indirect buffers. */
65745fad 1668 for (m = BUF_MARKERS (b); m; )
4a4a9db5 1669 {
65745fad 1670 struct Lisp_Marker *next = m->next;
4a4a9db5 1671 if (m->buffer == b)
65745fad
SM
1672 unchain_marker (m);
1673 m = next;
4a4a9db5
KH
1674 }
1675 }
1676 else
1ab256cb 1677 {
4a4a9db5 1678 /* Unchain all markers of this buffer and its indirect buffers.
336cd056 1679 and leave them pointing nowhere. */
65745fad 1680 for (m = BUF_MARKERS (b); m; )
336cd056 1681 {
65745fad 1682 struct Lisp_Marker *next = m->next;
336cd056 1683 m->buffer = 0;
65745fad
SM
1684 m->next = NULL;
1685 m = next;
336cd056 1686 }
65745fad 1687 BUF_MARKERS (b) = NULL;
336cd056 1688 BUF_INTERVALS (b) = NULL_INTERVAL;
336cd056
RS
1689
1690 /* Perhaps we should explicitly free the interval tree here... */
1691 }
33f7013e 1692
2f3f993b
RS
1693 /* Reset the local variables, so that this buffer's local values
1694 won't be protected from GC. They would be protected
e4769531 1695 if they happened to remain cached in their symbols.
2f3f993b
RS
1696 This gets rid of them for certain. */
1697 swap_out_buffer_local_variables (b);
13de9290 1698 reset_buffer_local_variables (b, 1);
2f3f993b 1699
4b4deea2 1700 BVAR (b, name) = Qnil;
336cd056 1701
9ac0d9e0 1702 BLOCK_INPUT;
04e9897c
DA
1703 if (b->base_buffer)
1704 {
1705 /* Notify our base buffer that we don't share the text anymore. */
1706 eassert (b->indirections == -1);
1707 b->base_buffer->indirections--;
1708 eassert (b->base_buffer->indirections >= 0);
1709 }
1710 else
1711 /* No one shares our buffer text, can free it. */
b86af064 1712 free_buffer_text (b);
336cd056 1713
28e969dd
JB
1714 if (b->newline_cache)
1715 {
1716 free_region_cache (b->newline_cache);
1717 b->newline_cache = 0;
1718 }
1719 if (b->width_run_cache)
1720 {
1721 free_region_cache (b->width_run_cache);
1722 b->width_run_cache = 0;
1723 }
4b4deea2 1724 BVAR (b, width_table) = Qnil;
9ac0d9e0 1725 UNBLOCK_INPUT;
4b4deea2 1726 BVAR (b, undo_list) = Qnil;
1ab256cb 1727
9397e56f
MR
1728 /* Run buffer-list-update-hook. */
1729 if (!NILP (Vrun_hooks))
1730 call1 (Vrun_hooks, Qbuffer_list_update_hook);
1731
1ab256cb
RM
1732 return Qt;
1733}
1734\f
9397e56f
MR
1735/* Move association for BUFFER to the front of buffer (a)lists. Since
1736 we do this each time BUFFER is selected visibly, the more recently
1737 selected buffers are always closer to the front of those lists. This
1738 means that other_buffer is more likely to choose a relevant buffer.
1739
1740 Note that this moves BUFFER to the front of the buffer lists of the
1741 selected frame even if BUFFER is not shown there. If BUFFER is not
1742 shown in the selected frame, consider the present behavior a feature.
1743 `select-window' gets this right since it shows BUFFER in the selected
1744 window when calling us. */
1ab256cb 1745
01136e9b 1746void
9397e56f 1747record_buffer (Lisp_Object buffer)
1ab256cb 1748{
4475bec4 1749 Lisp_Object aelt, aelt_cons, tem;
9397e56f 1750 register struct frame *f = XFRAME (selected_frame);
1ab256cb 1751
9397e56f 1752 CHECK_BUFFER (buffer);
1ab256cb 1753
9397e56f
MR
1754 /* Update Vbuffer_alist (we know that it has an entry for BUFFER).
1755 Don't allow quitting since this might leave the buffer list in an
1756 inconsistent state. */
1757 tem = Vinhibit_quit;
1758 Vinhibit_quit = Qt;
1759 aelt = Frassq (buffer, Vbuffer_alist);
4475bec4 1760 aelt_cons = Fmemq (aelt, Vbuffer_alist);
9397e56f 1761 Vbuffer_alist = Fdelq (aelt, Vbuffer_alist);
4475bec4
PE
1762 XSETCDR (aelt_cons, Vbuffer_alist);
1763 Vbuffer_alist = aelt_cons;
9397e56f 1764 Vinhibit_quit = tem;
1ab256cb 1765
9397e56f 1766 /* Update buffer list of selected frame. */
e34f7f79
DA
1767 FVAR (f, buffer_list) = Fcons (buffer, Fdelq (buffer, FVAR (f, buffer_list)));
1768 FVAR (f, buried_buffer_list) = Fdelq (buffer, FVAR (f, buried_buffer_list));
177c0ea7 1769
9397e56f
MR
1770 /* Run buffer-list-update-hook. */
1771 if (!NILP (Vrun_hooks))
1772 call1 (Vrun_hooks, Qbuffer_list_update_hook);
1773}
7962a441 1774
7962a441 1775
e4ed06f1
CY
1776/* Move BUFFER to the end of the buffer (a)lists. Do nothing if the
1777 buffer is killed. For the selected frame's buffer list this moves
1778 BUFFER to its end even if it was never shown in that frame. If
96a72ee9 1779 this happens we have a feature, hence `bury-buffer-internal' should be
e4ed06f1 1780 called only when BUFFER was shown in the selected frame. */
7962a441 1781
e4ed06f1
CY
1782DEFUN ("bury-buffer-internal", Fbury_buffer_internal, Sbury_buffer_internal,
1783 1, 1, 0,
1784 doc: /* Move BUFFER to the end of the buffer list. */)
9397e56f
MR
1785 (Lisp_Object buffer)
1786{
4475bec4 1787 Lisp_Object aelt, aelt_cons, tem;
9397e56f 1788 register struct frame *f = XFRAME (selected_frame);
7962a441 1789
9397e56f 1790 CHECK_BUFFER (buffer);
177c0ea7 1791
9397e56f
MR
1792 /* Update Vbuffer_alist (we know that it has an entry for BUFFER).
1793 Don't allow quitting since this might leave the buffer list in an
1794 inconsistent state. */
1795 tem = Vinhibit_quit;
1796 Vinhibit_quit = Qt;
1797 aelt = Frassq (buffer, Vbuffer_alist);
4475bec4 1798 aelt_cons = Fmemq (aelt, Vbuffer_alist);
9397e56f 1799 Vbuffer_alist = Fdelq (aelt, Vbuffer_alist);
4475bec4
PE
1800 XSETCDR (aelt_cons, Qnil);
1801 Vbuffer_alist = nconc2 (Vbuffer_alist, aelt_cons);
9397e56f
MR
1802 Vinhibit_quit = tem;
1803
1804 /* Update buffer lists of selected frame. */
e34f7f79
DA
1805 FVAR (f, buffer_list) = Fdelq (buffer, FVAR (f, buffer_list));
1806 FVAR (f, buried_buffer_list)
1807 = Fcons (buffer, Fdelq (buffer, FVAR (f, buried_buffer_list)));
9397e56f
MR
1808
1809 /* Run buffer-list-update-hook. */
1810 if (!NILP (Vrun_hooks))
1811 call1 (Vrun_hooks, Qbuffer_list_update_hook);
1812
e4ed06f1 1813 return Qnil;
1ab256cb
RM
1814}
1815
a9ee7a59 1816DEFUN ("set-buffer-major-mode", Fset_buffer_major_mode, Sset_buffer_major_mode, 1, 1, 0,
7ee72033 1817 doc: /* Set an appropriate major mode for BUFFER.
864b90c9 1818For the *scratch* buffer, use `initial-major-mode', otherwise choose a mode
71a0f2c6 1819according to `default-major-mode'.
018ba359 1820Use this function before selecting the buffer, since it may need to inspect
7ee72033 1821the current buffer's major mode. */)
5842a27b 1822 (Lisp_Object buffer)
a9ee7a59 1823{
d311d28c 1824 ptrdiff_t count;
a9ee7a59
KH
1825 Lisp_Object function;
1826
ea4fddd8
JB
1827 CHECK_BUFFER (buffer);
1828
4b4deea2
TT
1829 if (STRINGP (BVAR (XBUFFER (buffer), name))
1830 && strcmp (SSDATA (BVAR (XBUFFER (buffer), name)), "*scratch*") == 0)
71a0f2c6
GM
1831 function = find_symbol_value (intern ("initial-major-mode"));
1832 else
1833 {
4b4deea2 1834 function = BVAR (&buffer_defaults, major_mode);
71a0f2c6 1835 if (NILP (function)
4b4deea2
TT
1836 && NILP (Fget (BVAR (current_buffer, major_mode), Qmode_class)))
1837 function = BVAR (current_buffer, major_mode);
71a0f2c6 1838 }
177c0ea7 1839
48265e61
DL
1840 if (NILP (function) || EQ (function, Qfundamental_mode))
1841 return Qnil;
1842
aed13378 1843 count = SPECPDL_INDEX ();
a9ee7a59 1844
48265e61
DL
1845 /* To select a nonfundamental mode,
1846 select the buffer temporarily and then call the mode function. */
a9ee7a59
KH
1847
1848 record_unwind_protect (save_excursion_restore, save_excursion_save ());
1849
a2428fa2 1850 Fset_buffer (buffer);
48265e61 1851 call0 (function);
a9ee7a59
KH
1852
1853 return unbind_to (count, Qnil);
1854}
1855
a7ca3326 1856DEFUN ("current-buffer", Fcurrent_buffer, Scurrent_buffer, 0, 0, 0,
7ee72033 1857 doc: /* Return the current buffer as a Lisp object. */)
5842a27b 1858 (void)
1ab256cb
RM
1859{
1860 register Lisp_Object buf;
67180c6a 1861 XSETBUFFER (buf, current_buffer);
1ab256cb
RM
1862 return buf;
1863}
1864\f
7ec44ec6
GM
1865/* Set the current buffer to B.
1866
1867 We previously set windows_or_buffers_changed here to invalidate
1868 global unchanged information in beg_unchanged and end_unchanged.
1869 This is no longer necessary because we now compute unchanged
1870 information on a buffer-basis. Every action affecting other
1871 windows than the selected one requires a select_window at some
1872 time, and that increments windows_or_buffers_changed. */
1ab256cb
RM
1873
1874void
d3da34e0 1875set_buffer_internal (register struct buffer *b)
1ab256cb 1876{
b5a225b4 1877 if (current_buffer != b)
7ec44ec6 1878 set_buffer_internal_1 (b);
c7aa5005
KH
1879}
1880
1881/* Set the current buffer to B, and do not set windows_or_buffers_changed.
1882 This is used by redisplay. */
1883
1884void
d3da34e0 1885set_buffer_internal_1 (register struct buffer *b)
c7aa5005
KH
1886{
1887 register struct buffer *old_buf;
ce5b453a 1888 register Lisp_Object tail;
c7aa5005 1889
b86af064 1890#ifdef USE_MMAP_FOR_BUFFERS
684b01ee 1891 if (b->text->beg == NULL)
b86af064
GM
1892 enlarge_buffer_text (b, 0);
1893#endif /* USE_MMAP_FOR_BUFFERS */
177c0ea7 1894
c7aa5005
KH
1895 if (current_buffer == b)
1896 return;
1897
1ab256cb
RM
1898 old_buf = current_buffer;
1899 current_buffer = b;
1900 last_known_column_point = -1; /* invalidate indentation cache */
1901
336cd056
RS
1902 if (old_buf)
1903 {
1904 /* Put the undo list back in the base buffer, so that it appears
1905 that an indirect buffer shares the undo list of its base. */
1906 if (old_buf->base_buffer)
4b4deea2 1907 BVAR (old_buf->base_buffer, undo_list) = BVAR (old_buf, undo_list);
336cd056
RS
1908
1909 /* If the old current buffer has markers to record PT, BEGV and ZV
1910 when it is not current, update them now. */
cffc6f3b 1911 record_buffer_markers (old_buf);
336cd056
RS
1912 }
1913
1914 /* Get the undo list from the base buffer, so that it appears
1915 that an indirect buffer shares the undo list of its base. */
1916 if (b->base_buffer)
4b4deea2 1917 BVAR (b, undo_list) = BVAR (b->base_buffer, undo_list);
336cd056
RS
1918
1919 /* If the new current buffer has markers to record PT, BEGV and ZV
1920 when it is not current, fetch them now. */
cffc6f3b 1921 fetch_buffer_markers (b);
336cd056 1922
1ab256cb
RM
1923 /* Look down buffer's list of local Lisp variables
1924 to find and update any that forward into C variables. */
1925
ce5b453a 1926 do
1ab256cb 1927 {
4b4deea2 1928 for (tail = BVAR (b, local_var_alist); CONSP (tail); tail = XCDR (tail))
ce5b453a
SM
1929 {
1930 Lisp_Object var = XCAR (XCAR (tail));
1931 struct Lisp_Symbol *sym = XSYMBOL (var);
1932 if (sym->redirect == SYMBOL_LOCALIZED /* Just to be sure. */
1933 && SYMBOL_BLV (sym)->fwd)
1934 /* Just reference the variable
1935 to cause it to become set for this buffer. */
1936 Fsymbol_value (var);
1937 }
1ab256cb 1938 }
1ab256cb 1939 /* Do the same with any others that were local to the previous buffer */
ce5b453a 1940 while (b != old_buf && (b = old_buf, b));
1ab256cb
RM
1941}
1942
336cd056 1943/* Switch to buffer B temporarily for redisplay purposes.
bbbe9545 1944 This avoids certain things that don't need to be done within redisplay. */
336cd056
RS
1945
1946void
d3da34e0 1947set_buffer_temp (struct buffer *b)
336cd056
RS
1948{
1949 register struct buffer *old_buf;
1950
1951 if (current_buffer == b)
1952 return;
1953
1954 old_buf = current_buffer;
1955 current_buffer = b;
1956
cffc6f3b
CY
1957 /* If the old current buffer has markers to record PT, BEGV and ZV
1958 when it is not current, update them now. */
1959 record_buffer_markers (old_buf);
336cd056
RS
1960
1961 /* If the new current buffer has markers to record PT, BEGV and ZV
1962 when it is not current, fetch them now. */
cffc6f3b 1963 fetch_buffer_markers (b);
336cd056
RS
1964}
1965
a7ca3326 1966DEFUN ("set-buffer", Fset_buffer, Sset_buffer, 1, 1, 0,
c8804c4f
MR
1967 doc: /* Make buffer BUFFER-OR-NAME current for editing operations.
1968BUFFER-OR-NAME may be a buffer or the name of an existing buffer. See
1969also `save-excursion' when you want to make a buffer current
1970temporarily. This function does not display the buffer, so its effect
1971ends when the current command terminates. Use `switch-to-buffer' or
1972`pop-to-buffer' to switch buffers permanently. */)
5842a27b 1973 (register Lisp_Object buffer_or_name)
1ab256cb 1974{
c8804c4f
MR
1975 register Lisp_Object buffer;
1976 buffer = Fget_buffer (buffer_or_name);
1977 if (NILP (buffer))
1978 nsberror (buffer_or_name);
4b4deea2 1979 if (NILP (BVAR (XBUFFER (buffer), name)))
1ab256cb 1980 error ("Selecting deleted buffer");
c8804c4f
MR
1981 set_buffer_internal (XBUFFER (buffer));
1982 return buffer;
1ab256cb 1983}
d0628b06
RS
1984
1985/* Set the current buffer to BUFFER provided it is alive. */
1986
1987Lisp_Object
d3da34e0 1988set_buffer_if_live (Lisp_Object buffer)
d0628b06 1989{
4b4deea2 1990 if (! NILP (BVAR (XBUFFER (buffer), name)))
d0628b06
RS
1991 Fset_buffer (buffer);
1992 return Qnil;
1993}
1ab256cb 1994\f
a7ca3326 1995DEFUN ("barf-if-buffer-read-only", Fbarf_if_buffer_read_only,
1ab256cb 1996 Sbarf_if_buffer_read_only, 0, 0, 0,
7ee72033 1997 doc: /* Signal a `buffer-read-only' error if the current buffer is read-only. */)
5842a27b 1998 (void)
1ab256cb 1999{
4b4deea2 2000 if (!NILP (BVAR (current_buffer, read_only))
a96b68f1 2001 && NILP (Vinhibit_read_only))
4c4dc0b0 2002 xsignal1 (Qbuffer_read_only, Fcurrent_buffer ());
1ab256cb
RM
2003 return Qnil;
2004}
1ab256cb 2005\f
a7ca3326 2006DEFUN ("erase-buffer", Ferase_buffer, Serase_buffer, 0, 0, "*",
7ee72033 2007 doc: /* Delete the entire contents of the current buffer.
018ba359 2008Any narrowing restriction in effect (see `narrow-to-region') is removed,
7ee72033 2009so the buffer is truly empty after this. */)
5842a27b 2010 (void)
1ab256cb
RM
2011{
2012 Fwiden ();
c0d9a0c3
GM
2013
2014 del_range (BEG, Z);
c280bc6a 2015
1ab256cb
RM
2016 current_buffer->last_window_start = 1;
2017 /* Prevent warnings, or suspension of auto saving, that would happen
2018 if future size is less than past size. Use of erase-buffer
2019 implies that the future text is not really related to the past text. */
4b4deea2 2020 XSETFASTINT (BVAR (current_buffer, save_length), 0);
1ab256cb
RM
2021 return Qnil;
2022}
2023
01136e9b 2024void
d3da34e0 2025validate_region (register Lisp_Object *b, register Lisp_Object *e)
1ab256cb 2026{
b7826503
PJ
2027 CHECK_NUMBER_COERCE_MARKER (*b);
2028 CHECK_NUMBER_COERCE_MARKER (*e);
1ab256cb
RM
2029
2030 if (XINT (*b) > XINT (*e))
2031 {
03192067
KH
2032 Lisp_Object tem;
2033 tem = *b; *b = *e; *e = tem;
1ab256cb
RM
2034 }
2035
d311d28c 2036 if (! (BEGV <= XINT (*b) && XINT (*e) <= ZV))
1ab256cb
RM
2037 args_out_of_range (*b, *e);
2038}
2039\f
b05525fa
RS
2040/* Advance BYTE_POS up to a character boundary
2041 and return the adjusted position. */
2042
d311d28c
PE
2043static ptrdiff_t
2044advance_to_char_boundary (ptrdiff_t byte_pos)
b05525fa 2045{
f8449323 2046 int c;
b05525fa 2047
f8449323
RS
2048 if (byte_pos == BEG)
2049 /* Beginning of buffer is always a character boundary. */
6d70a280 2050 return BEG;
f8449323
RS
2051
2052 c = FETCH_BYTE (byte_pos);
2053 if (! CHAR_HEAD_P (c))
b05525fa 2054 {
1be6387d 2055 /* We should advance BYTE_POS only when C is a constituent of a
f8449323 2056 multibyte sequence. */
d311d28c 2057 ptrdiff_t orig_byte_pos = byte_pos;
a9bcded1
KH
2058
2059 do
2060 {
2061 byte_pos--;
2062 c = FETCH_BYTE (byte_pos);
2063 }
2064 while (! CHAR_HEAD_P (c) && byte_pos > BEG);
f8449323 2065 INC_POS (byte_pos);
a9bcded1
KH
2066 if (byte_pos < orig_byte_pos)
2067 byte_pos = orig_byte_pos;
f8449323
RS
2068 /* If C is a constituent of a multibyte sequence, BYTE_POS was
2069 surely advance to the correct character boundary. If C is
2070 not, BYTE_POS was unchanged. */
b05525fa
RS
2071 }
2072
20773569 2073 return byte_pos;
b05525fa
RS
2074}
2075
13cda5f9
SM
2076DEFUN ("buffer-swap-text", Fbuffer_swap_text, Sbuffer_swap_text,
2077 1, 1, 0,
2078 doc: /* Swap the text between current buffer and BUFFER. */)
5842a27b 2079 (Lisp_Object buffer)
13cda5f9
SM
2080{
2081 struct buffer *other_buffer;
2082 CHECK_BUFFER (buffer);
2083 other_buffer = XBUFFER (buffer);
2084
4b4deea2 2085 if (NILP (BVAR (other_buffer, name)))
409f2919 2086 error ("Cannot swap a dead buffer's text");
dc9cc574 2087
13cda5f9
SM
2088 /* Actually, it probably works just fine.
2089 * if (other_buffer == current_buffer)
2090 * error ("Cannot swap a buffer's text with itself"); */
2091
2092 /* Actually, this may be workable as well, tho probably only if they're
2093 *both* indirect. */
2094 if (other_buffer->base_buffer
2095 || current_buffer->base_buffer)
2096 error ("Cannot swap indirect buffers's text");
2097
2098 { /* This is probably harder to make work. */
2099 struct buffer *other;
52b852c7 2100 FOR_EACH_BUFFER (other)
13cda5f9
SM
2101 if (other->base_buffer == other_buffer
2102 || other->base_buffer == current_buffer)
2103 error ("One of the buffers to swap has indirect buffers");
2104 }
2105
2106#define swapfield(field, type) \
2107 do { \
2108 type tmp##field = other_buffer->field; \
2109 other_buffer->field = current_buffer->field; \
2110 current_buffer->field = tmp##field; \
2111 } while (0)
5d8ea120
TT
2112#define swapfield_(field, type) \
2113 do { \
4b4deea2
TT
2114 type tmp##field = BVAR (other_buffer, field); \
2115 BVAR (other_buffer, field) = BVAR (current_buffer, field); \
2116 BVAR (current_buffer, field) = tmp##field; \
5d8ea120 2117 } while (0)
13cda5f9
SM
2118
2119 swapfield (own_text, struct buffer_text);
2120 eassert (current_buffer->text == &current_buffer->own_text);
2121 eassert (other_buffer->text == &other_buffer->own_text);
baae5c2d 2122#ifdef REL_ALLOC
261cb4bb
PE
2123 r_alloc_reset_variable ((void **) &current_buffer->own_text.beg,
2124 (void **) &other_buffer->own_text.beg);
2125 r_alloc_reset_variable ((void **) &other_buffer->own_text.beg,
2126 (void **) &current_buffer->own_text.beg);
baae5c2d
JR
2127#endif /* REL_ALLOC */
2128
d311d28c
PE
2129 swapfield (pt, ptrdiff_t);
2130 swapfield (pt_byte, ptrdiff_t);
2131 swapfield (begv, ptrdiff_t);
2132 swapfield (begv_byte, ptrdiff_t);
2133 swapfield (zv, ptrdiff_t);
2134 swapfield (zv_byte, ptrdiff_t);
13cda5f9
SM
2135 eassert (!current_buffer->base_buffer);
2136 eassert (!other_buffer->base_buffer);
372f8ffc 2137 swapfield (indirections, ptrdiff_t);
13cda5f9
SM
2138 current_buffer->clip_changed = 1; other_buffer->clip_changed = 1;
2139 swapfield (newline_cache, struct region_cache *);
2140 swapfield (width_run_cache, struct region_cache *);
2141 current_buffer->prevent_redisplay_optimizations_p = 1;
2142 other_buffer->prevent_redisplay_optimizations_p = 1;
2143 swapfield (overlays_before, struct Lisp_Overlay *);
2144 swapfield (overlays_after, struct Lisp_Overlay *);
d311d28c 2145 swapfield (overlay_center, ptrdiff_t);
5d8ea120
TT
2146 swapfield_ (undo_list, Lisp_Object);
2147 swapfield_ (mark, Lisp_Object);
2148 swapfield_ (enable_multibyte_characters, Lisp_Object);
2149 swapfield_ (bidi_display_reordering, Lisp_Object);
2150 swapfield_ (bidi_paragraph_direction, Lisp_Object);
13cda5f9
SM
2151 /* FIXME: Not sure what we should do with these *_marker fields.
2152 Hopefully they're just nil anyway. */
5d8ea120
TT
2153 swapfield_ (pt_marker, Lisp_Object);
2154 swapfield_ (begv_marker, Lisp_Object);
2155 swapfield_ (zv_marker, Lisp_Object);
4b4deea2
TT
2156 BVAR (current_buffer, point_before_scroll) = Qnil;
2157 BVAR (other_buffer, point_before_scroll) = Qnil;
13cda5f9
SM
2158
2159 current_buffer->text->modiff++; other_buffer->text->modiff++;
2160 current_buffer->text->chars_modiff++; other_buffer->text->chars_modiff++;
2161 current_buffer->text->overlay_modiff++; other_buffer->text->overlay_modiff++;
2162 current_buffer->text->beg_unchanged = current_buffer->text->gpt;
2163 current_buffer->text->end_unchanged = current_buffer->text->gpt;
b8ff72fa
SM
2164 other_buffer->text->beg_unchanged = other_buffer->text->gpt;
2165 other_buffer->text->end_unchanged = other_buffer->text->gpt;
13cda5f9
SM
2166 {
2167 struct Lisp_Marker *m;
2168 for (m = BUF_MARKERS (current_buffer); m; m = m->next)
2169 if (m->buffer == other_buffer)
2170 m->buffer = current_buffer;
b8ff72fa
SM
2171 else
2172 /* Since there's no indirect buffer in sight, markers on
2173 BUF_MARKERS(buf) should either be for `buf' or dead. */
2174 eassert (!m->buffer);
13cda5f9
SM
2175 for (m = BUF_MARKERS (other_buffer); m; m = m->next)
2176 if (m->buffer == current_buffer)
2177 m->buffer = other_buffer;
b8ff72fa
SM
2178 else
2179 /* Since there's no indirect buffer in sight, markers on
2180 BUF_MARKERS(buf) should either be for `buf' or dead. */
2181 eassert (!m->buffer);
13cda5f9 2182 }
126f1fc1
SM
2183 { /* Some of the C code expects that w->buffer == w->pointm->buffer.
2184 So since we just swapped the markers between the two buffers, we need
2185 to undo the effect of this swap for window markers. */
2186 Lisp_Object w = Fselected_window (), ws = Qnil;
2187 Lisp_Object buf1, buf2;
2188 XSETBUFFER (buf1, current_buffer); XSETBUFFER (buf2, other_buffer);
2189
2190 while (NILP (Fmemq (w, ws)))
2191 {
2192 ws = Fcons (w, ws);
2193 if (MARKERP (XWINDOW (w)->pointm)
2194 && (EQ (XWINDOW (w)->buffer, buf1)
2195 || EQ (XWINDOW (w)->buffer, buf2)))
2196 Fset_marker (XWINDOW (w)->pointm,
2197 make_number (BUF_BEGV (XBUFFER (XWINDOW (w)->buffer))),
2198 XWINDOW (w)->buffer);
2199 w = Fnext_window (w, Qt, Qt);
2200 }
2201 }
2202
13cda5f9
SM
2203 if (current_buffer->text->intervals)
2204 (eassert (EQ (current_buffer->text->intervals->up.obj, buffer)),
2205 XSETBUFFER (current_buffer->text->intervals->up.obj, current_buffer));
2206 if (other_buffer->text->intervals)
2207 (eassert (EQ (other_buffer->text->intervals->up.obj, Fcurrent_buffer ())),
2208 XSETBUFFER (other_buffer->text->intervals->up.obj, other_buffer));
2209
2210 return Qnil;
2211}
2212
a7ca3326 2213DEFUN ("set-buffer-multibyte", Fset_buffer_multibyte, Sset_buffer_multibyte,
3ac81adb 2214 1, 1, 0,
7ee72033 2215 doc: /* Set the multibyte flag of the current buffer to FLAG.
018ba359
PJ
2216If FLAG is t, this makes the buffer a multibyte buffer.
2217If FLAG is nil, this makes the buffer a single-byte buffer.
8f924df7
KH
2218In these cases, the buffer contents remain unchanged as a sequence of
2219bytes but the contents viewed as characters do change.
2220If FLAG is `to', this makes the buffer a multibyte buffer by changing
6b61353c
KH
2221all eight-bit bytes to eight-bit characters.
2222If the multibyte flag was really changed, undo information of the
2223current buffer is cleared. */)
5842a27b 2224 (Lisp_Object flag)
3ac81adb 2225{
65745fad 2226 struct Lisp_Marker *tail, *markers;
abc9d959 2227 struct buffer *other;
d311d28c 2228 ptrdiff_t begv, zv;
8d1203ea 2229 int narrowed = (BEG != BEGV || Z != ZV);
ed00559d 2230 int modified_p = !NILP (Fbuffer_modified_p (Qnil));
4b4deea2 2231 Lisp_Object old_undo = BVAR (current_buffer, undo_list);
38babc07 2232 struct gcpro gcpro1;
3ac81adb 2233
6e553d5e
RS
2234 if (current_buffer->base_buffer)
2235 error ("Cannot do `set-buffer-multibyte' on an indirect buffer");
2236
70e77119 2237 /* Do nothing if nothing actually changes. */
4b4deea2 2238 if (NILP (flag) == NILP (BVAR (current_buffer, enable_multibyte_characters)))
70e77119
AS
2239 return flag;
2240
38babc07
KS
2241 GCPRO1 (old_undo);
2242
2243 /* Don't record these buffer changes. We will put a special undo entry
2244 instead. */
4b4deea2 2245 BVAR (current_buffer, undo_list) = Qt;
b05525fa 2246
3ac81adb
RS
2247 /* If the cached position is for this buffer, clear it out. */
2248 clear_charpos_cache (current_buffer);
2249
458c8af4
KH
2250 if (NILP (flag))
2251 begv = BEGV_BYTE, zv = ZV_BYTE;
2252 else
2253 begv = BEGV, zv = ZV;
2254
a9bcded1
KH
2255 if (narrowed)
2256 Fwiden ();
2257
3ac81adb
RS
2258 if (NILP (flag))
2259 {
d311d28c 2260 ptrdiff_t pos, stop;
a9bcded1
KH
2261 unsigned char *p;
2262
3ac81adb
RS
2263 /* Do this first, so it can use CHAR_TO_BYTE
2264 to calculate the old correspondences. */
2265 set_intervals_multibyte (0);
2266
4b4deea2 2267 BVAR (current_buffer, enable_multibyte_characters) = Qnil;
3ac81adb
RS
2268
2269 Z = Z_BYTE;
2270 BEGV = BEGV_BYTE;
2271 ZV = ZV_BYTE;
2272 GPT = GPT_BYTE;
2273 TEMP_SET_PT_BOTH (PT_BYTE, PT_BYTE);
2274
60ebfdf3 2275
65745fad
SM
2276 for (tail = BUF_MARKERS (current_buffer); tail; tail = tail->next)
2277 tail->charpos = tail->bytepos;
a9bcded1
KH
2278
2279 /* Convert multibyte form of 8-bit characters to unibyte. */
2280 pos = BEG;
2281 stop = GPT;
2282 p = BEG_ADDR;
2283 while (1)
2284 {
2285 int c, bytes;
2286
2287 if (pos == stop)
2288 {
2289 if (pos == Z)
2290 break;
2291 p = GAP_END_ADDR;
2292 stop = Z;
2293 }
8f348ed5
KH
2294 if (ASCII_BYTE_P (*p))
2295 p++, pos++;
2296 else if (CHAR_BYTE8_HEAD_P (*p))
a9bcded1 2297 {
62a6e103 2298 c = STRING_CHAR_AND_LENGTH (p, bytes);
a9bcded1 2299 /* Delete all bytes for this 8-bit character but the
3b59c351 2300 last one, and change the last one to the character
a9bcded1
KH
2301 code. */
2302 bytes--;
2303 del_range_2 (pos, pos, pos + bytes, pos + bytes, 0);
2304 p = GAP_END_ADDR;
2305 *p++ = c;
2306 pos++;
2307 if (begv > pos)
2308 begv -= bytes;
2309 if (zv > pos)
2310 zv -= bytes;
2311 stop = Z;
2312 }
8f924df7 2313 else
8f348ed5
KH
2314 {
2315 bytes = BYTES_BY_CHAR_HEAD (*p);
2316 p += bytes, pos += bytes;
2317 }
a9bcded1
KH
2318 }
2319 if (narrowed)
2320 Fnarrow_to_region (make_number (begv), make_number (zv));
3ac81adb
RS
2321 }
2322 else
2323 {
d311d28c
PE
2324 ptrdiff_t pt = PT;
2325 ptrdiff_t pos, stop;
8f348ed5 2326 unsigned char *p, *pend;
a9bcded1 2327
673c57d2 2328 /* Be sure not to have a multibyte sequence striding over the GAP.
8f348ed5
KH
2329 Ex: We change this: "...abc\302 _GAP_ \241def..."
2330 to: "...abc _GAP_ \302\241def..." */
673c57d2 2331
8f924df7 2332 if (EQ (flag, Qt)
a3a303df 2333 && GPT_BYTE > 1 && GPT_BYTE < Z_BYTE
673c57d2
KH
2334 && ! CHAR_HEAD_P (*(GAP_END_ADDR)))
2335 {
8f54f30a 2336 unsigned char *q = GPT_ADDR - 1;
673c57d2 2337
8f54f30a
PE
2338 while (! CHAR_HEAD_P (*q) && q > BEG_ADDR) q--;
2339 if (LEADING_CODE_P (*q))
673c57d2 2340 {
d311d28c 2341 ptrdiff_t new_gpt = GPT_BYTE - (GPT_ADDR - q);
673c57d2
KH
2342
2343 move_gap_both (new_gpt, new_gpt);
2344 }
2345 }
2346
a9bcded1
KH
2347 /* Make the buffer contents valid as multibyte by converting
2348 8-bit characters to multibyte form. */
2349 pos = BEG;
2350 stop = GPT;
2351 p = BEG_ADDR;
8f348ed5 2352 pend = GPT_ADDR;
a9bcded1
KH
2353 while (1)
2354 {
2355 int bytes;
2356
2357 if (pos == stop)
2358 {
2359 if (pos == Z)
2360 break;
2361 p = GAP_END_ADDR;
8f348ed5 2362 pend = Z_ADDR;
a9bcded1
KH
2363 stop = Z;
2364 }
177c0ea7 2365
a3a303df
KH
2366 if (ASCII_BYTE_P (*p))
2367 p++, pos++;
dcfb9bc4
KH
2368 else if (EQ (flag, Qt)
2369 && ! CHAR_BYTE8_HEAD_P (*p)
2370 && (bytes = MULTIBYTE_LENGTH (p, pend)) > 0)
a9bcded1
KH
2371 p += bytes, pos += bytes;
2372 else
2373 {
2374 unsigned char tmp[MAX_MULTIBYTE_LENGTH];
a3a303df 2375 int c;
a9bcded1 2376
8f924df7 2377 c = BYTE8_TO_CHAR (*p);
8c2fc311 2378 bytes = CHAR_STRING (c, tmp);
a9bcded1
KH
2379 *p = tmp[0];
2380 TEMP_SET_PT_BOTH (pos + 1, pos + 1);
2381 bytes--;
b68864e5 2382 insert_1_both ((char *) tmp + 1, bytes, bytes, 1, 0, 0);
a9bcded1
KH
2383 /* Now the gap is after the just inserted data. */
2384 pos = GPT;
2385 p = GAP_END_ADDR;
2386 if (pos <= begv)
2387 begv += bytes;
2388 if (pos <= zv)
2389 zv += bytes;
2390 if (pos <= pt)
2391 pt += bytes;
31285a8f 2392 pend = Z_ADDR;
a9bcded1
KH
2393 stop = Z;
2394 }
2395 }
2396
2397 if (pt != PT)
2398 TEMP_SET_PT (pt);
2399
2400 if (narrowed)
2401 Fnarrow_to_region (make_number (begv), make_number (zv));
2402
3ac81adb
RS
2403 /* Do this first, so that chars_in_text asks the right question.
2404 set_intervals_multibyte needs it too. */
4b4deea2 2405 BVAR (current_buffer, enable_multibyte_characters) = Qt;
3ac81adb 2406
b05525fa 2407 GPT_BYTE = advance_to_char_boundary (GPT_BYTE);
3ac81adb 2408 GPT = chars_in_text (BEG_ADDR, GPT_BYTE - BEG_BYTE) + BEG;
b05525fa 2409
673c57d2 2410 Z = chars_in_text (GAP_END_ADDR, Z_BYTE - GPT_BYTE) + GPT;
b05525fa
RS
2411
2412 BEGV_BYTE = advance_to_char_boundary (BEGV_BYTE);
3ac81adb 2413 if (BEGV_BYTE > GPT_BYTE)
673c57d2 2414 BEGV = chars_in_text (GAP_END_ADDR, BEGV_BYTE - GPT_BYTE) + GPT;
3ac81adb
RS
2415 else
2416 BEGV = chars_in_text (BEG_ADDR, BEGV_BYTE - BEG_BYTE) + BEG;
b05525fa
RS
2417
2418 ZV_BYTE = advance_to_char_boundary (ZV_BYTE);
3ac81adb 2419 if (ZV_BYTE > GPT_BYTE)
673c57d2 2420 ZV = chars_in_text (GAP_END_ADDR, ZV_BYTE - GPT_BYTE) + GPT;
3ac81adb
RS
2421 else
2422 ZV = chars_in_text (BEG_ADDR, ZV_BYTE - BEG_BYTE) + BEG;
b05525fa
RS
2423
2424 {
d311d28c
PE
2425 ptrdiff_t byte = advance_to_char_boundary (PT_BYTE);
2426 ptrdiff_t position;
b05525fa 2427
8f54f30a
PE
2428 if (byte > GPT_BYTE)
2429 position = chars_in_text (GAP_END_ADDR, byte - GPT_BYTE) + GPT;
b05525fa 2430 else
8f54f30a
PE
2431 position = chars_in_text (BEG_ADDR, byte - BEG_BYTE) + BEG;
2432 TEMP_SET_PT_BOTH (position, byte);
b05525fa 2433 }
3ac81adb
RS
2434
2435 tail = markers = BUF_MARKERS (current_buffer);
95fb069b
RS
2436
2437 /* This prevents BYTE_TO_CHAR (that is, buf_bytepos_to_charpos) from
2438 getting confused by the markers that have not yet been updated.
2439 It is also a signal that it should never create a marker. */
65745fad 2440 BUF_MARKERS (current_buffer) = NULL;
3ac81adb 2441
65745fad 2442 for (; tail; tail = tail->next)
3ac81adb 2443 {
65745fad
SM
2444 tail->bytepos = advance_to_char_boundary (tail->bytepos);
2445 tail->charpos = BYTE_TO_CHAR (tail->bytepos);
3ac81adb 2446 }
b69f9797
RS
2447
2448 /* Make sure no markers were put on the chain
2449 while the chain value was incorrect. */
65745fad 2450 if (BUF_MARKERS (current_buffer))
b69f9797
RS
2451 abort ();
2452
3ac81adb
RS
2453 BUF_MARKERS (current_buffer) = markers;
2454
2455 /* Do this last, so it can calculate the new correspondences
2456 between chars and bytes. */
2457 set_intervals_multibyte (1);
2458 }
2459
38babc07
KS
2460 if (!EQ (old_undo, Qt))
2461 {
2462 /* Represent all the above changes by a special undo entry. */
4b4deea2 2463 BVAR (current_buffer, undo_list) = Fcons (list3 (Qapply,
8929fd87
KS
2464 intern ("set-buffer-multibyte"),
2465 NILP (flag) ? Qt : Qnil),
2466 old_undo);
38babc07
KS
2467 }
2468
2469 UNGCPRO;
a9bcded1 2470
724b203f
GM
2471 /* Changing the multibyteness of a buffer means that all windows
2472 showing that buffer must be updated thoroughly. */
2473 current_buffer->prevent_redisplay_optimizations_p = 1;
2474 ++windows_or_buffers_changed;
2475
abc9d959
RS
2476 /* Copy this buffer's new multibyte status
2477 into all of its indirect buffers. */
52b852c7 2478 FOR_EACH_BUFFER (other)
4b4deea2 2479 if (other->base_buffer == current_buffer && !NILP (BVAR (other, name)))
724b203f 2480 {
4b4deea2
TT
2481 BVAR (other, enable_multibyte_characters)
2482 = BVAR (current_buffer, enable_multibyte_characters);
724b203f
GM
2483 other->prevent_redisplay_optimizations_p = 1;
2484 }
abc9d959 2485
ed00559d
KH
2486 /* Restore the modifiedness of the buffer. */
2487 if (!modified_p && !NILP (Fbuffer_modified_p (Qnil)))
2488 Fset_buffer_modified_p (Qnil);
2489
172f9454
KH
2490 /* Update coding systems of this buffer's process (if any). */
2491 {
2492 Lisp_Object process;
2493
2494 process = Fget_buffer_process (Fcurrent_buffer ());
2495 if (PROCESSP (process))
2496 setup_process_coding_systems (process);
2497 }
2498
3ac81adb
RS
2499 return flag;
2500}
2501\f
a7ca3326 2502DEFUN ("kill-all-local-variables", Fkill_all_local_variables,
16a97296 2503 Skill_all_local_variables, 0, 0, 0,
7ee72033 2504 doc: /* Switch to Fundamental mode by killing current buffer's local variables.
018ba359
PJ
2505Most local variable bindings are eliminated so that the default values
2506become effective once more. Also, the syntax table is set from
2507`standard-syntax-table', the local keymap is set to nil,
2508and the abbrev table from `fundamental-mode-abbrev-table'.
2509This function also forces redisplay of the mode line.
2510
2511Every function to select a new major mode starts by
2512calling this function.
2513
2514As a special exception, local variables whose names have
2515a non-nil `permanent-local' property are not eliminated by this function.
2516
2517The first thing this function does is run
7ee72033 2518the normal hook `change-major-mode-hook'. */)
5842a27b 2519 (void)
1ab256cb 2520{
dee091a3 2521 Frun_hooks (1, &Qchange_major_mode_hook);
1ab256cb 2522
3709505e 2523 /* Make sure none of the bindings in local_var_alist
2f3f993b 2524 remain swapped in, in their symbols. */
1ab256cb 2525
2f3f993b 2526 swap_out_buffer_local_variables (current_buffer);
1ab256cb
RM
2527
2528 /* Actually eliminate all local bindings of this buffer. */
2529
13de9290 2530 reset_buffer_local_variables (current_buffer, 0);
1ab256cb 2531
1ab256cb
RM
2532 /* Force mode-line redisplay. Useful here because all major mode
2533 commands call this function. */
2534 update_mode_lines++;
2535
2536 return Qnil;
2537}
2f3f993b
RS
2538
2539/* Make sure no local variables remain set up with buffer B
2540 for their current values. */
2541
2542static void
d3da34e0 2543swap_out_buffer_local_variables (struct buffer *b)
2f3f993b 2544{
ce5b453a 2545 Lisp_Object oalist, alist, buffer;
2f3f993b
RS
2546
2547 XSETBUFFER (buffer, b);
4b4deea2 2548 oalist = BVAR (b, local_var_alist);
2f3f993b 2549
67ee9f6e 2550 for (alist = oalist; CONSP (alist); alist = XCDR (alist))
2f3f993b 2551 {
ce5b453a
SM
2552 Lisp_Object sym = XCAR (XCAR (alist));
2553 eassert (XSYMBOL (sym)->redirect == SYMBOL_LOCALIZED);
2554 /* Need not do anything if some other buffer's binding is
e4769531 2555 now cached. */
ce5b453a 2556 if (EQ (SYMBOL_BLV (XSYMBOL (sym))->where, buffer))
2f3f993b 2557 {
e7c10f83
SM
2558 /* Symbol is set up for this buffer's old local value:
2559 swap it out! */
ce5b453a 2560 swap_in_global_binding (XSYMBOL (sym));
2f3f993b
RS
2561 }
2562 }
2563}
1ab256cb 2564\f
2eec3b4e 2565/* Find all the overlays in the current buffer that contain position POS.
177c0ea7 2566 Return the number found, and store them in a vector in *VEC_PTR.
2eec3b4e 2567 Store in *LEN_PTR the size allocated for the vector.
52f8ec73 2568 Store in *NEXT_PTR the next position after POS where an overlay starts,
624d2678 2569 or ZV if there are no more overlays between POS and ZV.
bbbe9545 2570 Store in *PREV_PTR the previous position before POS where an overlay ends,
413e06a4 2571 or where an overlay starts which ends at or after POS;
624d2678 2572 or BEGV if there are no such overlays from BEGV to POS.
239c932b 2573 NEXT_PTR and/or PREV_PTR may be 0, meaning don't store that info.
2eec3b4e
RS
2574
2575 *VEC_PTR and *LEN_PTR should contain a valid vector and size
61d54cd5
RS
2576 when this function is called.
2577
2578 If EXTEND is non-zero, we make the vector bigger if necessary.
2579 If EXTEND is zero, we never extend the vector,
2580 and we store only as many overlays as will fit.
ac869cf7
MB
2581 But we still return the total number of overlays.
2582
2583 If CHANGE_REQ is true, then any position written into *PREV_PTR or
2584 *NEXT_PTR is guaranteed to be not equal to POS, unless it is the
2585 default (BEGV or ZV). */
2eec3b4e 2586
b081724f
PE
2587ptrdiff_t
2588overlays_at (EMACS_INT pos, int extend, Lisp_Object **vec_ptr,
2589 ptrdiff_t *len_ptr,
d311d28c 2590 ptrdiff_t *next_ptr, ptrdiff_t *prev_ptr, int change_req)
1ab256cb 2591{
2410d73a
SM
2592 Lisp_Object overlay, start, end;
2593 struct Lisp_Overlay *tail;
b081724f
PE
2594 ptrdiff_t idx = 0;
2595 ptrdiff_t len = *len_ptr;
2eec3b4e 2596 Lisp_Object *vec = *vec_ptr;
d311d28c
PE
2597 ptrdiff_t next = ZV;
2598 ptrdiff_t prev = BEGV;
61d54cd5
RS
2599 int inhibit_storing = 0;
2600
2410d73a 2601 for (tail = current_buffer->overlays_before; tail; tail = tail->next)
2eec3b4e 2602 {
d311d28c 2603 ptrdiff_t startpos, endpos;
52f8ec73 2604
2410d73a 2605 XSETMISC (overlay, tail);
1ab256cb 2606
2eec3b4e
RS
2607 start = OVERLAY_START (overlay);
2608 end = OVERLAY_END (overlay);
239c932b
RS
2609 endpos = OVERLAY_POSITION (end);
2610 if (endpos < pos)
2611 {
2612 if (prev < endpos)
2613 prev = endpos;
2614 break;
2615 }
413e06a4
RS
2616 startpos = OVERLAY_POSITION (start);
2617 /* This one ends at or after POS
daa1c109 2618 so its start counts for PREV_PTR if it's before POS. */
413e06a4
RS
2619 if (prev < startpos && startpos < pos)
2620 prev = startpos;
239c932b
RS
2621 if (endpos == pos)
2622 continue;
2eec3b4e
RS
2623 if (startpos <= pos)
2624 {
2625 if (idx == len)
2626 {
61d54cd5
RS
2627 /* The supplied vector is full.
2628 Either make it bigger, or don't store any more in it. */
2629 if (extend)
2630 {
0065d054
PE
2631 vec = xpalloc (vec, len_ptr, 1, OVERLAY_COUNT_MAX,
2632 sizeof *vec);
61d54cd5 2633 *vec_ptr = vec;
0065d054 2634 len = *len_ptr;
61d54cd5
RS
2635 }
2636 else
2637 inhibit_storing = 1;
2eec3b4e 2638 }
61d54cd5
RS
2639
2640 if (!inhibit_storing)
2641 vec[idx] = overlay;
2642 /* Keep counting overlays even if we can't return them all. */
2643 idx++;
2eec3b4e
RS
2644 }
2645 else if (startpos < next)
2646 next = startpos;
2647 }
2648
2410d73a 2649 for (tail = current_buffer->overlays_after; tail; tail = tail->next)
1ab256cb 2650 {
d311d28c 2651 ptrdiff_t startpos, endpos;
52f8ec73 2652
2410d73a 2653 XSETMISC (overlay, tail);
2eec3b4e
RS
2654
2655 start = OVERLAY_START (overlay);
2656 end = OVERLAY_END (overlay);
2657 startpos = OVERLAY_POSITION (start);
52f8ec73 2658 if (pos < startpos)
2eec3b4e
RS
2659 {
2660 if (startpos < next)
2661 next = startpos;
2662 break;
2663 }
239c932b
RS
2664 endpos = OVERLAY_POSITION (end);
2665 if (pos < endpos)
2eec3b4e
RS
2666 {
2667 if (idx == len)
2668 {
61d54cd5
RS
2669 if (extend)
2670 {
0065d054
PE
2671 vec = xpalloc (vec, len_ptr, 1, OVERLAY_COUNT_MAX,
2672 sizeof *vec);
61d54cd5 2673 *vec_ptr = vec;
0065d054 2674 len = *len_ptr;
61d54cd5
RS
2675 }
2676 else
2677 inhibit_storing = 1;
2eec3b4e 2678 }
61d54cd5
RS
2679
2680 if (!inhibit_storing)
2681 vec[idx] = overlay;
2682 idx++;
413e06a4
RS
2683
2684 if (startpos < pos && startpos > prev)
2685 prev = startpos;
2eec3b4e 2686 }
239c932b
RS
2687 else if (endpos < pos && endpos > prev)
2688 prev = endpos;
1d5f4c1d
MB
2689 else if (endpos == pos && startpos > prev
2690 && (!change_req || startpos < pos))
413e06a4 2691 prev = startpos;
1ab256cb
RM
2692 }
2693
239c932b
RS
2694 if (next_ptr)
2695 *next_ptr = next;
2696 if (prev_ptr)
2697 *prev_ptr = prev;
2eec3b4e
RS
2698 return idx;
2699}
74514898 2700\f
7723e095
MR
2701/* Find all the overlays in the current buffer that overlap the range
2702 BEG-END, or are empty at BEG, or are empty at END provided END
2703 denotes the position at the end of the current buffer.
2a3eeee7 2704
177c0ea7 2705 Return the number found, and store them in a vector in *VEC_PTR.
74514898
RS
2706 Store in *LEN_PTR the size allocated for the vector.
2707 Store in *NEXT_PTR the next position after POS where an overlay starts,
2708 or ZV if there are no more overlays.
2709 Store in *PREV_PTR the previous position before POS where an overlay ends,
2710 or BEGV if there are no previous overlays.
2711 NEXT_PTR and/or PREV_PTR may be 0, meaning don't store that info.
2712
2713 *VEC_PTR and *LEN_PTR should contain a valid vector and size
2714 when this function is called.
2715
2716 If EXTEND is non-zero, we make the vector bigger if necessary.
2717 If EXTEND is zero, we never extend the vector,
2718 and we store only as many overlays as will fit.
2719 But we still return the total number of overlays. */
2720
21514da7 2721static ptrdiff_t
145582a0 2722overlays_in (EMACS_INT beg, EMACS_INT end, int extend,
21514da7 2723 Lisp_Object **vec_ptr, ptrdiff_t *len_ptr,
d311d28c 2724 ptrdiff_t *next_ptr, ptrdiff_t *prev_ptr)
74514898 2725{
2410d73a
SM
2726 Lisp_Object overlay, ostart, oend;
2727 struct Lisp_Overlay *tail;
21514da7
PE
2728 ptrdiff_t idx = 0;
2729 ptrdiff_t len = *len_ptr;
74514898 2730 Lisp_Object *vec = *vec_ptr;
d311d28c
PE
2731 ptrdiff_t next = ZV;
2732 ptrdiff_t prev = BEGV;
74514898 2733 int inhibit_storing = 0;
7723e095 2734 int end_is_Z = end == Z;
74514898 2735
2410d73a 2736 for (tail = current_buffer->overlays_before; tail; tail = tail->next)
74514898 2737 {
d311d28c 2738 ptrdiff_t startpos, endpos;
74514898 2739
2410d73a 2740 XSETMISC (overlay, tail);
74514898
RS
2741
2742 ostart = OVERLAY_START (overlay);
2743 oend = OVERLAY_END (overlay);
2744 endpos = OVERLAY_POSITION (oend);
2745 if (endpos < beg)
2746 {
2747 if (prev < endpos)
2748 prev = endpos;
2749 break;
2750 }
2751 startpos = OVERLAY_POSITION (ostart);
7723e095
MR
2752 /* Count an interval if it overlaps the range, is empty at the
2753 start of the range, or is empty at END provided END denotes the
2754 end of the buffer. */
74514898 2755 if ((beg < endpos && startpos < end)
7723e095
MR
2756 || (startpos == endpos
2757 && (beg == endpos || (end_is_Z && endpos == end))))
74514898
RS
2758 {
2759 if (idx == len)
2760 {
2761 /* The supplied vector is full.
2762 Either make it bigger, or don't store any more in it. */
2763 if (extend)
2764 {
0065d054
PE
2765 vec = xpalloc (vec, len_ptr, 1, OVERLAY_COUNT_MAX,
2766 sizeof *vec);
74514898 2767 *vec_ptr = vec;
0065d054 2768 len = *len_ptr;
74514898
RS
2769 }
2770 else
2771 inhibit_storing = 1;
2772 }
2773
2774 if (!inhibit_storing)
2775 vec[idx] = overlay;
2776 /* Keep counting overlays even if we can't return them all. */
2777 idx++;
2778 }
2779 else if (startpos < next)
2780 next = startpos;
2781 }
2782
2410d73a 2783 for (tail = current_buffer->overlays_after; tail; tail = tail->next)
74514898 2784 {
d311d28c 2785 ptrdiff_t startpos, endpos;
74514898 2786
2410d73a 2787 XSETMISC (overlay, tail);
74514898
RS
2788
2789 ostart = OVERLAY_START (overlay);
2790 oend = OVERLAY_END (overlay);
2791 startpos = OVERLAY_POSITION (ostart);
2792 if (end < startpos)
2793 {
2794 if (startpos < next)
2795 next = startpos;
2796 break;
2797 }
2798 endpos = OVERLAY_POSITION (oend);
7723e095
MR
2799 /* Count an interval if it overlaps the range, is empty at the
2800 start of the range, or is empty at END provided END denotes the
2801 end of the buffer. */
74514898 2802 if ((beg < endpos && startpos < end)
7723e095
MR
2803 || (startpos == endpos
2804 && (beg == endpos || (end_is_Z && endpos == end))))
74514898
RS
2805 {
2806 if (idx == len)
2807 {
2808 if (extend)
2809 {
0065d054
PE
2810 vec = xpalloc (vec, len_ptr, 1, OVERLAY_COUNT_MAX,
2811 sizeof *vec);
74514898 2812 *vec_ptr = vec;
0065d054 2813 len = *len_ptr;
74514898
RS
2814 }
2815 else
2816 inhibit_storing = 1;
2817 }
2818
2819 if (!inhibit_storing)
2820 vec[idx] = overlay;
2821 idx++;
2822 }
2823 else if (endpos < beg && endpos > prev)
2824 prev = endpos;
2825 }
fc04fa47 2826
74514898
RS
2827 if (next_ptr)
2828 *next_ptr = next;
2829 if (prev_ptr)
2830 *prev_ptr = prev;
2831 return idx;
2832}
09a22085
GM
2833
2834
2835/* Return non-zero if there exists an overlay with a non-nil
2836 `mouse-face' property overlapping OVERLAY. */
2837
2838int
d3da34e0 2839mouse_face_overlay_overlaps (Lisp_Object overlay)
09a22085 2840{
d311d28c
PE
2841 ptrdiff_t start = OVERLAY_POSITION (OVERLAY_START (overlay));
2842 ptrdiff_t end = OVERLAY_POSITION (OVERLAY_END (overlay));
21514da7 2843 ptrdiff_t n, i, size;
09a22085 2844 Lisp_Object *v, tem;
177c0ea7 2845
bfd8410f 2846 size = 10;
38182d90 2847 v = alloca (size * sizeof *v);
bfd8410f
GM
2848 n = overlays_in (start, end, 0, &v, &size, NULL, NULL);
2849 if (n > size)
09a22085 2850 {
38182d90 2851 v = alloca (n * sizeof *v);
09a22085
GM
2852 overlays_in (start, end, 0, &v, &n, NULL, NULL);
2853 }
2854
2855 for (i = 0; i < n; ++i)
2856 if (!EQ (v[i], overlay)
2857 && (tem = Foverlay_get (overlay, Qmouse_face),
2858 !NILP (tem)))
2859 break;
2860
2861 return i < n;
2862}
2863
2864
74514898 2865\f
fc04fa47
KH
2866/* Fast function to just test if we're at an overlay boundary. */
2867int
d311d28c 2868overlay_touches_p (ptrdiff_t pos)
fc04fa47 2869{
2410d73a
SM
2870 Lisp_Object overlay;
2871 struct Lisp_Overlay *tail;
fc04fa47 2872
2410d73a 2873 for (tail = current_buffer->overlays_before; tail; tail = tail->next)
fc04fa47 2874 {
d311d28c 2875 ptrdiff_t endpos;
fc04fa47 2876
2410d73a 2877 XSETMISC (overlay ,tail);
22657b40 2878 eassert (OVERLAYP (overlay));
fc04fa47
KH
2879
2880 endpos = OVERLAY_POSITION (OVERLAY_END (overlay));
2881 if (endpos < pos)
2882 break;
2883 if (endpos == pos || OVERLAY_POSITION (OVERLAY_START (overlay)) == pos)
2884 return 1;
2885 }
2886
2410d73a 2887 for (tail = current_buffer->overlays_after; tail; tail = tail->next)
fc04fa47 2888 {
d311d28c 2889 ptrdiff_t startpos;
fc04fa47 2890
2410d73a 2891 XSETMISC (overlay, tail);
22657b40 2892 eassert (OVERLAYP (overlay));
fc04fa47
KH
2893
2894 startpos = OVERLAY_POSITION (OVERLAY_START (overlay));
2895 if (pos < startpos)
2896 break;
2897 if (startpos == pos || OVERLAY_POSITION (OVERLAY_END (overlay)) == pos)
2898 return 1;
2899 }
2900 return 0;
2901}
2eec3b4e 2902\f
5985d248
KH
2903struct sortvec
2904{
2905 Lisp_Object overlay;
d311d28c 2906 ptrdiff_t beg, end;
fadf4e30 2907 EMACS_INT priority;
5985d248
KH
2908};
2909
2910static int
d3da34e0 2911compare_overlays (const void *v1, const void *v2)
5985d248 2912{
dfcf069d
AS
2913 const struct sortvec *s1 = (const struct sortvec *) v1;
2914 const struct sortvec *s2 = (const struct sortvec *) v2;
5985d248 2915 if (s1->priority != s2->priority)
c20998a7 2916 return s1->priority < s2->priority ? -1 : 1;
5985d248 2917 if (s1->beg != s2->beg)
c20998a7 2918 return s1->beg < s2->beg ? -1 : 1;
5985d248 2919 if (s1->end != s2->end)
c20998a7 2920 return s2->end < s1->end ? -1 : 1;
cae07000
SM
2921 /* Avoid the non-determinism of qsort by choosing an arbitrary ordering
2922 between "equal" overlays. The result can still change between
2923 invocations of Emacs, but it won't change in the middle of
2924 `find_field' (bug#6830). */
9af5ed87
PE
2925 if (XHASH (s1->overlay) != XHASH (s2->overlay))
2926 return XHASH (s1->overlay) < XHASH (s2->overlay) ? -1 : 1;
5985d248
KH
2927 return 0;
2928}
2929
2930/* Sort an array of overlays by priority. The array is modified in place.
2931 The return value is the new size; this may be smaller than the original
2932 size if some of the overlays were invalid or were window-specific. */
b081724f
PE
2933ptrdiff_t
2934sort_overlays (Lisp_Object *overlay_vec, ptrdiff_t noverlays, struct window *w)
5985d248 2935{
b081724f 2936 ptrdiff_t i, j;
38182d90 2937 struct sortvec *sortvec = alloca (noverlays * sizeof *sortvec);
5985d248
KH
2938
2939 /* Put the valid and relevant overlays into sortvec. */
2940
2941 for (i = 0, j = 0; i < noverlays; i++)
2942 {
0fa767e7 2943 Lisp_Object tem;
c99fc30f 2944 Lisp_Object overlay;
5985d248 2945
c99fc30f 2946 overlay = overlay_vec[i];
22657b40 2947 if (OVERLAYP (overlay)
5985d248
KH
2948 && OVERLAY_POSITION (OVERLAY_START (overlay)) > 0
2949 && OVERLAY_POSITION (OVERLAY_END (overlay)) > 0)
2950 {
0fa767e7
KH
2951 /* If we're interested in a specific window, then ignore
2952 overlays that are limited to some other window. */
2953 if (w)
5985d248 2954 {
28545e04 2955 Lisp_Object window;
0fa767e7
KH
2956
2957 window = Foverlay_get (overlay, Qwindow);
28545e04 2958 if (WINDOWP (window) && XWINDOW (window) != w)
0fa767e7 2959 continue;
5985d248 2960 }
0fa767e7
KH
2961
2962 /* This overlay is good and counts: put it into sortvec. */
2963 sortvec[j].overlay = overlay;
2964 sortvec[j].beg = OVERLAY_POSITION (OVERLAY_START (overlay));
2965 sortvec[j].end = OVERLAY_POSITION (OVERLAY_END (overlay));
2966 tem = Foverlay_get (overlay, Qpriority);
2967 if (INTEGERP (tem))
2968 sortvec[j].priority = XINT (tem);
2969 else
2970 sortvec[j].priority = 0;
2971 j++;
5985d248
KH
2972 }
2973 }
2974 noverlays = j;
2975
2976 /* Sort the overlays into the proper order: increasing priority. */
2977
2978 if (noverlays > 1)
2979 qsort (sortvec, noverlays, sizeof (struct sortvec), compare_overlays);
2980
2981 for (i = 0; i < noverlays; i++)
2982 overlay_vec[i] = sortvec[i].overlay;
2983 return (noverlays);
2984}
2985\f
bbbe9545
KH
2986struct sortstr
2987{
cb26008f 2988 Lisp_Object string, string2;
93cb6be3 2989 ptrdiff_t size;
8961a454 2990 EMACS_INT priority;
bbbe9545
KH
2991};
2992
e8185fa8
KH
2993struct sortstrlist
2994{
2995 struct sortstr *buf; /* An array that expands as needed; never freed. */
67c36fce
PE
2996 ptrdiff_t size; /* Allocated length of that array. */
2997 ptrdiff_t used; /* How much of the array is currently in use. */
0065d054 2998 ptrdiff_t bytes; /* Total length of the strings in buf. */
e8185fa8
KH
2999};
3000
3001/* Buffers for storing information about the overlays touching a given
3002 position. These could be automatic variables in overlay_strings, but
3003 it's more efficient to hold onto the memory instead of repeatedly
3004 allocating and freeing it. */
3005static struct sortstrlist overlay_heads, overlay_tails;
9492daf2 3006static unsigned char *overlay_str_buf;
e8185fa8
KH
3007
3008/* Allocated length of overlay_str_buf. */
fe5c5d37 3009static ptrdiff_t overlay_str_len;
e8185fa8 3010
bbbe9545
KH
3011/* A comparison function suitable for passing to qsort. */
3012static int
d3da34e0 3013cmp_for_strings (const void *as1, const void *as2)
bbbe9545
KH
3014{
3015 struct sortstr *s1 = (struct sortstr *)as1;
3016 struct sortstr *s2 = (struct sortstr *)as2;
3017 if (s1->size != s2->size)
c20998a7 3018 return s2->size < s1->size ? -1 : 1;
bbbe9545 3019 if (s1->priority != s2->priority)
c20998a7 3020 return s1->priority < s2->priority ? -1 : 1;
bbbe9545
KH
3021 return 0;
3022}
3023
e8185fa8 3024static void
93cb6be3
PE
3025record_overlay_string (struct sortstrlist *ssl, Lisp_Object str,
3026 Lisp_Object str2, Lisp_Object pri, ptrdiff_t size)
e8185fa8 3027{
d311d28c 3028 ptrdiff_t nbytes;
43d27a72 3029
e8185fa8 3030 if (ssl->used == ssl->size)
0065d054 3031 ssl->buf = xpalloc (ssl->buf, &ssl->size, 5, -1, sizeof *ssl->buf);
e8185fa8 3032 ssl->buf[ssl->used].string = str;
cb26008f 3033 ssl->buf[ssl->used].string2 = str2;
e8185fa8
KH
3034 ssl->buf[ssl->used].size = size;
3035 ssl->buf[ssl->used].priority = (INTEGERP (pri) ? XINT (pri) : 0);
3036 ssl->used++;
43d27a72 3037
4b4deea2 3038 if (NILP (BVAR (current_buffer, enable_multibyte_characters)))
d5db4077 3039 nbytes = SCHARS (str);
43d27a72 3040 else if (! STRING_MULTIBYTE (str))
d5db4077
KR
3041 nbytes = count_size_as_multibyte (SDATA (str),
3042 SBYTES (str));
43d27a72 3043 else
d5db4077 3044 nbytes = SBYTES (str);
43d27a72 3045
0065d054
PE
3046 if (INT_ADD_OVERFLOW (ssl->bytes, nbytes))
3047 memory_full (SIZE_MAX);
43d27a72
RS
3048 ssl->bytes += nbytes;
3049
cb26008f 3050 if (STRINGP (str2))
43d27a72 3051 {
4b4deea2 3052 if (NILP (BVAR (current_buffer, enable_multibyte_characters)))
d5db4077 3053 nbytes = SCHARS (str2);
43d27a72 3054 else if (! STRING_MULTIBYTE (str2))
d5db4077
KR
3055 nbytes = count_size_as_multibyte (SDATA (str2),
3056 SBYTES (str2));
43d27a72 3057 else
d5db4077 3058 nbytes = SBYTES (str2);
43d27a72 3059
0065d054
PE
3060 if (INT_ADD_OVERFLOW (ssl->bytes, nbytes))
3061 memory_full (SIZE_MAX);
43d27a72
RS
3062 ssl->bytes += nbytes;
3063 }
e8185fa8 3064}
bbbe9545
KH
3065
3066/* Return the concatenation of the strings associated with overlays that
3067 begin or end at POS, ignoring overlays that are specific to a window
3068 other than W. The strings are concatenated in the appropriate order:
3069 shorter overlays nest inside longer ones, and higher priority inside
cb26008f
KH
3070 lower. Normally all of the after-strings come first, but zero-sized
3071 overlays have their after-strings ride along with the before-strings
3072 because it would look strange to print them inside-out.
3073
3074 Returns the string length, and stores the contents indirectly through
3075 PSTR, if that variable is non-null. The string may be overwritten by
3076 subsequent calls. */
6b5d3b89 3077
d311d28c
PE
3078ptrdiff_t
3079overlay_strings (ptrdiff_t pos, struct window *w, unsigned char **pstr)
bbbe9545 3080{
28545e04 3081 Lisp_Object overlay, window, str;
2410d73a 3082 struct Lisp_Overlay *ov;
d311d28c 3083 ptrdiff_t startpos, endpos;
4b4deea2 3084 int multibyte = ! NILP (BVAR (current_buffer, enable_multibyte_characters));
bbbe9545 3085
e8185fa8
KH
3086 overlay_heads.used = overlay_heads.bytes = 0;
3087 overlay_tails.used = overlay_tails.bytes = 0;
2410d73a 3088 for (ov = current_buffer->overlays_before; ov; ov = ov->next)
bbbe9545 3089 {
2410d73a 3090 XSETMISC (overlay, ov);
c2d5b10f 3091 eassert (OVERLAYP (overlay));
bbbe9545
KH
3092
3093 startpos = OVERLAY_POSITION (OVERLAY_START (overlay));
3094 endpos = OVERLAY_POSITION (OVERLAY_END (overlay));
3095 if (endpos < pos)
3096 break;
3097 if (endpos != pos && startpos != pos)
3098 continue;
3099 window = Foverlay_get (overlay, Qwindow);
28545e04 3100 if (WINDOWP (window) && XWINDOW (window) != w)
bbbe9545 3101 continue;
e8185fa8
KH
3102 if (startpos == pos
3103 && (str = Foverlay_get (overlay, Qbefore_string), STRINGP (str)))
3104 record_overlay_string (&overlay_heads, str,
cb26008f
KH
3105 (startpos == endpos
3106 ? Foverlay_get (overlay, Qafter_string)
3107 : Qnil),
3108 Foverlay_get (overlay, Qpriority),
3109 endpos - startpos);
3110 else if (endpos == pos
3111 && (str = Foverlay_get (overlay, Qafter_string), STRINGP (str)))
3112 record_overlay_string (&overlay_tails, str, Qnil,
e8185fa8
KH
3113 Foverlay_get (overlay, Qpriority),
3114 endpos - startpos);
bbbe9545 3115 }
2410d73a 3116 for (ov = current_buffer->overlays_after; ov; ov = ov->next)
bbbe9545 3117 {
2410d73a
SM
3118 XSETMISC (overlay, ov);
3119 eassert (OVERLAYP (overlay));
bbbe9545
KH
3120
3121 startpos = OVERLAY_POSITION (OVERLAY_START (overlay));
3122 endpos = OVERLAY_POSITION (OVERLAY_END (overlay));
3123 if (startpos > pos)
3124 break;
e8185fa8
KH
3125 if (endpos != pos && startpos != pos)
3126 continue;
3127 window = Foverlay_get (overlay, Qwindow);
28545e04 3128 if (WINDOWP (window) && XWINDOW (window) != w)
e8185fa8 3129 continue;
e8185fa8
KH
3130 if (startpos == pos
3131 && (str = Foverlay_get (overlay, Qbefore_string), STRINGP (str)))
3132 record_overlay_string (&overlay_heads, str,
cb26008f
KH
3133 (startpos == endpos
3134 ? Foverlay_get (overlay, Qafter_string)
3135 : Qnil),
3136 Foverlay_get (overlay, Qpriority),
3137 endpos - startpos);
3138 else if (endpos == pos
3139 && (str = Foverlay_get (overlay, Qafter_string), STRINGP (str)))
3140 record_overlay_string (&overlay_tails, str, Qnil,
e8185fa8
KH
3141 Foverlay_get (overlay, Qpriority),
3142 endpos - startpos);
bbbe9545 3143 }
e8185fa8
KH
3144 if (overlay_tails.used > 1)
3145 qsort (overlay_tails.buf, overlay_tails.used, sizeof (struct sortstr),
3146 cmp_for_strings);
3147 if (overlay_heads.used > 1)
3148 qsort (overlay_heads.buf, overlay_heads.used, sizeof (struct sortstr),
3149 cmp_for_strings);
3150 if (overlay_heads.bytes || overlay_tails.bytes)
bbbe9545 3151 {
e8185fa8 3152 Lisp_Object tem;
d311d28c 3153 ptrdiff_t i;
9f4d7cde 3154 unsigned char *p;
0065d054 3155 ptrdiff_t total;
bbbe9545 3156
0065d054
PE
3157 if (INT_ADD_OVERFLOW (overlay_heads.bytes, overlay_tails.bytes))
3158 memory_full (SIZE_MAX);
3159 total = overlay_heads.bytes + overlay_tails.bytes;
bbbe9545 3160 if (total > overlay_str_len)
0065d054
PE
3161 overlay_str_buf = xpalloc (overlay_str_buf, &overlay_str_len,
3162 total - overlay_str_len, -1, 1);
3163
bbbe9545 3164 p = overlay_str_buf;
e8185fa8 3165 for (i = overlay_tails.used; --i >= 0;)
bbbe9545 3166 {
d311d28c 3167 ptrdiff_t nbytes;
e8185fa8 3168 tem = overlay_tails.buf[i].string;
d5db4077
KR
3169 nbytes = copy_text (SDATA (tem), p,
3170 SBYTES (tem),
43d27a72
RS
3171 STRING_MULTIBYTE (tem), multibyte);
3172 p += nbytes;
bbbe9545 3173 }
e8185fa8 3174 for (i = 0; i < overlay_heads.used; ++i)
bbbe9545 3175 {
d311d28c 3176 ptrdiff_t nbytes;
e8185fa8 3177 tem = overlay_heads.buf[i].string;
d5db4077
KR
3178 nbytes = copy_text (SDATA (tem), p,
3179 SBYTES (tem),
43d27a72
RS
3180 STRING_MULTIBYTE (tem), multibyte);
3181 p += nbytes;
cb26008f
KH
3182 tem = overlay_heads.buf[i].string2;
3183 if (STRINGP (tem))
3184 {
d5db4077
KR
3185 nbytes = copy_text (SDATA (tem), p,
3186 SBYTES (tem),
43d27a72
RS
3187 STRING_MULTIBYTE (tem), multibyte);
3188 p += nbytes;
cb26008f 3189 }
bbbe9545 3190 }
cb26008f
KH
3191 if (p != overlay_str_buf + total)
3192 abort ();
bbbe9545
KH
3193 if (pstr)
3194 *pstr = overlay_str_buf;
e8185fa8 3195 return total;
bbbe9545 3196 }
e8185fa8 3197 return 0;
bbbe9545
KH
3198}
3199\f
5c4f68f1 3200/* Shift overlays in BUF's overlay lists, to center the lists at POS. */
1ab256cb 3201
2eec3b4e 3202void
d311d28c 3203recenter_overlay_lists (struct buffer *buf, ptrdiff_t pos)
2eec3b4e 3204{
2410d73a
SM
3205 Lisp_Object overlay, beg, end;
3206 struct Lisp_Overlay *prev, *tail, *next;
2eec3b4e
RS
3207
3208 /* See if anything in overlays_before should move to overlays_after. */
3209
3210 /* We don't strictly need prev in this loop; it should always be nil.
3211 But we use it for symmetry and in case that should cease to be true
3212 with some future change. */
2410d73a
SM
3213 prev = NULL;
3214 for (tail = buf->overlays_before; tail; prev = tail, tail = next)
1ab256cb 3215 {
2410d73a
SM
3216 next = tail->next;
3217 XSETMISC (overlay, tail);
22657b40 3218 eassert (OVERLAYP (overlay));
1ab256cb 3219
2eec3b4e
RS
3220 beg = OVERLAY_START (overlay);
3221 end = OVERLAY_END (overlay);
1ab256cb 3222
2eec3b4e 3223 if (OVERLAY_POSITION (end) > pos)
1ab256cb 3224 {
2eec3b4e 3225 /* OVERLAY needs to be moved. */
d311d28c 3226 ptrdiff_t where = OVERLAY_POSITION (beg);
2410d73a 3227 struct Lisp_Overlay *other, *other_prev;
2eec3b4e
RS
3228
3229 /* Splice the cons cell TAIL out of overlays_before. */
2410d73a
SM
3230 if (prev)
3231 prev->next = next;
2eec3b4e 3232 else
5c4f68f1 3233 buf->overlays_before = next;
2eec3b4e
RS
3234
3235 /* Search thru overlays_after for where to put it. */
2410d73a
SM
3236 other_prev = NULL;
3237 for (other = buf->overlays_after; other;
3238 other_prev = other, other = other->next)
1ab256cb 3239 {
6af718a4 3240 Lisp_Object otherbeg, otheroverlay;
2eec3b4e 3241
2410d73a 3242 XSETMISC (otheroverlay, other);
22657b40 3243 eassert (OVERLAYP (otheroverlay));
2eec3b4e
RS
3244
3245 otherbeg = OVERLAY_START (otheroverlay);
3246 if (OVERLAY_POSITION (otherbeg) >= where)
3247 break;
1ab256cb 3248 }
2eec3b4e
RS
3249
3250 /* Add TAIL to overlays_after before OTHER. */
2410d73a
SM
3251 tail->next = other;
3252 if (other_prev)
3253 other_prev->next = tail;
1ab256cb 3254 else
5c4f68f1 3255 buf->overlays_after = tail;
2eec3b4e 3256 tail = prev;
1ab256cb 3257 }
2eec3b4e
RS
3258 else
3259 /* We've reached the things that should stay in overlays_before.
3260 All the rest of overlays_before must end even earlier,
3261 so stop now. */
3262 break;
3263 }
3264
3265 /* See if anything in overlays_after should be in overlays_before. */
2410d73a
SM
3266 prev = NULL;
3267 for (tail = buf->overlays_after; tail; prev = tail, tail = next)
2eec3b4e 3268 {
2410d73a
SM
3269 next = tail->next;
3270 XSETMISC (overlay, tail);
22657b40 3271 eassert (OVERLAYP (overlay));
2eec3b4e
RS
3272
3273 beg = OVERLAY_START (overlay);
3274 end = OVERLAY_END (overlay);
3275
3276 /* Stop looking, when we know that nothing further
3277 can possibly end before POS. */
3278 if (OVERLAY_POSITION (beg) > pos)
3279 break;
3280
3281 if (OVERLAY_POSITION (end) <= pos)
3282 {
3283 /* OVERLAY needs to be moved. */
d311d28c 3284 ptrdiff_t where = OVERLAY_POSITION (end);
2410d73a 3285 struct Lisp_Overlay *other, *other_prev;
2eec3b4e
RS
3286
3287 /* Splice the cons cell TAIL out of overlays_after. */
2410d73a
SM
3288 if (prev)
3289 prev->next = next;
2eec3b4e 3290 else
5c4f68f1 3291 buf->overlays_after = next;
2eec3b4e
RS
3292
3293 /* Search thru overlays_before for where to put it. */
2410d73a
SM
3294 other_prev = NULL;
3295 for (other = buf->overlays_before; other;
3296 other_prev = other, other = other->next)
2eec3b4e
RS
3297 {
3298 Lisp_Object otherend, otheroverlay;
2eec3b4e 3299
2410d73a 3300 XSETMISC (otheroverlay, other);
22657b40 3301 eassert (OVERLAYP (otheroverlay));
2eec3b4e
RS
3302
3303 otherend = OVERLAY_END (otheroverlay);
3304 if (OVERLAY_POSITION (otherend) <= where)
3305 break;
3306 }
3307
3308 /* Add TAIL to overlays_before before OTHER. */
2410d73a
SM
3309 tail->next = other;
3310 if (other_prev)
3311 other_prev->next = tail;
2eec3b4e 3312 else
5c4f68f1 3313 buf->overlays_before = tail;
2eec3b4e
RS
3314 tail = prev;
3315 }
3316 }
3317
c2d5b10f 3318 buf->overlay_center = pos;
2eec3b4e 3319}
2b1bdf65 3320
423cdb46 3321void
d311d28c 3322adjust_overlays_for_insert (ptrdiff_t pos, ptrdiff_t length)
423cdb46
KH
3323{
3324 /* After an insertion, the lists are still sorted properly,
3325 but we may need to update the value of the overlay center. */
c2d5b10f
SM
3326 if (current_buffer->overlay_center >= pos)
3327 current_buffer->overlay_center += length;
423cdb46
KH
3328}
3329
3330void
d311d28c 3331adjust_overlays_for_delete (ptrdiff_t pos, ptrdiff_t length)
423cdb46 3332{
c2d5b10f 3333 if (current_buffer->overlay_center < pos)
423cdb46
KH
3334 /* The deletion was to our right. No change needed; the before- and
3335 after-lists are still consistent. */
3336 ;
d311d28c 3337 else if (current_buffer->overlay_center - pos > length)
423cdb46
KH
3338 /* The deletion was to our left. We need to adjust the center value
3339 to account for the change in position, but the lists are consistent
3340 given the new value. */
c2d5b10f 3341 current_buffer->overlay_center -= length;
423cdb46
KH
3342 else
3343 /* We're right in the middle. There might be things on the after-list
3344 that now belong on the before-list. Recentering will move them,
3345 and also update the center point. */
3346 recenter_overlay_lists (current_buffer, pos);
3347}
3348
2b1bdf65
KH
3349/* Fix up overlays that were garbled as a result of permuting markers
3350 in the range START through END. Any overlay with at least one
3351 endpoint in this range will need to be unlinked from the overlay
3352 list and reinserted in its proper place.
3353 Such an overlay might even have negative size at this point.
6b61353c 3354 If so, we'll make the overlay empty. */
2b1bdf65 3355void
d311d28c 3356fix_start_end_in_overlays (register ptrdiff_t start, register ptrdiff_t end)
2b1bdf65 3357{
6af718a4 3358 Lisp_Object overlay;
5df8f01b
PE
3359 struct Lisp_Overlay *before_list IF_LINT (= NULL);
3360 struct Lisp_Overlay *after_list IF_LINT (= NULL);
1138e742
KR
3361 /* These are either nil, indicating that before_list or after_list
3362 should be assigned, or the cons cell the cdr of which should be
3363 assigned. */
2410d73a 3364 struct Lisp_Overlay *beforep = NULL, *afterp = NULL;
1138e742
KR
3365 /* 'Parent', likewise, indicates a cons cell or
3366 current_buffer->overlays_before or overlays_after, depending
3367 which loop we're in. */
2410d73a 3368 struct Lisp_Overlay *tail, *parent;
d311d28c 3369 ptrdiff_t startpos, endpos;
2b1bdf65
KH
3370
3371 /* This algorithm shifts links around instead of consing and GCing.
3372 The loop invariant is that before_list (resp. after_list) is a
1138e742
KR
3373 well-formed list except that its last element, the CDR of beforep
3374 (resp. afterp) if beforep (afterp) isn't nil or before_list
3375 (after_list) if it is, is still uninitialized. So it's not a bug
3376 that before_list isn't initialized, although it may look
3377 strange. */
2410d73a 3378 for (parent = NULL, tail = current_buffer->overlays_before; tail;)
2b1bdf65 3379 {
2410d73a 3380 XSETMISC (overlay, tail);
6b61353c 3381
2b1bdf65 3382 endpos = OVERLAY_POSITION (OVERLAY_END (overlay));
6b61353c
KH
3383 startpos = OVERLAY_POSITION (OVERLAY_START (overlay));
3384
3385 /* If the overlay is backwards, make it empty. */
3386 if (endpos < startpos)
3387 {
3388 startpos = endpos;
3389 Fset_marker (OVERLAY_START (overlay), make_number (startpos),
3390 Qnil);
3391 }
3392
2b1bdf65
KH
3393 if (endpos < start)
3394 break;
60ebfdf3 3395
2b1bdf65
KH
3396 if (endpos < end
3397 || (startpos >= start && startpos < end))
3398 {
2b1bdf65
KH
3399 /* Add it to the end of the wrong list. Later on,
3400 recenter_overlay_lists will move it to the right place. */
c2d5b10f 3401 if (endpos < current_buffer->overlay_center)
2b1bdf65 3402 {
2410d73a 3403 if (!afterp)
1138e742
KR
3404 after_list = tail;
3405 else
2410d73a 3406 afterp->next = tail;
1138e742 3407 afterp = tail;
2b1bdf65
KH
3408 }
3409 else
3410 {
2410d73a 3411 if (!beforep)
1138e742
KR
3412 before_list = tail;
3413 else
2410d73a 3414 beforep->next = tail;
1138e742 3415 beforep = tail;
2b1bdf65 3416 }
2410d73a
SM
3417 if (!parent)
3418 current_buffer->overlays_before = tail->next;
1138e742 3419 else
2410d73a
SM
3420 parent->next = tail->next;
3421 tail = tail->next;
2b1bdf65
KH
3422 }
3423 else
2410d73a 3424 parent = tail, tail = parent->next;
2b1bdf65 3425 }
2410d73a 3426 for (parent = NULL, tail = current_buffer->overlays_after; tail;)
2b1bdf65 3427 {
2410d73a 3428 XSETMISC (overlay, tail);
6b61353c 3429
2b1bdf65 3430 startpos = OVERLAY_POSITION (OVERLAY_START (overlay));
6b61353c
KH
3431 endpos = OVERLAY_POSITION (OVERLAY_END (overlay));
3432
3433 /* If the overlay is backwards, make it empty. */
3434 if (endpos < startpos)
3435 {
3436 startpos = endpos;
3437 Fset_marker (OVERLAY_START (overlay), make_number (startpos),
60ebfdf3 3438 Qnil);
6b61353c
KH
3439 }
3440
2b1bdf65
KH
3441 if (startpos >= end)
3442 break;
6b61353c 3443
2b1bdf65
KH
3444 if (startpos >= start
3445 || (endpos >= start && endpos < end))
3446 {
c2d5b10f 3447 if (endpos < current_buffer->overlay_center)
2b1bdf65 3448 {
2410d73a 3449 if (!afterp)
1138e742
KR
3450 after_list = tail;
3451 else
2410d73a 3452 afterp->next = tail;
1138e742 3453 afterp = tail;
2b1bdf65
KH
3454 }
3455 else
3456 {
2410d73a 3457 if (!beforep)
1138e742
KR
3458 before_list = tail;
3459 else
2410d73a 3460 beforep->next = tail;
1138e742 3461 beforep = tail;
2b1bdf65 3462 }
2410d73a
SM
3463 if (!parent)
3464 current_buffer->overlays_after = tail->next;
1138e742 3465 else
2410d73a
SM
3466 parent->next = tail->next;
3467 tail = tail->next;
2b1bdf65
KH
3468 }
3469 else
2410d73a 3470 parent = tail, tail = parent->next;
2b1bdf65
KH
3471 }
3472
3473 /* Splice the constructed (wrong) lists into the buffer's lists,
3474 and let the recenter function make it sane again. */
2410d73a 3475 if (beforep)
1138e742 3476 {
2410d73a 3477 beforep->next = current_buffer->overlays_before;
1138e742
KR
3478 current_buffer->overlays_before = before_list;
3479 }
c2d5b10f 3480 recenter_overlay_lists (current_buffer, current_buffer->overlay_center);
2b1bdf65 3481
2410d73a 3482 if (afterp)
1138e742 3483 {
2410d73a 3484 afterp->next = current_buffer->overlays_after;
1138e742
KR
3485 current_buffer->overlays_after = after_list;
3486 }
c2d5b10f 3487 recenter_overlay_lists (current_buffer, current_buffer->overlay_center);
2b1bdf65 3488}
3b06f880
KH
3489
3490/* We have two types of overlay: the one whose ending marker is
3491 after-insertion-marker (this is the usual case) and the one whose
3492 ending marker is before-insertion-marker. When `overlays_before'
3493 contains overlays of the latter type and the former type in this
3494 order and both overlays end at inserting position, inserting a text
3495 increases only the ending marker of the latter type, which results
3496 in incorrect ordering of `overlays_before'.
3497
3498 This function fixes ordering of overlays in the slot
3499 `overlays_before' of the buffer *BP. Before the insertion, `point'
3500 was at PREV, and now is at POS. */
3501
01136e9b 3502void
d311d28c 3503fix_overlays_before (struct buffer *bp, ptrdiff_t prev, ptrdiff_t pos)
3b06f880 3504{
2410d73a
SM
3505 /* If parent is nil, replace overlays_before; otherwise, parent->next. */
3506 struct Lisp_Overlay *tail = bp->overlays_before, *parent = NULL, *right_pair;
3507 Lisp_Object tem;
d311d28c 3508 ptrdiff_t end IF_LINT (= 0);
3b06f880
KH
3509
3510 /* After the insertion, the several overlays may be in incorrect
3511 order. The possibility is that, in the list `overlays_before',
3512 an overlay which ends at POS appears after an overlay which ends
3513 at PREV. Since POS is greater than PREV, we must fix the
3514 ordering of these overlays, by moving overlays ends at POS before
3515 the overlays ends at PREV. */
3516
3517 /* At first, find a place where disordered overlays should be linked
3518 in. It is where an overlay which end before POS exists. (i.e. an
3519 overlay whose ending marker is after-insertion-marker if disorder
3520 exists). */
2410d73a
SM
3521 while (tail
3522 && (XSETMISC (tem, tail),
3523 (end = OVERLAY_POSITION (OVERLAY_END (tem))) >= pos))
1138e742
KR
3524 {
3525 parent = tail;
2410d73a 3526 tail = tail->next;
1138e742 3527 }
3b06f880
KH
3528
3529 /* If we don't find such an overlay,
3530 or the found one ends before PREV,
3531 or the found one is the last one in the list,
3532 we don't have to fix anything. */
f93ad4cf 3533 if (!tail || end < prev || !tail->next)
3b06f880
KH
3534 return;
3535
1138e742
KR
3536 right_pair = parent;
3537 parent = tail;
2410d73a 3538 tail = tail->next;
3b06f880 3539
1138e742 3540 /* Now, end position of overlays in the list TAIL should be before
3b06f880 3541 or equal to PREV. In the loop, an overlay which ends at POS is
1138e742
KR
3542 moved ahead to the place indicated by the CDR of RIGHT_PAIR. If
3543 we found an overlay which ends before PREV, the remaining
3544 overlays are in correct order. */
2410d73a 3545 while (tail)
3b06f880 3546 {
2410d73a
SM
3547 XSETMISC (tem, tail);
3548 end = OVERLAY_POSITION (OVERLAY_END (tem));
3b06f880
KH
3549
3550 if (end == pos)
3551 { /* This overlay is disordered. */
2410d73a 3552 struct Lisp_Overlay *found = tail;
3b06f880
KH
3553
3554 /* Unlink the found overlay. */
2410d73a
SM
3555 tail = found->next;
3556 parent->next = tail;
1138e742
KR
3557 /* Move an overlay at RIGHT_PLACE to the next of the found one,
3558 and link it into the right place. */
2410d73a 3559 if (!right_pair)
1138e742 3560 {
2410d73a 3561 found->next = bp->overlays_before;
1138e742
KR
3562 bp->overlays_before = found;
3563 }
3564 else
3565 {
2410d73a
SM
3566 found->next = right_pair->next;
3567 right_pair->next = found;
1138e742 3568 }
3b06f880
KH
3569 }
3570 else if (end == prev)
1138e742
KR
3571 {
3572 parent = tail;
2410d73a 3573 tail = tail->next;
1138e742 3574 }
3b06f880
KH
3575 else /* No more disordered overlay. */
3576 break;
3577 }
3578}
2eec3b4e 3579\f
52f8ec73 3580DEFUN ("overlayp", Foverlayp, Soverlayp, 1, 1, 0,
7ee72033 3581 doc: /* Return t if OBJECT is an overlay. */)
5842a27b 3582 (Lisp_Object object)
52f8ec73
JB
3583{
3584 return (OVERLAYP (object) ? Qt : Qnil);
3585}
3586
acac2700 3587DEFUN ("make-overlay", Fmake_overlay, Smake_overlay, 2, 5, 0,
7ee72033 3588 doc: /* Create a new overlay with range BEG to END in BUFFER.
018ba359
PJ
3589If omitted, BUFFER defaults to the current buffer.
3590BEG and END may be integers or markers.
a625ee20
RS
3591The fourth arg FRONT-ADVANCE, if non-nil, makes the marker
3592for the front of the overlay advance when text is inserted there
63af6055 3593\(which means the text *is not* included in the overlay).
a625ee20
RS
3594The fifth arg REAR-ADVANCE, if non-nil, makes the marker
3595for the rear of the overlay advance when text is inserted there
63af6055 3596\(which means the text *is* included in the overlay). */)
5842a27b 3597 (Lisp_Object beg, Lisp_Object end, Lisp_Object buffer, Lisp_Object front_advance, Lisp_Object rear_advance)
2eec3b4e
RS
3598{
3599 Lisp_Object overlay;
5c4f68f1 3600 struct buffer *b;
2eec3b4e 3601
5c4f68f1 3602 if (NILP (buffer))
67180c6a 3603 XSETBUFFER (buffer, current_buffer);
883047b9 3604 else
b7826503 3605 CHECK_BUFFER (buffer);
883047b9
JB
3606 if (MARKERP (beg)
3607 && ! EQ (Fmarker_buffer (beg), buffer))
3608 error ("Marker points into wrong buffer");
3609 if (MARKERP (end)
3610 && ! EQ (Fmarker_buffer (end), buffer))
3611 error ("Marker points into wrong buffer");
2eec3b4e 3612
b7826503
PJ
3613 CHECK_NUMBER_COERCE_MARKER (beg);
3614 CHECK_NUMBER_COERCE_MARKER (end);
5c4f68f1 3615
883047b9 3616 if (XINT (beg) > XINT (end))
5c4f68f1 3617 {
c99fc30f
KH
3618 Lisp_Object temp;
3619 temp = beg; beg = end; end = temp;
5c4f68f1 3620 }
883047b9
JB
3621
3622 b = XBUFFER (buffer);
3623
3624 beg = Fset_marker (Fmake_marker (), beg, buffer);
3625 end = Fset_marker (Fmake_marker (), end, buffer);
5c4f68f1 3626
acac2700
RS
3627 if (!NILP (front_advance))
3628 XMARKER (beg)->insertion_type = 1;
3629 if (!NILP (rear_advance))
3630 XMARKER (end)->insertion_type = 1;
597dd755 3631
d7a7fda3 3632 overlay = build_overlay (beg, end, Qnil);
2eec3b4e 3633
177c0ea7 3634 /* Put the new overlay on the wrong list. */
2eec3b4e 3635 end = OVERLAY_END (overlay);
c2d5b10f 3636 if (OVERLAY_POSITION (end) < b->overlay_center)
2410d73a
SM
3637 {
3638 if (b->overlays_after)
3639 XOVERLAY (overlay)->next = b->overlays_after;
3640 b->overlays_after = XOVERLAY (overlay);
3641 }
2eec3b4e 3642 else
2410d73a
SM
3643 {
3644 if (b->overlays_before)
3645 XOVERLAY (overlay)->next = b->overlays_before;
3646 b->overlays_before = XOVERLAY (overlay);
3647 }
2eec3b4e
RS
3648
3649 /* This puts it in the right list, and in the right order. */
c2d5b10f 3650 recenter_overlay_lists (b, b->overlay_center);
2eec3b4e 3651
b61982dd
JB
3652 /* We don't need to redisplay the region covered by the overlay, because
3653 the overlay has no properties at the moment. */
3654
2eec3b4e
RS
3655 return overlay;
3656}
876aa27c
RS
3657\f
3658/* Mark a section of BUF as needing redisplay because of overlays changes. */
3659
3660static void
d311d28c 3661modify_overlay (struct buffer *buf, ptrdiff_t start, ptrdiff_t end)
876aa27c 3662{
876aa27c
RS
3663 if (start > end)
3664 {
d311d28c 3665 ptrdiff_t temp = start;
26f545d7
GM
3666 start = end;
3667 end = temp;
876aa27c
RS
3668 }
3669
481b5054 3670 BUF_COMPUTE_UNCHANGED (buf, start, end);
177c0ea7 3671
876aa27c
RS
3672 /* If this is a buffer not in the selected window,
3673 we must do other windows. */
3674 if (buf != XBUFFER (XWINDOW (selected_window)->buffer))
3675 windows_or_buffers_changed = 1;
876aa27c
RS
3676 /* If multiple windows show this buffer, we must do other windows. */
3677 else if (buffer_shared > 1)
3678 windows_or_buffers_changed = 1;
18700091
KS
3679 /* If we modify an overlay at the end of the buffer, we cannot
3680 be sure that window end is still valid. */
3681 else if (end >= ZV && start <= ZV)
3682 windows_or_buffers_changed = 1;
876aa27c 3683
d8b9150f 3684 ++BUF_OVERLAY_MODIFF (buf);
876aa27c 3685}
2eec3b4e 3686
7b7ae965
DA
3687/* Remove OVERLAY from LIST. */
3688
2410d73a 3689static struct Lisp_Overlay *
d3da34e0 3690unchain_overlay (struct Lisp_Overlay *list, struct Lisp_Overlay *overlay)
2410d73a 3691{
7b7ae965
DA
3692 register struct Lisp_Overlay *tail, **prev = &list;
3693
3694 for (tail = list; tail; prev = &tail->next, tail = *prev)
3695 if (tail == overlay)
2410d73a 3696 {
7b7ae965 3697 *prev = overlay->next;
2410d73a
SM
3698 overlay->next = NULL;
3699 break;
3700 }
3701 return list;
3702}
3703
5c4f68f1 3704DEFUN ("move-overlay", Fmove_overlay, Smove_overlay, 3, 4, 0,
7ee72033 3705 doc: /* Set the endpoints of OVERLAY to BEG and END in BUFFER.
018ba359
PJ
3706If BUFFER is omitted, leave OVERLAY in the same buffer it inhabits now.
3707If BUFFER is omitted, and OVERLAY is in no buffer, put it in the current
7ee72033 3708buffer. */)
5842a27b 3709 (Lisp_Object overlay, Lisp_Object beg, Lisp_Object end, Lisp_Object buffer)
2eec3b4e 3710{
471fe23d 3711 struct buffer *b, *ob = 0;
0a4469c9 3712 Lisp_Object obuffer;
d311d28c 3713 ptrdiff_t count = SPECPDL_INDEX ();
471fe23d 3714 ptrdiff_t n_beg, n_end, o_beg IF_LINT (= 0), o_end IF_LINT (= 0);
5c4f68f1 3715
b7826503 3716 CHECK_OVERLAY (overlay);
5c4f68f1
JB
3717 if (NILP (buffer))
3718 buffer = Fmarker_buffer (OVERLAY_START (overlay));
3ece337a 3719 if (NILP (buffer))
67180c6a 3720 XSETBUFFER (buffer, current_buffer);
b7826503 3721 CHECK_BUFFER (buffer);
883047b9 3722
471fe23d
TN
3723 if (NILP (Fbuffer_live_p (buffer)))
3724 error ("Attempt to move overlay to a dead buffer");
3725
883047b9
JB
3726 if (MARKERP (beg)
3727 && ! EQ (Fmarker_buffer (beg), buffer))
3728 error ("Marker points into wrong buffer");
3729 if (MARKERP (end)
3730 && ! EQ (Fmarker_buffer (end), buffer))
3731 error ("Marker points into wrong buffer");
3732
b7826503
PJ
3733 CHECK_NUMBER_COERCE_MARKER (beg);
3734 CHECK_NUMBER_COERCE_MARKER (end);
d311d28c 3735
471fe23d 3736 if (XINT (beg) > XINT (end))
02481186 3737 {
471fe23d
TN
3738 Lisp_Object temp;
3739 temp = beg; beg = end; end = temp;
02481186
PE
3740 }
3741
9d7608b7
KH
3742 specbind (Qinhibit_quit, Qt);
3743
0a4469c9 3744 obuffer = Fmarker_buffer (OVERLAY_START (overlay));
79cce3f2 3745 b = XBUFFER (buffer);
471fe23d
TN
3746
3747 if (!NILP (obuffer))
3748 {
3749 ob = XBUFFER (obuffer);
3750
3751 o_beg = OVERLAY_POSITION (OVERLAY_START (overlay));
3752 o_end = OVERLAY_POSITION (OVERLAY_END (overlay));
3753
3754 ob->overlays_before =
3755 unchain_overlay (ob->overlays_before, XOVERLAY (overlay));
3756 ob->overlays_after =
3757 unchain_overlay (ob->overlays_after, XOVERLAY (overlay));
3758 eassert (XOVERLAY (overlay)->next == NULL);
3759 }
3760
3761 /* Set the overlay boundaries, which may clip them. */
3762 Fset_marker (OVERLAY_START (overlay), beg, buffer);
3763 Fset_marker (OVERLAY_END (overlay), end, buffer);
3764
3765 n_beg = marker_position (OVERLAY_START (overlay));
3766 n_end = marker_position (OVERLAY_END (overlay));
2eec3b4e 3767
c82ed728 3768 /* If the overlay has changed buffers, do a thorough redisplay. */
0a4469c9 3769 if (!EQ (buffer, obuffer))
50760c4a
RS
3770 {
3771 /* Redisplay where the overlay was. */
471fe23d
TN
3772 if (ob)
3773 modify_overlay (ob, o_beg, o_end);
50760c4a
RS
3774
3775 /* Redisplay where the overlay is going to be. */
79cce3f2 3776 modify_overlay (b, n_beg, n_end);
50760c4a 3777 }
c82ed728
JB
3778 else
3779 /* Redisplay the area the overlay has just left, or just enclosed. */
3780 {
79cce3f2
PE
3781 if (o_beg == n_beg)
3782 modify_overlay (b, o_end, n_end);
3783 else if (o_end == n_end)
3784 modify_overlay (b, o_beg, n_beg);
c82ed728 3785 else
79cce3f2 3786 modify_overlay (b, min (o_beg, n_beg), max (o_end, n_end));
c82ed728 3787 }
b61982dd 3788
471fe23d
TN
3789 /* Delete the overlay if it is empty after clipping and has the
3790 evaporate property. */
3791 if (n_beg == n_end && !NILP (Foverlay_get (overlay, Qevaporate)))
3792 return unbind_to (count, Fdelete_overlay (overlay));
02481186 3793
471fe23d
TN
3794 /* Put the overlay into the new buffer's overlay lists, first on the
3795 wrong list. */
3796 if (n_end < b->overlay_center)
2410d73a 3797 {
8f924df7
KH
3798 XOVERLAY (overlay)->next = b->overlays_after;
3799 b->overlays_after = XOVERLAY (overlay);
2410d73a 3800 }
2eec3b4e 3801 else
2410d73a 3802 {
8f924df7
KH
3803 XOVERLAY (overlay)->next = b->overlays_before;
3804 b->overlays_before = XOVERLAY (overlay);
2410d73a 3805 }
2eec3b4e
RS
3806
3807 /* This puts it in the right list, and in the right order. */
c2d5b10f 3808 recenter_overlay_lists (b, b->overlay_center);
2eec3b4e 3809
0a4469c9 3810 return unbind_to (count, overlay);
2eec3b4e
RS
3811}
3812
3813DEFUN ("delete-overlay", Fdelete_overlay, Sdelete_overlay, 1, 1, 0,
7ee72033 3814 doc: /* Delete the overlay OVERLAY from its buffer. */)
5842a27b 3815 (Lisp_Object overlay)
2eec3b4e 3816{
0a4469c9 3817 Lisp_Object buffer;
5c4f68f1 3818 struct buffer *b;
d311d28c 3819 ptrdiff_t count = SPECPDL_INDEX ();
5c4f68f1 3820
b7826503 3821 CHECK_OVERLAY (overlay);
52f8ec73 3822
0a4469c9
RS
3823 buffer = Fmarker_buffer (OVERLAY_START (overlay));
3824 if (NILP (buffer))
3825 return Qnil;
3826
3827 b = XBUFFER (buffer);
0a4469c9 3828 specbind (Qinhibit_quit, Qt);
177c0ea7 3829
471fe23d
TN
3830 b->overlays_before
3831 = unchain_overlay (b->overlays_before, XOVERLAY (overlay));
3832 b->overlays_after
3833 = unchain_overlay (b->overlays_after, XOVERLAY (overlay));
2410d73a 3834 eassert (XOVERLAY (overlay)->next == NULL);
471fe23d 3835
041a49a6 3836 drop_overlay (b, XOVERLAY (overlay));
3ece337a 3837
e58c389d 3838 /* When deleting an overlay with before or after strings, turn off
26f545d7
GM
3839 display optimizations for the affected buffer, on the basis that
3840 these strings may contain newlines. This is easier to do than to
3841 check for that situation during redisplay. */
3842 if (!windows_or_buffers_changed
3843 && (!NILP (Foverlay_get (overlay, Qbefore_string))
3844 || !NILP (Foverlay_get (overlay, Qafter_string))))
3845 b->prevent_redisplay_optimizations_p = 1;
3846
0a4469c9 3847 return unbind_to (count, Qnil);
2eec3b4e
RS
3848}
3849\f
8ebafa8d
JB
3850/* Overlay dissection functions. */
3851
a7ca3326 3852DEFUN ("overlay-start", Foverlay_start, Soverlay_start, 1, 1, 0,
7ee72033 3853 doc: /* Return the position at which OVERLAY starts. */)
5842a27b 3854 (Lisp_Object overlay)
8ebafa8d 3855{
b7826503 3856 CHECK_OVERLAY (overlay);
8ebafa8d
JB
3857
3858 return (Fmarker_position (OVERLAY_START (overlay)));
3859}
3860
a7ca3326 3861DEFUN ("overlay-end", Foverlay_end, Soverlay_end, 1, 1, 0,
7ee72033 3862 doc: /* Return the position at which OVERLAY ends. */)
5842a27b 3863 (Lisp_Object overlay)
8ebafa8d 3864{
b7826503 3865 CHECK_OVERLAY (overlay);
8ebafa8d
JB
3866
3867 return (Fmarker_position (OVERLAY_END (overlay)));
3868}
3869
3870DEFUN ("overlay-buffer", Foverlay_buffer, Soverlay_buffer, 1, 1, 0,
563f7128
LK
3871 doc: /* Return the buffer OVERLAY belongs to.
3872Return nil if OVERLAY has been deleted. */)
5842a27b 3873 (Lisp_Object overlay)
8ebafa8d 3874{
b7826503 3875 CHECK_OVERLAY (overlay);
8ebafa8d
JB
3876
3877 return Fmarker_buffer (OVERLAY_START (overlay));
3878}
3879
3880DEFUN ("overlay-properties", Foverlay_properties, Soverlay_properties, 1, 1, 0,
7ee72033 3881 doc: /* Return a list of the properties on OVERLAY.
018ba359 3882This is a copy of OVERLAY's plist; modifying its conses has no effect on
7ee72033 3883OVERLAY. */)
5842a27b 3884 (Lisp_Object overlay)
8ebafa8d 3885{
b7826503 3886 CHECK_OVERLAY (overlay);
8ebafa8d 3887
48e2e3ba 3888 return Fcopy_sequence (XOVERLAY (overlay)->plist);
8ebafa8d
JB
3889}
3890
3891\f
2eec3b4e 3892DEFUN ("overlays-at", Foverlays_at, Soverlays_at, 1, 1, 0,
aabc29c8 3893 doc: /* Return a list of the overlays that contain the character at POS. */)
5842a27b 3894 (Lisp_Object pos)
2eec3b4e 3895{
b081724f 3896 ptrdiff_t len, noverlays;
2eec3b4e 3897 Lisp_Object *overlay_vec;
2eec3b4e
RS
3898 Lisp_Object result;
3899
b7826503 3900 CHECK_NUMBER_COERCE_MARKER (pos);
2eec3b4e
RS
3901
3902 len = 10;
a9800ae8 3903 /* We can't use alloca here because overlays_at can call xrealloc. */
38182d90 3904 overlay_vec = xmalloc (len * sizeof *overlay_vec);
2eec3b4e
RS
3905
3906 /* Put all the overlays we want in a vector in overlay_vec.
3907 Store the length in len. */
2a77a7d7 3908 noverlays = overlays_at (XINT (pos), 1, &overlay_vec, &len,
d311d28c 3909 0, 0, 0);
2eec3b4e
RS
3910
3911 /* Make a list of them all. */
3912 result = Flist (noverlays, overlay_vec);
3913
9ac0d9e0 3914 xfree (overlay_vec);
2eec3b4e
RS
3915 return result;
3916}
3917
74514898 3918DEFUN ("overlays-in", Foverlays_in, Soverlays_in, 2, 2, 0,
7ee72033 3919 doc: /* Return a list of the overlays that overlap the region BEG ... END.
018ba359
PJ
3920Overlap means that at least one character is contained within the overlay
3921and also contained within the specified region.
7723e095
MR
3922Empty overlays are included in the result if they are located at BEG,
3923between BEG and END, or at END provided END denotes the position at the
3924end of the buffer. */)
5842a27b 3925 (Lisp_Object beg, Lisp_Object end)
74514898 3926{
21514da7 3927 ptrdiff_t len, noverlays;
74514898 3928 Lisp_Object *overlay_vec;
74514898
RS
3929 Lisp_Object result;
3930
b7826503
PJ
3931 CHECK_NUMBER_COERCE_MARKER (beg);
3932 CHECK_NUMBER_COERCE_MARKER (end);
74514898
RS
3933
3934 len = 10;
38182d90 3935 overlay_vec = xmalloc (len * sizeof *overlay_vec);
74514898
RS
3936
3937 /* Put all the overlays we want in a vector in overlay_vec.
3938 Store the length in len. */
3939 noverlays = overlays_in (XINT (beg), XINT (end), 1, &overlay_vec, &len,
145582a0 3940 NULL, NULL);
74514898
RS
3941
3942 /* Make a list of them all. */
3943 result = Flist (noverlays, overlay_vec);
3944
3945 xfree (overlay_vec);
3946 return result;
3947}
3948
a7ca3326 3949DEFUN ("next-overlay-change", Fnext_overlay_change, Snext_overlay_change,
efc7e75f 3950 1, 1, 0,
7ee72033 3951 doc: /* Return the next position after POS where an overlay starts or ends.
624d2678
RS
3952If there are no overlay boundaries from POS to (point-max),
3953the value is (point-max). */)
5842a27b 3954 (Lisp_Object pos)
2eec3b4e 3955{
b081724f 3956 ptrdiff_t i, len, noverlays;
d311d28c 3957 ptrdiff_t endpos;
2eec3b4e 3958 Lisp_Object *overlay_vec;
2eec3b4e 3959
b7826503 3960 CHECK_NUMBER_COERCE_MARKER (pos);
2eec3b4e
RS
3961
3962 len = 10;
38182d90 3963 overlay_vec = xmalloc (len * sizeof *overlay_vec);
2eec3b4e
RS
3964
3965 /* Put all the overlays we want in a vector in overlay_vec.
3966 Store the length in len.
3967 endpos gets the position where the next overlay starts. */
2a77a7d7 3968 noverlays = overlays_at (XINT (pos), 1, &overlay_vec, &len,
d311d28c 3969 &endpos, 0, 1);
2eec3b4e
RS
3970
3971 /* If any of these overlays ends before endpos,
3972 use its ending point instead. */
3973 for (i = 0; i < noverlays; i++)
3974 {
3975 Lisp_Object oend;
d311d28c 3976 ptrdiff_t oendpos;
2eec3b4e
RS
3977
3978 oend = OVERLAY_END (overlay_vec[i]);
3979 oendpos = OVERLAY_POSITION (oend);
3980 if (oendpos < endpos)
3981 endpos = oendpos;
1ab256cb
RM
3982 }
3983
9ac0d9e0 3984 xfree (overlay_vec);
2eec3b4e
RS
3985 return make_number (endpos);
3986}
239c932b 3987
a7ca3326 3988DEFUN ("previous-overlay-change", Fprevious_overlay_change,
239c932b 3989 Sprevious_overlay_change, 1, 1, 0,
7ee72033 3990 doc: /* Return the previous position before POS where an overlay starts or ends.
624d2678
RS
3991If there are no overlay boundaries from (point-min) to POS,
3992the value is (point-min). */)
5842a27b 3993 (Lisp_Object pos)
239c932b 3994{
d311d28c 3995 ptrdiff_t prevpos;
239c932b 3996 Lisp_Object *overlay_vec;
b081724f 3997 ptrdiff_t len;
239c932b 3998
b7826503 3999 CHECK_NUMBER_COERCE_MARKER (pos);
239c932b 4000
624bbdc4
RS
4001 /* At beginning of buffer, we know the answer;
4002 avoid bug subtracting 1 below. */
4003 if (XINT (pos) == BEGV)
4004 return pos;
4005
017f0539 4006 len = 10;
38182d90 4007 overlay_vec = xmalloc (len * sizeof *overlay_vec);
017f0539 4008
239c932b
RS
4009 /* Put all the overlays we want in a vector in overlay_vec.
4010 Store the length in len.
daa1c109 4011 prevpos gets the position of the previous change. */
328ab8e7 4012 overlays_at (XINT (pos), 1, &overlay_vec, &len,
d311d28c 4013 0, &prevpos, 1);
239c932b 4014
239c932b
RS
4015 xfree (overlay_vec);
4016 return make_number (prevpos);
4017}
2eec3b4e
RS
4018\f
4019/* These functions are for debugging overlays. */
4020
4021DEFUN ("overlay-lists", Foverlay_lists, Soverlay_lists, 0, 0, 0,
7ee72033 4022 doc: /* Return a pair of lists giving all the overlays of the current buffer.
018ba359
PJ
4023The car has all the overlays before the overlay center;
4024the cdr has all the overlays after the overlay center.
4025Recentering overlays moves overlays between these lists.
4026The lists you get are copies, so that changing them has no effect.
7ee72033 4027However, the overlays you get are the real objects that the buffer uses. */)
5842a27b 4028 (void)
2eec3b4e 4029{
2410d73a
SM
4030 struct Lisp_Overlay *ol;
4031 Lisp_Object before = Qnil, after = Qnil, tmp;
4032 for (ol = current_buffer->overlays_before; ol; ol = ol->next)
4033 {
4034 XSETMISC (tmp, ol);
4035 before = Fcons (tmp, before);
4036 }
4037 for (ol = current_buffer->overlays_after; ol; ol = ol->next)
4038 {
4039 XSETMISC (tmp, ol);
4040 after = Fcons (tmp, after);
4041 }
4042 return Fcons (Fnreverse (before), Fnreverse (after));
2eec3b4e
RS
4043}
4044
4045DEFUN ("overlay-recenter", Foverlay_recenter, Soverlay_recenter, 1, 1, 0,
c87426c5
RS
4046 doc: /* Recenter the overlays of the current buffer around position POS.
4047That makes overlay lookup faster for positions near POS (but perhaps slower
4048for positions far away from POS). */)
5842a27b 4049 (Lisp_Object pos)
2eec3b4e 4050{
d311d28c 4051 ptrdiff_t p;
b7826503 4052 CHECK_NUMBER_COERCE_MARKER (pos);
2eec3b4e 4053
d311d28c
PE
4054 p = clip_to_bounds (PTRDIFF_MIN, XINT (pos), PTRDIFF_MAX);
4055 recenter_overlay_lists (current_buffer, p);
2eec3b4e
RS
4056 return Qnil;
4057}
4058\f
a7ca3326 4059DEFUN ("overlay-get", Foverlay_get, Soverlay_get, 2, 2, 0,
7ee72033 4060 doc: /* Get the property of overlay OVERLAY with property name PROP. */)
5842a27b 4061 (Lisp_Object overlay, Lisp_Object prop)
2eec3b4e 4062{
b7826503 4063 CHECK_OVERLAY (overlay);
9a593927 4064 return lookup_char_property (XOVERLAY (overlay)->plist, prop, 0);
2eec3b4e
RS
4065}
4066
4067DEFUN ("overlay-put", Foverlay_put, Soverlay_put, 3, 3, 0,
7c301272
LMI
4068 doc: /* Set one property of overlay OVERLAY: give property PROP value VALUE.
4069VALUE will be returned.*/)
5842a27b 4070 (Lisp_Object overlay, Lisp_Object prop, Lisp_Object value)
2eec3b4e 4071{
48e2e3ba 4072 Lisp_Object tail, buffer;
9d7608b7 4073 int changed;
2eec3b4e 4074
b7826503 4075 CHECK_OVERLAY (overlay);
b61982dd 4076
274a9425
RS
4077 buffer = Fmarker_buffer (OVERLAY_START (overlay));
4078
48e2e3ba 4079 for (tail = XOVERLAY (overlay)->plist;
7539e11f
KR
4080 CONSP (tail) && CONSP (XCDR (tail));
4081 tail = XCDR (XCDR (tail)))
4082 if (EQ (XCAR (tail), prop))
274a9425 4083 {
7539e11f 4084 changed = !EQ (XCAR (XCDR (tail)), value);
f3fbd155 4085 XSETCAR (XCDR (tail), value);
9d7608b7 4086 goto found;
274a9425 4087 }
9d7608b7
KH
4088 /* It wasn't in the list, so add it to the front. */
4089 changed = !NILP (value);
48e2e3ba
KH
4090 XOVERLAY (overlay)->plist
4091 = Fcons (prop, Fcons (value, XOVERLAY (overlay)->plist));
9d7608b7
KH
4092 found:
4093 if (! NILP (buffer))
4094 {
4095 if (changed)
876aa27c 4096 modify_overlay (XBUFFER (buffer),
26f545d7
GM
4097 marker_position (OVERLAY_START (overlay)),
4098 marker_position (OVERLAY_END (overlay)));
9d7608b7
KH
4099 if (EQ (prop, Qevaporate) && ! NILP (value)
4100 && (OVERLAY_POSITION (OVERLAY_START (overlay))
4101 == OVERLAY_POSITION (OVERLAY_END (overlay))))
4102 Fdelete_overlay (overlay);
4103 }
7d63db98 4104
2eec3b4e 4105 return value;
1ab256cb
RM
4106}
4107\f
9115729e
KH
4108/* Subroutine of report_overlay_modification. */
4109
4110/* Lisp vector holding overlay hook functions to call.
4111 Vector elements come in pairs.
4112 Each even-index element is a list of hook functions.
4113 The following odd-index element is the overlay they came from.
4114
4115 Before the buffer change, we fill in this vector
4116 as we call overlay hook functions.
4117 After the buffer change, we get the functions to call from this vector.
4118 This way we always call the same functions before and after the change. */
4119static Lisp_Object last_overlay_modification_hooks;
4120
4121/* Number of elements actually used in last_overlay_modification_hooks. */
d311d28c 4122static ptrdiff_t last_overlay_modification_hooks_used;
9115729e
KH
4123
4124/* Add one functionlist/overlay pair
4125 to the end of last_overlay_modification_hooks. */
4126
4127static void
d3da34e0 4128add_overlay_mod_hooklist (Lisp_Object functionlist, Lisp_Object overlay)
9115729e 4129{
d311d28c 4130 ptrdiff_t oldsize = ASIZE (last_overlay_modification_hooks);
9115729e 4131
d311d28c
PE
4132 if (oldsize - 1 <= last_overlay_modification_hooks_used)
4133 last_overlay_modification_hooks =
4134 larger_vector (last_overlay_modification_hooks, 2, -1);
3ae565b3
SM
4135 ASET (last_overlay_modification_hooks, last_overlay_modification_hooks_used,
4136 functionlist); last_overlay_modification_hooks_used++;
4137 ASET (last_overlay_modification_hooks, last_overlay_modification_hooks_used,
4138 overlay); last_overlay_modification_hooks_used++;
9115729e
KH
4139}
4140\f
173f2a64
RS
4141/* Run the modification-hooks of overlays that include
4142 any part of the text in START to END.
9115729e
KH
4143 If this change is an insertion, also
4144 run the insert-before-hooks of overlay starting at END,
930a9140
RS
4145 and the insert-after-hooks of overlay ending at START.
4146
4147 This is called both before and after the modification.
4148 AFTER is nonzero when we call after the modification.
4149
9115729e
KH
4150 ARG1, ARG2, ARG3 are arguments to pass to the hook functions.
4151 When AFTER is nonzero, they are the start position,
4152 the position after the inserted new text,
4153 and the length of deleted or replaced old text. */
173f2a64
RS
4154
4155void
d3da34e0
JB
4156report_overlay_modification (Lisp_Object start, Lisp_Object end, int after,
4157 Lisp_Object arg1, Lisp_Object arg2, Lisp_Object arg3)
173f2a64 4158{
2410d73a
SM
4159 Lisp_Object prop, overlay;
4160 struct Lisp_Overlay *tail;
9115729e
KH
4161 /* 1 if this change is an insertion. */
4162 int insertion = (after ? XFASTINT (arg3) == 0 : EQ (start, end));
a615c6dc 4163 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
55b48893
RS
4164
4165 overlay = Qnil;
2410d73a 4166 tail = NULL;
9115729e 4167
27c6b98e
SM
4168 /* We used to run the functions as soon as we found them and only register
4169 them in last_overlay_modification_hooks for the purpose of the `after'
4170 case. But running elisp code as we traverse the list of overlays is
4171 painful because the list can be modified by the elisp code so we had to
4172 copy at several places. We now simply do a read-only traversal that
4173 only collects the functions to run and we run them afterwards. It's
4174 simpler, especially since all the code was already there. -stef */
4175
a615c6dc 4176 if (!after)
173f2a64 4177 {
a615c6dc
SM
4178 /* We are being called before a change.
4179 Scan the overlays to find the functions to call. */
4180 last_overlay_modification_hooks_used = 0;
2410d73a 4181 for (tail = current_buffer->overlays_before; tail; tail = tail->next)
173f2a64 4182 {
d311d28c 4183 ptrdiff_t startpos, endpos;
a615c6dc
SM
4184 Lisp_Object ostart, oend;
4185
2410d73a 4186 XSETMISC (overlay, tail);
a615c6dc
SM
4187
4188 ostart = OVERLAY_START (overlay);
4189 oend = OVERLAY_END (overlay);
4190 endpos = OVERLAY_POSITION (oend);
4191 if (XFASTINT (start) > endpos)
4192 break;
4193 startpos = OVERLAY_POSITION (ostart);
4194 if (insertion && (XFASTINT (start) == startpos
4195 || XFASTINT (end) == startpos))
5fb5aa33 4196 {
a615c6dc
SM
4197 prop = Foverlay_get (overlay, Qinsert_in_front_hooks);
4198 if (!NILP (prop))
4199 add_overlay_mod_hooklist (prop, overlay);
5fb5aa33 4200 }
a615c6dc
SM
4201 if (insertion && (XFASTINT (start) == endpos
4202 || XFASTINT (end) == endpos))
5fb5aa33 4203 {
a615c6dc
SM
4204 prop = Foverlay_get (overlay, Qinsert_behind_hooks);
4205 if (!NILP (prop))
4206 add_overlay_mod_hooklist (prop, overlay);
5fb5aa33 4207 }
a615c6dc
SM
4208 /* Test for intersecting intervals. This does the right thing
4209 for both insertion and deletion. */
4210 if (XFASTINT (end) > startpos && XFASTINT (start) < endpos)
5fb5aa33 4211 {
a615c6dc
SM
4212 prop = Foverlay_get (overlay, Qmodification_hooks);
4213 if (!NILP (prop))
4214 add_overlay_mod_hooklist (prop, overlay);
5fb5aa33 4215 }
173f2a64 4216 }
60ebfdf3 4217
2410d73a 4218 for (tail = current_buffer->overlays_after; tail; tail = tail->next)
173f2a64 4219 {
d311d28c 4220 ptrdiff_t startpos, endpos;
a615c6dc
SM
4221 Lisp_Object ostart, oend;
4222
2410d73a 4223 XSETMISC (overlay, tail);
a615c6dc
SM
4224
4225 ostart = OVERLAY_START (overlay);
4226 oend = OVERLAY_END (overlay);
4227 startpos = OVERLAY_POSITION (ostart);
4228 endpos = OVERLAY_POSITION (oend);
4229 if (XFASTINT (end) < startpos)
4230 break;
4231 if (insertion && (XFASTINT (start) == startpos
4232 || XFASTINT (end) == startpos))
5fb5aa33 4233 {
a615c6dc
SM
4234 prop = Foverlay_get (overlay, Qinsert_in_front_hooks);
4235 if (!NILP (prop))
4236 add_overlay_mod_hooklist (prop, overlay);
5fb5aa33 4237 }
a615c6dc
SM
4238 if (insertion && (XFASTINT (start) == endpos
4239 || XFASTINT (end) == endpos))
5fb5aa33 4240 {
a615c6dc
SM
4241 prop = Foverlay_get (overlay, Qinsert_behind_hooks);
4242 if (!NILP (prop))
4243 add_overlay_mod_hooklist (prop, overlay);
5fb5aa33 4244 }
a615c6dc
SM
4245 /* Test for intersecting intervals. This does the right thing
4246 for both insertion and deletion. */
4247 if (XFASTINT (end) > startpos && XFASTINT (start) < endpos)
5fb5aa33 4248 {
a615c6dc
SM
4249 prop = Foverlay_get (overlay, Qmodification_hooks);
4250 if (!NILP (prop))
4251 add_overlay_mod_hooklist (prop, overlay);
5fb5aa33 4252 }
173f2a64
RS
4253 }
4254 }
55b48893 4255
a615c6dc
SM
4256 GCPRO4 (overlay, arg1, arg2, arg3);
4257 {
4258 /* Call the functions recorded in last_overlay_modification_hooks.
4259 First copy the vector contents, in case some of these hooks
4260 do subsequent modification of the buffer. */
d311d28c 4261 ptrdiff_t size = last_overlay_modification_hooks_used;
38182d90 4262 Lisp_Object *copy = alloca (size * sizeof *copy);
d311d28c 4263 ptrdiff_t i;
a615c6dc 4264
72af86bd
AS
4265 memcpy (copy, XVECTOR (last_overlay_modification_hooks)->contents,
4266 size * sizeof (Lisp_Object));
a615c6dc
SM
4267 gcpro1.var = copy;
4268 gcpro1.nvars = size;
4269
4270 for (i = 0; i < size;)
4271 {
8f54f30a
PE
4272 Lisp_Object prop_i, overlay_i;
4273 prop_i = copy[i++];
4274 overlay_i = copy[i++];
4275 call_overlay_mod_hooks (prop_i, overlay_i, after, arg1, arg2, arg3);
a615c6dc
SM
4276 }
4277 }
55b48893 4278 UNGCPRO;
173f2a64
RS
4279}
4280
4281static void
d3da34e0
JB
4282call_overlay_mod_hooks (Lisp_Object list, Lisp_Object overlay, int after,
4283 Lisp_Object arg1, Lisp_Object arg2, Lisp_Object arg3)
173f2a64 4284{
930a9140 4285 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
9115729e 4286
930a9140 4287 GCPRO4 (list, arg1, arg2, arg3);
9115729e 4288
6d70a280 4289 while (CONSP (list))
173f2a64 4290 {
930a9140 4291 if (NILP (arg3))
6d70a280 4292 call4 (XCAR (list), overlay, after ? Qt : Qnil, arg1, arg2);
930a9140 4293 else
6d70a280
SM
4294 call5 (XCAR (list), overlay, after ? Qt : Qnil, arg1, arg2, arg3);
4295 list = XCDR (list);
173f2a64
RS
4296 }
4297 UNGCPRO;
4298}
9d7608b7
KH
4299
4300/* Delete any zero-sized overlays at position POS, if the `evaporate'
4301 property is set. */
4302void
d311d28c 4303evaporate_overlays (ptrdiff_t pos)
9d7608b7 4304{
2410d73a
SM
4305 Lisp_Object overlay, hit_list;
4306 struct Lisp_Overlay *tail;
9d7608b7
KH
4307
4308 hit_list = Qnil;
c2d5b10f 4309 if (pos <= current_buffer->overlay_center)
2410d73a 4310 for (tail = current_buffer->overlays_before; tail; tail = tail->next)
9d7608b7 4311 {
d311d28c 4312 ptrdiff_t endpos;
2410d73a 4313 XSETMISC (overlay, tail);
9d7608b7
KH
4314 endpos = OVERLAY_POSITION (OVERLAY_END (overlay));
4315 if (endpos < pos)
4316 break;
4317 if (endpos == pos && OVERLAY_POSITION (OVERLAY_START (overlay)) == pos
c3935f9d 4318 && ! NILP (Foverlay_get (overlay, Qevaporate)))
9d7608b7
KH
4319 hit_list = Fcons (overlay, hit_list);
4320 }
4321 else
2410d73a 4322 for (tail = current_buffer->overlays_after; tail; tail = tail->next)
9d7608b7 4323 {
d311d28c 4324 ptrdiff_t startpos;
2410d73a 4325 XSETMISC (overlay, tail);
9d7608b7
KH
4326 startpos = OVERLAY_POSITION (OVERLAY_START (overlay));
4327 if (startpos > pos)
4328 break;
4329 if (startpos == pos && OVERLAY_POSITION (OVERLAY_END (overlay)) == pos
c3935f9d 4330 && ! NILP (Foverlay_get (overlay, Qevaporate)))
9d7608b7
KH
4331 hit_list = Fcons (overlay, hit_list);
4332 }
7539e11f
KR
4333 for (; CONSP (hit_list); hit_list = XCDR (hit_list))
4334 Fdelete_overlay (XCAR (hit_list));
9d7608b7 4335}
173f2a64 4336\f
54dfdeb0 4337/* Somebody has tried to store a value with an unacceptable type
1bf08baf
KH
4338 in the slot with offset OFFSET. */
4339
0fa3ba92 4340void
d3da34e0 4341buffer_slot_type_mismatch (Lisp_Object newval, int type)
0fa3ba92 4342{
ad97b375 4343 Lisp_Object predicate;
177c0ea7 4344
64e16c3c 4345 switch (type)
0fa3ba92 4346 {
2de9f71c 4347 case_Lisp_Int: predicate = Qintegerp; break;
ad97b375
SM
4348 case Lisp_String: predicate = Qstringp; break;
4349 case Lisp_Symbol: predicate = Qsymbolp; break;
4350 default: abort ();
0fa3ba92
JB
4351 }
4352
ad97b375 4353 wrong_type_argument (predicate, newval);
0fa3ba92 4354}
7c02e886 4355
0fa3ba92 4356\f
b86af064
GM
4357/***********************************************************************
4358 Allocation with mmap
4359 ***********************************************************************/
4360
4361#ifdef USE_MMAP_FOR_BUFFERS
4362
4363#include <sys/types.h>
4364#include <sys/mman.h>
4365
4366#ifndef MAP_ANON
4367#ifdef MAP_ANONYMOUS
4368#define MAP_ANON MAP_ANONYMOUS
4369#else
4370#define MAP_ANON 0
4371#endif
4372#endif
4373
09dfdf85
GM
4374#ifndef MAP_FAILED
4375#define MAP_FAILED ((void *) -1)
4376#endif
4377
b86af064 4378#include <stdio.h>
b86af064
GM
4379
4380#if MAP_ANON == 0
4381#include <fcntl.h>
4382#endif
4383
4384#include "coding.h"
4385
4386
4387/* Memory is allocated in regions which are mapped using mmap(2).
4388 The current implementation lets the system select mapped
4389 addresses; we're not using MAP_FIXED in general, except when
4390 trying to enlarge regions.
4391
4392 Each mapped region starts with a mmap_region structure, the user
4393 area starts after that structure, aligned to MEM_ALIGN.
4394
4395 +-----------------------+
4396 | struct mmap_info + |
4397 | padding |
4398 +-----------------------+
4399 | user data |
4400 | |
4401 | |
4402 +-----------------------+ */
4403
4404struct mmap_region
4405{
4406 /* User-specified size. */
4407 size_t nbytes_specified;
177c0ea7 4408
b86af064
GM
4409 /* Number of bytes mapped */
4410 size_t nbytes_mapped;
4411
4412 /* Pointer to the location holding the address of the memory
4413 allocated with the mmap'd block. The variable actually points
4414 after this structure. */
261cb4bb 4415 void **var;
b86af064
GM
4416
4417 /* Next and previous in list of all mmap'd regions. */
4418 struct mmap_region *next, *prev;
4419};
4420
4421/* Doubly-linked list of mmap'd regions. */
4422
4423static struct mmap_region *mmap_regions;
4424
4425/* File descriptor for mmap. If we don't have anonymous mapping,
4426 /dev/zero will be opened on it. */
4427
4428static int mmap_fd;
4429
4430/* Temporary storage for mmap_set_vars, see there. */
4431
4432static struct mmap_region *mmap_regions_1;
4433static int mmap_fd_1;
4434
4435/* Page size on this system. */
4436
4437static int mmap_page_size;
4438
cd1181db 4439/* 1 means mmap has been initialized. */
b86af064
GM
4440
4441static int mmap_initialized_p;
4442
4443/* Value is X rounded up to the next multiple of N. */
4444
4445#define ROUND(X, N) (((X) + (N) - 1) / (N) * (N))
4446
4447/* Size of mmap_region structure plus padding. */
4448
4449#define MMAP_REGION_STRUCT_SIZE \
4450 ROUND (sizeof (struct mmap_region), MEM_ALIGN)
4451
4452/* Given a pointer P to the start of the user-visible part of a mapped
4453 region, return a pointer to the start of the region. */
4454
4455#define MMAP_REGION(P) \
4456 ((struct mmap_region *) ((char *) (P) - MMAP_REGION_STRUCT_SIZE))
4457
4458/* Given a pointer P to the start of a mapped region, return a pointer
4459 to the start of the user-visible part of the region. */
4460
4461#define MMAP_USER_AREA(P) \
261cb4bb 4462 ((void *) ((char *) (P) + MMAP_REGION_STRUCT_SIZE))
b86af064
GM
4463
4464#define MEM_ALIGN sizeof (double)
4465
7273faa1
DL
4466/* Predicate returning true if part of the address range [START .. END]
4467 is currently mapped. Used to prevent overwriting an existing
08327b22
GM
4468 memory mapping.
4469
da6062e6 4470 Default is to conservatively assume the address range is occupied by
08327b22
GM
4471 something else. This can be overridden by system configuration
4472 files if system-specific means to determine this exists. */
4473
4474#ifndef MMAP_ALLOCATED_P
4475#define MMAP_ALLOCATED_P(start, end) 1
4476#endif
4477
53964682 4478/* Perform necessary initializations for the use of mmap. */
b86af064 4479
1dae0f0a
AS
4480static void
4481mmap_init (void)
4482{
4483#if MAP_ANON == 0
4484 /* The value of mmap_fd is initially 0 in temacs, and -1
4485 in a dumped Emacs. */
4486 if (mmap_fd <= 0)
4487 {
4488 /* No anonymous mmap -- we need the file descriptor. */
4489 mmap_fd = open ("/dev/zero", O_RDONLY);
4490 if (mmap_fd == -1)
4491 fatal ("Cannot open /dev/zero: %s", emacs_strerror (errno));
4492 }
4493#endif /* MAP_ANON == 0 */
4494
4495 if (mmap_initialized_p)
4496 return;
4497 mmap_initialized_p = 1;
b86af064 4498
1dae0f0a
AS
4499#if MAP_ANON != 0
4500 mmap_fd = -1;
4501#endif
4502
4503 mmap_page_size = getpagesize ();
4504}
b86af064
GM
4505
4506/* Return a region overlapping address range START...END, or null if
4507 none. END is not including, i.e. the last byte in the range
4508 is at END - 1. */
4509
4510static struct mmap_region *
261cb4bb 4511mmap_find (void *start, void *end)
b86af064
GM
4512{
4513 struct mmap_region *r;
4514 char *s = (char *) start, *e = (char *) end;
177c0ea7 4515
b86af064
GM
4516 for (r = mmap_regions; r; r = r->next)
4517 {
4518 char *rstart = (char *) r;
4519 char *rend = rstart + r->nbytes_mapped;
4520
4521 if (/* First byte of range, i.e. START, in this region? */
4522 (s >= rstart && s < rend)
4523 /* Last byte of range, i.e. END - 1, in this region? */
4524 || (e > rstart && e <= rend)
4525 /* First byte of this region in the range? */
4526 || (rstart >= s && rstart < e)
4527 /* Last byte of this region in the range? */
4528 || (rend > s && rend <= e))
4529 break;
4530 }
4531
4532 return r;
4533}
4534
4535
4536/* Unmap a region. P is a pointer to the start of the user-araa of
4537 the region. Value is non-zero if successful. */
4538
4539static int
1dae0f0a 4540mmap_free_1 (struct mmap_region *r)
b86af064
GM
4541{
4542 if (r->next)
4543 r->next->prev = r->prev;
4544 if (r->prev)
4545 r->prev->next = r->next;
4546 else
4547 mmap_regions = r->next;
177c0ea7 4548
261cb4bb 4549 if (munmap (r, r->nbytes_mapped) == -1)
b86af064
GM
4550 {
4551 fprintf (stderr, "munmap: %s\n", emacs_strerror (errno));
4552 return 0;
4553 }
4554
4555 return 1;
4556}
4557
4558
4559/* Enlarge region R by NPAGES pages. NPAGES < 0 means shrink R.
4560 Value is non-zero if successful. */
4561
4562static int
1dae0f0a 4563mmap_enlarge (struct mmap_region *r, int npages)
b86af064
GM
4564{
4565 char *region_end = (char *) r + r->nbytes_mapped;
4566 size_t nbytes;
4567 int success = 0;
4568
4569 if (npages < 0)
4570 {
4571 /* Unmap pages at the end of the region. */
4572 nbytes = - npages * mmap_page_size;
4573 if (munmap (region_end - nbytes, nbytes) == -1)
4574 fprintf (stderr, "munmap: %s\n", emacs_strerror (errno));
4575 else
4576 {
4577 r->nbytes_mapped -= nbytes;
4578 success = 1;
4579 }
4580 }
4581 else if (npages > 0)
4582 {
b86af064 4583 nbytes = npages * mmap_page_size;
177c0ea7 4584
b86af064
GM
4585 /* Try to map additional pages at the end of the region. We
4586 cannot do this if the address range is already occupied by
4587 something else because mmap deletes any previous mapping.
4588 I'm not sure this is worth doing, let's see. */
08327b22 4589 if (!MMAP_ALLOCATED_P (region_end, region_end + nbytes))
b86af064 4590 {
261cb4bb 4591 void *p;
177c0ea7 4592
b86af064
GM
4593 p = mmap (region_end, nbytes, PROT_READ | PROT_WRITE,
4594 MAP_ANON | MAP_PRIVATE | MAP_FIXED, mmap_fd, 0);
4595 if (p == MAP_FAILED)
edaa9aed 4596 ; /* fprintf (stderr, "mmap: %s\n", emacs_strerror (errno)); */
261cb4bb 4597 else if (p != region_end)
b86af064
GM
4598 {
4599 /* Kernels are free to choose a different address. In
4600 that case, unmap what we've mapped above; we have
4601 no use for it. */
4602 if (munmap (p, nbytes) == -1)
4603 fprintf (stderr, "munmap: %s\n", emacs_strerror (errno));
4604 }
4605 else
4606 {
4607 r->nbytes_mapped += nbytes;
4608 success = 1;
4609 }
4610 }
4611 }
4612
4613 return success;
4614}
4615
4616
4617/* Set or reset variables holding references to mapped regions. If
4618 RESTORE_P is zero, set all variables to null. If RESTORE_P is
4619 non-zero, set all variables to the start of the user-areas
4620 of mapped regions.
4621
4622 This function is called from Fdump_emacs to ensure that the dumped
4623 Emacs doesn't contain references to memory that won't be mapped
4624 when Emacs starts. */
4625
4626void
1dae0f0a 4627mmap_set_vars (int restore_p)
b86af064
GM
4628{
4629 struct mmap_region *r;
4630
4631 if (restore_p)
4632 {
4633 mmap_regions = mmap_regions_1;
4634 mmap_fd = mmap_fd_1;
4635 for (r = mmap_regions; r; r = r->next)
4636 *r->var = MMAP_USER_AREA (r);
4637 }
4638 else
4639 {
4640 for (r = mmap_regions; r; r = r->next)
4641 *r->var = NULL;
4642 mmap_regions_1 = mmap_regions;
4643 mmap_regions = NULL;
4644 mmap_fd_1 = mmap_fd;
4645 mmap_fd = -1;
4646 }
4647}
4648
4649
4650/* Allocate a block of storage large enough to hold NBYTES bytes of
4651 data. A pointer to the data is returned in *VAR. VAR is thus the
4652 address of some variable which will use the data area.
4653
4654 The allocation of 0 bytes is valid.
4655
4656 If we can't allocate the necessary memory, set *VAR to null, and
4657 return null. */
4658
261cb4bb
PE
4659static void *
4660mmap_alloc (void **var, size_t nbytes)
b86af064
GM
4661{
4662 void *p;
4663 size_t map;
4664
4665 mmap_init ();
4666
4667 map = ROUND (nbytes + MMAP_REGION_STRUCT_SIZE, mmap_page_size);
4668 p = mmap (NULL, map, PROT_READ | PROT_WRITE, MAP_ANON | MAP_PRIVATE,
4669 mmap_fd, 0);
177c0ea7 4670
b86af064
GM
4671 if (p == MAP_FAILED)
4672 {
4673 if (errno != ENOMEM)
4674 fprintf (stderr, "mmap: %s\n", emacs_strerror (errno));
4675 p = NULL;
4676 }
4677 else
4678 {
4679 struct mmap_region *r = (struct mmap_region *) p;
177c0ea7 4680
b86af064
GM
4681 r->nbytes_specified = nbytes;
4682 r->nbytes_mapped = map;
4683 r->var = var;
4684 r->prev = NULL;
4685 r->next = mmap_regions;
4686 if (r->next)
4687 r->next->prev = r;
4688 mmap_regions = r;
177c0ea7 4689
b86af064
GM
4690 p = MMAP_USER_AREA (p);
4691 }
177c0ea7 4692
b86af064
GM
4693 return *var = p;
4694}
4695
4696
1dae0f0a
AS
4697/* Free a block of relocatable storage whose data is pointed to by
4698 PTR. Store 0 in *PTR to show there's no block allocated. */
4699
4700static void
261cb4bb 4701mmap_free (void **var)
1dae0f0a
AS
4702{
4703 mmap_init ();
4704
4705 if (*var)
4706 {
4707 mmap_free_1 (MMAP_REGION (*var));
4708 *var = NULL;
4709 }
4710}
4711
4712
b86af064
GM
4713/* Given a pointer at address VAR to data allocated with mmap_alloc,
4714 resize it to size NBYTES. Change *VAR to reflect the new block,
4715 and return this value. If more memory cannot be allocated, then
4716 leave *VAR unchanged, and return null. */
4717
261cb4bb
PE
4718static void *
4719mmap_realloc (void **var, size_t nbytes)
b86af064 4720{
261cb4bb 4721 void *result;
177c0ea7 4722
b86af064
GM
4723 mmap_init ();
4724
4725 if (*var == NULL)
4726 result = mmap_alloc (var, nbytes);
177c0ea7 4727 else if (nbytes == 0)
b86af064
GM
4728 {
4729 mmap_free (var);
4730 result = mmap_alloc (var, nbytes);
4731 }
4732 else
4733 {
4734 struct mmap_region *r = MMAP_REGION (*var);
4735 size_t room = r->nbytes_mapped - MMAP_REGION_STRUCT_SIZE;
177c0ea7 4736
b86af064
GM
4737 if (room < nbytes)
4738 {
4739 /* Must enlarge. */
261cb4bb 4740 void *old_ptr = *var;
b86af064
GM
4741
4742 /* Try to map additional pages at the end of the region.
4743 If that fails, allocate a new region, copy data
4744 from the old region, then free it. */
4745 if (mmap_enlarge (r, (ROUND (nbytes - room, mmap_page_size)
4746 / mmap_page_size)))
4747 {
4748 r->nbytes_specified = nbytes;
4749 *var = result = old_ptr;
4750 }
4751 else if (mmap_alloc (var, nbytes))
4752 {
72af86bd 4753 memcpy (*var, old_ptr, r->nbytes_specified);
b86af064
GM
4754 mmap_free_1 (MMAP_REGION (old_ptr));
4755 result = *var;
4756 r = MMAP_REGION (result);
4757 r->nbytes_specified = nbytes;
4758 }
4759 else
4760 {
4761 *var = old_ptr;
4762 result = NULL;
4763 }
4764 }
4765 else if (room - nbytes >= mmap_page_size)
4766 {
4767 /* Shrinking by at least a page. Let's give some
6bcdeb8c
KR
4768 memory back to the system.
4769
4770 The extra parens are to make the division happens first,
4771 on positive values, so we know it will round towards
4772 zero. */
bb63c5c9 4773 mmap_enlarge (r, - ((room - nbytes) / mmap_page_size));
b86af064
GM
4774 result = *var;
4775 r->nbytes_specified = nbytes;
4776 }
4777 else
4778 {
4779 /* Leave it alone. */
4780 result = *var;
4781 r->nbytes_specified = nbytes;
4782 }
4783 }
4784
4785 return result;
4786}
4787
4788
b86af064
GM
4789#endif /* USE_MMAP_FOR_BUFFERS */
4790
4791
4792\f
4793/***********************************************************************
4794 Buffer-text Allocation
4795 ***********************************************************************/
4796
b86af064
GM
4797/* Allocate NBYTES bytes for buffer B's text buffer. */
4798
4799static void
fd05c7e9 4800alloc_buffer_text (struct buffer *b, ptrdiff_t nbytes)
b86af064 4801{
261cb4bb 4802 void *p;
177c0ea7 4803
b86af064
GM
4804 BLOCK_INPUT;
4805#if defined USE_MMAP_FOR_BUFFERS
261cb4bb 4806 p = mmap_alloc ((void **) &b->text->beg, nbytes);
b86af064 4807#elif defined REL_ALLOC
261cb4bb 4808 p = r_alloc ((void **) &b->text->beg, nbytes);
b86af064 4809#else
815add84 4810 p = xmalloc (nbytes);
b86af064 4811#endif
177c0ea7 4812
b86af064
GM
4813 if (p == NULL)
4814 {
4815 UNBLOCK_INPUT;
531b0165 4816 memory_full (nbytes);
b86af064
GM
4817 }
4818
4819 b->text->beg = (unsigned char *) p;
4820 UNBLOCK_INPUT;
4821}
4822
4823/* Enlarge buffer B's text buffer by DELTA bytes. DELTA < 0 means
4824 shrink it. */
4825
4826void
d311d28c 4827enlarge_buffer_text (struct buffer *b, ptrdiff_t delta)
b86af064 4828{
261cb4bb 4829 void *p;
fd05c7e9
PE
4830 ptrdiff_t nbytes = (BUF_Z_BYTE (b) - BUF_BEG_BYTE (b) + BUF_GAP_SIZE (b) + 1
4831 + delta);
b86af064
GM
4832 BLOCK_INPUT;
4833#if defined USE_MMAP_FOR_BUFFERS
261cb4bb 4834 p = mmap_realloc ((void **) &b->text->beg, nbytes);
b86af064 4835#elif defined REL_ALLOC
261cb4bb 4836 p = r_re_alloc ((void **) &b->text->beg, nbytes);
b86af064
GM
4837#else
4838 p = xrealloc (b->text->beg, nbytes);
4839#endif
177c0ea7 4840
b86af064
GM
4841 if (p == NULL)
4842 {
4843 UNBLOCK_INPUT;
531b0165 4844 memory_full (nbytes);
b86af064
GM
4845 }
4846
4847 BUF_BEG_ADDR (b) = (unsigned char *) p;
4848 UNBLOCK_INPUT;
4849}
4850
4851
4852/* Free buffer B's text buffer. */
4853
4854static void
d3da34e0 4855free_buffer_text (struct buffer *b)
b86af064
GM
4856{
4857 BLOCK_INPUT;
4858
4859#if defined USE_MMAP_FOR_BUFFERS
261cb4bb 4860 mmap_free ((void **) &b->text->beg);
b86af064 4861#elif defined REL_ALLOC
261cb4bb 4862 r_alloc_free ((void **) &b->text->beg);
b86af064
GM
4863#else
4864 xfree (b->text->beg);
4865#endif
177c0ea7 4866
b86af064
GM
4867 BUF_BEG_ADDR (b) = NULL;
4868 UNBLOCK_INPUT;
4869}
4870
4871
4872\f
4873/***********************************************************************
4874 Initialization
4875 ***********************************************************************/
4876
dfcf069d 4877void
d3da34e0 4878init_buffer_once (void)
1ab256cb 4879{
7c02e886 4880 int idx;
3884d954
DA
4881 /* If you add, remove, or reorder Lisp_Objects in a struct buffer, make
4882 sure that this is still correct. Otherwise, mark_vectorlike may not
4883 trace all Lisp_Objects in buffer_defaults and buffer_local_symbols. */
38182d90 4884 const int pvecsize
3884d954
DA
4885 = (offsetof (struct buffer, own_text) - sizeof (struct vectorlike_header))
4886 / sizeof (Lisp_Object);
7c02e886 4887
72af86bd 4888 memset (buffer_permanent_local_flags, 0, sizeof buffer_permanent_local_flags);
13de9290 4889
1ab256cb
RM
4890 /* Make sure all markable slots in buffer_defaults
4891 are initialized reasonably, so mark_buffer won't choke. */
4892 reset_buffer (&buffer_defaults);
4b4deea2 4893 eassert (EQ (BVAR (&buffer_defaults, name), make_number (0)));
13de9290 4894 reset_buffer_local_variables (&buffer_defaults, 1);
4b4deea2 4895 eassert (EQ (BVAR (&buffer_local_symbols, name), make_number (0)));
1ab256cb 4896 reset_buffer (&buffer_local_symbols);
13de9290 4897 reset_buffer_local_variables (&buffer_local_symbols, 1);
336cd056
RS
4898 /* Prevent GC from getting confused. */
4899 buffer_defaults.text = &buffer_defaults.own_text;
4900 buffer_local_symbols.text = &buffer_local_symbols.own_text;
04e9897c
DA
4901 /* No one will share the text with these buffers, but let's play it safe. */
4902 buffer_defaults.indirections = 0;
4903 buffer_local_symbols.indirections = 0;
336cd056
RS
4904 BUF_INTERVALS (&buffer_defaults) = 0;
4905 BUF_INTERVALS (&buffer_local_symbols) = 0;
3884d954 4906 XSETPVECTYPESIZE (&buffer_defaults, PVEC_BUFFER, pvecsize);
67180c6a 4907 XSETBUFFER (Vbuffer_defaults, &buffer_defaults);
3884d954 4908 XSETPVECTYPESIZE (&buffer_local_symbols, PVEC_BUFFER, pvecsize);
67180c6a 4909 XSETBUFFER (Vbuffer_local_symbols, &buffer_local_symbols);
1ab256cb
RM
4910
4911 /* Set up the default values of various buffer slots. */
4912 /* Must do these before making the first buffer! */
4913
f532dca0 4914 /* real setup is done in bindings.el */
2a0213a6 4915 BVAR (&buffer_defaults, mode_line_format) = build_pure_c_string ("%-");
4b4deea2
TT
4916 BVAR (&buffer_defaults, header_line_format) = Qnil;
4917 BVAR (&buffer_defaults, abbrev_mode) = Qnil;
4918 BVAR (&buffer_defaults, overwrite_mode) = Qnil;
4919 BVAR (&buffer_defaults, case_fold_search) = Qt;
4920 BVAR (&buffer_defaults, auto_fill_function) = Qnil;
4921 BVAR (&buffer_defaults, selective_display) = Qnil;
4b4deea2 4922 BVAR (&buffer_defaults, selective_display_ellipses) = Qt;
4b4deea2
TT
4923 BVAR (&buffer_defaults, abbrev_table) = Qnil;
4924 BVAR (&buffer_defaults, display_table) = Qnil;
4925 BVAR (&buffer_defaults, undo_list) = Qnil;
4926 BVAR (&buffer_defaults, mark_active) = Qnil;
4927 BVAR (&buffer_defaults, file_format) = Qnil;
4928 BVAR (&buffer_defaults, auto_save_file_format) = Qt;
2410d73a
SM
4929 buffer_defaults.overlays_before = NULL;
4930 buffer_defaults.overlays_after = NULL;
c2d5b10f 4931 buffer_defaults.overlay_center = BEG;
1ab256cb 4932
4b4deea2
TT
4933 XSETFASTINT (BVAR (&buffer_defaults, tab_width), 8);
4934 BVAR (&buffer_defaults, truncate_lines) = Qnil;
4935 BVAR (&buffer_defaults, word_wrap) = Qnil;
4936 BVAR (&buffer_defaults, ctl_arrow) = Qt;
4cc60b9b 4937 BVAR (&buffer_defaults, bidi_display_reordering) = Qt;
4b4deea2
TT
4938 BVAR (&buffer_defaults, bidi_paragraph_direction) = Qnil;
4939 BVAR (&buffer_defaults, cursor_type) = Qt;
4940 BVAR (&buffer_defaults, extra_line_spacing) = Qnil;
4941 BVAR (&buffer_defaults, cursor_in_non_selected_windows) = Qt;
1ab256cb 4942
4b4deea2
TT
4943 BVAR (&buffer_defaults, enable_multibyte_characters) = Qt;
4944 BVAR (&buffer_defaults, buffer_file_coding_system) = Qnil;
4945 XSETFASTINT (BVAR (&buffer_defaults, fill_column), 70);
4946 XSETFASTINT (BVAR (&buffer_defaults, left_margin), 0);
4947 BVAR (&buffer_defaults, cache_long_line_scans) = Qnil;
4948 BVAR (&buffer_defaults, file_truename) = Qnil;
4949 XSETFASTINT (BVAR (&buffer_defaults, display_count), 0);
4950 XSETFASTINT (BVAR (&buffer_defaults, left_margin_cols), 0);
4951 XSETFASTINT (BVAR (&buffer_defaults, right_margin_cols), 0);
4952 BVAR (&buffer_defaults, left_fringe_width) = Qnil;
4953 BVAR (&buffer_defaults, right_fringe_width) = Qnil;
4954 BVAR (&buffer_defaults, fringes_outside_margins) = Qnil;
4955 BVAR (&buffer_defaults, scroll_bar_width) = Qnil;
4956 BVAR (&buffer_defaults, vertical_scroll_bar_type) = Qt;
4957 BVAR (&buffer_defaults, indicate_empty_lines) = Qnil;
4958 BVAR (&buffer_defaults, indicate_buffer_boundaries) = Qnil;
4959 BVAR (&buffer_defaults, fringe_indicator_alist) = Qnil;
4960 BVAR (&buffer_defaults, fringe_cursor_alist) = Qnil;
4961 BVAR (&buffer_defaults, scroll_up_aggressively) = Qnil;
4962 BVAR (&buffer_defaults, scroll_down_aggressively) = Qnil;
4963 BVAR (&buffer_defaults, display_time) = Qnil;
1ab256cb
RM
4964
4965 /* Assign the local-flags to the slots that have default values.
4966 The local flag is a bit that is used in the buffer
4967 to say that it has its own local value for the slot.
4968 The local flag bits are in the local_var_flags slot of the buffer. */
4969
4970 /* Nothing can work if this isn't true */
d6202519 4971 { verify (sizeof (EMACS_INT) == sizeof (Lisp_Object)); }
1ab256cb
RM
4972
4973 /* 0 means not a lisp var, -1 means always local, else mask */
72af86bd 4974 memset (&buffer_local_flags, 0, sizeof buffer_local_flags);
4b4deea2
TT
4975 XSETINT (BVAR (&buffer_local_flags, filename), -1);
4976 XSETINT (BVAR (&buffer_local_flags, directory), -1);
4977 XSETINT (BVAR (&buffer_local_flags, backed_up), -1);
4978 XSETINT (BVAR (&buffer_local_flags, save_length), -1);
4979 XSETINT (BVAR (&buffer_local_flags, auto_save_file_name), -1);
4980 XSETINT (BVAR (&buffer_local_flags, read_only), -1);
4981 XSETINT (BVAR (&buffer_local_flags, major_mode), -1);
4982 XSETINT (BVAR (&buffer_local_flags, mode_name), -1);
4983 XSETINT (BVAR (&buffer_local_flags, undo_list), -1);
4984 XSETINT (BVAR (&buffer_local_flags, mark_active), -1);
4985 XSETINT (BVAR (&buffer_local_flags, point_before_scroll), -1);
4986 XSETINT (BVAR (&buffer_local_flags, file_truename), -1);
4987 XSETINT (BVAR (&buffer_local_flags, invisibility_spec), -1);
4988 XSETINT (BVAR (&buffer_local_flags, file_format), -1);
4989 XSETINT (BVAR (&buffer_local_flags, auto_save_file_format), -1);
4990 XSETINT (BVAR (&buffer_local_flags, display_count), -1);
4991 XSETINT (BVAR (&buffer_local_flags, display_time), -1);
4992 XSETINT (BVAR (&buffer_local_flags, enable_multibyte_characters), -1);
8d7a4592 4993
7c02e886 4994 idx = 1;
4b4deea2
TT
4995 XSETFASTINT (BVAR (&buffer_local_flags, mode_line_format), idx); ++idx;
4996 XSETFASTINT (BVAR (&buffer_local_flags, abbrev_mode), idx); ++idx;
4997 XSETFASTINT (BVAR (&buffer_local_flags, overwrite_mode), idx); ++idx;
4998 XSETFASTINT (BVAR (&buffer_local_flags, case_fold_search), idx); ++idx;
4999 XSETFASTINT (BVAR (&buffer_local_flags, auto_fill_function), idx); ++idx;
5000 XSETFASTINT (BVAR (&buffer_local_flags, selective_display), idx); ++idx;
4b4deea2 5001 XSETFASTINT (BVAR (&buffer_local_flags, selective_display_ellipses), idx); ++idx;
4b4deea2
TT
5002 XSETFASTINT (BVAR (&buffer_local_flags, tab_width), idx); ++idx;
5003 XSETFASTINT (BVAR (&buffer_local_flags, truncate_lines), idx); ++idx;
5004 XSETFASTINT (BVAR (&buffer_local_flags, word_wrap), idx); ++idx;
5005 XSETFASTINT (BVAR (&buffer_local_flags, ctl_arrow), idx); ++idx;
5006 XSETFASTINT (BVAR (&buffer_local_flags, fill_column), idx); ++idx;
5007 XSETFASTINT (BVAR (&buffer_local_flags, left_margin), idx); ++idx;
5008 XSETFASTINT (BVAR (&buffer_local_flags, abbrev_table), idx); ++idx;
5009 XSETFASTINT (BVAR (&buffer_local_flags, display_table), idx); ++idx;
4b4deea2
TT
5010 XSETFASTINT (BVAR (&buffer_local_flags, syntax_table), idx); ++idx;
5011 XSETFASTINT (BVAR (&buffer_local_flags, cache_long_line_scans), idx); ++idx;
5012 XSETFASTINT (BVAR (&buffer_local_flags, category_table), idx); ++idx;
5013 XSETFASTINT (BVAR (&buffer_local_flags, bidi_display_reordering), idx); ++idx;
5014 XSETFASTINT (BVAR (&buffer_local_flags, bidi_paragraph_direction), idx); ++idx;
5015 XSETFASTINT (BVAR (&buffer_local_flags, buffer_file_coding_system), idx);
a1a17b61 5016 /* Make this one a permanent local. */
7c02e886 5017 buffer_permanent_local_flags[idx++] = 1;
4b4deea2
TT
5018 XSETFASTINT (BVAR (&buffer_local_flags, left_margin_cols), idx); ++idx;
5019 XSETFASTINT (BVAR (&buffer_local_flags, right_margin_cols), idx); ++idx;
5020 XSETFASTINT (BVAR (&buffer_local_flags, left_fringe_width), idx); ++idx;
5021 XSETFASTINT (BVAR (&buffer_local_flags, right_fringe_width), idx); ++idx;
5022 XSETFASTINT (BVAR (&buffer_local_flags, fringes_outside_margins), idx); ++idx;
5023 XSETFASTINT (BVAR (&buffer_local_flags, scroll_bar_width), idx); ++idx;
5024 XSETFASTINT (BVAR (&buffer_local_flags, vertical_scroll_bar_type), idx); ++idx;
5025 XSETFASTINT (BVAR (&buffer_local_flags, indicate_empty_lines), idx); ++idx;
5026 XSETFASTINT (BVAR (&buffer_local_flags, indicate_buffer_boundaries), idx); ++idx;
5027 XSETFASTINT (BVAR (&buffer_local_flags, fringe_indicator_alist), idx); ++idx;
5028 XSETFASTINT (BVAR (&buffer_local_flags, fringe_cursor_alist), idx); ++idx;
5029 XSETFASTINT (BVAR (&buffer_local_flags, scroll_up_aggressively), idx); ++idx;
5030 XSETFASTINT (BVAR (&buffer_local_flags, scroll_down_aggressively), idx); ++idx;
5031 XSETFASTINT (BVAR (&buffer_local_flags, header_line_format), idx); ++idx;
5032 XSETFASTINT (BVAR (&buffer_local_flags, cursor_type), idx); ++idx;
5033 XSETFASTINT (BVAR (&buffer_local_flags, extra_line_spacing), idx); ++idx;
5034 XSETFASTINT (BVAR (&buffer_local_flags, cursor_in_non_selected_windows), idx); ++idx;
7c02e886
GM
5035
5036 /* Need more room? */
7313acd0 5037 if (idx >= MAX_PER_BUFFER_VARS)
7c02e886 5038 abort ();
7313acd0 5039 last_per_buffer_idx = idx;
177c0ea7 5040
1ab256cb
RM
5041 Vbuffer_alist = Qnil;
5042 current_buffer = 0;
5043 all_buffers = 0;
5044
2a0213a6 5045 QSFundamental = build_pure_c_string ("Fundamental");
1ab256cb 5046
d67b4f80 5047 Qfundamental_mode = intern_c_string ("fundamental-mode");
4b4deea2 5048 BVAR (&buffer_defaults, major_mode) = Qfundamental_mode;
1ab256cb 5049
d67b4f80 5050 Qmode_class = intern_c_string ("mode-class");
1ab256cb 5051
d67b4f80 5052 Qprotected_field = intern_c_string ("protected-field");
1ab256cb 5053
d67b4f80 5054 Qpermanent_local = intern_c_string ("permanent-local");
1ab256cb 5055
d67b4f80 5056 Qkill_buffer_hook = intern_c_string ("kill-buffer-hook");
fd6cfe11 5057 Fput (Qkill_buffer_hook, Qpermanent_local, Qt);
1ab256cb 5058
1ab256cb 5059 /* super-magic invisible buffer */
2a0213a6 5060 Vprin1_to_string_buffer = Fget_buffer_create (build_pure_c_string (" prin1"));
1ab256cb
RM
5061 Vbuffer_alist = Qnil;
5062
2a0213a6 5063 Fset_buffer (Fget_buffer_create (build_pure_c_string ("*scratch*")));
7775635d
KH
5064
5065 inhibit_modification_hooks = 0;
1ab256cb
RM
5066}
5067
dfcf069d 5068void
d3da34e0 5069init_buffer (void)
1ab256cb 5070{
2381d133 5071 char *pwd;
136351b7 5072 Lisp_Object temp;
965d34eb 5073 ptrdiff_t len;
1ab256cb 5074
b86af064 5075#ifdef USE_MMAP_FOR_BUFFERS
93c27ef1
GM
5076 {
5077 /* When using the ralloc implementation based on mmap(2), buffer
5078 text pointers will have been set to null in the dumped Emacs.
5079 Map new memory. */
5080 struct buffer *b;
177c0ea7 5081
52b852c7 5082 FOR_EACH_BUFFER (b)
93c27ef1 5083 if (b->text->beg == NULL)
b86af064 5084 enlarge_buffer_text (b, 0);
93c27ef1 5085 }
b86af064 5086#endif /* USE_MMAP_FOR_BUFFERS */
177c0ea7 5087
1ab256cb 5088 Fset_buffer (Fget_buffer_create (build_string ("*scratch*")));
4b4deea2 5089 if (NILP (BVAR (&buffer_defaults, enable_multibyte_characters)))
3d871c85 5090 Fset_buffer_multibyte (Qnil);
2381d133 5091
01537133 5092 pwd = get_current_dir_name ();
a17b5ed1 5093
156bdb41 5094 if (!pwd)
a17b5ed1 5095 fatal ("`get_current_dir_name' failed: %s\n", strerror (errno));
1ab256cb 5096
1ab256cb
RM
5097 /* Maybe this should really use some standard subroutine
5098 whose definition is filename syntax dependent. */
b639c9be
RF
5099 len = strlen (pwd);
5100 if (!(IS_DIRECTORY_SEP (pwd[len - 1])))
f7975d07 5101 {
156bdb41 5102 /* Grow buffer to add directory separator and '\0'. */
38182d90 5103 pwd = realloc (pwd, len + 2);
8b146312
AS
5104 if (!pwd)
5105 fatal ("`get_current_dir_name' failed: %s\n", strerror (errno));
b639c9be
RF
5106 pwd[len] = DIRECTORY_SEP;
5107 pwd[len + 1] = '\0';
cb1caeaf 5108 len++;
f7975d07 5109 }
0995fa35 5110
cb1caeaf 5111 BVAR (current_buffer, directory) = make_unibyte_string (pwd, len);
4b4deea2 5112 if (! NILP (BVAR (&buffer_defaults, enable_multibyte_characters)))
f9962371 5113 /* At this moment, we still don't know how to decode the
156bdb41 5114 directory name. So, we keep the bytes in multibyte form so
dcd74c5f 5115 that ENCODE_FILE correctly gets the original bytes. */
4b4deea2
TT
5116 BVAR (current_buffer, directory)
5117 = string_to_multibyte (BVAR (current_buffer, directory));
136351b7 5118
0995fa35
RS
5119 /* Add /: to the front of the name
5120 if it would otherwise be treated as magic. */
4b4deea2 5121 temp = Ffind_file_name_handler (BVAR (current_buffer, directory), Qt);
81ab2e07
KH
5122 if (! NILP (temp)
5123 /* If the default dir is just /, TEMP is non-nil
5124 because of the ange-ftp completion handler.
5125 However, it is not necessary to turn / into /:/.
5126 So avoid doing that. */
4b4deea2
TT
5127 && strcmp ("/", SSDATA (BVAR (current_buffer, directory))))
5128 BVAR (current_buffer, directory)
5129 = concat2 (build_string ("/:"), BVAR (current_buffer, directory));
0995fa35 5130
136351b7 5131 temp = get_minibuffer (0);
4b4deea2 5132 BVAR (XBUFFER (temp), directory) = BVAR (current_buffer, directory);
01537133
EZ
5133
5134 free (pwd);
1ab256cb
RM
5135}
5136
d6aa1876
SM
5137/* Similar to defvar_lisp but define a variable whose value is the Lisp
5138 Object stored in the current buffer. address is the address of the slot
5139 in the buffer that is current now. */
5140
5141/* TYPE is nil for a general Lisp variable.
ce5b453a 5142 An integer specifies a type; then only Lisp values
d6aa1876 5143 with that type code are allowed (except that nil is allowed too).
ce5b453a 5144 LNAME is the Lisp-level variable name.
d6aa1876
SM
5145 VNAME is the name of the buffer slot.
5146 DOC is a dummy where you write the doc string as a comment. */
ce5b453a
SM
5147#define DEFVAR_PER_BUFFER(lname, vname, type, doc) \
5148 do { \
5149 static struct Lisp_Buffer_Objfwd bo_fwd; \
6b1f9ba4 5150 defvar_per_buffer (&bo_fwd, lname, vname, type); \
ce5b453a 5151 } while (0)
d6aa1876
SM
5152
5153static void
8ea90aa3 5154defvar_per_buffer (struct Lisp_Buffer_Objfwd *bo_fwd, const char *namestring,
6b1f9ba4 5155 Lisp_Object *address, Lisp_Object type)
d6aa1876 5156{
ce5b453a 5157 struct Lisp_Symbol *sym;
d6aa1876
SM
5158 int offset;
5159
ce5b453a 5160 sym = XSYMBOL (intern (namestring));
d6aa1876
SM
5161 offset = (char *)address - (char *)current_buffer;
5162
ce5b453a
SM
5163 bo_fwd->type = Lisp_Fwd_Buffer_Obj;
5164 bo_fwd->offset = offset;
5165 bo_fwd->slottype = type;
b9598260 5166 sym->declared_special = 1;
ce5b453a
SM
5167 sym->redirect = SYMBOL_FORWARDED;
5168 {
5169 /* I tried to do the job without a cast, but it seems impossible.
5170 union Lisp_Fwd *fwd; &(fwd->u_buffer_objfwd) = bo_fwd; */
5171 SET_SYMBOL_FWD (sym, (union Lisp_Fwd *)bo_fwd);
5172 }
5173 XSETSYMBOL (PER_BUFFER_SYMBOL (offset), sym);
d6aa1876
SM
5174
5175 if (PER_BUFFER_IDX (offset) == 0)
5176 /* Did a DEFVAR_PER_BUFFER without initializing the corresponding
5177 slot of buffer_local_flags */
5178 abort ();
5179}
5180
5181
1ab256cb 5182/* initialize the buffer routines */
dfcf069d 5183void
d3da34e0 5184syms_of_buffer (void)
1ab256cb 5185{
9115729e
KH
5186 staticpro (&last_overlay_modification_hooks);
5187 last_overlay_modification_hooks
5188 = Fmake_vector (make_number (10), Qnil);
5189
1ab256cb
RM
5190 staticpro (&Vbuffer_defaults);
5191 staticpro (&Vbuffer_local_symbols);
5192 staticpro (&Qfundamental_mode);
5193 staticpro (&Qmode_class);
5194 staticpro (&QSFundamental);
5195 staticpro (&Vbuffer_alist);
5196 staticpro (&Qprotected_field);
5197 staticpro (&Qpermanent_local);
5198 staticpro (&Qkill_buffer_hook);
cd3520a4
JB
5199
5200 DEFSYM (Qpermanent_local_hook, "permanent-local-hook");
5201 DEFSYM (Qoverlayp, "overlayp");
5202 DEFSYM (Qevaporate, "evaporate");
5203 DEFSYM (Qmodification_hooks, "modification-hooks");
5204 DEFSYM (Qinsert_in_front_hooks, "insert-in-front-hooks");
5205 DEFSYM (Qinsert_behind_hooks, "insert-behind-hooks");
5206 DEFSYM (Qget_file_buffer, "get-file-buffer");
5207 DEFSYM (Qpriority, "priority");
5208 DEFSYM (Qbefore_string, "before-string");
5209 DEFSYM (Qafter_string, "after-string");
5210 DEFSYM (Qfirst_change_hook, "first-change-hook");
5211 DEFSYM (Qbefore_change_functions, "before-change-functions");
5212 DEFSYM (Qafter_change_functions, "after-change-functions");
5213 DEFSYM (Qkill_buffer_query_functions, "kill-buffer-query-functions");
5214
1ab256cb 5215 Fput (Qprotected_field, Qerror_conditions,
3438fe21 5216 listn (CONSTYPE_PURE, 2, Qprotected_field, Qerror));
1ab256cb 5217 Fput (Qprotected_field, Qerror_message,
2a0213a6 5218 build_pure_c_string ("Attempt to modify a protected field"));
1ab256cb 5219
422745d0
TT
5220 DEFVAR_BUFFER_DEFAULTS ("default-mode-line-format",
5221 mode_line_format,
5222 doc: /* Default value of `mode-line-format' for buffers that don't override it.
018ba359 5223This is the same as (default-value 'mode-line-format). */);
1ab256cb 5224
422745d0
TT
5225 DEFVAR_BUFFER_DEFAULTS ("default-header-line-format",
5226 header_line_format,
5227 doc: /* Default value of `header-line-format' for buffers that don't override it.
018ba359 5228This is the same as (default-value 'header-line-format). */);
0552666b 5229
422745d0
TT
5230 DEFVAR_BUFFER_DEFAULTS ("default-cursor-type", cursor_type,
5231 doc: /* Default value of `cursor-type' for buffers that don't override it.
018ba359 5232This is the same as (default-value 'cursor-type). */);
bd96bd79 5233
422745d0
TT
5234 DEFVAR_BUFFER_DEFAULTS ("default-line-spacing",
5235 extra_line_spacing,
5236 doc: /* Default value of `line-spacing' for buffers that don't override it.
018ba359 5237This is the same as (default-value 'line-spacing). */);
a3bbced0 5238
422745d0
TT
5239 DEFVAR_BUFFER_DEFAULTS ("default-cursor-in-non-selected-windows",
5240 cursor_in_non_selected_windows,
5241 doc: /* Default value of `cursor-in-non-selected-windows'.
187ccf49
KS
5242This is the same as (default-value 'cursor-in-non-selected-windows). */);
5243
422745d0
TT
5244 DEFVAR_BUFFER_DEFAULTS ("default-abbrev-mode",
5245 abbrev_mode,
5246 doc: /* Default value of `abbrev-mode' for buffers that do not override it.
018ba359 5247This is the same as (default-value 'abbrev-mode). */);
1ab256cb 5248
422745d0
TT
5249 DEFVAR_BUFFER_DEFAULTS ("default-ctl-arrow",
5250 ctl_arrow,
5251 doc: /* Default value of `ctl-arrow' for buffers that do not override it.
018ba359 5252This is the same as (default-value 'ctl-arrow). */);
1ab256cb 5253
422745d0
TT
5254 DEFVAR_BUFFER_DEFAULTS ("default-enable-multibyte-characters",
5255 enable_multibyte_characters,
fb7ada5f 5256 doc: /* Default value of `enable-multibyte-characters' for buffers not overriding it.
018ba359 5257This is the same as (default-value 'enable-multibyte-characters). */);
177c0ea7 5258
422745d0
TT
5259 DEFVAR_BUFFER_DEFAULTS ("default-buffer-file-coding-system",
5260 buffer_file_coding_system,
5261 doc: /* Default value of `buffer-file-coding-system' for buffers not overriding it.
018ba359 5262This is the same as (default-value 'buffer-file-coding-system). */);
177c0ea7 5263
422745d0
TT
5264 DEFVAR_BUFFER_DEFAULTS ("default-truncate-lines",
5265 truncate_lines,
5266 doc: /* Default value of `truncate-lines' for buffers that do not override it.
018ba359 5267This is the same as (default-value 'truncate-lines). */);
1ab256cb 5268
422745d0
TT
5269 DEFVAR_BUFFER_DEFAULTS ("default-fill-column",
5270 fill_column,
5271 doc: /* Default value of `fill-column' for buffers that do not override it.
018ba359 5272This is the same as (default-value 'fill-column). */);
1ab256cb 5273
422745d0
TT
5274 DEFVAR_BUFFER_DEFAULTS ("default-left-margin",
5275 left_margin,
5276 doc: /* Default value of `left-margin' for buffers that do not override it.
018ba359 5277This is the same as (default-value 'left-margin). */);
1ab256cb 5278
422745d0
TT
5279 DEFVAR_BUFFER_DEFAULTS ("default-tab-width",
5280 tab_width,
5281 doc: /* Default value of `tab-width' for buffers that do not override it.
018ba359 5282This is the same as (default-value 'tab-width). */);
1ab256cb 5283
422745d0
TT
5284 DEFVAR_BUFFER_DEFAULTS ("default-case-fold-search",
5285 case_fold_search,
5286 doc: /* Default value of `case-fold-search' for buffers that don't override it.
018ba359 5287This is the same as (default-value 'case-fold-search). */);
1ab256cb 5288
422745d0
TT
5289 DEFVAR_BUFFER_DEFAULTS ("default-left-margin-width",
5290 left_margin_cols,
5291 doc: /* Default value of `left-margin-width' for buffers that don't override it.
018ba359 5292This is the same as (default-value 'left-margin-width). */);
0552666b 5293
422745d0
TT
5294 DEFVAR_BUFFER_DEFAULTS ("default-right-margin-width",
5295 right_margin_cols,
5296 doc: /* Default value of `right-margin-width' for buffers that don't override it.
018ba359 5297This is the same as (default-value 'right-margin-width). */);
177c0ea7 5298
422745d0
TT
5299 DEFVAR_BUFFER_DEFAULTS ("default-left-fringe-width",
5300 left_fringe_width,
5301 doc: /* Default value of `left-fringe-width' for buffers that don't override it.
2ad8731a
KS
5302This is the same as (default-value 'left-fringe-width). */);
5303
422745d0
TT
5304 DEFVAR_BUFFER_DEFAULTS ("default-right-fringe-width",
5305 right_fringe_width,
5306 doc: /* Default value of `right-fringe-width' for buffers that don't override it.
2ad8731a
KS
5307This is the same as (default-value 'right-fringe-width). */);
5308
422745d0
TT
5309 DEFVAR_BUFFER_DEFAULTS ("default-fringes-outside-margins",
5310 fringes_outside_margins,
5311 doc: /* Default value of `fringes-outside-margins' for buffers that don't override it.
2ad8731a
KS
5312This is the same as (default-value 'fringes-outside-margins). */);
5313
422745d0
TT
5314 DEFVAR_BUFFER_DEFAULTS ("default-scroll-bar-width",
5315 scroll_bar_width,
5316 doc: /* Default value of `scroll-bar-width' for buffers that don't override it.
2ad8731a
KS
5317This is the same as (default-value 'scroll-bar-width). */);
5318
422745d0
TT
5319 DEFVAR_BUFFER_DEFAULTS ("default-vertical-scroll-bar",
5320 vertical_scroll_bar_type,
5321 doc: /* Default value of `vertical-scroll-bar' for buffers that don't override it.
2ad8731a
KS
5322This is the same as (default-value 'vertical-scroll-bar). */);
5323
422745d0
TT
5324 DEFVAR_BUFFER_DEFAULTS ("default-indicate-empty-lines",
5325 indicate_empty_lines,
5326 doc: /* Default value of `indicate-empty-lines' for buffers that don't override it.
018ba359 5327This is the same as (default-value 'indicate-empty-lines). */);
177c0ea7 5328
422745d0
TT
5329 DEFVAR_BUFFER_DEFAULTS ("default-indicate-buffer-boundaries",
5330 indicate_buffer_boundaries,
5331 doc: /* Default value of `indicate-buffer-boundaries' for buffers that don't override it.
6b61353c
KH
5332This is the same as (default-value 'indicate-buffer-boundaries). */);
5333
422745d0
TT
5334 DEFVAR_BUFFER_DEFAULTS ("default-fringe-indicator-alist",
5335 fringe_indicator_alist,
5336 doc: /* Default value of `fringe-indicator-alist' for buffers that don't override it.
c6a46372
KS
5337This is the same as (default-value 'fringe-indicator-alist'). */);
5338
422745d0
TT
5339 DEFVAR_BUFFER_DEFAULTS ("default-fringe-cursor-alist",
5340 fringe_cursor_alist,
5341 doc: /* Default value of `fringe-cursor-alist' for buffers that don't override it.
c6a46372
KS
5342This is the same as (default-value 'fringe-cursor-alist'). */);
5343
422745d0
TT
5344 DEFVAR_BUFFER_DEFAULTS ("default-scroll-up-aggressively",
5345 scroll_up_aggressively,
5346 doc: /* Default value of `scroll-up-aggressively'.
7614d762 5347This value applies in buffers that don't have their own local values.
fc961256 5348This is the same as (default-value 'scroll-up-aggressively). */);
177c0ea7 5349
422745d0
TT
5350 DEFVAR_BUFFER_DEFAULTS ("default-scroll-down-aggressively",
5351 scroll_down_aggressively,
5352 doc: /* Default value of `scroll-down-aggressively'.
7614d762 5353This value applies in buffers that don't have their own local values.
fc961256 5354This is the same as (default-value 'scroll-down-aggressively). */);
177c0ea7 5355
045dee35 5356 DEFVAR_PER_BUFFER ("header-line-format",
4b4deea2 5357 &BVAR (current_buffer, header_line_format),
7ee72033 5358 Qnil,
7614d762
RS
5359 doc: /* Analogous to `mode-line-format', but controls the header line.
5360The header line appears, optionally, at the top of a window;
5361the mode line appears at the bottom. */);
177c0ea7 5362
4b4deea2 5363 DEFVAR_PER_BUFFER ("mode-line-format", &BVAR (current_buffer, mode_line_format),
efc7e75f
PJ
5364 Qnil,
5365 doc: /* Template for displaying mode line for current buffer.
5f2c76c6
CY
5366
5367The value may be nil, a string, a symbol or a list.
5368
018ba359 5369A value of nil means don't display a mode line.
5f2c76c6
CY
5370
5371For any symbol other than t or nil, the symbol's value is processed as
5372 a mode line construct. As a special exception, if that value is a
5373 string, the string is processed verbatim, without handling any
5374 %-constructs (see below). Also, unless the symbol has a non-nil
5375 `risky-local-variable' property, all properties in any strings, as
5376 well as all :eval and :propertize forms in the value, are ignored.
5377
5378A list whose car is a string or list is processed by processing each
5379 of the list elements recursively, as separate mode line constructs,
5380 and concatenating the results.
5381
5382A list of the form `(:eval FORM)' is processed by evaluating FORM and
5383 using the result as a mode line construct. Be careful--FORM should
5384 not load any files, because that can cause an infinite recursion.
5385
5386A list of the form `(:propertize ELT PROPS...)' is processed by
5387 processing ELT as the mode line construct, and adding the text
5388 properties PROPS to the result.
5389
5390A list whose car is a symbol is processed by examining the symbol's
5391 value, and, if that value is non-nil, processing the cadr of the list
5392 recursively; and if that value is nil, processing the caddr of the
5393 list recursively.
5394
5395A list whose car is an integer is processed by processing the cadr of
5396 the list, and padding (if the number is positive) or truncating (if
5397 negative) to the width specified by that number.
5398
018ba359 5399A string is printed verbatim in the mode line except for %-constructs:
018ba359
PJ
5400 %b -- print buffer name. %f -- print visited file name.
5401 %F -- print frame name.
5402 %* -- print %, * or hyphen. %+ -- print *, % or hyphen.
5403 %& is like %*, but ignore read-only-ness.
5404 % means buffer is read-only and * means it is modified.
5405 For a modified read-only buffer, %* gives % and %+ gives *.
5406 %s -- print process status. %l -- print the current line number.
5407 %c -- print the current column number (this makes editing slower).
5408 To make the column number update correctly in all cases,
5409 `column-number-mode' must be non-nil.
6b61353c
KH
5410 %i -- print the size of the buffer.
5411 %I -- like %i, but use k, M, G, etc., to abbreviate.
018ba359
PJ
5412 %p -- print percent of buffer above top of window, or Top, Bot or All.
5413 %P -- print percent of buffer above bottom of window, perhaps plus Top,
5414 or print Bottom or All.
018ba359 5415 %n -- print Narrow if appropriate.
dafbe726 5416 %t -- visited file is text or binary (if OS supports this distinction).
47419860 5417 %z -- print mnemonics of keyboard, terminal, and buffer coding systems.
018ba359 5418 %Z -- like %z, but including the end-of-line format.
dafbe726 5419 %e -- print error message about full memory.
f7165034
NR
5420 %@ -- print @ or hyphen. @ means that default-directory is on a
5421 remote machine.
018ba359
PJ
5422 %[ -- print one [ for each recursive editing level. %] similar.
5423 %% -- print %. %- -- print infinitely many dashes.
5424Decimal digits after the % specify field width to which to pad. */);
5425
422745d0 5426 DEFVAR_BUFFER_DEFAULTS ("default-major-mode", major_mode,
fb7ada5f 5427 doc: /* Value of `major-mode' for new buffers. */);
1ab256cb 5428
4b4deea2 5429 DEFVAR_PER_BUFFER ("major-mode", &BVAR (current_buffer, major_mode),
7ee72033 5430 make_number (Lisp_Symbol),
5a021dd0
GM
5431 doc: /* Symbol for current buffer's major mode.
5432The default value (normally `fundamental-mode') affects new buffers.
5433A value of nil means to use the current buffer's major mode, provided
5434it is not marked as "special".
5435
5436When a mode is used by default, `find-file' switches to it before it
5437reads the contents into the buffer and before it finishes setting up
5438the buffer. Thus, the mode and its hooks should not expect certain
5439variables such as `buffer-read-only' and `buffer-file-coding-system'
5440to be set up. */);
1ab256cb 5441
4b4deea2 5442 DEFVAR_PER_BUFFER ("mode-name", &BVAR (current_buffer, mode_name),
c01d0677 5443 Qnil,
64a7c220 5444 doc: /* Pretty name of current buffer's major mode.
7cb70974
EZ
5445Usually a string, but can use any of the constructs for `mode-line-format',
5446which see.
5447Format with `format-mode-line' to produce a string value. */);
1ab256cb 5448
4b4deea2 5449 DEFVAR_PER_BUFFER ("local-abbrev-table", &BVAR (current_buffer, abbrev_table), Qnil,
d6aa1876
SM
5450 doc: /* Local (mode-specific) abbrev table of current buffer. */);
5451
4b4deea2 5452 DEFVAR_PER_BUFFER ("abbrev-mode", &BVAR (current_buffer, abbrev_mode), Qnil,
9d794026
GM
5453 doc: /* Non-nil if Abbrev mode is enabled.
5454Use the command `abbrev-mode' to change this variable. */);
1ab256cb 5455
4b4deea2 5456 DEFVAR_PER_BUFFER ("case-fold-search", &BVAR (current_buffer, case_fold_search),
7ee72033 5457 Qnil,
fb7ada5f 5458 doc: /* Non-nil if searches and matches should ignore case. */);
1ab256cb 5459
4b4deea2 5460 DEFVAR_PER_BUFFER ("fill-column", &BVAR (current_buffer, fill_column),
d5040d2d 5461 make_number (Lisp_Int0),
fb7ada5f 5462 doc: /* Column beyond which automatic line-wrapping should happen.
f1ccb329 5463Interactively, you can set the buffer local value using \\[set-fill-column]. */);
1ab256cb 5464
4b4deea2 5465 DEFVAR_PER_BUFFER ("left-margin", &BVAR (current_buffer, left_margin),
d5040d2d 5466 make_number (Lisp_Int0),
fb7ada5f 5467 doc: /* Column for the default `indent-line-function' to indent to.
018ba359 5468Linefeed indents to this column in Fundamental mode. */);
1ab256cb 5469
4b4deea2 5470 DEFVAR_PER_BUFFER ("tab-width", &BVAR (current_buffer, tab_width),
d5040d2d 5471 make_number (Lisp_Int0),
fb7ada5f 5472 doc: /* Distance between tab stops (for display of tab characters), in columns.
fde4eb86 5473This should be an integer greater than zero. */);
1ab256cb 5474
4b4deea2 5475 DEFVAR_PER_BUFFER ("ctl-arrow", &BVAR (current_buffer, ctl_arrow), Qnil,
fb7ada5f 5476 doc: /* Non-nil means display control chars with uparrow.
018ba359
PJ
5477A value of nil means use backslash and octal digits.
5478This variable does not apply to characters whose display is specified
5479in the current display table (if there is one). */);
1ab256cb 5480
3b06f880 5481 DEFVAR_PER_BUFFER ("enable-multibyte-characters",
4b4deea2 5482 &BVAR (current_buffer, enable_multibyte_characters),
a9b9a780 5483 Qnil,
efc7e75f 5484 doc: /* Non-nil means the buffer contents are regarded as multi-byte characters.
018ba359
PJ
5485Otherwise they are regarded as unibyte. This affects the display,
5486file I/O and the behavior of various editing commands.
5487
5488This variable is buffer-local but you cannot set it directly;
5489use the function `set-buffer-multibyte' to change a buffer's representation.
a66cfb1c 5490See also Info node `(elisp)Text Representations'. */);
d67b4f80 5491 XSYMBOL (intern_c_string ("enable-multibyte-characters"))->constant = 1;
3b06f880 5492
c71b5d9b 5493 DEFVAR_PER_BUFFER ("buffer-file-coding-system",
4b4deea2 5494 &BVAR (current_buffer, buffer_file_coding_system), Qnil,
efc7e75f 5495 doc: /* Coding system to be used for encoding the buffer contents on saving.
018ba359
PJ
5496This variable applies to saving the buffer, and also to `write-region'
5497and other functions that use `write-region'.
5498It does not apply to sending output to subprocesses, however.
5499
5500If this is nil, the buffer is saved without any code conversion
5501unless some coding system is specified in `file-coding-system-alist'
5502for the buffer file.
5503
31a6cb06
EZ
5504If the text to be saved cannot be encoded as specified by this variable,
5505an alternative encoding is selected by `select-safe-coding-system', which see.
5506
018ba359
PJ
5507The variable `coding-system-for-write', if non-nil, overrides this variable.
5508
5509This variable is never applied to a way of decoding a file while reading it. */);
c71b5d9b 5510
f44e260c 5511 DEFVAR_PER_BUFFER ("bidi-display-reordering",
4b4deea2 5512 &BVAR (current_buffer, bidi_display_reordering), Qnil,
938efb77 5513 doc: /* Non-nil means reorder bidirectional text for display in the visual order. */);
3b06f880 5514
6c0cf218 5515 DEFVAR_PER_BUFFER ("bidi-paragraph-direction",
4b4deea2 5516 &BVAR (current_buffer, bidi_paragraph_direction), Qnil,
fb7ada5f 5517 doc: /* If non-nil, forces directionality of text paragraphs in the buffer.
b4bf28b7 5518
b44d9321
EZ
5519If this is nil (the default), the direction of each paragraph is
5520determined by the first strong directional character of its text.
5521The values of `right-to-left' and `left-to-right' override that.
5522Any other value is treated as nil.
b4bf28b7 5523
b44d9321
EZ
5524This variable has no effect unless the buffer's value of
5525\`bidi-display-reordering' is non-nil. */);
5526
4b4deea2 5527 DEFVAR_PER_BUFFER ("truncate-lines", &BVAR (current_buffer, truncate_lines), Qnil,
fb7ada5f 5528 doc: /* Non-nil means do not display continuation lines.
7614d762 5529Instead, give each line of text just one screen line.
018ba359
PJ
5530
5531Note that this is overridden by the variable
5532`truncate-partial-width-windows' if that variable is non-nil
32bbb17c
GM
5533and this buffer is not full-frame width.
5534
5535Minibuffers set this variable to nil. */);
1ab256cb 5536
4b4deea2 5537 DEFVAR_PER_BUFFER ("word-wrap", &BVAR (current_buffer, word_wrap), Qnil,
fb7ada5f 5538 doc: /* Non-nil means to use word-wrapping for continuation lines.
0858cd02
CY
5539When word-wrapping is on, continuation lines are wrapped at the space
5540or tab character nearest to the right window edge.
5541If nil, continuation lines are wrapped at the right screen edge.
5542
5543This variable has no effect if long lines are truncated (see
eb577e27
GM
5544`truncate-lines' and `truncate-partial-width-windows'). If you use
5545word-wrapping, you might want to reduce the value of
5546`truncate-partial-width-windows', since wrapping can make text readable
c5cfcbe0
CY
5547in narrower windows.
5548
5549Instead of setting this variable directly, most users should use
5550Visual Line mode . Visual Line mode, when enabled, sets `word-wrap'
5551to t, and additionally redefines simple editing commands to act on
5552visual lines rather than logical lines. See the documentation of
5553`visual-line-mode'. */);
0858cd02 5554
4b4deea2 5555 DEFVAR_PER_BUFFER ("default-directory", &BVAR (current_buffer, directory),
7ee72033 5556 make_number (Lisp_String),
efc7e75f 5557 doc: /* Name of default directory of current buffer. Should end with slash.
018ba359 5558To interactively change the default directory, use command `cd'. */);
1ab256cb 5559
4b4deea2 5560 DEFVAR_PER_BUFFER ("auto-fill-function", &BVAR (current_buffer, auto_fill_function),
7ee72033 5561 Qnil,
efc7e75f 5562 doc: /* Function called (if non-nil) to perform auto-fill.
018ba359
PJ
5563It is called after self-inserting any character specified in
5564the `auto-fill-chars' table.
5565NOTE: This variable is not a hook;
5566its value may not be a list of functions. */);
1ab256cb 5567
4b4deea2 5568 DEFVAR_PER_BUFFER ("buffer-file-name", &BVAR (current_buffer, filename),
7ee72033 5569 make_number (Lisp_String),
efc7e75f 5570 doc: /* Name of file visited in current buffer, or nil if not visiting a file. */);
1ab256cb 5571
4b4deea2 5572 DEFVAR_PER_BUFFER ("buffer-file-truename", &BVAR (current_buffer, file_truename),
7ee72033 5573 make_number (Lisp_String),
efc7e75f 5574 doc: /* Abbreviated truename of file visited in current buffer, or nil if none.
018ba359
PJ
5575The truename of a file is calculated by `file-truename'
5576and then abbreviated with `abbreviate-file-name'. */);
f6ed2e84 5577
1ab256cb 5578 DEFVAR_PER_BUFFER ("buffer-auto-save-file-name",
4b4deea2 5579 &BVAR (current_buffer, auto_save_file_name),
7ee72033 5580 make_number (Lisp_String),
7614d762
RS
5581 doc: /* Name of file for auto-saving current buffer.
5582If it is nil, that means don't auto-save this buffer. */);
1ab256cb 5583
4b4deea2 5584 DEFVAR_PER_BUFFER ("buffer-read-only", &BVAR (current_buffer, read_only), Qnil,
efc7e75f 5585 doc: /* Non-nil if this buffer is read-only. */);
1ab256cb 5586
4b4deea2 5587 DEFVAR_PER_BUFFER ("buffer-backed-up", &BVAR (current_buffer, backed_up), Qnil,
efc7e75f 5588 doc: /* Non-nil if this buffer's file has been backed up.
018ba359 5589Backing up is done before the first time the file is saved. */);
1ab256cb 5590
4b4deea2 5591 DEFVAR_PER_BUFFER ("buffer-saved-size", &BVAR (current_buffer, save_length),
d5040d2d 5592 make_number (Lisp_Int0),
efc7e75f 5593 doc: /* Length of current buffer when last read in, saved or auto-saved.
4be941e3
RS
55940 initially.
5595-1 means auto-saving turned off until next real save.
5596
5597If you set this to -2, that means don't turn off auto-saving in this buffer
5598if its text size shrinks. If you use `buffer-swap-text' on a buffer,
5599you probably should set this to -2 in that buffer. */);
1ab256cb 5600
4b4deea2 5601 DEFVAR_PER_BUFFER ("selective-display", &BVAR (current_buffer, selective_display),
7ee72033 5602 Qnil,
7614d762 5603 doc: /* Non-nil enables selective display.
a66f285a
JB
5604An integer N as value means display only lines
5605that start with less than N columns of space.
7614d762
RS
5606A value of t means that the character ^M makes itself and
5607all the rest of the line invisible; also, when saving the buffer
5608in a file, save the ^M as a newline. */);
1ab256cb 5609
1ab256cb 5610 DEFVAR_PER_BUFFER ("selective-display-ellipses",
4b4deea2 5611 &BVAR (current_buffer, selective_display_ellipses),
7ee72033 5612 Qnil,
3f676284 5613 doc: /* Non-nil means display ... on previous line when a line is invisible. */);
1ab256cb 5614
4b4deea2 5615 DEFVAR_PER_BUFFER ("overwrite-mode", &BVAR (current_buffer, overwrite_mode), Qnil,
efc7e75f 5616 doc: /* Non-nil if self-insertion should replace existing text.
018ba359
PJ
5617The value should be one of `overwrite-mode-textual',
5618`overwrite-mode-binary', or nil.
5619If it is `overwrite-mode-textual', self-insertion still
5620inserts at the end of a line, and inserts when point is before a tab,
5621until the tab is filled in.
5622If `overwrite-mode-binary', self-insertion replaces newlines and tabs too. */);
5623
4b4deea2 5624 DEFVAR_PER_BUFFER ("buffer-display-table", &BVAR (current_buffer, display_table),
7ee72033 5625 Qnil,
efc7e75f 5626 doc: /* Display table that controls display of the contents of current buffer.
018ba359
PJ
5627
5628If this variable is nil, the value of `standard-display-table' is used.
5629Each window can have its own, overriding display table, see
5630`set-window-display-table' and `window-display-table'.
5631
5632The display table is a char-table created with `make-display-table'.
5633A char-table is an array indexed by character codes. Normal array
5634primitives `aref' and `aset' can be used to access elements of a char-table.
5635
5636Each of the char-table elements control how to display the corresponding
5637text character: the element at index C in the table says how to display
5638the character whose code is C. Each element should be a vector of
426a9163
JB
5639characters or nil. The value nil means display the character in the
5640default fashion; otherwise, the characters from the vector are delivered
5641to the screen instead of the original character.
018ba359 5642
5fd11dc8 5643For example, (aset buffer-display-table ?X [?Y]) tells Emacs
adbb3b05 5644to display a capital Y instead of each X character.
018ba359
PJ
5645
5646In addition, a char-table has six extra slots to control the display of:
5647
5648 the end of a truncated screen line (extra-slot 0, a single character);
5649 the end of a continued line (extra-slot 1, a single character);
5650 the escape character used to display character codes in octal
5651 (extra-slot 2, a single character);
5652 the character used as an arrow for control characters (extra-slot 3,
5653 a single character);
5654 the decoration indicating the presence of invisible lines (extra-slot 4,
5655 a vector of characters);
5656 the character used to draw the border between side-by-side windows
5657 (extra-slot 5, a single character).
5658
5659See also the functions `display-table-slot' and `set-display-table-slot'. */);
1ab256cb 5660
4b4deea2 5661 DEFVAR_PER_BUFFER ("left-margin-width", &BVAR (current_buffer, left_margin_cols),
7ee72033 5662 Qnil,
fb7ada5f 5663 doc: /* Width of left marginal area for display of a buffer.
018ba359 5664A value of nil means no marginal area. */);
177c0ea7 5665
4b4deea2 5666 DEFVAR_PER_BUFFER ("right-margin-width", &BVAR (current_buffer, right_margin_cols),
7ee72033 5667 Qnil,
fb7ada5f 5668 doc: /* Width of right marginal area for display of a buffer.
018ba359 5669A value of nil means no marginal area. */);
177c0ea7 5670
4b4deea2 5671 DEFVAR_PER_BUFFER ("left-fringe-width", &BVAR (current_buffer, left_fringe_width),
2ad8731a 5672 Qnil,
fb7ada5f 5673 doc: /* Width of this buffer's left fringe (in pixels).
2ad8731a
KS
5674A value of 0 means no left fringe is shown in this buffer's window.
5675A value of nil means to use the left fringe width from the window's frame. */);
5676
4b4deea2 5677 DEFVAR_PER_BUFFER ("right-fringe-width", &BVAR (current_buffer, right_fringe_width),
2ad8731a 5678 Qnil,
fb7ada5f 5679 doc: /* Width of this buffer's right fringe (in pixels).
2ad8731a
KS
5680A value of 0 means no right fringe is shown in this buffer's window.
5681A value of nil means to use the right fringe width from the window's frame. */);
5682
4b4deea2 5683 DEFVAR_PER_BUFFER ("fringes-outside-margins", &BVAR (current_buffer, fringes_outside_margins),
2ad8731a 5684 Qnil,
fb7ada5f 5685 doc: /* Non-nil means to display fringes outside display margins.
2ad8731a
KS
5686A value of nil means to display fringes between margins and buffer text. */);
5687
4b4deea2 5688 DEFVAR_PER_BUFFER ("scroll-bar-width", &BVAR (current_buffer, scroll_bar_width),
2ad8731a 5689 Qnil,
fb7ada5f 5690 doc: /* Width of this buffer's scroll bars in pixels.
2ad8731a
KS
5691A value of nil means to use the scroll bar width from the window's frame. */);
5692
4b4deea2 5693 DEFVAR_PER_BUFFER ("vertical-scroll-bar", &BVAR (current_buffer, vertical_scroll_bar_type),
2ad8731a 5694 Qnil,
fb7ada5f 5695 doc: /* Position of this buffer's vertical scroll bar.
7c6b2007 5696The value takes effect whenever you tell a window to display this buffer;
188577ce 5697for instance, with `set-window-buffer' or when `display-buffer' displays it.
7c6b2007 5698
fc2c8887
RS
5699A value of `left' or `right' means put the vertical scroll bar at that side
5700of the window; a value of nil means don't show any vertical scroll bars.
5701A value of t (the default) means do whatever the window's frame specifies. */);
2ad8731a 5702
0552666b 5703 DEFVAR_PER_BUFFER ("indicate-empty-lines",
4b4deea2 5704 &BVAR (current_buffer, indicate_empty_lines), Qnil,
fb7ada5f 5705 doc: /* Visually indicate empty lines after the buffer end.
018ba359
PJ
5706If non-nil, a bitmap is displayed in the left fringe of a window on
5707window-systems. */);
177c0ea7 5708
6b61353c 5709 DEFVAR_PER_BUFFER ("indicate-buffer-boundaries",
4b4deea2 5710 &BVAR (current_buffer, indicate_buffer_boundaries), Qnil,
fb7ada5f 5711 doc: /* Visually indicate buffer boundaries and scrolling.
6b61353c
KH
5712If non-nil, the first and last line of the buffer are marked in the fringe
5713of a window on window-systems with angle bitmaps, or if the window can be
5714scrolled, the top and bottom line of the window are marked with up and down
5715arrow bitmaps.
b2229037
KS
5716
5717If value is a symbol `left' or `right', both angle and arrow bitmaps
79e3497d 5718are displayed in the left or right fringe, resp. Any other value
845a78b4 5719that doesn't look like an alist means display the angle bitmaps in
79e3497d 5720the left fringe but no arrows.
b2229037 5721
79e3497d
RS
5722You can exercise more precise control by using an alist as the
5723value. Each alist element (INDICATOR . POSITION) specifies
5724where to show one of the indicators. INDICATOR is one of `top',
b2229037
KS
5725`bottom', `up', `down', or t, which specifies the default position,
5726and POSITION is one of `left', `right', or nil, meaning do not show
5727this indicator.
5728
5729For example, ((top . left) (t . right)) places the top angle bitmap in
5730left fringe, the bottom angle bitmap in right fringe, and both arrow
6b61353c 5731bitmaps in right fringe. To show just the angle bitmaps in the left
b2229037 5732fringe, but no arrow bitmaps, use ((top . left) (bottom . left)). */);
6b61353c 5733
c6a46372 5734 DEFVAR_PER_BUFFER ("fringe-indicator-alist",
4b4deea2 5735 &BVAR (current_buffer, fringe_indicator_alist), Qnil,
fb7ada5f 5736 doc: /* Mapping from logical to physical fringe indicator bitmaps.
c6a46372
KS
5737The value is an alist where each element (INDICATOR . BITMAPS)
5738specifies the fringe bitmaps used to display a specific logical
5739fringe indicator.
5740
5741INDICATOR specifies the logical indicator type which is one of the
5742following symbols: `truncation' , `continuation', `overlay-arrow',
14fb5704 5743`top', `bottom', `top-bottom', `up', `down', empty-line', or `unknown'.
c6a46372 5744
14fb5704 5745BITMAPS is a list of symbols (LEFT RIGHT [LEFT1 RIGHT1]) which specifies
c6a46372
KS
5746the actual bitmap shown in the left or right fringe for the logical
5747indicator. LEFT and RIGHT are the bitmaps shown in the left and/or
5748right fringe for the specific indicator. The LEFT1 or RIGHT1 bitmaps
14fb5704
JB
5749are used only for the `bottom' and `top-bottom' indicators when the
5750last (only) line has no final newline. BITMAPS may also be a single
c6a46372
KS
5751symbol which is used in both left and right fringes. */);
5752
5753 DEFVAR_PER_BUFFER ("fringe-cursor-alist",
4b4deea2 5754 &BVAR (current_buffer, fringe_cursor_alist), Qnil,
fb7ada5f 5755 doc: /* Mapping from logical to physical fringe cursor bitmaps.
c6a46372
KS
5756The value is an alist where each element (CURSOR . BITMAP)
5757specifies the fringe bitmaps used to display a specific logical
5758cursor type in the fringe.
5759
5760CURSOR specifies the logical cursor type which is one of the following
5761symbols: `box' , `hollow', `bar', `hbar', or `hollow-small'. The last
5762one is used to show a hollow cursor on narrow lines display lines
5763where the normal hollow cursor will not fit.
5764
5765BITMAP is the corresponding fringe bitmap shown for the logical
5766cursor type. */);
5767
0552666b 5768 DEFVAR_PER_BUFFER ("scroll-up-aggressively",
4b4deea2 5769 &BVAR (current_buffer, scroll_up_aggressively), Qnil,
4e0692c1
RS
5770 doc: /* How far to scroll windows upward.
5771If you move point off the bottom, the window scrolls automatically.
426a9163 5772This variable controls how far it scrolls. The value nil, the default,
4e0692c1
RS
5773means scroll to center point. A fraction means scroll to put point
5774that fraction of the window's height from the bottom of the window.
d765e3a3
JB
5775When the value is 0.0, point goes at the bottom line, which in the
5776simple case that you moved off with C-f means scrolling just one line.
57771.0 means point goes at the top, so that in that simple case, the
5778window scrolls by a full window height. Meaningful values are
175e9712 5779between 0.0 and 1.0, inclusive. */);
177c0ea7 5780
0552666b 5781 DEFVAR_PER_BUFFER ("scroll-down-aggressively",
4b4deea2 5782 &BVAR (current_buffer, scroll_down_aggressively), Qnil,
4e0692c1
RS
5783 doc: /* How far to scroll windows downward.
5784If you move point off the top, the window scrolls automatically.
426a9163 5785This variable controls how far it scrolls. The value nil, the default,
4e0692c1
RS
5786means scroll to center point. A fraction means scroll to put point
5787that fraction of the window's height from the top of the window.
d765e3a3
JB
5788When the value is 0.0, point goes at the top line, which in the
5789simple case that you moved off with C-b means scrolling just one line.
57901.0 means point goes at the bottom, so that in that simple case, the
5791window scrolls by a full window height. Meaningful values are
175e9712 5792between 0.0 and 1.0, inclusive. */);
177c0ea7 5793
1ab256cb
RM
5794/*DEFVAR_LISP ("debug-check-symbol", &Vcheck_symbol,
5795 "Don't ask.");
5796*/
1ab256cb 5797
29208e82 5798 DEFVAR_LISP ("before-change-functions", Vbefore_change_functions,
7ee72033 5799 doc: /* List of functions to call before each text change.
018ba359
PJ
5800Two arguments are passed to each function: the positions of
5801the beginning and end of the range of old text to be changed.
5802\(For an insertion, the beginning and end are at the same place.)
5803No information is given about the length of the text after the change.
5804
5805Buffer changes made while executing the `before-change-functions'
5806don't call any before-change or after-change functions.
7b2bf907 5807That's because `inhibit-modification-hooks' is temporarily set non-nil.
018ba359
PJ
5808
5809If an unhandled error happens in running these functions,
5810the variable's value remains nil. That prevents the error
5811from happening repeatedly and making Emacs nonfunctional. */);
5f079267
RS
5812 Vbefore_change_functions = Qnil;
5813
29208e82 5814 DEFVAR_LISP ("after-change-functions", Vafter_change_functions,
eacdfade 5815 doc: /* List of functions to call after each text change.
018ba359
PJ
5816Three arguments are passed to each function: the positions of
5817the beginning and end of the range of changed text,
5818and the length in bytes of the pre-change text replaced by that range.
5819\(For an insertion, the pre-change length is zero;
5820for a deletion, that length is the number of bytes deleted,
5821and the post-change beginning and end are at the same place.)
5822
5823Buffer changes made while executing the `after-change-functions'
5824don't call any before-change or after-change functions.
7b2bf907 5825That's because `inhibit-modification-hooks' is temporarily set non-nil.
018ba359
PJ
5826
5827If an unhandled error happens in running these functions,
5828the variable's value remains nil. That prevents the error
5829from happening repeatedly and making Emacs nonfunctional. */);
5f079267
RS
5830 Vafter_change_functions = Qnil;
5831
29208e82 5832 DEFVAR_LISP ("first-change-hook", Vfirst_change_hook,
efc7e75f 5833 doc: /* A list of functions to call before changing a buffer which is unmodified.
018ba359 5834The functions are run using the `run-hooks' function. */);
dbc4e1c1 5835 Vfirst_change_hook = Qnil;
1ab256cb 5836
4b4deea2 5837 DEFVAR_PER_BUFFER ("buffer-undo-list", &BVAR (current_buffer, undo_list), Qnil,
7ee72033 5838 doc: /* List of undo entries in current buffer.
018ba359
PJ
5839Recent changes come first; older changes follow newer.
5840
5841An entry (BEG . END) represents an insertion which begins at
5842position BEG and ends at position END.
5843
5844An entry (TEXT . POSITION) represents the deletion of the string TEXT
5845from (abs POSITION). If POSITION is positive, point was at the front
5846of the text being deleted; if negative, point was at the end.
5847
d35af63c
PE
5848An entry (t HIGH LOW USEC PSEC) indicates that the buffer was previously
5849unmodified; (HIGH LOW USEC PSEC) is in the same style as (current-time)
5850and is the visited file's modification time, as of that time. If the
018ba359
PJ
5851modification time of the most recent save is different, this entry is
5852obsolete.
5853
5854An entry (nil PROPERTY VALUE BEG . END) indicates that a text property
5855was modified between BEG and END. PROPERTY is the property name,
5856and VALUE is the old value.
5857
7405f386
KS
5858An entry (apply FUN-NAME . ARGS) means undo the change with
5859\(apply FUN-NAME ARGS).
5860
5861An entry (apply DELTA BEG END FUN-NAME . ARGS) supports selective undo
5862in the active region. BEG and END is the range affected by this entry
5863and DELTA is the number of bytes added or deleted in that range by
5864this change.
c6c7dc03 5865
018ba359
PJ
5866An entry (MARKER . DISTANCE) indicates that the marker MARKER
5867was adjusted in position by the offset DISTANCE (an integer).
5868
5869An entry of the form POSITION indicates that point was at the buffer
5870location given by the integer. Undoing an entry of this form places
5871point at POSITION.
5872
b4c4f2f4
JB
5873Entries with value `nil' mark undo boundaries. The undo command treats
5874the changes between two undo boundaries as a single step to be undone.
018ba359
PJ
5875
5876If the value of the variable is t, undo information is not recorded. */);
5877
4b4deea2 5878 DEFVAR_PER_BUFFER ("mark-active", &BVAR (current_buffer, mark_active), Qnil,
7ee72033 5879 doc: /* Non-nil means the mark and region are currently active in this buffer. */);
018ba359 5880
4b4deea2 5881 DEFVAR_PER_BUFFER ("cache-long-line-scans", &BVAR (current_buffer, cache_long_line_scans), Qnil,
7ee72033 5882 doc: /* Non-nil means that Emacs should use caches to handle long lines more quickly.
018ba359
PJ
5883
5884Normally, the line-motion functions work by scanning the buffer for
5629f29b
DK
5885newlines. Columnar operations (like `move-to-column' and
5886`compute-motion') also work by scanning the buffer, summing character
018ba359
PJ
5887widths as they go. This works well for ordinary text, but if the
5888buffer's lines are very long (say, more than 500 characters), these
5889motion functions will take longer to execute. Emacs may also take
5890longer to update the display.
5891
5629f29b 5892If `cache-long-line-scans' is non-nil, these motion functions cache the
018ba359
PJ
5893results of their scans, and consult the cache to avoid rescanning
5894regions of the buffer until the text is modified. The caches are most
5895beneficial when they prevent the most searching---that is, when the
5896buffer contains long lines and large regions of characters with the
5897same, fixed screen width.
5898
5629f29b 5899When `cache-long-line-scans' is non-nil, processing short lines will
018ba359
PJ
5900become slightly slower (because of the overhead of consulting the
5901cache), and the caches will use memory roughly proportional to the
5902number of newlines and characters whose screen width varies.
5903
5904The caches require no explicit maintenance; their accuracy is
5905maintained internally by the Emacs primitives. Enabling or disabling
5906the cache should not affect the behavior of any of the motion
5907functions; it should only affect their performance. */);
5908
4b4deea2 5909 DEFVAR_PER_BUFFER ("point-before-scroll", &BVAR (current_buffer, point_before_scroll), Qnil,
7ee72033 5910 doc: /* Value of point before the last series of scroll operations, or nil. */);
018ba359 5911
4b4deea2 5912 DEFVAR_PER_BUFFER ("buffer-file-format", &BVAR (current_buffer, file_format), Qnil,
7ee72033 5913 doc: /* List of formats to use when saving this buffer.
018ba359 5914Formats are defined by `format-alist'. This variable is
a9b9a780 5915set when a file is visited. */);
be9aafdd 5916
71ed49fa 5917 DEFVAR_PER_BUFFER ("buffer-auto-save-file-format",
4b4deea2 5918 &BVAR (current_buffer, auto_save_file_format), Qnil,
fb7ada5f 5919 doc: /* Format in which to write auto-save files.
71ed49fa
LT
5920Should be a list of symbols naming formats that are defined in `format-alist'.
5921If it is t, which is the default, auto-save files are written in the
5922same format as a regular save would use. */);
5923
3cb719bd 5924 DEFVAR_PER_BUFFER ("buffer-invisibility-spec",
4b4deea2 5925 &BVAR (current_buffer, invisibility_spec), Qnil,
7ee72033 5926 doc: /* Invisibility spec of this buffer.
018ba359
PJ
5927The default is t, which means that text is invisible
5928if it has a non-nil `invisible' property.
5929If the value is a list, a text character is invisible if its `invisible'
b49dd850 5930property is an element in that list (or is a list with members in common).
018ba359
PJ
5931If an element is a cons cell of the form (PROP . ELLIPSIS),
5932then characters with property value PROP are invisible,
5933and they have an ellipsis as well if ELLIPSIS is non-nil. */);
3cb719bd 5934
7962a441 5935 DEFVAR_PER_BUFFER ("buffer-display-count",
4b4deea2 5936 &BVAR (current_buffer, display_count), Qnil,
7ee72033 5937 doc: /* A number incremented each time this buffer is displayed in a window.
018ba359 5938The function `set-window-buffer' increments it. */);
3fd364db
RS
5939
5940 DEFVAR_PER_BUFFER ("buffer-display-time",
4b4deea2 5941 &BVAR (current_buffer, display_time), Qnil,
7ee72033 5942 doc: /* Time stamp updated each time this buffer is displayed in a window.
018ba359
PJ
5943The function `set-window-buffer' updates this variable
5944to the value obtained by calling `current-time'.
5945If the buffer has never been shown in a window, the value is nil. */);
5946
29208e82 5947 DEFVAR_LISP ("transient-mark-mode", Vtransient_mark_mode,
9d794026
GM
5948 doc: /* Non-nil if Transient Mark mode is enabled.
5949See the command `transient-mark-mode' for a description of this minor mode.
5950
5951Non-nil also enables highlighting of the region whenever the mark is active.
5952The variable `highlight-nonselected-windows' controls whether to highlight
5953all windows or just the selected window.
5954
f49d1f52 5955Lisp programs may give this variable certain special values:
9d794026 5956
f49d1f52
SM
5957- A value of `lambda' enables Transient Mark mode temporarily.
5958 It is disabled again after any subsequent action that would
5959 normally deactivate the mark (e.g. buffer modification).
5960
5961- A value of (only . OLDVAL) enables Transient Mark mode
5962 temporarily. After any subsequent point motion command that is
5963 not shift-translated, or any other action that would normally
5964 deactivate the mark (e.g. buffer modification), the value of
5965 `transient-mark-mode' is set to OLDVAL. */);
c48f61ef
RS
5966 Vtransient_mark_mode = Qnil;
5967
29208e82 5968 DEFVAR_LISP ("inhibit-read-only", Vinhibit_read_only,
fb7ada5f 5969 doc: /* Non-nil means disregard read-only status of buffers or characters.
018ba359
PJ
5970If the value is t, disregard `buffer-read-only' and all `read-only'
5971text properties. If the value is a list, disregard `buffer-read-only'
5972and disregard a `read-only' text property if the property value
5973is a member of the list. */);
a96b68f1
RS
5974 Vinhibit_read_only = Qnil;
5975
4b4deea2 5976 DEFVAR_PER_BUFFER ("cursor-type", &BVAR (current_buffer, cursor_type), Qnil,
f6e22881 5977 doc: /* Cursor to use when this buffer is in the selected window.
018ba359
PJ
5978Values are interpreted as follows:
5979
b8dc613f
JB
5980 t use the cursor specified for the frame
5981 nil don't display a cursor
5982 box display a filled box cursor
5983 hollow display a hollow box cursor
5984 bar display a vertical bar cursor with default width
5985 (bar . WIDTH) display a vertical bar cursor with width WIDTH
5986 hbar display a horizontal bar cursor with default height
b4234f4c 5987 (hbar . HEIGHT) display a horizontal bar cursor with height HEIGHT
b8dc613f 5988 ANYTHING ELSE display a hollow box cursor
cd8d5236 5989
e08b1705
MR
5990When the buffer is displayed in a non-selected window, the
5991cursor's appearance is instead controlled by the variable
5992`cursor-in-non-selected-windows'. */);
bb2ec976 5993
a3bbced0 5994 DEFVAR_PER_BUFFER ("line-spacing",
4b4deea2 5995 &BVAR (current_buffer, extra_line_spacing), Qnil,
7ee72033 5996 doc: /* Additional space to put between lines when displaying a buffer.
3ba010e5
EZ
5997The space is measured in pixels, and put below lines on graphic displays,
5998see `display-graphic-p'.
60ebfdf3 5999If value is a floating point number, it specifies the spacing relative
fc961256 6000to the default frame line height. A value of nil means add no extra space. */);
a3bbced0 6001
0124c5bd 6002 DEFVAR_PER_BUFFER ("cursor-in-non-selected-windows",
4b4deea2 6003 &BVAR (current_buffer, cursor_in_non_selected_windows), Qnil,
fb7ada5f 6004 doc: /* Non-nil means show a cursor in non-selected windows.
66c6abf0
GM
6005If nil, only shows a cursor in the selected window.
6006If t, displays a cursor related to the usual cursor type
6007\(a solid box becomes hollow, a bar becomes a narrower bar).
6008You can also specify the cursor type as in the `cursor-type' variable.
6009Use Custom to set this variable and update the display." */);
0124c5bd 6010
29208e82 6011 DEFVAR_LISP ("kill-buffer-query-functions", Vkill_buffer_query_functions,
f6e22881
JB
6012 doc: /* List of functions called with no args to query before killing a buffer.
6013The buffer being killed will be current while the functions are running.
b7e8d081
MR
6014
6015If any of them returns nil, the buffer is not killed. Functions run by
6016this hook are supposed to not change the current buffer. */);
dcdffbf6
RS
6017 Vkill_buffer_query_functions = Qnil;
6018
29208e82 6019 DEFVAR_LISP ("change-major-mode-hook", Vchange_major_mode_hook,
43ed3b8d
CY
6020 doc: /* Normal hook run before changing the major mode of a buffer.
6021The function `kill-all-local-variables' runs this before doing anything else. */);
6022 Vchange_major_mode_hook = Qnil;
cd3520a4 6023 DEFSYM (Qchange_major_mode_hook, "change-major-mode-hook");
43ed3b8d 6024
9397e56f
MR
6025 DEFVAR_LISP ("buffer-list-update-hook", Vbuffer_list_update_hook,
6026 doc: /* Hook run when the buffer list changes.
6027Functions running this hook are `get-buffer-create',
6028`make-indirect-buffer', `rename-buffer', `kill-buffer',
96a72ee9 6029and `bury-buffer-internal'. */);
9397e56f 6030 Vbuffer_list_update_hook = Qnil;
cd3520a4 6031 DEFSYM (Qbuffer_list_update_hook, "buffer-list-update-hook");
9397e56f 6032
0dc88e60 6033 defsubr (&Sbuffer_live_p);
1ab256cb
RM
6034 defsubr (&Sbuffer_list);
6035 defsubr (&Sget_buffer);
6036 defsubr (&Sget_file_buffer);
6037 defsubr (&Sget_buffer_create);
336cd056 6038 defsubr (&Smake_indirect_buffer);
01050cb5 6039 defsubr (&Sgenerate_new_buffer_name);
1ab256cb 6040 defsubr (&Sbuffer_name);
1ab256cb 6041 defsubr (&Sbuffer_file_name);
336cd056 6042 defsubr (&Sbuffer_base_buffer);
79aa712d 6043 defsubr (&Sbuffer_local_value);
1ab256cb
RM
6044 defsubr (&Sbuffer_local_variables);
6045 defsubr (&Sbuffer_modified_p);
6046 defsubr (&Sset_buffer_modified_p);
6047 defsubr (&Sbuffer_modified_tick);
3e145152 6048 defsubr (&Sbuffer_chars_modified_tick);
1ab256cb
RM
6049 defsubr (&Srename_buffer);
6050 defsubr (&Sother_buffer);
1ab256cb
RM
6051 defsubr (&Sbuffer_enable_undo);
6052 defsubr (&Skill_buffer);
e4ed06f1 6053 defsubr (&Sbury_buffer_internal);
a9ee7a59 6054 defsubr (&Sset_buffer_major_mode);
1ab256cb
RM
6055 defsubr (&Scurrent_buffer);
6056 defsubr (&Sset_buffer);
6057 defsubr (&Sbarf_if_buffer_read_only);
3ac81adb 6058 defsubr (&Serase_buffer);
13cda5f9 6059 defsubr (&Sbuffer_swap_text);
3ac81adb 6060 defsubr (&Sset_buffer_multibyte);
1ab256cb 6061 defsubr (&Skill_all_local_variables);
2eec3b4e 6062
52f8ec73 6063 defsubr (&Soverlayp);
2eec3b4e
RS
6064 defsubr (&Smake_overlay);
6065 defsubr (&Sdelete_overlay);
6066 defsubr (&Smove_overlay);
8ebafa8d
JB
6067 defsubr (&Soverlay_start);
6068 defsubr (&Soverlay_end);
6069 defsubr (&Soverlay_buffer);
6070 defsubr (&Soverlay_properties);
2eec3b4e 6071 defsubr (&Soverlays_at);
74514898 6072 defsubr (&Soverlays_in);
2eec3b4e 6073 defsubr (&Snext_overlay_change);
239c932b 6074 defsubr (&Sprevious_overlay_change);
2eec3b4e
RS
6075 defsubr (&Soverlay_recenter);
6076 defsubr (&Soverlay_lists);
6077 defsubr (&Soverlay_get);
6078 defsubr (&Soverlay_put);
a8c21b48 6079 defsubr (&Srestore_buffer_modified_p);
1ab256cb
RM
6080}
6081
dfcf069d 6082void
d3da34e0 6083keys_of_buffer (void)
1ab256cb
RM
6084{
6085 initial_define_key (control_x_map, 'b', "switch-to-buffer");
6086 initial_define_key (control_x_map, 'k', "kill-buffer");
4158c17d
RM
6087
6088 /* This must not be in syms_of_buffer, because Qdisabled is not
6089 initialized when that function gets called. */
d67b4f80 6090 Fput (intern_c_string ("erase-buffer"), Qdisabled, Qt);
1ab256cb 6091}