* progmodes/cfengine.el: Use symbol motion commands instead of extending the word...
[emacs.git] / src / buffer.c
blobaa3fcf8c234026fe9d06331b183b672f1ded1a5a
1 /* Buffer manipulation primitives for GNU Emacs.
3 Copyright (C) 1985-1989, 1993-1995, 1997-2013 Free Software Foundation,
4 Inc.
6 This file is part of GNU Emacs.
8 GNU Emacs is free software: you can redistribute it and/or modify
9 it under the terms of the GNU General Public License as published by
10 the Free Software Foundation, either version 3 of the License, or
11 (at your option) any later version.
13 GNU Emacs is distributed in the hope that it will be useful,
14 but WITHOUT ANY WARRANTY; without even the implied warranty of
15 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 GNU General Public License for more details.
18 You should have received a copy of the GNU General Public License
19 along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
21 #include <config.h>
23 #define BUFFER_INLINE EXTERN_INLINE
25 #include <sys/types.h>
26 #include <sys/stat.h>
27 #include <sys/param.h>
28 #include <errno.h>
29 #include <stdio.h>
30 #include <unistd.h>
32 #include <verify.h>
34 #include "lisp.h"
35 #include "intervals.h"
36 #include "window.h"
37 #include "commands.h"
38 #include "character.h"
39 #include "buffer.h"
40 #include "region-cache.h"
41 #include "indent.h"
42 #include "blockinput.h"
43 #include "keyboard.h"
44 #include "keymap.h"
45 #include "frame.h"
47 struct buffer *current_buffer; /* The current buffer. */
49 /* First buffer in chain of all buffers (in reverse order of creation).
50 Threaded through ->header.next.buffer. */
52 struct buffer *all_buffers;
54 /* This structure holds the default values of the buffer-local variables
55 defined with DEFVAR_PER_BUFFER, that have special slots in each buffer.
56 The default value occupies the same slot in this structure
57 as an individual buffer's value occupies in that buffer.
58 Setting the default value also goes through the alist of buffers
59 and stores into each buffer that does not say it has a local value. */
61 struct buffer alignas (GCALIGNMENT) buffer_defaults;
63 /* This structure marks which slots in a buffer have corresponding
64 default values in buffer_defaults.
65 Each such slot has a nonzero value in this structure.
66 The value has only one nonzero bit.
68 When a buffer has its own local value for a slot,
69 the entry for that slot (found in the same slot in this structure)
70 is turned on in the buffer's local_flags array.
72 If a slot in this structure is -1, then even though there may
73 be a DEFVAR_PER_BUFFER for the slot, there is no default value for it;
74 and the corresponding slot in buffer_defaults is not used.
76 If a slot in this structure corresponding to a DEFVAR_PER_BUFFER is
77 zero, that is a bug. */
79 struct buffer buffer_local_flags;
81 /* This structure holds the names of symbols whose values may be
82 buffer-local. It is indexed and accessed in the same way as the above. */
84 struct buffer alignas (GCALIGNMENT) buffer_local_symbols;
86 /* Return the symbol of the per-buffer variable at offset OFFSET in
87 the buffer structure. */
89 #define PER_BUFFER_SYMBOL(OFFSET) \
90 (*(Lisp_Object *)((OFFSET) + (char *) &buffer_local_symbols))
92 /* Maximum length of an overlay vector. */
93 #define OVERLAY_COUNT_MAX \
94 ((ptrdiff_t) min (MOST_POSITIVE_FIXNUM, \
95 min (PTRDIFF_MAX, SIZE_MAX) / word_size))
97 /* Flags indicating which built-in buffer-local variables
98 are permanent locals. */
99 static char buffer_permanent_local_flags[MAX_PER_BUFFER_VARS];
101 /* Number of per-buffer variables used. */
103 int last_per_buffer_idx;
105 static void call_overlay_mod_hooks (Lisp_Object list, Lisp_Object overlay,
106 bool after, Lisp_Object arg1,
107 Lisp_Object arg2, Lisp_Object arg3);
108 static void swap_out_buffer_local_variables (struct buffer *b);
109 static void reset_buffer_local_variables (struct buffer *, bool);
111 /* Alist of all buffer names vs the buffers. */
112 /* This used to be a variable, but is no longer,
113 to prevent lossage due to user rplac'ing this alist or its elements. */
114 Lisp_Object Vbuffer_alist;
116 static Lisp_Object Qkill_buffer_query_functions;
118 /* Hook run before changing a major mode. */
119 static Lisp_Object Qchange_major_mode_hook;
121 Lisp_Object Qfirst_change_hook;
122 Lisp_Object Qbefore_change_functions;
123 Lisp_Object Qafter_change_functions;
125 static Lisp_Object Qfundamental_mode, Qmode_class, Qpermanent_local;
126 static Lisp_Object Qpermanent_local_hook;
128 static Lisp_Object Qprotected_field;
130 static Lisp_Object QSFundamental; /* A string "Fundamental". */
132 static Lisp_Object Qkill_buffer_hook;
133 static Lisp_Object Qbuffer_list_update_hook;
135 static Lisp_Object Qget_file_buffer;
137 static Lisp_Object Qoverlayp;
139 Lisp_Object Qpriority, Qbefore_string, Qafter_string;
141 static Lisp_Object Qevaporate;
143 Lisp_Object Qmodification_hooks;
144 Lisp_Object Qinsert_in_front_hooks;
145 Lisp_Object Qinsert_behind_hooks;
147 static void alloc_buffer_text (struct buffer *, ptrdiff_t);
148 static void free_buffer_text (struct buffer *b);
149 static struct Lisp_Overlay * copy_overlays (struct buffer *, struct Lisp_Overlay *);
150 static void modify_overlay (struct buffer *, ptrdiff_t, ptrdiff_t);
151 static Lisp_Object buffer_lisp_local_variables (struct buffer *, bool);
153 /* These setters are used only in this file, so they can be private. */
154 static void
155 bset_abbrev_mode (struct buffer *b, Lisp_Object val)
157 b->INTERNAL_FIELD (abbrev_mode) = val;
159 static void
160 bset_abbrev_table (struct buffer *b, Lisp_Object val)
162 b->INTERNAL_FIELD (abbrev_table) = val;
164 static void
165 bset_auto_fill_function (struct buffer *b, Lisp_Object val)
167 b->INTERNAL_FIELD (auto_fill_function) = val;
169 static void
170 bset_auto_save_file_format (struct buffer *b, Lisp_Object val)
172 b->INTERNAL_FIELD (auto_save_file_format) = val;
174 static void
175 bset_auto_save_file_name (struct buffer *b, Lisp_Object val)
177 b->INTERNAL_FIELD (auto_save_file_name) = val;
179 static void
180 bset_backed_up (struct buffer *b, Lisp_Object val)
182 b->INTERNAL_FIELD (backed_up) = val;
184 static void
185 bset_begv_marker (struct buffer *b, Lisp_Object val)
187 b->INTERNAL_FIELD (begv_marker) = val;
189 static void
190 bset_bidi_display_reordering (struct buffer *b, Lisp_Object val)
192 b->INTERNAL_FIELD (bidi_display_reordering) = val;
194 static void
195 bset_buffer_file_coding_system (struct buffer *b, Lisp_Object val)
197 b->INTERNAL_FIELD (buffer_file_coding_system) = val;
199 static void
200 bset_cache_long_line_scans (struct buffer *b, Lisp_Object val)
202 b->INTERNAL_FIELD (cache_long_line_scans) = val;
204 static void
205 bset_case_fold_search (struct buffer *b, Lisp_Object val)
207 b->INTERNAL_FIELD (case_fold_search) = val;
209 static void
210 bset_ctl_arrow (struct buffer *b, Lisp_Object val)
212 b->INTERNAL_FIELD (ctl_arrow) = val;
214 static void
215 bset_cursor_in_non_selected_windows (struct buffer *b, Lisp_Object val)
217 b->INTERNAL_FIELD (cursor_in_non_selected_windows) = val;
219 static void
220 bset_cursor_type (struct buffer *b, Lisp_Object val)
222 b->INTERNAL_FIELD (cursor_type) = val;
224 static void
225 bset_display_table (struct buffer *b, Lisp_Object val)
227 b->INTERNAL_FIELD (display_table) = val;
229 static void
230 bset_extra_line_spacing (struct buffer *b, Lisp_Object val)
232 b->INTERNAL_FIELD (extra_line_spacing) = val;
234 static void
235 bset_file_format (struct buffer *b, Lisp_Object val)
237 b->INTERNAL_FIELD (file_format) = val;
239 static void
240 bset_file_truename (struct buffer *b, Lisp_Object val)
242 b->INTERNAL_FIELD (file_truename) = val;
244 static void
245 bset_fringe_cursor_alist (struct buffer *b, Lisp_Object val)
247 b->INTERNAL_FIELD (fringe_cursor_alist) = val;
249 static void
250 bset_fringe_indicator_alist (struct buffer *b, Lisp_Object val)
252 b->INTERNAL_FIELD (fringe_indicator_alist) = val;
254 static void
255 bset_fringes_outside_margins (struct buffer *b, Lisp_Object val)
257 b->INTERNAL_FIELD (fringes_outside_margins) = val;
259 static void
260 bset_header_line_format (struct buffer *b, Lisp_Object val)
262 b->INTERNAL_FIELD (header_line_format) = val;
264 static void
265 bset_indicate_buffer_boundaries (struct buffer *b, Lisp_Object val)
267 b->INTERNAL_FIELD (indicate_buffer_boundaries) = val;
269 static void
270 bset_indicate_empty_lines (struct buffer *b, Lisp_Object val)
272 b->INTERNAL_FIELD (indicate_empty_lines) = val;
274 static void
275 bset_invisibility_spec (struct buffer *b, Lisp_Object val)
277 b->INTERNAL_FIELD (invisibility_spec) = val;
279 static void
280 bset_left_fringe_width (struct buffer *b, Lisp_Object val)
282 b->INTERNAL_FIELD (left_fringe_width) = val;
284 static void
285 bset_major_mode (struct buffer *b, Lisp_Object val)
287 b->INTERNAL_FIELD (major_mode) = val;
289 static void
290 bset_mark (struct buffer *b, Lisp_Object val)
292 b->INTERNAL_FIELD (mark) = val;
294 static void
295 bset_minor_modes (struct buffer *b, Lisp_Object val)
297 b->INTERNAL_FIELD (minor_modes) = val;
299 static void
300 bset_mode_line_format (struct buffer *b, Lisp_Object val)
302 b->INTERNAL_FIELD (mode_line_format) = val;
304 static void
305 bset_mode_name (struct buffer *b, Lisp_Object val)
307 b->INTERNAL_FIELD (mode_name) = val;
309 static void
310 bset_name (struct buffer *b, Lisp_Object val)
312 b->INTERNAL_FIELD (name) = val;
314 static void
315 bset_overwrite_mode (struct buffer *b, Lisp_Object val)
317 b->INTERNAL_FIELD (overwrite_mode) = val;
319 static void
320 bset_pt_marker (struct buffer *b, Lisp_Object val)
322 b->INTERNAL_FIELD (pt_marker) = val;
324 static void
325 bset_right_fringe_width (struct buffer *b, Lisp_Object val)
327 b->INTERNAL_FIELD (right_fringe_width) = val;
329 static void
330 bset_save_length (struct buffer *b, Lisp_Object val)
332 b->INTERNAL_FIELD (save_length) = val;
334 static void
335 bset_scroll_bar_width (struct buffer *b, Lisp_Object val)
337 b->INTERNAL_FIELD (scroll_bar_width) = val;
339 static void
340 bset_scroll_down_aggressively (struct buffer *b, Lisp_Object val)
342 b->INTERNAL_FIELD (scroll_down_aggressively) = val;
344 static void
345 bset_scroll_up_aggressively (struct buffer *b, Lisp_Object val)
347 b->INTERNAL_FIELD (scroll_up_aggressively) = val;
349 static void
350 bset_selective_display (struct buffer *b, Lisp_Object val)
352 b->INTERNAL_FIELD (selective_display) = val;
354 static void
355 bset_selective_display_ellipses (struct buffer *b, Lisp_Object val)
357 b->INTERNAL_FIELD (selective_display_ellipses) = val;
359 static void
360 bset_vertical_scroll_bar_type (struct buffer *b, Lisp_Object val)
362 b->INTERNAL_FIELD (vertical_scroll_bar_type) = val;
364 static void
365 bset_word_wrap (struct buffer *b, Lisp_Object val)
367 b->INTERNAL_FIELD (word_wrap) = val;
369 static void
370 bset_zv_marker (struct buffer *b, Lisp_Object val)
372 b->INTERNAL_FIELD (zv_marker) = val;
375 void
376 nsberror (Lisp_Object spec)
378 if (STRINGP (spec))
379 error ("No buffer named %s", SDATA (spec));
380 error ("Invalid buffer argument");
383 DEFUN ("buffer-live-p", Fbuffer_live_p, Sbuffer_live_p, 1, 1, 0,
384 doc: /* Return non-nil if OBJECT is a buffer which has not been killed.
385 Value is nil if OBJECT is not a buffer or if it has been killed. */)
386 (Lisp_Object object)
388 return ((BUFFERP (object) && BUFFER_LIVE_P (XBUFFER (object)))
389 ? Qt : Qnil);
392 DEFUN ("buffer-list", Fbuffer_list, Sbuffer_list, 0, 1, 0,
393 doc: /* Return a list of all existing live buffers.
394 If the optional arg FRAME is a frame, we return the buffer list in the
395 proper order for that frame: the buffers show in FRAME come first,
396 followed by the rest of the buffers. */)
397 (Lisp_Object frame)
399 Lisp_Object general;
400 general = Fmapcar (Qcdr, Vbuffer_alist);
402 if (FRAMEP (frame))
404 Lisp_Object framelist, prevlist, tail;
405 Lisp_Object args[3];
407 framelist = Fcopy_sequence (XFRAME (frame)->buffer_list);
408 prevlist = Fnreverse (Fcopy_sequence
409 (XFRAME (frame)->buried_buffer_list));
411 /* Remove from GENERAL any buffer that duplicates one in
412 FRAMELIST or PREVLIST. */
413 tail = framelist;
414 while (CONSP (tail))
416 general = Fdelq (XCAR (tail), general);
417 tail = XCDR (tail);
419 tail = prevlist;
420 while (CONSP (tail))
422 general = Fdelq (XCAR (tail), general);
423 tail = XCDR (tail);
426 args[0] = framelist;
427 args[1] = general;
428 args[2] = prevlist;
429 return Fnconc (3, args);
431 else
432 return general;
435 /* Like Fassoc, but use Fstring_equal to compare
436 (which ignores text properties),
437 and don't ever QUIT. */
439 static Lisp_Object
440 assoc_ignore_text_properties (register Lisp_Object key, Lisp_Object list)
442 register Lisp_Object tail;
443 for (tail = list; CONSP (tail); tail = XCDR (tail))
445 register Lisp_Object elt, tem;
446 elt = XCAR (tail);
447 tem = Fstring_equal (Fcar (elt), key);
448 if (!NILP (tem))
449 return elt;
451 return Qnil;
454 DEFUN ("get-buffer", Fget_buffer, Sget_buffer, 1, 1, 0,
455 doc: /* Return the buffer named BUFFER-OR-NAME.
456 BUFFER-OR-NAME must be either a string or a buffer. If BUFFER-OR-NAME
457 is a string and there is no buffer with that name, return nil. If
458 BUFFER-OR-NAME is a buffer, return it as given. */)
459 (register Lisp_Object buffer_or_name)
461 if (BUFFERP (buffer_or_name))
462 return buffer_or_name;
463 CHECK_STRING (buffer_or_name);
465 return Fcdr (assoc_ignore_text_properties (buffer_or_name, Vbuffer_alist));
468 DEFUN ("get-file-buffer", Fget_file_buffer, Sget_file_buffer, 1, 1, 0,
469 doc: /* Return the buffer visiting file FILENAME (a string).
470 The buffer's `buffer-file-name' must match exactly the expansion of FILENAME.
471 If there is no such live buffer, return nil.
472 See also `find-buffer-visiting'. */)
473 (register Lisp_Object filename)
475 register Lisp_Object tail, buf, tem;
476 Lisp_Object handler;
478 CHECK_STRING (filename);
479 filename = Fexpand_file_name (filename, Qnil);
481 /* If the file name has special constructs in it,
482 call the corresponding file handler. */
483 handler = Ffind_file_name_handler (filename, Qget_file_buffer);
484 if (!NILP (handler))
486 Lisp_Object handled_buf = call2 (handler, Qget_file_buffer,
487 filename);
488 return BUFFERP (handled_buf) ? handled_buf : Qnil;
491 for (tail = Vbuffer_alist; CONSP (tail); tail = XCDR (tail))
493 buf = Fcdr (XCAR (tail));
494 if (!BUFFERP (buf)) continue;
495 if (!STRINGP (BVAR (XBUFFER (buf), filename))) continue;
496 tem = Fstring_equal (BVAR (XBUFFER (buf), filename), filename);
497 if (!NILP (tem))
498 return buf;
500 return Qnil;
503 Lisp_Object
504 get_truename_buffer (register Lisp_Object filename)
506 register Lisp_Object tail, buf, tem;
508 for (tail = Vbuffer_alist; CONSP (tail); tail = XCDR (tail))
510 buf = Fcdr (XCAR (tail));
511 if (!BUFFERP (buf)) continue;
512 if (!STRINGP (BVAR (XBUFFER (buf), file_truename))) continue;
513 tem = Fstring_equal (BVAR (XBUFFER (buf), file_truename), filename);
514 if (!NILP (tem))
515 return buf;
517 return Qnil;
520 DEFUN ("get-buffer-create", Fget_buffer_create, Sget_buffer_create, 1, 1, 0,
521 doc: /* Return the buffer specified by BUFFER-OR-NAME, creating a new one if needed.
522 If BUFFER-OR-NAME is a string and a live buffer with that name exists,
523 return that buffer. If no such buffer exists, create a new buffer with
524 that name and return it. If BUFFER-OR-NAME starts with a space, the new
525 buffer does not keep undo information.
527 If BUFFER-OR-NAME is a buffer instead of a string, return it as given,
528 even if it is dead. The return value is never nil. */)
529 (register Lisp_Object buffer_or_name)
531 register Lisp_Object buffer, name;
532 register struct buffer *b;
534 buffer = Fget_buffer (buffer_or_name);
535 if (!NILP (buffer))
536 return buffer;
538 if (SCHARS (buffer_or_name) == 0)
539 error ("Empty string for buffer name is not allowed");
541 b = allocate_buffer ();
543 /* An ordinary buffer uses its own struct buffer_text. */
544 b->text = &b->own_text;
545 b->base_buffer = NULL;
546 /* No one shares the text with us now. */
547 b->indirections = 0;
548 /* No one shows us now. */
549 b->window_count = 0;
551 BUF_GAP_SIZE (b) = 20;
552 block_input ();
553 /* We allocate extra 1-byte at the tail and keep it always '\0' for
554 anchoring a search. */
555 alloc_buffer_text (b, BUF_GAP_SIZE (b) + 1);
556 unblock_input ();
557 if (! BUF_BEG_ADDR (b))
558 buffer_memory_full (BUF_GAP_SIZE (b) + 1);
560 b->pt = BEG;
561 b->begv = BEG;
562 b->zv = BEG;
563 b->pt_byte = BEG_BYTE;
564 b->begv_byte = BEG_BYTE;
565 b->zv_byte = BEG_BYTE;
567 BUF_GPT (b) = BEG;
568 BUF_GPT_BYTE (b) = BEG_BYTE;
570 BUF_Z (b) = BEG;
571 BUF_Z_BYTE (b) = BEG_BYTE;
572 BUF_MODIFF (b) = 1;
573 BUF_CHARS_MODIFF (b) = 1;
574 BUF_OVERLAY_MODIFF (b) = 1;
575 BUF_SAVE_MODIFF (b) = 1;
576 BUF_COMPACT (b) = 1;
577 set_buffer_intervals (b, NULL);
578 BUF_UNCHANGED_MODIFIED (b) = 1;
579 BUF_OVERLAY_UNCHANGED_MODIFIED (b) = 1;
580 BUF_END_UNCHANGED (b) = 0;
581 BUF_BEG_UNCHANGED (b) = 0;
582 *(BUF_GPT_ADDR (b)) = *(BUF_Z_ADDR (b)) = 0; /* Put an anchor '\0'. */
583 b->text->inhibit_shrinking = 0;
585 b->newline_cache = 0;
586 b->width_run_cache = 0;
587 bset_width_table (b, Qnil);
588 b->prevent_redisplay_optimizations_p = 1;
590 /* An ordinary buffer normally doesn't need markers
591 to handle BEGV and ZV. */
592 bset_pt_marker (b, Qnil);
593 bset_begv_marker (b, Qnil);
594 bset_zv_marker (b, Qnil);
596 name = Fcopy_sequence (buffer_or_name);
597 set_string_intervals (name, NULL);
598 bset_name (b, name);
600 bset_undo_list (b, SREF (name, 0) != ' ' ? Qnil : Qt);
602 reset_buffer (b);
603 reset_buffer_local_variables (b, 1);
605 bset_mark (b, Fmake_marker ());
606 BUF_MARKERS (b) = NULL;
608 /* Put this in the alist of all live buffers. */
609 XSETBUFFER (buffer, b);
610 Vbuffer_alist = nconc2 (Vbuffer_alist, Fcons (Fcons (name, buffer), Qnil));
611 /* And run buffer-list-update-hook. */
612 if (!NILP (Vrun_hooks))
613 call1 (Vrun_hooks, Qbuffer_list_update_hook);
615 return buffer;
619 /* Return a list of overlays which is a copy of the overlay list
620 LIST, but for buffer B. */
622 static struct Lisp_Overlay *
623 copy_overlays (struct buffer *b, struct Lisp_Overlay *list)
625 struct Lisp_Overlay *result = NULL, *tail = NULL;
627 for (; list; list = list->next)
629 Lisp_Object overlay, start, end;
630 struct Lisp_Marker *m;
632 eassert (MARKERP (list->start));
633 m = XMARKER (list->start);
634 start = build_marker (b, m->charpos, m->bytepos);
635 XMARKER (start)->insertion_type = m->insertion_type;
637 eassert (MARKERP (list->end));
638 m = XMARKER (list->end);
639 end = build_marker (b, m->charpos, m->bytepos);
640 XMARKER (end)->insertion_type = m->insertion_type;
642 overlay = build_overlay (start, end, Fcopy_sequence (list->plist));
643 if (tail)
644 tail = tail->next = XOVERLAY (overlay);
645 else
646 result = tail = XOVERLAY (overlay);
649 return result;
652 /* Set an appropriate overlay of B. */
654 static void
655 set_buffer_overlays_before (struct buffer *b, struct Lisp_Overlay *o)
657 b->overlays_before = o;
660 static void
661 set_buffer_overlays_after (struct buffer *b, struct Lisp_Overlay *o)
663 b->overlays_after = o;
666 /* Clone per-buffer values of buffer FROM.
668 Buffer TO gets the same per-buffer values as FROM, with the
669 following exceptions: (1) TO's name is left untouched, (2) markers
670 are copied and made to refer to TO, and (3) overlay lists are
671 copied. */
673 static void
674 clone_per_buffer_values (struct buffer *from, struct buffer *to)
676 int offset;
678 FOR_EACH_PER_BUFFER_OBJECT_AT (offset)
680 Lisp_Object obj;
682 /* Don't touch the `name' which should be unique for every buffer. */
683 if (offset == PER_BUFFER_VAR_OFFSET (name))
684 continue;
686 obj = per_buffer_value (from, offset);
687 if (MARKERP (obj) && XMARKER (obj)->buffer == from)
689 struct Lisp_Marker *m = XMARKER (obj);
691 obj = build_marker (to, m->charpos, m->bytepos);
692 XMARKER (obj)->insertion_type = m->insertion_type;
695 set_per_buffer_value (to, offset, obj);
698 memcpy (to->local_flags, from->local_flags, sizeof to->local_flags);
700 set_buffer_overlays_before (to, copy_overlays (to, from->overlays_before));
701 set_buffer_overlays_after (to, copy_overlays (to, from->overlays_after));
703 /* Get (a copy of) the alist of Lisp-level local variables of FROM
704 and install that in TO. */
705 bset_local_var_alist (to, buffer_lisp_local_variables (from, 1));
709 /* If buffer B has markers to record PT, BEGV and ZV when it is not
710 current, update these markers. */
712 static void
713 record_buffer_markers (struct buffer *b)
715 if (! NILP (BVAR (b, pt_marker)))
717 Lisp_Object buffer;
719 eassert (!NILP (BVAR (b, begv_marker)));
720 eassert (!NILP (BVAR (b, zv_marker)));
722 XSETBUFFER (buffer, b);
723 set_marker_both (BVAR (b, pt_marker), buffer, b->pt, b->pt_byte);
724 set_marker_both (BVAR (b, begv_marker), buffer, b->begv, b->begv_byte);
725 set_marker_both (BVAR (b, zv_marker), buffer, b->zv, b->zv_byte);
730 /* If buffer B has markers to record PT, BEGV and ZV when it is not
731 current, fetch these values into B->begv etc. */
733 static void
734 fetch_buffer_markers (struct buffer *b)
736 if (! NILP (BVAR (b, pt_marker)))
738 Lisp_Object m;
740 eassert (!NILP (BVAR (b, begv_marker)));
741 eassert (!NILP (BVAR (b, zv_marker)));
743 m = BVAR (b, pt_marker);
744 SET_BUF_PT_BOTH (b, marker_position (m), marker_byte_position (m));
746 m = BVAR (b, begv_marker);
747 SET_BUF_BEGV_BOTH (b, marker_position (m), marker_byte_position (m));
749 m = BVAR (b, zv_marker);
750 SET_BUF_ZV_BOTH (b, marker_position (m), marker_byte_position (m));
755 DEFUN ("make-indirect-buffer", Fmake_indirect_buffer, Smake_indirect_buffer,
756 2, 3,
757 "bMake indirect buffer (to buffer): \nBName of indirect buffer: ",
758 doc: /* Create and return an indirect buffer for buffer BASE-BUFFER, named NAME.
759 BASE-BUFFER should be a live buffer, or the name of an existing buffer.
760 NAME should be a string which is not the name of an existing buffer.
761 Optional argument CLONE non-nil means preserve BASE-BUFFER's state,
762 such as major and minor modes, in the indirect buffer.
763 CLONE nil means the indirect buffer's state is reset to default values. */)
764 (Lisp_Object base_buffer, Lisp_Object name, Lisp_Object clone)
766 Lisp_Object buf, tem;
767 struct buffer *b;
769 CHECK_STRING (name);
770 buf = Fget_buffer (name);
771 if (!NILP (buf))
772 error ("Buffer name `%s' is in use", SDATA (name));
774 tem = base_buffer;
775 base_buffer = Fget_buffer (base_buffer);
776 if (NILP (base_buffer))
777 error ("No such buffer: `%s'", SDATA (tem));
778 if (!BUFFER_LIVE_P (XBUFFER (base_buffer)))
779 error ("Base buffer has been killed");
781 if (SCHARS (name) == 0)
782 error ("Empty string for buffer name is not allowed");
784 b = allocate_buffer ();
786 /* No double indirection - if base buffer is indirect,
787 new buffer becomes an indirect to base's base. */
788 b->base_buffer = (XBUFFER (base_buffer)->base_buffer
789 ? XBUFFER (base_buffer)->base_buffer
790 : XBUFFER (base_buffer));
792 /* Use the base buffer's text object. */
793 b->text = b->base_buffer->text;
794 /* We have no own text. */
795 b->indirections = -1;
796 /* Notify base buffer that we share the text now. */
797 b->base_buffer->indirections++;
798 /* Always -1 for an indirect buffer. */
799 b->window_count = -1;
801 b->pt = b->base_buffer->pt;
802 b->begv = b->base_buffer->begv;
803 b->zv = b->base_buffer->zv;
804 b->pt_byte = b->base_buffer->pt_byte;
805 b->begv_byte = b->base_buffer->begv_byte;
806 b->zv_byte = b->base_buffer->zv_byte;
808 b->newline_cache = 0;
809 b->width_run_cache = 0;
810 bset_width_table (b, Qnil);
812 name = Fcopy_sequence (name);
813 set_string_intervals (name, NULL);
814 bset_name (b, name);
816 reset_buffer (b);
817 reset_buffer_local_variables (b, 1);
819 /* Put this in the alist of all live buffers. */
820 XSETBUFFER (buf, b);
821 Vbuffer_alist = nconc2 (Vbuffer_alist, Fcons (Fcons (name, buf), Qnil));
823 bset_mark (b, Fmake_marker ());
825 /* The multibyte status belongs to the base buffer. */
826 bset_enable_multibyte_characters
827 (b, BVAR (b->base_buffer, enable_multibyte_characters));
829 /* Make sure the base buffer has markers for its narrowing. */
830 if (NILP (BVAR (b->base_buffer, pt_marker)))
832 eassert (NILP (BVAR (b->base_buffer, begv_marker)));
833 eassert (NILP (BVAR (b->base_buffer, zv_marker)));
835 bset_pt_marker (b->base_buffer,
836 build_marker (b->base_buffer, b->base_buffer->pt,
837 b->base_buffer->pt_byte));
839 bset_begv_marker (b->base_buffer,
840 build_marker (b->base_buffer, b->base_buffer->begv,
841 b->base_buffer->begv_byte));
843 bset_zv_marker (b->base_buffer,
844 build_marker (b->base_buffer, b->base_buffer->zv,
845 b->base_buffer->zv_byte));
847 XMARKER (BVAR (b->base_buffer, zv_marker))->insertion_type = 1;
850 if (NILP (clone))
852 /* Give the indirect buffer markers for its narrowing. */
853 bset_pt_marker (b, build_marker (b, b->pt, b->pt_byte));
854 bset_begv_marker (b, build_marker (b, b->begv, b->begv_byte));
855 bset_zv_marker (b, build_marker (b, b->zv, b->zv_byte));
856 XMARKER (BVAR (b, zv_marker))->insertion_type = 1;
858 else
860 struct buffer *old_b = current_buffer;
862 clone_per_buffer_values (b->base_buffer, b);
863 bset_filename (b, Qnil);
864 bset_file_truename (b, Qnil);
865 bset_display_count (b, make_number (0));
866 bset_backed_up (b, Qnil);
867 bset_auto_save_file_name (b, Qnil);
868 set_buffer_internal_1 (b);
869 Fset (intern ("buffer-save-without-query"), Qnil);
870 Fset (intern ("buffer-file-number"), Qnil);
871 Fset (intern ("buffer-stale-function"), Qnil);
872 set_buffer_internal_1 (old_b);
875 /* Run buffer-list-update-hook. */
876 if (!NILP (Vrun_hooks))
877 call1 (Vrun_hooks, Qbuffer_list_update_hook);
879 return buf;
882 /* Mark OV as no longer associated with B. */
884 static void
885 drop_overlay (struct buffer *b, struct Lisp_Overlay *ov)
887 eassert (b == XBUFFER (Fmarker_buffer (ov->start)));
888 modify_overlay (b, marker_position (ov->start),
889 marker_position (ov->end));
890 Fset_marker (ov->start, Qnil, Qnil);
891 Fset_marker (ov->end, Qnil, Qnil);
895 /* Delete all overlays of B and reset it's overlay lists. */
897 void
898 delete_all_overlays (struct buffer *b)
900 struct Lisp_Overlay *ov, *next;
902 /* FIXME: Since each drop_overlay will scan BUF_MARKERS to unlink its
903 markers, we have an unneeded O(N^2) behavior here. */
904 for (ov = b->overlays_before; ov; ov = next)
906 drop_overlay (b, ov);
907 next = ov->next;
908 ov->next = NULL;
911 for (ov = b->overlays_after; ov; ov = next)
913 drop_overlay (b, ov);
914 next = ov->next;
915 ov->next = NULL;
918 set_buffer_overlays_before (b, NULL);
919 set_buffer_overlays_after (b, NULL);
922 /* Reinitialize everything about a buffer except its name and contents
923 and local variables.
924 If called on an already-initialized buffer, the list of overlays
925 should be deleted before calling this function, otherwise we end up
926 with overlays that claim to belong to the buffer but the buffer
927 claims it doesn't belong to it. */
929 void
930 reset_buffer (register struct buffer *b)
932 bset_filename (b, Qnil);
933 bset_file_truename (b, Qnil);
934 bset_directory (b, current_buffer ? BVAR (current_buffer, directory) : Qnil);
935 b->modtime = make_emacs_time (0, UNKNOWN_MODTIME_NSECS);
936 b->modtime_size = -1;
937 XSETFASTINT (BVAR (b, save_length), 0);
938 b->last_window_start = 1;
939 /* It is more conservative to start out "changed" than "unchanged". */
940 b->clip_changed = 0;
941 b->prevent_redisplay_optimizations_p = 1;
942 bset_backed_up (b, Qnil);
943 BUF_AUTOSAVE_MODIFF (b) = 0;
944 b->auto_save_failure_time = 0;
945 bset_auto_save_file_name (b, Qnil);
946 bset_read_only (b, Qnil);
947 set_buffer_overlays_before (b, NULL);
948 set_buffer_overlays_after (b, NULL);
949 b->overlay_center = BEG;
950 bset_mark_active (b, Qnil);
951 bset_point_before_scroll (b, Qnil);
952 bset_file_format (b, Qnil);
953 bset_auto_save_file_format (b, Qt);
954 bset_last_selected_window (b, Qnil);
955 bset_display_count (b, make_number (0));
956 bset_display_time (b, Qnil);
957 bset_enable_multibyte_characters
958 (b, BVAR (&buffer_defaults, enable_multibyte_characters));
959 bset_cursor_type (b, BVAR (&buffer_defaults, cursor_type));
960 bset_extra_line_spacing (b, BVAR (&buffer_defaults, extra_line_spacing));
962 b->display_error_modiff = 0;
965 /* Reset buffer B's local variables info.
966 Don't use this on a buffer that has already been in use;
967 it does not treat permanent locals consistently.
968 Instead, use Fkill_all_local_variables.
970 If PERMANENT_TOO, reset permanent buffer-local variables.
971 If not, preserve those. */
973 static void
974 reset_buffer_local_variables (struct buffer *b, bool permanent_too)
976 int offset, i;
978 /* Reset the major mode to Fundamental, together with all the
979 things that depend on the major mode.
980 default-major-mode is handled at a higher level.
981 We ignore it here. */
982 bset_major_mode (b, Qfundamental_mode);
983 bset_keymap (b, Qnil);
984 bset_mode_name (b, QSFundamental);
985 bset_minor_modes (b, Qnil);
987 /* If the standard case table has been altered and invalidated,
988 fix up its insides first. */
989 if (! (CHAR_TABLE_P (XCHAR_TABLE (Vascii_downcase_table)->extras[0])
990 && CHAR_TABLE_P (XCHAR_TABLE (Vascii_downcase_table)->extras[1])
991 && CHAR_TABLE_P (XCHAR_TABLE (Vascii_downcase_table)->extras[2])))
992 Fset_standard_case_table (Vascii_downcase_table);
994 bset_downcase_table (b, Vascii_downcase_table);
995 bset_upcase_table (b, XCHAR_TABLE (Vascii_downcase_table)->extras[0]);
996 bset_case_canon_table (b, XCHAR_TABLE (Vascii_downcase_table)->extras[1]);
997 bset_case_eqv_table (b, XCHAR_TABLE (Vascii_downcase_table)->extras[2]);
998 bset_invisibility_spec (b, Qt);
1000 /* Reset all (or most) per-buffer variables to their defaults. */
1001 if (permanent_too)
1002 bset_local_var_alist (b, Qnil);
1003 else
1005 Lisp_Object tmp, prop, last = Qnil;
1006 for (tmp = BVAR (b, local_var_alist); CONSP (tmp); tmp = XCDR (tmp))
1007 if (!NILP (prop = Fget (XCAR (XCAR (tmp)), Qpermanent_local)))
1009 /* If permanent-local, keep it. */
1010 last = tmp;
1011 if (EQ (prop, Qpermanent_local_hook))
1013 /* This is a partially permanent hook variable.
1014 Preserve only the elements that want to be preserved. */
1015 Lisp_Object list, newlist;
1016 list = XCDR (XCAR (tmp));
1017 if (!CONSP (list))
1018 newlist = list;
1019 else
1020 for (newlist = Qnil; CONSP (list); list = XCDR (list))
1022 Lisp_Object elt = XCAR (list);
1023 /* Preserve element ELT if it's t,
1024 if it is a function with a `permanent-local-hook' property,
1025 or if it's not a symbol. */
1026 if (! SYMBOLP (elt)
1027 || EQ (elt, Qt)
1028 || !NILP (Fget (elt, Qpermanent_local_hook)))
1029 newlist = Fcons (elt, newlist);
1031 XSETCDR (XCAR (tmp), Fnreverse (newlist));
1034 /* Delete this local variable. */
1035 else if (NILP (last))
1036 bset_local_var_alist (b, XCDR (tmp));
1037 else
1038 XSETCDR (last, XCDR (tmp));
1041 for (i = 0; i < last_per_buffer_idx; ++i)
1042 if (permanent_too || buffer_permanent_local_flags[i] == 0)
1043 SET_PER_BUFFER_VALUE_P (b, i, 0);
1045 /* For each slot that has a default value, copy that into the slot. */
1046 FOR_EACH_PER_BUFFER_OBJECT_AT (offset)
1048 int idx = PER_BUFFER_IDX (offset);
1049 if ((idx > 0
1050 && (permanent_too
1051 || buffer_permanent_local_flags[idx] == 0)))
1052 set_per_buffer_value (b, offset, per_buffer_default (offset));
1056 /* We split this away from generate-new-buffer, because rename-buffer
1057 and set-visited-file-name ought to be able to use this to really
1058 rename the buffer properly. */
1060 DEFUN ("generate-new-buffer-name", Fgenerate_new_buffer_name,
1061 Sgenerate_new_buffer_name, 1, 2, 0,
1062 doc: /* Return a string that is the name of no existing buffer based on NAME.
1063 If there is no live buffer named NAME, then return NAME.
1064 Otherwise modify name by appending `<NUMBER>', incrementing NUMBER
1065 \(starting at 2) until an unused name is found, and then return that name.
1066 Optional second argument IGNORE specifies a name that is okay to use (if
1067 it is in the sequence to be tried) even if a buffer with that name exists.
1069 If NAME begins with a space (i.e., a buffer that is not normally
1070 visible to users), then if buffer NAME already exists a random number
1071 is first appended to NAME, to speed up finding a non-existent buffer. */)
1072 (register Lisp_Object name, Lisp_Object ignore)
1074 register Lisp_Object gentemp, tem, tem2;
1075 ptrdiff_t count;
1076 char number[INT_BUFSIZE_BOUND (ptrdiff_t) + sizeof "<>"];
1078 CHECK_STRING (name);
1080 tem = Fstring_equal (name, ignore);
1081 if (!NILP (tem))
1082 return name;
1083 tem = Fget_buffer (name);
1084 if (NILP (tem))
1085 return name;
1087 if (!strncmp (SSDATA (name), " ", 1)) /* see bug#1229 */
1089 /* Note fileio.c:make_temp_name does random differently. */
1090 tem2 = concat2 (name, make_formatted_string
1091 (number, "-%"pI"d",
1092 XFASTINT (Frandom (make_number (999999)))));
1093 tem = Fget_buffer (tem2);
1094 if (NILP (tem))
1095 return tem2;
1097 else
1098 tem2 = name;
1100 count = 1;
1101 while (1)
1103 gentemp = concat2 (tem2, make_formatted_string
1104 (number, "<%"pD"d>", ++count));
1105 tem = Fstring_equal (gentemp, ignore);
1106 if (!NILP (tem))
1107 return gentemp;
1108 tem = Fget_buffer (gentemp);
1109 if (NILP (tem))
1110 return gentemp;
1115 DEFUN ("buffer-name", Fbuffer_name, Sbuffer_name, 0, 1, 0,
1116 doc: /* Return the name of BUFFER, as a string.
1117 BUFFER defaults to the current buffer.
1118 Return nil if BUFFER has been killed. */)
1119 (register Lisp_Object buffer)
1121 if (NILP (buffer))
1122 return BVAR (current_buffer, name);
1123 CHECK_BUFFER (buffer);
1124 return BVAR (XBUFFER (buffer), name);
1127 DEFUN ("buffer-file-name", Fbuffer_file_name, Sbuffer_file_name, 0, 1, 0,
1128 doc: /* Return name of file BUFFER is visiting, or nil if none.
1129 No argument or nil as argument means use the current buffer. */)
1130 (register Lisp_Object buffer)
1132 if (NILP (buffer))
1133 return BVAR (current_buffer, filename);
1134 CHECK_BUFFER (buffer);
1135 return BVAR (XBUFFER (buffer), filename);
1138 DEFUN ("buffer-base-buffer", Fbuffer_base_buffer, Sbuffer_base_buffer,
1139 0, 1, 0,
1140 doc: /* Return the base buffer of indirect buffer BUFFER.
1141 If BUFFER is not indirect, return nil.
1142 BUFFER defaults to the current buffer. */)
1143 (register Lisp_Object buffer)
1145 struct buffer *base;
1146 Lisp_Object base_buffer;
1148 if (NILP (buffer))
1149 base = current_buffer->base_buffer;
1150 else
1152 CHECK_BUFFER (buffer);
1153 base = XBUFFER (buffer)->base_buffer;
1156 if (! base)
1157 return Qnil;
1158 XSETBUFFER (base_buffer, base);
1159 return base_buffer;
1162 DEFUN ("buffer-local-value", Fbuffer_local_value,
1163 Sbuffer_local_value, 2, 2, 0,
1164 doc: /* Return the value of VARIABLE in BUFFER.
1165 If VARIABLE does not have a buffer-local binding in BUFFER, the value
1166 is the default binding of the variable. */)
1167 (register Lisp_Object variable, register Lisp_Object buffer)
1169 register Lisp_Object result = buffer_local_value_1 (variable, buffer);
1171 if (EQ (result, Qunbound))
1172 xsignal1 (Qvoid_variable, variable);
1174 return result;
1178 /* Like Fbuffer_local_value, but return Qunbound if the variable is
1179 locally unbound. */
1181 Lisp_Object
1182 buffer_local_value_1 (Lisp_Object variable, Lisp_Object buffer)
1184 register struct buffer *buf;
1185 register Lisp_Object result;
1186 struct Lisp_Symbol *sym;
1188 CHECK_SYMBOL (variable);
1189 CHECK_BUFFER (buffer);
1190 buf = XBUFFER (buffer);
1191 sym = XSYMBOL (variable);
1193 start:
1194 switch (sym->redirect)
1196 case SYMBOL_VARALIAS: sym = indirect_variable (sym); goto start;
1197 case SYMBOL_PLAINVAL: result = SYMBOL_VAL (sym); break;
1198 case SYMBOL_LOCALIZED:
1199 { /* Look in local_var_alist. */
1200 struct Lisp_Buffer_Local_Value *blv = SYMBOL_BLV (sym);
1201 XSETSYMBOL (variable, sym); /* Update In case of aliasing. */
1202 result = Fassoc (variable, BVAR (buf, local_var_alist));
1203 if (!NILP (result))
1205 if (blv->fwd)
1206 { /* What binding is loaded right now? */
1207 Lisp_Object current_alist_element = blv->valcell;
1209 /* The value of the currently loaded binding is not
1210 stored in it, but rather in the realvalue slot.
1211 Store that value into the binding it belongs to
1212 in case that is the one we are about to use. */
1214 XSETCDR (current_alist_element,
1215 do_symval_forwarding (blv->fwd));
1217 /* Now get the (perhaps updated) value out of the binding. */
1218 result = XCDR (result);
1220 else
1221 result = Fdefault_value (variable);
1222 break;
1224 case SYMBOL_FORWARDED:
1226 union Lisp_Fwd *fwd = SYMBOL_FWD (sym);
1227 if (BUFFER_OBJFWDP (fwd))
1228 result = per_buffer_value (buf, XBUFFER_OBJFWD (fwd)->offset);
1229 else
1230 result = Fdefault_value (variable);
1231 break;
1233 default: emacs_abort ();
1236 return result;
1239 /* Return an alist of the Lisp-level buffer-local bindings of
1240 buffer BUF. That is, don't include the variables maintained
1241 in special slots in the buffer object.
1242 If not CLONE, replace elements of the form (VAR . unbound)
1243 by VAR. */
1245 static Lisp_Object
1246 buffer_lisp_local_variables (struct buffer *buf, bool clone)
1248 Lisp_Object result = Qnil;
1249 Lisp_Object tail;
1250 for (tail = BVAR (buf, local_var_alist); CONSP (tail); tail = XCDR (tail))
1252 Lisp_Object val, elt;
1254 elt = XCAR (tail);
1256 /* Reference each variable in the alist in buf.
1257 If inquiring about the current buffer, this gets the current values,
1258 so store them into the alist so the alist is up to date.
1259 If inquiring about some other buffer, this swaps out any values
1260 for that buffer, making the alist up to date automatically. */
1261 val = find_symbol_value (XCAR (elt));
1262 /* Use the current buffer value only if buf is the current buffer. */
1263 if (buf != current_buffer)
1264 val = XCDR (elt);
1266 result = Fcons (!clone && EQ (val, Qunbound)
1267 ? XCAR (elt)
1268 : Fcons (XCAR (elt), val),
1269 result);
1272 return result;
1275 DEFUN ("buffer-local-variables", Fbuffer_local_variables,
1276 Sbuffer_local_variables, 0, 1, 0,
1277 doc: /* Return an alist of variables that are buffer-local in BUFFER.
1278 Most elements look like (SYMBOL . VALUE), describing one variable.
1279 For a symbol that is locally unbound, just the symbol appears in the value.
1280 Note that storing new VALUEs in these elements doesn't change the variables.
1281 No argument or nil as argument means use current buffer as BUFFER. */)
1282 (register Lisp_Object buffer)
1284 register struct buffer *buf;
1285 register Lisp_Object result;
1287 if (NILP (buffer))
1288 buf = current_buffer;
1289 else
1291 CHECK_BUFFER (buffer);
1292 buf = XBUFFER (buffer);
1295 result = buffer_lisp_local_variables (buf, 0);
1297 /* Add on all the variables stored in special slots. */
1299 int offset, idx;
1301 FOR_EACH_PER_BUFFER_OBJECT_AT (offset)
1303 idx = PER_BUFFER_IDX (offset);
1304 if ((idx == -1 || PER_BUFFER_VALUE_P (buf, idx))
1305 && SYMBOLP (PER_BUFFER_SYMBOL (offset)))
1307 Lisp_Object sym = PER_BUFFER_SYMBOL (offset);
1308 Lisp_Object val = per_buffer_value (buf, offset);
1309 result = Fcons (EQ (val, Qunbound) ? sym : Fcons (sym, val),
1310 result);
1315 return result;
1318 DEFUN ("buffer-modified-p", Fbuffer_modified_p, Sbuffer_modified_p,
1319 0, 1, 0,
1320 doc: /* Return t if BUFFER was modified since its file was last read or saved.
1321 No argument or nil as argument means use current buffer as BUFFER. */)
1322 (register Lisp_Object buffer)
1324 register struct buffer *buf;
1325 if (NILP (buffer))
1326 buf = current_buffer;
1327 else
1329 CHECK_BUFFER (buffer);
1330 buf = XBUFFER (buffer);
1333 return BUF_SAVE_MODIFF (buf) < BUF_MODIFF (buf) ? Qt : Qnil;
1336 DEFUN ("set-buffer-modified-p", Fset_buffer_modified_p, Sset_buffer_modified_p,
1337 1, 1, 0,
1338 doc: /* Mark current buffer as modified or unmodified according to FLAG.
1339 A non-nil FLAG means mark the buffer modified. */)
1340 (Lisp_Object flag)
1342 Lisp_Object fn;
1344 #ifdef CLASH_DETECTION
1345 /* If buffer becoming modified, lock the file.
1346 If buffer becoming unmodified, unlock the file. */
1348 struct buffer *b = current_buffer->base_buffer
1349 ? current_buffer->base_buffer
1350 : current_buffer;
1352 fn = BVAR (b, file_truename);
1353 /* Test buffer-file-name so that binding it to nil is effective. */
1354 if (!NILP (fn) && ! NILP (BVAR (b, filename)))
1356 bool already = SAVE_MODIFF < MODIFF;
1357 if (!already && !NILP (flag))
1358 lock_file (fn);
1359 else if (already && NILP (flag))
1360 unlock_file (fn);
1362 #endif /* CLASH_DETECTION */
1364 /* Here we have a problem. SAVE_MODIFF is used here to encode
1365 buffer-modified-p (as SAVE_MODIFF<MODIFF) as well as
1366 recent-auto-save-p (as SAVE_MODIFF<auto_save_modified). So if we
1367 modify SAVE_MODIFF to affect one, we may affect the other
1368 as well.
1369 E.g. if FLAG is nil we need to set SAVE_MODIFF to MODIFF, but
1370 if SAVE_MODIFF<auto_save_modified that means we risk changing
1371 recent-auto-save-p from t to nil.
1372 Vice versa, if FLAG is non-nil and SAVE_MODIFF>=auto_save_modified
1373 we risk changing recent-auto-save-p from nil to t. */
1374 SAVE_MODIFF = (NILP (flag)
1375 /* FIXME: This unavoidably sets recent-auto-save-p to nil. */
1376 ? MODIFF
1377 /* Let's try to preserve recent-auto-save-p. */
1378 : SAVE_MODIFF < MODIFF ? SAVE_MODIFF
1379 /* If SAVE_MODIFF == auto_save_modified == MODIFF,
1380 we can either decrease SAVE_MODIFF and auto_save_modified
1381 or increase MODIFF. */
1382 : MODIFF++);
1384 /* Set update_mode_lines only if buffer is displayed in some window.
1385 Packages like jit-lock or lazy-lock preserve a buffer's modified
1386 state by recording/restoring the state around blocks of code.
1387 Setting update_mode_lines makes redisplay consider all windows
1388 (on all frames). Stealth fontification of buffers not displayed
1389 would incur additional redisplay costs if we'd set
1390 update_modes_lines unconditionally.
1392 Ideally, I think there should be another mechanism for fontifying
1393 buffers without "modifying" buffers, or redisplay should be
1394 smarter about updating the `*' in mode lines. --gerd */
1395 if (buffer_window_count (current_buffer))
1397 ++update_mode_lines;
1398 current_buffer->prevent_redisplay_optimizations_p = 1;
1401 return flag;
1404 DEFUN ("restore-buffer-modified-p", Frestore_buffer_modified_p,
1405 Srestore_buffer_modified_p, 1, 1, 0,
1406 doc: /* Like `set-buffer-modified-p', with a difference concerning redisplay.
1407 It is not ensured that mode lines will be updated to show the modified
1408 state of the current buffer. Use with care. */)
1409 (Lisp_Object flag)
1411 #ifdef CLASH_DETECTION
1412 Lisp_Object fn;
1414 /* If buffer becoming modified, lock the file.
1415 If buffer becoming unmodified, unlock the file. */
1417 fn = BVAR (current_buffer, file_truename);
1418 /* Test buffer-file-name so that binding it to nil is effective. */
1419 if (!NILP (fn) && ! NILP (BVAR (current_buffer, filename)))
1421 bool already = SAVE_MODIFF < MODIFF;
1422 if (!already && !NILP (flag))
1423 lock_file (fn);
1424 else if (already && NILP (flag))
1425 unlock_file (fn);
1427 #endif /* CLASH_DETECTION */
1429 SAVE_MODIFF = NILP (flag) ? MODIFF : 0;
1430 return flag;
1433 DEFUN ("buffer-modified-tick", Fbuffer_modified_tick, Sbuffer_modified_tick,
1434 0, 1, 0,
1435 doc: /* Return BUFFER's tick counter, incremented for each change in text.
1436 Each buffer has a tick counter which is incremented each time the
1437 text in that buffer is changed. It wraps around occasionally.
1438 No argument or nil as argument means use current buffer as BUFFER. */)
1439 (register Lisp_Object buffer)
1441 register struct buffer *buf;
1442 if (NILP (buffer))
1443 buf = current_buffer;
1444 else
1446 CHECK_BUFFER (buffer);
1447 buf = XBUFFER (buffer);
1450 return make_number (BUF_MODIFF (buf));
1453 DEFUN ("buffer-chars-modified-tick", Fbuffer_chars_modified_tick,
1454 Sbuffer_chars_modified_tick, 0, 1, 0,
1455 doc: /* Return BUFFER's character-change tick counter.
1456 Each buffer has a character-change tick counter, which is set to the
1457 value of the buffer's tick counter \(see `buffer-modified-tick'), each
1458 time text in that buffer is inserted or deleted. By comparing the
1459 values returned by two individual calls of `buffer-chars-modified-tick',
1460 you can tell whether a character change occurred in that buffer in
1461 between these calls. No argument or nil as argument means use current
1462 buffer as BUFFER. */)
1463 (register Lisp_Object buffer)
1465 register struct buffer *buf;
1466 if (NILP (buffer))
1467 buf = current_buffer;
1468 else
1470 CHECK_BUFFER (buffer);
1471 buf = XBUFFER (buffer);
1474 return make_number (BUF_CHARS_MODIFF (buf));
1477 DEFUN ("rename-buffer", Frename_buffer, Srename_buffer, 1, 2,
1478 "(list (read-string \"Rename buffer (to new name): \" \
1479 nil 'buffer-name-history (buffer-name (current-buffer))) \
1480 current-prefix-arg)",
1481 doc: /* Change current buffer's name to NEWNAME (a string).
1482 If second arg UNIQUE is nil or omitted, it is an error if a
1483 buffer named NEWNAME already exists.
1484 If UNIQUE is non-nil, come up with a new name using
1485 `generate-new-buffer-name'.
1486 Interactively, you can set UNIQUE with a prefix argument.
1487 We return the name we actually gave the buffer.
1488 This does not change the name of the visited file (if any). */)
1489 (register Lisp_Object newname, Lisp_Object unique)
1491 register Lisp_Object tem, buf;
1493 CHECK_STRING (newname);
1495 if (SCHARS (newname) == 0)
1496 error ("Empty string is invalid as a buffer name");
1498 tem = Fget_buffer (newname);
1499 if (!NILP (tem))
1501 /* Don't short-circuit if UNIQUE is t. That is a useful way to
1502 rename the buffer automatically so you can create another
1503 with the original name. It makes UNIQUE equivalent to
1504 (rename-buffer (generate-new-buffer-name NEWNAME)). */
1505 if (NILP (unique) && XBUFFER (tem) == current_buffer)
1506 return BVAR (current_buffer, name);
1507 if (!NILP (unique))
1508 newname = Fgenerate_new_buffer_name (newname, BVAR (current_buffer, name));
1509 else
1510 error ("Buffer name `%s' is in use", SDATA (newname));
1513 bset_name (current_buffer, newname);
1515 /* Catch redisplay's attention. Unless we do this, the mode lines for
1516 any windows displaying current_buffer will stay unchanged. */
1517 update_mode_lines++;
1519 XSETBUFFER (buf, current_buffer);
1520 Fsetcar (Frassq (buf, Vbuffer_alist), newname);
1521 if (NILP (BVAR (current_buffer, filename))
1522 && !NILP (BVAR (current_buffer, auto_save_file_name)))
1523 call0 (intern ("rename-auto-save-file"));
1525 /* Run buffer-list-update-hook. */
1526 if (!NILP (Vrun_hooks))
1527 call1 (Vrun_hooks, Qbuffer_list_update_hook);
1529 /* Refetch since that last call may have done GC. */
1530 return BVAR (current_buffer, name);
1533 /* True if B can be used as 'other-than-BUFFER' buffer. */
1535 static bool
1536 candidate_buffer (Lisp_Object b, Lisp_Object buffer)
1538 return (BUFFERP (b) && !EQ (b, buffer)
1539 && BUFFER_LIVE_P (XBUFFER (b))
1540 && !BUFFER_HIDDEN_P (XBUFFER (b)));
1543 DEFUN ("other-buffer", Fother_buffer, Sother_buffer, 0, 3, 0,
1544 doc: /* Return most recently selected buffer other than BUFFER.
1545 Buffers not visible in windows are preferred to visible buffers, unless
1546 optional second argument VISIBLE-OK is non-nil. Ignore the argument
1547 BUFFER unless it denotes a live buffer. If the optional third argument
1548 FRAME is non-nil, use that frame's buffer list instead of the selected
1549 frame's buffer list.
1551 The buffer is found by scanning the selected or specified frame's buffer
1552 list first, followed by the list of all buffers. If no other buffer
1553 exists, return the buffer `*scratch*' (creating it if necessary). */)
1554 (register Lisp_Object buffer, Lisp_Object visible_ok, Lisp_Object frame)
1556 struct frame *f = decode_any_frame (frame);
1557 Lisp_Object tail = f->buffer_list, pred = f->buffer_predicate;
1558 Lisp_Object buf, notsogood = Qnil;
1560 /* Consider buffers that have been seen in the frame first. */
1561 for (; CONSP (tail); tail = XCDR (tail))
1563 buf = XCAR (tail);
1564 if (candidate_buffer (buf, buffer)
1565 /* If the frame has a buffer_predicate, disregard buffers that
1566 don't fit the predicate. */
1567 && (NILP (pred) || !NILP (call1 (pred, buf))))
1569 if (!NILP (visible_ok)
1570 || NILP (Fget_buffer_window (buf, Qvisible)))
1571 return buf;
1572 else if (NILP (notsogood))
1573 notsogood = buf;
1577 /* Consider alist of all buffers next. */
1578 tail = Vbuffer_alist;
1579 for (; CONSP (tail); tail = XCDR (tail))
1581 buf = Fcdr (XCAR (tail));
1582 if (candidate_buffer (buf, buffer)
1583 /* If the frame has a buffer_predicate, disregard buffers that
1584 don't fit the predicate. */
1585 && (NILP (pred) || !NILP (call1 (pred, buf))))
1587 if (!NILP (visible_ok)
1588 || NILP (Fget_buffer_window (buf, Qvisible)))
1589 return buf;
1590 else if (NILP (notsogood))
1591 notsogood = buf;
1595 if (!NILP (notsogood))
1596 return notsogood;
1597 else
1599 buf = Fget_buffer (build_string ("*scratch*"));
1600 if (NILP (buf))
1602 buf = Fget_buffer_create (build_string ("*scratch*"));
1603 Fset_buffer_major_mode (buf);
1605 return buf;
1609 /* The following function is a safe variant of Fother_buffer: It doesn't
1610 pay attention to any frame-local buffer lists, doesn't care about
1611 visibility of buffers, and doesn't evaluate any frame predicates. */
1613 Lisp_Object
1614 other_buffer_safely (Lisp_Object buffer)
1616 Lisp_Object tail, buf;
1618 for (tail = Vbuffer_alist; CONSP (tail); tail = XCDR (tail))
1620 buf = Fcdr (XCAR (tail));
1621 if (candidate_buffer (buf, buffer))
1622 return buf;
1625 buf = Fget_buffer (build_string ("*scratch*"));
1626 if (NILP (buf))
1628 buf = Fget_buffer_create (build_string ("*scratch*"));
1629 Fset_buffer_major_mode (buf);
1632 return buf;
1635 DEFUN ("buffer-enable-undo", Fbuffer_enable_undo, Sbuffer_enable_undo,
1636 0, 1, "",
1637 doc: /* Start keeping undo information for buffer BUFFER.
1638 No argument or nil as argument means do this for the current buffer. */)
1639 (register Lisp_Object buffer)
1641 Lisp_Object real_buffer;
1643 if (NILP (buffer))
1644 XSETBUFFER (real_buffer, current_buffer);
1645 else
1647 real_buffer = Fget_buffer (buffer);
1648 if (NILP (real_buffer))
1649 nsberror (buffer);
1652 if (EQ (BVAR (XBUFFER (real_buffer), undo_list), Qt))
1653 bset_undo_list (XBUFFER (real_buffer), Qnil);
1655 return Qnil;
1658 /* Truncate undo list and shrink the gap of BUFFER. */
1660 void
1661 compact_buffer (struct buffer *buffer)
1663 BUFFER_CHECK_INDIRECTION (buffer);
1665 /* Skip dead buffers, indirect buffers and buffers
1666 which aren't changed since last compaction. */
1667 if (BUFFER_LIVE_P (buffer)
1668 && (buffer->base_buffer == NULL)
1669 && (BUF_COMPACT (buffer) != BUF_MODIFF (buffer)))
1671 /* If a buffer's undo list is Qt, that means that undo is
1672 turned off in that buffer. Calling truncate_undo_list on
1673 Qt tends to return NULL, which effectively turns undo back on.
1674 So don't call truncate_undo_list if undo_list is Qt. */
1675 if (!EQ (buffer->INTERNAL_FIELD (undo_list), Qt))
1676 truncate_undo_list (buffer);
1678 /* Shrink buffer gaps. */
1679 if (!buffer->text->inhibit_shrinking)
1681 /* If a buffer's gap size is more than 10% of the buffer
1682 size, or larger than GAP_BYTES_DFL bytes, then shrink it
1683 accordingly. Keep a minimum size of GAP_BYTES_MIN bytes. */
1684 ptrdiff_t size = clip_to_bounds (GAP_BYTES_MIN,
1685 BUF_Z_BYTE (buffer) / 10,
1686 GAP_BYTES_DFL);
1687 if (BUF_GAP_SIZE (buffer) > size)
1688 make_gap_1 (buffer, -(BUF_GAP_SIZE (buffer) - size));
1690 BUF_COMPACT (buffer) = BUF_MODIFF (buffer);
1694 DEFUN ("kill-buffer", Fkill_buffer, Skill_buffer, 0, 1, "bKill buffer: ",
1695 doc: /* Kill the buffer specified by BUFFER-OR-NAME.
1696 The argument may be a buffer or the name of an existing buffer.
1697 Argument nil or omitted means kill the current buffer. Return t if the
1698 buffer is actually killed, nil otherwise.
1700 The functions in `kill-buffer-query-functions' are called with the
1701 buffer to be killed as the current buffer. If any of them returns nil,
1702 the buffer is not killed. The hook `kill-buffer-hook' is run before the
1703 buffer is actually killed. The buffer being killed will be current
1704 while the hook is running. Functions called by any of these hooks are
1705 supposed to not change the current buffer.
1707 Any processes that have this buffer as the `process-buffer' are killed
1708 with SIGHUP. This function calls `replace-buffer-in-windows' for
1709 cleaning up all windows currently displaying the buffer to be killed. */)
1710 (Lisp_Object buffer_or_name)
1712 Lisp_Object buffer;
1713 register struct buffer *b;
1714 register Lisp_Object tem;
1715 register struct Lisp_Marker *m;
1716 struct gcpro gcpro1;
1718 if (NILP (buffer_or_name))
1719 buffer = Fcurrent_buffer ();
1720 else
1721 buffer = Fget_buffer (buffer_or_name);
1722 if (NILP (buffer))
1723 nsberror (buffer_or_name);
1725 b = XBUFFER (buffer);
1727 /* Avoid trouble for buffer already dead. */
1728 if (!BUFFER_LIVE_P (b))
1729 return Qnil;
1731 /* Query if the buffer is still modified. */
1732 if (INTERACTIVE && !NILP (BVAR (b, filename))
1733 && BUF_MODIFF (b) > BUF_SAVE_MODIFF (b))
1735 GCPRO1 (buffer);
1736 tem = do_yes_or_no_p (format2 ("Buffer %s modified; kill anyway? ",
1737 BVAR (b, name), make_number (0)));
1738 UNGCPRO;
1739 if (NILP (tem))
1740 return Qnil;
1743 /* Run hooks with the buffer to be killed the current buffer. */
1745 ptrdiff_t count = SPECPDL_INDEX ();
1746 Lisp_Object arglist[1];
1748 record_unwind_protect (save_excursion_restore, save_excursion_save ());
1749 set_buffer_internal (b);
1751 /* First run the query functions; if any query is answered no,
1752 don't kill the buffer. */
1753 arglist[0] = Qkill_buffer_query_functions;
1754 tem = Frun_hook_with_args_until_failure (1, arglist);
1755 if (NILP (tem))
1756 return unbind_to (count, Qnil);
1758 /* Then run the hooks. */
1759 Frun_hooks (1, &Qkill_buffer_hook);
1760 unbind_to (count, Qnil);
1763 /* If the hooks have killed the buffer, exit now. */
1764 if (!BUFFER_LIVE_P (b))
1765 return Qt;
1767 /* We have no more questions to ask. Verify that it is valid
1768 to kill the buffer. This must be done after the questions
1769 since anything can happen within do_yes_or_no_p. */
1771 /* Don't kill the minibuffer now current. */
1772 if (EQ (buffer, XWINDOW (minibuf_window)->buffer))
1773 return Qnil;
1775 /* When we kill an ordinary buffer which shares it's buffer text
1776 with indirect buffer(s), we must kill indirect buffer(s) too.
1777 We do it at this stage so nothing terrible happens if they
1778 ask questions or their hooks get errors. */
1779 if (!b->base_buffer && b->indirections > 0)
1781 struct buffer *other;
1783 GCPRO1 (buffer);
1785 FOR_EACH_BUFFER (other)
1786 if (other->base_buffer == b)
1788 Lisp_Object buf;
1789 XSETBUFFER (buf, other);
1790 Fkill_buffer (buf);
1793 UNGCPRO;
1795 /* Exit if we now have killed the base buffer (Bug#11665). */
1796 if (!BUFFER_LIVE_P (b))
1797 return Qt;
1800 /* Run replace_buffer_in_windows before making another buffer current
1801 since set-window-buffer-start-and-point will refuse to make another
1802 buffer current if the selected window does not show the current
1803 buffer. (Bug#10114) */
1804 replace_buffer_in_windows (buffer);
1806 /* Exit if replacing the buffer in windows has killed our buffer. */
1807 if (!BUFFER_LIVE_P (b))
1808 return Qt;
1810 /* Make this buffer not be current. Exit if it is the sole visible
1811 buffer. */
1812 if (b == current_buffer)
1814 tem = Fother_buffer (buffer, Qnil, Qnil);
1815 Fset_buffer (tem);
1816 if (b == current_buffer)
1817 return Qnil;
1820 /* If the buffer now current is shown in the minibuffer and our buffer
1821 is the sole other buffer give up. */
1822 XSETBUFFER (tem, current_buffer);
1823 if (EQ (tem, XWINDOW (minibuf_window)->buffer)
1824 && EQ (buffer, Fother_buffer (buffer, Qnil, Qnil)))
1825 return Qnil;
1827 /* Now there is no question: we can kill the buffer. */
1829 #ifdef CLASH_DETECTION
1830 /* Unlock this buffer's file, if it is locked. */
1831 unlock_buffer (b);
1832 #endif /* CLASH_DETECTION */
1834 GCPRO1 (buffer);
1835 kill_buffer_processes (buffer);
1836 UNGCPRO;
1838 /* Killing buffer processes may run sentinels which may have killed
1839 our buffer. */
1840 if (!BUFFER_LIVE_P (b))
1841 return Qt;
1843 /* These may run Lisp code and into infinite loops (if someone
1844 insisted on circular lists) so allow quitting here. */
1845 frames_discard_buffer (buffer);
1847 clear_charpos_cache (b);
1849 tem = Vinhibit_quit;
1850 Vinhibit_quit = Qt;
1851 /* Remove the buffer from the list of all buffers. */
1852 Vbuffer_alist = Fdelq (Frassq (buffer, Vbuffer_alist), Vbuffer_alist);
1853 /* If replace_buffer_in_windows didn't do its job fix that now. */
1854 replace_buffer_in_windows_safely (buffer);
1855 Vinhibit_quit = tem;
1857 /* Delete any auto-save file, if we saved it in this session.
1858 But not if the buffer is modified. */
1859 if (STRINGP (BVAR (b, auto_save_file_name))
1860 && BUF_AUTOSAVE_MODIFF (b) != 0
1861 && BUF_SAVE_MODIFF (b) < BUF_AUTOSAVE_MODIFF (b)
1862 && BUF_SAVE_MODIFF (b) < BUF_MODIFF (b)
1863 && NILP (Fsymbol_value (intern ("auto-save-visited-file-name"))))
1865 Lisp_Object delete;
1866 delete = Fsymbol_value (intern ("delete-auto-save-files"));
1867 if (! NILP (delete))
1868 internal_delete_file (BVAR (b, auto_save_file_name));
1871 /* Deleting an auto-save file could have killed our buffer. */
1872 if (!BUFFER_LIVE_P (b))
1873 return Qt;
1875 if (b->base_buffer)
1877 /* Unchain all markers that belong to this indirect buffer.
1878 Don't unchain the markers that belong to the base buffer
1879 or its other indirect buffers. */
1880 struct Lisp_Marker **mp = &BUF_MARKERS (b);
1881 while ((m = *mp))
1883 if (m->buffer == b)
1885 m->buffer = NULL;
1886 *mp = m->next;
1888 else
1889 mp = &m->next;
1892 else
1894 /* Unchain all markers of this buffer and its indirect buffers.
1895 and leave them pointing nowhere. */
1896 for (m = BUF_MARKERS (b); m; )
1898 struct Lisp_Marker *next = m->next;
1899 m->buffer = 0;
1900 m->next = NULL;
1901 m = next;
1903 BUF_MARKERS (b) = NULL;
1904 set_buffer_intervals (b, NULL);
1906 /* Perhaps we should explicitly free the interval tree here... */
1908 /* Since we've unlinked the markers, the overlays can't be here any more
1909 either. */
1910 b->overlays_before = NULL;
1911 b->overlays_after = NULL;
1913 /* Reset the local variables, so that this buffer's local values
1914 won't be protected from GC. They would be protected
1915 if they happened to remain cached in their symbols.
1916 This gets rid of them for certain. */
1917 swap_out_buffer_local_variables (b);
1918 reset_buffer_local_variables (b, 1);
1920 bset_name (b, Qnil);
1922 block_input ();
1923 if (b->base_buffer)
1925 /* Notify our base buffer that we don't share the text anymore. */
1926 eassert (b->indirections == -1);
1927 b->base_buffer->indirections--;
1928 eassert (b->base_buffer->indirections >= 0);
1929 /* Make sure that we wasn't confused. */
1930 eassert (b->window_count == -1);
1932 else
1934 /* Make sure that no one shows us. */
1935 eassert (b->window_count == 0);
1936 /* No one shares our buffer text, can free it. */
1937 free_buffer_text (b);
1940 if (b->newline_cache)
1942 free_region_cache (b->newline_cache);
1943 b->newline_cache = 0;
1945 if (b->width_run_cache)
1947 free_region_cache (b->width_run_cache);
1948 b->width_run_cache = 0;
1950 bset_width_table (b, Qnil);
1951 unblock_input ();
1952 bset_undo_list (b, Qnil);
1954 /* Run buffer-list-update-hook. */
1955 if (!NILP (Vrun_hooks))
1956 call1 (Vrun_hooks, Qbuffer_list_update_hook);
1958 return Qt;
1961 /* Move association for BUFFER to the front of buffer (a)lists. Since
1962 we do this each time BUFFER is selected visibly, the more recently
1963 selected buffers are always closer to the front of those lists. This
1964 means that other_buffer is more likely to choose a relevant buffer.
1966 Note that this moves BUFFER to the front of the buffer lists of the
1967 selected frame even if BUFFER is not shown there. If BUFFER is not
1968 shown in the selected frame, consider the present behavior a feature.
1969 `select-window' gets this right since it shows BUFFER in the selected
1970 window when calling us. */
1972 void
1973 record_buffer (Lisp_Object buffer)
1975 Lisp_Object aelt, aelt_cons, tem;
1976 register struct frame *f = XFRAME (selected_frame);
1978 CHECK_BUFFER (buffer);
1980 /* Update Vbuffer_alist (we know that it has an entry for BUFFER).
1981 Don't allow quitting since this might leave the buffer list in an
1982 inconsistent state. */
1983 tem = Vinhibit_quit;
1984 Vinhibit_quit = Qt;
1985 aelt = Frassq (buffer, Vbuffer_alist);
1986 aelt_cons = Fmemq (aelt, Vbuffer_alist);
1987 Vbuffer_alist = Fdelq (aelt, Vbuffer_alist);
1988 XSETCDR (aelt_cons, Vbuffer_alist);
1989 Vbuffer_alist = aelt_cons;
1990 Vinhibit_quit = tem;
1992 /* Update buffer list of selected frame. */
1993 fset_buffer_list (f, Fcons (buffer, Fdelq (buffer, f->buffer_list)));
1994 fset_buried_buffer_list (f, Fdelq (buffer, f->buried_buffer_list));
1996 /* Run buffer-list-update-hook. */
1997 if (!NILP (Vrun_hooks))
1998 call1 (Vrun_hooks, Qbuffer_list_update_hook);
2002 /* Move BUFFER to the end of the buffer (a)lists. Do nothing if the
2003 buffer is killed. For the selected frame's buffer list this moves
2004 BUFFER to its end even if it was never shown in that frame. If
2005 this happens we have a feature, hence `bury-buffer-internal' should be
2006 called only when BUFFER was shown in the selected frame. */
2008 DEFUN ("bury-buffer-internal", Fbury_buffer_internal, Sbury_buffer_internal,
2009 1, 1, 0,
2010 doc: /* Move BUFFER to the end of the buffer list. */)
2011 (Lisp_Object buffer)
2013 Lisp_Object aelt, aelt_cons, tem;
2014 register struct frame *f = XFRAME (selected_frame);
2016 CHECK_BUFFER (buffer);
2018 /* Update Vbuffer_alist (we know that it has an entry for BUFFER).
2019 Don't allow quitting since this might leave the buffer list in an
2020 inconsistent state. */
2021 tem = Vinhibit_quit;
2022 Vinhibit_quit = Qt;
2023 aelt = Frassq (buffer, Vbuffer_alist);
2024 aelt_cons = Fmemq (aelt, Vbuffer_alist);
2025 Vbuffer_alist = Fdelq (aelt, Vbuffer_alist);
2026 XSETCDR (aelt_cons, Qnil);
2027 Vbuffer_alist = nconc2 (Vbuffer_alist, aelt_cons);
2028 Vinhibit_quit = tem;
2030 /* Update buffer lists of selected frame. */
2031 fset_buffer_list (f, Fdelq (buffer, f->buffer_list));
2032 fset_buried_buffer_list
2033 (f, Fcons (buffer, Fdelq (buffer, f->buried_buffer_list)));
2035 /* Run buffer-list-update-hook. */
2036 if (!NILP (Vrun_hooks))
2037 call1 (Vrun_hooks, Qbuffer_list_update_hook);
2039 return Qnil;
2042 DEFUN ("set-buffer-major-mode", Fset_buffer_major_mode, Sset_buffer_major_mode, 1, 1, 0,
2043 doc: /* Set an appropriate major mode for BUFFER.
2044 For the *scratch* buffer, use `initial-major-mode', otherwise choose a mode
2045 according to the default value of `major-mode'.
2046 Use this function before selecting the buffer, since it may need to inspect
2047 the current buffer's major mode. */)
2048 (Lisp_Object buffer)
2050 ptrdiff_t count;
2051 Lisp_Object function;
2053 CHECK_BUFFER (buffer);
2055 if (!BUFFER_LIVE_P (XBUFFER (buffer)))
2056 error ("Attempt to set major mode for a dead buffer");
2058 if (strcmp (SSDATA (BVAR (XBUFFER (buffer), name)), "*scratch*") == 0)
2059 function = find_symbol_value (intern ("initial-major-mode"));
2060 else
2062 function = BVAR (&buffer_defaults, major_mode);
2063 if (NILP (function)
2064 && NILP (Fget (BVAR (current_buffer, major_mode), Qmode_class)))
2065 function = BVAR (current_buffer, major_mode);
2068 if (NILP (function) || EQ (function, Qfundamental_mode))
2069 return Qnil;
2071 count = SPECPDL_INDEX ();
2073 /* To select a nonfundamental mode,
2074 select the buffer temporarily and then call the mode function. */
2076 record_unwind_protect (save_excursion_restore, save_excursion_save ());
2078 Fset_buffer (buffer);
2079 call0 (function);
2081 return unbind_to (count, Qnil);
2084 DEFUN ("current-buffer", Fcurrent_buffer, Scurrent_buffer, 0, 0, 0,
2085 doc: /* Return the current buffer as a Lisp object. */)
2086 (void)
2088 register Lisp_Object buf;
2089 XSETBUFFER (buf, current_buffer);
2090 return buf;
2093 /* Set the current buffer to B, and do not set windows_or_buffers_changed.
2094 This is used by redisplay. */
2096 void
2097 set_buffer_internal_1 (register struct buffer *b)
2099 register struct buffer *old_buf;
2100 register Lisp_Object tail;
2102 #ifdef USE_MMAP_FOR_BUFFERS
2103 if (b->text->beg == NULL)
2104 enlarge_buffer_text (b, 0);
2105 #endif /* USE_MMAP_FOR_BUFFERS */
2107 if (current_buffer == b)
2108 return;
2110 BUFFER_CHECK_INDIRECTION (b);
2112 old_buf = current_buffer;
2113 current_buffer = b;
2114 last_known_column_point = -1; /* invalidate indentation cache */
2116 if (old_buf)
2118 /* Put the undo list back in the base buffer, so that it appears
2119 that an indirect buffer shares the undo list of its base. */
2120 if (old_buf->base_buffer)
2121 bset_undo_list (old_buf->base_buffer, BVAR (old_buf, undo_list));
2123 /* If the old current buffer has markers to record PT, BEGV and ZV
2124 when it is not current, update them now. */
2125 record_buffer_markers (old_buf);
2128 /* Get the undo list from the base buffer, so that it appears
2129 that an indirect buffer shares the undo list of its base. */
2130 if (b->base_buffer)
2131 bset_undo_list (b, BVAR (b->base_buffer, undo_list));
2133 /* If the new current buffer has markers to record PT, BEGV and ZV
2134 when it is not current, fetch them now. */
2135 fetch_buffer_markers (b);
2137 /* Look down buffer's list of local Lisp variables
2138 to find and update any that forward into C variables. */
2142 for (tail = BVAR (b, local_var_alist); CONSP (tail); tail = XCDR (tail))
2144 Lisp_Object var = XCAR (XCAR (tail));
2145 struct Lisp_Symbol *sym = XSYMBOL (var);
2146 if (sym->redirect == SYMBOL_LOCALIZED /* Just to be sure. */
2147 && SYMBOL_BLV (sym)->fwd)
2148 /* Just reference the variable
2149 to cause it to become set for this buffer. */
2150 Fsymbol_value (var);
2153 /* Do the same with any others that were local to the previous buffer */
2154 while (b != old_buf && (b = old_buf, b));
2157 /* Switch to buffer B temporarily for redisplay purposes.
2158 This avoids certain things that don't need to be done within redisplay. */
2160 void
2161 set_buffer_temp (struct buffer *b)
2163 register struct buffer *old_buf;
2165 if (current_buffer == b)
2166 return;
2168 old_buf = current_buffer;
2169 current_buffer = b;
2171 /* If the old current buffer has markers to record PT, BEGV and ZV
2172 when it is not current, update them now. */
2173 record_buffer_markers (old_buf);
2175 /* If the new current buffer has markers to record PT, BEGV and ZV
2176 when it is not current, fetch them now. */
2177 fetch_buffer_markers (b);
2180 DEFUN ("set-buffer", Fset_buffer, Sset_buffer, 1, 1, 0,
2181 doc: /* Make buffer BUFFER-OR-NAME current for editing operations.
2182 BUFFER-OR-NAME may be a buffer or the name of an existing buffer. See
2183 also `with-current-buffer' when you want to make a buffer current
2184 temporarily. This function does not display the buffer, so its effect
2185 ends when the current command terminates. Use `switch-to-buffer' or
2186 `pop-to-buffer' to switch buffers permanently. */)
2187 (register Lisp_Object buffer_or_name)
2189 register Lisp_Object buffer;
2190 buffer = Fget_buffer (buffer_or_name);
2191 if (NILP (buffer))
2192 nsberror (buffer_or_name);
2193 if (!BUFFER_LIVE_P (XBUFFER (buffer)))
2194 error ("Selecting deleted buffer");
2195 set_buffer_internal (XBUFFER (buffer));
2196 return buffer;
2199 /* Set the current buffer to BUFFER provided if it is alive. */
2201 Lisp_Object
2202 set_buffer_if_live (Lisp_Object buffer)
2204 if (BUFFER_LIVE_P (XBUFFER (buffer)))
2205 set_buffer_internal (XBUFFER (buffer));
2206 return Qnil;
2209 DEFUN ("barf-if-buffer-read-only", Fbarf_if_buffer_read_only,
2210 Sbarf_if_buffer_read_only, 0, 0, 0,
2211 doc: /* Signal a `buffer-read-only' error if the current buffer is read-only. */)
2212 (void)
2214 if (!NILP (BVAR (current_buffer, read_only))
2215 && NILP (Vinhibit_read_only))
2216 xsignal1 (Qbuffer_read_only, Fcurrent_buffer ());
2217 return Qnil;
2220 DEFUN ("erase-buffer", Ferase_buffer, Serase_buffer, 0, 0, "*",
2221 doc: /* Delete the entire contents of the current buffer.
2222 Any narrowing restriction in effect (see `narrow-to-region') is removed,
2223 so the buffer is truly empty after this. */)
2224 (void)
2226 Fwiden ();
2228 del_range (BEG, Z);
2230 current_buffer->last_window_start = 1;
2231 /* Prevent warnings, or suspension of auto saving, that would happen
2232 if future size is less than past size. Use of erase-buffer
2233 implies that the future text is not really related to the past text. */
2234 XSETFASTINT (BVAR (current_buffer, save_length), 0);
2235 return Qnil;
2238 void
2239 validate_region (register Lisp_Object *b, register Lisp_Object *e)
2241 CHECK_NUMBER_COERCE_MARKER (*b);
2242 CHECK_NUMBER_COERCE_MARKER (*e);
2244 if (XINT (*b) > XINT (*e))
2246 Lisp_Object tem;
2247 tem = *b; *b = *e; *e = tem;
2250 if (! (BEGV <= XINT (*b) && XINT (*e) <= ZV))
2251 args_out_of_range (*b, *e);
2254 /* Advance BYTE_POS up to a character boundary
2255 and return the adjusted position. */
2257 static ptrdiff_t
2258 advance_to_char_boundary (ptrdiff_t byte_pos)
2260 int c;
2262 if (byte_pos == BEG)
2263 /* Beginning of buffer is always a character boundary. */
2264 return BEG;
2266 c = FETCH_BYTE (byte_pos);
2267 if (! CHAR_HEAD_P (c))
2269 /* We should advance BYTE_POS only when C is a constituent of a
2270 multibyte sequence. */
2271 ptrdiff_t orig_byte_pos = byte_pos;
2275 byte_pos--;
2276 c = FETCH_BYTE (byte_pos);
2278 while (! CHAR_HEAD_P (c) && byte_pos > BEG);
2279 INC_POS (byte_pos);
2280 if (byte_pos < orig_byte_pos)
2281 byte_pos = orig_byte_pos;
2282 /* If C is a constituent of a multibyte sequence, BYTE_POS was
2283 surely advance to the correct character boundary. If C is
2284 not, BYTE_POS was unchanged. */
2287 return byte_pos;
2290 DEFUN ("buffer-swap-text", Fbuffer_swap_text, Sbuffer_swap_text,
2291 1, 1, 0,
2292 doc: /* Swap the text between current buffer and BUFFER. */)
2293 (Lisp_Object buffer)
2295 struct buffer *other_buffer;
2296 CHECK_BUFFER (buffer);
2297 other_buffer = XBUFFER (buffer);
2299 if (!BUFFER_LIVE_P (other_buffer))
2300 error ("Cannot swap a dead buffer's text");
2302 /* Actually, it probably works just fine.
2303 * if (other_buffer == current_buffer)
2304 * error ("Cannot swap a buffer's text with itself"); */
2306 /* Actually, this may be workable as well, tho probably only if they're
2307 *both* indirect. */
2308 if (other_buffer->base_buffer
2309 || current_buffer->base_buffer)
2310 error ("Cannot swap indirect buffers's text");
2312 { /* This is probably harder to make work. */
2313 struct buffer *other;
2314 FOR_EACH_BUFFER (other)
2315 if (other->base_buffer == other_buffer
2316 || other->base_buffer == current_buffer)
2317 error ("One of the buffers to swap has indirect buffers");
2320 #define swapfield(field, type) \
2321 do { \
2322 type tmp##field = other_buffer->field; \
2323 other_buffer->field = current_buffer->field; \
2324 current_buffer->field = tmp##field; \
2325 } while (0)
2326 #define swapfield_(field, type) \
2327 do { \
2328 type tmp##field = BVAR (other_buffer, field); \
2329 bset_##field (other_buffer, BVAR (current_buffer, field)); \
2330 bset_##field (current_buffer, tmp##field); \
2331 } while (0)
2333 swapfield (own_text, struct buffer_text);
2334 eassert (current_buffer->text == &current_buffer->own_text);
2335 eassert (other_buffer->text == &other_buffer->own_text);
2336 #ifdef REL_ALLOC
2337 r_alloc_reset_variable ((void **) &current_buffer->own_text.beg,
2338 (void **) &other_buffer->own_text.beg);
2339 r_alloc_reset_variable ((void **) &other_buffer->own_text.beg,
2340 (void **) &current_buffer->own_text.beg);
2341 #endif /* REL_ALLOC */
2343 swapfield (pt, ptrdiff_t);
2344 swapfield (pt_byte, ptrdiff_t);
2345 swapfield (begv, ptrdiff_t);
2346 swapfield (begv_byte, ptrdiff_t);
2347 swapfield (zv, ptrdiff_t);
2348 swapfield (zv_byte, ptrdiff_t);
2349 eassert (!current_buffer->base_buffer);
2350 eassert (!other_buffer->base_buffer);
2351 swapfield (indirections, ptrdiff_t);
2352 current_buffer->clip_changed = 1; other_buffer->clip_changed = 1;
2353 swapfield (newline_cache, struct region_cache *);
2354 swapfield (width_run_cache, struct region_cache *);
2355 current_buffer->prevent_redisplay_optimizations_p = 1;
2356 other_buffer->prevent_redisplay_optimizations_p = 1;
2357 swapfield (overlays_before, struct Lisp_Overlay *);
2358 swapfield (overlays_after, struct Lisp_Overlay *);
2359 swapfield (overlay_center, ptrdiff_t);
2360 swapfield_ (undo_list, Lisp_Object);
2361 swapfield_ (mark, Lisp_Object);
2362 swapfield_ (enable_multibyte_characters, Lisp_Object);
2363 swapfield_ (bidi_display_reordering, Lisp_Object);
2364 swapfield_ (bidi_paragraph_direction, Lisp_Object);
2365 /* FIXME: Not sure what we should do with these *_marker fields.
2366 Hopefully they're just nil anyway. */
2367 swapfield_ (pt_marker, Lisp_Object);
2368 swapfield_ (begv_marker, Lisp_Object);
2369 swapfield_ (zv_marker, Lisp_Object);
2370 bset_point_before_scroll (current_buffer, Qnil);
2371 bset_point_before_scroll (other_buffer, Qnil);
2373 current_buffer->text->modiff++; other_buffer->text->modiff++;
2374 current_buffer->text->chars_modiff++; other_buffer->text->chars_modiff++;
2375 current_buffer->text->overlay_modiff++; other_buffer->text->overlay_modiff++;
2376 current_buffer->text->beg_unchanged = current_buffer->text->gpt;
2377 current_buffer->text->end_unchanged = current_buffer->text->gpt;
2378 other_buffer->text->beg_unchanged = other_buffer->text->gpt;
2379 other_buffer->text->end_unchanged = other_buffer->text->gpt;
2381 struct Lisp_Marker *m;
2382 for (m = BUF_MARKERS (current_buffer); m; m = m->next)
2383 if (m->buffer == other_buffer)
2384 m->buffer = current_buffer;
2385 else
2386 /* Since there's no indirect buffer in sight, markers on
2387 BUF_MARKERS(buf) should either be for `buf' or dead. */
2388 eassert (!m->buffer);
2389 for (m = BUF_MARKERS (other_buffer); m; m = m->next)
2390 if (m->buffer == current_buffer)
2391 m->buffer = other_buffer;
2392 else
2393 /* Since there's no indirect buffer in sight, markers on
2394 BUF_MARKERS(buf) should either be for `buf' or dead. */
2395 eassert (!m->buffer);
2397 { /* Some of the C code expects that w->buffer == w->pointm->buffer.
2398 So since we just swapped the markers between the two buffers, we need
2399 to undo the effect of this swap for window markers. */
2400 Lisp_Object w = Fselected_window (), ws = Qnil;
2401 Lisp_Object buf1, buf2;
2402 XSETBUFFER (buf1, current_buffer); XSETBUFFER (buf2, other_buffer);
2404 while (NILP (Fmemq (w, ws)))
2406 ws = Fcons (w, ws);
2407 if (MARKERP (XWINDOW (w)->pointm)
2408 && (EQ (XWINDOW (w)->buffer, buf1)
2409 || EQ (XWINDOW (w)->buffer, buf2)))
2410 Fset_marker (XWINDOW (w)->pointm,
2411 make_number
2412 (BUF_BEGV (XBUFFER (XWINDOW (w)->buffer))),
2413 XWINDOW (w)->buffer);
2414 w = Fnext_window (w, Qt, Qt);
2418 if (current_buffer->text->intervals)
2419 (eassert (EQ (current_buffer->text->intervals->up.obj, buffer)),
2420 XSETBUFFER (current_buffer->text->intervals->up.obj, current_buffer));
2421 if (other_buffer->text->intervals)
2422 (eassert (EQ (other_buffer->text->intervals->up.obj, Fcurrent_buffer ())),
2423 XSETBUFFER (other_buffer->text->intervals->up.obj, other_buffer));
2425 return Qnil;
2428 DEFUN ("set-buffer-multibyte", Fset_buffer_multibyte, Sset_buffer_multibyte,
2429 1, 1, 0,
2430 doc: /* Set the multibyte flag of the current buffer to FLAG.
2431 If FLAG is t, this makes the buffer a multibyte buffer.
2432 If FLAG is nil, this makes the buffer a single-byte buffer.
2433 In these cases, the buffer contents remain unchanged as a sequence of
2434 bytes but the contents viewed as characters do change.
2435 If FLAG is `to', this makes the buffer a multibyte buffer by changing
2436 all eight-bit bytes to eight-bit characters.
2437 If the multibyte flag was really changed, undo information of the
2438 current buffer is cleared. */)
2439 (Lisp_Object flag)
2441 struct Lisp_Marker *tail, *markers;
2442 struct buffer *other;
2443 ptrdiff_t begv, zv;
2444 bool narrowed = (BEG != BEGV || Z != ZV);
2445 bool modified_p = !NILP (Fbuffer_modified_p (Qnil));
2446 Lisp_Object old_undo = BVAR (current_buffer, undo_list);
2447 struct gcpro gcpro1;
2449 if (current_buffer->base_buffer)
2450 error ("Cannot do `set-buffer-multibyte' on an indirect buffer");
2452 /* Do nothing if nothing actually changes. */
2453 if (NILP (flag) == NILP (BVAR (current_buffer, enable_multibyte_characters)))
2454 return flag;
2456 GCPRO1 (old_undo);
2458 /* Don't record these buffer changes. We will put a special undo entry
2459 instead. */
2460 bset_undo_list (current_buffer, Qt);
2462 /* If the cached position is for this buffer, clear it out. */
2463 clear_charpos_cache (current_buffer);
2465 if (NILP (flag))
2466 begv = BEGV_BYTE, zv = ZV_BYTE;
2467 else
2468 begv = BEGV, zv = ZV;
2470 if (narrowed)
2471 error ("Changing multibyteness in a narrowed buffer");
2473 if (NILP (flag))
2475 ptrdiff_t pos, stop;
2476 unsigned char *p;
2478 /* Do this first, so it can use CHAR_TO_BYTE
2479 to calculate the old correspondences. */
2480 set_intervals_multibyte (0);
2482 bset_enable_multibyte_characters (current_buffer, Qnil);
2484 Z = Z_BYTE;
2485 BEGV = BEGV_BYTE;
2486 ZV = ZV_BYTE;
2487 GPT = GPT_BYTE;
2488 TEMP_SET_PT_BOTH (PT_BYTE, PT_BYTE);
2491 for (tail = BUF_MARKERS (current_buffer); tail; tail = tail->next)
2492 tail->charpos = tail->bytepos;
2494 /* Convert multibyte form of 8-bit characters to unibyte. */
2495 pos = BEG;
2496 stop = GPT;
2497 p = BEG_ADDR;
2498 while (1)
2500 int c, bytes;
2502 if (pos == stop)
2504 if (pos == Z)
2505 break;
2506 p = GAP_END_ADDR;
2507 stop = Z;
2509 if (ASCII_BYTE_P (*p))
2510 p++, pos++;
2511 else if (CHAR_BYTE8_HEAD_P (*p))
2513 c = STRING_CHAR_AND_LENGTH (p, bytes);
2514 /* Delete all bytes for this 8-bit character but the
2515 last one, and change the last one to the character
2516 code. */
2517 bytes--;
2518 del_range_2 (pos, pos, pos + bytes, pos + bytes, 0);
2519 p = GAP_END_ADDR;
2520 *p++ = c;
2521 pos++;
2522 if (begv > pos)
2523 begv -= bytes;
2524 if (zv > pos)
2525 zv -= bytes;
2526 stop = Z;
2528 else
2530 bytes = BYTES_BY_CHAR_HEAD (*p);
2531 p += bytes, pos += bytes;
2534 if (narrowed)
2535 Fnarrow_to_region (make_number (begv), make_number (zv));
2537 else
2539 ptrdiff_t pt = PT;
2540 ptrdiff_t pos, stop;
2541 unsigned char *p, *pend;
2543 /* Be sure not to have a multibyte sequence striding over the GAP.
2544 Ex: We change this: "...abc\302 _GAP_ \241def..."
2545 to: "...abc _GAP_ \302\241def..." */
2547 if (EQ (flag, Qt)
2548 && GPT_BYTE > 1 && GPT_BYTE < Z_BYTE
2549 && ! CHAR_HEAD_P (*(GAP_END_ADDR)))
2551 unsigned char *q = GPT_ADDR - 1;
2553 while (! CHAR_HEAD_P (*q) && q > BEG_ADDR) q--;
2554 if (LEADING_CODE_P (*q))
2556 ptrdiff_t new_gpt = GPT_BYTE - (GPT_ADDR - q);
2558 move_gap_both (new_gpt, new_gpt);
2562 /* Make the buffer contents valid as multibyte by converting
2563 8-bit characters to multibyte form. */
2564 pos = BEG;
2565 stop = GPT;
2566 p = BEG_ADDR;
2567 pend = GPT_ADDR;
2568 while (1)
2570 int bytes;
2572 if (pos == stop)
2574 if (pos == Z)
2575 break;
2576 p = GAP_END_ADDR;
2577 pend = Z_ADDR;
2578 stop = Z;
2581 if (ASCII_BYTE_P (*p))
2582 p++, pos++;
2583 else if (EQ (flag, Qt)
2584 && ! CHAR_BYTE8_HEAD_P (*p)
2585 && (bytes = MULTIBYTE_LENGTH (p, pend)) > 0)
2586 p += bytes, pos += bytes;
2587 else
2589 unsigned char tmp[MAX_MULTIBYTE_LENGTH];
2590 int c;
2592 c = BYTE8_TO_CHAR (*p);
2593 bytes = CHAR_STRING (c, tmp);
2594 *p = tmp[0];
2595 TEMP_SET_PT_BOTH (pos + 1, pos + 1);
2596 bytes--;
2597 insert_1_both ((char *) tmp + 1, bytes, bytes, 1, 0, 0);
2598 /* Now the gap is after the just inserted data. */
2599 pos = GPT;
2600 p = GAP_END_ADDR;
2601 if (pos <= begv)
2602 begv += bytes;
2603 if (pos <= zv)
2604 zv += bytes;
2605 if (pos <= pt)
2606 pt += bytes;
2607 pend = Z_ADDR;
2608 stop = Z;
2612 if (pt != PT)
2613 TEMP_SET_PT (pt);
2615 if (narrowed)
2616 Fnarrow_to_region (make_number (begv), make_number (zv));
2618 /* Do this first, so that chars_in_text asks the right question.
2619 set_intervals_multibyte needs it too. */
2620 bset_enable_multibyte_characters (current_buffer, Qt);
2622 GPT_BYTE = advance_to_char_boundary (GPT_BYTE);
2623 GPT = chars_in_text (BEG_ADDR, GPT_BYTE - BEG_BYTE) + BEG;
2625 Z = chars_in_text (GAP_END_ADDR, Z_BYTE - GPT_BYTE) + GPT;
2627 BEGV_BYTE = advance_to_char_boundary (BEGV_BYTE);
2628 if (BEGV_BYTE > GPT_BYTE)
2629 BEGV = chars_in_text (GAP_END_ADDR, BEGV_BYTE - GPT_BYTE) + GPT;
2630 else
2631 BEGV = chars_in_text (BEG_ADDR, BEGV_BYTE - BEG_BYTE) + BEG;
2633 ZV_BYTE = advance_to_char_boundary (ZV_BYTE);
2634 if (ZV_BYTE > GPT_BYTE)
2635 ZV = chars_in_text (GAP_END_ADDR, ZV_BYTE - GPT_BYTE) + GPT;
2636 else
2637 ZV = chars_in_text (BEG_ADDR, ZV_BYTE - BEG_BYTE) + BEG;
2640 ptrdiff_t byte = advance_to_char_boundary (PT_BYTE);
2641 ptrdiff_t position;
2643 if (byte > GPT_BYTE)
2644 position = chars_in_text (GAP_END_ADDR, byte - GPT_BYTE) + GPT;
2645 else
2646 position = chars_in_text (BEG_ADDR, byte - BEG_BYTE) + BEG;
2647 TEMP_SET_PT_BOTH (position, byte);
2650 tail = markers = BUF_MARKERS (current_buffer);
2652 /* This prevents BYTE_TO_CHAR (that is, buf_bytepos_to_charpos) from
2653 getting confused by the markers that have not yet been updated.
2654 It is also a signal that it should never create a marker. */
2655 BUF_MARKERS (current_buffer) = NULL;
2657 for (; tail; tail = tail->next)
2659 tail->bytepos = advance_to_char_boundary (tail->bytepos);
2660 tail->charpos = BYTE_TO_CHAR (tail->bytepos);
2663 /* Make sure no markers were put on the chain
2664 while the chain value was incorrect. */
2665 if (BUF_MARKERS (current_buffer))
2666 emacs_abort ();
2668 BUF_MARKERS (current_buffer) = markers;
2670 /* Do this last, so it can calculate the new correspondences
2671 between chars and bytes. */
2672 set_intervals_multibyte (1);
2675 if (!EQ (old_undo, Qt))
2677 /* Represent all the above changes by a special undo entry. */
2678 bset_undo_list (current_buffer,
2679 Fcons (list3 (Qapply,
2680 intern ("set-buffer-multibyte"),
2681 NILP (flag) ? Qt : Qnil),
2682 old_undo));
2685 UNGCPRO;
2687 current_buffer->prevent_redisplay_optimizations_p = 1;
2689 /* If buffer is shown in a window, let redisplay consider other windows. */
2690 if (buffer_window_count (current_buffer))
2691 ++windows_or_buffers_changed;
2693 /* Copy this buffer's new multibyte status
2694 into all of its indirect buffers. */
2695 FOR_EACH_BUFFER (other)
2696 if (other->base_buffer == current_buffer && BUFFER_LIVE_P (other))
2698 BVAR (other, enable_multibyte_characters)
2699 = BVAR (current_buffer, enable_multibyte_characters);
2700 other->prevent_redisplay_optimizations_p = 1;
2703 /* Restore the modifiedness of the buffer. */
2704 if (!modified_p && !NILP (Fbuffer_modified_p (Qnil)))
2705 Fset_buffer_modified_p (Qnil);
2707 /* Update coding systems of this buffer's process (if any). */
2709 Lisp_Object process;
2711 process = Fget_buffer_process (Fcurrent_buffer ());
2712 if (PROCESSP (process))
2713 setup_process_coding_systems (process);
2716 return flag;
2719 DEFUN ("kill-all-local-variables", Fkill_all_local_variables,
2720 Skill_all_local_variables, 0, 0, 0,
2721 doc: /* Switch to Fundamental mode by killing current buffer's local variables.
2722 Most local variable bindings are eliminated so that the default values
2723 become effective once more. Also, the syntax table is set from
2724 `standard-syntax-table', the local keymap is set to nil,
2725 and the abbrev table from `fundamental-mode-abbrev-table'.
2726 This function also forces redisplay of the mode line.
2728 Every function to select a new major mode starts by
2729 calling this function.
2731 As a special exception, local variables whose names have
2732 a non-nil `permanent-local' property are not eliminated by this function.
2734 The first thing this function does is run
2735 the normal hook `change-major-mode-hook'. */)
2736 (void)
2738 Frun_hooks (1, &Qchange_major_mode_hook);
2740 /* Make sure none of the bindings in local_var_alist
2741 remain swapped in, in their symbols. */
2743 swap_out_buffer_local_variables (current_buffer);
2745 /* Actually eliminate all local bindings of this buffer. */
2747 reset_buffer_local_variables (current_buffer, 0);
2749 /* Force mode-line redisplay. Useful here because all major mode
2750 commands call this function. */
2751 update_mode_lines++;
2753 return Qnil;
2756 /* Make sure no local variables remain set up with buffer B
2757 for their current values. */
2759 static void
2760 swap_out_buffer_local_variables (struct buffer *b)
2762 Lisp_Object oalist, alist, buffer;
2764 XSETBUFFER (buffer, b);
2765 oalist = BVAR (b, local_var_alist);
2767 for (alist = oalist; CONSP (alist); alist = XCDR (alist))
2769 Lisp_Object sym = XCAR (XCAR (alist));
2770 eassert (XSYMBOL (sym)->redirect == SYMBOL_LOCALIZED);
2771 /* Need not do anything if some other buffer's binding is
2772 now cached. */
2773 if (EQ (SYMBOL_BLV (XSYMBOL (sym))->where, buffer))
2775 /* Symbol is set up for this buffer's old local value:
2776 swap it out! */
2777 swap_in_global_binding (XSYMBOL (sym));
2782 /* Find all the overlays in the current buffer that contain position POS.
2783 Return the number found, and store them in a vector in *VEC_PTR.
2784 Store in *LEN_PTR the size allocated for the vector.
2785 Store in *NEXT_PTR the next position after POS where an overlay starts,
2786 or ZV if there are no more overlays between POS and ZV.
2787 Store in *PREV_PTR the previous position before POS where an overlay ends,
2788 or where an overlay starts which ends at or after POS;
2789 or BEGV if there are no such overlays from BEGV to POS.
2790 NEXT_PTR and/or PREV_PTR may be 0, meaning don't store that info.
2792 *VEC_PTR and *LEN_PTR should contain a valid vector and size
2793 when this function is called.
2795 If EXTEND, make the vector bigger if necessary.
2796 If not, never extend the vector,
2797 and store only as many overlays as will fit.
2798 But still return the total number of overlays.
2800 If CHANGE_REQ, any position written into *PREV_PTR or
2801 *NEXT_PTR is guaranteed to be not equal to POS, unless it is the
2802 default (BEGV or ZV). */
2804 ptrdiff_t
2805 overlays_at (EMACS_INT pos, bool extend, Lisp_Object **vec_ptr,
2806 ptrdiff_t *len_ptr,
2807 ptrdiff_t *next_ptr, ptrdiff_t *prev_ptr, bool change_req)
2809 Lisp_Object overlay, start, end;
2810 struct Lisp_Overlay *tail;
2811 ptrdiff_t idx = 0;
2812 ptrdiff_t len = *len_ptr;
2813 Lisp_Object *vec = *vec_ptr;
2814 ptrdiff_t next = ZV;
2815 ptrdiff_t prev = BEGV;
2816 bool inhibit_storing = 0;
2818 for (tail = current_buffer->overlays_before; tail; tail = tail->next)
2820 ptrdiff_t startpos, endpos;
2822 XSETMISC (overlay, tail);
2824 start = OVERLAY_START (overlay);
2825 end = OVERLAY_END (overlay);
2826 endpos = OVERLAY_POSITION (end);
2827 if (endpos < pos)
2829 if (prev < endpos)
2830 prev = endpos;
2831 break;
2833 startpos = OVERLAY_POSITION (start);
2834 /* This one ends at or after POS
2835 so its start counts for PREV_PTR if it's before POS. */
2836 if (prev < startpos && startpos < pos)
2837 prev = startpos;
2838 if (endpos == pos)
2839 continue;
2840 if (startpos <= pos)
2842 if (idx == len)
2844 /* The supplied vector is full.
2845 Either make it bigger, or don't store any more in it. */
2846 if (extend)
2848 vec = xpalloc (vec, len_ptr, 1, OVERLAY_COUNT_MAX,
2849 sizeof *vec);
2850 *vec_ptr = vec;
2851 len = *len_ptr;
2853 else
2854 inhibit_storing = 1;
2857 if (!inhibit_storing)
2858 vec[idx] = overlay;
2859 /* Keep counting overlays even if we can't return them all. */
2860 idx++;
2862 else if (startpos < next)
2863 next = startpos;
2866 for (tail = current_buffer->overlays_after; tail; tail = tail->next)
2868 ptrdiff_t startpos, endpos;
2870 XSETMISC (overlay, tail);
2872 start = OVERLAY_START (overlay);
2873 end = OVERLAY_END (overlay);
2874 startpos = OVERLAY_POSITION (start);
2875 if (pos < startpos)
2877 if (startpos < next)
2878 next = startpos;
2879 break;
2881 endpos = OVERLAY_POSITION (end);
2882 if (pos < endpos)
2884 if (idx == len)
2886 if (extend)
2888 vec = xpalloc (vec, len_ptr, 1, OVERLAY_COUNT_MAX,
2889 sizeof *vec);
2890 *vec_ptr = vec;
2891 len = *len_ptr;
2893 else
2894 inhibit_storing = 1;
2897 if (!inhibit_storing)
2898 vec[idx] = overlay;
2899 idx++;
2901 if (startpos < pos && startpos > prev)
2902 prev = startpos;
2904 else if (endpos < pos && endpos > prev)
2905 prev = endpos;
2906 else if (endpos == pos && startpos > prev
2907 && (!change_req || startpos < pos))
2908 prev = startpos;
2911 if (next_ptr)
2912 *next_ptr = next;
2913 if (prev_ptr)
2914 *prev_ptr = prev;
2915 return idx;
2918 /* Find all the overlays in the current buffer that overlap the range
2919 BEG-END, or are empty at BEG, or are empty at END provided END
2920 denotes the position at the end of the current buffer.
2922 Return the number found, and store them in a vector in *VEC_PTR.
2923 Store in *LEN_PTR the size allocated for the vector.
2924 Store in *NEXT_PTR the next position after POS where an overlay starts,
2925 or ZV if there are no more overlays.
2926 Store in *PREV_PTR the previous position before POS where an overlay ends,
2927 or BEGV if there are no previous overlays.
2928 NEXT_PTR and/or PREV_PTR may be 0, meaning don't store that info.
2930 *VEC_PTR and *LEN_PTR should contain a valid vector and size
2931 when this function is called.
2933 If EXTEND, make the vector bigger if necessary.
2934 If not, never extend the vector,
2935 and store only as many overlays as will fit.
2936 But still return the total number of overlays. */
2938 static ptrdiff_t
2939 overlays_in (EMACS_INT beg, EMACS_INT end, bool extend,
2940 Lisp_Object **vec_ptr, ptrdiff_t *len_ptr,
2941 ptrdiff_t *next_ptr, ptrdiff_t *prev_ptr)
2943 Lisp_Object overlay, ostart, oend;
2944 struct Lisp_Overlay *tail;
2945 ptrdiff_t idx = 0;
2946 ptrdiff_t len = *len_ptr;
2947 Lisp_Object *vec = *vec_ptr;
2948 ptrdiff_t next = ZV;
2949 ptrdiff_t prev = BEGV;
2950 bool inhibit_storing = 0;
2951 bool end_is_Z = end == Z;
2953 for (tail = current_buffer->overlays_before; tail; tail = tail->next)
2955 ptrdiff_t startpos, endpos;
2957 XSETMISC (overlay, tail);
2959 ostart = OVERLAY_START (overlay);
2960 oend = OVERLAY_END (overlay);
2961 endpos = OVERLAY_POSITION (oend);
2962 if (endpos < beg)
2964 if (prev < endpos)
2965 prev = endpos;
2966 break;
2968 startpos = OVERLAY_POSITION (ostart);
2969 /* Count an interval if it overlaps the range, is empty at the
2970 start of the range, or is empty at END provided END denotes the
2971 end of the buffer. */
2972 if ((beg < endpos && startpos < end)
2973 || (startpos == endpos
2974 && (beg == endpos || (end_is_Z && endpos == end))))
2976 if (idx == len)
2978 /* The supplied vector is full.
2979 Either make it bigger, or don't store any more in it. */
2980 if (extend)
2982 vec = xpalloc (vec, len_ptr, 1, OVERLAY_COUNT_MAX,
2983 sizeof *vec);
2984 *vec_ptr = vec;
2985 len = *len_ptr;
2987 else
2988 inhibit_storing = 1;
2991 if (!inhibit_storing)
2992 vec[idx] = overlay;
2993 /* Keep counting overlays even if we can't return them all. */
2994 idx++;
2996 else if (startpos < next)
2997 next = startpos;
3000 for (tail = current_buffer->overlays_after; tail; tail = tail->next)
3002 ptrdiff_t startpos, endpos;
3004 XSETMISC (overlay, tail);
3006 ostart = OVERLAY_START (overlay);
3007 oend = OVERLAY_END (overlay);
3008 startpos = OVERLAY_POSITION (ostart);
3009 if (end < startpos)
3011 if (startpos < next)
3012 next = startpos;
3013 break;
3015 endpos = OVERLAY_POSITION (oend);
3016 /* Count an interval if it overlaps the range, is empty at the
3017 start of the range, or is empty at END provided END denotes the
3018 end of the buffer. */
3019 if ((beg < endpos && startpos < end)
3020 || (startpos == endpos
3021 && (beg == endpos || (end_is_Z && endpos == end))))
3023 if (idx == len)
3025 if (extend)
3027 vec = xpalloc (vec, len_ptr, 1, OVERLAY_COUNT_MAX,
3028 sizeof *vec);
3029 *vec_ptr = vec;
3030 len = *len_ptr;
3032 else
3033 inhibit_storing = 1;
3036 if (!inhibit_storing)
3037 vec[idx] = overlay;
3038 idx++;
3040 else if (endpos < beg && endpos > prev)
3041 prev = endpos;
3044 if (next_ptr)
3045 *next_ptr = next;
3046 if (prev_ptr)
3047 *prev_ptr = prev;
3048 return idx;
3052 /* Return true if there exists an overlay with a non-nil
3053 `mouse-face' property overlapping OVERLAY. */
3055 bool
3056 mouse_face_overlay_overlaps (Lisp_Object overlay)
3058 ptrdiff_t start = OVERLAY_POSITION (OVERLAY_START (overlay));
3059 ptrdiff_t end = OVERLAY_POSITION (OVERLAY_END (overlay));
3060 ptrdiff_t n, i, size;
3061 Lisp_Object *v, tem;
3063 size = 10;
3064 v = alloca (size * sizeof *v);
3065 n = overlays_in (start, end, 0, &v, &size, NULL, NULL);
3066 if (n > size)
3068 v = alloca (n * sizeof *v);
3069 overlays_in (start, end, 0, &v, &n, NULL, NULL);
3072 for (i = 0; i < n; ++i)
3073 if (!EQ (v[i], overlay)
3074 && (tem = Foverlay_get (overlay, Qmouse_face),
3075 !NILP (tem)))
3076 break;
3078 return i < n;
3083 /* Fast function to just test if we're at an overlay boundary. */
3084 bool
3085 overlay_touches_p (ptrdiff_t pos)
3087 Lisp_Object overlay;
3088 struct Lisp_Overlay *tail;
3090 for (tail = current_buffer->overlays_before; tail; tail = tail->next)
3092 ptrdiff_t endpos;
3094 XSETMISC (overlay ,tail);
3095 eassert (OVERLAYP (overlay));
3097 endpos = OVERLAY_POSITION (OVERLAY_END (overlay));
3098 if (endpos < pos)
3099 break;
3100 if (endpos == pos || OVERLAY_POSITION (OVERLAY_START (overlay)) == pos)
3101 return 1;
3104 for (tail = current_buffer->overlays_after; tail; tail = tail->next)
3106 ptrdiff_t startpos;
3108 XSETMISC (overlay, tail);
3109 eassert (OVERLAYP (overlay));
3111 startpos = OVERLAY_POSITION (OVERLAY_START (overlay));
3112 if (pos < startpos)
3113 break;
3114 if (startpos == pos || OVERLAY_POSITION (OVERLAY_END (overlay)) == pos)
3115 return 1;
3117 return 0;
3120 struct sortvec
3122 Lisp_Object overlay;
3123 ptrdiff_t beg, end;
3124 EMACS_INT priority;
3127 static int
3128 compare_overlays (const void *v1, const void *v2)
3130 const struct sortvec *s1 = (const struct sortvec *) v1;
3131 const struct sortvec *s2 = (const struct sortvec *) v2;
3132 if (s1->priority != s2->priority)
3133 return s1->priority < s2->priority ? -1 : 1;
3134 if (s1->beg != s2->beg)
3135 return s1->beg < s2->beg ? -1 : 1;
3136 if (s1->end != s2->end)
3137 return s2->end < s1->end ? -1 : 1;
3138 /* Avoid the non-determinism of qsort by choosing an arbitrary ordering
3139 between "equal" overlays. The result can still change between
3140 invocations of Emacs, but it won't change in the middle of
3141 `find_field' (bug#6830). */
3142 if (!EQ (s1->overlay, s2->overlay))
3143 return XLI (s1->overlay) < XLI (s2->overlay) ? -1 : 1;
3144 return 0;
3147 /* Sort an array of overlays by priority. The array is modified in place.
3148 The return value is the new size; this may be smaller than the original
3149 size if some of the overlays were invalid or were window-specific. */
3150 ptrdiff_t
3151 sort_overlays (Lisp_Object *overlay_vec, ptrdiff_t noverlays, struct window *w)
3153 ptrdiff_t i, j;
3154 USE_SAFE_ALLOCA;
3155 struct sortvec *sortvec;
3157 SAFE_NALLOCA (sortvec, 1, noverlays);
3159 /* Put the valid and relevant overlays into sortvec. */
3161 for (i = 0, j = 0; i < noverlays; i++)
3163 Lisp_Object tem;
3164 Lisp_Object overlay;
3166 overlay = overlay_vec[i];
3167 if (OVERLAYP (overlay)
3168 && OVERLAY_POSITION (OVERLAY_START (overlay)) > 0
3169 && OVERLAY_POSITION (OVERLAY_END (overlay)) > 0)
3171 /* If we're interested in a specific window, then ignore
3172 overlays that are limited to some other window. */
3173 if (w)
3175 Lisp_Object window;
3177 window = Foverlay_get (overlay, Qwindow);
3178 if (WINDOWP (window) && XWINDOW (window) != w)
3179 continue;
3182 /* This overlay is good and counts: put it into sortvec. */
3183 sortvec[j].overlay = overlay;
3184 sortvec[j].beg = OVERLAY_POSITION (OVERLAY_START (overlay));
3185 sortvec[j].end = OVERLAY_POSITION (OVERLAY_END (overlay));
3186 tem = Foverlay_get (overlay, Qpriority);
3187 if (INTEGERP (tem))
3188 sortvec[j].priority = XINT (tem);
3189 else
3190 sortvec[j].priority = 0;
3191 j++;
3194 noverlays = j;
3196 /* Sort the overlays into the proper order: increasing priority. */
3198 if (noverlays > 1)
3199 qsort (sortvec, noverlays, sizeof (struct sortvec), compare_overlays);
3201 for (i = 0; i < noverlays; i++)
3202 overlay_vec[i] = sortvec[i].overlay;
3204 SAFE_FREE ();
3205 return (noverlays);
3208 struct sortstr
3210 Lisp_Object string, string2;
3211 ptrdiff_t size;
3212 EMACS_INT priority;
3215 struct sortstrlist
3217 struct sortstr *buf; /* An array that expands as needed; never freed. */
3218 ptrdiff_t size; /* Allocated length of that array. */
3219 ptrdiff_t used; /* How much of the array is currently in use. */
3220 ptrdiff_t bytes; /* Total length of the strings in buf. */
3223 /* Buffers for storing information about the overlays touching a given
3224 position. These could be automatic variables in overlay_strings, but
3225 it's more efficient to hold onto the memory instead of repeatedly
3226 allocating and freeing it. */
3227 static struct sortstrlist overlay_heads, overlay_tails;
3228 static unsigned char *overlay_str_buf;
3230 /* Allocated length of overlay_str_buf. */
3231 static ptrdiff_t overlay_str_len;
3233 /* A comparison function suitable for passing to qsort. */
3234 static int
3235 cmp_for_strings (const void *as1, const void *as2)
3237 struct sortstr *s1 = (struct sortstr *)as1;
3238 struct sortstr *s2 = (struct sortstr *)as2;
3239 if (s1->size != s2->size)
3240 return s2->size < s1->size ? -1 : 1;
3241 if (s1->priority != s2->priority)
3242 return s1->priority < s2->priority ? -1 : 1;
3243 return 0;
3246 static void
3247 record_overlay_string (struct sortstrlist *ssl, Lisp_Object str,
3248 Lisp_Object str2, Lisp_Object pri, ptrdiff_t size)
3250 ptrdiff_t nbytes;
3252 if (ssl->used == ssl->size)
3253 ssl->buf = xpalloc (ssl->buf, &ssl->size, 5, -1, sizeof *ssl->buf);
3254 ssl->buf[ssl->used].string = str;
3255 ssl->buf[ssl->used].string2 = str2;
3256 ssl->buf[ssl->used].size = size;
3257 ssl->buf[ssl->used].priority = (INTEGERP (pri) ? XINT (pri) : 0);
3258 ssl->used++;
3260 if (NILP (BVAR (current_buffer, enable_multibyte_characters)))
3261 nbytes = SCHARS (str);
3262 else if (! STRING_MULTIBYTE (str))
3263 nbytes = count_size_as_multibyte (SDATA (str),
3264 SBYTES (str));
3265 else
3266 nbytes = SBYTES (str);
3268 if (INT_ADD_OVERFLOW (ssl->bytes, nbytes))
3269 memory_full (SIZE_MAX);
3270 ssl->bytes += nbytes;
3272 if (STRINGP (str2))
3274 if (NILP (BVAR (current_buffer, enable_multibyte_characters)))
3275 nbytes = SCHARS (str2);
3276 else if (! STRING_MULTIBYTE (str2))
3277 nbytes = count_size_as_multibyte (SDATA (str2),
3278 SBYTES (str2));
3279 else
3280 nbytes = SBYTES (str2);
3282 if (INT_ADD_OVERFLOW (ssl->bytes, nbytes))
3283 memory_full (SIZE_MAX);
3284 ssl->bytes += nbytes;
3288 /* Return the concatenation of the strings associated with overlays that
3289 begin or end at POS, ignoring overlays that are specific to a window
3290 other than W. The strings are concatenated in the appropriate order:
3291 shorter overlays nest inside longer ones, and higher priority inside
3292 lower. Normally all of the after-strings come first, but zero-sized
3293 overlays have their after-strings ride along with the before-strings
3294 because it would look strange to print them inside-out.
3296 Returns the string length, and stores the contents indirectly through
3297 PSTR, if that variable is non-null. The string may be overwritten by
3298 subsequent calls. */
3300 ptrdiff_t
3301 overlay_strings (ptrdiff_t pos, struct window *w, unsigned char **pstr)
3303 Lisp_Object overlay, window, str;
3304 struct Lisp_Overlay *ov;
3305 ptrdiff_t startpos, endpos;
3306 bool multibyte = ! NILP (BVAR (current_buffer, enable_multibyte_characters));
3308 overlay_heads.used = overlay_heads.bytes = 0;
3309 overlay_tails.used = overlay_tails.bytes = 0;
3310 for (ov = current_buffer->overlays_before; ov; ov = ov->next)
3312 XSETMISC (overlay, ov);
3313 eassert (OVERLAYP (overlay));
3315 startpos = OVERLAY_POSITION (OVERLAY_START (overlay));
3316 endpos = OVERLAY_POSITION (OVERLAY_END (overlay));
3317 if (endpos < pos)
3318 break;
3319 if (endpos != pos && startpos != pos)
3320 continue;
3321 window = Foverlay_get (overlay, Qwindow);
3322 if (WINDOWP (window) && XWINDOW (window) != w)
3323 continue;
3324 if (startpos == pos
3325 && (str = Foverlay_get (overlay, Qbefore_string), STRINGP (str)))
3326 record_overlay_string (&overlay_heads, str,
3327 (startpos == endpos
3328 ? Foverlay_get (overlay, Qafter_string)
3329 : Qnil),
3330 Foverlay_get (overlay, Qpriority),
3331 endpos - startpos);
3332 else if (endpos == pos
3333 && (str = Foverlay_get (overlay, Qafter_string), STRINGP (str)))
3334 record_overlay_string (&overlay_tails, str, Qnil,
3335 Foverlay_get (overlay, Qpriority),
3336 endpos - startpos);
3338 for (ov = current_buffer->overlays_after; ov; ov = ov->next)
3340 XSETMISC (overlay, ov);
3341 eassert (OVERLAYP (overlay));
3343 startpos = OVERLAY_POSITION (OVERLAY_START (overlay));
3344 endpos = OVERLAY_POSITION (OVERLAY_END (overlay));
3345 if (startpos > pos)
3346 break;
3347 if (endpos != pos && startpos != pos)
3348 continue;
3349 window = Foverlay_get (overlay, Qwindow);
3350 if (WINDOWP (window) && XWINDOW (window) != w)
3351 continue;
3352 if (startpos == pos
3353 && (str = Foverlay_get (overlay, Qbefore_string), STRINGP (str)))
3354 record_overlay_string (&overlay_heads, str,
3355 (startpos == endpos
3356 ? Foverlay_get (overlay, Qafter_string)
3357 : Qnil),
3358 Foverlay_get (overlay, Qpriority),
3359 endpos - startpos);
3360 else if (endpos == pos
3361 && (str = Foverlay_get (overlay, Qafter_string), STRINGP (str)))
3362 record_overlay_string (&overlay_tails, str, Qnil,
3363 Foverlay_get (overlay, Qpriority),
3364 endpos - startpos);
3366 if (overlay_tails.used > 1)
3367 qsort (overlay_tails.buf, overlay_tails.used, sizeof (struct sortstr),
3368 cmp_for_strings);
3369 if (overlay_heads.used > 1)
3370 qsort (overlay_heads.buf, overlay_heads.used, sizeof (struct sortstr),
3371 cmp_for_strings);
3372 if (overlay_heads.bytes || overlay_tails.bytes)
3374 Lisp_Object tem;
3375 ptrdiff_t i;
3376 unsigned char *p;
3377 ptrdiff_t total;
3379 if (INT_ADD_OVERFLOW (overlay_heads.bytes, overlay_tails.bytes))
3380 memory_full (SIZE_MAX);
3381 total = overlay_heads.bytes + overlay_tails.bytes;
3382 if (total > overlay_str_len)
3383 overlay_str_buf = xpalloc (overlay_str_buf, &overlay_str_len,
3384 total - overlay_str_len, -1, 1);
3386 p = overlay_str_buf;
3387 for (i = overlay_tails.used; --i >= 0;)
3389 ptrdiff_t nbytes;
3390 tem = overlay_tails.buf[i].string;
3391 nbytes = copy_text (SDATA (tem), p,
3392 SBYTES (tem),
3393 STRING_MULTIBYTE (tem), multibyte);
3394 p += nbytes;
3396 for (i = 0; i < overlay_heads.used; ++i)
3398 ptrdiff_t nbytes;
3399 tem = overlay_heads.buf[i].string;
3400 nbytes = copy_text (SDATA (tem), p,
3401 SBYTES (tem),
3402 STRING_MULTIBYTE (tem), multibyte);
3403 p += nbytes;
3404 tem = overlay_heads.buf[i].string2;
3405 if (STRINGP (tem))
3407 nbytes = copy_text (SDATA (tem), p,
3408 SBYTES (tem),
3409 STRING_MULTIBYTE (tem), multibyte);
3410 p += nbytes;
3413 if (p != overlay_str_buf + total)
3414 emacs_abort ();
3415 if (pstr)
3416 *pstr = overlay_str_buf;
3417 return total;
3419 return 0;
3422 /* Shift overlays in BUF's overlay lists, to center the lists at POS. */
3424 void
3425 recenter_overlay_lists (struct buffer *buf, ptrdiff_t pos)
3427 Lisp_Object overlay, beg, end;
3428 struct Lisp_Overlay *prev, *tail, *next;
3430 /* See if anything in overlays_before should move to overlays_after. */
3432 /* We don't strictly need prev in this loop; it should always be nil.
3433 But we use it for symmetry and in case that should cease to be true
3434 with some future change. */
3435 prev = NULL;
3436 for (tail = buf->overlays_before; tail; prev = tail, tail = next)
3438 next = tail->next;
3439 XSETMISC (overlay, tail);
3440 eassert (OVERLAYP (overlay));
3442 beg = OVERLAY_START (overlay);
3443 end = OVERLAY_END (overlay);
3445 if (OVERLAY_POSITION (end) > pos)
3447 /* OVERLAY needs to be moved. */
3448 ptrdiff_t where = OVERLAY_POSITION (beg);
3449 struct Lisp_Overlay *other, *other_prev;
3451 /* Splice the cons cell TAIL out of overlays_before. */
3452 if (prev)
3453 prev->next = next;
3454 else
3455 set_buffer_overlays_before (buf, next);
3457 /* Search thru overlays_after for where to put it. */
3458 other_prev = NULL;
3459 for (other = buf->overlays_after; other;
3460 other_prev = other, other = other->next)
3462 Lisp_Object otherbeg, otheroverlay;
3464 XSETMISC (otheroverlay, other);
3465 eassert (OVERLAYP (otheroverlay));
3467 otherbeg = OVERLAY_START (otheroverlay);
3468 if (OVERLAY_POSITION (otherbeg) >= where)
3469 break;
3472 /* Add TAIL to overlays_after before OTHER. */
3473 tail->next = other;
3474 if (other_prev)
3475 other_prev->next = tail;
3476 else
3477 set_buffer_overlays_after (buf, tail);
3478 tail = prev;
3480 else
3481 /* We've reached the things that should stay in overlays_before.
3482 All the rest of overlays_before must end even earlier,
3483 so stop now. */
3484 break;
3487 /* See if anything in overlays_after should be in overlays_before. */
3488 prev = NULL;
3489 for (tail = buf->overlays_after; tail; prev = tail, tail = next)
3491 next = tail->next;
3492 XSETMISC (overlay, tail);
3493 eassert (OVERLAYP (overlay));
3495 beg = OVERLAY_START (overlay);
3496 end = OVERLAY_END (overlay);
3498 /* Stop looking, when we know that nothing further
3499 can possibly end before POS. */
3500 if (OVERLAY_POSITION (beg) > pos)
3501 break;
3503 if (OVERLAY_POSITION (end) <= pos)
3505 /* OVERLAY needs to be moved. */
3506 ptrdiff_t where = OVERLAY_POSITION (end);
3507 struct Lisp_Overlay *other, *other_prev;
3509 /* Splice the cons cell TAIL out of overlays_after. */
3510 if (prev)
3511 prev->next = next;
3512 else
3513 set_buffer_overlays_after (buf, next);
3515 /* Search thru overlays_before for where to put it. */
3516 other_prev = NULL;
3517 for (other = buf->overlays_before; other;
3518 other_prev = other, other = other->next)
3520 Lisp_Object otherend, otheroverlay;
3522 XSETMISC (otheroverlay, other);
3523 eassert (OVERLAYP (otheroverlay));
3525 otherend = OVERLAY_END (otheroverlay);
3526 if (OVERLAY_POSITION (otherend) <= where)
3527 break;
3530 /* Add TAIL to overlays_before before OTHER. */
3531 tail->next = other;
3532 if (other_prev)
3533 other_prev->next = tail;
3534 else
3535 set_buffer_overlays_before (buf, tail);
3536 tail = prev;
3540 buf->overlay_center = pos;
3543 void
3544 adjust_overlays_for_insert (ptrdiff_t pos, ptrdiff_t length)
3546 /* After an insertion, the lists are still sorted properly,
3547 but we may need to update the value of the overlay center. */
3548 if (current_buffer->overlay_center >= pos)
3549 current_buffer->overlay_center += length;
3552 void
3553 adjust_overlays_for_delete (ptrdiff_t pos, ptrdiff_t length)
3555 if (current_buffer->overlay_center < pos)
3556 /* The deletion was to our right. No change needed; the before- and
3557 after-lists are still consistent. */
3559 else if (current_buffer->overlay_center - pos > length)
3560 /* The deletion was to our left. We need to adjust the center value
3561 to account for the change in position, but the lists are consistent
3562 given the new value. */
3563 current_buffer->overlay_center -= length;
3564 else
3565 /* We're right in the middle. There might be things on the after-list
3566 that now belong on the before-list. Recentering will move them,
3567 and also update the center point. */
3568 recenter_overlay_lists (current_buffer, pos);
3571 /* Fix up overlays that were garbled as a result of permuting markers
3572 in the range START through END. Any overlay with at least one
3573 endpoint in this range will need to be unlinked from the overlay
3574 list and reinserted in its proper place.
3575 Such an overlay might even have negative size at this point.
3576 If so, we'll make the overlay empty. */
3577 void
3578 fix_start_end_in_overlays (register ptrdiff_t start, register ptrdiff_t end)
3580 Lisp_Object overlay;
3581 struct Lisp_Overlay *before_list IF_LINT (= NULL);
3582 struct Lisp_Overlay *after_list IF_LINT (= NULL);
3583 /* These are either nil, indicating that before_list or after_list
3584 should be assigned, or the cons cell the cdr of which should be
3585 assigned. */
3586 struct Lisp_Overlay *beforep = NULL, *afterp = NULL;
3587 /* 'Parent', likewise, indicates a cons cell or
3588 current_buffer->overlays_before or overlays_after, depending
3589 which loop we're in. */
3590 struct Lisp_Overlay *tail, *parent;
3591 ptrdiff_t startpos, endpos;
3593 /* This algorithm shifts links around instead of consing and GCing.
3594 The loop invariant is that before_list (resp. after_list) is a
3595 well-formed list except that its last element, the CDR of beforep
3596 (resp. afterp) if beforep (afterp) isn't nil or before_list
3597 (after_list) if it is, is still uninitialized. So it's not a bug
3598 that before_list isn't initialized, although it may look
3599 strange. */
3600 for (parent = NULL, tail = current_buffer->overlays_before; tail;)
3602 XSETMISC (overlay, tail);
3604 endpos = OVERLAY_POSITION (OVERLAY_END (overlay));
3605 startpos = OVERLAY_POSITION (OVERLAY_START (overlay));
3607 /* If the overlay is backwards, make it empty. */
3608 if (endpos < startpos)
3610 startpos = endpos;
3611 Fset_marker (OVERLAY_START (overlay), make_number (startpos),
3612 Qnil);
3615 if (endpos < start)
3616 break;
3618 if (endpos < end
3619 || (startpos >= start && startpos < end))
3621 /* Add it to the end of the wrong list. Later on,
3622 recenter_overlay_lists will move it to the right place. */
3623 if (endpos < current_buffer->overlay_center)
3625 if (!afterp)
3626 after_list = tail;
3627 else
3628 afterp->next = tail;
3629 afterp = tail;
3631 else
3633 if (!beforep)
3634 before_list = tail;
3635 else
3636 beforep->next = tail;
3637 beforep = tail;
3639 if (!parent)
3640 set_buffer_overlays_before (current_buffer, tail->next);
3641 else
3642 parent->next = tail->next;
3643 tail = tail->next;
3645 else
3646 parent = tail, tail = parent->next;
3648 for (parent = NULL, tail = current_buffer->overlays_after; tail;)
3650 XSETMISC (overlay, tail);
3652 startpos = OVERLAY_POSITION (OVERLAY_START (overlay));
3653 endpos = OVERLAY_POSITION (OVERLAY_END (overlay));
3655 /* If the overlay is backwards, make it empty. */
3656 if (endpos < startpos)
3658 startpos = endpos;
3659 Fset_marker (OVERLAY_START (overlay), make_number (startpos),
3660 Qnil);
3663 if (startpos >= end)
3664 break;
3666 if (startpos >= start
3667 || (endpos >= start && endpos < end))
3669 if (endpos < current_buffer->overlay_center)
3671 if (!afterp)
3672 after_list = tail;
3673 else
3674 afterp->next = tail;
3675 afterp = tail;
3677 else
3679 if (!beforep)
3680 before_list = tail;
3681 else
3682 beforep->next = tail;
3683 beforep = tail;
3685 if (!parent)
3686 set_buffer_overlays_after (current_buffer, tail->next);
3687 else
3688 parent->next = tail->next;
3689 tail = tail->next;
3691 else
3692 parent = tail, tail = parent->next;
3695 /* Splice the constructed (wrong) lists into the buffer's lists,
3696 and let the recenter function make it sane again. */
3697 if (beforep)
3699 beforep->next = current_buffer->overlays_before;
3700 set_buffer_overlays_before (current_buffer, before_list);
3703 if (afterp)
3705 afterp->next = current_buffer->overlays_after;
3706 set_buffer_overlays_after (current_buffer, after_list);
3708 recenter_overlay_lists (current_buffer, current_buffer->overlay_center);
3711 /* We have two types of overlay: the one whose ending marker is
3712 after-insertion-marker (this is the usual case) and the one whose
3713 ending marker is before-insertion-marker. When `overlays_before'
3714 contains overlays of the latter type and the former type in this
3715 order and both overlays end at inserting position, inserting a text
3716 increases only the ending marker of the latter type, which results
3717 in incorrect ordering of `overlays_before'.
3719 This function fixes ordering of overlays in the slot
3720 `overlays_before' of the buffer *BP. Before the insertion, `point'
3721 was at PREV, and now is at POS. */
3723 void
3724 fix_overlays_before (struct buffer *bp, ptrdiff_t prev, ptrdiff_t pos)
3726 /* If parent is nil, replace overlays_before; otherwise, parent->next. */
3727 struct Lisp_Overlay *tail = bp->overlays_before, *parent = NULL, *right_pair;
3728 Lisp_Object tem;
3729 ptrdiff_t end IF_LINT (= 0);
3731 /* After the insertion, the several overlays may be in incorrect
3732 order. The possibility is that, in the list `overlays_before',
3733 an overlay which ends at POS appears after an overlay which ends
3734 at PREV. Since POS is greater than PREV, we must fix the
3735 ordering of these overlays, by moving overlays ends at POS before
3736 the overlays ends at PREV. */
3738 /* At first, find a place where disordered overlays should be linked
3739 in. It is where an overlay which end before POS exists. (i.e. an
3740 overlay whose ending marker is after-insertion-marker if disorder
3741 exists). */
3742 while (tail
3743 && (XSETMISC (tem, tail),
3744 (end = OVERLAY_POSITION (OVERLAY_END (tem))) >= pos))
3746 parent = tail;
3747 tail = tail->next;
3750 /* If we don't find such an overlay,
3751 or the found one ends before PREV,
3752 or the found one is the last one in the list,
3753 we don't have to fix anything. */
3754 if (!tail || end < prev || !tail->next)
3755 return;
3757 right_pair = parent;
3758 parent = tail;
3759 tail = tail->next;
3761 /* Now, end position of overlays in the list TAIL should be before
3762 or equal to PREV. In the loop, an overlay which ends at POS is
3763 moved ahead to the place indicated by the CDR of RIGHT_PAIR. If
3764 we found an overlay which ends before PREV, the remaining
3765 overlays are in correct order. */
3766 while (tail)
3768 XSETMISC (tem, tail);
3769 end = OVERLAY_POSITION (OVERLAY_END (tem));
3771 if (end == pos)
3772 { /* This overlay is disordered. */
3773 struct Lisp_Overlay *found = tail;
3775 /* Unlink the found overlay. */
3776 tail = found->next;
3777 parent->next = tail;
3778 /* Move an overlay at RIGHT_PLACE to the next of the found one,
3779 and link it into the right place. */
3780 if (!right_pair)
3782 found->next = bp->overlays_before;
3783 set_buffer_overlays_before (bp, found);
3785 else
3787 found->next = right_pair->next;
3788 right_pair->next = found;
3791 else if (end == prev)
3793 parent = tail;
3794 tail = tail->next;
3796 else /* No more disordered overlay. */
3797 break;
3801 DEFUN ("overlayp", Foverlayp, Soverlayp, 1, 1, 0,
3802 doc: /* Return t if OBJECT is an overlay. */)
3803 (Lisp_Object object)
3805 return (OVERLAYP (object) ? Qt : Qnil);
3808 DEFUN ("make-overlay", Fmake_overlay, Smake_overlay, 2, 5, 0,
3809 doc: /* Create a new overlay with range BEG to END in BUFFER.
3810 If omitted, BUFFER defaults to the current buffer.
3811 BEG and END may be integers or markers.
3812 The fourth arg FRONT-ADVANCE, if non-nil, makes the marker
3813 for the front of the overlay advance when text is inserted there
3814 \(which means the text *is not* included in the overlay).
3815 The fifth arg REAR-ADVANCE, if non-nil, makes the marker
3816 for the rear of the overlay advance when text is inserted there
3817 \(which means the text *is* included in the overlay). */)
3818 (Lisp_Object beg, Lisp_Object end, Lisp_Object buffer, Lisp_Object front_advance, Lisp_Object rear_advance)
3820 Lisp_Object overlay;
3821 struct buffer *b;
3823 if (NILP (buffer))
3824 XSETBUFFER (buffer, current_buffer);
3825 else
3826 CHECK_BUFFER (buffer);
3827 if (MARKERP (beg)
3828 && ! EQ (Fmarker_buffer (beg), buffer))
3829 error ("Marker points into wrong buffer");
3830 if (MARKERP (end)
3831 && ! EQ (Fmarker_buffer (end), buffer))
3832 error ("Marker points into wrong buffer");
3834 CHECK_NUMBER_COERCE_MARKER (beg);
3835 CHECK_NUMBER_COERCE_MARKER (end);
3837 if (XINT (beg) > XINT (end))
3839 Lisp_Object temp;
3840 temp = beg; beg = end; end = temp;
3843 b = XBUFFER (buffer);
3845 beg = Fset_marker (Fmake_marker (), beg, buffer);
3846 end = Fset_marker (Fmake_marker (), end, buffer);
3848 if (!NILP (front_advance))
3849 XMARKER (beg)->insertion_type = 1;
3850 if (!NILP (rear_advance))
3851 XMARKER (end)->insertion_type = 1;
3853 overlay = build_overlay (beg, end, Qnil);
3855 /* Put the new overlay on the wrong list. */
3856 end = OVERLAY_END (overlay);
3857 if (OVERLAY_POSITION (end) < b->overlay_center)
3859 eassert (b->overlays_after || (XOVERLAY (overlay)->next == NULL));
3860 XOVERLAY (overlay)->next = b->overlays_after;
3861 set_buffer_overlays_after (b, XOVERLAY (overlay));
3863 else
3865 eassert (b->overlays_before || (XOVERLAY (overlay)->next == NULL));
3866 XOVERLAY (overlay)->next = b->overlays_before;
3867 set_buffer_overlays_before (b, XOVERLAY (overlay));
3869 /* This puts it in the right list, and in the right order. */
3870 recenter_overlay_lists (b, b->overlay_center);
3872 /* We don't need to redisplay the region covered by the overlay, because
3873 the overlay has no properties at the moment. */
3875 return overlay;
3878 /* Mark a section of BUF as needing redisplay because of overlays changes. */
3880 static void
3881 modify_overlay (struct buffer *buf, ptrdiff_t start, ptrdiff_t end)
3883 if (start > end)
3885 ptrdiff_t temp = start;
3886 start = end;
3887 end = temp;
3890 BUF_COMPUTE_UNCHANGED (buf, start, end);
3892 /* If BUF is visible, consider updating the display if ... */
3893 if (buffer_window_count (buf) > 0)
3895 /* ... it's visible in other window than selected, */
3896 if (buf != XBUFFER (XWINDOW (selected_window)->buffer))
3897 windows_or_buffers_changed = 1;
3898 /* ... or if we modify an overlay at the end of the buffer
3899 and so we cannot be sure that window end is still valid. */
3900 else if (end >= ZV && start <= ZV)
3901 windows_or_buffers_changed = 1;
3904 ++BUF_OVERLAY_MODIFF (buf);
3907 /* Remove OVERLAY from LIST. */
3909 static struct Lisp_Overlay *
3910 unchain_overlay (struct Lisp_Overlay *list, struct Lisp_Overlay *overlay)
3912 register struct Lisp_Overlay *tail, **prev = &list;
3914 for (tail = list; tail; prev = &tail->next, tail = *prev)
3915 if (tail == overlay)
3917 *prev = overlay->next;
3918 overlay->next = NULL;
3919 break;
3921 return list;
3924 /* Remove OVERLAY from both overlay lists of B. */
3926 static void
3927 unchain_both (struct buffer *b, Lisp_Object overlay)
3929 struct Lisp_Overlay *ov = XOVERLAY (overlay);
3931 set_buffer_overlays_before (b, unchain_overlay (b->overlays_before, ov));
3932 set_buffer_overlays_after (b, unchain_overlay (b->overlays_after, ov));
3933 eassert (XOVERLAY (overlay)->next == NULL);
3936 DEFUN ("move-overlay", Fmove_overlay, Smove_overlay, 3, 4, 0,
3937 doc: /* Set the endpoints of OVERLAY to BEG and END in BUFFER.
3938 If BUFFER is omitted, leave OVERLAY in the same buffer it inhabits now.
3939 If BUFFER is omitted, and OVERLAY is in no buffer, put it in the current
3940 buffer. */)
3941 (Lisp_Object overlay, Lisp_Object beg, Lisp_Object end, Lisp_Object buffer)
3943 struct buffer *b, *ob = 0;
3944 Lisp_Object obuffer;
3945 ptrdiff_t count = SPECPDL_INDEX ();
3946 ptrdiff_t n_beg, n_end, o_beg IF_LINT (= 0), o_end IF_LINT (= 0);
3948 CHECK_OVERLAY (overlay);
3949 if (NILP (buffer))
3950 buffer = Fmarker_buffer (OVERLAY_START (overlay));
3951 if (NILP (buffer))
3952 XSETBUFFER (buffer, current_buffer);
3953 CHECK_BUFFER (buffer);
3955 if (NILP (Fbuffer_live_p (buffer)))
3956 error ("Attempt to move overlay to a dead buffer");
3958 if (MARKERP (beg)
3959 && ! EQ (Fmarker_buffer (beg), buffer))
3960 error ("Marker points into wrong buffer");
3961 if (MARKERP (end)
3962 && ! EQ (Fmarker_buffer (end), buffer))
3963 error ("Marker points into wrong buffer");
3965 CHECK_NUMBER_COERCE_MARKER (beg);
3966 CHECK_NUMBER_COERCE_MARKER (end);
3968 if (XINT (beg) > XINT (end))
3970 Lisp_Object temp;
3971 temp = beg; beg = end; end = temp;
3974 specbind (Qinhibit_quit, Qt);
3976 obuffer = Fmarker_buffer (OVERLAY_START (overlay));
3977 b = XBUFFER (buffer);
3979 if (!NILP (obuffer))
3981 ob = XBUFFER (obuffer);
3983 o_beg = OVERLAY_POSITION (OVERLAY_START (overlay));
3984 o_end = OVERLAY_POSITION (OVERLAY_END (overlay));
3986 unchain_both (ob, overlay);
3989 /* Set the overlay boundaries, which may clip them. */
3990 Fset_marker (OVERLAY_START (overlay), beg, buffer);
3991 Fset_marker (OVERLAY_END (overlay), end, buffer);
3993 n_beg = marker_position (OVERLAY_START (overlay));
3994 n_end = marker_position (OVERLAY_END (overlay));
3996 /* If the overlay has changed buffers, do a thorough redisplay. */
3997 if (!EQ (buffer, obuffer))
3999 /* Redisplay where the overlay was. */
4000 if (ob)
4001 modify_overlay (ob, o_beg, o_end);
4003 /* Redisplay where the overlay is going to be. */
4004 modify_overlay (b, n_beg, n_end);
4006 else
4007 /* Redisplay the area the overlay has just left, or just enclosed. */
4009 if (o_beg == n_beg)
4010 modify_overlay (b, o_end, n_end);
4011 else if (o_end == n_end)
4012 modify_overlay (b, o_beg, n_beg);
4013 else
4014 modify_overlay (b, min (o_beg, n_beg), max (o_end, n_end));
4017 /* Delete the overlay if it is empty after clipping and has the
4018 evaporate property. */
4019 if (n_beg == n_end && !NILP (Foverlay_get (overlay, Qevaporate)))
4020 return unbind_to (count, Fdelete_overlay (overlay));
4022 /* Put the overlay into the new buffer's overlay lists, first on the
4023 wrong list. */
4024 if (n_end < b->overlay_center)
4026 XOVERLAY (overlay)->next = b->overlays_after;
4027 set_buffer_overlays_after (b, XOVERLAY (overlay));
4029 else
4031 XOVERLAY (overlay)->next = b->overlays_before;
4032 set_buffer_overlays_before (b, XOVERLAY (overlay));
4035 /* This puts it in the right list, and in the right order. */
4036 recenter_overlay_lists (b, b->overlay_center);
4038 return unbind_to (count, overlay);
4041 DEFUN ("delete-overlay", Fdelete_overlay, Sdelete_overlay, 1, 1, 0,
4042 doc: /* Delete the overlay OVERLAY from its buffer. */)
4043 (Lisp_Object overlay)
4045 Lisp_Object buffer;
4046 struct buffer *b;
4047 ptrdiff_t count = SPECPDL_INDEX ();
4049 CHECK_OVERLAY (overlay);
4051 buffer = Fmarker_buffer (OVERLAY_START (overlay));
4052 if (NILP (buffer))
4053 return Qnil;
4055 b = XBUFFER (buffer);
4056 specbind (Qinhibit_quit, Qt);
4058 unchain_both (b, overlay);
4059 drop_overlay (b, XOVERLAY (overlay));
4061 /* When deleting an overlay with before or after strings, turn off
4062 display optimizations for the affected buffer, on the basis that
4063 these strings may contain newlines. This is easier to do than to
4064 check for that situation during redisplay. */
4065 if (!windows_or_buffers_changed
4066 && (!NILP (Foverlay_get (overlay, Qbefore_string))
4067 || !NILP (Foverlay_get (overlay, Qafter_string))))
4068 b->prevent_redisplay_optimizations_p = 1;
4070 return unbind_to (count, Qnil);
4073 DEFUN ("delete-all-overlays", Fdelete_all_overlays, Sdelete_all_overlays, 0, 1, 0,
4074 doc: /* Delete all overlays of BUFFER.
4075 BUFFER omitted or nil means delete all overlays of the current
4076 buffer. */)
4077 (Lisp_Object buffer)
4079 register struct buffer *buf;
4081 if (NILP (buffer))
4082 buf = current_buffer;
4083 else
4085 CHECK_BUFFER (buffer);
4086 buf = XBUFFER (buffer);
4089 delete_all_overlays (buf);
4090 return Qnil;
4093 /* Overlay dissection functions. */
4095 DEFUN ("overlay-start", Foverlay_start, Soverlay_start, 1, 1, 0,
4096 doc: /* Return the position at which OVERLAY starts. */)
4097 (Lisp_Object overlay)
4099 CHECK_OVERLAY (overlay);
4101 return (Fmarker_position (OVERLAY_START (overlay)));
4104 DEFUN ("overlay-end", Foverlay_end, Soverlay_end, 1, 1, 0,
4105 doc: /* Return the position at which OVERLAY ends. */)
4106 (Lisp_Object overlay)
4108 CHECK_OVERLAY (overlay);
4110 return (Fmarker_position (OVERLAY_END (overlay)));
4113 DEFUN ("overlay-buffer", Foverlay_buffer, Soverlay_buffer, 1, 1, 0,
4114 doc: /* Return the buffer OVERLAY belongs to.
4115 Return nil if OVERLAY has been deleted. */)
4116 (Lisp_Object overlay)
4118 CHECK_OVERLAY (overlay);
4120 return Fmarker_buffer (OVERLAY_START (overlay));
4123 DEFUN ("overlay-properties", Foverlay_properties, Soverlay_properties, 1, 1, 0,
4124 doc: /* Return a list of the properties on OVERLAY.
4125 This is a copy of OVERLAY's plist; modifying its conses has no effect on
4126 OVERLAY. */)
4127 (Lisp_Object overlay)
4129 CHECK_OVERLAY (overlay);
4131 return Fcopy_sequence (XOVERLAY (overlay)->plist);
4135 DEFUN ("overlays-at", Foverlays_at, Soverlays_at, 1, 1, 0,
4136 doc: /* Return a list of the overlays that contain the character at POS. */)
4137 (Lisp_Object pos)
4139 ptrdiff_t len, noverlays;
4140 Lisp_Object *overlay_vec;
4141 Lisp_Object result;
4143 CHECK_NUMBER_COERCE_MARKER (pos);
4145 len = 10;
4146 /* We can't use alloca here because overlays_at can call xrealloc. */
4147 overlay_vec = xmalloc (len * sizeof *overlay_vec);
4149 /* Put all the overlays we want in a vector in overlay_vec.
4150 Store the length in len. */
4151 noverlays = overlays_at (XINT (pos), 1, &overlay_vec, &len,
4152 NULL, NULL, 0);
4154 /* Make a list of them all. */
4155 result = Flist (noverlays, overlay_vec);
4157 xfree (overlay_vec);
4158 return result;
4161 DEFUN ("overlays-in", Foverlays_in, Soverlays_in, 2, 2, 0,
4162 doc: /* Return a list of the overlays that overlap the region BEG ... END.
4163 Overlap means that at least one character is contained within the overlay
4164 and also contained within the specified region.
4165 Empty overlays are included in the result if they are located at BEG,
4166 between BEG and END, or at END provided END denotes the position at the
4167 end of the buffer. */)
4168 (Lisp_Object beg, Lisp_Object end)
4170 ptrdiff_t len, noverlays;
4171 Lisp_Object *overlay_vec;
4172 Lisp_Object result;
4174 CHECK_NUMBER_COERCE_MARKER (beg);
4175 CHECK_NUMBER_COERCE_MARKER (end);
4177 len = 10;
4178 overlay_vec = xmalloc (len * sizeof *overlay_vec);
4180 /* Put all the overlays we want in a vector in overlay_vec.
4181 Store the length in len. */
4182 noverlays = overlays_in (XINT (beg), XINT (end), 1, &overlay_vec, &len,
4183 NULL, NULL);
4185 /* Make a list of them all. */
4186 result = Flist (noverlays, overlay_vec);
4188 xfree (overlay_vec);
4189 return result;
4192 DEFUN ("next-overlay-change", Fnext_overlay_change, Snext_overlay_change,
4193 1, 1, 0,
4194 doc: /* Return the next position after POS where an overlay starts or ends.
4195 If there are no overlay boundaries from POS to (point-max),
4196 the value is (point-max). */)
4197 (Lisp_Object pos)
4199 ptrdiff_t i, len, noverlays;
4200 ptrdiff_t endpos;
4201 Lisp_Object *overlay_vec;
4203 CHECK_NUMBER_COERCE_MARKER (pos);
4205 len = 10;
4206 overlay_vec = xmalloc (len * sizeof *overlay_vec);
4208 /* Put all the overlays we want in a vector in overlay_vec.
4209 Store the length in len.
4210 endpos gets the position where the next overlay starts. */
4211 noverlays = overlays_at (XINT (pos), 1, &overlay_vec, &len,
4212 &endpos, 0, 1);
4214 /* If any of these overlays ends before endpos,
4215 use its ending point instead. */
4216 for (i = 0; i < noverlays; i++)
4218 Lisp_Object oend;
4219 ptrdiff_t oendpos;
4221 oend = OVERLAY_END (overlay_vec[i]);
4222 oendpos = OVERLAY_POSITION (oend);
4223 if (oendpos < endpos)
4224 endpos = oendpos;
4227 xfree (overlay_vec);
4228 return make_number (endpos);
4231 DEFUN ("previous-overlay-change", Fprevious_overlay_change,
4232 Sprevious_overlay_change, 1, 1, 0,
4233 doc: /* Return the previous position before POS where an overlay starts or ends.
4234 If there are no overlay boundaries from (point-min) to POS,
4235 the value is (point-min). */)
4236 (Lisp_Object pos)
4238 ptrdiff_t prevpos;
4239 Lisp_Object *overlay_vec;
4240 ptrdiff_t len;
4242 CHECK_NUMBER_COERCE_MARKER (pos);
4244 /* At beginning of buffer, we know the answer;
4245 avoid bug subtracting 1 below. */
4246 if (XINT (pos) == BEGV)
4247 return pos;
4249 len = 10;
4250 overlay_vec = xmalloc (len * sizeof *overlay_vec);
4252 /* Put all the overlays we want in a vector in overlay_vec.
4253 Store the length in len.
4254 prevpos gets the position of the previous change. */
4255 overlays_at (XINT (pos), 1, &overlay_vec, &len,
4256 0, &prevpos, 1);
4258 xfree (overlay_vec);
4259 return make_number (prevpos);
4262 /* These functions are for debugging overlays. */
4264 DEFUN ("overlay-lists", Foverlay_lists, Soverlay_lists, 0, 0, 0,
4265 doc: /* Return a pair of lists giving all the overlays of the current buffer.
4266 The car has all the overlays before the overlay center;
4267 the cdr has all the overlays after the overlay center.
4268 Recentering overlays moves overlays between these lists.
4269 The lists you get are copies, so that changing them has no effect.
4270 However, the overlays you get are the real objects that the buffer uses. */)
4271 (void)
4273 struct Lisp_Overlay *ol;
4274 Lisp_Object before = Qnil, after = Qnil, tmp;
4276 for (ol = current_buffer->overlays_before; ol; ol = ol->next)
4278 XSETMISC (tmp, ol);
4279 before = Fcons (tmp, before);
4281 for (ol = current_buffer->overlays_after; ol; ol = ol->next)
4283 XSETMISC (tmp, ol);
4284 after = Fcons (tmp, after);
4287 return Fcons (Fnreverse (before), Fnreverse (after));
4290 DEFUN ("overlay-recenter", Foverlay_recenter, Soverlay_recenter, 1, 1, 0,
4291 doc: /* Recenter the overlays of the current buffer around position POS.
4292 That makes overlay lookup faster for positions near POS (but perhaps slower
4293 for positions far away from POS). */)
4294 (Lisp_Object pos)
4296 ptrdiff_t p;
4297 CHECK_NUMBER_COERCE_MARKER (pos);
4299 p = clip_to_bounds (PTRDIFF_MIN, XINT (pos), PTRDIFF_MAX);
4300 recenter_overlay_lists (current_buffer, p);
4301 return Qnil;
4304 DEFUN ("overlay-get", Foverlay_get, Soverlay_get, 2, 2, 0,
4305 doc: /* Get the property of overlay OVERLAY with property name PROP. */)
4306 (Lisp_Object overlay, Lisp_Object prop)
4308 CHECK_OVERLAY (overlay);
4309 return lookup_char_property (XOVERLAY (overlay)->plist, prop, 0);
4312 DEFUN ("overlay-put", Foverlay_put, Soverlay_put, 3, 3, 0,
4313 doc: /* Set one property of overlay OVERLAY: give property PROP value VALUE.
4314 VALUE will be returned.*/)
4315 (Lisp_Object overlay, Lisp_Object prop, Lisp_Object value)
4317 Lisp_Object tail, buffer;
4318 bool changed;
4320 CHECK_OVERLAY (overlay);
4322 buffer = Fmarker_buffer (OVERLAY_START (overlay));
4324 for (tail = XOVERLAY (overlay)->plist;
4325 CONSP (tail) && CONSP (XCDR (tail));
4326 tail = XCDR (XCDR (tail)))
4327 if (EQ (XCAR (tail), prop))
4329 changed = !EQ (XCAR (XCDR (tail)), value);
4330 XSETCAR (XCDR (tail), value);
4331 goto found;
4333 /* It wasn't in the list, so add it to the front. */
4334 changed = !NILP (value);
4335 set_overlay_plist
4336 (overlay, Fcons (prop, Fcons (value, XOVERLAY (overlay)->plist)));
4337 found:
4338 if (! NILP (buffer))
4340 if (changed)
4341 modify_overlay (XBUFFER (buffer),
4342 marker_position (OVERLAY_START (overlay)),
4343 marker_position (OVERLAY_END (overlay)));
4344 if (EQ (prop, Qevaporate) && ! NILP (value)
4345 && (OVERLAY_POSITION (OVERLAY_START (overlay))
4346 == OVERLAY_POSITION (OVERLAY_END (overlay))))
4347 Fdelete_overlay (overlay);
4350 return value;
4353 /* Subroutine of report_overlay_modification. */
4355 /* Lisp vector holding overlay hook functions to call.
4356 Vector elements come in pairs.
4357 Each even-index element is a list of hook functions.
4358 The following odd-index element is the overlay they came from.
4360 Before the buffer change, we fill in this vector
4361 as we call overlay hook functions.
4362 After the buffer change, we get the functions to call from this vector.
4363 This way we always call the same functions before and after the change. */
4364 static Lisp_Object last_overlay_modification_hooks;
4366 /* Number of elements actually used in last_overlay_modification_hooks. */
4367 static ptrdiff_t last_overlay_modification_hooks_used;
4369 /* Add one functionlist/overlay pair
4370 to the end of last_overlay_modification_hooks. */
4372 static void
4373 add_overlay_mod_hooklist (Lisp_Object functionlist, Lisp_Object overlay)
4375 ptrdiff_t oldsize = ASIZE (last_overlay_modification_hooks);
4377 if (oldsize - 1 <= last_overlay_modification_hooks_used)
4378 last_overlay_modification_hooks =
4379 larger_vector (last_overlay_modification_hooks, 2, -1);
4380 ASET (last_overlay_modification_hooks, last_overlay_modification_hooks_used,
4381 functionlist); last_overlay_modification_hooks_used++;
4382 ASET (last_overlay_modification_hooks, last_overlay_modification_hooks_used,
4383 overlay); last_overlay_modification_hooks_used++;
4386 /* Run the modification-hooks of overlays that include
4387 any part of the text in START to END.
4388 If this change is an insertion, also
4389 run the insert-before-hooks of overlay starting at END,
4390 and the insert-after-hooks of overlay ending at START.
4392 This is called both before and after the modification.
4393 AFTER is true when we call after the modification.
4395 ARG1, ARG2, ARG3 are arguments to pass to the hook functions.
4396 When AFTER is nonzero, they are the start position,
4397 the position after the inserted new text,
4398 and the length of deleted or replaced old text. */
4400 void
4401 report_overlay_modification (Lisp_Object start, Lisp_Object end, bool after,
4402 Lisp_Object arg1, Lisp_Object arg2, Lisp_Object arg3)
4404 Lisp_Object prop, overlay;
4405 struct Lisp_Overlay *tail;
4406 /* True if this change is an insertion. */
4407 bool insertion = (after ? XFASTINT (arg3) == 0 : EQ (start, end));
4408 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
4410 overlay = Qnil;
4411 tail = NULL;
4413 /* We used to run the functions as soon as we found them and only register
4414 them in last_overlay_modification_hooks for the purpose of the `after'
4415 case. But running elisp code as we traverse the list of overlays is
4416 painful because the list can be modified by the elisp code so we had to
4417 copy at several places. We now simply do a read-only traversal that
4418 only collects the functions to run and we run them afterwards. It's
4419 simpler, especially since all the code was already there. -stef */
4421 if (!after)
4423 /* We are being called before a change.
4424 Scan the overlays to find the functions to call. */
4425 last_overlay_modification_hooks_used = 0;
4426 for (tail = current_buffer->overlays_before; tail; tail = tail->next)
4428 ptrdiff_t startpos, endpos;
4429 Lisp_Object ostart, oend;
4431 XSETMISC (overlay, tail);
4433 ostart = OVERLAY_START (overlay);
4434 oend = OVERLAY_END (overlay);
4435 endpos = OVERLAY_POSITION (oend);
4436 if (XFASTINT (start) > endpos)
4437 break;
4438 startpos = OVERLAY_POSITION (ostart);
4439 if (insertion && (XFASTINT (start) == startpos
4440 || XFASTINT (end) == startpos))
4442 prop = Foverlay_get (overlay, Qinsert_in_front_hooks);
4443 if (!NILP (prop))
4444 add_overlay_mod_hooklist (prop, overlay);
4446 if (insertion && (XFASTINT (start) == endpos
4447 || XFASTINT (end) == endpos))
4449 prop = Foverlay_get (overlay, Qinsert_behind_hooks);
4450 if (!NILP (prop))
4451 add_overlay_mod_hooklist (prop, overlay);
4453 /* Test for intersecting intervals. This does the right thing
4454 for both insertion and deletion. */
4455 if (XFASTINT (end) > startpos && XFASTINT (start) < endpos)
4457 prop = Foverlay_get (overlay, Qmodification_hooks);
4458 if (!NILP (prop))
4459 add_overlay_mod_hooklist (prop, overlay);
4463 for (tail = current_buffer->overlays_after; tail; tail = tail->next)
4465 ptrdiff_t startpos, endpos;
4466 Lisp_Object ostart, oend;
4468 XSETMISC (overlay, tail);
4470 ostart = OVERLAY_START (overlay);
4471 oend = OVERLAY_END (overlay);
4472 startpos = OVERLAY_POSITION (ostart);
4473 endpos = OVERLAY_POSITION (oend);
4474 if (XFASTINT (end) < startpos)
4475 break;
4476 if (insertion && (XFASTINT (start) == startpos
4477 || XFASTINT (end) == startpos))
4479 prop = Foverlay_get (overlay, Qinsert_in_front_hooks);
4480 if (!NILP (prop))
4481 add_overlay_mod_hooklist (prop, overlay);
4483 if (insertion && (XFASTINT (start) == endpos
4484 || XFASTINT (end) == endpos))
4486 prop = Foverlay_get (overlay, Qinsert_behind_hooks);
4487 if (!NILP (prop))
4488 add_overlay_mod_hooklist (prop, overlay);
4490 /* Test for intersecting intervals. This does the right thing
4491 for both insertion and deletion. */
4492 if (XFASTINT (end) > startpos && XFASTINT (start) < endpos)
4494 prop = Foverlay_get (overlay, Qmodification_hooks);
4495 if (!NILP (prop))
4496 add_overlay_mod_hooklist (prop, overlay);
4501 GCPRO4 (overlay, arg1, arg2, arg3);
4503 /* Call the functions recorded in last_overlay_modification_hooks.
4504 First copy the vector contents, in case some of these hooks
4505 do subsequent modification of the buffer. */
4506 ptrdiff_t size = last_overlay_modification_hooks_used;
4507 Lisp_Object *copy = alloca (size * sizeof *copy);
4508 ptrdiff_t i;
4510 memcpy (copy, XVECTOR (last_overlay_modification_hooks)->contents,
4511 size * word_size);
4512 gcpro1.var = copy;
4513 gcpro1.nvars = size;
4515 for (i = 0; i < size;)
4517 Lisp_Object prop_i, overlay_i;
4518 prop_i = copy[i++];
4519 overlay_i = copy[i++];
4520 call_overlay_mod_hooks (prop_i, overlay_i, after, arg1, arg2, arg3);
4523 UNGCPRO;
4526 static void
4527 call_overlay_mod_hooks (Lisp_Object list, Lisp_Object overlay, bool after,
4528 Lisp_Object arg1, Lisp_Object arg2, Lisp_Object arg3)
4530 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
4532 GCPRO4 (list, arg1, arg2, arg3);
4534 while (CONSP (list))
4536 if (NILP (arg3))
4537 call4 (XCAR (list), overlay, after ? Qt : Qnil, arg1, arg2);
4538 else
4539 call5 (XCAR (list), overlay, after ? Qt : Qnil, arg1, arg2, arg3);
4540 list = XCDR (list);
4542 UNGCPRO;
4545 /* Delete any zero-sized overlays at position POS, if the `evaporate'
4546 property is set. */
4547 void
4548 evaporate_overlays (ptrdiff_t pos)
4550 Lisp_Object overlay, hit_list;
4551 struct Lisp_Overlay *tail;
4553 hit_list = Qnil;
4554 if (pos <= current_buffer->overlay_center)
4555 for (tail = current_buffer->overlays_before; tail; tail = tail->next)
4557 ptrdiff_t endpos;
4558 XSETMISC (overlay, tail);
4559 endpos = OVERLAY_POSITION (OVERLAY_END (overlay));
4560 if (endpos < pos)
4561 break;
4562 if (endpos == pos && OVERLAY_POSITION (OVERLAY_START (overlay)) == pos
4563 && ! NILP (Foverlay_get (overlay, Qevaporate)))
4564 hit_list = Fcons (overlay, hit_list);
4566 else
4567 for (tail = current_buffer->overlays_after; tail; tail = tail->next)
4569 ptrdiff_t startpos;
4570 XSETMISC (overlay, tail);
4571 startpos = OVERLAY_POSITION (OVERLAY_START (overlay));
4572 if (startpos > pos)
4573 break;
4574 if (startpos == pos && OVERLAY_POSITION (OVERLAY_END (overlay)) == pos
4575 && ! NILP (Foverlay_get (overlay, Qevaporate)))
4576 hit_list = Fcons (overlay, hit_list);
4578 for (; CONSP (hit_list); hit_list = XCDR (hit_list))
4579 Fdelete_overlay (XCAR (hit_list));
4582 /***********************************************************************
4583 Allocation with mmap
4584 ***********************************************************************/
4586 #ifdef USE_MMAP_FOR_BUFFERS
4588 #include <sys/types.h>
4589 #include <sys/mman.h>
4591 #ifndef MAP_ANON
4592 #ifdef MAP_ANONYMOUS
4593 #define MAP_ANON MAP_ANONYMOUS
4594 #else
4595 #define MAP_ANON 0
4596 #endif
4597 #endif
4599 #ifndef MAP_FAILED
4600 #define MAP_FAILED ((void *) -1)
4601 #endif
4603 #include <stdio.h>
4605 #if MAP_ANON == 0
4606 #include <fcntl.h>
4607 #endif
4609 #include "coding.h"
4612 /* Memory is allocated in regions which are mapped using mmap(2).
4613 The current implementation lets the system select mapped
4614 addresses; we're not using MAP_FIXED in general, except when
4615 trying to enlarge regions.
4617 Each mapped region starts with a mmap_region structure, the user
4618 area starts after that structure, aligned to MEM_ALIGN.
4620 +-----------------------+
4621 | struct mmap_info + |
4622 | padding |
4623 +-----------------------+
4624 | user data |
4627 +-----------------------+ */
4629 struct mmap_region
4631 /* User-specified size. */
4632 size_t nbytes_specified;
4634 /* Number of bytes mapped */
4635 size_t nbytes_mapped;
4637 /* Pointer to the location holding the address of the memory
4638 allocated with the mmap'd block. The variable actually points
4639 after this structure. */
4640 void **var;
4642 /* Next and previous in list of all mmap'd regions. */
4643 struct mmap_region *next, *prev;
4646 /* Doubly-linked list of mmap'd regions. */
4648 static struct mmap_region *mmap_regions;
4650 /* File descriptor for mmap. If we don't have anonymous mapping,
4651 /dev/zero will be opened on it. */
4653 static int mmap_fd;
4655 /* Temporary storage for mmap_set_vars, see there. */
4657 static struct mmap_region *mmap_regions_1;
4658 static int mmap_fd_1;
4660 /* Page size on this system. */
4662 static int mmap_page_size;
4664 /* 1 means mmap has been initialized. */
4666 static bool mmap_initialized_p;
4668 /* Value is X rounded up to the next multiple of N. */
4670 #define ROUND(X, N) (((X) + (N) - 1) / (N) * (N))
4672 /* Size of mmap_region structure plus padding. */
4674 #define MMAP_REGION_STRUCT_SIZE \
4675 ROUND (sizeof (struct mmap_region), MEM_ALIGN)
4677 /* Given a pointer P to the start of the user-visible part of a mapped
4678 region, return a pointer to the start of the region. */
4680 #define MMAP_REGION(P) \
4681 ((struct mmap_region *) ((char *) (P) - MMAP_REGION_STRUCT_SIZE))
4683 /* Given a pointer P to the start of a mapped region, return a pointer
4684 to the start of the user-visible part of the region. */
4686 #define MMAP_USER_AREA(P) \
4687 ((void *) ((char *) (P) + MMAP_REGION_STRUCT_SIZE))
4689 #define MEM_ALIGN sizeof (double)
4691 /* Predicate returning true if part of the address range [START .. END]
4692 is currently mapped. Used to prevent overwriting an existing
4693 memory mapping.
4695 Default is to conservatively assume the address range is occupied by
4696 something else. This can be overridden by system configuration
4697 files if system-specific means to determine this exists. */
4699 #ifndef MMAP_ALLOCATED_P
4700 #define MMAP_ALLOCATED_P(start, end) 1
4701 #endif
4703 /* Perform necessary initializations for the use of mmap. */
4705 static void
4706 mmap_init (void)
4708 #if MAP_ANON == 0
4709 /* The value of mmap_fd is initially 0 in temacs, and -1
4710 in a dumped Emacs. */
4711 if (mmap_fd <= 0)
4713 /* No anonymous mmap -- we need the file descriptor. */
4714 mmap_fd = open ("/dev/zero", O_RDONLY);
4715 if (mmap_fd == -1)
4716 fatal ("Cannot open /dev/zero: %s", emacs_strerror (errno));
4718 #endif /* MAP_ANON == 0 */
4720 if (mmap_initialized_p)
4721 return;
4722 mmap_initialized_p = 1;
4724 #if MAP_ANON != 0
4725 mmap_fd = -1;
4726 #endif
4728 mmap_page_size = getpagesize ();
4731 /* Return a region overlapping address range START...END, or null if
4732 none. END is not including, i.e. the last byte in the range
4733 is at END - 1. */
4735 static struct mmap_region *
4736 mmap_find (void *start, void *end)
4738 struct mmap_region *r;
4739 char *s = (char *) start, *e = (char *) end;
4741 for (r = mmap_regions; r; r = r->next)
4743 char *rstart = (char *) r;
4744 char *rend = rstart + r->nbytes_mapped;
4746 if (/* First byte of range, i.e. START, in this region? */
4747 (s >= rstart && s < rend)
4748 /* Last byte of range, i.e. END - 1, in this region? */
4749 || (e > rstart && e <= rend)
4750 /* First byte of this region in the range? */
4751 || (rstart >= s && rstart < e)
4752 /* Last byte of this region in the range? */
4753 || (rend > s && rend <= e))
4754 break;
4757 return r;
4761 /* Unmap a region. P is a pointer to the start of the user-araa of
4762 the region. */
4764 static void
4765 mmap_free_1 (struct mmap_region *r)
4767 if (r->next)
4768 r->next->prev = r->prev;
4769 if (r->prev)
4770 r->prev->next = r->next;
4771 else
4772 mmap_regions = r->next;
4774 if (munmap (r, r->nbytes_mapped) == -1)
4775 fprintf (stderr, "munmap: %s\n", emacs_strerror (errno));
4779 /* Enlarge region R by NPAGES pages. NPAGES < 0 means shrink R.
4780 Value is true if successful. */
4782 static bool
4783 mmap_enlarge (struct mmap_region *r, int npages)
4785 char *region_end = (char *) r + r->nbytes_mapped;
4786 size_t nbytes;
4787 bool success = 0;
4789 if (npages < 0)
4791 /* Unmap pages at the end of the region. */
4792 nbytes = - npages * mmap_page_size;
4793 if (munmap (region_end - nbytes, nbytes) == -1)
4794 fprintf (stderr, "munmap: %s\n", emacs_strerror (errno));
4795 else
4797 r->nbytes_mapped -= nbytes;
4798 success = 1;
4801 else if (npages > 0)
4803 nbytes = npages * mmap_page_size;
4805 /* Try to map additional pages at the end of the region. We
4806 cannot do this if the address range is already occupied by
4807 something else because mmap deletes any previous mapping.
4808 I'm not sure this is worth doing, let's see. */
4809 if (!MMAP_ALLOCATED_P (region_end, region_end + nbytes))
4811 void *p;
4813 p = mmap (region_end, nbytes, PROT_READ | PROT_WRITE,
4814 MAP_ANON | MAP_PRIVATE | MAP_FIXED, mmap_fd, 0);
4815 if (p == MAP_FAILED)
4816 ; /* fprintf (stderr, "mmap: %s\n", emacs_strerror (errno)); */
4817 else if (p != region_end)
4819 /* Kernels are free to choose a different address. In
4820 that case, unmap what we've mapped above; we have
4821 no use for it. */
4822 if (munmap (p, nbytes) == -1)
4823 fprintf (stderr, "munmap: %s\n", emacs_strerror (errno));
4825 else
4827 r->nbytes_mapped += nbytes;
4828 success = 1;
4833 return success;
4837 /* Set or reset variables holding references to mapped regions.
4838 If not RESTORE_P, set all variables to null. If RESTORE_P, set all
4839 variables to the start of the user-areas of mapped regions.
4841 This function is called from Fdump_emacs to ensure that the dumped
4842 Emacs doesn't contain references to memory that won't be mapped
4843 when Emacs starts. */
4845 void
4846 mmap_set_vars (bool restore_p)
4848 struct mmap_region *r;
4850 if (restore_p)
4852 mmap_regions = mmap_regions_1;
4853 mmap_fd = mmap_fd_1;
4854 for (r = mmap_regions; r; r = r->next)
4855 *r->var = MMAP_USER_AREA (r);
4857 else
4859 for (r = mmap_regions; r; r = r->next)
4860 *r->var = NULL;
4861 mmap_regions_1 = mmap_regions;
4862 mmap_regions = NULL;
4863 mmap_fd_1 = mmap_fd;
4864 mmap_fd = -1;
4869 /* Allocate a block of storage large enough to hold NBYTES bytes of
4870 data. A pointer to the data is returned in *VAR. VAR is thus the
4871 address of some variable which will use the data area.
4873 The allocation of 0 bytes is valid.
4875 If we can't allocate the necessary memory, set *VAR to null, and
4876 return null. */
4878 static void *
4879 mmap_alloc (void **var, size_t nbytes)
4881 void *p;
4882 size_t map;
4884 mmap_init ();
4886 map = ROUND (nbytes + MMAP_REGION_STRUCT_SIZE, mmap_page_size);
4887 p = mmap (NULL, map, PROT_READ | PROT_WRITE, MAP_ANON | MAP_PRIVATE,
4888 mmap_fd, 0);
4890 if (p == MAP_FAILED)
4892 if (errno != ENOMEM)
4893 fprintf (stderr, "mmap: %s\n", emacs_strerror (errno));
4894 p = NULL;
4896 else
4898 struct mmap_region *r = (struct mmap_region *) p;
4900 r->nbytes_specified = nbytes;
4901 r->nbytes_mapped = map;
4902 r->var = var;
4903 r->prev = NULL;
4904 r->next = mmap_regions;
4905 if (r->next)
4906 r->next->prev = r;
4907 mmap_regions = r;
4909 p = MMAP_USER_AREA (p);
4912 return *var = p;
4916 /* Free a block of relocatable storage whose data is pointed to by
4917 PTR. Store 0 in *PTR to show there's no block allocated. */
4919 static void
4920 mmap_free (void **var)
4922 mmap_init ();
4924 if (*var)
4926 mmap_free_1 (MMAP_REGION (*var));
4927 *var = NULL;
4932 /* Given a pointer at address VAR to data allocated with mmap_alloc,
4933 resize it to size NBYTES. Change *VAR to reflect the new block,
4934 and return this value. If more memory cannot be allocated, then
4935 leave *VAR unchanged, and return null. */
4937 static void *
4938 mmap_realloc (void **var, size_t nbytes)
4940 void *result;
4942 mmap_init ();
4944 if (*var == NULL)
4945 result = mmap_alloc (var, nbytes);
4946 else if (nbytes == 0)
4948 mmap_free (var);
4949 result = mmap_alloc (var, nbytes);
4951 else
4953 struct mmap_region *r = MMAP_REGION (*var);
4954 size_t room = r->nbytes_mapped - MMAP_REGION_STRUCT_SIZE;
4956 if (room < nbytes)
4958 /* Must enlarge. */
4959 void *old_ptr = *var;
4961 /* Try to map additional pages at the end of the region.
4962 If that fails, allocate a new region, copy data
4963 from the old region, then free it. */
4964 if (mmap_enlarge (r, (ROUND (nbytes - room, mmap_page_size)
4965 / mmap_page_size)))
4967 r->nbytes_specified = nbytes;
4968 *var = result = old_ptr;
4970 else if (mmap_alloc (var, nbytes))
4972 memcpy (*var, old_ptr, r->nbytes_specified);
4973 mmap_free_1 (MMAP_REGION (old_ptr));
4974 result = *var;
4975 r = MMAP_REGION (result);
4976 r->nbytes_specified = nbytes;
4978 else
4980 *var = old_ptr;
4981 result = NULL;
4984 else if (room - nbytes >= mmap_page_size)
4986 /* Shrinking by at least a page. Let's give some
4987 memory back to the system.
4989 The extra parens are to make the division happens first,
4990 on positive values, so we know it will round towards
4991 zero. */
4992 mmap_enlarge (r, - ((room - nbytes) / mmap_page_size));
4993 result = *var;
4994 r->nbytes_specified = nbytes;
4996 else
4998 /* Leave it alone. */
4999 result = *var;
5000 r->nbytes_specified = nbytes;
5004 return result;
5008 #endif /* USE_MMAP_FOR_BUFFERS */
5012 /***********************************************************************
5013 Buffer-text Allocation
5014 ***********************************************************************/
5016 /* Allocate NBYTES bytes for buffer B's text buffer. */
5018 static void
5019 alloc_buffer_text (struct buffer *b, ptrdiff_t nbytes)
5021 void *p;
5023 block_input ();
5024 #if defined USE_MMAP_FOR_BUFFERS
5025 p = mmap_alloc ((void **) &b->text->beg, nbytes);
5026 #elif defined REL_ALLOC
5027 p = r_alloc ((void **) &b->text->beg, nbytes);
5028 #else
5029 p = xmalloc (nbytes);
5030 #endif
5032 if (p == NULL)
5034 unblock_input ();
5035 memory_full (nbytes);
5038 b->text->beg = (unsigned char *) p;
5039 unblock_input ();
5042 /* Enlarge buffer B's text buffer by DELTA bytes. DELTA < 0 means
5043 shrink it. */
5045 void
5046 enlarge_buffer_text (struct buffer *b, ptrdiff_t delta)
5048 void *p;
5049 ptrdiff_t nbytes = (BUF_Z_BYTE (b) - BUF_BEG_BYTE (b) + BUF_GAP_SIZE (b) + 1
5050 + delta);
5051 block_input ();
5052 #if defined USE_MMAP_FOR_BUFFERS
5053 p = mmap_realloc ((void **) &b->text->beg, nbytes);
5054 #elif defined REL_ALLOC
5055 p = r_re_alloc ((void **) &b->text->beg, nbytes);
5056 #else
5057 p = xrealloc (b->text->beg, nbytes);
5058 #endif
5060 if (p == NULL)
5062 unblock_input ();
5063 memory_full (nbytes);
5066 BUF_BEG_ADDR (b) = (unsigned char *) p;
5067 unblock_input ();
5071 /* Free buffer B's text buffer. */
5073 static void
5074 free_buffer_text (struct buffer *b)
5076 block_input ();
5078 #if defined USE_MMAP_FOR_BUFFERS
5079 mmap_free ((void **) &b->text->beg);
5080 #elif defined REL_ALLOC
5081 r_alloc_free ((void **) &b->text->beg);
5082 #else
5083 xfree (b->text->beg);
5084 #endif
5086 BUF_BEG_ADDR (b) = NULL;
5087 unblock_input ();
5092 /***********************************************************************
5093 Initialization
5094 ***********************************************************************/
5096 void
5097 init_buffer_once (void)
5099 int idx;
5101 memset (buffer_permanent_local_flags, 0, sizeof buffer_permanent_local_flags);
5103 /* Make sure all markable slots in buffer_defaults
5104 are initialized reasonably, so mark_buffer won't choke. */
5105 reset_buffer (&buffer_defaults);
5106 eassert (EQ (BVAR (&buffer_defaults, name), make_number (0)));
5107 reset_buffer_local_variables (&buffer_defaults, 1);
5108 eassert (EQ (BVAR (&buffer_local_symbols, name), make_number (0)));
5109 reset_buffer (&buffer_local_symbols);
5110 reset_buffer_local_variables (&buffer_local_symbols, 1);
5111 /* Prevent GC from getting confused. */
5112 buffer_defaults.text = &buffer_defaults.own_text;
5113 buffer_local_symbols.text = &buffer_local_symbols.own_text;
5114 /* No one will share the text with these buffers, but let's play it safe. */
5115 buffer_defaults.indirections = 0;
5116 buffer_local_symbols.indirections = 0;
5117 /* Likewise no one will display them. */
5118 buffer_defaults.window_count = 0;
5119 buffer_local_symbols.window_count = 0;
5120 set_buffer_intervals (&buffer_defaults, NULL);
5121 set_buffer_intervals (&buffer_local_symbols, NULL);
5122 /* This is not strictly necessary, but let's make them initialized. */
5123 bset_name (&buffer_defaults, build_pure_c_string (" *buffer-defaults*"));
5124 bset_name (&buffer_local_symbols, build_pure_c_string (" *buffer-local-symbols*"));
5125 BUFFER_PVEC_INIT (&buffer_defaults);
5126 BUFFER_PVEC_INIT (&buffer_local_symbols);
5128 /* Set up the default values of various buffer slots. */
5129 /* Must do these before making the first buffer! */
5131 /* real setup is done in bindings.el */
5132 bset_mode_line_format (&buffer_defaults, build_pure_c_string ("%-"));
5133 bset_header_line_format (&buffer_defaults, Qnil);
5134 bset_abbrev_mode (&buffer_defaults, Qnil);
5135 bset_overwrite_mode (&buffer_defaults, Qnil);
5136 bset_case_fold_search (&buffer_defaults, Qt);
5137 bset_auto_fill_function (&buffer_defaults, Qnil);
5138 bset_selective_display (&buffer_defaults, Qnil);
5139 bset_selective_display_ellipses (&buffer_defaults, Qt);
5140 bset_abbrev_table (&buffer_defaults, Qnil);
5141 bset_display_table (&buffer_defaults, Qnil);
5142 bset_undo_list (&buffer_defaults, Qnil);
5143 bset_mark_active (&buffer_defaults, Qnil);
5144 bset_file_format (&buffer_defaults, Qnil);
5145 bset_auto_save_file_format (&buffer_defaults, Qt);
5146 set_buffer_overlays_before (&buffer_defaults, NULL);
5147 set_buffer_overlays_after (&buffer_defaults, NULL);
5148 buffer_defaults.overlay_center = BEG;
5150 XSETFASTINT (BVAR (&buffer_defaults, tab_width), 8);
5151 bset_truncate_lines (&buffer_defaults, Qnil);
5152 bset_word_wrap (&buffer_defaults, Qnil);
5153 bset_ctl_arrow (&buffer_defaults, Qt);
5154 bset_bidi_display_reordering (&buffer_defaults, Qt);
5155 bset_bidi_paragraph_direction (&buffer_defaults, Qnil);
5156 bset_cursor_type (&buffer_defaults, Qt);
5157 bset_extra_line_spacing (&buffer_defaults, Qnil);
5158 bset_cursor_in_non_selected_windows (&buffer_defaults, Qt);
5160 bset_enable_multibyte_characters (&buffer_defaults, Qt);
5161 bset_buffer_file_coding_system (&buffer_defaults, Qnil);
5162 XSETFASTINT (BVAR (&buffer_defaults, fill_column), 70);
5163 XSETFASTINT (BVAR (&buffer_defaults, left_margin), 0);
5164 bset_cache_long_line_scans (&buffer_defaults, Qnil);
5165 bset_file_truename (&buffer_defaults, Qnil);
5166 XSETFASTINT (BVAR (&buffer_defaults, display_count), 0);
5167 XSETFASTINT (BVAR (&buffer_defaults, left_margin_cols), 0);
5168 XSETFASTINT (BVAR (&buffer_defaults, right_margin_cols), 0);
5169 bset_left_fringe_width (&buffer_defaults, Qnil);
5170 bset_right_fringe_width (&buffer_defaults, Qnil);
5171 bset_fringes_outside_margins (&buffer_defaults, Qnil);
5172 bset_scroll_bar_width (&buffer_defaults, Qnil);
5173 bset_vertical_scroll_bar_type (&buffer_defaults, Qt);
5174 bset_indicate_empty_lines (&buffer_defaults, Qnil);
5175 bset_indicate_buffer_boundaries (&buffer_defaults, Qnil);
5176 bset_fringe_indicator_alist (&buffer_defaults, Qnil);
5177 bset_fringe_cursor_alist (&buffer_defaults, Qnil);
5178 bset_scroll_up_aggressively (&buffer_defaults, Qnil);
5179 bset_scroll_down_aggressively (&buffer_defaults, Qnil);
5180 bset_display_time (&buffer_defaults, Qnil);
5182 /* Assign the local-flags to the slots that have default values.
5183 The local flag is a bit that is used in the buffer
5184 to say that it has its own local value for the slot.
5185 The local flag bits are in the local_var_flags slot of the buffer. */
5187 /* Nothing can work if this isn't true */
5188 { verify (sizeof (EMACS_INT) == word_size); }
5190 /* 0 means not a lisp var, -1 means always local, else mask */
5191 memset (&buffer_local_flags, 0, sizeof buffer_local_flags);
5192 bset_filename (&buffer_local_flags, make_number (-1));
5193 bset_directory (&buffer_local_flags, make_number (-1));
5194 bset_backed_up (&buffer_local_flags, make_number (-1));
5195 bset_save_length (&buffer_local_flags, make_number (-1));
5196 bset_auto_save_file_name (&buffer_local_flags, make_number (-1));
5197 bset_read_only (&buffer_local_flags, make_number (-1));
5198 bset_major_mode (&buffer_local_flags, make_number (-1));
5199 bset_mode_name (&buffer_local_flags, make_number (-1));
5200 bset_undo_list (&buffer_local_flags, make_number (-1));
5201 bset_mark_active (&buffer_local_flags, make_number (-1));
5202 bset_point_before_scroll (&buffer_local_flags, make_number (-1));
5203 bset_file_truename (&buffer_local_flags, make_number (-1));
5204 bset_invisibility_spec (&buffer_local_flags, make_number (-1));
5205 bset_file_format (&buffer_local_flags, make_number (-1));
5206 bset_auto_save_file_format (&buffer_local_flags, make_number (-1));
5207 bset_display_count (&buffer_local_flags, make_number (-1));
5208 bset_display_time (&buffer_local_flags, make_number (-1));
5209 bset_enable_multibyte_characters (&buffer_local_flags, make_number (-1));
5211 idx = 1;
5212 XSETFASTINT (BVAR (&buffer_local_flags, mode_line_format), idx); ++idx;
5213 XSETFASTINT (BVAR (&buffer_local_flags, abbrev_mode), idx); ++idx;
5214 XSETFASTINT (BVAR (&buffer_local_flags, overwrite_mode), idx); ++idx;
5215 XSETFASTINT (BVAR (&buffer_local_flags, case_fold_search), idx); ++idx;
5216 XSETFASTINT (BVAR (&buffer_local_flags, auto_fill_function), idx); ++idx;
5217 XSETFASTINT (BVAR (&buffer_local_flags, selective_display), idx); ++idx;
5218 XSETFASTINT (BVAR (&buffer_local_flags, selective_display_ellipses), idx); ++idx;
5219 XSETFASTINT (BVAR (&buffer_local_flags, tab_width), idx); ++idx;
5220 XSETFASTINT (BVAR (&buffer_local_flags, truncate_lines), idx); ++idx;
5221 XSETFASTINT (BVAR (&buffer_local_flags, word_wrap), idx); ++idx;
5222 XSETFASTINT (BVAR (&buffer_local_flags, ctl_arrow), idx); ++idx;
5223 XSETFASTINT (BVAR (&buffer_local_flags, fill_column), idx); ++idx;
5224 XSETFASTINT (BVAR (&buffer_local_flags, left_margin), idx); ++idx;
5225 XSETFASTINT (BVAR (&buffer_local_flags, abbrev_table), idx); ++idx;
5226 XSETFASTINT (BVAR (&buffer_local_flags, display_table), idx); ++idx;
5227 XSETFASTINT (BVAR (&buffer_local_flags, syntax_table), idx); ++idx;
5228 XSETFASTINT (BVAR (&buffer_local_flags, cache_long_line_scans), idx); ++idx;
5229 XSETFASTINT (BVAR (&buffer_local_flags, category_table), idx); ++idx;
5230 XSETFASTINT (BVAR (&buffer_local_flags, bidi_display_reordering), idx); ++idx;
5231 XSETFASTINT (BVAR (&buffer_local_flags, bidi_paragraph_direction), idx); ++idx;
5232 XSETFASTINT (BVAR (&buffer_local_flags, buffer_file_coding_system), idx);
5233 /* Make this one a permanent local. */
5234 buffer_permanent_local_flags[idx++] = 1;
5235 XSETFASTINT (BVAR (&buffer_local_flags, left_margin_cols), idx); ++idx;
5236 XSETFASTINT (BVAR (&buffer_local_flags, right_margin_cols), idx); ++idx;
5237 XSETFASTINT (BVAR (&buffer_local_flags, left_fringe_width), idx); ++idx;
5238 XSETFASTINT (BVAR (&buffer_local_flags, right_fringe_width), idx); ++idx;
5239 XSETFASTINT (BVAR (&buffer_local_flags, fringes_outside_margins), idx); ++idx;
5240 XSETFASTINT (BVAR (&buffer_local_flags, scroll_bar_width), idx); ++idx;
5241 XSETFASTINT (BVAR (&buffer_local_flags, vertical_scroll_bar_type), idx); ++idx;
5242 XSETFASTINT (BVAR (&buffer_local_flags, indicate_empty_lines), idx); ++idx;
5243 XSETFASTINT (BVAR (&buffer_local_flags, indicate_buffer_boundaries), idx); ++idx;
5244 XSETFASTINT (BVAR (&buffer_local_flags, fringe_indicator_alist), idx); ++idx;
5245 XSETFASTINT (BVAR (&buffer_local_flags, fringe_cursor_alist), idx); ++idx;
5246 XSETFASTINT (BVAR (&buffer_local_flags, scroll_up_aggressively), idx); ++idx;
5247 XSETFASTINT (BVAR (&buffer_local_flags, scroll_down_aggressively), idx); ++idx;
5248 XSETFASTINT (BVAR (&buffer_local_flags, header_line_format), idx); ++idx;
5249 XSETFASTINT (BVAR (&buffer_local_flags, cursor_type), idx); ++idx;
5250 XSETFASTINT (BVAR (&buffer_local_flags, extra_line_spacing), idx); ++idx;
5251 XSETFASTINT (BVAR (&buffer_local_flags, cursor_in_non_selected_windows), idx); ++idx;
5253 /* Need more room? */
5254 if (idx >= MAX_PER_BUFFER_VARS)
5255 emacs_abort ();
5256 last_per_buffer_idx = idx;
5258 Vbuffer_alist = Qnil;
5259 current_buffer = 0;
5260 all_buffers = 0;
5262 QSFundamental = build_pure_c_string ("Fundamental");
5264 Qfundamental_mode = intern_c_string ("fundamental-mode");
5265 bset_major_mode (&buffer_defaults, Qfundamental_mode);
5267 Qmode_class = intern_c_string ("mode-class");
5269 Qprotected_field = intern_c_string ("protected-field");
5271 Qpermanent_local = intern_c_string ("permanent-local");
5273 Qkill_buffer_hook = intern_c_string ("kill-buffer-hook");
5274 Fput (Qkill_buffer_hook, Qpermanent_local, Qt);
5276 /* super-magic invisible buffer */
5277 Vprin1_to_string_buffer = Fget_buffer_create (build_pure_c_string (" prin1"));
5278 Vbuffer_alist = Qnil;
5280 Fset_buffer (Fget_buffer_create (build_pure_c_string ("*scratch*")));
5282 inhibit_modification_hooks = 0;
5285 void
5286 init_buffer (void)
5288 char *pwd;
5289 Lisp_Object temp;
5290 ptrdiff_t len;
5292 #ifdef USE_MMAP_FOR_BUFFERS
5294 /* When using the ralloc implementation based on mmap(2), buffer
5295 text pointers will have been set to null in the dumped Emacs.
5296 Map new memory. */
5297 struct buffer *b;
5299 FOR_EACH_BUFFER (b)
5300 if (b->text->beg == NULL)
5301 enlarge_buffer_text (b, 0);
5303 #endif /* USE_MMAP_FOR_BUFFERS */
5305 Fset_buffer (Fget_buffer_create (build_string ("*scratch*")));
5306 if (NILP (BVAR (&buffer_defaults, enable_multibyte_characters)))
5307 Fset_buffer_multibyte (Qnil);
5309 pwd = get_current_dir_name ();
5311 if (!pwd)
5312 fatal ("`get_current_dir_name' failed: %s\n", strerror (errno));
5314 /* Maybe this should really use some standard subroutine
5315 whose definition is filename syntax dependent. */
5316 len = strlen (pwd);
5317 if (!(IS_DIRECTORY_SEP (pwd[len - 1])))
5319 /* Grow buffer to add directory separator and '\0'. */
5320 pwd = realloc (pwd, len + 2);
5321 if (!pwd)
5322 fatal ("`get_current_dir_name' failed: %s\n", strerror (errno));
5323 pwd[len] = DIRECTORY_SEP;
5324 pwd[len + 1] = '\0';
5325 len++;
5328 bset_directory (current_buffer, make_unibyte_string (pwd, len));
5329 if (! NILP (BVAR (&buffer_defaults, enable_multibyte_characters)))
5330 /* At this moment, we still don't know how to decode the
5331 directory name. So, we keep the bytes in multibyte form so
5332 that ENCODE_FILE correctly gets the original bytes. */
5333 bset_directory
5334 (current_buffer, string_to_multibyte (BVAR (current_buffer, directory)));
5336 /* Add /: to the front of the name
5337 if it would otherwise be treated as magic. */
5338 temp = Ffind_file_name_handler (BVAR (current_buffer, directory), Qt);
5339 if (! NILP (temp)
5340 /* If the default dir is just /, TEMP is non-nil
5341 because of the ange-ftp completion handler.
5342 However, it is not necessary to turn / into /:/.
5343 So avoid doing that. */
5344 && strcmp ("/", SSDATA (BVAR (current_buffer, directory))))
5345 bset_directory
5346 (current_buffer,
5347 concat2 (build_string ("/:"), BVAR (current_buffer, directory)));
5349 temp = get_minibuffer (0);
5350 bset_directory (XBUFFER (temp), BVAR (current_buffer, directory));
5352 free (pwd);
5355 /* Similar to defvar_lisp but define a variable whose value is the
5356 Lisp_Object stored in the current buffer. LNAME is the Lisp-level
5357 variable name. VNAME is the name of the buffer slot. PREDICATE
5358 is nil for a general Lisp variable. If PREDICATE is non-nil, then
5359 only Lisp values that satisfies the PREDICATE are allowed (except
5360 that nil is allowed too). DOC is a dummy where you write the doc
5361 string as a comment. */
5363 #define DEFVAR_PER_BUFFER(lname, vname, predicate, doc) \
5364 do { \
5365 static struct Lisp_Buffer_Objfwd bo_fwd; \
5366 defvar_per_buffer (&bo_fwd, lname, vname, predicate); \
5367 } while (0)
5369 static void
5370 defvar_per_buffer (struct Lisp_Buffer_Objfwd *bo_fwd, const char *namestring,
5371 Lisp_Object *address, Lisp_Object predicate)
5373 struct Lisp_Symbol *sym;
5374 int offset;
5376 sym = XSYMBOL (intern (namestring));
5377 offset = (char *)address - (char *)current_buffer;
5379 bo_fwd->type = Lisp_Fwd_Buffer_Obj;
5380 bo_fwd->offset = offset;
5381 bo_fwd->predicate = predicate;
5382 sym->declared_special = 1;
5383 sym->redirect = SYMBOL_FORWARDED;
5385 /* I tried to do the job without a cast, but it seems impossible.
5386 union Lisp_Fwd *fwd; &(fwd->u_buffer_objfwd) = bo_fwd; */
5387 SET_SYMBOL_FWD (sym, (union Lisp_Fwd *)bo_fwd);
5389 XSETSYMBOL (PER_BUFFER_SYMBOL (offset), sym);
5391 if (PER_BUFFER_IDX (offset) == 0)
5392 /* Did a DEFVAR_PER_BUFFER without initializing the corresponding
5393 slot of buffer_local_flags */
5394 emacs_abort ();
5398 /* initialize the buffer routines */
5399 void
5400 syms_of_buffer (void)
5402 staticpro (&last_overlay_modification_hooks);
5403 last_overlay_modification_hooks
5404 = Fmake_vector (make_number (10), Qnil);
5406 staticpro (&Qfundamental_mode);
5407 staticpro (&Qmode_class);
5408 staticpro (&QSFundamental);
5409 staticpro (&Vbuffer_alist);
5410 staticpro (&Qprotected_field);
5411 staticpro (&Qpermanent_local);
5412 staticpro (&Qkill_buffer_hook);
5414 DEFSYM (Qpermanent_local_hook, "permanent-local-hook");
5415 DEFSYM (Qoverlayp, "overlayp");
5416 DEFSYM (Qevaporate, "evaporate");
5417 DEFSYM (Qmodification_hooks, "modification-hooks");
5418 DEFSYM (Qinsert_in_front_hooks, "insert-in-front-hooks");
5419 DEFSYM (Qinsert_behind_hooks, "insert-behind-hooks");
5420 DEFSYM (Qget_file_buffer, "get-file-buffer");
5421 DEFSYM (Qpriority, "priority");
5422 DEFSYM (Qbefore_string, "before-string");
5423 DEFSYM (Qafter_string, "after-string");
5424 DEFSYM (Qfirst_change_hook, "first-change-hook");
5425 DEFSYM (Qbefore_change_functions, "before-change-functions");
5426 DEFSYM (Qafter_change_functions, "after-change-functions");
5427 DEFSYM (Qkill_buffer_query_functions, "kill-buffer-query-functions");
5429 Fput (Qprotected_field, Qerror_conditions,
5430 listn (CONSTYPE_PURE, 2, Qprotected_field, Qerror));
5431 Fput (Qprotected_field, Qerror_message,
5432 build_pure_c_string ("Attempt to modify a protected field"));
5434 DEFVAR_BUFFER_DEFAULTS ("default-mode-line-format",
5435 mode_line_format,
5436 doc: /* Default value of `mode-line-format' for buffers that don't override it.
5437 This is the same as (default-value 'mode-line-format). */);
5439 DEFVAR_BUFFER_DEFAULTS ("default-header-line-format",
5440 header_line_format,
5441 doc: /* Default value of `header-line-format' for buffers that don't override it.
5442 This is the same as (default-value 'header-line-format). */);
5444 DEFVAR_BUFFER_DEFAULTS ("default-cursor-type", cursor_type,
5445 doc: /* Default value of `cursor-type' for buffers that don't override it.
5446 This is the same as (default-value 'cursor-type). */);
5448 DEFVAR_BUFFER_DEFAULTS ("default-line-spacing",
5449 extra_line_spacing,
5450 doc: /* Default value of `line-spacing' for buffers that don't override it.
5451 This is the same as (default-value 'line-spacing). */);
5453 DEFVAR_BUFFER_DEFAULTS ("default-cursor-in-non-selected-windows",
5454 cursor_in_non_selected_windows,
5455 doc: /* Default value of `cursor-in-non-selected-windows'.
5456 This is the same as (default-value 'cursor-in-non-selected-windows). */);
5458 DEFVAR_BUFFER_DEFAULTS ("default-abbrev-mode",
5459 abbrev_mode,
5460 doc: /* Default value of `abbrev-mode' for buffers that do not override it.
5461 This is the same as (default-value 'abbrev-mode). */);
5463 DEFVAR_BUFFER_DEFAULTS ("default-ctl-arrow",
5464 ctl_arrow,
5465 doc: /* Default value of `ctl-arrow' for buffers that do not override it.
5466 This is the same as (default-value 'ctl-arrow). */);
5468 DEFVAR_BUFFER_DEFAULTS ("default-enable-multibyte-characters",
5469 enable_multibyte_characters,
5470 doc: /* Default value of `enable-multibyte-characters' for buffers not overriding it.
5471 This is the same as (default-value 'enable-multibyte-characters). */);
5473 DEFVAR_BUFFER_DEFAULTS ("default-buffer-file-coding-system",
5474 buffer_file_coding_system,
5475 doc: /* Default value of `buffer-file-coding-system' for buffers not overriding it.
5476 This is the same as (default-value 'buffer-file-coding-system). */);
5478 DEFVAR_BUFFER_DEFAULTS ("default-truncate-lines",
5479 truncate_lines,
5480 doc: /* Default value of `truncate-lines' for buffers that do not override it.
5481 This is the same as (default-value 'truncate-lines). */);
5483 DEFVAR_BUFFER_DEFAULTS ("default-fill-column",
5484 fill_column,
5485 doc: /* Default value of `fill-column' for buffers that do not override it.
5486 This is the same as (default-value 'fill-column). */);
5488 DEFVAR_BUFFER_DEFAULTS ("default-left-margin",
5489 left_margin,
5490 doc: /* Default value of `left-margin' for buffers that do not override it.
5491 This is the same as (default-value 'left-margin). */);
5493 DEFVAR_BUFFER_DEFAULTS ("default-tab-width",
5494 tab_width,
5495 doc: /* Default value of `tab-width' for buffers that do not override it.
5496 This is the same as (default-value 'tab-width). */);
5498 DEFVAR_BUFFER_DEFAULTS ("default-case-fold-search",
5499 case_fold_search,
5500 doc: /* Default value of `case-fold-search' for buffers that don't override it.
5501 This is the same as (default-value 'case-fold-search). */);
5503 DEFVAR_BUFFER_DEFAULTS ("default-left-margin-width",
5504 left_margin_cols,
5505 doc: /* Default value of `left-margin-width' for buffers that don't override it.
5506 This is the same as (default-value 'left-margin-width). */);
5508 DEFVAR_BUFFER_DEFAULTS ("default-right-margin-width",
5509 right_margin_cols,
5510 doc: /* Default value of `right-margin-width' for buffers that don't override it.
5511 This is the same as (default-value 'right-margin-width). */);
5513 DEFVAR_BUFFER_DEFAULTS ("default-left-fringe-width",
5514 left_fringe_width,
5515 doc: /* Default value of `left-fringe-width' for buffers that don't override it.
5516 This is the same as (default-value 'left-fringe-width). */);
5518 DEFVAR_BUFFER_DEFAULTS ("default-right-fringe-width",
5519 right_fringe_width,
5520 doc: /* Default value of `right-fringe-width' for buffers that don't override it.
5521 This is the same as (default-value 'right-fringe-width). */);
5523 DEFVAR_BUFFER_DEFAULTS ("default-fringes-outside-margins",
5524 fringes_outside_margins,
5525 doc: /* Default value of `fringes-outside-margins' for buffers that don't override it.
5526 This is the same as (default-value 'fringes-outside-margins). */);
5528 DEFVAR_BUFFER_DEFAULTS ("default-scroll-bar-width",
5529 scroll_bar_width,
5530 doc: /* Default value of `scroll-bar-width' for buffers that don't override it.
5531 This is the same as (default-value 'scroll-bar-width). */);
5533 DEFVAR_BUFFER_DEFAULTS ("default-vertical-scroll-bar",
5534 vertical_scroll_bar_type,
5535 doc: /* Default value of `vertical-scroll-bar' for buffers that don't override it.
5536 This is the same as (default-value 'vertical-scroll-bar). */);
5538 DEFVAR_BUFFER_DEFAULTS ("default-indicate-empty-lines",
5539 indicate_empty_lines,
5540 doc: /* Default value of `indicate-empty-lines' for buffers that don't override it.
5541 This is the same as (default-value 'indicate-empty-lines). */);
5543 DEFVAR_BUFFER_DEFAULTS ("default-indicate-buffer-boundaries",
5544 indicate_buffer_boundaries,
5545 doc: /* Default value of `indicate-buffer-boundaries' for buffers that don't override it.
5546 This is the same as (default-value 'indicate-buffer-boundaries). */);
5548 DEFVAR_BUFFER_DEFAULTS ("default-fringe-indicator-alist",
5549 fringe_indicator_alist,
5550 doc: /* Default value of `fringe-indicator-alist' for buffers that don't override it.
5551 This is the same as (default-value 'fringe-indicator-alist'). */);
5553 DEFVAR_BUFFER_DEFAULTS ("default-fringe-cursor-alist",
5554 fringe_cursor_alist,
5555 doc: /* Default value of `fringe-cursor-alist' for buffers that don't override it.
5556 This is the same as (default-value 'fringe-cursor-alist'). */);
5558 DEFVAR_BUFFER_DEFAULTS ("default-scroll-up-aggressively",
5559 scroll_up_aggressively,
5560 doc: /* Default value of `scroll-up-aggressively'.
5561 This value applies in buffers that don't have their own local values.
5562 This is the same as (default-value 'scroll-up-aggressively). */);
5564 DEFVAR_BUFFER_DEFAULTS ("default-scroll-down-aggressively",
5565 scroll_down_aggressively,
5566 doc: /* Default value of `scroll-down-aggressively'.
5567 This value applies in buffers that don't have their own local values.
5568 This is the same as (default-value 'scroll-down-aggressively). */);
5570 DEFVAR_PER_BUFFER ("header-line-format",
5571 &BVAR (current_buffer, header_line_format),
5572 Qnil,
5573 doc: /* Analogous to `mode-line-format', but controls the header line.
5574 The header line appears, optionally, at the top of a window;
5575 the mode line appears at the bottom. */);
5577 DEFVAR_PER_BUFFER ("mode-line-format", &BVAR (current_buffer, mode_line_format),
5578 Qnil,
5579 doc: /* Template for displaying mode line for current buffer.
5581 The value may be nil, a string, a symbol or a list.
5583 A value of nil means don't display a mode line.
5585 For any symbol other than t or nil, the symbol's value is processed as
5586 a mode line construct. As a special exception, if that value is a
5587 string, the string is processed verbatim, without handling any
5588 %-constructs (see below). Also, unless the symbol has a non-nil
5589 `risky-local-variable' property, all properties in any strings, as
5590 well as all :eval and :propertize forms in the value, are ignored.
5592 A list whose car is a string or list is processed by processing each
5593 of the list elements recursively, as separate mode line constructs,
5594 and concatenating the results.
5596 A list of the form `(:eval FORM)' is processed by evaluating FORM and
5597 using the result as a mode line construct. Be careful--FORM should
5598 not load any files, because that can cause an infinite recursion.
5600 A list of the form `(:propertize ELT PROPS...)' is processed by
5601 processing ELT as the mode line construct, and adding the text
5602 properties PROPS to the result.
5604 A list whose car is a symbol is processed by examining the symbol's
5605 value, and, if that value is non-nil, processing the cadr of the list
5606 recursively; and if that value is nil, processing the caddr of the
5607 list recursively.
5609 A list whose car is an integer is processed by processing the cadr of
5610 the list, and padding (if the number is positive) or truncating (if
5611 negative) to the width specified by that number.
5613 A string is printed verbatim in the mode line except for %-constructs:
5614 %b -- print buffer name. %f -- print visited file name.
5615 %F -- print frame name.
5616 %* -- print %, * or hyphen. %+ -- print *, % or hyphen.
5617 %& is like %*, but ignore read-only-ness.
5618 % means buffer is read-only and * means it is modified.
5619 For a modified read-only buffer, %* gives % and %+ gives *.
5620 %s -- print process status. %l -- print the current line number.
5621 %c -- print the current column number (this makes editing slower).
5622 To make the column number update correctly in all cases,
5623 `column-number-mode' must be non-nil.
5624 %i -- print the size of the buffer.
5625 %I -- like %i, but use k, M, G, etc., to abbreviate.
5626 %p -- print percent of buffer above top of window, or Top, Bot or All.
5627 %P -- print percent of buffer above bottom of window, perhaps plus Top,
5628 or print Bottom or All.
5629 %n -- print Narrow if appropriate.
5630 %t -- visited file is text or binary (if OS supports this distinction).
5631 %z -- print mnemonics of keyboard, terminal, and buffer coding systems.
5632 %Z -- like %z, but including the end-of-line format.
5633 %e -- print error message about full memory.
5634 %@ -- print @ or hyphen. @ means that default-directory is on a
5635 remote machine.
5636 %[ -- print one [ for each recursive editing level. %] similar.
5637 %% -- print %. %- -- print infinitely many dashes.
5638 Decimal digits after the % specify field width to which to pad. */);
5640 DEFVAR_BUFFER_DEFAULTS ("default-major-mode", major_mode,
5641 doc: /* Value of `major-mode' for new buffers. */);
5643 DEFVAR_PER_BUFFER ("major-mode", &BVAR (current_buffer, major_mode),
5644 Qsymbolp,
5645 doc: /* Symbol for current buffer's major mode.
5646 The default value (normally `fundamental-mode') affects new buffers.
5647 A value of nil means to use the current buffer's major mode, provided
5648 it is not marked as "special".
5650 When a mode is used by default, `find-file' switches to it before it
5651 reads the contents into the buffer and before it finishes setting up
5652 the buffer. Thus, the mode and its hooks should not expect certain
5653 variables such as `buffer-read-only' and `buffer-file-coding-system'
5654 to be set up. */);
5656 DEFVAR_PER_BUFFER ("mode-name", &BVAR (current_buffer, mode_name),
5657 Qnil,
5658 doc: /* Pretty name of current buffer's major mode.
5659 Usually a string, but can use any of the constructs for `mode-line-format',
5660 which see.
5661 Format with `format-mode-line' to produce a string value. */);
5663 DEFVAR_PER_BUFFER ("local-abbrev-table", &BVAR (current_buffer, abbrev_table), Qnil,
5664 doc: /* Local (mode-specific) abbrev table of current buffer. */);
5666 DEFVAR_PER_BUFFER ("abbrev-mode", &BVAR (current_buffer, abbrev_mode), Qnil,
5667 doc: /* Non-nil if Abbrev mode is enabled.
5668 Use the command `abbrev-mode' to change this variable. */);
5670 DEFVAR_PER_BUFFER ("case-fold-search", &BVAR (current_buffer, case_fold_search),
5671 Qnil,
5672 doc: /* Non-nil if searches and matches should ignore case. */);
5674 DEFVAR_PER_BUFFER ("fill-column", &BVAR (current_buffer, fill_column),
5675 Qintegerp,
5676 doc: /* Column beyond which automatic line-wrapping should happen.
5677 Interactively, you can set the buffer local value using \\[set-fill-column]. */);
5679 DEFVAR_PER_BUFFER ("left-margin", &BVAR (current_buffer, left_margin),
5680 Qintegerp,
5681 doc: /* Column for the default `indent-line-function' to indent to.
5682 Linefeed indents to this column in Fundamental mode. */);
5684 DEFVAR_PER_BUFFER ("tab-width", &BVAR (current_buffer, tab_width),
5685 Qintegerp,
5686 doc: /* Distance between tab stops (for display of tab characters), in columns.
5687 This should be an integer greater than zero. */);
5689 DEFVAR_PER_BUFFER ("ctl-arrow", &BVAR (current_buffer, ctl_arrow), Qnil,
5690 doc: /* Non-nil means display control chars with uparrow.
5691 A value of nil means use backslash and octal digits.
5692 This variable does not apply to characters whose display is specified
5693 in the current display table (if there is one). */);
5695 DEFVAR_PER_BUFFER ("enable-multibyte-characters",
5696 &BVAR (current_buffer, enable_multibyte_characters),
5697 Qnil,
5698 doc: /* Non-nil means the buffer contents are regarded as multi-byte characters.
5699 Otherwise they are regarded as unibyte. This affects the display,
5700 file I/O and the behavior of various editing commands.
5702 This variable is buffer-local but you cannot set it directly;
5703 use the function `set-buffer-multibyte' to change a buffer's representation.
5704 See also Info node `(elisp)Text Representations'. */);
5705 XSYMBOL (intern_c_string ("enable-multibyte-characters"))->constant = 1;
5707 DEFVAR_PER_BUFFER ("buffer-file-coding-system",
5708 &BVAR (current_buffer, buffer_file_coding_system), Qnil,
5709 doc: /* Coding system to be used for encoding the buffer contents on saving.
5710 This variable applies to saving the buffer, and also to `write-region'
5711 and other functions that use `write-region'.
5712 It does not apply to sending output to subprocesses, however.
5714 If this is nil, the buffer is saved without any code conversion
5715 unless some coding system is specified in `file-coding-system-alist'
5716 for the buffer file.
5718 If the text to be saved cannot be encoded as specified by this variable,
5719 an alternative encoding is selected by `select-safe-coding-system', which see.
5721 The variable `coding-system-for-write', if non-nil, overrides this variable.
5723 This variable is never applied to a way of decoding a file while reading it. */);
5725 DEFVAR_PER_BUFFER ("bidi-display-reordering",
5726 &BVAR (current_buffer, bidi_display_reordering), Qnil,
5727 doc: /* Non-nil means reorder bidirectional text for display in the visual order. */);
5729 DEFVAR_PER_BUFFER ("bidi-paragraph-direction",
5730 &BVAR (current_buffer, bidi_paragraph_direction), Qnil,
5731 doc: /* If non-nil, forces directionality of text paragraphs in the buffer.
5733 If this is nil (the default), the direction of each paragraph is
5734 determined by the first strong directional character of its text.
5735 The values of `right-to-left' and `left-to-right' override that.
5736 Any other value is treated as nil.
5738 This variable has no effect unless the buffer's value of
5739 \`bidi-display-reordering' is non-nil. */);
5741 DEFVAR_PER_BUFFER ("truncate-lines", &BVAR (current_buffer, truncate_lines), Qnil,
5742 doc: /* Non-nil means do not display continuation lines.
5743 Instead, give each line of text just one screen line.
5745 Note that this is overridden by the variable
5746 `truncate-partial-width-windows' if that variable is non-nil
5747 and this buffer is not full-frame width.
5749 Minibuffers set this variable to nil. */);
5751 DEFVAR_PER_BUFFER ("word-wrap", &BVAR (current_buffer, word_wrap), Qnil,
5752 doc: /* Non-nil means to use word-wrapping for continuation lines.
5753 When word-wrapping is on, continuation lines are wrapped at the space
5754 or tab character nearest to the right window edge.
5755 If nil, continuation lines are wrapped at the right screen edge.
5757 This variable has no effect if long lines are truncated (see
5758 `truncate-lines' and `truncate-partial-width-windows'). If you use
5759 word-wrapping, you might want to reduce the value of
5760 `truncate-partial-width-windows', since wrapping can make text readable
5761 in narrower windows.
5763 Instead of setting this variable directly, most users should use
5764 Visual Line mode . Visual Line mode, when enabled, sets `word-wrap'
5765 to t, and additionally redefines simple editing commands to act on
5766 visual lines rather than logical lines. See the documentation of
5767 `visual-line-mode'. */);
5769 DEFVAR_PER_BUFFER ("default-directory", &BVAR (current_buffer, directory),
5770 Qstringp,
5771 doc: /* Name of default directory of current buffer. Should end with slash.
5772 To interactively change the default directory, use command `cd'. */);
5774 DEFVAR_PER_BUFFER ("auto-fill-function", &BVAR (current_buffer, auto_fill_function),
5775 Qnil,
5776 doc: /* Function called (if non-nil) to perform auto-fill.
5777 It is called after self-inserting any character specified in
5778 the `auto-fill-chars' table.
5779 NOTE: This variable is not a hook;
5780 its value may not be a list of functions. */);
5782 DEFVAR_PER_BUFFER ("buffer-file-name", &BVAR (current_buffer, filename),
5783 Qstringp,
5784 doc: /* Name of file visited in current buffer, or nil if not visiting a file. */);
5786 DEFVAR_PER_BUFFER ("buffer-file-truename", &BVAR (current_buffer, file_truename),
5787 Qstringp,
5788 doc: /* Abbreviated truename of file visited in current buffer, or nil if none.
5789 The truename of a file is calculated by `file-truename'
5790 and then abbreviated with `abbreviate-file-name'. */);
5792 DEFVAR_PER_BUFFER ("buffer-auto-save-file-name",
5793 &BVAR (current_buffer, auto_save_file_name),
5794 Qstringp,
5795 doc: /* Name of file for auto-saving current buffer.
5796 If it is nil, that means don't auto-save this buffer. */);
5798 DEFVAR_PER_BUFFER ("buffer-read-only", &BVAR (current_buffer, read_only), Qnil,
5799 doc: /* Non-nil if this buffer is read-only. */);
5801 DEFVAR_PER_BUFFER ("buffer-backed-up", &BVAR (current_buffer, backed_up), Qnil,
5802 doc: /* Non-nil if this buffer's file has been backed up.
5803 Backing up is done before the first time the file is saved. */);
5805 DEFVAR_PER_BUFFER ("buffer-saved-size", &BVAR (current_buffer, save_length),
5806 Qintegerp,
5807 doc: /* Length of current buffer when last read in, saved or auto-saved.
5808 0 initially.
5809 -1 means auto-saving turned off until next real save.
5811 If you set this to -2, that means don't turn off auto-saving in this buffer
5812 if its text size shrinks. If you use `buffer-swap-text' on a buffer,
5813 you probably should set this to -2 in that buffer. */);
5815 DEFVAR_PER_BUFFER ("selective-display", &BVAR (current_buffer, selective_display),
5816 Qnil,
5817 doc: /* Non-nil enables selective display.
5818 An integer N as value means display only lines
5819 that start with less than N columns of space.
5820 A value of t means that the character ^M makes itself and
5821 all the rest of the line invisible; also, when saving the buffer
5822 in a file, save the ^M as a newline. */);
5824 DEFVAR_PER_BUFFER ("selective-display-ellipses",
5825 &BVAR (current_buffer, selective_display_ellipses),
5826 Qnil,
5827 doc: /* Non-nil means display ... on previous line when a line is invisible. */);
5829 DEFVAR_PER_BUFFER ("overwrite-mode", &BVAR (current_buffer, overwrite_mode), Qnil,
5830 doc: /* Non-nil if self-insertion should replace existing text.
5831 The value should be one of `overwrite-mode-textual',
5832 `overwrite-mode-binary', or nil.
5833 If it is `overwrite-mode-textual', self-insertion still
5834 inserts at the end of a line, and inserts when point is before a tab,
5835 until the tab is filled in.
5836 If `overwrite-mode-binary', self-insertion replaces newlines and tabs too. */);
5838 DEFVAR_PER_BUFFER ("buffer-display-table", &BVAR (current_buffer, display_table),
5839 Qnil,
5840 doc: /* Display table that controls display of the contents of current buffer.
5842 If this variable is nil, the value of `standard-display-table' is used.
5843 Each window can have its own, overriding display table, see
5844 `set-window-display-table' and `window-display-table'.
5846 The display table is a char-table created with `make-display-table'.
5847 A char-table is an array indexed by character codes. Normal array
5848 primitives `aref' and `aset' can be used to access elements of a char-table.
5850 Each of the char-table elements control how to display the corresponding
5851 text character: the element at index C in the table says how to display
5852 the character whose code is C. Each element should be a vector of
5853 characters or nil. The value nil means display the character in the
5854 default fashion; otherwise, the characters from the vector are delivered
5855 to the screen instead of the original character.
5857 For example, (aset buffer-display-table ?X [?Y]) tells Emacs
5858 to display a capital Y instead of each X character.
5860 In addition, a char-table has six extra slots to control the display of:
5862 the end of a truncated screen line (extra-slot 0, a single character);
5863 the end of a continued line (extra-slot 1, a single character);
5864 the escape character used to display character codes in octal
5865 (extra-slot 2, a single character);
5866 the character used as an arrow for control characters (extra-slot 3,
5867 a single character);
5868 the decoration indicating the presence of invisible lines (extra-slot 4,
5869 a vector of characters);
5870 the character used to draw the border between side-by-side windows
5871 (extra-slot 5, a single character).
5873 See also the functions `display-table-slot' and `set-display-table-slot'. */);
5875 DEFVAR_PER_BUFFER ("left-margin-width", &BVAR (current_buffer, left_margin_cols),
5876 Qintegerp,
5877 doc: /* Width of left marginal area for display of a buffer.
5878 A value of nil means no marginal area. */);
5880 DEFVAR_PER_BUFFER ("right-margin-width", &BVAR (current_buffer, right_margin_cols),
5881 Qintegerp,
5882 doc: /* Width of right marginal area for display of a buffer.
5883 A value of nil means no marginal area. */);
5885 DEFVAR_PER_BUFFER ("left-fringe-width", &BVAR (current_buffer, left_fringe_width),
5886 Qintegerp,
5887 doc: /* Width of this buffer's left fringe (in pixels).
5888 A value of 0 means no left fringe is shown in this buffer's window.
5889 A value of nil means to use the left fringe width from the window's frame. */);
5891 DEFVAR_PER_BUFFER ("right-fringe-width", &BVAR (current_buffer, right_fringe_width),
5892 Qintegerp,
5893 doc: /* Width of this buffer's right fringe (in pixels).
5894 A value of 0 means no right fringe is shown in this buffer's window.
5895 A value of nil means to use the right fringe width from the window's frame. */);
5897 DEFVAR_PER_BUFFER ("fringes-outside-margins", &BVAR (current_buffer, fringes_outside_margins),
5898 Qnil,
5899 doc: /* Non-nil means to display fringes outside display margins.
5900 A value of nil means to display fringes between margins and buffer text. */);
5902 DEFVAR_PER_BUFFER ("scroll-bar-width", &BVAR (current_buffer, scroll_bar_width),
5903 Qintegerp,
5904 doc: /* Width of this buffer's scroll bars in pixels.
5905 A value of nil means to use the scroll bar width from the window's frame. */);
5907 DEFVAR_PER_BUFFER ("vertical-scroll-bar", &BVAR (current_buffer, vertical_scroll_bar_type),
5908 Qnil,
5909 doc: /* Position of this buffer's vertical scroll bar.
5910 The value takes effect whenever you tell a window to display this buffer;
5911 for instance, with `set-window-buffer' or when `display-buffer' displays it.
5913 A value of `left' or `right' means put the vertical scroll bar at that side
5914 of the window; a value of nil means don't show any vertical scroll bars.
5915 A value of t (the default) means do whatever the window's frame specifies. */);
5917 DEFVAR_PER_BUFFER ("indicate-empty-lines",
5918 &BVAR (current_buffer, indicate_empty_lines), Qnil,
5919 doc: /* Visually indicate empty lines after the buffer end.
5920 If non-nil, a bitmap is displayed in the left fringe of a window on
5921 window-systems. */);
5923 DEFVAR_PER_BUFFER ("indicate-buffer-boundaries",
5924 &BVAR (current_buffer, indicate_buffer_boundaries), Qnil,
5925 doc: /* Visually indicate buffer boundaries and scrolling.
5926 If non-nil, the first and last line of the buffer are marked in the fringe
5927 of a window on window-systems with angle bitmaps, or if the window can be
5928 scrolled, the top and bottom line of the window are marked with up and down
5929 arrow bitmaps.
5931 If value is a symbol `left' or `right', both angle and arrow bitmaps
5932 are displayed in the left or right fringe, resp. Any other value
5933 that doesn't look like an alist means display the angle bitmaps in
5934 the left fringe but no arrows.
5936 You can exercise more precise control by using an alist as the
5937 value. Each alist element (INDICATOR . POSITION) specifies
5938 where to show one of the indicators. INDICATOR is one of `top',
5939 `bottom', `up', `down', or t, which specifies the default position,
5940 and POSITION is one of `left', `right', or nil, meaning do not show
5941 this indicator.
5943 For example, ((top . left) (t . right)) places the top angle bitmap in
5944 left fringe, the bottom angle bitmap in right fringe, and both arrow
5945 bitmaps in right fringe. To show just the angle bitmaps in the left
5946 fringe, but no arrow bitmaps, use ((top . left) (bottom . left)). */);
5948 DEFVAR_PER_BUFFER ("fringe-indicator-alist",
5949 &BVAR (current_buffer, fringe_indicator_alist), Qnil,
5950 doc: /* Mapping from logical to physical fringe indicator bitmaps.
5951 The value is an alist where each element (INDICATOR . BITMAPS)
5952 specifies the fringe bitmaps used to display a specific logical
5953 fringe indicator.
5955 INDICATOR specifies the logical indicator type which is one of the
5956 following symbols: `truncation' , `continuation', `overlay-arrow',
5957 `top', `bottom', `top-bottom', `up', `down', empty-line', or `unknown'.
5959 BITMAPS is a list of symbols (LEFT RIGHT [LEFT1 RIGHT1]) which specifies
5960 the actual bitmap shown in the left or right fringe for the logical
5961 indicator. LEFT and RIGHT are the bitmaps shown in the left and/or
5962 right fringe for the specific indicator. The LEFT1 or RIGHT1 bitmaps
5963 are used only for the `bottom' and `top-bottom' indicators when the
5964 last (only) line has no final newline. BITMAPS may also be a single
5965 symbol which is used in both left and right fringes. */);
5967 DEFVAR_PER_BUFFER ("fringe-cursor-alist",
5968 &BVAR (current_buffer, fringe_cursor_alist), Qnil,
5969 doc: /* Mapping from logical to physical fringe cursor bitmaps.
5970 The value is an alist where each element (CURSOR . BITMAP)
5971 specifies the fringe bitmaps used to display a specific logical
5972 cursor type in the fringe.
5974 CURSOR specifies the logical cursor type which is one of the following
5975 symbols: `box' , `hollow', `bar', `hbar', or `hollow-small'. The last
5976 one is used to show a hollow cursor on narrow lines display lines
5977 where the normal hollow cursor will not fit.
5979 BITMAP is the corresponding fringe bitmap shown for the logical
5980 cursor type. */);
5982 DEFVAR_PER_BUFFER ("scroll-up-aggressively",
5983 &BVAR (current_buffer, scroll_up_aggressively), Qfloatp,
5984 doc: /* How far to scroll windows upward.
5985 If you move point off the bottom, the window scrolls automatically.
5986 This variable controls how far it scrolls. The value nil, the default,
5987 means scroll to center point. A fraction means scroll to put point
5988 that fraction of the window's height from the bottom of the window.
5989 When the value is 0.0, point goes at the bottom line, which in the
5990 simple case that you moved off with C-f means scrolling just one line.
5991 1.0 means point goes at the top, so that in that simple case, the
5992 window scrolls by a full window height. Meaningful values are
5993 between 0.0 and 1.0, inclusive. */);
5995 DEFVAR_PER_BUFFER ("scroll-down-aggressively",
5996 &BVAR (current_buffer, scroll_down_aggressively), Qfloatp,
5997 doc: /* How far to scroll windows downward.
5998 If you move point off the top, the window scrolls automatically.
5999 This variable controls how far it scrolls. The value nil, the default,
6000 means scroll to center point. A fraction means scroll to put point
6001 that fraction of the window's height from the top of the window.
6002 When the value is 0.0, point goes at the top line, which in the
6003 simple case that you moved off with C-b means scrolling just one line.
6004 1.0 means point goes at the bottom, so that in that simple case, the
6005 window scrolls by a full window height. Meaningful values are
6006 between 0.0 and 1.0, inclusive. */);
6008 DEFVAR_LISP ("before-change-functions", Vbefore_change_functions,
6009 doc: /* List of functions to call before each text change.
6010 Two arguments are passed to each function: the positions of
6011 the beginning and end of the range of old text to be changed.
6012 \(For an insertion, the beginning and end are at the same place.)
6013 No information is given about the length of the text after the change.
6015 Buffer changes made while executing the `before-change-functions'
6016 don't call any before-change or after-change functions.
6017 That's because `inhibit-modification-hooks' is temporarily set non-nil.
6019 If an unhandled error happens in running these functions,
6020 the variable's value remains nil. That prevents the error
6021 from happening repeatedly and making Emacs nonfunctional. */);
6022 Vbefore_change_functions = Qnil;
6024 DEFVAR_LISP ("after-change-functions", Vafter_change_functions,
6025 doc: /* List of functions to call after each text change.
6026 Three arguments are passed to each function: the positions of
6027 the beginning and end of the range of changed text,
6028 and the length in bytes of the pre-change text replaced by that range.
6029 \(For an insertion, the pre-change length is zero;
6030 for a deletion, that length is the number of bytes deleted,
6031 and the post-change beginning and end are at the same place.)
6033 Buffer changes made while executing the `after-change-functions'
6034 don't call any before-change or after-change functions.
6035 That's because `inhibit-modification-hooks' is temporarily set non-nil.
6037 If an unhandled error happens in running these functions,
6038 the variable's value remains nil. That prevents the error
6039 from happening repeatedly and making Emacs nonfunctional. */);
6040 Vafter_change_functions = Qnil;
6042 DEFVAR_LISP ("first-change-hook", Vfirst_change_hook,
6043 doc: /* A list of functions to call before changing a buffer which is unmodified.
6044 The functions are run using the `run-hooks' function. */);
6045 Vfirst_change_hook = Qnil;
6047 DEFVAR_PER_BUFFER ("buffer-undo-list", &BVAR (current_buffer, undo_list), Qnil,
6048 doc: /* List of undo entries in current buffer.
6049 Recent changes come first; older changes follow newer.
6051 An entry (BEG . END) represents an insertion which begins at
6052 position BEG and ends at position END.
6054 An entry (TEXT . POSITION) represents the deletion of the string TEXT
6055 from (abs POSITION). If POSITION is positive, point was at the front
6056 of the text being deleted; if negative, point was at the end.
6058 An entry (t HIGH LOW USEC PSEC) indicates that the buffer was previously
6059 unmodified; (HIGH LOW USEC PSEC) is in the same style as (current-time)
6060 and is the visited file's modification time, as of that time. If the
6061 modification time of the most recent save is different, this entry is
6062 obsolete.
6064 An entry (nil PROPERTY VALUE BEG . END) indicates that a text property
6065 was modified between BEG and END. PROPERTY is the property name,
6066 and VALUE is the old value.
6068 An entry (apply FUN-NAME . ARGS) means undo the change with
6069 \(apply FUN-NAME ARGS).
6071 An entry (apply DELTA BEG END FUN-NAME . ARGS) supports selective undo
6072 in the active region. BEG and END is the range affected by this entry
6073 and DELTA is the number of bytes added or deleted in that range by
6074 this change.
6076 An entry (MARKER . DISTANCE) indicates that the marker MARKER
6077 was adjusted in position by the offset DISTANCE (an integer).
6079 An entry of the form POSITION indicates that point was at the buffer
6080 location given by the integer. Undoing an entry of this form places
6081 point at POSITION.
6083 Entries with value `nil' mark undo boundaries. The undo command treats
6084 the changes between two undo boundaries as a single step to be undone.
6086 If the value of the variable is t, undo information is not recorded. */);
6088 DEFVAR_PER_BUFFER ("mark-active", &BVAR (current_buffer, mark_active), Qnil,
6089 doc: /* Non-nil means the mark and region are currently active in this buffer. */);
6091 DEFVAR_PER_BUFFER ("cache-long-line-scans", &BVAR (current_buffer, cache_long_line_scans), Qnil,
6092 doc: /* Non-nil means that Emacs should use caches to handle long lines more quickly.
6094 Normally, the line-motion functions work by scanning the buffer for
6095 newlines. Columnar operations (like `move-to-column' and
6096 `compute-motion') also work by scanning the buffer, summing character
6097 widths as they go. This works well for ordinary text, but if the
6098 buffer's lines are very long (say, more than 500 characters), these
6099 motion functions will take longer to execute. Emacs may also take
6100 longer to update the display.
6102 If `cache-long-line-scans' is non-nil, these motion functions cache the
6103 results of their scans, and consult the cache to avoid rescanning
6104 regions of the buffer until the text is modified. The caches are most
6105 beneficial when they prevent the most searching---that is, when the
6106 buffer contains long lines and large regions of characters with the
6107 same, fixed screen width.
6109 When `cache-long-line-scans' is non-nil, processing short lines will
6110 become slightly slower (because of the overhead of consulting the
6111 cache), and the caches will use memory roughly proportional to the
6112 number of newlines and characters whose screen width varies.
6114 The caches require no explicit maintenance; their accuracy is
6115 maintained internally by the Emacs primitives. Enabling or disabling
6116 the cache should not affect the behavior of any of the motion
6117 functions; it should only affect their performance. */);
6119 DEFVAR_PER_BUFFER ("point-before-scroll", &BVAR (current_buffer, point_before_scroll), Qnil,
6120 doc: /* Value of point before the last series of scroll operations, or nil. */);
6122 DEFVAR_PER_BUFFER ("buffer-file-format", &BVAR (current_buffer, file_format), Qnil,
6123 doc: /* List of formats to use when saving this buffer.
6124 Formats are defined by `format-alist'. This variable is
6125 set when a file is visited. */);
6127 DEFVAR_PER_BUFFER ("buffer-auto-save-file-format",
6128 &BVAR (current_buffer, auto_save_file_format), Qnil,
6129 doc: /* Format in which to write auto-save files.
6130 Should be a list of symbols naming formats that are defined in `format-alist'.
6131 If it is t, which is the default, auto-save files are written in the
6132 same format as a regular save would use. */);
6134 DEFVAR_PER_BUFFER ("buffer-invisibility-spec",
6135 &BVAR (current_buffer, invisibility_spec), Qnil,
6136 doc: /* Invisibility spec of this buffer.
6137 The default is t, which means that text is invisible
6138 if it has a non-nil `invisible' property.
6139 If the value is a list, a text character is invisible if its `invisible'
6140 property is an element in that list (or is a list with members in common).
6141 If an element is a cons cell of the form (PROP . ELLIPSIS),
6142 then characters with property value PROP are invisible,
6143 and they have an ellipsis as well if ELLIPSIS is non-nil. */);
6145 DEFVAR_PER_BUFFER ("buffer-display-count",
6146 &BVAR (current_buffer, display_count), Qintegerp,
6147 doc: /* A number incremented each time this buffer is displayed in a window.
6148 The function `set-window-buffer' increments it. */);
6150 DEFVAR_PER_BUFFER ("buffer-display-time",
6151 &BVAR (current_buffer, display_time), Qnil,
6152 doc: /* Time stamp updated each time this buffer is displayed in a window.
6153 The function `set-window-buffer' updates this variable
6154 to the value obtained by calling `current-time'.
6155 If the buffer has never been shown in a window, the value is nil. */);
6157 DEFVAR_LISP ("transient-mark-mode", Vtransient_mark_mode,
6158 doc: /* Non-nil if Transient Mark mode is enabled.
6159 See the command `transient-mark-mode' for a description of this minor mode.
6161 Non-nil also enables highlighting of the region whenever the mark is active.
6162 The variable `highlight-nonselected-windows' controls whether to highlight
6163 all windows or just the selected window.
6165 Lisp programs may give this variable certain special values:
6167 - A value of `lambda' enables Transient Mark mode temporarily.
6168 It is disabled again after any subsequent action that would
6169 normally deactivate the mark (e.g. buffer modification).
6171 - A value of (only . OLDVAL) enables Transient Mark mode
6172 temporarily. After any subsequent point motion command that is
6173 not shift-translated, or any other action that would normally
6174 deactivate the mark (e.g. buffer modification), the value of
6175 `transient-mark-mode' is set to OLDVAL. */);
6176 Vtransient_mark_mode = Qnil;
6178 DEFVAR_LISP ("inhibit-read-only", Vinhibit_read_only,
6179 doc: /* Non-nil means disregard read-only status of buffers or characters.
6180 If the value is t, disregard `buffer-read-only' and all `read-only'
6181 text properties. If the value is a list, disregard `buffer-read-only'
6182 and disregard a `read-only' text property if the property value
6183 is a member of the list. */);
6184 Vinhibit_read_only = Qnil;
6186 DEFVAR_PER_BUFFER ("cursor-type", &BVAR (current_buffer, cursor_type), Qnil,
6187 doc: /* Cursor to use when this buffer is in the selected window.
6188 Values are interpreted as follows:
6190 t use the cursor specified for the frame
6191 nil don't display a cursor
6192 box display a filled box cursor
6193 hollow display a hollow box cursor
6194 bar display a vertical bar cursor with default width
6195 (bar . WIDTH) display a vertical bar cursor with width WIDTH
6196 hbar display a horizontal bar cursor with default height
6197 (hbar . HEIGHT) display a horizontal bar cursor with height HEIGHT
6198 ANYTHING ELSE display a hollow box cursor
6200 When the buffer is displayed in a non-selected window, the
6201 cursor's appearance is instead controlled by the variable
6202 `cursor-in-non-selected-windows'. */);
6204 DEFVAR_PER_BUFFER ("line-spacing",
6205 &BVAR (current_buffer, extra_line_spacing), Qnumberp,
6206 doc: /* Additional space to put between lines when displaying a buffer.
6207 The space is measured in pixels, and put below lines on graphic displays,
6208 see `display-graphic-p'.
6209 If value is a floating point number, it specifies the spacing relative
6210 to the default frame line height. A value of nil means add no extra space. */);
6212 DEFVAR_PER_BUFFER ("cursor-in-non-selected-windows",
6213 &BVAR (current_buffer, cursor_in_non_selected_windows), Qnil,
6214 doc: /* Non-nil means show a cursor in non-selected windows.
6215 If nil, only shows a cursor in the selected window.
6216 If t, displays a cursor related to the usual cursor type
6217 \(a solid box becomes hollow, a bar becomes a narrower bar).
6218 You can also specify the cursor type as in the `cursor-type' variable.
6219 Use Custom to set this variable and update the display." */);
6221 DEFVAR_LISP ("kill-buffer-query-functions", Vkill_buffer_query_functions,
6222 doc: /* List of functions called with no args to query before killing a buffer.
6223 The buffer being killed will be current while the functions are running.
6225 If any of them returns nil, the buffer is not killed. Functions run by
6226 this hook are supposed to not change the current buffer. */);
6227 Vkill_buffer_query_functions = Qnil;
6229 DEFVAR_LISP ("change-major-mode-hook", Vchange_major_mode_hook,
6230 doc: /* Normal hook run before changing the major mode of a buffer.
6231 The function `kill-all-local-variables' runs this before doing anything else. */);
6232 Vchange_major_mode_hook = Qnil;
6233 DEFSYM (Qchange_major_mode_hook, "change-major-mode-hook");
6235 DEFVAR_LISP ("buffer-list-update-hook", Vbuffer_list_update_hook,
6236 doc: /* Hook run when the buffer list changes.
6237 Functions running this hook are `get-buffer-create',
6238 `make-indirect-buffer', `rename-buffer', `kill-buffer',
6239 and `bury-buffer-internal'. */);
6240 Vbuffer_list_update_hook = Qnil;
6241 DEFSYM (Qbuffer_list_update_hook, "buffer-list-update-hook");
6243 defsubr (&Sbuffer_live_p);
6244 defsubr (&Sbuffer_list);
6245 defsubr (&Sget_buffer);
6246 defsubr (&Sget_file_buffer);
6247 defsubr (&Sget_buffer_create);
6248 defsubr (&Smake_indirect_buffer);
6249 defsubr (&Sgenerate_new_buffer_name);
6250 defsubr (&Sbuffer_name);
6251 defsubr (&Sbuffer_file_name);
6252 defsubr (&Sbuffer_base_buffer);
6253 defsubr (&Sbuffer_local_value);
6254 defsubr (&Sbuffer_local_variables);
6255 defsubr (&Sbuffer_modified_p);
6256 defsubr (&Sset_buffer_modified_p);
6257 defsubr (&Sbuffer_modified_tick);
6258 defsubr (&Sbuffer_chars_modified_tick);
6259 defsubr (&Srename_buffer);
6260 defsubr (&Sother_buffer);
6261 defsubr (&Sbuffer_enable_undo);
6262 defsubr (&Skill_buffer);
6263 defsubr (&Sbury_buffer_internal);
6264 defsubr (&Sset_buffer_major_mode);
6265 defsubr (&Scurrent_buffer);
6266 defsubr (&Sset_buffer);
6267 defsubr (&Sbarf_if_buffer_read_only);
6268 defsubr (&Serase_buffer);
6269 defsubr (&Sbuffer_swap_text);
6270 defsubr (&Sset_buffer_multibyte);
6271 defsubr (&Skill_all_local_variables);
6273 defsubr (&Soverlayp);
6274 defsubr (&Smake_overlay);
6275 defsubr (&Sdelete_overlay);
6276 defsubr (&Sdelete_all_overlays);
6277 defsubr (&Smove_overlay);
6278 defsubr (&Soverlay_start);
6279 defsubr (&Soverlay_end);
6280 defsubr (&Soverlay_buffer);
6281 defsubr (&Soverlay_properties);
6282 defsubr (&Soverlays_at);
6283 defsubr (&Soverlays_in);
6284 defsubr (&Snext_overlay_change);
6285 defsubr (&Sprevious_overlay_change);
6286 defsubr (&Soverlay_recenter);
6287 defsubr (&Soverlay_lists);
6288 defsubr (&Soverlay_get);
6289 defsubr (&Soverlay_put);
6290 defsubr (&Srestore_buffer_modified_p);
6293 void
6294 keys_of_buffer (void)
6296 initial_define_key (control_x_map, 'b', "switch-to-buffer");
6297 initial_define_key (control_x_map, 'k', "kill-buffer");
6299 /* This must not be in syms_of_buffer, because Qdisabled is not
6300 initialized when that function gets called. */
6301 Fput (intern_c_string ("erase-buffer"), Qdisabled, Qt);