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