* lisp/net/ange-ftp.el: Use lexical-binding
[emacs.git] / src / buffer.c
blob75cb470af8da1a73d9cc017924fa55dd9f068137
1 /* Buffer manipulation primitives for GNU Emacs.
3 Copyright (C) 1985-1989, 1993-1995, 1997-2017 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 (at
11 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 <https://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 <stdlib.h>
29 #include <unistd.h>
31 #include <verify.h>
33 #include "lisp.h"
34 #include "intervals.h"
35 #include "process.h"
36 #include "systime.h"
37 #include "window.h"
38 #include "commands.h"
39 #include "character.h"
40 #include "buffer.h"
41 #include "region-cache.h"
42 #include "indent.h"
43 #include "blockinput.h"
44 #include "keymap.h"
45 #include "frame.h"
46 #include "xwidget.h"
48 #ifdef WINDOWSNT
49 #include "w32heap.h" /* for mmap_* */
50 #endif
52 /* First buffer in chain of all buffers (in reverse order of creation).
53 Threaded through ->header.next.buffer. */
55 struct buffer *all_buffers;
57 /* This structure holds the default values of the buffer-local variables
58 defined with DEFVAR_PER_BUFFER, that have special slots in each buffer.
59 The default value occupies the same slot in this structure
60 as an individual buffer's value occupies in that buffer.
61 Setting the default value also goes through the alist of buffers
62 and stores into each buffer that does not say it has a local value. */
64 struct buffer buffer_defaults;
66 /* This structure marks which slots in a buffer have corresponding
67 default values in buffer_defaults.
68 Each such slot has a nonzero value in this structure.
69 The value has only one nonzero bit.
71 When a buffer has its own local value for a slot,
72 the entry for that slot (found in the same slot in this structure)
73 is turned on in the buffer's local_flags array.
75 If a slot in this structure is -1, then even though there may
76 be a DEFVAR_PER_BUFFER for the slot, there is no default value for it;
77 and the corresponding slot in buffer_defaults is not used.
79 If a slot in this structure corresponding to a DEFVAR_PER_BUFFER is
80 zero, that is a bug. */
82 struct buffer buffer_local_flags;
84 /* This structure holds the names of symbols whose values may be
85 buffer-local. It is indexed and accessed in the same way as the above. */
87 struct buffer buffer_local_symbols;
89 /* Return the symbol of the per-buffer variable at offset OFFSET in
90 the buffer structure. */
92 #define PER_BUFFER_SYMBOL(OFFSET) \
93 (*(Lisp_Object *)((OFFSET) + (char *) &buffer_local_symbols))
95 /* Maximum length of an overlay vector. */
96 #define OVERLAY_COUNT_MAX \
97 ((ptrdiff_t) min (MOST_POSITIVE_FIXNUM, \
98 min (PTRDIFF_MAX, SIZE_MAX) / word_size))
100 /* Flags indicating which built-in buffer-local variables
101 are permanent locals. */
102 static char buffer_permanent_local_flags[MAX_PER_BUFFER_VARS];
104 /* Number of per-buffer variables used. */
106 int last_per_buffer_idx;
108 static void call_overlay_mod_hooks (Lisp_Object list, Lisp_Object overlay,
109 bool after, Lisp_Object arg1,
110 Lisp_Object arg2, Lisp_Object arg3);
111 static void swap_out_buffer_local_variables (struct buffer *b);
112 static void reset_buffer_local_variables (struct buffer *, bool);
114 /* Alist of all buffer names vs the buffers. This used to be
115 a Lisp-visible variable, but is no longer, to prevent lossage
116 due to user rplac'ing this alist or its elements. */
117 Lisp_Object Vbuffer_alist;
119 static Lisp_Object QSFundamental; /* A string "Fundamental". */
121 static void alloc_buffer_text (struct buffer *, ptrdiff_t);
122 static void free_buffer_text (struct buffer *b);
123 static struct Lisp_Overlay * copy_overlays (struct buffer *, struct Lisp_Overlay *);
124 static void modify_overlay (struct buffer *, ptrdiff_t, ptrdiff_t);
125 static Lisp_Object buffer_lisp_local_variables (struct buffer *, bool);
127 static void
128 CHECK_OVERLAY (Lisp_Object x)
130 CHECK_TYPE (OVERLAYP (x), Qoverlayp, x);
133 /* These setters are used only in this file, so they can be private.
134 The public setters are inline functions defined in buffer.h. */
135 static void
136 bset_abbrev_mode (struct buffer *b, Lisp_Object val)
138 b->abbrev_mode_ = val;
140 static void
141 bset_abbrev_table (struct buffer *b, Lisp_Object val)
143 b->abbrev_table_ = val;
145 static void
146 bset_auto_fill_function (struct buffer *b, Lisp_Object val)
148 b->auto_fill_function_ = val;
150 static void
151 bset_auto_save_file_format (struct buffer *b, Lisp_Object val)
153 b->auto_save_file_format_ = val;
155 static void
156 bset_auto_save_file_name (struct buffer *b, Lisp_Object val)
158 b->auto_save_file_name_ = val;
160 static void
161 bset_backed_up (struct buffer *b, Lisp_Object val)
163 b->backed_up_ = val;
165 static void
166 bset_begv_marker (struct buffer *b, Lisp_Object val)
168 b->begv_marker_ = val;
170 static void
171 bset_bidi_display_reordering (struct buffer *b, Lisp_Object val)
173 b->bidi_display_reordering_ = val;
175 static void
176 bset_bidi_paragraph_start_re (struct buffer *b, Lisp_Object val)
178 b->bidi_paragraph_start_re_ = val;
180 static void
181 bset_bidi_paragraph_separate_re (struct buffer *b, Lisp_Object val)
183 b->bidi_paragraph_separate_re_ = val;
185 static void
186 bset_buffer_file_coding_system (struct buffer *b, Lisp_Object val)
188 b->buffer_file_coding_system_ = val;
190 static void
191 bset_case_fold_search (struct buffer *b, Lisp_Object val)
193 b->case_fold_search_ = val;
195 static void
196 bset_ctl_arrow (struct buffer *b, Lisp_Object val)
198 b->ctl_arrow_ = val;
200 static void
201 bset_cursor_in_non_selected_windows (struct buffer *b, Lisp_Object val)
203 b->cursor_in_non_selected_windows_ = val;
205 static void
206 bset_cursor_type (struct buffer *b, Lisp_Object val)
208 b->cursor_type_ = val;
210 static void
211 bset_display_table (struct buffer *b, Lisp_Object val)
213 b->display_table_ = val;
215 static void
216 bset_extra_line_spacing (struct buffer *b, Lisp_Object val)
218 b->extra_line_spacing_ = val;
220 static void
221 bset_file_format (struct buffer *b, Lisp_Object val)
223 b->file_format_ = val;
225 static void
226 bset_file_truename (struct buffer *b, Lisp_Object val)
228 b->file_truename_ = val;
230 static void
231 bset_fringe_cursor_alist (struct buffer *b, Lisp_Object val)
233 b->fringe_cursor_alist_ = val;
235 static void
236 bset_fringe_indicator_alist (struct buffer *b, Lisp_Object val)
238 b->fringe_indicator_alist_ = val;
240 static void
241 bset_fringes_outside_margins (struct buffer *b, Lisp_Object val)
243 b->fringes_outside_margins_ = val;
245 static void
246 bset_header_line_format (struct buffer *b, Lisp_Object val)
248 b->header_line_format_ = val;
250 static void
251 bset_indicate_buffer_boundaries (struct buffer *b, Lisp_Object val)
253 b->indicate_buffer_boundaries_ = val;
255 static void
256 bset_indicate_empty_lines (struct buffer *b, Lisp_Object val)
258 b->indicate_empty_lines_ = val;
260 static void
261 bset_invisibility_spec (struct buffer *b, Lisp_Object val)
263 b->invisibility_spec_ = val;
265 static void
266 bset_left_fringe_width (struct buffer *b, Lisp_Object val)
268 b->left_fringe_width_ = val;
270 static void
271 bset_major_mode (struct buffer *b, Lisp_Object val)
273 b->major_mode_ = val;
275 static void
276 bset_mark (struct buffer *b, Lisp_Object val)
278 b->mark_ = val;
280 static void
281 bset_minor_modes (struct buffer *b, Lisp_Object val)
283 b->minor_modes_ = val;
285 static void
286 bset_mode_line_format (struct buffer *b, Lisp_Object val)
288 b->mode_line_format_ = val;
290 static void
291 bset_mode_name (struct buffer *b, Lisp_Object val)
293 b->mode_name_ = val;
295 static void
296 bset_name (struct buffer *b, Lisp_Object val)
298 b->name_ = val;
300 static void
301 bset_overwrite_mode (struct buffer *b, Lisp_Object val)
303 b->overwrite_mode_ = val;
305 static void
306 bset_pt_marker (struct buffer *b, Lisp_Object val)
308 b->pt_marker_ = val;
310 static void
311 bset_right_fringe_width (struct buffer *b, Lisp_Object val)
313 b->right_fringe_width_ = val;
315 static void
316 bset_save_length (struct buffer *b, Lisp_Object val)
318 b->save_length_ = val;
320 static void
321 bset_scroll_bar_width (struct buffer *b, Lisp_Object val)
323 b->scroll_bar_width_ = val;
325 static void
326 bset_scroll_bar_height (struct buffer *b, Lisp_Object val)
328 b->scroll_bar_height_ = val;
330 static void
331 bset_scroll_down_aggressively (struct buffer *b, Lisp_Object val)
333 b->scroll_down_aggressively_ = val;
335 static void
336 bset_scroll_up_aggressively (struct buffer *b, Lisp_Object val)
338 b->scroll_up_aggressively_ = val;
340 static void
341 bset_selective_display (struct buffer *b, Lisp_Object val)
343 b->selective_display_ = val;
345 static void
346 bset_selective_display_ellipses (struct buffer *b, Lisp_Object val)
348 b->selective_display_ellipses_ = val;
350 static void
351 bset_vertical_scroll_bar_type (struct buffer *b, Lisp_Object val)
353 b->vertical_scroll_bar_type_ = val;
355 static void
356 bset_horizontal_scroll_bar_type (struct buffer *b, Lisp_Object val)
358 b->horizontal_scroll_bar_type_ = val;
360 static void
361 bset_word_wrap (struct buffer *b, Lisp_Object val)
363 b->word_wrap_ = val;
365 static void
366 bset_zv_marker (struct buffer *b, Lisp_Object val)
368 b->zv_marker_ = val;
371 void
372 nsberror (Lisp_Object spec)
374 if (STRINGP (spec))
375 error ("No buffer named %s", SDATA (spec));
376 error ("Invalid buffer argument");
379 DEFUN ("buffer-live-p", Fbuffer_live_p, Sbuffer_live_p, 1, 1, 0,
380 doc: /* Return non-nil if OBJECT is a buffer which has not been killed.
381 Value is nil if OBJECT is not a buffer or if it has been killed. */)
382 (Lisp_Object object)
384 return ((BUFFERP (object) && BUFFER_LIVE_P (XBUFFER (object)))
385 ? Qt : Qnil);
388 DEFUN ("buffer-list", Fbuffer_list, Sbuffer_list, 0, 1, 0,
389 doc: /* Return a list of all live buffers.
390 If the optional arg FRAME is a frame, return the buffer list in the
391 proper order for that frame: the buffers shown in FRAME come first,
392 followed by the rest of the buffers. */)
393 (Lisp_Object frame)
395 Lisp_Object general;
396 general = Fmapcar (Qcdr, Vbuffer_alist);
398 if (FRAMEP (frame))
400 Lisp_Object framelist, prevlist, tail;
402 framelist = Fcopy_sequence (XFRAME (frame)->buffer_list);
403 prevlist = Fnreverse (Fcopy_sequence
404 (XFRAME (frame)->buried_buffer_list));
406 /* Remove from GENERAL any buffer that duplicates one in
407 FRAMELIST or PREVLIST. */
408 tail = framelist;
409 while (CONSP (tail))
411 general = Fdelq (XCAR (tail), general);
412 tail = XCDR (tail);
414 tail = prevlist;
415 while (CONSP (tail))
417 general = Fdelq (XCAR (tail), general);
418 tail = XCDR (tail);
421 return CALLN (Fnconc, framelist, general, prevlist);
423 else
424 return general;
427 /* Like Fassoc, but use Fstring_equal to compare
428 (which ignores text properties), and don't ever quit. */
430 static Lisp_Object
431 assoc_ignore_text_properties (Lisp_Object key, Lisp_Object list)
433 Lisp_Object tail;
434 for (tail = list; CONSP (tail); tail = XCDR (tail))
436 Lisp_Object elt = XCAR (tail);
437 if (!NILP (Fstring_equal (Fcar (elt), key)))
438 return elt;
440 return Qnil;
443 DEFUN ("get-buffer", Fget_buffer, Sget_buffer, 1, 1, 0,
444 doc: /* Return the buffer named BUFFER-OR-NAME.
445 BUFFER-OR-NAME must be either a string or a buffer. If BUFFER-OR-NAME
446 is a string and there is no buffer with that name, return nil. If
447 BUFFER-OR-NAME is a buffer, return it as given. */)
448 (register Lisp_Object buffer_or_name)
450 if (BUFFERP (buffer_or_name))
451 return buffer_or_name;
452 CHECK_STRING (buffer_or_name);
454 return Fcdr (assoc_ignore_text_properties (buffer_or_name, Vbuffer_alist));
457 DEFUN ("get-file-buffer", Fget_file_buffer, Sget_file_buffer, 1, 1, 0,
458 doc: /* Return the buffer visiting file FILENAME (a string).
459 The buffer's `buffer-file-name' must match exactly the expansion of FILENAME.
460 If there is no such live buffer, return nil.
461 See also `find-buffer-visiting'. */)
462 (register Lisp_Object filename)
464 register Lisp_Object tail, buf, handler;
466 CHECK_STRING (filename);
467 filename = Fexpand_file_name (filename, Qnil);
469 /* If the file name has special constructs in it,
470 call the corresponding file handler. */
471 handler = Ffind_file_name_handler (filename, Qget_file_buffer);
472 if (!NILP (handler))
474 Lisp_Object handled_buf = call2 (handler, Qget_file_buffer,
475 filename);
476 return BUFFERP (handled_buf) ? handled_buf : Qnil;
479 FOR_EACH_LIVE_BUFFER (tail, buf)
481 if (!STRINGP (BVAR (XBUFFER (buf), filename))) continue;
482 if (!NILP (Fstring_equal (BVAR (XBUFFER (buf), filename), filename)))
483 return buf;
485 return Qnil;
488 Lisp_Object
489 get_truename_buffer (register Lisp_Object filename)
491 register Lisp_Object tail, buf;
493 FOR_EACH_LIVE_BUFFER (tail, buf)
495 if (!STRINGP (BVAR (XBUFFER (buf), file_truename))) continue;
496 if (!NILP (Fstring_equal (BVAR (XBUFFER (buf), file_truename), filename)))
497 return buf;
499 return Qnil;
502 DEFUN ("get-buffer-create", Fget_buffer_create, Sget_buffer_create, 1, 1, 0,
503 doc: /* Return the buffer specified by BUFFER-OR-NAME, creating a new one if needed.
504 If BUFFER-OR-NAME is a string and a live buffer with that name exists,
505 return that buffer. If no such buffer exists, create a new buffer with
506 that name and return it. If BUFFER-OR-NAME starts with a space, the new
507 buffer does not keep undo information.
509 If BUFFER-OR-NAME is a buffer instead of a string, return it as given,
510 even if it is dead. The return value is never nil. */)
511 (register Lisp_Object buffer_or_name)
513 register Lisp_Object buffer, name;
514 register struct buffer *b;
516 buffer = Fget_buffer (buffer_or_name);
517 if (!NILP (buffer))
518 return buffer;
520 if (SCHARS (buffer_or_name) == 0)
521 error ("Empty string for buffer name is not allowed");
523 b = allocate_buffer ();
525 /* An ordinary buffer uses its own struct buffer_text. */
526 b->text = &b->own_text;
527 b->base_buffer = NULL;
528 /* No one shares the text with us now. */
529 b->indirections = 0;
530 /* No one shows us now. */
531 b->window_count = 0;
533 BUF_GAP_SIZE (b) = 20;
534 block_input ();
535 /* We allocate extra 1-byte at the tail and keep it always '\0' for
536 anchoring a search. */
537 alloc_buffer_text (b, BUF_GAP_SIZE (b) + 1);
538 unblock_input ();
539 if (! BUF_BEG_ADDR (b))
540 buffer_memory_full (BUF_GAP_SIZE (b) + 1);
542 b->pt = BEG;
543 b->begv = BEG;
544 b->zv = BEG;
545 b->pt_byte = BEG_BYTE;
546 b->begv_byte = BEG_BYTE;
547 b->zv_byte = BEG_BYTE;
549 BUF_GPT (b) = BEG;
550 BUF_GPT_BYTE (b) = BEG_BYTE;
552 BUF_Z (b) = BEG;
553 BUF_Z_BYTE (b) = BEG_BYTE;
554 BUF_MODIFF (b) = 1;
555 BUF_CHARS_MODIFF (b) = 1;
556 BUF_OVERLAY_MODIFF (b) = 1;
557 BUF_SAVE_MODIFF (b) = 1;
558 BUF_COMPACT (b) = 1;
559 set_buffer_intervals (b, NULL);
560 BUF_UNCHANGED_MODIFIED (b) = 1;
561 BUF_OVERLAY_UNCHANGED_MODIFIED (b) = 1;
562 BUF_END_UNCHANGED (b) = 0;
563 BUF_BEG_UNCHANGED (b) = 0;
564 *(BUF_GPT_ADDR (b)) = *(BUF_Z_ADDR (b)) = 0; /* Put an anchor '\0'. */
565 b->text->inhibit_shrinking = false;
566 b->text->redisplay = false;
568 b->newline_cache = 0;
569 b->width_run_cache = 0;
570 b->bidi_paragraph_cache = 0;
571 bset_width_table (b, Qnil);
572 b->prevent_redisplay_optimizations_p = 1;
574 /* An ordinary buffer normally doesn't need markers
575 to handle BEGV and ZV. */
576 bset_pt_marker (b, Qnil);
577 bset_begv_marker (b, Qnil);
578 bset_zv_marker (b, Qnil);
580 name = Fcopy_sequence (buffer_or_name);
581 set_string_intervals (name, NULL);
582 bset_name (b, name);
584 bset_undo_list (b, SREF (name, 0) != ' ' ? Qnil : Qt);
586 reset_buffer (b);
587 reset_buffer_local_variables (b, 1);
589 bset_mark (b, Fmake_marker ());
590 BUF_MARKERS (b) = NULL;
592 /* Put this in the alist of all live buffers. */
593 XSETBUFFER (buffer, b);
594 Vbuffer_alist = nconc2 (Vbuffer_alist, list1 (Fcons (name, buffer)));
595 /* And run buffer-list-update-hook. */
596 if (!NILP (Vrun_hooks))
597 call1 (Vrun_hooks, Qbuffer_list_update_hook);
599 return buffer;
603 /* Return a list of overlays which is a copy of the overlay list
604 LIST, but for buffer B. */
606 static struct Lisp_Overlay *
607 copy_overlays (struct buffer *b, struct Lisp_Overlay *list)
609 struct Lisp_Overlay *result = NULL, *tail = NULL;
611 for (; list; list = list->next)
613 Lisp_Object overlay, start, end;
614 struct Lisp_Marker *m;
616 eassert (MARKERP (list->start));
617 m = XMARKER (list->start);
618 start = build_marker (b, m->charpos, m->bytepos);
619 XMARKER (start)->insertion_type = m->insertion_type;
621 eassert (MARKERP (list->end));
622 m = XMARKER (list->end);
623 end = build_marker (b, m->charpos, m->bytepos);
624 XMARKER (end)->insertion_type = m->insertion_type;
626 overlay = build_overlay (start, end, Fcopy_sequence (list->plist));
627 if (tail)
628 tail = tail->next = XOVERLAY (overlay);
629 else
630 result = tail = XOVERLAY (overlay);
633 return result;
636 /* Set an appropriate overlay of B. */
638 static void
639 set_buffer_overlays_before (struct buffer *b, struct Lisp_Overlay *o)
641 b->overlays_before = o;
644 static void
645 set_buffer_overlays_after (struct buffer *b, struct Lisp_Overlay *o)
647 b->overlays_after = o;
650 /* Clone per-buffer values of buffer FROM.
652 Buffer TO gets the same per-buffer values as FROM, with the
653 following exceptions: (1) TO's name is left untouched, (2) markers
654 are copied and made to refer to TO, and (3) overlay lists are
655 copied. */
657 static void
658 clone_per_buffer_values (struct buffer *from, struct buffer *to)
660 int offset;
662 FOR_EACH_PER_BUFFER_OBJECT_AT (offset)
664 Lisp_Object obj;
666 /* Don't touch the `name' which should be unique for every buffer. */
667 if (offset == PER_BUFFER_VAR_OFFSET (name))
668 continue;
670 obj = per_buffer_value (from, offset);
671 if (MARKERP (obj) && XMARKER (obj)->buffer == from)
673 struct Lisp_Marker *m = XMARKER (obj);
675 obj = build_marker (to, m->charpos, m->bytepos);
676 XMARKER (obj)->insertion_type = m->insertion_type;
679 set_per_buffer_value (to, offset, obj);
682 memcpy (to->local_flags, from->local_flags, sizeof to->local_flags);
684 set_buffer_overlays_before (to, copy_overlays (to, from->overlays_before));
685 set_buffer_overlays_after (to, copy_overlays (to, from->overlays_after));
687 /* Get (a copy of) the alist of Lisp-level local variables of FROM
688 and install that in TO. */
689 bset_local_var_alist (to, buffer_lisp_local_variables (from, 1));
693 /* If buffer B has markers to record PT, BEGV and ZV when it is not
694 current, update these markers. */
696 static void
697 record_buffer_markers (struct buffer *b)
699 if (! NILP (BVAR (b, pt_marker)))
701 Lisp_Object buffer;
703 eassert (!NILP (BVAR (b, begv_marker)));
704 eassert (!NILP (BVAR (b, zv_marker)));
706 XSETBUFFER (buffer, b);
707 set_marker_both (BVAR (b, pt_marker), buffer, b->pt, b->pt_byte);
708 set_marker_both (BVAR (b, begv_marker), buffer, b->begv, b->begv_byte);
709 set_marker_both (BVAR (b, zv_marker), buffer, b->zv, b->zv_byte);
714 /* If buffer B has markers to record PT, BEGV and ZV when it is not
715 current, fetch these values into B->begv etc. */
717 static void
718 fetch_buffer_markers (struct buffer *b)
720 if (! NILP (BVAR (b, pt_marker)))
722 Lisp_Object m;
724 eassert (!NILP (BVAR (b, begv_marker)));
725 eassert (!NILP (BVAR (b, zv_marker)));
727 m = BVAR (b, pt_marker);
728 SET_BUF_PT_BOTH (b, marker_position (m), marker_byte_position (m));
730 m = BVAR (b, begv_marker);
731 SET_BUF_BEGV_BOTH (b, marker_position (m), marker_byte_position (m));
733 m = BVAR (b, zv_marker);
734 SET_BUF_ZV_BOTH (b, marker_position (m), marker_byte_position (m));
739 DEFUN ("make-indirect-buffer", Fmake_indirect_buffer, Smake_indirect_buffer,
740 2, 3,
741 "bMake indirect buffer (to buffer): \nBName of indirect buffer: ",
742 doc: /* Create and return an indirect buffer for buffer BASE-BUFFER, named NAME.
743 BASE-BUFFER should be a live buffer, or the name of an existing buffer.
744 NAME should be a string which is not the name of an existing buffer.
745 Optional argument CLONE non-nil means preserve BASE-BUFFER's state,
746 such as major and minor modes, in the indirect buffer.
747 CLONE nil means the indirect buffer's state is reset to default values. */)
748 (Lisp_Object base_buffer, Lisp_Object name, Lisp_Object clone)
750 Lisp_Object buf, tem;
751 struct buffer *b;
753 CHECK_STRING (name);
754 buf = Fget_buffer (name);
755 if (!NILP (buf))
756 error ("Buffer name `%s' is in use", SDATA (name));
758 tem = base_buffer;
759 base_buffer = Fget_buffer (base_buffer);
760 if (NILP (base_buffer))
761 error ("No such buffer: `%s'", SDATA (tem));
762 if (!BUFFER_LIVE_P (XBUFFER (base_buffer)))
763 error ("Base buffer has been killed");
765 if (SCHARS (name) == 0)
766 error ("Empty string for buffer name is not allowed");
768 b = allocate_buffer ();
770 /* No double indirection - if base buffer is indirect,
771 new buffer becomes an indirect to base's base. */
772 b->base_buffer = (XBUFFER (base_buffer)->base_buffer
773 ? XBUFFER (base_buffer)->base_buffer
774 : XBUFFER (base_buffer));
776 /* Use the base buffer's text object. */
777 b->text = b->base_buffer->text;
778 /* We have no own text. */
779 b->indirections = -1;
780 /* Notify base buffer that we share the text now. */
781 b->base_buffer->indirections++;
782 /* Always -1 for an indirect buffer. */
783 b->window_count = -1;
785 b->pt = b->base_buffer->pt;
786 b->begv = b->base_buffer->begv;
787 b->zv = b->base_buffer->zv;
788 b->pt_byte = b->base_buffer->pt_byte;
789 b->begv_byte = b->base_buffer->begv_byte;
790 b->zv_byte = b->base_buffer->zv_byte;
792 b->newline_cache = 0;
793 b->width_run_cache = 0;
794 b->bidi_paragraph_cache = 0;
795 bset_width_table (b, Qnil);
797 name = Fcopy_sequence (name);
798 set_string_intervals (name, NULL);
799 bset_name (b, name);
801 /* An indirect buffer shares undo list of its base (Bug#18180). */
802 bset_undo_list (b, BVAR (b->base_buffer, undo_list));
804 reset_buffer (b);
805 reset_buffer_local_variables (b, 1);
807 /* Put this in the alist of all live buffers. */
808 XSETBUFFER (buf, b);
809 Vbuffer_alist = nconc2 (Vbuffer_alist, list1 (Fcons (name, buf)));
811 bset_mark (b, Fmake_marker ());
813 /* The multibyte status belongs to the base buffer. */
814 bset_enable_multibyte_characters
815 (b, BVAR (b->base_buffer, enable_multibyte_characters));
817 /* Make sure the base buffer has markers for its narrowing. */
818 if (NILP (BVAR (b->base_buffer, pt_marker)))
820 eassert (NILP (BVAR (b->base_buffer, begv_marker)));
821 eassert (NILP (BVAR (b->base_buffer, zv_marker)));
823 bset_pt_marker (b->base_buffer,
824 build_marker (b->base_buffer, b->base_buffer->pt,
825 b->base_buffer->pt_byte));
827 bset_begv_marker (b->base_buffer,
828 build_marker (b->base_buffer, b->base_buffer->begv,
829 b->base_buffer->begv_byte));
831 bset_zv_marker (b->base_buffer,
832 build_marker (b->base_buffer, b->base_buffer->zv,
833 b->base_buffer->zv_byte));
835 XMARKER (BVAR (b->base_buffer, zv_marker))->insertion_type = 1;
838 if (NILP (clone))
840 /* Give the indirect buffer markers for its narrowing. */
841 bset_pt_marker (b, build_marker (b, b->pt, b->pt_byte));
842 bset_begv_marker (b, build_marker (b, b->begv, b->begv_byte));
843 bset_zv_marker (b, build_marker (b, b->zv, b->zv_byte));
844 XMARKER (BVAR (b, zv_marker))->insertion_type = 1;
846 else
848 struct buffer *old_b = current_buffer;
850 clone_per_buffer_values (b->base_buffer, b);
851 bset_filename (b, Qnil);
852 bset_file_truename (b, Qnil);
853 bset_display_count (b, make_number (0));
854 bset_backed_up (b, Qnil);
855 bset_auto_save_file_name (b, Qnil);
856 set_buffer_internal_1 (b);
857 Fset (intern ("buffer-save-without-query"), Qnil);
858 Fset (intern ("buffer-file-number"), Qnil);
859 Fset (intern ("buffer-stale-function"), Qnil);
860 set_buffer_internal_1 (old_b);
863 /* Run buffer-list-update-hook. */
864 if (!NILP (Vrun_hooks))
865 call1 (Vrun_hooks, Qbuffer_list_update_hook);
867 return buf;
870 /* Mark OV as no longer associated with B. */
872 static void
873 drop_overlay (struct buffer *b, struct Lisp_Overlay *ov)
875 eassert (b == XBUFFER (Fmarker_buffer (ov->start)));
876 modify_overlay (b, marker_position (ov->start),
877 marker_position (ov->end));
878 unchain_marker (XMARKER (ov->start));
879 unchain_marker (XMARKER (ov->end));
883 /* Delete all overlays of B and reset its overlay lists. */
885 void
886 delete_all_overlays (struct buffer *b)
888 struct Lisp_Overlay *ov, *next;
890 /* FIXME: Since each drop_overlay will scan BUF_MARKERS to unlink its
891 markers, we have an unneeded O(N^2) behavior here. */
892 for (ov = b->overlays_before; ov; ov = next)
894 drop_overlay (b, ov);
895 next = ov->next;
896 ov->next = NULL;
899 for (ov = b->overlays_after; ov; ov = next)
901 drop_overlay (b, ov);
902 next = ov->next;
903 ov->next = NULL;
906 set_buffer_overlays_before (b, NULL);
907 set_buffer_overlays_after (b, NULL);
910 /* Reinitialize everything about a buffer except its name and contents
911 and local variables.
912 If called on an already-initialized buffer, the list of overlays
913 should be deleted before calling this function, otherwise we end up
914 with overlays that claim to belong to the buffer but the buffer
915 claims it doesn't belong to it. */
917 void
918 reset_buffer (register struct buffer *b)
920 bset_filename (b, Qnil);
921 bset_file_truename (b, Qnil);
922 bset_directory (b, current_buffer ? BVAR (current_buffer, directory) : Qnil);
923 b->modtime = make_timespec (0, UNKNOWN_MODTIME_NSECS);
924 b->modtime_size = -1;
925 XSETFASTINT (BVAR (b, save_length), 0);
926 b->last_window_start = 1;
927 /* It is more conservative to start out "changed" than "unchanged". */
928 b->clip_changed = 0;
929 b->prevent_redisplay_optimizations_p = 1;
930 bset_backed_up (b, Qnil);
931 BUF_AUTOSAVE_MODIFF (b) = 0;
932 b->auto_save_failure_time = 0;
933 bset_auto_save_file_name (b, Qnil);
934 bset_read_only (b, Qnil);
935 set_buffer_overlays_before (b, NULL);
936 set_buffer_overlays_after (b, NULL);
937 b->overlay_center = BEG;
938 bset_mark_active (b, Qnil);
939 bset_point_before_scroll (b, Qnil);
940 bset_file_format (b, Qnil);
941 bset_auto_save_file_format (b, Qt);
942 bset_last_selected_window (b, Qnil);
943 bset_display_count (b, make_number (0));
944 bset_display_time (b, Qnil);
945 bset_enable_multibyte_characters
946 (b, BVAR (&buffer_defaults, enable_multibyte_characters));
947 bset_cursor_type (b, BVAR (&buffer_defaults, cursor_type));
948 bset_extra_line_spacing (b, BVAR (&buffer_defaults, extra_line_spacing));
950 b->display_error_modiff = 0;
953 /* Reset buffer B's local variables info.
954 Don't use this on a buffer that has already been in use;
955 it does not treat permanent locals consistently.
956 Instead, use Fkill_all_local_variables.
958 If PERMANENT_TOO, reset permanent buffer-local variables.
959 If not, preserve those. */
961 static void
962 reset_buffer_local_variables (struct buffer *b, bool permanent_too)
964 int offset, i;
966 /* Reset the major mode to Fundamental, together with all the
967 things that depend on the major mode.
968 default-major-mode is handled at a higher level.
969 We ignore it here. */
970 bset_major_mode (b, Qfundamental_mode);
971 bset_keymap (b, Qnil);
972 bset_mode_name (b, QSFundamental);
973 bset_minor_modes (b, Qnil);
975 /* If the standard case table has been altered and invalidated,
976 fix up its insides first. */
977 if (! (CHAR_TABLE_P (XCHAR_TABLE (Vascii_downcase_table)->extras[0])
978 && CHAR_TABLE_P (XCHAR_TABLE (Vascii_downcase_table)->extras[1])
979 && CHAR_TABLE_P (XCHAR_TABLE (Vascii_downcase_table)->extras[2])))
980 Fset_standard_case_table (Vascii_downcase_table);
982 bset_downcase_table (b, Vascii_downcase_table);
983 bset_upcase_table (b, XCHAR_TABLE (Vascii_downcase_table)->extras[0]);
984 bset_case_canon_table (b, XCHAR_TABLE (Vascii_downcase_table)->extras[1]);
985 bset_case_eqv_table (b, XCHAR_TABLE (Vascii_downcase_table)->extras[2]);
986 bset_invisibility_spec (b, Qt);
988 /* Reset all (or most) per-buffer variables to their defaults. */
989 if (permanent_too)
990 bset_local_var_alist (b, Qnil);
991 else
993 Lisp_Object tmp, last = Qnil;
994 for (tmp = BVAR (b, local_var_alist); CONSP (tmp); tmp = XCDR (tmp))
996 Lisp_Object local_var = XCAR (XCAR (tmp));
997 Lisp_Object prop = Fget (local_var, Qpermanent_local);
999 if (!NILP (prop))
1001 /* If permanent-local, keep it. */
1002 last = tmp;
1003 if (EQ (prop, Qpermanent_local_hook))
1005 /* This is a partially permanent hook variable.
1006 Preserve only the elements that want to be preserved. */
1007 Lisp_Object list, newlist;
1008 list = XCDR (XCAR (tmp));
1009 if (!CONSP (list))
1010 newlist = list;
1011 else
1012 for (newlist = Qnil; CONSP (list); list = XCDR (list))
1014 Lisp_Object elt = XCAR (list);
1015 /* Preserve element ELT if it's t,
1016 if it is a function with a `permanent-local-hook' property,
1017 or if it's not a symbol. */
1018 if (! SYMBOLP (elt)
1019 || EQ (elt, Qt)
1020 || !NILP (Fget (elt, Qpermanent_local_hook)))
1021 newlist = Fcons (elt, newlist);
1023 newlist = Fnreverse (newlist);
1024 if (XSYMBOL (local_var)->u.s.trapped_write
1025 == SYMBOL_TRAPPED_WRITE)
1026 notify_variable_watchers (local_var, newlist,
1027 Qmakunbound, Fcurrent_buffer ());
1028 XSETCDR (XCAR (tmp), newlist);
1029 continue; /* Don't do variable write trapping twice. */
1032 /* Delete this local variable. */
1033 else if (NILP (last))
1034 bset_local_var_alist (b, XCDR (tmp));
1035 else
1036 XSETCDR (last, XCDR (tmp));
1038 if (XSYMBOL (local_var)->u.s.trapped_write == SYMBOL_TRAPPED_WRITE)
1039 notify_variable_watchers (local_var, Qnil,
1040 Qmakunbound, Fcurrent_buffer ());
1044 for (i = 0; i < last_per_buffer_idx; ++i)
1045 if (permanent_too || buffer_permanent_local_flags[i] == 0)
1046 SET_PER_BUFFER_VALUE_P (b, i, 0);
1048 /* For each slot that has a default value, copy that into the slot. */
1049 FOR_EACH_PER_BUFFER_OBJECT_AT (offset)
1051 int idx = PER_BUFFER_IDX (offset);
1052 if ((idx > 0
1053 && (permanent_too
1054 || buffer_permanent_local_flags[idx] == 0)))
1055 set_per_buffer_value (b, offset, per_buffer_default (offset));
1059 /* We split this away from generate-new-buffer, because rename-buffer
1060 and set-visited-file-name ought to be able to use this to really
1061 rename the buffer properly. */
1063 DEFUN ("generate-new-buffer-name", Fgenerate_new_buffer_name,
1064 Sgenerate_new_buffer_name, 1, 2, 0,
1065 doc: /* Return a string that is the name of no existing buffer based on NAME.
1066 If there is no live buffer named NAME, then return NAME.
1067 Otherwise modify name by appending `<NUMBER>', incrementing NUMBER
1068 \(starting at 2) until an unused name is found, and then return that name.
1069 Optional second argument IGNORE specifies a name that is okay to use (if
1070 it is in the sequence to be tried) even if a buffer with that name exists.
1072 If NAME begins with a space (i.e., a buffer that is not normally
1073 visible to users), then if buffer NAME already exists a random number
1074 is first appended to NAME, to speed up finding a non-existent buffer. */)
1075 (Lisp_Object name, Lisp_Object ignore)
1077 Lisp_Object genbase;
1079 CHECK_STRING (name);
1081 if ((!NILP (ignore) && !NILP (Fstring_equal (name, ignore)))
1082 || NILP (Fget_buffer (name)))
1083 return name;
1085 if (SREF (name, 0) != ' ') /* See bug#1229. */
1086 genbase = name;
1087 else
1089 char number[sizeof "-999999"];
1091 /* Use XINT instead of XFASTINT to work around GCC bug 80776. */
1092 int i = XINT (Frandom (make_number (1000000)));
1093 eassume (0 <= i && i < 1000000);
1095 AUTO_STRING_WITH_LEN (lnumber, number, sprintf (number, "-%d", i));
1096 genbase = concat2 (name, lnumber);
1097 if (NILP (Fget_buffer (genbase)))
1098 return genbase;
1101 for (ptrdiff_t count = 2; ; count++)
1103 char number[INT_BUFSIZE_BOUND (ptrdiff_t) + sizeof "<>"];
1104 AUTO_STRING_WITH_LEN (lnumber, number,
1105 sprintf (number, "<%"pD"d>", count));
1106 Lisp_Object gentemp = concat2 (genbase, lnumber);
1107 if (!NILP (Fstring_equal (gentemp, ignore))
1108 || NILP (Fget_buffer (gentemp)))
1109 return gentemp;
1114 DEFUN ("buffer-name", Fbuffer_name, Sbuffer_name, 0, 1, 0,
1115 doc: /* Return the name of BUFFER, as a string.
1116 BUFFER defaults to the current buffer.
1117 Return nil if BUFFER has been killed. */)
1118 (register Lisp_Object buffer)
1120 return BVAR (decode_buffer (buffer), name);
1123 DEFUN ("buffer-file-name", Fbuffer_file_name, Sbuffer_file_name, 0, 1, 0,
1124 doc: /* Return name of file BUFFER is visiting, or nil if none.
1125 No argument or nil as argument means use the current buffer. */)
1126 (register Lisp_Object buffer)
1128 return BVAR (decode_buffer (buffer), filename);
1131 DEFUN ("buffer-base-buffer", Fbuffer_base_buffer, Sbuffer_base_buffer,
1132 0, 1, 0,
1133 doc: /* Return the base buffer of indirect buffer BUFFER.
1134 If BUFFER is not indirect, return nil.
1135 BUFFER defaults to the current buffer. */)
1136 (register Lisp_Object buffer)
1138 struct buffer *base = decode_buffer (buffer)->base_buffer;
1139 return base ? (XSETBUFFER (buffer, base), buffer) : Qnil;
1142 DEFUN ("buffer-local-value", Fbuffer_local_value,
1143 Sbuffer_local_value, 2, 2, 0,
1144 doc: /* Return the value of VARIABLE in BUFFER.
1145 If VARIABLE does not have a buffer-local binding in BUFFER, the value
1146 is the default binding of the variable. */)
1147 (register Lisp_Object variable, register Lisp_Object buffer)
1149 register Lisp_Object result = buffer_local_value (variable, buffer);
1151 if (EQ (result, Qunbound))
1152 xsignal1 (Qvoid_variable, variable);
1154 return result;
1158 /* Like Fbuffer_local_value, but return Qunbound if the variable is
1159 locally unbound. */
1161 Lisp_Object
1162 buffer_local_value (Lisp_Object variable, Lisp_Object buffer)
1164 register struct buffer *buf;
1165 register Lisp_Object result;
1166 struct Lisp_Symbol *sym;
1168 CHECK_SYMBOL (variable);
1169 CHECK_BUFFER (buffer);
1170 buf = XBUFFER (buffer);
1171 sym = XSYMBOL (variable);
1173 start:
1174 switch (sym->u.s.redirect)
1176 case SYMBOL_VARALIAS: sym = indirect_variable (sym); goto start;
1177 case SYMBOL_PLAINVAL: result = SYMBOL_VAL (sym); break;
1178 case SYMBOL_LOCALIZED:
1179 { /* Look in local_var_alist. */
1180 struct Lisp_Buffer_Local_Value *blv = SYMBOL_BLV (sym);
1181 XSETSYMBOL (variable, sym); /* Update In case of aliasing. */
1182 result = Fassoc (variable, BVAR (buf, local_var_alist), Qnil);
1183 if (!NILP (result))
1185 if (blv->fwd)
1186 { /* What binding is loaded right now? */
1187 Lisp_Object current_alist_element = blv->valcell;
1189 /* The value of the currently loaded binding is not
1190 stored in it, but rather in the realvalue slot.
1191 Store that value into the binding it belongs to
1192 in case that is the one we are about to use. */
1194 XSETCDR (current_alist_element,
1195 do_symval_forwarding (blv->fwd));
1197 /* Now get the (perhaps updated) value out of the binding. */
1198 result = XCDR (result);
1200 else
1201 result = Fdefault_value (variable);
1202 break;
1204 case SYMBOL_FORWARDED:
1206 union Lisp_Fwd *fwd = SYMBOL_FWD (sym);
1207 if (BUFFER_OBJFWDP (fwd))
1208 result = per_buffer_value (buf, XBUFFER_OBJFWD (fwd)->offset);
1209 else
1210 result = Fdefault_value (variable);
1211 break;
1213 default: emacs_abort ();
1216 return result;
1219 /* Return an alist of the Lisp-level buffer-local bindings of
1220 buffer BUF. That is, don't include the variables maintained
1221 in special slots in the buffer object.
1222 If not CLONE, replace elements of the form (VAR . unbound)
1223 by VAR. */
1225 static Lisp_Object
1226 buffer_lisp_local_variables (struct buffer *buf, bool clone)
1228 Lisp_Object result = Qnil;
1229 Lisp_Object tail;
1230 for (tail = BVAR (buf, local_var_alist); CONSP (tail); tail = XCDR (tail))
1232 Lisp_Object val, elt;
1234 elt = XCAR (tail);
1236 /* Reference each variable in the alist in buf.
1237 If inquiring about the current buffer, this gets the current values,
1238 so store them into the alist so the alist is up to date.
1239 If inquiring about some other buffer, this swaps out any values
1240 for that buffer, making the alist up to date automatically. */
1241 val = find_symbol_value (XCAR (elt));
1242 /* Use the current buffer value only if buf is the current buffer. */
1243 if (buf != current_buffer)
1244 val = XCDR (elt);
1246 result = Fcons (!clone && EQ (val, Qunbound)
1247 ? XCAR (elt)
1248 : Fcons (XCAR (elt), val),
1249 result);
1252 return result;
1255 DEFUN ("buffer-local-variables", Fbuffer_local_variables,
1256 Sbuffer_local_variables, 0, 1, 0,
1257 doc: /* Return an alist of variables that are buffer-local in BUFFER.
1258 Most elements look like (SYMBOL . VALUE), describing one variable.
1259 For a symbol that is locally unbound, just the symbol appears in the value.
1260 Note that storing new VALUEs in these elements doesn't change the variables.
1261 No argument or nil as argument means use current buffer as BUFFER. */)
1262 (Lisp_Object buffer)
1264 struct buffer *buf = decode_buffer (buffer);
1265 Lisp_Object result = buffer_lisp_local_variables (buf, 0);
1267 /* Add on all the variables stored in special slots. */
1269 int offset, idx;
1271 FOR_EACH_PER_BUFFER_OBJECT_AT (offset)
1273 idx = PER_BUFFER_IDX (offset);
1274 if ((idx == -1 || PER_BUFFER_VALUE_P (buf, idx))
1275 && SYMBOLP (PER_BUFFER_SYMBOL (offset)))
1277 Lisp_Object sym = PER_BUFFER_SYMBOL (offset);
1278 Lisp_Object val = per_buffer_value (buf, offset);
1279 result = Fcons (EQ (val, Qunbound) ? sym : Fcons (sym, val),
1280 result);
1285 return result;
1288 DEFUN ("buffer-modified-p", Fbuffer_modified_p, Sbuffer_modified_p,
1289 0, 1, 0,
1290 doc: /* Return t if BUFFER was modified since its file was last read or saved.
1291 No argument or nil as argument means use current buffer as BUFFER. */)
1292 (Lisp_Object buffer)
1294 struct buffer *buf = decode_buffer (buffer);
1295 return BUF_SAVE_MODIFF (buf) < BUF_MODIFF (buf) ? Qt : Qnil;
1298 DEFUN ("force-mode-line-update", Fforce_mode_line_update,
1299 Sforce_mode_line_update, 0, 1, 0,
1300 doc: /* Force redisplay of the current buffer's mode line and header line.
1301 With optional non-nil ALL, force redisplay of all mode lines and
1302 header lines. This function also forces recomputation of the
1303 menu bar menus and the frame title. */)
1304 (Lisp_Object all)
1306 if (!NILP (all))
1308 update_mode_lines = 10;
1309 /* FIXME: This can't be right. */
1310 current_buffer->prevent_redisplay_optimizations_p = true;
1312 else if (buffer_window_count (current_buffer))
1314 bset_update_mode_line (current_buffer);
1315 current_buffer->prevent_redisplay_optimizations_p = true;
1317 return all;
1320 DEFUN ("set-buffer-modified-p", Fset_buffer_modified_p, Sset_buffer_modified_p,
1321 1, 1, 0,
1322 doc: /* Mark current buffer as modified or unmodified according to FLAG.
1323 A non-nil FLAG means mark the buffer modified. */)
1324 (Lisp_Object flag)
1326 Frestore_buffer_modified_p (flag);
1328 /* Set update_mode_lines only if buffer is displayed in some window.
1329 Packages like jit-lock or lazy-lock preserve a buffer's modified
1330 state by recording/restoring the state around blocks of code.
1331 Setting update_mode_lines makes redisplay consider all windows
1332 (on all frames). Stealth fontification of buffers not displayed
1333 would incur additional redisplay costs if we'd set
1334 update_modes_lines unconditionally.
1336 Ideally, I think there should be another mechanism for fontifying
1337 buffers without "modifying" buffers, or redisplay should be
1338 smarter about updating the `*' in mode lines. --gerd */
1339 return Fforce_mode_line_update (Qnil);
1342 DEFUN ("restore-buffer-modified-p", Frestore_buffer_modified_p,
1343 Srestore_buffer_modified_p, 1, 1, 0,
1344 doc: /* Like `set-buffer-modified-p', with a difference concerning redisplay.
1345 It is not ensured that mode lines will be updated to show the modified
1346 state of the current buffer. Use with care. */)
1347 (Lisp_Object flag)
1349 Lisp_Object fn;
1351 /* If buffer becoming modified, lock the file.
1352 If buffer becoming unmodified, unlock the file. */
1354 struct buffer *b = current_buffer->base_buffer
1355 ? current_buffer->base_buffer
1356 : current_buffer;
1358 fn = BVAR (b, file_truename);
1359 /* Test buffer-file-name so that binding it to nil is effective. */
1360 if (!NILP (fn) && ! NILP (BVAR (b, filename)))
1362 bool already = SAVE_MODIFF < MODIFF;
1363 if (!already && !NILP (flag))
1364 lock_file (fn);
1365 else if (already && NILP (flag))
1366 unlock_file (fn);
1369 /* Here we have a problem. SAVE_MODIFF is used here to encode
1370 buffer-modified-p (as SAVE_MODIFF<MODIFF) as well as
1371 recent-auto-save-p (as SAVE_MODIFF<auto_save_modified). So if we
1372 modify SAVE_MODIFF to affect one, we may affect the other
1373 as well.
1374 E.g. if FLAG is nil we need to set SAVE_MODIFF to MODIFF, but
1375 if SAVE_MODIFF<auto_save_modified that means we risk changing
1376 recent-auto-save-p from t to nil.
1377 Vice versa, if FLAG is non-nil and SAVE_MODIFF>=auto_save_modified
1378 we risk changing recent-auto-save-p from nil to t. */
1379 SAVE_MODIFF = (NILP (flag)
1380 /* FIXME: This unavoidably sets recent-auto-save-p to nil. */
1381 ? MODIFF
1382 /* Let's try to preserve recent-auto-save-p. */
1383 : SAVE_MODIFF < MODIFF ? SAVE_MODIFF
1384 /* If SAVE_MODIFF == auto_save_modified == MODIFF,
1385 we can either decrease SAVE_MODIFF and auto_save_modified
1386 or increase MODIFF. */
1387 : MODIFF++);
1389 return flag;
1392 DEFUN ("buffer-modified-tick", Fbuffer_modified_tick, Sbuffer_modified_tick,
1393 0, 1, 0,
1394 doc: /* Return BUFFER's tick counter, incremented for each change in text.
1395 Each buffer has a tick counter which is incremented each time the
1396 text in that buffer is changed. It wraps around occasionally.
1397 No argument or nil as argument means use current buffer as BUFFER. */)
1398 (register Lisp_Object buffer)
1400 return make_number (BUF_MODIFF (decode_buffer (buffer)));
1403 DEFUN ("buffer-chars-modified-tick", Fbuffer_chars_modified_tick,
1404 Sbuffer_chars_modified_tick, 0, 1, 0,
1405 doc: /* Return BUFFER's character-change tick counter.
1406 Each buffer has a character-change tick counter, which is set to the
1407 value of the buffer's tick counter (see `buffer-modified-tick'), each
1408 time text in that buffer is inserted or deleted. By comparing the
1409 values returned by two individual calls of `buffer-chars-modified-tick',
1410 you can tell whether a character change occurred in that buffer in
1411 between these calls. No argument or nil as argument means use current
1412 buffer as BUFFER. */)
1413 (register Lisp_Object buffer)
1415 return make_number (BUF_CHARS_MODIFF (decode_buffer (buffer)));
1418 DEFUN ("rename-buffer", Frename_buffer, Srename_buffer, 1, 2,
1419 "(list (read-string \"Rename buffer (to new name): \" \
1420 nil 'buffer-name-history (buffer-name (current-buffer))) \
1421 current-prefix-arg)",
1422 doc: /* Change current buffer's name to NEWNAME (a string).
1423 If second arg UNIQUE is nil or omitted, it is an error if a
1424 buffer named NEWNAME already exists.
1425 If UNIQUE is non-nil, come up with a new name using
1426 `generate-new-buffer-name'.
1427 Interactively, you can set UNIQUE with a prefix argument.
1428 We return the name we actually gave the buffer.
1429 This does not change the name of the visited file (if any). */)
1430 (register Lisp_Object newname, Lisp_Object unique)
1432 register Lisp_Object tem, buf;
1434 CHECK_STRING (newname);
1436 if (SCHARS (newname) == 0)
1437 error ("Empty string is invalid as a buffer name");
1439 tem = Fget_buffer (newname);
1440 if (!NILP (tem))
1442 /* Don't short-circuit if UNIQUE is t. That is a useful way to
1443 rename the buffer automatically so you can create another
1444 with the original name. It makes UNIQUE equivalent to
1445 (rename-buffer (generate-new-buffer-name NEWNAME)). */
1446 if (NILP (unique) && XBUFFER (tem) == current_buffer)
1447 return BVAR (current_buffer, name);
1448 if (!NILP (unique))
1449 newname = Fgenerate_new_buffer_name (newname, BVAR (current_buffer, name));
1450 else
1451 error ("Buffer name `%s' is in use", SDATA (newname));
1454 bset_name (current_buffer, newname);
1456 /* Catch redisplay's attention. Unless we do this, the mode lines for
1457 any windows displaying current_buffer will stay unchanged. */
1458 update_mode_lines = 11;
1460 XSETBUFFER (buf, current_buffer);
1461 Fsetcar (Frassq (buf, Vbuffer_alist), newname);
1462 if (NILP (BVAR (current_buffer, filename))
1463 && !NILP (BVAR (current_buffer, auto_save_file_name)))
1464 call0 (intern ("rename-auto-save-file"));
1466 /* Run buffer-list-update-hook. */
1467 if (!NILP (Vrun_hooks))
1468 call1 (Vrun_hooks, Qbuffer_list_update_hook);
1470 /* Refetch since that last call may have done GC. */
1471 return BVAR (current_buffer, name);
1474 /* True if B can be used as 'other-than-BUFFER' buffer. */
1476 static bool
1477 candidate_buffer (Lisp_Object b, Lisp_Object buffer)
1479 return (BUFFERP (b) && !EQ (b, buffer)
1480 && BUFFER_LIVE_P (XBUFFER (b))
1481 && !BUFFER_HIDDEN_P (XBUFFER (b)));
1484 DEFUN ("other-buffer", Fother_buffer, Sother_buffer, 0, 3, 0,
1485 doc: /* Return most recently selected buffer other than BUFFER.
1486 Buffers not visible in windows are preferred to visible buffers, unless
1487 optional second argument VISIBLE-OK is non-nil. Ignore the argument
1488 BUFFER unless it denotes a live buffer. If the optional third argument
1489 FRAME specifies a live frame, then use that frame's buffer list instead
1490 of the selected frame's buffer list.
1492 The buffer is found by scanning the selected or specified frame's buffer
1493 list first, followed by the list of all buffers. If no other buffer
1494 exists, return the buffer `*scratch*' (creating it if necessary). */)
1495 (Lisp_Object buffer, Lisp_Object visible_ok, Lisp_Object frame)
1497 struct frame *f = decode_live_frame (frame);
1498 Lisp_Object tail = f->buffer_list, pred = f->buffer_predicate;
1499 Lisp_Object buf, notsogood = Qnil;
1501 /* Consider buffers that have been seen in the frame first. */
1502 for (; CONSP (tail); tail = XCDR (tail))
1504 buf = XCAR (tail);
1505 if (candidate_buffer (buf, buffer)
1506 /* If the frame has a buffer_predicate, disregard buffers that
1507 don't fit the predicate. */
1508 && (NILP (pred) || !NILP (call1 (pred, buf))))
1510 if (!NILP (visible_ok)
1511 || NILP (Fget_buffer_window (buf, Qvisible)))
1512 return buf;
1513 else if (NILP (notsogood))
1514 notsogood = buf;
1518 /* Consider alist of all buffers next. */
1519 FOR_EACH_LIVE_BUFFER (tail, buf)
1521 if (candidate_buffer (buf, buffer)
1522 /* If the frame has a buffer_predicate, disregard buffers that
1523 don't fit the predicate. */
1524 && (NILP (pred) || !NILP (call1 (pred, buf))))
1526 if (!NILP (visible_ok)
1527 || NILP (Fget_buffer_window (buf, Qvisible)))
1528 return buf;
1529 else if (NILP (notsogood))
1530 notsogood = buf;
1534 if (!NILP (notsogood))
1535 return notsogood;
1536 else
1538 AUTO_STRING (scratch, "*scratch*");
1539 buf = Fget_buffer (scratch);
1540 if (NILP (buf))
1542 buf = Fget_buffer_create (scratch);
1543 Fset_buffer_major_mode (buf);
1545 return buf;
1549 /* The following function is a safe variant of Fother_buffer: It doesn't
1550 pay attention to any frame-local buffer lists, doesn't care about
1551 visibility of buffers, and doesn't evaluate any frame predicates. */
1553 Lisp_Object
1554 other_buffer_safely (Lisp_Object buffer)
1556 Lisp_Object tail, buf;
1558 FOR_EACH_LIVE_BUFFER (tail, buf)
1559 if (candidate_buffer (buf, buffer))
1560 return buf;
1562 AUTO_STRING (scratch, "*scratch*");
1563 buf = Fget_buffer (scratch);
1564 if (NILP (buf))
1566 buf = Fget_buffer_create (scratch);
1567 Fset_buffer_major_mode (buf);
1570 return buf;
1573 DEFUN ("buffer-enable-undo", Fbuffer_enable_undo, Sbuffer_enable_undo,
1574 0, 1, "",
1575 doc: /* Start keeping undo information for buffer BUFFER.
1576 No argument or nil as argument means do this for the current buffer. */)
1577 (register Lisp_Object buffer)
1579 Lisp_Object real_buffer;
1581 if (NILP (buffer))
1582 XSETBUFFER (real_buffer, current_buffer);
1583 else
1585 real_buffer = Fget_buffer (buffer);
1586 if (NILP (real_buffer))
1587 nsberror (buffer);
1590 if (EQ (BVAR (XBUFFER (real_buffer), undo_list), Qt))
1591 bset_undo_list (XBUFFER (real_buffer), Qnil);
1593 return Qnil;
1596 /* Truncate undo list and shrink the gap of BUFFER. */
1598 void
1599 compact_buffer (struct buffer *buffer)
1601 BUFFER_CHECK_INDIRECTION (buffer);
1603 /* Skip dead buffers, indirect buffers and buffers
1604 which aren't changed since last compaction. */
1605 if (BUFFER_LIVE_P (buffer)
1606 && (buffer->base_buffer == NULL)
1607 && (BUF_COMPACT (buffer) != BUF_MODIFF (buffer)))
1609 /* If a buffer's undo list is Qt, that means that undo is
1610 turned off in that buffer. Calling truncate_undo_list on
1611 Qt tends to return NULL, which effectively turns undo back on.
1612 So don't call truncate_undo_list if undo_list is Qt. */
1613 if (!EQ (BVAR(buffer, undo_list), Qt))
1614 truncate_undo_list (buffer);
1616 /* Shrink buffer gaps. */
1617 if (!buffer->text->inhibit_shrinking)
1619 /* If a buffer's gap size is more than 10% of the buffer
1620 size, or larger than GAP_BYTES_DFL bytes, then shrink it
1621 accordingly. Keep a minimum size of GAP_BYTES_MIN bytes. */
1622 ptrdiff_t size = clip_to_bounds (GAP_BYTES_MIN,
1623 BUF_Z_BYTE (buffer) / 10,
1624 GAP_BYTES_DFL);
1625 if (BUF_GAP_SIZE (buffer) > size)
1626 make_gap_1 (buffer, -(BUF_GAP_SIZE (buffer) - size));
1628 BUF_COMPACT (buffer) = BUF_MODIFF (buffer);
1632 DEFUN ("kill-buffer", Fkill_buffer, Skill_buffer, 0, 1, "bKill buffer: ",
1633 doc: /* Kill the buffer specified by BUFFER-OR-NAME.
1634 The argument may be a buffer or the name of an existing buffer.
1635 Argument nil or omitted means kill the current buffer. Return t if the
1636 buffer is actually killed, nil otherwise.
1638 The functions in `kill-buffer-query-functions' are called with the
1639 buffer to be killed as the current buffer. If any of them returns nil,
1640 the buffer is not killed. The hook `kill-buffer-hook' is run before the
1641 buffer is actually killed. The buffer being killed will be current
1642 while the hook is running. Functions called by any of these hooks are
1643 supposed to not change the current buffer.
1645 Any processes that have this buffer as the `process-buffer' are killed
1646 with SIGHUP. This function calls `replace-buffer-in-windows' for
1647 cleaning up all windows currently displaying the buffer to be killed. */)
1648 (Lisp_Object buffer_or_name)
1650 Lisp_Object buffer;
1651 struct buffer *b;
1652 Lisp_Object tem;
1653 struct Lisp_Marker *m;
1655 if (NILP (buffer_or_name))
1656 buffer = Fcurrent_buffer ();
1657 else
1658 buffer = Fget_buffer (buffer_or_name);
1659 if (NILP (buffer))
1660 nsberror (buffer_or_name);
1662 b = XBUFFER (buffer);
1664 /* Avoid trouble for buffer already dead. */
1665 if (!BUFFER_LIVE_P (b))
1666 return Qnil;
1668 if (thread_check_current_buffer (b))
1669 return Qnil;
1671 /* Run hooks with the buffer to be killed the current buffer. */
1673 ptrdiff_t count = SPECPDL_INDEX ();
1675 record_unwind_protect (save_excursion_restore, save_excursion_save ());
1676 set_buffer_internal (b);
1678 /* First run the query functions; if any query is answered no,
1679 don't kill the buffer. */
1680 tem = CALLN (Frun_hook_with_args_until_failure,
1681 Qkill_buffer_query_functions);
1682 if (NILP (tem))
1683 return unbind_to (count, Qnil);
1685 /* Query if the buffer is still modified. */
1686 if (INTERACTIVE && !NILP (BVAR (b, filename))
1687 && BUF_MODIFF (b) > BUF_SAVE_MODIFF (b))
1689 AUTO_STRING (format, "Buffer %s modified; kill anyway? ");
1690 tem = do_yes_or_no_p (CALLN (Fformat, format, BVAR (b, name)));
1691 if (NILP (tem))
1692 return unbind_to (count, Qnil);
1695 /* If the hooks have killed the buffer, exit now. */
1696 if (!BUFFER_LIVE_P (b))
1697 return unbind_to (count, Qt);
1699 /* Then run the hooks. */
1700 run_hook (Qkill_buffer_hook);
1701 unbind_to (count, Qnil);
1704 /* If the hooks have killed the buffer, exit now. */
1705 if (!BUFFER_LIVE_P (b))
1706 return Qt;
1708 /* We have no more questions to ask. Verify that it is valid
1709 to kill the buffer. This must be done after the questions
1710 since anything can happen within do_yes_or_no_p. */
1712 /* Don't kill the minibuffer now current. */
1713 if (EQ (buffer, XWINDOW (minibuf_window)->contents))
1714 return Qnil;
1716 /* When we kill an ordinary buffer which shares its buffer text
1717 with indirect buffer(s), we must kill indirect buffer(s) too.
1718 We do it at this stage so nothing terrible happens if they
1719 ask questions or their hooks get errors. */
1720 if (!b->base_buffer && b->indirections > 0)
1722 struct buffer *other;
1724 FOR_EACH_BUFFER (other)
1725 if (other->base_buffer == b)
1727 Lisp_Object buf;
1728 XSETBUFFER (buf, other);
1729 Fkill_buffer (buf);
1732 /* Exit if we now have killed the base buffer (Bug#11665). */
1733 if (!BUFFER_LIVE_P (b))
1734 return Qt;
1737 /* Run replace_buffer_in_windows before making another buffer current
1738 since set-window-buffer-start-and-point will refuse to make another
1739 buffer current if the selected window does not show the current
1740 buffer (bug#10114). */
1741 replace_buffer_in_windows (buffer);
1743 /* Exit if replacing the buffer in windows has killed our buffer. */
1744 if (!BUFFER_LIVE_P (b))
1745 return Qt;
1747 /* Make this buffer not be current. Exit if it is the sole visible
1748 buffer. */
1749 if (b == current_buffer)
1751 tem = Fother_buffer (buffer, Qnil, Qnil);
1752 Fset_buffer (tem);
1753 if (b == current_buffer)
1754 return Qnil;
1757 /* If the buffer now current is shown in the minibuffer and our buffer
1758 is the sole other buffer give up. */
1759 XSETBUFFER (tem, current_buffer);
1760 if (EQ (tem, XWINDOW (minibuf_window)->contents)
1761 && EQ (buffer, Fother_buffer (buffer, Qnil, Qnil)))
1762 return Qnil;
1764 /* Now there is no question: we can kill the buffer. */
1766 /* Unlock this buffer's file, if it is locked. */
1767 unlock_buffer (b);
1769 kill_buffer_processes (buffer);
1770 kill_buffer_xwidgets (buffer);
1772 /* Killing buffer processes may run sentinels which may have killed
1773 our buffer. */
1774 if (!BUFFER_LIVE_P (b))
1775 return Qt;
1777 /* These may run Lisp code and into infinite loops (if someone
1778 insisted on circular lists) so allow quitting here. */
1779 frames_discard_buffer (buffer);
1781 clear_charpos_cache (b);
1783 tem = Vinhibit_quit;
1784 Vinhibit_quit = Qt;
1785 /* Remove the buffer from the list of all buffers. */
1786 Vbuffer_alist = Fdelq (Frassq (buffer, Vbuffer_alist), Vbuffer_alist);
1787 /* If replace_buffer_in_windows didn't do its job fix that now. */
1788 replace_buffer_in_windows_safely (buffer);
1789 Vinhibit_quit = tem;
1791 /* Delete any auto-save file, if we saved it in this session.
1792 But not if the buffer is modified. */
1793 if (STRINGP (BVAR (b, auto_save_file_name))
1794 && BUF_AUTOSAVE_MODIFF (b) != 0
1795 && BUF_SAVE_MODIFF (b) < BUF_AUTOSAVE_MODIFF (b)
1796 && BUF_SAVE_MODIFF (b) < BUF_MODIFF (b)
1797 && NILP (Fsymbol_value (intern ("auto-save-visited-file-name"))))
1799 Lisp_Object delete;
1800 delete = Fsymbol_value (intern ("delete-auto-save-files"));
1801 if (! NILP (delete))
1802 internal_delete_file (BVAR (b, auto_save_file_name));
1805 /* Deleting an auto-save file could have killed our buffer. */
1806 if (!BUFFER_LIVE_P (b))
1807 return Qt;
1809 if (b->base_buffer)
1811 INTERVAL i;
1812 /* Unchain all markers that belong to this indirect buffer.
1813 Don't unchain the markers that belong to the base buffer
1814 or its other indirect buffers. */
1815 struct Lisp_Marker **mp = &BUF_MARKERS (b);
1816 while ((m = *mp))
1818 if (m->buffer == b)
1820 m->buffer = NULL;
1821 *mp = m->next;
1823 else
1824 mp = &m->next;
1826 /* Intervals should be owned by the base buffer (Bug#16502). */
1827 i = buffer_intervals (b);
1828 if (i)
1830 Lisp_Object owner;
1831 XSETBUFFER (owner, b->base_buffer);
1832 set_interval_object (i, owner);
1835 else
1837 /* Unchain all markers of this buffer and its indirect buffers.
1838 and leave them pointing nowhere. */
1839 for (m = BUF_MARKERS (b); m; )
1841 struct Lisp_Marker *next = m->next;
1842 m->buffer = 0;
1843 m->next = NULL;
1844 m = next;
1846 BUF_MARKERS (b) = NULL;
1847 set_buffer_intervals (b, NULL);
1849 /* Perhaps we should explicitly free the interval tree here... */
1851 /* Since we've unlinked the markers, the overlays can't be here any more
1852 either. */
1853 b->overlays_before = NULL;
1854 b->overlays_after = NULL;
1856 /* Reset the local variables, so that this buffer's local values
1857 won't be protected from GC. They would be protected
1858 if they happened to remain cached in their symbols.
1859 This gets rid of them for certain. */
1860 swap_out_buffer_local_variables (b);
1861 reset_buffer_local_variables (b, 1);
1863 bset_name (b, Qnil);
1865 block_input ();
1866 if (b->base_buffer)
1868 /* Notify our base buffer that we don't share the text anymore. */
1869 eassert (b->indirections == -1);
1870 b->base_buffer->indirections--;
1871 eassert (b->base_buffer->indirections >= 0);
1872 /* Make sure that we wasn't confused. */
1873 eassert (b->window_count == -1);
1875 else
1877 /* Make sure that no one shows us. */
1878 eassert (b->window_count == 0);
1879 /* No one shares our buffer text, can free it. */
1880 free_buffer_text (b);
1883 if (b->newline_cache)
1885 free_region_cache (b->newline_cache);
1886 b->newline_cache = 0;
1888 if (b->width_run_cache)
1890 free_region_cache (b->width_run_cache);
1891 b->width_run_cache = 0;
1893 if (b->bidi_paragraph_cache)
1895 free_region_cache (b->bidi_paragraph_cache);
1896 b->bidi_paragraph_cache = 0;
1898 bset_width_table (b, Qnil);
1899 unblock_input ();
1900 bset_undo_list (b, Qnil);
1902 /* Run buffer-list-update-hook. */
1903 if (!NILP (Vrun_hooks))
1904 call1 (Vrun_hooks, Qbuffer_list_update_hook);
1906 return Qt;
1909 /* Move association for BUFFER to the front of buffer (a)lists. Since
1910 we do this each time BUFFER is selected visibly, the more recently
1911 selected buffers are always closer to the front of those lists. This
1912 means that other_buffer is more likely to choose a relevant buffer.
1914 Note that this moves BUFFER to the front of the buffer lists of the
1915 selected frame even if BUFFER is not shown there. If BUFFER is not
1916 shown in the selected frame, consider the present behavior a feature.
1917 `select-window' gets this right since it shows BUFFER in the selected
1918 window when calling us. */
1920 void
1921 record_buffer (Lisp_Object buffer)
1923 Lisp_Object aelt, aelt_cons, tem;
1924 register struct frame *f = XFRAME (selected_frame);
1926 CHECK_BUFFER (buffer);
1928 /* Update Vbuffer_alist (we know that it has an entry for BUFFER).
1929 Don't allow quitting since this might leave the buffer list in an
1930 inconsistent state. */
1931 tem = Vinhibit_quit;
1932 Vinhibit_quit = Qt;
1933 aelt = Frassq (buffer, Vbuffer_alist);
1934 aelt_cons = Fmemq (aelt, Vbuffer_alist);
1935 Vbuffer_alist = Fdelq (aelt, Vbuffer_alist);
1936 XSETCDR (aelt_cons, Vbuffer_alist);
1937 Vbuffer_alist = aelt_cons;
1938 Vinhibit_quit = tem;
1940 /* Update buffer list of selected frame. */
1941 fset_buffer_list (f, Fcons (buffer, Fdelq (buffer, f->buffer_list)));
1942 fset_buried_buffer_list (f, Fdelq (buffer, f->buried_buffer_list));
1944 /* Run buffer-list-update-hook. */
1945 if (!NILP (Vrun_hooks))
1946 call1 (Vrun_hooks, Qbuffer_list_update_hook);
1950 /* Move BUFFER to the end of the buffer (a)lists. Do nothing if the
1951 buffer is killed. For the selected frame's buffer list this moves
1952 BUFFER to its end even if it was never shown in that frame. If
1953 this happens we have a feature, hence `bury-buffer-internal' should be
1954 called only when BUFFER was shown in the selected frame. */
1956 DEFUN ("bury-buffer-internal", Fbury_buffer_internal, Sbury_buffer_internal,
1957 1, 1, 0,
1958 doc: /* Move BUFFER to the end of the buffer list. */)
1959 (Lisp_Object buffer)
1961 Lisp_Object aelt, aelt_cons, tem;
1962 register struct frame *f = XFRAME (selected_frame);
1964 CHECK_BUFFER (buffer);
1966 /* Update Vbuffer_alist (we know that it has an entry for BUFFER).
1967 Don't allow quitting since this might leave the buffer list in an
1968 inconsistent state. */
1969 tem = Vinhibit_quit;
1970 Vinhibit_quit = Qt;
1971 aelt = Frassq (buffer, Vbuffer_alist);
1972 aelt_cons = Fmemq (aelt, Vbuffer_alist);
1973 Vbuffer_alist = Fdelq (aelt, Vbuffer_alist);
1974 XSETCDR (aelt_cons, Qnil);
1975 Vbuffer_alist = nconc2 (Vbuffer_alist, aelt_cons);
1976 Vinhibit_quit = tem;
1978 /* Update buffer lists of selected frame. */
1979 fset_buffer_list (f, Fdelq (buffer, f->buffer_list));
1980 fset_buried_buffer_list
1981 (f, Fcons (buffer, Fdelq (buffer, f->buried_buffer_list)));
1983 /* Run buffer-list-update-hook. */
1984 if (!NILP (Vrun_hooks))
1985 call1 (Vrun_hooks, Qbuffer_list_update_hook);
1987 return Qnil;
1990 DEFUN ("set-buffer-major-mode", Fset_buffer_major_mode, Sset_buffer_major_mode, 1, 1, 0,
1991 doc: /* Set an appropriate major mode for BUFFER.
1992 For the *scratch* buffer, use `initial-major-mode', otherwise choose a mode
1993 according to the default value of `major-mode'.
1994 Use this function before selecting the buffer, since it may need to inspect
1995 the current buffer's major mode. */)
1996 (Lisp_Object buffer)
1998 ptrdiff_t count;
1999 Lisp_Object function;
2001 CHECK_BUFFER (buffer);
2003 if (!BUFFER_LIVE_P (XBUFFER (buffer)))
2004 error ("Attempt to set major mode for a dead buffer");
2006 if (strcmp (SSDATA (BVAR (XBUFFER (buffer), name)), "*scratch*") == 0)
2007 function = find_symbol_value (intern ("initial-major-mode"));
2008 else
2010 function = BVAR (&buffer_defaults, major_mode);
2011 if (NILP (function)
2012 && NILP (Fget (BVAR (current_buffer, major_mode), Qmode_class)))
2013 function = BVAR (current_buffer, major_mode);
2016 if (NILP (function)) /* If function is `fundamental-mode', allow it to run
2017 so that `run-mode-hooks' and thus
2018 `hack-local-variables' get run. */
2019 return Qnil;
2021 count = SPECPDL_INDEX ();
2023 /* To select a nonfundamental mode,
2024 select the buffer temporarily and then call the mode function. */
2026 record_unwind_current_buffer ();
2028 Fset_buffer (buffer);
2029 call0 (function);
2031 return unbind_to (count, Qnil);
2034 DEFUN ("current-buffer", Fcurrent_buffer, Scurrent_buffer, 0, 0, 0,
2035 doc: /* Return the current buffer as a Lisp object. */)
2036 (void)
2038 register Lisp_Object buf;
2039 XSETBUFFER (buf, current_buffer);
2040 return buf;
2043 /* Set the current buffer to B, and do not set windows_or_buffers_changed.
2044 This is used by redisplay. */
2046 void
2047 set_buffer_internal_1 (register struct buffer *b)
2049 #ifdef USE_MMAP_FOR_BUFFERS
2050 if (b->text->beg == NULL)
2051 enlarge_buffer_text (b, 0);
2052 #endif /* USE_MMAP_FOR_BUFFERS */
2054 if (current_buffer == b)
2055 return;
2057 set_buffer_internal_2 (b);
2060 /* Like set_buffer_internal_1, but doesn't check whether B is already
2061 the current buffer. Called upon switch of the current thread, see
2062 post_acquire_global_lock. */
2063 void set_buffer_internal_2 (register struct buffer *b)
2065 register struct buffer *old_buf;
2066 register Lisp_Object tail;
2068 BUFFER_CHECK_INDIRECTION (b);
2070 old_buf = current_buffer;
2071 current_buffer = b;
2072 last_known_column_point = -1; /* Invalidate indentation cache. */
2074 if (old_buf)
2076 /* Put the undo list back in the base buffer, so that it appears
2077 that an indirect buffer shares the undo list of its base. */
2078 if (old_buf->base_buffer)
2079 bset_undo_list (old_buf->base_buffer, BVAR (old_buf, undo_list));
2081 /* If the old current buffer has markers to record PT, BEGV and ZV
2082 when it is not current, update them now. */
2083 record_buffer_markers (old_buf);
2086 /* Get the undo list from the base buffer, so that it appears
2087 that an indirect buffer shares the undo list of its base. */
2088 if (b->base_buffer)
2089 bset_undo_list (b, BVAR (b->base_buffer, undo_list));
2091 /* If the new current buffer has markers to record PT, BEGV and ZV
2092 when it is not current, fetch them now. */
2093 fetch_buffer_markers (b);
2095 /* Look down buffer's list of local Lisp variables
2096 to find and update any that forward into C variables. */
2100 for (tail = BVAR (b, local_var_alist); CONSP (tail); tail = XCDR (tail))
2102 Lisp_Object var = XCAR (XCAR (tail));
2103 struct Lisp_Symbol *sym = XSYMBOL (var);
2104 if (sym->u.s.redirect == SYMBOL_LOCALIZED /* Just to be sure. */
2105 && SYMBOL_BLV (sym)->fwd)
2106 /* Just reference the variable
2107 to cause it to become set for this buffer. */
2108 Fsymbol_value (var);
2111 /* Do the same with any others that were local to the previous buffer */
2112 while (b != old_buf && (b = old_buf, b));
2115 /* Switch to buffer B temporarily for redisplay purposes.
2116 This avoids certain things that don't need to be done within redisplay. */
2118 void
2119 set_buffer_temp (struct buffer *b)
2121 register struct buffer *old_buf;
2123 if (current_buffer == b)
2124 return;
2126 old_buf = current_buffer;
2127 current_buffer = b;
2129 /* If the old current buffer has markers to record PT, BEGV and ZV
2130 when it is not current, update them now. */
2131 record_buffer_markers (old_buf);
2133 /* If the new current buffer has markers to record PT, BEGV and ZV
2134 when it is not current, fetch them now. */
2135 fetch_buffer_markers (b);
2138 DEFUN ("set-buffer", Fset_buffer, Sset_buffer, 1, 1, 0,
2139 doc: /* Make buffer BUFFER-OR-NAME current for editing operations.
2140 BUFFER-OR-NAME may be a buffer or the name of an existing buffer.
2141 See also `with-current-buffer' when you want to make a buffer current
2142 temporarily. This function does not display the buffer, so its effect
2143 ends when the current command terminates. Use `switch-to-buffer' or
2144 `pop-to-buffer' to switch buffers permanently.
2145 The return value is the buffer made current. */)
2146 (register Lisp_Object buffer_or_name)
2148 register Lisp_Object buffer;
2149 buffer = Fget_buffer (buffer_or_name);
2150 if (NILP (buffer))
2151 nsberror (buffer_or_name);
2152 if (!BUFFER_LIVE_P (XBUFFER (buffer)))
2153 error ("Selecting deleted buffer");
2154 set_buffer_internal (XBUFFER (buffer));
2155 return buffer;
2158 void
2159 restore_buffer (Lisp_Object buffer_or_name)
2161 Fset_buffer (buffer_or_name);
2164 /* Set the current buffer to BUFFER provided if it is alive. */
2166 void
2167 set_buffer_if_live (Lisp_Object buffer)
2169 if (BUFFER_LIVE_P (XBUFFER (buffer)))
2170 set_buffer_internal (XBUFFER (buffer));
2173 DEFUN ("barf-if-buffer-read-only", Fbarf_if_buffer_read_only,
2174 Sbarf_if_buffer_read_only, 0, 1, 0,
2175 doc: /* Signal a `buffer-read-only' error if the current buffer is read-only.
2176 If the text under POSITION (which defaults to point) has the
2177 `inhibit-read-only' text property set, the error will not be raised. */)
2178 (Lisp_Object position)
2180 if (NILP (position))
2181 XSETFASTINT (position, PT);
2182 else
2183 CHECK_NUMBER (position);
2185 if (!NILP (BVAR (current_buffer, read_only))
2186 && NILP (Vinhibit_read_only)
2187 && NILP (Fget_text_property (position, Qinhibit_read_only, Qnil)))
2188 xsignal1 (Qbuffer_read_only, Fcurrent_buffer ());
2189 return Qnil;
2192 DEFUN ("erase-buffer", Ferase_buffer, Serase_buffer, 0, 0, "*",
2193 doc: /* Delete the entire contents of the current buffer.
2194 Any narrowing restriction in effect (see `narrow-to-region') is removed,
2195 so the buffer is truly empty after this. */)
2196 (void)
2198 Fwiden ();
2200 del_range (BEG, Z);
2202 current_buffer->last_window_start = 1;
2203 /* Prevent warnings, or suspension of auto saving, that would happen
2204 if future size is less than past size. Use of erase-buffer
2205 implies that the future text is not really related to the past text. */
2206 XSETFASTINT (BVAR (current_buffer, save_length), 0);
2207 return Qnil;
2210 void
2211 validate_region (register Lisp_Object *b, register Lisp_Object *e)
2213 CHECK_NUMBER_COERCE_MARKER (*b);
2214 CHECK_NUMBER_COERCE_MARKER (*e);
2216 if (XINT (*b) > XINT (*e))
2218 Lisp_Object tem;
2219 tem = *b; *b = *e; *e = tem;
2222 if (! (BEGV <= XINT (*b) && XINT (*e) <= ZV))
2223 args_out_of_range_3 (Fcurrent_buffer (), *b, *e);
2226 /* Advance BYTE_POS up to a character boundary
2227 and return the adjusted position. */
2229 static ptrdiff_t
2230 advance_to_char_boundary (ptrdiff_t byte_pos)
2232 int c;
2234 if (byte_pos == BEG)
2235 /* Beginning of buffer is always a character boundary. */
2236 return BEG;
2238 c = FETCH_BYTE (byte_pos);
2239 if (! CHAR_HEAD_P (c))
2241 /* We should advance BYTE_POS only when C is a constituent of a
2242 multibyte sequence. */
2243 ptrdiff_t orig_byte_pos = byte_pos;
2247 byte_pos--;
2248 c = FETCH_BYTE (byte_pos);
2250 while (! CHAR_HEAD_P (c) && byte_pos > BEG);
2251 INC_POS (byte_pos);
2252 if (byte_pos < orig_byte_pos)
2253 byte_pos = orig_byte_pos;
2254 /* If C is a constituent of a multibyte sequence, BYTE_POS was
2255 surely advance to the correct character boundary. If C is
2256 not, BYTE_POS was unchanged. */
2259 return byte_pos;
2262 DEFUN ("buffer-swap-text", Fbuffer_swap_text, Sbuffer_swap_text,
2263 1, 1, 0,
2264 doc: /* Swap the text between current buffer and BUFFER.
2265 Using this function from `save-excursion' might produce surprising
2266 results, see Info node `(elisp)Swapping Text'. */)
2267 (Lisp_Object buffer)
2269 struct buffer *other_buffer;
2270 CHECK_BUFFER (buffer);
2271 other_buffer = XBUFFER (buffer);
2273 if (!BUFFER_LIVE_P (other_buffer))
2274 error ("Cannot swap a dead buffer's text");
2276 /* Actually, it probably works just fine.
2277 * if (other_buffer == current_buffer)
2278 * error ("Cannot swap a buffer's text with itself"); */
2280 /* Actually, this may be workable as well, tho probably only if they're
2281 *both* indirect. */
2282 if (other_buffer->base_buffer
2283 || current_buffer->base_buffer)
2284 error ("Cannot swap indirect buffers's text");
2286 { /* This is probably harder to make work. */
2287 struct buffer *other;
2288 FOR_EACH_BUFFER (other)
2289 if (other->base_buffer == other_buffer
2290 || other->base_buffer == current_buffer)
2291 error ("One of the buffers to swap has indirect buffers");
2294 #define swapfield(field, type) \
2295 do { \
2296 type tmp##field = other_buffer->field; \
2297 other_buffer->field = current_buffer->field; \
2298 current_buffer->field = tmp##field; \
2299 } while (0)
2300 #define swapfield_(field, type) \
2301 do { \
2302 type tmp##field = BVAR (other_buffer, field); \
2303 bset_##field (other_buffer, BVAR (current_buffer, field)); \
2304 bset_##field (current_buffer, tmp##field); \
2305 } while (0)
2307 swapfield (own_text, struct buffer_text);
2308 eassert (current_buffer->text == &current_buffer->own_text);
2309 eassert (other_buffer->text == &other_buffer->own_text);
2310 #ifdef REL_ALLOC
2311 r_alloc_reset_variable ((void **) &current_buffer->own_text.beg,
2312 (void **) &other_buffer->own_text.beg);
2313 r_alloc_reset_variable ((void **) &other_buffer->own_text.beg,
2314 (void **) &current_buffer->own_text.beg);
2315 #endif /* REL_ALLOC */
2317 swapfield (pt, ptrdiff_t);
2318 swapfield (pt_byte, ptrdiff_t);
2319 swapfield (begv, ptrdiff_t);
2320 swapfield (begv_byte, ptrdiff_t);
2321 swapfield (zv, ptrdiff_t);
2322 swapfield (zv_byte, ptrdiff_t);
2323 eassert (!current_buffer->base_buffer);
2324 eassert (!other_buffer->base_buffer);
2325 swapfield (indirections, ptrdiff_t);
2326 current_buffer->clip_changed = 1; other_buffer->clip_changed = 1;
2327 swapfield (newline_cache, struct region_cache *);
2328 swapfield (width_run_cache, struct region_cache *);
2329 swapfield (bidi_paragraph_cache, struct region_cache *);
2330 current_buffer->prevent_redisplay_optimizations_p = 1;
2331 other_buffer->prevent_redisplay_optimizations_p = 1;
2332 swapfield (overlays_before, struct Lisp_Overlay *);
2333 swapfield (overlays_after, struct Lisp_Overlay *);
2334 swapfield (overlay_center, ptrdiff_t);
2335 swapfield_ (undo_list, Lisp_Object);
2336 swapfield_ (mark, Lisp_Object);
2337 swapfield_ (enable_multibyte_characters, Lisp_Object);
2338 swapfield_ (bidi_display_reordering, Lisp_Object);
2339 swapfield_ (bidi_paragraph_direction, Lisp_Object);
2340 swapfield_ (bidi_paragraph_separate_re, Lisp_Object);
2341 swapfield_ (bidi_paragraph_start_re, Lisp_Object);
2342 /* FIXME: Not sure what we should do with these *_marker fields.
2343 Hopefully they're just nil anyway. */
2344 swapfield_ (pt_marker, Lisp_Object);
2345 swapfield_ (begv_marker, Lisp_Object);
2346 swapfield_ (zv_marker, Lisp_Object);
2347 bset_point_before_scroll (current_buffer, Qnil);
2348 bset_point_before_scroll (other_buffer, Qnil);
2350 current_buffer->text->modiff++; other_buffer->text->modiff++;
2351 current_buffer->text->chars_modiff++; other_buffer->text->chars_modiff++;
2352 current_buffer->text->overlay_modiff++; other_buffer->text->overlay_modiff++;
2353 current_buffer->text->beg_unchanged = current_buffer->text->gpt;
2354 current_buffer->text->end_unchanged = current_buffer->text->gpt;
2355 other_buffer->text->beg_unchanged = other_buffer->text->gpt;
2356 other_buffer->text->end_unchanged = other_buffer->text->gpt;
2358 struct Lisp_Marker *m;
2359 for (m = BUF_MARKERS (current_buffer); m; m = m->next)
2360 if (m->buffer == other_buffer)
2361 m->buffer = current_buffer;
2362 else
2363 /* Since there's no indirect buffer in sight, markers on
2364 BUF_MARKERS(buf) should either be for `buf' or dead. */
2365 eassert (!m->buffer);
2366 for (m = BUF_MARKERS (other_buffer); m; m = m->next)
2367 if (m->buffer == current_buffer)
2368 m->buffer = other_buffer;
2369 else
2370 /* Since there's no indirect buffer in sight, markers on
2371 BUF_MARKERS(buf) should either be for `buf' or dead. */
2372 eassert (!m->buffer);
2374 { /* Some of the C code expects that both window markers of a
2375 live window points to that window's buffer. So since we
2376 just swapped the markers between the two buffers, we need
2377 to undo the effect of this swap for window markers. */
2378 Lisp_Object w = selected_window, ws = Qnil;
2379 Lisp_Object buf1, buf2;
2380 XSETBUFFER (buf1, current_buffer); XSETBUFFER (buf2, other_buffer);
2382 while (NILP (Fmemq (w, ws)))
2384 ws = Fcons (w, ws);
2385 if (MARKERP (XWINDOW (w)->pointm)
2386 && (EQ (XWINDOW (w)->contents, buf1)
2387 || EQ (XWINDOW (w)->contents, buf2)))
2388 Fset_marker (XWINDOW (w)->pointm,
2389 make_number
2390 (BUF_BEGV (XBUFFER (XWINDOW (w)->contents))),
2391 XWINDOW (w)->contents);
2392 /* Blindly copied from pointm part. */
2393 if (MARKERP (XWINDOW (w)->old_pointm)
2394 && (EQ (XWINDOW (w)->contents, buf1)
2395 || EQ (XWINDOW (w)->contents, buf2)))
2396 Fset_marker (XWINDOW (w)->old_pointm,
2397 make_number
2398 (BUF_BEGV (XBUFFER (XWINDOW (w)->contents))),
2399 XWINDOW (w)->contents);
2400 if (MARKERP (XWINDOW (w)->start)
2401 && (EQ (XWINDOW (w)->contents, buf1)
2402 || EQ (XWINDOW (w)->contents, buf2)))
2403 Fset_marker (XWINDOW (w)->start,
2404 make_number
2405 (XBUFFER (XWINDOW (w)->contents)->last_window_start),
2406 XWINDOW (w)->contents);
2407 w = Fnext_window (w, Qt, Qt);
2411 if (current_buffer->text->intervals)
2412 (eassert (EQ (current_buffer->text->intervals->up.obj, buffer)),
2413 XSETBUFFER (current_buffer->text->intervals->up.obj, current_buffer));
2414 if (other_buffer->text->intervals)
2415 (eassert (EQ (other_buffer->text->intervals->up.obj, Fcurrent_buffer ())),
2416 XSETBUFFER (other_buffer->text->intervals->up.obj, other_buffer));
2418 return Qnil;
2421 DEFUN ("set-buffer-multibyte", Fset_buffer_multibyte, Sset_buffer_multibyte,
2422 1, 1, 0,
2423 doc: /* Set the multibyte flag of the current buffer to FLAG.
2424 If FLAG is t, this makes the buffer a multibyte buffer.
2425 If FLAG is nil, this makes the buffer a single-byte buffer.
2426 In these cases, the buffer contents remain unchanged as a sequence of
2427 bytes but the contents viewed as characters do change.
2428 If FLAG is `to', this makes the buffer a multibyte buffer by changing
2429 all eight-bit bytes to eight-bit characters.
2430 If the multibyte flag was really changed, undo information of the
2431 current buffer is cleared. */)
2432 (Lisp_Object flag)
2434 struct Lisp_Marker *tail, *markers;
2435 struct buffer *other;
2436 ptrdiff_t begv, zv;
2437 bool narrowed = (BEG != BEGV || Z != ZV);
2438 bool modified_p = !NILP (Fbuffer_modified_p (Qnil));
2439 Lisp_Object old_undo = BVAR (current_buffer, undo_list);
2441 if (current_buffer->base_buffer)
2442 error ("Cannot do `set-buffer-multibyte' on an indirect buffer");
2444 /* Do nothing if nothing actually changes. */
2445 if (NILP (flag) == NILP (BVAR (current_buffer, enable_multibyte_characters)))
2446 return flag;
2448 /* Don't record these buffer changes. We will put a special undo entry
2449 instead. */
2450 bset_undo_list (current_buffer, Qt);
2452 /* If the cached position is for this buffer, clear it out. */
2453 clear_charpos_cache (current_buffer);
2455 if (NILP (flag))
2456 begv = BEGV_BYTE, zv = ZV_BYTE;
2457 else
2458 begv = BEGV, zv = ZV;
2460 if (narrowed)
2461 error ("Changing multibyteness in a narrowed buffer");
2463 invalidate_buffer_caches (current_buffer, BEGV, ZV);
2465 if (NILP (flag))
2467 ptrdiff_t pos, stop;
2468 unsigned char *p;
2470 /* Do this first, so it can use CHAR_TO_BYTE
2471 to calculate the old correspondences. */
2472 set_intervals_multibyte (0);
2474 bset_enable_multibyte_characters (current_buffer, Qnil);
2476 Z = Z_BYTE;
2477 BEGV = BEGV_BYTE;
2478 ZV = ZV_BYTE;
2479 GPT = GPT_BYTE;
2480 TEMP_SET_PT_BOTH (PT_BYTE, PT_BYTE);
2483 for (tail = BUF_MARKERS (current_buffer); tail; tail = tail->next)
2484 tail->charpos = tail->bytepos;
2486 /* Convert multibyte form of 8-bit characters to unibyte. */
2487 pos = BEG;
2488 stop = GPT;
2489 p = BEG_ADDR;
2490 while (1)
2492 int c, bytes;
2494 if (pos == stop)
2496 if (pos == Z)
2497 break;
2498 p = GAP_END_ADDR;
2499 stop = Z;
2501 if (ASCII_CHAR_P (*p))
2502 p++, pos++;
2503 else if (CHAR_BYTE8_HEAD_P (*p))
2505 c = STRING_CHAR_AND_LENGTH (p, bytes);
2506 /* Delete all bytes for this 8-bit character but the
2507 last one, and change the last one to the character
2508 code. */
2509 bytes--;
2510 del_range_2 (pos, pos, pos + bytes, pos + bytes, 0);
2511 p = GAP_END_ADDR;
2512 *p++ = c;
2513 pos++;
2514 if (begv > pos)
2515 begv -= bytes;
2516 if (zv > pos)
2517 zv -= bytes;
2518 stop = Z;
2520 else
2522 bytes = BYTES_BY_CHAR_HEAD (*p);
2523 p += bytes, pos += bytes;
2526 if (narrowed)
2527 Fnarrow_to_region (make_number (begv), make_number (zv));
2529 else
2531 ptrdiff_t pt = PT;
2532 ptrdiff_t pos, stop;
2533 unsigned char *p, *pend;
2535 /* Be sure not to have a multibyte sequence striding over the GAP.
2536 Ex: We change this: "...abc\302 _GAP_ \241def..."
2537 to: "...abc _GAP_ \302\241def..." */
2539 if (EQ (flag, Qt)
2540 && GPT_BYTE > 1 && GPT_BYTE < Z_BYTE
2541 && ! CHAR_HEAD_P (*(GAP_END_ADDR)))
2543 unsigned char *q = GPT_ADDR - 1;
2545 while (! CHAR_HEAD_P (*q) && q > BEG_ADDR) q--;
2546 if (LEADING_CODE_P (*q))
2548 ptrdiff_t new_gpt = GPT_BYTE - (GPT_ADDR - q);
2550 move_gap_both (new_gpt, new_gpt);
2554 /* Make the buffer contents valid as multibyte by converting
2555 8-bit characters to multibyte form. */
2556 pos = BEG;
2557 stop = GPT;
2558 p = BEG_ADDR;
2559 pend = GPT_ADDR;
2560 while (1)
2562 int bytes;
2564 if (pos == stop)
2566 if (pos == Z)
2567 break;
2568 p = GAP_END_ADDR;
2569 pend = Z_ADDR;
2570 stop = Z;
2573 if (ASCII_CHAR_P (*p))
2574 p++, pos++;
2575 else if (EQ (flag, Qt)
2576 && ! CHAR_BYTE8_HEAD_P (*p)
2577 && (bytes = MULTIBYTE_LENGTH (p, pend)) > 0)
2578 p += bytes, pos += bytes;
2579 else
2581 unsigned char tmp[MAX_MULTIBYTE_LENGTH];
2582 int c;
2584 c = BYTE8_TO_CHAR (*p);
2585 bytes = CHAR_STRING (c, tmp);
2586 *p = tmp[0];
2587 TEMP_SET_PT_BOTH (pos + 1, pos + 1);
2588 bytes--;
2589 insert_1_both ((char *) tmp + 1, bytes, bytes, 1, 0, 0);
2590 /* Now the gap is after the just inserted data. */
2591 pos = GPT;
2592 p = GAP_END_ADDR;
2593 if (pos <= begv)
2594 begv += bytes;
2595 if (pos <= zv)
2596 zv += bytes;
2597 if (pos <= pt)
2598 pt += bytes;
2599 pend = Z_ADDR;
2600 stop = Z;
2604 if (pt != PT)
2605 TEMP_SET_PT (pt);
2607 if (narrowed)
2608 Fnarrow_to_region (make_number (begv), make_number (zv));
2610 /* Do this first, so that chars_in_text asks the right question.
2611 set_intervals_multibyte needs it too. */
2612 bset_enable_multibyte_characters (current_buffer, Qt);
2614 GPT_BYTE = advance_to_char_boundary (GPT_BYTE);
2615 GPT = chars_in_text (BEG_ADDR, GPT_BYTE - BEG_BYTE) + BEG;
2617 Z = chars_in_text (GAP_END_ADDR, Z_BYTE - GPT_BYTE) + GPT;
2619 BEGV_BYTE = advance_to_char_boundary (BEGV_BYTE);
2620 if (BEGV_BYTE > GPT_BYTE)
2621 BEGV = chars_in_text (GAP_END_ADDR, BEGV_BYTE - GPT_BYTE) + GPT;
2622 else
2623 BEGV = chars_in_text (BEG_ADDR, BEGV_BYTE - BEG_BYTE) + BEG;
2625 ZV_BYTE = advance_to_char_boundary (ZV_BYTE);
2626 if (ZV_BYTE > GPT_BYTE)
2627 ZV = chars_in_text (GAP_END_ADDR, ZV_BYTE - GPT_BYTE) + GPT;
2628 else
2629 ZV = chars_in_text (BEG_ADDR, ZV_BYTE - BEG_BYTE) + BEG;
2632 ptrdiff_t byte = advance_to_char_boundary (PT_BYTE);
2633 ptrdiff_t position;
2635 if (byte > GPT_BYTE)
2636 position = chars_in_text (GAP_END_ADDR, byte - GPT_BYTE) + GPT;
2637 else
2638 position = chars_in_text (BEG_ADDR, byte - BEG_BYTE) + BEG;
2639 TEMP_SET_PT_BOTH (position, byte);
2642 tail = markers = BUF_MARKERS (current_buffer);
2644 /* This prevents BYTE_TO_CHAR (that is, buf_bytepos_to_charpos) from
2645 getting confused by the markers that have not yet been updated.
2646 It is also a signal that it should never create a marker. */
2647 BUF_MARKERS (current_buffer) = NULL;
2649 for (; tail; tail = tail->next)
2651 tail->bytepos = advance_to_char_boundary (tail->bytepos);
2652 tail->charpos = BYTE_TO_CHAR (tail->bytepos);
2655 /* Make sure no markers were put on the chain
2656 while the chain value was incorrect. */
2657 if (BUF_MARKERS (current_buffer))
2658 emacs_abort ();
2660 BUF_MARKERS (current_buffer) = markers;
2662 /* Do this last, so it can calculate the new correspondences
2663 between chars and bytes. */
2664 set_intervals_multibyte (1);
2667 if (!EQ (old_undo, Qt))
2669 /* Represent all the above changes by a special undo entry. */
2670 bset_undo_list (current_buffer,
2671 Fcons (list3 (Qapply,
2672 intern ("set-buffer-multibyte"),
2673 NILP (flag) ? Qt : Qnil),
2674 old_undo));
2677 current_buffer->prevent_redisplay_optimizations_p = 1;
2679 /* If buffer is shown in a window, let redisplay consider other windows. */
2680 if (buffer_window_count (current_buffer))
2681 windows_or_buffers_changed = 10;
2683 /* Copy this buffer's new multibyte status
2684 into all of its indirect buffers. */
2685 FOR_EACH_BUFFER (other)
2686 if (other->base_buffer == current_buffer && BUFFER_LIVE_P (other))
2688 BVAR (other, enable_multibyte_characters)
2689 = BVAR (current_buffer, enable_multibyte_characters);
2690 other->prevent_redisplay_optimizations_p = 1;
2693 /* Restore the modifiedness of the buffer. */
2694 if (!modified_p && !NILP (Fbuffer_modified_p (Qnil)))
2695 Fset_buffer_modified_p (Qnil);
2697 /* Update coding systems of this buffer's process (if any). */
2699 Lisp_Object process;
2701 process = Fget_buffer_process (Fcurrent_buffer ());
2702 if (PROCESSP (process))
2703 setup_process_coding_systems (process);
2706 return flag;
2709 DEFUN ("kill-all-local-variables", Fkill_all_local_variables,
2710 Skill_all_local_variables, 0, 0, 0,
2711 doc: /* Switch to Fundamental mode by killing current buffer's local variables.
2712 Most local variable bindings are eliminated so that the default values
2713 become effective once more. Also, the syntax table is set from
2714 `standard-syntax-table', the local keymap is set to nil,
2715 and the abbrev table from `fundamental-mode-abbrev-table'.
2716 This function also forces redisplay of the mode line.
2718 Every function to select a new major mode starts by
2719 calling this function.
2721 As a special exception, local variables whose names have
2722 a non-nil `permanent-local' property are not eliminated by this function.
2724 The first thing this function does is run
2725 the normal hook `change-major-mode-hook'. */)
2726 (void)
2728 run_hook (Qchange_major_mode_hook);
2730 /* Make sure none of the bindings in local_var_alist
2731 remain swapped in, in their symbols. */
2733 swap_out_buffer_local_variables (current_buffer);
2735 /* Actually eliminate all local bindings of this buffer. */
2737 reset_buffer_local_variables (current_buffer, 0);
2739 /* Force mode-line redisplay. Useful here because all major mode
2740 commands call this function. */
2741 update_mode_lines = 12;
2743 return Qnil;
2746 /* Make sure no local variables remain set up with buffer B
2747 for their current values. */
2749 static void
2750 swap_out_buffer_local_variables (struct buffer *b)
2752 Lisp_Object oalist, alist, buffer;
2754 XSETBUFFER (buffer, b);
2755 oalist = BVAR (b, local_var_alist);
2757 for (alist = oalist; CONSP (alist); alist = XCDR (alist))
2759 Lisp_Object sym = XCAR (XCAR (alist));
2760 eassert (XSYMBOL (sym)->u.s.redirect == SYMBOL_LOCALIZED);
2761 /* Need not do anything if some other buffer's binding is
2762 now cached. */
2763 if (EQ (SYMBOL_BLV (XSYMBOL (sym))->where, buffer))
2765 /* Symbol is set up for this buffer's old local value:
2766 swap it out! */
2767 swap_in_global_binding (XSYMBOL (sym));
2772 /* Find all the overlays in the current buffer that contain position POS.
2773 Return the number found, and store them in a vector in *VEC_PTR.
2774 Store in *LEN_PTR the size allocated for the vector.
2775 Store in *NEXT_PTR the next position after POS where an overlay starts,
2776 or ZV if there are no more overlays between POS and ZV.
2777 Store in *PREV_PTR the previous position before POS where an overlay ends,
2778 or where an overlay starts which ends at or after POS;
2779 or BEGV if there are no such overlays from BEGV to POS.
2780 NEXT_PTR and/or PREV_PTR may be 0, meaning don't store that info.
2782 *VEC_PTR and *LEN_PTR should contain a valid vector and size
2783 when this function is called.
2785 If EXTEND, make the vector bigger if necessary.
2786 If not, never extend the vector,
2787 and store only as many overlays as will fit.
2788 But still return the total number of overlays.
2790 If CHANGE_REQ, any position written into *PREV_PTR or
2791 *NEXT_PTR is guaranteed to be not equal to POS, unless it is the
2792 default (BEGV or ZV). */
2794 ptrdiff_t
2795 overlays_at (EMACS_INT pos, bool extend, Lisp_Object **vec_ptr,
2796 ptrdiff_t *len_ptr,
2797 ptrdiff_t *next_ptr, ptrdiff_t *prev_ptr, bool change_req)
2799 Lisp_Object overlay, start, end;
2800 struct Lisp_Overlay *tail;
2801 ptrdiff_t idx = 0;
2802 ptrdiff_t len = *len_ptr;
2803 Lisp_Object *vec = *vec_ptr;
2804 ptrdiff_t next = ZV;
2805 ptrdiff_t prev = BEGV;
2806 bool inhibit_storing = 0;
2808 for (tail = current_buffer->overlays_before; tail; tail = tail->next)
2810 ptrdiff_t startpos, endpos;
2812 XSETMISC (overlay, tail);
2814 start = OVERLAY_START (overlay);
2815 end = OVERLAY_END (overlay);
2816 endpos = OVERLAY_POSITION (end);
2817 if (endpos < pos)
2819 if (prev < endpos)
2820 prev = endpos;
2821 break;
2823 startpos = OVERLAY_POSITION (start);
2824 /* This one ends at or after POS
2825 so its start counts for PREV_PTR if it's before POS. */
2826 if (prev < startpos && startpos < pos)
2827 prev = startpos;
2828 if (endpos == pos)
2829 continue;
2830 if (startpos <= pos)
2832 if (idx == len)
2834 /* The supplied vector is full.
2835 Either make it bigger, or don't store any more in it. */
2836 if (extend)
2838 vec = xpalloc (vec, len_ptr, 1, OVERLAY_COUNT_MAX,
2839 sizeof *vec);
2840 *vec_ptr = vec;
2841 len = *len_ptr;
2843 else
2844 inhibit_storing = 1;
2847 if (!inhibit_storing)
2848 vec[idx] = overlay;
2849 /* Keep counting overlays even if we can't return them all. */
2850 idx++;
2852 else if (startpos < next)
2853 next = startpos;
2856 for (tail = current_buffer->overlays_after; tail; tail = tail->next)
2858 ptrdiff_t startpos, endpos;
2860 XSETMISC (overlay, tail);
2862 start = OVERLAY_START (overlay);
2863 end = OVERLAY_END (overlay);
2864 startpos = OVERLAY_POSITION (start);
2865 if (pos < startpos)
2867 if (startpos < next)
2868 next = startpos;
2869 break;
2871 endpos = OVERLAY_POSITION (end);
2872 if (pos < endpos)
2874 if (idx == len)
2876 if (extend)
2878 vec = xpalloc (vec, len_ptr, 1, OVERLAY_COUNT_MAX,
2879 sizeof *vec);
2880 *vec_ptr = vec;
2881 len = *len_ptr;
2883 else
2884 inhibit_storing = 1;
2887 if (!inhibit_storing)
2888 vec[idx] = overlay;
2889 idx++;
2891 if (startpos < pos && startpos > prev)
2892 prev = startpos;
2894 else if (endpos < pos && endpos > prev)
2895 prev = endpos;
2896 else if (endpos == pos && startpos > prev
2897 && (!change_req || startpos < pos))
2898 prev = startpos;
2901 if (next_ptr)
2902 *next_ptr = next;
2903 if (prev_ptr)
2904 *prev_ptr = prev;
2905 return idx;
2908 /* Find all the overlays in the current buffer that overlap the range
2909 BEG-END, or are empty at BEG, or are empty at END provided END
2910 denotes the position at the end of the current buffer.
2912 Return the number found, and store them in a vector in *VEC_PTR.
2913 Store in *LEN_PTR the size allocated for the vector.
2914 Store in *NEXT_PTR the next position after POS where an overlay starts,
2915 or ZV if there are no more overlays.
2916 Store in *PREV_PTR the previous position before POS where an overlay ends,
2917 or BEGV if there are no previous overlays.
2918 NEXT_PTR and/or PREV_PTR may be 0, meaning don't store that info.
2920 *VEC_PTR and *LEN_PTR should contain a valid vector and size
2921 when this function is called.
2923 If EXTEND, make the vector bigger if necessary.
2924 If not, never extend the vector,
2925 and store only as many overlays as will fit.
2926 But still return the total number of overlays. */
2928 static ptrdiff_t
2929 overlays_in (EMACS_INT beg, EMACS_INT end, bool extend,
2930 Lisp_Object **vec_ptr, ptrdiff_t *len_ptr,
2931 ptrdiff_t *next_ptr, ptrdiff_t *prev_ptr)
2933 Lisp_Object overlay, ostart, oend;
2934 struct Lisp_Overlay *tail;
2935 ptrdiff_t idx = 0;
2936 ptrdiff_t len = *len_ptr;
2937 Lisp_Object *vec = *vec_ptr;
2938 ptrdiff_t next = ZV;
2939 ptrdiff_t prev = BEGV;
2940 bool inhibit_storing = 0;
2941 bool end_is_Z = end == Z;
2943 for (tail = current_buffer->overlays_before; tail; tail = tail->next)
2945 ptrdiff_t startpos, endpos;
2947 XSETMISC (overlay, tail);
2949 ostart = OVERLAY_START (overlay);
2950 oend = OVERLAY_END (overlay);
2951 endpos = OVERLAY_POSITION (oend);
2952 if (endpos < beg)
2954 if (prev < endpos)
2955 prev = endpos;
2956 break;
2958 startpos = OVERLAY_POSITION (ostart);
2959 /* Count an interval if it overlaps the range, is empty at the
2960 start of the range, or is empty at END provided END denotes the
2961 end of the buffer. */
2962 if ((beg < endpos && startpos < end)
2963 || (startpos == endpos
2964 && (beg == endpos || (end_is_Z && endpos == end))))
2966 if (idx == len)
2968 /* The supplied vector is full.
2969 Either make it bigger, or don't store any more in it. */
2970 if (extend)
2972 vec = xpalloc (vec, len_ptr, 1, OVERLAY_COUNT_MAX,
2973 sizeof *vec);
2974 *vec_ptr = vec;
2975 len = *len_ptr;
2977 else
2978 inhibit_storing = 1;
2981 if (!inhibit_storing)
2982 vec[idx] = overlay;
2983 /* Keep counting overlays even if we can't return them all. */
2984 idx++;
2986 else if (startpos < next)
2987 next = startpos;
2990 for (tail = current_buffer->overlays_after; tail; tail = tail->next)
2992 ptrdiff_t startpos, endpos;
2994 XSETMISC (overlay, tail);
2996 ostart = OVERLAY_START (overlay);
2997 oend = OVERLAY_END (overlay);
2998 startpos = OVERLAY_POSITION (ostart);
2999 if (end < startpos)
3001 if (startpos < next)
3002 next = startpos;
3003 break;
3005 endpos = OVERLAY_POSITION (oend);
3006 /* Count an interval if it overlaps the range, is empty at the
3007 start of the range, or is empty at END provided END denotes the
3008 end of the buffer. */
3009 if ((beg < endpos && startpos < end)
3010 || (startpos == endpos
3011 && (beg == endpos || (end_is_Z && endpos == end))))
3013 if (idx == len)
3015 if (extend)
3017 vec = xpalloc (vec, len_ptr, 1, OVERLAY_COUNT_MAX,
3018 sizeof *vec);
3019 *vec_ptr = vec;
3020 len = *len_ptr;
3022 else
3023 inhibit_storing = 1;
3026 if (!inhibit_storing)
3027 vec[idx] = overlay;
3028 idx++;
3030 else if (endpos < beg && endpos > prev)
3031 prev = endpos;
3034 if (next_ptr)
3035 *next_ptr = next;
3036 if (prev_ptr)
3037 *prev_ptr = prev;
3038 return idx;
3042 /* Return true if there exists an overlay with a non-nil
3043 `mouse-face' property overlapping OVERLAY. */
3045 bool
3046 mouse_face_overlay_overlaps (Lisp_Object overlay)
3048 ptrdiff_t start = OVERLAY_POSITION (OVERLAY_START (overlay));
3049 ptrdiff_t end = OVERLAY_POSITION (OVERLAY_END (overlay));
3050 ptrdiff_t n, i, size;
3051 Lisp_Object *v, tem;
3052 Lisp_Object vbuf[10];
3053 USE_SAFE_ALLOCA;
3055 size = ARRAYELTS (vbuf);
3056 v = vbuf;
3057 n = overlays_in (start, end, 0, &v, &size, NULL, NULL);
3058 if (n > size)
3060 SAFE_NALLOCA (v, 1, n);
3061 overlays_in (start, end, 0, &v, &n, NULL, NULL);
3064 for (i = 0; i < n; ++i)
3065 if (!EQ (v[i], overlay)
3066 && (tem = Foverlay_get (overlay, Qmouse_face),
3067 !NILP (tem)))
3068 break;
3070 SAFE_FREE ();
3071 return i < n;
3074 /* Return the value of the 'display-line-numbers-disable' property at
3075 EOB, if there's an overlay at ZV with a non-nil value of that property. */
3076 Lisp_Object
3077 disable_line_numbers_overlay_at_eob (void)
3079 ptrdiff_t n, i, size;
3080 Lisp_Object *v, tem = Qnil;
3081 Lisp_Object vbuf[10];
3082 USE_SAFE_ALLOCA;
3084 size = ARRAYELTS (vbuf);
3085 v = vbuf;
3086 n = overlays_in (ZV, ZV, 0, &v, &size, NULL, NULL);
3087 if (n > size)
3089 SAFE_NALLOCA (v, 1, n);
3090 overlays_in (ZV, ZV, 0, &v, &n, NULL, NULL);
3093 for (i = 0; i < n; ++i)
3094 if ((tem = Foverlay_get (v[i], Qdisplay_line_numbers_disable),
3095 !NILP (tem)))
3096 break;
3098 SAFE_FREE ();
3099 return tem;
3103 /* Fast function to just test if we're at an overlay boundary. */
3104 bool
3105 overlay_touches_p (ptrdiff_t pos)
3107 Lisp_Object overlay;
3108 struct Lisp_Overlay *tail;
3110 for (tail = current_buffer->overlays_before; tail; tail = tail->next)
3112 ptrdiff_t endpos;
3114 XSETMISC (overlay ,tail);
3115 eassert (OVERLAYP (overlay));
3117 endpos = OVERLAY_POSITION (OVERLAY_END (overlay));
3118 if (endpos < pos)
3119 break;
3120 if (endpos == pos || OVERLAY_POSITION (OVERLAY_START (overlay)) == pos)
3121 return 1;
3124 for (tail = current_buffer->overlays_after; tail; tail = tail->next)
3126 ptrdiff_t startpos;
3128 XSETMISC (overlay, tail);
3129 eassert (OVERLAYP (overlay));
3131 startpos = OVERLAY_POSITION (OVERLAY_START (overlay));
3132 if (pos < startpos)
3133 break;
3134 if (startpos == pos || OVERLAY_POSITION (OVERLAY_END (overlay)) == pos)
3135 return 1;
3137 return 0;
3140 struct sortvec
3142 Lisp_Object overlay;
3143 ptrdiff_t beg, end;
3144 EMACS_INT priority;
3145 EMACS_INT spriority; /* Secondary priority. */
3148 static int
3149 compare_overlays (const void *v1, const void *v2)
3151 const struct sortvec *s1 = v1;
3152 const struct sortvec *s2 = v2;
3153 /* Return 1 if s1 should take precedence, -1 if v2 should take precedence,
3154 and 0 if they're equal. */
3155 if (s1->priority != s2->priority)
3156 return s1->priority < s2->priority ? -1 : 1;
3157 /* If the priority is equal, give precedence to the one not covered by the
3158 other. If neither covers the other, obey spriority. */
3159 else if (s1->beg < s2->beg)
3160 return (s1->end < s2->end && s1->spriority > s2->spriority ? 1 : -1);
3161 else if (s1->beg > s2->beg)
3162 return (s1->end > s2->end && s1->spriority < s2->spriority ? -1 : 1);
3163 else if (s1->end != s2->end)
3164 return s2->end < s1->end ? -1 : 1;
3165 else if (s1->spriority != s2->spriority)
3166 return (s1->spriority < s2->spriority ? -1 : 1);
3167 else if (EQ (s1->overlay, s2->overlay))
3168 return 0;
3169 else
3170 /* Avoid the non-determinism of qsort by choosing an arbitrary ordering
3171 between "equal" overlays. The result can still change between
3172 invocations of Emacs, but it won't change in the middle of
3173 `find_field' (bug#6830). */
3174 return XLI (s1->overlay) < XLI (s2->overlay) ? -1 : 1;
3177 /* Sort an array of overlays by priority. The array is modified in place.
3178 The return value is the new size; this may be smaller than the original
3179 size if some of the overlays were invalid or were window-specific. */
3180 ptrdiff_t
3181 sort_overlays (Lisp_Object *overlay_vec, ptrdiff_t noverlays, struct window *w)
3183 ptrdiff_t i, j;
3184 USE_SAFE_ALLOCA;
3185 struct sortvec *sortvec;
3187 SAFE_NALLOCA (sortvec, 1, noverlays);
3189 /* Put the valid and relevant overlays into sortvec. */
3191 for (i = 0, j = 0; i < noverlays; i++)
3193 Lisp_Object tem;
3194 Lisp_Object overlay;
3196 overlay = overlay_vec[i];
3197 if (OVERLAYP (overlay)
3198 && OVERLAY_POSITION (OVERLAY_START (overlay)) > 0
3199 && OVERLAY_POSITION (OVERLAY_END (overlay)) > 0)
3201 /* If we're interested in a specific window, then ignore
3202 overlays that are limited to some other window. */
3203 if (w)
3205 Lisp_Object window;
3207 window = Foverlay_get (overlay, Qwindow);
3208 if (WINDOWP (window) && XWINDOW (window) != w)
3209 continue;
3212 /* This overlay is good and counts: put it into sortvec. */
3213 sortvec[j].overlay = overlay;
3214 sortvec[j].beg = OVERLAY_POSITION (OVERLAY_START (overlay));
3215 sortvec[j].end = OVERLAY_POSITION (OVERLAY_END (overlay));
3216 tem = Foverlay_get (overlay, Qpriority);
3217 if (NILP (tem))
3219 sortvec[j].priority = 0;
3220 sortvec[j].spriority = 0;
3222 else if (INTEGERP (tem))
3224 sortvec[j].priority = XINT (tem);
3225 sortvec[j].spriority = 0;
3227 else if (CONSP (tem))
3229 Lisp_Object car = XCAR (tem);
3230 Lisp_Object cdr = XCDR (tem);
3231 sortvec[j].priority = INTEGERP (car) ? XINT (car) : 0;
3232 sortvec[j].spriority = INTEGERP (cdr) ? XINT (cdr) : 0;
3234 j++;
3237 noverlays = j;
3239 /* Sort the overlays into the proper order: increasing priority. */
3241 if (noverlays > 1)
3242 qsort (sortvec, noverlays, sizeof (struct sortvec), compare_overlays);
3244 for (i = 0; i < noverlays; i++)
3245 overlay_vec[i] = sortvec[i].overlay;
3247 SAFE_FREE ();
3248 return (noverlays);
3251 struct sortstr
3253 Lisp_Object string, string2;
3254 ptrdiff_t size;
3255 EMACS_INT priority;
3258 struct sortstrlist
3260 struct sortstr *buf; /* An array that expands as needed; never freed. */
3261 ptrdiff_t size; /* Allocated length of that array. */
3262 ptrdiff_t used; /* How much of the array is currently in use. */
3263 ptrdiff_t bytes; /* Total length of the strings in buf. */
3266 /* Buffers for storing information about the overlays touching a given
3267 position. These could be automatic variables in overlay_strings, but
3268 it's more efficient to hold onto the memory instead of repeatedly
3269 allocating and freeing it. */
3270 static struct sortstrlist overlay_heads, overlay_tails;
3271 static unsigned char *overlay_str_buf;
3273 /* Allocated length of overlay_str_buf. */
3274 static ptrdiff_t overlay_str_len;
3276 /* A comparison function suitable for passing to qsort. */
3277 static int
3278 cmp_for_strings (const void *as1, const void *as2)
3280 struct sortstr const *s1 = as1;
3281 struct sortstr const *s2 = as2;
3282 if (s1->size != s2->size)
3283 return s2->size < s1->size ? -1 : 1;
3284 if (s1->priority != s2->priority)
3285 return s1->priority < s2->priority ? -1 : 1;
3286 return 0;
3289 static void
3290 record_overlay_string (struct sortstrlist *ssl, Lisp_Object str,
3291 Lisp_Object str2, Lisp_Object pri, ptrdiff_t size)
3293 ptrdiff_t nbytes;
3295 if (ssl->used == ssl->size)
3296 ssl->buf = xpalloc (ssl->buf, &ssl->size, 5, -1, sizeof *ssl->buf);
3297 ssl->buf[ssl->used].string = str;
3298 ssl->buf[ssl->used].string2 = str2;
3299 ssl->buf[ssl->used].size = size;
3300 ssl->buf[ssl->used].priority = (INTEGERP (pri) ? XINT (pri) : 0);
3301 ssl->used++;
3303 if (NILP (BVAR (current_buffer, enable_multibyte_characters)))
3304 nbytes = SCHARS (str);
3305 else if (! STRING_MULTIBYTE (str))
3306 nbytes = count_size_as_multibyte (SDATA (str),
3307 SBYTES (str));
3308 else
3309 nbytes = SBYTES (str);
3311 if (INT_ADD_WRAPV (ssl->bytes, nbytes, &nbytes))
3312 memory_full (SIZE_MAX);
3313 ssl->bytes = nbytes;
3315 if (STRINGP (str2))
3317 if (NILP (BVAR (current_buffer, enable_multibyte_characters)))
3318 nbytes = SCHARS (str2);
3319 else if (! STRING_MULTIBYTE (str2))
3320 nbytes = count_size_as_multibyte (SDATA (str2),
3321 SBYTES (str2));
3322 else
3323 nbytes = SBYTES (str2);
3325 if (INT_ADD_WRAPV (ssl->bytes, nbytes, &nbytes))
3326 memory_full (SIZE_MAX);
3327 ssl->bytes = nbytes;
3331 /* Concatenate the strings associated with overlays that begin or end
3332 at POS, ignoring overlays that are specific to windows other than W.
3333 The strings are concatenated in the appropriate order: shorter
3334 overlays nest inside longer ones, and higher priority inside lower.
3335 Normally all of the after-strings come first, but zero-sized
3336 overlays have their after-strings ride along with the
3337 before-strings because it would look strange to print them
3338 inside-out.
3340 Returns the concatenated string's length, and return the pointer to
3341 that string via PSTR, if that variable is non-NULL. The storage of
3342 the concatenated strings may be overwritten by subsequent calls. */
3344 ptrdiff_t
3345 overlay_strings (ptrdiff_t pos, struct window *w, unsigned char **pstr)
3347 Lisp_Object overlay, window, str;
3348 struct Lisp_Overlay *ov;
3349 ptrdiff_t startpos, endpos;
3350 bool multibyte = ! NILP (BVAR (current_buffer, enable_multibyte_characters));
3352 overlay_heads.used = overlay_heads.bytes = 0;
3353 overlay_tails.used = overlay_tails.bytes = 0;
3354 for (ov = current_buffer->overlays_before; ov; ov = ov->next)
3356 XSETMISC (overlay, ov);
3357 eassert (OVERLAYP (overlay));
3359 startpos = OVERLAY_POSITION (OVERLAY_START (overlay));
3360 endpos = OVERLAY_POSITION (OVERLAY_END (overlay));
3361 if (endpos < pos)
3362 break;
3363 if (endpos != pos && startpos != pos)
3364 continue;
3365 window = Foverlay_get (overlay, Qwindow);
3366 if (WINDOWP (window) && XWINDOW (window) != w)
3367 continue;
3368 if (startpos == pos
3369 && (str = Foverlay_get (overlay, Qbefore_string), STRINGP (str)))
3370 record_overlay_string (&overlay_heads, str,
3371 (startpos == endpos
3372 ? Foverlay_get (overlay, Qafter_string)
3373 : Qnil),
3374 Foverlay_get (overlay, Qpriority),
3375 endpos - startpos);
3376 else if (endpos == pos
3377 && (str = Foverlay_get (overlay, Qafter_string), STRINGP (str)))
3378 record_overlay_string (&overlay_tails, str, Qnil,
3379 Foverlay_get (overlay, Qpriority),
3380 endpos - startpos);
3382 for (ov = current_buffer->overlays_after; ov; ov = ov->next)
3384 XSETMISC (overlay, ov);
3385 eassert (OVERLAYP (overlay));
3387 startpos = OVERLAY_POSITION (OVERLAY_START (overlay));
3388 endpos = OVERLAY_POSITION (OVERLAY_END (overlay));
3389 if (startpos > pos)
3390 break;
3391 if (endpos != pos && startpos != pos)
3392 continue;
3393 window = Foverlay_get (overlay, Qwindow);
3394 if (WINDOWP (window) && XWINDOW (window) != w)
3395 continue;
3396 if (startpos == pos
3397 && (str = Foverlay_get (overlay, Qbefore_string), STRINGP (str)))
3398 record_overlay_string (&overlay_heads, str,
3399 (startpos == endpos
3400 ? Foverlay_get (overlay, Qafter_string)
3401 : Qnil),
3402 Foverlay_get (overlay, Qpriority),
3403 endpos - startpos);
3404 else if (endpos == pos
3405 && (str = Foverlay_get (overlay, Qafter_string), STRINGP (str)))
3406 record_overlay_string (&overlay_tails, str, Qnil,
3407 Foverlay_get (overlay, Qpriority),
3408 endpos - startpos);
3410 if (overlay_tails.used > 1)
3411 qsort (overlay_tails.buf, overlay_tails.used, sizeof (struct sortstr),
3412 cmp_for_strings);
3413 if (overlay_heads.used > 1)
3414 qsort (overlay_heads.buf, overlay_heads.used, sizeof (struct sortstr),
3415 cmp_for_strings);
3416 if (overlay_heads.bytes || overlay_tails.bytes)
3418 Lisp_Object tem;
3419 ptrdiff_t i;
3420 unsigned char *p;
3421 ptrdiff_t total;
3423 if (INT_ADD_WRAPV (overlay_heads.bytes, overlay_tails.bytes, &total))
3424 memory_full (SIZE_MAX);
3425 if (total > overlay_str_len)
3426 overlay_str_buf = xpalloc (overlay_str_buf, &overlay_str_len,
3427 total - overlay_str_len, -1, 1);
3429 p = overlay_str_buf;
3430 for (i = overlay_tails.used; --i >= 0;)
3432 ptrdiff_t nbytes;
3433 tem = overlay_tails.buf[i].string;
3434 nbytes = copy_text (SDATA (tem), p,
3435 SBYTES (tem),
3436 STRING_MULTIBYTE (tem), multibyte);
3437 p += nbytes;
3439 for (i = 0; i < overlay_heads.used; ++i)
3441 ptrdiff_t nbytes;
3442 tem = overlay_heads.buf[i].string;
3443 nbytes = copy_text (SDATA (tem), p,
3444 SBYTES (tem),
3445 STRING_MULTIBYTE (tem), multibyte);
3446 p += nbytes;
3447 tem = overlay_heads.buf[i].string2;
3448 if (STRINGP (tem))
3450 nbytes = copy_text (SDATA (tem), p,
3451 SBYTES (tem),
3452 STRING_MULTIBYTE (tem), multibyte);
3453 p += nbytes;
3456 if (p != overlay_str_buf + total)
3457 emacs_abort ();
3458 if (pstr)
3459 *pstr = overlay_str_buf;
3460 return total;
3462 return 0;
3465 /* Shift overlays in BUF's overlay lists, to center the lists at POS. */
3467 void
3468 recenter_overlay_lists (struct buffer *buf, ptrdiff_t pos)
3470 Lisp_Object overlay, beg, end;
3471 struct Lisp_Overlay *prev, *tail, *next;
3473 /* See if anything in overlays_before should move to overlays_after. */
3475 /* We don't strictly need prev in this loop; it should always be nil.
3476 But we use it for symmetry and in case that should cease to be true
3477 with some future change. */
3478 prev = NULL;
3479 for (tail = buf->overlays_before; tail; prev = tail, tail = next)
3481 next = tail->next;
3482 XSETMISC (overlay, tail);
3483 eassert (OVERLAYP (overlay));
3485 beg = OVERLAY_START (overlay);
3486 end = OVERLAY_END (overlay);
3488 if (OVERLAY_POSITION (end) > pos)
3490 /* OVERLAY needs to be moved. */
3491 ptrdiff_t where = OVERLAY_POSITION (beg);
3492 struct Lisp_Overlay *other, *other_prev;
3494 /* Splice the cons cell TAIL out of overlays_before. */
3495 if (prev)
3496 prev->next = next;
3497 else
3498 set_buffer_overlays_before (buf, next);
3500 /* Search thru overlays_after for where to put it. */
3501 other_prev = NULL;
3502 for (other = buf->overlays_after; other;
3503 other_prev = other, other = other->next)
3505 Lisp_Object otherbeg, otheroverlay;
3507 XSETMISC (otheroverlay, other);
3508 eassert (OVERLAYP (otheroverlay));
3510 otherbeg = OVERLAY_START (otheroverlay);
3511 if (OVERLAY_POSITION (otherbeg) >= where)
3512 break;
3515 /* Add TAIL to overlays_after before OTHER. */
3516 tail->next = other;
3517 if (other_prev)
3518 other_prev->next = tail;
3519 else
3520 set_buffer_overlays_after (buf, tail);
3521 tail = prev;
3523 else
3524 /* We've reached the things that should stay in overlays_before.
3525 All the rest of overlays_before must end even earlier,
3526 so stop now. */
3527 break;
3530 /* See if anything in overlays_after should be in overlays_before. */
3531 prev = NULL;
3532 for (tail = buf->overlays_after; tail; prev = tail, tail = next)
3534 next = tail->next;
3535 XSETMISC (overlay, tail);
3536 eassert (OVERLAYP (overlay));
3538 beg = OVERLAY_START (overlay);
3539 end = OVERLAY_END (overlay);
3541 /* Stop looking, when we know that nothing further
3542 can possibly end before POS. */
3543 if (OVERLAY_POSITION (beg) > pos)
3544 break;
3546 if (OVERLAY_POSITION (end) <= pos)
3548 /* OVERLAY needs to be moved. */
3549 ptrdiff_t where = OVERLAY_POSITION (end);
3550 struct Lisp_Overlay *other, *other_prev;
3552 /* Splice the cons cell TAIL out of overlays_after. */
3553 if (prev)
3554 prev->next = next;
3555 else
3556 set_buffer_overlays_after (buf, next);
3558 /* Search thru overlays_before for where to put it. */
3559 other_prev = NULL;
3560 for (other = buf->overlays_before; other;
3561 other_prev = other, other = other->next)
3563 Lisp_Object otherend, otheroverlay;
3565 XSETMISC (otheroverlay, other);
3566 eassert (OVERLAYP (otheroverlay));
3568 otherend = OVERLAY_END (otheroverlay);
3569 if (OVERLAY_POSITION (otherend) <= where)
3570 break;
3573 /* Add TAIL to overlays_before before OTHER. */
3574 tail->next = other;
3575 if (other_prev)
3576 other_prev->next = tail;
3577 else
3578 set_buffer_overlays_before (buf, tail);
3579 tail = prev;
3583 buf->overlay_center = pos;
3586 void
3587 adjust_overlays_for_insert (ptrdiff_t pos, ptrdiff_t length)
3589 /* After an insertion, the lists are still sorted properly,
3590 but we may need to update the value of the overlay center. */
3591 if (current_buffer->overlay_center >= pos)
3592 current_buffer->overlay_center += length;
3595 void
3596 adjust_overlays_for_delete (ptrdiff_t pos, ptrdiff_t length)
3598 if (current_buffer->overlay_center < pos)
3599 /* The deletion was to our right. No change needed; the before- and
3600 after-lists are still consistent. */
3602 else if (current_buffer->overlay_center - pos > length)
3603 /* The deletion was to our left. We need to adjust the center value
3604 to account for the change in position, but the lists are consistent
3605 given the new value. */
3606 current_buffer->overlay_center -= length;
3607 else
3608 /* We're right in the middle. There might be things on the after-list
3609 that now belong on the before-list. Recentering will move them,
3610 and also update the center point. */
3611 recenter_overlay_lists (current_buffer, pos);
3614 /* Fix up overlays that were garbled as a result of permuting markers
3615 in the range START through END. Any overlay with at least one
3616 endpoint in this range will need to be unlinked from the overlay
3617 list and reinserted in its proper place.
3618 Such an overlay might even have negative size at this point.
3619 If so, we'll make the overlay empty. */
3620 void
3621 fix_start_end_in_overlays (register ptrdiff_t start, register ptrdiff_t end)
3623 Lisp_Object overlay;
3624 struct Lisp_Overlay *before_list UNINIT;
3625 struct Lisp_Overlay *after_list UNINIT;
3626 /* These are either nil, indicating that before_list or after_list
3627 should be assigned, or the cons cell the cdr of which should be
3628 assigned. */
3629 struct Lisp_Overlay *beforep = NULL, *afterp = NULL;
3630 /* 'Parent', likewise, indicates a cons cell or
3631 current_buffer->overlays_before or overlays_after, depending
3632 which loop we're in. */
3633 struct Lisp_Overlay *tail, *parent;
3634 ptrdiff_t startpos, endpos;
3636 /* This algorithm shifts links around instead of consing and GCing.
3637 The loop invariant is that before_list (resp. after_list) is a
3638 well-formed list except that its last element, the CDR of beforep
3639 (resp. afterp) if beforep (afterp) isn't nil or before_list
3640 (after_list) if it is, is still uninitialized. So it's not a bug
3641 that before_list isn't initialized, although it may look
3642 strange. */
3643 for (parent = NULL, tail = current_buffer->overlays_before; tail;)
3645 XSETMISC (overlay, tail);
3647 endpos = OVERLAY_POSITION (OVERLAY_END (overlay));
3648 startpos = OVERLAY_POSITION (OVERLAY_START (overlay));
3650 /* If the overlay is backwards, make it empty. */
3651 if (endpos < startpos)
3653 startpos = endpos;
3654 Fset_marker (OVERLAY_START (overlay), make_number (startpos),
3655 Qnil);
3658 if (endpos < start)
3659 break;
3661 if (endpos < end
3662 || (startpos >= start && startpos < end))
3664 /* Add it to the end of the wrong list. Later on,
3665 recenter_overlay_lists will move it to the right place. */
3666 if (endpos < current_buffer->overlay_center)
3668 if (!afterp)
3669 after_list = tail;
3670 else
3671 afterp->next = tail;
3672 afterp = tail;
3674 else
3676 if (!beforep)
3677 before_list = tail;
3678 else
3679 beforep->next = tail;
3680 beforep = tail;
3682 if (!parent)
3683 set_buffer_overlays_before (current_buffer, tail->next);
3684 else
3685 parent->next = tail->next;
3686 tail = tail->next;
3688 else
3689 parent = tail, tail = parent->next;
3691 for (parent = NULL, tail = current_buffer->overlays_after; tail;)
3693 XSETMISC (overlay, tail);
3695 startpos = OVERLAY_POSITION (OVERLAY_START (overlay));
3696 endpos = OVERLAY_POSITION (OVERLAY_END (overlay));
3698 /* If the overlay is backwards, make it empty. */
3699 if (endpos < startpos)
3701 startpos = endpos;
3702 Fset_marker (OVERLAY_START (overlay), make_number (startpos),
3703 Qnil);
3706 if (startpos >= end)
3707 break;
3709 if (startpos >= start
3710 || (endpos >= start && endpos < end))
3712 if (endpos < current_buffer->overlay_center)
3714 if (!afterp)
3715 after_list = tail;
3716 else
3717 afterp->next = tail;
3718 afterp = tail;
3720 else
3722 if (!beforep)
3723 before_list = tail;
3724 else
3725 beforep->next = tail;
3726 beforep = tail;
3728 if (!parent)
3729 set_buffer_overlays_after (current_buffer, tail->next);
3730 else
3731 parent->next = tail->next;
3732 tail = tail->next;
3734 else
3735 parent = tail, tail = parent->next;
3738 /* Splice the constructed (wrong) lists into the buffer's lists,
3739 and let the recenter function make it sane again. */
3740 if (beforep)
3742 beforep->next = current_buffer->overlays_before;
3743 set_buffer_overlays_before (current_buffer, before_list);
3746 if (afterp)
3748 afterp->next = current_buffer->overlays_after;
3749 set_buffer_overlays_after (current_buffer, after_list);
3751 recenter_overlay_lists (current_buffer, current_buffer->overlay_center);
3754 /* We have two types of overlay: the one whose ending marker is
3755 after-insertion-marker (this is the usual case) and the one whose
3756 ending marker is before-insertion-marker. When `overlays_before'
3757 contains overlays of the latter type and the former type in this
3758 order and both overlays end at inserting position, inserting a text
3759 increases only the ending marker of the latter type, which results
3760 in incorrect ordering of `overlays_before'.
3762 This function fixes ordering of overlays in the slot
3763 `overlays_before' of the buffer *BP. Before the insertion, `point'
3764 was at PREV, and now is at POS. */
3766 void
3767 fix_overlays_before (struct buffer *bp, ptrdiff_t prev, ptrdiff_t pos)
3769 /* If parent is nil, replace overlays_before; otherwise, parent->next. */
3770 struct Lisp_Overlay *tail = bp->overlays_before, *parent = NULL, *right_pair;
3771 Lisp_Object tem;
3772 ptrdiff_t end UNINIT;
3774 /* After the insertion, the several overlays may be in incorrect
3775 order. The possibility is that, in the list `overlays_before',
3776 an overlay which ends at POS appears after an overlay which ends
3777 at PREV. Since POS is greater than PREV, we must fix the
3778 ordering of these overlays, by moving overlays ends at POS before
3779 the overlays ends at PREV. */
3781 /* At first, find a place where disordered overlays should be linked
3782 in. It is where an overlay which end before POS exists. (i.e. an
3783 overlay whose ending marker is after-insertion-marker if disorder
3784 exists). */
3785 while (tail
3786 && (XSETMISC (tem, tail),
3787 (end = OVERLAY_POSITION (OVERLAY_END (tem))) >= pos))
3789 parent = tail;
3790 tail = tail->next;
3793 /* If we don't find such an overlay,
3794 or the found one ends before PREV,
3795 or the found one is the last one in the list,
3796 we don't have to fix anything. */
3797 if (!tail || end < prev || !tail->next)
3798 return;
3800 right_pair = parent;
3801 parent = tail;
3802 tail = tail->next;
3804 /* Now, end position of overlays in the list TAIL should be before
3805 or equal to PREV. In the loop, an overlay which ends at POS is
3806 moved ahead to the place indicated by the CDR of RIGHT_PAIR. If
3807 we found an overlay which ends before PREV, the remaining
3808 overlays are in correct order. */
3809 while (tail)
3811 XSETMISC (tem, tail);
3812 end = OVERLAY_POSITION (OVERLAY_END (tem));
3814 if (end == pos)
3815 { /* This overlay is disordered. */
3816 struct Lisp_Overlay *found = tail;
3818 /* Unlink the found overlay. */
3819 tail = found->next;
3820 parent->next = tail;
3821 /* Move an overlay at RIGHT_PLACE to the next of the found one,
3822 and link it into the right place. */
3823 if (!right_pair)
3825 found->next = bp->overlays_before;
3826 set_buffer_overlays_before (bp, found);
3828 else
3830 found->next = right_pair->next;
3831 right_pair->next = found;
3834 else if (end == prev)
3836 parent = tail;
3837 tail = tail->next;
3839 else /* No more disordered overlay. */
3840 break;
3844 DEFUN ("overlayp", Foverlayp, Soverlayp, 1, 1, 0,
3845 doc: /* Return t if OBJECT is an overlay. */)
3846 (Lisp_Object object)
3848 return (OVERLAYP (object) ? Qt : Qnil);
3851 DEFUN ("make-overlay", Fmake_overlay, Smake_overlay, 2, 5, 0,
3852 doc: /* Create a new overlay with range BEG to END in BUFFER and return it.
3853 If omitted, BUFFER defaults to the current buffer.
3854 BEG and END may be integers or markers.
3855 The fourth arg FRONT-ADVANCE, if non-nil, makes the marker
3856 for the front of the overlay advance when text is inserted there
3857 \(which means the text *is not* included in the overlay).
3858 The fifth arg REAR-ADVANCE, if non-nil, makes the marker
3859 for the rear of the overlay advance when text is inserted there
3860 \(which means the text *is* included in the overlay). */)
3861 (Lisp_Object beg, Lisp_Object end, Lisp_Object buffer,
3862 Lisp_Object front_advance, Lisp_Object rear_advance)
3864 Lisp_Object overlay;
3865 struct buffer *b;
3867 if (NILP (buffer))
3868 XSETBUFFER (buffer, current_buffer);
3869 else
3870 CHECK_BUFFER (buffer);
3872 if (MARKERP (beg) && !EQ (Fmarker_buffer (beg), buffer))
3873 signal_error ("Marker points into wrong buffer", beg);
3874 if (MARKERP (end) && !EQ (Fmarker_buffer (end), buffer))
3875 signal_error ("Marker points into wrong buffer", end);
3877 CHECK_NUMBER_COERCE_MARKER (beg);
3878 CHECK_NUMBER_COERCE_MARKER (end);
3880 if (XINT (beg) > XINT (end))
3882 Lisp_Object temp;
3883 temp = beg; beg = end; end = temp;
3886 b = XBUFFER (buffer);
3888 beg = Fset_marker (Fmake_marker (), beg, buffer);
3889 end = Fset_marker (Fmake_marker (), end, buffer);
3891 if (!NILP (front_advance))
3892 XMARKER (beg)->insertion_type = 1;
3893 if (!NILP (rear_advance))
3894 XMARKER (end)->insertion_type = 1;
3896 overlay = build_overlay (beg, end, Qnil);
3898 /* Put the new overlay on the wrong list. */
3899 end = OVERLAY_END (overlay);
3900 if (OVERLAY_POSITION (end) < b->overlay_center)
3902 eassert (b->overlays_after || (XOVERLAY (overlay)->next == NULL));
3903 XOVERLAY (overlay)->next = b->overlays_after;
3904 set_buffer_overlays_after (b, XOVERLAY (overlay));
3906 else
3908 eassert (b->overlays_before || (XOVERLAY (overlay)->next == NULL));
3909 XOVERLAY (overlay)->next = b->overlays_before;
3910 set_buffer_overlays_before (b, XOVERLAY (overlay));
3912 /* This puts it in the right list, and in the right order. */
3913 recenter_overlay_lists (b, b->overlay_center);
3915 /* We don't need to redisplay the region covered by the overlay, because
3916 the overlay has no properties at the moment. */
3918 return overlay;
3921 /* Mark a section of BUF as needing redisplay because of overlays changes. */
3923 static void
3924 modify_overlay (struct buffer *buf, ptrdiff_t start, ptrdiff_t end)
3926 if (start > end)
3928 ptrdiff_t temp = start;
3929 start = end;
3930 end = temp;
3933 BUF_COMPUTE_UNCHANGED (buf, start, end);
3935 bset_redisplay (buf);
3937 ++BUF_OVERLAY_MODIFF (buf);
3940 /* Remove OVERLAY from LIST. */
3942 static struct Lisp_Overlay *
3943 unchain_overlay (struct Lisp_Overlay *list, struct Lisp_Overlay *overlay)
3945 register struct Lisp_Overlay *tail, **prev = &list;
3947 for (tail = list; tail; prev = &tail->next, tail = *prev)
3948 if (tail == overlay)
3950 *prev = overlay->next;
3951 overlay->next = NULL;
3952 break;
3954 return list;
3957 /* Remove OVERLAY from both overlay lists of B. */
3959 static void
3960 unchain_both (struct buffer *b, Lisp_Object overlay)
3962 struct Lisp_Overlay *ov = XOVERLAY (overlay);
3964 set_buffer_overlays_before (b, unchain_overlay (b->overlays_before, ov));
3965 set_buffer_overlays_after (b, unchain_overlay (b->overlays_after, ov));
3966 eassert (XOVERLAY (overlay)->next == NULL);
3969 DEFUN ("move-overlay", Fmove_overlay, Smove_overlay, 3, 4, 0,
3970 doc: /* Set the endpoints of OVERLAY to BEG and END in BUFFER.
3971 If BUFFER is omitted, leave OVERLAY in the same buffer it inhabits now.
3972 If BUFFER is omitted, and OVERLAY is in no buffer, put it in the current
3973 buffer. */)
3974 (Lisp_Object overlay, Lisp_Object beg, Lisp_Object end, Lisp_Object buffer)
3976 struct buffer *b, *ob = 0;
3977 Lisp_Object obuffer;
3978 ptrdiff_t count = SPECPDL_INDEX ();
3979 ptrdiff_t n_beg, n_end;
3980 ptrdiff_t o_beg UNINIT, o_end UNINIT;
3982 CHECK_OVERLAY (overlay);
3983 if (NILP (buffer))
3984 buffer = Fmarker_buffer (OVERLAY_START (overlay));
3985 if (NILP (buffer))
3986 XSETBUFFER (buffer, current_buffer);
3987 CHECK_BUFFER (buffer);
3989 if (NILP (Fbuffer_live_p (buffer)))
3990 error ("Attempt to move overlay to a dead buffer");
3992 if (MARKERP (beg) && !EQ (Fmarker_buffer (beg), buffer))
3993 signal_error ("Marker points into wrong buffer", beg);
3994 if (MARKERP (end) && !EQ (Fmarker_buffer (end), buffer))
3995 signal_error ("Marker points into wrong buffer", end);
3997 CHECK_NUMBER_COERCE_MARKER (beg);
3998 CHECK_NUMBER_COERCE_MARKER (end);
4000 if (XINT (beg) > XINT (end))
4002 Lisp_Object temp;
4003 temp = beg; beg = end; end = temp;
4006 specbind (Qinhibit_quit, Qt);
4008 obuffer = Fmarker_buffer (OVERLAY_START (overlay));
4009 b = XBUFFER (buffer);
4011 if (!NILP (obuffer))
4013 ob = XBUFFER (obuffer);
4015 o_beg = OVERLAY_POSITION (OVERLAY_START (overlay));
4016 o_end = OVERLAY_POSITION (OVERLAY_END (overlay));
4018 unchain_both (ob, overlay);
4021 /* Set the overlay boundaries, which may clip them. */
4022 Fset_marker (OVERLAY_START (overlay), beg, buffer);
4023 Fset_marker (OVERLAY_END (overlay), end, buffer);
4025 n_beg = marker_position (OVERLAY_START (overlay));
4026 n_end = marker_position (OVERLAY_END (overlay));
4028 /* If the overlay has changed buffers, do a thorough redisplay. */
4029 if (!EQ (buffer, obuffer))
4031 /* Redisplay where the overlay was. */
4032 if (ob)
4033 modify_overlay (ob, o_beg, o_end);
4035 /* Redisplay where the overlay is going to be. */
4036 modify_overlay (b, n_beg, n_end);
4038 else
4039 /* Redisplay the area the overlay has just left, or just enclosed. */
4041 if (o_beg == n_beg)
4042 modify_overlay (b, o_end, n_end);
4043 else if (o_end == n_end)
4044 modify_overlay (b, o_beg, n_beg);
4045 else
4046 modify_overlay (b, min (o_beg, n_beg), max (o_end, n_end));
4049 /* Delete the overlay if it is empty after clipping and has the
4050 evaporate property. */
4051 if (n_beg == n_end && !NILP (Foverlay_get (overlay, Qevaporate)))
4052 return unbind_to (count, Fdelete_overlay (overlay));
4054 /* Put the overlay into the new buffer's overlay lists, first on the
4055 wrong list. */
4056 if (n_end < b->overlay_center)
4058 XOVERLAY (overlay)->next = b->overlays_after;
4059 set_buffer_overlays_after (b, XOVERLAY (overlay));
4061 else
4063 XOVERLAY (overlay)->next = b->overlays_before;
4064 set_buffer_overlays_before (b, XOVERLAY (overlay));
4067 /* This puts it in the right list, and in the right order. */
4068 recenter_overlay_lists (b, b->overlay_center);
4070 return unbind_to (count, overlay);
4073 DEFUN ("delete-overlay", Fdelete_overlay, Sdelete_overlay, 1, 1, 0,
4074 doc: /* Delete the overlay OVERLAY from its buffer. */)
4075 (Lisp_Object overlay)
4077 Lisp_Object buffer;
4078 struct buffer *b;
4079 ptrdiff_t count = SPECPDL_INDEX ();
4081 CHECK_OVERLAY (overlay);
4083 buffer = Fmarker_buffer (OVERLAY_START (overlay));
4084 if (NILP (buffer))
4085 return Qnil;
4087 b = XBUFFER (buffer);
4088 specbind (Qinhibit_quit, Qt);
4090 unchain_both (b, overlay);
4091 drop_overlay (b, XOVERLAY (overlay));
4093 /* When deleting an overlay with before or after strings, turn off
4094 display optimizations for the affected buffer, on the basis that
4095 these strings may contain newlines. This is easier to do than to
4096 check for that situation during redisplay. */
4097 if (!windows_or_buffers_changed
4098 && (!NILP (Foverlay_get (overlay, Qbefore_string))
4099 || !NILP (Foverlay_get (overlay, Qafter_string))))
4100 b->prevent_redisplay_optimizations_p = 1;
4102 return unbind_to (count, Qnil);
4105 DEFUN ("delete-all-overlays", Fdelete_all_overlays, Sdelete_all_overlays, 0, 1, 0,
4106 doc: /* Delete all overlays of BUFFER.
4107 BUFFER omitted or nil means delete all overlays of the current
4108 buffer. */)
4109 (Lisp_Object buffer)
4111 delete_all_overlays (decode_buffer (buffer));
4112 return Qnil;
4115 /* Overlay dissection functions. */
4117 DEFUN ("overlay-start", Foverlay_start, Soverlay_start, 1, 1, 0,
4118 doc: /* Return the position at which OVERLAY starts. */)
4119 (Lisp_Object overlay)
4121 CHECK_OVERLAY (overlay);
4123 return (Fmarker_position (OVERLAY_START (overlay)));
4126 DEFUN ("overlay-end", Foverlay_end, Soverlay_end, 1, 1, 0,
4127 doc: /* Return the position at which OVERLAY ends. */)
4128 (Lisp_Object overlay)
4130 CHECK_OVERLAY (overlay);
4132 return (Fmarker_position (OVERLAY_END (overlay)));
4135 DEFUN ("overlay-buffer", Foverlay_buffer, Soverlay_buffer, 1, 1, 0,
4136 doc: /* Return the buffer OVERLAY belongs to.
4137 Return nil if OVERLAY has been deleted. */)
4138 (Lisp_Object overlay)
4140 CHECK_OVERLAY (overlay);
4142 return Fmarker_buffer (OVERLAY_START (overlay));
4145 DEFUN ("overlay-properties", Foverlay_properties, Soverlay_properties, 1, 1, 0,
4146 doc: /* Return a list of the properties on OVERLAY.
4147 This is a copy of OVERLAY's plist; modifying its conses has no effect on
4148 OVERLAY. */)
4149 (Lisp_Object overlay)
4151 CHECK_OVERLAY (overlay);
4153 return Fcopy_sequence (XOVERLAY (overlay)->plist);
4157 DEFUN ("overlays-at", Foverlays_at, Soverlays_at, 1, 2, 0,
4158 doc: /* Return a list of the overlays that contain the character at POS.
4159 If SORTED is non-nil, then sort them by decreasing priority. */)
4160 (Lisp_Object pos, Lisp_Object sorted)
4162 ptrdiff_t len, noverlays;
4163 Lisp_Object *overlay_vec;
4164 Lisp_Object result;
4166 CHECK_NUMBER_COERCE_MARKER (pos);
4168 if (!buffer_has_overlays ())
4169 return Qnil;
4171 len = 10;
4172 /* We can't use alloca here because overlays_at can call xrealloc. */
4173 overlay_vec = xmalloc (len * sizeof *overlay_vec);
4175 /* Put all the overlays we want in a vector in overlay_vec.
4176 Store the length in len. */
4177 noverlays = overlays_at (XINT (pos), 1, &overlay_vec, &len,
4178 NULL, NULL, 0);
4180 if (!NILP (sorted))
4181 noverlays = sort_overlays (overlay_vec, noverlays,
4182 WINDOWP (sorted) ? XWINDOW (sorted) : NULL);
4184 /* Make a list of them all. */
4185 result = Flist (noverlays, overlay_vec);
4187 /* The doc string says the list should be in decreasing order of
4188 priority, so we reverse the list, because sort_overlays sorts in
4189 the increasing order of priority. */
4190 if (!NILP (sorted))
4191 result = Fnreverse (result);
4193 xfree (overlay_vec);
4194 return result;
4197 DEFUN ("overlays-in", Foverlays_in, Soverlays_in, 2, 2, 0,
4198 doc: /* Return a list of the overlays that overlap the region BEG ... END.
4199 Overlap means that at least one character is contained within the overlay
4200 and also contained within the specified region.
4201 Empty overlays are included in the result if they are located at BEG,
4202 between BEG and END, or at END provided END denotes the position at the
4203 end of the buffer. */)
4204 (Lisp_Object beg, Lisp_Object end)
4206 ptrdiff_t len, noverlays;
4207 Lisp_Object *overlay_vec;
4208 Lisp_Object result;
4210 CHECK_NUMBER_COERCE_MARKER (beg);
4211 CHECK_NUMBER_COERCE_MARKER (end);
4213 if (!buffer_has_overlays ())
4214 return Qnil;
4216 len = 10;
4217 overlay_vec = xmalloc (len * sizeof *overlay_vec);
4219 /* Put all the overlays we want in a vector in overlay_vec.
4220 Store the length in len. */
4221 noverlays = overlays_in (XINT (beg), XINT (end), 1, &overlay_vec, &len,
4222 NULL, NULL);
4224 /* Make a list of them all. */
4225 result = Flist (noverlays, overlay_vec);
4227 xfree (overlay_vec);
4228 return result;
4231 DEFUN ("next-overlay-change", Fnext_overlay_change, Snext_overlay_change,
4232 1, 1, 0,
4233 doc: /* Return the next position after POS where an overlay starts or ends.
4234 If there are no overlay boundaries from POS to (point-max),
4235 the value is (point-max). */)
4236 (Lisp_Object pos)
4238 ptrdiff_t i, len, noverlays;
4239 ptrdiff_t endpos;
4240 Lisp_Object *overlay_vec;
4242 CHECK_NUMBER_COERCE_MARKER (pos);
4244 if (!buffer_has_overlays ())
4245 return make_number (ZV);
4247 len = 10;
4248 overlay_vec = xmalloc (len * sizeof *overlay_vec);
4250 /* Put all the overlays we want in a vector in overlay_vec.
4251 Store the length in len.
4252 endpos gets the position where the next overlay starts. */
4253 noverlays = overlays_at (XINT (pos), 1, &overlay_vec, &len,
4254 &endpos, 0, 1);
4256 /* If any of these overlays ends before endpos,
4257 use its ending point instead. */
4258 for (i = 0; i < noverlays; i++)
4260 Lisp_Object oend;
4261 ptrdiff_t oendpos;
4263 oend = OVERLAY_END (overlay_vec[i]);
4264 oendpos = OVERLAY_POSITION (oend);
4265 if (oendpos < endpos)
4266 endpos = oendpos;
4269 xfree (overlay_vec);
4270 return make_number (endpos);
4273 DEFUN ("previous-overlay-change", Fprevious_overlay_change,
4274 Sprevious_overlay_change, 1, 1, 0,
4275 doc: /* Return the previous position before POS where an overlay starts or ends.
4276 If there are no overlay boundaries from (point-min) to POS,
4277 the value is (point-min). */)
4278 (Lisp_Object pos)
4280 ptrdiff_t prevpos;
4281 Lisp_Object *overlay_vec;
4282 ptrdiff_t len;
4284 CHECK_NUMBER_COERCE_MARKER (pos);
4286 if (!buffer_has_overlays ())
4287 return make_number (BEGV);
4289 /* At beginning of buffer, we know the answer;
4290 avoid bug subtracting 1 below. */
4291 if (XINT (pos) == BEGV)
4292 return pos;
4294 len = 10;
4295 overlay_vec = xmalloc (len * sizeof *overlay_vec);
4297 /* Put all the overlays we want in a vector in overlay_vec.
4298 Store the length in len.
4299 prevpos gets the position of the previous change. */
4300 overlays_at (XINT (pos), 1, &overlay_vec, &len,
4301 0, &prevpos, 1);
4303 xfree (overlay_vec);
4304 return make_number (prevpos);
4307 /* These functions are for debugging overlays. */
4309 DEFUN ("overlay-lists", Foverlay_lists, Soverlay_lists, 0, 0, 0,
4310 doc: /* Return a pair of lists giving all the overlays of the current buffer.
4311 The car has all the overlays before the overlay center;
4312 the cdr has all the overlays after the overlay center.
4313 Recentering overlays moves overlays between these lists.
4314 The lists you get are copies, so that changing them has no effect.
4315 However, the overlays you get are the real objects that the buffer uses. */)
4316 (void)
4318 struct Lisp_Overlay *ol;
4319 Lisp_Object before = Qnil, after = Qnil, tmp;
4321 for (ol = current_buffer->overlays_before; ol; ol = ol->next)
4323 XSETMISC (tmp, ol);
4324 before = Fcons (tmp, before);
4326 for (ol = current_buffer->overlays_after; ol; ol = ol->next)
4328 XSETMISC (tmp, ol);
4329 after = Fcons (tmp, after);
4332 return Fcons (Fnreverse (before), Fnreverse (after));
4335 DEFUN ("overlay-recenter", Foverlay_recenter, Soverlay_recenter, 1, 1, 0,
4336 doc: /* Recenter the overlays of the current buffer around position POS.
4337 That makes overlay lookup faster for positions near POS (but perhaps slower
4338 for positions far away from POS). */)
4339 (Lisp_Object pos)
4341 ptrdiff_t p;
4342 CHECK_NUMBER_COERCE_MARKER (pos);
4344 p = clip_to_bounds (PTRDIFF_MIN, XINT (pos), PTRDIFF_MAX);
4345 recenter_overlay_lists (current_buffer, p);
4346 return Qnil;
4349 DEFUN ("overlay-get", Foverlay_get, Soverlay_get, 2, 2, 0,
4350 doc: /* Get the property of overlay OVERLAY with property name PROP. */)
4351 (Lisp_Object overlay, Lisp_Object prop)
4353 CHECK_OVERLAY (overlay);
4354 return lookup_char_property (XOVERLAY (overlay)->plist, prop, 0);
4357 DEFUN ("overlay-put", Foverlay_put, Soverlay_put, 3, 3, 0,
4358 doc: /* Set one property of overlay OVERLAY: give property PROP value VALUE.
4359 VALUE will be returned.*/)
4360 (Lisp_Object overlay, Lisp_Object prop, Lisp_Object value)
4362 Lisp_Object tail, buffer;
4363 bool changed;
4365 CHECK_OVERLAY (overlay);
4367 buffer = Fmarker_buffer (OVERLAY_START (overlay));
4369 for (tail = XOVERLAY (overlay)->plist;
4370 CONSP (tail) && CONSP (XCDR (tail));
4371 tail = XCDR (XCDR (tail)))
4372 if (EQ (XCAR (tail), prop))
4374 changed = !EQ (XCAR (XCDR (tail)), value);
4375 XSETCAR (XCDR (tail), value);
4376 goto found;
4378 /* It wasn't in the list, so add it to the front. */
4379 changed = !NILP (value);
4380 set_overlay_plist
4381 (overlay, Fcons (prop, Fcons (value, XOVERLAY (overlay)->plist)));
4382 found:
4383 if (! NILP (buffer))
4385 if (changed)
4386 modify_overlay (XBUFFER (buffer),
4387 marker_position (OVERLAY_START (overlay)),
4388 marker_position (OVERLAY_END (overlay)));
4389 if (EQ (prop, Qevaporate) && ! NILP (value)
4390 && (OVERLAY_POSITION (OVERLAY_START (overlay))
4391 == OVERLAY_POSITION (OVERLAY_END (overlay))))
4392 Fdelete_overlay (overlay);
4395 return value;
4398 /* Subroutine of report_overlay_modification. */
4400 /* Lisp vector holding overlay hook functions to call.
4401 Vector elements come in pairs.
4402 Each even-index element is a list of hook functions.
4403 The following odd-index element is the overlay they came from.
4405 Before the buffer change, we fill in this vector
4406 as we call overlay hook functions.
4407 After the buffer change, we get the functions to call from this vector.
4408 This way we always call the same functions before and after the change. */
4409 static Lisp_Object last_overlay_modification_hooks;
4411 /* Number of elements actually used in last_overlay_modification_hooks. */
4412 static ptrdiff_t last_overlay_modification_hooks_used;
4414 /* Add one functionlist/overlay pair
4415 to the end of last_overlay_modification_hooks. */
4417 static void
4418 add_overlay_mod_hooklist (Lisp_Object functionlist, Lisp_Object overlay)
4420 ptrdiff_t oldsize = ASIZE (last_overlay_modification_hooks);
4422 if (oldsize - 1 <= last_overlay_modification_hooks_used)
4423 last_overlay_modification_hooks =
4424 larger_vector (last_overlay_modification_hooks, 2, -1);
4425 ASET (last_overlay_modification_hooks, last_overlay_modification_hooks_used,
4426 functionlist); last_overlay_modification_hooks_used++;
4427 ASET (last_overlay_modification_hooks, last_overlay_modification_hooks_used,
4428 overlay); last_overlay_modification_hooks_used++;
4431 /* Run the modification-hooks of overlays that include
4432 any part of the text in START to END.
4433 If this change is an insertion, also
4434 run the insert-before-hooks of overlay starting at END,
4435 and the insert-after-hooks of overlay ending at START.
4437 This is called both before and after the modification.
4438 AFTER is true when we call after the modification.
4440 ARG1, ARG2, ARG3 are arguments to pass to the hook functions.
4441 When AFTER is nonzero, they are the start position,
4442 the position after the inserted new text,
4443 and the length of deleted or replaced old text. */
4445 void
4446 report_overlay_modification (Lisp_Object start, Lisp_Object end, bool after,
4447 Lisp_Object arg1, Lisp_Object arg2, Lisp_Object arg3)
4449 Lisp_Object prop, overlay;
4450 struct Lisp_Overlay *tail;
4451 /* True if this change is an insertion. */
4452 bool insertion = (after ? XFASTINT (arg3) == 0 : EQ (start, end));
4454 overlay = Qnil;
4455 tail = NULL;
4457 /* We used to run the functions as soon as we found them and only register
4458 them in last_overlay_modification_hooks for the purpose of the `after'
4459 case. But running elisp code as we traverse the list of overlays is
4460 painful because the list can be modified by the elisp code so we had to
4461 copy at several places. We now simply do a read-only traversal that
4462 only collects the functions to run and we run them afterwards. It's
4463 simpler, especially since all the code was already there. -stef */
4465 if (!after)
4467 /* We are being called before a change.
4468 Scan the overlays to find the functions to call. */
4469 last_overlay_modification_hooks_used = 0;
4470 for (tail = current_buffer->overlays_before; tail; tail = tail->next)
4472 ptrdiff_t startpos, endpos;
4473 Lisp_Object ostart, oend;
4475 XSETMISC (overlay, tail);
4477 ostart = OVERLAY_START (overlay);
4478 oend = OVERLAY_END (overlay);
4479 endpos = OVERLAY_POSITION (oend);
4480 if (XFASTINT (start) > endpos)
4481 break;
4482 startpos = OVERLAY_POSITION (ostart);
4483 if (insertion && (XFASTINT (start) == startpos
4484 || XFASTINT (end) == startpos))
4486 prop = Foverlay_get (overlay, Qinsert_in_front_hooks);
4487 if (!NILP (prop))
4488 add_overlay_mod_hooklist (prop, overlay);
4490 if (insertion && (XFASTINT (start) == endpos
4491 || XFASTINT (end) == endpos))
4493 prop = Foverlay_get (overlay, Qinsert_behind_hooks);
4494 if (!NILP (prop))
4495 add_overlay_mod_hooklist (prop, overlay);
4497 /* Test for intersecting intervals. This does the right thing
4498 for both insertion and deletion. */
4499 if (XFASTINT (end) > startpos && XFASTINT (start) < endpos)
4501 prop = Foverlay_get (overlay, Qmodification_hooks);
4502 if (!NILP (prop))
4503 add_overlay_mod_hooklist (prop, overlay);
4507 for (tail = current_buffer->overlays_after; tail; tail = tail->next)
4509 ptrdiff_t startpos, endpos;
4510 Lisp_Object ostart, oend;
4512 XSETMISC (overlay, tail);
4514 ostart = OVERLAY_START (overlay);
4515 oend = OVERLAY_END (overlay);
4516 startpos = OVERLAY_POSITION (ostart);
4517 endpos = OVERLAY_POSITION (oend);
4518 if (XFASTINT (end) < startpos)
4519 break;
4520 if (insertion && (XFASTINT (start) == startpos
4521 || XFASTINT (end) == startpos))
4523 prop = Foverlay_get (overlay, Qinsert_in_front_hooks);
4524 if (!NILP (prop))
4525 add_overlay_mod_hooklist (prop, overlay);
4527 if (insertion && (XFASTINT (start) == endpos
4528 || XFASTINT (end) == endpos))
4530 prop = Foverlay_get (overlay, Qinsert_behind_hooks);
4531 if (!NILP (prop))
4532 add_overlay_mod_hooklist (prop, overlay);
4534 /* Test for intersecting intervals. This does the right thing
4535 for both insertion and deletion. */
4536 if (XFASTINT (end) > startpos && XFASTINT (start) < endpos)
4538 prop = Foverlay_get (overlay, Qmodification_hooks);
4539 if (!NILP (prop))
4540 add_overlay_mod_hooklist (prop, overlay);
4546 /* Call the functions recorded in last_overlay_modification_hooks.
4547 First copy the vector contents, in case some of these hooks
4548 do subsequent modification of the buffer. */
4549 ptrdiff_t size = last_overlay_modification_hooks_used;
4550 Lisp_Object *copy;
4551 ptrdiff_t i;
4553 if (size)
4555 Lisp_Object ovl
4556 = XVECTOR (last_overlay_modification_hooks)->contents[1];
4558 /* If the buffer of the first overlay in the array doesn't
4559 match the current buffer, then these modification hooks
4560 should not be run in this buffer. This could happen when
4561 some code calls some insdel functions, such as del_range_1,
4562 with the PREPARE argument false -- in that case this
4563 function is never called to record the overlay modification
4564 hook functions in the last_overlay_modification_hooks
4565 array, so anything we find there is not ours. */
4566 if (XMARKER (OVERLAY_START (ovl))->buffer != current_buffer)
4567 return;
4570 USE_SAFE_ALLOCA;
4571 SAFE_ALLOCA_LISP (copy, size);
4572 memcpy (copy, XVECTOR (last_overlay_modification_hooks)->contents,
4573 size * word_size);
4575 for (i = 0; i < size;)
4577 Lisp_Object prop_i, overlay_i;
4578 prop_i = copy[i++];
4579 overlay_i = copy[i++];
4580 call_overlay_mod_hooks (prop_i, overlay_i, after, arg1, arg2, arg3);
4583 SAFE_FREE ();
4587 static void
4588 call_overlay_mod_hooks (Lisp_Object list, Lisp_Object overlay, bool after,
4589 Lisp_Object arg1, Lisp_Object arg2, Lisp_Object arg3)
4591 while (CONSP (list))
4593 if (NILP (arg3))
4594 call4 (XCAR (list), overlay, after ? Qt : Qnil, arg1, arg2);
4595 else
4596 call5 (XCAR (list), overlay, after ? Qt : Qnil, arg1, arg2, arg3);
4597 list = XCDR (list);
4601 /* Delete any zero-sized overlays at position POS, if the `evaporate'
4602 property is set. */
4603 void
4604 evaporate_overlays (ptrdiff_t pos)
4606 Lisp_Object overlay, hit_list;
4607 struct Lisp_Overlay *tail;
4609 hit_list = Qnil;
4610 if (pos <= current_buffer->overlay_center)
4611 for (tail = current_buffer->overlays_before; tail; tail = tail->next)
4613 ptrdiff_t endpos;
4614 XSETMISC (overlay, tail);
4615 endpos = OVERLAY_POSITION (OVERLAY_END (overlay));
4616 if (endpos < pos)
4617 break;
4618 if (endpos == pos && OVERLAY_POSITION (OVERLAY_START (overlay)) == pos
4619 && ! NILP (Foverlay_get (overlay, Qevaporate)))
4620 hit_list = Fcons (overlay, hit_list);
4622 else
4623 for (tail = current_buffer->overlays_after; tail; tail = tail->next)
4625 ptrdiff_t startpos;
4626 XSETMISC (overlay, tail);
4627 startpos = OVERLAY_POSITION (OVERLAY_START (overlay));
4628 if (startpos > pos)
4629 break;
4630 if (startpos == pos && OVERLAY_POSITION (OVERLAY_END (overlay)) == pos
4631 && ! NILP (Foverlay_get (overlay, Qevaporate)))
4632 hit_list = Fcons (overlay, hit_list);
4634 for (; CONSP (hit_list); hit_list = XCDR (hit_list))
4635 Fdelete_overlay (XCAR (hit_list));
4638 /***********************************************************************
4639 Allocation with mmap
4640 ***********************************************************************/
4642 /* Note: WINDOWSNT implements this stuff on w32heap.c. */
4643 #if defined USE_MMAP_FOR_BUFFERS && !defined WINDOWSNT
4645 #include <sys/mman.h>
4647 #ifndef MAP_ANON
4648 #ifdef MAP_ANONYMOUS
4649 #define MAP_ANON MAP_ANONYMOUS
4650 #else
4651 #define MAP_ANON 0
4652 #endif
4653 #endif
4655 #ifndef MAP_FAILED
4656 #define MAP_FAILED ((void *) -1)
4657 #endif
4659 #if MAP_ANON == 0
4660 #include <fcntl.h>
4661 #endif
4664 /* Memory is allocated in regions which are mapped using mmap(2).
4665 The current implementation lets the system select mapped
4666 addresses; we're not using MAP_FIXED in general, except when
4667 trying to enlarge regions.
4669 Each mapped region starts with a mmap_region structure, the user
4670 area starts after that structure, aligned to MEM_ALIGN.
4672 +-----------------------+
4673 | struct mmap_info + |
4674 | padding |
4675 +-----------------------+
4676 | user data |
4679 +-----------------------+ */
4681 struct mmap_region
4683 /* User-specified size. */
4684 size_t nbytes_specified;
4686 /* Number of bytes mapped */
4687 size_t nbytes_mapped;
4689 /* Pointer to the location holding the address of the memory
4690 allocated with the mmap'd block. The variable actually points
4691 after this structure. */
4692 void **var;
4694 /* Next and previous in list of all mmap'd regions. */
4695 struct mmap_region *next, *prev;
4698 /* Doubly-linked list of mmap'd regions. */
4700 static struct mmap_region *mmap_regions;
4702 /* File descriptor for mmap. If we don't have anonymous mapping,
4703 /dev/zero will be opened on it. */
4705 static int mmap_fd;
4707 /* Page size on this system. */
4709 static int mmap_page_size;
4711 /* 1 means mmap has been initialized. */
4713 static bool mmap_initialized_p;
4715 /* Value is X rounded up to the next multiple of N. */
4717 #define ROUND(X, N) (((X) + (N) - 1) / (N) * (N))
4719 /* Size of mmap_region structure plus padding. */
4721 #define MMAP_REGION_STRUCT_SIZE \
4722 ROUND (sizeof (struct mmap_region), MEM_ALIGN)
4724 /* Given a pointer P to the start of the user-visible part of a mapped
4725 region, return a pointer to the start of the region. */
4727 #define MMAP_REGION(P) \
4728 ((struct mmap_region *) ((char *) (P) - MMAP_REGION_STRUCT_SIZE))
4730 /* Given a pointer P to the start of a mapped region, return a pointer
4731 to the start of the user-visible part of the region. */
4733 #define MMAP_USER_AREA(P) \
4734 ((void *) ((char *) (P) + MMAP_REGION_STRUCT_SIZE))
4736 #define MEM_ALIGN sizeof (double)
4738 /* Predicate returning true if part of the address range [START .. END]
4739 is currently mapped. Used to prevent overwriting an existing
4740 memory mapping.
4742 Default is to conservatively assume the address range is occupied by
4743 something else. This can be overridden by system configuration
4744 files if system-specific means to determine this exists. */
4746 #ifndef MMAP_ALLOCATED_P
4747 #define MMAP_ALLOCATED_P(start, end) 1
4748 #endif
4750 /* Perform necessary initializations for the use of mmap. */
4752 static void
4753 mmap_init (void)
4755 #if MAP_ANON == 0
4756 /* The value of mmap_fd is initially 0 in temacs, and -1
4757 in a dumped Emacs. */
4758 if (mmap_fd <= 0)
4760 /* No anonymous mmap -- we need the file descriptor. */
4761 mmap_fd = emacs_open ("/dev/zero", O_RDONLY, 0);
4762 if (mmap_fd == -1)
4763 fatal ("Cannot open /dev/zero: %s", emacs_strerror (errno));
4765 #endif /* MAP_ANON == 0 */
4767 if (mmap_initialized_p)
4768 return;
4769 mmap_initialized_p = 1;
4771 #if MAP_ANON != 0
4772 mmap_fd = -1;
4773 #endif
4775 mmap_page_size = getpagesize ();
4778 /* Unmap a region. P is a pointer to the start of the user-araa of
4779 the region. */
4781 static void
4782 mmap_free_1 (struct mmap_region *r)
4784 if (r->next)
4785 r->next->prev = r->prev;
4786 if (r->prev)
4787 r->prev->next = r->next;
4788 else
4789 mmap_regions = r->next;
4791 if (munmap (r, r->nbytes_mapped) == -1)
4792 fprintf (stderr, "munmap: %s\n", emacs_strerror (errno));
4796 /* Enlarge region R by NPAGES pages. NPAGES < 0 means shrink R.
4797 Value is true if successful. */
4799 static bool
4800 mmap_enlarge (struct mmap_region *r, int npages)
4802 char *region_end = (char *) r + r->nbytes_mapped;
4803 size_t nbytes;
4804 bool success = 0;
4806 if (npages < 0)
4808 /* Unmap pages at the end of the region. */
4809 nbytes = - npages * mmap_page_size;
4810 if (munmap (region_end - nbytes, nbytes) == -1)
4811 fprintf (stderr, "munmap: %s\n", emacs_strerror (errno));
4812 else
4814 r->nbytes_mapped -= nbytes;
4815 success = 1;
4818 else if (npages > 0)
4820 nbytes = npages * mmap_page_size;
4822 /* Try to map additional pages at the end of the region. We
4823 cannot do this if the address range is already occupied by
4824 something else because mmap deletes any previous mapping.
4825 I'm not sure this is worth doing, let's see. */
4826 if (!MMAP_ALLOCATED_P (region_end, region_end + nbytes))
4828 void *p;
4830 p = mmap (region_end, nbytes, PROT_READ | PROT_WRITE,
4831 MAP_ANON | MAP_PRIVATE | MAP_FIXED, mmap_fd, 0);
4832 if (p == MAP_FAILED)
4833 ; /* fprintf (stderr, "mmap: %s\n", emacs_strerror (errno)); */
4834 else if (p != region_end)
4836 /* Kernels are free to choose a different address. In
4837 that case, unmap what we've mapped above; we have
4838 no use for it. */
4839 if (munmap (p, nbytes) == -1)
4840 fprintf (stderr, "munmap: %s\n", emacs_strerror (errno));
4842 else
4844 r->nbytes_mapped += nbytes;
4845 success = 1;
4850 return success;
4854 /* Allocate a block of storage large enough to hold NBYTES bytes of
4855 data. A pointer to the data is returned in *VAR. VAR is thus the
4856 address of some variable which will use the data area.
4858 The allocation of 0 bytes is valid.
4860 If we can't allocate the necessary memory, set *VAR to null, and
4861 return null. */
4863 static void *
4864 mmap_alloc (void **var, size_t nbytes)
4866 void *p;
4867 size_t map;
4869 mmap_init ();
4871 map = ROUND (nbytes + MMAP_REGION_STRUCT_SIZE, mmap_page_size);
4872 p = mmap (NULL, map, PROT_READ | PROT_WRITE, MAP_ANON | MAP_PRIVATE,
4873 mmap_fd, 0);
4875 if (p == MAP_FAILED)
4877 if (errno != ENOMEM)
4878 fprintf (stderr, "mmap: %s\n", emacs_strerror (errno));
4879 p = NULL;
4881 else
4883 struct mmap_region *r = p;
4885 r->nbytes_specified = nbytes;
4886 r->nbytes_mapped = map;
4887 r->var = var;
4888 r->prev = NULL;
4889 r->next = mmap_regions;
4890 if (r->next)
4891 r->next->prev = r;
4892 mmap_regions = r;
4894 p = MMAP_USER_AREA (p);
4897 return *var = p;
4901 /* Free a block of relocatable storage whose data is pointed to by
4902 PTR. Store 0 in *PTR to show there's no block allocated. */
4904 static void
4905 mmap_free (void **var)
4907 mmap_init ();
4909 if (*var)
4911 mmap_free_1 (MMAP_REGION (*var));
4912 *var = NULL;
4917 /* Given a pointer at address VAR to data allocated with mmap_alloc,
4918 resize it to size NBYTES. Change *VAR to reflect the new block,
4919 and return this value. If more memory cannot be allocated, then
4920 leave *VAR unchanged, and return null. */
4922 static void *
4923 mmap_realloc (void **var, size_t nbytes)
4925 void *result;
4927 mmap_init ();
4929 if (*var == NULL)
4930 result = mmap_alloc (var, nbytes);
4931 else if (nbytes == 0)
4933 mmap_free (var);
4934 result = mmap_alloc (var, nbytes);
4936 else
4938 struct mmap_region *r = MMAP_REGION (*var);
4939 size_t room = r->nbytes_mapped - MMAP_REGION_STRUCT_SIZE;
4941 if (room < nbytes)
4943 /* Must enlarge. */
4944 void *old_ptr = *var;
4946 /* Try to map additional pages at the end of the region.
4947 If that fails, allocate a new region, copy data
4948 from the old region, then free it. */
4949 if (mmap_enlarge (r, (ROUND (nbytes - room, mmap_page_size)
4950 / mmap_page_size)))
4952 r->nbytes_specified = nbytes;
4953 *var = result = old_ptr;
4955 else if (mmap_alloc (var, nbytes))
4957 memcpy (*var, old_ptr, r->nbytes_specified);
4958 mmap_free_1 (MMAP_REGION (old_ptr));
4959 result = *var;
4960 r = MMAP_REGION (result);
4961 r->nbytes_specified = nbytes;
4963 else
4965 *var = old_ptr;
4966 result = NULL;
4969 else if (room - nbytes >= mmap_page_size)
4971 /* Shrinking by at least a page. Let's give some
4972 memory back to the system.
4974 The extra parens are to make the division happens first,
4975 on positive values, so we know it will round towards
4976 zero. */
4977 mmap_enlarge (r, - ((room - nbytes) / mmap_page_size));
4978 result = *var;
4979 r->nbytes_specified = nbytes;
4981 else
4983 /* Leave it alone. */
4984 result = *var;
4985 r->nbytes_specified = nbytes;
4989 return result;
4993 #endif /* USE_MMAP_FOR_BUFFERS */
4997 /***********************************************************************
4998 Buffer-text Allocation
4999 ***********************************************************************/
5001 /* Allocate NBYTES bytes for buffer B's text buffer. */
5003 static void
5004 alloc_buffer_text (struct buffer *b, ptrdiff_t nbytes)
5006 void *p;
5008 block_input ();
5009 #if defined USE_MMAP_FOR_BUFFERS
5010 p = mmap_alloc ((void **) &b->text->beg, nbytes);
5011 #elif defined REL_ALLOC
5012 p = r_alloc ((void **) &b->text->beg, nbytes);
5013 #else
5014 p = xmalloc (nbytes);
5015 #endif
5017 if (p == NULL)
5019 unblock_input ();
5020 memory_full (nbytes);
5023 b->text->beg = p;
5024 unblock_input ();
5027 /* Enlarge buffer B's text buffer by DELTA bytes. DELTA < 0 means
5028 shrink it. */
5030 void
5031 enlarge_buffer_text (struct buffer *b, ptrdiff_t delta)
5033 void *p;
5034 ptrdiff_t nbytes = (BUF_Z_BYTE (b) - BUF_BEG_BYTE (b) + BUF_GAP_SIZE (b) + 1
5035 + delta);
5036 block_input ();
5037 #if defined USE_MMAP_FOR_BUFFERS
5038 p = mmap_realloc ((void **) &b->text->beg, nbytes);
5039 #elif defined REL_ALLOC
5040 p = r_re_alloc ((void **) &b->text->beg, nbytes);
5041 #else
5042 p = xrealloc (b->text->beg, nbytes);
5043 #endif
5045 if (p == NULL)
5047 unblock_input ();
5048 memory_full (nbytes);
5051 BUF_BEG_ADDR (b) = p;
5052 unblock_input ();
5056 /* Free buffer B's text buffer. */
5058 static void
5059 free_buffer_text (struct buffer *b)
5061 block_input ();
5063 #if defined USE_MMAP_FOR_BUFFERS
5064 mmap_free ((void **) &b->text->beg);
5065 #elif defined REL_ALLOC
5066 r_alloc_free ((void **) &b->text->beg);
5067 #else
5068 xfree (b->text->beg);
5069 #endif
5071 BUF_BEG_ADDR (b) = NULL;
5072 unblock_input ();
5077 /***********************************************************************
5078 Initialization
5079 ***********************************************************************/
5081 void
5082 init_buffer_once (void)
5084 int idx;
5086 /* Items flagged permanent get an explicit permanent-local property
5087 added in bindings.el, for clarity. */
5088 memset (buffer_permanent_local_flags, 0, sizeof buffer_permanent_local_flags);
5090 /* 0 means not a lisp var, -1 means always local, else mask. */
5091 memset (&buffer_local_flags, 0, sizeof buffer_local_flags);
5092 bset_filename (&buffer_local_flags, make_number (-1));
5093 bset_directory (&buffer_local_flags, make_number (-1));
5094 bset_backed_up (&buffer_local_flags, make_number (-1));
5095 bset_save_length (&buffer_local_flags, make_number (-1));
5096 bset_auto_save_file_name (&buffer_local_flags, make_number (-1));
5097 bset_read_only (&buffer_local_flags, make_number (-1));
5098 bset_major_mode (&buffer_local_flags, make_number (-1));
5099 bset_mode_name (&buffer_local_flags, make_number (-1));
5100 bset_undo_list (&buffer_local_flags, make_number (-1));
5101 bset_mark_active (&buffer_local_flags, make_number (-1));
5102 bset_point_before_scroll (&buffer_local_flags, make_number (-1));
5103 bset_file_truename (&buffer_local_flags, make_number (-1));
5104 bset_invisibility_spec (&buffer_local_flags, make_number (-1));
5105 bset_file_format (&buffer_local_flags, make_number (-1));
5106 bset_auto_save_file_format (&buffer_local_flags, make_number (-1));
5107 bset_display_count (&buffer_local_flags, make_number (-1));
5108 bset_display_time (&buffer_local_flags, make_number (-1));
5109 bset_enable_multibyte_characters (&buffer_local_flags, make_number (-1));
5111 /* These used to be stuck at 0 by default, but now that the all-zero value
5112 means Qnil, we have to initialize them explicitly. */
5113 bset_name (&buffer_local_flags, make_number (0));
5114 bset_mark (&buffer_local_flags, make_number (0));
5115 bset_local_var_alist (&buffer_local_flags, make_number (0));
5116 bset_keymap (&buffer_local_flags, make_number (0));
5117 bset_downcase_table (&buffer_local_flags, make_number (0));
5118 bset_upcase_table (&buffer_local_flags, make_number (0));
5119 bset_case_canon_table (&buffer_local_flags, make_number (0));
5120 bset_case_eqv_table (&buffer_local_flags, make_number (0));
5121 bset_minor_modes (&buffer_local_flags, make_number (0));
5122 bset_width_table (&buffer_local_flags, make_number (0));
5123 bset_pt_marker (&buffer_local_flags, make_number (0));
5124 bset_begv_marker (&buffer_local_flags, make_number (0));
5125 bset_zv_marker (&buffer_local_flags, make_number (0));
5126 bset_last_selected_window (&buffer_local_flags, make_number (0));
5128 idx = 1;
5129 XSETFASTINT (BVAR (&buffer_local_flags, mode_line_format), idx); ++idx;
5130 XSETFASTINT (BVAR (&buffer_local_flags, abbrev_mode), idx); ++idx;
5131 XSETFASTINT (BVAR (&buffer_local_flags, overwrite_mode), idx); ++idx;
5132 XSETFASTINT (BVAR (&buffer_local_flags, case_fold_search), idx); ++idx;
5133 XSETFASTINT (BVAR (&buffer_local_flags, auto_fill_function), idx); ++idx;
5134 XSETFASTINT (BVAR (&buffer_local_flags, selective_display), idx); ++idx;
5135 XSETFASTINT (BVAR (&buffer_local_flags, selective_display_ellipses), idx); ++idx;
5136 XSETFASTINT (BVAR (&buffer_local_flags, tab_width), idx); ++idx;
5137 XSETFASTINT (BVAR (&buffer_local_flags, truncate_lines), idx);
5138 /* Make this one a permanent local. */
5139 buffer_permanent_local_flags[idx++] = 1;
5140 XSETFASTINT (BVAR (&buffer_local_flags, word_wrap), idx); ++idx;
5141 XSETFASTINT (BVAR (&buffer_local_flags, ctl_arrow), idx); ++idx;
5142 XSETFASTINT (BVAR (&buffer_local_flags, fill_column), idx); ++idx;
5143 XSETFASTINT (BVAR (&buffer_local_flags, left_margin), idx); ++idx;
5144 XSETFASTINT (BVAR (&buffer_local_flags, abbrev_table), idx); ++idx;
5145 XSETFASTINT (BVAR (&buffer_local_flags, display_table), idx); ++idx;
5146 XSETFASTINT (BVAR (&buffer_local_flags, syntax_table), idx); ++idx;
5147 XSETFASTINT (BVAR (&buffer_local_flags, cache_long_scans), idx); ++idx;
5148 XSETFASTINT (BVAR (&buffer_local_flags, category_table), idx); ++idx;
5149 XSETFASTINT (BVAR (&buffer_local_flags, bidi_display_reordering), idx); ++idx;
5150 XSETFASTINT (BVAR (&buffer_local_flags, bidi_paragraph_direction), idx); ++idx;
5151 XSETFASTINT (BVAR (&buffer_local_flags, bidi_paragraph_separate_re), idx); ++idx;
5152 XSETFASTINT (BVAR (&buffer_local_flags, bidi_paragraph_start_re), idx); ++idx;
5153 XSETFASTINT (BVAR (&buffer_local_flags, buffer_file_coding_system), idx);
5154 /* Make this one a permanent local. */
5155 buffer_permanent_local_flags[idx++] = 1;
5156 XSETFASTINT (BVAR (&buffer_local_flags, left_margin_cols), idx); ++idx;
5157 XSETFASTINT (BVAR (&buffer_local_flags, right_margin_cols), idx); ++idx;
5158 XSETFASTINT (BVAR (&buffer_local_flags, left_fringe_width), idx); ++idx;
5159 XSETFASTINT (BVAR (&buffer_local_flags, right_fringe_width), idx); ++idx;
5160 XSETFASTINT (BVAR (&buffer_local_flags, fringes_outside_margins), idx); ++idx;
5161 XSETFASTINT (BVAR (&buffer_local_flags, scroll_bar_width), idx); ++idx;
5162 XSETFASTINT (BVAR (&buffer_local_flags, scroll_bar_height), idx); ++idx;
5163 XSETFASTINT (BVAR (&buffer_local_flags, vertical_scroll_bar_type), idx); ++idx;
5164 XSETFASTINT (BVAR (&buffer_local_flags, horizontal_scroll_bar_type), idx); ++idx;
5165 XSETFASTINT (BVAR (&buffer_local_flags, indicate_empty_lines), idx); ++idx;
5166 XSETFASTINT (BVAR (&buffer_local_flags, indicate_buffer_boundaries), idx); ++idx;
5167 XSETFASTINT (BVAR (&buffer_local_flags, fringe_indicator_alist), idx); ++idx;
5168 XSETFASTINT (BVAR (&buffer_local_flags, fringe_cursor_alist), idx); ++idx;
5169 XSETFASTINT (BVAR (&buffer_local_flags, scroll_up_aggressively), idx); ++idx;
5170 XSETFASTINT (BVAR (&buffer_local_flags, scroll_down_aggressively), idx); ++idx;
5171 XSETFASTINT (BVAR (&buffer_local_flags, header_line_format), idx); ++idx;
5172 XSETFASTINT (BVAR (&buffer_local_flags, cursor_type), idx); ++idx;
5173 XSETFASTINT (BVAR (&buffer_local_flags, extra_line_spacing), idx); ++idx;
5174 XSETFASTINT (BVAR (&buffer_local_flags, cursor_in_non_selected_windows), idx); ++idx;
5176 /* Need more room? */
5177 if (idx >= MAX_PER_BUFFER_VARS)
5178 emacs_abort ();
5179 last_per_buffer_idx = idx;
5181 /* Make sure all markable slots in buffer_defaults
5182 are initialized reasonably, so mark_buffer won't choke. */
5183 reset_buffer (&buffer_defaults);
5184 eassert (NILP (BVAR (&buffer_defaults, name)));
5185 reset_buffer_local_variables (&buffer_defaults, 1);
5186 eassert (NILP (BVAR (&buffer_local_symbols, name)));
5187 reset_buffer (&buffer_local_symbols);
5188 reset_buffer_local_variables (&buffer_local_symbols, 1);
5189 /* Prevent GC from getting confused. */
5190 buffer_defaults.text = &buffer_defaults.own_text;
5191 buffer_local_symbols.text = &buffer_local_symbols.own_text;
5192 /* No one will share the text with these buffers, but let's play it safe. */
5193 buffer_defaults.indirections = 0;
5194 buffer_local_symbols.indirections = 0;
5195 /* Likewise no one will display them. */
5196 buffer_defaults.window_count = 0;
5197 buffer_local_symbols.window_count = 0;
5198 set_buffer_intervals (&buffer_defaults, NULL);
5199 set_buffer_intervals (&buffer_local_symbols, NULL);
5200 /* This is not strictly necessary, but let's make them initialized. */
5201 bset_name (&buffer_defaults, build_pure_c_string (" *buffer-defaults*"));
5202 bset_name (&buffer_local_symbols, build_pure_c_string (" *buffer-local-symbols*"));
5203 BUFFER_PVEC_INIT (&buffer_defaults);
5204 BUFFER_PVEC_INIT (&buffer_local_symbols);
5206 /* Set up the default values of various buffer slots. */
5207 /* Must do these before making the first buffer! */
5209 /* real setup is done in bindings.el */
5210 bset_mode_line_format (&buffer_defaults, build_pure_c_string ("%-"));
5211 bset_header_line_format (&buffer_defaults, Qnil);
5212 bset_abbrev_mode (&buffer_defaults, Qnil);
5213 bset_overwrite_mode (&buffer_defaults, Qnil);
5214 bset_case_fold_search (&buffer_defaults, Qt);
5215 bset_auto_fill_function (&buffer_defaults, Qnil);
5216 bset_selective_display (&buffer_defaults, Qnil);
5217 bset_selective_display_ellipses (&buffer_defaults, Qt);
5218 bset_abbrev_table (&buffer_defaults, Qnil);
5219 bset_display_table (&buffer_defaults, Qnil);
5220 bset_undo_list (&buffer_defaults, Qnil);
5221 bset_mark_active (&buffer_defaults, Qnil);
5222 bset_file_format (&buffer_defaults, Qnil);
5223 bset_auto_save_file_format (&buffer_defaults, Qt);
5224 set_buffer_overlays_before (&buffer_defaults, NULL);
5225 set_buffer_overlays_after (&buffer_defaults, NULL);
5226 buffer_defaults.overlay_center = BEG;
5228 XSETFASTINT (BVAR (&buffer_defaults, tab_width), 8);
5229 bset_truncate_lines (&buffer_defaults, Qnil);
5230 bset_word_wrap (&buffer_defaults, Qnil);
5231 bset_ctl_arrow (&buffer_defaults, Qt);
5232 bset_bidi_display_reordering (&buffer_defaults, Qt);
5233 bset_bidi_paragraph_direction (&buffer_defaults, Qnil);
5234 bset_bidi_paragraph_start_re (&buffer_defaults, Qnil);
5235 bset_bidi_paragraph_separate_re (&buffer_defaults, Qnil);
5236 bset_cursor_type (&buffer_defaults, Qt);
5237 bset_extra_line_spacing (&buffer_defaults, Qnil);
5238 bset_cursor_in_non_selected_windows (&buffer_defaults, Qt);
5240 bset_enable_multibyte_characters (&buffer_defaults, Qt);
5241 bset_buffer_file_coding_system (&buffer_defaults, Qnil);
5242 XSETFASTINT (BVAR (&buffer_defaults, fill_column), 70);
5243 XSETFASTINT (BVAR (&buffer_defaults, left_margin), 0);
5244 bset_cache_long_scans (&buffer_defaults, Qt);
5245 bset_file_truename (&buffer_defaults, Qnil);
5246 XSETFASTINT (BVAR (&buffer_defaults, display_count), 0);
5247 XSETFASTINT (BVAR (&buffer_defaults, left_margin_cols), 0);
5248 XSETFASTINT (BVAR (&buffer_defaults, right_margin_cols), 0);
5249 bset_left_fringe_width (&buffer_defaults, Qnil);
5250 bset_right_fringe_width (&buffer_defaults, Qnil);
5251 bset_fringes_outside_margins (&buffer_defaults, Qnil);
5252 bset_scroll_bar_width (&buffer_defaults, Qnil);
5253 bset_scroll_bar_height (&buffer_defaults, Qnil);
5254 bset_vertical_scroll_bar_type (&buffer_defaults, Qt);
5255 bset_horizontal_scroll_bar_type (&buffer_defaults, Qt);
5256 bset_indicate_empty_lines (&buffer_defaults, Qnil);
5257 bset_indicate_buffer_boundaries (&buffer_defaults, Qnil);
5258 bset_fringe_indicator_alist (&buffer_defaults, Qnil);
5259 bset_fringe_cursor_alist (&buffer_defaults, Qnil);
5260 bset_scroll_up_aggressively (&buffer_defaults, Qnil);
5261 bset_scroll_down_aggressively (&buffer_defaults, Qnil);
5262 bset_display_time (&buffer_defaults, Qnil);
5264 /* Assign the local-flags to the slots that have default values.
5265 The local flag is a bit that is used in the buffer
5266 to say that it has its own local value for the slot.
5267 The local flag bits are in the local_var_flags slot of the buffer. */
5269 /* Nothing can work if this isn't true. */
5270 { verify (sizeof (EMACS_INT) == word_size); }
5272 Vbuffer_alist = Qnil;
5273 current_buffer = 0;
5274 all_buffers = 0;
5276 QSFundamental = build_pure_c_string ("Fundamental");
5278 DEFSYM (Qfundamental_mode, "fundamental-mode");
5279 bset_major_mode (&buffer_defaults, Qfundamental_mode);
5281 DEFSYM (Qmode_class, "mode-class");
5282 DEFSYM (Qprotected_field, "protected-field");
5284 DEFSYM (Qpermanent_local, "permanent-local");
5285 DEFSYM (Qkill_buffer_hook, "kill-buffer-hook");
5286 Fput (Qkill_buffer_hook, Qpermanent_local, Qt);
5288 /* Super-magic invisible buffer. */
5289 Vprin1_to_string_buffer = Fget_buffer_create (build_pure_c_string (" prin1"));
5290 Vbuffer_alist = Qnil;
5292 Fset_buffer (Fget_buffer_create (build_pure_c_string ("*scratch*")));
5294 inhibit_modification_hooks = 0;
5297 void
5298 init_buffer (int initialized)
5300 char *pwd;
5301 Lisp_Object temp;
5302 ptrdiff_t len;
5304 #ifdef USE_MMAP_FOR_BUFFERS
5305 if (initialized)
5307 struct buffer *b;
5309 #ifndef WINDOWSNT
5310 /* These must be reset in the dumped Emacs, to avoid stale
5311 references to mmap'ed memory from before the dump.
5313 WINDOWSNT doesn't need this because it doesn't track mmap'ed
5314 regions by hand (see w32heap.c, which uses system APIs for
5315 that purpose), and thus doesn't use mmap_regions. */
5316 mmap_regions = NULL;
5317 mmap_fd = -1;
5318 #endif
5320 /* The dumped buffers reference addresses of buffer text
5321 recorded by temacs, that cannot be used by the dumped Emacs.
5322 We map new memory for their text here.
5324 Implementation note: the buffers we carry from temacs are:
5325 " prin1", "*scratch*", " *Minibuf-0*", "*Messages*", and
5326 " *code-conversion-work*". They are created by
5327 init_buffer_once and init_window_once (which are not called
5328 in the dumped Emacs), and by the first call to coding.c routines. */
5329 FOR_EACH_BUFFER (b)
5331 b->text->beg = NULL;
5332 enlarge_buffer_text (b, 0);
5335 else
5337 struct buffer *b;
5339 /* Only buffers with allocated buffer text should be present at
5340 this point in temacs. */
5341 FOR_EACH_BUFFER (b)
5343 eassert (b->text->beg != NULL);
5346 #else /* not USE_MMAP_FOR_BUFFERS */
5347 /* Avoid compiler warnings. */
5348 (void) initialized;
5349 #endif /* USE_MMAP_FOR_BUFFERS */
5351 AUTO_STRING (scratch, "*scratch*");
5352 Fset_buffer (Fget_buffer_create (scratch));
5353 if (NILP (BVAR (&buffer_defaults, enable_multibyte_characters)))
5354 Fset_buffer_multibyte (Qnil);
5356 pwd = emacs_get_current_dir_name ();
5358 if (!pwd)
5360 fprintf (stderr, "Error getting directory: %s\n",
5361 emacs_strerror (errno));
5362 bset_directory (current_buffer, Qnil);
5364 else
5366 /* Maybe this should really use some standard subroutine
5367 whose definition is filename syntax dependent. */
5368 len = strlen (pwd);
5369 if (!(IS_DIRECTORY_SEP (pwd[len - 1])))
5371 /* Grow buffer to add directory separator and '\0'. */
5372 pwd = realloc (pwd, len + 2);
5373 if (!pwd)
5374 fatal ("get_current_dir_name: %s\n", strerror (errno));
5375 pwd[len] = DIRECTORY_SEP;
5376 pwd[len + 1] = '\0';
5377 len++;
5380 /* At this moment, we still don't know how to decode the directory
5381 name. So, we keep the bytes in unibyte form so that file I/O
5382 routines correctly get the original bytes. */
5383 bset_directory (current_buffer, make_unibyte_string (pwd, len));
5385 /* Add /: to the front of the name
5386 if it would otherwise be treated as magic. */
5387 temp = Ffind_file_name_handler (BVAR (current_buffer, directory), Qt);
5388 if (! NILP (temp)
5389 /* If the default dir is just /, TEMP is non-nil
5390 because of the ange-ftp completion handler.
5391 However, it is not necessary to turn / into /:/.
5392 So avoid doing that. */
5393 && strcmp ("/", SSDATA (BVAR (current_buffer, directory))))
5395 AUTO_STRING (slash_colon, "/:");
5396 bset_directory (current_buffer,
5397 concat2 (slash_colon,
5398 BVAR (current_buffer, directory)));
5402 temp = get_minibuffer (0);
5403 bset_directory (XBUFFER (temp), BVAR (current_buffer, directory));
5405 free (pwd);
5408 /* Similar to defvar_lisp but define a variable whose value is the
5409 Lisp_Object stored in the current buffer. LNAME is the Lisp-level
5410 variable name. VNAME is the name of the buffer slot. PREDICATE
5411 is nil for a general Lisp variable. If PREDICATE is non-nil, then
5412 only Lisp values that satisfies the PREDICATE are allowed (except
5413 that nil is allowed too). DOC is a dummy where you write the doc
5414 string as a comment. */
5416 #define DEFVAR_PER_BUFFER(lname, vname, predicate, doc) \
5417 do { \
5418 static struct Lisp_Buffer_Objfwd bo_fwd; \
5419 defvar_per_buffer (&bo_fwd, lname, vname, predicate); \
5420 } while (0)
5422 static void
5423 defvar_per_buffer (struct Lisp_Buffer_Objfwd *bo_fwd, const char *namestring,
5424 Lisp_Object *address, Lisp_Object predicate)
5426 struct Lisp_Symbol *sym;
5427 int offset;
5429 sym = XSYMBOL (intern (namestring));
5430 offset = (char *)address - (char *)current_buffer;
5432 bo_fwd->type = Lisp_Fwd_Buffer_Obj;
5433 bo_fwd->offset = offset;
5434 bo_fwd->predicate = predicate;
5435 sym->u.s.declared_special = true;
5436 sym->u.s.redirect = SYMBOL_FORWARDED;
5437 SET_SYMBOL_FWD (sym, (union Lisp_Fwd *) bo_fwd);
5438 XSETSYMBOL (PER_BUFFER_SYMBOL (offset), sym);
5440 if (PER_BUFFER_IDX (offset) == 0)
5441 /* Did a DEFVAR_PER_BUFFER without initializing the corresponding
5442 slot of buffer_local_flags. */
5443 emacs_abort ();
5447 /* Initialize the buffer routines. */
5448 void
5449 syms_of_buffer (void)
5451 staticpro (&last_overlay_modification_hooks);
5452 last_overlay_modification_hooks
5453 = Fmake_vector (make_number (10), Qnil);
5455 staticpro (&QSFundamental);
5456 staticpro (&Vbuffer_alist);
5458 DEFSYM (Qchoice, "choice");
5459 DEFSYM (Qleft, "left");
5460 DEFSYM (Qright, "right");
5461 DEFSYM (Qrange, "range");
5463 DEFSYM (Qpermanent_local_hook, "permanent-local-hook");
5464 DEFSYM (Qoverlayp, "overlayp");
5465 DEFSYM (Qevaporate, "evaporate");
5466 DEFSYM (Qmodification_hooks, "modification-hooks");
5467 DEFSYM (Qinsert_in_front_hooks, "insert-in-front-hooks");
5468 DEFSYM (Qinsert_behind_hooks, "insert-behind-hooks");
5469 DEFSYM (Qget_file_buffer, "get-file-buffer");
5470 DEFSYM (Qpriority, "priority");
5471 DEFSYM (Qbefore_string, "before-string");
5472 DEFSYM (Qafter_string, "after-string");
5473 DEFSYM (Qfirst_change_hook, "first-change-hook");
5474 DEFSYM (Qbefore_change_functions, "before-change-functions");
5475 DEFSYM (Qafter_change_functions, "after-change-functions");
5476 DEFSYM (Qkill_buffer_query_functions, "kill-buffer-query-functions");
5478 DEFSYM (Qvertical_scroll_bar, "vertical-scroll-bar");
5479 Fput (Qvertical_scroll_bar, Qchoice, list4 (Qnil, Qt, Qleft, Qright));
5480 DEFSYM (Qhorizontal_scroll_bar, "horizontal-scroll-bar");
5482 DEFSYM (Qfraction, "fraction");
5483 Fput (Qfraction, Qrange, Fcons (make_float (0.0), make_float (1.0)));
5485 DEFSYM (Qoverwrite_mode, "overwrite-mode");
5486 Fput (Qoverwrite_mode, Qchoice,
5487 list3 (Qnil, intern ("overwrite-mode-textual"),
5488 Qoverwrite_mode_binary));
5490 Fput (Qprotected_field, Qerror_conditions,
5491 listn (CONSTYPE_PURE, 2, Qprotected_field, Qerror));
5492 Fput (Qprotected_field, Qerror_message,
5493 build_pure_c_string ("Attempt to modify a protected field"));
5495 DEFVAR_PER_BUFFER ("header-line-format",
5496 &BVAR (current_buffer, header_line_format),
5497 Qnil,
5498 doc: /* Analogous to `mode-line-format', but controls the header line.
5499 The header line appears, optionally, at the top of a window;
5500 the mode line appears at the bottom. */);
5502 DEFVAR_PER_BUFFER ("mode-line-format", &BVAR (current_buffer, mode_line_format),
5503 Qnil,
5504 doc: /* Template for displaying mode line for current buffer.
5506 The value may be nil, a string, a symbol or a list.
5508 A value of nil means don't display a mode line.
5510 For any symbol other than t or nil, the symbol's value is processed as
5511 a mode line construct. As a special exception, if that value is a
5512 string, the string is processed verbatim, without handling any
5513 %-constructs (see below). Also, unless the symbol has a non-nil
5514 `risky-local-variable' property, all properties in any strings, as
5515 well as all :eval and :propertize forms in the value, are ignored.
5517 A list whose car is a string or list is processed by processing each
5518 of the list elements recursively, as separate mode line constructs,
5519 and concatenating the results.
5521 A list of the form `(:eval FORM)' is processed by evaluating FORM and
5522 using the result as a mode line construct. Be careful--FORM should
5523 not load any files, because that can cause an infinite recursion.
5525 A list of the form `(:propertize ELT PROPS...)' is processed by
5526 processing ELT as the mode line construct, and adding the text
5527 properties PROPS to the result.
5529 A list whose car is a symbol is processed by examining the symbol's
5530 value, and, if that value is non-nil, processing the cadr of the list
5531 recursively; and if that value is nil, processing the caddr of the
5532 list recursively.
5534 A list whose car is an integer is processed by processing the cadr of
5535 the list, and padding (if the number is positive) or truncating (if
5536 negative) to the width specified by that number.
5538 A string is printed verbatim in the mode line except for %-constructs:
5539 %b -- print buffer name. %f -- print visited file name.
5540 %F -- print frame name.
5541 %* -- print %, * or hyphen. %+ -- print *, % or hyphen.
5542 %& is like %*, but ignore read-only-ness.
5543 % means buffer is read-only and * means it is modified.
5544 For a modified read-only buffer, %* gives % and %+ gives *.
5545 %s -- print process status. %l -- print the current line number.
5546 %c -- print the current column number (this makes editing slower).
5547 Columns are numbered starting from the left margin, and the
5548 leftmost column is displayed as zero.
5549 To make the column number update correctly in all cases,
5550 `column-number-mode' must be non-nil.
5551 %C -- Like %c, but the leftmost column is displayed as one.
5552 %i -- print the size of the buffer.
5553 %I -- like %i, but use k, M, G, etc., to abbreviate.
5554 %p -- print percent of buffer above top of window, or Top, Bot or All.
5555 %P -- print percent of buffer above bottom of window, perhaps plus Top,
5556 or print Bottom or All.
5557 %n -- print Narrow if appropriate.
5558 %t -- visited file is text or binary (if OS supports this distinction).
5559 %z -- print mnemonics of keyboard, terminal, and buffer coding systems.
5560 %Z -- like %z, but including the end-of-line format.
5561 %e -- print error message about full memory.
5562 %@ -- print @ or hyphen. @ means that default-directory is on a
5563 remote machine.
5564 %[ -- print one [ for each recursive editing level. %] similar.
5565 %% -- print %. %- -- print infinitely many dashes.
5566 Decimal digits after the % specify field width to which to pad. */);
5568 DEFVAR_PER_BUFFER ("major-mode", &BVAR (current_buffer, major_mode),
5569 Qsymbolp,
5570 doc: /* Symbol for current buffer's major mode.
5571 The default value (normally `fundamental-mode') affects new buffers.
5572 A value of nil means to use the current buffer's major mode, provided
5573 it is not marked as "special". */);
5575 DEFVAR_PER_BUFFER ("mode-name", &BVAR (current_buffer, mode_name),
5576 Qnil,
5577 doc: /* Pretty name of current buffer's major mode.
5578 Usually a string, but can use any of the constructs for `mode-line-format',
5579 which see.
5580 Format with `format-mode-line' to produce a string value. */);
5582 DEFVAR_PER_BUFFER ("local-abbrev-table", &BVAR (current_buffer, abbrev_table), Qnil,
5583 doc: /* Local (mode-specific) abbrev table of current buffer. */);
5585 DEFVAR_PER_BUFFER ("abbrev-mode", &BVAR (current_buffer, abbrev_mode), Qnil,
5586 doc: /* Non-nil if Abbrev mode is enabled.
5587 Use the command `abbrev-mode' to change this variable. */);
5589 DEFVAR_PER_BUFFER ("case-fold-search", &BVAR (current_buffer, case_fold_search),
5590 Qnil,
5591 doc: /* Non-nil if searches and matches should ignore case. */);
5593 DEFVAR_PER_BUFFER ("fill-column", &BVAR (current_buffer, fill_column),
5594 Qintegerp,
5595 doc: /* Column beyond which automatic line-wrapping should happen.
5596 Interactively, you can set the buffer local value using \\[set-fill-column]. */);
5598 DEFVAR_PER_BUFFER ("left-margin", &BVAR (current_buffer, left_margin),
5599 Qintegerp,
5600 doc: /* Column for the default `indent-line-function' to indent to.
5601 Linefeed indents to this column in Fundamental mode. */);
5603 DEFVAR_PER_BUFFER ("tab-width", &BVAR (current_buffer, tab_width),
5604 Qintegerp,
5605 doc: /* Distance between tab stops (for display of tab characters), in columns.
5606 NOTE: This controls the display width of a TAB character, and not
5607 the size of an indentation step.
5608 This should be an integer greater than zero. */);
5610 DEFVAR_PER_BUFFER ("ctl-arrow", &BVAR (current_buffer, ctl_arrow), Qnil,
5611 doc: /* Non-nil means display control chars with uparrow.
5612 A value of nil means use backslash and octal digits.
5613 This variable does not apply to characters whose display is specified
5614 in the current display table (if there is one). */);
5616 DEFVAR_PER_BUFFER ("enable-multibyte-characters",
5617 &BVAR (current_buffer, enable_multibyte_characters),
5618 Qnil,
5619 doc: /* Non-nil means the buffer contents are regarded as multi-byte characters.
5620 Otherwise they are regarded as unibyte. This affects the display,
5621 file I/O and the behavior of various editing commands.
5623 This variable is buffer-local but you cannot set it directly;
5624 use the function `set-buffer-multibyte' to change a buffer's representation.
5625 To prevent any attempts to set it or make it buffer-local, Emacs will
5626 signal an error in those cases.
5627 See also Info node `(elisp)Text Representations'. */);
5628 make_symbol_constant (intern_c_string ("enable-multibyte-characters"));
5630 DEFVAR_PER_BUFFER ("buffer-file-coding-system",
5631 &BVAR (current_buffer, buffer_file_coding_system), Qnil,
5632 doc: /* Coding system to be used for encoding the buffer contents on saving.
5633 This variable applies to saving the buffer, and also to `write-region'
5634 and other functions that use `write-region'.
5635 It does not apply to sending output to subprocesses, however.
5637 If this is nil, the buffer is saved without any code conversion
5638 unless some coding system is specified in `file-coding-system-alist'
5639 for the buffer file.
5641 If the text to be saved cannot be encoded as specified by this variable,
5642 an alternative encoding is selected by `select-safe-coding-system', which see.
5644 The variable `coding-system-for-write', if non-nil, overrides this variable.
5646 This variable is never applied to a way of decoding a file while reading it. */);
5648 DEFVAR_PER_BUFFER ("bidi-display-reordering",
5649 &BVAR (current_buffer, bidi_display_reordering), Qnil,
5650 doc: /* Non-nil means reorder bidirectional text for display in the visual order. */);
5652 DEFVAR_PER_BUFFER ("bidi-paragraph-start-re",
5653 &BVAR (current_buffer, bidi_paragraph_start_re), Qnil,
5654 doc: /* If non-nil, a regexp matching a line that starts OR separates paragraphs.
5656 The value of nil means to use empty lines as lines that start and
5657 separate paragraphs.
5659 When Emacs displays bidirectional text, it by default computes
5660 the base paragraph direction separately for each paragraph.
5661 Setting this variable changes the places where paragraph base
5662 direction is recomputed.
5664 The regexp is always matched after a newline, so it is best to
5665 anchor it by beginning it with a "^".
5667 If you change the value of this variable, be sure to change
5668 the value of `bidi-paragraph-separate-re' accordingly. For
5669 example, to have a single newline behave as a paragraph separator,
5670 set both these variables to "^".
5672 See also `bidi-paragraph-direction'. */);
5674 DEFVAR_PER_BUFFER ("bidi-paragraph-separate-re",
5675 &BVAR (current_buffer, bidi_paragraph_separate_re), Qnil,
5676 doc: /* If non-nil, a regexp matching a line that separates paragraphs.
5678 The value of nil means to use empty lines as paragraph separators.
5680 When Emacs displays bidirectional text, it by default computes
5681 the base paragraph direction separately for each paragraph.
5682 Setting this variable changes the places where paragraph base
5683 direction is recomputed.
5685 The regexp is always matched after a newline, so it is best to
5686 anchor it by beginning it with a "^".
5688 If you change the value of this variable, be sure to change
5689 the value of `bidi-paragraph-start-re' accordingly. For
5690 example, to have a single newline behave as a paragraph separator,
5691 set both these variables to "^".
5693 See also `bidi-paragraph-direction'. */);
5695 DEFVAR_PER_BUFFER ("bidi-paragraph-direction",
5696 &BVAR (current_buffer, bidi_paragraph_direction), Qnil,
5697 doc: /* If non-nil, forces directionality of text paragraphs in the buffer.
5699 If this is nil (the default), the direction of each paragraph is
5700 determined by the first strong directional character of its text.
5701 The values of `right-to-left' and `left-to-right' override that.
5702 Any other value is treated as nil.
5704 This variable has no effect unless the buffer's value of
5705 `bidi-display-reordering' is non-nil. */);
5707 DEFVAR_PER_BUFFER ("truncate-lines", &BVAR (current_buffer, truncate_lines), Qnil,
5708 doc: /* Non-nil means do not display continuation lines.
5709 Instead, give each line of text just one screen line.
5711 Note that this is overridden by the variable
5712 `truncate-partial-width-windows' if that variable is non-nil
5713 and this buffer is not full-frame width.
5715 Minibuffers set this variable to nil. */);
5717 DEFVAR_PER_BUFFER ("word-wrap", &BVAR (current_buffer, word_wrap), Qnil,
5718 doc: /* Non-nil means to use word-wrapping for continuation lines.
5719 When word-wrapping is on, continuation lines are wrapped at the space
5720 or tab character nearest to the right window edge.
5721 If nil, continuation lines are wrapped at the right screen edge.
5723 This variable has no effect if long lines are truncated (see
5724 `truncate-lines' and `truncate-partial-width-windows'). If you use
5725 word-wrapping, you might want to reduce the value of
5726 `truncate-partial-width-windows', since wrapping can make text readable
5727 in narrower windows.
5729 Instead of setting this variable directly, most users should use
5730 Visual Line mode. Visual Line mode, when enabled, sets `word-wrap'
5731 to t, and additionally redefines simple editing commands to act on
5732 visual lines rather than logical lines. See the documentation of
5733 `visual-line-mode'. */);
5735 DEFVAR_PER_BUFFER ("default-directory", &BVAR (current_buffer, directory),
5736 Qstringp,
5737 doc: /* Name of default directory of current buffer.
5738 It should be a directory name (as opposed to a directory file-name).
5739 On GNU and Unix systems, directory names end in a slash `/'.
5740 To interactively change the default directory, use command `cd'. */);
5742 DEFVAR_PER_BUFFER ("auto-fill-function", &BVAR (current_buffer, auto_fill_function),
5743 Qnil,
5744 doc: /* Function called (if non-nil) to perform auto-fill.
5745 It is called after self-inserting any character specified in
5746 the `auto-fill-chars' table.
5747 NOTE: This variable is not a hook;
5748 its value may not be a list of functions. */);
5750 DEFVAR_PER_BUFFER ("buffer-file-name", &BVAR (current_buffer, filename),
5751 Qstringp,
5752 doc: /* Name of file visited in current buffer, or nil if not visiting a file.
5753 This should be an absolute file name. */);
5755 DEFVAR_PER_BUFFER ("buffer-file-truename", &BVAR (current_buffer, file_truename),
5756 Qstringp,
5757 doc: /* Abbreviated truename of file visited in current buffer, or nil if none.
5758 The truename of a file is calculated by `file-truename'
5759 and then abbreviated with `abbreviate-file-name'. */);
5761 DEFVAR_PER_BUFFER ("buffer-auto-save-file-name",
5762 &BVAR (current_buffer, auto_save_file_name),
5763 Qstringp,
5764 doc: /* Name of file for auto-saving current buffer.
5765 If it is nil, that means don't auto-save this buffer. */);
5767 DEFVAR_PER_BUFFER ("buffer-read-only", &BVAR (current_buffer, read_only), Qnil,
5768 doc: /* Non-nil if this buffer is read-only. */);
5770 DEFVAR_PER_BUFFER ("buffer-backed-up", &BVAR (current_buffer, backed_up), Qnil,
5771 doc: /* Non-nil if this buffer's file has been backed up.
5772 Backing up is done before the first time the file is saved. */);
5774 DEFVAR_PER_BUFFER ("buffer-saved-size", &BVAR (current_buffer, save_length),
5775 Qintegerp,
5776 doc: /* Length of current buffer when last read in, saved or auto-saved.
5777 0 initially.
5778 -1 means auto-saving turned off until next real save.
5780 If you set this to -2, that means don't turn off auto-saving in this buffer
5781 if its text size shrinks. If you use `buffer-swap-text' on a buffer,
5782 you probably should set this to -2 in that buffer. */);
5784 DEFVAR_PER_BUFFER ("selective-display", &BVAR (current_buffer, selective_display),
5785 Qnil,
5786 doc: /* Non-nil enables selective display.
5788 An integer N as value means display only lines
5789 that start with less than N columns of space.
5791 A value of t means that the character ^M makes itself and
5792 all the rest of the line invisible; also, when saving the buffer
5793 in a file, save the ^M as a newline. This usage is obsolete; use
5794 overlays or text properties instead. */);
5796 DEFVAR_PER_BUFFER ("selective-display-ellipses",
5797 &BVAR (current_buffer, selective_display_ellipses),
5798 Qnil,
5799 doc: /* Non-nil means display ... on previous line when a line is invisible. */);
5801 DEFVAR_PER_BUFFER ("overwrite-mode", &BVAR (current_buffer, overwrite_mode),
5802 Qoverwrite_mode,
5803 doc: /* Non-nil if self-insertion should replace existing text.
5804 The value should be one of `overwrite-mode-textual',
5805 `overwrite-mode-binary', or nil.
5806 If it is `overwrite-mode-textual', self-insertion still
5807 inserts at the end of a line, and inserts when point is before a tab,
5808 until the tab is filled in.
5809 If `overwrite-mode-binary', self-insertion replaces newlines and tabs too. */);
5811 DEFVAR_PER_BUFFER ("buffer-display-table", &BVAR (current_buffer, display_table),
5812 Qnil,
5813 doc: /* Display table that controls display of the contents of current buffer.
5815 If this variable is nil, the value of `standard-display-table' is used.
5816 Each window can have its own, overriding display table, see
5817 `set-window-display-table' and `window-display-table'.
5819 The display table is a char-table created with `make-display-table'.
5820 A char-table is an array indexed by character codes. Normal array
5821 primitives `aref' and `aset' can be used to access elements of a char-table.
5823 Each of the char-table elements control how to display the corresponding
5824 text character: the element at index C in the table says how to display
5825 the character whose code is C. Each element should be a vector of
5826 characters or nil. The value nil means display the character in the
5827 default fashion; otherwise, the characters from the vector are delivered
5828 to the screen instead of the original character.
5830 For example, (aset buffer-display-table ?X [?Y]) tells Emacs
5831 to display a capital Y instead of each X character.
5833 In addition, a char-table has six extra slots to control the display of:
5835 the end of a truncated screen line (extra-slot 0, a single character);
5836 the end of a continued line (extra-slot 1, a single character);
5837 the escape character used to display character codes in octal
5838 (extra-slot 2, a single character);
5839 the character used as an arrow for control characters (extra-slot 3,
5840 a single character);
5841 the decoration indicating the presence of invisible lines (extra-slot 4,
5842 a vector of characters);
5843 the character used to draw the border between side-by-side windows
5844 (extra-slot 5, a single character).
5846 See also the functions `display-table-slot' and `set-display-table-slot'. */);
5848 DEFVAR_PER_BUFFER ("left-margin-width", &BVAR (current_buffer, left_margin_cols),
5849 Qintegerp,
5850 doc: /* Width in columns of left marginal area for display of a buffer.
5851 A value of nil means no marginal area.
5853 Setting this variable does not take effect until a new buffer is displayed
5854 in a window. To make the change take effect, call `set-window-buffer'. */);
5856 DEFVAR_PER_BUFFER ("right-margin-width", &BVAR (current_buffer, right_margin_cols),
5857 Qintegerp,
5858 doc: /* Width in columns of right marginal area for display of a buffer.
5859 A value of nil means no marginal area.
5861 Setting this variable does not take effect until a new buffer is displayed
5862 in a window. To make the change take effect, call `set-window-buffer'. */);
5864 DEFVAR_PER_BUFFER ("left-fringe-width", &BVAR (current_buffer, left_fringe_width),
5865 Qintegerp,
5866 doc: /* Width of this buffer's left fringe (in pixels).
5867 A value of 0 means no left fringe is shown in this buffer's window.
5868 A value of nil means to use the left fringe width from the window's frame.
5870 Setting this variable does not take effect until a new buffer is displayed
5871 in a window. To make the change take effect, call `set-window-buffer'. */);
5873 DEFVAR_PER_BUFFER ("right-fringe-width", &BVAR (current_buffer, right_fringe_width),
5874 Qintegerp,
5875 doc: /* Width of this buffer's right fringe (in pixels).
5876 A value of 0 means no right fringe is shown in this buffer's window.
5877 A value of nil means to use the right fringe width from the window's frame.
5879 Setting this variable does not take effect until a new buffer is displayed
5880 in a window. To make the change take effect, call `set-window-buffer'. */);
5882 DEFVAR_PER_BUFFER ("fringes-outside-margins", &BVAR (current_buffer, fringes_outside_margins),
5883 Qnil,
5884 doc: /* Non-nil means to display fringes outside display margins.
5885 A value of nil means to display fringes between margins and buffer text.
5887 Setting this variable does not take effect until a new buffer is displayed
5888 in a window. To make the change take effect, call `set-window-buffer'. */);
5890 DEFVAR_PER_BUFFER ("scroll-bar-width", &BVAR (current_buffer, scroll_bar_width),
5891 Qintegerp,
5892 doc: /* Width of this buffer's vertical scroll bars in pixels.
5893 A value of nil means to use the scroll bar width from the window's frame. */);
5895 DEFVAR_PER_BUFFER ("scroll-bar-height", &BVAR (current_buffer, scroll_bar_height),
5896 Qintegerp,
5897 doc: /* Height of this buffer's horizontal scroll bars in pixels.
5898 A value of nil means to use the scroll bar height from the window's frame. */);
5900 DEFVAR_PER_BUFFER ("vertical-scroll-bar", &BVAR (current_buffer, vertical_scroll_bar_type),
5901 Qvertical_scroll_bar,
5902 doc: /* Position of this buffer's vertical scroll bar.
5903 The value takes effect whenever you tell a window to display this buffer;
5904 for instance, with `set-window-buffer' or when `display-buffer' displays it.
5906 A value of `left' or `right' means put the vertical scroll bar at that side
5907 of the window; a value of nil means don't show any vertical scroll bars.
5908 A value of t (the default) means do whatever the window's frame specifies. */);
5910 DEFVAR_PER_BUFFER ("horizontal-scroll-bar", &BVAR (current_buffer, horizontal_scroll_bar_type),
5911 Qnil,
5912 doc: /* Position of this buffer's horizontal scroll bar.
5913 The value takes effect whenever you tell a window to display this buffer;
5914 for instance, with `set-window-buffer' or when `display-buffer' displays it.
5916 A value of `bottom' means put the horizontal scroll bar at the bottom of
5917 the window; a value of nil means don't show any horizontal scroll bars.
5918 A value of t (the default) means do whatever the window's frame
5919 specifies. */);
5921 DEFVAR_PER_BUFFER ("indicate-empty-lines",
5922 &BVAR (current_buffer, indicate_empty_lines), Qnil,
5923 doc: /* Visually indicate empty lines after the buffer end.
5924 If non-nil, a bitmap is displayed in the left fringe of a window on
5925 window-systems. */);
5927 DEFVAR_PER_BUFFER ("indicate-buffer-boundaries",
5928 &BVAR (current_buffer, indicate_buffer_boundaries), Qnil,
5929 doc: /* Visually indicate buffer boundaries and scrolling.
5930 If non-nil, the first and last line of the buffer are marked in the fringe
5931 of a window on window-systems with angle bitmaps, or if the window can be
5932 scrolled, the top and bottom line of the window are marked with up and down
5933 arrow bitmaps.
5935 If value is a symbol `left' or `right', both angle and arrow bitmaps
5936 are displayed in the left or right fringe, resp. Any other value
5937 that doesn't look like an alist means display the angle bitmaps in
5938 the left fringe but no arrows.
5940 You can exercise more precise control by using an alist as the
5941 value. Each alist element (INDICATOR . POSITION) specifies
5942 where to show one of the indicators. INDICATOR is one of `top',
5943 `bottom', `up', `down', or t, which specifies the default position,
5944 and POSITION is one of `left', `right', or nil, meaning do not show
5945 this indicator.
5947 For example, ((top . left) (t . right)) places the top angle bitmap in
5948 left fringe, the bottom angle bitmap in right fringe, and both arrow
5949 bitmaps in right fringe. To show just the angle bitmaps in the left
5950 fringe, but no arrow bitmaps, use ((top . left) (bottom . left)). */);
5952 DEFVAR_PER_BUFFER ("fringe-indicator-alist",
5953 &BVAR (current_buffer, fringe_indicator_alist), Qnil,
5954 doc: /* Mapping from logical to physical fringe indicator bitmaps.
5955 The value is an alist where each element (INDICATOR . BITMAPS)
5956 specifies the fringe bitmaps used to display a specific logical
5957 fringe indicator.
5959 INDICATOR specifies the logical indicator type which is one of the
5960 following symbols: `truncation' , `continuation', `overlay-arrow',
5961 `top', `bottom', `top-bottom', `up', `down', empty-line', or `unknown'.
5963 BITMAPS is a list of symbols (LEFT RIGHT [LEFT1 RIGHT1]) which specifies
5964 the actual bitmap shown in the left or right fringe for the logical
5965 indicator. LEFT and RIGHT are the bitmaps shown in the left and/or
5966 right fringe for the specific indicator. The LEFT1 or RIGHT1 bitmaps
5967 are used only for the `bottom' and `top-bottom' indicators when the
5968 last (only) line has no final newline. BITMAPS may also be a single
5969 symbol which is used in both left and right fringes. */);
5971 DEFVAR_PER_BUFFER ("fringe-cursor-alist",
5972 &BVAR (current_buffer, fringe_cursor_alist), Qnil,
5973 doc: /* Mapping from logical to physical fringe cursor bitmaps.
5974 The value is an alist where each element (CURSOR . BITMAP)
5975 specifies the fringe bitmaps used to display a specific logical
5976 cursor type in the fringe.
5978 CURSOR specifies the logical cursor type which is one of the following
5979 symbols: `box' , `hollow', `bar', `hbar', or `hollow-small'. The last
5980 one is used to show a hollow cursor on narrow lines display lines
5981 where the normal hollow cursor will not fit.
5983 BITMAP is the corresponding fringe bitmap shown for the logical
5984 cursor type. */);
5986 DEFVAR_PER_BUFFER ("scroll-up-aggressively",
5987 &BVAR (current_buffer, scroll_up_aggressively), Qfraction,
5988 doc: /* How far to scroll windows upward.
5989 If you move point off the bottom, the window scrolls automatically.
5990 This variable controls how far it scrolls. The value nil, the default,
5991 means scroll to center point. A fraction means scroll to put point
5992 that fraction of the window's height from the bottom of the window.
5993 When the value is 0.0, point goes at the bottom line, which in the
5994 simple case that you moved off with C-f means scrolling just one line.
5995 1.0 means point goes at the top, so that in that simple case, the
5996 window scrolls by a full window height. Meaningful values are
5997 between 0.0 and 1.0, inclusive. */);
5999 DEFVAR_PER_BUFFER ("scroll-down-aggressively",
6000 &BVAR (current_buffer, scroll_down_aggressively), Qfraction,
6001 doc: /* How far to scroll windows downward.
6002 If you move point off the top, the window scrolls automatically.
6003 This variable controls how far it scrolls. The value nil, the default,
6004 means scroll to center point. A fraction means scroll to put point
6005 that fraction of the window's height from the top of the window.
6006 When the value is 0.0, point goes at the top line, which in the
6007 simple case that you moved off with C-b means scrolling just one line.
6008 1.0 means point goes at the bottom, so that in that simple case, the
6009 window scrolls by a full window height. Meaningful values are
6010 between 0.0 and 1.0, inclusive. */);
6012 DEFVAR_LISP ("before-change-functions", Vbefore_change_functions,
6013 doc: /* List of functions to call before each text change.
6014 Two arguments are passed to each function: the positions of
6015 the beginning and end of the range of old text to be changed.
6016 \(For an insertion, the beginning and end are at the same place.)
6017 No information is given about the length of the text after the change.
6019 Buffer changes made while executing the `before-change-functions'
6020 don't call any before-change or after-change functions.
6021 That's because `inhibit-modification-hooks' is temporarily set non-nil.
6023 If an unhandled error happens in running these functions,
6024 the variable's value remains nil. That prevents the error
6025 from happening repeatedly and making Emacs nonfunctional. */);
6026 Vbefore_change_functions = Qnil;
6028 DEFVAR_LISP ("after-change-functions", Vafter_change_functions,
6029 doc: /* List of functions to call after each text change.
6030 Three arguments are passed to each function: the positions of
6031 the beginning and end of the range of changed text,
6032 and the length in chars of the pre-change text replaced by that range.
6033 \(For an insertion, the pre-change length is zero;
6034 for a deletion, that length is the number of chars deleted,
6035 and the post-change beginning and end are at the same place.)
6037 Buffer changes made while executing the `after-change-functions'
6038 don't call any before-change or after-change functions.
6039 That's because `inhibit-modification-hooks' is temporarily set non-nil.
6041 If an unhandled error happens in running these functions,
6042 the variable's value remains nil. That prevents the error
6043 from happening repeatedly and making Emacs nonfunctional. */);
6044 Vafter_change_functions = Qnil;
6046 DEFVAR_LISP ("first-change-hook", Vfirst_change_hook,
6047 doc: /* A list of functions to call before changing a buffer which is unmodified.
6048 The functions are run using the `run-hooks' function. */);
6049 Vfirst_change_hook = Qnil;
6051 DEFVAR_PER_BUFFER ("buffer-undo-list", &BVAR (current_buffer, undo_list), Qnil,
6052 doc: /* List of undo entries in current buffer.
6053 Recent changes come first; older changes follow newer.
6055 An entry (BEG . END) represents an insertion which begins at
6056 position BEG and ends at position END.
6058 An entry (TEXT . POSITION) represents the deletion of the string TEXT
6059 from (abs POSITION). If POSITION is positive, point was at the front
6060 of the text being deleted; if negative, point was at the end.
6062 An entry (t HIGH LOW USEC PSEC) indicates that the buffer was previously
6063 unmodified; (HIGH LOW USEC PSEC) is in the same style as (current-time)
6064 and is the visited file's modification time, as of that time. If the
6065 modification time of the most recent save is different, this entry is
6066 obsolete.
6068 An entry (t . 0) means the buffer was previously unmodified but
6069 its time stamp was unknown because it was not associated with a file.
6070 An entry (t . -1) is similar, except that it means the buffer's visited
6071 file did not exist.
6073 An entry (nil PROPERTY VALUE BEG . END) indicates that a text property
6074 was modified between BEG and END. PROPERTY is the property name,
6075 and VALUE is the old value.
6077 An entry (apply FUN-NAME . ARGS) means undo the change with
6078 \(apply FUN-NAME ARGS).
6080 An entry (apply DELTA BEG END FUN-NAME . ARGS) supports selective undo
6081 in the active region. BEG and END is the range affected by this entry
6082 and DELTA is the number of characters added or deleted in that range by
6083 this change.
6085 An entry (MARKER . DISTANCE) indicates that the marker MARKER
6086 was adjusted in position by the offset DISTANCE (an integer).
6088 An entry of the form POSITION indicates that point was at the buffer
6089 location given by the integer. Undoing an entry of this form places
6090 point at POSITION.
6092 Entries with value nil mark undo boundaries. The undo command treats
6093 the changes between two undo boundaries as a single step to be undone.
6095 If the value of the variable is t, undo information is not recorded. */);
6097 DEFVAR_PER_BUFFER ("mark-active", &BVAR (current_buffer, mark_active), Qnil,
6098 doc: /* Non-nil means the mark and region are currently active in this buffer. */);
6100 DEFVAR_PER_BUFFER ("cache-long-scans", &BVAR (current_buffer, cache_long_scans), Qnil,
6101 doc: /* Non-nil means that Emacs should use caches in attempt to speedup buffer scans.
6103 There is no reason to set this to nil except for debugging purposes.
6105 Normally, the line-motion functions work by scanning the buffer for
6106 newlines. Columnar operations (like `move-to-column' and
6107 `compute-motion') also work by scanning the buffer, summing character
6108 widths as they go. This works well for ordinary text, but if the
6109 buffer's lines are very long (say, more than 500 characters), these
6110 motion functions will take longer to execute. Emacs may also take
6111 longer to update the display.
6113 If `cache-long-scans' is non-nil, these motion functions cache the
6114 results of their scans, and consult the cache to avoid rescanning
6115 regions of the buffer until the text is modified. The caches are most
6116 beneficial when they prevent the most searching---that is, when the
6117 buffer contains long lines and large regions of characters with the
6118 same, fixed screen width.
6120 When `cache-long-scans' is non-nil, processing short lines will
6121 become slightly slower (because of the overhead of consulting the
6122 cache), and the caches will use memory roughly proportional to the
6123 number of newlines and characters whose screen width varies.
6125 Bidirectional editing also requires buffer scans to find paragraph
6126 separators. If you have large paragraphs or no paragraph separators
6127 at all, these scans may be slow. If `cache-long-scans' is non-nil,
6128 results of these scans are cached. This doesn't help too much if
6129 paragraphs are of the reasonable (few thousands of characters) size.
6131 The caches require no explicit maintenance; their accuracy is
6132 maintained internally by the Emacs primitives. Enabling or disabling
6133 the cache should not affect the behavior of any of the motion
6134 functions; it should only affect their performance. */);
6136 DEFVAR_PER_BUFFER ("point-before-scroll", &BVAR (current_buffer, point_before_scroll), Qnil,
6137 doc: /* Value of point before the last series of scroll operations, or nil. */);
6139 DEFVAR_PER_BUFFER ("buffer-file-format", &BVAR (current_buffer, file_format), Qnil,
6140 doc: /* List of formats to use when saving this buffer.
6141 Formats are defined by `format-alist'. This variable is
6142 set when a file is visited. */);
6144 DEFVAR_PER_BUFFER ("buffer-auto-save-file-format",
6145 &BVAR (current_buffer, auto_save_file_format), Qnil,
6146 doc: /* Format in which to write auto-save files.
6147 Should be a list of symbols naming formats that are defined in `format-alist'.
6148 If it is t, which is the default, auto-save files are written in the
6149 same format as a regular save would use. */);
6151 DEFVAR_PER_BUFFER ("buffer-invisibility-spec",
6152 &BVAR (current_buffer, invisibility_spec), Qnil,
6153 doc: /* Invisibility spec of this buffer.
6154 The default is t, which means that text is invisible if it has a non-nil
6155 `invisible' property.
6156 This variable can also be a list. The list can have two kinds of elements:
6157 `ATOM' and `(ATOM . ELLIPSIS)'. A text character is invisible if its
6158 `invisible' property is `ATOM', or has an `invisible' property that is a list
6159 that contains `ATOM'.
6160 If the `(ATOM . ELLIPSIS)' form is used, and `ELLIPSIS' is non-nil, an
6161 ellipsis will be displayed after the invisible characters.
6162 Setting this variable is very fast, much faster than scanning all the text in
6163 the buffer looking for properties to change. */);
6165 DEFVAR_PER_BUFFER ("buffer-display-count",
6166 &BVAR (current_buffer, display_count), Qintegerp,
6167 doc: /* A number incremented each time this buffer is displayed in a window.
6168 The function `set-window-buffer' increments it. */);
6170 DEFVAR_PER_BUFFER ("buffer-display-time",
6171 &BVAR (current_buffer, display_time), Qnil,
6172 doc: /* Time stamp updated each time this buffer is displayed in a window.
6173 The function `set-window-buffer' updates this variable
6174 to the value obtained by calling `current-time'.
6175 If the buffer has never been shown in a window, the value is nil. */);
6177 DEFVAR_LISP ("transient-mark-mode", Vtransient_mark_mode,
6178 doc: /* Non-nil if Transient Mark mode is enabled.
6179 See the command `transient-mark-mode' for a description of this minor mode.
6181 Non-nil also enables highlighting of the region whenever the mark is active.
6182 The region is highlighted with the `region' face.
6183 The variable `highlight-nonselected-windows' controls whether to highlight
6184 all windows or just the selected window.
6186 Lisp programs may give this variable certain special values:
6188 - The symbol `lambda' enables Transient Mark mode temporarily.
6189 The mode is disabled again after any subsequent action that would
6190 normally deactivate the mark (e.g. buffer modification).
6192 - The pair (only . OLDVAL) enables Transient Mark mode
6193 temporarily. After any subsequent point motion command that is
6194 not shift-translated, or any other action that would normally
6195 deactivate the mark (e.g. buffer modification), the value of
6196 `transient-mark-mode' is set to OLDVAL. */);
6197 Vtransient_mark_mode = Qnil;
6199 DEFVAR_LISP ("inhibit-read-only", Vinhibit_read_only,
6200 doc: /* Non-nil means disregard read-only status of buffers or characters.
6201 If the value is t, disregard `buffer-read-only' and all `read-only'
6202 text properties. If the value is a list, disregard `buffer-read-only'
6203 and disregard a `read-only' text property if the property value
6204 is a member of the list. */);
6205 Vinhibit_read_only = Qnil;
6207 DEFVAR_PER_BUFFER ("cursor-type", &BVAR (current_buffer, cursor_type), Qnil,
6208 doc: /* Cursor to use when this buffer is in the selected window.
6209 Values are interpreted as follows:
6211 t use the cursor specified for the frame
6212 nil don't display a cursor
6213 box display a filled box cursor
6214 hollow display a hollow box cursor
6215 bar display a vertical bar cursor with default width
6216 (bar . WIDTH) display a vertical bar cursor with width WIDTH
6217 hbar display a horizontal bar cursor with default height
6218 (hbar . HEIGHT) display a horizontal bar cursor with height HEIGHT
6219 ANYTHING ELSE display a hollow box cursor
6221 WIDTH and HEIGHT can't exceed the frame's canonical character size.
6223 When the buffer is displayed in a non-selected window, the
6224 cursor's appearance is instead controlled by the variable
6225 `cursor-in-non-selected-windows'. */);
6227 DEFVAR_PER_BUFFER ("line-spacing",
6228 &BVAR (current_buffer, extra_line_spacing), Qnumberp,
6229 doc: /* Additional space to put between lines when displaying a buffer.
6230 The space is measured in pixels, and put below lines on graphic displays,
6231 see `display-graphic-p'.
6232 If value is a floating point number, it specifies the spacing relative
6233 to the default frame line height. A value of nil means add no extra space. */);
6235 DEFVAR_PER_BUFFER ("cursor-in-non-selected-windows",
6236 &BVAR (current_buffer, cursor_in_non_selected_windows), Qnil,
6237 doc: /* Non-nil means show a cursor in non-selected windows.
6238 If nil, only shows a cursor in the selected window.
6239 If t, displays a cursor related to the usual cursor type
6240 \(a solid box becomes hollow, a bar becomes a narrower bar).
6241 You can also specify the cursor type as in the `cursor-type' variable.
6242 Use Custom to set this variable and update the display. */);
6244 DEFVAR_LISP ("kill-buffer-query-functions", Vkill_buffer_query_functions,
6245 doc: /* List of functions called with no args to query before killing a buffer.
6246 The buffer being killed will be current while the functions are running.
6248 If any of them returns nil, the buffer is not killed. Functions run by
6249 this hook are supposed to not change the current buffer. */);
6250 Vkill_buffer_query_functions = Qnil;
6252 DEFVAR_LISP ("change-major-mode-hook", Vchange_major_mode_hook,
6253 doc: /* Normal hook run before changing the major mode of a buffer.
6254 The function `kill-all-local-variables' runs this before doing anything else. */);
6255 Vchange_major_mode_hook = Qnil;
6256 DEFSYM (Qchange_major_mode_hook, "change-major-mode-hook");
6258 DEFVAR_LISP ("buffer-list-update-hook", Vbuffer_list_update_hook,
6259 doc: /* Hook run when the buffer list changes.
6260 Functions running this hook are, `get-buffer-create',
6261 `make-indirect-buffer', `rename-buffer', `kill-buffer',
6262 `bury-buffer-internal' and `select-window'. */);
6263 Vbuffer_list_update_hook = Qnil;
6264 DEFSYM (Qbuffer_list_update_hook, "buffer-list-update-hook");
6266 defsubr (&Sbuffer_live_p);
6267 defsubr (&Sbuffer_list);
6268 defsubr (&Sget_buffer);
6269 defsubr (&Sget_file_buffer);
6270 defsubr (&Sget_buffer_create);
6271 defsubr (&Smake_indirect_buffer);
6272 defsubr (&Sgenerate_new_buffer_name);
6273 defsubr (&Sbuffer_name);
6274 defsubr (&Sbuffer_file_name);
6275 defsubr (&Sbuffer_base_buffer);
6276 defsubr (&Sbuffer_local_value);
6277 defsubr (&Sbuffer_local_variables);
6278 defsubr (&Sbuffer_modified_p);
6279 defsubr (&Sforce_mode_line_update);
6280 defsubr (&Sset_buffer_modified_p);
6281 defsubr (&Sbuffer_modified_tick);
6282 defsubr (&Sbuffer_chars_modified_tick);
6283 defsubr (&Srename_buffer);
6284 defsubr (&Sother_buffer);
6285 defsubr (&Sbuffer_enable_undo);
6286 defsubr (&Skill_buffer);
6287 defsubr (&Sbury_buffer_internal);
6288 defsubr (&Sset_buffer_major_mode);
6289 defsubr (&Scurrent_buffer);
6290 defsubr (&Sset_buffer);
6291 defsubr (&Sbarf_if_buffer_read_only);
6292 defsubr (&Serase_buffer);
6293 defsubr (&Sbuffer_swap_text);
6294 defsubr (&Sset_buffer_multibyte);
6295 defsubr (&Skill_all_local_variables);
6297 defsubr (&Soverlayp);
6298 defsubr (&Smake_overlay);
6299 defsubr (&Sdelete_overlay);
6300 defsubr (&Sdelete_all_overlays);
6301 defsubr (&Smove_overlay);
6302 defsubr (&Soverlay_start);
6303 defsubr (&Soverlay_end);
6304 defsubr (&Soverlay_buffer);
6305 defsubr (&Soverlay_properties);
6306 defsubr (&Soverlays_at);
6307 defsubr (&Soverlays_in);
6308 defsubr (&Snext_overlay_change);
6309 defsubr (&Sprevious_overlay_change);
6310 defsubr (&Soverlay_recenter);
6311 defsubr (&Soverlay_lists);
6312 defsubr (&Soverlay_get);
6313 defsubr (&Soverlay_put);
6314 defsubr (&Srestore_buffer_modified_p);
6316 Fput (intern_c_string ("erase-buffer"), Qdisabled, Qt);
6319 void
6320 keys_of_buffer (void)
6322 initial_define_key (control_x_map, 'b', "switch-to-buffer");
6323 initial_define_key (control_x_map, 'k', "kill-buffer");