merge from trunk
[emacs.git] / src / buffer.c
blob8a1ad607e0b9cf8b1b0e09b69f69919fff8616ed
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 /* First buffer in chain of all buffers (in reverse order of creation).
48 Threaded through ->header.next.buffer. */
50 struct buffer *all_buffers;
52 /* This structure holds the default values of the buffer-local variables
53 defined with DEFVAR_PER_BUFFER, that have special slots in each buffer.
54 The default value occupies the same slot in this structure
55 as an individual buffer's value occupies in that buffer.
56 Setting the default value also goes through the alist of buffers
57 and stores into each buffer that does not say it has a local value. */
59 struct buffer alignas (GCALIGNMENT) buffer_defaults;
61 /* This structure marks which slots in a buffer have corresponding
62 default values in buffer_defaults.
63 Each such slot has a nonzero value in this structure.
64 The value has only one nonzero bit.
66 When a buffer has its own local value for a slot,
67 the entry for that slot (found in the same slot in this structure)
68 is turned on in the buffer's local_flags array.
70 If a slot in this structure is -1, then even though there may
71 be a DEFVAR_PER_BUFFER for the slot, there is no default value for it;
72 and the corresponding slot in buffer_defaults is not used.
74 If a slot in this structure corresponding to a DEFVAR_PER_BUFFER is
75 zero, that is a bug. */
77 struct buffer buffer_local_flags;
79 /* This structure holds the names of symbols whose values may be
80 buffer-local. It is indexed and accessed in the same way as the above. */
82 struct buffer alignas (GCALIGNMENT) buffer_local_symbols;
84 /* Return the symbol of the per-buffer variable at offset OFFSET in
85 the buffer structure. */
87 #define PER_BUFFER_SYMBOL(OFFSET) \
88 (*(Lisp_Object *)((OFFSET) + (char *) &buffer_local_symbols))
90 /* Maximum length of an overlay vector. */
91 #define OVERLAY_COUNT_MAX \
92 ((ptrdiff_t) min (MOST_POSITIVE_FIXNUM, \
93 min (PTRDIFF_MAX, SIZE_MAX) / word_size))
95 /* Flags indicating which built-in buffer-local variables
96 are permanent locals. */
97 static char buffer_permanent_local_flags[MAX_PER_BUFFER_VARS];
99 /* Number of per-buffer variables used. */
101 int last_per_buffer_idx;
103 static void call_overlay_mod_hooks (Lisp_Object list, Lisp_Object overlay,
104 bool after, Lisp_Object arg1,
105 Lisp_Object arg2, Lisp_Object arg3);
106 static void swap_out_buffer_local_variables (struct buffer *b);
107 static void reset_buffer_local_variables (struct buffer *, bool);
109 /* Alist of all buffer names vs the buffers. This used to be
110 a Lisp-visible variable, but is no longer, to prevent lossage
111 due to user rplac'ing this alist or its elements. */
112 Lisp_Object Vbuffer_alist;
114 static Lisp_Object Qkill_buffer_query_functions;
116 /* Hook run before changing a major mode. */
117 static Lisp_Object Qchange_major_mode_hook;
119 Lisp_Object Qfirst_change_hook;
120 Lisp_Object Qbefore_change_functions;
121 Lisp_Object Qafter_change_functions;
123 static Lisp_Object Qfundamental_mode, Qmode_class, Qpermanent_local;
124 static Lisp_Object Qpermanent_local_hook;
126 static Lisp_Object Qprotected_field;
128 static Lisp_Object QSFundamental; /* A string "Fundamental". */
130 static Lisp_Object Qkill_buffer_hook;
131 static Lisp_Object Qbuffer_list_update_hook;
133 static Lisp_Object Qget_file_buffer;
135 static Lisp_Object Qoverlayp;
137 Lisp_Object Qpriority, Qbefore_string, Qafter_string;
139 static Lisp_Object Qevaporate;
141 Lisp_Object Qmodification_hooks;
142 Lisp_Object Qinsert_in_front_hooks;
143 Lisp_Object Qinsert_behind_hooks;
145 static void alloc_buffer_text (struct buffer *, ptrdiff_t);
146 static void free_buffer_text (struct buffer *b);
147 static struct Lisp_Overlay * copy_overlays (struct buffer *, struct Lisp_Overlay *);
148 static void modify_overlay (struct buffer *, ptrdiff_t, ptrdiff_t);
149 static Lisp_Object buffer_lisp_local_variables (struct buffer *, bool);
151 static void
152 CHECK_OVERLAY (Lisp_Object x)
154 CHECK_TYPE (OVERLAYP (x), Qoverlayp, x);
157 /* These setters are used only in this file, so they can be private. */
158 static void
159 bset_abbrev_mode (struct buffer *b, Lisp_Object val)
161 b->INTERNAL_FIELD (abbrev_mode) = val;
163 static void
164 bset_abbrev_table (struct buffer *b, Lisp_Object val)
166 b->INTERNAL_FIELD (abbrev_table) = val;
168 static void
169 bset_auto_fill_function (struct buffer *b, Lisp_Object val)
171 b->INTERNAL_FIELD (auto_fill_function) = val;
173 static void
174 bset_auto_save_file_format (struct buffer *b, Lisp_Object val)
176 b->INTERNAL_FIELD (auto_save_file_format) = val;
178 static void
179 bset_auto_save_file_name (struct buffer *b, Lisp_Object val)
181 b->INTERNAL_FIELD (auto_save_file_name) = val;
183 static void
184 bset_backed_up (struct buffer *b, Lisp_Object val)
186 b->INTERNAL_FIELD (backed_up) = val;
188 static void
189 bset_begv_marker (struct buffer *b, Lisp_Object val)
191 b->INTERNAL_FIELD (begv_marker) = val;
193 static void
194 bset_bidi_display_reordering (struct buffer *b, Lisp_Object val)
196 b->INTERNAL_FIELD (bidi_display_reordering) = val;
198 static void
199 bset_buffer_file_coding_system (struct buffer *b, Lisp_Object val)
201 b->INTERNAL_FIELD (buffer_file_coding_system) = val;
203 static void
204 bset_cache_long_scans (struct buffer *b, Lisp_Object val)
206 b->INTERNAL_FIELD (cache_long_scans) = val;
208 static void
209 bset_case_fold_search (struct buffer *b, Lisp_Object val)
211 b->INTERNAL_FIELD (case_fold_search) = val;
213 static void
214 bset_ctl_arrow (struct buffer *b, Lisp_Object val)
216 b->INTERNAL_FIELD (ctl_arrow) = val;
218 static void
219 bset_cursor_in_non_selected_windows (struct buffer *b, Lisp_Object val)
221 b->INTERNAL_FIELD (cursor_in_non_selected_windows) = val;
223 static void
224 bset_cursor_type (struct buffer *b, Lisp_Object val)
226 b->INTERNAL_FIELD (cursor_type) = val;
228 static void
229 bset_display_table (struct buffer *b, Lisp_Object val)
231 b->INTERNAL_FIELD (display_table) = val;
233 static void
234 bset_extra_line_spacing (struct buffer *b, Lisp_Object val)
236 b->INTERNAL_FIELD (extra_line_spacing) = val;
238 static void
239 bset_file_format (struct buffer *b, Lisp_Object val)
241 b->INTERNAL_FIELD (file_format) = val;
243 static void
244 bset_file_truename (struct buffer *b, Lisp_Object val)
246 b->INTERNAL_FIELD (file_truename) = val;
248 static void
249 bset_fringe_cursor_alist (struct buffer *b, Lisp_Object val)
251 b->INTERNAL_FIELD (fringe_cursor_alist) = val;
253 static void
254 bset_fringe_indicator_alist (struct buffer *b, Lisp_Object val)
256 b->INTERNAL_FIELD (fringe_indicator_alist) = val;
258 static void
259 bset_fringes_outside_margins (struct buffer *b, Lisp_Object val)
261 b->INTERNAL_FIELD (fringes_outside_margins) = val;
263 static void
264 bset_header_line_format (struct buffer *b, Lisp_Object val)
266 b->INTERNAL_FIELD (header_line_format) = val;
268 static void
269 bset_indicate_buffer_boundaries (struct buffer *b, Lisp_Object val)
271 b->INTERNAL_FIELD (indicate_buffer_boundaries) = val;
273 static void
274 bset_indicate_empty_lines (struct buffer *b, Lisp_Object val)
276 b->INTERNAL_FIELD (indicate_empty_lines) = val;
278 static void
279 bset_invisibility_spec (struct buffer *b, Lisp_Object val)
281 b->INTERNAL_FIELD (invisibility_spec) = val;
283 static void
284 bset_left_fringe_width (struct buffer *b, Lisp_Object val)
286 b->INTERNAL_FIELD (left_fringe_width) = val;
288 static void
289 bset_major_mode (struct buffer *b, Lisp_Object val)
291 b->INTERNAL_FIELD (major_mode) = val;
293 static void
294 bset_mark (struct buffer *b, Lisp_Object val)
296 b->INTERNAL_FIELD (mark) = val;
298 static void
299 bset_minor_modes (struct buffer *b, Lisp_Object val)
301 b->INTERNAL_FIELD (minor_modes) = val;
303 static void
304 bset_mode_line_format (struct buffer *b, Lisp_Object val)
306 b->INTERNAL_FIELD (mode_line_format) = val;
308 static void
309 bset_mode_name (struct buffer *b, Lisp_Object val)
311 b->INTERNAL_FIELD (mode_name) = val;
313 static void
314 bset_name (struct buffer *b, Lisp_Object val)
316 b->INTERNAL_FIELD (name) = val;
318 static void
319 bset_overwrite_mode (struct buffer *b, Lisp_Object val)
321 b->INTERNAL_FIELD (overwrite_mode) = val;
323 static void
324 bset_pt_marker (struct buffer *b, Lisp_Object val)
326 b->INTERNAL_FIELD (pt_marker) = val;
328 static void
329 bset_right_fringe_width (struct buffer *b, Lisp_Object val)
331 b->INTERNAL_FIELD (right_fringe_width) = val;
333 static void
334 bset_save_length (struct buffer *b, Lisp_Object val)
336 b->INTERNAL_FIELD (save_length) = val;
338 static void
339 bset_scroll_bar_width (struct buffer *b, Lisp_Object val)
341 b->INTERNAL_FIELD (scroll_bar_width) = val;
343 static void
344 bset_scroll_down_aggressively (struct buffer *b, Lisp_Object val)
346 b->INTERNAL_FIELD (scroll_down_aggressively) = val;
348 static void
349 bset_scroll_up_aggressively (struct buffer *b, Lisp_Object val)
351 b->INTERNAL_FIELD (scroll_up_aggressively) = val;
353 static void
354 bset_selective_display (struct buffer *b, Lisp_Object val)
356 b->INTERNAL_FIELD (selective_display) = val;
358 static void
359 bset_selective_display_ellipses (struct buffer *b, Lisp_Object val)
361 b->INTERNAL_FIELD (selective_display_ellipses) = val;
363 static void
364 bset_vertical_scroll_bar_type (struct buffer *b, Lisp_Object val)
366 b->INTERNAL_FIELD (vertical_scroll_bar_type) = val;
368 static void
369 bset_word_wrap (struct buffer *b, Lisp_Object val)
371 b->INTERNAL_FIELD (word_wrap) = val;
373 static void
374 bset_zv_marker (struct buffer *b, Lisp_Object val)
376 b->INTERNAL_FIELD (zv_marker) = val;
379 void
380 nsberror (Lisp_Object spec)
382 if (STRINGP (spec))
383 error ("No buffer named %s", SDATA (spec));
384 error ("Invalid buffer argument");
387 DEFUN ("buffer-live-p", Fbuffer_live_p, Sbuffer_live_p, 1, 1, 0,
388 doc: /* Return non-nil if OBJECT is a buffer which has not been killed.
389 Value is nil if OBJECT is not a buffer or if it has been killed. */)
390 (Lisp_Object object)
392 return ((BUFFERP (object) && BUFFER_LIVE_P (XBUFFER (object)))
393 ? Qt : Qnil);
396 DEFUN ("buffer-list", Fbuffer_list, Sbuffer_list, 0, 1, 0,
397 doc: /* Return a list of all existing live buffers.
398 If the optional arg FRAME is a frame, we return the buffer list in the
399 proper order for that frame: the buffers show in FRAME come first,
400 followed by the rest of the buffers. */)
401 (Lisp_Object frame)
403 Lisp_Object general;
404 general = Fmapcar (Qcdr, Vbuffer_alist);
406 if (FRAMEP (frame))
408 Lisp_Object framelist, prevlist, tail;
409 Lisp_Object args[3];
411 framelist = Fcopy_sequence (XFRAME (frame)->buffer_list);
412 prevlist = Fnreverse (Fcopy_sequence
413 (XFRAME (frame)->buried_buffer_list));
415 /* Remove from GENERAL any buffer that duplicates one in
416 FRAMELIST or PREVLIST. */
417 tail = framelist;
418 while (CONSP (tail))
420 general = Fdelq (XCAR (tail), general);
421 tail = XCDR (tail);
423 tail = prevlist;
424 while (CONSP (tail))
426 general = Fdelq (XCAR (tail), general);
427 tail = XCDR (tail);
430 args[0] = framelist;
431 args[1] = general;
432 args[2] = prevlist;
433 return Fnconc (3, args);
435 else
436 return general;
439 /* Like Fassoc, but use Fstring_equal to compare
440 (which ignores text properties),
441 and don't ever QUIT. */
443 static Lisp_Object
444 assoc_ignore_text_properties (register Lisp_Object key, Lisp_Object list)
446 register Lisp_Object tail;
447 for (tail = list; CONSP (tail); tail = XCDR (tail))
449 register Lisp_Object elt, tem;
450 elt = XCAR (tail);
451 tem = Fstring_equal (Fcar (elt), key);
452 if (!NILP (tem))
453 return elt;
455 return Qnil;
458 DEFUN ("get-buffer", Fget_buffer, Sget_buffer, 1, 1, 0,
459 doc: /* Return the buffer named BUFFER-OR-NAME.
460 BUFFER-OR-NAME must be either a string or a buffer. If BUFFER-OR-NAME
461 is a string and there is no buffer with that name, return nil. If
462 BUFFER-OR-NAME is a buffer, return it as given. */)
463 (register Lisp_Object buffer_or_name)
465 if (BUFFERP (buffer_or_name))
466 return buffer_or_name;
467 CHECK_STRING (buffer_or_name);
469 return Fcdr (assoc_ignore_text_properties (buffer_or_name, Vbuffer_alist));
472 DEFUN ("get-file-buffer", Fget_file_buffer, Sget_file_buffer, 1, 1, 0,
473 doc: /* Return the buffer visiting file FILENAME (a string).
474 The buffer's `buffer-file-name' must match exactly the expansion of FILENAME.
475 If there is no such live buffer, return nil.
476 See also `find-buffer-visiting'. */)
477 (register Lisp_Object filename)
479 register Lisp_Object tail, buf, handler;
481 CHECK_STRING (filename);
482 filename = Fexpand_file_name (filename, Qnil);
484 /* If the file name has special constructs in it,
485 call the corresponding file handler. */
486 handler = Ffind_file_name_handler (filename, Qget_file_buffer);
487 if (!NILP (handler))
489 Lisp_Object handled_buf = call2 (handler, Qget_file_buffer,
490 filename);
491 return BUFFERP (handled_buf) ? handled_buf : Qnil;
494 FOR_EACH_LIVE_BUFFER (tail, buf)
496 if (!STRINGP (BVAR (XBUFFER (buf), filename))) continue;
497 if (!NILP (Fstring_equal (BVAR (XBUFFER (buf), filename), filename)))
498 return buf;
500 return Qnil;
503 Lisp_Object
504 get_truename_buffer (register Lisp_Object filename)
506 register Lisp_Object tail, buf;
508 FOR_EACH_LIVE_BUFFER (tail, buf)
510 if (!STRINGP (BVAR (XBUFFER (buf), file_truename))) continue;
511 if (!NILP (Fstring_equal (BVAR (XBUFFER (buf), file_truename), filename)))
512 return buf;
514 return Qnil;
517 DEFUN ("get-buffer-create", Fget_buffer_create, Sget_buffer_create, 1, 1, 0,
518 doc: /* Return the buffer specified by BUFFER-OR-NAME, creating a new one if needed.
519 If BUFFER-OR-NAME is a string and a live buffer with that name exists,
520 return that buffer. If no such buffer exists, create a new buffer with
521 that name and return it. If BUFFER-OR-NAME starts with a space, the new
522 buffer does not keep undo information.
524 If BUFFER-OR-NAME is a buffer instead of a string, return it as given,
525 even if it is dead. The return value is never nil. */)
526 (register Lisp_Object buffer_or_name)
528 register Lisp_Object buffer, name;
529 register struct buffer *b;
531 buffer = Fget_buffer (buffer_or_name);
532 if (!NILP (buffer))
533 return buffer;
535 if (SCHARS (buffer_or_name) == 0)
536 error ("Empty string for buffer name is not allowed");
538 b = allocate_buffer ();
540 /* An ordinary buffer uses its own struct buffer_text. */
541 b->text = &b->own_text;
542 b->base_buffer = NULL;
543 /* No one shares the text with us now. */
544 b->indirections = 0;
545 /* No one shows us now. */
546 b->window_count = 0;
548 BUF_GAP_SIZE (b) = 20;
549 block_input ();
550 /* We allocate extra 1-byte at the tail and keep it always '\0' for
551 anchoring a search. */
552 alloc_buffer_text (b, BUF_GAP_SIZE (b) + 1);
553 unblock_input ();
554 if (! BUF_BEG_ADDR (b))
555 buffer_memory_full (BUF_GAP_SIZE (b) + 1);
557 b->pt = BEG;
558 b->begv = BEG;
559 b->zv = BEG;
560 b->pt_byte = BEG_BYTE;
561 b->begv_byte = BEG_BYTE;
562 b->zv_byte = BEG_BYTE;
564 BUF_GPT (b) = BEG;
565 BUF_GPT_BYTE (b) = BEG_BYTE;
567 BUF_Z (b) = BEG;
568 BUF_Z_BYTE (b) = BEG_BYTE;
569 BUF_MODIFF (b) = 1;
570 BUF_CHARS_MODIFF (b) = 1;
571 BUF_OVERLAY_MODIFF (b) = 1;
572 BUF_SAVE_MODIFF (b) = 1;
573 BUF_COMPACT (b) = 1;
574 set_buffer_intervals (b, NULL);
575 BUF_UNCHANGED_MODIFIED (b) = 1;
576 BUF_OVERLAY_UNCHANGED_MODIFIED (b) = 1;
577 BUF_END_UNCHANGED (b) = 0;
578 BUF_BEG_UNCHANGED (b) = 0;
579 *(BUF_GPT_ADDR (b)) = *(BUF_Z_ADDR (b)) = 0; /* Put an anchor '\0'. */
580 b->text->inhibit_shrinking = 0;
582 b->newline_cache = 0;
583 b->width_run_cache = 0;
584 b->bidi_paragraph_cache = 0;
585 bset_width_table (b, Qnil);
586 b->prevent_redisplay_optimizations_p = 1;
588 /* An ordinary buffer normally doesn't need markers
589 to handle BEGV and ZV. */
590 bset_pt_marker (b, Qnil);
591 bset_begv_marker (b, Qnil);
592 bset_zv_marker (b, Qnil);
594 name = Fcopy_sequence (buffer_or_name);
595 set_string_intervals (name, NULL);
596 bset_name (b, name);
598 bset_undo_list (b, SREF (name, 0) != ' ' ? Qnil : Qt);
600 reset_buffer (b);
601 reset_buffer_local_variables (b, 1);
603 bset_mark (b, Fmake_marker ());
604 BUF_MARKERS (b) = NULL;
606 /* Put this in the alist of all live buffers. */
607 XSETBUFFER (buffer, b);
608 Vbuffer_alist = nconc2 (Vbuffer_alist, list1 (Fcons (name, buffer)));
609 /* And run buffer-list-update-hook. */
610 if (!NILP (Vrun_hooks))
611 call1 (Vrun_hooks, Qbuffer_list_update_hook);
613 return buffer;
617 /* Return a list of overlays which is a copy of the overlay list
618 LIST, but for buffer B. */
620 static struct Lisp_Overlay *
621 copy_overlays (struct buffer *b, struct Lisp_Overlay *list)
623 struct Lisp_Overlay *result = NULL, *tail = NULL;
625 for (; list; list = list->next)
627 Lisp_Object overlay, start, end;
628 struct Lisp_Marker *m;
630 eassert (MARKERP (list->start));
631 m = XMARKER (list->start);
632 start = build_marker (b, m->charpos, m->bytepos);
633 XMARKER (start)->insertion_type = m->insertion_type;
635 eassert (MARKERP (list->end));
636 m = XMARKER (list->end);
637 end = build_marker (b, m->charpos, m->bytepos);
638 XMARKER (end)->insertion_type = m->insertion_type;
640 overlay = build_overlay (start, end, Fcopy_sequence (list->plist));
641 if (tail)
642 tail = tail->next = XOVERLAY (overlay);
643 else
644 result = tail = XOVERLAY (overlay);
647 return result;
650 /* Set an appropriate overlay of B. */
652 static void
653 set_buffer_overlays_before (struct buffer *b, struct Lisp_Overlay *o)
655 b->overlays_before = o;
658 static void
659 set_buffer_overlays_after (struct buffer *b, struct Lisp_Overlay *o)
661 b->overlays_after = o;
664 /* Clone per-buffer values of buffer FROM.
666 Buffer TO gets the same per-buffer values as FROM, with the
667 following exceptions: (1) TO's name is left untouched, (2) markers
668 are copied and made to refer to TO, and (3) overlay lists are
669 copied. */
671 static void
672 clone_per_buffer_values (struct buffer *from, struct buffer *to)
674 int offset;
676 FOR_EACH_PER_BUFFER_OBJECT_AT (offset)
678 Lisp_Object obj;
680 /* Don't touch the `name' which should be unique for every buffer. */
681 if (offset == PER_BUFFER_VAR_OFFSET (name))
682 continue;
684 obj = per_buffer_value (from, offset);
685 if (MARKERP (obj) && XMARKER (obj)->buffer == from)
687 struct Lisp_Marker *m = XMARKER (obj);
689 obj = build_marker (to, m->charpos, m->bytepos);
690 XMARKER (obj)->insertion_type = m->insertion_type;
693 set_per_buffer_value (to, offset, obj);
696 memcpy (to->local_flags, from->local_flags, sizeof to->local_flags);
698 set_buffer_overlays_before (to, copy_overlays (to, from->overlays_before));
699 set_buffer_overlays_after (to, copy_overlays (to, from->overlays_after));
701 /* Get (a copy of) the alist of Lisp-level local variables of FROM
702 and install that in TO. */
703 bset_local_var_alist (to, buffer_lisp_local_variables (from, 1));
707 /* If buffer B has markers to record PT, BEGV and ZV when it is not
708 current, update these markers. */
710 static void
711 record_buffer_markers (struct buffer *b)
713 if (! NILP (BVAR (b, pt_marker)))
715 Lisp_Object buffer;
717 eassert (!NILP (BVAR (b, begv_marker)));
718 eassert (!NILP (BVAR (b, zv_marker)));
720 XSETBUFFER (buffer, b);
721 set_marker_both (BVAR (b, pt_marker), buffer, b->pt, b->pt_byte);
722 set_marker_both (BVAR (b, begv_marker), buffer, b->begv, b->begv_byte);
723 set_marker_both (BVAR (b, zv_marker), buffer, b->zv, b->zv_byte);
728 /* If buffer B has markers to record PT, BEGV and ZV when it is not
729 current, fetch these values into B->begv etc. */
731 static void
732 fetch_buffer_markers (struct buffer *b)
734 if (! NILP (BVAR (b, pt_marker)))
736 Lisp_Object m;
738 eassert (!NILP (BVAR (b, begv_marker)));
739 eassert (!NILP (BVAR (b, zv_marker)));
741 m = BVAR (b, pt_marker);
742 SET_BUF_PT_BOTH (b, marker_position (m), marker_byte_position (m));
744 m = BVAR (b, begv_marker);
745 SET_BUF_BEGV_BOTH (b, marker_position (m), marker_byte_position (m));
747 m = BVAR (b, zv_marker);
748 SET_BUF_ZV_BOTH (b, marker_position (m), marker_byte_position (m));
753 DEFUN ("make-indirect-buffer", Fmake_indirect_buffer, Smake_indirect_buffer,
754 2, 3,
755 "bMake indirect buffer (to buffer): \nBName of indirect buffer: ",
756 doc: /* Create and return an indirect buffer for buffer BASE-BUFFER, named NAME.
757 BASE-BUFFER should be a live buffer, or the name of an existing buffer.
758 NAME should be a string which is not the name of an existing buffer.
759 Optional argument CLONE non-nil means preserve BASE-BUFFER's state,
760 such as major and minor modes, in the indirect buffer.
761 CLONE nil means the indirect buffer's state is reset to default values. */)
762 (Lisp_Object base_buffer, Lisp_Object name, Lisp_Object clone)
764 Lisp_Object buf, tem;
765 struct buffer *b;
767 CHECK_STRING (name);
768 buf = Fget_buffer (name);
769 if (!NILP (buf))
770 error ("Buffer name `%s' is in use", SDATA (name));
772 tem = base_buffer;
773 base_buffer = Fget_buffer (base_buffer);
774 if (NILP (base_buffer))
775 error ("No such buffer: `%s'", SDATA (tem));
776 if (!BUFFER_LIVE_P (XBUFFER (base_buffer)))
777 error ("Base buffer has been killed");
779 if (SCHARS (name) == 0)
780 error ("Empty string for buffer name is not allowed");
782 b = allocate_buffer ();
784 /* No double indirection - if base buffer is indirect,
785 new buffer becomes an indirect to base's base. */
786 b->base_buffer = (XBUFFER (base_buffer)->base_buffer
787 ? XBUFFER (base_buffer)->base_buffer
788 : XBUFFER (base_buffer));
790 /* Use the base buffer's text object. */
791 b->text = b->base_buffer->text;
792 /* We have no own text. */
793 b->indirections = -1;
794 /* Notify base buffer that we share the text now. */
795 b->base_buffer->indirections++;
796 /* Always -1 for an indirect buffer. */
797 b->window_count = -1;
799 b->pt = b->base_buffer->pt;
800 b->begv = b->base_buffer->begv;
801 b->zv = b->base_buffer->zv;
802 b->pt_byte = b->base_buffer->pt_byte;
803 b->begv_byte = b->base_buffer->begv_byte;
804 b->zv_byte = b->base_buffer->zv_byte;
806 b->newline_cache = 0;
807 b->width_run_cache = 0;
808 b->bidi_paragraph_cache = 0;
809 bset_width_table (b, Qnil);
811 name = Fcopy_sequence (name);
812 set_string_intervals (name, NULL);
813 bset_name (b, name);
815 reset_buffer (b);
816 reset_buffer_local_variables (b, 1);
818 /* Put this in the alist of all live buffers. */
819 XSETBUFFER (buf, b);
820 Vbuffer_alist = nconc2 (Vbuffer_alist, list1 (Fcons (name, buf)));
822 bset_mark (b, Fmake_marker ());
824 /* The multibyte status belongs to the base buffer. */
825 bset_enable_multibyte_characters
826 (b, BVAR (b->base_buffer, enable_multibyte_characters));
828 /* Make sure the base buffer has markers for its narrowing. */
829 if (NILP (BVAR (b->base_buffer, pt_marker)))
831 eassert (NILP (BVAR (b->base_buffer, begv_marker)));
832 eassert (NILP (BVAR (b->base_buffer, zv_marker)));
834 bset_pt_marker (b->base_buffer,
835 build_marker (b->base_buffer, b->base_buffer->pt,
836 b->base_buffer->pt_byte));
838 bset_begv_marker (b->base_buffer,
839 build_marker (b->base_buffer, b->base_buffer->begv,
840 b->base_buffer->begv_byte));
842 bset_zv_marker (b->base_buffer,
843 build_marker (b->base_buffer, b->base_buffer->zv,
844 b->base_buffer->zv_byte));
846 XMARKER (BVAR (b->base_buffer, zv_marker))->insertion_type = 1;
849 if (NILP (clone))
851 /* Give the indirect buffer markers for its narrowing. */
852 bset_pt_marker (b, build_marker (b, b->pt, b->pt_byte));
853 bset_begv_marker (b, build_marker (b, b->begv, b->begv_byte));
854 bset_zv_marker (b, build_marker (b, b->zv, b->zv_byte));
855 XMARKER (BVAR (b, zv_marker))->insertion_type = 1;
857 else
859 struct buffer *old_b = current_buffer;
861 clone_per_buffer_values (b->base_buffer, b);
862 bset_filename (b, Qnil);
863 bset_file_truename (b, Qnil);
864 bset_display_count (b, make_number (0));
865 bset_backed_up (b, Qnil);
866 bset_auto_save_file_name (b, Qnil);
867 set_buffer_internal_1 (b);
868 Fset (intern ("buffer-save-without-query"), Qnil);
869 Fset (intern ("buffer-file-number"), Qnil);
870 Fset (intern ("buffer-stale-function"), Qnil);
871 set_buffer_internal_1 (old_b);
874 /* Run buffer-list-update-hook. */
875 if (!NILP (Vrun_hooks))
876 call1 (Vrun_hooks, Qbuffer_list_update_hook);
878 return buf;
881 /* Mark OV as no longer associated with B. */
883 static void
884 drop_overlay (struct buffer *b, struct Lisp_Overlay *ov)
886 eassert (b == XBUFFER (Fmarker_buffer (ov->start)));
887 modify_overlay (b, marker_position (ov->start),
888 marker_position (ov->end));
889 Fset_marker (ov->start, Qnil, Qnil);
890 Fset_marker (ov->end, Qnil, Qnil);
894 /* Delete all overlays of B and reset it's overlay lists. */
896 void
897 delete_all_overlays (struct buffer *b)
899 struct Lisp_Overlay *ov, *next;
901 /* FIXME: Since each drop_overlay will scan BUF_MARKERS to unlink its
902 markers, we have an unneeded O(N^2) behavior here. */
903 for (ov = b->overlays_before; ov; ov = next)
905 drop_overlay (b, ov);
906 next = ov->next;
907 ov->next = NULL;
910 for (ov = b->overlays_after; ov; ov = next)
912 drop_overlay (b, ov);
913 next = ov->next;
914 ov->next = NULL;
917 set_buffer_overlays_before (b, NULL);
918 set_buffer_overlays_after (b, NULL);
921 /* Reinitialize everything about a buffer except its name and contents
922 and local variables.
923 If called on an already-initialized buffer, the list of overlays
924 should be deleted before calling this function, otherwise we end up
925 with overlays that claim to belong to the buffer but the buffer
926 claims it doesn't belong to it. */
928 void
929 reset_buffer (register struct buffer *b)
931 bset_filename (b, Qnil);
932 bset_file_truename (b, Qnil);
933 bset_directory (b, current_buffer ? BVAR (current_buffer, directory) : Qnil);
934 b->modtime = make_emacs_time (0, UNKNOWN_MODTIME_NSECS);
935 b->modtime_size = -1;
936 XSETFASTINT (BVAR (b, save_length), 0);
937 b->last_window_start = 1;
938 /* It is more conservative to start out "changed" than "unchanged". */
939 b->clip_changed = 0;
940 b->prevent_redisplay_optimizations_p = 1;
941 bset_backed_up (b, Qnil);
942 BUF_AUTOSAVE_MODIFF (b) = 0;
943 b->auto_save_failure_time = 0;
944 bset_auto_save_file_name (b, Qnil);
945 bset_read_only (b, Qnil);
946 set_buffer_overlays_before (b, NULL);
947 set_buffer_overlays_after (b, NULL);
948 b->overlay_center = BEG;
949 bset_mark_active (b, Qnil);
950 bset_point_before_scroll (b, Qnil);
951 bset_file_format (b, Qnil);
952 bset_auto_save_file_format (b, Qt);
953 bset_last_selected_window (b, Qnil);
954 bset_display_count (b, make_number (0));
955 bset_display_time (b, Qnil);
956 bset_enable_multibyte_characters
957 (b, BVAR (&buffer_defaults, enable_multibyte_characters));
958 bset_cursor_type (b, BVAR (&buffer_defaults, cursor_type));
959 bset_extra_line_spacing (b, BVAR (&buffer_defaults, extra_line_spacing));
961 b->display_error_modiff = 0;
964 /* Reset buffer B's local variables info.
965 Don't use this on a buffer that has already been in use;
966 it does not treat permanent locals consistently.
967 Instead, use Fkill_all_local_variables.
969 If PERMANENT_TOO, reset permanent buffer-local variables.
970 If not, preserve those. */
972 static void
973 reset_buffer_local_variables (struct buffer *b, bool permanent_too)
975 int offset, i;
977 /* Reset the major mode to Fundamental, together with all the
978 things that depend on the major mode.
979 default-major-mode is handled at a higher level.
980 We ignore it here. */
981 bset_major_mode (b, Qfundamental_mode);
982 bset_keymap (b, Qnil);
983 bset_mode_name (b, QSFundamental);
984 bset_minor_modes (b, Qnil);
986 /* If the standard case table has been altered and invalidated,
987 fix up its insides first. */
988 if (! (CHAR_TABLE_P (XCHAR_TABLE (Vascii_downcase_table)->extras[0])
989 && CHAR_TABLE_P (XCHAR_TABLE (Vascii_downcase_table)->extras[1])
990 && CHAR_TABLE_P (XCHAR_TABLE (Vascii_downcase_table)->extras[2])))
991 Fset_standard_case_table (Vascii_downcase_table);
993 bset_downcase_table (b, Vascii_downcase_table);
994 bset_upcase_table (b, XCHAR_TABLE (Vascii_downcase_table)->extras[0]);
995 bset_case_canon_table (b, XCHAR_TABLE (Vascii_downcase_table)->extras[1]);
996 bset_case_eqv_table (b, XCHAR_TABLE (Vascii_downcase_table)->extras[2]);
997 bset_invisibility_spec (b, Qt);
999 /* Reset all (or most) per-buffer variables to their defaults. */
1000 if (permanent_too)
1001 bset_local_var_alist (b, Qnil);
1002 else
1004 Lisp_Object tmp, prop, last = Qnil;
1005 for (tmp = BVAR (b, local_var_alist); CONSP (tmp); tmp = XCDR (tmp))
1006 if (!NILP (prop = Fget (XCAR (XCAR (tmp)), Qpermanent_local)))
1008 /* If permanent-local, keep it. */
1009 last = tmp;
1010 if (EQ (prop, Qpermanent_local_hook))
1012 /* This is a partially permanent hook variable.
1013 Preserve only the elements that want to be preserved. */
1014 Lisp_Object list, newlist;
1015 list = XCDR (XCAR (tmp));
1016 if (!CONSP (list))
1017 newlist = list;
1018 else
1019 for (newlist = Qnil; CONSP (list); list = XCDR (list))
1021 Lisp_Object elt = XCAR (list);
1022 /* Preserve element ELT if it's t,
1023 if it is a function with a `permanent-local-hook' property,
1024 or if it's not a symbol. */
1025 if (! SYMBOLP (elt)
1026 || EQ (elt, Qt)
1027 || !NILP (Fget (elt, Qpermanent_local_hook)))
1028 newlist = Fcons (elt, newlist);
1030 XSETCDR (XCAR (tmp), Fnreverse (newlist));
1033 /* Delete this local variable. */
1034 else if (NILP (last))
1035 bset_local_var_alist (b, XCDR (tmp));
1036 else
1037 XSETCDR (last, XCDR (tmp));
1040 for (i = 0; i < last_per_buffer_idx; ++i)
1041 if (permanent_too || buffer_permanent_local_flags[i] == 0)
1042 SET_PER_BUFFER_VALUE_P (b, i, 0);
1044 /* For each slot that has a default value, copy that into the slot. */
1045 FOR_EACH_PER_BUFFER_OBJECT_AT (offset)
1047 int idx = PER_BUFFER_IDX (offset);
1048 if ((idx > 0
1049 && (permanent_too
1050 || buffer_permanent_local_flags[idx] == 0)))
1051 set_per_buffer_value (b, offset, per_buffer_default (offset));
1055 /* We split this away from generate-new-buffer, because rename-buffer
1056 and set-visited-file-name ought to be able to use this to really
1057 rename the buffer properly. */
1059 DEFUN ("generate-new-buffer-name", Fgenerate_new_buffer_name,
1060 Sgenerate_new_buffer_name, 1, 2, 0,
1061 doc: /* Return a string that is the name of no existing buffer based on NAME.
1062 If there is no live buffer named NAME, then return NAME.
1063 Otherwise modify name by appending `<NUMBER>', incrementing NUMBER
1064 \(starting at 2) until an unused name is found, and then return that name.
1065 Optional second argument IGNORE specifies a name that is okay to use (if
1066 it is in the sequence to be tried) even if a buffer with that name exists.
1068 If NAME begins with a space (i.e., a buffer that is not normally
1069 visible to users), then if buffer NAME already exists a random number
1070 is first appended to NAME, to speed up finding a non-existent buffer. */)
1071 (register Lisp_Object name, Lisp_Object ignore)
1073 register Lisp_Object gentemp, tem, tem2;
1074 ptrdiff_t count;
1075 char number[INT_BUFSIZE_BOUND (ptrdiff_t) + sizeof "<>"];
1077 CHECK_STRING (name);
1079 tem = Fstring_equal (name, ignore);
1080 if (!NILP (tem))
1081 return name;
1082 tem = Fget_buffer (name);
1083 if (NILP (tem))
1084 return name;
1086 if (!strncmp (SSDATA (name), " ", 1)) /* see bug#1229 */
1088 /* Note fileio.c:make_temp_name does random differently. */
1089 tem2 = concat2 (name, make_formatted_string
1090 (number, "-%"pI"d",
1091 XFASTINT (Frandom (make_number (999999)))));
1092 tem = Fget_buffer (tem2);
1093 if (NILP (tem))
1094 return tem2;
1096 else
1097 tem2 = name;
1099 count = 1;
1100 while (1)
1102 gentemp = concat2 (tem2, make_formatted_string
1103 (number, "<%"pD"d>", ++count));
1104 tem = Fstring_equal (gentemp, ignore);
1105 if (!NILP (tem))
1106 return gentemp;
1107 tem = Fget_buffer (gentemp);
1108 if (NILP (tem))
1109 return gentemp;
1114 DEFUN ("buffer-name", Fbuffer_name, Sbuffer_name, 0, 1, 0,
1115 doc: /* Return the name of BUFFER, as a string.
1116 BUFFER defaults to the current buffer.
1117 Return nil if BUFFER has been killed. */)
1118 (register Lisp_Object buffer)
1120 if (NILP (buffer))
1121 return BVAR (current_buffer, name);
1122 CHECK_BUFFER (buffer);
1123 return BVAR (XBUFFER (buffer), name);
1126 DEFUN ("buffer-file-name", Fbuffer_file_name, Sbuffer_file_name, 0, 1, 0,
1127 doc: /* Return name of file BUFFER is visiting, or nil if none.
1128 No argument or nil as argument means use the current buffer. */)
1129 (register Lisp_Object buffer)
1131 if (NILP (buffer))
1132 return BVAR (current_buffer, filename);
1133 CHECK_BUFFER (buffer);
1134 return BVAR (XBUFFER (buffer), filename);
1137 DEFUN ("buffer-base-buffer", Fbuffer_base_buffer, Sbuffer_base_buffer,
1138 0, 1, 0,
1139 doc: /* Return the base buffer of indirect buffer BUFFER.
1140 If BUFFER is not indirect, return nil.
1141 BUFFER defaults to the current buffer. */)
1142 (register Lisp_Object buffer)
1144 struct buffer *base;
1145 Lisp_Object base_buffer;
1147 if (NILP (buffer))
1148 base = current_buffer->base_buffer;
1149 else
1151 CHECK_BUFFER (buffer);
1152 base = XBUFFER (buffer)->base_buffer;
1155 if (! base)
1156 return Qnil;
1157 XSETBUFFER (base_buffer, base);
1158 return base_buffer;
1161 DEFUN ("buffer-local-value", Fbuffer_local_value,
1162 Sbuffer_local_value, 2, 2, 0,
1163 doc: /* Return the value of VARIABLE in BUFFER.
1164 If VARIABLE does not have a buffer-local binding in BUFFER, the value
1165 is the default binding of the variable. */)
1166 (register Lisp_Object variable, register Lisp_Object buffer)
1168 register Lisp_Object result = buffer_local_value_1 (variable, buffer);
1170 if (EQ (result, Qunbound))
1171 xsignal1 (Qvoid_variable, variable);
1173 return result;
1177 /* Like Fbuffer_local_value, but return Qunbound if the variable is
1178 locally unbound. */
1180 Lisp_Object
1181 buffer_local_value_1 (Lisp_Object variable, Lisp_Object buffer)
1183 register struct buffer *buf;
1184 register Lisp_Object result;
1185 struct Lisp_Symbol *sym;
1187 CHECK_SYMBOL (variable);
1188 CHECK_BUFFER (buffer);
1189 buf = XBUFFER (buffer);
1190 sym = XSYMBOL (variable);
1192 start:
1193 switch (sym->redirect)
1195 case SYMBOL_VARALIAS: sym = indirect_variable (sym); goto start;
1196 case SYMBOL_PLAINVAL: result = SYMBOL_VAL (sym); break;
1197 case SYMBOL_LOCALIZED:
1198 { /* Look in local_var_alist. */
1199 struct Lisp_Buffer_Local_Value *blv = SYMBOL_BLV (sym);
1200 XSETSYMBOL (variable, sym); /* Update In case of aliasing. */
1201 result = Fassoc (variable, BVAR (buf, local_var_alist));
1202 if (!NILP (result))
1204 if (blv->fwd)
1205 { /* What binding is loaded right now? */
1206 Lisp_Object current_alist_element = blv->valcell;
1208 /* The value of the currently loaded binding is not
1209 stored in it, but rather in the realvalue slot.
1210 Store that value into the binding it belongs to
1211 in case that is the one we are about to use. */
1213 XSETCDR (current_alist_element,
1214 do_symval_forwarding (blv->fwd));
1216 /* Now get the (perhaps updated) value out of the binding. */
1217 result = XCDR (result);
1219 else
1220 result = Fdefault_value (variable);
1221 break;
1223 case SYMBOL_FORWARDED:
1225 union Lisp_Fwd *fwd = SYMBOL_FWD (sym);
1226 if (BUFFER_OBJFWDP (fwd))
1227 result = per_buffer_value (buf, XBUFFER_OBJFWD (fwd)->offset);
1228 else
1229 result = Fdefault_value (variable);
1230 break;
1232 default: emacs_abort ();
1235 return result;
1238 /* Return an alist of the Lisp-level buffer-local bindings of
1239 buffer BUF. That is, don't include the variables maintained
1240 in special slots in the buffer object.
1241 If not CLONE, replace elements of the form (VAR . unbound)
1242 by VAR. */
1244 static Lisp_Object
1245 buffer_lisp_local_variables (struct buffer *buf, bool clone)
1247 Lisp_Object result = Qnil;
1248 Lisp_Object tail;
1249 for (tail = BVAR (buf, local_var_alist); CONSP (tail); tail = XCDR (tail))
1251 Lisp_Object val, elt;
1253 elt = XCAR (tail);
1255 /* Reference each variable in the alist in buf.
1256 If inquiring about the current buffer, this gets the current values,
1257 so store them into the alist so the alist is up to date.
1258 If inquiring about some other buffer, this swaps out any values
1259 for that buffer, making the alist up to date automatically. */
1260 val = find_symbol_value (XCAR (elt));
1261 /* Use the current buffer value only if buf is the current buffer. */
1262 if (buf != current_buffer)
1263 val = XCDR (elt);
1265 result = Fcons (!clone && EQ (val, Qunbound)
1266 ? XCAR (elt)
1267 : Fcons (XCAR (elt), val),
1268 result);
1271 return result;
1274 DEFUN ("buffer-local-variables", Fbuffer_local_variables,
1275 Sbuffer_local_variables, 0, 1, 0,
1276 doc: /* Return an alist of variables that are buffer-local in BUFFER.
1277 Most elements look like (SYMBOL . VALUE), describing one variable.
1278 For a symbol that is locally unbound, just the symbol appears in the value.
1279 Note that storing new VALUEs in these elements doesn't change the variables.
1280 No argument or nil as argument means use current buffer as BUFFER. */)
1281 (register Lisp_Object buffer)
1283 register struct buffer *buf;
1284 register Lisp_Object result;
1286 if (NILP (buffer))
1287 buf = current_buffer;
1288 else
1290 CHECK_BUFFER (buffer);
1291 buf = XBUFFER (buffer);
1294 result = buffer_lisp_local_variables (buf, 0);
1296 /* Add on all the variables stored in special slots. */
1298 int offset, idx;
1300 FOR_EACH_PER_BUFFER_OBJECT_AT (offset)
1302 idx = PER_BUFFER_IDX (offset);
1303 if ((idx == -1 || PER_BUFFER_VALUE_P (buf, idx))
1304 && SYMBOLP (PER_BUFFER_SYMBOL (offset)))
1306 Lisp_Object sym = PER_BUFFER_SYMBOL (offset);
1307 Lisp_Object val = per_buffer_value (buf, offset);
1308 result = Fcons (EQ (val, Qunbound) ? sym : Fcons (sym, val),
1309 result);
1314 return result;
1317 DEFUN ("buffer-modified-p", Fbuffer_modified_p, Sbuffer_modified_p,
1318 0, 1, 0,
1319 doc: /* Return t if BUFFER was modified since its file was last read or saved.
1320 No argument or nil as argument means use current buffer as BUFFER. */)
1321 (register Lisp_Object buffer)
1323 register struct buffer *buf;
1324 if (NILP (buffer))
1325 buf = current_buffer;
1326 else
1328 CHECK_BUFFER (buffer);
1329 buf = XBUFFER (buffer);
1332 return BUF_SAVE_MODIFF (buf) < BUF_MODIFF (buf) ? Qt : Qnil;
1335 DEFUN ("set-buffer-modified-p", Fset_buffer_modified_p, Sset_buffer_modified_p,
1336 1, 1, 0,
1337 doc: /* Mark current buffer as modified or unmodified according to FLAG.
1338 A non-nil FLAG means mark the buffer modified. */)
1339 (Lisp_Object flag)
1341 Lisp_Object fn;
1343 #ifdef CLASH_DETECTION
1344 /* If buffer becoming modified, lock the file.
1345 If buffer becoming unmodified, unlock the file. */
1347 struct buffer *b = current_buffer->base_buffer
1348 ? current_buffer->base_buffer
1349 : current_buffer;
1351 fn = BVAR (b, file_truename);
1352 /* Test buffer-file-name so that binding it to nil is effective. */
1353 if (!NILP (fn) && ! NILP (BVAR (b, filename)))
1355 bool already = SAVE_MODIFF < MODIFF;
1356 if (!already && !NILP (flag))
1357 lock_file (fn);
1358 else if (already && NILP (flag))
1359 unlock_file (fn);
1361 #endif /* CLASH_DETECTION */
1363 /* Here we have a problem. SAVE_MODIFF is used here to encode
1364 buffer-modified-p (as SAVE_MODIFF<MODIFF) as well as
1365 recent-auto-save-p (as SAVE_MODIFF<auto_save_modified). So if we
1366 modify SAVE_MODIFF to affect one, we may affect the other
1367 as well.
1368 E.g. if FLAG is nil we need to set SAVE_MODIFF to MODIFF, but
1369 if SAVE_MODIFF<auto_save_modified that means we risk changing
1370 recent-auto-save-p from t to nil.
1371 Vice versa, if FLAG is non-nil and SAVE_MODIFF>=auto_save_modified
1372 we risk changing recent-auto-save-p from nil to t. */
1373 SAVE_MODIFF = (NILP (flag)
1374 /* FIXME: This unavoidably sets recent-auto-save-p to nil. */
1375 ? MODIFF
1376 /* Let's try to preserve recent-auto-save-p. */
1377 : SAVE_MODIFF < MODIFF ? SAVE_MODIFF
1378 /* If SAVE_MODIFF == auto_save_modified == MODIFF,
1379 we can either decrease SAVE_MODIFF and auto_save_modified
1380 or increase MODIFF. */
1381 : MODIFF++);
1383 /* Set update_mode_lines only if buffer is displayed in some window.
1384 Packages like jit-lock or lazy-lock preserve a buffer's modified
1385 state by recording/restoring the state around blocks of code.
1386 Setting update_mode_lines makes redisplay consider all windows
1387 (on all frames). Stealth fontification of buffers not displayed
1388 would incur additional redisplay costs if we'd set
1389 update_modes_lines unconditionally.
1391 Ideally, I think there should be another mechanism for fontifying
1392 buffers without "modifying" buffers, or redisplay should be
1393 smarter about updating the `*' in mode lines. --gerd */
1394 if (buffer_window_count (current_buffer))
1396 ++update_mode_lines;
1397 current_buffer->prevent_redisplay_optimizations_p = 1;
1400 return flag;
1403 DEFUN ("restore-buffer-modified-p", Frestore_buffer_modified_p,
1404 Srestore_buffer_modified_p, 1, 1, 0,
1405 doc: /* Like `set-buffer-modified-p', with a difference concerning redisplay.
1406 It is not ensured that mode lines will be updated to show the modified
1407 state of the current buffer. Use with care. */)
1408 (Lisp_Object flag)
1410 #ifdef CLASH_DETECTION
1411 Lisp_Object fn;
1413 /* If buffer becoming modified, lock the file.
1414 If buffer becoming unmodified, unlock the file. */
1416 fn = BVAR (current_buffer, file_truename);
1417 /* Test buffer-file-name so that binding it to nil is effective. */
1418 if (!NILP (fn) && ! NILP (BVAR (current_buffer, filename)))
1420 bool already = SAVE_MODIFF < MODIFF;
1421 if (!already && !NILP (flag))
1422 lock_file (fn);
1423 else if (already && NILP (flag))
1424 unlock_file (fn);
1426 #endif /* CLASH_DETECTION */
1428 SAVE_MODIFF = NILP (flag) ? MODIFF : 0;
1429 return flag;
1432 DEFUN ("buffer-modified-tick", Fbuffer_modified_tick, Sbuffer_modified_tick,
1433 0, 1, 0,
1434 doc: /* Return BUFFER's tick counter, incremented for each change in text.
1435 Each buffer has a tick counter which is incremented each time the
1436 text in that buffer is changed. It wraps around occasionally.
1437 No argument or nil as argument means use current buffer as BUFFER. */)
1438 (register Lisp_Object buffer)
1440 register struct buffer *buf;
1441 if (NILP (buffer))
1442 buf = current_buffer;
1443 else
1445 CHECK_BUFFER (buffer);
1446 buf = XBUFFER (buffer);
1449 return make_number (BUF_MODIFF (buf));
1452 DEFUN ("buffer-chars-modified-tick", Fbuffer_chars_modified_tick,
1453 Sbuffer_chars_modified_tick, 0, 1, 0,
1454 doc: /* Return BUFFER's character-change tick counter.
1455 Each buffer has a character-change tick counter, which is set to the
1456 value of the buffer's tick counter \(see `buffer-modified-tick'), each
1457 time text in that buffer is inserted or deleted. By comparing the
1458 values returned by two individual calls of `buffer-chars-modified-tick',
1459 you can tell whether a character change occurred in that buffer in
1460 between these calls. No argument or nil as argument means use current
1461 buffer as BUFFER. */)
1462 (register Lisp_Object buffer)
1464 register struct buffer *buf;
1465 if (NILP (buffer))
1466 buf = current_buffer;
1467 else
1469 CHECK_BUFFER (buffer);
1470 buf = XBUFFER (buffer);
1473 return make_number (BUF_CHARS_MODIFF (buf));
1476 DEFUN ("rename-buffer", Frename_buffer, Srename_buffer, 1, 2,
1477 "(list (read-string \"Rename buffer (to new name): \" \
1478 nil 'buffer-name-history (buffer-name (current-buffer))) \
1479 current-prefix-arg)",
1480 doc: /* Change current buffer's name to NEWNAME (a string).
1481 If second arg UNIQUE is nil or omitted, it is an error if a
1482 buffer named NEWNAME already exists.
1483 If UNIQUE is non-nil, come up with a new name using
1484 `generate-new-buffer-name'.
1485 Interactively, you can set UNIQUE with a prefix argument.
1486 We return the name we actually gave the buffer.
1487 This does not change the name of the visited file (if any). */)
1488 (register Lisp_Object newname, Lisp_Object unique)
1490 register Lisp_Object tem, buf;
1492 CHECK_STRING (newname);
1494 if (SCHARS (newname) == 0)
1495 error ("Empty string is invalid as a buffer name");
1497 tem = Fget_buffer (newname);
1498 if (!NILP (tem))
1500 /* Don't short-circuit if UNIQUE is t. That is a useful way to
1501 rename the buffer automatically so you can create another
1502 with the original name. It makes UNIQUE equivalent to
1503 (rename-buffer (generate-new-buffer-name NEWNAME)). */
1504 if (NILP (unique) && XBUFFER (tem) == current_buffer)
1505 return BVAR (current_buffer, name);
1506 if (!NILP (unique))
1507 newname = Fgenerate_new_buffer_name (newname, BVAR (current_buffer, name));
1508 else
1509 error ("Buffer name `%s' is in use", SDATA (newname));
1512 bset_name (current_buffer, newname);
1514 /* Catch redisplay's attention. Unless we do this, the mode lines for
1515 any windows displaying current_buffer will stay unchanged. */
1516 update_mode_lines++;
1518 XSETBUFFER (buf, current_buffer);
1519 Fsetcar (Frassq (buf, Vbuffer_alist), newname);
1520 if (NILP (BVAR (current_buffer, filename))
1521 && !NILP (BVAR (current_buffer, auto_save_file_name)))
1522 call0 (intern ("rename-auto-save-file"));
1524 /* Run buffer-list-update-hook. */
1525 if (!NILP (Vrun_hooks))
1526 call1 (Vrun_hooks, Qbuffer_list_update_hook);
1528 /* Refetch since that last call may have done GC. */
1529 return BVAR (current_buffer, name);
1532 /* True if B can be used as 'other-than-BUFFER' buffer. */
1534 static bool
1535 candidate_buffer (Lisp_Object b, Lisp_Object buffer)
1537 return (BUFFERP (b) && !EQ (b, buffer)
1538 && BUFFER_LIVE_P (XBUFFER (b))
1539 && !BUFFER_HIDDEN_P (XBUFFER (b)));
1542 DEFUN ("other-buffer", Fother_buffer, Sother_buffer, 0, 3, 0,
1543 doc: /* Return most recently selected buffer other than BUFFER.
1544 Buffers not visible in windows are preferred to visible buffers, unless
1545 optional second argument VISIBLE-OK is non-nil. Ignore the argument
1546 BUFFER unless it denotes a live buffer. If the optional third argument
1547 FRAME is non-nil, use that frame's buffer list instead of the selected
1548 frame's buffer list.
1550 The buffer is found by scanning the selected or specified frame's buffer
1551 list first, followed by the list of all buffers. If no other buffer
1552 exists, return the buffer `*scratch*' (creating it if necessary). */)
1553 (register Lisp_Object buffer, Lisp_Object visible_ok, Lisp_Object frame)
1555 struct frame *f = decode_any_frame (frame);
1556 Lisp_Object tail = f->buffer_list, pred = f->buffer_predicate;
1557 Lisp_Object buf, notsogood = Qnil;
1559 /* Consider buffers that have been seen in the frame first. */
1560 for (; CONSP (tail); tail = XCDR (tail))
1562 buf = XCAR (tail);
1563 if (candidate_buffer (buf, buffer)
1564 /* If the frame has a buffer_predicate, disregard buffers that
1565 don't fit the predicate. */
1566 && (NILP (pred) || !NILP (call1 (pred, buf))))
1568 if (!NILP (visible_ok)
1569 || NILP (Fget_buffer_window (buf, Qvisible)))
1570 return buf;
1571 else if (NILP (notsogood))
1572 notsogood = buf;
1576 /* Consider alist of all buffers next. */
1577 FOR_EACH_LIVE_BUFFER (tail, buf)
1579 if (candidate_buffer (buf, buffer)
1580 /* If the frame has a buffer_predicate, disregard buffers that
1581 don't fit the predicate. */
1582 && (NILP (pred) || !NILP (call1 (pred, buf))))
1584 if (!NILP (visible_ok)
1585 || NILP (Fget_buffer_window (buf, Qvisible)))
1586 return buf;
1587 else if (NILP (notsogood))
1588 notsogood = buf;
1592 if (!NILP (notsogood))
1593 return notsogood;
1594 else
1596 buf = Fget_buffer (build_string ("*scratch*"));
1597 if (NILP (buf))
1599 buf = Fget_buffer_create (build_string ("*scratch*"));
1600 Fset_buffer_major_mode (buf);
1602 return buf;
1606 /* The following function is a safe variant of Fother_buffer: It doesn't
1607 pay attention to any frame-local buffer lists, doesn't care about
1608 visibility of buffers, and doesn't evaluate any frame predicates. */
1610 Lisp_Object
1611 other_buffer_safely (Lisp_Object buffer)
1613 Lisp_Object tail, buf;
1615 FOR_EACH_LIVE_BUFFER (tail, buf)
1616 if (candidate_buffer (buf, buffer))
1617 return buf;
1619 buf = Fget_buffer (build_string ("*scratch*"));
1620 if (NILP (buf))
1622 buf = Fget_buffer_create (build_string ("*scratch*"));
1623 Fset_buffer_major_mode (buf);
1626 return buf;
1629 DEFUN ("buffer-enable-undo", Fbuffer_enable_undo, Sbuffer_enable_undo,
1630 0, 1, "",
1631 doc: /* Start keeping undo information for buffer BUFFER.
1632 No argument or nil as argument means do this for the current buffer. */)
1633 (register Lisp_Object buffer)
1635 Lisp_Object real_buffer;
1637 if (NILP (buffer))
1638 XSETBUFFER (real_buffer, current_buffer);
1639 else
1641 real_buffer = Fget_buffer (buffer);
1642 if (NILP (real_buffer))
1643 nsberror (buffer);
1646 if (EQ (BVAR (XBUFFER (real_buffer), undo_list), Qt))
1647 bset_undo_list (XBUFFER (real_buffer), Qnil);
1649 return Qnil;
1652 /* Truncate undo list and shrink the gap of BUFFER. */
1654 void
1655 compact_buffer (struct buffer *buffer)
1657 BUFFER_CHECK_INDIRECTION (buffer);
1659 /* Skip dead buffers, indirect buffers and buffers
1660 which aren't changed since last compaction. */
1661 if (BUFFER_LIVE_P (buffer)
1662 && (buffer->base_buffer == NULL)
1663 && (BUF_COMPACT (buffer) != BUF_MODIFF (buffer)))
1665 /* If a buffer's undo list is Qt, that means that undo is
1666 turned off in that buffer. Calling truncate_undo_list on
1667 Qt tends to return NULL, which effectively turns undo back on.
1668 So don't call truncate_undo_list if undo_list is Qt. */
1669 if (!EQ (buffer->INTERNAL_FIELD (undo_list), Qt))
1670 truncate_undo_list (buffer);
1672 /* Shrink buffer gaps. */
1673 if (!buffer->text->inhibit_shrinking)
1675 /* If a buffer's gap size is more than 10% of the buffer
1676 size, or larger than GAP_BYTES_DFL bytes, then shrink it
1677 accordingly. Keep a minimum size of GAP_BYTES_MIN bytes. */
1678 ptrdiff_t size = clip_to_bounds (GAP_BYTES_MIN,
1679 BUF_Z_BYTE (buffer) / 10,
1680 GAP_BYTES_DFL);
1681 if (BUF_GAP_SIZE (buffer) > size)
1682 make_gap_1 (buffer, -(BUF_GAP_SIZE (buffer) - size));
1684 BUF_COMPACT (buffer) = BUF_MODIFF (buffer);
1688 DEFUN ("kill-buffer", Fkill_buffer, Skill_buffer, 0, 1, "bKill buffer: ",
1689 doc: /* Kill the buffer specified by BUFFER-OR-NAME.
1690 The argument may be a buffer or the name of an existing buffer.
1691 Argument nil or omitted means kill the current buffer. Return t if the
1692 buffer is actually killed, nil otherwise.
1694 The functions in `kill-buffer-query-functions' are called with the
1695 buffer to be killed as the current buffer. If any of them returns nil,
1696 the buffer is not killed. The hook `kill-buffer-hook' is run before the
1697 buffer is actually killed. The buffer being killed will be current
1698 while the hook is running. Functions called by any of these hooks are
1699 supposed to not change the current buffer.
1701 Any processes that have this buffer as the `process-buffer' are killed
1702 with SIGHUP. This function calls `replace-buffer-in-windows' for
1703 cleaning up all windows currently displaying the buffer to be killed. */)
1704 (Lisp_Object buffer_or_name)
1706 Lisp_Object buffer;
1707 register struct buffer *b;
1708 register Lisp_Object tem;
1709 register struct Lisp_Marker *m;
1710 struct gcpro gcpro1;
1712 if (NILP (buffer_or_name))
1713 buffer = Fcurrent_buffer ();
1714 else
1715 buffer = Fget_buffer (buffer_or_name);
1716 if (NILP (buffer))
1717 nsberror (buffer_or_name);
1719 b = XBUFFER (buffer);
1721 /* Avoid trouble for buffer already dead. */
1722 if (!BUFFER_LIVE_P (b))
1723 return Qnil;
1725 if (thread_check_current_buffer (b))
1726 return Qnil;
1728 /* Run hooks with the buffer to be killed the current buffer. */
1730 ptrdiff_t count = SPECPDL_INDEX ();
1731 Lisp_Object arglist[1];
1733 record_unwind_protect (save_excursion_restore, save_excursion_save ());
1734 set_buffer_internal (b);
1736 /* First run the query functions; if any query is answered no,
1737 don't kill the buffer. */
1738 arglist[0] = Qkill_buffer_query_functions;
1739 tem = Frun_hook_with_args_until_failure (1, arglist);
1740 if (NILP (tem))
1741 return unbind_to (count, Qnil);
1743 /* Query if the buffer is still modified. */
1744 if (INTERACTIVE && !NILP (BVAR (b, filename))
1745 && BUF_MODIFF (b) > BUF_SAVE_MODIFF (b))
1747 GCPRO1 (buffer);
1748 tem = do_yes_or_no_p (format2 ("Buffer %s modified; kill anyway? ",
1749 BVAR (b, name), make_number (0)));
1750 UNGCPRO;
1751 if (NILP (tem))
1752 return unbind_to (count, Qnil);
1755 /* If the hooks have killed the buffer, exit now. */
1756 if (!BUFFER_LIVE_P (b))
1757 return unbind_to (count, Qt);
1759 /* Then run the hooks. */
1760 Frun_hooks (1, &Qkill_buffer_hook);
1761 unbind_to (count, Qnil);
1764 /* If the hooks have killed the buffer, exit now. */
1765 if (!BUFFER_LIVE_P (b))
1766 return Qt;
1768 /* We have no more questions to ask. Verify that it is valid
1769 to kill the buffer. This must be done after the questions
1770 since anything can happen within do_yes_or_no_p. */
1772 /* Don't kill the minibuffer now current. */
1773 if (EQ (buffer, XWINDOW (minibuf_window)->contents))
1774 return Qnil;
1776 /* When we kill an ordinary buffer which shares it's buffer text
1777 with indirect buffer(s), we must kill indirect buffer(s) too.
1778 We do it at this stage so nothing terrible happens if they
1779 ask questions or their hooks get errors. */
1780 if (!b->base_buffer && b->indirections > 0)
1782 struct buffer *other;
1784 GCPRO1 (buffer);
1786 FOR_EACH_BUFFER (other)
1787 if (other->base_buffer == b)
1789 Lisp_Object buf;
1790 XSETBUFFER (buf, other);
1791 Fkill_buffer (buf);
1794 UNGCPRO;
1796 /* Exit if we now have killed the base buffer (Bug#11665). */
1797 if (!BUFFER_LIVE_P (b))
1798 return Qt;
1801 /* Run replace_buffer_in_windows before making another buffer current
1802 since set-window-buffer-start-and-point will refuse to make another
1803 buffer current if the selected window does not show the current
1804 buffer. (Bug#10114) */
1805 replace_buffer_in_windows (buffer);
1807 /* Exit if replacing the buffer in windows has killed our buffer. */
1808 if (!BUFFER_LIVE_P (b))
1809 return Qt;
1811 /* Make this buffer not be current. Exit if it is the sole visible
1812 buffer. */
1813 if (b == current_buffer)
1815 tem = Fother_buffer (buffer, Qnil, Qnil);
1816 Fset_buffer (tem);
1817 if (b == current_buffer)
1818 return Qnil;
1821 /* If the buffer now current is shown in the minibuffer and our buffer
1822 is the sole other buffer give up. */
1823 XSETBUFFER (tem, current_buffer);
1824 if (EQ (tem, XWINDOW (minibuf_window)->contents)
1825 && EQ (buffer, Fother_buffer (buffer, Qnil, Qnil)))
1826 return Qnil;
1828 /* Now there is no question: we can kill the buffer. */
1830 #ifdef CLASH_DETECTION
1831 /* Unlock this buffer's file, if it is locked. */
1832 unlock_buffer (b);
1833 #endif /* CLASH_DETECTION */
1835 GCPRO1 (buffer);
1836 kill_buffer_processes (buffer);
1837 UNGCPRO;
1839 /* Killing buffer processes may run sentinels which may have killed
1840 our buffer. */
1841 if (!BUFFER_LIVE_P (b))
1842 return Qt;
1844 /* These may run Lisp code and into infinite loops (if someone
1845 insisted on circular lists) so allow quitting here. */
1846 frames_discard_buffer (buffer);
1848 clear_charpos_cache (b);
1850 tem = Vinhibit_quit;
1851 Vinhibit_quit = Qt;
1852 /* Remove the buffer from the list of all buffers. */
1853 Vbuffer_alist = Fdelq (Frassq (buffer, Vbuffer_alist), Vbuffer_alist);
1854 /* If replace_buffer_in_windows didn't do its job fix that now. */
1855 replace_buffer_in_windows_safely (buffer);
1856 Vinhibit_quit = tem;
1858 /* Delete any auto-save file, if we saved it in this session.
1859 But not if the buffer is modified. */
1860 if (STRINGP (BVAR (b, auto_save_file_name))
1861 && BUF_AUTOSAVE_MODIFF (b) != 0
1862 && BUF_SAVE_MODIFF (b) < BUF_AUTOSAVE_MODIFF (b)
1863 && BUF_SAVE_MODIFF (b) < BUF_MODIFF (b)
1864 && NILP (Fsymbol_value (intern ("auto-save-visited-file-name"))))
1866 Lisp_Object delete;
1867 delete = Fsymbol_value (intern ("delete-auto-save-files"));
1868 if (! NILP (delete))
1869 internal_delete_file (BVAR (b, auto_save_file_name));
1872 /* Deleting an auto-save file could have killed our buffer. */
1873 if (!BUFFER_LIVE_P (b))
1874 return Qt;
1876 if (b->base_buffer)
1878 /* Unchain all markers that belong to this indirect buffer.
1879 Don't unchain the markers that belong to the base buffer
1880 or its other indirect buffers. */
1881 struct Lisp_Marker **mp = &BUF_MARKERS (b);
1882 while ((m = *mp))
1884 if (m->buffer == b)
1886 m->buffer = NULL;
1887 *mp = m->next;
1889 else
1890 mp = &m->next;
1893 else
1895 /* Unchain all markers of this buffer and its indirect buffers.
1896 and leave them pointing nowhere. */
1897 for (m = BUF_MARKERS (b); m; )
1899 struct Lisp_Marker *next = m->next;
1900 m->buffer = 0;
1901 m->next = NULL;
1902 m = next;
1904 BUF_MARKERS (b) = NULL;
1905 set_buffer_intervals (b, NULL);
1907 /* Perhaps we should explicitly free the interval tree here... */
1909 /* Since we've unlinked the markers, the overlays can't be here any more
1910 either. */
1911 b->overlays_before = NULL;
1912 b->overlays_after = NULL;
1914 /* Reset the local variables, so that this buffer's local values
1915 won't be protected from GC. They would be protected
1916 if they happened to remain cached in their symbols.
1917 This gets rid of them for certain. */
1918 swap_out_buffer_local_variables (b);
1919 reset_buffer_local_variables (b, 1);
1921 bset_name (b, Qnil);
1923 block_input ();
1924 if (b->base_buffer)
1926 /* Notify our base buffer that we don't share the text anymore. */
1927 eassert (b->indirections == -1);
1928 b->base_buffer->indirections--;
1929 eassert (b->base_buffer->indirections >= 0);
1930 /* Make sure that we wasn't confused. */
1931 eassert (b->window_count == -1);
1933 else
1935 /* Make sure that no one shows us. */
1936 eassert (b->window_count == 0);
1937 /* No one shares our buffer text, can free it. */
1938 free_buffer_text (b);
1941 if (b->newline_cache)
1943 free_region_cache (b->newline_cache);
1944 b->newline_cache = 0;
1946 if (b->width_run_cache)
1948 free_region_cache (b->width_run_cache);
1949 b->width_run_cache = 0;
1951 if (b->bidi_paragraph_cache)
1953 free_region_cache (b->bidi_paragraph_cache);
1954 b->bidi_paragraph_cache = 0;
1956 bset_width_table (b, Qnil);
1957 unblock_input ();
1958 bset_undo_list (b, Qnil);
1960 /* Run buffer-list-update-hook. */
1961 if (!NILP (Vrun_hooks))
1962 call1 (Vrun_hooks, Qbuffer_list_update_hook);
1964 return Qt;
1967 /* Move association for BUFFER to the front of buffer (a)lists. Since
1968 we do this each time BUFFER is selected visibly, the more recently
1969 selected buffers are always closer to the front of those lists. This
1970 means that other_buffer is more likely to choose a relevant buffer.
1972 Note that this moves BUFFER to the front of the buffer lists of the
1973 selected frame even if BUFFER is not shown there. If BUFFER is not
1974 shown in the selected frame, consider the present behavior a feature.
1975 `select-window' gets this right since it shows BUFFER in the selected
1976 window when calling us. */
1978 void
1979 record_buffer (Lisp_Object buffer)
1981 Lisp_Object aelt, aelt_cons, tem;
1982 register struct frame *f = XFRAME (selected_frame);
1984 CHECK_BUFFER (buffer);
1986 /* Update Vbuffer_alist (we know that it has an entry for BUFFER).
1987 Don't allow quitting since this might leave the buffer list in an
1988 inconsistent state. */
1989 tem = Vinhibit_quit;
1990 Vinhibit_quit = Qt;
1991 aelt = Frassq (buffer, Vbuffer_alist);
1992 aelt_cons = Fmemq (aelt, Vbuffer_alist);
1993 Vbuffer_alist = Fdelq (aelt, Vbuffer_alist);
1994 XSETCDR (aelt_cons, Vbuffer_alist);
1995 Vbuffer_alist = aelt_cons;
1996 Vinhibit_quit = tem;
1998 /* Update buffer list of selected frame. */
1999 fset_buffer_list (f, Fcons (buffer, Fdelq (buffer, f->buffer_list)));
2000 fset_buried_buffer_list (f, Fdelq (buffer, f->buried_buffer_list));
2002 /* Run buffer-list-update-hook. */
2003 if (!NILP (Vrun_hooks))
2004 call1 (Vrun_hooks, Qbuffer_list_update_hook);
2008 /* Move BUFFER to the end of the buffer (a)lists. Do nothing if the
2009 buffer is killed. For the selected frame's buffer list this moves
2010 BUFFER to its end even if it was never shown in that frame. If
2011 this happens we have a feature, hence `bury-buffer-internal' should be
2012 called only when BUFFER was shown in the selected frame. */
2014 DEFUN ("bury-buffer-internal", Fbury_buffer_internal, Sbury_buffer_internal,
2015 1, 1, 0,
2016 doc: /* Move BUFFER to the end of the buffer list. */)
2017 (Lisp_Object buffer)
2019 Lisp_Object aelt, aelt_cons, tem;
2020 register struct frame *f = XFRAME (selected_frame);
2022 CHECK_BUFFER (buffer);
2024 /* Update Vbuffer_alist (we know that it has an entry for BUFFER).
2025 Don't allow quitting since this might leave the buffer list in an
2026 inconsistent state. */
2027 tem = Vinhibit_quit;
2028 Vinhibit_quit = Qt;
2029 aelt = Frassq (buffer, Vbuffer_alist);
2030 aelt_cons = Fmemq (aelt, Vbuffer_alist);
2031 Vbuffer_alist = Fdelq (aelt, Vbuffer_alist);
2032 XSETCDR (aelt_cons, Qnil);
2033 Vbuffer_alist = nconc2 (Vbuffer_alist, aelt_cons);
2034 Vinhibit_quit = tem;
2036 /* Update buffer lists of selected frame. */
2037 fset_buffer_list (f, Fdelq (buffer, f->buffer_list));
2038 fset_buried_buffer_list
2039 (f, Fcons (buffer, Fdelq (buffer, f->buried_buffer_list)));
2041 /* Run buffer-list-update-hook. */
2042 if (!NILP (Vrun_hooks))
2043 call1 (Vrun_hooks, Qbuffer_list_update_hook);
2045 return Qnil;
2048 DEFUN ("set-buffer-major-mode", Fset_buffer_major_mode, Sset_buffer_major_mode, 1, 1, 0,
2049 doc: /* Set an appropriate major mode for BUFFER.
2050 For the *scratch* buffer, use `initial-major-mode', otherwise choose a mode
2051 according to the default value of `major-mode'.
2052 Use this function before selecting the buffer, since it may need to inspect
2053 the current buffer's major mode. */)
2054 (Lisp_Object buffer)
2056 ptrdiff_t count;
2057 Lisp_Object function;
2059 CHECK_BUFFER (buffer);
2061 if (!BUFFER_LIVE_P (XBUFFER (buffer)))
2062 error ("Attempt to set major mode for a dead buffer");
2064 if (strcmp (SSDATA (BVAR (XBUFFER (buffer), name)), "*scratch*") == 0)
2065 function = find_symbol_value (intern ("initial-major-mode"));
2066 else
2068 function = BVAR (&buffer_defaults, major_mode);
2069 if (NILP (function)
2070 && NILP (Fget (BVAR (current_buffer, major_mode), Qmode_class)))
2071 function = BVAR (current_buffer, major_mode);
2074 if (NILP (function) || EQ (function, Qfundamental_mode))
2075 return Qnil;
2077 count = SPECPDL_INDEX ();
2079 /* To select a nonfundamental mode,
2080 select the buffer temporarily and then call the mode function. */
2082 record_unwind_protect (save_excursion_restore, save_excursion_save ());
2084 Fset_buffer (buffer);
2085 call0 (function);
2087 return unbind_to (count, Qnil);
2090 DEFUN ("current-buffer", Fcurrent_buffer, Scurrent_buffer, 0, 0, 0,
2091 doc: /* Return the current buffer as a Lisp object. */)
2092 (void)
2094 register Lisp_Object buf;
2095 XSETBUFFER (buf, current_buffer);
2096 return buf;
2099 /* Set the current buffer to B, and do not set windows_or_buffers_changed.
2100 This is used by redisplay. */
2102 void
2103 set_buffer_internal_1 (register struct buffer *b)
2105 register struct buffer *old_buf;
2106 register Lisp_Object tail;
2108 #ifdef USE_MMAP_FOR_BUFFERS
2109 if (b->text->beg == NULL)
2110 enlarge_buffer_text (b, 0);
2111 #endif /* USE_MMAP_FOR_BUFFERS */
2113 if (current_buffer == b)
2114 return;
2116 BUFFER_CHECK_INDIRECTION (b);
2118 old_buf = current_buffer;
2119 current_buffer = b;
2120 last_known_column_point = -1; /* invalidate indentation cache */
2122 if (old_buf)
2124 /* Put the undo list back in the base buffer, so that it appears
2125 that an indirect buffer shares the undo list of its base. */
2126 if (old_buf->base_buffer)
2127 bset_undo_list (old_buf->base_buffer, BVAR (old_buf, undo_list));
2129 /* If the old current buffer has markers to record PT, BEGV and ZV
2130 when it is not current, update them now. */
2131 record_buffer_markers (old_buf);
2134 /* Get the undo list from the base buffer, so that it appears
2135 that an indirect buffer shares the undo list of its base. */
2136 if (b->base_buffer)
2137 bset_undo_list (b, BVAR (b->base_buffer, undo_list));
2139 /* If the new current buffer has markers to record PT, BEGV and ZV
2140 when it is not current, fetch them now. */
2141 fetch_buffer_markers (b);
2143 /* Look down buffer's list of local Lisp variables
2144 to find and update any that forward into C variables. */
2148 for (tail = BVAR (b, local_var_alist); CONSP (tail); tail = XCDR (tail))
2150 Lisp_Object var = XCAR (XCAR (tail));
2151 struct Lisp_Symbol *sym = XSYMBOL (var);
2152 if (sym->redirect == SYMBOL_LOCALIZED /* Just to be sure. */
2153 && SYMBOL_BLV (sym)->fwd)
2154 /* Just reference the variable
2155 to cause it to become set for this buffer. */
2156 Fsymbol_value (var);
2159 /* Do the same with any others that were local to the previous buffer */
2160 while (b != old_buf && (b = old_buf, b));
2163 /* Switch to buffer B temporarily for redisplay purposes.
2164 This avoids certain things that don't need to be done within redisplay. */
2166 void
2167 set_buffer_temp (struct buffer *b)
2169 register struct buffer *old_buf;
2171 if (current_buffer == b)
2172 return;
2174 old_buf = current_buffer;
2175 current_buffer = b;
2177 /* If the old current buffer has markers to record PT, BEGV and ZV
2178 when it is not current, update them now. */
2179 record_buffer_markers (old_buf);
2181 /* If the new current buffer has markers to record PT, BEGV and ZV
2182 when it is not current, fetch them now. */
2183 fetch_buffer_markers (b);
2186 DEFUN ("set-buffer", Fset_buffer, Sset_buffer, 1, 1, 0,
2187 doc: /* Make buffer BUFFER-OR-NAME current for editing operations.
2188 BUFFER-OR-NAME may be a buffer or the name of an existing buffer. See
2189 also `with-current-buffer' when you want to make a buffer current
2190 temporarily. This function does not display the buffer, so its effect
2191 ends when the current command terminates. Use `switch-to-buffer' or
2192 `pop-to-buffer' to switch buffers permanently. */)
2193 (register Lisp_Object buffer_or_name)
2195 register Lisp_Object buffer;
2196 buffer = Fget_buffer (buffer_or_name);
2197 if (NILP (buffer))
2198 nsberror (buffer_or_name);
2199 if (!BUFFER_LIVE_P (XBUFFER (buffer)))
2200 error ("Selecting deleted buffer");
2201 set_buffer_internal (XBUFFER (buffer));
2202 return buffer;
2205 void
2206 restore_buffer (Lisp_Object buffer_or_name)
2208 Fset_buffer (buffer_or_name);
2211 /* Set the current buffer to BUFFER provided if it is alive. */
2213 void
2214 set_buffer_if_live (Lisp_Object buffer)
2216 if (BUFFER_LIVE_P (XBUFFER (buffer)))
2217 set_buffer_internal (XBUFFER (buffer));
2220 DEFUN ("barf-if-buffer-read-only", Fbarf_if_buffer_read_only,
2221 Sbarf_if_buffer_read_only, 0, 0, 0,
2222 doc: /* Signal a `buffer-read-only' error if the current buffer is read-only. */)
2223 (void)
2225 if (!NILP (BVAR (current_buffer, read_only))
2226 && NILP (Vinhibit_read_only))
2227 xsignal1 (Qbuffer_read_only, Fcurrent_buffer ());
2228 return Qnil;
2231 DEFUN ("erase-buffer", Ferase_buffer, Serase_buffer, 0, 0, "*",
2232 doc: /* Delete the entire contents of the current buffer.
2233 Any narrowing restriction in effect (see `narrow-to-region') is removed,
2234 so the buffer is truly empty after this. */)
2235 (void)
2237 Fwiden ();
2239 del_range (BEG, Z);
2241 current_buffer->last_window_start = 1;
2242 /* Prevent warnings, or suspension of auto saving, that would happen
2243 if future size is less than past size. Use of erase-buffer
2244 implies that the future text is not really related to the past text. */
2245 XSETFASTINT (BVAR (current_buffer, save_length), 0);
2246 return Qnil;
2249 void
2250 validate_region (register Lisp_Object *b, register Lisp_Object *e)
2252 CHECK_NUMBER_COERCE_MARKER (*b);
2253 CHECK_NUMBER_COERCE_MARKER (*e);
2255 if (XINT (*b) > XINT (*e))
2257 Lisp_Object tem;
2258 tem = *b; *b = *e; *e = tem;
2261 if (! (BEGV <= XINT (*b) && XINT (*e) <= ZV))
2262 args_out_of_range (*b, *e);
2265 /* Advance BYTE_POS up to a character boundary
2266 and return the adjusted position. */
2268 static ptrdiff_t
2269 advance_to_char_boundary (ptrdiff_t byte_pos)
2271 int c;
2273 if (byte_pos == BEG)
2274 /* Beginning of buffer is always a character boundary. */
2275 return BEG;
2277 c = FETCH_BYTE (byte_pos);
2278 if (! CHAR_HEAD_P (c))
2280 /* We should advance BYTE_POS only when C is a constituent of a
2281 multibyte sequence. */
2282 ptrdiff_t orig_byte_pos = byte_pos;
2286 byte_pos--;
2287 c = FETCH_BYTE (byte_pos);
2289 while (! CHAR_HEAD_P (c) && byte_pos > BEG);
2290 INC_POS (byte_pos);
2291 if (byte_pos < orig_byte_pos)
2292 byte_pos = orig_byte_pos;
2293 /* If C is a constituent of a multibyte sequence, BYTE_POS was
2294 surely advance to the correct character boundary. If C is
2295 not, BYTE_POS was unchanged. */
2298 return byte_pos;
2301 DEFUN ("buffer-swap-text", Fbuffer_swap_text, Sbuffer_swap_text,
2302 1, 1, 0,
2303 doc: /* Swap the text between current buffer and BUFFER. */)
2304 (Lisp_Object buffer)
2306 struct buffer *other_buffer;
2307 CHECK_BUFFER (buffer);
2308 other_buffer = XBUFFER (buffer);
2310 if (!BUFFER_LIVE_P (other_buffer))
2311 error ("Cannot swap a dead buffer's text");
2313 /* Actually, it probably works just fine.
2314 * if (other_buffer == current_buffer)
2315 * error ("Cannot swap a buffer's text with itself"); */
2317 /* Actually, this may be workable as well, tho probably only if they're
2318 *both* indirect. */
2319 if (other_buffer->base_buffer
2320 || current_buffer->base_buffer)
2321 error ("Cannot swap indirect buffers's text");
2323 { /* This is probably harder to make work. */
2324 struct buffer *other;
2325 FOR_EACH_BUFFER (other)
2326 if (other->base_buffer == other_buffer
2327 || other->base_buffer == current_buffer)
2328 error ("One of the buffers to swap has indirect buffers");
2331 #define swapfield(field, type) \
2332 do { \
2333 type tmp##field = other_buffer->field; \
2334 other_buffer->field = current_buffer->field; \
2335 current_buffer->field = tmp##field; \
2336 } while (0)
2337 #define swapfield_(field, type) \
2338 do { \
2339 type tmp##field = BVAR (other_buffer, field); \
2340 bset_##field (other_buffer, BVAR (current_buffer, field)); \
2341 bset_##field (current_buffer, tmp##field); \
2342 } while (0)
2344 swapfield (own_text, struct buffer_text);
2345 eassert (current_buffer->text == &current_buffer->own_text);
2346 eassert (other_buffer->text == &other_buffer->own_text);
2347 #ifdef REL_ALLOC
2348 r_alloc_reset_variable ((void **) &current_buffer->own_text.beg,
2349 (void **) &other_buffer->own_text.beg);
2350 r_alloc_reset_variable ((void **) &other_buffer->own_text.beg,
2351 (void **) &current_buffer->own_text.beg);
2352 #endif /* REL_ALLOC */
2354 swapfield (pt, ptrdiff_t);
2355 swapfield (pt_byte, ptrdiff_t);
2356 swapfield (begv, ptrdiff_t);
2357 swapfield (begv_byte, ptrdiff_t);
2358 swapfield (zv, ptrdiff_t);
2359 swapfield (zv_byte, ptrdiff_t);
2360 eassert (!current_buffer->base_buffer);
2361 eassert (!other_buffer->base_buffer);
2362 swapfield (indirections, ptrdiff_t);
2363 current_buffer->clip_changed = 1; other_buffer->clip_changed = 1;
2364 swapfield (newline_cache, struct region_cache *);
2365 swapfield (width_run_cache, struct region_cache *);
2366 swapfield (bidi_paragraph_cache, struct region_cache *);
2367 current_buffer->prevent_redisplay_optimizations_p = 1;
2368 other_buffer->prevent_redisplay_optimizations_p = 1;
2369 swapfield (overlays_before, struct Lisp_Overlay *);
2370 swapfield (overlays_after, struct Lisp_Overlay *);
2371 swapfield (overlay_center, ptrdiff_t);
2372 swapfield_ (undo_list, Lisp_Object);
2373 swapfield_ (mark, Lisp_Object);
2374 swapfield_ (enable_multibyte_characters, Lisp_Object);
2375 swapfield_ (bidi_display_reordering, Lisp_Object);
2376 swapfield_ (bidi_paragraph_direction, Lisp_Object);
2377 /* FIXME: Not sure what we should do with these *_marker fields.
2378 Hopefully they're just nil anyway. */
2379 swapfield_ (pt_marker, Lisp_Object);
2380 swapfield_ (begv_marker, Lisp_Object);
2381 swapfield_ (zv_marker, Lisp_Object);
2382 bset_point_before_scroll (current_buffer, Qnil);
2383 bset_point_before_scroll (other_buffer, Qnil);
2385 current_buffer->text->modiff++; other_buffer->text->modiff++;
2386 current_buffer->text->chars_modiff++; other_buffer->text->chars_modiff++;
2387 current_buffer->text->overlay_modiff++; other_buffer->text->overlay_modiff++;
2388 current_buffer->text->beg_unchanged = current_buffer->text->gpt;
2389 current_buffer->text->end_unchanged = current_buffer->text->gpt;
2390 other_buffer->text->beg_unchanged = other_buffer->text->gpt;
2391 other_buffer->text->end_unchanged = other_buffer->text->gpt;
2393 struct Lisp_Marker *m;
2394 for (m = BUF_MARKERS (current_buffer); m; m = m->next)
2395 if (m->buffer == other_buffer)
2396 m->buffer = current_buffer;
2397 else
2398 /* Since there's no indirect buffer in sight, markers on
2399 BUF_MARKERS(buf) should either be for `buf' or dead. */
2400 eassert (!m->buffer);
2401 for (m = BUF_MARKERS (other_buffer); m; m = m->next)
2402 if (m->buffer == current_buffer)
2403 m->buffer = other_buffer;
2404 else
2405 /* Since there's no indirect buffer in sight, markers on
2406 BUF_MARKERS(buf) should either be for `buf' or dead. */
2407 eassert (!m->buffer);
2409 { /* Some of the C code expects that both window markers of a
2410 live window points to that window's buffer. So since we
2411 just swapped the markers between the two buffers, we need
2412 to undo the effect of this swap for window markers. */
2413 Lisp_Object w = selected_window, ws = Qnil;
2414 Lisp_Object buf1, buf2;
2415 XSETBUFFER (buf1, current_buffer); XSETBUFFER (buf2, other_buffer);
2417 while (NILP (Fmemq (w, ws)))
2419 ws = Fcons (w, ws);
2420 if (MARKERP (XWINDOW (w)->pointm)
2421 && (EQ (XWINDOW (w)->contents, buf1)
2422 || EQ (XWINDOW (w)->contents, buf2)))
2423 Fset_marker (XWINDOW (w)->pointm,
2424 make_number
2425 (BUF_BEGV (XBUFFER (XWINDOW (w)->contents))),
2426 XWINDOW (w)->contents);
2427 if (MARKERP (XWINDOW (w)->start)
2428 && (EQ (XWINDOW (w)->contents, buf1)
2429 || EQ (XWINDOW (w)->contents, buf2)))
2430 Fset_marker (XWINDOW (w)->start,
2431 make_number
2432 (XBUFFER (XWINDOW (w)->contents)->last_window_start),
2433 XWINDOW (w)->contents);
2434 w = Fnext_window (w, Qt, Qt);
2438 if (current_buffer->text->intervals)
2439 (eassert (EQ (current_buffer->text->intervals->up.obj, buffer)),
2440 XSETBUFFER (current_buffer->text->intervals->up.obj, current_buffer));
2441 if (other_buffer->text->intervals)
2442 (eassert (EQ (other_buffer->text->intervals->up.obj, Fcurrent_buffer ())),
2443 XSETBUFFER (other_buffer->text->intervals->up.obj, other_buffer));
2445 return Qnil;
2448 DEFUN ("set-buffer-multibyte", Fset_buffer_multibyte, Sset_buffer_multibyte,
2449 1, 1, 0,
2450 doc: /* Set the multibyte flag of the current buffer to FLAG.
2451 If FLAG is t, this makes the buffer a multibyte buffer.
2452 If FLAG is nil, this makes the buffer a single-byte buffer.
2453 In these cases, the buffer contents remain unchanged as a sequence of
2454 bytes but the contents viewed as characters do change.
2455 If FLAG is `to', this makes the buffer a multibyte buffer by changing
2456 all eight-bit bytes to eight-bit characters.
2457 If the multibyte flag was really changed, undo information of the
2458 current buffer is cleared. */)
2459 (Lisp_Object flag)
2461 struct Lisp_Marker *tail, *markers;
2462 struct buffer *other;
2463 ptrdiff_t begv, zv;
2464 bool narrowed = (BEG != BEGV || Z != ZV);
2465 bool modified_p = !NILP (Fbuffer_modified_p (Qnil));
2466 Lisp_Object old_undo = BVAR (current_buffer, undo_list);
2467 struct gcpro gcpro1;
2469 if (current_buffer->base_buffer)
2470 error ("Cannot do `set-buffer-multibyte' on an indirect buffer");
2472 /* Do nothing if nothing actually changes. */
2473 if (NILP (flag) == NILP (BVAR (current_buffer, enable_multibyte_characters)))
2474 return flag;
2476 GCPRO1 (old_undo);
2478 /* Don't record these buffer changes. We will put a special undo entry
2479 instead. */
2480 bset_undo_list (current_buffer, Qt);
2482 /* If the cached position is for this buffer, clear it out. */
2483 clear_charpos_cache (current_buffer);
2485 if (NILP (flag))
2486 begv = BEGV_BYTE, zv = ZV_BYTE;
2487 else
2488 begv = BEGV, zv = ZV;
2490 if (narrowed)
2491 error ("Changing multibyteness in a narrowed buffer");
2493 if (NILP (flag))
2495 ptrdiff_t pos, stop;
2496 unsigned char *p;
2498 /* Do this first, so it can use CHAR_TO_BYTE
2499 to calculate the old correspondences. */
2500 set_intervals_multibyte (0);
2502 bset_enable_multibyte_characters (current_buffer, Qnil);
2504 Z = Z_BYTE;
2505 BEGV = BEGV_BYTE;
2506 ZV = ZV_BYTE;
2507 GPT = GPT_BYTE;
2508 TEMP_SET_PT_BOTH (PT_BYTE, PT_BYTE);
2511 for (tail = BUF_MARKERS (current_buffer); tail; tail = tail->next)
2512 tail->charpos = tail->bytepos;
2514 /* Convert multibyte form of 8-bit characters to unibyte. */
2515 pos = BEG;
2516 stop = GPT;
2517 p = BEG_ADDR;
2518 while (1)
2520 int c, bytes;
2522 if (pos == stop)
2524 if (pos == Z)
2525 break;
2526 p = GAP_END_ADDR;
2527 stop = Z;
2529 if (ASCII_BYTE_P (*p))
2530 p++, pos++;
2531 else if (CHAR_BYTE8_HEAD_P (*p))
2533 c = STRING_CHAR_AND_LENGTH (p, bytes);
2534 /* Delete all bytes for this 8-bit character but the
2535 last one, and change the last one to the character
2536 code. */
2537 bytes--;
2538 del_range_2 (pos, pos, pos + bytes, pos + bytes, 0);
2539 p = GAP_END_ADDR;
2540 *p++ = c;
2541 pos++;
2542 if (begv > pos)
2543 begv -= bytes;
2544 if (zv > pos)
2545 zv -= bytes;
2546 stop = Z;
2548 else
2550 bytes = BYTES_BY_CHAR_HEAD (*p);
2551 p += bytes, pos += bytes;
2554 if (narrowed)
2555 Fnarrow_to_region (make_number (begv), make_number (zv));
2557 else
2559 ptrdiff_t pt = PT;
2560 ptrdiff_t pos, stop;
2561 unsigned char *p, *pend;
2563 /* Be sure not to have a multibyte sequence striding over the GAP.
2564 Ex: We change this: "...abc\302 _GAP_ \241def..."
2565 to: "...abc _GAP_ \302\241def..." */
2567 if (EQ (flag, Qt)
2568 && GPT_BYTE > 1 && GPT_BYTE < Z_BYTE
2569 && ! CHAR_HEAD_P (*(GAP_END_ADDR)))
2571 unsigned char *q = GPT_ADDR - 1;
2573 while (! CHAR_HEAD_P (*q) && q > BEG_ADDR) q--;
2574 if (LEADING_CODE_P (*q))
2576 ptrdiff_t new_gpt = GPT_BYTE - (GPT_ADDR - q);
2578 move_gap_both (new_gpt, new_gpt);
2582 /* Make the buffer contents valid as multibyte by converting
2583 8-bit characters to multibyte form. */
2584 pos = BEG;
2585 stop = GPT;
2586 p = BEG_ADDR;
2587 pend = GPT_ADDR;
2588 while (1)
2590 int bytes;
2592 if (pos == stop)
2594 if (pos == Z)
2595 break;
2596 p = GAP_END_ADDR;
2597 pend = Z_ADDR;
2598 stop = Z;
2601 if (ASCII_BYTE_P (*p))
2602 p++, pos++;
2603 else if (EQ (flag, Qt)
2604 && ! CHAR_BYTE8_HEAD_P (*p)
2605 && (bytes = MULTIBYTE_LENGTH (p, pend)) > 0)
2606 p += bytes, pos += bytes;
2607 else
2609 unsigned char tmp[MAX_MULTIBYTE_LENGTH];
2610 int c;
2612 c = BYTE8_TO_CHAR (*p);
2613 bytes = CHAR_STRING (c, tmp);
2614 *p = tmp[0];
2615 TEMP_SET_PT_BOTH (pos + 1, pos + 1);
2616 bytes--;
2617 insert_1_both ((char *) tmp + 1, bytes, bytes, 1, 0, 0);
2618 /* Now the gap is after the just inserted data. */
2619 pos = GPT;
2620 p = GAP_END_ADDR;
2621 if (pos <= begv)
2622 begv += bytes;
2623 if (pos <= zv)
2624 zv += bytes;
2625 if (pos <= pt)
2626 pt += bytes;
2627 pend = Z_ADDR;
2628 stop = Z;
2632 if (pt != PT)
2633 TEMP_SET_PT (pt);
2635 if (narrowed)
2636 Fnarrow_to_region (make_number (begv), make_number (zv));
2638 /* Do this first, so that chars_in_text asks the right question.
2639 set_intervals_multibyte needs it too. */
2640 bset_enable_multibyte_characters (current_buffer, Qt);
2642 GPT_BYTE = advance_to_char_boundary (GPT_BYTE);
2643 GPT = chars_in_text (BEG_ADDR, GPT_BYTE - BEG_BYTE) + BEG;
2645 Z = chars_in_text (GAP_END_ADDR, Z_BYTE - GPT_BYTE) + GPT;
2647 BEGV_BYTE = advance_to_char_boundary (BEGV_BYTE);
2648 if (BEGV_BYTE > GPT_BYTE)
2649 BEGV = chars_in_text (GAP_END_ADDR, BEGV_BYTE - GPT_BYTE) + GPT;
2650 else
2651 BEGV = chars_in_text (BEG_ADDR, BEGV_BYTE - BEG_BYTE) + BEG;
2653 ZV_BYTE = advance_to_char_boundary (ZV_BYTE);
2654 if (ZV_BYTE > GPT_BYTE)
2655 ZV = chars_in_text (GAP_END_ADDR, ZV_BYTE - GPT_BYTE) + GPT;
2656 else
2657 ZV = chars_in_text (BEG_ADDR, ZV_BYTE - BEG_BYTE) + BEG;
2660 ptrdiff_t byte = advance_to_char_boundary (PT_BYTE);
2661 ptrdiff_t position;
2663 if (byte > GPT_BYTE)
2664 position = chars_in_text (GAP_END_ADDR, byte - GPT_BYTE) + GPT;
2665 else
2666 position = chars_in_text (BEG_ADDR, byte - BEG_BYTE) + BEG;
2667 TEMP_SET_PT_BOTH (position, byte);
2670 tail = markers = BUF_MARKERS (current_buffer);
2672 /* This prevents BYTE_TO_CHAR (that is, buf_bytepos_to_charpos) from
2673 getting confused by the markers that have not yet been updated.
2674 It is also a signal that it should never create a marker. */
2675 BUF_MARKERS (current_buffer) = NULL;
2677 for (; tail; tail = tail->next)
2679 tail->bytepos = advance_to_char_boundary (tail->bytepos);
2680 tail->charpos = BYTE_TO_CHAR (tail->bytepos);
2683 /* Make sure no markers were put on the chain
2684 while the chain value was incorrect. */
2685 if (BUF_MARKERS (current_buffer))
2686 emacs_abort ();
2688 BUF_MARKERS (current_buffer) = markers;
2690 /* Do this last, so it can calculate the new correspondences
2691 between chars and bytes. */
2692 set_intervals_multibyte (1);
2695 if (!EQ (old_undo, Qt))
2697 /* Represent all the above changes by a special undo entry. */
2698 bset_undo_list (current_buffer,
2699 Fcons (list3 (Qapply,
2700 intern ("set-buffer-multibyte"),
2701 NILP (flag) ? Qt : Qnil),
2702 old_undo));
2705 UNGCPRO;
2707 current_buffer->prevent_redisplay_optimizations_p = 1;
2709 /* If buffer is shown in a window, let redisplay consider other windows. */
2710 if (buffer_window_count (current_buffer))
2711 ++windows_or_buffers_changed;
2713 /* Copy this buffer's new multibyte status
2714 into all of its indirect buffers. */
2715 FOR_EACH_BUFFER (other)
2716 if (other->base_buffer == current_buffer && BUFFER_LIVE_P (other))
2718 BVAR (other, enable_multibyte_characters)
2719 = BVAR (current_buffer, enable_multibyte_characters);
2720 other->prevent_redisplay_optimizations_p = 1;
2723 /* Restore the modifiedness of the buffer. */
2724 if (!modified_p && !NILP (Fbuffer_modified_p (Qnil)))
2725 Fset_buffer_modified_p (Qnil);
2727 /* Update coding systems of this buffer's process (if any). */
2729 Lisp_Object process;
2731 process = Fget_buffer_process (Fcurrent_buffer ());
2732 if (PROCESSP (process))
2733 setup_process_coding_systems (process);
2736 return flag;
2739 DEFUN ("kill-all-local-variables", Fkill_all_local_variables,
2740 Skill_all_local_variables, 0, 0, 0,
2741 doc: /* Switch to Fundamental mode by killing current buffer's local variables.
2742 Most local variable bindings are eliminated so that the default values
2743 become effective once more. Also, the syntax table is set from
2744 `standard-syntax-table', the local keymap is set to nil,
2745 and the abbrev table from `fundamental-mode-abbrev-table'.
2746 This function also forces redisplay of the mode line.
2748 Every function to select a new major mode starts by
2749 calling this function.
2751 As a special exception, local variables whose names have
2752 a non-nil `permanent-local' property are not eliminated by this function.
2754 The first thing this function does is run
2755 the normal hook `change-major-mode-hook'. */)
2756 (void)
2758 Frun_hooks (1, &Qchange_major_mode_hook);
2760 /* Make sure none of the bindings in local_var_alist
2761 remain swapped in, in their symbols. */
2763 swap_out_buffer_local_variables (current_buffer);
2765 /* Actually eliminate all local bindings of this buffer. */
2767 reset_buffer_local_variables (current_buffer, 0);
2769 /* Force mode-line redisplay. Useful here because all major mode
2770 commands call this function. */
2771 update_mode_lines++;
2773 return Qnil;
2776 /* Make sure no local variables remain set up with buffer B
2777 for their current values. */
2779 static void
2780 swap_out_buffer_local_variables (struct buffer *b)
2782 Lisp_Object oalist, alist, buffer;
2784 XSETBUFFER (buffer, b);
2785 oalist = BVAR (b, local_var_alist);
2787 for (alist = oalist; CONSP (alist); alist = XCDR (alist))
2789 Lisp_Object sym = XCAR (XCAR (alist));
2790 eassert (XSYMBOL (sym)->redirect == SYMBOL_LOCALIZED);
2791 /* Need not do anything if some other buffer's binding is
2792 now cached. */
2793 if (EQ (SYMBOL_BLV (XSYMBOL (sym))->where, buffer))
2795 /* Symbol is set up for this buffer's old local value:
2796 swap it out! */
2797 swap_in_global_binding (XSYMBOL (sym));
2802 /* Find all the overlays in the current buffer that contain position POS.
2803 Return the number found, and store them in a vector in *VEC_PTR.
2804 Store in *LEN_PTR the size allocated for the vector.
2805 Store in *NEXT_PTR the next position after POS where an overlay starts,
2806 or ZV if there are no more overlays between POS and ZV.
2807 Store in *PREV_PTR the previous position before POS where an overlay ends,
2808 or where an overlay starts which ends at or after POS;
2809 or BEGV if there are no such overlays from BEGV to POS.
2810 NEXT_PTR and/or PREV_PTR may be 0, meaning don't store that info.
2812 *VEC_PTR and *LEN_PTR should contain a valid vector and size
2813 when this function is called.
2815 If EXTEND, make the vector bigger if necessary.
2816 If not, never extend the vector,
2817 and store only as many overlays as will fit.
2818 But still return the total number of overlays.
2820 If CHANGE_REQ, any position written into *PREV_PTR or
2821 *NEXT_PTR is guaranteed to be not equal to POS, unless it is the
2822 default (BEGV or ZV). */
2824 ptrdiff_t
2825 overlays_at (EMACS_INT pos, bool extend, Lisp_Object **vec_ptr,
2826 ptrdiff_t *len_ptr,
2827 ptrdiff_t *next_ptr, ptrdiff_t *prev_ptr, bool change_req)
2829 Lisp_Object overlay, start, end;
2830 struct Lisp_Overlay *tail;
2831 ptrdiff_t idx = 0;
2832 ptrdiff_t len = *len_ptr;
2833 Lisp_Object *vec = *vec_ptr;
2834 ptrdiff_t next = ZV;
2835 ptrdiff_t prev = BEGV;
2836 bool inhibit_storing = 0;
2838 for (tail = current_buffer->overlays_before; tail; tail = tail->next)
2840 ptrdiff_t startpos, endpos;
2842 XSETMISC (overlay, tail);
2844 start = OVERLAY_START (overlay);
2845 end = OVERLAY_END (overlay);
2846 endpos = OVERLAY_POSITION (end);
2847 if (endpos < pos)
2849 if (prev < endpos)
2850 prev = endpos;
2851 break;
2853 startpos = OVERLAY_POSITION (start);
2854 /* This one ends at or after POS
2855 so its start counts for PREV_PTR if it's before POS. */
2856 if (prev < startpos && startpos < pos)
2857 prev = startpos;
2858 if (endpos == pos)
2859 continue;
2860 if (startpos <= pos)
2862 if (idx == len)
2864 /* The supplied vector is full.
2865 Either make it bigger, or don't store any more in it. */
2866 if (extend)
2868 vec = xpalloc (vec, len_ptr, 1, OVERLAY_COUNT_MAX,
2869 sizeof *vec);
2870 *vec_ptr = vec;
2871 len = *len_ptr;
2873 else
2874 inhibit_storing = 1;
2877 if (!inhibit_storing)
2878 vec[idx] = overlay;
2879 /* Keep counting overlays even if we can't return them all. */
2880 idx++;
2882 else if (startpos < next)
2883 next = startpos;
2886 for (tail = current_buffer->overlays_after; tail; tail = tail->next)
2888 ptrdiff_t startpos, endpos;
2890 XSETMISC (overlay, tail);
2892 start = OVERLAY_START (overlay);
2893 end = OVERLAY_END (overlay);
2894 startpos = OVERLAY_POSITION (start);
2895 if (pos < startpos)
2897 if (startpos < next)
2898 next = startpos;
2899 break;
2901 endpos = OVERLAY_POSITION (end);
2902 if (pos < endpos)
2904 if (idx == len)
2906 if (extend)
2908 vec = xpalloc (vec, len_ptr, 1, OVERLAY_COUNT_MAX,
2909 sizeof *vec);
2910 *vec_ptr = vec;
2911 len = *len_ptr;
2913 else
2914 inhibit_storing = 1;
2917 if (!inhibit_storing)
2918 vec[idx] = overlay;
2919 idx++;
2921 if (startpos < pos && startpos > prev)
2922 prev = startpos;
2924 else if (endpos < pos && endpos > prev)
2925 prev = endpos;
2926 else if (endpos == pos && startpos > prev
2927 && (!change_req || startpos < pos))
2928 prev = startpos;
2931 if (next_ptr)
2932 *next_ptr = next;
2933 if (prev_ptr)
2934 *prev_ptr = prev;
2935 return idx;
2938 /* Find all the overlays in the current buffer that overlap the range
2939 BEG-END, or are empty at BEG, or are empty at END provided END
2940 denotes the position at the end of the current buffer.
2942 Return the number found, and store them in a vector in *VEC_PTR.
2943 Store in *LEN_PTR the size allocated for the vector.
2944 Store in *NEXT_PTR the next position after POS where an overlay starts,
2945 or ZV if there are no more overlays.
2946 Store in *PREV_PTR the previous position before POS where an overlay ends,
2947 or BEGV if there are no previous overlays.
2948 NEXT_PTR and/or PREV_PTR may be 0, meaning don't store that info.
2950 *VEC_PTR and *LEN_PTR should contain a valid vector and size
2951 when this function is called.
2953 If EXTEND, make the vector bigger if necessary.
2954 If not, never extend the vector,
2955 and store only as many overlays as will fit.
2956 But still return the total number of overlays. */
2958 static ptrdiff_t
2959 overlays_in (EMACS_INT beg, EMACS_INT end, bool extend,
2960 Lisp_Object **vec_ptr, ptrdiff_t *len_ptr,
2961 ptrdiff_t *next_ptr, ptrdiff_t *prev_ptr)
2963 Lisp_Object overlay, ostart, oend;
2964 struct Lisp_Overlay *tail;
2965 ptrdiff_t idx = 0;
2966 ptrdiff_t len = *len_ptr;
2967 Lisp_Object *vec = *vec_ptr;
2968 ptrdiff_t next = ZV;
2969 ptrdiff_t prev = BEGV;
2970 bool inhibit_storing = 0;
2971 bool end_is_Z = end == Z;
2973 for (tail = current_buffer->overlays_before; tail; tail = tail->next)
2975 ptrdiff_t startpos, endpos;
2977 XSETMISC (overlay, tail);
2979 ostart = OVERLAY_START (overlay);
2980 oend = OVERLAY_END (overlay);
2981 endpos = OVERLAY_POSITION (oend);
2982 if (endpos < beg)
2984 if (prev < endpos)
2985 prev = endpos;
2986 break;
2988 startpos = OVERLAY_POSITION (ostart);
2989 /* Count an interval if it overlaps the range, is empty at the
2990 start of the range, or is empty at END provided END denotes the
2991 end of the buffer. */
2992 if ((beg < endpos && startpos < end)
2993 || (startpos == endpos
2994 && (beg == endpos || (end_is_Z && endpos == end))))
2996 if (idx == len)
2998 /* The supplied vector is full.
2999 Either make it bigger, or don't store any more in it. */
3000 if (extend)
3002 vec = xpalloc (vec, len_ptr, 1, OVERLAY_COUNT_MAX,
3003 sizeof *vec);
3004 *vec_ptr = vec;
3005 len = *len_ptr;
3007 else
3008 inhibit_storing = 1;
3011 if (!inhibit_storing)
3012 vec[idx] = overlay;
3013 /* Keep counting overlays even if we can't return them all. */
3014 idx++;
3016 else if (startpos < next)
3017 next = startpos;
3020 for (tail = current_buffer->overlays_after; tail; tail = tail->next)
3022 ptrdiff_t startpos, endpos;
3024 XSETMISC (overlay, tail);
3026 ostart = OVERLAY_START (overlay);
3027 oend = OVERLAY_END (overlay);
3028 startpos = OVERLAY_POSITION (ostart);
3029 if (end < startpos)
3031 if (startpos < next)
3032 next = startpos;
3033 break;
3035 endpos = OVERLAY_POSITION (oend);
3036 /* Count an interval if it overlaps the range, is empty at the
3037 start of the range, or is empty at END provided END denotes the
3038 end of the buffer. */
3039 if ((beg < endpos && startpos < end)
3040 || (startpos == endpos
3041 && (beg == endpos || (end_is_Z && endpos == end))))
3043 if (idx == len)
3045 if (extend)
3047 vec = xpalloc (vec, len_ptr, 1, OVERLAY_COUNT_MAX,
3048 sizeof *vec);
3049 *vec_ptr = vec;
3050 len = *len_ptr;
3052 else
3053 inhibit_storing = 1;
3056 if (!inhibit_storing)
3057 vec[idx] = overlay;
3058 idx++;
3060 else if (endpos < beg && endpos > prev)
3061 prev = endpos;
3064 if (next_ptr)
3065 *next_ptr = next;
3066 if (prev_ptr)
3067 *prev_ptr = prev;
3068 return idx;
3072 /* Return true if there exists an overlay with a non-nil
3073 `mouse-face' property overlapping OVERLAY. */
3075 bool
3076 mouse_face_overlay_overlaps (Lisp_Object overlay)
3078 ptrdiff_t start = OVERLAY_POSITION (OVERLAY_START (overlay));
3079 ptrdiff_t end = OVERLAY_POSITION (OVERLAY_END (overlay));
3080 ptrdiff_t n, i, size;
3081 Lisp_Object *v, tem;
3083 size = 10;
3084 v = alloca (size * sizeof *v);
3085 n = overlays_in (start, end, 0, &v, &size, NULL, NULL);
3086 if (n > size)
3088 v = alloca (n * sizeof *v);
3089 overlays_in (start, end, 0, &v, &n, NULL, NULL);
3092 for (i = 0; i < n; ++i)
3093 if (!EQ (v[i], overlay)
3094 && (tem = Foverlay_get (overlay, Qmouse_face),
3095 !NILP (tem)))
3096 break;
3098 return i < n;
3103 /* Fast function to just test if we're at an overlay boundary. */
3104 bool
3105 overlay_touches_p (ptrdiff_t pos)
3107 Lisp_Object overlay;
3108 struct Lisp_Overlay *tail;
3110 for (tail = current_buffer->overlays_before; tail; tail = tail->next)
3112 ptrdiff_t endpos;
3114 XSETMISC (overlay ,tail);
3115 eassert (OVERLAYP (overlay));
3117 endpos = OVERLAY_POSITION (OVERLAY_END (overlay));
3118 if (endpos < pos)
3119 break;
3120 if (endpos == pos || OVERLAY_POSITION (OVERLAY_START (overlay)) == pos)
3121 return 1;
3124 for (tail = current_buffer->overlays_after; tail; tail = tail->next)
3126 ptrdiff_t startpos;
3128 XSETMISC (overlay, tail);
3129 eassert (OVERLAYP (overlay));
3131 startpos = OVERLAY_POSITION (OVERLAY_START (overlay));
3132 if (pos < startpos)
3133 break;
3134 if (startpos == pos || OVERLAY_POSITION (OVERLAY_END (overlay)) == pos)
3135 return 1;
3137 return 0;
3140 struct sortvec
3142 Lisp_Object overlay;
3143 ptrdiff_t beg, end;
3144 EMACS_INT priority;
3147 static int
3148 compare_overlays (const void *v1, const void *v2)
3150 const struct sortvec *s1 = v1;
3151 const struct sortvec *s2 = v2;
3152 if (s1->priority != s2->priority)
3153 return s1->priority < s2->priority ? -1 : 1;
3154 if (s1->beg != s2->beg)
3155 return s1->beg < s2->beg ? -1 : 1;
3156 if (s1->end != s2->end)
3157 return s2->end < s1->end ? -1 : 1;
3158 /* Avoid the non-determinism of qsort by choosing an arbitrary ordering
3159 between "equal" overlays. The result can still change between
3160 invocations of Emacs, but it won't change in the middle of
3161 `find_field' (bug#6830). */
3162 if (!EQ (s1->overlay, s2->overlay))
3163 return XLI (s1->overlay) < XLI (s2->overlay) ? -1 : 1;
3164 return 0;
3167 /* Sort an array of overlays by priority. The array is modified in place.
3168 The return value is the new size; this may be smaller than the original
3169 size if some of the overlays were invalid or were window-specific. */
3170 ptrdiff_t
3171 sort_overlays (Lisp_Object *overlay_vec, ptrdiff_t noverlays, struct window *w)
3173 ptrdiff_t i, j;
3174 USE_SAFE_ALLOCA;
3175 struct sortvec *sortvec;
3177 SAFE_NALLOCA (sortvec, 1, noverlays);
3179 /* Put the valid and relevant overlays into sortvec. */
3181 for (i = 0, j = 0; i < noverlays; i++)
3183 Lisp_Object tem;
3184 Lisp_Object overlay;
3186 overlay = overlay_vec[i];
3187 if (OVERLAYP (overlay)
3188 && OVERLAY_POSITION (OVERLAY_START (overlay)) > 0
3189 && OVERLAY_POSITION (OVERLAY_END (overlay)) > 0)
3191 /* If we're interested in a specific window, then ignore
3192 overlays that are limited to some other window. */
3193 if (w)
3195 Lisp_Object window;
3197 window = Foverlay_get (overlay, Qwindow);
3198 if (WINDOWP (window) && XWINDOW (window) != w)
3199 continue;
3202 /* This overlay is good and counts: put it into sortvec. */
3203 sortvec[j].overlay = overlay;
3204 sortvec[j].beg = OVERLAY_POSITION (OVERLAY_START (overlay));
3205 sortvec[j].end = OVERLAY_POSITION (OVERLAY_END (overlay));
3206 tem = Foverlay_get (overlay, Qpriority);
3207 if (INTEGERP (tem))
3208 sortvec[j].priority = XINT (tem);
3209 else
3210 sortvec[j].priority = 0;
3211 j++;
3214 noverlays = j;
3216 /* Sort the overlays into the proper order: increasing priority. */
3218 if (noverlays > 1)
3219 qsort (sortvec, noverlays, sizeof (struct sortvec), compare_overlays);
3221 for (i = 0; i < noverlays; i++)
3222 overlay_vec[i] = sortvec[i].overlay;
3224 SAFE_FREE ();
3225 return (noverlays);
3228 struct sortstr
3230 Lisp_Object string, string2;
3231 ptrdiff_t size;
3232 EMACS_INT priority;
3235 struct sortstrlist
3237 struct sortstr *buf; /* An array that expands as needed; never freed. */
3238 ptrdiff_t size; /* Allocated length of that array. */
3239 ptrdiff_t used; /* How much of the array is currently in use. */
3240 ptrdiff_t bytes; /* Total length of the strings in buf. */
3243 /* Buffers for storing information about the overlays touching a given
3244 position. These could be automatic variables in overlay_strings, but
3245 it's more efficient to hold onto the memory instead of repeatedly
3246 allocating and freeing it. */
3247 static struct sortstrlist overlay_heads, overlay_tails;
3248 static unsigned char *overlay_str_buf;
3250 /* Allocated length of overlay_str_buf. */
3251 static ptrdiff_t overlay_str_len;
3253 /* A comparison function suitable for passing to qsort. */
3254 static int
3255 cmp_for_strings (const void *as1, const void *as2)
3257 struct sortstr const *s1 = as1;
3258 struct sortstr const *s2 = as2;
3259 if (s1->size != s2->size)
3260 return s2->size < s1->size ? -1 : 1;
3261 if (s1->priority != s2->priority)
3262 return s1->priority < s2->priority ? -1 : 1;
3263 return 0;
3266 static void
3267 record_overlay_string (struct sortstrlist *ssl, Lisp_Object str,
3268 Lisp_Object str2, Lisp_Object pri, ptrdiff_t size)
3270 ptrdiff_t nbytes;
3272 if (ssl->used == ssl->size)
3273 ssl->buf = xpalloc (ssl->buf, &ssl->size, 5, -1, sizeof *ssl->buf);
3274 ssl->buf[ssl->used].string = str;
3275 ssl->buf[ssl->used].string2 = str2;
3276 ssl->buf[ssl->used].size = size;
3277 ssl->buf[ssl->used].priority = (INTEGERP (pri) ? XINT (pri) : 0);
3278 ssl->used++;
3280 if (NILP (BVAR (current_buffer, enable_multibyte_characters)))
3281 nbytes = SCHARS (str);
3282 else if (! STRING_MULTIBYTE (str))
3283 nbytes = count_size_as_multibyte (SDATA (str),
3284 SBYTES (str));
3285 else
3286 nbytes = SBYTES (str);
3288 if (INT_ADD_OVERFLOW (ssl->bytes, nbytes))
3289 memory_full (SIZE_MAX);
3290 ssl->bytes += nbytes;
3292 if (STRINGP (str2))
3294 if (NILP (BVAR (current_buffer, enable_multibyte_characters)))
3295 nbytes = SCHARS (str2);
3296 else if (! STRING_MULTIBYTE (str2))
3297 nbytes = count_size_as_multibyte (SDATA (str2),
3298 SBYTES (str2));
3299 else
3300 nbytes = SBYTES (str2);
3302 if (INT_ADD_OVERFLOW (ssl->bytes, nbytes))
3303 memory_full (SIZE_MAX);
3304 ssl->bytes += nbytes;
3308 /* Return the concatenation of the strings associated with overlays that
3309 begin or end at POS, ignoring overlays that are specific to a window
3310 other than W. The strings are concatenated in the appropriate order:
3311 shorter overlays nest inside longer ones, and higher priority inside
3312 lower. Normally all of the after-strings come first, but zero-sized
3313 overlays have their after-strings ride along with the before-strings
3314 because it would look strange to print them inside-out.
3316 Returns the string length, and stores the contents indirectly through
3317 PSTR, if that variable is non-null. The string may be overwritten by
3318 subsequent calls. */
3320 ptrdiff_t
3321 overlay_strings (ptrdiff_t pos, struct window *w, unsigned char **pstr)
3323 Lisp_Object overlay, window, str;
3324 struct Lisp_Overlay *ov;
3325 ptrdiff_t startpos, endpos;
3326 bool multibyte = ! NILP (BVAR (current_buffer, enable_multibyte_characters));
3328 overlay_heads.used = overlay_heads.bytes = 0;
3329 overlay_tails.used = overlay_tails.bytes = 0;
3330 for (ov = current_buffer->overlays_before; ov; ov = ov->next)
3332 XSETMISC (overlay, ov);
3333 eassert (OVERLAYP (overlay));
3335 startpos = OVERLAY_POSITION (OVERLAY_START (overlay));
3336 endpos = OVERLAY_POSITION (OVERLAY_END (overlay));
3337 if (endpos < pos)
3338 break;
3339 if (endpos != pos && startpos != pos)
3340 continue;
3341 window = Foverlay_get (overlay, Qwindow);
3342 if (WINDOWP (window) && XWINDOW (window) != w)
3343 continue;
3344 if (startpos == pos
3345 && (str = Foverlay_get (overlay, Qbefore_string), STRINGP (str)))
3346 record_overlay_string (&overlay_heads, str,
3347 (startpos == endpos
3348 ? Foverlay_get (overlay, Qafter_string)
3349 : Qnil),
3350 Foverlay_get (overlay, Qpriority),
3351 endpos - startpos);
3352 else if (endpos == pos
3353 && (str = Foverlay_get (overlay, Qafter_string), STRINGP (str)))
3354 record_overlay_string (&overlay_tails, str, Qnil,
3355 Foverlay_get (overlay, Qpriority),
3356 endpos - startpos);
3358 for (ov = current_buffer->overlays_after; ov; ov = ov->next)
3360 XSETMISC (overlay, ov);
3361 eassert (OVERLAYP (overlay));
3363 startpos = OVERLAY_POSITION (OVERLAY_START (overlay));
3364 endpos = OVERLAY_POSITION (OVERLAY_END (overlay));
3365 if (startpos > pos)
3366 break;
3367 if (endpos != pos && startpos != pos)
3368 continue;
3369 window = Foverlay_get (overlay, Qwindow);
3370 if (WINDOWP (window) && XWINDOW (window) != w)
3371 continue;
3372 if (startpos == pos
3373 && (str = Foverlay_get (overlay, Qbefore_string), STRINGP (str)))
3374 record_overlay_string (&overlay_heads, str,
3375 (startpos == endpos
3376 ? Foverlay_get (overlay, Qafter_string)
3377 : Qnil),
3378 Foverlay_get (overlay, Qpriority),
3379 endpos - startpos);
3380 else if (endpos == pos
3381 && (str = Foverlay_get (overlay, Qafter_string), STRINGP (str)))
3382 record_overlay_string (&overlay_tails, str, Qnil,
3383 Foverlay_get (overlay, Qpriority),
3384 endpos - startpos);
3386 if (overlay_tails.used > 1)
3387 qsort (overlay_tails.buf, overlay_tails.used, sizeof (struct sortstr),
3388 cmp_for_strings);
3389 if (overlay_heads.used > 1)
3390 qsort (overlay_heads.buf, overlay_heads.used, sizeof (struct sortstr),
3391 cmp_for_strings);
3392 if (overlay_heads.bytes || overlay_tails.bytes)
3394 Lisp_Object tem;
3395 ptrdiff_t i;
3396 unsigned char *p;
3397 ptrdiff_t total;
3399 if (INT_ADD_OVERFLOW (overlay_heads.bytes, overlay_tails.bytes))
3400 memory_full (SIZE_MAX);
3401 total = overlay_heads.bytes + overlay_tails.bytes;
3402 if (total > overlay_str_len)
3403 overlay_str_buf = xpalloc (overlay_str_buf, &overlay_str_len,
3404 total - overlay_str_len, -1, 1);
3406 p = overlay_str_buf;
3407 for (i = overlay_tails.used; --i >= 0;)
3409 ptrdiff_t nbytes;
3410 tem = overlay_tails.buf[i].string;
3411 nbytes = copy_text (SDATA (tem), p,
3412 SBYTES (tem),
3413 STRING_MULTIBYTE (tem), multibyte);
3414 p += nbytes;
3416 for (i = 0; i < overlay_heads.used; ++i)
3418 ptrdiff_t nbytes;
3419 tem = overlay_heads.buf[i].string;
3420 nbytes = copy_text (SDATA (tem), p,
3421 SBYTES (tem),
3422 STRING_MULTIBYTE (tem), multibyte);
3423 p += nbytes;
3424 tem = overlay_heads.buf[i].string2;
3425 if (STRINGP (tem))
3427 nbytes = copy_text (SDATA (tem), p,
3428 SBYTES (tem),
3429 STRING_MULTIBYTE (tem), multibyte);
3430 p += nbytes;
3433 if (p != overlay_str_buf + total)
3434 emacs_abort ();
3435 if (pstr)
3436 *pstr = overlay_str_buf;
3437 return total;
3439 return 0;
3442 /* Shift overlays in BUF's overlay lists, to center the lists at POS. */
3444 void
3445 recenter_overlay_lists (struct buffer *buf, ptrdiff_t pos)
3447 Lisp_Object overlay, beg, end;
3448 struct Lisp_Overlay *prev, *tail, *next;
3450 /* See if anything in overlays_before should move to overlays_after. */
3452 /* We don't strictly need prev in this loop; it should always be nil.
3453 But we use it for symmetry and in case that should cease to be true
3454 with some future change. */
3455 prev = NULL;
3456 for (tail = buf->overlays_before; tail; prev = tail, tail = next)
3458 next = tail->next;
3459 XSETMISC (overlay, tail);
3460 eassert (OVERLAYP (overlay));
3462 beg = OVERLAY_START (overlay);
3463 end = OVERLAY_END (overlay);
3465 if (OVERLAY_POSITION (end) > pos)
3467 /* OVERLAY needs to be moved. */
3468 ptrdiff_t where = OVERLAY_POSITION (beg);
3469 struct Lisp_Overlay *other, *other_prev;
3471 /* Splice the cons cell TAIL out of overlays_before. */
3472 if (prev)
3473 prev->next = next;
3474 else
3475 set_buffer_overlays_before (buf, next);
3477 /* Search thru overlays_after for where to put it. */
3478 other_prev = NULL;
3479 for (other = buf->overlays_after; other;
3480 other_prev = other, other = other->next)
3482 Lisp_Object otherbeg, otheroverlay;
3484 XSETMISC (otheroverlay, other);
3485 eassert (OVERLAYP (otheroverlay));
3487 otherbeg = OVERLAY_START (otheroverlay);
3488 if (OVERLAY_POSITION (otherbeg) >= where)
3489 break;
3492 /* Add TAIL to overlays_after before OTHER. */
3493 tail->next = other;
3494 if (other_prev)
3495 other_prev->next = tail;
3496 else
3497 set_buffer_overlays_after (buf, tail);
3498 tail = prev;
3500 else
3501 /* We've reached the things that should stay in overlays_before.
3502 All the rest of overlays_before must end even earlier,
3503 so stop now. */
3504 break;
3507 /* See if anything in overlays_after should be in overlays_before. */
3508 prev = NULL;
3509 for (tail = buf->overlays_after; tail; prev = tail, tail = next)
3511 next = tail->next;
3512 XSETMISC (overlay, tail);
3513 eassert (OVERLAYP (overlay));
3515 beg = OVERLAY_START (overlay);
3516 end = OVERLAY_END (overlay);
3518 /* Stop looking, when we know that nothing further
3519 can possibly end before POS. */
3520 if (OVERLAY_POSITION (beg) > pos)
3521 break;
3523 if (OVERLAY_POSITION (end) <= pos)
3525 /* OVERLAY needs to be moved. */
3526 ptrdiff_t where = OVERLAY_POSITION (end);
3527 struct Lisp_Overlay *other, *other_prev;
3529 /* Splice the cons cell TAIL out of overlays_after. */
3530 if (prev)
3531 prev->next = next;
3532 else
3533 set_buffer_overlays_after (buf, next);
3535 /* Search thru overlays_before for where to put it. */
3536 other_prev = NULL;
3537 for (other = buf->overlays_before; other;
3538 other_prev = other, other = other->next)
3540 Lisp_Object otherend, otheroverlay;
3542 XSETMISC (otheroverlay, other);
3543 eassert (OVERLAYP (otheroverlay));
3545 otherend = OVERLAY_END (otheroverlay);
3546 if (OVERLAY_POSITION (otherend) <= where)
3547 break;
3550 /* Add TAIL to overlays_before before OTHER. */
3551 tail->next = other;
3552 if (other_prev)
3553 other_prev->next = tail;
3554 else
3555 set_buffer_overlays_before (buf, tail);
3556 tail = prev;
3560 buf->overlay_center = pos;
3563 void
3564 adjust_overlays_for_insert (ptrdiff_t pos, ptrdiff_t length)
3566 /* After an insertion, the lists are still sorted properly,
3567 but we may need to update the value of the overlay center. */
3568 if (current_buffer->overlay_center >= pos)
3569 current_buffer->overlay_center += length;
3572 void
3573 adjust_overlays_for_delete (ptrdiff_t pos, ptrdiff_t length)
3575 if (current_buffer->overlay_center < pos)
3576 /* The deletion was to our right. No change needed; the before- and
3577 after-lists are still consistent. */
3579 else if (current_buffer->overlay_center - pos > length)
3580 /* The deletion was to our left. We need to adjust the center value
3581 to account for the change in position, but the lists are consistent
3582 given the new value. */
3583 current_buffer->overlay_center -= length;
3584 else
3585 /* We're right in the middle. There might be things on the after-list
3586 that now belong on the before-list. Recentering will move them,
3587 and also update the center point. */
3588 recenter_overlay_lists (current_buffer, pos);
3591 /* Fix up overlays that were garbled as a result of permuting markers
3592 in the range START through END. Any overlay with at least one
3593 endpoint in this range will need to be unlinked from the overlay
3594 list and reinserted in its proper place.
3595 Such an overlay might even have negative size at this point.
3596 If so, we'll make the overlay empty. */
3597 void
3598 fix_start_end_in_overlays (register ptrdiff_t start, register ptrdiff_t end)
3600 Lisp_Object overlay;
3601 struct Lisp_Overlay *before_list IF_LINT (= NULL);
3602 struct Lisp_Overlay *after_list IF_LINT (= NULL);
3603 /* These are either nil, indicating that before_list or after_list
3604 should be assigned, or the cons cell the cdr of which should be
3605 assigned. */
3606 struct Lisp_Overlay *beforep = NULL, *afterp = NULL;
3607 /* 'Parent', likewise, indicates a cons cell or
3608 current_buffer->overlays_before or overlays_after, depending
3609 which loop we're in. */
3610 struct Lisp_Overlay *tail, *parent;
3611 ptrdiff_t startpos, endpos;
3613 /* This algorithm shifts links around instead of consing and GCing.
3614 The loop invariant is that before_list (resp. after_list) is a
3615 well-formed list except that its last element, the CDR of beforep
3616 (resp. afterp) if beforep (afterp) isn't nil or before_list
3617 (after_list) if it is, is still uninitialized. So it's not a bug
3618 that before_list isn't initialized, although it may look
3619 strange. */
3620 for (parent = NULL, tail = current_buffer->overlays_before; tail;)
3622 XSETMISC (overlay, tail);
3624 endpos = OVERLAY_POSITION (OVERLAY_END (overlay));
3625 startpos = OVERLAY_POSITION (OVERLAY_START (overlay));
3627 /* If the overlay is backwards, make it empty. */
3628 if (endpos < startpos)
3630 startpos = endpos;
3631 Fset_marker (OVERLAY_START (overlay), make_number (startpos),
3632 Qnil);
3635 if (endpos < start)
3636 break;
3638 if (endpos < end
3639 || (startpos >= start && startpos < end))
3641 /* Add it to the end of the wrong list. Later on,
3642 recenter_overlay_lists will move it to the right place. */
3643 if (endpos < current_buffer->overlay_center)
3645 if (!afterp)
3646 after_list = tail;
3647 else
3648 afterp->next = tail;
3649 afterp = tail;
3651 else
3653 if (!beforep)
3654 before_list = tail;
3655 else
3656 beforep->next = tail;
3657 beforep = tail;
3659 if (!parent)
3660 set_buffer_overlays_before (current_buffer, tail->next);
3661 else
3662 parent->next = tail->next;
3663 tail = tail->next;
3665 else
3666 parent = tail, tail = parent->next;
3668 for (parent = NULL, tail = current_buffer->overlays_after; tail;)
3670 XSETMISC (overlay, tail);
3672 startpos = OVERLAY_POSITION (OVERLAY_START (overlay));
3673 endpos = OVERLAY_POSITION (OVERLAY_END (overlay));
3675 /* If the overlay is backwards, make it empty. */
3676 if (endpos < startpos)
3678 startpos = endpos;
3679 Fset_marker (OVERLAY_START (overlay), make_number (startpos),
3680 Qnil);
3683 if (startpos >= end)
3684 break;
3686 if (startpos >= start
3687 || (endpos >= start && endpos < end))
3689 if (endpos < current_buffer->overlay_center)
3691 if (!afterp)
3692 after_list = tail;
3693 else
3694 afterp->next = tail;
3695 afterp = tail;
3697 else
3699 if (!beforep)
3700 before_list = tail;
3701 else
3702 beforep->next = tail;
3703 beforep = tail;
3705 if (!parent)
3706 set_buffer_overlays_after (current_buffer, tail->next);
3707 else
3708 parent->next = tail->next;
3709 tail = tail->next;
3711 else
3712 parent = tail, tail = parent->next;
3715 /* Splice the constructed (wrong) lists into the buffer's lists,
3716 and let the recenter function make it sane again. */
3717 if (beforep)
3719 beforep->next = current_buffer->overlays_before;
3720 set_buffer_overlays_before (current_buffer, before_list);
3723 if (afterp)
3725 afterp->next = current_buffer->overlays_after;
3726 set_buffer_overlays_after (current_buffer, after_list);
3728 recenter_overlay_lists (current_buffer, current_buffer->overlay_center);
3731 /* We have two types of overlay: the one whose ending marker is
3732 after-insertion-marker (this is the usual case) and the one whose
3733 ending marker is before-insertion-marker. When `overlays_before'
3734 contains overlays of the latter type and the former type in this
3735 order and both overlays end at inserting position, inserting a text
3736 increases only the ending marker of the latter type, which results
3737 in incorrect ordering of `overlays_before'.
3739 This function fixes ordering of overlays in the slot
3740 `overlays_before' of the buffer *BP. Before the insertion, `point'
3741 was at PREV, and now is at POS. */
3743 void
3744 fix_overlays_before (struct buffer *bp, ptrdiff_t prev, ptrdiff_t pos)
3746 /* If parent is nil, replace overlays_before; otherwise, parent->next. */
3747 struct Lisp_Overlay *tail = bp->overlays_before, *parent = NULL, *right_pair;
3748 Lisp_Object tem;
3749 ptrdiff_t end IF_LINT (= 0);
3751 /* After the insertion, the several overlays may be in incorrect
3752 order. The possibility is that, in the list `overlays_before',
3753 an overlay which ends at POS appears after an overlay which ends
3754 at PREV. Since POS is greater than PREV, we must fix the
3755 ordering of these overlays, by moving overlays ends at POS before
3756 the overlays ends at PREV. */
3758 /* At first, find a place where disordered overlays should be linked
3759 in. It is where an overlay which end before POS exists. (i.e. an
3760 overlay whose ending marker is after-insertion-marker if disorder
3761 exists). */
3762 while (tail
3763 && (XSETMISC (tem, tail),
3764 (end = OVERLAY_POSITION (OVERLAY_END (tem))) >= pos))
3766 parent = tail;
3767 tail = tail->next;
3770 /* If we don't find such an overlay,
3771 or the found one ends before PREV,
3772 or the found one is the last one in the list,
3773 we don't have to fix anything. */
3774 if (!tail || end < prev || !tail->next)
3775 return;
3777 right_pair = parent;
3778 parent = tail;
3779 tail = tail->next;
3781 /* Now, end position of overlays in the list TAIL should be before
3782 or equal to PREV. In the loop, an overlay which ends at POS is
3783 moved ahead to the place indicated by the CDR of RIGHT_PAIR. If
3784 we found an overlay which ends before PREV, the remaining
3785 overlays are in correct order. */
3786 while (tail)
3788 XSETMISC (tem, tail);
3789 end = OVERLAY_POSITION (OVERLAY_END (tem));
3791 if (end == pos)
3792 { /* This overlay is disordered. */
3793 struct Lisp_Overlay *found = tail;
3795 /* Unlink the found overlay. */
3796 tail = found->next;
3797 parent->next = tail;
3798 /* Move an overlay at RIGHT_PLACE to the next of the found one,
3799 and link it into the right place. */
3800 if (!right_pair)
3802 found->next = bp->overlays_before;
3803 set_buffer_overlays_before (bp, found);
3805 else
3807 found->next = right_pair->next;
3808 right_pair->next = found;
3811 else if (end == prev)
3813 parent = tail;
3814 tail = tail->next;
3816 else /* No more disordered overlay. */
3817 break;
3821 DEFUN ("overlayp", Foverlayp, Soverlayp, 1, 1, 0,
3822 doc: /* Return t if OBJECT is an overlay. */)
3823 (Lisp_Object object)
3825 return (OVERLAYP (object) ? Qt : Qnil);
3828 DEFUN ("make-overlay", Fmake_overlay, Smake_overlay, 2, 5, 0,
3829 doc: /* Create a new overlay with range BEG to END in BUFFER.
3830 If omitted, BUFFER defaults to the current buffer.
3831 BEG and END may be integers or markers.
3832 The fourth arg FRONT-ADVANCE, if non-nil, makes the marker
3833 for the front of the overlay advance when text is inserted there
3834 \(which means the text *is not* included in the overlay).
3835 The fifth arg REAR-ADVANCE, if non-nil, makes the marker
3836 for the rear of the overlay advance when text is inserted there
3837 \(which means the text *is* included in the overlay). */)
3838 (Lisp_Object beg, Lisp_Object end, Lisp_Object buffer, Lisp_Object front_advance, Lisp_Object rear_advance)
3840 Lisp_Object overlay;
3841 struct buffer *b;
3843 if (NILP (buffer))
3844 XSETBUFFER (buffer, current_buffer);
3845 else
3846 CHECK_BUFFER (buffer);
3847 if (MARKERP (beg)
3848 && ! EQ (Fmarker_buffer (beg), buffer))
3849 error ("Marker points into wrong buffer");
3850 if (MARKERP (end)
3851 && ! EQ (Fmarker_buffer (end), buffer))
3852 error ("Marker points into wrong buffer");
3854 CHECK_NUMBER_COERCE_MARKER (beg);
3855 CHECK_NUMBER_COERCE_MARKER (end);
3857 if (XINT (beg) > XINT (end))
3859 Lisp_Object temp;
3860 temp = beg; beg = end; end = temp;
3863 b = XBUFFER (buffer);
3865 beg = Fset_marker (Fmake_marker (), beg, buffer);
3866 end = Fset_marker (Fmake_marker (), end, buffer);
3868 if (!NILP (front_advance))
3869 XMARKER (beg)->insertion_type = 1;
3870 if (!NILP (rear_advance))
3871 XMARKER (end)->insertion_type = 1;
3873 overlay = build_overlay (beg, end, Qnil);
3875 /* Put the new overlay on the wrong list. */
3876 end = OVERLAY_END (overlay);
3877 if (OVERLAY_POSITION (end) < b->overlay_center)
3879 eassert (b->overlays_after || (XOVERLAY (overlay)->next == NULL));
3880 XOVERLAY (overlay)->next = b->overlays_after;
3881 set_buffer_overlays_after (b, XOVERLAY (overlay));
3883 else
3885 eassert (b->overlays_before || (XOVERLAY (overlay)->next == NULL));
3886 XOVERLAY (overlay)->next = b->overlays_before;
3887 set_buffer_overlays_before (b, XOVERLAY (overlay));
3889 /* This puts it in the right list, and in the right order. */
3890 recenter_overlay_lists (b, b->overlay_center);
3892 /* We don't need to redisplay the region covered by the overlay, because
3893 the overlay has no properties at the moment. */
3895 return overlay;
3898 /* Mark a section of BUF as needing redisplay because of overlays changes. */
3900 static void
3901 modify_overlay (struct buffer *buf, ptrdiff_t start, ptrdiff_t end)
3903 if (start > end)
3905 ptrdiff_t temp = start;
3906 start = end;
3907 end = temp;
3910 BUF_COMPUTE_UNCHANGED (buf, start, end);
3912 /* If BUF is visible, consider updating the display if ... */
3913 if (buffer_window_count (buf) > 0)
3915 /* ... it's visible in other window than selected, */
3916 if (buf != XBUFFER (XWINDOW (selected_window)->contents))
3917 windows_or_buffers_changed = 1;
3918 /* ... or if we modify an overlay at the end of the buffer
3919 and so we cannot be sure that window end is still valid. */
3920 else if (end >= ZV && start <= ZV)
3921 windows_or_buffers_changed = 1;
3924 ++BUF_OVERLAY_MODIFF (buf);
3927 /* Remove OVERLAY from LIST. */
3929 static struct Lisp_Overlay *
3930 unchain_overlay (struct Lisp_Overlay *list, struct Lisp_Overlay *overlay)
3932 register struct Lisp_Overlay *tail, **prev = &list;
3934 for (tail = list; tail; prev = &tail->next, tail = *prev)
3935 if (tail == overlay)
3937 *prev = overlay->next;
3938 overlay->next = NULL;
3939 break;
3941 return list;
3944 /* Remove OVERLAY from both overlay lists of B. */
3946 static void
3947 unchain_both (struct buffer *b, Lisp_Object overlay)
3949 struct Lisp_Overlay *ov = XOVERLAY (overlay);
3951 set_buffer_overlays_before (b, unchain_overlay (b->overlays_before, ov));
3952 set_buffer_overlays_after (b, unchain_overlay (b->overlays_after, ov));
3953 eassert (XOVERLAY (overlay)->next == NULL);
3956 DEFUN ("move-overlay", Fmove_overlay, Smove_overlay, 3, 4, 0,
3957 doc: /* Set the endpoints of OVERLAY to BEG and END in BUFFER.
3958 If BUFFER is omitted, leave OVERLAY in the same buffer it inhabits now.
3959 If BUFFER is omitted, and OVERLAY is in no buffer, put it in the current
3960 buffer. */)
3961 (Lisp_Object overlay, Lisp_Object beg, Lisp_Object end, Lisp_Object buffer)
3963 struct buffer *b, *ob = 0;
3964 Lisp_Object obuffer;
3965 ptrdiff_t count = SPECPDL_INDEX ();
3966 ptrdiff_t n_beg, n_end, o_beg IF_LINT (= 0), o_end IF_LINT (= 0);
3968 CHECK_OVERLAY (overlay);
3969 if (NILP (buffer))
3970 buffer = Fmarker_buffer (OVERLAY_START (overlay));
3971 if (NILP (buffer))
3972 XSETBUFFER (buffer, current_buffer);
3973 CHECK_BUFFER (buffer);
3975 if (NILP (Fbuffer_live_p (buffer)))
3976 error ("Attempt to move overlay to a dead buffer");
3978 if (MARKERP (beg)
3979 && ! EQ (Fmarker_buffer (beg), buffer))
3980 error ("Marker points into wrong buffer");
3981 if (MARKERP (end)
3982 && ! EQ (Fmarker_buffer (end), buffer))
3983 error ("Marker points into wrong buffer");
3985 CHECK_NUMBER_COERCE_MARKER (beg);
3986 CHECK_NUMBER_COERCE_MARKER (end);
3988 if (XINT (beg) > XINT (end))
3990 Lisp_Object temp;
3991 temp = beg; beg = end; end = temp;
3994 specbind (Qinhibit_quit, Qt);
3996 obuffer = Fmarker_buffer (OVERLAY_START (overlay));
3997 b = XBUFFER (buffer);
3999 if (!NILP (obuffer))
4001 ob = XBUFFER (obuffer);
4003 o_beg = OVERLAY_POSITION (OVERLAY_START (overlay));
4004 o_end = OVERLAY_POSITION (OVERLAY_END (overlay));
4006 unchain_both (ob, overlay);
4009 /* Set the overlay boundaries, which may clip them. */
4010 Fset_marker (OVERLAY_START (overlay), beg, buffer);
4011 Fset_marker (OVERLAY_END (overlay), end, buffer);
4013 n_beg = marker_position (OVERLAY_START (overlay));
4014 n_end = marker_position (OVERLAY_END (overlay));
4016 /* If the overlay has changed buffers, do a thorough redisplay. */
4017 if (!EQ (buffer, obuffer))
4019 /* Redisplay where the overlay was. */
4020 if (ob)
4021 modify_overlay (ob, o_beg, o_end);
4023 /* Redisplay where the overlay is going to be. */
4024 modify_overlay (b, n_beg, n_end);
4026 else
4027 /* Redisplay the area the overlay has just left, or just enclosed. */
4029 if (o_beg == n_beg)
4030 modify_overlay (b, o_end, n_end);
4031 else if (o_end == n_end)
4032 modify_overlay (b, o_beg, n_beg);
4033 else
4034 modify_overlay (b, min (o_beg, n_beg), max (o_end, n_end));
4037 /* Delete the overlay if it is empty after clipping and has the
4038 evaporate property. */
4039 if (n_beg == n_end && !NILP (Foverlay_get (overlay, Qevaporate)))
4040 return unbind_to (count, Fdelete_overlay (overlay));
4042 /* Put the overlay into the new buffer's overlay lists, first on the
4043 wrong list. */
4044 if (n_end < b->overlay_center)
4046 XOVERLAY (overlay)->next = b->overlays_after;
4047 set_buffer_overlays_after (b, XOVERLAY (overlay));
4049 else
4051 XOVERLAY (overlay)->next = b->overlays_before;
4052 set_buffer_overlays_before (b, XOVERLAY (overlay));
4055 /* This puts it in the right list, and in the right order. */
4056 recenter_overlay_lists (b, b->overlay_center);
4058 return unbind_to (count, overlay);
4061 DEFUN ("delete-overlay", Fdelete_overlay, Sdelete_overlay, 1, 1, 0,
4062 doc: /* Delete the overlay OVERLAY from its buffer. */)
4063 (Lisp_Object overlay)
4065 Lisp_Object buffer;
4066 struct buffer *b;
4067 ptrdiff_t count = SPECPDL_INDEX ();
4069 CHECK_OVERLAY (overlay);
4071 buffer = Fmarker_buffer (OVERLAY_START (overlay));
4072 if (NILP (buffer))
4073 return Qnil;
4075 b = XBUFFER (buffer);
4076 specbind (Qinhibit_quit, Qt);
4078 unchain_both (b, overlay);
4079 drop_overlay (b, XOVERLAY (overlay));
4081 /* When deleting an overlay with before or after strings, turn off
4082 display optimizations for the affected buffer, on the basis that
4083 these strings may contain newlines. This is easier to do than to
4084 check for that situation during redisplay. */
4085 if (!windows_or_buffers_changed
4086 && (!NILP (Foverlay_get (overlay, Qbefore_string))
4087 || !NILP (Foverlay_get (overlay, Qafter_string))))
4088 b->prevent_redisplay_optimizations_p = 1;
4090 return unbind_to (count, Qnil);
4093 DEFUN ("delete-all-overlays", Fdelete_all_overlays, Sdelete_all_overlays, 0, 1, 0,
4094 doc: /* Delete all overlays of BUFFER.
4095 BUFFER omitted or nil means delete all overlays of the current
4096 buffer. */)
4097 (Lisp_Object buffer)
4099 register struct buffer *buf;
4101 if (NILP (buffer))
4102 buf = current_buffer;
4103 else
4105 CHECK_BUFFER (buffer);
4106 buf = XBUFFER (buffer);
4109 delete_all_overlays (buf);
4110 return Qnil;
4113 /* Overlay dissection functions. */
4115 DEFUN ("overlay-start", Foverlay_start, Soverlay_start, 1, 1, 0,
4116 doc: /* Return the position at which OVERLAY starts. */)
4117 (Lisp_Object overlay)
4119 CHECK_OVERLAY (overlay);
4121 return (Fmarker_position (OVERLAY_START (overlay)));
4124 DEFUN ("overlay-end", Foverlay_end, Soverlay_end, 1, 1, 0,
4125 doc: /* Return the position at which OVERLAY ends. */)
4126 (Lisp_Object overlay)
4128 CHECK_OVERLAY (overlay);
4130 return (Fmarker_position (OVERLAY_END (overlay)));
4133 DEFUN ("overlay-buffer", Foverlay_buffer, Soverlay_buffer, 1, 1, 0,
4134 doc: /* Return the buffer OVERLAY belongs to.
4135 Return nil if OVERLAY has been deleted. */)
4136 (Lisp_Object overlay)
4138 CHECK_OVERLAY (overlay);
4140 return Fmarker_buffer (OVERLAY_START (overlay));
4143 DEFUN ("overlay-properties", Foverlay_properties, Soverlay_properties, 1, 1, 0,
4144 doc: /* Return a list of the properties on OVERLAY.
4145 This is a copy of OVERLAY's plist; modifying its conses has no effect on
4146 OVERLAY. */)
4147 (Lisp_Object overlay)
4149 CHECK_OVERLAY (overlay);
4151 return Fcopy_sequence (XOVERLAY (overlay)->plist);
4155 DEFUN ("overlays-at", Foverlays_at, Soverlays_at, 1, 1, 0,
4156 doc: /* Return a list of the overlays that contain the character at POS. */)
4157 (Lisp_Object pos)
4159 ptrdiff_t len, noverlays;
4160 Lisp_Object *overlay_vec;
4161 Lisp_Object result;
4163 CHECK_NUMBER_COERCE_MARKER (pos);
4165 len = 10;
4166 /* We can't use alloca here because overlays_at can call xrealloc. */
4167 overlay_vec = xmalloc (len * sizeof *overlay_vec);
4169 /* Put all the overlays we want in a vector in overlay_vec.
4170 Store the length in len. */
4171 noverlays = overlays_at (XINT (pos), 1, &overlay_vec, &len,
4172 NULL, NULL, 0);
4174 /* Make a list of them all. */
4175 result = Flist (noverlays, overlay_vec);
4177 xfree (overlay_vec);
4178 return result;
4181 DEFUN ("overlays-in", Foverlays_in, Soverlays_in, 2, 2, 0,
4182 doc: /* Return a list of the overlays that overlap the region BEG ... END.
4183 Overlap means that at least one character is contained within the overlay
4184 and also contained within the specified region.
4185 Empty overlays are included in the result if they are located at BEG,
4186 between BEG and END, or at END provided END denotes the position at the
4187 end of the buffer. */)
4188 (Lisp_Object beg, Lisp_Object end)
4190 ptrdiff_t len, noverlays;
4191 Lisp_Object *overlay_vec;
4192 Lisp_Object result;
4194 CHECK_NUMBER_COERCE_MARKER (beg);
4195 CHECK_NUMBER_COERCE_MARKER (end);
4197 len = 10;
4198 overlay_vec = xmalloc (len * sizeof *overlay_vec);
4200 /* Put all the overlays we want in a vector in overlay_vec.
4201 Store the length in len. */
4202 noverlays = overlays_in (XINT (beg), XINT (end), 1, &overlay_vec, &len,
4203 NULL, NULL);
4205 /* Make a list of them all. */
4206 result = Flist (noverlays, overlay_vec);
4208 xfree (overlay_vec);
4209 return result;
4212 DEFUN ("next-overlay-change", Fnext_overlay_change, Snext_overlay_change,
4213 1, 1, 0,
4214 doc: /* Return the next position after POS where an overlay starts or ends.
4215 If there are no overlay boundaries from POS to (point-max),
4216 the value is (point-max). */)
4217 (Lisp_Object pos)
4219 ptrdiff_t i, len, noverlays;
4220 ptrdiff_t endpos;
4221 Lisp_Object *overlay_vec;
4223 CHECK_NUMBER_COERCE_MARKER (pos);
4225 len = 10;
4226 overlay_vec = xmalloc (len * sizeof *overlay_vec);
4228 /* Put all the overlays we want in a vector in overlay_vec.
4229 Store the length in len.
4230 endpos gets the position where the next overlay starts. */
4231 noverlays = overlays_at (XINT (pos), 1, &overlay_vec, &len,
4232 &endpos, 0, 1);
4234 /* If any of these overlays ends before endpos,
4235 use its ending point instead. */
4236 for (i = 0; i < noverlays; i++)
4238 Lisp_Object oend;
4239 ptrdiff_t oendpos;
4241 oend = OVERLAY_END (overlay_vec[i]);
4242 oendpos = OVERLAY_POSITION (oend);
4243 if (oendpos < endpos)
4244 endpos = oendpos;
4247 xfree (overlay_vec);
4248 return make_number (endpos);
4251 DEFUN ("previous-overlay-change", Fprevious_overlay_change,
4252 Sprevious_overlay_change, 1, 1, 0,
4253 doc: /* Return the previous position before POS where an overlay starts or ends.
4254 If there are no overlay boundaries from (point-min) to POS,
4255 the value is (point-min). */)
4256 (Lisp_Object pos)
4258 ptrdiff_t prevpos;
4259 Lisp_Object *overlay_vec;
4260 ptrdiff_t len;
4262 CHECK_NUMBER_COERCE_MARKER (pos);
4264 /* At beginning of buffer, we know the answer;
4265 avoid bug subtracting 1 below. */
4266 if (XINT (pos) == BEGV)
4267 return pos;
4269 len = 10;
4270 overlay_vec = xmalloc (len * sizeof *overlay_vec);
4272 /* Put all the overlays we want in a vector in overlay_vec.
4273 Store the length in len.
4274 prevpos gets the position of the previous change. */
4275 overlays_at (XINT (pos), 1, &overlay_vec, &len,
4276 0, &prevpos, 1);
4278 xfree (overlay_vec);
4279 return make_number (prevpos);
4282 /* These functions are for debugging overlays. */
4284 DEFUN ("overlay-lists", Foverlay_lists, Soverlay_lists, 0, 0, 0,
4285 doc: /* Return a pair of lists giving all the overlays of the current buffer.
4286 The car has all the overlays before the overlay center;
4287 the cdr has all the overlays after the overlay center.
4288 Recentering overlays moves overlays between these lists.
4289 The lists you get are copies, so that changing them has no effect.
4290 However, the overlays you get are the real objects that the buffer uses. */)
4291 (void)
4293 struct Lisp_Overlay *ol;
4294 Lisp_Object before = Qnil, after = Qnil, tmp;
4296 for (ol = current_buffer->overlays_before; ol; ol = ol->next)
4298 XSETMISC (tmp, ol);
4299 before = Fcons (tmp, before);
4301 for (ol = current_buffer->overlays_after; ol; ol = ol->next)
4303 XSETMISC (tmp, ol);
4304 after = Fcons (tmp, after);
4307 return Fcons (Fnreverse (before), Fnreverse (after));
4310 DEFUN ("overlay-recenter", Foverlay_recenter, Soverlay_recenter, 1, 1, 0,
4311 doc: /* Recenter the overlays of the current buffer around position POS.
4312 That makes overlay lookup faster for positions near POS (but perhaps slower
4313 for positions far away from POS). */)
4314 (Lisp_Object pos)
4316 ptrdiff_t p;
4317 CHECK_NUMBER_COERCE_MARKER (pos);
4319 p = clip_to_bounds (PTRDIFF_MIN, XINT (pos), PTRDIFF_MAX);
4320 recenter_overlay_lists (current_buffer, p);
4321 return Qnil;
4324 DEFUN ("overlay-get", Foverlay_get, Soverlay_get, 2, 2, 0,
4325 doc: /* Get the property of overlay OVERLAY with property name PROP. */)
4326 (Lisp_Object overlay, Lisp_Object prop)
4328 CHECK_OVERLAY (overlay);
4329 return lookup_char_property (XOVERLAY (overlay)->plist, prop, 0);
4332 DEFUN ("overlay-put", Foverlay_put, Soverlay_put, 3, 3, 0,
4333 doc: /* Set one property of overlay OVERLAY: give property PROP value VALUE.
4334 VALUE will be returned.*/)
4335 (Lisp_Object overlay, Lisp_Object prop, Lisp_Object value)
4337 Lisp_Object tail, buffer;
4338 bool changed;
4340 CHECK_OVERLAY (overlay);
4342 buffer = Fmarker_buffer (OVERLAY_START (overlay));
4344 for (tail = XOVERLAY (overlay)->plist;
4345 CONSP (tail) && CONSP (XCDR (tail));
4346 tail = XCDR (XCDR (tail)))
4347 if (EQ (XCAR (tail), prop))
4349 changed = !EQ (XCAR (XCDR (tail)), value);
4350 XSETCAR (XCDR (tail), value);
4351 goto found;
4353 /* It wasn't in the list, so add it to the front. */
4354 changed = !NILP (value);
4355 set_overlay_plist
4356 (overlay, Fcons (prop, Fcons (value, XOVERLAY (overlay)->plist)));
4357 found:
4358 if (! NILP (buffer))
4360 if (changed)
4361 modify_overlay (XBUFFER (buffer),
4362 marker_position (OVERLAY_START (overlay)),
4363 marker_position (OVERLAY_END (overlay)));
4364 if (EQ (prop, Qevaporate) && ! NILP (value)
4365 && (OVERLAY_POSITION (OVERLAY_START (overlay))
4366 == OVERLAY_POSITION (OVERLAY_END (overlay))))
4367 Fdelete_overlay (overlay);
4370 return value;
4373 /* Subroutine of report_overlay_modification. */
4375 /* Lisp vector holding overlay hook functions to call.
4376 Vector elements come in pairs.
4377 Each even-index element is a list of hook functions.
4378 The following odd-index element is the overlay they came from.
4380 Before the buffer change, we fill in this vector
4381 as we call overlay hook functions.
4382 After the buffer change, we get the functions to call from this vector.
4383 This way we always call the same functions before and after the change. */
4384 static Lisp_Object last_overlay_modification_hooks;
4386 /* Number of elements actually used in last_overlay_modification_hooks. */
4387 static ptrdiff_t last_overlay_modification_hooks_used;
4389 /* Add one functionlist/overlay pair
4390 to the end of last_overlay_modification_hooks. */
4392 static void
4393 add_overlay_mod_hooklist (Lisp_Object functionlist, Lisp_Object overlay)
4395 ptrdiff_t oldsize = ASIZE (last_overlay_modification_hooks);
4397 if (oldsize - 1 <= last_overlay_modification_hooks_used)
4398 last_overlay_modification_hooks =
4399 larger_vector (last_overlay_modification_hooks, 2, -1);
4400 ASET (last_overlay_modification_hooks, last_overlay_modification_hooks_used,
4401 functionlist); last_overlay_modification_hooks_used++;
4402 ASET (last_overlay_modification_hooks, last_overlay_modification_hooks_used,
4403 overlay); last_overlay_modification_hooks_used++;
4406 /* Run the modification-hooks of overlays that include
4407 any part of the text in START to END.
4408 If this change is an insertion, also
4409 run the insert-before-hooks of overlay starting at END,
4410 and the insert-after-hooks of overlay ending at START.
4412 This is called both before and after the modification.
4413 AFTER is true when we call after the modification.
4415 ARG1, ARG2, ARG3 are arguments to pass to the hook functions.
4416 When AFTER is nonzero, they are the start position,
4417 the position after the inserted new text,
4418 and the length of deleted or replaced old text. */
4420 void
4421 report_overlay_modification (Lisp_Object start, Lisp_Object end, bool after,
4422 Lisp_Object arg1, Lisp_Object arg2, Lisp_Object arg3)
4424 Lisp_Object prop, overlay;
4425 struct Lisp_Overlay *tail;
4426 /* True if this change is an insertion. */
4427 bool insertion = (after ? XFASTINT (arg3) == 0 : EQ (start, end));
4428 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
4430 overlay = Qnil;
4431 tail = NULL;
4433 /* We used to run the functions as soon as we found them and only register
4434 them in last_overlay_modification_hooks for the purpose of the `after'
4435 case. But running elisp code as we traverse the list of overlays is
4436 painful because the list can be modified by the elisp code so we had to
4437 copy at several places. We now simply do a read-only traversal that
4438 only collects the functions to run and we run them afterwards. It's
4439 simpler, especially since all the code was already there. -stef */
4441 if (!after)
4443 /* We are being called before a change.
4444 Scan the overlays to find the functions to call. */
4445 last_overlay_modification_hooks_used = 0;
4446 for (tail = current_buffer->overlays_before; tail; tail = tail->next)
4448 ptrdiff_t startpos, endpos;
4449 Lisp_Object ostart, oend;
4451 XSETMISC (overlay, tail);
4453 ostart = OVERLAY_START (overlay);
4454 oend = OVERLAY_END (overlay);
4455 endpos = OVERLAY_POSITION (oend);
4456 if (XFASTINT (start) > endpos)
4457 break;
4458 startpos = OVERLAY_POSITION (ostart);
4459 if (insertion && (XFASTINT (start) == startpos
4460 || XFASTINT (end) == startpos))
4462 prop = Foverlay_get (overlay, Qinsert_in_front_hooks);
4463 if (!NILP (prop))
4464 add_overlay_mod_hooklist (prop, overlay);
4466 if (insertion && (XFASTINT (start) == endpos
4467 || XFASTINT (end) == endpos))
4469 prop = Foverlay_get (overlay, Qinsert_behind_hooks);
4470 if (!NILP (prop))
4471 add_overlay_mod_hooklist (prop, overlay);
4473 /* Test for intersecting intervals. This does the right thing
4474 for both insertion and deletion. */
4475 if (XFASTINT (end) > startpos && XFASTINT (start) < endpos)
4477 prop = Foverlay_get (overlay, Qmodification_hooks);
4478 if (!NILP (prop))
4479 add_overlay_mod_hooklist (prop, overlay);
4483 for (tail = current_buffer->overlays_after; tail; tail = tail->next)
4485 ptrdiff_t startpos, endpos;
4486 Lisp_Object ostart, oend;
4488 XSETMISC (overlay, tail);
4490 ostart = OVERLAY_START (overlay);
4491 oend = OVERLAY_END (overlay);
4492 startpos = OVERLAY_POSITION (ostart);
4493 endpos = OVERLAY_POSITION (oend);
4494 if (XFASTINT (end) < startpos)
4495 break;
4496 if (insertion && (XFASTINT (start) == startpos
4497 || XFASTINT (end) == startpos))
4499 prop = Foverlay_get (overlay, Qinsert_in_front_hooks);
4500 if (!NILP (prop))
4501 add_overlay_mod_hooklist (prop, overlay);
4503 if (insertion && (XFASTINT (start) == endpos
4504 || XFASTINT (end) == endpos))
4506 prop = Foverlay_get (overlay, Qinsert_behind_hooks);
4507 if (!NILP (prop))
4508 add_overlay_mod_hooklist (prop, overlay);
4510 /* Test for intersecting intervals. This does the right thing
4511 for both insertion and deletion. */
4512 if (XFASTINT (end) > startpos && XFASTINT (start) < endpos)
4514 prop = Foverlay_get (overlay, Qmodification_hooks);
4515 if (!NILP (prop))
4516 add_overlay_mod_hooklist (prop, overlay);
4521 GCPRO4 (overlay, arg1, arg2, arg3);
4523 /* Call the functions recorded in last_overlay_modification_hooks.
4524 First copy the vector contents, in case some of these hooks
4525 do subsequent modification of the buffer. */
4526 ptrdiff_t size = last_overlay_modification_hooks_used;
4527 Lisp_Object *copy = alloca (size * sizeof *copy);
4528 ptrdiff_t i;
4530 memcpy (copy, XVECTOR (last_overlay_modification_hooks)->contents,
4531 size * word_size);
4532 gcpro1.var = copy;
4533 gcpro1.nvars = size;
4535 for (i = 0; i < size;)
4537 Lisp_Object prop_i, overlay_i;
4538 prop_i = copy[i++];
4539 overlay_i = copy[i++];
4540 call_overlay_mod_hooks (prop_i, overlay_i, after, arg1, arg2, arg3);
4543 UNGCPRO;
4546 static void
4547 call_overlay_mod_hooks (Lisp_Object list, Lisp_Object overlay, bool after,
4548 Lisp_Object arg1, Lisp_Object arg2, Lisp_Object arg3)
4550 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
4552 GCPRO4 (list, arg1, arg2, arg3);
4554 while (CONSP (list))
4556 if (NILP (arg3))
4557 call4 (XCAR (list), overlay, after ? Qt : Qnil, arg1, arg2);
4558 else
4559 call5 (XCAR (list), overlay, after ? Qt : Qnil, arg1, arg2, arg3);
4560 list = XCDR (list);
4562 UNGCPRO;
4565 /* Delete any zero-sized overlays at position POS, if the `evaporate'
4566 property is set. */
4567 void
4568 evaporate_overlays (ptrdiff_t pos)
4570 Lisp_Object overlay, hit_list;
4571 struct Lisp_Overlay *tail;
4573 hit_list = Qnil;
4574 if (pos <= current_buffer->overlay_center)
4575 for (tail = current_buffer->overlays_before; tail; tail = tail->next)
4577 ptrdiff_t endpos;
4578 XSETMISC (overlay, tail);
4579 endpos = OVERLAY_POSITION (OVERLAY_END (overlay));
4580 if (endpos < pos)
4581 break;
4582 if (endpos == pos && OVERLAY_POSITION (OVERLAY_START (overlay)) == pos
4583 && ! NILP (Foverlay_get (overlay, Qevaporate)))
4584 hit_list = Fcons (overlay, hit_list);
4586 else
4587 for (tail = current_buffer->overlays_after; tail; tail = tail->next)
4589 ptrdiff_t startpos;
4590 XSETMISC (overlay, tail);
4591 startpos = OVERLAY_POSITION (OVERLAY_START (overlay));
4592 if (startpos > pos)
4593 break;
4594 if (startpos == pos && OVERLAY_POSITION (OVERLAY_END (overlay)) == pos
4595 && ! NILP (Foverlay_get (overlay, Qevaporate)))
4596 hit_list = Fcons (overlay, hit_list);
4598 for (; CONSP (hit_list); hit_list = XCDR (hit_list))
4599 Fdelete_overlay (XCAR (hit_list));
4602 /***********************************************************************
4603 Allocation with mmap
4604 ***********************************************************************/
4606 #ifdef USE_MMAP_FOR_BUFFERS
4608 #include <sys/mman.h>
4610 #ifndef MAP_ANON
4611 #ifdef MAP_ANONYMOUS
4612 #define MAP_ANON MAP_ANONYMOUS
4613 #else
4614 #define MAP_ANON 0
4615 #endif
4616 #endif
4618 #ifndef MAP_FAILED
4619 #define MAP_FAILED ((void *) -1)
4620 #endif
4622 #if MAP_ANON == 0
4623 #include <fcntl.h>
4624 #endif
4626 #include "coding.h"
4629 /* Memory is allocated in regions which are mapped using mmap(2).
4630 The current implementation lets the system select mapped
4631 addresses; we're not using MAP_FIXED in general, except when
4632 trying to enlarge regions.
4634 Each mapped region starts with a mmap_region structure, the user
4635 area starts after that structure, aligned to MEM_ALIGN.
4637 +-----------------------+
4638 | struct mmap_info + |
4639 | padding |
4640 +-----------------------+
4641 | user data |
4644 +-----------------------+ */
4646 struct mmap_region
4648 /* User-specified size. */
4649 size_t nbytes_specified;
4651 /* Number of bytes mapped */
4652 size_t nbytes_mapped;
4654 /* Pointer to the location holding the address of the memory
4655 allocated with the mmap'd block. The variable actually points
4656 after this structure. */
4657 void **var;
4659 /* Next and previous in list of all mmap'd regions. */
4660 struct mmap_region *next, *prev;
4663 /* Doubly-linked list of mmap'd regions. */
4665 static struct mmap_region *mmap_regions;
4667 /* File descriptor for mmap. If we don't have anonymous mapping,
4668 /dev/zero will be opened on it. */
4670 static int mmap_fd;
4672 /* Temporary storage for mmap_set_vars, see there. */
4674 static struct mmap_region *mmap_regions_1;
4675 static int mmap_fd_1;
4677 /* Page size on this system. */
4679 static int mmap_page_size;
4681 /* 1 means mmap has been initialized. */
4683 static bool mmap_initialized_p;
4685 /* Value is X rounded up to the next multiple of N. */
4687 #define ROUND(X, N) (((X) + (N) - 1) / (N) * (N))
4689 /* Size of mmap_region structure plus padding. */
4691 #define MMAP_REGION_STRUCT_SIZE \
4692 ROUND (sizeof (struct mmap_region), MEM_ALIGN)
4694 /* Given a pointer P to the start of the user-visible part of a mapped
4695 region, return a pointer to the start of the region. */
4697 #define MMAP_REGION(P) \
4698 ((struct mmap_region *) ((char *) (P) - MMAP_REGION_STRUCT_SIZE))
4700 /* Given a pointer P to the start of a mapped region, return a pointer
4701 to the start of the user-visible part of the region. */
4703 #define MMAP_USER_AREA(P) \
4704 ((void *) ((char *) (P) + MMAP_REGION_STRUCT_SIZE))
4706 #define MEM_ALIGN sizeof (double)
4708 /* Predicate returning true if part of the address range [START .. END]
4709 is currently mapped. Used to prevent overwriting an existing
4710 memory mapping.
4712 Default is to conservatively assume the address range is occupied by
4713 something else. This can be overridden by system configuration
4714 files if system-specific means to determine this exists. */
4716 #ifndef MMAP_ALLOCATED_P
4717 #define MMAP_ALLOCATED_P(start, end) 1
4718 #endif
4720 /* Perform necessary initializations for the use of mmap. */
4722 static void
4723 mmap_init (void)
4725 #if MAP_ANON == 0
4726 /* The value of mmap_fd is initially 0 in temacs, and -1
4727 in a dumped Emacs. */
4728 if (mmap_fd <= 0)
4730 /* No anonymous mmap -- we need the file descriptor. */
4731 mmap_fd = emacs_open ("/dev/zero", O_RDONLY, 0);
4732 if (mmap_fd == -1)
4733 fatal ("Cannot open /dev/zero: %s", emacs_strerror (errno));
4735 #endif /* MAP_ANON == 0 */
4737 if (mmap_initialized_p)
4738 return;
4739 mmap_initialized_p = 1;
4741 #if MAP_ANON != 0
4742 mmap_fd = -1;
4743 #endif
4745 mmap_page_size = getpagesize ();
4748 /* Return a region overlapping address range START...END, or null if
4749 none. END is not including, i.e. the last byte in the range
4750 is at END - 1. */
4752 static struct mmap_region *
4753 mmap_find (void *start, void *end)
4755 struct mmap_region *r;
4756 char *s = start, *e = end;
4758 for (r = mmap_regions; r; r = r->next)
4760 char *rstart = (char *) r;
4761 char *rend = rstart + r->nbytes_mapped;
4763 if (/* First byte of range, i.e. START, in this region? */
4764 (s >= rstart && s < rend)
4765 /* Last byte of range, i.e. END - 1, in this region? */
4766 || (e > rstart && e <= rend)
4767 /* First byte of this region in the range? */
4768 || (rstart >= s && rstart < e)
4769 /* Last byte of this region in the range? */
4770 || (rend > s && rend <= e))
4771 break;
4774 return r;
4778 /* Unmap a region. P is a pointer to the start of the user-araa of
4779 the region. */
4781 static void
4782 mmap_free_1 (struct mmap_region *r)
4784 if (r->next)
4785 r->next->prev = r->prev;
4786 if (r->prev)
4787 r->prev->next = r->next;
4788 else
4789 mmap_regions = r->next;
4791 if (munmap (r, r->nbytes_mapped) == -1)
4792 fprintf (stderr, "munmap: %s\n", emacs_strerror (errno));
4796 /* Enlarge region R by NPAGES pages. NPAGES < 0 means shrink R.
4797 Value is true if successful. */
4799 static bool
4800 mmap_enlarge (struct mmap_region *r, int npages)
4802 char *region_end = (char *) r + r->nbytes_mapped;
4803 size_t nbytes;
4804 bool success = 0;
4806 if (npages < 0)
4808 /* Unmap pages at the end of the region. */
4809 nbytes = - npages * mmap_page_size;
4810 if (munmap (region_end - nbytes, nbytes) == -1)
4811 fprintf (stderr, "munmap: %s\n", emacs_strerror (errno));
4812 else
4814 r->nbytes_mapped -= nbytes;
4815 success = 1;
4818 else if (npages > 0)
4820 nbytes = npages * mmap_page_size;
4822 /* Try to map additional pages at the end of the region. We
4823 cannot do this if the address range is already occupied by
4824 something else because mmap deletes any previous mapping.
4825 I'm not sure this is worth doing, let's see. */
4826 if (!MMAP_ALLOCATED_P (region_end, region_end + nbytes))
4828 void *p;
4830 p = mmap (region_end, nbytes, PROT_READ | PROT_WRITE,
4831 MAP_ANON | MAP_PRIVATE | MAP_FIXED, mmap_fd, 0);
4832 if (p == MAP_FAILED)
4833 ; /* fprintf (stderr, "mmap: %s\n", emacs_strerror (errno)); */
4834 else if (p != region_end)
4836 /* Kernels are free to choose a different address. In
4837 that case, unmap what we've mapped above; we have
4838 no use for it. */
4839 if (munmap (p, nbytes) == -1)
4840 fprintf (stderr, "munmap: %s\n", emacs_strerror (errno));
4842 else
4844 r->nbytes_mapped += nbytes;
4845 success = 1;
4850 return success;
4854 /* Set or reset variables holding references to mapped regions.
4855 If not RESTORE_P, set all variables to null. If RESTORE_P, set all
4856 variables to the start of the user-areas of mapped regions.
4858 This function is called from Fdump_emacs to ensure that the dumped
4859 Emacs doesn't contain references to memory that won't be mapped
4860 when Emacs starts. */
4862 void
4863 mmap_set_vars (bool restore_p)
4865 struct mmap_region *r;
4867 if (restore_p)
4869 mmap_regions = mmap_regions_1;
4870 mmap_fd = mmap_fd_1;
4871 for (r = mmap_regions; r; r = r->next)
4872 *r->var = MMAP_USER_AREA (r);
4874 else
4876 for (r = mmap_regions; r; r = r->next)
4877 *r->var = NULL;
4878 mmap_regions_1 = mmap_regions;
4879 mmap_regions = NULL;
4880 mmap_fd_1 = mmap_fd;
4881 mmap_fd = -1;
4886 /* Allocate a block of storage large enough to hold NBYTES bytes of
4887 data. A pointer to the data is returned in *VAR. VAR is thus the
4888 address of some variable which will use the data area.
4890 The allocation of 0 bytes is valid.
4892 If we can't allocate the necessary memory, set *VAR to null, and
4893 return null. */
4895 static void *
4896 mmap_alloc (void **var, size_t nbytes)
4898 void *p;
4899 size_t map;
4901 mmap_init ();
4903 map = ROUND (nbytes + MMAP_REGION_STRUCT_SIZE, mmap_page_size);
4904 p = mmap (NULL, map, PROT_READ | PROT_WRITE, MAP_ANON | MAP_PRIVATE,
4905 mmap_fd, 0);
4907 if (p == MAP_FAILED)
4909 if (errno != ENOMEM)
4910 fprintf (stderr, "mmap: %s\n", emacs_strerror (errno));
4911 p = NULL;
4913 else
4915 struct mmap_region *r = p;
4917 r->nbytes_specified = nbytes;
4918 r->nbytes_mapped = map;
4919 r->var = var;
4920 r->prev = NULL;
4921 r->next = mmap_regions;
4922 if (r->next)
4923 r->next->prev = r;
4924 mmap_regions = r;
4926 p = MMAP_USER_AREA (p);
4929 return *var = p;
4933 /* Free a block of relocatable storage whose data is pointed to by
4934 PTR. Store 0 in *PTR to show there's no block allocated. */
4936 static void
4937 mmap_free (void **var)
4939 mmap_init ();
4941 if (*var)
4943 mmap_free_1 (MMAP_REGION (*var));
4944 *var = NULL;
4949 /* Given a pointer at address VAR to data allocated with mmap_alloc,
4950 resize it to size NBYTES. Change *VAR to reflect the new block,
4951 and return this value. If more memory cannot be allocated, then
4952 leave *VAR unchanged, and return null. */
4954 static void *
4955 mmap_realloc (void **var, size_t nbytes)
4957 void *result;
4959 mmap_init ();
4961 if (*var == NULL)
4962 result = mmap_alloc (var, nbytes);
4963 else if (nbytes == 0)
4965 mmap_free (var);
4966 result = mmap_alloc (var, nbytes);
4968 else
4970 struct mmap_region *r = MMAP_REGION (*var);
4971 size_t room = r->nbytes_mapped - MMAP_REGION_STRUCT_SIZE;
4973 if (room < nbytes)
4975 /* Must enlarge. */
4976 void *old_ptr = *var;
4978 /* Try to map additional pages at the end of the region.
4979 If that fails, allocate a new region, copy data
4980 from the old region, then free it. */
4981 if (mmap_enlarge (r, (ROUND (nbytes - room, mmap_page_size)
4982 / mmap_page_size)))
4984 r->nbytes_specified = nbytes;
4985 *var = result = old_ptr;
4987 else if (mmap_alloc (var, nbytes))
4989 memcpy (*var, old_ptr, r->nbytes_specified);
4990 mmap_free_1 (MMAP_REGION (old_ptr));
4991 result = *var;
4992 r = MMAP_REGION (result);
4993 r->nbytes_specified = nbytes;
4995 else
4997 *var = old_ptr;
4998 result = NULL;
5001 else if (room - nbytes >= mmap_page_size)
5003 /* Shrinking by at least a page. Let's give some
5004 memory back to the system.
5006 The extra parens are to make the division happens first,
5007 on positive values, so we know it will round towards
5008 zero. */
5009 mmap_enlarge (r, - ((room - nbytes) / mmap_page_size));
5010 result = *var;
5011 r->nbytes_specified = nbytes;
5013 else
5015 /* Leave it alone. */
5016 result = *var;
5017 r->nbytes_specified = nbytes;
5021 return result;
5025 #endif /* USE_MMAP_FOR_BUFFERS */
5029 /***********************************************************************
5030 Buffer-text Allocation
5031 ***********************************************************************/
5033 /* Allocate NBYTES bytes for buffer B's text buffer. */
5035 static void
5036 alloc_buffer_text (struct buffer *b, ptrdiff_t nbytes)
5038 void *p;
5040 block_input ();
5041 #if defined USE_MMAP_FOR_BUFFERS
5042 p = mmap_alloc ((void **) &b->text->beg, nbytes);
5043 #elif defined REL_ALLOC
5044 p = r_alloc ((void **) &b->text->beg, nbytes);
5045 #else
5046 p = xmalloc (nbytes);
5047 #endif
5049 if (p == NULL)
5051 unblock_input ();
5052 memory_full (nbytes);
5055 b->text->beg = p;
5056 unblock_input ();
5059 /* Enlarge buffer B's text buffer by DELTA bytes. DELTA < 0 means
5060 shrink it. */
5062 void
5063 enlarge_buffer_text (struct buffer *b, ptrdiff_t delta)
5065 void *p;
5066 ptrdiff_t nbytes = (BUF_Z_BYTE (b) - BUF_BEG_BYTE (b) + BUF_GAP_SIZE (b) + 1
5067 + delta);
5068 block_input ();
5069 #if defined USE_MMAP_FOR_BUFFERS
5070 p = mmap_realloc ((void **) &b->text->beg, nbytes);
5071 #elif defined REL_ALLOC
5072 p = r_re_alloc ((void **) &b->text->beg, nbytes);
5073 #else
5074 p = xrealloc (b->text->beg, nbytes);
5075 #endif
5077 if (p == NULL)
5079 unblock_input ();
5080 memory_full (nbytes);
5083 BUF_BEG_ADDR (b) = p;
5084 unblock_input ();
5088 /* Free buffer B's text buffer. */
5090 static void
5091 free_buffer_text (struct buffer *b)
5093 block_input ();
5095 #if defined USE_MMAP_FOR_BUFFERS
5096 mmap_free ((void **) &b->text->beg);
5097 #elif defined REL_ALLOC
5098 r_alloc_free ((void **) &b->text->beg);
5099 #else
5100 xfree (b->text->beg);
5101 #endif
5103 BUF_BEG_ADDR (b) = NULL;
5104 unblock_input ();
5109 /***********************************************************************
5110 Initialization
5111 ***********************************************************************/
5113 void
5114 init_buffer_once (void)
5116 int idx;
5118 memset (buffer_permanent_local_flags, 0, sizeof buffer_permanent_local_flags);
5120 /* Make sure all markable slots in buffer_defaults
5121 are initialized reasonably, so mark_buffer won't choke. */
5122 reset_buffer (&buffer_defaults);
5123 eassert (EQ (BVAR (&buffer_defaults, name), make_number (0)));
5124 reset_buffer_local_variables (&buffer_defaults, 1);
5125 eassert (EQ (BVAR (&buffer_local_symbols, name), make_number (0)));
5126 reset_buffer (&buffer_local_symbols);
5127 reset_buffer_local_variables (&buffer_local_symbols, 1);
5128 /* Prevent GC from getting confused. */
5129 buffer_defaults.text = &buffer_defaults.own_text;
5130 buffer_local_symbols.text = &buffer_local_symbols.own_text;
5131 /* No one will share the text with these buffers, but let's play it safe. */
5132 buffer_defaults.indirections = 0;
5133 buffer_local_symbols.indirections = 0;
5134 /* Likewise no one will display them. */
5135 buffer_defaults.window_count = 0;
5136 buffer_local_symbols.window_count = 0;
5137 set_buffer_intervals (&buffer_defaults, NULL);
5138 set_buffer_intervals (&buffer_local_symbols, NULL);
5139 /* This is not strictly necessary, but let's make them initialized. */
5140 bset_name (&buffer_defaults, build_pure_c_string (" *buffer-defaults*"));
5141 bset_name (&buffer_local_symbols, build_pure_c_string (" *buffer-local-symbols*"));
5142 BUFFER_PVEC_INIT (&buffer_defaults);
5143 BUFFER_PVEC_INIT (&buffer_local_symbols);
5145 /* Set up the default values of various buffer slots. */
5146 /* Must do these before making the first buffer! */
5148 /* real setup is done in bindings.el */
5149 bset_mode_line_format (&buffer_defaults, build_pure_c_string ("%-"));
5150 bset_header_line_format (&buffer_defaults, Qnil);
5151 bset_abbrev_mode (&buffer_defaults, Qnil);
5152 bset_overwrite_mode (&buffer_defaults, Qnil);
5153 bset_case_fold_search (&buffer_defaults, Qt);
5154 bset_auto_fill_function (&buffer_defaults, Qnil);
5155 bset_selective_display (&buffer_defaults, Qnil);
5156 bset_selective_display_ellipses (&buffer_defaults, Qt);
5157 bset_abbrev_table (&buffer_defaults, Qnil);
5158 bset_display_table (&buffer_defaults, Qnil);
5159 bset_undo_list (&buffer_defaults, Qnil);
5160 bset_mark_active (&buffer_defaults, Qnil);
5161 bset_file_format (&buffer_defaults, Qnil);
5162 bset_auto_save_file_format (&buffer_defaults, Qt);
5163 set_buffer_overlays_before (&buffer_defaults, NULL);
5164 set_buffer_overlays_after (&buffer_defaults, NULL);
5165 buffer_defaults.overlay_center = BEG;
5167 XSETFASTINT (BVAR (&buffer_defaults, tab_width), 8);
5168 bset_truncate_lines (&buffer_defaults, Qnil);
5169 bset_word_wrap (&buffer_defaults, Qnil);
5170 bset_ctl_arrow (&buffer_defaults, Qt);
5171 bset_bidi_display_reordering (&buffer_defaults, Qt);
5172 bset_bidi_paragraph_direction (&buffer_defaults, Qnil);
5173 bset_cursor_type (&buffer_defaults, Qt);
5174 bset_extra_line_spacing (&buffer_defaults, Qnil);
5175 bset_cursor_in_non_selected_windows (&buffer_defaults, Qt);
5177 bset_enable_multibyte_characters (&buffer_defaults, Qt);
5178 bset_buffer_file_coding_system (&buffer_defaults, Qnil);
5179 XSETFASTINT (BVAR (&buffer_defaults, fill_column), 70);
5180 XSETFASTINT (BVAR (&buffer_defaults, left_margin), 0);
5181 bset_cache_long_scans (&buffer_defaults, Qnil);
5182 bset_file_truename (&buffer_defaults, Qnil);
5183 XSETFASTINT (BVAR (&buffer_defaults, display_count), 0);
5184 XSETFASTINT (BVAR (&buffer_defaults, left_margin_cols), 0);
5185 XSETFASTINT (BVAR (&buffer_defaults, right_margin_cols), 0);
5186 bset_left_fringe_width (&buffer_defaults, Qnil);
5187 bset_right_fringe_width (&buffer_defaults, Qnil);
5188 bset_fringes_outside_margins (&buffer_defaults, Qnil);
5189 bset_scroll_bar_width (&buffer_defaults, Qnil);
5190 bset_vertical_scroll_bar_type (&buffer_defaults, Qt);
5191 bset_indicate_empty_lines (&buffer_defaults, Qnil);
5192 bset_indicate_buffer_boundaries (&buffer_defaults, Qnil);
5193 bset_fringe_indicator_alist (&buffer_defaults, Qnil);
5194 bset_fringe_cursor_alist (&buffer_defaults, Qnil);
5195 bset_scroll_up_aggressively (&buffer_defaults, Qnil);
5196 bset_scroll_down_aggressively (&buffer_defaults, Qnil);
5197 bset_display_time (&buffer_defaults, Qnil);
5199 /* Assign the local-flags to the slots that have default values.
5200 The local flag is a bit that is used in the buffer
5201 to say that it has its own local value for the slot.
5202 The local flag bits are in the local_var_flags slot of the buffer. */
5204 /* Nothing can work if this isn't true */
5205 { verify (sizeof (EMACS_INT) == word_size); }
5207 /* 0 means not a lisp var, -1 means always local, else mask */
5208 memset (&buffer_local_flags, 0, sizeof buffer_local_flags);
5209 bset_filename (&buffer_local_flags, make_number (-1));
5210 bset_directory (&buffer_local_flags, make_number (-1));
5211 bset_backed_up (&buffer_local_flags, make_number (-1));
5212 bset_save_length (&buffer_local_flags, make_number (-1));
5213 bset_auto_save_file_name (&buffer_local_flags, make_number (-1));
5214 bset_read_only (&buffer_local_flags, make_number (-1));
5215 bset_major_mode (&buffer_local_flags, make_number (-1));
5216 bset_mode_name (&buffer_local_flags, make_number (-1));
5217 bset_undo_list (&buffer_local_flags, make_number (-1));
5218 bset_mark_active (&buffer_local_flags, make_number (-1));
5219 bset_point_before_scroll (&buffer_local_flags, make_number (-1));
5220 bset_file_truename (&buffer_local_flags, make_number (-1));
5221 bset_invisibility_spec (&buffer_local_flags, make_number (-1));
5222 bset_file_format (&buffer_local_flags, make_number (-1));
5223 bset_auto_save_file_format (&buffer_local_flags, make_number (-1));
5224 bset_display_count (&buffer_local_flags, make_number (-1));
5225 bset_display_time (&buffer_local_flags, make_number (-1));
5226 bset_enable_multibyte_characters (&buffer_local_flags, make_number (-1));
5228 idx = 1;
5229 XSETFASTINT (BVAR (&buffer_local_flags, mode_line_format), idx); ++idx;
5230 XSETFASTINT (BVAR (&buffer_local_flags, abbrev_mode), idx); ++idx;
5231 XSETFASTINT (BVAR (&buffer_local_flags, overwrite_mode), idx); ++idx;
5232 XSETFASTINT (BVAR (&buffer_local_flags, case_fold_search), idx); ++idx;
5233 XSETFASTINT (BVAR (&buffer_local_flags, auto_fill_function), idx); ++idx;
5234 XSETFASTINT (BVAR (&buffer_local_flags, selective_display), idx); ++idx;
5235 XSETFASTINT (BVAR (&buffer_local_flags, selective_display_ellipses), idx); ++idx;
5236 XSETFASTINT (BVAR (&buffer_local_flags, tab_width), idx); ++idx;
5237 XSETFASTINT (BVAR (&buffer_local_flags, truncate_lines), idx); ++idx;
5238 XSETFASTINT (BVAR (&buffer_local_flags, word_wrap), idx); ++idx;
5239 XSETFASTINT (BVAR (&buffer_local_flags, ctl_arrow), idx); ++idx;
5240 XSETFASTINT (BVAR (&buffer_local_flags, fill_column), idx); ++idx;
5241 XSETFASTINT (BVAR (&buffer_local_flags, left_margin), idx); ++idx;
5242 XSETFASTINT (BVAR (&buffer_local_flags, abbrev_table), idx); ++idx;
5243 XSETFASTINT (BVAR (&buffer_local_flags, display_table), idx); ++idx;
5244 XSETFASTINT (BVAR (&buffer_local_flags, syntax_table), idx); ++idx;
5245 XSETFASTINT (BVAR (&buffer_local_flags, cache_long_scans), idx); ++idx;
5246 XSETFASTINT (BVAR (&buffer_local_flags, category_table), idx); ++idx;
5247 XSETFASTINT (BVAR (&buffer_local_flags, bidi_display_reordering), idx); ++idx;
5248 XSETFASTINT (BVAR (&buffer_local_flags, bidi_paragraph_direction), idx); ++idx;
5249 XSETFASTINT (BVAR (&buffer_local_flags, buffer_file_coding_system), idx);
5250 /* Make this one a permanent local. */
5251 buffer_permanent_local_flags[idx++] = 1;
5252 XSETFASTINT (BVAR (&buffer_local_flags, left_margin_cols), idx); ++idx;
5253 XSETFASTINT (BVAR (&buffer_local_flags, right_margin_cols), idx); ++idx;
5254 XSETFASTINT (BVAR (&buffer_local_flags, left_fringe_width), idx); ++idx;
5255 XSETFASTINT (BVAR (&buffer_local_flags, right_fringe_width), idx); ++idx;
5256 XSETFASTINT (BVAR (&buffer_local_flags, fringes_outside_margins), idx); ++idx;
5257 XSETFASTINT (BVAR (&buffer_local_flags, scroll_bar_width), idx); ++idx;
5258 XSETFASTINT (BVAR (&buffer_local_flags, vertical_scroll_bar_type), idx); ++idx;
5259 XSETFASTINT (BVAR (&buffer_local_flags, indicate_empty_lines), idx); ++idx;
5260 XSETFASTINT (BVAR (&buffer_local_flags, indicate_buffer_boundaries), idx); ++idx;
5261 XSETFASTINT (BVAR (&buffer_local_flags, fringe_indicator_alist), idx); ++idx;
5262 XSETFASTINT (BVAR (&buffer_local_flags, fringe_cursor_alist), idx); ++idx;
5263 XSETFASTINT (BVAR (&buffer_local_flags, scroll_up_aggressively), idx); ++idx;
5264 XSETFASTINT (BVAR (&buffer_local_flags, scroll_down_aggressively), idx); ++idx;
5265 XSETFASTINT (BVAR (&buffer_local_flags, header_line_format), idx); ++idx;
5266 XSETFASTINT (BVAR (&buffer_local_flags, cursor_type), idx); ++idx;
5267 XSETFASTINT (BVAR (&buffer_local_flags, extra_line_spacing), idx); ++idx;
5268 XSETFASTINT (BVAR (&buffer_local_flags, cursor_in_non_selected_windows), idx); ++idx;
5270 /* Need more room? */
5271 if (idx >= MAX_PER_BUFFER_VARS)
5272 emacs_abort ();
5273 last_per_buffer_idx = idx;
5275 Vbuffer_alist = Qnil;
5276 current_buffer = 0;
5277 all_buffers = 0;
5279 QSFundamental = build_pure_c_string ("Fundamental");
5281 Qfundamental_mode = intern_c_string ("fundamental-mode");
5282 bset_major_mode (&buffer_defaults, Qfundamental_mode);
5284 Qmode_class = intern_c_string ("mode-class");
5286 Qprotected_field = intern_c_string ("protected-field");
5288 Qpermanent_local = intern_c_string ("permanent-local");
5290 Qkill_buffer_hook = intern_c_string ("kill-buffer-hook");
5291 Fput (Qkill_buffer_hook, Qpermanent_local, Qt);
5293 /* super-magic invisible buffer */
5294 Vprin1_to_string_buffer = Fget_buffer_create (build_pure_c_string (" prin1"));
5295 Vbuffer_alist = Qnil;
5297 Fset_buffer (Fget_buffer_create (build_pure_c_string ("*scratch*")));
5299 inhibit_modification_hooks = 0;
5302 void
5303 init_buffer (void)
5305 char *pwd;
5306 Lisp_Object temp;
5307 ptrdiff_t len;
5309 #ifdef USE_MMAP_FOR_BUFFERS
5311 /* When using the ralloc implementation based on mmap(2), buffer
5312 text pointers will have been set to null in the dumped Emacs.
5313 Map new memory. */
5314 struct buffer *b;
5316 FOR_EACH_BUFFER (b)
5317 if (b->text->beg == NULL)
5318 enlarge_buffer_text (b, 0);
5320 #endif /* USE_MMAP_FOR_BUFFERS */
5322 Fset_buffer (Fget_buffer_create (build_string ("*scratch*")));
5323 if (NILP (BVAR (&buffer_defaults, enable_multibyte_characters)))
5324 Fset_buffer_multibyte (Qnil);
5326 pwd = get_current_dir_name ();
5328 if (!pwd)
5329 fatal ("`get_current_dir_name' failed: %s\n", strerror (errno));
5331 /* Maybe this should really use some standard subroutine
5332 whose definition is filename syntax dependent. */
5333 len = strlen (pwd);
5334 if (!(IS_DIRECTORY_SEP (pwd[len - 1])))
5336 /* Grow buffer to add directory separator and '\0'. */
5337 pwd = realloc (pwd, len + 2);
5338 if (!pwd)
5339 fatal ("`get_current_dir_name' failed: %s\n", strerror (errno));
5340 pwd[len] = DIRECTORY_SEP;
5341 pwd[len + 1] = '\0';
5342 len++;
5345 bset_directory (current_buffer, make_unibyte_string (pwd, len));
5346 if (! NILP (BVAR (&buffer_defaults, enable_multibyte_characters)))
5347 /* At this moment, we still don't know how to decode the
5348 directory name. So, we keep the bytes in multibyte form so
5349 that ENCODE_FILE correctly gets the original bytes. */
5350 bset_directory
5351 (current_buffer, string_to_multibyte (BVAR (current_buffer, directory)));
5353 /* Add /: to the front of the name
5354 if it would otherwise be treated as magic. */
5355 temp = Ffind_file_name_handler (BVAR (current_buffer, directory), Qt);
5356 if (! NILP (temp)
5357 /* If the default dir is just /, TEMP is non-nil
5358 because of the ange-ftp completion handler.
5359 However, it is not necessary to turn / into /:/.
5360 So avoid doing that. */
5361 && strcmp ("/", SSDATA (BVAR (current_buffer, directory))))
5362 bset_directory
5363 (current_buffer,
5364 concat2 (build_string ("/:"), BVAR (current_buffer, directory)));
5366 temp = get_minibuffer (0);
5367 bset_directory (XBUFFER (temp), BVAR (current_buffer, directory));
5369 free (pwd);
5372 /* Similar to defvar_lisp but define a variable whose value is the
5373 Lisp_Object stored in the current buffer. LNAME is the Lisp-level
5374 variable name. VNAME is the name of the buffer slot. PREDICATE
5375 is nil for a general Lisp variable. If PREDICATE is non-nil, then
5376 only Lisp values that satisfies the PREDICATE are allowed (except
5377 that nil is allowed too). DOC is a dummy where you write the doc
5378 string as a comment. */
5380 #define DEFVAR_PER_BUFFER(lname, vname, predicate, doc) \
5381 do { \
5382 static struct Lisp_Buffer_Objfwd bo_fwd; \
5383 defvar_per_buffer (&bo_fwd, lname, vname, predicate); \
5384 } while (0)
5386 static void
5387 defvar_per_buffer (struct Lisp_Buffer_Objfwd *bo_fwd, const char *namestring,
5388 Lisp_Object *address, Lisp_Object predicate)
5390 struct Lisp_Symbol *sym;
5391 int offset;
5393 sym = XSYMBOL (intern (namestring));
5394 offset = (char *)address - (char *)current_buffer;
5396 bo_fwd->type = Lisp_Fwd_Buffer_Obj;
5397 bo_fwd->offset = offset;
5398 bo_fwd->predicate = predicate;
5399 sym->declared_special = 1;
5400 sym->redirect = SYMBOL_FORWARDED;
5401 SET_SYMBOL_FWD (sym, (union Lisp_Fwd *) bo_fwd);
5402 XSETSYMBOL (PER_BUFFER_SYMBOL (offset), sym);
5404 if (PER_BUFFER_IDX (offset) == 0)
5405 /* Did a DEFVAR_PER_BUFFER without initializing the corresponding
5406 slot of buffer_local_flags */
5407 emacs_abort ();
5411 /* initialize the buffer routines */
5412 void
5413 syms_of_buffer (void)
5415 staticpro (&last_overlay_modification_hooks);
5416 last_overlay_modification_hooks
5417 = Fmake_vector (make_number (10), Qnil);
5419 staticpro (&Qfundamental_mode);
5420 staticpro (&Qmode_class);
5421 staticpro (&QSFundamental);
5422 staticpro (&Vbuffer_alist);
5423 staticpro (&Qprotected_field);
5424 staticpro (&Qpermanent_local);
5425 staticpro (&Qkill_buffer_hook);
5427 DEFSYM (Qpermanent_local_hook, "permanent-local-hook");
5428 DEFSYM (Qoverlayp, "overlayp");
5429 DEFSYM (Qevaporate, "evaporate");
5430 DEFSYM (Qmodification_hooks, "modification-hooks");
5431 DEFSYM (Qinsert_in_front_hooks, "insert-in-front-hooks");
5432 DEFSYM (Qinsert_behind_hooks, "insert-behind-hooks");
5433 DEFSYM (Qget_file_buffer, "get-file-buffer");
5434 DEFSYM (Qpriority, "priority");
5435 DEFSYM (Qbefore_string, "before-string");
5436 DEFSYM (Qafter_string, "after-string");
5437 DEFSYM (Qfirst_change_hook, "first-change-hook");
5438 DEFSYM (Qbefore_change_functions, "before-change-functions");
5439 DEFSYM (Qafter_change_functions, "after-change-functions");
5440 DEFSYM (Qkill_buffer_query_functions, "kill-buffer-query-functions");
5442 Fput (Qprotected_field, Qerror_conditions,
5443 listn (CONSTYPE_PURE, 2, Qprotected_field, Qerror));
5444 Fput (Qprotected_field, Qerror_message,
5445 build_pure_c_string ("Attempt to modify a protected field"));
5447 DEFVAR_BUFFER_DEFAULTS ("default-mode-line-format",
5448 mode_line_format,
5449 doc: /* Default value of `mode-line-format' for buffers that don't override it.
5450 This is the same as (default-value 'mode-line-format). */);
5452 DEFVAR_BUFFER_DEFAULTS ("default-header-line-format",
5453 header_line_format,
5454 doc: /* Default value of `header-line-format' for buffers that don't override it.
5455 This is the same as (default-value 'header-line-format). */);
5457 DEFVAR_BUFFER_DEFAULTS ("default-cursor-type", cursor_type,
5458 doc: /* Default value of `cursor-type' for buffers that don't override it.
5459 This is the same as (default-value 'cursor-type). */);
5461 DEFVAR_BUFFER_DEFAULTS ("default-line-spacing",
5462 extra_line_spacing,
5463 doc: /* Default value of `line-spacing' for buffers that don't override it.
5464 This is the same as (default-value 'line-spacing). */);
5466 DEFVAR_BUFFER_DEFAULTS ("default-cursor-in-non-selected-windows",
5467 cursor_in_non_selected_windows,
5468 doc: /* Default value of `cursor-in-non-selected-windows'.
5469 This is the same as (default-value 'cursor-in-non-selected-windows). */);
5471 DEFVAR_BUFFER_DEFAULTS ("default-abbrev-mode",
5472 abbrev_mode,
5473 doc: /* Default value of `abbrev-mode' for buffers that do not override it.
5474 This is the same as (default-value 'abbrev-mode). */);
5476 DEFVAR_BUFFER_DEFAULTS ("default-ctl-arrow",
5477 ctl_arrow,
5478 doc: /* Default value of `ctl-arrow' for buffers that do not override it.
5479 This is the same as (default-value 'ctl-arrow). */);
5481 DEFVAR_BUFFER_DEFAULTS ("default-enable-multibyte-characters",
5482 enable_multibyte_characters,
5483 doc: /* Default value of `enable-multibyte-characters' for buffers not overriding it.
5484 This is the same as (default-value 'enable-multibyte-characters). */);
5486 DEFVAR_BUFFER_DEFAULTS ("default-buffer-file-coding-system",
5487 buffer_file_coding_system,
5488 doc: /* Default value of `buffer-file-coding-system' for buffers not overriding it.
5489 This is the same as (default-value 'buffer-file-coding-system). */);
5491 DEFVAR_BUFFER_DEFAULTS ("default-truncate-lines",
5492 truncate_lines,
5493 doc: /* Default value of `truncate-lines' for buffers that do not override it.
5494 This is the same as (default-value 'truncate-lines). */);
5496 DEFVAR_BUFFER_DEFAULTS ("default-fill-column",
5497 fill_column,
5498 doc: /* Default value of `fill-column' for buffers that do not override it.
5499 This is the same as (default-value 'fill-column). */);
5501 DEFVAR_BUFFER_DEFAULTS ("default-left-margin",
5502 left_margin,
5503 doc: /* Default value of `left-margin' for buffers that do not override it.
5504 This is the same as (default-value 'left-margin). */);
5506 DEFVAR_BUFFER_DEFAULTS ("default-tab-width",
5507 tab_width,
5508 doc: /* Default value of `tab-width' for buffers that do not override it.
5509 NOTE: This controls the display width of a TAB character, and not
5510 the size of an indentation step.
5511 This is the same as (default-value 'tab-width). */);
5513 DEFVAR_BUFFER_DEFAULTS ("default-case-fold-search",
5514 case_fold_search,
5515 doc: /* Default value of `case-fold-search' for buffers that don't override it.
5516 This is the same as (default-value 'case-fold-search). */);
5518 DEFVAR_BUFFER_DEFAULTS ("default-left-margin-width",
5519 left_margin_cols,
5520 doc: /* Default value of `left-margin-width' for buffers that don't override it.
5521 This is the same as (default-value 'left-margin-width). */);
5523 DEFVAR_BUFFER_DEFAULTS ("default-right-margin-width",
5524 right_margin_cols,
5525 doc: /* Default value of `right-margin-width' for buffers that don't override it.
5526 This is the same as (default-value 'right-margin-width). */);
5528 DEFVAR_BUFFER_DEFAULTS ("default-left-fringe-width",
5529 left_fringe_width,
5530 doc: /* Default value of `left-fringe-width' for buffers that don't override it.
5531 This is the same as (default-value 'left-fringe-width). */);
5533 DEFVAR_BUFFER_DEFAULTS ("default-right-fringe-width",
5534 right_fringe_width,
5535 doc: /* Default value of `right-fringe-width' for buffers that don't override it.
5536 This is the same as (default-value 'right-fringe-width). */);
5538 DEFVAR_BUFFER_DEFAULTS ("default-fringes-outside-margins",
5539 fringes_outside_margins,
5540 doc: /* Default value of `fringes-outside-margins' for buffers that don't override it.
5541 This is the same as (default-value 'fringes-outside-margins). */);
5543 DEFVAR_BUFFER_DEFAULTS ("default-scroll-bar-width",
5544 scroll_bar_width,
5545 doc: /* Default value of `scroll-bar-width' for buffers that don't override it.
5546 This is the same as (default-value 'scroll-bar-width). */);
5548 DEFVAR_BUFFER_DEFAULTS ("default-vertical-scroll-bar",
5549 vertical_scroll_bar_type,
5550 doc: /* Default value of `vertical-scroll-bar' for buffers that don't override it.
5551 This is the same as (default-value 'vertical-scroll-bar). */);
5553 DEFVAR_BUFFER_DEFAULTS ("default-indicate-empty-lines",
5554 indicate_empty_lines,
5555 doc: /* Default value of `indicate-empty-lines' for buffers that don't override it.
5556 This is the same as (default-value 'indicate-empty-lines). */);
5558 DEFVAR_BUFFER_DEFAULTS ("default-indicate-buffer-boundaries",
5559 indicate_buffer_boundaries,
5560 doc: /* Default value of `indicate-buffer-boundaries' for buffers that don't override it.
5561 This is the same as (default-value 'indicate-buffer-boundaries). */);
5563 DEFVAR_BUFFER_DEFAULTS ("default-fringe-indicator-alist",
5564 fringe_indicator_alist,
5565 doc: /* Default value of `fringe-indicator-alist' for buffers that don't override it.
5566 This is the same as (default-value 'fringe-indicator-alist'). */);
5568 DEFVAR_BUFFER_DEFAULTS ("default-fringe-cursor-alist",
5569 fringe_cursor_alist,
5570 doc: /* Default value of `fringe-cursor-alist' for buffers that don't override it.
5571 This is the same as (default-value 'fringe-cursor-alist'). */);
5573 DEFVAR_BUFFER_DEFAULTS ("default-scroll-up-aggressively",
5574 scroll_up_aggressively,
5575 doc: /* Default value of `scroll-up-aggressively'.
5576 This value applies in buffers that don't have their own local values.
5577 This is the same as (default-value 'scroll-up-aggressively). */);
5579 DEFVAR_BUFFER_DEFAULTS ("default-scroll-down-aggressively",
5580 scroll_down_aggressively,
5581 doc: /* Default value of `scroll-down-aggressively'.
5582 This value applies in buffers that don't have their own local values.
5583 This is the same as (default-value 'scroll-down-aggressively). */);
5585 DEFVAR_PER_BUFFER ("header-line-format",
5586 &BVAR (current_buffer, header_line_format),
5587 Qnil,
5588 doc: /* Analogous to `mode-line-format', but controls the header line.
5589 The header line appears, optionally, at the top of a window;
5590 the mode line appears at the bottom. */);
5592 DEFVAR_PER_BUFFER ("mode-line-format", &BVAR (current_buffer, mode_line_format),
5593 Qnil,
5594 doc: /* Template for displaying mode line for current buffer.
5596 The value may be nil, a string, a symbol or a list.
5598 A value of nil means don't display a mode line.
5600 For any symbol other than t or nil, the symbol's value is processed as
5601 a mode line construct. As a special exception, if that value is a
5602 string, the string is processed verbatim, without handling any
5603 %-constructs (see below). Also, unless the symbol has a non-nil
5604 `risky-local-variable' property, all properties in any strings, as
5605 well as all :eval and :propertize forms in the value, are ignored.
5607 A list whose car is a string or list is processed by processing each
5608 of the list elements recursively, as separate mode line constructs,
5609 and concatenating the results.
5611 A list of the form `(:eval FORM)' is processed by evaluating FORM and
5612 using the result as a mode line construct. Be careful--FORM should
5613 not load any files, because that can cause an infinite recursion.
5615 A list of the form `(:propertize ELT PROPS...)' is processed by
5616 processing ELT as the mode line construct, and adding the text
5617 properties PROPS to the result.
5619 A list whose car is a symbol is processed by examining the symbol's
5620 value, and, if that value is non-nil, processing the cadr of the list
5621 recursively; and if that value is nil, processing the caddr of the
5622 list recursively.
5624 A list whose car is an integer is processed by processing the cadr of
5625 the list, and padding (if the number is positive) or truncating (if
5626 negative) to the width specified by that number.
5628 A string is printed verbatim in the mode line except for %-constructs:
5629 %b -- print buffer name. %f -- print visited file name.
5630 %F -- print frame name.
5631 %* -- print %, * or hyphen. %+ -- print *, % or hyphen.
5632 %& is like %*, but ignore read-only-ness.
5633 % means buffer is read-only and * means it is modified.
5634 For a modified read-only buffer, %* gives % and %+ gives *.
5635 %s -- print process status. %l -- print the current line number.
5636 %c -- print the current column number (this makes editing slower).
5637 To make the column number update correctly in all cases,
5638 `column-number-mode' must be non-nil.
5639 %i -- print the size of the buffer.
5640 %I -- like %i, but use k, M, G, etc., to abbreviate.
5641 %p -- print percent of buffer above top of window, or Top, Bot or All.
5642 %P -- print percent of buffer above bottom of window, perhaps plus Top,
5643 or print Bottom or All.
5644 %n -- print Narrow if appropriate.
5645 %t -- visited file is text or binary (if OS supports this distinction).
5646 %z -- print mnemonics of keyboard, terminal, and buffer coding systems.
5647 %Z -- like %z, but including the end-of-line format.
5648 %e -- print error message about full memory.
5649 %@ -- print @ or hyphen. @ means that default-directory is on a
5650 remote machine.
5651 %[ -- print one [ for each recursive editing level. %] similar.
5652 %% -- print %. %- -- print infinitely many dashes.
5653 Decimal digits after the % specify field width to which to pad. */);
5655 DEFVAR_BUFFER_DEFAULTS ("default-major-mode", major_mode,
5656 doc: /* Value of `major-mode' for new buffers. */);
5658 DEFVAR_PER_BUFFER ("major-mode", &BVAR (current_buffer, major_mode),
5659 Qsymbolp,
5660 doc: /* Symbol for current buffer's major mode.
5661 The default value (normally `fundamental-mode') affects new buffers.
5662 A value of nil means to use the current buffer's major mode, provided
5663 it is not marked as "special".
5665 When a mode is used by default, `find-file' switches to it before it
5666 reads the contents into the buffer and before it finishes setting up
5667 the buffer. Thus, the mode and its hooks should not expect certain
5668 variables such as `buffer-read-only' and `buffer-file-coding-system'
5669 to be set up. */);
5671 DEFVAR_PER_BUFFER ("mode-name", &BVAR (current_buffer, mode_name),
5672 Qnil,
5673 doc: /* Pretty name of current buffer's major mode.
5674 Usually a string, but can use any of the constructs for `mode-line-format',
5675 which see.
5676 Format with `format-mode-line' to produce a string value. */);
5678 DEFVAR_PER_BUFFER ("local-abbrev-table", &BVAR (current_buffer, abbrev_table), Qnil,
5679 doc: /* Local (mode-specific) abbrev table of current buffer. */);
5681 DEFVAR_PER_BUFFER ("abbrev-mode", &BVAR (current_buffer, abbrev_mode), Qnil,
5682 doc: /* Non-nil if Abbrev mode is enabled.
5683 Use the command `abbrev-mode' to change this variable. */);
5685 DEFVAR_PER_BUFFER ("case-fold-search", &BVAR (current_buffer, case_fold_search),
5686 Qnil,
5687 doc: /* Non-nil if searches and matches should ignore case. */);
5689 DEFVAR_PER_BUFFER ("fill-column", &BVAR (current_buffer, fill_column),
5690 Qintegerp,
5691 doc: /* Column beyond which automatic line-wrapping should happen.
5692 Interactively, you can set the buffer local value using \\[set-fill-column]. */);
5694 DEFVAR_PER_BUFFER ("left-margin", &BVAR (current_buffer, left_margin),
5695 Qintegerp,
5696 doc: /* Column for the default `indent-line-function' to indent to.
5697 Linefeed indents to this column in Fundamental mode. */);
5699 DEFVAR_PER_BUFFER ("tab-width", &BVAR (current_buffer, tab_width),
5700 Qintegerp,
5701 doc: /* Distance between tab stops (for display of tab characters), in columns.
5702 NOTE: This controls the display width of a TAB character, and not
5703 the size of an indentation step.
5704 This should be an integer greater than zero. */);
5706 DEFVAR_PER_BUFFER ("ctl-arrow", &BVAR (current_buffer, ctl_arrow), Qnil,
5707 doc: /* Non-nil means display control chars with uparrow.
5708 A value of nil means use backslash and octal digits.
5709 This variable does not apply to characters whose display is specified
5710 in the current display table (if there is one). */);
5712 DEFVAR_PER_BUFFER ("enable-multibyte-characters",
5713 &BVAR (current_buffer, enable_multibyte_characters),
5714 Qnil,
5715 doc: /* Non-nil means the buffer contents are regarded as multi-byte characters.
5716 Otherwise they are regarded as unibyte. This affects the display,
5717 file I/O and the behavior of various editing commands.
5719 This variable is buffer-local but you cannot set it directly;
5720 use the function `set-buffer-multibyte' to change a buffer's representation.
5721 See also Info node `(elisp)Text Representations'. */);
5722 XSYMBOL (intern_c_string ("enable-multibyte-characters"))->constant = 1;
5724 DEFVAR_PER_BUFFER ("buffer-file-coding-system",
5725 &BVAR (current_buffer, buffer_file_coding_system), Qnil,
5726 doc: /* Coding system to be used for encoding the buffer contents on saving.
5727 This variable applies to saving the buffer, and also to `write-region'
5728 and other functions that use `write-region'.
5729 It does not apply to sending output to subprocesses, however.
5731 If this is nil, the buffer is saved without any code conversion
5732 unless some coding system is specified in `file-coding-system-alist'
5733 for the buffer file.
5735 If the text to be saved cannot be encoded as specified by this variable,
5736 an alternative encoding is selected by `select-safe-coding-system', which see.
5738 The variable `coding-system-for-write', if non-nil, overrides this variable.
5740 This variable is never applied to a way of decoding a file while reading it. */);
5742 DEFVAR_PER_BUFFER ("bidi-display-reordering",
5743 &BVAR (current_buffer, bidi_display_reordering), Qnil,
5744 doc: /* Non-nil means reorder bidirectional text for display in the visual order. */);
5746 DEFVAR_PER_BUFFER ("bidi-paragraph-direction",
5747 &BVAR (current_buffer, bidi_paragraph_direction), Qnil,
5748 doc: /* If non-nil, forces directionality of text paragraphs in the buffer.
5750 If this is nil (the default), the direction of each paragraph is
5751 determined by the first strong directional character of its text.
5752 The values of `right-to-left' and `left-to-right' override that.
5753 Any other value is treated as nil.
5755 This variable has no effect unless the buffer's value of
5756 \`bidi-display-reordering' is non-nil. */);
5758 DEFVAR_PER_BUFFER ("truncate-lines", &BVAR (current_buffer, truncate_lines), Qnil,
5759 doc: /* Non-nil means do not display continuation lines.
5760 Instead, give each line of text just one screen line.
5762 Note that this is overridden by the variable
5763 `truncate-partial-width-windows' if that variable is non-nil
5764 and this buffer is not full-frame width.
5766 Minibuffers set this variable to nil. */);
5768 DEFVAR_PER_BUFFER ("word-wrap", &BVAR (current_buffer, word_wrap), Qnil,
5769 doc: /* Non-nil means to use word-wrapping for continuation lines.
5770 When word-wrapping is on, continuation lines are wrapped at the space
5771 or tab character nearest to the right window edge.
5772 If nil, continuation lines are wrapped at the right screen edge.
5774 This variable has no effect if long lines are truncated (see
5775 `truncate-lines' and `truncate-partial-width-windows'). If you use
5776 word-wrapping, you might want to reduce the value of
5777 `truncate-partial-width-windows', since wrapping can make text readable
5778 in narrower windows.
5780 Instead of setting this variable directly, most users should use
5781 Visual Line mode . Visual Line mode, when enabled, sets `word-wrap'
5782 to t, and additionally redefines simple editing commands to act on
5783 visual lines rather than logical lines. See the documentation of
5784 `visual-line-mode'. */);
5786 DEFVAR_PER_BUFFER ("default-directory", &BVAR (current_buffer, directory),
5787 Qstringp,
5788 doc: /* Name of default directory of current buffer. Should end with slash.
5789 To interactively change the default directory, use command `cd'. */);
5791 DEFVAR_PER_BUFFER ("auto-fill-function", &BVAR (current_buffer, auto_fill_function),
5792 Qnil,
5793 doc: /* Function called (if non-nil) to perform auto-fill.
5794 It is called after self-inserting any character specified in
5795 the `auto-fill-chars' table.
5796 NOTE: This variable is not a hook;
5797 its value may not be a list of functions. */);
5799 DEFVAR_PER_BUFFER ("buffer-file-name", &BVAR (current_buffer, filename),
5800 Qstringp,
5801 doc: /* Name of file visited in current buffer, or nil if not visiting a file. */);
5803 DEFVAR_PER_BUFFER ("buffer-file-truename", &BVAR (current_buffer, file_truename),
5804 Qstringp,
5805 doc: /* Abbreviated truename of file visited in current buffer, or nil if none.
5806 The truename of a file is calculated by `file-truename'
5807 and then abbreviated with `abbreviate-file-name'. */);
5809 DEFVAR_PER_BUFFER ("buffer-auto-save-file-name",
5810 &BVAR (current_buffer, auto_save_file_name),
5811 Qstringp,
5812 doc: /* Name of file for auto-saving current buffer.
5813 If it is nil, that means don't auto-save this buffer. */);
5815 DEFVAR_PER_BUFFER ("buffer-read-only", &BVAR (current_buffer, read_only), Qnil,
5816 doc: /* Non-nil if this buffer is read-only. */);
5818 DEFVAR_PER_BUFFER ("buffer-backed-up", &BVAR (current_buffer, backed_up), Qnil,
5819 doc: /* Non-nil if this buffer's file has been backed up.
5820 Backing up is done before the first time the file is saved. */);
5822 DEFVAR_PER_BUFFER ("buffer-saved-size", &BVAR (current_buffer, save_length),
5823 Qintegerp,
5824 doc: /* Length of current buffer when last read in, saved or auto-saved.
5825 0 initially.
5826 -1 means auto-saving turned off until next real save.
5828 If you set this to -2, that means don't turn off auto-saving in this buffer
5829 if its text size shrinks. If you use `buffer-swap-text' on a buffer,
5830 you probably should set this to -2 in that buffer. */);
5832 DEFVAR_PER_BUFFER ("selective-display", &BVAR (current_buffer, selective_display),
5833 Qnil,
5834 doc: /* Non-nil enables selective display.
5835 An integer N as value means display only lines
5836 that start with less than N columns of space.
5837 A value of t means that the character ^M makes itself and
5838 all the rest of the line invisible; also, when saving the buffer
5839 in a file, save the ^M as a newline. */);
5841 DEFVAR_PER_BUFFER ("selective-display-ellipses",
5842 &BVAR (current_buffer, selective_display_ellipses),
5843 Qnil,
5844 doc: /* Non-nil means display ... on previous line when a line is invisible. */);
5846 DEFVAR_PER_BUFFER ("overwrite-mode", &BVAR (current_buffer, overwrite_mode), Qnil,
5847 doc: /* Non-nil if self-insertion should replace existing text.
5848 The value should be one of `overwrite-mode-textual',
5849 `overwrite-mode-binary', or nil.
5850 If it is `overwrite-mode-textual', self-insertion still
5851 inserts at the end of a line, and inserts when point is before a tab,
5852 until the tab is filled in.
5853 If `overwrite-mode-binary', self-insertion replaces newlines and tabs too. */);
5855 DEFVAR_PER_BUFFER ("buffer-display-table", &BVAR (current_buffer, display_table),
5856 Qnil,
5857 doc: /* Display table that controls display of the contents of current buffer.
5859 If this variable is nil, the value of `standard-display-table' is used.
5860 Each window can have its own, overriding display table, see
5861 `set-window-display-table' and `window-display-table'.
5863 The display table is a char-table created with `make-display-table'.
5864 A char-table is an array indexed by character codes. Normal array
5865 primitives `aref' and `aset' can be used to access elements of a char-table.
5867 Each of the char-table elements control how to display the corresponding
5868 text character: the element at index C in the table says how to display
5869 the character whose code is C. Each element should be a vector of
5870 characters or nil. The value nil means display the character in the
5871 default fashion; otherwise, the characters from the vector are delivered
5872 to the screen instead of the original character.
5874 For example, (aset buffer-display-table ?X [?Y]) tells Emacs
5875 to display a capital Y instead of each X character.
5877 In addition, a char-table has six extra slots to control the display of:
5879 the end of a truncated screen line (extra-slot 0, a single character);
5880 the end of a continued line (extra-slot 1, a single character);
5881 the escape character used to display character codes in octal
5882 (extra-slot 2, a single character);
5883 the character used as an arrow for control characters (extra-slot 3,
5884 a single character);
5885 the decoration indicating the presence of invisible lines (extra-slot 4,
5886 a vector of characters);
5887 the character used to draw the border between side-by-side windows
5888 (extra-slot 5, a single character).
5890 See also the functions `display-table-slot' and `set-display-table-slot'. */);
5892 DEFVAR_PER_BUFFER ("left-margin-width", &BVAR (current_buffer, left_margin_cols),
5893 Qintegerp,
5894 doc: /* Width of left marginal area for display of a buffer.
5895 A value of nil means no marginal area.
5897 Setting this variable does not take effect until a new buffer is displayed
5898 in a window. To make the change take effect, call `set-window-buffer'. */);
5900 DEFVAR_PER_BUFFER ("right-margin-width", &BVAR (current_buffer, right_margin_cols),
5901 Qintegerp,
5902 doc: /* Width of right marginal area for display of a buffer.
5903 A value of nil means no marginal area.
5905 Setting this variable does not take effect until a new buffer is displayed
5906 in a window. To make the change take effect, call `set-window-buffer'. */);
5908 DEFVAR_PER_BUFFER ("left-fringe-width", &BVAR (current_buffer, left_fringe_width),
5909 Qintegerp,
5910 doc: /* Width of this buffer's left fringe (in pixels).
5911 A value of 0 means no left fringe is shown in this buffer's window.
5912 A value of nil means to use the left fringe width from the window's frame.
5914 Setting this variable does not take effect until a new buffer is displayed
5915 in a window. To make the change take effect, call `set-window-buffer'. */);
5917 DEFVAR_PER_BUFFER ("right-fringe-width", &BVAR (current_buffer, right_fringe_width),
5918 Qintegerp,
5919 doc: /* Width of this buffer's right fringe (in pixels).
5920 A value of 0 means no right fringe is shown in this buffer's window.
5921 A value of nil means to use the right fringe width from the window's frame.
5923 Setting this variable does not take effect until a new buffer is displayed
5924 in a window. To make the change take effect, call `set-window-buffer'. */);
5926 DEFVAR_PER_BUFFER ("fringes-outside-margins", &BVAR (current_buffer, fringes_outside_margins),
5927 Qnil,
5928 doc: /* Non-nil means to display fringes outside display margins.
5929 A value of nil means to display fringes between margins and buffer text.
5931 Setting this variable does not take effect until a new buffer is displayed
5932 in a window. To make the change take effect, call `set-window-buffer'. */);
5934 DEFVAR_PER_BUFFER ("scroll-bar-width", &BVAR (current_buffer, scroll_bar_width),
5935 Qintegerp,
5936 doc: /* Width of this buffer's scroll bars in pixels.
5937 A value of nil means to use the scroll bar width from the window's frame. */);
5939 DEFVAR_PER_BUFFER ("vertical-scroll-bar", &BVAR (current_buffer, vertical_scroll_bar_type),
5940 Qnil,
5941 doc: /* Position of this buffer's vertical scroll bar.
5942 The value takes effect whenever you tell a window to display this buffer;
5943 for instance, with `set-window-buffer' or when `display-buffer' displays it.
5945 A value of `left' or `right' means put the vertical scroll bar at that side
5946 of the window; a value of nil means don't show any vertical scroll bars.
5947 A value of t (the default) means do whatever the window's frame specifies. */);
5949 DEFVAR_PER_BUFFER ("indicate-empty-lines",
5950 &BVAR (current_buffer, indicate_empty_lines), Qnil,
5951 doc: /* Visually indicate empty lines after the buffer end.
5952 If non-nil, a bitmap is displayed in the left fringe of a window on
5953 window-systems. */);
5955 DEFVAR_PER_BUFFER ("indicate-buffer-boundaries",
5956 &BVAR (current_buffer, indicate_buffer_boundaries), Qnil,
5957 doc: /* Visually indicate buffer boundaries and scrolling.
5958 If non-nil, the first and last line of the buffer are marked in the fringe
5959 of a window on window-systems with angle bitmaps, or if the window can be
5960 scrolled, the top and bottom line of the window are marked with up and down
5961 arrow bitmaps.
5963 If value is a symbol `left' or `right', both angle and arrow bitmaps
5964 are displayed in the left or right fringe, resp. Any other value
5965 that doesn't look like an alist means display the angle bitmaps in
5966 the left fringe but no arrows.
5968 You can exercise more precise control by using an alist as the
5969 value. Each alist element (INDICATOR . POSITION) specifies
5970 where to show one of the indicators. INDICATOR is one of `top',
5971 `bottom', `up', `down', or t, which specifies the default position,
5972 and POSITION is one of `left', `right', or nil, meaning do not show
5973 this indicator.
5975 For example, ((top . left) (t . right)) places the top angle bitmap in
5976 left fringe, the bottom angle bitmap in right fringe, and both arrow
5977 bitmaps in right fringe. To show just the angle bitmaps in the left
5978 fringe, but no arrow bitmaps, use ((top . left) (bottom . left)). */);
5980 DEFVAR_PER_BUFFER ("fringe-indicator-alist",
5981 &BVAR (current_buffer, fringe_indicator_alist), Qnil,
5982 doc: /* Mapping from logical to physical fringe indicator bitmaps.
5983 The value is an alist where each element (INDICATOR . BITMAPS)
5984 specifies the fringe bitmaps used to display a specific logical
5985 fringe indicator.
5987 INDICATOR specifies the logical indicator type which is one of the
5988 following symbols: `truncation' , `continuation', `overlay-arrow',
5989 `top', `bottom', `top-bottom', `up', `down', empty-line', or `unknown'.
5991 BITMAPS is a list of symbols (LEFT RIGHT [LEFT1 RIGHT1]) which specifies
5992 the actual bitmap shown in the left or right fringe for the logical
5993 indicator. LEFT and RIGHT are the bitmaps shown in the left and/or
5994 right fringe for the specific indicator. The LEFT1 or RIGHT1 bitmaps
5995 are used only for the `bottom' and `top-bottom' indicators when the
5996 last (only) line has no final newline. BITMAPS may also be a single
5997 symbol which is used in both left and right fringes. */);
5999 DEFVAR_PER_BUFFER ("fringe-cursor-alist",
6000 &BVAR (current_buffer, fringe_cursor_alist), Qnil,
6001 doc: /* Mapping from logical to physical fringe cursor bitmaps.
6002 The value is an alist where each element (CURSOR . BITMAP)
6003 specifies the fringe bitmaps used to display a specific logical
6004 cursor type in the fringe.
6006 CURSOR specifies the logical cursor type which is one of the following
6007 symbols: `box' , `hollow', `bar', `hbar', or `hollow-small'. The last
6008 one is used to show a hollow cursor on narrow lines display lines
6009 where the normal hollow cursor will not fit.
6011 BITMAP is the corresponding fringe bitmap shown for the logical
6012 cursor type. */);
6014 DEFVAR_PER_BUFFER ("scroll-up-aggressively",
6015 &BVAR (current_buffer, scroll_up_aggressively), Qfloatp,
6016 doc: /* How far to scroll windows upward.
6017 If you move point off the bottom, the window scrolls automatically.
6018 This variable controls how far it scrolls. The value nil, the default,
6019 means scroll to center point. A fraction means scroll to put point
6020 that fraction of the window's height from the bottom of the window.
6021 When the value is 0.0, point goes at the bottom line, which in the
6022 simple case that you moved off with C-f means scrolling just one line.
6023 1.0 means point goes at the top, so that in that simple case, the
6024 window scrolls by a full window height. Meaningful values are
6025 between 0.0 and 1.0, inclusive. */);
6027 DEFVAR_PER_BUFFER ("scroll-down-aggressively",
6028 &BVAR (current_buffer, scroll_down_aggressively), Qfloatp,
6029 doc: /* How far to scroll windows downward.
6030 If you move point off the top, the window scrolls automatically.
6031 This variable controls how far it scrolls. The value nil, the default,
6032 means scroll to center point. A fraction means scroll to put point
6033 that fraction of the window's height from the top of the window.
6034 When the value is 0.0, point goes at the top line, which in the
6035 simple case that you moved off with C-b means scrolling just one line.
6036 1.0 means point goes at the bottom, so that in that simple case, the
6037 window scrolls by a full window height. Meaningful values are
6038 between 0.0 and 1.0, inclusive. */);
6040 DEFVAR_LISP ("before-change-functions", Vbefore_change_functions,
6041 doc: /* List of functions to call before each text change.
6042 Two arguments are passed to each function: the positions of
6043 the beginning and end of the range of old text to be changed.
6044 \(For an insertion, the beginning and end are at the same place.)
6045 No information is given about the length of the text after the change.
6047 Buffer changes made while executing the `before-change-functions'
6048 don't call any before-change or after-change functions.
6049 That's because `inhibit-modification-hooks' is temporarily set non-nil.
6051 If an unhandled error happens in running these functions,
6052 the variable's value remains nil. That prevents the error
6053 from happening repeatedly and making Emacs nonfunctional. */);
6054 Vbefore_change_functions = Qnil;
6056 DEFVAR_LISP ("after-change-functions", Vafter_change_functions,
6057 doc: /* List of functions to call after each text change.
6058 Three arguments are passed to each function: the positions of
6059 the beginning and end of the range of changed text,
6060 and the length in bytes of the pre-change text replaced by that range.
6061 \(For an insertion, the pre-change length is zero;
6062 for a deletion, that length is the number of bytes deleted,
6063 and the post-change beginning and end are at the same place.)
6065 Buffer changes made while executing the `after-change-functions'
6066 don't call any before-change or after-change functions.
6067 That's because `inhibit-modification-hooks' is temporarily set non-nil.
6069 If an unhandled error happens in running these functions,
6070 the variable's value remains nil. That prevents the error
6071 from happening repeatedly and making Emacs nonfunctional. */);
6072 Vafter_change_functions = Qnil;
6074 DEFVAR_LISP ("first-change-hook", Vfirst_change_hook,
6075 doc: /* A list of functions to call before changing a buffer which is unmodified.
6076 The functions are run using the `run-hooks' function. */);
6077 Vfirst_change_hook = Qnil;
6079 DEFVAR_PER_BUFFER ("buffer-undo-list", &BVAR (current_buffer, undo_list), Qnil,
6080 doc: /* List of undo entries in current buffer.
6081 Recent changes come first; older changes follow newer.
6083 An entry (BEG . END) represents an insertion which begins at
6084 position BEG and ends at position END.
6086 An entry (TEXT . POSITION) represents the deletion of the string TEXT
6087 from (abs POSITION). If POSITION is positive, point was at the front
6088 of the text being deleted; if negative, point was at the end.
6090 An entry (t HIGH LOW USEC PSEC) indicates that the buffer was previously
6091 unmodified; (HIGH LOW USEC PSEC) is in the same style as (current-time)
6092 and is the visited file's modification time, as of that time. If the
6093 modification time of the most recent save is different, this entry is
6094 obsolete.
6096 An entry (t . 0) means means the buffer was previously unmodified but
6097 its time stamp was unknown because it was not associated with a file.
6098 An entry (t . -1) is similar, except that it means the buffer's visited
6099 file did not exist.
6101 An entry (nil PROPERTY VALUE BEG . END) indicates that a text property
6102 was modified between BEG and END. PROPERTY is the property name,
6103 and VALUE is the old value.
6105 An entry (apply FUN-NAME . ARGS) means undo the change with
6106 \(apply FUN-NAME ARGS).
6108 An entry (apply DELTA BEG END FUN-NAME . ARGS) supports selective undo
6109 in the active region. BEG and END is the range affected by this entry
6110 and DELTA is the number of characters added or deleted in that range by
6111 this change.
6113 An entry (MARKER . DISTANCE) indicates that the marker MARKER
6114 was adjusted in position by the offset DISTANCE (an integer).
6116 An entry of the form POSITION indicates that point was at the buffer
6117 location given by the integer. Undoing an entry of this form places
6118 point at POSITION.
6120 Entries with value `nil' mark undo boundaries. The undo command treats
6121 the changes between two undo boundaries as a single step to be undone.
6123 If the value of the variable is t, undo information is not recorded. */);
6125 DEFVAR_PER_BUFFER ("mark-active", &BVAR (current_buffer, mark_active), Qnil,
6126 doc: /* Non-nil means the mark and region are currently active in this buffer. */);
6128 DEFVAR_PER_BUFFER ("cache-long-scans", &BVAR (current_buffer, cache_long_scans), Qnil,
6129 doc: /* Non-nil means that Emacs should use caches in attempt to speedup buffer scans.
6131 Normally, the line-motion functions work by scanning the buffer for
6132 newlines. Columnar operations (like `move-to-column' and
6133 `compute-motion') also work by scanning the buffer, summing character
6134 widths as they go. This works well for ordinary text, but if the
6135 buffer's lines are very long (say, more than 500 characters), these
6136 motion functions will take longer to execute. Emacs may also take
6137 longer to update the display.
6139 If `cache-long-scans' is non-nil, these motion functions cache the
6140 results of their scans, and consult the cache to avoid rescanning
6141 regions of the buffer until the text is modified. The caches are most
6142 beneficial when they prevent the most searching---that is, when the
6143 buffer contains long lines and large regions of characters with the
6144 same, fixed screen width.
6146 When `cache-long-scans' is non-nil, processing short lines will
6147 become slightly slower (because of the overhead of consulting the
6148 cache), and the caches will use memory roughly proportional to the
6149 number of newlines and characters whose screen width varies.
6151 Bidirectional editing also requires buffer scans to find paragraph
6152 separators. If you have large paragraphs or no paragraph separators
6153 at all, these scans may be slow. If `cache-long-scans' is non-nil,
6154 results of these scans are cached. This doesn't help too much if
6155 paragraphs are of the reasonable (few thousands of characters) size.
6157 The caches require no explicit maintenance; their accuracy is
6158 maintained internally by the Emacs primitives. Enabling or disabling
6159 the cache should not affect the behavior of any of the motion
6160 functions; it should only affect their performance. */);
6162 DEFVAR_PER_BUFFER ("point-before-scroll", &BVAR (current_buffer, point_before_scroll), Qnil,
6163 doc: /* Value of point before the last series of scroll operations, or nil. */);
6165 DEFVAR_PER_BUFFER ("buffer-file-format", &BVAR (current_buffer, file_format), Qnil,
6166 doc: /* List of formats to use when saving this buffer.
6167 Formats are defined by `format-alist'. This variable is
6168 set when a file is visited. */);
6170 DEFVAR_PER_BUFFER ("buffer-auto-save-file-format",
6171 &BVAR (current_buffer, auto_save_file_format), Qnil,
6172 doc: /* Format in which to write auto-save files.
6173 Should be a list of symbols naming formats that are defined in `format-alist'.
6174 If it is t, which is the default, auto-save files are written in the
6175 same format as a regular save would use. */);
6177 DEFVAR_PER_BUFFER ("buffer-invisibility-spec",
6178 &BVAR (current_buffer, invisibility_spec), Qnil,
6179 doc: /* Invisibility spec of this buffer.
6180 The default is t, which means that text is invisible
6181 if it has a non-nil `invisible' property.
6182 If the value is a list, a text character is invisible if its `invisible'
6183 property is an element in that list (or is a list with members in common).
6184 If an element is a cons cell of the form (PROP . ELLIPSIS),
6185 then characters with property value PROP are invisible,
6186 and they have an ellipsis as well if ELLIPSIS is non-nil. */);
6188 DEFVAR_PER_BUFFER ("buffer-display-count",
6189 &BVAR (current_buffer, display_count), Qintegerp,
6190 doc: /* A number incremented each time this buffer is displayed in a window.
6191 The function `set-window-buffer' increments it. */);
6193 DEFVAR_PER_BUFFER ("buffer-display-time",
6194 &BVAR (current_buffer, display_time), Qnil,
6195 doc: /* Time stamp updated each time this buffer is displayed in a window.
6196 The function `set-window-buffer' updates this variable
6197 to the value obtained by calling `current-time'.
6198 If the buffer has never been shown in a window, the value is nil. */);
6200 DEFVAR_LISP ("transient-mark-mode", Vtransient_mark_mode,
6201 doc: /* Non-nil if Transient Mark mode is enabled.
6202 See the command `transient-mark-mode' for a description of this minor mode.
6204 Non-nil also enables highlighting of the region whenever the mark is active.
6205 The variable `highlight-nonselected-windows' controls whether to highlight
6206 all windows or just the selected window.
6208 Lisp programs may give this variable certain special values:
6210 - A value of `lambda' enables Transient Mark mode temporarily.
6211 It is disabled again after any subsequent action that would
6212 normally deactivate the mark (e.g. buffer modification).
6214 - A value of (only . OLDVAL) enables Transient Mark mode
6215 temporarily. After any subsequent point motion command that is
6216 not shift-translated, or any other action that would normally
6217 deactivate the mark (e.g. buffer modification), the value of
6218 `transient-mark-mode' is set to OLDVAL. */);
6219 Vtransient_mark_mode = Qnil;
6221 DEFVAR_LISP ("inhibit-read-only", Vinhibit_read_only,
6222 doc: /* Non-nil means disregard read-only status of buffers or characters.
6223 If the value is t, disregard `buffer-read-only' and all `read-only'
6224 text properties. If the value is a list, disregard `buffer-read-only'
6225 and disregard a `read-only' text property if the property value
6226 is a member of the list. */);
6227 Vinhibit_read_only = Qnil;
6229 DEFVAR_PER_BUFFER ("cursor-type", &BVAR (current_buffer, cursor_type), Qnil,
6230 doc: /* Cursor to use when this buffer is in the selected window.
6231 Values are interpreted as follows:
6233 t use the cursor specified for the frame
6234 nil don't display a cursor
6235 box display a filled box cursor
6236 hollow display a hollow box cursor
6237 bar display a vertical bar cursor with default width
6238 (bar . WIDTH) display a vertical bar cursor with width WIDTH
6239 hbar display a horizontal bar cursor with default height
6240 (hbar . HEIGHT) display a horizontal bar cursor with height HEIGHT
6241 ANYTHING ELSE display a hollow box cursor
6243 When the buffer is displayed in a non-selected window, the
6244 cursor's appearance is instead controlled by the variable
6245 `cursor-in-non-selected-windows'. */);
6247 DEFVAR_PER_BUFFER ("line-spacing",
6248 &BVAR (current_buffer, extra_line_spacing), Qnumberp,
6249 doc: /* Additional space to put between lines when displaying a buffer.
6250 The space is measured in pixels, and put below lines on graphic displays,
6251 see `display-graphic-p'.
6252 If value is a floating point number, it specifies the spacing relative
6253 to the default frame line height. A value of nil means add no extra space. */);
6255 DEFVAR_PER_BUFFER ("cursor-in-non-selected-windows",
6256 &BVAR (current_buffer, cursor_in_non_selected_windows), Qnil,
6257 doc: /* Non-nil means show a cursor in non-selected windows.
6258 If nil, only shows a cursor in the selected window.
6259 If t, displays a cursor related to the usual cursor type
6260 \(a solid box becomes hollow, a bar becomes a narrower bar).
6261 You can also specify the cursor type as in the `cursor-type' variable.
6262 Use Custom to set this variable and update the display." */);
6264 DEFVAR_LISP ("kill-buffer-query-functions", Vkill_buffer_query_functions,
6265 doc: /* List of functions called with no args to query before killing a buffer.
6266 The buffer being killed will be current while the functions are running.
6268 If any of them returns nil, the buffer is not killed. Functions run by
6269 this hook are supposed to not change the current buffer. */);
6270 Vkill_buffer_query_functions = Qnil;
6272 DEFVAR_LISP ("change-major-mode-hook", Vchange_major_mode_hook,
6273 doc: /* Normal hook run before changing the major mode of a buffer.
6274 The function `kill-all-local-variables' runs this before doing anything else. */);
6275 Vchange_major_mode_hook = Qnil;
6276 DEFSYM (Qchange_major_mode_hook, "change-major-mode-hook");
6278 DEFVAR_LISP ("buffer-list-update-hook", Vbuffer_list_update_hook,
6279 doc: /* Hook run when the buffer list changes.
6280 Functions running this hook are `get-buffer-create',
6281 `make-indirect-buffer', `rename-buffer', `kill-buffer',
6282 and `bury-buffer-internal'. */);
6283 Vbuffer_list_update_hook = Qnil;
6284 DEFSYM (Qbuffer_list_update_hook, "buffer-list-update-hook");
6286 defsubr (&Sbuffer_live_p);
6287 defsubr (&Sbuffer_list);
6288 defsubr (&Sget_buffer);
6289 defsubr (&Sget_file_buffer);
6290 defsubr (&Sget_buffer_create);
6291 defsubr (&Smake_indirect_buffer);
6292 defsubr (&Sgenerate_new_buffer_name);
6293 defsubr (&Sbuffer_name);
6294 defsubr (&Sbuffer_file_name);
6295 defsubr (&Sbuffer_base_buffer);
6296 defsubr (&Sbuffer_local_value);
6297 defsubr (&Sbuffer_local_variables);
6298 defsubr (&Sbuffer_modified_p);
6299 defsubr (&Sset_buffer_modified_p);
6300 defsubr (&Sbuffer_modified_tick);
6301 defsubr (&Sbuffer_chars_modified_tick);
6302 defsubr (&Srename_buffer);
6303 defsubr (&Sother_buffer);
6304 defsubr (&Sbuffer_enable_undo);
6305 defsubr (&Skill_buffer);
6306 defsubr (&Sbury_buffer_internal);
6307 defsubr (&Sset_buffer_major_mode);
6308 defsubr (&Scurrent_buffer);
6309 defsubr (&Sset_buffer);
6310 defsubr (&Sbarf_if_buffer_read_only);
6311 defsubr (&Serase_buffer);
6312 defsubr (&Sbuffer_swap_text);
6313 defsubr (&Sset_buffer_multibyte);
6314 defsubr (&Skill_all_local_variables);
6316 defsubr (&Soverlayp);
6317 defsubr (&Smake_overlay);
6318 defsubr (&Sdelete_overlay);
6319 defsubr (&Sdelete_all_overlays);
6320 defsubr (&Smove_overlay);
6321 defsubr (&Soverlay_start);
6322 defsubr (&Soverlay_end);
6323 defsubr (&Soverlay_buffer);
6324 defsubr (&Soverlay_properties);
6325 defsubr (&Soverlays_at);
6326 defsubr (&Soverlays_in);
6327 defsubr (&Snext_overlay_change);
6328 defsubr (&Sprevious_overlay_change);
6329 defsubr (&Soverlay_recenter);
6330 defsubr (&Soverlay_lists);
6331 defsubr (&Soverlay_get);
6332 defsubr (&Soverlay_put);
6333 defsubr (&Srestore_buffer_modified_p);
6336 void
6337 keys_of_buffer (void)
6339 initial_define_key (control_x_map, 'b', "switch-to-buffer");
6340 initial_define_key (control_x_map, 'k', "kill-buffer");
6342 /* This must not be in syms_of_buffer, because Qdisabled is not
6343 initialized when that function gets called. */
6344 Fput (intern_c_string ("erase-buffer"), Qdisabled, Qt);