Avoid error in TLS connections due to incorrect format
[emacs.git] / src / buffer.c
blobe151e9451d1561d434cda64576c8faaf6a1f8e9c
1 /* Buffer manipulation primitives for GNU Emacs.
3 Copyright (C) 1985-1989, 1993-1995, 1997-2015 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 #include <sys/types.h>
24 #include <sys/stat.h>
25 #include <sys/param.h>
26 #include <errno.h>
27 #include <stdio.h>
28 #include <unistd.h>
30 #include <verify.h>
32 #include "lisp.h"
33 #include "intervals.h"
34 #include "window.h"
35 #include "commands.h"
36 #include "character.h"
37 #include "buffer.h"
38 #include "region-cache.h"
39 #include "indent.h"
40 #include "blockinput.h"
41 #include "keyboard.h"
42 #include "keymap.h"
43 #include "frame.h"
45 #ifdef WINDOWSNT
46 #include "w32heap.h" /* for mmap_* */
47 #endif
49 struct buffer *current_buffer; /* The current buffer. */
51 /* First buffer in chain of all buffers (in reverse order of creation).
52 Threaded through ->header.next.buffer. */
54 struct buffer *all_buffers;
56 /* This structure holds the default values of the buffer-local variables
57 defined with DEFVAR_PER_BUFFER, that have special slots in each buffer.
58 The default value occupies the same slot in this structure
59 as an individual buffer's value occupies in that buffer.
60 Setting the default value also goes through the alist of buffers
61 and stores into each buffer that does not say it has a local value. */
63 struct buffer alignas (GCALIGNMENT) buffer_defaults;
65 /* This structure marks which slots in a buffer have corresponding
66 default values in buffer_defaults.
67 Each such slot has a nonzero value in this structure.
68 The value has only one nonzero bit.
70 When a buffer has its own local value for a slot,
71 the entry for that slot (found in the same slot in this structure)
72 is turned on in the buffer's local_flags array.
74 If a slot in this structure is -1, then even though there may
75 be a DEFVAR_PER_BUFFER for the slot, there is no default value for it;
76 and the corresponding slot in buffer_defaults is not used.
78 If a slot in this structure corresponding to a DEFVAR_PER_BUFFER is
79 zero, that is a bug. */
81 struct buffer buffer_local_flags;
83 /* This structure holds the names of symbols whose values may be
84 buffer-local. It is indexed and accessed in the same way as the above. */
86 struct buffer alignas (GCALIGNMENT) buffer_local_symbols;
88 /* Return the symbol of the per-buffer variable at offset OFFSET in
89 the buffer structure. */
91 #define PER_BUFFER_SYMBOL(OFFSET) \
92 (*(Lisp_Object *)((OFFSET) + (char *) &buffer_local_symbols))
94 /* Maximum length of an overlay vector. */
95 #define OVERLAY_COUNT_MAX \
96 ((ptrdiff_t) min (MOST_POSITIVE_FIXNUM, \
97 min (PTRDIFF_MAX, SIZE_MAX) / word_size))
99 /* Flags indicating which built-in buffer-local variables
100 are permanent locals. */
101 static char buffer_permanent_local_flags[MAX_PER_BUFFER_VARS];
103 /* Number of per-buffer variables used. */
105 int last_per_buffer_idx;
107 static void call_overlay_mod_hooks (Lisp_Object list, Lisp_Object overlay,
108 bool after, Lisp_Object arg1,
109 Lisp_Object arg2, Lisp_Object arg3);
110 static void swap_out_buffer_local_variables (struct buffer *b);
111 static void reset_buffer_local_variables (struct buffer *, bool);
113 /* Alist of all buffer names vs the buffers. This used to be
114 a Lisp-visible variable, but is no longer, to prevent lossage
115 due to user rplac'ing this alist or its elements. */
116 Lisp_Object Vbuffer_alist;
118 static Lisp_Object QSFundamental; /* A string "Fundamental". */
120 static void alloc_buffer_text (struct buffer *, ptrdiff_t);
121 static void free_buffer_text (struct buffer *b);
122 static struct Lisp_Overlay * copy_overlays (struct buffer *, struct Lisp_Overlay *);
123 static void modify_overlay (struct buffer *, ptrdiff_t, ptrdiff_t);
124 static Lisp_Object buffer_lisp_local_variables (struct buffer *, bool);
126 static void
127 CHECK_OVERLAY (Lisp_Object x)
129 CHECK_TYPE (OVERLAYP (x), Qoverlayp, x);
132 /* These setters are used only in this file, so they can be private.
133 The public setters are inline functions defined in buffer.h. */
134 static void
135 bset_abbrev_mode (struct buffer *b, Lisp_Object val)
137 b->abbrev_mode_ = val;
139 static void
140 bset_abbrev_table (struct buffer *b, Lisp_Object val)
142 b->abbrev_table_ = val;
144 static void
145 bset_auto_fill_function (struct buffer *b, Lisp_Object val)
147 b->auto_fill_function_ = val;
149 static void
150 bset_auto_save_file_format (struct buffer *b, Lisp_Object val)
152 b->auto_save_file_format_ = val;
154 static void
155 bset_auto_save_file_name (struct buffer *b, Lisp_Object val)
157 b->auto_save_file_name_ = val;
159 static void
160 bset_backed_up (struct buffer *b, Lisp_Object val)
162 b->backed_up_ = val;
164 static void
165 bset_begv_marker (struct buffer *b, Lisp_Object val)
167 b->begv_marker_ = val;
169 static void
170 bset_bidi_display_reordering (struct buffer *b, Lisp_Object val)
172 b->bidi_display_reordering_ = val;
174 static void
175 bset_buffer_file_coding_system (struct buffer *b, Lisp_Object val)
177 b->buffer_file_coding_system_ = val;
179 static void
180 bset_case_fold_search (struct buffer *b, Lisp_Object val)
182 b->case_fold_search_ = val;
184 static void
185 bset_ctl_arrow (struct buffer *b, Lisp_Object val)
187 b->ctl_arrow_ = val;
189 static void
190 bset_cursor_in_non_selected_windows (struct buffer *b, Lisp_Object val)
192 b->cursor_in_non_selected_windows_ = val;
194 static void
195 bset_cursor_type (struct buffer *b, Lisp_Object val)
197 b->cursor_type_ = val;
199 static void
200 bset_display_table (struct buffer *b, Lisp_Object val)
202 b->display_table_ = val;
204 static void
205 bset_extra_line_spacing (struct buffer *b, Lisp_Object val)
207 b->extra_line_spacing_ = val;
209 static void
210 bset_file_format (struct buffer *b, Lisp_Object val)
212 b->file_format_ = val;
214 static void
215 bset_file_truename (struct buffer *b, Lisp_Object val)
217 b->file_truename_ = val;
219 static void
220 bset_fringe_cursor_alist (struct buffer *b, Lisp_Object val)
222 b->fringe_cursor_alist_ = val;
224 static void
225 bset_fringe_indicator_alist (struct buffer *b, Lisp_Object val)
227 b->fringe_indicator_alist_ = val;
229 static void
230 bset_fringes_outside_margins (struct buffer *b, Lisp_Object val)
232 b->fringes_outside_margins_ = val;
234 static void
235 bset_header_line_format (struct buffer *b, Lisp_Object val)
237 b->header_line_format_ = val;
239 static void
240 bset_indicate_buffer_boundaries (struct buffer *b, Lisp_Object val)
242 b->indicate_buffer_boundaries_ = val;
244 static void
245 bset_indicate_empty_lines (struct buffer *b, Lisp_Object val)
247 b->indicate_empty_lines_ = val;
249 static void
250 bset_invisibility_spec (struct buffer *b, Lisp_Object val)
252 b->invisibility_spec_ = val;
254 static void
255 bset_left_fringe_width (struct buffer *b, Lisp_Object val)
257 b->left_fringe_width_ = val;
259 static void
260 bset_major_mode (struct buffer *b, Lisp_Object val)
262 b->major_mode_ = val;
264 static void
265 bset_mark (struct buffer *b, Lisp_Object val)
267 b->mark_ = val;
269 static void
270 bset_minor_modes (struct buffer *b, Lisp_Object val)
272 b->minor_modes_ = val;
274 static void
275 bset_mode_line_format (struct buffer *b, Lisp_Object val)
277 b->mode_line_format_ = val;
279 static void
280 bset_mode_name (struct buffer *b, Lisp_Object val)
282 b->mode_name_ = val;
284 static void
285 bset_name (struct buffer *b, Lisp_Object val)
287 b->name_ = val;
289 static void
290 bset_overwrite_mode (struct buffer *b, Lisp_Object val)
292 b->overwrite_mode_ = val;
294 static void
295 bset_pt_marker (struct buffer *b, Lisp_Object val)
297 b->pt_marker_ = val;
299 static void
300 bset_right_fringe_width (struct buffer *b, Lisp_Object val)
302 b->right_fringe_width_ = val;
304 static void
305 bset_save_length (struct buffer *b, Lisp_Object val)
307 b->save_length_ = val;
309 static void
310 bset_scroll_bar_width (struct buffer *b, Lisp_Object val)
312 b->scroll_bar_width_ = val;
314 static void
315 bset_scroll_bar_height (struct buffer *b, Lisp_Object val)
317 b->scroll_bar_height_ = val;
319 static void
320 bset_scroll_down_aggressively (struct buffer *b, Lisp_Object val)
322 b->scroll_down_aggressively_ = val;
324 static void
325 bset_scroll_up_aggressively (struct buffer *b, Lisp_Object val)
327 b->scroll_up_aggressively_ = val;
329 static void
330 bset_selective_display (struct buffer *b, Lisp_Object val)
332 b->selective_display_ = val;
334 static void
335 bset_selective_display_ellipses (struct buffer *b, Lisp_Object val)
337 b->selective_display_ellipses_ = val;
339 static void
340 bset_vertical_scroll_bar_type (struct buffer *b, Lisp_Object val)
342 b->vertical_scroll_bar_type_ = val;
344 static void
345 bset_horizontal_scroll_bar_type (struct buffer *b, Lisp_Object val)
347 b->horizontal_scroll_bar_type_ = val;
349 static void
350 bset_word_wrap (struct buffer *b, Lisp_Object val)
352 b->word_wrap_ = val;
354 static void
355 bset_zv_marker (struct buffer *b, Lisp_Object val)
357 b->zv_marker_ = val;
360 void
361 nsberror (Lisp_Object spec)
363 if (STRINGP (spec))
364 error ("No buffer named %s", SDATA (spec));
365 error ("Invalid buffer argument");
368 DEFUN ("buffer-live-p", Fbuffer_live_p, Sbuffer_live_p, 1, 1, 0,
369 doc: /* Return non-nil if OBJECT is a buffer which has not been killed.
370 Value is nil if OBJECT is not a buffer or if it has been killed. */)
371 (Lisp_Object object)
373 return ((BUFFERP (object) && BUFFER_LIVE_P (XBUFFER (object)))
374 ? Qt : Qnil);
377 DEFUN ("buffer-list", Fbuffer_list, Sbuffer_list, 0, 1, 0,
378 doc: /* Return a list of all existing live buffers.
379 If the optional arg FRAME is a frame, we return the buffer list in the
380 proper order for that frame: the buffers show in FRAME come first,
381 followed by the rest of the buffers. */)
382 (Lisp_Object frame)
384 Lisp_Object general;
385 general = Fmapcar (Qcdr, Vbuffer_alist);
387 if (FRAMEP (frame))
389 Lisp_Object framelist, prevlist, tail;
391 framelist = Fcopy_sequence (XFRAME (frame)->buffer_list);
392 prevlist = Fnreverse (Fcopy_sequence
393 (XFRAME (frame)->buried_buffer_list));
395 /* Remove from GENERAL any buffer that duplicates one in
396 FRAMELIST or PREVLIST. */
397 tail = framelist;
398 while (CONSP (tail))
400 general = Fdelq (XCAR (tail), general);
401 tail = XCDR (tail);
403 tail = prevlist;
404 while (CONSP (tail))
406 general = Fdelq (XCAR (tail), general);
407 tail = XCDR (tail);
410 return CALLN (Fnconc, framelist, general, prevlist);
412 else
413 return general;
416 /* Like Fassoc, but use Fstring_equal to compare
417 (which ignores text properties),
418 and don't ever QUIT. */
420 static Lisp_Object
421 assoc_ignore_text_properties (register Lisp_Object key, Lisp_Object list)
423 register Lisp_Object tail;
424 for (tail = list; CONSP (tail); tail = XCDR (tail))
426 register Lisp_Object elt, tem;
427 elt = XCAR (tail);
428 tem = Fstring_equal (Fcar (elt), key);
429 if (!NILP (tem))
430 return elt;
432 return Qnil;
435 DEFUN ("get-buffer", Fget_buffer, Sget_buffer, 1, 1, 0,
436 doc: /* Return the buffer named BUFFER-OR-NAME.
437 BUFFER-OR-NAME must be either a string or a buffer. If BUFFER-OR-NAME
438 is a string and there is no buffer with that name, return nil. If
439 BUFFER-OR-NAME is a buffer, return it as given. */)
440 (register Lisp_Object buffer_or_name)
442 if (BUFFERP (buffer_or_name))
443 return buffer_or_name;
444 CHECK_STRING (buffer_or_name);
446 return Fcdr (assoc_ignore_text_properties (buffer_or_name, Vbuffer_alist));
449 DEFUN ("get-file-buffer", Fget_file_buffer, Sget_file_buffer, 1, 1, 0,
450 doc: /* Return the buffer visiting file FILENAME (a string).
451 The buffer's `buffer-file-name' must match exactly the expansion of FILENAME.
452 If there is no such live buffer, return nil.
453 See also `find-buffer-visiting'. */)
454 (register Lisp_Object filename)
456 register Lisp_Object tail, buf, handler;
458 CHECK_STRING (filename);
459 filename = Fexpand_file_name (filename, Qnil);
461 /* If the file name has special constructs in it,
462 call the corresponding file handler. */
463 handler = Ffind_file_name_handler (filename, Qget_file_buffer);
464 if (!NILP (handler))
466 Lisp_Object handled_buf = call2 (handler, Qget_file_buffer,
467 filename);
468 return BUFFERP (handled_buf) ? handled_buf : Qnil;
471 FOR_EACH_LIVE_BUFFER (tail, buf)
473 if (!STRINGP (BVAR (XBUFFER (buf), filename))) continue;
474 if (!NILP (Fstring_equal (BVAR (XBUFFER (buf), filename), filename)))
475 return buf;
477 return Qnil;
480 Lisp_Object
481 get_truename_buffer (register Lisp_Object filename)
483 register Lisp_Object tail, buf;
485 FOR_EACH_LIVE_BUFFER (tail, buf)
487 if (!STRINGP (BVAR (XBUFFER (buf), file_truename))) continue;
488 if (!NILP (Fstring_equal (BVAR (XBUFFER (buf), file_truename), filename)))
489 return buf;
491 return Qnil;
494 DEFUN ("get-buffer-create", Fget_buffer_create, Sget_buffer_create, 1, 1, 0,
495 doc: /* Return the buffer specified by BUFFER-OR-NAME, creating a new one if needed.
496 If BUFFER-OR-NAME is a string and a live buffer with that name exists,
497 return that buffer. If no such buffer exists, create a new buffer with
498 that name and return it. If BUFFER-OR-NAME starts with a space, the new
499 buffer does not keep undo information.
501 If BUFFER-OR-NAME is a buffer instead of a string, return it as given,
502 even if it is dead. The return value is never nil. */)
503 (register Lisp_Object buffer_or_name)
505 register Lisp_Object buffer, name;
506 register struct buffer *b;
508 buffer = Fget_buffer (buffer_or_name);
509 if (!NILP (buffer))
510 return buffer;
512 if (SCHARS (buffer_or_name) == 0)
513 error ("Empty string for buffer name is not allowed");
515 b = allocate_buffer ();
517 /* An ordinary buffer uses its own struct buffer_text. */
518 b->text = &b->own_text;
519 b->base_buffer = NULL;
520 /* No one shares the text with us now. */
521 b->indirections = 0;
522 /* No one shows us now. */
523 b->window_count = 0;
525 BUF_GAP_SIZE (b) = 20;
526 block_input ();
527 /* We allocate extra 1-byte at the tail and keep it always '\0' for
528 anchoring a search. */
529 alloc_buffer_text (b, BUF_GAP_SIZE (b) + 1);
530 unblock_input ();
531 if (! BUF_BEG_ADDR (b))
532 buffer_memory_full (BUF_GAP_SIZE (b) + 1);
534 b->pt = BEG;
535 b->begv = BEG;
536 b->zv = BEG;
537 b->pt_byte = BEG_BYTE;
538 b->begv_byte = BEG_BYTE;
539 b->zv_byte = BEG_BYTE;
541 BUF_GPT (b) = BEG;
542 BUF_GPT_BYTE (b) = BEG_BYTE;
544 BUF_Z (b) = BEG;
545 BUF_Z_BYTE (b) = BEG_BYTE;
546 BUF_MODIFF (b) = 1;
547 BUF_CHARS_MODIFF (b) = 1;
548 BUF_OVERLAY_MODIFF (b) = 1;
549 BUF_SAVE_MODIFF (b) = 1;
550 BUF_COMPACT (b) = 1;
551 set_buffer_intervals (b, NULL);
552 BUF_UNCHANGED_MODIFIED (b) = 1;
553 BUF_OVERLAY_UNCHANGED_MODIFIED (b) = 1;
554 BUF_END_UNCHANGED (b) = 0;
555 BUF_BEG_UNCHANGED (b) = 0;
556 *(BUF_GPT_ADDR (b)) = *(BUF_Z_ADDR (b)) = 0; /* Put an anchor '\0'. */
557 b->text->inhibit_shrinking = false;
558 b->text->redisplay = false;
560 b->newline_cache = 0;
561 b->width_run_cache = 0;
562 b->bidi_paragraph_cache = 0;
563 bset_width_table (b, Qnil);
564 b->prevent_redisplay_optimizations_p = 1;
566 /* An ordinary buffer normally doesn't need markers
567 to handle BEGV and ZV. */
568 bset_pt_marker (b, Qnil);
569 bset_begv_marker (b, Qnil);
570 bset_zv_marker (b, Qnil);
572 name = Fcopy_sequence (buffer_or_name);
573 set_string_intervals (name, NULL);
574 bset_name (b, name);
576 bset_undo_list (b, SREF (name, 0) != ' ' ? Qnil : Qt);
578 reset_buffer (b);
579 reset_buffer_local_variables (b, 1);
581 bset_mark (b, Fmake_marker ());
582 BUF_MARKERS (b) = NULL;
584 /* Put this in the alist of all live buffers. */
585 XSETBUFFER (buffer, b);
586 Vbuffer_alist = nconc2 (Vbuffer_alist, list1 (Fcons (name, buffer)));
587 /* And run buffer-list-update-hook. */
588 if (!NILP (Vrun_hooks))
589 call1 (Vrun_hooks, Qbuffer_list_update_hook);
591 return buffer;
595 /* Return a list of overlays which is a copy of the overlay list
596 LIST, but for buffer B. */
598 static struct Lisp_Overlay *
599 copy_overlays (struct buffer *b, struct Lisp_Overlay *list)
601 struct Lisp_Overlay *result = NULL, *tail = NULL;
603 for (; list; list = list->next)
605 Lisp_Object overlay, start, end;
606 struct Lisp_Marker *m;
608 eassert (MARKERP (list->start));
609 m = XMARKER (list->start);
610 start = build_marker (b, m->charpos, m->bytepos);
611 XMARKER (start)->insertion_type = m->insertion_type;
613 eassert (MARKERP (list->end));
614 m = XMARKER (list->end);
615 end = build_marker (b, m->charpos, m->bytepos);
616 XMARKER (end)->insertion_type = m->insertion_type;
618 overlay = build_overlay (start, end, Fcopy_sequence (list->plist));
619 if (tail)
620 tail = tail->next = XOVERLAY (overlay);
621 else
622 result = tail = XOVERLAY (overlay);
625 return result;
628 /* Set an appropriate overlay of B. */
630 static void
631 set_buffer_overlays_before (struct buffer *b, struct Lisp_Overlay *o)
633 b->overlays_before = o;
636 static void
637 set_buffer_overlays_after (struct buffer *b, struct Lisp_Overlay *o)
639 b->overlays_after = o;
642 /* Clone per-buffer values of buffer FROM.
644 Buffer TO gets the same per-buffer values as FROM, with the
645 following exceptions: (1) TO's name is left untouched, (2) markers
646 are copied and made to refer to TO, and (3) overlay lists are
647 copied. */
649 static void
650 clone_per_buffer_values (struct buffer *from, struct buffer *to)
652 int offset;
654 FOR_EACH_PER_BUFFER_OBJECT_AT (offset)
656 Lisp_Object obj;
658 /* Don't touch the `name' which should be unique for every buffer. */
659 if (offset == PER_BUFFER_VAR_OFFSET (name))
660 continue;
662 obj = per_buffer_value (from, offset);
663 if (MARKERP (obj) && XMARKER (obj)->buffer == from)
665 struct Lisp_Marker *m = XMARKER (obj);
667 obj = build_marker (to, m->charpos, m->bytepos);
668 XMARKER (obj)->insertion_type = m->insertion_type;
671 set_per_buffer_value (to, offset, obj);
674 memcpy (to->local_flags, from->local_flags, sizeof to->local_flags);
676 set_buffer_overlays_before (to, copy_overlays (to, from->overlays_before));
677 set_buffer_overlays_after (to, copy_overlays (to, from->overlays_after));
679 /* Get (a copy of) the alist of Lisp-level local variables of FROM
680 and install that in TO. */
681 bset_local_var_alist (to, buffer_lisp_local_variables (from, 1));
685 /* If buffer B has markers to record PT, BEGV and ZV when it is not
686 current, update these markers. */
688 static void
689 record_buffer_markers (struct buffer *b)
691 if (! NILP (BVAR (b, pt_marker)))
693 Lisp_Object buffer;
695 eassert (!NILP (BVAR (b, begv_marker)));
696 eassert (!NILP (BVAR (b, zv_marker)));
698 XSETBUFFER (buffer, b);
699 set_marker_both (BVAR (b, pt_marker), buffer, b->pt, b->pt_byte);
700 set_marker_both (BVAR (b, begv_marker), buffer, b->begv, b->begv_byte);
701 set_marker_both (BVAR (b, zv_marker), buffer, b->zv, b->zv_byte);
706 /* If buffer B has markers to record PT, BEGV and ZV when it is not
707 current, fetch these values into B->begv etc. */
709 static void
710 fetch_buffer_markers (struct buffer *b)
712 if (! NILP (BVAR (b, pt_marker)))
714 Lisp_Object m;
716 eassert (!NILP (BVAR (b, begv_marker)));
717 eassert (!NILP (BVAR (b, zv_marker)));
719 m = BVAR (b, pt_marker);
720 SET_BUF_PT_BOTH (b, marker_position (m), marker_byte_position (m));
722 m = BVAR (b, begv_marker);
723 SET_BUF_BEGV_BOTH (b, marker_position (m), marker_byte_position (m));
725 m = BVAR (b, zv_marker);
726 SET_BUF_ZV_BOTH (b, marker_position (m), marker_byte_position (m));
731 DEFUN ("make-indirect-buffer", Fmake_indirect_buffer, Smake_indirect_buffer,
732 2, 3,
733 "bMake indirect buffer (to buffer): \nBName of indirect buffer: ",
734 doc: /* Create and return an indirect buffer for buffer BASE-BUFFER, named NAME.
735 BASE-BUFFER should be a live buffer, or the name of an existing buffer.
736 NAME should be a string which is not the name of an existing buffer.
737 Optional argument CLONE non-nil means preserve BASE-BUFFER's state,
738 such as major and minor modes, in the indirect buffer.
739 CLONE nil means the indirect buffer's state is reset to default values. */)
740 (Lisp_Object base_buffer, Lisp_Object name, Lisp_Object clone)
742 Lisp_Object buf, tem;
743 struct buffer *b;
745 CHECK_STRING (name);
746 buf = Fget_buffer (name);
747 if (!NILP (buf))
748 error ("Buffer name `%s' is in use", SDATA (name));
750 tem = base_buffer;
751 base_buffer = Fget_buffer (base_buffer);
752 if (NILP (base_buffer))
753 error ("No such buffer: `%s'", SDATA (tem));
754 if (!BUFFER_LIVE_P (XBUFFER (base_buffer)))
755 error ("Base buffer has been killed");
757 if (SCHARS (name) == 0)
758 error ("Empty string for buffer name is not allowed");
760 b = allocate_buffer ();
762 /* No double indirection - if base buffer is indirect,
763 new buffer becomes an indirect to base's base. */
764 b->base_buffer = (XBUFFER (base_buffer)->base_buffer
765 ? XBUFFER (base_buffer)->base_buffer
766 : XBUFFER (base_buffer));
768 /* Use the base buffer's text object. */
769 b->text = b->base_buffer->text;
770 /* We have no own text. */
771 b->indirections = -1;
772 /* Notify base buffer that we share the text now. */
773 b->base_buffer->indirections++;
774 /* Always -1 for an indirect buffer. */
775 b->window_count = -1;
777 b->pt = b->base_buffer->pt;
778 b->begv = b->base_buffer->begv;
779 b->zv = b->base_buffer->zv;
780 b->pt_byte = b->base_buffer->pt_byte;
781 b->begv_byte = b->base_buffer->begv_byte;
782 b->zv_byte = b->base_buffer->zv_byte;
784 b->newline_cache = 0;
785 b->width_run_cache = 0;
786 b->bidi_paragraph_cache = 0;
787 bset_width_table (b, Qnil);
789 name = Fcopy_sequence (name);
790 set_string_intervals (name, NULL);
791 bset_name (b, name);
793 /* An indirect buffer shares undo list of its base (Bug#18180). */
794 bset_undo_list (b, BVAR (b->base_buffer, undo_list));
796 reset_buffer (b);
797 reset_buffer_local_variables (b, 1);
799 /* Put this in the alist of all live buffers. */
800 XSETBUFFER (buf, b);
801 Vbuffer_alist = nconc2 (Vbuffer_alist, list1 (Fcons (name, buf)));
803 bset_mark (b, Fmake_marker ());
805 /* The multibyte status belongs to the base buffer. */
806 bset_enable_multibyte_characters
807 (b, BVAR (b->base_buffer, enable_multibyte_characters));
809 /* Make sure the base buffer has markers for its narrowing. */
810 if (NILP (BVAR (b->base_buffer, pt_marker)))
812 eassert (NILP (BVAR (b->base_buffer, begv_marker)));
813 eassert (NILP (BVAR (b->base_buffer, zv_marker)));
815 bset_pt_marker (b->base_buffer,
816 build_marker (b->base_buffer, b->base_buffer->pt,
817 b->base_buffer->pt_byte));
819 bset_begv_marker (b->base_buffer,
820 build_marker (b->base_buffer, b->base_buffer->begv,
821 b->base_buffer->begv_byte));
823 bset_zv_marker (b->base_buffer,
824 build_marker (b->base_buffer, b->base_buffer->zv,
825 b->base_buffer->zv_byte));
827 XMARKER (BVAR (b->base_buffer, zv_marker))->insertion_type = 1;
830 if (NILP (clone))
832 /* Give the indirect buffer markers for its narrowing. */
833 bset_pt_marker (b, build_marker (b, b->pt, b->pt_byte));
834 bset_begv_marker (b, build_marker (b, b->begv, b->begv_byte));
835 bset_zv_marker (b, build_marker (b, b->zv, b->zv_byte));
836 XMARKER (BVAR (b, zv_marker))->insertion_type = 1;
838 else
840 struct buffer *old_b = current_buffer;
842 clone_per_buffer_values (b->base_buffer, b);
843 bset_filename (b, Qnil);
844 bset_file_truename (b, Qnil);
845 bset_display_count (b, make_number (0));
846 bset_backed_up (b, Qnil);
847 bset_auto_save_file_name (b, Qnil);
848 set_buffer_internal_1 (b);
849 Fset (intern ("buffer-save-without-query"), Qnil);
850 Fset (intern ("buffer-file-number"), Qnil);
851 Fset (intern ("buffer-stale-function"), Qnil);
852 set_buffer_internal_1 (old_b);
855 /* Run buffer-list-update-hook. */
856 if (!NILP (Vrun_hooks))
857 call1 (Vrun_hooks, Qbuffer_list_update_hook);
859 return buf;
862 /* Mark OV as no longer associated with B. */
864 static void
865 drop_overlay (struct buffer *b, struct Lisp_Overlay *ov)
867 eassert (b == XBUFFER (Fmarker_buffer (ov->start)));
868 modify_overlay (b, marker_position (ov->start),
869 marker_position (ov->end));
870 unchain_marker (XMARKER (ov->start));
871 unchain_marker (XMARKER (ov->end));
875 /* Delete all overlays of B and reset it's overlay lists. */
877 void
878 delete_all_overlays (struct buffer *b)
880 struct Lisp_Overlay *ov, *next;
882 /* FIXME: Since each drop_overlay will scan BUF_MARKERS to unlink its
883 markers, we have an unneeded O(N^2) behavior here. */
884 for (ov = b->overlays_before; ov; ov = next)
886 drop_overlay (b, ov);
887 next = ov->next;
888 ov->next = NULL;
891 for (ov = b->overlays_after; ov; ov = next)
893 drop_overlay (b, ov);
894 next = ov->next;
895 ov->next = NULL;
898 set_buffer_overlays_before (b, NULL);
899 set_buffer_overlays_after (b, NULL);
902 /* Reinitialize everything about a buffer except its name and contents
903 and local variables.
904 If called on an already-initialized buffer, the list of overlays
905 should be deleted before calling this function, otherwise we end up
906 with overlays that claim to belong to the buffer but the buffer
907 claims it doesn't belong to it. */
909 void
910 reset_buffer (register struct buffer *b)
912 bset_filename (b, Qnil);
913 bset_file_truename (b, Qnil);
914 bset_directory (b, current_buffer ? BVAR (current_buffer, directory) : Qnil);
915 b->modtime = make_timespec (0, UNKNOWN_MODTIME_NSECS);
916 b->modtime_size = -1;
917 XSETFASTINT (BVAR (b, save_length), 0);
918 b->last_window_start = 1;
919 /* It is more conservative to start out "changed" than "unchanged". */
920 b->clip_changed = 0;
921 b->prevent_redisplay_optimizations_p = 1;
922 bset_backed_up (b, Qnil);
923 BUF_AUTOSAVE_MODIFF (b) = 0;
924 b->auto_save_failure_time = 0;
925 bset_auto_save_file_name (b, Qnil);
926 bset_read_only (b, Qnil);
927 set_buffer_overlays_before (b, NULL);
928 set_buffer_overlays_after (b, NULL);
929 b->overlay_center = BEG;
930 bset_mark_active (b, Qnil);
931 bset_point_before_scroll (b, Qnil);
932 bset_file_format (b, Qnil);
933 bset_auto_save_file_format (b, Qt);
934 bset_last_selected_window (b, Qnil);
935 bset_display_count (b, make_number (0));
936 bset_display_time (b, Qnil);
937 bset_enable_multibyte_characters
938 (b, BVAR (&buffer_defaults, enable_multibyte_characters));
939 bset_cursor_type (b, BVAR (&buffer_defaults, cursor_type));
940 bset_extra_line_spacing (b, BVAR (&buffer_defaults, extra_line_spacing));
942 b->display_error_modiff = 0;
945 /* Reset buffer B's local variables info.
946 Don't use this on a buffer that has already been in use;
947 it does not treat permanent locals consistently.
948 Instead, use Fkill_all_local_variables.
950 If PERMANENT_TOO, reset permanent buffer-local variables.
951 If not, preserve those. */
953 static void
954 reset_buffer_local_variables (struct buffer *b, bool permanent_too)
956 int offset, i;
958 /* Reset the major mode to Fundamental, together with all the
959 things that depend on the major mode.
960 default-major-mode is handled at a higher level.
961 We ignore it here. */
962 bset_major_mode (b, Qfundamental_mode);
963 bset_keymap (b, Qnil);
964 bset_mode_name (b, QSFundamental);
965 bset_minor_modes (b, Qnil);
967 /* If the standard case table has been altered and invalidated,
968 fix up its insides first. */
969 if (! (CHAR_TABLE_P (XCHAR_TABLE (Vascii_downcase_table)->extras[0])
970 && CHAR_TABLE_P (XCHAR_TABLE (Vascii_downcase_table)->extras[1])
971 && CHAR_TABLE_P (XCHAR_TABLE (Vascii_downcase_table)->extras[2])))
972 Fset_standard_case_table (Vascii_downcase_table);
974 bset_downcase_table (b, Vascii_downcase_table);
975 bset_upcase_table (b, XCHAR_TABLE (Vascii_downcase_table)->extras[0]);
976 bset_case_canon_table (b, XCHAR_TABLE (Vascii_downcase_table)->extras[1]);
977 bset_case_eqv_table (b, XCHAR_TABLE (Vascii_downcase_table)->extras[2]);
978 bset_invisibility_spec (b, Qt);
980 /* Reset all (or most) per-buffer variables to their defaults. */
981 if (permanent_too)
982 bset_local_var_alist (b, Qnil);
983 else
985 Lisp_Object tmp, prop, last = Qnil;
986 for (tmp = BVAR (b, local_var_alist); CONSP (tmp); tmp = XCDR (tmp))
987 if (!NILP (prop = Fget (XCAR (XCAR (tmp)), Qpermanent_local)))
989 /* If permanent-local, keep it. */
990 last = tmp;
991 if (EQ (prop, Qpermanent_local_hook))
993 /* This is a partially permanent hook variable.
994 Preserve only the elements that want to be preserved. */
995 Lisp_Object list, newlist;
996 list = XCDR (XCAR (tmp));
997 if (!CONSP (list))
998 newlist = list;
999 else
1000 for (newlist = Qnil; CONSP (list); list = XCDR (list))
1002 Lisp_Object elt = XCAR (list);
1003 /* Preserve element ELT if it's t,
1004 if it is a function with a `permanent-local-hook' property,
1005 or if it's not a symbol. */
1006 if (! SYMBOLP (elt)
1007 || EQ (elt, Qt)
1008 || !NILP (Fget (elt, Qpermanent_local_hook)))
1009 newlist = Fcons (elt, newlist);
1011 XSETCDR (XCAR (tmp), Fnreverse (newlist));
1014 /* Delete this local variable. */
1015 else if (NILP (last))
1016 bset_local_var_alist (b, XCDR (tmp));
1017 else
1018 XSETCDR (last, XCDR (tmp));
1021 for (i = 0; i < last_per_buffer_idx; ++i)
1022 if (permanent_too || buffer_permanent_local_flags[i] == 0)
1023 SET_PER_BUFFER_VALUE_P (b, i, 0);
1025 /* For each slot that has a default value, copy that into the slot. */
1026 FOR_EACH_PER_BUFFER_OBJECT_AT (offset)
1028 int idx = PER_BUFFER_IDX (offset);
1029 if ((idx > 0
1030 && (permanent_too
1031 || buffer_permanent_local_flags[idx] == 0)))
1032 set_per_buffer_value (b, offset, per_buffer_default (offset));
1036 /* We split this away from generate-new-buffer, because rename-buffer
1037 and set-visited-file-name ought to be able to use this to really
1038 rename the buffer properly. */
1040 DEFUN ("generate-new-buffer-name", Fgenerate_new_buffer_name,
1041 Sgenerate_new_buffer_name, 1, 2, 0,
1042 doc: /* Return a string that is the name of no existing buffer based on NAME.
1043 If there is no live buffer named NAME, then return NAME.
1044 Otherwise modify name by appending `<NUMBER>', incrementing NUMBER
1045 \(starting at 2) until an unused name is found, and then return that name.
1046 Optional second argument IGNORE specifies a name that is okay to use (if
1047 it is in the sequence to be tried) even if a buffer with that name exists.
1049 If NAME begins with a space (i.e., a buffer that is not normally
1050 visible to users), then if buffer NAME already exists a random number
1051 is first appended to NAME, to speed up finding a non-existent buffer. */)
1052 (register Lisp_Object name, Lisp_Object ignore)
1054 register Lisp_Object gentemp, tem, tem2;
1055 ptrdiff_t count;
1056 char number[INT_BUFSIZE_BOUND (ptrdiff_t) + sizeof "<>"];
1058 CHECK_STRING (name);
1060 tem = Fstring_equal (name, ignore);
1061 if (!NILP (tem))
1062 return name;
1063 tem = Fget_buffer (name);
1064 if (NILP (tem))
1065 return name;
1067 if (!strncmp (SSDATA (name), " ", 1)) /* see bug#1229 */
1069 /* Note fileio.c:make_temp_name does random differently. */
1070 tem2 = concat2 (name, make_formatted_string
1071 (number, "-%"pI"d",
1072 XFASTINT (Frandom (make_number (999999)))));
1073 tem = Fget_buffer (tem2);
1074 if (NILP (tem))
1075 return tem2;
1077 else
1078 tem2 = name;
1080 count = 1;
1081 while (1)
1083 gentemp = concat2 (tem2, make_formatted_string
1084 (number, "<%"pD"d>", ++count));
1085 tem = Fstring_equal (gentemp, ignore);
1086 if (!NILP (tem))
1087 return gentemp;
1088 tem = Fget_buffer (gentemp);
1089 if (NILP (tem))
1090 return gentemp;
1095 DEFUN ("buffer-name", Fbuffer_name, Sbuffer_name, 0, 1, 0,
1096 doc: /* Return the name of BUFFER, as a string.
1097 BUFFER defaults to the current buffer.
1098 Return nil if BUFFER has been killed. */)
1099 (register Lisp_Object buffer)
1101 return BVAR (decode_buffer (buffer), name);
1104 DEFUN ("buffer-file-name", Fbuffer_file_name, Sbuffer_file_name, 0, 1, 0,
1105 doc: /* Return name of file BUFFER is visiting, or nil if none.
1106 No argument or nil as argument means use the current buffer. */)
1107 (register Lisp_Object buffer)
1109 return BVAR (decode_buffer (buffer), filename);
1112 DEFUN ("buffer-base-buffer", Fbuffer_base_buffer, Sbuffer_base_buffer,
1113 0, 1, 0,
1114 doc: /* Return the base buffer of indirect buffer BUFFER.
1115 If BUFFER is not indirect, return nil.
1116 BUFFER defaults to the current buffer. */)
1117 (register Lisp_Object buffer)
1119 struct buffer *base = decode_buffer (buffer)->base_buffer;
1120 return base ? (XSETBUFFER (buffer, base), buffer) : Qnil;
1123 DEFUN ("buffer-local-value", Fbuffer_local_value,
1124 Sbuffer_local_value, 2, 2, 0,
1125 doc: /* Return the value of VARIABLE in BUFFER.
1126 If VARIABLE does not have a buffer-local binding in BUFFER, the value
1127 is the default binding of the variable. */)
1128 (register Lisp_Object variable, register Lisp_Object buffer)
1130 register Lisp_Object result = buffer_local_value (variable, buffer);
1132 if (EQ (result, Qunbound))
1133 xsignal1 (Qvoid_variable, variable);
1135 return result;
1139 /* Like Fbuffer_local_value, but return Qunbound if the variable is
1140 locally unbound. */
1142 Lisp_Object
1143 buffer_local_value (Lisp_Object variable, Lisp_Object buffer)
1145 register struct buffer *buf;
1146 register Lisp_Object result;
1147 struct Lisp_Symbol *sym;
1149 CHECK_SYMBOL (variable);
1150 CHECK_BUFFER (buffer);
1151 buf = XBUFFER (buffer);
1152 sym = XSYMBOL (variable);
1154 start:
1155 switch (sym->redirect)
1157 case SYMBOL_VARALIAS: sym = indirect_variable (sym); goto start;
1158 case SYMBOL_PLAINVAL: result = SYMBOL_VAL (sym); break;
1159 case SYMBOL_LOCALIZED:
1160 { /* Look in local_var_alist. */
1161 struct Lisp_Buffer_Local_Value *blv = SYMBOL_BLV (sym);
1162 XSETSYMBOL (variable, sym); /* Update In case of aliasing. */
1163 result = Fassoc (variable, BVAR (buf, local_var_alist));
1164 if (!NILP (result))
1166 if (blv->fwd)
1167 { /* What binding is loaded right now? */
1168 Lisp_Object current_alist_element = blv->valcell;
1170 /* The value of the currently loaded binding is not
1171 stored in it, but rather in the realvalue slot.
1172 Store that value into the binding it belongs to
1173 in case that is the one we are about to use. */
1175 XSETCDR (current_alist_element,
1176 do_symval_forwarding (blv->fwd));
1178 /* Now get the (perhaps updated) value out of the binding. */
1179 result = XCDR (result);
1181 else
1182 result = Fdefault_value (variable);
1183 break;
1185 case SYMBOL_FORWARDED:
1187 union Lisp_Fwd *fwd = SYMBOL_FWD (sym);
1188 if (BUFFER_OBJFWDP (fwd))
1189 result = per_buffer_value (buf, XBUFFER_OBJFWD (fwd)->offset);
1190 else
1191 result = Fdefault_value (variable);
1192 break;
1194 default: emacs_abort ();
1197 return result;
1200 /* Return an alist of the Lisp-level buffer-local bindings of
1201 buffer BUF. That is, don't include the variables maintained
1202 in special slots in the buffer object.
1203 If not CLONE, replace elements of the form (VAR . unbound)
1204 by VAR. */
1206 static Lisp_Object
1207 buffer_lisp_local_variables (struct buffer *buf, bool clone)
1209 Lisp_Object result = Qnil;
1210 Lisp_Object tail;
1211 for (tail = BVAR (buf, local_var_alist); CONSP (tail); tail = XCDR (tail))
1213 Lisp_Object val, elt;
1215 elt = XCAR (tail);
1217 /* Reference each variable in the alist in buf.
1218 If inquiring about the current buffer, this gets the current values,
1219 so store them into the alist so the alist is up to date.
1220 If inquiring about some other buffer, this swaps out any values
1221 for that buffer, making the alist up to date automatically. */
1222 val = find_symbol_value (XCAR (elt));
1223 /* Use the current buffer value only if buf is the current buffer. */
1224 if (buf != current_buffer)
1225 val = XCDR (elt);
1227 result = Fcons (!clone && EQ (val, Qunbound)
1228 ? XCAR (elt)
1229 : Fcons (XCAR (elt), val),
1230 result);
1233 return result;
1236 DEFUN ("buffer-local-variables", Fbuffer_local_variables,
1237 Sbuffer_local_variables, 0, 1, 0,
1238 doc: /* Return an alist of variables that are buffer-local in BUFFER.
1239 Most elements look like (SYMBOL . VALUE), describing one variable.
1240 For a symbol that is locally unbound, just the symbol appears in the value.
1241 Note that storing new VALUEs in these elements doesn't change the variables.
1242 No argument or nil as argument means use current buffer as BUFFER. */)
1243 (Lisp_Object buffer)
1245 struct buffer *buf = decode_buffer (buffer);
1246 Lisp_Object result = buffer_lisp_local_variables (buf, 0);
1248 /* Add on all the variables stored in special slots. */
1250 int offset, idx;
1252 FOR_EACH_PER_BUFFER_OBJECT_AT (offset)
1254 idx = PER_BUFFER_IDX (offset);
1255 if ((idx == -1 || PER_BUFFER_VALUE_P (buf, idx))
1256 && SYMBOLP (PER_BUFFER_SYMBOL (offset)))
1258 Lisp_Object sym = PER_BUFFER_SYMBOL (offset);
1259 Lisp_Object val = per_buffer_value (buf, offset);
1260 result = Fcons (EQ (val, Qunbound) ? sym : Fcons (sym, val),
1261 result);
1266 return result;
1269 DEFUN ("buffer-modified-p", Fbuffer_modified_p, Sbuffer_modified_p,
1270 0, 1, 0,
1271 doc: /* Return t if BUFFER was modified since its file was last read or saved.
1272 No argument or nil as argument means use current buffer as BUFFER. */)
1273 (Lisp_Object buffer)
1275 struct buffer *buf = decode_buffer (buffer);
1276 return BUF_SAVE_MODIFF (buf) < BUF_MODIFF (buf) ? Qt : Qnil;
1279 DEFUN ("force-mode-line-update", Fforce_mode_line_update,
1280 Sforce_mode_line_update, 0, 1, 0,
1281 doc: /* Force redisplay of the current buffer's mode line and header line.
1282 With optional non-nil ALL, force redisplay of all mode lines and
1283 header lines. This function also forces recomputation of the
1284 menu bar menus and the frame title. */)
1285 (Lisp_Object all)
1287 if (!NILP (all))
1289 update_mode_lines = 10;
1290 /* FIXME: This can't be right. */
1291 current_buffer->prevent_redisplay_optimizations_p = true;
1293 else if (buffer_window_count (current_buffer))
1295 bset_update_mode_line (current_buffer);
1296 current_buffer->prevent_redisplay_optimizations_p = true;
1298 return all;
1301 DEFUN ("set-buffer-modified-p", Fset_buffer_modified_p, Sset_buffer_modified_p,
1302 1, 1, 0,
1303 doc: /* Mark current buffer as modified or unmodified according to FLAG.
1304 A non-nil FLAG means mark the buffer modified. */)
1305 (Lisp_Object flag)
1307 Frestore_buffer_modified_p (flag);
1309 /* Set update_mode_lines only if buffer is displayed in some window.
1310 Packages like jit-lock or lazy-lock preserve a buffer's modified
1311 state by recording/restoring the state around blocks of code.
1312 Setting update_mode_lines makes redisplay consider all windows
1313 (on all frames). Stealth fontification of buffers not displayed
1314 would incur additional redisplay costs if we'd set
1315 update_modes_lines unconditionally.
1317 Ideally, I think there should be another mechanism for fontifying
1318 buffers without "modifying" buffers, or redisplay should be
1319 smarter about updating the `*' in mode lines. --gerd */
1320 return Fforce_mode_line_update (Qnil);
1323 DEFUN ("restore-buffer-modified-p", Frestore_buffer_modified_p,
1324 Srestore_buffer_modified_p, 1, 1, 0,
1325 doc: /* Like `set-buffer-modified-p', with a difference concerning redisplay.
1326 It is not ensured that mode lines will be updated to show the modified
1327 state of the current buffer. Use with care. */)
1328 (Lisp_Object flag)
1330 Lisp_Object fn;
1332 /* If buffer becoming modified, lock the file.
1333 If buffer becoming unmodified, unlock the file. */
1335 struct buffer *b = current_buffer->base_buffer
1336 ? current_buffer->base_buffer
1337 : current_buffer;
1339 fn = BVAR (b, file_truename);
1340 /* Test buffer-file-name so that binding it to nil is effective. */
1341 if (!NILP (fn) && ! NILP (BVAR (b, filename)))
1343 bool already = SAVE_MODIFF < MODIFF;
1344 if (!already && !NILP (flag))
1345 lock_file (fn);
1346 else if (already && NILP (flag))
1347 unlock_file (fn);
1350 /* Here we have a problem. SAVE_MODIFF is used here to encode
1351 buffer-modified-p (as SAVE_MODIFF<MODIFF) as well as
1352 recent-auto-save-p (as SAVE_MODIFF<auto_save_modified). So if we
1353 modify SAVE_MODIFF to affect one, we may affect the other
1354 as well.
1355 E.g. if FLAG is nil we need to set SAVE_MODIFF to MODIFF, but
1356 if SAVE_MODIFF<auto_save_modified that means we risk changing
1357 recent-auto-save-p from t to nil.
1358 Vice versa, if FLAG is non-nil and SAVE_MODIFF>=auto_save_modified
1359 we risk changing recent-auto-save-p from nil to t. */
1360 SAVE_MODIFF = (NILP (flag)
1361 /* FIXME: This unavoidably sets recent-auto-save-p to nil. */
1362 ? MODIFF
1363 /* Let's try to preserve recent-auto-save-p. */
1364 : SAVE_MODIFF < MODIFF ? SAVE_MODIFF
1365 /* If SAVE_MODIFF == auto_save_modified == MODIFF,
1366 we can either decrease SAVE_MODIFF and auto_save_modified
1367 or increase MODIFF. */
1368 : MODIFF++);
1370 return flag;
1373 DEFUN ("buffer-modified-tick", Fbuffer_modified_tick, Sbuffer_modified_tick,
1374 0, 1, 0,
1375 doc: /* Return BUFFER's tick counter, incremented for each change in text.
1376 Each buffer has a tick counter which is incremented each time the
1377 text in that buffer is changed. It wraps around occasionally.
1378 No argument or nil as argument means use current buffer as BUFFER. */)
1379 (register Lisp_Object buffer)
1381 return make_number (BUF_MODIFF (decode_buffer (buffer)));
1384 DEFUN ("buffer-chars-modified-tick", Fbuffer_chars_modified_tick,
1385 Sbuffer_chars_modified_tick, 0, 1, 0,
1386 doc: /* Return BUFFER's character-change tick counter.
1387 Each buffer has a character-change tick counter, which is set to the
1388 value of the buffer's tick counter \(see `buffer-modified-tick'), each
1389 time text in that buffer is inserted or deleted. By comparing the
1390 values returned by two individual calls of `buffer-chars-modified-tick',
1391 you can tell whether a character change occurred in that buffer in
1392 between these calls. No argument or nil as argument means use current
1393 buffer as BUFFER. */)
1394 (register Lisp_Object buffer)
1396 return make_number (BUF_CHARS_MODIFF (decode_buffer (buffer)));
1399 DEFUN ("rename-buffer", Frename_buffer, Srename_buffer, 1, 2,
1400 "(list (read-string \"Rename buffer (to new name): \" \
1401 nil 'buffer-name-history (buffer-name (current-buffer))) \
1402 current-prefix-arg)",
1403 doc: /* Change current buffer's name to NEWNAME (a string).
1404 If second arg UNIQUE is nil or omitted, it is an error if a
1405 buffer named NEWNAME already exists.
1406 If UNIQUE is non-nil, come up with a new name using
1407 `generate-new-buffer-name'.
1408 Interactively, you can set UNIQUE with a prefix argument.
1409 We return the name we actually gave the buffer.
1410 This does not change the name of the visited file (if any). */)
1411 (register Lisp_Object newname, Lisp_Object unique)
1413 register Lisp_Object tem, buf;
1415 CHECK_STRING (newname);
1417 if (SCHARS (newname) == 0)
1418 error ("Empty string is invalid as a buffer name");
1420 tem = Fget_buffer (newname);
1421 if (!NILP (tem))
1423 /* Don't short-circuit if UNIQUE is t. That is a useful way to
1424 rename the buffer automatically so you can create another
1425 with the original name. It makes UNIQUE equivalent to
1426 (rename-buffer (generate-new-buffer-name NEWNAME)). */
1427 if (NILP (unique) && XBUFFER (tem) == current_buffer)
1428 return BVAR (current_buffer, name);
1429 if (!NILP (unique))
1430 newname = Fgenerate_new_buffer_name (newname, BVAR (current_buffer, name));
1431 else
1432 error ("Buffer name `%s' is in use", SDATA (newname));
1435 bset_name (current_buffer, newname);
1437 /* Catch redisplay's attention. Unless we do this, the mode lines for
1438 any windows displaying current_buffer will stay unchanged. */
1439 update_mode_lines = 11;
1441 XSETBUFFER (buf, current_buffer);
1442 Fsetcar (Frassq (buf, Vbuffer_alist), newname);
1443 if (NILP (BVAR (current_buffer, filename))
1444 && !NILP (BVAR (current_buffer, auto_save_file_name)))
1445 call0 (intern ("rename-auto-save-file"));
1447 /* Run buffer-list-update-hook. */
1448 if (!NILP (Vrun_hooks))
1449 call1 (Vrun_hooks, Qbuffer_list_update_hook);
1451 /* Refetch since that last call may have done GC. */
1452 return BVAR (current_buffer, name);
1455 /* True if B can be used as 'other-than-BUFFER' buffer. */
1457 static bool
1458 candidate_buffer (Lisp_Object b, Lisp_Object buffer)
1460 return (BUFFERP (b) && !EQ (b, buffer)
1461 && BUFFER_LIVE_P (XBUFFER (b))
1462 && !BUFFER_HIDDEN_P (XBUFFER (b)));
1465 DEFUN ("other-buffer", Fother_buffer, Sother_buffer, 0, 3, 0,
1466 doc: /* Return most recently selected buffer other than BUFFER.
1467 Buffers not visible in windows are preferred to visible buffers, unless
1468 optional second argument VISIBLE-OK is non-nil. Ignore the argument
1469 BUFFER unless it denotes a live buffer. If the optional third argument
1470 FRAME specifies a live frame, then use that frame's buffer list instead
1471 of the selected frame's buffer list.
1473 The buffer is found by scanning the selected or specified frame's buffer
1474 list first, followed by the list of all buffers. If no other buffer
1475 exists, return the buffer `*scratch*' (creating it if necessary). */)
1476 (Lisp_Object buffer, Lisp_Object visible_ok, Lisp_Object frame)
1478 struct frame *f = decode_live_frame (frame);
1479 Lisp_Object tail = f->buffer_list, pred = f->buffer_predicate;
1480 Lisp_Object buf, notsogood = Qnil;
1482 /* Consider buffers that have been seen in the frame first. */
1483 for (; CONSP (tail); tail = XCDR (tail))
1485 buf = XCAR (tail);
1486 if (candidate_buffer (buf, buffer)
1487 /* If the frame has a buffer_predicate, disregard buffers that
1488 don't fit the predicate. */
1489 && (NILP (pred) || !NILP (call1 (pred, buf))))
1491 if (!NILP (visible_ok)
1492 || NILP (Fget_buffer_window (buf, Qvisible)))
1493 return buf;
1494 else if (NILP (notsogood))
1495 notsogood = buf;
1499 /* Consider alist of all buffers next. */
1500 FOR_EACH_LIVE_BUFFER (tail, buf)
1502 if (candidate_buffer (buf, buffer)
1503 /* If the frame has a buffer_predicate, disregard buffers that
1504 don't fit the predicate. */
1505 && (NILP (pred) || !NILP (call1 (pred, buf))))
1507 if (!NILP (visible_ok)
1508 || NILP (Fget_buffer_window (buf, Qvisible)))
1509 return buf;
1510 else if (NILP (notsogood))
1511 notsogood = buf;
1515 if (!NILP (notsogood))
1516 return notsogood;
1517 else
1519 AUTO_STRING (scratch, "*scratch*");
1520 buf = Fget_buffer (scratch);
1521 if (NILP (buf))
1523 buf = Fget_buffer_create (scratch);
1524 Fset_buffer_major_mode (buf);
1526 return buf;
1530 /* The following function is a safe variant of Fother_buffer: It doesn't
1531 pay attention to any frame-local buffer lists, doesn't care about
1532 visibility of buffers, and doesn't evaluate any frame predicates. */
1534 Lisp_Object
1535 other_buffer_safely (Lisp_Object buffer)
1537 Lisp_Object tail, buf;
1539 FOR_EACH_LIVE_BUFFER (tail, buf)
1540 if (candidate_buffer (buf, buffer))
1541 return buf;
1543 AUTO_STRING (scratch, "*scratch*");
1544 buf = Fget_buffer (scratch);
1545 if (NILP (buf))
1547 buf = Fget_buffer_create (scratch);
1548 Fset_buffer_major_mode (buf);
1551 return buf;
1554 DEFUN ("buffer-enable-undo", Fbuffer_enable_undo, Sbuffer_enable_undo,
1555 0, 1, "",
1556 doc: /* Start keeping undo information for buffer BUFFER.
1557 No argument or nil as argument means do this for the current buffer. */)
1558 (register Lisp_Object buffer)
1560 Lisp_Object real_buffer;
1562 if (NILP (buffer))
1563 XSETBUFFER (real_buffer, current_buffer);
1564 else
1566 real_buffer = Fget_buffer (buffer);
1567 if (NILP (real_buffer))
1568 nsberror (buffer);
1571 if (EQ (BVAR (XBUFFER (real_buffer), undo_list), Qt))
1572 bset_undo_list (XBUFFER (real_buffer), Qnil);
1574 return Qnil;
1577 /* Truncate undo list and shrink the gap of BUFFER. */
1579 void
1580 compact_buffer (struct buffer *buffer)
1582 BUFFER_CHECK_INDIRECTION (buffer);
1584 /* Skip dead buffers, indirect buffers and buffers
1585 which aren't changed since last compaction. */
1586 if (BUFFER_LIVE_P (buffer)
1587 && (buffer->base_buffer == NULL)
1588 && (BUF_COMPACT (buffer) != BUF_MODIFF (buffer)))
1590 /* If a buffer's undo list is Qt, that means that undo is
1591 turned off in that buffer. Calling truncate_undo_list on
1592 Qt tends to return NULL, which effectively turns undo back on.
1593 So don't call truncate_undo_list if undo_list is Qt. */
1594 if (!EQ (BVAR(buffer, undo_list), Qt))
1595 truncate_undo_list (buffer);
1597 /* Shrink buffer gaps. */
1598 if (!buffer->text->inhibit_shrinking)
1600 /* If a buffer's gap size is more than 10% of the buffer
1601 size, or larger than GAP_BYTES_DFL bytes, then shrink it
1602 accordingly. Keep a minimum size of GAP_BYTES_MIN bytes. */
1603 ptrdiff_t size = clip_to_bounds (GAP_BYTES_MIN,
1604 BUF_Z_BYTE (buffer) / 10,
1605 GAP_BYTES_DFL);
1606 if (BUF_GAP_SIZE (buffer) > size)
1607 make_gap_1 (buffer, -(BUF_GAP_SIZE (buffer) - size));
1609 BUF_COMPACT (buffer) = BUF_MODIFF (buffer);
1613 DEFUN ("kill-buffer", Fkill_buffer, Skill_buffer, 0, 1, "bKill buffer: ",
1614 doc: /* Kill the buffer specified by BUFFER-OR-NAME.
1615 The argument may be a buffer or the name of an existing buffer.
1616 Argument nil or omitted means kill the current buffer. Return t if the
1617 buffer is actually killed, nil otherwise.
1619 The functions in `kill-buffer-query-functions' are called with the
1620 buffer to be killed as the current buffer. If any of them returns nil,
1621 the buffer is not killed. The hook `kill-buffer-hook' is run before the
1622 buffer is actually killed. The buffer being killed will be current
1623 while the hook is running. Functions called by any of these hooks are
1624 supposed to not change the current buffer.
1626 Any processes that have this buffer as the `process-buffer' are killed
1627 with SIGHUP. This function calls `replace-buffer-in-windows' for
1628 cleaning up all windows currently displaying the buffer to be killed. */)
1629 (Lisp_Object buffer_or_name)
1631 Lisp_Object buffer;
1632 register struct buffer *b;
1633 register Lisp_Object tem;
1634 register struct Lisp_Marker *m;
1635 struct gcpro gcpro1;
1637 if (NILP (buffer_or_name))
1638 buffer = Fcurrent_buffer ();
1639 else
1640 buffer = Fget_buffer (buffer_or_name);
1641 if (NILP (buffer))
1642 nsberror (buffer_or_name);
1644 b = XBUFFER (buffer);
1646 /* Avoid trouble for buffer already dead. */
1647 if (!BUFFER_LIVE_P (b))
1648 return Qnil;
1650 /* Run hooks with the buffer to be killed the current buffer. */
1652 ptrdiff_t count = SPECPDL_INDEX ();
1654 record_unwind_protect (save_excursion_restore, save_excursion_save ());
1655 set_buffer_internal (b);
1657 /* First run the query functions; if any query is answered no,
1658 don't kill the buffer. */
1659 tem = CALLN (Frun_hook_with_args_until_failure,
1660 Qkill_buffer_query_functions);
1661 if (NILP (tem))
1662 return unbind_to (count, Qnil);
1664 /* Query if the buffer is still modified. */
1665 if (INTERACTIVE && !NILP (BVAR (b, filename))
1666 && BUF_MODIFF (b) > BUF_SAVE_MODIFF (b))
1668 GCPRO1 (buffer);
1669 AUTO_STRING (format, "Buffer %s modified; kill anyway? ");
1670 tem = do_yes_or_no_p (CALLN (Fformat, format, BVAR (b, name)));
1671 UNGCPRO;
1672 if (NILP (tem))
1673 return unbind_to (count, Qnil);
1676 /* If the hooks have killed the buffer, exit now. */
1677 if (!BUFFER_LIVE_P (b))
1678 return unbind_to (count, Qt);
1680 /* Then run the hooks. */
1681 run_hook (Qkill_buffer_hook);
1682 unbind_to (count, Qnil);
1685 /* If the hooks have killed the buffer, exit now. */
1686 if (!BUFFER_LIVE_P (b))
1687 return Qt;
1689 /* We have no more questions to ask. Verify that it is valid
1690 to kill the buffer. This must be done after the questions
1691 since anything can happen within do_yes_or_no_p. */
1693 /* Don't kill the minibuffer now current. */
1694 if (EQ (buffer, XWINDOW (minibuf_window)->contents))
1695 return Qnil;
1697 /* When we kill an ordinary buffer which shares it's buffer text
1698 with indirect buffer(s), we must kill indirect buffer(s) too.
1699 We do it at this stage so nothing terrible happens if they
1700 ask questions or their hooks get errors. */
1701 if (!b->base_buffer && b->indirections > 0)
1703 struct buffer *other;
1705 GCPRO1 (buffer);
1707 FOR_EACH_BUFFER (other)
1708 if (other->base_buffer == b)
1710 Lisp_Object buf;
1711 XSETBUFFER (buf, other);
1712 Fkill_buffer (buf);
1715 UNGCPRO;
1717 /* Exit if we now have killed the base buffer (Bug#11665). */
1718 if (!BUFFER_LIVE_P (b))
1719 return Qt;
1722 /* Run replace_buffer_in_windows before making another buffer current
1723 since set-window-buffer-start-and-point will refuse to make another
1724 buffer current if the selected window does not show the current
1725 buffer (bug#10114). */
1726 replace_buffer_in_windows (buffer);
1728 /* Exit if replacing the buffer in windows has killed our buffer. */
1729 if (!BUFFER_LIVE_P (b))
1730 return Qt;
1732 /* Make this buffer not be current. Exit if it is the sole visible
1733 buffer. */
1734 if (b == current_buffer)
1736 tem = Fother_buffer (buffer, Qnil, Qnil);
1737 Fset_buffer (tem);
1738 if (b == current_buffer)
1739 return Qnil;
1742 /* If the buffer now current is shown in the minibuffer and our buffer
1743 is the sole other buffer give up. */
1744 XSETBUFFER (tem, current_buffer);
1745 if (EQ (tem, XWINDOW (minibuf_window)->contents)
1746 && EQ (buffer, Fother_buffer (buffer, Qnil, Qnil)))
1747 return Qnil;
1749 /* Now there is no question: we can kill the buffer. */
1751 /* Unlock this buffer's file, if it is locked. */
1752 unlock_buffer (b);
1754 GCPRO1 (buffer);
1755 kill_buffer_processes (buffer);
1756 UNGCPRO;
1758 /* Killing buffer processes may run sentinels which may have killed
1759 our buffer. */
1760 if (!BUFFER_LIVE_P (b))
1761 return Qt;
1763 /* These may run Lisp code and into infinite loops (if someone
1764 insisted on circular lists) so allow quitting here. */
1765 frames_discard_buffer (buffer);
1767 clear_charpos_cache (b);
1769 tem = Vinhibit_quit;
1770 Vinhibit_quit = Qt;
1771 /* Remove the buffer from the list of all buffers. */
1772 Vbuffer_alist = Fdelq (Frassq (buffer, Vbuffer_alist), Vbuffer_alist);
1773 /* If replace_buffer_in_windows didn't do its job fix that now. */
1774 replace_buffer_in_windows_safely (buffer);
1775 Vinhibit_quit = tem;
1777 /* Delete any auto-save file, if we saved it in this session.
1778 But not if the buffer is modified. */
1779 if (STRINGP (BVAR (b, auto_save_file_name))
1780 && BUF_AUTOSAVE_MODIFF (b) != 0
1781 && BUF_SAVE_MODIFF (b) < BUF_AUTOSAVE_MODIFF (b)
1782 && BUF_SAVE_MODIFF (b) < BUF_MODIFF (b)
1783 && NILP (Fsymbol_value (intern ("auto-save-visited-file-name"))))
1785 Lisp_Object delete;
1786 delete = Fsymbol_value (intern ("delete-auto-save-files"));
1787 if (! NILP (delete))
1788 internal_delete_file (BVAR (b, auto_save_file_name));
1791 /* Deleting an auto-save file could have killed our buffer. */
1792 if (!BUFFER_LIVE_P (b))
1793 return Qt;
1795 if (b->base_buffer)
1797 INTERVAL i;
1798 /* Unchain all markers that belong to this indirect buffer.
1799 Don't unchain the markers that belong to the base buffer
1800 or its other indirect buffers. */
1801 struct Lisp_Marker **mp = &BUF_MARKERS (b);
1802 while ((m = *mp))
1804 if (m->buffer == b)
1806 m->buffer = NULL;
1807 *mp = m->next;
1809 else
1810 mp = &m->next;
1812 /* Intervals should be owned by the base buffer (Bug#16502). */
1813 i = buffer_intervals (b);
1814 if (i)
1816 Lisp_Object owner;
1817 XSETBUFFER (owner, b->base_buffer);
1818 set_interval_object (i, owner);
1821 else
1823 /* Unchain all markers of this buffer and its indirect buffers.
1824 and leave them pointing nowhere. */
1825 for (m = BUF_MARKERS (b); m; )
1827 struct Lisp_Marker *next = m->next;
1828 m->buffer = 0;
1829 m->next = NULL;
1830 m = next;
1832 BUF_MARKERS (b) = NULL;
1833 set_buffer_intervals (b, NULL);
1835 /* Perhaps we should explicitly free the interval tree here... */
1837 /* Since we've unlinked the markers, the overlays can't be here any more
1838 either. */
1839 b->overlays_before = NULL;
1840 b->overlays_after = NULL;
1842 /* Reset the local variables, so that this buffer's local values
1843 won't be protected from GC. They would be protected
1844 if they happened to remain cached in their symbols.
1845 This gets rid of them for certain. */
1846 swap_out_buffer_local_variables (b);
1847 reset_buffer_local_variables (b, 1);
1849 bset_name (b, Qnil);
1851 block_input ();
1852 if (b->base_buffer)
1854 /* Notify our base buffer that we don't share the text anymore. */
1855 eassert (b->indirections == -1);
1856 b->base_buffer->indirections--;
1857 eassert (b->base_buffer->indirections >= 0);
1858 /* Make sure that we wasn't confused. */
1859 eassert (b->window_count == -1);
1861 else
1863 /* Make sure that no one shows us. */
1864 eassert (b->window_count == 0);
1865 /* No one shares our buffer text, can free it. */
1866 free_buffer_text (b);
1869 if (b->newline_cache)
1871 free_region_cache (b->newline_cache);
1872 b->newline_cache = 0;
1874 if (b->width_run_cache)
1876 free_region_cache (b->width_run_cache);
1877 b->width_run_cache = 0;
1879 if (b->bidi_paragraph_cache)
1881 free_region_cache (b->bidi_paragraph_cache);
1882 b->bidi_paragraph_cache = 0;
1884 bset_width_table (b, Qnil);
1885 unblock_input ();
1886 bset_undo_list (b, Qnil);
1888 /* Run buffer-list-update-hook. */
1889 if (!NILP (Vrun_hooks))
1890 call1 (Vrun_hooks, Qbuffer_list_update_hook);
1892 return Qt;
1895 /* Move association for BUFFER to the front of buffer (a)lists. Since
1896 we do this each time BUFFER is selected visibly, the more recently
1897 selected buffers are always closer to the front of those lists. This
1898 means that other_buffer is more likely to choose a relevant buffer.
1900 Note that this moves BUFFER to the front of the buffer lists of the
1901 selected frame even if BUFFER is not shown there. If BUFFER is not
1902 shown in the selected frame, consider the present behavior a feature.
1903 `select-window' gets this right since it shows BUFFER in the selected
1904 window when calling us. */
1906 void
1907 record_buffer (Lisp_Object buffer)
1909 Lisp_Object aelt, aelt_cons, tem;
1910 register struct frame *f = XFRAME (selected_frame);
1912 CHECK_BUFFER (buffer);
1914 /* Update Vbuffer_alist (we know that it has an entry for BUFFER).
1915 Don't allow quitting since this might leave the buffer list in an
1916 inconsistent state. */
1917 tem = Vinhibit_quit;
1918 Vinhibit_quit = Qt;
1919 aelt = Frassq (buffer, Vbuffer_alist);
1920 aelt_cons = Fmemq (aelt, Vbuffer_alist);
1921 Vbuffer_alist = Fdelq (aelt, Vbuffer_alist);
1922 XSETCDR (aelt_cons, Vbuffer_alist);
1923 Vbuffer_alist = aelt_cons;
1924 Vinhibit_quit = tem;
1926 /* Update buffer list of selected frame. */
1927 fset_buffer_list (f, Fcons (buffer, Fdelq (buffer, f->buffer_list)));
1928 fset_buried_buffer_list (f, Fdelq (buffer, f->buried_buffer_list));
1930 /* Run buffer-list-update-hook. */
1931 if (!NILP (Vrun_hooks))
1932 call1 (Vrun_hooks, Qbuffer_list_update_hook);
1936 /* Move BUFFER to the end of the buffer (a)lists. Do nothing if the
1937 buffer is killed. For the selected frame's buffer list this moves
1938 BUFFER to its end even if it was never shown in that frame. If
1939 this happens we have a feature, hence `bury-buffer-internal' should be
1940 called only when BUFFER was shown in the selected frame. */
1942 DEFUN ("bury-buffer-internal", Fbury_buffer_internal, Sbury_buffer_internal,
1943 1, 1, 0,
1944 doc: /* Move BUFFER to the end of the buffer list. */)
1945 (Lisp_Object buffer)
1947 Lisp_Object aelt, aelt_cons, tem;
1948 register struct frame *f = XFRAME (selected_frame);
1950 CHECK_BUFFER (buffer);
1952 /* Update Vbuffer_alist (we know that it has an entry for BUFFER).
1953 Don't allow quitting since this might leave the buffer list in an
1954 inconsistent state. */
1955 tem = Vinhibit_quit;
1956 Vinhibit_quit = Qt;
1957 aelt = Frassq (buffer, Vbuffer_alist);
1958 aelt_cons = Fmemq (aelt, Vbuffer_alist);
1959 Vbuffer_alist = Fdelq (aelt, Vbuffer_alist);
1960 XSETCDR (aelt_cons, Qnil);
1961 Vbuffer_alist = nconc2 (Vbuffer_alist, aelt_cons);
1962 Vinhibit_quit = tem;
1964 /* Update buffer lists of selected frame. */
1965 fset_buffer_list (f, Fdelq (buffer, f->buffer_list));
1966 fset_buried_buffer_list
1967 (f, Fcons (buffer, Fdelq (buffer, f->buried_buffer_list)));
1969 /* Run buffer-list-update-hook. */
1970 if (!NILP (Vrun_hooks))
1971 call1 (Vrun_hooks, Qbuffer_list_update_hook);
1973 return Qnil;
1976 DEFUN ("set-buffer-major-mode", Fset_buffer_major_mode, Sset_buffer_major_mode, 1, 1, 0,
1977 doc: /* Set an appropriate major mode for BUFFER.
1978 For the *scratch* buffer, use `initial-major-mode', otherwise choose a mode
1979 according to the default value of `major-mode'.
1980 Use this function before selecting the buffer, since it may need to inspect
1981 the current buffer's major mode. */)
1982 (Lisp_Object buffer)
1984 ptrdiff_t count;
1985 Lisp_Object function;
1987 CHECK_BUFFER (buffer);
1989 if (!BUFFER_LIVE_P (XBUFFER (buffer)))
1990 error ("Attempt to set major mode for a dead buffer");
1992 if (strcmp (SSDATA (BVAR (XBUFFER (buffer), name)), "*scratch*") == 0)
1993 function = find_symbol_value (intern ("initial-major-mode"));
1994 else
1996 function = BVAR (&buffer_defaults, major_mode);
1997 if (NILP (function)
1998 && NILP (Fget (BVAR (current_buffer, major_mode), Qmode_class)))
1999 function = BVAR (current_buffer, major_mode);
2002 if (NILP (function) || EQ (function, Qfundamental_mode))
2003 return Qnil;
2005 count = SPECPDL_INDEX ();
2007 /* To select a nonfundamental mode,
2008 select the buffer temporarily and then call the mode function. */
2010 record_unwind_protect (save_excursion_restore, save_excursion_save ());
2012 Fset_buffer (buffer);
2013 call0 (function);
2015 return unbind_to (count, Qnil);
2018 DEFUN ("current-buffer", Fcurrent_buffer, Scurrent_buffer, 0, 0, 0,
2019 doc: /* Return the current buffer as a Lisp object. */)
2020 (void)
2022 register Lisp_Object buf;
2023 XSETBUFFER (buf, current_buffer);
2024 return buf;
2027 /* Set the current buffer to B, and do not set windows_or_buffers_changed.
2028 This is used by redisplay. */
2030 void
2031 set_buffer_internal_1 (register struct buffer *b)
2033 register struct buffer *old_buf;
2034 register Lisp_Object tail;
2036 #ifdef USE_MMAP_FOR_BUFFERS
2037 if (b->text->beg == NULL)
2038 enlarge_buffer_text (b, 0);
2039 #endif /* USE_MMAP_FOR_BUFFERS */
2041 if (current_buffer == b)
2042 return;
2044 BUFFER_CHECK_INDIRECTION (b);
2046 old_buf = current_buffer;
2047 current_buffer = b;
2048 last_known_column_point = -1; /* Invalidate indentation cache. */
2050 if (old_buf)
2052 /* Put the undo list back in the base buffer, so that it appears
2053 that an indirect buffer shares the undo list of its base. */
2054 if (old_buf->base_buffer)
2055 bset_undo_list (old_buf->base_buffer, BVAR (old_buf, undo_list));
2057 /* If the old current buffer has markers to record PT, BEGV and ZV
2058 when it is not current, update them now. */
2059 record_buffer_markers (old_buf);
2062 /* Get the undo list from the base buffer, so that it appears
2063 that an indirect buffer shares the undo list of its base. */
2064 if (b->base_buffer)
2065 bset_undo_list (b, BVAR (b->base_buffer, undo_list));
2067 /* If the new current buffer has markers to record PT, BEGV and ZV
2068 when it is not current, fetch them now. */
2069 fetch_buffer_markers (b);
2071 /* Look down buffer's list of local Lisp variables
2072 to find and update any that forward into C variables. */
2076 for (tail = BVAR (b, local_var_alist); CONSP (tail); tail = XCDR (tail))
2078 Lisp_Object var = XCAR (XCAR (tail));
2079 struct Lisp_Symbol *sym = XSYMBOL (var);
2080 if (sym->redirect == SYMBOL_LOCALIZED /* Just to be sure. */
2081 && SYMBOL_BLV (sym)->fwd)
2082 /* Just reference the variable
2083 to cause it to become set for this buffer. */
2084 Fsymbol_value (var);
2087 /* Do the same with any others that were local to the previous buffer */
2088 while (b != old_buf && (b = old_buf, b));
2091 /* Switch to buffer B temporarily for redisplay purposes.
2092 This avoids certain things that don't need to be done within redisplay. */
2094 void
2095 set_buffer_temp (struct buffer *b)
2097 register struct buffer *old_buf;
2099 if (current_buffer == b)
2100 return;
2102 old_buf = current_buffer;
2103 current_buffer = b;
2105 /* If the old current buffer has markers to record PT, BEGV and ZV
2106 when it is not current, update them now. */
2107 record_buffer_markers (old_buf);
2109 /* If the new current buffer has markers to record PT, BEGV and ZV
2110 when it is not current, fetch them now. */
2111 fetch_buffer_markers (b);
2114 DEFUN ("set-buffer", Fset_buffer, Sset_buffer, 1, 1, 0,
2115 doc: /* Make buffer BUFFER-OR-NAME current for editing operations.
2116 BUFFER-OR-NAME may be a buffer or the name of an existing buffer.
2117 See also `with-current-buffer' when you want to make a buffer current
2118 temporarily. This function does not display the buffer, so its effect
2119 ends when the current command terminates. Use `switch-to-buffer' or
2120 `pop-to-buffer' to switch buffers permanently.
2121 The return value is the buffer made current. */)
2122 (register Lisp_Object buffer_or_name)
2124 register Lisp_Object buffer;
2125 buffer = Fget_buffer (buffer_or_name);
2126 if (NILP (buffer))
2127 nsberror (buffer_or_name);
2128 if (!BUFFER_LIVE_P (XBUFFER (buffer)))
2129 error ("Selecting deleted buffer");
2130 set_buffer_internal (XBUFFER (buffer));
2131 return buffer;
2134 void
2135 restore_buffer (Lisp_Object buffer_or_name)
2137 Fset_buffer (buffer_or_name);
2140 /* Set the current buffer to BUFFER provided if it is alive. */
2142 void
2143 set_buffer_if_live (Lisp_Object buffer)
2145 if (BUFFER_LIVE_P (XBUFFER (buffer)))
2146 set_buffer_internal (XBUFFER (buffer));
2149 DEFUN ("barf-if-buffer-read-only", Fbarf_if_buffer_read_only,
2150 Sbarf_if_buffer_read_only, 0, 1, 0,
2151 doc: /* Signal a `buffer-read-only' error if the current buffer is read-only.
2152 If the text under POSITION (which defaults to point) has the
2153 `inhibit-read-only' text property set, the error will not be raised. */)
2154 (Lisp_Object pos)
2156 if (NILP (pos))
2157 XSETFASTINT (pos, PT);
2158 else
2159 CHECK_NUMBER (pos);
2161 if (!NILP (BVAR (current_buffer, read_only))
2162 && NILP (Vinhibit_read_only)
2163 && NILP (Fget_text_property (pos, Qinhibit_read_only, Qnil)))
2164 xsignal1 (Qbuffer_read_only, Fcurrent_buffer ());
2165 return Qnil;
2168 DEFUN ("erase-buffer", Ferase_buffer, Serase_buffer, 0, 0, "*",
2169 doc: /* Delete the entire contents of the current buffer.
2170 Any narrowing restriction in effect (see `narrow-to-region') is removed,
2171 so the buffer is truly empty after this. */)
2172 (void)
2174 Fwiden ();
2176 del_range (BEG, Z);
2178 current_buffer->last_window_start = 1;
2179 /* Prevent warnings, or suspension of auto saving, that would happen
2180 if future size is less than past size. Use of erase-buffer
2181 implies that the future text is not really related to the past text. */
2182 XSETFASTINT (BVAR (current_buffer, save_length), 0);
2183 return Qnil;
2186 void
2187 validate_region (register Lisp_Object *b, register Lisp_Object *e)
2189 CHECK_NUMBER_COERCE_MARKER (*b);
2190 CHECK_NUMBER_COERCE_MARKER (*e);
2192 if (XINT (*b) > XINT (*e))
2194 Lisp_Object tem;
2195 tem = *b; *b = *e; *e = tem;
2198 if (! (BEGV <= XINT (*b) && XINT (*e) <= ZV))
2199 args_out_of_range_3 (Fcurrent_buffer (), *b, *e);
2202 /* Advance BYTE_POS up to a character boundary
2203 and return the adjusted position. */
2205 static ptrdiff_t
2206 advance_to_char_boundary (ptrdiff_t byte_pos)
2208 int c;
2210 if (byte_pos == BEG)
2211 /* Beginning of buffer is always a character boundary. */
2212 return BEG;
2214 c = FETCH_BYTE (byte_pos);
2215 if (! CHAR_HEAD_P (c))
2217 /* We should advance BYTE_POS only when C is a constituent of a
2218 multibyte sequence. */
2219 ptrdiff_t orig_byte_pos = byte_pos;
2223 byte_pos--;
2224 c = FETCH_BYTE (byte_pos);
2226 while (! CHAR_HEAD_P (c) && byte_pos > BEG);
2227 INC_POS (byte_pos);
2228 if (byte_pos < orig_byte_pos)
2229 byte_pos = orig_byte_pos;
2230 /* If C is a constituent of a multibyte sequence, BYTE_POS was
2231 surely advance to the correct character boundary. If C is
2232 not, BYTE_POS was unchanged. */
2235 return byte_pos;
2238 DEFUN ("buffer-swap-text", Fbuffer_swap_text, Sbuffer_swap_text,
2239 1, 1, 0,
2240 doc: /* Swap the text between current buffer and BUFFER. */)
2241 (Lisp_Object buffer)
2243 struct buffer *other_buffer;
2244 CHECK_BUFFER (buffer);
2245 other_buffer = XBUFFER (buffer);
2247 if (!BUFFER_LIVE_P (other_buffer))
2248 error ("Cannot swap a dead buffer's text");
2250 /* Actually, it probably works just fine.
2251 * if (other_buffer == current_buffer)
2252 * error ("Cannot swap a buffer's text with itself"); */
2254 /* Actually, this may be workable as well, tho probably only if they're
2255 *both* indirect. */
2256 if (other_buffer->base_buffer
2257 || current_buffer->base_buffer)
2258 error ("Cannot swap indirect buffers's text");
2260 { /* This is probably harder to make work. */
2261 struct buffer *other;
2262 FOR_EACH_BUFFER (other)
2263 if (other->base_buffer == other_buffer
2264 || other->base_buffer == current_buffer)
2265 error ("One of the buffers to swap has indirect buffers");
2268 #define swapfield(field, type) \
2269 do { \
2270 type tmp##field = other_buffer->field; \
2271 other_buffer->field = current_buffer->field; \
2272 current_buffer->field = tmp##field; \
2273 } while (0)
2274 #define swapfield_(field, type) \
2275 do { \
2276 type tmp##field = BVAR (other_buffer, field); \
2277 bset_##field (other_buffer, BVAR (current_buffer, field)); \
2278 bset_##field (current_buffer, tmp##field); \
2279 } while (0)
2281 swapfield (own_text, struct buffer_text);
2282 eassert (current_buffer->text == &current_buffer->own_text);
2283 eassert (other_buffer->text == &other_buffer->own_text);
2284 #ifdef REL_ALLOC
2285 r_alloc_reset_variable ((void **) &current_buffer->own_text.beg,
2286 (void **) &other_buffer->own_text.beg);
2287 r_alloc_reset_variable ((void **) &other_buffer->own_text.beg,
2288 (void **) &current_buffer->own_text.beg);
2289 #endif /* REL_ALLOC */
2291 swapfield (pt, ptrdiff_t);
2292 swapfield (pt_byte, ptrdiff_t);
2293 swapfield (begv, ptrdiff_t);
2294 swapfield (begv_byte, ptrdiff_t);
2295 swapfield (zv, ptrdiff_t);
2296 swapfield (zv_byte, ptrdiff_t);
2297 eassert (!current_buffer->base_buffer);
2298 eassert (!other_buffer->base_buffer);
2299 swapfield (indirections, ptrdiff_t);
2300 current_buffer->clip_changed = 1; other_buffer->clip_changed = 1;
2301 swapfield (newline_cache, struct region_cache *);
2302 swapfield (width_run_cache, struct region_cache *);
2303 swapfield (bidi_paragraph_cache, struct region_cache *);
2304 current_buffer->prevent_redisplay_optimizations_p = 1;
2305 other_buffer->prevent_redisplay_optimizations_p = 1;
2306 swapfield (overlays_before, struct Lisp_Overlay *);
2307 swapfield (overlays_after, struct Lisp_Overlay *);
2308 swapfield (overlay_center, ptrdiff_t);
2309 swapfield_ (undo_list, Lisp_Object);
2310 swapfield_ (mark, Lisp_Object);
2311 swapfield_ (enable_multibyte_characters, Lisp_Object);
2312 swapfield_ (bidi_display_reordering, Lisp_Object);
2313 swapfield_ (bidi_paragraph_direction, Lisp_Object);
2314 /* FIXME: Not sure what we should do with these *_marker fields.
2315 Hopefully they're just nil anyway. */
2316 swapfield_ (pt_marker, Lisp_Object);
2317 swapfield_ (begv_marker, Lisp_Object);
2318 swapfield_ (zv_marker, Lisp_Object);
2319 bset_point_before_scroll (current_buffer, Qnil);
2320 bset_point_before_scroll (other_buffer, Qnil);
2322 current_buffer->text->modiff++; other_buffer->text->modiff++;
2323 current_buffer->text->chars_modiff++; other_buffer->text->chars_modiff++;
2324 current_buffer->text->overlay_modiff++; other_buffer->text->overlay_modiff++;
2325 current_buffer->text->beg_unchanged = current_buffer->text->gpt;
2326 current_buffer->text->end_unchanged = current_buffer->text->gpt;
2327 other_buffer->text->beg_unchanged = other_buffer->text->gpt;
2328 other_buffer->text->end_unchanged = other_buffer->text->gpt;
2330 struct Lisp_Marker *m;
2331 for (m = BUF_MARKERS (current_buffer); m; m = m->next)
2332 if (m->buffer == other_buffer)
2333 m->buffer = current_buffer;
2334 else
2335 /* Since there's no indirect buffer in sight, markers on
2336 BUF_MARKERS(buf) should either be for `buf' or dead. */
2337 eassert (!m->buffer);
2338 for (m = BUF_MARKERS (other_buffer); m; m = m->next)
2339 if (m->buffer == current_buffer)
2340 m->buffer = other_buffer;
2341 else
2342 /* Since there's no indirect buffer in sight, markers on
2343 BUF_MARKERS(buf) should either be for `buf' or dead. */
2344 eassert (!m->buffer);
2346 { /* Some of the C code expects that both window markers of a
2347 live window points to that window's buffer. So since we
2348 just swapped the markers between the two buffers, we need
2349 to undo the effect of this swap for window markers. */
2350 Lisp_Object w = selected_window, ws = Qnil;
2351 Lisp_Object buf1, buf2;
2352 XSETBUFFER (buf1, current_buffer); XSETBUFFER (buf2, other_buffer);
2354 while (NILP (Fmemq (w, ws)))
2356 ws = Fcons (w, ws);
2357 if (MARKERP (XWINDOW (w)->pointm)
2358 && (EQ (XWINDOW (w)->contents, buf1)
2359 || EQ (XWINDOW (w)->contents, buf2)))
2360 Fset_marker (XWINDOW (w)->pointm,
2361 make_number
2362 (BUF_BEGV (XBUFFER (XWINDOW (w)->contents))),
2363 XWINDOW (w)->contents);
2364 /* Blindly copied from pointm part. */
2365 if (MARKERP (XWINDOW (w)->old_pointm)
2366 && (EQ (XWINDOW (w)->contents, buf1)
2367 || EQ (XWINDOW (w)->contents, buf2)))
2368 Fset_marker (XWINDOW (w)->old_pointm,
2369 make_number
2370 (BUF_BEGV (XBUFFER (XWINDOW (w)->contents))),
2371 XWINDOW (w)->contents);
2372 if (MARKERP (XWINDOW (w)->start)
2373 && (EQ (XWINDOW (w)->contents, buf1)
2374 || EQ (XWINDOW (w)->contents, buf2)))
2375 Fset_marker (XWINDOW (w)->start,
2376 make_number
2377 (XBUFFER (XWINDOW (w)->contents)->last_window_start),
2378 XWINDOW (w)->contents);
2379 w = Fnext_window (w, Qt, Qt);
2383 if (current_buffer->text->intervals)
2384 (eassert (EQ (current_buffer->text->intervals->up.obj, buffer)),
2385 XSETBUFFER (current_buffer->text->intervals->up.obj, current_buffer));
2386 if (other_buffer->text->intervals)
2387 (eassert (EQ (other_buffer->text->intervals->up.obj, Fcurrent_buffer ())),
2388 XSETBUFFER (other_buffer->text->intervals->up.obj, other_buffer));
2390 return Qnil;
2393 DEFUN ("set-buffer-multibyte", Fset_buffer_multibyte, Sset_buffer_multibyte,
2394 1, 1, 0,
2395 doc: /* Set the multibyte flag of the current buffer to FLAG.
2396 If FLAG is t, this makes the buffer a multibyte buffer.
2397 If FLAG is nil, this makes the buffer a single-byte buffer.
2398 In these cases, the buffer contents remain unchanged as a sequence of
2399 bytes but the contents viewed as characters do change.
2400 If FLAG is `to', this makes the buffer a multibyte buffer by changing
2401 all eight-bit bytes to eight-bit characters.
2402 If the multibyte flag was really changed, undo information of the
2403 current buffer is cleared. */)
2404 (Lisp_Object flag)
2406 struct Lisp_Marker *tail, *markers;
2407 struct buffer *other;
2408 ptrdiff_t begv, zv;
2409 bool narrowed = (BEG != BEGV || Z != ZV);
2410 bool modified_p = !NILP (Fbuffer_modified_p (Qnil));
2411 Lisp_Object old_undo = BVAR (current_buffer, undo_list);
2412 struct gcpro gcpro1;
2414 if (current_buffer->base_buffer)
2415 error ("Cannot do `set-buffer-multibyte' on an indirect buffer");
2417 /* Do nothing if nothing actually changes. */
2418 if (NILP (flag) == NILP (BVAR (current_buffer, enable_multibyte_characters)))
2419 return flag;
2421 GCPRO1 (old_undo);
2423 /* Don't record these buffer changes. We will put a special undo entry
2424 instead. */
2425 bset_undo_list (current_buffer, Qt);
2427 /* If the cached position is for this buffer, clear it out. */
2428 clear_charpos_cache (current_buffer);
2430 if (NILP (flag))
2431 begv = BEGV_BYTE, zv = ZV_BYTE;
2432 else
2433 begv = BEGV, zv = ZV;
2435 if (narrowed)
2436 error ("Changing multibyteness in a narrowed buffer");
2438 invalidate_buffer_caches (current_buffer, BEGV, ZV);
2440 if (NILP (flag))
2442 ptrdiff_t pos, stop;
2443 unsigned char *p;
2445 /* Do this first, so it can use CHAR_TO_BYTE
2446 to calculate the old correspondences. */
2447 set_intervals_multibyte (0);
2449 bset_enable_multibyte_characters (current_buffer, Qnil);
2451 Z = Z_BYTE;
2452 BEGV = BEGV_BYTE;
2453 ZV = ZV_BYTE;
2454 GPT = GPT_BYTE;
2455 TEMP_SET_PT_BOTH (PT_BYTE, PT_BYTE);
2458 for (tail = BUF_MARKERS (current_buffer); tail; tail = tail->next)
2459 tail->charpos = tail->bytepos;
2461 /* Convert multibyte form of 8-bit characters to unibyte. */
2462 pos = BEG;
2463 stop = GPT;
2464 p = BEG_ADDR;
2465 while (1)
2467 int c, bytes;
2469 if (pos == stop)
2471 if (pos == Z)
2472 break;
2473 p = GAP_END_ADDR;
2474 stop = Z;
2476 if (ASCII_CHAR_P (*p))
2477 p++, pos++;
2478 else if (CHAR_BYTE8_HEAD_P (*p))
2480 c = STRING_CHAR_AND_LENGTH (p, bytes);
2481 /* Delete all bytes for this 8-bit character but the
2482 last one, and change the last one to the character
2483 code. */
2484 bytes--;
2485 del_range_2 (pos, pos, pos + bytes, pos + bytes, 0);
2486 p = GAP_END_ADDR;
2487 *p++ = c;
2488 pos++;
2489 if (begv > pos)
2490 begv -= bytes;
2491 if (zv > pos)
2492 zv -= bytes;
2493 stop = Z;
2495 else
2497 bytes = BYTES_BY_CHAR_HEAD (*p);
2498 p += bytes, pos += bytes;
2501 if (narrowed)
2502 Fnarrow_to_region (make_number (begv), make_number (zv));
2504 else
2506 ptrdiff_t pt = PT;
2507 ptrdiff_t pos, stop;
2508 unsigned char *p, *pend;
2510 /* Be sure not to have a multibyte sequence striding over the GAP.
2511 Ex: We change this: "...abc\302 _GAP_ \241def..."
2512 to: "...abc _GAP_ \302\241def..." */
2514 if (EQ (flag, Qt)
2515 && GPT_BYTE > 1 && GPT_BYTE < Z_BYTE
2516 && ! CHAR_HEAD_P (*(GAP_END_ADDR)))
2518 unsigned char *q = GPT_ADDR - 1;
2520 while (! CHAR_HEAD_P (*q) && q > BEG_ADDR) q--;
2521 if (LEADING_CODE_P (*q))
2523 ptrdiff_t new_gpt = GPT_BYTE - (GPT_ADDR - q);
2525 move_gap_both (new_gpt, new_gpt);
2529 /* Make the buffer contents valid as multibyte by converting
2530 8-bit characters to multibyte form. */
2531 pos = BEG;
2532 stop = GPT;
2533 p = BEG_ADDR;
2534 pend = GPT_ADDR;
2535 while (1)
2537 int bytes;
2539 if (pos == stop)
2541 if (pos == Z)
2542 break;
2543 p = GAP_END_ADDR;
2544 pend = Z_ADDR;
2545 stop = Z;
2548 if (ASCII_CHAR_P (*p))
2549 p++, pos++;
2550 else if (EQ (flag, Qt)
2551 && ! CHAR_BYTE8_HEAD_P (*p)
2552 && (bytes = MULTIBYTE_LENGTH (p, pend)) > 0)
2553 p += bytes, pos += bytes;
2554 else
2556 unsigned char tmp[MAX_MULTIBYTE_LENGTH];
2557 int c;
2559 c = BYTE8_TO_CHAR (*p);
2560 bytes = CHAR_STRING (c, tmp);
2561 *p = tmp[0];
2562 TEMP_SET_PT_BOTH (pos + 1, pos + 1);
2563 bytes--;
2564 insert_1_both ((char *) tmp + 1, bytes, bytes, 1, 0, 0);
2565 /* Now the gap is after the just inserted data. */
2566 pos = GPT;
2567 p = GAP_END_ADDR;
2568 if (pos <= begv)
2569 begv += bytes;
2570 if (pos <= zv)
2571 zv += bytes;
2572 if (pos <= pt)
2573 pt += bytes;
2574 pend = Z_ADDR;
2575 stop = Z;
2579 if (pt != PT)
2580 TEMP_SET_PT (pt);
2582 if (narrowed)
2583 Fnarrow_to_region (make_number (begv), make_number (zv));
2585 /* Do this first, so that chars_in_text asks the right question.
2586 set_intervals_multibyte needs it too. */
2587 bset_enable_multibyte_characters (current_buffer, Qt);
2589 GPT_BYTE = advance_to_char_boundary (GPT_BYTE);
2590 GPT = chars_in_text (BEG_ADDR, GPT_BYTE - BEG_BYTE) + BEG;
2592 Z = chars_in_text (GAP_END_ADDR, Z_BYTE - GPT_BYTE) + GPT;
2594 BEGV_BYTE = advance_to_char_boundary (BEGV_BYTE);
2595 if (BEGV_BYTE > GPT_BYTE)
2596 BEGV = chars_in_text (GAP_END_ADDR, BEGV_BYTE - GPT_BYTE) + GPT;
2597 else
2598 BEGV = chars_in_text (BEG_ADDR, BEGV_BYTE - BEG_BYTE) + BEG;
2600 ZV_BYTE = advance_to_char_boundary (ZV_BYTE);
2601 if (ZV_BYTE > GPT_BYTE)
2602 ZV = chars_in_text (GAP_END_ADDR, ZV_BYTE - GPT_BYTE) + GPT;
2603 else
2604 ZV = chars_in_text (BEG_ADDR, ZV_BYTE - BEG_BYTE) + BEG;
2607 ptrdiff_t byte = advance_to_char_boundary (PT_BYTE);
2608 ptrdiff_t position;
2610 if (byte > GPT_BYTE)
2611 position = chars_in_text (GAP_END_ADDR, byte - GPT_BYTE) + GPT;
2612 else
2613 position = chars_in_text (BEG_ADDR, byte - BEG_BYTE) + BEG;
2614 TEMP_SET_PT_BOTH (position, byte);
2617 tail = markers = BUF_MARKERS (current_buffer);
2619 /* This prevents BYTE_TO_CHAR (that is, buf_bytepos_to_charpos) from
2620 getting confused by the markers that have not yet been updated.
2621 It is also a signal that it should never create a marker. */
2622 BUF_MARKERS (current_buffer) = NULL;
2624 for (; tail; tail = tail->next)
2626 tail->bytepos = advance_to_char_boundary (tail->bytepos);
2627 tail->charpos = BYTE_TO_CHAR (tail->bytepos);
2630 /* Make sure no markers were put on the chain
2631 while the chain value was incorrect. */
2632 if (BUF_MARKERS (current_buffer))
2633 emacs_abort ();
2635 BUF_MARKERS (current_buffer) = markers;
2637 /* Do this last, so it can calculate the new correspondences
2638 between chars and bytes. */
2639 set_intervals_multibyte (1);
2642 if (!EQ (old_undo, Qt))
2644 /* Represent all the above changes by a special undo entry. */
2645 bset_undo_list (current_buffer,
2646 Fcons (list3 (Qapply,
2647 intern ("set-buffer-multibyte"),
2648 NILP (flag) ? Qt : Qnil),
2649 old_undo));
2652 UNGCPRO;
2654 current_buffer->prevent_redisplay_optimizations_p = 1;
2656 /* If buffer is shown in a window, let redisplay consider other windows. */
2657 if (buffer_window_count (current_buffer))
2658 windows_or_buffers_changed = 10;
2660 /* Copy this buffer's new multibyte status
2661 into all of its indirect buffers. */
2662 FOR_EACH_BUFFER (other)
2663 if (other->base_buffer == current_buffer && BUFFER_LIVE_P (other))
2665 BVAR (other, enable_multibyte_characters)
2666 = BVAR (current_buffer, enable_multibyte_characters);
2667 other->prevent_redisplay_optimizations_p = 1;
2670 /* Restore the modifiedness of the buffer. */
2671 if (!modified_p && !NILP (Fbuffer_modified_p (Qnil)))
2672 Fset_buffer_modified_p (Qnil);
2674 /* Update coding systems of this buffer's process (if any). */
2676 Lisp_Object process;
2678 process = Fget_buffer_process (Fcurrent_buffer ());
2679 if (PROCESSP (process))
2680 setup_process_coding_systems (process);
2683 return flag;
2686 DEFUN ("kill-all-local-variables", Fkill_all_local_variables,
2687 Skill_all_local_variables, 0, 0, 0,
2688 doc: /* Switch to Fundamental mode by killing current buffer's local variables.
2689 Most local variable bindings are eliminated so that the default values
2690 become effective once more. Also, the syntax table is set from
2691 `standard-syntax-table', the local keymap is set to nil,
2692 and the abbrev table from `fundamental-mode-abbrev-table'.
2693 This function also forces redisplay of the mode line.
2695 Every function to select a new major mode starts by
2696 calling this function.
2698 As a special exception, local variables whose names have
2699 a non-nil `permanent-local' property are not eliminated by this function.
2701 The first thing this function does is run
2702 the normal hook `change-major-mode-hook'. */)
2703 (void)
2705 run_hook (Qchange_major_mode_hook);
2707 /* Make sure none of the bindings in local_var_alist
2708 remain swapped in, in their symbols. */
2710 swap_out_buffer_local_variables (current_buffer);
2712 /* Actually eliminate all local bindings of this buffer. */
2714 reset_buffer_local_variables (current_buffer, 0);
2716 /* Force mode-line redisplay. Useful here because all major mode
2717 commands call this function. */
2718 update_mode_lines = 12;
2720 return Qnil;
2723 /* Make sure no local variables remain set up with buffer B
2724 for their current values. */
2726 static void
2727 swap_out_buffer_local_variables (struct buffer *b)
2729 Lisp_Object oalist, alist, buffer;
2731 XSETBUFFER (buffer, b);
2732 oalist = BVAR (b, local_var_alist);
2734 for (alist = oalist; CONSP (alist); alist = XCDR (alist))
2736 Lisp_Object sym = XCAR (XCAR (alist));
2737 eassert (XSYMBOL (sym)->redirect == SYMBOL_LOCALIZED);
2738 /* Need not do anything if some other buffer's binding is
2739 now cached. */
2740 if (EQ (SYMBOL_BLV (XSYMBOL (sym))->where, buffer))
2742 /* Symbol is set up for this buffer's old local value:
2743 swap it out! */
2744 swap_in_global_binding (XSYMBOL (sym));
2749 /* Find all the overlays in the current buffer that contain position POS.
2750 Return the number found, and store them in a vector in *VEC_PTR.
2751 Store in *LEN_PTR the size allocated for the vector.
2752 Store in *NEXT_PTR the next position after POS where an overlay starts,
2753 or ZV if there are no more overlays between POS and ZV.
2754 Store in *PREV_PTR the previous position before POS where an overlay ends,
2755 or where an overlay starts which ends at or after POS;
2756 or BEGV if there are no such overlays from BEGV to POS.
2757 NEXT_PTR and/or PREV_PTR may be 0, meaning don't store that info.
2759 *VEC_PTR and *LEN_PTR should contain a valid vector and size
2760 when this function is called.
2762 If EXTEND, make the vector bigger if necessary.
2763 If not, never extend the vector,
2764 and store only as many overlays as will fit.
2765 But still return the total number of overlays.
2767 If CHANGE_REQ, any position written into *PREV_PTR or
2768 *NEXT_PTR is guaranteed to be not equal to POS, unless it is the
2769 default (BEGV or ZV). */
2771 ptrdiff_t
2772 overlays_at (EMACS_INT pos, bool extend, Lisp_Object **vec_ptr,
2773 ptrdiff_t *len_ptr,
2774 ptrdiff_t *next_ptr, ptrdiff_t *prev_ptr, bool change_req)
2776 Lisp_Object overlay, start, end;
2777 struct Lisp_Overlay *tail;
2778 ptrdiff_t idx = 0;
2779 ptrdiff_t len = *len_ptr;
2780 Lisp_Object *vec = *vec_ptr;
2781 ptrdiff_t next = ZV;
2782 ptrdiff_t prev = BEGV;
2783 bool inhibit_storing = 0;
2785 for (tail = current_buffer->overlays_before; tail; tail = tail->next)
2787 ptrdiff_t startpos, endpos;
2789 XSETMISC (overlay, tail);
2791 start = OVERLAY_START (overlay);
2792 end = OVERLAY_END (overlay);
2793 endpos = OVERLAY_POSITION (end);
2794 if (endpos < pos)
2796 if (prev < endpos)
2797 prev = endpos;
2798 break;
2800 startpos = OVERLAY_POSITION (start);
2801 /* This one ends at or after POS
2802 so its start counts for PREV_PTR if it's before POS. */
2803 if (prev < startpos && startpos < pos)
2804 prev = startpos;
2805 if (endpos == pos)
2806 continue;
2807 if (startpos <= pos)
2809 if (idx == len)
2811 /* The supplied vector is full.
2812 Either make it bigger, or don't store any more in it. */
2813 if (extend)
2815 vec = xpalloc (vec, len_ptr, 1, OVERLAY_COUNT_MAX,
2816 sizeof *vec);
2817 *vec_ptr = vec;
2818 len = *len_ptr;
2820 else
2821 inhibit_storing = 1;
2824 if (!inhibit_storing)
2825 vec[idx] = overlay;
2826 /* Keep counting overlays even if we can't return them all. */
2827 idx++;
2829 else if (startpos < next)
2830 next = startpos;
2833 for (tail = current_buffer->overlays_after; tail; tail = tail->next)
2835 ptrdiff_t startpos, endpos;
2837 XSETMISC (overlay, tail);
2839 start = OVERLAY_START (overlay);
2840 end = OVERLAY_END (overlay);
2841 startpos = OVERLAY_POSITION (start);
2842 if (pos < startpos)
2844 if (startpos < next)
2845 next = startpos;
2846 break;
2848 endpos = OVERLAY_POSITION (end);
2849 if (pos < endpos)
2851 if (idx == len)
2853 if (extend)
2855 vec = xpalloc (vec, len_ptr, 1, OVERLAY_COUNT_MAX,
2856 sizeof *vec);
2857 *vec_ptr = vec;
2858 len = *len_ptr;
2860 else
2861 inhibit_storing = 1;
2864 if (!inhibit_storing)
2865 vec[idx] = overlay;
2866 idx++;
2868 if (startpos < pos && startpos > prev)
2869 prev = startpos;
2871 else if (endpos < pos && endpos > prev)
2872 prev = endpos;
2873 else if (endpos == pos && startpos > prev
2874 && (!change_req || startpos < pos))
2875 prev = startpos;
2878 if (next_ptr)
2879 *next_ptr = next;
2880 if (prev_ptr)
2881 *prev_ptr = prev;
2882 return idx;
2885 /* Find all the overlays in the current buffer that overlap the range
2886 BEG-END, or are empty at BEG, or are empty at END provided END
2887 denotes the position at the end of the current buffer.
2889 Return the number found, and store them in a vector in *VEC_PTR.
2890 Store in *LEN_PTR the size allocated for the vector.
2891 Store in *NEXT_PTR the next position after POS where an overlay starts,
2892 or ZV if there are no more overlays.
2893 Store in *PREV_PTR the previous position before POS where an overlay ends,
2894 or BEGV if there are no previous overlays.
2895 NEXT_PTR and/or PREV_PTR may be 0, meaning don't store that info.
2897 *VEC_PTR and *LEN_PTR should contain a valid vector and size
2898 when this function is called.
2900 If EXTEND, make the vector bigger if necessary.
2901 If not, never extend the vector,
2902 and store only as many overlays as will fit.
2903 But still return the total number of overlays. */
2905 static ptrdiff_t
2906 overlays_in (EMACS_INT beg, EMACS_INT end, bool extend,
2907 Lisp_Object **vec_ptr, ptrdiff_t *len_ptr,
2908 ptrdiff_t *next_ptr, ptrdiff_t *prev_ptr)
2910 Lisp_Object overlay, ostart, oend;
2911 struct Lisp_Overlay *tail;
2912 ptrdiff_t idx = 0;
2913 ptrdiff_t len = *len_ptr;
2914 Lisp_Object *vec = *vec_ptr;
2915 ptrdiff_t next = ZV;
2916 ptrdiff_t prev = BEGV;
2917 bool inhibit_storing = 0;
2918 bool end_is_Z = end == Z;
2920 for (tail = current_buffer->overlays_before; tail; tail = tail->next)
2922 ptrdiff_t startpos, endpos;
2924 XSETMISC (overlay, tail);
2926 ostart = OVERLAY_START (overlay);
2927 oend = OVERLAY_END (overlay);
2928 endpos = OVERLAY_POSITION (oend);
2929 if (endpos < beg)
2931 if (prev < endpos)
2932 prev = endpos;
2933 break;
2935 startpos = OVERLAY_POSITION (ostart);
2936 /* Count an interval if it overlaps the range, is empty at the
2937 start of the range, or is empty at END provided END denotes the
2938 end of the buffer. */
2939 if ((beg < endpos && startpos < end)
2940 || (startpos == endpos
2941 && (beg == endpos || (end_is_Z && endpos == end))))
2943 if (idx == len)
2945 /* The supplied vector is full.
2946 Either make it bigger, or don't store any more in it. */
2947 if (extend)
2949 vec = xpalloc (vec, len_ptr, 1, OVERLAY_COUNT_MAX,
2950 sizeof *vec);
2951 *vec_ptr = vec;
2952 len = *len_ptr;
2954 else
2955 inhibit_storing = 1;
2958 if (!inhibit_storing)
2959 vec[idx] = overlay;
2960 /* Keep counting overlays even if we can't return them all. */
2961 idx++;
2963 else if (startpos < next)
2964 next = startpos;
2967 for (tail = current_buffer->overlays_after; tail; tail = tail->next)
2969 ptrdiff_t startpos, endpos;
2971 XSETMISC (overlay, tail);
2973 ostart = OVERLAY_START (overlay);
2974 oend = OVERLAY_END (overlay);
2975 startpos = OVERLAY_POSITION (ostart);
2976 if (end < startpos)
2978 if (startpos < next)
2979 next = startpos;
2980 break;
2982 endpos = OVERLAY_POSITION (oend);
2983 /* Count an interval if it overlaps the range, is empty at the
2984 start of the range, or is empty at END provided END denotes the
2985 end of the buffer. */
2986 if ((beg < endpos && startpos < end)
2987 || (startpos == endpos
2988 && (beg == endpos || (end_is_Z && endpos == end))))
2990 if (idx == len)
2992 if (extend)
2994 vec = xpalloc (vec, len_ptr, 1, OVERLAY_COUNT_MAX,
2995 sizeof *vec);
2996 *vec_ptr = vec;
2997 len = *len_ptr;
2999 else
3000 inhibit_storing = 1;
3003 if (!inhibit_storing)
3004 vec[idx] = overlay;
3005 idx++;
3007 else if (endpos < beg && endpos > prev)
3008 prev = endpos;
3011 if (next_ptr)
3012 *next_ptr = next;
3013 if (prev_ptr)
3014 *prev_ptr = prev;
3015 return idx;
3019 /* Return true if there exists an overlay with a non-nil
3020 `mouse-face' property overlapping OVERLAY. */
3022 bool
3023 mouse_face_overlay_overlaps (Lisp_Object overlay)
3025 ptrdiff_t start = OVERLAY_POSITION (OVERLAY_START (overlay));
3026 ptrdiff_t end = OVERLAY_POSITION (OVERLAY_END (overlay));
3027 ptrdiff_t n, i, size;
3028 Lisp_Object *v, tem;
3029 Lisp_Object vbuf[10];
3030 USE_SAFE_ALLOCA;
3032 size = ARRAYELTS (vbuf);
3033 v = vbuf;
3034 n = overlays_in (start, end, 0, &v, &size, NULL, NULL);
3035 if (n > size)
3037 SAFE_NALLOCA (v, 1, n);
3038 overlays_in (start, end, 0, &v, &n, NULL, NULL);
3041 for (i = 0; i < n; ++i)
3042 if (!EQ (v[i], overlay)
3043 && (tem = Foverlay_get (overlay, Qmouse_face),
3044 !NILP (tem)))
3045 break;
3047 SAFE_FREE ();
3048 return i < n;
3053 /* Fast function to just test if we're at an overlay boundary. */
3054 bool
3055 overlay_touches_p (ptrdiff_t pos)
3057 Lisp_Object overlay;
3058 struct Lisp_Overlay *tail;
3060 for (tail = current_buffer->overlays_before; tail; tail = tail->next)
3062 ptrdiff_t endpos;
3064 XSETMISC (overlay ,tail);
3065 eassert (OVERLAYP (overlay));
3067 endpos = OVERLAY_POSITION (OVERLAY_END (overlay));
3068 if (endpos < pos)
3069 break;
3070 if (endpos == pos || OVERLAY_POSITION (OVERLAY_START (overlay)) == pos)
3071 return 1;
3074 for (tail = current_buffer->overlays_after; tail; tail = tail->next)
3076 ptrdiff_t startpos;
3078 XSETMISC (overlay, tail);
3079 eassert (OVERLAYP (overlay));
3081 startpos = OVERLAY_POSITION (OVERLAY_START (overlay));
3082 if (pos < startpos)
3083 break;
3084 if (startpos == pos || OVERLAY_POSITION (OVERLAY_END (overlay)) == pos)
3085 return 1;
3087 return 0;
3090 struct sortvec
3092 Lisp_Object overlay;
3093 ptrdiff_t beg, end;
3094 EMACS_INT priority;
3095 EMACS_INT spriority; /* Secondary priority. */
3098 static int
3099 compare_overlays (const void *v1, const void *v2)
3101 const struct sortvec *s1 = v1;
3102 const struct sortvec *s2 = v2;
3103 /* Return 1 if s1 should take precedence, -1 if v2 should take precedence,
3104 and 0 if they're equal. */
3105 if (s1->priority != s2->priority)
3106 return s1->priority < s2->priority ? -1 : 1;
3107 /* If the priority is equal, give precedence to the one not covered by the
3108 other. If neither covers the other, obey spriority. */
3109 else if (s1->beg < s2->beg)
3110 return (s1->end < s2->end && s1->spriority > s2->spriority ? 1 : -1);
3111 else if (s1->beg > s2->beg)
3112 return (s1->end > s2->end && s1->spriority < s2->spriority ? -1 : 1);
3113 else if (s1->end != s2->end)
3114 return s2->end < s1->end ? -1 : 1;
3115 else if (s1->spriority != s2->spriority)
3116 return (s1->spriority < s2->spriority ? -1 : 1);
3117 else if (EQ (s1->overlay, s2->overlay))
3118 return 0;
3119 else
3120 /* Avoid the non-determinism of qsort by choosing an arbitrary ordering
3121 between "equal" overlays. The result can still change between
3122 invocations of Emacs, but it won't change in the middle of
3123 `find_field' (bug#6830). */
3124 return XLI (s1->overlay) < XLI (s2->overlay) ? -1 : 1;
3127 /* Sort an array of overlays by priority. The array is modified in place.
3128 The return value is the new size; this may be smaller than the original
3129 size if some of the overlays were invalid or were window-specific. */
3130 ptrdiff_t
3131 sort_overlays (Lisp_Object *overlay_vec, ptrdiff_t noverlays, struct window *w)
3133 ptrdiff_t i, j;
3134 USE_SAFE_ALLOCA;
3135 struct sortvec *sortvec;
3137 SAFE_NALLOCA (sortvec, 1, noverlays);
3139 /* Put the valid and relevant overlays into sortvec. */
3141 for (i = 0, j = 0; i < noverlays; i++)
3143 Lisp_Object tem;
3144 Lisp_Object overlay;
3146 overlay = overlay_vec[i];
3147 if (OVERLAYP (overlay)
3148 && OVERLAY_POSITION (OVERLAY_START (overlay)) > 0
3149 && OVERLAY_POSITION (OVERLAY_END (overlay)) > 0)
3151 /* If we're interested in a specific window, then ignore
3152 overlays that are limited to some other window. */
3153 if (w)
3155 Lisp_Object window;
3157 window = Foverlay_get (overlay, Qwindow);
3158 if (WINDOWP (window) && XWINDOW (window) != w)
3159 continue;
3162 /* This overlay is good and counts: put it into sortvec. */
3163 sortvec[j].overlay = overlay;
3164 sortvec[j].beg = OVERLAY_POSITION (OVERLAY_START (overlay));
3165 sortvec[j].end = OVERLAY_POSITION (OVERLAY_END (overlay));
3166 tem = Foverlay_get (overlay, Qpriority);
3167 if (NILP (tem))
3169 sortvec[j].priority = 0;
3170 sortvec[j].spriority = 0;
3172 else if (INTEGERP (tem))
3174 sortvec[j].priority = XINT (tem);
3175 sortvec[j].spriority = 0;
3177 else if (CONSP (tem))
3179 Lisp_Object car = XCAR (tem);
3180 Lisp_Object cdr = XCDR (tem);
3181 sortvec[j].priority = INTEGERP (car) ? XINT (car) : 0;
3182 sortvec[j].spriority = INTEGERP (cdr) ? XINT (cdr) : 0;
3184 j++;
3187 noverlays = j;
3189 /* Sort the overlays into the proper order: increasing priority. */
3191 if (noverlays > 1)
3192 qsort (sortvec, noverlays, sizeof (struct sortvec), compare_overlays);
3194 for (i = 0; i < noverlays; i++)
3195 overlay_vec[i] = sortvec[i].overlay;
3197 SAFE_FREE ();
3198 return (noverlays);
3201 struct sortstr
3203 Lisp_Object string, string2;
3204 ptrdiff_t size;
3205 EMACS_INT priority;
3208 struct sortstrlist
3210 struct sortstr *buf; /* An array that expands as needed; never freed. */
3211 ptrdiff_t size; /* Allocated length of that array. */
3212 ptrdiff_t used; /* How much of the array is currently in use. */
3213 ptrdiff_t bytes; /* Total length of the strings in buf. */
3216 /* Buffers for storing information about the overlays touching a given
3217 position. These could be automatic variables in overlay_strings, but
3218 it's more efficient to hold onto the memory instead of repeatedly
3219 allocating and freeing it. */
3220 static struct sortstrlist overlay_heads, overlay_tails;
3221 static unsigned char *overlay_str_buf;
3223 /* Allocated length of overlay_str_buf. */
3224 static ptrdiff_t overlay_str_len;
3226 /* A comparison function suitable for passing to qsort. */
3227 static int
3228 cmp_for_strings (const void *as1, const void *as2)
3230 struct sortstr const *s1 = as1;
3231 struct sortstr const *s2 = as2;
3232 if (s1->size != s2->size)
3233 return s2->size < s1->size ? -1 : 1;
3234 if (s1->priority != s2->priority)
3235 return s1->priority < s2->priority ? -1 : 1;
3236 return 0;
3239 static void
3240 record_overlay_string (struct sortstrlist *ssl, Lisp_Object str,
3241 Lisp_Object str2, Lisp_Object pri, ptrdiff_t size)
3243 ptrdiff_t nbytes;
3245 if (ssl->used == ssl->size)
3246 ssl->buf = xpalloc (ssl->buf, &ssl->size, 5, -1, sizeof *ssl->buf);
3247 ssl->buf[ssl->used].string = str;
3248 ssl->buf[ssl->used].string2 = str2;
3249 ssl->buf[ssl->used].size = size;
3250 ssl->buf[ssl->used].priority = (INTEGERP (pri) ? XINT (pri) : 0);
3251 ssl->used++;
3253 if (NILP (BVAR (current_buffer, enable_multibyte_characters)))
3254 nbytes = SCHARS (str);
3255 else if (! STRING_MULTIBYTE (str))
3256 nbytes = count_size_as_multibyte (SDATA (str),
3257 SBYTES (str));
3258 else
3259 nbytes = SBYTES (str);
3261 if (INT_ADD_OVERFLOW (ssl->bytes, nbytes))
3262 memory_full (SIZE_MAX);
3263 ssl->bytes += nbytes;
3265 if (STRINGP (str2))
3267 if (NILP (BVAR (current_buffer, enable_multibyte_characters)))
3268 nbytes = SCHARS (str2);
3269 else if (! STRING_MULTIBYTE (str2))
3270 nbytes = count_size_as_multibyte (SDATA (str2),
3271 SBYTES (str2));
3272 else
3273 nbytes = SBYTES (str2);
3275 if (INT_ADD_OVERFLOW (ssl->bytes, nbytes))
3276 memory_full (SIZE_MAX);
3277 ssl->bytes += nbytes;
3281 /* Concatenate the strings associated with overlays that begin or end
3282 at POS, ignoring overlays that are specific to windows other than W.
3283 The strings are concatenated in the appropriate order: shorter
3284 overlays nest inside longer ones, and higher priority inside lower.
3285 Normally all of the after-strings come first, but zero-sized
3286 overlays have their after-strings ride along with the
3287 before-strings because it would look strange to print them
3288 inside-out.
3290 Returns the concatenated string's length, and return the pointer to
3291 that string via PSTR, if that variable is non-NULL. The storage of
3292 the concatenated strings may be overwritten by subsequent calls. */
3294 ptrdiff_t
3295 overlay_strings (ptrdiff_t pos, struct window *w, unsigned char **pstr)
3297 Lisp_Object overlay, window, str;
3298 struct Lisp_Overlay *ov;
3299 ptrdiff_t startpos, endpos;
3300 bool multibyte = ! NILP (BVAR (current_buffer, enable_multibyte_characters));
3302 overlay_heads.used = overlay_heads.bytes = 0;
3303 overlay_tails.used = overlay_tails.bytes = 0;
3304 for (ov = current_buffer->overlays_before; ov; ov = ov->next)
3306 XSETMISC (overlay, ov);
3307 eassert (OVERLAYP (overlay));
3309 startpos = OVERLAY_POSITION (OVERLAY_START (overlay));
3310 endpos = OVERLAY_POSITION (OVERLAY_END (overlay));
3311 if (endpos < pos)
3312 break;
3313 if (endpos != pos && startpos != pos)
3314 continue;
3315 window = Foverlay_get (overlay, Qwindow);
3316 if (WINDOWP (window) && XWINDOW (window) != w)
3317 continue;
3318 if (startpos == pos
3319 && (str = Foverlay_get (overlay, Qbefore_string), STRINGP (str)))
3320 record_overlay_string (&overlay_heads, str,
3321 (startpos == endpos
3322 ? Foverlay_get (overlay, Qafter_string)
3323 : Qnil),
3324 Foverlay_get (overlay, Qpriority),
3325 endpos - startpos);
3326 else if (endpos == pos
3327 && (str = Foverlay_get (overlay, Qafter_string), STRINGP (str)))
3328 record_overlay_string (&overlay_tails, str, Qnil,
3329 Foverlay_get (overlay, Qpriority),
3330 endpos - startpos);
3332 for (ov = current_buffer->overlays_after; ov; ov = ov->next)
3334 XSETMISC (overlay, ov);
3335 eassert (OVERLAYP (overlay));
3337 startpos = OVERLAY_POSITION (OVERLAY_START (overlay));
3338 endpos = OVERLAY_POSITION (OVERLAY_END (overlay));
3339 if (startpos > pos)
3340 break;
3341 if (endpos != pos && startpos != pos)
3342 continue;
3343 window = Foverlay_get (overlay, Qwindow);
3344 if (WINDOWP (window) && XWINDOW (window) != w)
3345 continue;
3346 if (startpos == pos
3347 && (str = Foverlay_get (overlay, Qbefore_string), STRINGP (str)))
3348 record_overlay_string (&overlay_heads, str,
3349 (startpos == endpos
3350 ? Foverlay_get (overlay, Qafter_string)
3351 : Qnil),
3352 Foverlay_get (overlay, Qpriority),
3353 endpos - startpos);
3354 else if (endpos == pos
3355 && (str = Foverlay_get (overlay, Qafter_string), STRINGP (str)))
3356 record_overlay_string (&overlay_tails, str, Qnil,
3357 Foverlay_get (overlay, Qpriority),
3358 endpos - startpos);
3360 if (overlay_tails.used > 1)
3361 qsort (overlay_tails.buf, overlay_tails.used, sizeof (struct sortstr),
3362 cmp_for_strings);
3363 if (overlay_heads.used > 1)
3364 qsort (overlay_heads.buf, overlay_heads.used, sizeof (struct sortstr),
3365 cmp_for_strings);
3366 if (overlay_heads.bytes || overlay_tails.bytes)
3368 Lisp_Object tem;
3369 ptrdiff_t i;
3370 unsigned char *p;
3371 ptrdiff_t total;
3373 if (INT_ADD_OVERFLOW (overlay_heads.bytes, overlay_tails.bytes))
3374 memory_full (SIZE_MAX);
3375 total = overlay_heads.bytes + overlay_tails.bytes;
3376 if (total > overlay_str_len)
3377 overlay_str_buf = xpalloc (overlay_str_buf, &overlay_str_len,
3378 total - overlay_str_len, -1, 1);
3380 p = overlay_str_buf;
3381 for (i = overlay_tails.used; --i >= 0;)
3383 ptrdiff_t nbytes;
3384 tem = overlay_tails.buf[i].string;
3385 nbytes = copy_text (SDATA (tem), p,
3386 SBYTES (tem),
3387 STRING_MULTIBYTE (tem), multibyte);
3388 p += nbytes;
3390 for (i = 0; i < overlay_heads.used; ++i)
3392 ptrdiff_t nbytes;
3393 tem = overlay_heads.buf[i].string;
3394 nbytes = copy_text (SDATA (tem), p,
3395 SBYTES (tem),
3396 STRING_MULTIBYTE (tem), multibyte);
3397 p += nbytes;
3398 tem = overlay_heads.buf[i].string2;
3399 if (STRINGP (tem))
3401 nbytes = copy_text (SDATA (tem), p,
3402 SBYTES (tem),
3403 STRING_MULTIBYTE (tem), multibyte);
3404 p += nbytes;
3407 if (p != overlay_str_buf + total)
3408 emacs_abort ();
3409 if (pstr)
3410 *pstr = overlay_str_buf;
3411 return total;
3413 return 0;
3416 /* Shift overlays in BUF's overlay lists, to center the lists at POS. */
3418 void
3419 recenter_overlay_lists (struct buffer *buf, ptrdiff_t pos)
3421 Lisp_Object overlay, beg, end;
3422 struct Lisp_Overlay *prev, *tail, *next;
3424 /* See if anything in overlays_before should move to overlays_after. */
3426 /* We don't strictly need prev in this loop; it should always be nil.
3427 But we use it for symmetry and in case that should cease to be true
3428 with some future change. */
3429 prev = NULL;
3430 for (tail = buf->overlays_before; tail; prev = tail, tail = next)
3432 next = tail->next;
3433 XSETMISC (overlay, tail);
3434 eassert (OVERLAYP (overlay));
3436 beg = OVERLAY_START (overlay);
3437 end = OVERLAY_END (overlay);
3439 if (OVERLAY_POSITION (end) > pos)
3441 /* OVERLAY needs to be moved. */
3442 ptrdiff_t where = OVERLAY_POSITION (beg);
3443 struct Lisp_Overlay *other, *other_prev;
3445 /* Splice the cons cell TAIL out of overlays_before. */
3446 if (prev)
3447 prev->next = next;
3448 else
3449 set_buffer_overlays_before (buf, next);
3451 /* Search thru overlays_after for where to put it. */
3452 other_prev = NULL;
3453 for (other = buf->overlays_after; other;
3454 other_prev = other, other = other->next)
3456 Lisp_Object otherbeg, otheroverlay;
3458 XSETMISC (otheroverlay, other);
3459 eassert (OVERLAYP (otheroverlay));
3461 otherbeg = OVERLAY_START (otheroverlay);
3462 if (OVERLAY_POSITION (otherbeg) >= where)
3463 break;
3466 /* Add TAIL to overlays_after before OTHER. */
3467 tail->next = other;
3468 if (other_prev)
3469 other_prev->next = tail;
3470 else
3471 set_buffer_overlays_after (buf, tail);
3472 tail = prev;
3474 else
3475 /* We've reached the things that should stay in overlays_before.
3476 All the rest of overlays_before must end even earlier,
3477 so stop now. */
3478 break;
3481 /* See if anything in overlays_after should be in overlays_before. */
3482 prev = NULL;
3483 for (tail = buf->overlays_after; tail; prev = tail, tail = next)
3485 next = tail->next;
3486 XSETMISC (overlay, tail);
3487 eassert (OVERLAYP (overlay));
3489 beg = OVERLAY_START (overlay);
3490 end = OVERLAY_END (overlay);
3492 /* Stop looking, when we know that nothing further
3493 can possibly end before POS. */
3494 if (OVERLAY_POSITION (beg) > pos)
3495 break;
3497 if (OVERLAY_POSITION (end) <= pos)
3499 /* OVERLAY needs to be moved. */
3500 ptrdiff_t where = OVERLAY_POSITION (end);
3501 struct Lisp_Overlay *other, *other_prev;
3503 /* Splice the cons cell TAIL out of overlays_after. */
3504 if (prev)
3505 prev->next = next;
3506 else
3507 set_buffer_overlays_after (buf, next);
3509 /* Search thru overlays_before for where to put it. */
3510 other_prev = NULL;
3511 for (other = buf->overlays_before; other;
3512 other_prev = other, other = other->next)
3514 Lisp_Object otherend, otheroverlay;
3516 XSETMISC (otheroverlay, other);
3517 eassert (OVERLAYP (otheroverlay));
3519 otherend = OVERLAY_END (otheroverlay);
3520 if (OVERLAY_POSITION (otherend) <= where)
3521 break;
3524 /* Add TAIL to overlays_before before OTHER. */
3525 tail->next = other;
3526 if (other_prev)
3527 other_prev->next = tail;
3528 else
3529 set_buffer_overlays_before (buf, tail);
3530 tail = prev;
3534 buf->overlay_center = pos;
3537 void
3538 adjust_overlays_for_insert (ptrdiff_t pos, ptrdiff_t length)
3540 /* After an insertion, the lists are still sorted properly,
3541 but we may need to update the value of the overlay center. */
3542 if (current_buffer->overlay_center >= pos)
3543 current_buffer->overlay_center += length;
3546 void
3547 adjust_overlays_for_delete (ptrdiff_t pos, ptrdiff_t length)
3549 if (current_buffer->overlay_center < pos)
3550 /* The deletion was to our right. No change needed; the before- and
3551 after-lists are still consistent. */
3553 else if (current_buffer->overlay_center - pos > length)
3554 /* The deletion was to our left. We need to adjust the center value
3555 to account for the change in position, but the lists are consistent
3556 given the new value. */
3557 current_buffer->overlay_center -= length;
3558 else
3559 /* We're right in the middle. There might be things on the after-list
3560 that now belong on the before-list. Recentering will move them,
3561 and also update the center point. */
3562 recenter_overlay_lists (current_buffer, pos);
3565 /* Fix up overlays that were garbled as a result of permuting markers
3566 in the range START through END. Any overlay with at least one
3567 endpoint in this range will need to be unlinked from the overlay
3568 list and reinserted in its proper place.
3569 Such an overlay might even have negative size at this point.
3570 If so, we'll make the overlay empty. */
3571 void
3572 fix_start_end_in_overlays (register ptrdiff_t start, register ptrdiff_t end)
3574 Lisp_Object overlay;
3575 struct Lisp_Overlay *before_list IF_LINT (= NULL);
3576 struct Lisp_Overlay *after_list IF_LINT (= NULL);
3577 /* These are either nil, indicating that before_list or after_list
3578 should be assigned, or the cons cell the cdr of which should be
3579 assigned. */
3580 struct Lisp_Overlay *beforep = NULL, *afterp = NULL;
3581 /* 'Parent', likewise, indicates a cons cell or
3582 current_buffer->overlays_before or overlays_after, depending
3583 which loop we're in. */
3584 struct Lisp_Overlay *tail, *parent;
3585 ptrdiff_t startpos, endpos;
3587 /* This algorithm shifts links around instead of consing and GCing.
3588 The loop invariant is that before_list (resp. after_list) is a
3589 well-formed list except that its last element, the CDR of beforep
3590 (resp. afterp) if beforep (afterp) isn't nil or before_list
3591 (after_list) if it is, is still uninitialized. So it's not a bug
3592 that before_list isn't initialized, although it may look
3593 strange. */
3594 for (parent = NULL, tail = current_buffer->overlays_before; tail;)
3596 XSETMISC (overlay, tail);
3598 endpos = OVERLAY_POSITION (OVERLAY_END (overlay));
3599 startpos = OVERLAY_POSITION (OVERLAY_START (overlay));
3601 /* If the overlay is backwards, make it empty. */
3602 if (endpos < startpos)
3604 startpos = endpos;
3605 Fset_marker (OVERLAY_START (overlay), make_number (startpos),
3606 Qnil);
3609 if (endpos < start)
3610 break;
3612 if (endpos < end
3613 || (startpos >= start && startpos < end))
3615 /* Add it to the end of the wrong list. Later on,
3616 recenter_overlay_lists will move it to the right place. */
3617 if (endpos < current_buffer->overlay_center)
3619 if (!afterp)
3620 after_list = tail;
3621 else
3622 afterp->next = tail;
3623 afterp = tail;
3625 else
3627 if (!beforep)
3628 before_list = tail;
3629 else
3630 beforep->next = tail;
3631 beforep = tail;
3633 if (!parent)
3634 set_buffer_overlays_before (current_buffer, tail->next);
3635 else
3636 parent->next = tail->next;
3637 tail = tail->next;
3639 else
3640 parent = tail, tail = parent->next;
3642 for (parent = NULL, tail = current_buffer->overlays_after; tail;)
3644 XSETMISC (overlay, tail);
3646 startpos = OVERLAY_POSITION (OVERLAY_START (overlay));
3647 endpos = OVERLAY_POSITION (OVERLAY_END (overlay));
3649 /* If the overlay is backwards, make it empty. */
3650 if (endpos < startpos)
3652 startpos = endpos;
3653 Fset_marker (OVERLAY_START (overlay), make_number (startpos),
3654 Qnil);
3657 if (startpos >= end)
3658 break;
3660 if (startpos >= start
3661 || (endpos >= start && endpos < end))
3663 if (endpos < current_buffer->overlay_center)
3665 if (!afterp)
3666 after_list = tail;
3667 else
3668 afterp->next = tail;
3669 afterp = tail;
3671 else
3673 if (!beforep)
3674 before_list = tail;
3675 else
3676 beforep->next = tail;
3677 beforep = tail;
3679 if (!parent)
3680 set_buffer_overlays_after (current_buffer, tail->next);
3681 else
3682 parent->next = tail->next;
3683 tail = tail->next;
3685 else
3686 parent = tail, tail = parent->next;
3689 /* Splice the constructed (wrong) lists into the buffer's lists,
3690 and let the recenter function make it sane again. */
3691 if (beforep)
3693 beforep->next = current_buffer->overlays_before;
3694 set_buffer_overlays_before (current_buffer, before_list);
3697 if (afterp)
3699 afterp->next = current_buffer->overlays_after;
3700 set_buffer_overlays_after (current_buffer, after_list);
3702 recenter_overlay_lists (current_buffer, current_buffer->overlay_center);
3705 /* We have two types of overlay: the one whose ending marker is
3706 after-insertion-marker (this is the usual case) and the one whose
3707 ending marker is before-insertion-marker. When `overlays_before'
3708 contains overlays of the latter type and the former type in this
3709 order and both overlays end at inserting position, inserting a text
3710 increases only the ending marker of the latter type, which results
3711 in incorrect ordering of `overlays_before'.
3713 This function fixes ordering of overlays in the slot
3714 `overlays_before' of the buffer *BP. Before the insertion, `point'
3715 was at PREV, and now is at POS. */
3717 void
3718 fix_overlays_before (struct buffer *bp, ptrdiff_t prev, ptrdiff_t pos)
3720 /* If parent is nil, replace overlays_before; otherwise, parent->next. */
3721 struct Lisp_Overlay *tail = bp->overlays_before, *parent = NULL, *right_pair;
3722 Lisp_Object tem;
3723 ptrdiff_t end IF_LINT (= 0);
3725 /* After the insertion, the several overlays may be in incorrect
3726 order. The possibility is that, in the list `overlays_before',
3727 an overlay which ends at POS appears after an overlay which ends
3728 at PREV. Since POS is greater than PREV, we must fix the
3729 ordering of these overlays, by moving overlays ends at POS before
3730 the overlays ends at PREV. */
3732 /* At first, find a place where disordered overlays should be linked
3733 in. It is where an overlay which end before POS exists. (i.e. an
3734 overlay whose ending marker is after-insertion-marker if disorder
3735 exists). */
3736 while (tail
3737 && (XSETMISC (tem, tail),
3738 (end = OVERLAY_POSITION (OVERLAY_END (tem))) >= pos))
3740 parent = tail;
3741 tail = tail->next;
3744 /* If we don't find such an overlay,
3745 or the found one ends before PREV,
3746 or the found one is the last one in the list,
3747 we don't have to fix anything. */
3748 if (!tail || end < prev || !tail->next)
3749 return;
3751 right_pair = parent;
3752 parent = tail;
3753 tail = tail->next;
3755 /* Now, end position of overlays in the list TAIL should be before
3756 or equal to PREV. In the loop, an overlay which ends at POS is
3757 moved ahead to the place indicated by the CDR of RIGHT_PAIR. If
3758 we found an overlay which ends before PREV, the remaining
3759 overlays are in correct order. */
3760 while (tail)
3762 XSETMISC (tem, tail);
3763 end = OVERLAY_POSITION (OVERLAY_END (tem));
3765 if (end == pos)
3766 { /* This overlay is disordered. */
3767 struct Lisp_Overlay *found = tail;
3769 /* Unlink the found overlay. */
3770 tail = found->next;
3771 parent->next = tail;
3772 /* Move an overlay at RIGHT_PLACE to the next of the found one,
3773 and link it into the right place. */
3774 if (!right_pair)
3776 found->next = bp->overlays_before;
3777 set_buffer_overlays_before (bp, found);
3779 else
3781 found->next = right_pair->next;
3782 right_pair->next = found;
3785 else if (end == prev)
3787 parent = tail;
3788 tail = tail->next;
3790 else /* No more disordered overlay. */
3791 break;
3795 DEFUN ("overlayp", Foverlayp, Soverlayp, 1, 1, 0,
3796 doc: /* Return t if OBJECT is an overlay. */)
3797 (Lisp_Object object)
3799 return (OVERLAYP (object) ? Qt : Qnil);
3802 DEFUN ("make-overlay", Fmake_overlay, Smake_overlay, 2, 5, 0,
3803 doc: /* Create a new overlay with range BEG to END in BUFFER and return it.
3804 If omitted, BUFFER defaults to the current buffer.
3805 BEG and END may be integers or markers.
3806 The fourth arg FRONT-ADVANCE, if non-nil, makes the marker
3807 for the front of the overlay advance when text is inserted there
3808 \(which means the text *is not* included in the overlay).
3809 The fifth arg REAR-ADVANCE, if non-nil, makes the marker
3810 for the rear of the overlay advance when text is inserted there
3811 \(which means the text *is* included in the overlay). */)
3812 (Lisp_Object beg, Lisp_Object end, Lisp_Object buffer,
3813 Lisp_Object front_advance, Lisp_Object rear_advance)
3815 Lisp_Object overlay;
3816 struct buffer *b;
3818 if (NILP (buffer))
3819 XSETBUFFER (buffer, current_buffer);
3820 else
3821 CHECK_BUFFER (buffer);
3823 if (MARKERP (beg) && !EQ (Fmarker_buffer (beg), buffer))
3824 signal_error ("Marker points into wrong buffer", beg);
3825 if (MARKERP (end) && !EQ (Fmarker_buffer (end), buffer))
3826 signal_error ("Marker points into wrong buffer", end);
3828 CHECK_NUMBER_COERCE_MARKER (beg);
3829 CHECK_NUMBER_COERCE_MARKER (end);
3831 if (XINT (beg) > XINT (end))
3833 Lisp_Object temp;
3834 temp = beg; beg = end; end = temp;
3837 b = XBUFFER (buffer);
3839 beg = Fset_marker (Fmake_marker (), beg, buffer);
3840 end = Fset_marker (Fmake_marker (), end, buffer);
3842 if (!NILP (front_advance))
3843 XMARKER (beg)->insertion_type = 1;
3844 if (!NILP (rear_advance))
3845 XMARKER (end)->insertion_type = 1;
3847 overlay = build_overlay (beg, end, Qnil);
3849 /* Put the new overlay on the wrong list. */
3850 end = OVERLAY_END (overlay);
3851 if (OVERLAY_POSITION (end) < b->overlay_center)
3853 eassert (b->overlays_after || (XOVERLAY (overlay)->next == NULL));
3854 XOVERLAY (overlay)->next = b->overlays_after;
3855 set_buffer_overlays_after (b, XOVERLAY (overlay));
3857 else
3859 eassert (b->overlays_before || (XOVERLAY (overlay)->next == NULL));
3860 XOVERLAY (overlay)->next = b->overlays_before;
3861 set_buffer_overlays_before (b, XOVERLAY (overlay));
3863 /* This puts it in the right list, and in the right order. */
3864 recenter_overlay_lists (b, b->overlay_center);
3866 /* We don't need to redisplay the region covered by the overlay, because
3867 the overlay has no properties at the moment. */
3869 return overlay;
3872 /* Mark a section of BUF as needing redisplay because of overlays changes. */
3874 static void
3875 modify_overlay (struct buffer *buf, ptrdiff_t start, ptrdiff_t end)
3877 if (start > end)
3879 ptrdiff_t temp = start;
3880 start = end;
3881 end = temp;
3884 BUF_COMPUTE_UNCHANGED (buf, start, end);
3886 bset_redisplay (buf);
3888 ++BUF_OVERLAY_MODIFF (buf);
3891 /* Remove OVERLAY from LIST. */
3893 static struct Lisp_Overlay *
3894 unchain_overlay (struct Lisp_Overlay *list, struct Lisp_Overlay *overlay)
3896 register struct Lisp_Overlay *tail, **prev = &list;
3898 for (tail = list; tail; prev = &tail->next, tail = *prev)
3899 if (tail == overlay)
3901 *prev = overlay->next;
3902 overlay->next = NULL;
3903 break;
3905 return list;
3908 /* Remove OVERLAY from both overlay lists of B. */
3910 static void
3911 unchain_both (struct buffer *b, Lisp_Object overlay)
3913 struct Lisp_Overlay *ov = XOVERLAY (overlay);
3915 set_buffer_overlays_before (b, unchain_overlay (b->overlays_before, ov));
3916 set_buffer_overlays_after (b, unchain_overlay (b->overlays_after, ov));
3917 eassert (XOVERLAY (overlay)->next == NULL);
3920 DEFUN ("move-overlay", Fmove_overlay, Smove_overlay, 3, 4, 0,
3921 doc: /* Set the endpoints of OVERLAY to BEG and END in BUFFER.
3922 If BUFFER is omitted, leave OVERLAY in the same buffer it inhabits now.
3923 If BUFFER is omitted, and OVERLAY is in no buffer, put it in the current
3924 buffer. */)
3925 (Lisp_Object overlay, Lisp_Object beg, Lisp_Object end, Lisp_Object buffer)
3927 struct buffer *b, *ob = 0;
3928 Lisp_Object obuffer;
3929 ptrdiff_t count = SPECPDL_INDEX ();
3930 ptrdiff_t n_beg, n_end, o_beg IF_LINT (= 0), o_end IF_LINT (= 0);
3932 CHECK_OVERLAY (overlay);
3933 if (NILP (buffer))
3934 buffer = Fmarker_buffer (OVERLAY_START (overlay));
3935 if (NILP (buffer))
3936 XSETBUFFER (buffer, current_buffer);
3937 CHECK_BUFFER (buffer);
3939 if (NILP (Fbuffer_live_p (buffer)))
3940 error ("Attempt to move overlay to a dead buffer");
3942 if (MARKERP (beg) && !EQ (Fmarker_buffer (beg), buffer))
3943 signal_error ("Marker points into wrong buffer", beg);
3944 if (MARKERP (end) && !EQ (Fmarker_buffer (end), buffer))
3945 signal_error ("Marker points into wrong buffer", end);
3947 CHECK_NUMBER_COERCE_MARKER (beg);
3948 CHECK_NUMBER_COERCE_MARKER (end);
3950 if (XINT (beg) > XINT (end))
3952 Lisp_Object temp;
3953 temp = beg; beg = end; end = temp;
3956 specbind (Qinhibit_quit, Qt);
3958 obuffer = Fmarker_buffer (OVERLAY_START (overlay));
3959 b = XBUFFER (buffer);
3961 if (!NILP (obuffer))
3963 ob = XBUFFER (obuffer);
3965 o_beg = OVERLAY_POSITION (OVERLAY_START (overlay));
3966 o_end = OVERLAY_POSITION (OVERLAY_END (overlay));
3968 unchain_both (ob, overlay);
3971 /* Set the overlay boundaries, which may clip them. */
3972 Fset_marker (OVERLAY_START (overlay), beg, buffer);
3973 Fset_marker (OVERLAY_END (overlay), end, buffer);
3975 n_beg = marker_position (OVERLAY_START (overlay));
3976 n_end = marker_position (OVERLAY_END (overlay));
3978 /* If the overlay has changed buffers, do a thorough redisplay. */
3979 if (!EQ (buffer, obuffer))
3981 /* Redisplay where the overlay was. */
3982 if (ob)
3983 modify_overlay (ob, o_beg, o_end);
3985 /* Redisplay where the overlay is going to be. */
3986 modify_overlay (b, n_beg, n_end);
3988 else
3989 /* Redisplay the area the overlay has just left, or just enclosed. */
3991 if (o_beg == n_beg)
3992 modify_overlay (b, o_end, n_end);
3993 else if (o_end == n_end)
3994 modify_overlay (b, o_beg, n_beg);
3995 else
3996 modify_overlay (b, min (o_beg, n_beg), max (o_end, n_end));
3999 /* Delete the overlay if it is empty after clipping and has the
4000 evaporate property. */
4001 if (n_beg == n_end && !NILP (Foverlay_get (overlay, Qevaporate)))
4002 return unbind_to (count, Fdelete_overlay (overlay));
4004 /* Put the overlay into the new buffer's overlay lists, first on the
4005 wrong list. */
4006 if (n_end < b->overlay_center)
4008 XOVERLAY (overlay)->next = b->overlays_after;
4009 set_buffer_overlays_after (b, XOVERLAY (overlay));
4011 else
4013 XOVERLAY (overlay)->next = b->overlays_before;
4014 set_buffer_overlays_before (b, XOVERLAY (overlay));
4017 /* This puts it in the right list, and in the right order. */
4018 recenter_overlay_lists (b, b->overlay_center);
4020 return unbind_to (count, overlay);
4023 DEFUN ("delete-overlay", Fdelete_overlay, Sdelete_overlay, 1, 1, 0,
4024 doc: /* Delete the overlay OVERLAY from its buffer. */)
4025 (Lisp_Object overlay)
4027 Lisp_Object buffer;
4028 struct buffer *b;
4029 ptrdiff_t count = SPECPDL_INDEX ();
4031 CHECK_OVERLAY (overlay);
4033 buffer = Fmarker_buffer (OVERLAY_START (overlay));
4034 if (NILP (buffer))
4035 return Qnil;
4037 b = XBUFFER (buffer);
4038 specbind (Qinhibit_quit, Qt);
4040 unchain_both (b, overlay);
4041 drop_overlay (b, XOVERLAY (overlay));
4043 /* When deleting an overlay with before or after strings, turn off
4044 display optimizations for the affected buffer, on the basis that
4045 these strings may contain newlines. This is easier to do than to
4046 check for that situation during redisplay. */
4047 if (!windows_or_buffers_changed
4048 && (!NILP (Foverlay_get (overlay, Qbefore_string))
4049 || !NILP (Foverlay_get (overlay, Qafter_string))))
4050 b->prevent_redisplay_optimizations_p = 1;
4052 return unbind_to (count, Qnil);
4055 DEFUN ("delete-all-overlays", Fdelete_all_overlays, Sdelete_all_overlays, 0, 1, 0,
4056 doc: /* Delete all overlays of BUFFER.
4057 BUFFER omitted or nil means delete all overlays of the current
4058 buffer. */)
4059 (Lisp_Object buffer)
4061 delete_all_overlays (decode_buffer (buffer));
4062 return Qnil;
4065 /* Overlay dissection functions. */
4067 DEFUN ("overlay-start", Foverlay_start, Soverlay_start, 1, 1, 0,
4068 doc: /* Return the position at which OVERLAY starts. */)
4069 (Lisp_Object overlay)
4071 CHECK_OVERLAY (overlay);
4073 return (Fmarker_position (OVERLAY_START (overlay)));
4076 DEFUN ("overlay-end", Foverlay_end, Soverlay_end, 1, 1, 0,
4077 doc: /* Return the position at which OVERLAY ends. */)
4078 (Lisp_Object overlay)
4080 CHECK_OVERLAY (overlay);
4082 return (Fmarker_position (OVERLAY_END (overlay)));
4085 DEFUN ("overlay-buffer", Foverlay_buffer, Soverlay_buffer, 1, 1, 0,
4086 doc: /* Return the buffer OVERLAY belongs to.
4087 Return nil if OVERLAY has been deleted. */)
4088 (Lisp_Object overlay)
4090 CHECK_OVERLAY (overlay);
4092 return Fmarker_buffer (OVERLAY_START (overlay));
4095 DEFUN ("overlay-properties", Foverlay_properties, Soverlay_properties, 1, 1, 0,
4096 doc: /* Return a list of the properties on OVERLAY.
4097 This is a copy of OVERLAY's plist; modifying its conses has no effect on
4098 OVERLAY. */)
4099 (Lisp_Object overlay)
4101 CHECK_OVERLAY (overlay);
4103 return Fcopy_sequence (XOVERLAY (overlay)->plist);
4107 DEFUN ("overlays-at", Foverlays_at, Soverlays_at, 1, 2, 0,
4108 doc: /* Return a list of the overlays that contain the character at POS.
4109 If SORTED is non-nil, then sort them by decreasing priority. */)
4110 (Lisp_Object pos, Lisp_Object sorted)
4112 ptrdiff_t len, noverlays;
4113 Lisp_Object *overlay_vec;
4114 Lisp_Object result;
4116 CHECK_NUMBER_COERCE_MARKER (pos);
4118 if (!buffer_has_overlays ())
4119 return Qnil;
4121 len = 10;
4122 /* We can't use alloca here because overlays_at can call xrealloc. */
4123 overlay_vec = xmalloc (len * sizeof *overlay_vec);
4125 /* Put all the overlays we want in a vector in overlay_vec.
4126 Store the length in len. */
4127 noverlays = overlays_at (XINT (pos), 1, &overlay_vec, &len,
4128 NULL, NULL, 0);
4130 if (!NILP (sorted))
4131 noverlays = sort_overlays (overlay_vec, noverlays,
4132 WINDOWP (sorted) ? XWINDOW (sorted) : NULL);
4134 /* Make a list of them all. */
4135 result = Flist (noverlays, overlay_vec);
4137 xfree (overlay_vec);
4138 return result;
4141 DEFUN ("overlays-in", Foverlays_in, Soverlays_in, 2, 2, 0,
4142 doc: /* Return a list of the overlays that overlap the region BEG ... END.
4143 Overlap means that at least one character is contained within the overlay
4144 and also contained within the specified region.
4145 Empty overlays are included in the result if they are located at BEG,
4146 between BEG and END, or at END provided END denotes the position at the
4147 end of the buffer. */)
4148 (Lisp_Object beg, Lisp_Object end)
4150 ptrdiff_t len, noverlays;
4151 Lisp_Object *overlay_vec;
4152 Lisp_Object result;
4154 CHECK_NUMBER_COERCE_MARKER (beg);
4155 CHECK_NUMBER_COERCE_MARKER (end);
4157 if (!buffer_has_overlays ())
4158 return Qnil;
4160 len = 10;
4161 overlay_vec = xmalloc (len * sizeof *overlay_vec);
4163 /* Put all the overlays we want in a vector in overlay_vec.
4164 Store the length in len. */
4165 noverlays = overlays_in (XINT (beg), XINT (end), 1, &overlay_vec, &len,
4166 NULL, NULL);
4168 /* Make a list of them all. */
4169 result = Flist (noverlays, overlay_vec);
4171 xfree (overlay_vec);
4172 return result;
4175 DEFUN ("next-overlay-change", Fnext_overlay_change, Snext_overlay_change,
4176 1, 1, 0,
4177 doc: /* Return the next position after POS where an overlay starts or ends.
4178 If there are no overlay boundaries from POS to (point-max),
4179 the value is (point-max). */)
4180 (Lisp_Object pos)
4182 ptrdiff_t i, len, noverlays;
4183 ptrdiff_t endpos;
4184 Lisp_Object *overlay_vec;
4186 CHECK_NUMBER_COERCE_MARKER (pos);
4188 if (!buffer_has_overlays ())
4189 return make_number (ZV);
4191 len = 10;
4192 overlay_vec = xmalloc (len * sizeof *overlay_vec);
4194 /* Put all the overlays we want in a vector in overlay_vec.
4195 Store the length in len.
4196 endpos gets the position where the next overlay starts. */
4197 noverlays = overlays_at (XINT (pos), 1, &overlay_vec, &len,
4198 &endpos, 0, 1);
4200 /* If any of these overlays ends before endpos,
4201 use its ending point instead. */
4202 for (i = 0; i < noverlays; i++)
4204 Lisp_Object oend;
4205 ptrdiff_t oendpos;
4207 oend = OVERLAY_END (overlay_vec[i]);
4208 oendpos = OVERLAY_POSITION (oend);
4209 if (oendpos < endpos)
4210 endpos = oendpos;
4213 xfree (overlay_vec);
4214 return make_number (endpos);
4217 DEFUN ("previous-overlay-change", Fprevious_overlay_change,
4218 Sprevious_overlay_change, 1, 1, 0,
4219 doc: /* Return the previous position before POS where an overlay starts or ends.
4220 If there are no overlay boundaries from (point-min) to POS,
4221 the value is (point-min). */)
4222 (Lisp_Object pos)
4224 ptrdiff_t prevpos;
4225 Lisp_Object *overlay_vec;
4226 ptrdiff_t len;
4228 CHECK_NUMBER_COERCE_MARKER (pos);
4230 if (!buffer_has_overlays ())
4231 return make_number (BEGV);
4233 /* At beginning of buffer, we know the answer;
4234 avoid bug subtracting 1 below. */
4235 if (XINT (pos) == BEGV)
4236 return pos;
4238 len = 10;
4239 overlay_vec = xmalloc (len * sizeof *overlay_vec);
4241 /* Put all the overlays we want in a vector in overlay_vec.
4242 Store the length in len.
4243 prevpos gets the position of the previous change. */
4244 overlays_at (XINT (pos), 1, &overlay_vec, &len,
4245 0, &prevpos, 1);
4247 xfree (overlay_vec);
4248 return make_number (prevpos);
4251 /* These functions are for debugging overlays. */
4253 DEFUN ("overlay-lists", Foverlay_lists, Soverlay_lists, 0, 0, 0,
4254 doc: /* Return a pair of lists giving all the overlays of the current buffer.
4255 The car has all the overlays before the overlay center;
4256 the cdr has all the overlays after the overlay center.
4257 Recentering overlays moves overlays between these lists.
4258 The lists you get are copies, so that changing them has no effect.
4259 However, the overlays you get are the real objects that the buffer uses. */)
4260 (void)
4262 struct Lisp_Overlay *ol;
4263 Lisp_Object before = Qnil, after = Qnil, tmp;
4265 for (ol = current_buffer->overlays_before; ol; ol = ol->next)
4267 XSETMISC (tmp, ol);
4268 before = Fcons (tmp, before);
4270 for (ol = current_buffer->overlays_after; ol; ol = ol->next)
4272 XSETMISC (tmp, ol);
4273 after = Fcons (tmp, after);
4276 return Fcons (Fnreverse (before), Fnreverse (after));
4279 DEFUN ("overlay-recenter", Foverlay_recenter, Soverlay_recenter, 1, 1, 0,
4280 doc: /* Recenter the overlays of the current buffer around position POS.
4281 That makes overlay lookup faster for positions near POS (but perhaps slower
4282 for positions far away from POS). */)
4283 (Lisp_Object pos)
4285 ptrdiff_t p;
4286 CHECK_NUMBER_COERCE_MARKER (pos);
4288 p = clip_to_bounds (PTRDIFF_MIN, XINT (pos), PTRDIFF_MAX);
4289 recenter_overlay_lists (current_buffer, p);
4290 return Qnil;
4293 DEFUN ("overlay-get", Foverlay_get, Soverlay_get, 2, 2, 0,
4294 doc: /* Get the property of overlay OVERLAY with property name PROP. */)
4295 (Lisp_Object overlay, Lisp_Object prop)
4297 CHECK_OVERLAY (overlay);
4298 return lookup_char_property (XOVERLAY (overlay)->plist, prop, 0);
4301 DEFUN ("overlay-put", Foverlay_put, Soverlay_put, 3, 3, 0,
4302 doc: /* Set one property of overlay OVERLAY: give property PROP value VALUE.
4303 VALUE will be returned.*/)
4304 (Lisp_Object overlay, Lisp_Object prop, Lisp_Object value)
4306 Lisp_Object tail, buffer;
4307 bool changed;
4309 CHECK_OVERLAY (overlay);
4311 buffer = Fmarker_buffer (OVERLAY_START (overlay));
4313 for (tail = XOVERLAY (overlay)->plist;
4314 CONSP (tail) && CONSP (XCDR (tail));
4315 tail = XCDR (XCDR (tail)))
4316 if (EQ (XCAR (tail), prop))
4318 changed = !EQ (XCAR (XCDR (tail)), value);
4319 XSETCAR (XCDR (tail), value);
4320 goto found;
4322 /* It wasn't in the list, so add it to the front. */
4323 changed = !NILP (value);
4324 set_overlay_plist
4325 (overlay, Fcons (prop, Fcons (value, XOVERLAY (overlay)->plist)));
4326 found:
4327 if (! NILP (buffer))
4329 if (changed)
4330 modify_overlay (XBUFFER (buffer),
4331 marker_position (OVERLAY_START (overlay)),
4332 marker_position (OVERLAY_END (overlay)));
4333 if (EQ (prop, Qevaporate) && ! NILP (value)
4334 && (OVERLAY_POSITION (OVERLAY_START (overlay))
4335 == OVERLAY_POSITION (OVERLAY_END (overlay))))
4336 Fdelete_overlay (overlay);
4339 return value;
4342 /* Subroutine of report_overlay_modification. */
4344 /* Lisp vector holding overlay hook functions to call.
4345 Vector elements come in pairs.
4346 Each even-index element is a list of hook functions.
4347 The following odd-index element is the overlay they came from.
4349 Before the buffer change, we fill in this vector
4350 as we call overlay hook functions.
4351 After the buffer change, we get the functions to call from this vector.
4352 This way we always call the same functions before and after the change. */
4353 static Lisp_Object last_overlay_modification_hooks;
4355 /* Number of elements actually used in last_overlay_modification_hooks. */
4356 static ptrdiff_t last_overlay_modification_hooks_used;
4358 /* Add one functionlist/overlay pair
4359 to the end of last_overlay_modification_hooks. */
4361 static void
4362 add_overlay_mod_hooklist (Lisp_Object functionlist, Lisp_Object overlay)
4364 ptrdiff_t oldsize = ASIZE (last_overlay_modification_hooks);
4366 if (oldsize - 1 <= last_overlay_modification_hooks_used)
4367 last_overlay_modification_hooks =
4368 larger_vector (last_overlay_modification_hooks, 2, -1);
4369 ASET (last_overlay_modification_hooks, last_overlay_modification_hooks_used,
4370 functionlist); last_overlay_modification_hooks_used++;
4371 ASET (last_overlay_modification_hooks, last_overlay_modification_hooks_used,
4372 overlay); last_overlay_modification_hooks_used++;
4375 /* Run the modification-hooks of overlays that include
4376 any part of the text in START to END.
4377 If this change is an insertion, also
4378 run the insert-before-hooks of overlay starting at END,
4379 and the insert-after-hooks of overlay ending at START.
4381 This is called both before and after the modification.
4382 AFTER is true when we call after the modification.
4384 ARG1, ARG2, ARG3 are arguments to pass to the hook functions.
4385 When AFTER is nonzero, they are the start position,
4386 the position after the inserted new text,
4387 and the length of deleted or replaced old text. */
4389 void
4390 report_overlay_modification (Lisp_Object start, Lisp_Object end, bool after,
4391 Lisp_Object arg1, Lisp_Object arg2, Lisp_Object arg3)
4393 Lisp_Object prop, overlay;
4394 struct Lisp_Overlay *tail;
4395 /* True if this change is an insertion. */
4396 bool insertion = (after ? XFASTINT (arg3) == 0 : EQ (start, end));
4397 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
4399 overlay = Qnil;
4400 tail = NULL;
4402 /* We used to run the functions as soon as we found them and only register
4403 them in last_overlay_modification_hooks for the purpose of the `after'
4404 case. But running elisp code as we traverse the list of overlays is
4405 painful because the list can be modified by the elisp code so we had to
4406 copy at several places. We now simply do a read-only traversal that
4407 only collects the functions to run and we run them afterwards. It's
4408 simpler, especially since all the code was already there. -stef */
4410 if (!after)
4412 /* We are being called before a change.
4413 Scan the overlays to find the functions to call. */
4414 last_overlay_modification_hooks_used = 0;
4415 for (tail = current_buffer->overlays_before; tail; tail = tail->next)
4417 ptrdiff_t startpos, endpos;
4418 Lisp_Object ostart, oend;
4420 XSETMISC (overlay, tail);
4422 ostart = OVERLAY_START (overlay);
4423 oend = OVERLAY_END (overlay);
4424 endpos = OVERLAY_POSITION (oend);
4425 if (XFASTINT (start) > endpos)
4426 break;
4427 startpos = OVERLAY_POSITION (ostart);
4428 if (insertion && (XFASTINT (start) == startpos
4429 || XFASTINT (end) == startpos))
4431 prop = Foverlay_get (overlay, Qinsert_in_front_hooks);
4432 if (!NILP (prop))
4433 add_overlay_mod_hooklist (prop, overlay);
4435 if (insertion && (XFASTINT (start) == endpos
4436 || XFASTINT (end) == endpos))
4438 prop = Foverlay_get (overlay, Qinsert_behind_hooks);
4439 if (!NILP (prop))
4440 add_overlay_mod_hooklist (prop, overlay);
4442 /* Test for intersecting intervals. This does the right thing
4443 for both insertion and deletion. */
4444 if (XFASTINT (end) > startpos && XFASTINT (start) < endpos)
4446 prop = Foverlay_get (overlay, Qmodification_hooks);
4447 if (!NILP (prop))
4448 add_overlay_mod_hooklist (prop, overlay);
4452 for (tail = current_buffer->overlays_after; tail; tail = tail->next)
4454 ptrdiff_t startpos, endpos;
4455 Lisp_Object ostart, oend;
4457 XSETMISC (overlay, tail);
4459 ostart = OVERLAY_START (overlay);
4460 oend = OVERLAY_END (overlay);
4461 startpos = OVERLAY_POSITION (ostart);
4462 endpos = OVERLAY_POSITION (oend);
4463 if (XFASTINT (end) < startpos)
4464 break;
4465 if (insertion && (XFASTINT (start) == startpos
4466 || XFASTINT (end) == startpos))
4468 prop = Foverlay_get (overlay, Qinsert_in_front_hooks);
4469 if (!NILP (prop))
4470 add_overlay_mod_hooklist (prop, overlay);
4472 if (insertion && (XFASTINT (start) == endpos
4473 || XFASTINT (end) == endpos))
4475 prop = Foverlay_get (overlay, Qinsert_behind_hooks);
4476 if (!NILP (prop))
4477 add_overlay_mod_hooklist (prop, overlay);
4479 /* Test for intersecting intervals. This does the right thing
4480 for both insertion and deletion. */
4481 if (XFASTINT (end) > startpos && XFASTINT (start) < endpos)
4483 prop = Foverlay_get (overlay, Qmodification_hooks);
4484 if (!NILP (prop))
4485 add_overlay_mod_hooklist (prop, overlay);
4490 GCPRO4 (overlay, arg1, arg2, arg3);
4492 /* Call the functions recorded in last_overlay_modification_hooks.
4493 First copy the vector contents, in case some of these hooks
4494 do subsequent modification of the buffer. */
4495 ptrdiff_t size = last_overlay_modification_hooks_used;
4496 Lisp_Object *copy;
4497 ptrdiff_t i;
4499 USE_SAFE_ALLOCA;
4500 SAFE_ALLOCA_LISP (copy, size);
4501 memcpy (copy, XVECTOR (last_overlay_modification_hooks)->contents,
4502 size * word_size);
4504 for (i = 0; i < size;)
4506 Lisp_Object prop_i, overlay_i;
4507 prop_i = copy[i++];
4508 overlay_i = copy[i++];
4509 call_overlay_mod_hooks (prop_i, overlay_i, after, arg1, arg2, arg3);
4512 SAFE_FREE ();
4514 UNGCPRO;
4517 static void
4518 call_overlay_mod_hooks (Lisp_Object list, Lisp_Object overlay, bool after,
4519 Lisp_Object arg1, Lisp_Object arg2, Lisp_Object arg3)
4521 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
4523 GCPRO4 (list, arg1, arg2, arg3);
4525 while (CONSP (list))
4527 if (NILP (arg3))
4528 call4 (XCAR (list), overlay, after ? Qt : Qnil, arg1, arg2);
4529 else
4530 call5 (XCAR (list), overlay, after ? Qt : Qnil, arg1, arg2, arg3);
4531 list = XCDR (list);
4533 UNGCPRO;
4536 /* Delete any zero-sized overlays at position POS, if the `evaporate'
4537 property is set. */
4538 void
4539 evaporate_overlays (ptrdiff_t pos)
4541 Lisp_Object overlay, hit_list;
4542 struct Lisp_Overlay *tail;
4544 hit_list = Qnil;
4545 if (pos <= current_buffer->overlay_center)
4546 for (tail = current_buffer->overlays_before; tail; tail = tail->next)
4548 ptrdiff_t endpos;
4549 XSETMISC (overlay, tail);
4550 endpos = OVERLAY_POSITION (OVERLAY_END (overlay));
4551 if (endpos < pos)
4552 break;
4553 if (endpos == pos && OVERLAY_POSITION (OVERLAY_START (overlay)) == pos
4554 && ! NILP (Foverlay_get (overlay, Qevaporate)))
4555 hit_list = Fcons (overlay, hit_list);
4557 else
4558 for (tail = current_buffer->overlays_after; tail; tail = tail->next)
4560 ptrdiff_t startpos;
4561 XSETMISC (overlay, tail);
4562 startpos = OVERLAY_POSITION (OVERLAY_START (overlay));
4563 if (startpos > pos)
4564 break;
4565 if (startpos == pos && OVERLAY_POSITION (OVERLAY_END (overlay)) == pos
4566 && ! NILP (Foverlay_get (overlay, Qevaporate)))
4567 hit_list = Fcons (overlay, hit_list);
4569 for (; CONSP (hit_list); hit_list = XCDR (hit_list))
4570 Fdelete_overlay (XCAR (hit_list));
4573 /***********************************************************************
4574 Allocation with mmap
4575 ***********************************************************************/
4577 /* Note: WINDOWSNT implements this stuff on w32heap.c. */
4578 #if defined USE_MMAP_FOR_BUFFERS && !defined WINDOWSNT
4580 #include <sys/mman.h>
4582 #ifndef MAP_ANON
4583 #ifdef MAP_ANONYMOUS
4584 #define MAP_ANON MAP_ANONYMOUS
4585 #else
4586 #define MAP_ANON 0
4587 #endif
4588 #endif
4590 #ifndef MAP_FAILED
4591 #define MAP_FAILED ((void *) -1)
4592 #endif
4594 #if MAP_ANON == 0
4595 #include <fcntl.h>
4596 #endif
4598 #include "coding.h"
4601 /* Memory is allocated in regions which are mapped using mmap(2).
4602 The current implementation lets the system select mapped
4603 addresses; we're not using MAP_FIXED in general, except when
4604 trying to enlarge regions.
4606 Each mapped region starts with a mmap_region structure, the user
4607 area starts after that structure, aligned to MEM_ALIGN.
4609 +-----------------------+
4610 | struct mmap_info + |
4611 | padding |
4612 +-----------------------+
4613 | user data |
4616 +-----------------------+ */
4618 struct mmap_region
4620 /* User-specified size. */
4621 size_t nbytes_specified;
4623 /* Number of bytes mapped */
4624 size_t nbytes_mapped;
4626 /* Pointer to the location holding the address of the memory
4627 allocated with the mmap'd block. The variable actually points
4628 after this structure. */
4629 void **var;
4631 /* Next and previous in list of all mmap'd regions. */
4632 struct mmap_region *next, *prev;
4635 /* Doubly-linked list of mmap'd regions. */
4637 static struct mmap_region *mmap_regions;
4639 /* File descriptor for mmap. If we don't have anonymous mapping,
4640 /dev/zero will be opened on it. */
4642 static int mmap_fd;
4644 /* Page size on this system. */
4646 static int mmap_page_size;
4648 /* 1 means mmap has been initialized. */
4650 static bool mmap_initialized_p;
4652 /* Value is X rounded up to the next multiple of N. */
4654 #define ROUND(X, N) (((X) + (N) - 1) / (N) * (N))
4656 /* Size of mmap_region structure plus padding. */
4658 #define MMAP_REGION_STRUCT_SIZE \
4659 ROUND (sizeof (struct mmap_region), MEM_ALIGN)
4661 /* Given a pointer P to the start of the user-visible part of a mapped
4662 region, return a pointer to the start of the region. */
4664 #define MMAP_REGION(P) \
4665 ((struct mmap_region *) ((char *) (P) - MMAP_REGION_STRUCT_SIZE))
4667 /* Given a pointer P to the start of a mapped region, return a pointer
4668 to the start of the user-visible part of the region. */
4670 #define MMAP_USER_AREA(P) \
4671 ((void *) ((char *) (P) + MMAP_REGION_STRUCT_SIZE))
4673 #define MEM_ALIGN sizeof (double)
4675 /* Predicate returning true if part of the address range [START .. END]
4676 is currently mapped. Used to prevent overwriting an existing
4677 memory mapping.
4679 Default is to conservatively assume the address range is occupied by
4680 something else. This can be overridden by system configuration
4681 files if system-specific means to determine this exists. */
4683 #ifndef MMAP_ALLOCATED_P
4684 #define MMAP_ALLOCATED_P(start, end) 1
4685 #endif
4687 /* Perform necessary initializations for the use of mmap. */
4689 static void
4690 mmap_init (void)
4692 #if MAP_ANON == 0
4693 /* The value of mmap_fd is initially 0 in temacs, and -1
4694 in a dumped Emacs. */
4695 if (mmap_fd <= 0)
4697 /* No anonymous mmap -- we need the file descriptor. */
4698 mmap_fd = emacs_open ("/dev/zero", O_RDONLY, 0);
4699 if (mmap_fd == -1)
4700 fatal ("Cannot open /dev/zero: %s", emacs_strerror (errno));
4702 #endif /* MAP_ANON == 0 */
4704 if (mmap_initialized_p)
4705 return;
4706 mmap_initialized_p = 1;
4708 #if MAP_ANON != 0
4709 mmap_fd = -1;
4710 #endif
4712 mmap_page_size = getpagesize ();
4715 /* Unmap a region. P is a pointer to the start of the user-araa of
4716 the region. */
4718 static void
4719 mmap_free_1 (struct mmap_region *r)
4721 if (r->next)
4722 r->next->prev = r->prev;
4723 if (r->prev)
4724 r->prev->next = r->next;
4725 else
4726 mmap_regions = r->next;
4728 if (munmap (r, r->nbytes_mapped) == -1)
4729 fprintf (stderr, "munmap: %s\n", emacs_strerror (errno));
4733 /* Enlarge region R by NPAGES pages. NPAGES < 0 means shrink R.
4734 Value is true if successful. */
4736 static bool
4737 mmap_enlarge (struct mmap_region *r, int npages)
4739 char *region_end = (char *) r + r->nbytes_mapped;
4740 size_t nbytes;
4741 bool success = 0;
4743 if (npages < 0)
4745 /* Unmap pages at the end of the region. */
4746 nbytes = - npages * mmap_page_size;
4747 if (munmap (region_end - nbytes, nbytes) == -1)
4748 fprintf (stderr, "munmap: %s\n", emacs_strerror (errno));
4749 else
4751 r->nbytes_mapped -= nbytes;
4752 success = 1;
4755 else if (npages > 0)
4757 nbytes = npages * mmap_page_size;
4759 /* Try to map additional pages at the end of the region. We
4760 cannot do this if the address range is already occupied by
4761 something else because mmap deletes any previous mapping.
4762 I'm not sure this is worth doing, let's see. */
4763 if (!MMAP_ALLOCATED_P (region_end, region_end + nbytes))
4765 void *p;
4767 p = mmap (region_end, nbytes, PROT_READ | PROT_WRITE,
4768 MAP_ANON | MAP_PRIVATE | MAP_FIXED, mmap_fd, 0);
4769 if (p == MAP_FAILED)
4770 ; /* fprintf (stderr, "mmap: %s\n", emacs_strerror (errno)); */
4771 else if (p != region_end)
4773 /* Kernels are free to choose a different address. In
4774 that case, unmap what we've mapped above; we have
4775 no use for it. */
4776 if (munmap (p, nbytes) == -1)
4777 fprintf (stderr, "munmap: %s\n", emacs_strerror (errno));
4779 else
4781 r->nbytes_mapped += nbytes;
4782 success = 1;
4787 return success;
4791 /* Allocate a block of storage large enough to hold NBYTES bytes of
4792 data. A pointer to the data is returned in *VAR. VAR is thus the
4793 address of some variable which will use the data area.
4795 The allocation of 0 bytes is valid.
4797 If we can't allocate the necessary memory, set *VAR to null, and
4798 return null. */
4800 static void *
4801 mmap_alloc (void **var, size_t nbytes)
4803 void *p;
4804 size_t map;
4806 mmap_init ();
4808 map = ROUND (nbytes + MMAP_REGION_STRUCT_SIZE, mmap_page_size);
4809 p = mmap (NULL, map, PROT_READ | PROT_WRITE, MAP_ANON | MAP_PRIVATE,
4810 mmap_fd, 0);
4812 if (p == MAP_FAILED)
4814 if (errno != ENOMEM)
4815 fprintf (stderr, "mmap: %s\n", emacs_strerror (errno));
4816 p = NULL;
4818 else
4820 struct mmap_region *r = p;
4822 r->nbytes_specified = nbytes;
4823 r->nbytes_mapped = map;
4824 r->var = var;
4825 r->prev = NULL;
4826 r->next = mmap_regions;
4827 if (r->next)
4828 r->next->prev = r;
4829 mmap_regions = r;
4831 p = MMAP_USER_AREA (p);
4834 return *var = p;
4838 /* Free a block of relocatable storage whose data is pointed to by
4839 PTR. Store 0 in *PTR to show there's no block allocated. */
4841 static void
4842 mmap_free (void **var)
4844 mmap_init ();
4846 if (*var)
4848 mmap_free_1 (MMAP_REGION (*var));
4849 *var = NULL;
4854 /* Given a pointer at address VAR to data allocated with mmap_alloc,
4855 resize it to size NBYTES. Change *VAR to reflect the new block,
4856 and return this value. If more memory cannot be allocated, then
4857 leave *VAR unchanged, and return null. */
4859 static void *
4860 mmap_realloc (void **var, size_t nbytes)
4862 void *result;
4864 mmap_init ();
4866 if (*var == NULL)
4867 result = mmap_alloc (var, nbytes);
4868 else if (nbytes == 0)
4870 mmap_free (var);
4871 result = mmap_alloc (var, nbytes);
4873 else
4875 struct mmap_region *r = MMAP_REGION (*var);
4876 size_t room = r->nbytes_mapped - MMAP_REGION_STRUCT_SIZE;
4878 if (room < nbytes)
4880 /* Must enlarge. */
4881 void *old_ptr = *var;
4883 /* Try to map additional pages at the end of the region.
4884 If that fails, allocate a new region, copy data
4885 from the old region, then free it. */
4886 if (mmap_enlarge (r, (ROUND (nbytes - room, mmap_page_size)
4887 / mmap_page_size)))
4889 r->nbytes_specified = nbytes;
4890 *var = result = old_ptr;
4892 else if (mmap_alloc (var, nbytes))
4894 memcpy (*var, old_ptr, r->nbytes_specified);
4895 mmap_free_1 (MMAP_REGION (old_ptr));
4896 result = *var;
4897 r = MMAP_REGION (result);
4898 r->nbytes_specified = nbytes;
4900 else
4902 *var = old_ptr;
4903 result = NULL;
4906 else if (room - nbytes >= mmap_page_size)
4908 /* Shrinking by at least a page. Let's give some
4909 memory back to the system.
4911 The extra parens are to make the division happens first,
4912 on positive values, so we know it will round towards
4913 zero. */
4914 mmap_enlarge (r, - ((room - nbytes) / mmap_page_size));
4915 result = *var;
4916 r->nbytes_specified = nbytes;
4918 else
4920 /* Leave it alone. */
4921 result = *var;
4922 r->nbytes_specified = nbytes;
4926 return result;
4930 #endif /* USE_MMAP_FOR_BUFFERS */
4934 /***********************************************************************
4935 Buffer-text Allocation
4936 ***********************************************************************/
4938 /* Allocate NBYTES bytes for buffer B's text buffer. */
4940 static void
4941 alloc_buffer_text (struct buffer *b, ptrdiff_t nbytes)
4943 void *p;
4945 block_input ();
4946 #if defined USE_MMAP_FOR_BUFFERS
4947 p = mmap_alloc ((void **) &b->text->beg, nbytes);
4948 #elif defined REL_ALLOC
4949 p = r_alloc ((void **) &b->text->beg, nbytes);
4950 #else
4951 p = xmalloc (nbytes);
4952 #endif
4954 if (p == NULL)
4956 unblock_input ();
4957 memory_full (nbytes);
4960 b->text->beg = p;
4961 unblock_input ();
4964 /* Enlarge buffer B's text buffer by DELTA bytes. DELTA < 0 means
4965 shrink it. */
4967 void
4968 enlarge_buffer_text (struct buffer *b, ptrdiff_t delta)
4970 void *p;
4971 ptrdiff_t nbytes = (BUF_Z_BYTE (b) - BUF_BEG_BYTE (b) + BUF_GAP_SIZE (b) + 1
4972 + delta);
4973 block_input ();
4974 #if defined USE_MMAP_FOR_BUFFERS
4975 p = mmap_realloc ((void **) &b->text->beg, nbytes);
4976 #elif defined REL_ALLOC
4977 p = r_re_alloc ((void **) &b->text->beg, nbytes);
4978 #else
4979 p = xrealloc (b->text->beg, nbytes);
4980 #endif
4982 if (p == NULL)
4984 unblock_input ();
4985 memory_full (nbytes);
4988 BUF_BEG_ADDR (b) = p;
4989 unblock_input ();
4993 /* Free buffer B's text buffer. */
4995 static void
4996 free_buffer_text (struct buffer *b)
4998 block_input ();
5000 #if defined USE_MMAP_FOR_BUFFERS
5001 mmap_free ((void **) &b->text->beg);
5002 #elif defined REL_ALLOC
5003 r_alloc_free ((void **) &b->text->beg);
5004 #else
5005 xfree (b->text->beg);
5006 #endif
5008 BUF_BEG_ADDR (b) = NULL;
5009 unblock_input ();
5014 /***********************************************************************
5015 Initialization
5016 ***********************************************************************/
5018 void
5019 init_buffer_once (void)
5021 int idx;
5023 memset (buffer_permanent_local_flags, 0, sizeof buffer_permanent_local_flags);
5025 /* 0 means not a lisp var, -1 means always local, else mask. */
5026 memset (&buffer_local_flags, 0, sizeof buffer_local_flags);
5027 bset_filename (&buffer_local_flags, make_number (-1));
5028 bset_directory (&buffer_local_flags, make_number (-1));
5029 bset_backed_up (&buffer_local_flags, make_number (-1));
5030 bset_save_length (&buffer_local_flags, make_number (-1));
5031 bset_auto_save_file_name (&buffer_local_flags, make_number (-1));
5032 bset_read_only (&buffer_local_flags, make_number (-1));
5033 bset_major_mode (&buffer_local_flags, make_number (-1));
5034 bset_mode_name (&buffer_local_flags, make_number (-1));
5035 bset_undo_list (&buffer_local_flags, make_number (-1));
5036 bset_mark_active (&buffer_local_flags, make_number (-1));
5037 bset_point_before_scroll (&buffer_local_flags, make_number (-1));
5038 bset_file_truename (&buffer_local_flags, make_number (-1));
5039 bset_invisibility_spec (&buffer_local_flags, make_number (-1));
5040 bset_file_format (&buffer_local_flags, make_number (-1));
5041 bset_auto_save_file_format (&buffer_local_flags, make_number (-1));
5042 bset_display_count (&buffer_local_flags, make_number (-1));
5043 bset_display_time (&buffer_local_flags, make_number (-1));
5044 bset_enable_multibyte_characters (&buffer_local_flags, make_number (-1));
5046 /* These used to be stuck at 0 by default, but now that the all-zero value
5047 means Qnil, we have to initialize them explicitly. */
5048 bset_name (&buffer_local_flags, make_number (0));
5049 bset_mark (&buffer_local_flags, make_number (0));
5050 bset_local_var_alist (&buffer_local_flags, make_number (0));
5051 bset_keymap (&buffer_local_flags, make_number (0));
5052 bset_downcase_table (&buffer_local_flags, make_number (0));
5053 bset_upcase_table (&buffer_local_flags, make_number (0));
5054 bset_case_canon_table (&buffer_local_flags, make_number (0));
5055 bset_case_eqv_table (&buffer_local_flags, make_number (0));
5056 bset_minor_modes (&buffer_local_flags, make_number (0));
5057 bset_width_table (&buffer_local_flags, make_number (0));
5058 bset_pt_marker (&buffer_local_flags, make_number (0));
5059 bset_begv_marker (&buffer_local_flags, make_number (0));
5060 bset_zv_marker (&buffer_local_flags, make_number (0));
5061 bset_last_selected_window (&buffer_local_flags, make_number (0));
5063 idx = 1;
5064 XSETFASTINT (BVAR (&buffer_local_flags, mode_line_format), idx); ++idx;
5065 XSETFASTINT (BVAR (&buffer_local_flags, abbrev_mode), idx); ++idx;
5066 XSETFASTINT (BVAR (&buffer_local_flags, overwrite_mode), idx); ++idx;
5067 XSETFASTINT (BVAR (&buffer_local_flags, case_fold_search), idx); ++idx;
5068 XSETFASTINT (BVAR (&buffer_local_flags, auto_fill_function), idx); ++idx;
5069 XSETFASTINT (BVAR (&buffer_local_flags, selective_display), idx); ++idx;
5070 XSETFASTINT (BVAR (&buffer_local_flags, selective_display_ellipses), idx); ++idx;
5071 XSETFASTINT (BVAR (&buffer_local_flags, tab_width), idx); ++idx;
5072 XSETFASTINT (BVAR (&buffer_local_flags, truncate_lines), idx); ++idx;
5073 XSETFASTINT (BVAR (&buffer_local_flags, word_wrap), idx); ++idx;
5074 XSETFASTINT (BVAR (&buffer_local_flags, ctl_arrow), idx); ++idx;
5075 XSETFASTINT (BVAR (&buffer_local_flags, fill_column), idx); ++idx;
5076 XSETFASTINT (BVAR (&buffer_local_flags, left_margin), idx); ++idx;
5077 XSETFASTINT (BVAR (&buffer_local_flags, abbrev_table), idx); ++idx;
5078 XSETFASTINT (BVAR (&buffer_local_flags, display_table), idx); ++idx;
5079 XSETFASTINT (BVAR (&buffer_local_flags, syntax_table), idx); ++idx;
5080 XSETFASTINT (BVAR (&buffer_local_flags, cache_long_scans), idx); ++idx;
5081 XSETFASTINT (BVAR (&buffer_local_flags, category_table), idx); ++idx;
5082 XSETFASTINT (BVAR (&buffer_local_flags, bidi_display_reordering), idx); ++idx;
5083 XSETFASTINT (BVAR (&buffer_local_flags, bidi_paragraph_direction), idx); ++idx;
5084 XSETFASTINT (BVAR (&buffer_local_flags, buffer_file_coding_system), idx);
5085 /* Make this one a permanent local. */
5086 buffer_permanent_local_flags[idx++] = 1;
5087 XSETFASTINT (BVAR (&buffer_local_flags, left_margin_cols), idx); ++idx;
5088 XSETFASTINT (BVAR (&buffer_local_flags, right_margin_cols), idx); ++idx;
5089 XSETFASTINT (BVAR (&buffer_local_flags, left_fringe_width), idx); ++idx;
5090 XSETFASTINT (BVAR (&buffer_local_flags, right_fringe_width), idx); ++idx;
5091 XSETFASTINT (BVAR (&buffer_local_flags, fringes_outside_margins), idx); ++idx;
5092 XSETFASTINT (BVAR (&buffer_local_flags, scroll_bar_width), idx); ++idx;
5093 XSETFASTINT (BVAR (&buffer_local_flags, scroll_bar_height), idx); ++idx;
5094 XSETFASTINT (BVAR (&buffer_local_flags, vertical_scroll_bar_type), idx); ++idx;
5095 XSETFASTINT (BVAR (&buffer_local_flags, horizontal_scroll_bar_type), idx); ++idx;
5096 XSETFASTINT (BVAR (&buffer_local_flags, indicate_empty_lines), idx); ++idx;
5097 XSETFASTINT (BVAR (&buffer_local_flags, indicate_buffer_boundaries), idx); ++idx;
5098 XSETFASTINT (BVAR (&buffer_local_flags, fringe_indicator_alist), idx); ++idx;
5099 XSETFASTINT (BVAR (&buffer_local_flags, fringe_cursor_alist), idx); ++idx;
5100 XSETFASTINT (BVAR (&buffer_local_flags, scroll_up_aggressively), idx); ++idx;
5101 XSETFASTINT (BVAR (&buffer_local_flags, scroll_down_aggressively), idx); ++idx;
5102 XSETFASTINT (BVAR (&buffer_local_flags, header_line_format), idx); ++idx;
5103 XSETFASTINT (BVAR (&buffer_local_flags, cursor_type), idx); ++idx;
5104 XSETFASTINT (BVAR (&buffer_local_flags, extra_line_spacing), idx); ++idx;
5105 XSETFASTINT (BVAR (&buffer_local_flags, cursor_in_non_selected_windows), idx); ++idx;
5107 /* Need more room? */
5108 if (idx >= MAX_PER_BUFFER_VARS)
5109 emacs_abort ();
5110 last_per_buffer_idx = idx;
5112 /* Make sure all markable slots in buffer_defaults
5113 are initialized reasonably, so mark_buffer won't choke. */
5114 reset_buffer (&buffer_defaults);
5115 eassert (NILP (BVAR (&buffer_defaults, name)));
5116 reset_buffer_local_variables (&buffer_defaults, 1);
5117 eassert (NILP (BVAR (&buffer_local_symbols, name)));
5118 reset_buffer (&buffer_local_symbols);
5119 reset_buffer_local_variables (&buffer_local_symbols, 1);
5120 /* Prevent GC from getting confused. */
5121 buffer_defaults.text = &buffer_defaults.own_text;
5122 buffer_local_symbols.text = &buffer_local_symbols.own_text;
5123 /* No one will share the text with these buffers, but let's play it safe. */
5124 buffer_defaults.indirections = 0;
5125 buffer_local_symbols.indirections = 0;
5126 /* Likewise no one will display them. */
5127 buffer_defaults.window_count = 0;
5128 buffer_local_symbols.window_count = 0;
5129 set_buffer_intervals (&buffer_defaults, NULL);
5130 set_buffer_intervals (&buffer_local_symbols, NULL);
5131 /* This is not strictly necessary, but let's make them initialized. */
5132 bset_name (&buffer_defaults, build_pure_c_string (" *buffer-defaults*"));
5133 bset_name (&buffer_local_symbols, build_pure_c_string (" *buffer-local-symbols*"));
5134 BUFFER_PVEC_INIT (&buffer_defaults);
5135 BUFFER_PVEC_INIT (&buffer_local_symbols);
5137 /* Set up the default values of various buffer slots. */
5138 /* Must do these before making the first buffer! */
5140 /* real setup is done in bindings.el */
5141 bset_mode_line_format (&buffer_defaults, build_pure_c_string ("%-"));
5142 bset_header_line_format (&buffer_defaults, Qnil);
5143 bset_abbrev_mode (&buffer_defaults, Qnil);
5144 bset_overwrite_mode (&buffer_defaults, Qnil);
5145 bset_case_fold_search (&buffer_defaults, Qt);
5146 bset_auto_fill_function (&buffer_defaults, Qnil);
5147 bset_selective_display (&buffer_defaults, Qnil);
5148 bset_selective_display_ellipses (&buffer_defaults, Qt);
5149 bset_abbrev_table (&buffer_defaults, Qnil);
5150 bset_display_table (&buffer_defaults, Qnil);
5151 bset_undo_list (&buffer_defaults, Qnil);
5152 bset_mark_active (&buffer_defaults, Qnil);
5153 bset_file_format (&buffer_defaults, Qnil);
5154 bset_auto_save_file_format (&buffer_defaults, Qt);
5155 set_buffer_overlays_before (&buffer_defaults, NULL);
5156 set_buffer_overlays_after (&buffer_defaults, NULL);
5157 buffer_defaults.overlay_center = BEG;
5159 XSETFASTINT (BVAR (&buffer_defaults, tab_width), 8);
5160 bset_truncate_lines (&buffer_defaults, Qnil);
5161 bset_word_wrap (&buffer_defaults, Qnil);
5162 bset_ctl_arrow (&buffer_defaults, Qt);
5163 bset_bidi_display_reordering (&buffer_defaults, Qt);
5164 bset_bidi_paragraph_direction (&buffer_defaults, Qnil);
5165 bset_cursor_type (&buffer_defaults, Qt);
5166 bset_extra_line_spacing (&buffer_defaults, Qnil);
5167 bset_cursor_in_non_selected_windows (&buffer_defaults, Qt);
5169 bset_enable_multibyte_characters (&buffer_defaults, Qt);
5170 bset_buffer_file_coding_system (&buffer_defaults, Qnil);
5171 XSETFASTINT (BVAR (&buffer_defaults, fill_column), 70);
5172 XSETFASTINT (BVAR (&buffer_defaults, left_margin), 0);
5173 bset_cache_long_scans (&buffer_defaults, Qt);
5174 bset_file_truename (&buffer_defaults, Qnil);
5175 XSETFASTINT (BVAR (&buffer_defaults, display_count), 0);
5176 XSETFASTINT (BVAR (&buffer_defaults, left_margin_cols), 0);
5177 XSETFASTINT (BVAR (&buffer_defaults, right_margin_cols), 0);
5178 bset_left_fringe_width (&buffer_defaults, Qnil);
5179 bset_right_fringe_width (&buffer_defaults, Qnil);
5180 bset_fringes_outside_margins (&buffer_defaults, Qnil);
5181 bset_scroll_bar_width (&buffer_defaults, Qnil);
5182 bset_scroll_bar_height (&buffer_defaults, Qnil);
5183 bset_vertical_scroll_bar_type (&buffer_defaults, Qt);
5184 bset_horizontal_scroll_bar_type (&buffer_defaults, Qt);
5185 bset_indicate_empty_lines (&buffer_defaults, Qnil);
5186 bset_indicate_buffer_boundaries (&buffer_defaults, Qnil);
5187 bset_fringe_indicator_alist (&buffer_defaults, Qnil);
5188 bset_fringe_cursor_alist (&buffer_defaults, Qnil);
5189 bset_scroll_up_aggressively (&buffer_defaults, Qnil);
5190 bset_scroll_down_aggressively (&buffer_defaults, Qnil);
5191 bset_display_time (&buffer_defaults, Qnil);
5193 /* Assign the local-flags to the slots that have default values.
5194 The local flag is a bit that is used in the buffer
5195 to say that it has its own local value for the slot.
5196 The local flag bits are in the local_var_flags slot of the buffer. */
5198 /* Nothing can work if this isn't true. */
5199 { verify (sizeof (EMACS_INT) == word_size); }
5201 Vbuffer_alist = Qnil;
5202 current_buffer = 0;
5203 all_buffers = 0;
5205 QSFundamental = build_pure_c_string ("Fundamental");
5207 DEFSYM (Qfundamental_mode, "fundamental-mode");
5208 bset_major_mode (&buffer_defaults, Qfundamental_mode);
5210 DEFSYM (Qmode_class, "mode-class");
5211 DEFSYM (Qprotected_field, "protected-field");
5213 DEFSYM (Qpermanent_local, "permanent-local");
5214 DEFSYM (Qkill_buffer_hook, "kill-buffer-hook");
5215 Fput (Qkill_buffer_hook, Qpermanent_local, Qt);
5217 /* Super-magic invisible buffer. */
5218 Vprin1_to_string_buffer = Fget_buffer_create (build_pure_c_string (" prin1"));
5219 Vbuffer_alist = Qnil;
5221 Fset_buffer (Fget_buffer_create (build_pure_c_string ("*scratch*")));
5223 inhibit_modification_hooks = 0;
5226 void
5227 init_buffer (int initialized)
5229 char *pwd;
5230 Lisp_Object temp;
5231 ptrdiff_t len;
5233 #ifdef USE_MMAP_FOR_BUFFERS
5234 if (initialized)
5236 struct buffer *b;
5238 #ifndef WINDOWSNT
5239 /* These must be reset in the dumped Emacs, to avoid stale
5240 references to mmap'ed memory from before the dump.
5242 WINDOWSNT doesn't need this because it doesn't track mmap'ed
5243 regions by hand (see w32heap.c, which uses system APIs for
5244 that purpose), and thus doesn't use mmap_regions. */
5245 mmap_regions = NULL;
5246 mmap_fd = -1;
5247 #endif
5249 /* The dumped buffers reference addresses of buffer text
5250 recorded by temacs, that cannot be used by the dumped Emacs.
5251 We map new memory for their text here.
5253 Implementation note: the buffers we carry from temacs are:
5254 " prin1", "*scratch*", " *Minibuf-0*", "*Messages*", and
5255 " *code-conversion-work*". They are created by
5256 init_buffer_once and init_window_once (which are not called
5257 in the dumped Emacs), and by the first call to coding.c routines. */
5258 FOR_EACH_BUFFER (b)
5260 b->text->beg = NULL;
5261 enlarge_buffer_text (b, 0);
5264 else
5266 struct buffer *b;
5268 /* Only buffers with allocated buffer text should be present at
5269 this point in temacs. */
5270 FOR_EACH_BUFFER (b)
5272 eassert (b->text->beg != NULL);
5275 #else /* not USE_MMAP_FOR_BUFFERS */
5276 /* Avoid compiler warnings. */
5277 (void) initialized;
5278 #endif /* USE_MMAP_FOR_BUFFERS */
5280 AUTO_STRING (scratch, "*scratch*");
5281 Fset_buffer (Fget_buffer_create (scratch));
5282 if (NILP (BVAR (&buffer_defaults, enable_multibyte_characters)))
5283 Fset_buffer_multibyte (Qnil);
5285 pwd = get_current_dir_name ();
5287 if (!pwd)
5289 fprintf (stderr, "Error getting directory: %s\n",
5290 emacs_strerror (errno));
5291 bset_directory (current_buffer, Qnil);
5293 else
5295 /* Maybe this should really use some standard subroutine
5296 whose definition is filename syntax dependent. */
5297 len = strlen (pwd);
5298 if (!(IS_DIRECTORY_SEP (pwd[len - 1])))
5300 /* Grow buffer to add directory separator and '\0'. */
5301 pwd = realloc (pwd, len + 2);
5302 if (!pwd)
5303 fatal ("get_current_dir_name: %s\n", strerror (errno));
5304 pwd[len] = DIRECTORY_SEP;
5305 pwd[len + 1] = '\0';
5306 len++;
5309 /* At this moment, we still don't know how to decode the directory
5310 name. So, we keep the bytes in unibyte form so that file I/O
5311 routines correctly get the original bytes. */
5312 bset_directory (current_buffer, make_unibyte_string (pwd, len));
5314 /* Add /: to the front of the name
5315 if it would otherwise be treated as magic. */
5316 temp = Ffind_file_name_handler (BVAR (current_buffer, directory), Qt);
5317 if (! NILP (temp)
5318 /* If the default dir is just /, TEMP is non-nil
5319 because of the ange-ftp completion handler.
5320 However, it is not necessary to turn / into /:/.
5321 So avoid doing that. */
5322 && strcmp ("/", SSDATA (BVAR (current_buffer, directory))))
5324 AUTO_STRING (slash_colon, "/:");
5325 bset_directory (current_buffer,
5326 concat2 (slash_colon,
5327 BVAR (current_buffer, directory)));
5331 temp = get_minibuffer (0);
5332 bset_directory (XBUFFER (temp), BVAR (current_buffer, directory));
5334 free (pwd);
5337 /* Similar to defvar_lisp but define a variable whose value is the
5338 Lisp_Object stored in the current buffer. LNAME is the Lisp-level
5339 variable name. VNAME is the name of the buffer slot. PREDICATE
5340 is nil for a general Lisp variable. If PREDICATE is non-nil, then
5341 only Lisp values that satisfies the PREDICATE are allowed (except
5342 that nil is allowed too). DOC is a dummy where you write the doc
5343 string as a comment. */
5345 #define DEFVAR_PER_BUFFER(lname, vname, predicate, doc) \
5346 do { \
5347 static struct Lisp_Buffer_Objfwd bo_fwd; \
5348 defvar_per_buffer (&bo_fwd, lname, vname, predicate); \
5349 } while (0)
5351 static void
5352 defvar_per_buffer (struct Lisp_Buffer_Objfwd *bo_fwd, const char *namestring,
5353 Lisp_Object *address, Lisp_Object predicate)
5355 struct Lisp_Symbol *sym;
5356 int offset;
5358 sym = XSYMBOL (intern (namestring));
5359 offset = (char *)address - (char *)current_buffer;
5361 bo_fwd->type = Lisp_Fwd_Buffer_Obj;
5362 bo_fwd->offset = offset;
5363 bo_fwd->predicate = predicate;
5364 sym->declared_special = 1;
5365 sym->redirect = SYMBOL_FORWARDED;
5366 SET_SYMBOL_FWD (sym, (union Lisp_Fwd *) bo_fwd);
5367 XSETSYMBOL (PER_BUFFER_SYMBOL (offset), sym);
5369 if (PER_BUFFER_IDX (offset) == 0)
5370 /* Did a DEFVAR_PER_BUFFER without initializing the corresponding
5371 slot of buffer_local_flags. */
5372 emacs_abort ();
5376 /* Initialize the buffer routines. */
5377 void
5378 syms_of_buffer (void)
5380 staticpro (&last_overlay_modification_hooks);
5381 last_overlay_modification_hooks
5382 = Fmake_vector (make_number (10), Qnil);
5384 staticpro (&QSFundamental);
5385 staticpro (&Vbuffer_alist);
5387 DEFSYM (Qchoice, "choice");
5388 DEFSYM (Qleft, "left");
5389 DEFSYM (Qright, "right");
5390 DEFSYM (Qrange, "range");
5392 DEFSYM (Qpermanent_local_hook, "permanent-local-hook");
5393 DEFSYM (Qoverlayp, "overlayp");
5394 DEFSYM (Qevaporate, "evaporate");
5395 DEFSYM (Qmodification_hooks, "modification-hooks");
5396 DEFSYM (Qinsert_in_front_hooks, "insert-in-front-hooks");
5397 DEFSYM (Qinsert_behind_hooks, "insert-behind-hooks");
5398 DEFSYM (Qget_file_buffer, "get-file-buffer");
5399 DEFSYM (Qpriority, "priority");
5400 DEFSYM (Qbefore_string, "before-string");
5401 DEFSYM (Qafter_string, "after-string");
5402 DEFSYM (Qfirst_change_hook, "first-change-hook");
5403 DEFSYM (Qbefore_change_functions, "before-change-functions");
5404 DEFSYM (Qafter_change_functions, "after-change-functions");
5405 DEFSYM (Qkill_buffer_query_functions, "kill-buffer-query-functions");
5407 DEFSYM (Qvertical_scroll_bar, "vertical-scroll-bar");
5408 Fput (Qvertical_scroll_bar, Qchoice, list4 (Qnil, Qt, Qleft, Qright));
5409 DEFSYM (Qhorizontal_scroll_bar, "horizontal-scroll-bar");
5411 DEFSYM (Qfraction, "fraction");
5412 Fput (Qfraction, Qrange, Fcons (make_float (0.0), make_float (1.0)));
5414 DEFSYM (Qoverwrite_mode, "overwrite-mode");
5415 Fput (Qoverwrite_mode, Qchoice,
5416 list3 (Qnil, intern ("overwrite-mode-textual"),
5417 Qoverwrite_mode_binary));
5419 Fput (Qprotected_field, Qerror_conditions,
5420 listn (CONSTYPE_PURE, 2, Qprotected_field, Qerror));
5421 Fput (Qprotected_field, Qerror_message,
5422 build_pure_c_string ("Attempt to modify a protected field"));
5424 DEFVAR_BUFFER_DEFAULTS ("default-mode-line-format",
5425 mode_line_format,
5426 doc: /* Default value of `mode-line-format' for buffers that don't override it.
5427 This is the same as (default-value 'mode-line-format). */);
5429 DEFVAR_BUFFER_DEFAULTS ("default-header-line-format",
5430 header_line_format,
5431 doc: /* Default value of `header-line-format' for buffers that don't override it.
5432 This is the same as (default-value 'header-line-format). */);
5434 DEFVAR_BUFFER_DEFAULTS ("default-cursor-type", cursor_type,
5435 doc: /* Default value of `cursor-type' for buffers that don't override it.
5436 This is the same as (default-value 'cursor-type). */);
5438 DEFVAR_BUFFER_DEFAULTS ("default-line-spacing",
5439 extra_line_spacing,
5440 doc: /* Default value of `line-spacing' for buffers that don't override it.
5441 This is the same as (default-value 'line-spacing). */);
5443 DEFVAR_BUFFER_DEFAULTS ("default-cursor-in-non-selected-windows",
5444 cursor_in_non_selected_windows,
5445 doc: /* Default value of `cursor-in-non-selected-windows'.
5446 This is the same as (default-value 'cursor-in-non-selected-windows). */);
5448 DEFVAR_BUFFER_DEFAULTS ("default-abbrev-mode",
5449 abbrev_mode,
5450 doc: /* Default value of `abbrev-mode' for buffers that do not override it.
5451 This is the same as (default-value 'abbrev-mode). */);
5453 DEFVAR_BUFFER_DEFAULTS ("default-ctl-arrow",
5454 ctl_arrow,
5455 doc: /* Default value of `ctl-arrow' for buffers that do not override it.
5456 This is the same as (default-value 'ctl-arrow). */);
5458 DEFVAR_BUFFER_DEFAULTS ("default-enable-multibyte-characters",
5459 enable_multibyte_characters,
5460 doc: /* Default value of `enable-multibyte-characters' for buffers not overriding it.
5461 This is the same as (default-value 'enable-multibyte-characters). */);
5463 DEFVAR_BUFFER_DEFAULTS ("default-buffer-file-coding-system",
5464 buffer_file_coding_system,
5465 doc: /* Default value of `buffer-file-coding-system' for buffers not overriding it.
5466 This is the same as (default-value 'buffer-file-coding-system). */);
5468 DEFVAR_BUFFER_DEFAULTS ("default-truncate-lines",
5469 truncate_lines,
5470 doc: /* Default value of `truncate-lines' for buffers that do not override it.
5471 This is the same as (default-value 'truncate-lines). */);
5473 DEFVAR_BUFFER_DEFAULTS ("default-fill-column",
5474 fill_column,
5475 doc: /* Default value of `fill-column' for buffers that do not override it.
5476 This is the same as (default-value 'fill-column). */);
5478 DEFVAR_BUFFER_DEFAULTS ("default-left-margin",
5479 left_margin,
5480 doc: /* Default value of `left-margin' for buffers that do not override it.
5481 This is the same as (default-value 'left-margin). */);
5483 DEFVAR_BUFFER_DEFAULTS ("default-tab-width",
5484 tab_width,
5485 doc: /* Default value of `tab-width' for buffers that do not override it.
5486 NOTE: This controls the display width of a TAB character, and not
5487 the size of an indentation step.
5488 This is the same as (default-value 'tab-width). */);
5490 DEFVAR_BUFFER_DEFAULTS ("default-case-fold-search",
5491 case_fold_search,
5492 doc: /* Default value of `case-fold-search' for buffers that don't override it.
5493 This is the same as (default-value 'case-fold-search). */);
5495 DEFVAR_BUFFER_DEFAULTS ("default-left-margin-width",
5496 left_margin_cols,
5497 doc: /* Default value of `left-margin-width' for buffers that don't override it.
5498 This is the same as (default-value 'left-margin-width). */);
5500 DEFVAR_BUFFER_DEFAULTS ("default-right-margin-width",
5501 right_margin_cols,
5502 doc: /* Default value of `right-margin-width' for buffers that don't override it.
5503 This is the same as (default-value 'right-margin-width). */);
5505 DEFVAR_BUFFER_DEFAULTS ("default-left-fringe-width",
5506 left_fringe_width,
5507 doc: /* Default value of `left-fringe-width' for buffers that don't override it.
5508 This is the same as (default-value 'left-fringe-width). */);
5510 DEFVAR_BUFFER_DEFAULTS ("default-right-fringe-width",
5511 right_fringe_width,
5512 doc: /* Default value of `right-fringe-width' for buffers that don't override it.
5513 This is the same as (default-value 'right-fringe-width). */);
5515 DEFVAR_BUFFER_DEFAULTS ("default-fringes-outside-margins",
5516 fringes_outside_margins,
5517 doc: /* Default value of `fringes-outside-margins' for buffers that don't override it.
5518 This is the same as (default-value 'fringes-outside-margins). */);
5520 DEFVAR_BUFFER_DEFAULTS ("default-scroll-bar-width",
5521 scroll_bar_width,
5522 doc: /* Default value of `scroll-bar-width' for buffers that don't override it.
5523 This is the same as (default-value 'scroll-bar-width). */);
5525 DEFVAR_BUFFER_DEFAULTS ("default-vertical-scroll-bar",
5526 vertical_scroll_bar_type,
5527 doc: /* Default value of `vertical-scroll-bar' for buffers that don't override it.
5528 This is the same as (default-value 'vertical-scroll-bar). */);
5530 DEFVAR_BUFFER_DEFAULTS ("default-indicate-empty-lines",
5531 indicate_empty_lines,
5532 doc: /* Default value of `indicate-empty-lines' for buffers that don't override it.
5533 This is the same as (default-value 'indicate-empty-lines). */);
5535 DEFVAR_BUFFER_DEFAULTS ("default-indicate-buffer-boundaries",
5536 indicate_buffer_boundaries,
5537 doc: /* Default value of `indicate-buffer-boundaries' for buffers that don't override it.
5538 This is the same as (default-value 'indicate-buffer-boundaries). */);
5540 DEFVAR_BUFFER_DEFAULTS ("default-fringe-indicator-alist",
5541 fringe_indicator_alist,
5542 doc: /* Default value of `fringe-indicator-alist' for buffers that don't override it.
5543 This is the same as (default-value 'fringe-indicator-alist'). */);
5545 DEFVAR_BUFFER_DEFAULTS ("default-fringe-cursor-alist",
5546 fringe_cursor_alist,
5547 doc: /* Default value of `fringe-cursor-alist' for buffers that don't override it.
5548 This is the same as (default-value 'fringe-cursor-alist'). */);
5550 DEFVAR_BUFFER_DEFAULTS ("default-scroll-up-aggressively",
5551 scroll_up_aggressively,
5552 doc: /* Default value of `scroll-up-aggressively'.
5553 This value applies in buffers that don't have their own local values.
5554 This is the same as (default-value 'scroll-up-aggressively). */);
5556 DEFVAR_BUFFER_DEFAULTS ("default-scroll-down-aggressively",
5557 scroll_down_aggressively,
5558 doc: /* Default value of `scroll-down-aggressively'.
5559 This value applies in buffers that don't have their own local values.
5560 This is the same as (default-value 'scroll-down-aggressively). */);
5562 DEFVAR_PER_BUFFER ("header-line-format",
5563 &BVAR (current_buffer, header_line_format),
5564 Qnil,
5565 doc: /* Analogous to `mode-line-format', but controls the header line.
5566 The header line appears, optionally, at the top of a window;
5567 the mode line appears at the bottom. */);
5569 DEFVAR_PER_BUFFER ("mode-line-format", &BVAR (current_buffer, mode_line_format),
5570 Qnil,
5571 doc: /* Template for displaying mode line for current buffer.
5573 The value may be nil, a string, a symbol or a list.
5575 A value of nil means don't display a mode line.
5577 For any symbol other than t or nil, the symbol's value is processed as
5578 a mode line construct. As a special exception, if that value is a
5579 string, the string is processed verbatim, without handling any
5580 %-constructs (see below). Also, unless the symbol has a non-nil
5581 `risky-local-variable' property, all properties in any strings, as
5582 well as all :eval and :propertize forms in the value, are ignored.
5584 A list whose car is a string or list is processed by processing each
5585 of the list elements recursively, as separate mode line constructs,
5586 and concatenating the results.
5588 A list of the form `(:eval FORM)' is processed by evaluating FORM and
5589 using the result as a mode line construct. Be careful--FORM should
5590 not load any files, because that can cause an infinite recursion.
5592 A list of the form `(:propertize ELT PROPS...)' is processed by
5593 processing ELT as the mode line construct, and adding the text
5594 properties PROPS to the result.
5596 A list whose car is a symbol is processed by examining the symbol's
5597 value, and, if that value is non-nil, processing the cadr of the list
5598 recursively; and if that value is nil, processing the caddr of the
5599 list recursively.
5601 A list whose car is an integer is processed by processing the cadr of
5602 the list, and padding (if the number is positive) or truncating (if
5603 negative) to the width specified by that number.
5605 A string is printed verbatim in the mode line except for %-constructs:
5606 %b -- print buffer name. %f -- print visited file name.
5607 %F -- print frame name.
5608 %* -- print %, * or hyphen. %+ -- print *, % or hyphen.
5609 %& is like %*, but ignore read-only-ness.
5610 % means buffer is read-only and * means it is modified.
5611 For a modified read-only buffer, %* gives % and %+ gives *.
5612 %s -- print process status. %l -- print the current line number.
5613 %c -- print the current column number (this makes editing slower).
5614 To make the column number update correctly in all cases,
5615 `column-number-mode' must be non-nil.
5616 %i -- print the size of the buffer.
5617 %I -- like %i, but use k, M, G, etc., to abbreviate.
5618 %p -- print percent of buffer above top of window, or Top, Bot or All.
5619 %P -- print percent of buffer above bottom of window, perhaps plus Top,
5620 or print Bottom or All.
5621 %n -- print Narrow if appropriate.
5622 %t -- visited file is text or binary (if OS supports this distinction).
5623 %z -- print mnemonics of keyboard, terminal, and buffer coding systems.
5624 %Z -- like %z, but including the end-of-line format.
5625 %e -- print error message about full memory.
5626 %@ -- print @ or hyphen. @ means that default-directory is on a
5627 remote machine.
5628 %[ -- print one [ for each recursive editing level. %] similar.
5629 %% -- print %. %- -- print infinitely many dashes.
5630 Decimal digits after the % specify field width to which to pad. */);
5632 DEFVAR_BUFFER_DEFAULTS ("default-major-mode", major_mode,
5633 doc: /* Value of `major-mode' for new buffers. */);
5635 DEFVAR_PER_BUFFER ("major-mode", &BVAR (current_buffer, major_mode),
5636 Qsymbolp,
5637 doc: /* Symbol for current buffer's major mode.
5638 The default value (normally `fundamental-mode') affects new buffers.
5639 A value of nil means to use the current buffer's major mode, provided
5640 it is not marked as "special".
5642 When a mode is used by default, `find-file' switches to it before it
5643 reads the contents into the buffer and before it finishes setting up
5644 the buffer. Thus, the mode and its hooks should not expect certain
5645 variables such as `buffer-read-only' and `buffer-file-coding-system'
5646 to be set up. */);
5648 DEFVAR_PER_BUFFER ("mode-name", &BVAR (current_buffer, mode_name),
5649 Qnil,
5650 doc: /* Pretty name of current buffer's major mode.
5651 Usually a string, but can use any of the constructs for `mode-line-format',
5652 which see.
5653 Format with `format-mode-line' to produce a string value. */);
5655 DEFVAR_PER_BUFFER ("local-abbrev-table", &BVAR (current_buffer, abbrev_table), Qnil,
5656 doc: /* Local (mode-specific) abbrev table of current buffer. */);
5658 DEFVAR_PER_BUFFER ("abbrev-mode", &BVAR (current_buffer, abbrev_mode), Qnil,
5659 doc: /* Non-nil if Abbrev mode is enabled.
5660 Use the command `abbrev-mode' to change this variable. */);
5662 DEFVAR_PER_BUFFER ("case-fold-search", &BVAR (current_buffer, case_fold_search),
5663 Qnil,
5664 doc: /* Non-nil if searches and matches should ignore case. */);
5666 DEFVAR_PER_BUFFER ("fill-column", &BVAR (current_buffer, fill_column),
5667 Qintegerp,
5668 doc: /* Column beyond which automatic line-wrapping should happen.
5669 Interactively, you can set the buffer local value using \\[set-fill-column]. */);
5671 DEFVAR_PER_BUFFER ("left-margin", &BVAR (current_buffer, left_margin),
5672 Qintegerp,
5673 doc: /* Column for the default `indent-line-function' to indent to.
5674 Linefeed indents to this column in Fundamental mode. */);
5676 DEFVAR_PER_BUFFER ("tab-width", &BVAR (current_buffer, tab_width),
5677 Qintegerp,
5678 doc: /* Distance between tab stops (for display of tab characters), in columns.
5679 NOTE: This controls the display width of a TAB character, and not
5680 the size of an indentation step.
5681 This should be an integer greater than zero. */);
5683 DEFVAR_PER_BUFFER ("ctl-arrow", &BVAR (current_buffer, ctl_arrow), Qnil,
5684 doc: /* Non-nil means display control chars with uparrow.
5685 A value of nil means use backslash and octal digits.
5686 This variable does not apply to characters whose display is specified
5687 in the current display table (if there is one). */);
5689 DEFVAR_PER_BUFFER ("enable-multibyte-characters",
5690 &BVAR (current_buffer, enable_multibyte_characters),
5691 Qnil,
5692 doc: /* Non-nil means the buffer contents are regarded as multi-byte characters.
5693 Otherwise they are regarded as unibyte. This affects the display,
5694 file I/O and the behavior of various editing commands.
5696 This variable is buffer-local but you cannot set it directly;
5697 use the function `set-buffer-multibyte' to change a buffer's representation.
5698 See also Info node `(elisp)Text Representations'. */);
5699 XSYMBOL (intern_c_string ("enable-multibyte-characters"))->constant = 1;
5701 DEFVAR_PER_BUFFER ("buffer-file-coding-system",
5702 &BVAR (current_buffer, buffer_file_coding_system), Qnil,
5703 doc: /* Coding system to be used for encoding the buffer contents on saving.
5704 This variable applies to saving the buffer, and also to `write-region'
5705 and other functions that use `write-region'.
5706 It does not apply to sending output to subprocesses, however.
5708 If this is nil, the buffer is saved without any code conversion
5709 unless some coding system is specified in `file-coding-system-alist'
5710 for the buffer file.
5712 If the text to be saved cannot be encoded as specified by this variable,
5713 an alternative encoding is selected by `select-safe-coding-system', which see.
5715 The variable `coding-system-for-write', if non-nil, overrides this variable.
5717 This variable is never applied to a way of decoding a file while reading it. */);
5719 DEFVAR_PER_BUFFER ("bidi-display-reordering",
5720 &BVAR (current_buffer, bidi_display_reordering), Qnil,
5721 doc: /* Non-nil means reorder bidirectional text for display in the visual order. */);
5723 DEFVAR_PER_BUFFER ("bidi-paragraph-direction",
5724 &BVAR (current_buffer, bidi_paragraph_direction), Qnil,
5725 doc: /* If non-nil, forces directionality of text paragraphs in the buffer.
5727 If this is nil (the default), the direction of each paragraph is
5728 determined by the first strong directional character of its text.
5729 The values of `right-to-left' and `left-to-right' override that.
5730 Any other value is treated as nil.
5732 This variable has no effect unless the buffer's value of
5733 \`bidi-display-reordering' is non-nil. */);
5735 DEFVAR_PER_BUFFER ("truncate-lines", &BVAR (current_buffer, truncate_lines), Qnil,
5736 doc: /* Non-nil means do not display continuation lines.
5737 Instead, give each line of text just one screen line.
5739 Note that this is overridden by the variable
5740 `truncate-partial-width-windows' if that variable is non-nil
5741 and this buffer is not full-frame width.
5743 Minibuffers set this variable to nil. */);
5745 DEFVAR_PER_BUFFER ("word-wrap", &BVAR (current_buffer, word_wrap), Qnil,
5746 doc: /* Non-nil means to use word-wrapping for continuation lines.
5747 When word-wrapping is on, continuation lines are wrapped at the space
5748 or tab character nearest to the right window edge.
5749 If nil, continuation lines are wrapped at the right screen edge.
5751 This variable has no effect if long lines are truncated (see
5752 `truncate-lines' and `truncate-partial-width-windows'). If you use
5753 word-wrapping, you might want to reduce the value of
5754 `truncate-partial-width-windows', since wrapping can make text readable
5755 in narrower windows.
5757 Instead of setting this variable directly, most users should use
5758 Visual Line mode . Visual Line mode, when enabled, sets `word-wrap'
5759 to t, and additionally redefines simple editing commands to act on
5760 visual lines rather than logical lines. See the documentation of
5761 `visual-line-mode'. */);
5763 DEFVAR_PER_BUFFER ("default-directory", &BVAR (current_buffer, directory),
5764 Qstringp,
5765 doc: /* Name of default directory of current buffer. Should end with slash.
5766 To interactively change the default directory, use command `cd'. */);
5768 DEFVAR_PER_BUFFER ("auto-fill-function", &BVAR (current_buffer, auto_fill_function),
5769 Qnil,
5770 doc: /* Function called (if non-nil) to perform auto-fill.
5771 It is called after self-inserting any character specified in
5772 the `auto-fill-chars' table.
5773 NOTE: This variable is not a hook;
5774 its value may not be a list of functions. */);
5776 DEFVAR_PER_BUFFER ("buffer-file-name", &BVAR (current_buffer, filename),
5777 Qstringp,
5778 doc: /* Name of file visited in current buffer, or nil if not visiting a file.
5779 This should be an absolute file name. */);
5781 DEFVAR_PER_BUFFER ("buffer-file-truename", &BVAR (current_buffer, file_truename),
5782 Qstringp,
5783 doc: /* Abbreviated truename of file visited in current buffer, or nil if none.
5784 The truename of a file is calculated by `file-truename'
5785 and then abbreviated with `abbreviate-file-name'. */);
5787 DEFVAR_PER_BUFFER ("buffer-auto-save-file-name",
5788 &BVAR (current_buffer, auto_save_file_name),
5789 Qstringp,
5790 doc: /* Name of file for auto-saving current buffer.
5791 If it is nil, that means don't auto-save this buffer. */);
5793 DEFVAR_PER_BUFFER ("buffer-read-only", &BVAR (current_buffer, read_only), Qnil,
5794 doc: /* Non-nil if this buffer is read-only. */);
5796 DEFVAR_PER_BUFFER ("buffer-backed-up", &BVAR (current_buffer, backed_up), Qnil,
5797 doc: /* Non-nil if this buffer's file has been backed up.
5798 Backing up is done before the first time the file is saved. */);
5800 DEFVAR_PER_BUFFER ("buffer-saved-size", &BVAR (current_buffer, save_length),
5801 Qintegerp,
5802 doc: /* Length of current buffer when last read in, saved or auto-saved.
5803 0 initially.
5804 -1 means auto-saving turned off until next real save.
5806 If you set this to -2, that means don't turn off auto-saving in this buffer
5807 if its text size shrinks. If you use `buffer-swap-text' on a buffer,
5808 you probably should set this to -2 in that buffer. */);
5810 DEFVAR_PER_BUFFER ("selective-display", &BVAR (current_buffer, selective_display),
5811 Qnil,
5812 doc: /* Non-nil enables selective display.
5813 An integer N as value means display only lines
5814 that start with less than N columns of space.
5815 A value of t means that the character ^M makes itself and
5816 all the rest of the line invisible; also, when saving the buffer
5817 in a file, save the ^M as a newline. */);
5819 DEFVAR_PER_BUFFER ("selective-display-ellipses",
5820 &BVAR (current_buffer, selective_display_ellipses),
5821 Qnil,
5822 doc: /* Non-nil means display ... on previous line when a line is invisible. */);
5824 DEFVAR_PER_BUFFER ("overwrite-mode", &BVAR (current_buffer, overwrite_mode),
5825 Qoverwrite_mode,
5826 doc: /* Non-nil if self-insertion should replace existing text.
5827 The value should be one of `overwrite-mode-textual',
5828 `overwrite-mode-binary', or nil.
5829 If it is `overwrite-mode-textual', self-insertion still
5830 inserts at the end of a line, and inserts when point is before a tab,
5831 until the tab is filled in.
5832 If `overwrite-mode-binary', self-insertion replaces newlines and tabs too. */);
5834 DEFVAR_PER_BUFFER ("buffer-display-table", &BVAR (current_buffer, display_table),
5835 Qnil,
5836 doc: /* Display table that controls display of the contents of current buffer.
5838 If this variable is nil, the value of `standard-display-table' is used.
5839 Each window can have its own, overriding display table, see
5840 `set-window-display-table' and `window-display-table'.
5842 The display table is a char-table created with `make-display-table'.
5843 A char-table is an array indexed by character codes. Normal array
5844 primitives `aref' and `aset' can be used to access elements of a char-table.
5846 Each of the char-table elements control how to display the corresponding
5847 text character: the element at index C in the table says how to display
5848 the character whose code is C. Each element should be a vector of
5849 characters or nil. The value nil means display the character in the
5850 default fashion; otherwise, the characters from the vector are delivered
5851 to the screen instead of the original character.
5853 For example, (aset buffer-display-table ?X [?Y]) tells Emacs
5854 to display a capital Y instead of each X character.
5856 In addition, a char-table has six extra slots to control the display of:
5858 the end of a truncated screen line (extra-slot 0, a single character);
5859 the end of a continued line (extra-slot 1, a single character);
5860 the escape character used to display character codes in octal
5861 (extra-slot 2, a single character);
5862 the character used as an arrow for control characters (extra-slot 3,
5863 a single character);
5864 the decoration indicating the presence of invisible lines (extra-slot 4,
5865 a vector of characters);
5866 the character used to draw the border between side-by-side windows
5867 (extra-slot 5, a single character).
5869 See also the functions `display-table-slot' and `set-display-table-slot'. */);
5871 DEFVAR_PER_BUFFER ("left-margin-width", &BVAR (current_buffer, left_margin_cols),
5872 Qintegerp,
5873 doc: /* Width in columns of left marginal area for display of a buffer.
5874 A value of nil means no marginal area.
5876 Setting this variable does not take effect until a new buffer is displayed
5877 in a window. To make the change take effect, call `set-window-buffer'. */);
5879 DEFVAR_PER_BUFFER ("right-margin-width", &BVAR (current_buffer, right_margin_cols),
5880 Qintegerp,
5881 doc: /* Width in columns of right marginal area for display of a buffer.
5882 A value of nil means no marginal area.
5884 Setting this variable does not take effect until a new buffer is displayed
5885 in a window. To make the change take effect, call `set-window-buffer'. */);
5887 DEFVAR_PER_BUFFER ("left-fringe-width", &BVAR (current_buffer, left_fringe_width),
5888 Qintegerp,
5889 doc: /* Width of this buffer's left fringe (in pixels).
5890 A value of 0 means no left fringe is shown in this buffer's window.
5891 A value of nil means to use the left fringe width from the window's frame.
5893 Setting this variable does not take effect until a new buffer is displayed
5894 in a window. To make the change take effect, call `set-window-buffer'. */);
5896 DEFVAR_PER_BUFFER ("right-fringe-width", &BVAR (current_buffer, right_fringe_width),
5897 Qintegerp,
5898 doc: /* Width of this buffer's right fringe (in pixels).
5899 A value of 0 means no right fringe is shown in this buffer's window.
5900 A value of nil means to use the right fringe width from the window's frame.
5902 Setting this variable does not take effect until a new buffer is displayed
5903 in a window. To make the change take effect, call `set-window-buffer'. */);
5905 DEFVAR_PER_BUFFER ("fringes-outside-margins", &BVAR (current_buffer, fringes_outside_margins),
5906 Qnil,
5907 doc: /* Non-nil means to display fringes outside display margins.
5908 A value of nil means to display fringes between margins and buffer text.
5910 Setting this variable does not take effect until a new buffer is displayed
5911 in a window. To make the change take effect, call `set-window-buffer'. */);
5913 DEFVAR_PER_BUFFER ("scroll-bar-width", &BVAR (current_buffer, scroll_bar_width),
5914 Qintegerp,
5915 doc: /* Width of this buffer's vertical scroll bars in pixels.
5916 A value of nil means to use the scroll bar width from the window's frame. */);
5918 DEFVAR_PER_BUFFER ("scroll-bar-height", &BVAR (current_buffer, scroll_bar_height),
5919 Qintegerp,
5920 doc: /* Height of this buffer's horizontal scroll bars in pixels.
5921 A value of nil means to use the scroll bar height from the window's frame. */);
5923 DEFVAR_PER_BUFFER ("vertical-scroll-bar", &BVAR (current_buffer, vertical_scroll_bar_type),
5924 Qvertical_scroll_bar,
5925 doc: /* Position of this buffer's vertical scroll bar.
5926 The value takes effect whenever you tell a window to display this buffer;
5927 for instance, with `set-window-buffer' or when `display-buffer' displays it.
5929 A value of `left' or `right' means put the vertical scroll bar at that side
5930 of the window; a value of nil means don't show any vertical scroll bars.
5931 A value of t (the default) means do whatever the window's frame specifies. */);
5933 DEFVAR_PER_BUFFER ("horizontal-scroll-bar", &BVAR (current_buffer, horizontal_scroll_bar_type),
5934 Qnil,
5935 doc: /* Position of this buffer's horizontal scroll bar.
5936 The value takes effect whenever you tell a window to display this buffer;
5937 for instance, with `set-window-buffer' or when `display-buffer' displays it.
5939 A value of `bottom' means put the horizontal scroll bar at the bottom of
5940 the window; a value of nil means don't show any horizontal scroll bars.
5941 A value of t (the default) means do whatever the window's frame
5942 specifies. */);
5944 DEFVAR_PER_BUFFER ("indicate-empty-lines",
5945 &BVAR (current_buffer, indicate_empty_lines), Qnil,
5946 doc: /* Visually indicate empty lines after the buffer end.
5947 If non-nil, a bitmap is displayed in the left fringe of a window on
5948 window-systems. */);
5950 DEFVAR_PER_BUFFER ("indicate-buffer-boundaries",
5951 &BVAR (current_buffer, indicate_buffer_boundaries), Qnil,
5952 doc: /* Visually indicate buffer boundaries and scrolling.
5953 If non-nil, the first and last line of the buffer are marked in the fringe
5954 of a window on window-systems with angle bitmaps, or if the window can be
5955 scrolled, the top and bottom line of the window are marked with up and down
5956 arrow bitmaps.
5958 If value is a symbol `left' or `right', both angle and arrow bitmaps
5959 are displayed in the left or right fringe, resp. Any other value
5960 that doesn't look like an alist means display the angle bitmaps in
5961 the left fringe but no arrows.
5963 You can exercise more precise control by using an alist as the
5964 value. Each alist element (INDICATOR . POSITION) specifies
5965 where to show one of the indicators. INDICATOR is one of `top',
5966 `bottom', `up', `down', or t, which specifies the default position,
5967 and POSITION is one of `left', `right', or nil, meaning do not show
5968 this indicator.
5970 For example, ((top . left) (t . right)) places the top angle bitmap in
5971 left fringe, the bottom angle bitmap in right fringe, and both arrow
5972 bitmaps in right fringe. To show just the angle bitmaps in the left
5973 fringe, but no arrow bitmaps, use ((top . left) (bottom . left)). */);
5975 DEFVAR_PER_BUFFER ("fringe-indicator-alist",
5976 &BVAR (current_buffer, fringe_indicator_alist), Qnil,
5977 doc: /* Mapping from logical to physical fringe indicator bitmaps.
5978 The value is an alist where each element (INDICATOR . BITMAPS)
5979 specifies the fringe bitmaps used to display a specific logical
5980 fringe indicator.
5982 INDICATOR specifies the logical indicator type which is one of the
5983 following symbols: `truncation' , `continuation', `overlay-arrow',
5984 `top', `bottom', `top-bottom', `up', `down', empty-line', or `unknown'.
5986 BITMAPS is a list of symbols (LEFT RIGHT [LEFT1 RIGHT1]) which specifies
5987 the actual bitmap shown in the left or right fringe for the logical
5988 indicator. LEFT and RIGHT are the bitmaps shown in the left and/or
5989 right fringe for the specific indicator. The LEFT1 or RIGHT1 bitmaps
5990 are used only for the `bottom' and `top-bottom' indicators when the
5991 last (only) line has no final newline. BITMAPS may also be a single
5992 symbol which is used in both left and right fringes. */);
5994 DEFVAR_PER_BUFFER ("fringe-cursor-alist",
5995 &BVAR (current_buffer, fringe_cursor_alist), Qnil,
5996 doc: /* Mapping from logical to physical fringe cursor bitmaps.
5997 The value is an alist where each element (CURSOR . BITMAP)
5998 specifies the fringe bitmaps used to display a specific logical
5999 cursor type in the fringe.
6001 CURSOR specifies the logical cursor type which is one of the following
6002 symbols: `box' , `hollow', `bar', `hbar', or `hollow-small'. The last
6003 one is used to show a hollow cursor on narrow lines display lines
6004 where the normal hollow cursor will not fit.
6006 BITMAP is the corresponding fringe bitmap shown for the logical
6007 cursor type. */);
6009 DEFVAR_PER_BUFFER ("scroll-up-aggressively",
6010 &BVAR (current_buffer, scroll_up_aggressively), Qfraction,
6011 doc: /* How far to scroll windows upward.
6012 If you move point off the bottom, the window scrolls automatically.
6013 This variable controls how far it scrolls. The value nil, the default,
6014 means scroll to center point. A fraction means scroll to put point
6015 that fraction of the window's height from the bottom of the window.
6016 When the value is 0.0, point goes at the bottom line, which in the
6017 simple case that you moved off with C-f means scrolling just one line.
6018 1.0 means point goes at the top, so that in that simple case, the
6019 window scrolls by a full window height. Meaningful values are
6020 between 0.0 and 1.0, inclusive. */);
6022 DEFVAR_PER_BUFFER ("scroll-down-aggressively",
6023 &BVAR (current_buffer, scroll_down_aggressively), Qfraction,
6024 doc: /* How far to scroll windows downward.
6025 If you move point off the top, the window scrolls automatically.
6026 This variable controls how far it scrolls. The value nil, the default,
6027 means scroll to center point. A fraction means scroll to put point
6028 that fraction of the window's height from the top of the window.
6029 When the value is 0.0, point goes at the top line, which in the
6030 simple case that you moved off with C-b means scrolling just one line.
6031 1.0 means point goes at the bottom, so that in that simple case, the
6032 window scrolls by a full window height. Meaningful values are
6033 between 0.0 and 1.0, inclusive. */);
6035 DEFVAR_LISP ("before-change-functions", Vbefore_change_functions,
6036 doc: /* List of functions to call before each text change.
6037 Two arguments are passed to each function: the positions of
6038 the beginning and end of the range of old text to be changed.
6039 \(For an insertion, the beginning and end are at the same place.)
6040 No information is given about the length of the text after the change.
6042 Buffer changes made while executing the `before-change-functions'
6043 don't call any before-change or after-change functions.
6044 That's because `inhibit-modification-hooks' is temporarily set non-nil.
6046 If an unhandled error happens in running these functions,
6047 the variable's value remains nil. That prevents the error
6048 from happening repeatedly and making Emacs nonfunctional. */);
6049 Vbefore_change_functions = Qnil;
6051 DEFVAR_LISP ("after-change-functions", Vafter_change_functions,
6052 doc: /* List of functions to call after each text change.
6053 Three arguments are passed to each function: the positions of
6054 the beginning and end of the range of changed text,
6055 and the length in chars of the pre-change text replaced by that range.
6056 \(For an insertion, the pre-change length is zero;
6057 for a deletion, that length is the number of chars deleted,
6058 and the post-change beginning and end are at the same place.)
6060 Buffer changes made while executing the `after-change-functions'
6061 don't call any before-change or after-change functions.
6062 That's because `inhibit-modification-hooks' is temporarily set non-nil.
6064 If an unhandled error happens in running these functions,
6065 the variable's value remains nil. That prevents the error
6066 from happening repeatedly and making Emacs nonfunctional. */);
6067 Vafter_change_functions = Qnil;
6069 DEFVAR_LISP ("first-change-hook", Vfirst_change_hook,
6070 doc: /* A list of functions to call before changing a buffer which is unmodified.
6071 The functions are run using the `run-hooks' function. */);
6072 Vfirst_change_hook = Qnil;
6074 DEFVAR_PER_BUFFER ("buffer-undo-list", &BVAR (current_buffer, undo_list), Qnil,
6075 doc: /* List of undo entries in current buffer.
6076 Recent changes come first; older changes follow newer.
6078 An entry (BEG . END) represents an insertion which begins at
6079 position BEG and ends at position END.
6081 An entry (TEXT . POSITION) represents the deletion of the string TEXT
6082 from (abs POSITION). If POSITION is positive, point was at the front
6083 of the text being deleted; if negative, point was at the end.
6085 An entry (t HIGH LOW USEC PSEC) indicates that the buffer was previously
6086 unmodified; (HIGH LOW USEC PSEC) is in the same style as (current-time)
6087 and is the visited file's modification time, as of that time. If the
6088 modification time of the most recent save is different, this entry is
6089 obsolete.
6091 An entry (t . 0) means means the buffer was previously unmodified but
6092 its time stamp was unknown because it was not associated with a file.
6093 An entry (t . -1) is similar, except that it means the buffer's visited
6094 file did not exist.
6096 An entry (nil PROPERTY VALUE BEG . END) indicates that a text property
6097 was modified between BEG and END. PROPERTY is the property name,
6098 and VALUE is the old value.
6100 An entry (apply FUN-NAME . ARGS) means undo the change with
6101 \(apply FUN-NAME ARGS).
6103 An entry (apply DELTA BEG END FUN-NAME . ARGS) supports selective undo
6104 in the active region. BEG and END is the range affected by this entry
6105 and DELTA is the number of characters added or deleted in that range by
6106 this change.
6108 An entry (MARKER . DISTANCE) indicates that the marker MARKER
6109 was adjusted in position by the offset DISTANCE (an integer).
6111 An entry of the form POSITION indicates that point was at the buffer
6112 location given by the integer. Undoing an entry of this form places
6113 point at POSITION.
6115 Entries with value nil mark undo boundaries. The undo command treats
6116 the changes between two undo boundaries as a single step to be undone.
6118 If the value of the variable is t, undo information is not recorded. */);
6120 DEFVAR_PER_BUFFER ("mark-active", &BVAR (current_buffer, mark_active), Qnil,
6121 doc: /* Non-nil means the mark and region are currently active in this buffer. */);
6123 DEFVAR_PER_BUFFER ("cache-long-scans", &BVAR (current_buffer, cache_long_scans), Qnil,
6124 doc: /* Non-nil means that Emacs should use caches in attempt to speedup buffer scans.
6126 There is no reason to set this to nil except for debugging purposes.
6128 Normally, the line-motion functions work by scanning the buffer for
6129 newlines. Columnar operations (like `move-to-column' and
6130 `compute-motion') also work by scanning the buffer, summing character
6131 widths as they go. This works well for ordinary text, but if the
6132 buffer's lines are very long (say, more than 500 characters), these
6133 motion functions will take longer to execute. Emacs may also take
6134 longer to update the display.
6136 If `cache-long-scans' is non-nil, these motion functions cache the
6137 results of their scans, and consult the cache to avoid rescanning
6138 regions of the buffer until the text is modified. The caches are most
6139 beneficial when they prevent the most searching---that is, when the
6140 buffer contains long lines and large regions of characters with the
6141 same, fixed screen width.
6143 When `cache-long-scans' is non-nil, processing short lines will
6144 become slightly slower (because of the overhead of consulting the
6145 cache), and the caches will use memory roughly proportional to the
6146 number of newlines and characters whose screen width varies.
6148 Bidirectional editing also requires buffer scans to find paragraph
6149 separators. If you have large paragraphs or no paragraph separators
6150 at all, these scans may be slow. If `cache-long-scans' is non-nil,
6151 results of these scans are cached. This doesn't help too much if
6152 paragraphs are of the reasonable (few thousands of characters) size.
6154 The caches require no explicit maintenance; their accuracy is
6155 maintained internally by the Emacs primitives. Enabling or disabling
6156 the cache should not affect the behavior of any of the motion
6157 functions; it should only affect their performance. */);
6159 DEFVAR_PER_BUFFER ("point-before-scroll", &BVAR (current_buffer, point_before_scroll), Qnil,
6160 doc: /* Value of point before the last series of scroll operations, or nil. */);
6162 DEFVAR_PER_BUFFER ("buffer-file-format", &BVAR (current_buffer, file_format), Qnil,
6163 doc: /* List of formats to use when saving this buffer.
6164 Formats are defined by `format-alist'. This variable is
6165 set when a file is visited. */);
6167 DEFVAR_PER_BUFFER ("buffer-auto-save-file-format",
6168 &BVAR (current_buffer, auto_save_file_format), Qnil,
6169 doc: /* Format in which to write auto-save files.
6170 Should be a list of symbols naming formats that are defined in `format-alist'.
6171 If it is t, which is the default, auto-save files are written in the
6172 same format as a regular save would use. */);
6174 DEFVAR_PER_BUFFER ("buffer-invisibility-spec",
6175 &BVAR (current_buffer, invisibility_spec), Qnil,
6176 doc: /* Invisibility spec of this buffer.
6177 The default is t, which means that text is invisible if it has a non-nil
6178 `invisible' property.
6179 This variable can also be a list. The list can have two kinds of elements:
6180 `ATOM' and `(ATOM . ELLIPSIS)'. A text character is invisible if its
6181 `invisible' property is `ATOM', or has an `invisible' property that is a list
6182 that contains `ATOM'.
6183 If the `(ATOM . ELLIPSIS)' form is used, and `ELLIPSIS' is non-nil, an
6184 ellipsis will be displayed after the invisible characters.
6185 Setting this variable is very fast, much faster than scanning all the text in
6186 the buffer looking for properties to change. */);
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 region is highlighted with the `region' face.
6206 The variable `highlight-nonselected-windows' controls whether to highlight
6207 all windows or just the selected window.
6209 Lisp programs may give this variable certain special values:
6211 - A value of `lambda' enables Transient Mark mode temporarily.
6212 It is disabled again after any subsequent action that would
6213 normally deactivate the mark (e.g. buffer modification).
6215 - A value of (only . OLDVAL) enables Transient Mark mode
6216 temporarily. After any subsequent point motion command that is
6217 not shift-translated, or any other action that would normally
6218 deactivate the mark (e.g. buffer modification), the value of
6219 `transient-mark-mode' is set to OLDVAL. */);
6220 Vtransient_mark_mode = Qnil;
6222 DEFVAR_LISP ("inhibit-read-only", Vinhibit_read_only,
6223 doc: /* Non-nil means disregard read-only status of buffers or characters.
6224 If the value is t, disregard `buffer-read-only' and all `read-only'
6225 text properties. If the value is a list, disregard `buffer-read-only'
6226 and disregard a `read-only' text property if the property value
6227 is a member of the list. */);
6228 Vinhibit_read_only = Qnil;
6230 DEFVAR_PER_BUFFER ("cursor-type", &BVAR (current_buffer, cursor_type), Qnil,
6231 doc: /* Cursor to use when this buffer is in the selected window.
6232 Values are interpreted as follows:
6234 t use the cursor specified for the frame
6235 nil don't display a cursor
6236 box display a filled box cursor
6237 hollow display a hollow box cursor
6238 bar display a vertical bar cursor with default width
6239 (bar . WIDTH) display a vertical bar cursor with width WIDTH
6240 hbar display a horizontal bar cursor with default height
6241 (hbar . HEIGHT) display a horizontal bar cursor with height HEIGHT
6242 ANYTHING ELSE display a hollow box cursor
6244 When the buffer is displayed in a non-selected window, the
6245 cursor's appearance is instead controlled by the variable
6246 `cursor-in-non-selected-windows'. */);
6248 DEFVAR_PER_BUFFER ("line-spacing",
6249 &BVAR (current_buffer, extra_line_spacing), Qnumberp,
6250 doc: /* Additional space to put between lines when displaying a buffer.
6251 The space is measured in pixels, and put below lines on graphic displays,
6252 see `display-graphic-p'.
6253 If value is a floating point number, it specifies the spacing relative
6254 to the default frame line height. A value of nil means add no extra space. */);
6256 DEFVAR_PER_BUFFER ("cursor-in-non-selected-windows",
6257 &BVAR (current_buffer, cursor_in_non_selected_windows), Qnil,
6258 doc: /* Non-nil means show a cursor in non-selected windows.
6259 If nil, only shows a cursor in the selected window.
6260 If t, displays a cursor related to the usual cursor type
6261 \(a solid box becomes hollow, a bar becomes a narrower bar).
6262 You can also specify the cursor type as in the `cursor-type' variable.
6263 Use Custom to set this variable and update the display." */);
6265 DEFVAR_LISP ("kill-buffer-query-functions", Vkill_buffer_query_functions,
6266 doc: /* List of functions called with no args to query before killing a buffer.
6267 The buffer being killed will be current while the functions are running.
6269 If any of them returns nil, the buffer is not killed. Functions run by
6270 this hook are supposed to not change the current buffer. */);
6271 Vkill_buffer_query_functions = Qnil;
6273 DEFVAR_LISP ("change-major-mode-hook", Vchange_major_mode_hook,
6274 doc: /* Normal hook run before changing the major mode of a buffer.
6275 The function `kill-all-local-variables' runs this before doing anything else. */);
6276 Vchange_major_mode_hook = Qnil;
6277 DEFSYM (Qchange_major_mode_hook, "change-major-mode-hook");
6279 DEFVAR_LISP ("buffer-list-update-hook", Vbuffer_list_update_hook,
6280 doc: /* Hook run when the buffer list changes.
6281 Functions running this hook are, `get-buffer-create',
6282 `make-indirect-buffer', `rename-buffer', `kill-buffer',
6283 `bury-buffer-internal' and `select-window'. */);
6284 Vbuffer_list_update_hook = Qnil;
6285 DEFSYM (Qbuffer_list_update_hook, "buffer-list-update-hook");
6287 defsubr (&Sbuffer_live_p);
6288 defsubr (&Sbuffer_list);
6289 defsubr (&Sget_buffer);
6290 defsubr (&Sget_file_buffer);
6291 defsubr (&Sget_buffer_create);
6292 defsubr (&Smake_indirect_buffer);
6293 defsubr (&Sgenerate_new_buffer_name);
6294 defsubr (&Sbuffer_name);
6295 defsubr (&Sbuffer_file_name);
6296 defsubr (&Sbuffer_base_buffer);
6297 defsubr (&Sbuffer_local_value);
6298 defsubr (&Sbuffer_local_variables);
6299 defsubr (&Sbuffer_modified_p);
6300 defsubr (&Sforce_mode_line_update);
6301 defsubr (&Sset_buffer_modified_p);
6302 defsubr (&Sbuffer_modified_tick);
6303 defsubr (&Sbuffer_chars_modified_tick);
6304 defsubr (&Srename_buffer);
6305 defsubr (&Sother_buffer);
6306 defsubr (&Sbuffer_enable_undo);
6307 defsubr (&Skill_buffer);
6308 defsubr (&Sbury_buffer_internal);
6309 defsubr (&Sset_buffer_major_mode);
6310 defsubr (&Scurrent_buffer);
6311 defsubr (&Sset_buffer);
6312 defsubr (&Sbarf_if_buffer_read_only);
6313 defsubr (&Serase_buffer);
6314 defsubr (&Sbuffer_swap_text);
6315 defsubr (&Sset_buffer_multibyte);
6316 defsubr (&Skill_all_local_variables);
6318 defsubr (&Soverlayp);
6319 defsubr (&Smake_overlay);
6320 defsubr (&Sdelete_overlay);
6321 defsubr (&Sdelete_all_overlays);
6322 defsubr (&Smove_overlay);
6323 defsubr (&Soverlay_start);
6324 defsubr (&Soverlay_end);
6325 defsubr (&Soverlay_buffer);
6326 defsubr (&Soverlay_properties);
6327 defsubr (&Soverlays_at);
6328 defsubr (&Soverlays_in);
6329 defsubr (&Snext_overlay_change);
6330 defsubr (&Sprevious_overlay_change);
6331 defsubr (&Soverlay_recenter);
6332 defsubr (&Soverlay_lists);
6333 defsubr (&Soverlay_get);
6334 defsubr (&Soverlay_put);
6335 defsubr (&Srestore_buffer_modified_p);
6337 Fput (intern_c_string ("erase-buffer"), Qdisabled, Qt);
6340 void
6341 keys_of_buffer (void)
6343 initial_define_key (control_x_map, 'b', "switch-to-buffer");
6344 initial_define_key (control_x_map, 'k', "kill-buffer");