Avoid infloop in python
[emacs.git] / src / buffer.c
blob89f4479740adcbc9e3240a5c104524fadcfdb0cb
1 /* Buffer manipulation primitives for GNU Emacs.
3 Copyright (C) 1985-1989, 1993-1995, 1997-2016 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 <http://www.gnu.org/licenses/>. */
21 #include <config.h>
23 #include <sys/types.h>
24 #include <sys/stat.h>
25 #include <sys/param.h>
26 #include <errno.h>
27 #include <stdio.h>
28 #include <unistd.h>
30 #include <verify.h>
32 #include "lisp.h"
33 #include "coding.h"
34 #include "intervals.h"
35 #include "systime.h"
36 #include "window.h"
37 #include "commands.h"
38 #include "character.h"
39 #include "buffer.h"
40 #include "region-cache.h"
41 #include "indent.h"
42 #include "blockinput.h"
43 #include "keymap.h"
44 #include "frame.h"
45 #include "xwidget.h"
47 #ifdef WINDOWSNT
48 #include "w32heap.h" /* for mmap_* */
49 #endif
51 struct buffer *current_buffer; /* The current buffer. */
53 /* First buffer in chain of all buffers (in reverse order of creation).
54 Threaded through ->header.next.buffer. */
56 struct buffer *all_buffers;
58 /* This structure holds the default values of the buffer-local variables
59 defined with DEFVAR_PER_BUFFER, that have special slots in each buffer.
60 The default value occupies the same slot in this structure
61 as an individual buffer's value occupies in that buffer.
62 Setting the default value also goes through the alist of buffers
63 and stores into each buffer that does not say it has a local value. */
65 struct buffer alignas (GCALIGNMENT) buffer_defaults;
67 /* This structure marks which slots in a buffer have corresponding
68 default values in buffer_defaults.
69 Each such slot has a nonzero value in this structure.
70 The value has only one nonzero bit.
72 When a buffer has its own local value for a slot,
73 the entry for that slot (found in the same slot in this structure)
74 is turned on in the buffer's local_flags array.
76 If a slot in this structure is -1, then even though there may
77 be a DEFVAR_PER_BUFFER for the slot, there is no default value for it;
78 and the corresponding slot in buffer_defaults is not used.
80 If a slot in this structure corresponding to a DEFVAR_PER_BUFFER is
81 zero, that is a bug. */
83 struct buffer buffer_local_flags;
85 /* This structure holds the names of symbols whose values may be
86 buffer-local. It is indexed and accessed in the same way as the above. */
88 struct buffer alignas (GCALIGNMENT) buffer_local_symbols;
90 /* Return the symbol of the per-buffer variable at offset OFFSET in
91 the buffer structure. */
93 #define PER_BUFFER_SYMBOL(OFFSET) \
94 (*(Lisp_Object *)((OFFSET) + (char *) &buffer_local_symbols))
96 /* Maximum length of an overlay vector. */
97 #define OVERLAY_COUNT_MAX \
98 ((ptrdiff_t) min (MOST_POSITIVE_FIXNUM, \
99 min (PTRDIFF_MAX, SIZE_MAX) / word_size))
101 /* Flags indicating which built-in buffer-local variables
102 are permanent locals. */
103 static char buffer_permanent_local_flags[MAX_PER_BUFFER_VARS];
105 /* Number of per-buffer variables used. */
107 int last_per_buffer_idx;
109 static void call_overlay_mod_hooks (Lisp_Object list, Lisp_Object overlay,
110 bool after, Lisp_Object arg1,
111 Lisp_Object arg2, Lisp_Object arg3);
112 static void swap_out_buffer_local_variables (struct buffer *b);
113 static void reset_buffer_local_variables (struct buffer *, bool);
115 /* Alist of all buffer names vs the buffers. This used to be
116 a Lisp-visible variable, but is no longer, to prevent lossage
117 due to user rplac'ing this alist or its elements. */
118 Lisp_Object Vbuffer_alist;
120 static Lisp_Object QSFundamental; /* A string "Fundamental". */
122 static void alloc_buffer_text (struct buffer *, ptrdiff_t);
123 static void free_buffer_text (struct buffer *b);
124 static struct Lisp_Overlay * copy_overlays (struct buffer *, struct Lisp_Overlay *);
125 static void modify_overlay (struct buffer *, ptrdiff_t, ptrdiff_t);
126 static Lisp_Object buffer_lisp_local_variables (struct buffer *, bool);
128 static void
129 CHECK_OVERLAY (Lisp_Object x)
131 CHECK_TYPE (OVERLAYP (x), Qoverlayp, x);
134 /* These setters are used only in this file, so they can be private.
135 The public setters are inline functions defined in buffer.h. */
136 static void
137 bset_abbrev_mode (struct buffer *b, Lisp_Object val)
139 b->abbrev_mode_ = val;
141 static void
142 bset_abbrev_table (struct buffer *b, Lisp_Object val)
144 b->abbrev_table_ = val;
146 static void
147 bset_auto_fill_function (struct buffer *b, Lisp_Object val)
149 b->auto_fill_function_ = val;
151 static void
152 bset_auto_save_file_format (struct buffer *b, Lisp_Object val)
154 b->auto_save_file_format_ = val;
156 static void
157 bset_auto_save_file_name (struct buffer *b, Lisp_Object val)
159 b->auto_save_file_name_ = val;
161 static void
162 bset_backed_up (struct buffer *b, Lisp_Object val)
164 b->backed_up_ = val;
166 static void
167 bset_begv_marker (struct buffer *b, Lisp_Object val)
169 b->begv_marker_ = val;
171 static void
172 bset_bidi_display_reordering (struct buffer *b, Lisp_Object val)
174 b->bidi_display_reordering_ = val;
176 static void
177 bset_buffer_file_coding_system (struct buffer *b, Lisp_Object val)
179 b->buffer_file_coding_system_ = val;
181 static void
182 bset_case_fold_search (struct buffer *b, Lisp_Object val)
184 b->case_fold_search_ = val;
186 static void
187 bset_ctl_arrow (struct buffer *b, Lisp_Object val)
189 b->ctl_arrow_ = val;
191 static void
192 bset_cursor_in_non_selected_windows (struct buffer *b, Lisp_Object val)
194 b->cursor_in_non_selected_windows_ = val;
196 static void
197 bset_cursor_type (struct buffer *b, Lisp_Object val)
199 b->cursor_type_ = val;
201 static void
202 bset_display_table (struct buffer *b, Lisp_Object val)
204 b->display_table_ = val;
206 static void
207 bset_extra_line_spacing (struct buffer *b, Lisp_Object val)
209 b->extra_line_spacing_ = val;
211 static void
212 bset_file_format (struct buffer *b, Lisp_Object val)
214 b->file_format_ = val;
216 static void
217 bset_file_truename (struct buffer *b, Lisp_Object val)
219 b->file_truename_ = val;
221 static void
222 bset_fringe_cursor_alist (struct buffer *b, Lisp_Object val)
224 b->fringe_cursor_alist_ = val;
226 static void
227 bset_fringe_indicator_alist (struct buffer *b, Lisp_Object val)
229 b->fringe_indicator_alist_ = val;
231 static void
232 bset_fringes_outside_margins (struct buffer *b, Lisp_Object val)
234 b->fringes_outside_margins_ = val;
236 static void
237 bset_header_line_format (struct buffer *b, Lisp_Object val)
239 b->header_line_format_ = val;
241 static void
242 bset_indicate_buffer_boundaries (struct buffer *b, Lisp_Object val)
244 b->indicate_buffer_boundaries_ = val;
246 static void
247 bset_indicate_empty_lines (struct buffer *b, Lisp_Object val)
249 b->indicate_empty_lines_ = val;
251 static void
252 bset_invisibility_spec (struct buffer *b, Lisp_Object val)
254 b->invisibility_spec_ = val;
256 static void
257 bset_left_fringe_width (struct buffer *b, Lisp_Object val)
259 b->left_fringe_width_ = val;
261 static void
262 bset_major_mode (struct buffer *b, Lisp_Object val)
264 b->major_mode_ = val;
266 static void
267 bset_mark (struct buffer *b, Lisp_Object val)
269 b->mark_ = val;
271 static void
272 bset_minor_modes (struct buffer *b, Lisp_Object val)
274 b->minor_modes_ = val;
276 static void
277 bset_mode_line_format (struct buffer *b, Lisp_Object val)
279 b->mode_line_format_ = val;
281 static void
282 bset_mode_name (struct buffer *b, Lisp_Object val)
284 b->mode_name_ = val;
286 static void
287 bset_name (struct buffer *b, Lisp_Object val)
289 b->name_ = val;
291 static void
292 bset_overwrite_mode (struct buffer *b, Lisp_Object val)
294 b->overwrite_mode_ = val;
296 static void
297 bset_pt_marker (struct buffer *b, Lisp_Object val)
299 b->pt_marker_ = val;
301 static void
302 bset_right_fringe_width (struct buffer *b, Lisp_Object val)
304 b->right_fringe_width_ = val;
306 static void
307 bset_save_length (struct buffer *b, Lisp_Object val)
309 b->save_length_ = val;
311 static void
312 bset_scroll_bar_width (struct buffer *b, Lisp_Object val)
314 b->scroll_bar_width_ = val;
316 static void
317 bset_scroll_bar_height (struct buffer *b, Lisp_Object val)
319 b->scroll_bar_height_ = val;
321 static void
322 bset_scroll_down_aggressively (struct buffer *b, Lisp_Object val)
324 b->scroll_down_aggressively_ = val;
326 static void
327 bset_scroll_up_aggressively (struct buffer *b, Lisp_Object val)
329 b->scroll_up_aggressively_ = val;
331 static void
332 bset_selective_display (struct buffer *b, Lisp_Object val)
334 b->selective_display_ = val;
336 static void
337 bset_selective_display_ellipses (struct buffer *b, Lisp_Object val)
339 b->selective_display_ellipses_ = val;
341 static void
342 bset_vertical_scroll_bar_type (struct buffer *b, Lisp_Object val)
344 b->vertical_scroll_bar_type_ = val;
346 static void
347 bset_horizontal_scroll_bar_type (struct buffer *b, Lisp_Object val)
349 b->horizontal_scroll_bar_type_ = val;
351 static void
352 bset_word_wrap (struct buffer *b, Lisp_Object val)
354 b->word_wrap_ = val;
356 static void
357 bset_zv_marker (struct buffer *b, Lisp_Object val)
359 b->zv_marker_ = val;
362 void
363 nsberror (Lisp_Object spec)
365 if (STRINGP (spec))
366 error ("No buffer named %s", SDATA (spec));
367 error ("Invalid buffer argument");
370 DEFUN ("buffer-live-p", Fbuffer_live_p, Sbuffer_live_p, 1, 1, 0,
371 doc: /* Return non-nil if OBJECT is a buffer which has not been killed.
372 Value is nil if OBJECT is not a buffer or if it has been killed. */)
373 (Lisp_Object object)
375 return ((BUFFERP (object) && BUFFER_LIVE_P (XBUFFER (object)))
376 ? Qt : Qnil);
379 DEFUN ("buffer-list", Fbuffer_list, Sbuffer_list, 0, 1, 0,
380 doc: /* Return a list of all existing live buffers.
381 If the optional arg FRAME is a frame, we return the buffer list in the
382 proper order for that frame: the buffers show in FRAME come first,
383 followed by the rest of the buffers. */)
384 (Lisp_Object frame)
386 Lisp_Object general;
387 general = Fmapcar (Qcdr, Vbuffer_alist);
389 if (FRAMEP (frame))
391 Lisp_Object framelist, prevlist, tail;
393 framelist = Fcopy_sequence (XFRAME (frame)->buffer_list);
394 prevlist = Fnreverse (Fcopy_sequence
395 (XFRAME (frame)->buried_buffer_list));
397 /* Remove from GENERAL any buffer that duplicates one in
398 FRAMELIST or PREVLIST. */
399 tail = framelist;
400 while (CONSP (tail))
402 general = Fdelq (XCAR (tail), general);
403 tail = XCDR (tail);
405 tail = prevlist;
406 while (CONSP (tail))
408 general = Fdelq (XCAR (tail), general);
409 tail = XCDR (tail);
412 return CALLN (Fnconc, framelist, general, prevlist);
414 else
415 return general;
418 /* Like Fassoc, but use Fstring_equal to compare
419 (which ignores text properties),
420 and don't ever QUIT. */
422 static Lisp_Object
423 assoc_ignore_text_properties (register Lisp_Object key, Lisp_Object list)
425 register Lisp_Object tail;
426 for (tail = list; CONSP (tail); tail = XCDR (tail))
428 register Lisp_Object elt, tem;
429 elt = XCAR (tail);
430 tem = Fstring_equal (Fcar (elt), key);
431 if (!NILP (tem))
432 return elt;
434 return Qnil;
437 DEFUN ("get-buffer", Fget_buffer, Sget_buffer, 1, 1, 0,
438 doc: /* Return the buffer named BUFFER-OR-NAME.
439 BUFFER-OR-NAME must be either a string or a buffer. If BUFFER-OR-NAME
440 is a string and there is no buffer with that name, return nil. If
441 BUFFER-OR-NAME is a buffer, return it as given. */)
442 (register Lisp_Object buffer_or_name)
444 if (BUFFERP (buffer_or_name))
445 return buffer_or_name;
446 CHECK_STRING (buffer_or_name);
448 return Fcdr (assoc_ignore_text_properties (buffer_or_name, Vbuffer_alist));
451 DEFUN ("get-file-buffer", Fget_file_buffer, Sget_file_buffer, 1, 1, 0,
452 doc: /* Return the buffer visiting file FILENAME (a string).
453 The buffer's `buffer-file-name' must match exactly the expansion of FILENAME.
454 If there is no such live buffer, return nil.
455 See also `find-buffer-visiting'. */)
456 (register Lisp_Object filename)
458 register Lisp_Object tail, buf, handler;
460 CHECK_STRING (filename);
461 filename = Fexpand_file_name (filename, Qnil);
463 /* If the file name has special constructs in it,
464 call the corresponding file handler. */
465 handler = Ffind_file_name_handler (filename, Qget_file_buffer);
466 if (!NILP (handler))
468 Lisp_Object handled_buf = call2 (handler, Qget_file_buffer,
469 filename);
470 return BUFFERP (handled_buf) ? handled_buf : Qnil;
473 FOR_EACH_LIVE_BUFFER (tail, buf)
475 if (!STRINGP (BVAR (XBUFFER (buf), filename))) continue;
476 if (!NILP (Fstring_equal (BVAR (XBUFFER (buf), filename), filename)))
477 return buf;
479 return Qnil;
482 Lisp_Object
483 get_truename_buffer (register Lisp_Object filename)
485 register Lisp_Object tail, buf;
487 FOR_EACH_LIVE_BUFFER (tail, buf)
489 if (!STRINGP (BVAR (XBUFFER (buf), file_truename))) continue;
490 if (!NILP (Fstring_equal (BVAR (XBUFFER (buf), file_truename), filename)))
491 return buf;
493 return Qnil;
496 DEFUN ("get-buffer-create", Fget_buffer_create, Sget_buffer_create, 1, 1, 0,
497 doc: /* Return the buffer specified by BUFFER-OR-NAME, creating a new one if needed.
498 If BUFFER-OR-NAME is a string and a live buffer with that name exists,
499 return that buffer. If no such buffer exists, create a new buffer with
500 that name and return it. If BUFFER-OR-NAME starts with a space, the new
501 buffer does not keep undo information.
503 If BUFFER-OR-NAME is a buffer instead of a string, return it as given,
504 even if it is dead. The return value is never nil. */)
505 (register Lisp_Object buffer_or_name)
507 register Lisp_Object buffer, name;
508 register struct buffer *b;
510 buffer = Fget_buffer (buffer_or_name);
511 if (!NILP (buffer))
512 return buffer;
514 if (SCHARS (buffer_or_name) == 0)
515 error ("Empty string for buffer name is not allowed");
517 b = allocate_buffer ();
519 /* An ordinary buffer uses its own struct buffer_text. */
520 b->text = &b->own_text;
521 b->base_buffer = NULL;
522 /* No one shares the text with us now. */
523 b->indirections = 0;
524 /* No one shows us now. */
525 b->window_count = 0;
527 BUF_GAP_SIZE (b) = 20;
528 block_input ();
529 /* We allocate extra 1-byte at the tail and keep it always '\0' for
530 anchoring a search. */
531 alloc_buffer_text (b, BUF_GAP_SIZE (b) + 1);
532 unblock_input ();
533 if (! BUF_BEG_ADDR (b))
534 buffer_memory_full (BUF_GAP_SIZE (b) + 1);
536 b->pt = BEG;
537 b->begv = BEG;
538 b->zv = BEG;
539 b->pt_byte = BEG_BYTE;
540 b->begv_byte = BEG_BYTE;
541 b->zv_byte = BEG_BYTE;
543 BUF_GPT (b) = BEG;
544 BUF_GPT_BYTE (b) = BEG_BYTE;
546 BUF_Z (b) = BEG;
547 BUF_Z_BYTE (b) = BEG_BYTE;
548 BUF_MODIFF (b) = 1;
549 BUF_CHARS_MODIFF (b) = 1;
550 BUF_OVERLAY_MODIFF (b) = 1;
551 BUF_SAVE_MODIFF (b) = 1;
552 BUF_COMPACT (b) = 1;
553 set_buffer_intervals (b, NULL);
554 BUF_UNCHANGED_MODIFIED (b) = 1;
555 BUF_OVERLAY_UNCHANGED_MODIFIED (b) = 1;
556 BUF_END_UNCHANGED (b) = 0;
557 BUF_BEG_UNCHANGED (b) = 0;
558 *(BUF_GPT_ADDR (b)) = *(BUF_Z_ADDR (b)) = 0; /* Put an anchor '\0'. */
559 b->text->inhibit_shrinking = false;
560 b->text->redisplay = false;
562 b->newline_cache = 0;
563 b->width_run_cache = 0;
564 b->bidi_paragraph_cache = 0;
565 bset_width_table (b, Qnil);
566 b->prevent_redisplay_optimizations_p = 1;
568 /* An ordinary buffer normally doesn't need markers
569 to handle BEGV and ZV. */
570 bset_pt_marker (b, Qnil);
571 bset_begv_marker (b, Qnil);
572 bset_zv_marker (b, Qnil);
574 name = Fcopy_sequence (buffer_or_name);
575 set_string_intervals (name, NULL);
576 bset_name (b, name);
578 bset_undo_list (b, SREF (name, 0) != ' ' ? Qnil : Qt);
580 reset_buffer (b);
581 reset_buffer_local_variables (b, 1);
583 bset_mark (b, Fmake_marker ());
584 BUF_MARKERS (b) = NULL;
586 /* Put this in the alist of all live buffers. */
587 XSETBUFFER (buffer, b);
588 Vbuffer_alist = nconc2 (Vbuffer_alist, list1 (Fcons (name, buffer)));
589 /* And run buffer-list-update-hook. */
590 if (!NILP (Vrun_hooks))
591 call1 (Vrun_hooks, Qbuffer_list_update_hook);
593 return buffer;
597 /* Return a list of overlays which is a copy of the overlay list
598 LIST, but for buffer B. */
600 static struct Lisp_Overlay *
601 copy_overlays (struct buffer *b, struct Lisp_Overlay *list)
603 struct Lisp_Overlay *result = NULL, *tail = NULL;
605 for (; list; list = list->next)
607 Lisp_Object overlay, start, end;
608 struct Lisp_Marker *m;
610 eassert (MARKERP (list->start));
611 m = XMARKER (list->start);
612 start = build_marker (b, m->charpos, m->bytepos);
613 XMARKER (start)->insertion_type = m->insertion_type;
615 eassert (MARKERP (list->end));
616 m = XMARKER (list->end);
617 end = build_marker (b, m->charpos, m->bytepos);
618 XMARKER (end)->insertion_type = m->insertion_type;
620 overlay = build_overlay (start, end, Fcopy_sequence (list->plist));
621 if (tail)
622 tail = tail->next = XOVERLAY (overlay);
623 else
624 result = tail = XOVERLAY (overlay);
627 return result;
630 /* Set an appropriate overlay of B. */
632 static void
633 set_buffer_overlays_before (struct buffer *b, struct Lisp_Overlay *o)
635 b->overlays_before = o;
638 static void
639 set_buffer_overlays_after (struct buffer *b, struct Lisp_Overlay *o)
641 b->overlays_after = o;
644 /* Clone per-buffer values of buffer FROM.
646 Buffer TO gets the same per-buffer values as FROM, with the
647 following exceptions: (1) TO's name is left untouched, (2) markers
648 are copied and made to refer to TO, and (3) overlay lists are
649 copied. */
651 static void
652 clone_per_buffer_values (struct buffer *from, struct buffer *to)
654 int offset;
656 FOR_EACH_PER_BUFFER_OBJECT_AT (offset)
658 Lisp_Object obj;
660 /* Don't touch the `name' which should be unique for every buffer. */
661 if (offset == PER_BUFFER_VAR_OFFSET (name))
662 continue;
664 obj = per_buffer_value (from, offset);
665 if (MARKERP (obj) && XMARKER (obj)->buffer == from)
667 struct Lisp_Marker *m = XMARKER (obj);
669 obj = build_marker (to, m->charpos, m->bytepos);
670 XMARKER (obj)->insertion_type = m->insertion_type;
673 set_per_buffer_value (to, offset, obj);
676 memcpy (to->local_flags, from->local_flags, sizeof to->local_flags);
678 set_buffer_overlays_before (to, copy_overlays (to, from->overlays_before));
679 set_buffer_overlays_after (to, copy_overlays (to, from->overlays_after));
681 /* Get (a copy of) the alist of Lisp-level local variables of FROM
682 and install that in TO. */
683 bset_local_var_alist (to, buffer_lisp_local_variables (from, 1));
687 /* If buffer B has markers to record PT, BEGV and ZV when it is not
688 current, update these markers. */
690 static void
691 record_buffer_markers (struct buffer *b)
693 if (! NILP (BVAR (b, pt_marker)))
695 Lisp_Object buffer;
697 eassert (!NILP (BVAR (b, begv_marker)));
698 eassert (!NILP (BVAR (b, zv_marker)));
700 XSETBUFFER (buffer, b);
701 set_marker_both (BVAR (b, pt_marker), buffer, b->pt, b->pt_byte);
702 set_marker_both (BVAR (b, begv_marker), buffer, b->begv, b->begv_byte);
703 set_marker_both (BVAR (b, zv_marker), buffer, b->zv, b->zv_byte);
708 /* If buffer B has markers to record PT, BEGV and ZV when it is not
709 current, fetch these values into B->begv etc. */
711 static void
712 fetch_buffer_markers (struct buffer *b)
714 if (! NILP (BVAR (b, pt_marker)))
716 Lisp_Object m;
718 eassert (!NILP (BVAR (b, begv_marker)));
719 eassert (!NILP (BVAR (b, zv_marker)));
721 m = BVAR (b, pt_marker);
722 SET_BUF_PT_BOTH (b, marker_position (m), marker_byte_position (m));
724 m = BVAR (b, begv_marker);
725 SET_BUF_BEGV_BOTH (b, marker_position (m), marker_byte_position (m));
727 m = BVAR (b, zv_marker);
728 SET_BUF_ZV_BOTH (b, marker_position (m), marker_byte_position (m));
733 DEFUN ("make-indirect-buffer", Fmake_indirect_buffer, Smake_indirect_buffer,
734 2, 3,
735 "bMake indirect buffer (to buffer): \nBName of indirect buffer: ",
736 doc: /* Create and return an indirect buffer for buffer BASE-BUFFER, named NAME.
737 BASE-BUFFER should be a live buffer, or the name of an existing buffer.
738 NAME should be a string which is not the name of an existing buffer.
739 Optional argument CLONE non-nil means preserve BASE-BUFFER's state,
740 such as major and minor modes, in the indirect buffer.
741 CLONE nil means the indirect buffer's state is reset to default values. */)
742 (Lisp_Object base_buffer, Lisp_Object name, Lisp_Object clone)
744 Lisp_Object buf, tem;
745 struct buffer *b;
747 CHECK_STRING (name);
748 buf = Fget_buffer (name);
749 if (!NILP (buf))
750 error ("Buffer name `%s' is in use", SDATA (name));
752 tem = base_buffer;
753 base_buffer = Fget_buffer (base_buffer);
754 if (NILP (base_buffer))
755 error ("No such buffer: `%s'", SDATA (tem));
756 if (!BUFFER_LIVE_P (XBUFFER (base_buffer)))
757 error ("Base buffer has been killed");
759 if (SCHARS (name) == 0)
760 error ("Empty string for buffer name is not allowed");
762 b = allocate_buffer ();
764 /* No double indirection - if base buffer is indirect,
765 new buffer becomes an indirect to base's base. */
766 b->base_buffer = (XBUFFER (base_buffer)->base_buffer
767 ? XBUFFER (base_buffer)->base_buffer
768 : XBUFFER (base_buffer));
770 /* Use the base buffer's text object. */
771 b->text = b->base_buffer->text;
772 /* We have no own text. */
773 b->indirections = -1;
774 /* Notify base buffer that we share the text now. */
775 b->base_buffer->indirections++;
776 /* Always -1 for an indirect buffer. */
777 b->window_count = -1;
779 b->pt = b->base_buffer->pt;
780 b->begv = b->base_buffer->begv;
781 b->zv = b->base_buffer->zv;
782 b->pt_byte = b->base_buffer->pt_byte;
783 b->begv_byte = b->base_buffer->begv_byte;
784 b->zv_byte = b->base_buffer->zv_byte;
786 b->newline_cache = 0;
787 b->width_run_cache = 0;
788 b->bidi_paragraph_cache = 0;
789 bset_width_table (b, Qnil);
791 name = Fcopy_sequence (name);
792 set_string_intervals (name, NULL);
793 bset_name (b, name);
795 /* An indirect buffer shares undo list of its base (Bug#18180). */
796 bset_undo_list (b, BVAR (b->base_buffer, undo_list));
798 reset_buffer (b);
799 reset_buffer_local_variables (b, 1);
801 /* Put this in the alist of all live buffers. */
802 XSETBUFFER (buf, b);
803 Vbuffer_alist = nconc2 (Vbuffer_alist, list1 (Fcons (name, buf)));
805 bset_mark (b, Fmake_marker ());
807 /* The multibyte status belongs to the base buffer. */
808 bset_enable_multibyte_characters
809 (b, BVAR (b->base_buffer, enable_multibyte_characters));
811 /* Make sure the base buffer has markers for its narrowing. */
812 if (NILP (BVAR (b->base_buffer, pt_marker)))
814 eassert (NILP (BVAR (b->base_buffer, begv_marker)));
815 eassert (NILP (BVAR (b->base_buffer, zv_marker)));
817 bset_pt_marker (b->base_buffer,
818 build_marker (b->base_buffer, b->base_buffer->pt,
819 b->base_buffer->pt_byte));
821 bset_begv_marker (b->base_buffer,
822 build_marker (b->base_buffer, b->base_buffer->begv,
823 b->base_buffer->begv_byte));
825 bset_zv_marker (b->base_buffer,
826 build_marker (b->base_buffer, b->base_buffer->zv,
827 b->base_buffer->zv_byte));
829 XMARKER (BVAR (b->base_buffer, zv_marker))->insertion_type = 1;
832 if (NILP (clone))
834 /* Give the indirect buffer markers for its narrowing. */
835 bset_pt_marker (b, build_marker (b, b->pt, b->pt_byte));
836 bset_begv_marker (b, build_marker (b, b->begv, b->begv_byte));
837 bset_zv_marker (b, build_marker (b, b->zv, b->zv_byte));
838 XMARKER (BVAR (b, zv_marker))->insertion_type = 1;
840 else
842 struct buffer *old_b = current_buffer;
844 clone_per_buffer_values (b->base_buffer, b);
845 bset_filename (b, Qnil);
846 bset_file_truename (b, Qnil);
847 bset_display_count (b, make_number (0));
848 bset_backed_up (b, Qnil);
849 bset_auto_save_file_name (b, Qnil);
850 set_buffer_internal_1 (b);
851 Fset (intern ("buffer-save-without-query"), Qnil);
852 Fset (intern ("buffer-file-number"), Qnil);
853 Fset (intern ("buffer-stale-function"), Qnil);
854 set_buffer_internal_1 (old_b);
857 /* Run buffer-list-update-hook. */
858 if (!NILP (Vrun_hooks))
859 call1 (Vrun_hooks, Qbuffer_list_update_hook);
861 return buf;
864 /* Mark OV as no longer associated with B. */
866 static void
867 drop_overlay (struct buffer *b, struct Lisp_Overlay *ov)
869 eassert (b == XBUFFER (Fmarker_buffer (ov->start)));
870 modify_overlay (b, marker_position (ov->start),
871 marker_position (ov->end));
872 unchain_marker (XMARKER (ov->start));
873 unchain_marker (XMARKER (ov->end));
877 /* Delete all overlays of B and reset it's overlay lists. */
879 void
880 delete_all_overlays (struct buffer *b)
882 struct Lisp_Overlay *ov, *next;
884 /* FIXME: Since each drop_overlay will scan BUF_MARKERS to unlink its
885 markers, we have an unneeded O(N^2) behavior here. */
886 for (ov = b->overlays_before; ov; ov = next)
888 drop_overlay (b, ov);
889 next = ov->next;
890 ov->next = NULL;
893 for (ov = b->overlays_after; ov; ov = next)
895 drop_overlay (b, ov);
896 next = ov->next;
897 ov->next = NULL;
900 set_buffer_overlays_before (b, NULL);
901 set_buffer_overlays_after (b, NULL);
904 /* Reinitialize everything about a buffer except its name and contents
905 and local variables.
906 If called on an already-initialized buffer, the list of overlays
907 should be deleted before calling this function, otherwise we end up
908 with overlays that claim to belong to the buffer but the buffer
909 claims it doesn't belong to it. */
911 void
912 reset_buffer (register struct buffer *b)
914 bset_filename (b, Qnil);
915 bset_file_truename (b, Qnil);
916 bset_directory (b, current_buffer ? BVAR (current_buffer, directory) : Qnil);
917 b->modtime = make_timespec (0, UNKNOWN_MODTIME_NSECS);
918 b->modtime_size = -1;
919 XSETFASTINT (BVAR (b, save_length), 0);
920 b->last_window_start = 1;
921 /* It is more conservative to start out "changed" than "unchanged". */
922 b->clip_changed = 0;
923 b->prevent_redisplay_optimizations_p = 1;
924 bset_backed_up (b, Qnil);
925 BUF_AUTOSAVE_MODIFF (b) = 0;
926 b->auto_save_failure_time = 0;
927 bset_auto_save_file_name (b, Qnil);
928 bset_read_only (b, Qnil);
929 set_buffer_overlays_before (b, NULL);
930 set_buffer_overlays_after (b, NULL);
931 b->overlay_center = BEG;
932 bset_mark_active (b, Qnil);
933 bset_point_before_scroll (b, Qnil);
934 bset_file_format (b, Qnil);
935 bset_auto_save_file_format (b, Qt);
936 bset_last_selected_window (b, Qnil);
937 bset_display_count (b, make_number (0));
938 bset_display_time (b, Qnil);
939 bset_enable_multibyte_characters
940 (b, BVAR (&buffer_defaults, enable_multibyte_characters));
941 bset_cursor_type (b, BVAR (&buffer_defaults, cursor_type));
942 bset_extra_line_spacing (b, BVAR (&buffer_defaults, extra_line_spacing));
944 b->display_error_modiff = 0;
947 /* Reset buffer B's local variables info.
948 Don't use this on a buffer that has already been in use;
949 it does not treat permanent locals consistently.
950 Instead, use Fkill_all_local_variables.
952 If PERMANENT_TOO, reset permanent buffer-local variables.
953 If not, preserve those. */
955 static void
956 reset_buffer_local_variables (struct buffer *b, bool permanent_too)
958 int offset, i;
960 /* Reset the major mode to Fundamental, together with all the
961 things that depend on the major mode.
962 default-major-mode is handled at a higher level.
963 We ignore it here. */
964 bset_major_mode (b, Qfundamental_mode);
965 bset_keymap (b, Qnil);
966 bset_mode_name (b, QSFundamental);
967 bset_minor_modes (b, Qnil);
969 /* If the standard case table has been altered and invalidated,
970 fix up its insides first. */
971 if (! (CHAR_TABLE_P (XCHAR_TABLE (Vascii_downcase_table)->extras[0])
972 && CHAR_TABLE_P (XCHAR_TABLE (Vascii_downcase_table)->extras[1])
973 && CHAR_TABLE_P (XCHAR_TABLE (Vascii_downcase_table)->extras[2])))
974 Fset_standard_case_table (Vascii_downcase_table);
976 bset_downcase_table (b, Vascii_downcase_table);
977 bset_upcase_table (b, XCHAR_TABLE (Vascii_downcase_table)->extras[0]);
978 bset_case_canon_table (b, XCHAR_TABLE (Vascii_downcase_table)->extras[1]);
979 bset_case_eqv_table (b, XCHAR_TABLE (Vascii_downcase_table)->extras[2]);
980 bset_invisibility_spec (b, Qt);
982 /* Reset all (or most) per-buffer variables to their defaults. */
983 if (permanent_too)
984 bset_local_var_alist (b, Qnil);
985 else
987 Lisp_Object tmp, prop, last = Qnil;
988 for (tmp = BVAR (b, local_var_alist); CONSP (tmp); tmp = XCDR (tmp))
989 if (!NILP (prop = Fget (XCAR (XCAR (tmp)), Qpermanent_local)))
991 /* If permanent-local, keep it. */
992 last = tmp;
993 if (EQ (prop, Qpermanent_local_hook))
995 /* This is a partially permanent hook variable.
996 Preserve only the elements that want to be preserved. */
997 Lisp_Object list, newlist;
998 list = XCDR (XCAR (tmp));
999 if (!CONSP (list))
1000 newlist = list;
1001 else
1002 for (newlist = Qnil; CONSP (list); list = XCDR (list))
1004 Lisp_Object elt = XCAR (list);
1005 /* Preserve element ELT if it's t,
1006 if it is a function with a `permanent-local-hook' property,
1007 or if it's not a symbol. */
1008 if (! SYMBOLP (elt)
1009 || EQ (elt, Qt)
1010 || !NILP (Fget (elt, Qpermanent_local_hook)))
1011 newlist = Fcons (elt, newlist);
1013 XSETCDR (XCAR (tmp), Fnreverse (newlist));
1016 /* Delete this local variable. */
1017 else if (NILP (last))
1018 bset_local_var_alist (b, XCDR (tmp));
1019 else
1020 XSETCDR (last, XCDR (tmp));
1023 for (i = 0; i < last_per_buffer_idx; ++i)
1024 if (permanent_too || buffer_permanent_local_flags[i] == 0)
1025 SET_PER_BUFFER_VALUE_P (b, i, 0);
1027 /* For each slot that has a default value, copy that into the slot. */
1028 FOR_EACH_PER_BUFFER_OBJECT_AT (offset)
1030 int idx = PER_BUFFER_IDX (offset);
1031 if ((idx > 0
1032 && (permanent_too
1033 || buffer_permanent_local_flags[idx] == 0)))
1034 set_per_buffer_value (b, offset, per_buffer_default (offset));
1038 /* We split this away from generate-new-buffer, because rename-buffer
1039 and set-visited-file-name ought to be able to use this to really
1040 rename the buffer properly. */
1042 DEFUN ("generate-new-buffer-name", Fgenerate_new_buffer_name,
1043 Sgenerate_new_buffer_name, 1, 2, 0,
1044 doc: /* Return a string that is the name of no existing buffer based on NAME.
1045 If there is no live buffer named NAME, then return NAME.
1046 Otherwise modify name by appending `<NUMBER>', incrementing NUMBER
1047 \(starting at 2) until an unused name is found, and then return that name.
1048 Optional second argument IGNORE specifies a name that is okay to use (if
1049 it is in the sequence to be tried) even if a buffer with that name exists.
1051 If NAME begins with a space (i.e., a buffer that is not normally
1052 visible to users), then if buffer NAME already exists a random number
1053 is first appended to NAME, to speed up finding a non-existent buffer. */)
1054 (register Lisp_Object name, Lisp_Object ignore)
1056 register Lisp_Object gentemp, tem, tem2;
1057 ptrdiff_t count;
1058 char number[INT_BUFSIZE_BOUND (ptrdiff_t) + sizeof "<>"];
1060 CHECK_STRING (name);
1062 tem = Fstring_equal (name, ignore);
1063 if (!NILP (tem))
1064 return name;
1065 tem = Fget_buffer (name);
1066 if (NILP (tem))
1067 return name;
1069 if (!strncmp (SSDATA (name), " ", 1)) /* see bug#1229 */
1071 /* Note fileio.c:make_temp_name does random differently. */
1072 tem2 = concat2 (name, make_formatted_string
1073 (number, "-%"pI"d",
1074 XFASTINT (Frandom (make_number (999999)))));
1075 tem = Fget_buffer (tem2);
1076 if (NILP (tem))
1077 return tem2;
1079 else
1080 tem2 = name;
1082 count = 1;
1083 while (1)
1085 gentemp = concat2 (tem2, make_formatted_string
1086 (number, "<%"pD"d>", ++count));
1087 tem = Fstring_equal (gentemp, ignore);
1088 if (!NILP (tem))
1089 return gentemp;
1090 tem = Fget_buffer (gentemp);
1091 if (NILP (tem))
1092 return gentemp;
1097 DEFUN ("buffer-name", Fbuffer_name, Sbuffer_name, 0, 1, 0,
1098 doc: /* Return the name of BUFFER, as a string.
1099 BUFFER defaults to the current buffer.
1100 Return nil if BUFFER has been killed. */)
1101 (register Lisp_Object buffer)
1103 return BVAR (decode_buffer (buffer), name);
1106 DEFUN ("buffer-file-name", Fbuffer_file_name, Sbuffer_file_name, 0, 1, 0,
1107 doc: /* Return name of file BUFFER is visiting, or nil if none.
1108 No argument or nil as argument means use the current buffer. */)
1109 (register Lisp_Object buffer)
1111 return BVAR (decode_buffer (buffer), filename);
1114 DEFUN ("buffer-base-buffer", Fbuffer_base_buffer, Sbuffer_base_buffer,
1115 0, 1, 0,
1116 doc: /* Return the base buffer of indirect buffer BUFFER.
1117 If BUFFER is not indirect, return nil.
1118 BUFFER defaults to the current buffer. */)
1119 (register Lisp_Object buffer)
1121 struct buffer *base = decode_buffer (buffer)->base_buffer;
1122 return base ? (XSETBUFFER (buffer, base), buffer) : Qnil;
1125 DEFUN ("buffer-local-value", Fbuffer_local_value,
1126 Sbuffer_local_value, 2, 2, 0,
1127 doc: /* Return the value of VARIABLE in BUFFER.
1128 If VARIABLE does not have a buffer-local binding in BUFFER, the value
1129 is the default binding of the variable. */)
1130 (register Lisp_Object variable, register Lisp_Object buffer)
1132 register Lisp_Object result = buffer_local_value (variable, buffer);
1134 if (EQ (result, Qunbound))
1135 xsignal1 (Qvoid_variable, variable);
1137 return result;
1141 /* Like Fbuffer_local_value, but return Qunbound if the variable is
1142 locally unbound. */
1144 Lisp_Object
1145 buffer_local_value (Lisp_Object variable, Lisp_Object buffer)
1147 register struct buffer *buf;
1148 register Lisp_Object result;
1149 struct Lisp_Symbol *sym;
1151 CHECK_SYMBOL (variable);
1152 CHECK_BUFFER (buffer);
1153 buf = XBUFFER (buffer);
1154 sym = XSYMBOL (variable);
1156 start:
1157 switch (sym->redirect)
1159 case SYMBOL_VARALIAS: sym = indirect_variable (sym); goto start;
1160 case SYMBOL_PLAINVAL: result = SYMBOL_VAL (sym); break;
1161 case SYMBOL_LOCALIZED:
1162 { /* Look in local_var_alist. */
1163 struct Lisp_Buffer_Local_Value *blv = SYMBOL_BLV (sym);
1164 XSETSYMBOL (variable, sym); /* Update In case of aliasing. */
1165 result = Fassoc (variable, BVAR (buf, local_var_alist));
1166 if (!NILP (result))
1168 if (blv->fwd)
1169 { /* What binding is loaded right now? */
1170 Lisp_Object current_alist_element = blv->valcell;
1172 /* The value of the currently loaded binding is not
1173 stored in it, but rather in the realvalue slot.
1174 Store that value into the binding it belongs to
1175 in case that is the one we are about to use. */
1177 XSETCDR (current_alist_element,
1178 do_symval_forwarding (blv->fwd));
1180 /* Now get the (perhaps updated) value out of the binding. */
1181 result = XCDR (result);
1183 else
1184 result = Fdefault_value (variable);
1185 break;
1187 case SYMBOL_FORWARDED:
1189 union Lisp_Fwd *fwd = SYMBOL_FWD (sym);
1190 if (BUFFER_OBJFWDP (fwd))
1191 result = per_buffer_value (buf, XBUFFER_OBJFWD (fwd)->offset);
1192 else
1193 result = Fdefault_value (variable);
1194 break;
1196 default: emacs_abort ();
1199 return result;
1202 /* Return an alist of the Lisp-level buffer-local bindings of
1203 buffer BUF. That is, don't include the variables maintained
1204 in special slots in the buffer object.
1205 If not CLONE, replace elements of the form (VAR . unbound)
1206 by VAR. */
1208 static Lisp_Object
1209 buffer_lisp_local_variables (struct buffer *buf, bool clone)
1211 Lisp_Object result = Qnil;
1212 Lisp_Object tail;
1213 for (tail = BVAR (buf, local_var_alist); CONSP (tail); tail = XCDR (tail))
1215 Lisp_Object val, elt;
1217 elt = XCAR (tail);
1219 /* Reference each variable in the alist in buf.
1220 If inquiring about the current buffer, this gets the current values,
1221 so store them into the alist so the alist is up to date.
1222 If inquiring about some other buffer, this swaps out any values
1223 for that buffer, making the alist up to date automatically. */
1224 val = find_symbol_value (XCAR (elt));
1225 /* Use the current buffer value only if buf is the current buffer. */
1226 if (buf != current_buffer)
1227 val = XCDR (elt);
1229 result = Fcons (!clone && EQ (val, Qunbound)
1230 ? XCAR (elt)
1231 : Fcons (XCAR (elt), val),
1232 result);
1235 return result;
1238 DEFUN ("buffer-local-variables", Fbuffer_local_variables,
1239 Sbuffer_local_variables, 0, 1, 0,
1240 doc: /* Return an alist of variables that are buffer-local in BUFFER.
1241 Most elements look like (SYMBOL . VALUE), describing one variable.
1242 For a symbol that is locally unbound, just the symbol appears in the value.
1243 Note that storing new VALUEs in these elements doesn't change the variables.
1244 No argument or nil as argument means use current buffer as BUFFER. */)
1245 (Lisp_Object buffer)
1247 struct buffer *buf = decode_buffer (buffer);
1248 Lisp_Object result = buffer_lisp_local_variables (buf, 0);
1250 /* Add on all the variables stored in special slots. */
1252 int offset, idx;
1254 FOR_EACH_PER_BUFFER_OBJECT_AT (offset)
1256 idx = PER_BUFFER_IDX (offset);
1257 if ((idx == -1 || PER_BUFFER_VALUE_P (buf, idx))
1258 && SYMBOLP (PER_BUFFER_SYMBOL (offset)))
1260 Lisp_Object sym = PER_BUFFER_SYMBOL (offset);
1261 Lisp_Object val = per_buffer_value (buf, offset);
1262 result = Fcons (EQ (val, Qunbound) ? sym : Fcons (sym, val),
1263 result);
1268 return result;
1271 DEFUN ("buffer-modified-p", Fbuffer_modified_p, Sbuffer_modified_p,
1272 0, 1, 0,
1273 doc: /* Return t if BUFFER was modified since its file was last read or saved.
1274 No argument or nil as argument means use current buffer as BUFFER. */)
1275 (Lisp_Object buffer)
1277 struct buffer *buf = decode_buffer (buffer);
1278 return BUF_SAVE_MODIFF (buf) < BUF_MODIFF (buf) ? Qt : Qnil;
1281 DEFUN ("force-mode-line-update", Fforce_mode_line_update,
1282 Sforce_mode_line_update, 0, 1, 0,
1283 doc: /* Force redisplay of the current buffer's mode line and header line.
1284 With optional non-nil ALL, force redisplay of all mode lines and
1285 header lines. This function also forces recomputation of the
1286 menu bar menus and the frame title. */)
1287 (Lisp_Object all)
1289 if (!NILP (all))
1291 update_mode_lines = 10;
1292 /* FIXME: This can't be right. */
1293 current_buffer->prevent_redisplay_optimizations_p = true;
1295 else if (buffer_window_count (current_buffer))
1297 bset_update_mode_line (current_buffer);
1298 current_buffer->prevent_redisplay_optimizations_p = true;
1300 return all;
1303 DEFUN ("set-buffer-modified-p", Fset_buffer_modified_p, Sset_buffer_modified_p,
1304 1, 1, 0,
1305 doc: /* Mark current buffer as modified or unmodified according to FLAG.
1306 A non-nil FLAG means mark the buffer modified. */)
1307 (Lisp_Object flag)
1309 Frestore_buffer_modified_p (flag);
1311 /* Set update_mode_lines only if buffer is displayed in some window.
1312 Packages like jit-lock or lazy-lock preserve a buffer's modified
1313 state by recording/restoring the state around blocks of code.
1314 Setting update_mode_lines makes redisplay consider all windows
1315 (on all frames). Stealth fontification of buffers not displayed
1316 would incur additional redisplay costs if we'd set
1317 update_modes_lines unconditionally.
1319 Ideally, I think there should be another mechanism for fontifying
1320 buffers without "modifying" buffers, or redisplay should be
1321 smarter about updating the `*' in mode lines. --gerd */
1322 return Fforce_mode_line_update (Qnil);
1325 DEFUN ("restore-buffer-modified-p", Frestore_buffer_modified_p,
1326 Srestore_buffer_modified_p, 1, 1, 0,
1327 doc: /* Like `set-buffer-modified-p', with a difference concerning redisplay.
1328 It is not ensured that mode lines will be updated to show the modified
1329 state of the current buffer. Use with care. */)
1330 (Lisp_Object flag)
1332 Lisp_Object fn;
1334 /* If buffer becoming modified, lock the file.
1335 If buffer becoming unmodified, unlock the file. */
1337 struct buffer *b = current_buffer->base_buffer
1338 ? current_buffer->base_buffer
1339 : current_buffer;
1341 fn = BVAR (b, file_truename);
1342 /* Test buffer-file-name so that binding it to nil is effective. */
1343 if (!NILP (fn) && ! NILP (BVAR (b, filename)))
1345 bool already = SAVE_MODIFF < MODIFF;
1346 if (!already && !NILP (flag))
1347 lock_file (fn);
1348 else if (already && NILP (flag))
1349 unlock_file (fn);
1352 /* Here we have a problem. SAVE_MODIFF is used here to encode
1353 buffer-modified-p (as SAVE_MODIFF<MODIFF) as well as
1354 recent-auto-save-p (as SAVE_MODIFF<auto_save_modified). So if we
1355 modify SAVE_MODIFF to affect one, we may affect the other
1356 as well.
1357 E.g. if FLAG is nil we need to set SAVE_MODIFF to MODIFF, but
1358 if SAVE_MODIFF<auto_save_modified that means we risk changing
1359 recent-auto-save-p from t to nil.
1360 Vice versa, if FLAG is non-nil and SAVE_MODIFF>=auto_save_modified
1361 we risk changing recent-auto-save-p from nil to t. */
1362 SAVE_MODIFF = (NILP (flag)
1363 /* FIXME: This unavoidably sets recent-auto-save-p to nil. */
1364 ? MODIFF
1365 /* Let's try to preserve recent-auto-save-p. */
1366 : SAVE_MODIFF < MODIFF ? SAVE_MODIFF
1367 /* If SAVE_MODIFF == auto_save_modified == MODIFF,
1368 we can either decrease SAVE_MODIFF and auto_save_modified
1369 or increase MODIFF. */
1370 : MODIFF++);
1372 return flag;
1375 DEFUN ("buffer-modified-tick", Fbuffer_modified_tick, Sbuffer_modified_tick,
1376 0, 1, 0,
1377 doc: /* Return BUFFER's tick counter, incremented for each change in text.
1378 Each buffer has a tick counter which is incremented each time the
1379 text in that buffer is changed. It wraps around occasionally.
1380 No argument or nil as argument means use current buffer as BUFFER. */)
1381 (register Lisp_Object buffer)
1383 return make_number (BUF_MODIFF (decode_buffer (buffer)));
1386 DEFUN ("buffer-chars-modified-tick", Fbuffer_chars_modified_tick,
1387 Sbuffer_chars_modified_tick, 0, 1, 0,
1388 doc: /* Return BUFFER's character-change tick counter.
1389 Each buffer has a character-change tick counter, which is set to the
1390 value of the buffer's tick counter (see `buffer-modified-tick'), each
1391 time text in that buffer is inserted or deleted. By comparing the
1392 values returned by two individual calls of `buffer-chars-modified-tick',
1393 you can tell whether a character change occurred in that buffer in
1394 between these calls. No argument or nil as argument means use current
1395 buffer as BUFFER. */)
1396 (register Lisp_Object buffer)
1398 return make_number (BUF_CHARS_MODIFF (decode_buffer (buffer)));
1401 DEFUN ("rename-buffer", Frename_buffer, Srename_buffer, 1, 2,
1402 "(list (read-string \"Rename buffer (to new name): \" \
1403 nil 'buffer-name-history (buffer-name (current-buffer))) \
1404 current-prefix-arg)",
1405 doc: /* Change current buffer's name to NEWNAME (a string).
1406 If second arg UNIQUE is nil or omitted, it is an error if a
1407 buffer named NEWNAME already exists.
1408 If UNIQUE is non-nil, come up with a new name using
1409 `generate-new-buffer-name'.
1410 Interactively, you can set UNIQUE with a prefix argument.
1411 We return the name we actually gave the buffer.
1412 This does not change the name of the visited file (if any). */)
1413 (register Lisp_Object newname, Lisp_Object unique)
1415 register Lisp_Object tem, buf;
1417 CHECK_STRING (newname);
1419 if (SCHARS (newname) == 0)
1420 error ("Empty string is invalid as a buffer name");
1422 tem = Fget_buffer (newname);
1423 if (!NILP (tem))
1425 /* Don't short-circuit if UNIQUE is t. That is a useful way to
1426 rename the buffer automatically so you can create another
1427 with the original name. It makes UNIQUE equivalent to
1428 (rename-buffer (generate-new-buffer-name NEWNAME)). */
1429 if (NILP (unique) && XBUFFER (tem) == current_buffer)
1430 return BVAR (current_buffer, name);
1431 if (!NILP (unique))
1432 newname = Fgenerate_new_buffer_name (newname, BVAR (current_buffer, name));
1433 else
1434 error ("Buffer name `%s' is in use", SDATA (newname));
1437 bset_name (current_buffer, newname);
1439 /* Catch redisplay's attention. Unless we do this, the mode lines for
1440 any windows displaying current_buffer will stay unchanged. */
1441 update_mode_lines = 11;
1443 XSETBUFFER (buf, current_buffer);
1444 Fsetcar (Frassq (buf, Vbuffer_alist), newname);
1445 if (NILP (BVAR (current_buffer, filename))
1446 && !NILP (BVAR (current_buffer, auto_save_file_name)))
1447 call0 (intern ("rename-auto-save-file"));
1449 /* Run buffer-list-update-hook. */
1450 if (!NILP (Vrun_hooks))
1451 call1 (Vrun_hooks, Qbuffer_list_update_hook);
1453 /* Refetch since that last call may have done GC. */
1454 return BVAR (current_buffer, name);
1457 /* True if B can be used as 'other-than-BUFFER' buffer. */
1459 static bool
1460 candidate_buffer (Lisp_Object b, Lisp_Object buffer)
1462 return (BUFFERP (b) && !EQ (b, buffer)
1463 && BUFFER_LIVE_P (XBUFFER (b))
1464 && !BUFFER_HIDDEN_P (XBUFFER (b)));
1467 DEFUN ("other-buffer", Fother_buffer, Sother_buffer, 0, 3, 0,
1468 doc: /* Return most recently selected buffer other than BUFFER.
1469 Buffers not visible in windows are preferred to visible buffers, unless
1470 optional second argument VISIBLE-OK is non-nil. Ignore the argument
1471 BUFFER unless it denotes a live buffer. If the optional third argument
1472 FRAME specifies a live frame, then use that frame's buffer list instead
1473 of the selected frame's buffer list.
1475 The buffer is found by scanning the selected or specified frame's buffer
1476 list first, followed by the list of all buffers. If no other buffer
1477 exists, return the buffer `*scratch*' (creating it if necessary). */)
1478 (Lisp_Object buffer, Lisp_Object visible_ok, Lisp_Object frame)
1480 struct frame *f = decode_live_frame (frame);
1481 Lisp_Object tail = f->buffer_list, pred = f->buffer_predicate;
1482 Lisp_Object buf, notsogood = Qnil;
1484 /* Consider buffers that have been seen in the frame first. */
1485 for (; CONSP (tail); tail = XCDR (tail))
1487 buf = XCAR (tail);
1488 if (candidate_buffer (buf, buffer)
1489 /* If the frame has a buffer_predicate, disregard buffers that
1490 don't fit the predicate. */
1491 && (NILP (pred) || !NILP (call1 (pred, buf))))
1493 if (!NILP (visible_ok)
1494 || NILP (Fget_buffer_window (buf, Qvisible)))
1495 return buf;
1496 else if (NILP (notsogood))
1497 notsogood = buf;
1501 /* Consider alist of all buffers next. */
1502 FOR_EACH_LIVE_BUFFER (tail, buf)
1504 if (candidate_buffer (buf, buffer)
1505 /* If the frame has a buffer_predicate, disregard buffers that
1506 don't fit the predicate. */
1507 && (NILP (pred) || !NILP (call1 (pred, buf))))
1509 if (!NILP (visible_ok)
1510 || NILP (Fget_buffer_window (buf, Qvisible)))
1511 return buf;
1512 else if (NILP (notsogood))
1513 notsogood = buf;
1517 if (!NILP (notsogood))
1518 return notsogood;
1519 else
1521 AUTO_STRING (scratch, "*scratch*");
1522 buf = Fget_buffer (scratch);
1523 if (NILP (buf))
1525 buf = Fget_buffer_create (scratch);
1526 Fset_buffer_major_mode (buf);
1528 return buf;
1532 /* The following function is a safe variant of Fother_buffer: It doesn't
1533 pay attention to any frame-local buffer lists, doesn't care about
1534 visibility of buffers, and doesn't evaluate any frame predicates. */
1536 Lisp_Object
1537 other_buffer_safely (Lisp_Object buffer)
1539 Lisp_Object tail, buf;
1541 FOR_EACH_LIVE_BUFFER (tail, buf)
1542 if (candidate_buffer (buf, buffer))
1543 return buf;
1545 AUTO_STRING (scratch, "*scratch*");
1546 buf = Fget_buffer (scratch);
1547 if (NILP (buf))
1549 buf = Fget_buffer_create (scratch);
1550 Fset_buffer_major_mode (buf);
1553 return buf;
1556 DEFUN ("buffer-enable-undo", Fbuffer_enable_undo, Sbuffer_enable_undo,
1557 0, 1, "",
1558 doc: /* Start keeping undo information for buffer BUFFER.
1559 No argument or nil as argument means do this for the current buffer. */)
1560 (register Lisp_Object buffer)
1562 Lisp_Object real_buffer;
1564 if (NILP (buffer))
1565 XSETBUFFER (real_buffer, current_buffer);
1566 else
1568 real_buffer = Fget_buffer (buffer);
1569 if (NILP (real_buffer))
1570 nsberror (buffer);
1573 if (EQ (BVAR (XBUFFER (real_buffer), undo_list), Qt))
1574 bset_undo_list (XBUFFER (real_buffer), Qnil);
1576 return Qnil;
1579 /* Truncate undo list and shrink the gap of BUFFER. */
1581 void
1582 compact_buffer (struct buffer *buffer)
1584 BUFFER_CHECK_INDIRECTION (buffer);
1586 /* Skip dead buffers, indirect buffers and buffers
1587 which aren't changed since last compaction. */
1588 if (BUFFER_LIVE_P (buffer)
1589 && (buffer->base_buffer == NULL)
1590 && (BUF_COMPACT (buffer) != BUF_MODIFF (buffer)))
1592 /* If a buffer's undo list is Qt, that means that undo is
1593 turned off in that buffer. Calling truncate_undo_list on
1594 Qt tends to return NULL, which effectively turns undo back on.
1595 So don't call truncate_undo_list if undo_list is Qt. */
1596 if (!EQ (BVAR(buffer, undo_list), Qt))
1597 truncate_undo_list (buffer);
1599 /* Shrink buffer gaps. */
1600 if (!buffer->text->inhibit_shrinking)
1602 /* If a buffer's gap size is more than 10% of the buffer
1603 size, or larger than GAP_BYTES_DFL bytes, then shrink it
1604 accordingly. Keep a minimum size of GAP_BYTES_MIN bytes. */
1605 ptrdiff_t size = clip_to_bounds (GAP_BYTES_MIN,
1606 BUF_Z_BYTE (buffer) / 10,
1607 GAP_BYTES_DFL);
1608 if (BUF_GAP_SIZE (buffer) > size)
1609 make_gap_1 (buffer, -(BUF_GAP_SIZE (buffer) - size));
1611 BUF_COMPACT (buffer) = BUF_MODIFF (buffer);
1615 DEFUN ("kill-buffer", Fkill_buffer, Skill_buffer, 0, 1, "bKill buffer: ",
1616 doc: /* Kill the buffer specified by BUFFER-OR-NAME.
1617 The argument may be a buffer or the name of an existing buffer.
1618 Argument nil or omitted means kill the current buffer. Return t if the
1619 buffer is actually killed, nil otherwise.
1621 The functions in `kill-buffer-query-functions' are called with the
1622 buffer to be killed as the current buffer. If any of them returns nil,
1623 the buffer is not killed. The hook `kill-buffer-hook' is run before the
1624 buffer is actually killed. The buffer being killed will be current
1625 while the hook is running. Functions called by any of these hooks are
1626 supposed to not change the current buffer.
1628 Any processes that have this buffer as the `process-buffer' are killed
1629 with SIGHUP. This function calls `replace-buffer-in-windows' for
1630 cleaning up all windows currently displaying the buffer to be killed. */)
1631 (Lisp_Object buffer_or_name)
1633 Lisp_Object buffer;
1634 struct buffer *b;
1635 Lisp_Object tem;
1636 struct Lisp_Marker *m;
1638 if (NILP (buffer_or_name))
1639 buffer = Fcurrent_buffer ();
1640 else
1641 buffer = Fget_buffer (buffer_or_name);
1642 if (NILP (buffer))
1643 nsberror (buffer_or_name);
1645 b = XBUFFER (buffer);
1647 /* Avoid trouble for buffer already dead. */
1648 if (!BUFFER_LIVE_P (b))
1649 return Qnil;
1651 /* Run hooks with the buffer to be killed the current buffer. */
1653 ptrdiff_t count = SPECPDL_INDEX ();
1655 record_unwind_protect (save_excursion_restore, save_excursion_save ());
1656 set_buffer_internal (b);
1658 /* First run the query functions; if any query is answered no,
1659 don't kill the buffer. */
1660 tem = CALLN (Frun_hook_with_args_until_failure,
1661 Qkill_buffer_query_functions);
1662 if (NILP (tem))
1663 return unbind_to (count, Qnil);
1665 /* Query if the buffer is still modified. */
1666 if (INTERACTIVE && !NILP (BVAR (b, filename))
1667 && BUF_MODIFF (b) > BUF_SAVE_MODIFF (b))
1669 AUTO_STRING (format, "Buffer %s modified; kill anyway? ");
1670 tem = do_yes_or_no_p (CALLN (Fformat, format, BVAR (b, name)));
1671 if (NILP (tem))
1672 return unbind_to (count, Qnil);
1675 /* If the hooks have killed the buffer, exit now. */
1676 if (!BUFFER_LIVE_P (b))
1677 return unbind_to (count, Qt);
1679 /* Then run the hooks. */
1680 run_hook (Qkill_buffer_hook);
1681 unbind_to (count, Qnil);
1684 /* If the hooks have killed the buffer, exit now. */
1685 if (!BUFFER_LIVE_P (b))
1686 return Qt;
1688 /* We have no more questions to ask. Verify that it is valid
1689 to kill the buffer. This must be done after the questions
1690 since anything can happen within do_yes_or_no_p. */
1692 /* Don't kill the minibuffer now current. */
1693 if (EQ (buffer, XWINDOW (minibuf_window)->contents))
1694 return Qnil;
1696 /* When we kill an ordinary buffer which shares it's buffer text
1697 with indirect buffer(s), we must kill indirect buffer(s) too.
1698 We do it at this stage so nothing terrible happens if they
1699 ask questions or their hooks get errors. */
1700 if (!b->base_buffer && b->indirections > 0)
1702 struct buffer *other;
1704 FOR_EACH_BUFFER (other)
1705 if (other->base_buffer == b)
1707 Lisp_Object buf;
1708 XSETBUFFER (buf, other);
1709 Fkill_buffer (buf);
1712 /* Exit if we now have killed the base buffer (Bug#11665). */
1713 if (!BUFFER_LIVE_P (b))
1714 return Qt;
1717 /* Run replace_buffer_in_windows before making another buffer current
1718 since set-window-buffer-start-and-point will refuse to make another
1719 buffer current if the selected window does not show the current
1720 buffer (bug#10114). */
1721 replace_buffer_in_windows (buffer);
1723 /* Exit if replacing the buffer in windows has killed our buffer. */
1724 if (!BUFFER_LIVE_P (b))
1725 return Qt;
1727 /* Make this buffer not be current. Exit if it is the sole visible
1728 buffer. */
1729 if (b == current_buffer)
1731 tem = Fother_buffer (buffer, Qnil, Qnil);
1732 Fset_buffer (tem);
1733 if (b == current_buffer)
1734 return Qnil;
1737 /* If the buffer now current is shown in the minibuffer and our buffer
1738 is the sole other buffer give up. */
1739 XSETBUFFER (tem, current_buffer);
1740 if (EQ (tem, XWINDOW (minibuf_window)->contents)
1741 && EQ (buffer, Fother_buffer (buffer, Qnil, Qnil)))
1742 return Qnil;
1744 /* Now there is no question: we can kill the buffer. */
1746 /* Unlock this buffer's file, if it is locked. */
1747 unlock_buffer (b);
1749 kill_buffer_processes (buffer);
1750 kill_buffer_xwidgets (buffer);
1752 /* Killing buffer processes may run sentinels which may have killed
1753 our buffer. */
1754 if (!BUFFER_LIVE_P (b))
1755 return Qt;
1757 /* These may run Lisp code and into infinite loops (if someone
1758 insisted on circular lists) so allow quitting here. */
1759 frames_discard_buffer (buffer);
1761 clear_charpos_cache (b);
1763 tem = Vinhibit_quit;
1764 Vinhibit_quit = Qt;
1765 /* Remove the buffer from the list of all buffers. */
1766 Vbuffer_alist = Fdelq (Frassq (buffer, Vbuffer_alist), Vbuffer_alist);
1767 /* If replace_buffer_in_windows didn't do its job fix that now. */
1768 replace_buffer_in_windows_safely (buffer);
1769 Vinhibit_quit = tem;
1771 /* Delete any auto-save file, if we saved it in this session.
1772 But not if the buffer is modified. */
1773 if (STRINGP (BVAR (b, auto_save_file_name))
1774 && BUF_AUTOSAVE_MODIFF (b) != 0
1775 && BUF_SAVE_MODIFF (b) < BUF_AUTOSAVE_MODIFF (b)
1776 && BUF_SAVE_MODIFF (b) < BUF_MODIFF (b)
1777 && NILP (Fsymbol_value (intern ("auto-save-visited-file-name"))))
1779 Lisp_Object delete;
1780 delete = Fsymbol_value (intern ("delete-auto-save-files"));
1781 if (! NILP (delete))
1782 internal_delete_file (BVAR (b, auto_save_file_name));
1785 /* Deleting an auto-save file could have killed our buffer. */
1786 if (!BUFFER_LIVE_P (b))
1787 return Qt;
1789 if (b->base_buffer)
1791 INTERVAL i;
1792 /* Unchain all markers that belong to this indirect buffer.
1793 Don't unchain the markers that belong to the base buffer
1794 or its other indirect buffers. */
1795 struct Lisp_Marker **mp = &BUF_MARKERS (b);
1796 while ((m = *mp))
1798 if (m->buffer == b)
1800 m->buffer = NULL;
1801 *mp = m->next;
1803 else
1804 mp = &m->next;
1806 /* Intervals should be owned by the base buffer (Bug#16502). */
1807 i = buffer_intervals (b);
1808 if (i)
1810 Lisp_Object owner;
1811 XSETBUFFER (owner, b->base_buffer);
1812 set_interval_object (i, owner);
1815 else
1817 /* Unchain all markers of this buffer and its indirect buffers.
1818 and leave them pointing nowhere. */
1819 for (m = BUF_MARKERS (b); m; )
1821 struct Lisp_Marker *next = m->next;
1822 m->buffer = 0;
1823 m->next = NULL;
1824 m = next;
1826 BUF_MARKERS (b) = NULL;
1827 set_buffer_intervals (b, NULL);
1829 /* Perhaps we should explicitly free the interval tree here... */
1831 /* Since we've unlinked the markers, the overlays can't be here any more
1832 either. */
1833 b->overlays_before = NULL;
1834 b->overlays_after = NULL;
1836 /* Reset the local variables, so that this buffer's local values
1837 won't be protected from GC. They would be protected
1838 if they happened to remain cached in their symbols.
1839 This gets rid of them for certain. */
1840 swap_out_buffer_local_variables (b);
1841 reset_buffer_local_variables (b, 1);
1843 bset_name (b, Qnil);
1845 block_input ();
1846 if (b->base_buffer)
1848 /* Notify our base buffer that we don't share the text anymore. */
1849 eassert (b->indirections == -1);
1850 b->base_buffer->indirections--;
1851 eassert (b->base_buffer->indirections >= 0);
1852 /* Make sure that we wasn't confused. */
1853 eassert (b->window_count == -1);
1855 else
1857 /* Make sure that no one shows us. */
1858 eassert (b->window_count == 0);
1859 /* No one shares our buffer text, can free it. */
1860 free_buffer_text (b);
1863 if (b->newline_cache)
1865 free_region_cache (b->newline_cache);
1866 b->newline_cache = 0;
1868 if (b->width_run_cache)
1870 free_region_cache (b->width_run_cache);
1871 b->width_run_cache = 0;
1873 if (b->bidi_paragraph_cache)
1875 free_region_cache (b->bidi_paragraph_cache);
1876 b->bidi_paragraph_cache = 0;
1878 bset_width_table (b, Qnil);
1879 unblock_input ();
1880 bset_undo_list (b, Qnil);
1882 /* Run buffer-list-update-hook. */
1883 if (!NILP (Vrun_hooks))
1884 call1 (Vrun_hooks, Qbuffer_list_update_hook);
1886 return Qt;
1889 /* Move association for BUFFER to the front of buffer (a)lists. Since
1890 we do this each time BUFFER is selected visibly, the more recently
1891 selected buffers are always closer to the front of those lists. This
1892 means that other_buffer is more likely to choose a relevant buffer.
1894 Note that this moves BUFFER to the front of the buffer lists of the
1895 selected frame even if BUFFER is not shown there. If BUFFER is not
1896 shown in the selected frame, consider the present behavior a feature.
1897 `select-window' gets this right since it shows BUFFER in the selected
1898 window when calling us. */
1900 void
1901 record_buffer (Lisp_Object buffer)
1903 Lisp_Object aelt, aelt_cons, tem;
1904 register struct frame *f = XFRAME (selected_frame);
1906 CHECK_BUFFER (buffer);
1908 /* Update Vbuffer_alist (we know that it has an entry for BUFFER).
1909 Don't allow quitting since this might leave the buffer list in an
1910 inconsistent state. */
1911 tem = Vinhibit_quit;
1912 Vinhibit_quit = Qt;
1913 aelt = Frassq (buffer, Vbuffer_alist);
1914 aelt_cons = Fmemq (aelt, Vbuffer_alist);
1915 Vbuffer_alist = Fdelq (aelt, Vbuffer_alist);
1916 XSETCDR (aelt_cons, Vbuffer_alist);
1917 Vbuffer_alist = aelt_cons;
1918 Vinhibit_quit = tem;
1920 /* Update buffer list of selected frame. */
1921 fset_buffer_list (f, Fcons (buffer, Fdelq (buffer, f->buffer_list)));
1922 fset_buried_buffer_list (f, Fdelq (buffer, f->buried_buffer_list));
1924 /* Run buffer-list-update-hook. */
1925 if (!NILP (Vrun_hooks))
1926 call1 (Vrun_hooks, Qbuffer_list_update_hook);
1930 /* Move BUFFER to the end of the buffer (a)lists. Do nothing if the
1931 buffer is killed. For the selected frame's buffer list this moves
1932 BUFFER to its end even if it was never shown in that frame. If
1933 this happens we have a feature, hence `bury-buffer-internal' should be
1934 called only when BUFFER was shown in the selected frame. */
1936 DEFUN ("bury-buffer-internal", Fbury_buffer_internal, Sbury_buffer_internal,
1937 1, 1, 0,
1938 doc: /* Move BUFFER to the end of the buffer list. */)
1939 (Lisp_Object buffer)
1941 Lisp_Object aelt, aelt_cons, tem;
1942 register struct frame *f = XFRAME (selected_frame);
1944 CHECK_BUFFER (buffer);
1946 /* Update Vbuffer_alist (we know that it has an entry for BUFFER).
1947 Don't allow quitting since this might leave the buffer list in an
1948 inconsistent state. */
1949 tem = Vinhibit_quit;
1950 Vinhibit_quit = Qt;
1951 aelt = Frassq (buffer, Vbuffer_alist);
1952 aelt_cons = Fmemq (aelt, Vbuffer_alist);
1953 Vbuffer_alist = Fdelq (aelt, Vbuffer_alist);
1954 XSETCDR (aelt_cons, Qnil);
1955 Vbuffer_alist = nconc2 (Vbuffer_alist, aelt_cons);
1956 Vinhibit_quit = tem;
1958 /* Update buffer lists of selected frame. */
1959 fset_buffer_list (f, Fdelq (buffer, f->buffer_list));
1960 fset_buried_buffer_list
1961 (f, Fcons (buffer, Fdelq (buffer, f->buried_buffer_list)));
1963 /* Run buffer-list-update-hook. */
1964 if (!NILP (Vrun_hooks))
1965 call1 (Vrun_hooks, Qbuffer_list_update_hook);
1967 return Qnil;
1970 DEFUN ("set-buffer-major-mode", Fset_buffer_major_mode, Sset_buffer_major_mode, 1, 1, 0,
1971 doc: /* Set an appropriate major mode for BUFFER.
1972 For the *scratch* buffer, use `initial-major-mode', otherwise choose a mode
1973 according to the default value of `major-mode'.
1974 Use this function before selecting the buffer, since it may need to inspect
1975 the current buffer's major mode. */)
1976 (Lisp_Object buffer)
1978 ptrdiff_t count;
1979 Lisp_Object function;
1981 CHECK_BUFFER (buffer);
1983 if (!BUFFER_LIVE_P (XBUFFER (buffer)))
1984 error ("Attempt to set major mode for a dead buffer");
1986 if (strcmp (SSDATA (BVAR (XBUFFER (buffer), name)), "*scratch*") == 0)
1987 function = find_symbol_value (intern ("initial-major-mode"));
1988 else
1990 function = BVAR (&buffer_defaults, major_mode);
1991 if (NILP (function)
1992 && NILP (Fget (BVAR (current_buffer, major_mode), Qmode_class)))
1993 function = BVAR (current_buffer, major_mode);
1996 if (NILP (function) || EQ (function, Qfundamental_mode))
1997 return Qnil;
1999 count = SPECPDL_INDEX ();
2001 /* To select a nonfundamental mode,
2002 select the buffer temporarily and then call the mode function. */
2004 record_unwind_protect (save_excursion_restore, save_excursion_save ());
2006 Fset_buffer (buffer);
2007 call0 (function);
2009 return unbind_to (count, Qnil);
2012 DEFUN ("current-buffer", Fcurrent_buffer, Scurrent_buffer, 0, 0, 0,
2013 doc: /* Return the current buffer as a Lisp object. */)
2014 (void)
2016 register Lisp_Object buf;
2017 XSETBUFFER (buf, current_buffer);
2018 return buf;
2021 /* Set the current buffer to B, and do not set windows_or_buffers_changed.
2022 This is used by redisplay. */
2024 void
2025 set_buffer_internal_1 (register struct buffer *b)
2027 register struct buffer *old_buf;
2028 register Lisp_Object tail;
2030 #ifdef USE_MMAP_FOR_BUFFERS
2031 if (b->text->beg == NULL)
2032 enlarge_buffer_text (b, 0);
2033 #endif /* USE_MMAP_FOR_BUFFERS */
2035 if (current_buffer == b)
2036 return;
2038 BUFFER_CHECK_INDIRECTION (b);
2040 old_buf = current_buffer;
2041 current_buffer = b;
2042 last_known_column_point = -1; /* Invalidate indentation cache. */
2044 if (old_buf)
2046 /* Put the undo list back in the base buffer, so that it appears
2047 that an indirect buffer shares the undo list of its base. */
2048 if (old_buf->base_buffer)
2049 bset_undo_list (old_buf->base_buffer, BVAR (old_buf, undo_list));
2051 /* If the old current buffer has markers to record PT, BEGV and ZV
2052 when it is not current, update them now. */
2053 record_buffer_markers (old_buf);
2056 /* Get the undo list from the base buffer, so that it appears
2057 that an indirect buffer shares the undo list of its base. */
2058 if (b->base_buffer)
2059 bset_undo_list (b, BVAR (b->base_buffer, undo_list));
2061 /* If the new current buffer has markers to record PT, BEGV and ZV
2062 when it is not current, fetch them now. */
2063 fetch_buffer_markers (b);
2065 /* Look down buffer's list of local Lisp variables
2066 to find and update any that forward into C variables. */
2070 for (tail = BVAR (b, local_var_alist); CONSP (tail); tail = XCDR (tail))
2072 Lisp_Object var = XCAR (XCAR (tail));
2073 struct Lisp_Symbol *sym = XSYMBOL (var);
2074 if (sym->redirect == SYMBOL_LOCALIZED /* Just to be sure. */
2075 && SYMBOL_BLV (sym)->fwd)
2076 /* Just reference the variable
2077 to cause it to become set for this buffer. */
2078 Fsymbol_value (var);
2081 /* Do the same with any others that were local to the previous buffer */
2082 while (b != old_buf && (b = old_buf, b));
2085 /* Switch to buffer B temporarily for redisplay purposes.
2086 This avoids certain things that don't need to be done within redisplay. */
2088 void
2089 set_buffer_temp (struct buffer *b)
2091 register struct buffer *old_buf;
2093 if (current_buffer == b)
2094 return;
2096 old_buf = current_buffer;
2097 current_buffer = b;
2099 /* If the old current buffer has markers to record PT, BEGV and ZV
2100 when it is not current, update them now. */
2101 record_buffer_markers (old_buf);
2103 /* If the new current buffer has markers to record PT, BEGV and ZV
2104 when it is not current, fetch them now. */
2105 fetch_buffer_markers (b);
2108 DEFUN ("set-buffer", Fset_buffer, Sset_buffer, 1, 1, 0,
2109 doc: /* Make buffer BUFFER-OR-NAME current for editing operations.
2110 BUFFER-OR-NAME may be a buffer or the name of an existing buffer.
2111 See also `with-current-buffer' when you want to make a buffer current
2112 temporarily. This function does not display the buffer, so its effect
2113 ends when the current command terminates. Use `switch-to-buffer' or
2114 `pop-to-buffer' to switch buffers permanently.
2115 The return value is the buffer made current. */)
2116 (register Lisp_Object buffer_or_name)
2118 register Lisp_Object buffer;
2119 buffer = Fget_buffer (buffer_or_name);
2120 if (NILP (buffer))
2121 nsberror (buffer_or_name);
2122 if (!BUFFER_LIVE_P (XBUFFER (buffer)))
2123 error ("Selecting deleted buffer");
2124 set_buffer_internal (XBUFFER (buffer));
2125 return buffer;
2128 void
2129 restore_buffer (Lisp_Object buffer_or_name)
2131 Fset_buffer (buffer_or_name);
2134 /* Set the current buffer to BUFFER provided if it is alive. */
2136 void
2137 set_buffer_if_live (Lisp_Object buffer)
2139 if (BUFFER_LIVE_P (XBUFFER (buffer)))
2140 set_buffer_internal (XBUFFER (buffer));
2143 DEFUN ("barf-if-buffer-read-only", Fbarf_if_buffer_read_only,
2144 Sbarf_if_buffer_read_only, 0, 1, 0,
2145 doc: /* Signal a `buffer-read-only' error if the current buffer is read-only.
2146 If the text under POSITION (which defaults to point) has the
2147 `inhibit-read-only' text property set, the error will not be raised. */)
2148 (Lisp_Object position)
2150 if (NILP (position))
2151 XSETFASTINT (position, PT);
2152 else
2153 CHECK_NUMBER (position);
2155 if (!NILP (BVAR (current_buffer, read_only))
2156 && NILP (Vinhibit_read_only)
2157 && NILP (Fget_text_property (position, Qinhibit_read_only, Qnil)))
2158 xsignal1 (Qbuffer_read_only, Fcurrent_buffer ());
2159 return Qnil;
2162 DEFUN ("erase-buffer", Ferase_buffer, Serase_buffer, 0, 0, "*",
2163 doc: /* Delete the entire contents of the current buffer.
2164 Any narrowing restriction in effect (see `narrow-to-region') is removed,
2165 so the buffer is truly empty after this. */)
2166 (void)
2168 Fwiden ();
2170 del_range (BEG, Z);
2172 current_buffer->last_window_start = 1;
2173 /* Prevent warnings, or suspension of auto saving, that would happen
2174 if future size is less than past size. Use of erase-buffer
2175 implies that the future text is not really related to the past text. */
2176 XSETFASTINT (BVAR (current_buffer, save_length), 0);
2177 return Qnil;
2180 void
2181 validate_region (register Lisp_Object *b, register Lisp_Object *e)
2183 CHECK_NUMBER_COERCE_MARKER (*b);
2184 CHECK_NUMBER_COERCE_MARKER (*e);
2186 if (XINT (*b) > XINT (*e))
2188 Lisp_Object tem;
2189 tem = *b; *b = *e; *e = tem;
2192 if (! (BEGV <= XINT (*b) && XINT (*e) <= ZV))
2193 args_out_of_range_3 (Fcurrent_buffer (), *b, *e);
2196 /* Advance BYTE_POS up to a character boundary
2197 and return the adjusted position. */
2199 static ptrdiff_t
2200 advance_to_char_boundary (ptrdiff_t byte_pos)
2202 int c;
2204 if (byte_pos == BEG)
2205 /* Beginning of buffer is always a character boundary. */
2206 return BEG;
2208 c = FETCH_BYTE (byte_pos);
2209 if (! CHAR_HEAD_P (c))
2211 /* We should advance BYTE_POS only when C is a constituent of a
2212 multibyte sequence. */
2213 ptrdiff_t orig_byte_pos = byte_pos;
2217 byte_pos--;
2218 c = FETCH_BYTE (byte_pos);
2220 while (! CHAR_HEAD_P (c) && byte_pos > BEG);
2221 INC_POS (byte_pos);
2222 if (byte_pos < orig_byte_pos)
2223 byte_pos = orig_byte_pos;
2224 /* If C is a constituent of a multibyte sequence, BYTE_POS was
2225 surely advance to the correct character boundary. If C is
2226 not, BYTE_POS was unchanged. */
2229 return byte_pos;
2232 DEFUN ("buffer-swap-text", Fbuffer_swap_text, Sbuffer_swap_text,
2233 1, 1, 0,
2234 doc: /* Swap the text between current buffer and BUFFER.
2235 Using this function from `save-excursion' might produce surprising
2236 results, see Info node `(elisp)Swapping Text'. */)
2237 (Lisp_Object buffer)
2239 struct buffer *other_buffer;
2240 CHECK_BUFFER (buffer);
2241 other_buffer = XBUFFER (buffer);
2243 if (!BUFFER_LIVE_P (other_buffer))
2244 error ("Cannot swap a dead buffer's text");
2246 /* Actually, it probably works just fine.
2247 * if (other_buffer == current_buffer)
2248 * error ("Cannot swap a buffer's text with itself"); */
2250 /* Actually, this may be workable as well, tho probably only if they're
2251 *both* indirect. */
2252 if (other_buffer->base_buffer
2253 || current_buffer->base_buffer)
2254 error ("Cannot swap indirect buffers's text");
2256 { /* This is probably harder to make work. */
2257 struct buffer *other;
2258 FOR_EACH_BUFFER (other)
2259 if (other->base_buffer == other_buffer
2260 || other->base_buffer == current_buffer)
2261 error ("One of the buffers to swap has indirect buffers");
2264 #define swapfield(field, type) \
2265 do { \
2266 type tmp##field = other_buffer->field; \
2267 other_buffer->field = current_buffer->field; \
2268 current_buffer->field = tmp##field; \
2269 } while (0)
2270 #define swapfield_(field, type) \
2271 do { \
2272 type tmp##field = BVAR (other_buffer, field); \
2273 bset_##field (other_buffer, BVAR (current_buffer, field)); \
2274 bset_##field (current_buffer, tmp##field); \
2275 } while (0)
2277 swapfield (own_text, struct buffer_text);
2278 eassert (current_buffer->text == &current_buffer->own_text);
2279 eassert (other_buffer->text == &other_buffer->own_text);
2280 #ifdef REL_ALLOC
2281 r_alloc_reset_variable ((void **) &current_buffer->own_text.beg,
2282 (void **) &other_buffer->own_text.beg);
2283 r_alloc_reset_variable ((void **) &other_buffer->own_text.beg,
2284 (void **) &current_buffer->own_text.beg);
2285 #endif /* REL_ALLOC */
2287 swapfield (pt, ptrdiff_t);
2288 swapfield (pt_byte, ptrdiff_t);
2289 swapfield (begv, ptrdiff_t);
2290 swapfield (begv_byte, ptrdiff_t);
2291 swapfield (zv, ptrdiff_t);
2292 swapfield (zv_byte, ptrdiff_t);
2293 eassert (!current_buffer->base_buffer);
2294 eassert (!other_buffer->base_buffer);
2295 swapfield (indirections, ptrdiff_t);
2296 current_buffer->clip_changed = 1; other_buffer->clip_changed = 1;
2297 swapfield (newline_cache, struct region_cache *);
2298 swapfield (width_run_cache, struct region_cache *);
2299 swapfield (bidi_paragraph_cache, struct region_cache *);
2300 current_buffer->prevent_redisplay_optimizations_p = 1;
2301 other_buffer->prevent_redisplay_optimizations_p = 1;
2302 swapfield (overlays_before, struct Lisp_Overlay *);
2303 swapfield (overlays_after, struct Lisp_Overlay *);
2304 swapfield (overlay_center, ptrdiff_t);
2305 swapfield_ (undo_list, Lisp_Object);
2306 swapfield_ (mark, Lisp_Object);
2307 swapfield_ (enable_multibyte_characters, Lisp_Object);
2308 swapfield_ (bidi_display_reordering, Lisp_Object);
2309 swapfield_ (bidi_paragraph_direction, Lisp_Object);
2310 /* FIXME: Not sure what we should do with these *_marker fields.
2311 Hopefully they're just nil anyway. */
2312 swapfield_ (pt_marker, Lisp_Object);
2313 swapfield_ (begv_marker, Lisp_Object);
2314 swapfield_ (zv_marker, Lisp_Object);
2315 bset_point_before_scroll (current_buffer, Qnil);
2316 bset_point_before_scroll (other_buffer, Qnil);
2318 current_buffer->text->modiff++; other_buffer->text->modiff++;
2319 current_buffer->text->chars_modiff++; other_buffer->text->chars_modiff++;
2320 current_buffer->text->overlay_modiff++; other_buffer->text->overlay_modiff++;
2321 current_buffer->text->beg_unchanged = current_buffer->text->gpt;
2322 current_buffer->text->end_unchanged = current_buffer->text->gpt;
2323 other_buffer->text->beg_unchanged = other_buffer->text->gpt;
2324 other_buffer->text->end_unchanged = other_buffer->text->gpt;
2326 struct Lisp_Marker *m;
2327 for (m = BUF_MARKERS (current_buffer); m; m = m->next)
2328 if (m->buffer == other_buffer)
2329 m->buffer = current_buffer;
2330 else
2331 /* Since there's no indirect buffer in sight, markers on
2332 BUF_MARKERS(buf) should either be for `buf' or dead. */
2333 eassert (!m->buffer);
2334 for (m = BUF_MARKERS (other_buffer); m; m = m->next)
2335 if (m->buffer == current_buffer)
2336 m->buffer = other_buffer;
2337 else
2338 /* Since there's no indirect buffer in sight, markers on
2339 BUF_MARKERS(buf) should either be for `buf' or dead. */
2340 eassert (!m->buffer);
2342 { /* Some of the C code expects that both window markers of a
2343 live window points to that window's buffer. So since we
2344 just swapped the markers between the two buffers, we need
2345 to undo the effect of this swap for window markers. */
2346 Lisp_Object w = selected_window, ws = Qnil;
2347 Lisp_Object buf1, buf2;
2348 XSETBUFFER (buf1, current_buffer); XSETBUFFER (buf2, other_buffer);
2350 while (NILP (Fmemq (w, ws)))
2352 ws = Fcons (w, ws);
2353 if (MARKERP (XWINDOW (w)->pointm)
2354 && (EQ (XWINDOW (w)->contents, buf1)
2355 || EQ (XWINDOW (w)->contents, buf2)))
2356 Fset_marker (XWINDOW (w)->pointm,
2357 make_number
2358 (BUF_BEGV (XBUFFER (XWINDOW (w)->contents))),
2359 XWINDOW (w)->contents);
2360 /* Blindly copied from pointm part. */
2361 if (MARKERP (XWINDOW (w)->old_pointm)
2362 && (EQ (XWINDOW (w)->contents, buf1)
2363 || EQ (XWINDOW (w)->contents, buf2)))
2364 Fset_marker (XWINDOW (w)->old_pointm,
2365 make_number
2366 (BUF_BEGV (XBUFFER (XWINDOW (w)->contents))),
2367 XWINDOW (w)->contents);
2368 if (MARKERP (XWINDOW (w)->start)
2369 && (EQ (XWINDOW (w)->contents, buf1)
2370 || EQ (XWINDOW (w)->contents, buf2)))
2371 Fset_marker (XWINDOW (w)->start,
2372 make_number
2373 (XBUFFER (XWINDOW (w)->contents)->last_window_start),
2374 XWINDOW (w)->contents);
2375 w = Fnext_window (w, Qt, Qt);
2379 if (current_buffer->text->intervals)
2380 (eassert (EQ (current_buffer->text->intervals->up.obj, buffer)),
2381 XSETBUFFER (current_buffer->text->intervals->up.obj, current_buffer));
2382 if (other_buffer->text->intervals)
2383 (eassert (EQ (other_buffer->text->intervals->up.obj, Fcurrent_buffer ())),
2384 XSETBUFFER (other_buffer->text->intervals->up.obj, other_buffer));
2386 return Qnil;
2389 DEFUN ("set-buffer-multibyte", Fset_buffer_multibyte, Sset_buffer_multibyte,
2390 1, 1, 0,
2391 doc: /* Set the multibyte flag of the current buffer to FLAG.
2392 If FLAG is t, this makes the buffer a multibyte buffer.
2393 If FLAG is nil, this makes the buffer a single-byte buffer.
2394 In these cases, the buffer contents remain unchanged as a sequence of
2395 bytes but the contents viewed as characters do change.
2396 If FLAG is `to', this makes the buffer a multibyte buffer by changing
2397 all eight-bit bytes to eight-bit characters.
2398 If the multibyte flag was really changed, undo information of the
2399 current buffer is cleared. */)
2400 (Lisp_Object flag)
2402 struct Lisp_Marker *tail, *markers;
2403 struct buffer *other;
2404 ptrdiff_t begv, zv;
2405 bool narrowed = (BEG != BEGV || Z != ZV);
2406 bool modified_p = !NILP (Fbuffer_modified_p (Qnil));
2407 Lisp_Object old_undo = BVAR (current_buffer, undo_list);
2409 if (current_buffer->base_buffer)
2410 error ("Cannot do `set-buffer-multibyte' on an indirect buffer");
2412 /* Do nothing if nothing actually changes. */
2413 if (NILP (flag) == NILP (BVAR (current_buffer, enable_multibyte_characters)))
2414 return flag;
2416 /* Don't record these buffer changes. We will put a special undo entry
2417 instead. */
2418 bset_undo_list (current_buffer, Qt);
2420 /* If the cached position is for this buffer, clear it out. */
2421 clear_charpos_cache (current_buffer);
2423 if (NILP (flag))
2424 begv = BEGV_BYTE, zv = ZV_BYTE;
2425 else
2426 begv = BEGV, zv = ZV;
2428 if (narrowed)
2429 error ("Changing multibyteness in a narrowed buffer");
2431 invalidate_buffer_caches (current_buffer, BEGV, ZV);
2433 if (NILP (flag))
2435 ptrdiff_t pos, stop;
2436 unsigned char *p;
2438 /* Do this first, so it can use CHAR_TO_BYTE
2439 to calculate the old correspondences. */
2440 set_intervals_multibyte (0);
2442 bset_enable_multibyte_characters (current_buffer, Qnil);
2444 Z = Z_BYTE;
2445 BEGV = BEGV_BYTE;
2446 ZV = ZV_BYTE;
2447 GPT = GPT_BYTE;
2448 TEMP_SET_PT_BOTH (PT_BYTE, PT_BYTE);
2451 for (tail = BUF_MARKERS (current_buffer); tail; tail = tail->next)
2452 tail->charpos = tail->bytepos;
2454 /* Convert multibyte form of 8-bit characters to unibyte. */
2455 pos = BEG;
2456 stop = GPT;
2457 p = BEG_ADDR;
2458 while (1)
2460 int c, bytes;
2462 if (pos == stop)
2464 if (pos == Z)
2465 break;
2466 p = GAP_END_ADDR;
2467 stop = Z;
2469 if (ASCII_CHAR_P (*p))
2470 p++, pos++;
2471 else if (CHAR_BYTE8_HEAD_P (*p))
2473 c = STRING_CHAR_AND_LENGTH (p, bytes);
2474 /* Delete all bytes for this 8-bit character but the
2475 last one, and change the last one to the character
2476 code. */
2477 bytes--;
2478 del_range_2 (pos, pos, pos + bytes, pos + bytes, 0);
2479 p = GAP_END_ADDR;
2480 *p++ = c;
2481 pos++;
2482 if (begv > pos)
2483 begv -= bytes;
2484 if (zv > pos)
2485 zv -= bytes;
2486 stop = Z;
2488 else
2490 bytes = BYTES_BY_CHAR_HEAD (*p);
2491 p += bytes, pos += bytes;
2494 if (narrowed)
2495 Fnarrow_to_region (make_number (begv), make_number (zv));
2497 else
2499 ptrdiff_t pt = PT;
2500 ptrdiff_t pos, stop;
2501 unsigned char *p, *pend;
2503 /* Be sure not to have a multibyte sequence striding over the GAP.
2504 Ex: We change this: "...abc\302 _GAP_ \241def..."
2505 to: "...abc _GAP_ \302\241def..." */
2507 if (EQ (flag, Qt)
2508 && GPT_BYTE > 1 && GPT_BYTE < Z_BYTE
2509 && ! CHAR_HEAD_P (*(GAP_END_ADDR)))
2511 unsigned char *q = GPT_ADDR - 1;
2513 while (! CHAR_HEAD_P (*q) && q > BEG_ADDR) q--;
2514 if (LEADING_CODE_P (*q))
2516 ptrdiff_t new_gpt = GPT_BYTE - (GPT_ADDR - q);
2518 move_gap_both (new_gpt, new_gpt);
2522 /* Make the buffer contents valid as multibyte by converting
2523 8-bit characters to multibyte form. */
2524 pos = BEG;
2525 stop = GPT;
2526 p = BEG_ADDR;
2527 pend = GPT_ADDR;
2528 while (1)
2530 int bytes;
2532 if (pos == stop)
2534 if (pos == Z)
2535 break;
2536 p = GAP_END_ADDR;
2537 pend = Z_ADDR;
2538 stop = Z;
2541 if (ASCII_CHAR_P (*p))
2542 p++, pos++;
2543 else if (EQ (flag, Qt)
2544 && ! CHAR_BYTE8_HEAD_P (*p)
2545 && (bytes = MULTIBYTE_LENGTH (p, pend)) > 0)
2546 p += bytes, pos += bytes;
2547 else
2549 unsigned char tmp[MAX_MULTIBYTE_LENGTH];
2550 int c;
2552 c = BYTE8_TO_CHAR (*p);
2553 bytes = CHAR_STRING (c, tmp);
2554 *p = tmp[0];
2555 TEMP_SET_PT_BOTH (pos + 1, pos + 1);
2556 bytes--;
2557 insert_1_both ((char *) tmp + 1, bytes, bytes, 1, 0, 0);
2558 /* Now the gap is after the just inserted data. */
2559 pos = GPT;
2560 p = GAP_END_ADDR;
2561 if (pos <= begv)
2562 begv += bytes;
2563 if (pos <= zv)
2564 zv += bytes;
2565 if (pos <= pt)
2566 pt += bytes;
2567 pend = Z_ADDR;
2568 stop = Z;
2572 if (pt != PT)
2573 TEMP_SET_PT (pt);
2575 if (narrowed)
2576 Fnarrow_to_region (make_number (begv), make_number (zv));
2578 /* Do this first, so that chars_in_text asks the right question.
2579 set_intervals_multibyte needs it too. */
2580 bset_enable_multibyte_characters (current_buffer, Qt);
2582 GPT_BYTE = advance_to_char_boundary (GPT_BYTE);
2583 GPT = chars_in_text (BEG_ADDR, GPT_BYTE - BEG_BYTE) + BEG;
2585 Z = chars_in_text (GAP_END_ADDR, Z_BYTE - GPT_BYTE) + GPT;
2587 BEGV_BYTE = advance_to_char_boundary (BEGV_BYTE);
2588 if (BEGV_BYTE > GPT_BYTE)
2589 BEGV = chars_in_text (GAP_END_ADDR, BEGV_BYTE - GPT_BYTE) + GPT;
2590 else
2591 BEGV = chars_in_text (BEG_ADDR, BEGV_BYTE - BEG_BYTE) + BEG;
2593 ZV_BYTE = advance_to_char_boundary (ZV_BYTE);
2594 if (ZV_BYTE > GPT_BYTE)
2595 ZV = chars_in_text (GAP_END_ADDR, ZV_BYTE - GPT_BYTE) + GPT;
2596 else
2597 ZV = chars_in_text (BEG_ADDR, ZV_BYTE - BEG_BYTE) + BEG;
2600 ptrdiff_t byte = advance_to_char_boundary (PT_BYTE);
2601 ptrdiff_t position;
2603 if (byte > GPT_BYTE)
2604 position = chars_in_text (GAP_END_ADDR, byte - GPT_BYTE) + GPT;
2605 else
2606 position = chars_in_text (BEG_ADDR, byte - BEG_BYTE) + BEG;
2607 TEMP_SET_PT_BOTH (position, byte);
2610 tail = markers = BUF_MARKERS (current_buffer);
2612 /* This prevents BYTE_TO_CHAR (that is, buf_bytepos_to_charpos) from
2613 getting confused by the markers that have not yet been updated.
2614 It is also a signal that it should never create a marker. */
2615 BUF_MARKERS (current_buffer) = NULL;
2617 for (; tail; tail = tail->next)
2619 tail->bytepos = advance_to_char_boundary (tail->bytepos);
2620 tail->charpos = BYTE_TO_CHAR (tail->bytepos);
2623 /* Make sure no markers were put on the chain
2624 while the chain value was incorrect. */
2625 if (BUF_MARKERS (current_buffer))
2626 emacs_abort ();
2628 BUF_MARKERS (current_buffer) = markers;
2630 /* Do this last, so it can calculate the new correspondences
2631 between chars and bytes. */
2632 set_intervals_multibyte (1);
2635 if (!EQ (old_undo, Qt))
2637 /* Represent all the above changes by a special undo entry. */
2638 bset_undo_list (current_buffer,
2639 Fcons (list3 (Qapply,
2640 intern ("set-buffer-multibyte"),
2641 NILP (flag) ? Qt : Qnil),
2642 old_undo));
2645 current_buffer->prevent_redisplay_optimizations_p = 1;
2647 /* If buffer is shown in a window, let redisplay consider other windows. */
2648 if (buffer_window_count (current_buffer))
2649 windows_or_buffers_changed = 10;
2651 /* Copy this buffer's new multibyte status
2652 into all of its indirect buffers. */
2653 FOR_EACH_BUFFER (other)
2654 if (other->base_buffer == current_buffer && BUFFER_LIVE_P (other))
2656 BVAR (other, enable_multibyte_characters)
2657 = BVAR (current_buffer, enable_multibyte_characters);
2658 other->prevent_redisplay_optimizations_p = 1;
2661 /* Restore the modifiedness of the buffer. */
2662 if (!modified_p && !NILP (Fbuffer_modified_p (Qnil)))
2663 Fset_buffer_modified_p (Qnil);
2665 /* Update coding systems of this buffer's process (if any). */
2667 Lisp_Object process;
2669 process = Fget_buffer_process (Fcurrent_buffer ());
2670 if (PROCESSP (process))
2671 setup_process_coding_systems (process);
2674 return flag;
2677 DEFUN ("kill-all-local-variables", Fkill_all_local_variables,
2678 Skill_all_local_variables, 0, 0, 0,
2679 doc: /* Switch to Fundamental mode by killing current buffer's local variables.
2680 Most local variable bindings are eliminated so that the default values
2681 become effective once more. Also, the syntax table is set from
2682 `standard-syntax-table', the local keymap is set to nil,
2683 and the abbrev table from `fundamental-mode-abbrev-table'.
2684 This function also forces redisplay of the mode line.
2686 Every function to select a new major mode starts by
2687 calling this function.
2689 As a special exception, local variables whose names have
2690 a non-nil `permanent-local' property are not eliminated by this function.
2692 The first thing this function does is run
2693 the normal hook `change-major-mode-hook'. */)
2694 (void)
2696 run_hook (Qchange_major_mode_hook);
2698 /* Make sure none of the bindings in local_var_alist
2699 remain swapped in, in their symbols. */
2701 swap_out_buffer_local_variables (current_buffer);
2703 /* Actually eliminate all local bindings of this buffer. */
2705 reset_buffer_local_variables (current_buffer, 0);
2707 /* Force mode-line redisplay. Useful here because all major mode
2708 commands call this function. */
2709 update_mode_lines = 12;
2711 return Qnil;
2714 /* Make sure no local variables remain set up with buffer B
2715 for their current values. */
2717 static void
2718 swap_out_buffer_local_variables (struct buffer *b)
2720 Lisp_Object oalist, alist, buffer;
2722 XSETBUFFER (buffer, b);
2723 oalist = BVAR (b, local_var_alist);
2725 for (alist = oalist; CONSP (alist); alist = XCDR (alist))
2727 Lisp_Object sym = XCAR (XCAR (alist));
2728 eassert (XSYMBOL (sym)->redirect == SYMBOL_LOCALIZED);
2729 /* Need not do anything if some other buffer's binding is
2730 now cached. */
2731 if (EQ (SYMBOL_BLV (XSYMBOL (sym))->where, buffer))
2733 /* Symbol is set up for this buffer's old local value:
2734 swap it out! */
2735 swap_in_global_binding (XSYMBOL (sym));
2740 /* Find all the overlays in the current buffer that contain position POS.
2741 Return the number found, and store them in a vector in *VEC_PTR.
2742 Store in *LEN_PTR the size allocated for the vector.
2743 Store in *NEXT_PTR the next position after POS where an overlay starts,
2744 or ZV if there are no more overlays between POS and ZV.
2745 Store in *PREV_PTR the previous position before POS where an overlay ends,
2746 or where an overlay starts which ends at or after POS;
2747 or BEGV if there are no such overlays from BEGV to POS.
2748 NEXT_PTR and/or PREV_PTR may be 0, meaning don't store that info.
2750 *VEC_PTR and *LEN_PTR should contain a valid vector and size
2751 when this function is called.
2753 If EXTEND, make the vector bigger if necessary.
2754 If not, never extend the vector,
2755 and store only as many overlays as will fit.
2756 But still return the total number of overlays.
2758 If CHANGE_REQ, any position written into *PREV_PTR or
2759 *NEXT_PTR is guaranteed to be not equal to POS, unless it is the
2760 default (BEGV or ZV). */
2762 ptrdiff_t
2763 overlays_at (EMACS_INT pos, bool extend, Lisp_Object **vec_ptr,
2764 ptrdiff_t *len_ptr,
2765 ptrdiff_t *next_ptr, ptrdiff_t *prev_ptr, bool change_req)
2767 Lisp_Object overlay, start, end;
2768 struct Lisp_Overlay *tail;
2769 ptrdiff_t idx = 0;
2770 ptrdiff_t len = *len_ptr;
2771 Lisp_Object *vec = *vec_ptr;
2772 ptrdiff_t next = ZV;
2773 ptrdiff_t prev = BEGV;
2774 bool inhibit_storing = 0;
2776 for (tail = current_buffer->overlays_before; tail; tail = tail->next)
2778 ptrdiff_t startpos, endpos;
2780 XSETMISC (overlay, tail);
2782 start = OVERLAY_START (overlay);
2783 end = OVERLAY_END (overlay);
2784 endpos = OVERLAY_POSITION (end);
2785 if (endpos < pos)
2787 if (prev < endpos)
2788 prev = endpos;
2789 break;
2791 startpos = OVERLAY_POSITION (start);
2792 /* This one ends at or after POS
2793 so its start counts for PREV_PTR if it's before POS. */
2794 if (prev < startpos && startpos < pos)
2795 prev = startpos;
2796 if (endpos == pos)
2797 continue;
2798 if (startpos <= pos)
2800 if (idx == len)
2802 /* The supplied vector is full.
2803 Either make it bigger, or don't store any more in it. */
2804 if (extend)
2806 vec = xpalloc (vec, len_ptr, 1, OVERLAY_COUNT_MAX,
2807 sizeof *vec);
2808 *vec_ptr = vec;
2809 len = *len_ptr;
2811 else
2812 inhibit_storing = 1;
2815 if (!inhibit_storing)
2816 vec[idx] = overlay;
2817 /* Keep counting overlays even if we can't return them all. */
2818 idx++;
2820 else if (startpos < next)
2821 next = startpos;
2824 for (tail = current_buffer->overlays_after; tail; tail = tail->next)
2826 ptrdiff_t startpos, endpos;
2828 XSETMISC (overlay, tail);
2830 start = OVERLAY_START (overlay);
2831 end = OVERLAY_END (overlay);
2832 startpos = OVERLAY_POSITION (start);
2833 if (pos < startpos)
2835 if (startpos < next)
2836 next = startpos;
2837 break;
2839 endpos = OVERLAY_POSITION (end);
2840 if (pos < endpos)
2842 if (idx == len)
2844 if (extend)
2846 vec = xpalloc (vec, len_ptr, 1, OVERLAY_COUNT_MAX,
2847 sizeof *vec);
2848 *vec_ptr = vec;
2849 len = *len_ptr;
2851 else
2852 inhibit_storing = 1;
2855 if (!inhibit_storing)
2856 vec[idx] = overlay;
2857 idx++;
2859 if (startpos < pos && startpos > prev)
2860 prev = startpos;
2862 else if (endpos < pos && endpos > prev)
2863 prev = endpos;
2864 else if (endpos == pos && startpos > prev
2865 && (!change_req || startpos < pos))
2866 prev = startpos;
2869 if (next_ptr)
2870 *next_ptr = next;
2871 if (prev_ptr)
2872 *prev_ptr = prev;
2873 return idx;
2876 /* Find all the overlays in the current buffer that overlap the range
2877 BEG-END, or are empty at BEG, or are empty at END provided END
2878 denotes the position at the end of the current buffer.
2880 Return the number found, and store them in a vector in *VEC_PTR.
2881 Store in *LEN_PTR the size allocated for the vector.
2882 Store in *NEXT_PTR the next position after POS where an overlay starts,
2883 or ZV if there are no more overlays.
2884 Store in *PREV_PTR the previous position before POS where an overlay ends,
2885 or BEGV if there are no previous overlays.
2886 NEXT_PTR and/or PREV_PTR may be 0, meaning don't store that info.
2888 *VEC_PTR and *LEN_PTR should contain a valid vector and size
2889 when this function is called.
2891 If EXTEND, make the vector bigger if necessary.
2892 If not, never extend the vector,
2893 and store only as many overlays as will fit.
2894 But still return the total number of overlays. */
2896 static ptrdiff_t
2897 overlays_in (EMACS_INT beg, EMACS_INT end, bool extend,
2898 Lisp_Object **vec_ptr, ptrdiff_t *len_ptr,
2899 ptrdiff_t *next_ptr, ptrdiff_t *prev_ptr)
2901 Lisp_Object overlay, ostart, oend;
2902 struct Lisp_Overlay *tail;
2903 ptrdiff_t idx = 0;
2904 ptrdiff_t len = *len_ptr;
2905 Lisp_Object *vec = *vec_ptr;
2906 ptrdiff_t next = ZV;
2907 ptrdiff_t prev = BEGV;
2908 bool inhibit_storing = 0;
2909 bool end_is_Z = end == Z;
2911 for (tail = current_buffer->overlays_before; tail; tail = tail->next)
2913 ptrdiff_t startpos, endpos;
2915 XSETMISC (overlay, tail);
2917 ostart = OVERLAY_START (overlay);
2918 oend = OVERLAY_END (overlay);
2919 endpos = OVERLAY_POSITION (oend);
2920 if (endpos < beg)
2922 if (prev < endpos)
2923 prev = endpos;
2924 break;
2926 startpos = OVERLAY_POSITION (ostart);
2927 /* Count an interval if it overlaps the range, is empty at the
2928 start of the range, or is empty at END provided END denotes the
2929 end of the buffer. */
2930 if ((beg < endpos && startpos < end)
2931 || (startpos == endpos
2932 && (beg == endpos || (end_is_Z && endpos == end))))
2934 if (idx == len)
2936 /* The supplied vector is full.
2937 Either make it bigger, or don't store any more in it. */
2938 if (extend)
2940 vec = xpalloc (vec, len_ptr, 1, OVERLAY_COUNT_MAX,
2941 sizeof *vec);
2942 *vec_ptr = vec;
2943 len = *len_ptr;
2945 else
2946 inhibit_storing = 1;
2949 if (!inhibit_storing)
2950 vec[idx] = overlay;
2951 /* Keep counting overlays even if we can't return them all. */
2952 idx++;
2954 else if (startpos < next)
2955 next = startpos;
2958 for (tail = current_buffer->overlays_after; tail; tail = tail->next)
2960 ptrdiff_t startpos, endpos;
2962 XSETMISC (overlay, tail);
2964 ostart = OVERLAY_START (overlay);
2965 oend = OVERLAY_END (overlay);
2966 startpos = OVERLAY_POSITION (ostart);
2967 if (end < startpos)
2969 if (startpos < next)
2970 next = startpos;
2971 break;
2973 endpos = OVERLAY_POSITION (oend);
2974 /* Count an interval if it overlaps the range, is empty at the
2975 start of the range, or is empty at END provided END denotes the
2976 end of the buffer. */
2977 if ((beg < endpos && startpos < end)
2978 || (startpos == endpos
2979 && (beg == endpos || (end_is_Z && endpos == end))))
2981 if (idx == len)
2983 if (extend)
2985 vec = xpalloc (vec, len_ptr, 1, OVERLAY_COUNT_MAX,
2986 sizeof *vec);
2987 *vec_ptr = vec;
2988 len = *len_ptr;
2990 else
2991 inhibit_storing = 1;
2994 if (!inhibit_storing)
2995 vec[idx] = overlay;
2996 idx++;
2998 else if (endpos < beg && endpos > prev)
2999 prev = endpos;
3002 if (next_ptr)
3003 *next_ptr = next;
3004 if (prev_ptr)
3005 *prev_ptr = prev;
3006 return idx;
3010 /* Return true if there exists an overlay with a non-nil
3011 `mouse-face' property overlapping OVERLAY. */
3013 bool
3014 mouse_face_overlay_overlaps (Lisp_Object overlay)
3016 ptrdiff_t start = OVERLAY_POSITION (OVERLAY_START (overlay));
3017 ptrdiff_t end = OVERLAY_POSITION (OVERLAY_END (overlay));
3018 ptrdiff_t n, i, size;
3019 Lisp_Object *v, tem;
3020 Lisp_Object vbuf[10];
3021 USE_SAFE_ALLOCA;
3023 size = ARRAYELTS (vbuf);
3024 v = vbuf;
3025 n = overlays_in (start, end, 0, &v, &size, NULL, NULL);
3026 if (n > size)
3028 SAFE_NALLOCA (v, 1, n);
3029 overlays_in (start, end, 0, &v, &n, NULL, NULL);
3032 for (i = 0; i < n; ++i)
3033 if (!EQ (v[i], overlay)
3034 && (tem = Foverlay_get (overlay, Qmouse_face),
3035 !NILP (tem)))
3036 break;
3038 SAFE_FREE ();
3039 return i < n;
3044 /* Fast function to just test if we're at an overlay boundary. */
3045 bool
3046 overlay_touches_p (ptrdiff_t pos)
3048 Lisp_Object overlay;
3049 struct Lisp_Overlay *tail;
3051 for (tail = current_buffer->overlays_before; tail; tail = tail->next)
3053 ptrdiff_t endpos;
3055 XSETMISC (overlay ,tail);
3056 eassert (OVERLAYP (overlay));
3058 endpos = OVERLAY_POSITION (OVERLAY_END (overlay));
3059 if (endpos < pos)
3060 break;
3061 if (endpos == pos || OVERLAY_POSITION (OVERLAY_START (overlay)) == pos)
3062 return 1;
3065 for (tail = current_buffer->overlays_after; tail; tail = tail->next)
3067 ptrdiff_t startpos;
3069 XSETMISC (overlay, tail);
3070 eassert (OVERLAYP (overlay));
3072 startpos = OVERLAY_POSITION (OVERLAY_START (overlay));
3073 if (pos < startpos)
3074 break;
3075 if (startpos == pos || OVERLAY_POSITION (OVERLAY_END (overlay)) == pos)
3076 return 1;
3078 return 0;
3081 struct sortvec
3083 Lisp_Object overlay;
3084 ptrdiff_t beg, end;
3085 EMACS_INT priority;
3086 EMACS_INT spriority; /* Secondary priority. */
3089 static int
3090 compare_overlays (const void *v1, const void *v2)
3092 const struct sortvec *s1 = v1;
3093 const struct sortvec *s2 = v2;
3094 /* Return 1 if s1 should take precedence, -1 if v2 should take precedence,
3095 and 0 if they're equal. */
3096 if (s1->priority != s2->priority)
3097 return s1->priority < s2->priority ? -1 : 1;
3098 /* If the priority is equal, give precedence to the one not covered by the
3099 other. If neither covers the other, obey spriority. */
3100 else if (s1->beg < s2->beg)
3101 return (s1->end < s2->end && s1->spriority > s2->spriority ? 1 : -1);
3102 else if (s1->beg > s2->beg)
3103 return (s1->end > s2->end && s1->spriority < s2->spriority ? -1 : 1);
3104 else if (s1->end != s2->end)
3105 return s2->end < s1->end ? -1 : 1;
3106 else if (s1->spriority != s2->spriority)
3107 return (s1->spriority < s2->spriority ? -1 : 1);
3108 else if (EQ (s1->overlay, s2->overlay))
3109 return 0;
3110 else
3111 /* Avoid the non-determinism of qsort by choosing an arbitrary ordering
3112 between "equal" overlays. The result can still change between
3113 invocations of Emacs, but it won't change in the middle of
3114 `find_field' (bug#6830). */
3115 return XLI (s1->overlay) < XLI (s2->overlay) ? -1 : 1;
3118 /* Sort an array of overlays by priority. The array is modified in place.
3119 The return value is the new size; this may be smaller than the original
3120 size if some of the overlays were invalid or were window-specific. */
3121 ptrdiff_t
3122 sort_overlays (Lisp_Object *overlay_vec, ptrdiff_t noverlays, struct window *w)
3124 ptrdiff_t i, j;
3125 USE_SAFE_ALLOCA;
3126 struct sortvec *sortvec;
3128 SAFE_NALLOCA (sortvec, 1, noverlays);
3130 /* Put the valid and relevant overlays into sortvec. */
3132 for (i = 0, j = 0; i < noverlays; i++)
3134 Lisp_Object tem;
3135 Lisp_Object overlay;
3137 overlay = overlay_vec[i];
3138 if (OVERLAYP (overlay)
3139 && OVERLAY_POSITION (OVERLAY_START (overlay)) > 0
3140 && OVERLAY_POSITION (OVERLAY_END (overlay)) > 0)
3142 /* If we're interested in a specific window, then ignore
3143 overlays that are limited to some other window. */
3144 if (w)
3146 Lisp_Object window;
3148 window = Foverlay_get (overlay, Qwindow);
3149 if (WINDOWP (window) && XWINDOW (window) != w)
3150 continue;
3153 /* This overlay is good and counts: put it into sortvec. */
3154 sortvec[j].overlay = overlay;
3155 sortvec[j].beg = OVERLAY_POSITION (OVERLAY_START (overlay));
3156 sortvec[j].end = OVERLAY_POSITION (OVERLAY_END (overlay));
3157 tem = Foverlay_get (overlay, Qpriority);
3158 if (NILP (tem))
3160 sortvec[j].priority = 0;
3161 sortvec[j].spriority = 0;
3163 else if (INTEGERP (tem))
3165 sortvec[j].priority = XINT (tem);
3166 sortvec[j].spriority = 0;
3168 else if (CONSP (tem))
3170 Lisp_Object car = XCAR (tem);
3171 Lisp_Object cdr = XCDR (tem);
3172 sortvec[j].priority = INTEGERP (car) ? XINT (car) : 0;
3173 sortvec[j].spriority = INTEGERP (cdr) ? XINT (cdr) : 0;
3175 j++;
3178 noverlays = j;
3180 /* Sort the overlays into the proper order: increasing priority. */
3182 if (noverlays > 1)
3183 qsort (sortvec, noverlays, sizeof (struct sortvec), compare_overlays);
3185 for (i = 0; i < noverlays; i++)
3186 overlay_vec[i] = sortvec[i].overlay;
3188 SAFE_FREE ();
3189 return (noverlays);
3192 struct sortstr
3194 Lisp_Object string, string2;
3195 ptrdiff_t size;
3196 EMACS_INT priority;
3199 struct sortstrlist
3201 struct sortstr *buf; /* An array that expands as needed; never freed. */
3202 ptrdiff_t size; /* Allocated length of that array. */
3203 ptrdiff_t used; /* How much of the array is currently in use. */
3204 ptrdiff_t bytes; /* Total length of the strings in buf. */
3207 /* Buffers for storing information about the overlays touching a given
3208 position. These could be automatic variables in overlay_strings, but
3209 it's more efficient to hold onto the memory instead of repeatedly
3210 allocating and freeing it. */
3211 static struct sortstrlist overlay_heads, overlay_tails;
3212 static unsigned char *overlay_str_buf;
3214 /* Allocated length of overlay_str_buf. */
3215 static ptrdiff_t overlay_str_len;
3217 /* A comparison function suitable for passing to qsort. */
3218 static int
3219 cmp_for_strings (const void *as1, const void *as2)
3221 struct sortstr const *s1 = as1;
3222 struct sortstr const *s2 = as2;
3223 if (s1->size != s2->size)
3224 return s2->size < s1->size ? -1 : 1;
3225 if (s1->priority != s2->priority)
3226 return s1->priority < s2->priority ? -1 : 1;
3227 return 0;
3230 static void
3231 record_overlay_string (struct sortstrlist *ssl, Lisp_Object str,
3232 Lisp_Object str2, Lisp_Object pri, ptrdiff_t size)
3234 ptrdiff_t nbytes;
3236 if (ssl->used == ssl->size)
3237 ssl->buf = xpalloc (ssl->buf, &ssl->size, 5, -1, sizeof *ssl->buf);
3238 ssl->buf[ssl->used].string = str;
3239 ssl->buf[ssl->used].string2 = str2;
3240 ssl->buf[ssl->used].size = size;
3241 ssl->buf[ssl->used].priority = (INTEGERP (pri) ? XINT (pri) : 0);
3242 ssl->used++;
3244 if (NILP (BVAR (current_buffer, enable_multibyte_characters)))
3245 nbytes = SCHARS (str);
3246 else if (! STRING_MULTIBYTE (str))
3247 nbytes = count_size_as_multibyte (SDATA (str),
3248 SBYTES (str));
3249 else
3250 nbytes = SBYTES (str);
3252 if (INT_ADD_WRAPV (ssl->bytes, nbytes, &nbytes))
3253 memory_full (SIZE_MAX);
3254 ssl->bytes = nbytes;
3256 if (STRINGP (str2))
3258 if (NILP (BVAR (current_buffer, enable_multibyte_characters)))
3259 nbytes = SCHARS (str2);
3260 else if (! STRING_MULTIBYTE (str2))
3261 nbytes = count_size_as_multibyte (SDATA (str2),
3262 SBYTES (str2));
3263 else
3264 nbytes = SBYTES (str2);
3266 if (INT_ADD_WRAPV (ssl->bytes, nbytes, &nbytes))
3267 memory_full (SIZE_MAX);
3268 ssl->bytes = nbytes;
3272 /* Concatenate the strings associated with overlays that begin or end
3273 at POS, ignoring overlays that are specific to windows other than W.
3274 The strings are concatenated in the appropriate order: shorter
3275 overlays nest inside longer ones, and higher priority inside lower.
3276 Normally all of the after-strings come first, but zero-sized
3277 overlays have their after-strings ride along with the
3278 before-strings because it would look strange to print them
3279 inside-out.
3281 Returns the concatenated string's length, and return the pointer to
3282 that string via PSTR, if that variable is non-NULL. The storage of
3283 the concatenated strings may be overwritten by subsequent calls. */
3285 ptrdiff_t
3286 overlay_strings (ptrdiff_t pos, struct window *w, unsigned char **pstr)
3288 Lisp_Object overlay, window, str;
3289 struct Lisp_Overlay *ov;
3290 ptrdiff_t startpos, endpos;
3291 bool multibyte = ! NILP (BVAR (current_buffer, enable_multibyte_characters));
3293 overlay_heads.used = overlay_heads.bytes = 0;
3294 overlay_tails.used = overlay_tails.bytes = 0;
3295 for (ov = current_buffer->overlays_before; ov; ov = ov->next)
3297 XSETMISC (overlay, ov);
3298 eassert (OVERLAYP (overlay));
3300 startpos = OVERLAY_POSITION (OVERLAY_START (overlay));
3301 endpos = OVERLAY_POSITION (OVERLAY_END (overlay));
3302 if (endpos < pos)
3303 break;
3304 if (endpos != pos && startpos != pos)
3305 continue;
3306 window = Foverlay_get (overlay, Qwindow);
3307 if (WINDOWP (window) && XWINDOW (window) != w)
3308 continue;
3309 if (startpos == pos
3310 && (str = Foverlay_get (overlay, Qbefore_string), STRINGP (str)))
3311 record_overlay_string (&overlay_heads, str,
3312 (startpos == endpos
3313 ? Foverlay_get (overlay, Qafter_string)
3314 : Qnil),
3315 Foverlay_get (overlay, Qpriority),
3316 endpos - startpos);
3317 else if (endpos == pos
3318 && (str = Foverlay_get (overlay, Qafter_string), STRINGP (str)))
3319 record_overlay_string (&overlay_tails, str, Qnil,
3320 Foverlay_get (overlay, Qpriority),
3321 endpos - startpos);
3323 for (ov = current_buffer->overlays_after; ov; ov = ov->next)
3325 XSETMISC (overlay, ov);
3326 eassert (OVERLAYP (overlay));
3328 startpos = OVERLAY_POSITION (OVERLAY_START (overlay));
3329 endpos = OVERLAY_POSITION (OVERLAY_END (overlay));
3330 if (startpos > pos)
3331 break;
3332 if (endpos != pos && startpos != pos)
3333 continue;
3334 window = Foverlay_get (overlay, Qwindow);
3335 if (WINDOWP (window) && XWINDOW (window) != w)
3336 continue;
3337 if (startpos == pos
3338 && (str = Foverlay_get (overlay, Qbefore_string), STRINGP (str)))
3339 record_overlay_string (&overlay_heads, str,
3340 (startpos == endpos
3341 ? Foverlay_get (overlay, Qafter_string)
3342 : Qnil),
3343 Foverlay_get (overlay, Qpriority),
3344 endpos - startpos);
3345 else if (endpos == pos
3346 && (str = Foverlay_get (overlay, Qafter_string), STRINGP (str)))
3347 record_overlay_string (&overlay_tails, str, Qnil,
3348 Foverlay_get (overlay, Qpriority),
3349 endpos - startpos);
3351 if (overlay_tails.used > 1)
3352 qsort (overlay_tails.buf, overlay_tails.used, sizeof (struct sortstr),
3353 cmp_for_strings);
3354 if (overlay_heads.used > 1)
3355 qsort (overlay_heads.buf, overlay_heads.used, sizeof (struct sortstr),
3356 cmp_for_strings);
3357 if (overlay_heads.bytes || overlay_tails.bytes)
3359 Lisp_Object tem;
3360 ptrdiff_t i;
3361 unsigned char *p;
3362 ptrdiff_t total;
3364 if (INT_ADD_WRAPV (overlay_heads.bytes, overlay_tails.bytes, &total))
3365 memory_full (SIZE_MAX);
3366 if (total > overlay_str_len)
3367 overlay_str_buf = xpalloc (overlay_str_buf, &overlay_str_len,
3368 total - overlay_str_len, -1, 1);
3370 p = overlay_str_buf;
3371 for (i = overlay_tails.used; --i >= 0;)
3373 ptrdiff_t nbytes;
3374 tem = overlay_tails.buf[i].string;
3375 nbytes = copy_text (SDATA (tem), p,
3376 SBYTES (tem),
3377 STRING_MULTIBYTE (tem), multibyte);
3378 p += nbytes;
3380 for (i = 0; i < overlay_heads.used; ++i)
3382 ptrdiff_t nbytes;
3383 tem = overlay_heads.buf[i].string;
3384 nbytes = copy_text (SDATA (tem), p,
3385 SBYTES (tem),
3386 STRING_MULTIBYTE (tem), multibyte);
3387 p += nbytes;
3388 tem = overlay_heads.buf[i].string2;
3389 if (STRINGP (tem))
3391 nbytes = copy_text (SDATA (tem), p,
3392 SBYTES (tem),
3393 STRING_MULTIBYTE (tem), multibyte);
3394 p += nbytes;
3397 if (p != overlay_str_buf + total)
3398 emacs_abort ();
3399 if (pstr)
3400 *pstr = overlay_str_buf;
3401 return total;
3403 return 0;
3406 /* Shift overlays in BUF's overlay lists, to center the lists at POS. */
3408 void
3409 recenter_overlay_lists (struct buffer *buf, ptrdiff_t pos)
3411 Lisp_Object overlay, beg, end;
3412 struct Lisp_Overlay *prev, *tail, *next;
3414 /* See if anything in overlays_before should move to overlays_after. */
3416 /* We don't strictly need prev in this loop; it should always be nil.
3417 But we use it for symmetry and in case that should cease to be true
3418 with some future change. */
3419 prev = NULL;
3420 for (tail = buf->overlays_before; tail; prev = tail, tail = next)
3422 next = tail->next;
3423 XSETMISC (overlay, tail);
3424 eassert (OVERLAYP (overlay));
3426 beg = OVERLAY_START (overlay);
3427 end = OVERLAY_END (overlay);
3429 if (OVERLAY_POSITION (end) > pos)
3431 /* OVERLAY needs to be moved. */
3432 ptrdiff_t where = OVERLAY_POSITION (beg);
3433 struct Lisp_Overlay *other, *other_prev;
3435 /* Splice the cons cell TAIL out of overlays_before. */
3436 if (prev)
3437 prev->next = next;
3438 else
3439 set_buffer_overlays_before (buf, next);
3441 /* Search thru overlays_after for where to put it. */
3442 other_prev = NULL;
3443 for (other = buf->overlays_after; other;
3444 other_prev = other, other = other->next)
3446 Lisp_Object otherbeg, otheroverlay;
3448 XSETMISC (otheroverlay, other);
3449 eassert (OVERLAYP (otheroverlay));
3451 otherbeg = OVERLAY_START (otheroverlay);
3452 if (OVERLAY_POSITION (otherbeg) >= where)
3453 break;
3456 /* Add TAIL to overlays_after before OTHER. */
3457 tail->next = other;
3458 if (other_prev)
3459 other_prev->next = tail;
3460 else
3461 set_buffer_overlays_after (buf, tail);
3462 tail = prev;
3464 else
3465 /* We've reached the things that should stay in overlays_before.
3466 All the rest of overlays_before must end even earlier,
3467 so stop now. */
3468 break;
3471 /* See if anything in overlays_after should be in overlays_before. */
3472 prev = NULL;
3473 for (tail = buf->overlays_after; tail; prev = tail, tail = next)
3475 next = tail->next;
3476 XSETMISC (overlay, tail);
3477 eassert (OVERLAYP (overlay));
3479 beg = OVERLAY_START (overlay);
3480 end = OVERLAY_END (overlay);
3482 /* Stop looking, when we know that nothing further
3483 can possibly end before POS. */
3484 if (OVERLAY_POSITION (beg) > pos)
3485 break;
3487 if (OVERLAY_POSITION (end) <= pos)
3489 /* OVERLAY needs to be moved. */
3490 ptrdiff_t where = OVERLAY_POSITION (end);
3491 struct Lisp_Overlay *other, *other_prev;
3493 /* Splice the cons cell TAIL out of overlays_after. */
3494 if (prev)
3495 prev->next = next;
3496 else
3497 set_buffer_overlays_after (buf, next);
3499 /* Search thru overlays_before for where to put it. */
3500 other_prev = NULL;
3501 for (other = buf->overlays_before; other;
3502 other_prev = other, other = other->next)
3504 Lisp_Object otherend, otheroverlay;
3506 XSETMISC (otheroverlay, other);
3507 eassert (OVERLAYP (otheroverlay));
3509 otherend = OVERLAY_END (otheroverlay);
3510 if (OVERLAY_POSITION (otherend) <= where)
3511 break;
3514 /* Add TAIL to overlays_before before OTHER. */
3515 tail->next = other;
3516 if (other_prev)
3517 other_prev->next = tail;
3518 else
3519 set_buffer_overlays_before (buf, tail);
3520 tail = prev;
3524 buf->overlay_center = pos;
3527 void
3528 adjust_overlays_for_insert (ptrdiff_t pos, ptrdiff_t length)
3530 /* After an insertion, the lists are still sorted properly,
3531 but we may need to update the value of the overlay center. */
3532 if (current_buffer->overlay_center >= pos)
3533 current_buffer->overlay_center += length;
3536 void
3537 adjust_overlays_for_delete (ptrdiff_t pos, ptrdiff_t length)
3539 if (current_buffer->overlay_center < pos)
3540 /* The deletion was to our right. No change needed; the before- and
3541 after-lists are still consistent. */
3543 else if (current_buffer->overlay_center - pos > length)
3544 /* The deletion was to our left. We need to adjust the center value
3545 to account for the change in position, but the lists are consistent
3546 given the new value. */
3547 current_buffer->overlay_center -= length;
3548 else
3549 /* We're right in the middle. There might be things on the after-list
3550 that now belong on the before-list. Recentering will move them,
3551 and also update the center point. */
3552 recenter_overlay_lists (current_buffer, pos);
3555 /* Fix up overlays that were garbled as a result of permuting markers
3556 in the range START through END. Any overlay with at least one
3557 endpoint in this range will need to be unlinked from the overlay
3558 list and reinserted in its proper place.
3559 Such an overlay might even have negative size at this point.
3560 If so, we'll make the overlay empty. */
3561 void
3562 fix_start_end_in_overlays (register ptrdiff_t start, register ptrdiff_t end)
3564 Lisp_Object overlay;
3565 struct Lisp_Overlay *before_list IF_LINT (= NULL);
3566 struct Lisp_Overlay *after_list IF_LINT (= NULL);
3567 /* These are either nil, indicating that before_list or after_list
3568 should be assigned, or the cons cell the cdr of which should be
3569 assigned. */
3570 struct Lisp_Overlay *beforep = NULL, *afterp = NULL;
3571 /* 'Parent', likewise, indicates a cons cell or
3572 current_buffer->overlays_before or overlays_after, depending
3573 which loop we're in. */
3574 struct Lisp_Overlay *tail, *parent;
3575 ptrdiff_t startpos, endpos;
3577 /* This algorithm shifts links around instead of consing and GCing.
3578 The loop invariant is that before_list (resp. after_list) is a
3579 well-formed list except that its last element, the CDR of beforep
3580 (resp. afterp) if beforep (afterp) isn't nil or before_list
3581 (after_list) if it is, is still uninitialized. So it's not a bug
3582 that before_list isn't initialized, although it may look
3583 strange. */
3584 for (parent = NULL, tail = current_buffer->overlays_before; tail;)
3586 XSETMISC (overlay, tail);
3588 endpos = OVERLAY_POSITION (OVERLAY_END (overlay));
3589 startpos = OVERLAY_POSITION (OVERLAY_START (overlay));
3591 /* If the overlay is backwards, make it empty. */
3592 if (endpos < startpos)
3594 startpos = endpos;
3595 Fset_marker (OVERLAY_START (overlay), make_number (startpos),
3596 Qnil);
3599 if (endpos < start)
3600 break;
3602 if (endpos < end
3603 || (startpos >= start && startpos < end))
3605 /* Add it to the end of the wrong list. Later on,
3606 recenter_overlay_lists will move it to the right place. */
3607 if (endpos < current_buffer->overlay_center)
3609 if (!afterp)
3610 after_list = tail;
3611 else
3612 afterp->next = tail;
3613 afterp = tail;
3615 else
3617 if (!beforep)
3618 before_list = tail;
3619 else
3620 beforep->next = tail;
3621 beforep = tail;
3623 if (!parent)
3624 set_buffer_overlays_before (current_buffer, tail->next);
3625 else
3626 parent->next = tail->next;
3627 tail = tail->next;
3629 else
3630 parent = tail, tail = parent->next;
3632 for (parent = NULL, tail = current_buffer->overlays_after; tail;)
3634 XSETMISC (overlay, tail);
3636 startpos = OVERLAY_POSITION (OVERLAY_START (overlay));
3637 endpos = OVERLAY_POSITION (OVERLAY_END (overlay));
3639 /* If the overlay is backwards, make it empty. */
3640 if (endpos < startpos)
3642 startpos = endpos;
3643 Fset_marker (OVERLAY_START (overlay), make_number (startpos),
3644 Qnil);
3647 if (startpos >= end)
3648 break;
3650 if (startpos >= start
3651 || (endpos >= start && endpos < end))
3653 if (endpos < current_buffer->overlay_center)
3655 if (!afterp)
3656 after_list = tail;
3657 else
3658 afterp->next = tail;
3659 afterp = tail;
3661 else
3663 if (!beforep)
3664 before_list = tail;
3665 else
3666 beforep->next = tail;
3667 beforep = tail;
3669 if (!parent)
3670 set_buffer_overlays_after (current_buffer, tail->next);
3671 else
3672 parent->next = tail->next;
3673 tail = tail->next;
3675 else
3676 parent = tail, tail = parent->next;
3679 /* Splice the constructed (wrong) lists into the buffer's lists,
3680 and let the recenter function make it sane again. */
3681 if (beforep)
3683 beforep->next = current_buffer->overlays_before;
3684 set_buffer_overlays_before (current_buffer, before_list);
3687 if (afterp)
3689 afterp->next = current_buffer->overlays_after;
3690 set_buffer_overlays_after (current_buffer, after_list);
3692 recenter_overlay_lists (current_buffer, current_buffer->overlay_center);
3695 /* We have two types of overlay: the one whose ending marker is
3696 after-insertion-marker (this is the usual case) and the one whose
3697 ending marker is before-insertion-marker. When `overlays_before'
3698 contains overlays of the latter type and the former type in this
3699 order and both overlays end at inserting position, inserting a text
3700 increases only the ending marker of the latter type, which results
3701 in incorrect ordering of `overlays_before'.
3703 This function fixes ordering of overlays in the slot
3704 `overlays_before' of the buffer *BP. Before the insertion, `point'
3705 was at PREV, and now is at POS. */
3707 void
3708 fix_overlays_before (struct buffer *bp, ptrdiff_t prev, ptrdiff_t pos)
3710 /* If parent is nil, replace overlays_before; otherwise, parent->next. */
3711 struct Lisp_Overlay *tail = bp->overlays_before, *parent = NULL, *right_pair;
3712 Lisp_Object tem;
3713 ptrdiff_t end IF_LINT (= 0);
3715 /* After the insertion, the several overlays may be in incorrect
3716 order. The possibility is that, in the list `overlays_before',
3717 an overlay which ends at POS appears after an overlay which ends
3718 at PREV. Since POS is greater than PREV, we must fix the
3719 ordering of these overlays, by moving overlays ends at POS before
3720 the overlays ends at PREV. */
3722 /* At first, find a place where disordered overlays should be linked
3723 in. It is where an overlay which end before POS exists. (i.e. an
3724 overlay whose ending marker is after-insertion-marker if disorder
3725 exists). */
3726 while (tail
3727 && (XSETMISC (tem, tail),
3728 (end = OVERLAY_POSITION (OVERLAY_END (tem))) >= pos))
3730 parent = tail;
3731 tail = tail->next;
3734 /* If we don't find such an overlay,
3735 or the found one ends before PREV,
3736 or the found one is the last one in the list,
3737 we don't have to fix anything. */
3738 if (!tail || end < prev || !tail->next)
3739 return;
3741 right_pair = parent;
3742 parent = tail;
3743 tail = tail->next;
3745 /* Now, end position of overlays in the list TAIL should be before
3746 or equal to PREV. In the loop, an overlay which ends at POS is
3747 moved ahead to the place indicated by the CDR of RIGHT_PAIR. If
3748 we found an overlay which ends before PREV, the remaining
3749 overlays are in correct order. */
3750 while (tail)
3752 XSETMISC (tem, tail);
3753 end = OVERLAY_POSITION (OVERLAY_END (tem));
3755 if (end == pos)
3756 { /* This overlay is disordered. */
3757 struct Lisp_Overlay *found = tail;
3759 /* Unlink the found overlay. */
3760 tail = found->next;
3761 parent->next = tail;
3762 /* Move an overlay at RIGHT_PLACE to the next of the found one,
3763 and link it into the right place. */
3764 if (!right_pair)
3766 found->next = bp->overlays_before;
3767 set_buffer_overlays_before (bp, found);
3769 else
3771 found->next = right_pair->next;
3772 right_pair->next = found;
3775 else if (end == prev)
3777 parent = tail;
3778 tail = tail->next;
3780 else /* No more disordered overlay. */
3781 break;
3785 DEFUN ("overlayp", Foverlayp, Soverlayp, 1, 1, 0,
3786 doc: /* Return t if OBJECT is an overlay. */)
3787 (Lisp_Object object)
3789 return (OVERLAYP (object) ? Qt : Qnil);
3792 DEFUN ("make-overlay", Fmake_overlay, Smake_overlay, 2, 5, 0,
3793 doc: /* Create a new overlay with range BEG to END in BUFFER and return it.
3794 If omitted, BUFFER defaults to the current buffer.
3795 BEG and END may be integers or markers.
3796 The fourth arg FRONT-ADVANCE, if non-nil, makes the marker
3797 for the front of the overlay advance when text is inserted there
3798 \(which means the text *is not* included in the overlay).
3799 The fifth arg REAR-ADVANCE, if non-nil, makes the marker
3800 for the rear of the overlay advance when text is inserted there
3801 \(which means the text *is* included in the overlay). */)
3802 (Lisp_Object beg, Lisp_Object end, Lisp_Object buffer,
3803 Lisp_Object front_advance, Lisp_Object rear_advance)
3805 Lisp_Object overlay;
3806 struct buffer *b;
3808 if (NILP (buffer))
3809 XSETBUFFER (buffer, current_buffer);
3810 else
3811 CHECK_BUFFER (buffer);
3813 if (MARKERP (beg) && !EQ (Fmarker_buffer (beg), buffer))
3814 signal_error ("Marker points into wrong buffer", beg);
3815 if (MARKERP (end) && !EQ (Fmarker_buffer (end), buffer))
3816 signal_error ("Marker points into wrong buffer", end);
3818 CHECK_NUMBER_COERCE_MARKER (beg);
3819 CHECK_NUMBER_COERCE_MARKER (end);
3821 if (XINT (beg) > XINT (end))
3823 Lisp_Object temp;
3824 temp = beg; beg = end; end = temp;
3827 b = XBUFFER (buffer);
3829 beg = Fset_marker (Fmake_marker (), beg, buffer);
3830 end = Fset_marker (Fmake_marker (), end, buffer);
3832 if (!NILP (front_advance))
3833 XMARKER (beg)->insertion_type = 1;
3834 if (!NILP (rear_advance))
3835 XMARKER (end)->insertion_type = 1;
3837 overlay = build_overlay (beg, end, Qnil);
3839 /* Put the new overlay on the wrong list. */
3840 end = OVERLAY_END (overlay);
3841 if (OVERLAY_POSITION (end) < b->overlay_center)
3843 eassert (b->overlays_after || (XOVERLAY (overlay)->next == NULL));
3844 XOVERLAY (overlay)->next = b->overlays_after;
3845 set_buffer_overlays_after (b, XOVERLAY (overlay));
3847 else
3849 eassert (b->overlays_before || (XOVERLAY (overlay)->next == NULL));
3850 XOVERLAY (overlay)->next = b->overlays_before;
3851 set_buffer_overlays_before (b, XOVERLAY (overlay));
3853 /* This puts it in the right list, and in the right order. */
3854 recenter_overlay_lists (b, b->overlay_center);
3856 /* We don't need to redisplay the region covered by the overlay, because
3857 the overlay has no properties at the moment. */
3859 return overlay;
3862 /* Mark a section of BUF as needing redisplay because of overlays changes. */
3864 static void
3865 modify_overlay (struct buffer *buf, ptrdiff_t start, ptrdiff_t end)
3867 if (start > end)
3869 ptrdiff_t temp = start;
3870 start = end;
3871 end = temp;
3874 BUF_COMPUTE_UNCHANGED (buf, start, end);
3876 bset_redisplay (buf);
3878 ++BUF_OVERLAY_MODIFF (buf);
3881 /* Remove OVERLAY from LIST. */
3883 static struct Lisp_Overlay *
3884 unchain_overlay (struct Lisp_Overlay *list, struct Lisp_Overlay *overlay)
3886 register struct Lisp_Overlay *tail, **prev = &list;
3888 for (tail = list; tail; prev = &tail->next, tail = *prev)
3889 if (tail == overlay)
3891 *prev = overlay->next;
3892 overlay->next = NULL;
3893 break;
3895 return list;
3898 /* Remove OVERLAY from both overlay lists of B. */
3900 static void
3901 unchain_both (struct buffer *b, Lisp_Object overlay)
3903 struct Lisp_Overlay *ov = XOVERLAY (overlay);
3905 set_buffer_overlays_before (b, unchain_overlay (b->overlays_before, ov));
3906 set_buffer_overlays_after (b, unchain_overlay (b->overlays_after, ov));
3907 eassert (XOVERLAY (overlay)->next == NULL);
3910 DEFUN ("move-overlay", Fmove_overlay, Smove_overlay, 3, 4, 0,
3911 doc: /* Set the endpoints of OVERLAY to BEG and END in BUFFER.
3912 If BUFFER is omitted, leave OVERLAY in the same buffer it inhabits now.
3913 If BUFFER is omitted, and OVERLAY is in no buffer, put it in the current
3914 buffer. */)
3915 (Lisp_Object overlay, Lisp_Object beg, Lisp_Object end, Lisp_Object buffer)
3917 struct buffer *b, *ob = 0;
3918 Lisp_Object obuffer;
3919 ptrdiff_t count = SPECPDL_INDEX ();
3920 ptrdiff_t n_beg, n_end, o_beg IF_LINT (= 0), o_end IF_LINT (= 0);
3922 CHECK_OVERLAY (overlay);
3923 if (NILP (buffer))
3924 buffer = Fmarker_buffer (OVERLAY_START (overlay));
3925 if (NILP (buffer))
3926 XSETBUFFER (buffer, current_buffer);
3927 CHECK_BUFFER (buffer);
3929 if (NILP (Fbuffer_live_p (buffer)))
3930 error ("Attempt to move overlay to a dead buffer");
3932 if (MARKERP (beg) && !EQ (Fmarker_buffer (beg), buffer))
3933 signal_error ("Marker points into wrong buffer", beg);
3934 if (MARKERP (end) && !EQ (Fmarker_buffer (end), buffer))
3935 signal_error ("Marker points into wrong buffer", end);
3937 CHECK_NUMBER_COERCE_MARKER (beg);
3938 CHECK_NUMBER_COERCE_MARKER (end);
3940 if (XINT (beg) > XINT (end))
3942 Lisp_Object temp;
3943 temp = beg; beg = end; end = temp;
3946 specbind (Qinhibit_quit, Qt);
3948 obuffer = Fmarker_buffer (OVERLAY_START (overlay));
3949 b = XBUFFER (buffer);
3951 if (!NILP (obuffer))
3953 ob = XBUFFER (obuffer);
3955 o_beg = OVERLAY_POSITION (OVERLAY_START (overlay));
3956 o_end = OVERLAY_POSITION (OVERLAY_END (overlay));
3958 unchain_both (ob, overlay);
3961 /* Set the overlay boundaries, which may clip them. */
3962 Fset_marker (OVERLAY_START (overlay), beg, buffer);
3963 Fset_marker (OVERLAY_END (overlay), end, buffer);
3965 n_beg = marker_position (OVERLAY_START (overlay));
3966 n_end = marker_position (OVERLAY_END (overlay));
3968 /* If the overlay has changed buffers, do a thorough redisplay. */
3969 if (!EQ (buffer, obuffer))
3971 /* Redisplay where the overlay was. */
3972 if (ob)
3973 modify_overlay (ob, o_beg, o_end);
3975 /* Redisplay where the overlay is going to be. */
3976 modify_overlay (b, n_beg, n_end);
3978 else
3979 /* Redisplay the area the overlay has just left, or just enclosed. */
3981 if (o_beg == n_beg)
3982 modify_overlay (b, o_end, n_end);
3983 else if (o_end == n_end)
3984 modify_overlay (b, o_beg, n_beg);
3985 else
3986 modify_overlay (b, min (o_beg, n_beg), max (o_end, n_end));
3989 /* Delete the overlay if it is empty after clipping and has the
3990 evaporate property. */
3991 if (n_beg == n_end && !NILP (Foverlay_get (overlay, Qevaporate)))
3992 return unbind_to (count, Fdelete_overlay (overlay));
3994 /* Put the overlay into the new buffer's overlay lists, first on the
3995 wrong list. */
3996 if (n_end < b->overlay_center)
3998 XOVERLAY (overlay)->next = b->overlays_after;
3999 set_buffer_overlays_after (b, XOVERLAY (overlay));
4001 else
4003 XOVERLAY (overlay)->next = b->overlays_before;
4004 set_buffer_overlays_before (b, XOVERLAY (overlay));
4007 /* This puts it in the right list, and in the right order. */
4008 recenter_overlay_lists (b, b->overlay_center);
4010 return unbind_to (count, overlay);
4013 DEFUN ("delete-overlay", Fdelete_overlay, Sdelete_overlay, 1, 1, 0,
4014 doc: /* Delete the overlay OVERLAY from its buffer. */)
4015 (Lisp_Object overlay)
4017 Lisp_Object buffer;
4018 struct buffer *b;
4019 ptrdiff_t count = SPECPDL_INDEX ();
4021 CHECK_OVERLAY (overlay);
4023 buffer = Fmarker_buffer (OVERLAY_START (overlay));
4024 if (NILP (buffer))
4025 return Qnil;
4027 b = XBUFFER (buffer);
4028 specbind (Qinhibit_quit, Qt);
4030 unchain_both (b, overlay);
4031 drop_overlay (b, XOVERLAY (overlay));
4033 /* When deleting an overlay with before or after strings, turn off
4034 display optimizations for the affected buffer, on the basis that
4035 these strings may contain newlines. This is easier to do than to
4036 check for that situation during redisplay. */
4037 if (!windows_or_buffers_changed
4038 && (!NILP (Foverlay_get (overlay, Qbefore_string))
4039 || !NILP (Foverlay_get (overlay, Qafter_string))))
4040 b->prevent_redisplay_optimizations_p = 1;
4042 return unbind_to (count, Qnil);
4045 DEFUN ("delete-all-overlays", Fdelete_all_overlays, Sdelete_all_overlays, 0, 1, 0,
4046 doc: /* Delete all overlays of BUFFER.
4047 BUFFER omitted or nil means delete all overlays of the current
4048 buffer. */)
4049 (Lisp_Object buffer)
4051 delete_all_overlays (decode_buffer (buffer));
4052 return Qnil;
4055 /* Overlay dissection functions. */
4057 DEFUN ("overlay-start", Foverlay_start, Soverlay_start, 1, 1, 0,
4058 doc: /* Return the position at which OVERLAY starts. */)
4059 (Lisp_Object overlay)
4061 CHECK_OVERLAY (overlay);
4063 return (Fmarker_position (OVERLAY_START (overlay)));
4066 DEFUN ("overlay-end", Foverlay_end, Soverlay_end, 1, 1, 0,
4067 doc: /* Return the position at which OVERLAY ends. */)
4068 (Lisp_Object overlay)
4070 CHECK_OVERLAY (overlay);
4072 return (Fmarker_position (OVERLAY_END (overlay)));
4075 DEFUN ("overlay-buffer", Foverlay_buffer, Soverlay_buffer, 1, 1, 0,
4076 doc: /* Return the buffer OVERLAY belongs to.
4077 Return nil if OVERLAY has been deleted. */)
4078 (Lisp_Object overlay)
4080 CHECK_OVERLAY (overlay);
4082 return Fmarker_buffer (OVERLAY_START (overlay));
4085 DEFUN ("overlay-properties", Foverlay_properties, Soverlay_properties, 1, 1, 0,
4086 doc: /* Return a list of the properties on OVERLAY.
4087 This is a copy of OVERLAY's plist; modifying its conses has no effect on
4088 OVERLAY. */)
4089 (Lisp_Object overlay)
4091 CHECK_OVERLAY (overlay);
4093 return Fcopy_sequence (XOVERLAY (overlay)->plist);
4097 DEFUN ("overlays-at", Foverlays_at, Soverlays_at, 1, 2, 0,
4098 doc: /* Return a list of the overlays that contain the character at POS.
4099 If SORTED is non-nil, then sort them by decreasing priority. */)
4100 (Lisp_Object pos, Lisp_Object sorted)
4102 ptrdiff_t len, noverlays;
4103 Lisp_Object *overlay_vec;
4104 Lisp_Object result;
4106 CHECK_NUMBER_COERCE_MARKER (pos);
4108 if (!buffer_has_overlays ())
4109 return Qnil;
4111 len = 10;
4112 /* We can't use alloca here because overlays_at can call xrealloc. */
4113 overlay_vec = xmalloc (len * sizeof *overlay_vec);
4115 /* Put all the overlays we want in a vector in overlay_vec.
4116 Store the length in len. */
4117 noverlays = overlays_at (XINT (pos), 1, &overlay_vec, &len,
4118 NULL, NULL, 0);
4120 if (!NILP (sorted))
4121 noverlays = sort_overlays (overlay_vec, noverlays,
4122 WINDOWP (sorted) ? XWINDOW (sorted) : NULL);
4124 /* Make a list of them all. */
4125 result = Flist (noverlays, overlay_vec);
4127 xfree (overlay_vec);
4128 return result;
4131 DEFUN ("overlays-in", Foverlays_in, Soverlays_in, 2, 2, 0,
4132 doc: /* Return a list of the overlays that overlap the region BEG ... END.
4133 Overlap means that at least one character is contained within the overlay
4134 and also contained within the specified region.
4135 Empty overlays are included in the result if they are located at BEG,
4136 between BEG and END, or at END provided END denotes the position at the
4137 end of the buffer. */)
4138 (Lisp_Object beg, Lisp_Object end)
4140 ptrdiff_t len, noverlays;
4141 Lisp_Object *overlay_vec;
4142 Lisp_Object result;
4144 CHECK_NUMBER_COERCE_MARKER (beg);
4145 CHECK_NUMBER_COERCE_MARKER (end);
4147 if (!buffer_has_overlays ())
4148 return Qnil;
4150 len = 10;
4151 overlay_vec = xmalloc (len * sizeof *overlay_vec);
4153 /* Put all the overlays we want in a vector in overlay_vec.
4154 Store the length in len. */
4155 noverlays = overlays_in (XINT (beg), XINT (end), 1, &overlay_vec, &len,
4156 NULL, NULL);
4158 /* Make a list of them all. */
4159 result = Flist (noverlays, overlay_vec);
4161 xfree (overlay_vec);
4162 return result;
4165 DEFUN ("next-overlay-change", Fnext_overlay_change, Snext_overlay_change,
4166 1, 1, 0,
4167 doc: /* Return the next position after POS where an overlay starts or ends.
4168 If there are no overlay boundaries from POS to (point-max),
4169 the value is (point-max). */)
4170 (Lisp_Object pos)
4172 ptrdiff_t i, len, noverlays;
4173 ptrdiff_t endpos;
4174 Lisp_Object *overlay_vec;
4176 CHECK_NUMBER_COERCE_MARKER (pos);
4178 if (!buffer_has_overlays ())
4179 return make_number (ZV);
4181 len = 10;
4182 overlay_vec = xmalloc (len * sizeof *overlay_vec);
4184 /* Put all the overlays we want in a vector in overlay_vec.
4185 Store the length in len.
4186 endpos gets the position where the next overlay starts. */
4187 noverlays = overlays_at (XINT (pos), 1, &overlay_vec, &len,
4188 &endpos, 0, 1);
4190 /* If any of these overlays ends before endpos,
4191 use its ending point instead. */
4192 for (i = 0; i < noverlays; i++)
4194 Lisp_Object oend;
4195 ptrdiff_t oendpos;
4197 oend = OVERLAY_END (overlay_vec[i]);
4198 oendpos = OVERLAY_POSITION (oend);
4199 if (oendpos < endpos)
4200 endpos = oendpos;
4203 xfree (overlay_vec);
4204 return make_number (endpos);
4207 DEFUN ("previous-overlay-change", Fprevious_overlay_change,
4208 Sprevious_overlay_change, 1, 1, 0,
4209 doc: /* Return the previous position before POS where an overlay starts or ends.
4210 If there are no overlay boundaries from (point-min) to POS,
4211 the value is (point-min). */)
4212 (Lisp_Object pos)
4214 ptrdiff_t prevpos;
4215 Lisp_Object *overlay_vec;
4216 ptrdiff_t len;
4218 CHECK_NUMBER_COERCE_MARKER (pos);
4220 if (!buffer_has_overlays ())
4221 return make_number (BEGV);
4223 /* At beginning of buffer, we know the answer;
4224 avoid bug subtracting 1 below. */
4225 if (XINT (pos) == BEGV)
4226 return pos;
4228 len = 10;
4229 overlay_vec = xmalloc (len * sizeof *overlay_vec);
4231 /* Put all the overlays we want in a vector in overlay_vec.
4232 Store the length in len.
4233 prevpos gets the position of the previous change. */
4234 overlays_at (XINT (pos), 1, &overlay_vec, &len,
4235 0, &prevpos, 1);
4237 xfree (overlay_vec);
4238 return make_number (prevpos);
4241 /* These functions are for debugging overlays. */
4243 DEFUN ("overlay-lists", Foverlay_lists, Soverlay_lists, 0, 0, 0,
4244 doc: /* Return a pair of lists giving all the overlays of the current buffer.
4245 The car has all the overlays before the overlay center;
4246 the cdr has all the overlays after the overlay center.
4247 Recentering overlays moves overlays between these lists.
4248 The lists you get are copies, so that changing them has no effect.
4249 However, the overlays you get are the real objects that the buffer uses. */)
4250 (void)
4252 struct Lisp_Overlay *ol;
4253 Lisp_Object before = Qnil, after = Qnil, tmp;
4255 for (ol = current_buffer->overlays_before; ol; ol = ol->next)
4257 XSETMISC (tmp, ol);
4258 before = Fcons (tmp, before);
4260 for (ol = current_buffer->overlays_after; ol; ol = ol->next)
4262 XSETMISC (tmp, ol);
4263 after = Fcons (tmp, after);
4266 return Fcons (Fnreverse (before), Fnreverse (after));
4269 DEFUN ("overlay-recenter", Foverlay_recenter, Soverlay_recenter, 1, 1, 0,
4270 doc: /* Recenter the overlays of the current buffer around position POS.
4271 That makes overlay lookup faster for positions near POS (but perhaps slower
4272 for positions far away from POS). */)
4273 (Lisp_Object pos)
4275 ptrdiff_t p;
4276 CHECK_NUMBER_COERCE_MARKER (pos);
4278 p = clip_to_bounds (PTRDIFF_MIN, XINT (pos), PTRDIFF_MAX);
4279 recenter_overlay_lists (current_buffer, p);
4280 return Qnil;
4283 DEFUN ("overlay-get", Foverlay_get, Soverlay_get, 2, 2, 0,
4284 doc: /* Get the property of overlay OVERLAY with property name PROP. */)
4285 (Lisp_Object overlay, Lisp_Object prop)
4287 CHECK_OVERLAY (overlay);
4288 return lookup_char_property (XOVERLAY (overlay)->plist, prop, 0);
4291 DEFUN ("overlay-put", Foverlay_put, Soverlay_put, 3, 3, 0,
4292 doc: /* Set one property of overlay OVERLAY: give property PROP value VALUE.
4293 VALUE will be returned.*/)
4294 (Lisp_Object overlay, Lisp_Object prop, Lisp_Object value)
4296 Lisp_Object tail, buffer;
4297 bool changed;
4299 CHECK_OVERLAY (overlay);
4301 buffer = Fmarker_buffer (OVERLAY_START (overlay));
4303 for (tail = XOVERLAY (overlay)->plist;
4304 CONSP (tail) && CONSP (XCDR (tail));
4305 tail = XCDR (XCDR (tail)))
4306 if (EQ (XCAR (tail), prop))
4308 changed = !EQ (XCAR (XCDR (tail)), value);
4309 XSETCAR (XCDR (tail), value);
4310 goto found;
4312 /* It wasn't in the list, so add it to the front. */
4313 changed = !NILP (value);
4314 set_overlay_plist
4315 (overlay, Fcons (prop, Fcons (value, XOVERLAY (overlay)->plist)));
4316 found:
4317 if (! NILP (buffer))
4319 if (changed)
4320 modify_overlay (XBUFFER (buffer),
4321 marker_position (OVERLAY_START (overlay)),
4322 marker_position (OVERLAY_END (overlay)));
4323 if (EQ (prop, Qevaporate) && ! NILP (value)
4324 && (OVERLAY_POSITION (OVERLAY_START (overlay))
4325 == OVERLAY_POSITION (OVERLAY_END (overlay))))
4326 Fdelete_overlay (overlay);
4329 return value;
4332 /* Subroutine of report_overlay_modification. */
4334 /* Lisp vector holding overlay hook functions to call.
4335 Vector elements come in pairs.
4336 Each even-index element is a list of hook functions.
4337 The following odd-index element is the overlay they came from.
4339 Before the buffer change, we fill in this vector
4340 as we call overlay hook functions.
4341 After the buffer change, we get the functions to call from this vector.
4342 This way we always call the same functions before and after the change. */
4343 static Lisp_Object last_overlay_modification_hooks;
4345 /* Number of elements actually used in last_overlay_modification_hooks. */
4346 static ptrdiff_t last_overlay_modification_hooks_used;
4348 /* Add one functionlist/overlay pair
4349 to the end of last_overlay_modification_hooks. */
4351 static void
4352 add_overlay_mod_hooklist (Lisp_Object functionlist, Lisp_Object overlay)
4354 ptrdiff_t oldsize = ASIZE (last_overlay_modification_hooks);
4356 if (oldsize - 1 <= last_overlay_modification_hooks_used)
4357 last_overlay_modification_hooks =
4358 larger_vector (last_overlay_modification_hooks, 2, -1);
4359 ASET (last_overlay_modification_hooks, last_overlay_modification_hooks_used,
4360 functionlist); last_overlay_modification_hooks_used++;
4361 ASET (last_overlay_modification_hooks, last_overlay_modification_hooks_used,
4362 overlay); last_overlay_modification_hooks_used++;
4365 /* Run the modification-hooks of overlays that include
4366 any part of the text in START to END.
4367 If this change is an insertion, also
4368 run the insert-before-hooks of overlay starting at END,
4369 and the insert-after-hooks of overlay ending at START.
4371 This is called both before and after the modification.
4372 AFTER is true when we call after the modification.
4374 ARG1, ARG2, ARG3 are arguments to pass to the hook functions.
4375 When AFTER is nonzero, they are the start position,
4376 the position after the inserted new text,
4377 and the length of deleted or replaced old text. */
4379 void
4380 report_overlay_modification (Lisp_Object start, Lisp_Object end, bool after,
4381 Lisp_Object arg1, Lisp_Object arg2, Lisp_Object arg3)
4383 Lisp_Object prop, overlay;
4384 struct Lisp_Overlay *tail;
4385 /* True if this change is an insertion. */
4386 bool insertion = (after ? XFASTINT (arg3) == 0 : EQ (start, end));
4388 overlay = Qnil;
4389 tail = NULL;
4391 /* We used to run the functions as soon as we found them and only register
4392 them in last_overlay_modification_hooks for the purpose of the `after'
4393 case. But running elisp code as we traverse the list of overlays is
4394 painful because the list can be modified by the elisp code so we had to
4395 copy at several places. We now simply do a read-only traversal that
4396 only collects the functions to run and we run them afterwards. It's
4397 simpler, especially since all the code was already there. -stef */
4399 if (!after)
4401 /* We are being called before a change.
4402 Scan the overlays to find the functions to call. */
4403 last_overlay_modification_hooks_used = 0;
4404 for (tail = current_buffer->overlays_before; tail; tail = tail->next)
4406 ptrdiff_t startpos, endpos;
4407 Lisp_Object ostart, oend;
4409 XSETMISC (overlay, tail);
4411 ostart = OVERLAY_START (overlay);
4412 oend = OVERLAY_END (overlay);
4413 endpos = OVERLAY_POSITION (oend);
4414 if (XFASTINT (start) > endpos)
4415 break;
4416 startpos = OVERLAY_POSITION (ostart);
4417 if (insertion && (XFASTINT (start) == startpos
4418 || XFASTINT (end) == startpos))
4420 prop = Foverlay_get (overlay, Qinsert_in_front_hooks);
4421 if (!NILP (prop))
4422 add_overlay_mod_hooklist (prop, overlay);
4424 if (insertion && (XFASTINT (start) == endpos
4425 || XFASTINT (end) == endpos))
4427 prop = Foverlay_get (overlay, Qinsert_behind_hooks);
4428 if (!NILP (prop))
4429 add_overlay_mod_hooklist (prop, overlay);
4431 /* Test for intersecting intervals. This does the right thing
4432 for both insertion and deletion. */
4433 if (XFASTINT (end) > startpos && XFASTINT (start) < endpos)
4435 prop = Foverlay_get (overlay, Qmodification_hooks);
4436 if (!NILP (prop))
4437 add_overlay_mod_hooklist (prop, overlay);
4441 for (tail = current_buffer->overlays_after; tail; tail = tail->next)
4443 ptrdiff_t startpos, endpos;
4444 Lisp_Object ostart, oend;
4446 XSETMISC (overlay, tail);
4448 ostart = OVERLAY_START (overlay);
4449 oend = OVERLAY_END (overlay);
4450 startpos = OVERLAY_POSITION (ostart);
4451 endpos = OVERLAY_POSITION (oend);
4452 if (XFASTINT (end) < startpos)
4453 break;
4454 if (insertion && (XFASTINT (start) == startpos
4455 || XFASTINT (end) == startpos))
4457 prop = Foverlay_get (overlay, Qinsert_in_front_hooks);
4458 if (!NILP (prop))
4459 add_overlay_mod_hooklist (prop, overlay);
4461 if (insertion && (XFASTINT (start) == endpos
4462 || XFASTINT (end) == endpos))
4464 prop = Foverlay_get (overlay, Qinsert_behind_hooks);
4465 if (!NILP (prop))
4466 add_overlay_mod_hooklist (prop, overlay);
4468 /* Test for intersecting intervals. This does the right thing
4469 for both insertion and deletion. */
4470 if (XFASTINT (end) > startpos && XFASTINT (start) < endpos)
4472 prop = Foverlay_get (overlay, Qmodification_hooks);
4473 if (!NILP (prop))
4474 add_overlay_mod_hooklist (prop, overlay);
4480 /* Call the functions recorded in last_overlay_modification_hooks.
4481 First copy the vector contents, in case some of these hooks
4482 do subsequent modification of the buffer. */
4483 ptrdiff_t size = last_overlay_modification_hooks_used;
4484 Lisp_Object *copy;
4485 ptrdiff_t i;
4487 if (size)
4489 Lisp_Object ovl
4490 = XVECTOR (last_overlay_modification_hooks)->contents[1];
4492 /* If the buffer of the first overlay in the array doesn't
4493 match the current buffer, then these modification hooks
4494 should not be run in this buffer. This could happen when
4495 some code calls some insdel functions, such as del_range_1,
4496 with the PREPARE argument false -- in that case this
4497 function is never called to record the overlay modification
4498 hook functions in the last_overlay_modification_hooks
4499 array, so anything we find there is not ours. */
4500 if (XMARKER (OVERLAY_START (ovl))->buffer != current_buffer)
4501 return;
4504 USE_SAFE_ALLOCA;
4505 SAFE_ALLOCA_LISP (copy, size);
4506 memcpy (copy, XVECTOR (last_overlay_modification_hooks)->contents,
4507 size * word_size);
4509 for (i = 0; i < size;)
4511 Lisp_Object prop_i, overlay_i;
4512 prop_i = copy[i++];
4513 overlay_i = copy[i++];
4514 call_overlay_mod_hooks (prop_i, overlay_i, after, arg1, arg2, arg3);
4517 SAFE_FREE ();
4521 static void
4522 call_overlay_mod_hooks (Lisp_Object list, Lisp_Object overlay, bool after,
4523 Lisp_Object arg1, Lisp_Object arg2, Lisp_Object arg3)
4525 while (CONSP (list))
4527 if (NILP (arg3))
4528 call4 (XCAR (list), overlay, after ? Qt : Qnil, arg1, arg2);
4529 else
4530 call5 (XCAR (list), overlay, after ? Qt : Qnil, arg1, arg2, arg3);
4531 list = XCDR (list);
4535 /* Delete any zero-sized overlays at position POS, if the `evaporate'
4536 property is set. */
4537 void
4538 evaporate_overlays (ptrdiff_t pos)
4540 Lisp_Object overlay, hit_list;
4541 struct Lisp_Overlay *tail;
4543 hit_list = Qnil;
4544 if (pos <= current_buffer->overlay_center)
4545 for (tail = current_buffer->overlays_before; tail; tail = tail->next)
4547 ptrdiff_t endpos;
4548 XSETMISC (overlay, tail);
4549 endpos = OVERLAY_POSITION (OVERLAY_END (overlay));
4550 if (endpos < pos)
4551 break;
4552 if (endpos == pos && OVERLAY_POSITION (OVERLAY_START (overlay)) == pos
4553 && ! NILP (Foverlay_get (overlay, Qevaporate)))
4554 hit_list = Fcons (overlay, hit_list);
4556 else
4557 for (tail = current_buffer->overlays_after; tail; tail = tail->next)
4559 ptrdiff_t startpos;
4560 XSETMISC (overlay, tail);
4561 startpos = OVERLAY_POSITION (OVERLAY_START (overlay));
4562 if (startpos > pos)
4563 break;
4564 if (startpos == pos && OVERLAY_POSITION (OVERLAY_END (overlay)) == pos
4565 && ! NILP (Foverlay_get (overlay, Qevaporate)))
4566 hit_list = Fcons (overlay, hit_list);
4568 for (; CONSP (hit_list); hit_list = XCDR (hit_list))
4569 Fdelete_overlay (XCAR (hit_list));
4572 /***********************************************************************
4573 Allocation with mmap
4574 ***********************************************************************/
4576 /* Note: WINDOWSNT implements this stuff on w32heap.c. */
4577 #if defined USE_MMAP_FOR_BUFFERS && !defined WINDOWSNT
4579 #include <sys/mman.h>
4581 #ifndef MAP_ANON
4582 #ifdef MAP_ANONYMOUS
4583 #define MAP_ANON MAP_ANONYMOUS
4584 #else
4585 #define MAP_ANON 0
4586 #endif
4587 #endif
4589 #ifndef MAP_FAILED
4590 #define MAP_FAILED ((void *) -1)
4591 #endif
4593 #if MAP_ANON == 0
4594 #include <fcntl.h>
4595 #endif
4598 /* Memory is allocated in regions which are mapped using mmap(2).
4599 The current implementation lets the system select mapped
4600 addresses; we're not using MAP_FIXED in general, except when
4601 trying to enlarge regions.
4603 Each mapped region starts with a mmap_region structure, the user
4604 area starts after that structure, aligned to MEM_ALIGN.
4606 +-----------------------+
4607 | struct mmap_info + |
4608 | padding |
4609 +-----------------------+
4610 | user data |
4613 +-----------------------+ */
4615 struct mmap_region
4617 /* User-specified size. */
4618 size_t nbytes_specified;
4620 /* Number of bytes mapped */
4621 size_t nbytes_mapped;
4623 /* Pointer to the location holding the address of the memory
4624 allocated with the mmap'd block. The variable actually points
4625 after this structure. */
4626 void **var;
4628 /* Next and previous in list of all mmap'd regions. */
4629 struct mmap_region *next, *prev;
4632 /* Doubly-linked list of mmap'd regions. */
4634 static struct mmap_region *mmap_regions;
4636 /* File descriptor for mmap. If we don't have anonymous mapping,
4637 /dev/zero will be opened on it. */
4639 static int mmap_fd;
4641 /* Page size on this system. */
4643 static int mmap_page_size;
4645 /* 1 means mmap has been initialized. */
4647 static bool mmap_initialized_p;
4649 /* Value is X rounded up to the next multiple of N. */
4651 #define ROUND(X, N) (((X) + (N) - 1) / (N) * (N))
4653 /* Size of mmap_region structure plus padding. */
4655 #define MMAP_REGION_STRUCT_SIZE \
4656 ROUND (sizeof (struct mmap_region), MEM_ALIGN)
4658 /* Given a pointer P to the start of the user-visible part of a mapped
4659 region, return a pointer to the start of the region. */
4661 #define MMAP_REGION(P) \
4662 ((struct mmap_region *) ((char *) (P) - MMAP_REGION_STRUCT_SIZE))
4664 /* Given a pointer P to the start of a mapped region, return a pointer
4665 to the start of the user-visible part of the region. */
4667 #define MMAP_USER_AREA(P) \
4668 ((void *) ((char *) (P) + MMAP_REGION_STRUCT_SIZE))
4670 #define MEM_ALIGN sizeof (double)
4672 /* Predicate returning true if part of the address range [START .. END]
4673 is currently mapped. Used to prevent overwriting an existing
4674 memory mapping.
4676 Default is to conservatively assume the address range is occupied by
4677 something else. This can be overridden by system configuration
4678 files if system-specific means to determine this exists. */
4680 #ifndef MMAP_ALLOCATED_P
4681 #define MMAP_ALLOCATED_P(start, end) 1
4682 #endif
4684 /* Perform necessary initializations for the use of mmap. */
4686 static void
4687 mmap_init (void)
4689 #if MAP_ANON == 0
4690 /* The value of mmap_fd is initially 0 in temacs, and -1
4691 in a dumped Emacs. */
4692 if (mmap_fd <= 0)
4694 /* No anonymous mmap -- we need the file descriptor. */
4695 mmap_fd = emacs_open ("/dev/zero", O_RDONLY, 0);
4696 if (mmap_fd == -1)
4697 fatal ("Cannot open /dev/zero: %s", emacs_strerror (errno));
4699 #endif /* MAP_ANON == 0 */
4701 if (mmap_initialized_p)
4702 return;
4703 mmap_initialized_p = 1;
4705 #if MAP_ANON != 0
4706 mmap_fd = -1;
4707 #endif
4709 mmap_page_size = getpagesize ();
4712 /* Unmap a region. P is a pointer to the start of the user-araa of
4713 the region. */
4715 static void
4716 mmap_free_1 (struct mmap_region *r)
4718 if (r->next)
4719 r->next->prev = r->prev;
4720 if (r->prev)
4721 r->prev->next = r->next;
4722 else
4723 mmap_regions = r->next;
4725 if (munmap (r, r->nbytes_mapped) == -1)
4726 fprintf (stderr, "munmap: %s\n", emacs_strerror (errno));
4730 /* Enlarge region R by NPAGES pages. NPAGES < 0 means shrink R.
4731 Value is true if successful. */
4733 static bool
4734 mmap_enlarge (struct mmap_region *r, int npages)
4736 char *region_end = (char *) r + r->nbytes_mapped;
4737 size_t nbytes;
4738 bool success = 0;
4740 if (npages < 0)
4742 /* Unmap pages at the end of the region. */
4743 nbytes = - npages * mmap_page_size;
4744 if (munmap (region_end - nbytes, nbytes) == -1)
4745 fprintf (stderr, "munmap: %s\n", emacs_strerror (errno));
4746 else
4748 r->nbytes_mapped -= nbytes;
4749 success = 1;
4752 else if (npages > 0)
4754 nbytes = npages * mmap_page_size;
4756 /* Try to map additional pages at the end of the region. We
4757 cannot do this if the address range is already occupied by
4758 something else because mmap deletes any previous mapping.
4759 I'm not sure this is worth doing, let's see. */
4760 if (!MMAP_ALLOCATED_P (region_end, region_end + nbytes))
4762 void *p;
4764 p = mmap (region_end, nbytes, PROT_READ | PROT_WRITE,
4765 MAP_ANON | MAP_PRIVATE | MAP_FIXED, mmap_fd, 0);
4766 if (p == MAP_FAILED)
4767 ; /* fprintf (stderr, "mmap: %s\n", emacs_strerror (errno)); */
4768 else if (p != region_end)
4770 /* Kernels are free to choose a different address. In
4771 that case, unmap what we've mapped above; we have
4772 no use for it. */
4773 if (munmap (p, nbytes) == -1)
4774 fprintf (stderr, "munmap: %s\n", emacs_strerror (errno));
4776 else
4778 r->nbytes_mapped += nbytes;
4779 success = 1;
4784 return success;
4788 /* Allocate a block of storage large enough to hold NBYTES bytes of
4789 data. A pointer to the data is returned in *VAR. VAR is thus the
4790 address of some variable which will use the data area.
4792 The allocation of 0 bytes is valid.
4794 If we can't allocate the necessary memory, set *VAR to null, and
4795 return null. */
4797 static void *
4798 mmap_alloc (void **var, size_t nbytes)
4800 void *p;
4801 size_t map;
4803 mmap_init ();
4805 map = ROUND (nbytes + MMAP_REGION_STRUCT_SIZE, mmap_page_size);
4806 p = mmap (NULL, map, PROT_READ | PROT_WRITE, MAP_ANON | MAP_PRIVATE,
4807 mmap_fd, 0);
4809 if (p == MAP_FAILED)
4811 if (errno != ENOMEM)
4812 fprintf (stderr, "mmap: %s\n", emacs_strerror (errno));
4813 p = NULL;
4815 else
4817 struct mmap_region *r = p;
4819 r->nbytes_specified = nbytes;
4820 r->nbytes_mapped = map;
4821 r->var = var;
4822 r->prev = NULL;
4823 r->next = mmap_regions;
4824 if (r->next)
4825 r->next->prev = r;
4826 mmap_regions = r;
4828 p = MMAP_USER_AREA (p);
4831 return *var = p;
4835 /* Free a block of relocatable storage whose data is pointed to by
4836 PTR. Store 0 in *PTR to show there's no block allocated. */
4838 static void
4839 mmap_free (void **var)
4841 mmap_init ();
4843 if (*var)
4845 mmap_free_1 (MMAP_REGION (*var));
4846 *var = NULL;
4851 /* Given a pointer at address VAR to data allocated with mmap_alloc,
4852 resize it to size NBYTES. Change *VAR to reflect the new block,
4853 and return this value. If more memory cannot be allocated, then
4854 leave *VAR unchanged, and return null. */
4856 static void *
4857 mmap_realloc (void **var, size_t nbytes)
4859 void *result;
4861 mmap_init ();
4863 if (*var == NULL)
4864 result = mmap_alloc (var, nbytes);
4865 else if (nbytes == 0)
4867 mmap_free (var);
4868 result = mmap_alloc (var, nbytes);
4870 else
4872 struct mmap_region *r = MMAP_REGION (*var);
4873 size_t room = r->nbytes_mapped - MMAP_REGION_STRUCT_SIZE;
4875 if (room < nbytes)
4877 /* Must enlarge. */
4878 void *old_ptr = *var;
4880 /* Try to map additional pages at the end of the region.
4881 If that fails, allocate a new region, copy data
4882 from the old region, then free it. */
4883 if (mmap_enlarge (r, (ROUND (nbytes - room, mmap_page_size)
4884 / mmap_page_size)))
4886 r->nbytes_specified = nbytes;
4887 *var = result = old_ptr;
4889 else if (mmap_alloc (var, nbytes))
4891 memcpy (*var, old_ptr, r->nbytes_specified);
4892 mmap_free_1 (MMAP_REGION (old_ptr));
4893 result = *var;
4894 r = MMAP_REGION (result);
4895 r->nbytes_specified = nbytes;
4897 else
4899 *var = old_ptr;
4900 result = NULL;
4903 else if (room - nbytes >= mmap_page_size)
4905 /* Shrinking by at least a page. Let's give some
4906 memory back to the system.
4908 The extra parens are to make the division happens first,
4909 on positive values, so we know it will round towards
4910 zero. */
4911 mmap_enlarge (r, - ((room - nbytes) / mmap_page_size));
4912 result = *var;
4913 r->nbytes_specified = nbytes;
4915 else
4917 /* Leave it alone. */
4918 result = *var;
4919 r->nbytes_specified = nbytes;
4923 return result;
4927 #endif /* USE_MMAP_FOR_BUFFERS */
4931 /***********************************************************************
4932 Buffer-text Allocation
4933 ***********************************************************************/
4935 /* Allocate NBYTES bytes for buffer B's text buffer. */
4937 static void
4938 alloc_buffer_text (struct buffer *b, ptrdiff_t nbytes)
4940 void *p;
4942 block_input ();
4943 #if defined USE_MMAP_FOR_BUFFERS
4944 p = mmap_alloc ((void **) &b->text->beg, nbytes);
4945 #elif defined REL_ALLOC
4946 p = r_alloc ((void **) &b->text->beg, nbytes);
4947 #else
4948 p = xmalloc (nbytes);
4949 #endif
4951 if (p == NULL)
4953 unblock_input ();
4954 memory_full (nbytes);
4957 b->text->beg = p;
4958 unblock_input ();
4961 /* Enlarge buffer B's text buffer by DELTA bytes. DELTA < 0 means
4962 shrink it. */
4964 void
4965 enlarge_buffer_text (struct buffer *b, ptrdiff_t delta)
4967 void *p;
4968 ptrdiff_t nbytes = (BUF_Z_BYTE (b) - BUF_BEG_BYTE (b) + BUF_GAP_SIZE (b) + 1
4969 + delta);
4970 block_input ();
4971 #if defined USE_MMAP_FOR_BUFFERS
4972 p = mmap_realloc ((void **) &b->text->beg, nbytes);
4973 #elif defined REL_ALLOC
4974 p = r_re_alloc ((void **) &b->text->beg, nbytes);
4975 #else
4976 p = xrealloc (b->text->beg, nbytes);
4977 #endif
4979 if (p == NULL)
4981 unblock_input ();
4982 memory_full (nbytes);
4985 BUF_BEG_ADDR (b) = p;
4986 unblock_input ();
4990 /* Free buffer B's text buffer. */
4992 static void
4993 free_buffer_text (struct buffer *b)
4995 block_input ();
4997 #if defined USE_MMAP_FOR_BUFFERS
4998 mmap_free ((void **) &b->text->beg);
4999 #elif defined REL_ALLOC
5000 r_alloc_free ((void **) &b->text->beg);
5001 #else
5002 xfree (b->text->beg);
5003 #endif
5005 BUF_BEG_ADDR (b) = NULL;
5006 unblock_input ();
5011 /***********************************************************************
5012 Initialization
5013 ***********************************************************************/
5015 void
5016 init_buffer_once (void)
5018 int idx;
5020 memset (buffer_permanent_local_flags, 0, sizeof buffer_permanent_local_flags);
5022 /* 0 means not a lisp var, -1 means always local, else mask. */
5023 memset (&buffer_local_flags, 0, sizeof buffer_local_flags);
5024 bset_filename (&buffer_local_flags, make_number (-1));
5025 bset_directory (&buffer_local_flags, make_number (-1));
5026 bset_backed_up (&buffer_local_flags, make_number (-1));
5027 bset_save_length (&buffer_local_flags, make_number (-1));
5028 bset_auto_save_file_name (&buffer_local_flags, make_number (-1));
5029 bset_read_only (&buffer_local_flags, make_number (-1));
5030 bset_major_mode (&buffer_local_flags, make_number (-1));
5031 bset_mode_name (&buffer_local_flags, make_number (-1));
5032 bset_undo_list (&buffer_local_flags, make_number (-1));
5033 bset_mark_active (&buffer_local_flags, make_number (-1));
5034 bset_point_before_scroll (&buffer_local_flags, make_number (-1));
5035 bset_file_truename (&buffer_local_flags, make_number (-1));
5036 bset_invisibility_spec (&buffer_local_flags, make_number (-1));
5037 bset_file_format (&buffer_local_flags, make_number (-1));
5038 bset_auto_save_file_format (&buffer_local_flags, make_number (-1));
5039 bset_display_count (&buffer_local_flags, make_number (-1));
5040 bset_display_time (&buffer_local_flags, make_number (-1));
5041 bset_enable_multibyte_characters (&buffer_local_flags, make_number (-1));
5043 /* These used to be stuck at 0 by default, but now that the all-zero value
5044 means Qnil, we have to initialize them explicitly. */
5045 bset_name (&buffer_local_flags, make_number (0));
5046 bset_mark (&buffer_local_flags, make_number (0));
5047 bset_local_var_alist (&buffer_local_flags, make_number (0));
5048 bset_keymap (&buffer_local_flags, make_number (0));
5049 bset_downcase_table (&buffer_local_flags, make_number (0));
5050 bset_upcase_table (&buffer_local_flags, make_number (0));
5051 bset_case_canon_table (&buffer_local_flags, make_number (0));
5052 bset_case_eqv_table (&buffer_local_flags, make_number (0));
5053 bset_minor_modes (&buffer_local_flags, make_number (0));
5054 bset_width_table (&buffer_local_flags, make_number (0));
5055 bset_pt_marker (&buffer_local_flags, make_number (0));
5056 bset_begv_marker (&buffer_local_flags, make_number (0));
5057 bset_zv_marker (&buffer_local_flags, make_number (0));
5058 bset_last_selected_window (&buffer_local_flags, make_number (0));
5060 idx = 1;
5061 XSETFASTINT (BVAR (&buffer_local_flags, mode_line_format), idx); ++idx;
5062 XSETFASTINT (BVAR (&buffer_local_flags, abbrev_mode), idx); ++idx;
5063 XSETFASTINT (BVAR (&buffer_local_flags, overwrite_mode), idx); ++idx;
5064 XSETFASTINT (BVAR (&buffer_local_flags, case_fold_search), idx); ++idx;
5065 XSETFASTINT (BVAR (&buffer_local_flags, auto_fill_function), idx); ++idx;
5066 XSETFASTINT (BVAR (&buffer_local_flags, selective_display), idx); ++idx;
5067 XSETFASTINT (BVAR (&buffer_local_flags, selective_display_ellipses), idx); ++idx;
5068 XSETFASTINT (BVAR (&buffer_local_flags, tab_width), idx); ++idx;
5069 XSETFASTINT (BVAR (&buffer_local_flags, truncate_lines), idx); ++idx;
5070 XSETFASTINT (BVAR (&buffer_local_flags, word_wrap), idx); ++idx;
5071 XSETFASTINT (BVAR (&buffer_local_flags, ctl_arrow), idx); ++idx;
5072 XSETFASTINT (BVAR (&buffer_local_flags, fill_column), idx); ++idx;
5073 XSETFASTINT (BVAR (&buffer_local_flags, left_margin), idx); ++idx;
5074 XSETFASTINT (BVAR (&buffer_local_flags, abbrev_table), idx); ++idx;
5075 XSETFASTINT (BVAR (&buffer_local_flags, display_table), idx); ++idx;
5076 XSETFASTINT (BVAR (&buffer_local_flags, syntax_table), idx); ++idx;
5077 XSETFASTINT (BVAR (&buffer_local_flags, cache_long_scans), idx); ++idx;
5078 XSETFASTINT (BVAR (&buffer_local_flags, category_table), idx); ++idx;
5079 XSETFASTINT (BVAR (&buffer_local_flags, bidi_display_reordering), idx); ++idx;
5080 XSETFASTINT (BVAR (&buffer_local_flags, bidi_paragraph_direction), idx); ++idx;
5081 XSETFASTINT (BVAR (&buffer_local_flags, buffer_file_coding_system), idx);
5082 /* Make this one a permanent local. */
5083 buffer_permanent_local_flags[idx++] = 1;
5084 XSETFASTINT (BVAR (&buffer_local_flags, left_margin_cols), idx); ++idx;
5085 XSETFASTINT (BVAR (&buffer_local_flags, right_margin_cols), idx); ++idx;
5086 XSETFASTINT (BVAR (&buffer_local_flags, left_fringe_width), idx); ++idx;
5087 XSETFASTINT (BVAR (&buffer_local_flags, right_fringe_width), idx); ++idx;
5088 XSETFASTINT (BVAR (&buffer_local_flags, fringes_outside_margins), idx); ++idx;
5089 XSETFASTINT (BVAR (&buffer_local_flags, scroll_bar_width), idx); ++idx;
5090 XSETFASTINT (BVAR (&buffer_local_flags, scroll_bar_height), idx); ++idx;
5091 XSETFASTINT (BVAR (&buffer_local_flags, vertical_scroll_bar_type), idx); ++idx;
5092 XSETFASTINT (BVAR (&buffer_local_flags, horizontal_scroll_bar_type), idx); ++idx;
5093 XSETFASTINT (BVAR (&buffer_local_flags, indicate_empty_lines), idx); ++idx;
5094 XSETFASTINT (BVAR (&buffer_local_flags, indicate_buffer_boundaries), idx); ++idx;
5095 XSETFASTINT (BVAR (&buffer_local_flags, fringe_indicator_alist), idx); ++idx;
5096 XSETFASTINT (BVAR (&buffer_local_flags, fringe_cursor_alist), idx); ++idx;
5097 XSETFASTINT (BVAR (&buffer_local_flags, scroll_up_aggressively), idx); ++idx;
5098 XSETFASTINT (BVAR (&buffer_local_flags, scroll_down_aggressively), idx); ++idx;
5099 XSETFASTINT (BVAR (&buffer_local_flags, header_line_format), idx); ++idx;
5100 XSETFASTINT (BVAR (&buffer_local_flags, cursor_type), idx); ++idx;
5101 XSETFASTINT (BVAR (&buffer_local_flags, extra_line_spacing), idx); ++idx;
5102 XSETFASTINT (BVAR (&buffer_local_flags, cursor_in_non_selected_windows), idx); ++idx;
5104 /* Need more room? */
5105 if (idx >= MAX_PER_BUFFER_VARS)
5106 emacs_abort ();
5107 last_per_buffer_idx = idx;
5109 /* Make sure all markable slots in buffer_defaults
5110 are initialized reasonably, so mark_buffer won't choke. */
5111 reset_buffer (&buffer_defaults);
5112 eassert (NILP (BVAR (&buffer_defaults, name)));
5113 reset_buffer_local_variables (&buffer_defaults, 1);
5114 eassert (NILP (BVAR (&buffer_local_symbols, name)));
5115 reset_buffer (&buffer_local_symbols);
5116 reset_buffer_local_variables (&buffer_local_symbols, 1);
5117 /* Prevent GC from getting confused. */
5118 buffer_defaults.text = &buffer_defaults.own_text;
5119 buffer_local_symbols.text = &buffer_local_symbols.own_text;
5120 /* No one will share the text with these buffers, but let's play it safe. */
5121 buffer_defaults.indirections = 0;
5122 buffer_local_symbols.indirections = 0;
5123 /* Likewise no one will display them. */
5124 buffer_defaults.window_count = 0;
5125 buffer_local_symbols.window_count = 0;
5126 set_buffer_intervals (&buffer_defaults, NULL);
5127 set_buffer_intervals (&buffer_local_symbols, NULL);
5128 /* This is not strictly necessary, but let's make them initialized. */
5129 bset_name (&buffer_defaults, build_pure_c_string (" *buffer-defaults*"));
5130 bset_name (&buffer_local_symbols, build_pure_c_string (" *buffer-local-symbols*"));
5131 BUFFER_PVEC_INIT (&buffer_defaults);
5132 BUFFER_PVEC_INIT (&buffer_local_symbols);
5134 /* Set up the default values of various buffer slots. */
5135 /* Must do these before making the first buffer! */
5137 /* real setup is done in bindings.el */
5138 bset_mode_line_format (&buffer_defaults, build_pure_c_string ("%-"));
5139 bset_header_line_format (&buffer_defaults, Qnil);
5140 bset_abbrev_mode (&buffer_defaults, Qnil);
5141 bset_overwrite_mode (&buffer_defaults, Qnil);
5142 bset_case_fold_search (&buffer_defaults, Qt);
5143 bset_auto_fill_function (&buffer_defaults, Qnil);
5144 bset_selective_display (&buffer_defaults, Qnil);
5145 bset_selective_display_ellipses (&buffer_defaults, Qt);
5146 bset_abbrev_table (&buffer_defaults, Qnil);
5147 bset_display_table (&buffer_defaults, Qnil);
5148 bset_undo_list (&buffer_defaults, Qnil);
5149 bset_mark_active (&buffer_defaults, Qnil);
5150 bset_file_format (&buffer_defaults, Qnil);
5151 bset_auto_save_file_format (&buffer_defaults, Qt);
5152 set_buffer_overlays_before (&buffer_defaults, NULL);
5153 set_buffer_overlays_after (&buffer_defaults, NULL);
5154 buffer_defaults.overlay_center = BEG;
5156 XSETFASTINT (BVAR (&buffer_defaults, tab_width), 8);
5157 bset_truncate_lines (&buffer_defaults, Qnil);
5158 bset_word_wrap (&buffer_defaults, Qnil);
5159 bset_ctl_arrow (&buffer_defaults, Qt);
5160 bset_bidi_display_reordering (&buffer_defaults, Qt);
5161 bset_bidi_paragraph_direction (&buffer_defaults, Qnil);
5162 bset_cursor_type (&buffer_defaults, Qt);
5163 bset_extra_line_spacing (&buffer_defaults, Qnil);
5164 bset_cursor_in_non_selected_windows (&buffer_defaults, Qt);
5166 bset_enable_multibyte_characters (&buffer_defaults, Qt);
5167 bset_buffer_file_coding_system (&buffer_defaults, Qnil);
5168 XSETFASTINT (BVAR (&buffer_defaults, fill_column), 70);
5169 XSETFASTINT (BVAR (&buffer_defaults, left_margin), 0);
5170 bset_cache_long_scans (&buffer_defaults, Qt);
5171 bset_file_truename (&buffer_defaults, Qnil);
5172 XSETFASTINT (BVAR (&buffer_defaults, display_count), 0);
5173 XSETFASTINT (BVAR (&buffer_defaults, left_margin_cols), 0);
5174 XSETFASTINT (BVAR (&buffer_defaults, right_margin_cols), 0);
5175 bset_left_fringe_width (&buffer_defaults, Qnil);
5176 bset_right_fringe_width (&buffer_defaults, Qnil);
5177 bset_fringes_outside_margins (&buffer_defaults, Qnil);
5178 bset_scroll_bar_width (&buffer_defaults, Qnil);
5179 bset_scroll_bar_height (&buffer_defaults, Qnil);
5180 bset_vertical_scroll_bar_type (&buffer_defaults, Qt);
5181 bset_horizontal_scroll_bar_type (&buffer_defaults, Qt);
5182 bset_indicate_empty_lines (&buffer_defaults, Qnil);
5183 bset_indicate_buffer_boundaries (&buffer_defaults, Qnil);
5184 bset_fringe_indicator_alist (&buffer_defaults, Qnil);
5185 bset_fringe_cursor_alist (&buffer_defaults, Qnil);
5186 bset_scroll_up_aggressively (&buffer_defaults, Qnil);
5187 bset_scroll_down_aggressively (&buffer_defaults, Qnil);
5188 bset_display_time (&buffer_defaults, Qnil);
5190 /* Assign the local-flags to the slots that have default values.
5191 The local flag is a bit that is used in the buffer
5192 to say that it has its own local value for the slot.
5193 The local flag bits are in the local_var_flags slot of the buffer. */
5195 /* Nothing can work if this isn't true. */
5196 { verify (sizeof (EMACS_INT) == word_size); }
5198 Vbuffer_alist = Qnil;
5199 current_buffer = 0;
5200 all_buffers = 0;
5202 QSFundamental = build_pure_c_string ("Fundamental");
5204 DEFSYM (Qfundamental_mode, "fundamental-mode");
5205 bset_major_mode (&buffer_defaults, Qfundamental_mode);
5207 DEFSYM (Qmode_class, "mode-class");
5208 DEFSYM (Qprotected_field, "protected-field");
5210 DEFSYM (Qpermanent_local, "permanent-local");
5211 DEFSYM (Qkill_buffer_hook, "kill-buffer-hook");
5212 Fput (Qkill_buffer_hook, Qpermanent_local, Qt);
5214 /* Super-magic invisible buffer. */
5215 Vprin1_to_string_buffer = Fget_buffer_create (build_pure_c_string (" prin1"));
5216 Vbuffer_alist = Qnil;
5218 Fset_buffer (Fget_buffer_create (build_pure_c_string ("*scratch*")));
5220 inhibit_modification_hooks = 0;
5223 void
5224 init_buffer (int initialized)
5226 char *pwd;
5227 Lisp_Object temp;
5228 ptrdiff_t len;
5230 #ifdef USE_MMAP_FOR_BUFFERS
5231 if (initialized)
5233 struct buffer *b;
5235 #ifndef WINDOWSNT
5236 /* These must be reset in the dumped Emacs, to avoid stale
5237 references to mmap'ed memory from before the dump.
5239 WINDOWSNT doesn't need this because it doesn't track mmap'ed
5240 regions by hand (see w32heap.c, which uses system APIs for
5241 that purpose), and thus doesn't use mmap_regions. */
5242 mmap_regions = NULL;
5243 mmap_fd = -1;
5244 #endif
5246 /* The dumped buffers reference addresses of buffer text
5247 recorded by temacs, that cannot be used by the dumped Emacs.
5248 We map new memory for their text here.
5250 Implementation note: the buffers we carry from temacs are:
5251 " prin1", "*scratch*", " *Minibuf-0*", "*Messages*", and
5252 " *code-conversion-work*". They are created by
5253 init_buffer_once and init_window_once (which are not called
5254 in the dumped Emacs), and by the first call to coding.c routines. */
5255 FOR_EACH_BUFFER (b)
5257 b->text->beg = NULL;
5258 enlarge_buffer_text (b, 0);
5261 else
5263 struct buffer *b;
5265 /* Only buffers with allocated buffer text should be present at
5266 this point in temacs. */
5267 FOR_EACH_BUFFER (b)
5269 eassert (b->text->beg != NULL);
5272 #else /* not USE_MMAP_FOR_BUFFERS */
5273 /* Avoid compiler warnings. */
5274 (void) initialized;
5275 #endif /* USE_MMAP_FOR_BUFFERS */
5277 AUTO_STRING (scratch, "*scratch*");
5278 Fset_buffer (Fget_buffer_create (scratch));
5279 if (NILP (BVAR (&buffer_defaults, enable_multibyte_characters)))
5280 Fset_buffer_multibyte (Qnil);
5282 pwd = get_current_dir_name ();
5284 if (!pwd)
5286 fprintf (stderr, "Error getting directory: %s\n",
5287 emacs_strerror (errno));
5288 bset_directory (current_buffer, Qnil);
5290 else
5292 /* Maybe this should really use some standard subroutine
5293 whose definition is filename syntax dependent. */
5294 len = strlen (pwd);
5295 if (!(IS_DIRECTORY_SEP (pwd[len - 1])))
5297 /* Grow buffer to add directory separator and '\0'. */
5298 pwd = realloc (pwd, len + 2);
5299 if (!pwd)
5300 fatal ("get_current_dir_name: %s\n", strerror (errno));
5301 pwd[len] = DIRECTORY_SEP;
5302 pwd[len + 1] = '\0';
5303 len++;
5306 /* At this moment, we still don't know how to decode the directory
5307 name. So, we keep the bytes in unibyte form so that file I/O
5308 routines correctly get the original bytes. */
5309 bset_directory (current_buffer, make_unibyte_string (pwd, len));
5311 /* Add /: to the front of the name
5312 if it would otherwise be treated as magic. */
5313 temp = Ffind_file_name_handler (BVAR (current_buffer, directory), Qt);
5314 if (! NILP (temp)
5315 /* If the default dir is just /, TEMP is non-nil
5316 because of the ange-ftp completion handler.
5317 However, it is not necessary to turn / into /:/.
5318 So avoid doing that. */
5319 && strcmp ("/", SSDATA (BVAR (current_buffer, directory))))
5321 AUTO_STRING (slash_colon, "/:");
5322 bset_directory (current_buffer,
5323 concat2 (slash_colon,
5324 BVAR (current_buffer, directory)));
5328 temp = get_minibuffer (0);
5329 bset_directory (XBUFFER (temp), BVAR (current_buffer, directory));
5331 free (pwd);
5334 /* Similar to defvar_lisp but define a variable whose value is the
5335 Lisp_Object stored in the current buffer. LNAME is the Lisp-level
5336 variable name. VNAME is the name of the buffer slot. PREDICATE
5337 is nil for a general Lisp variable. If PREDICATE is non-nil, then
5338 only Lisp values that satisfies the PREDICATE are allowed (except
5339 that nil is allowed too). DOC is a dummy where you write the doc
5340 string as a comment. */
5342 #define DEFVAR_PER_BUFFER(lname, vname, predicate, doc) \
5343 do { \
5344 static struct Lisp_Buffer_Objfwd bo_fwd; \
5345 defvar_per_buffer (&bo_fwd, lname, vname, predicate); \
5346 } while (0)
5348 static void
5349 defvar_per_buffer (struct Lisp_Buffer_Objfwd *bo_fwd, const char *namestring,
5350 Lisp_Object *address, Lisp_Object predicate)
5352 struct Lisp_Symbol *sym;
5353 int offset;
5355 sym = XSYMBOL (intern (namestring));
5356 offset = (char *)address - (char *)current_buffer;
5358 bo_fwd->type = Lisp_Fwd_Buffer_Obj;
5359 bo_fwd->offset = offset;
5360 bo_fwd->predicate = predicate;
5361 sym->declared_special = 1;
5362 sym->redirect = SYMBOL_FORWARDED;
5363 SET_SYMBOL_FWD (sym, (union Lisp_Fwd *) bo_fwd);
5364 XSETSYMBOL (PER_BUFFER_SYMBOL (offset), sym);
5366 if (PER_BUFFER_IDX (offset) == 0)
5367 /* Did a DEFVAR_PER_BUFFER without initializing the corresponding
5368 slot of buffer_local_flags. */
5369 emacs_abort ();
5373 /* Initialize the buffer routines. */
5374 void
5375 syms_of_buffer (void)
5377 staticpro (&last_overlay_modification_hooks);
5378 last_overlay_modification_hooks
5379 = Fmake_vector (make_number (10), Qnil);
5381 staticpro (&QSFundamental);
5382 staticpro (&Vbuffer_alist);
5384 DEFSYM (Qchoice, "choice");
5385 DEFSYM (Qleft, "left");
5386 DEFSYM (Qright, "right");
5387 DEFSYM (Qrange, "range");
5389 DEFSYM (Qpermanent_local_hook, "permanent-local-hook");
5390 DEFSYM (Qoverlayp, "overlayp");
5391 DEFSYM (Qevaporate, "evaporate");
5392 DEFSYM (Qmodification_hooks, "modification-hooks");
5393 DEFSYM (Qinsert_in_front_hooks, "insert-in-front-hooks");
5394 DEFSYM (Qinsert_behind_hooks, "insert-behind-hooks");
5395 DEFSYM (Qget_file_buffer, "get-file-buffer");
5396 DEFSYM (Qpriority, "priority");
5397 DEFSYM (Qbefore_string, "before-string");
5398 DEFSYM (Qafter_string, "after-string");
5399 DEFSYM (Qfirst_change_hook, "first-change-hook");
5400 DEFSYM (Qbefore_change_functions, "before-change-functions");
5401 DEFSYM (Qafter_change_functions, "after-change-functions");
5402 DEFSYM (Qkill_buffer_query_functions, "kill-buffer-query-functions");
5404 DEFSYM (Qvertical_scroll_bar, "vertical-scroll-bar");
5405 Fput (Qvertical_scroll_bar, Qchoice, list4 (Qnil, Qt, Qleft, Qright));
5406 DEFSYM (Qhorizontal_scroll_bar, "horizontal-scroll-bar");
5408 DEFSYM (Qfraction, "fraction");
5409 Fput (Qfraction, Qrange, Fcons (make_float (0.0), make_float (1.0)));
5411 DEFSYM (Qoverwrite_mode, "overwrite-mode");
5412 Fput (Qoverwrite_mode, Qchoice,
5413 list3 (Qnil, intern ("overwrite-mode-textual"),
5414 Qoverwrite_mode_binary));
5416 Fput (Qprotected_field, Qerror_conditions,
5417 listn (CONSTYPE_PURE, 2, Qprotected_field, Qerror));
5418 Fput (Qprotected_field, Qerror_message,
5419 build_pure_c_string ("Attempt to modify a protected field"));
5421 DEFVAR_BUFFER_DEFAULTS ("default-mode-line-format",
5422 mode_line_format,
5423 doc: /* Default value of `mode-line-format' for buffers that don't override it.
5424 This is the same as (default-value \\='mode-line-format). */);
5426 DEFVAR_BUFFER_DEFAULTS ("default-header-line-format",
5427 header_line_format,
5428 doc: /* Default value of `header-line-format' for buffers that don't override it.
5429 This is the same as (default-value \\='header-line-format). */);
5431 DEFVAR_BUFFER_DEFAULTS ("default-cursor-type", cursor_type,
5432 doc: /* Default value of `cursor-type' for buffers that don't override it.
5433 This is the same as (default-value \\='cursor-type). */);
5435 DEFVAR_BUFFER_DEFAULTS ("default-line-spacing",
5436 extra_line_spacing,
5437 doc: /* Default value of `line-spacing' for buffers that don't override it.
5438 This is the same as (default-value \\='line-spacing). */);
5440 DEFVAR_BUFFER_DEFAULTS ("default-cursor-in-non-selected-windows",
5441 cursor_in_non_selected_windows,
5442 doc: /* Default value of `cursor-in-non-selected-windows'.
5443 This is the same as (default-value \\='cursor-in-non-selected-windows). */);
5445 DEFVAR_BUFFER_DEFAULTS ("default-abbrev-mode",
5446 abbrev_mode,
5447 doc: /* Default value of `abbrev-mode' for buffers that do not override it.
5448 This is the same as (default-value \\='abbrev-mode). */);
5450 DEFVAR_BUFFER_DEFAULTS ("default-ctl-arrow",
5451 ctl_arrow,
5452 doc: /* Default value of `ctl-arrow' for buffers that do not override it.
5453 This is the same as (default-value \\='ctl-arrow). */);
5455 DEFVAR_BUFFER_DEFAULTS ("default-enable-multibyte-characters",
5456 enable_multibyte_characters,
5457 doc: /* Default value of `enable-multibyte-characters' for buffers not overriding it.
5458 This is the same as (default-value \\='enable-multibyte-characters). */);
5460 DEFVAR_BUFFER_DEFAULTS ("default-buffer-file-coding-system",
5461 buffer_file_coding_system,
5462 doc: /* Default value of `buffer-file-coding-system' for buffers not overriding it.
5463 This is the same as (default-value \\='buffer-file-coding-system). */);
5465 DEFVAR_BUFFER_DEFAULTS ("default-truncate-lines",
5466 truncate_lines,
5467 doc: /* Default value of `truncate-lines' for buffers that do not override it.
5468 This is the same as (default-value \\='truncate-lines). */);
5470 DEFVAR_BUFFER_DEFAULTS ("default-fill-column",
5471 fill_column,
5472 doc: /* Default value of `fill-column' for buffers that do not override it.
5473 This is the same as (default-value \\='fill-column). */);
5475 DEFVAR_BUFFER_DEFAULTS ("default-left-margin",
5476 left_margin,
5477 doc: /* Default value of `left-margin' for buffers that do not override it.
5478 This is the same as (default-value \\='left-margin). */);
5480 DEFVAR_BUFFER_DEFAULTS ("default-tab-width",
5481 tab_width,
5482 doc: /* Default value of `tab-width' for buffers that do not override it.
5483 NOTE: This controls the display width of a TAB character, and not
5484 the size of an indentation step.
5485 This is the same as (default-value \\='tab-width). */);
5487 DEFVAR_BUFFER_DEFAULTS ("default-case-fold-search",
5488 case_fold_search,
5489 doc: /* Default value of `case-fold-search' for buffers that don't override it.
5490 This is the same as (default-value \\='case-fold-search). */);
5492 DEFVAR_BUFFER_DEFAULTS ("default-left-margin-width",
5493 left_margin_cols,
5494 doc: /* Default value of `left-margin-width' for buffers that don't override it.
5495 This is the same as (default-value \\='left-margin-width). */);
5497 DEFVAR_BUFFER_DEFAULTS ("default-right-margin-width",
5498 right_margin_cols,
5499 doc: /* Default value of `right-margin-width' for buffers that don't override it.
5500 This is the same as (default-value \\='right-margin-width). */);
5502 DEFVAR_BUFFER_DEFAULTS ("default-left-fringe-width",
5503 left_fringe_width,
5504 doc: /* Default value of `left-fringe-width' for buffers that don't override it.
5505 This is the same as (default-value \\='left-fringe-width). */);
5507 DEFVAR_BUFFER_DEFAULTS ("default-right-fringe-width",
5508 right_fringe_width,
5509 doc: /* Default value of `right-fringe-width' for buffers that don't override it.
5510 This is the same as (default-value \\='right-fringe-width). */);
5512 DEFVAR_BUFFER_DEFAULTS ("default-fringes-outside-margins",
5513 fringes_outside_margins,
5514 doc: /* Default value of `fringes-outside-margins' for buffers that don't override it.
5515 This is the same as (default-value \\='fringes-outside-margins). */);
5517 DEFVAR_BUFFER_DEFAULTS ("default-scroll-bar-width",
5518 scroll_bar_width,
5519 doc: /* Default value of `scroll-bar-width' for buffers that don't override it.
5520 This is the same as (default-value \\='scroll-bar-width). */);
5522 DEFVAR_BUFFER_DEFAULTS ("default-vertical-scroll-bar",
5523 vertical_scroll_bar_type,
5524 doc: /* Default value of `vertical-scroll-bar' for buffers that don't override it.
5525 This is the same as (default-value \\='vertical-scroll-bar). */);
5527 DEFVAR_BUFFER_DEFAULTS ("default-indicate-empty-lines",
5528 indicate_empty_lines,
5529 doc: /* Default value of `indicate-empty-lines' for buffers that don't override it.
5530 This is the same as (default-value \\='indicate-empty-lines). */);
5532 DEFVAR_BUFFER_DEFAULTS ("default-indicate-buffer-boundaries",
5533 indicate_buffer_boundaries,
5534 doc: /* Default value of `indicate-buffer-boundaries' for buffers that don't override it.
5535 This is the same as (default-value \\='indicate-buffer-boundaries). */);
5537 DEFVAR_BUFFER_DEFAULTS ("default-fringe-indicator-alist",
5538 fringe_indicator_alist,
5539 doc: /* Default value of `fringe-indicator-alist' for buffers that don't override it.
5540 This is the same as (default-value \\='fringe-indicator-alist). */);
5542 DEFVAR_BUFFER_DEFAULTS ("default-fringe-cursor-alist",
5543 fringe_cursor_alist,
5544 doc: /* Default value of `fringe-cursor-alist' for buffers that don't override it.
5545 This is the same as (default-value \\='fringe-cursor-alist). */);
5547 DEFVAR_BUFFER_DEFAULTS ("default-scroll-up-aggressively",
5548 scroll_up_aggressively,
5549 doc: /* Default value of `scroll-up-aggressively'.
5550 This value applies in buffers that don't have their own local values.
5551 This is the same as (default-value \\='scroll-up-aggressively). */);
5553 DEFVAR_BUFFER_DEFAULTS ("default-scroll-down-aggressively",
5554 scroll_down_aggressively,
5555 doc: /* Default value of `scroll-down-aggressively'.
5556 This value applies in buffers that don't have their own local values.
5557 This is the same as (default-value \\='scroll-down-aggressively). */);
5559 DEFVAR_PER_BUFFER ("header-line-format",
5560 &BVAR (current_buffer, header_line_format),
5561 Qnil,
5562 doc: /* Analogous to `mode-line-format', but controls the header line.
5563 The header line appears, optionally, at the top of a window;
5564 the mode line appears at the bottom. */);
5566 DEFVAR_PER_BUFFER ("mode-line-format", &BVAR (current_buffer, mode_line_format),
5567 Qnil,
5568 doc: /* Template for displaying mode line for current buffer.
5570 The value may be nil, a string, a symbol or a list.
5572 A value of nil means don't display a mode line.
5574 For any symbol other than t or nil, the symbol's value is processed as
5575 a mode line construct. As a special exception, if that value is a
5576 string, the string is processed verbatim, without handling any
5577 %-constructs (see below). Also, unless the symbol has a non-nil
5578 `risky-local-variable' property, all properties in any strings, as
5579 well as all :eval and :propertize forms in the value, are ignored.
5581 A list whose car is a string or list is processed by processing each
5582 of the list elements recursively, as separate mode line constructs,
5583 and concatenating the results.
5585 A list of the form `(:eval FORM)' is processed by evaluating FORM and
5586 using the result as a mode line construct. Be careful--FORM should
5587 not load any files, because that can cause an infinite recursion.
5589 A list of the form `(:propertize ELT PROPS...)' is processed by
5590 processing ELT as the mode line construct, and adding the text
5591 properties PROPS to the result.
5593 A list whose car is a symbol is processed by examining the symbol's
5594 value, and, if that value is non-nil, processing the cadr of the list
5595 recursively; and if that value is nil, processing the caddr of the
5596 list recursively.
5598 A list whose car is an integer is processed by processing the cadr of
5599 the list, and padding (if the number is positive) or truncating (if
5600 negative) to the width specified by that number.
5602 A string is printed verbatim in the mode line except for %-constructs:
5603 %b -- print buffer name. %f -- print visited file name.
5604 %F -- print frame name.
5605 %* -- print %, * or hyphen. %+ -- print *, % or hyphen.
5606 %& is like %*, but ignore read-only-ness.
5607 % means buffer is read-only and * means it is modified.
5608 For a modified read-only buffer, %* gives % and %+ gives *.
5609 %s -- print process status. %l -- print the current line number.
5610 %c -- print the current column number (this makes editing slower).
5611 To make the column number update correctly in all cases,
5612 `column-number-mode' must be non-nil.
5613 %i -- print the size of the buffer.
5614 %I -- like %i, but use k, M, G, etc., to abbreviate.
5615 %p -- print percent of buffer above top of window, or Top, Bot or All.
5616 %P -- print percent of buffer above bottom of window, perhaps plus Top,
5617 or print Bottom or All.
5618 %n -- print Narrow if appropriate.
5619 %t -- visited file is text or binary (if OS supports this distinction).
5620 %z -- print mnemonics of keyboard, terminal, and buffer coding systems.
5621 %Z -- like %z, but including the end-of-line format.
5622 %e -- print error message about full memory.
5623 %@ -- print @ or hyphen. @ means that default-directory is on a
5624 remote machine.
5625 %[ -- print one [ for each recursive editing level. %] similar.
5626 %% -- print %. %- -- print infinitely many dashes.
5627 Decimal digits after the % specify field width to which to pad. */);
5629 DEFVAR_BUFFER_DEFAULTS ("default-major-mode", major_mode,
5630 doc: /* Value of `major-mode' for new buffers. */);
5632 DEFVAR_PER_BUFFER ("major-mode", &BVAR (current_buffer, major_mode),
5633 Qsymbolp,
5634 doc: /* Symbol for current buffer's major mode.
5635 The default value (normally `fundamental-mode') affects new buffers.
5636 A value of nil means to use the current buffer's major mode, provided
5637 it is not marked as "special". */);
5639 DEFVAR_PER_BUFFER ("mode-name", &BVAR (current_buffer, mode_name),
5640 Qnil,
5641 doc: /* Pretty name of current buffer's major mode.
5642 Usually a string, but can use any of the constructs for `mode-line-format',
5643 which see.
5644 Format with `format-mode-line' to produce a string value. */);
5646 DEFVAR_PER_BUFFER ("local-abbrev-table", &BVAR (current_buffer, abbrev_table), Qnil,
5647 doc: /* Local (mode-specific) abbrev table of current buffer. */);
5649 DEFVAR_PER_BUFFER ("abbrev-mode", &BVAR (current_buffer, abbrev_mode), Qnil,
5650 doc: /* Non-nil if Abbrev mode is enabled.
5651 Use the command `abbrev-mode' to change this variable. */);
5653 DEFVAR_PER_BUFFER ("case-fold-search", &BVAR (current_buffer, case_fold_search),
5654 Qnil,
5655 doc: /* Non-nil if searches and matches should ignore case. */);
5657 DEFVAR_PER_BUFFER ("fill-column", &BVAR (current_buffer, fill_column),
5658 Qintegerp,
5659 doc: /* Column beyond which automatic line-wrapping should happen.
5660 Interactively, you can set the buffer local value using \\[set-fill-column]. */);
5662 DEFVAR_PER_BUFFER ("left-margin", &BVAR (current_buffer, left_margin),
5663 Qintegerp,
5664 doc: /* Column for the default `indent-line-function' to indent to.
5665 Linefeed indents to this column in Fundamental mode. */);
5667 DEFVAR_PER_BUFFER ("tab-width", &BVAR (current_buffer, tab_width),
5668 Qintegerp,
5669 doc: /* Distance between tab stops (for display of tab characters), in columns.
5670 NOTE: This controls the display width of a TAB character, and not
5671 the size of an indentation step.
5672 This should be an integer greater than zero. */);
5674 DEFVAR_PER_BUFFER ("ctl-arrow", &BVAR (current_buffer, ctl_arrow), Qnil,
5675 doc: /* Non-nil means display control chars with uparrow.
5676 A value of nil means use backslash and octal digits.
5677 This variable does not apply to characters whose display is specified
5678 in the current display table (if there is one). */);
5680 DEFVAR_PER_BUFFER ("enable-multibyte-characters",
5681 &BVAR (current_buffer, enable_multibyte_characters),
5682 Qnil,
5683 doc: /* Non-nil means the buffer contents are regarded as multi-byte characters.
5684 Otherwise they are regarded as unibyte. This affects the display,
5685 file I/O and the behavior of various editing commands.
5687 This variable is buffer-local but you cannot set it directly;
5688 use the function `set-buffer-multibyte' to change a buffer's representation.
5689 See also Info node `(elisp)Text Representations'. */);
5690 XSYMBOL (intern_c_string ("enable-multibyte-characters"))->constant = 1;
5692 DEFVAR_PER_BUFFER ("buffer-file-coding-system",
5693 &BVAR (current_buffer, buffer_file_coding_system), Qnil,
5694 doc: /* Coding system to be used for encoding the buffer contents on saving.
5695 This variable applies to saving the buffer, and also to `write-region'
5696 and other functions that use `write-region'.
5697 It does not apply to sending output to subprocesses, however.
5699 If this is nil, the buffer is saved without any code conversion
5700 unless some coding system is specified in `file-coding-system-alist'
5701 for the buffer file.
5703 If the text to be saved cannot be encoded as specified by this variable,
5704 an alternative encoding is selected by `select-safe-coding-system', which see.
5706 The variable `coding-system-for-write', if non-nil, overrides this variable.
5708 This variable is never applied to a way of decoding a file while reading it. */);
5710 DEFVAR_PER_BUFFER ("bidi-display-reordering",
5711 &BVAR (current_buffer, bidi_display_reordering), Qnil,
5712 doc: /* Non-nil means reorder bidirectional text for display in the visual order. */);
5714 DEFVAR_PER_BUFFER ("bidi-paragraph-direction",
5715 &BVAR (current_buffer, bidi_paragraph_direction), Qnil,
5716 doc: /* If non-nil, forces directionality of text paragraphs in the buffer.
5718 If this is nil (the default), the direction of each paragraph is
5719 determined by the first strong directional character of its text.
5720 The values of `right-to-left' and `left-to-right' override that.
5721 Any other value is treated as nil.
5723 This variable has no effect unless the buffer's value of
5724 `bidi-display-reordering' is non-nil. */);
5726 DEFVAR_PER_BUFFER ("truncate-lines", &BVAR (current_buffer, truncate_lines), Qnil,
5727 doc: /* Non-nil means do not display continuation lines.
5728 Instead, give each line of text just one screen line.
5730 Note that this is overridden by the variable
5731 `truncate-partial-width-windows' if that variable is non-nil
5732 and this buffer is not full-frame width.
5734 Minibuffers set this variable to nil. */);
5736 DEFVAR_PER_BUFFER ("word-wrap", &BVAR (current_buffer, word_wrap), Qnil,
5737 doc: /* Non-nil means to use word-wrapping for continuation lines.
5738 When word-wrapping is on, continuation lines are wrapped at the space
5739 or tab character nearest to the right window edge.
5740 If nil, continuation lines are wrapped at the right screen edge.
5742 This variable has no effect if long lines are truncated (see
5743 `truncate-lines' and `truncate-partial-width-windows'). If you use
5744 word-wrapping, you might want to reduce the value of
5745 `truncate-partial-width-windows', since wrapping can make text readable
5746 in narrower windows.
5748 Instead of setting this variable directly, most users should use
5749 Visual Line mode . Visual Line mode, when enabled, sets `word-wrap'
5750 to t, and additionally redefines simple editing commands to act on
5751 visual lines rather than logical lines. See the documentation of
5752 `visual-line-mode'. */);
5754 DEFVAR_PER_BUFFER ("default-directory", &BVAR (current_buffer, directory),
5755 Qstringp,
5756 doc: /* Name of default directory of current buffer.
5757 To interactively change the default directory, use command `cd'. */);
5759 DEFVAR_PER_BUFFER ("auto-fill-function", &BVAR (current_buffer, auto_fill_function),
5760 Qnil,
5761 doc: /* Function called (if non-nil) to perform auto-fill.
5762 It is called after self-inserting any character specified in
5763 the `auto-fill-chars' table.
5764 NOTE: This variable is not a hook;
5765 its value may not be a list of functions. */);
5767 DEFVAR_PER_BUFFER ("buffer-file-name", &BVAR (current_buffer, filename),
5768 Qstringp,
5769 doc: /* Name of file visited in current buffer, or nil if not visiting a file.
5770 This should be an absolute file name. */);
5772 DEFVAR_PER_BUFFER ("buffer-file-truename", &BVAR (current_buffer, file_truename),
5773 Qstringp,
5774 doc: /* Abbreviated truename of file visited in current buffer, or nil if none.
5775 The truename of a file is calculated by `file-truename'
5776 and then abbreviated with `abbreviate-file-name'. */);
5778 DEFVAR_PER_BUFFER ("buffer-auto-save-file-name",
5779 &BVAR (current_buffer, auto_save_file_name),
5780 Qstringp,
5781 doc: /* Name of file for auto-saving current buffer.
5782 If it is nil, that means don't auto-save this buffer. */);
5784 DEFVAR_PER_BUFFER ("buffer-read-only", &BVAR (current_buffer, read_only), Qnil,
5785 doc: /* Non-nil if this buffer is read-only. */);
5787 DEFVAR_PER_BUFFER ("buffer-backed-up", &BVAR (current_buffer, backed_up), Qnil,
5788 doc: /* Non-nil if this buffer's file has been backed up.
5789 Backing up is done before the first time the file is saved. */);
5791 DEFVAR_PER_BUFFER ("buffer-saved-size", &BVAR (current_buffer, save_length),
5792 Qintegerp,
5793 doc: /* Length of current buffer when last read in, saved or auto-saved.
5794 0 initially.
5795 -1 means auto-saving turned off until next real save.
5797 If you set this to -2, that means don't turn off auto-saving in this buffer
5798 if its text size shrinks. If you use `buffer-swap-text' on a buffer,
5799 you probably should set this to -2 in that buffer. */);
5801 DEFVAR_PER_BUFFER ("selective-display", &BVAR (current_buffer, selective_display),
5802 Qnil,
5803 doc: /* Non-nil enables selective display.
5805 An integer N as value means display only lines
5806 that start with less than N columns of space.
5808 A value of t means that the character ^M makes itself and
5809 all the rest of the line invisible; also, when saving the buffer
5810 in a file, save the ^M as a newline. This usage is obsolete; use
5811 overlays or text properties instead. */);
5813 DEFVAR_PER_BUFFER ("selective-display-ellipses",
5814 &BVAR (current_buffer, selective_display_ellipses),
5815 Qnil,
5816 doc: /* Non-nil means display ... on previous line when a line is invisible. */);
5818 DEFVAR_PER_BUFFER ("overwrite-mode", &BVAR (current_buffer, overwrite_mode),
5819 Qoverwrite_mode,
5820 doc: /* Non-nil if self-insertion should replace existing text.
5821 The value should be one of `overwrite-mode-textual',
5822 `overwrite-mode-binary', or nil.
5823 If it is `overwrite-mode-textual', self-insertion still
5824 inserts at the end of a line, and inserts when point is before a tab,
5825 until the tab is filled in.
5826 If `overwrite-mode-binary', self-insertion replaces newlines and tabs too. */);
5828 DEFVAR_PER_BUFFER ("buffer-display-table", &BVAR (current_buffer, display_table),
5829 Qnil,
5830 doc: /* Display table that controls display of the contents of current buffer.
5832 If this variable is nil, the value of `standard-display-table' is used.
5833 Each window can have its own, overriding display table, see
5834 `set-window-display-table' and `window-display-table'.
5836 The display table is a char-table created with `make-display-table'.
5837 A char-table is an array indexed by character codes. Normal array
5838 primitives `aref' and `aset' can be used to access elements of a char-table.
5840 Each of the char-table elements control how to display the corresponding
5841 text character: the element at index C in the table says how to display
5842 the character whose code is C. Each element should be a vector of
5843 characters or nil. The value nil means display the character in the
5844 default fashion; otherwise, the characters from the vector are delivered
5845 to the screen instead of the original character.
5847 For example, (aset buffer-display-table ?X [?Y]) tells Emacs
5848 to display a capital Y instead of each X character.
5850 In addition, a char-table has six extra slots to control the display of:
5852 the end of a truncated screen line (extra-slot 0, a single character);
5853 the end of a continued line (extra-slot 1, a single character);
5854 the escape character used to display character codes in octal
5855 (extra-slot 2, a single character);
5856 the character used as an arrow for control characters (extra-slot 3,
5857 a single character);
5858 the decoration indicating the presence of invisible lines (extra-slot 4,
5859 a vector of characters);
5860 the character used to draw the border between side-by-side windows
5861 (extra-slot 5, a single character).
5863 See also the functions `display-table-slot' and `set-display-table-slot'. */);
5865 DEFVAR_PER_BUFFER ("left-margin-width", &BVAR (current_buffer, left_margin_cols),
5866 Qintegerp,
5867 doc: /* Width in columns of left marginal area for display of a buffer.
5868 A value of nil means no marginal area.
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-margin-width", &BVAR (current_buffer, right_margin_cols),
5874 Qintegerp,
5875 doc: /* Width in columns of right marginal area for display of a buffer.
5876 A value of nil means no marginal area.
5878 Setting this variable does not take effect until a new buffer is displayed
5879 in a window. To make the change take effect, call `set-window-buffer'. */);
5881 DEFVAR_PER_BUFFER ("left-fringe-width", &BVAR (current_buffer, left_fringe_width),
5882 Qintegerp,
5883 doc: /* Width of this buffer's left fringe (in pixels).
5884 A value of 0 means no left fringe is shown in this buffer's window.
5885 A value of nil means to use the left fringe width from the window's frame.
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 ("right-fringe-width", &BVAR (current_buffer, right_fringe_width),
5891 Qintegerp,
5892 doc: /* Width of this buffer's right fringe (in pixels).
5893 A value of 0 means no right fringe is shown in this buffer's window.
5894 A value of nil means to use the right fringe width from the window's frame.
5896 Setting this variable does not take effect until a new buffer is displayed
5897 in a window. To make the change take effect, call `set-window-buffer'. */);
5899 DEFVAR_PER_BUFFER ("fringes-outside-margins", &BVAR (current_buffer, fringes_outside_margins),
5900 Qnil,
5901 doc: /* Non-nil means to display fringes outside display margins.
5902 A value of nil means to display fringes between margins and buffer text.
5904 Setting this variable does not take effect until a new buffer is displayed
5905 in a window. To make the change take effect, call `set-window-buffer'. */);
5907 DEFVAR_PER_BUFFER ("scroll-bar-width", &BVAR (current_buffer, scroll_bar_width),
5908 Qintegerp,
5909 doc: /* Width of this buffer's vertical scroll bars in pixels.
5910 A value of nil means to use the scroll bar width from the window's frame. */);
5912 DEFVAR_PER_BUFFER ("scroll-bar-height", &BVAR (current_buffer, scroll_bar_height),
5913 Qintegerp,
5914 doc: /* Height of this buffer's horizontal scroll bars in pixels.
5915 A value of nil means to use the scroll bar height from the window's frame. */);
5917 DEFVAR_PER_BUFFER ("vertical-scroll-bar", &BVAR (current_buffer, vertical_scroll_bar_type),
5918 Qvertical_scroll_bar,
5919 doc: /* Position of this buffer's vertical scroll bar.
5920 The value takes effect whenever you tell a window to display this buffer;
5921 for instance, with `set-window-buffer' or when `display-buffer' displays it.
5923 A value of `left' or `right' means put the vertical scroll bar at that side
5924 of the window; a value of nil means don't show any vertical scroll bars.
5925 A value of t (the default) means do whatever the window's frame specifies. */);
5927 DEFVAR_PER_BUFFER ("horizontal-scroll-bar", &BVAR (current_buffer, horizontal_scroll_bar_type),
5928 Qnil,
5929 doc: /* Position of this buffer's horizontal scroll bar.
5930 The value takes effect whenever you tell a window to display this buffer;
5931 for instance, with `set-window-buffer' or when `display-buffer' displays it.
5933 A value of `bottom' means put the horizontal scroll bar at the bottom of
5934 the window; a value of nil means don't show any horizontal scroll bars.
5935 A value of t (the default) means do whatever the window's frame
5936 specifies. */);
5938 DEFVAR_PER_BUFFER ("indicate-empty-lines",
5939 &BVAR (current_buffer, indicate_empty_lines), Qnil,
5940 doc: /* Visually indicate empty lines after the buffer end.
5941 If non-nil, a bitmap is displayed in the left fringe of a window on
5942 window-systems. */);
5944 DEFVAR_PER_BUFFER ("indicate-buffer-boundaries",
5945 &BVAR (current_buffer, indicate_buffer_boundaries), Qnil,
5946 doc: /* Visually indicate buffer boundaries and scrolling.
5947 If non-nil, the first and last line of the buffer are marked in the fringe
5948 of a window on window-systems with angle bitmaps, or if the window can be
5949 scrolled, the top and bottom line of the window are marked with up and down
5950 arrow bitmaps.
5952 If value is a symbol `left' or `right', both angle and arrow bitmaps
5953 are displayed in the left or right fringe, resp. Any other value
5954 that doesn't look like an alist means display the angle bitmaps in
5955 the left fringe but no arrows.
5957 You can exercise more precise control by using an alist as the
5958 value. Each alist element (INDICATOR . POSITION) specifies
5959 where to show one of the indicators. INDICATOR is one of `top',
5960 `bottom', `up', `down', or t, which specifies the default position,
5961 and POSITION is one of `left', `right', or nil, meaning do not show
5962 this indicator.
5964 For example, ((top . left) (t . right)) places the top angle bitmap in
5965 left fringe, the bottom angle bitmap in right fringe, and both arrow
5966 bitmaps in right fringe. To show just the angle bitmaps in the left
5967 fringe, but no arrow bitmaps, use ((top . left) (bottom . left)). */);
5969 DEFVAR_PER_BUFFER ("fringe-indicator-alist",
5970 &BVAR (current_buffer, fringe_indicator_alist), Qnil,
5971 doc: /* Mapping from logical to physical fringe indicator bitmaps.
5972 The value is an alist where each element (INDICATOR . BITMAPS)
5973 specifies the fringe bitmaps used to display a specific logical
5974 fringe indicator.
5976 INDICATOR specifies the logical indicator type which is one of the
5977 following symbols: `truncation' , `continuation', `overlay-arrow',
5978 `top', `bottom', `top-bottom', `up', `down', empty-line', or `unknown'.
5980 BITMAPS is a list of symbols (LEFT RIGHT [LEFT1 RIGHT1]) which specifies
5981 the actual bitmap shown in the left or right fringe for the logical
5982 indicator. LEFT and RIGHT are the bitmaps shown in the left and/or
5983 right fringe for the specific indicator. The LEFT1 or RIGHT1 bitmaps
5984 are used only for the `bottom' and `top-bottom' indicators when the
5985 last (only) line has no final newline. BITMAPS may also be a single
5986 symbol which is used in both left and right fringes. */);
5988 DEFVAR_PER_BUFFER ("fringe-cursor-alist",
5989 &BVAR (current_buffer, fringe_cursor_alist), Qnil,
5990 doc: /* Mapping from logical to physical fringe cursor bitmaps.
5991 The value is an alist where each element (CURSOR . BITMAP)
5992 specifies the fringe bitmaps used to display a specific logical
5993 cursor type in the fringe.
5995 CURSOR specifies the logical cursor type which is one of the following
5996 symbols: `box' , `hollow', `bar', `hbar', or `hollow-small'. The last
5997 one is used to show a hollow cursor on narrow lines display lines
5998 where the normal hollow cursor will not fit.
6000 BITMAP is the corresponding fringe bitmap shown for the logical
6001 cursor type. */);
6003 DEFVAR_PER_BUFFER ("scroll-up-aggressively",
6004 &BVAR (current_buffer, scroll_up_aggressively), Qfraction,
6005 doc: /* How far to scroll windows upward.
6006 If you move point off the bottom, the window scrolls automatically.
6007 This variable controls how far it scrolls. The value nil, the default,
6008 means scroll to center point. A fraction means scroll to put point
6009 that fraction of the window's height from the bottom of the window.
6010 When the value is 0.0, point goes at the bottom line, which in the
6011 simple case that you moved off with C-f means scrolling just one line.
6012 1.0 means point goes at the top, so that in that simple case, the
6013 window scrolls by a full window height. Meaningful values are
6014 between 0.0 and 1.0, inclusive. */);
6016 DEFVAR_PER_BUFFER ("scroll-down-aggressively",
6017 &BVAR (current_buffer, scroll_down_aggressively), Qfraction,
6018 doc: /* How far to scroll windows downward.
6019 If you move point off the top, the window scrolls automatically.
6020 This variable controls how far it scrolls. The value nil, the default,
6021 means scroll to center point. A fraction means scroll to put point
6022 that fraction of the window's height from the top of the window.
6023 When the value is 0.0, point goes at the top line, which in the
6024 simple case that you moved off with C-b means scrolling just one line.
6025 1.0 means point goes at the bottom, so that in that simple case, the
6026 window scrolls by a full window height. Meaningful values are
6027 between 0.0 and 1.0, inclusive. */);
6029 DEFVAR_LISP ("before-change-functions", Vbefore_change_functions,
6030 doc: /* List of functions to call before each text change.
6031 Two arguments are passed to each function: the positions of
6032 the beginning and end of the range of old text to be changed.
6033 \(For an insertion, the beginning and end are at the same place.)
6034 No information is given about the length of the text after the change.
6036 Buffer changes made while executing the `before-change-functions'
6037 don't call any before-change or after-change functions.
6038 That's because `inhibit-modification-hooks' is temporarily set non-nil.
6040 If an unhandled error happens in running these functions,
6041 the variable's value remains nil. That prevents the error
6042 from happening repeatedly and making Emacs nonfunctional. */);
6043 Vbefore_change_functions = Qnil;
6045 DEFVAR_LISP ("after-change-functions", Vafter_change_functions,
6046 doc: /* List of functions to call after each text change.
6047 Three arguments are passed to each function: the positions of
6048 the beginning and end of the range of changed text,
6049 and the length in chars of the pre-change text replaced by that range.
6050 \(For an insertion, the pre-change length is zero;
6051 for a deletion, that length is the number of chars deleted,
6052 and the post-change beginning and end are at the same place.)
6054 Buffer changes made while executing the `after-change-functions'
6055 don't call any before-change or after-change functions.
6056 That's because `inhibit-modification-hooks' is temporarily set non-nil.
6058 If an unhandled error happens in running these functions,
6059 the variable's value remains nil. That prevents the error
6060 from happening repeatedly and making Emacs nonfunctional. */);
6061 Vafter_change_functions = Qnil;
6063 DEFVAR_LISP ("first-change-hook", Vfirst_change_hook,
6064 doc: /* A list of functions to call before changing a buffer which is unmodified.
6065 The functions are run using the `run-hooks' function. */);
6066 Vfirst_change_hook = Qnil;
6068 DEFVAR_PER_BUFFER ("buffer-undo-list", &BVAR (current_buffer, undo_list), Qnil,
6069 doc: /* List of undo entries in current buffer.
6070 Recent changes come first; older changes follow newer.
6072 An entry (BEG . END) represents an insertion which begins at
6073 position BEG and ends at position END.
6075 An entry (TEXT . POSITION) represents the deletion of the string TEXT
6076 from (abs POSITION). If POSITION is positive, point was at the front
6077 of the text being deleted; if negative, point was at the end.
6079 An entry (t HIGH LOW USEC PSEC) indicates that the buffer was previously
6080 unmodified; (HIGH LOW USEC PSEC) is in the same style as (current-time)
6081 and is the visited file's modification time, as of that time. If the
6082 modification time of the most recent save is different, this entry is
6083 obsolete.
6085 An entry (t . 0) means means the buffer was previously unmodified but
6086 its time stamp was unknown because it was not associated with a file.
6087 An entry (t . -1) is similar, except that it means the buffer's visited
6088 file did not exist.
6090 An entry (nil PROPERTY VALUE BEG . END) indicates that a text property
6091 was modified between BEG and END. PROPERTY is the property name,
6092 and VALUE is the old value.
6094 An entry (apply FUN-NAME . ARGS) means undo the change with
6095 \(apply FUN-NAME ARGS).
6097 An entry (apply DELTA BEG END FUN-NAME . ARGS) supports selective undo
6098 in the active region. BEG and END is the range affected by this entry
6099 and DELTA is the number of characters added or deleted in that range by
6100 this change.
6102 An entry (MARKER . DISTANCE) indicates that the marker MARKER
6103 was adjusted in position by the offset DISTANCE (an integer).
6105 An entry of the form POSITION indicates that point was at the buffer
6106 location given by the integer. Undoing an entry of this form places
6107 point at POSITION.
6109 Entries with value nil mark undo boundaries. The undo command treats
6110 the changes between two undo boundaries as a single step to be undone.
6112 If the value of the variable is t, undo information is not recorded. */);
6114 DEFVAR_PER_BUFFER ("mark-active", &BVAR (current_buffer, mark_active), Qnil,
6115 doc: /* Non-nil means the mark and region are currently active in this buffer. */);
6117 DEFVAR_PER_BUFFER ("cache-long-scans", &BVAR (current_buffer, cache_long_scans), Qnil,
6118 doc: /* Non-nil means that Emacs should use caches in attempt to speedup buffer scans.
6120 There is no reason to set this to nil except for debugging purposes.
6122 Normally, the line-motion functions work by scanning the buffer for
6123 newlines. Columnar operations (like `move-to-column' and
6124 `compute-motion') also work by scanning the buffer, summing character
6125 widths as they go. This works well for ordinary text, but if the
6126 buffer's lines are very long (say, more than 500 characters), these
6127 motion functions will take longer to execute. Emacs may also take
6128 longer to update the display.
6130 If `cache-long-scans' is non-nil, these motion functions cache the
6131 results of their scans, and consult the cache to avoid rescanning
6132 regions of the buffer until the text is modified. The caches are most
6133 beneficial when they prevent the most searching---that is, when the
6134 buffer contains long lines and large regions of characters with the
6135 same, fixed screen width.
6137 When `cache-long-scans' is non-nil, processing short lines will
6138 become slightly slower (because of the overhead of consulting the
6139 cache), and the caches will use memory roughly proportional to the
6140 number of newlines and characters whose screen width varies.
6142 Bidirectional editing also requires buffer scans to find paragraph
6143 separators. If you have large paragraphs or no paragraph separators
6144 at all, these scans may be slow. If `cache-long-scans' is non-nil,
6145 results of these scans are cached. This doesn't help too much if
6146 paragraphs are of the reasonable (few thousands of characters) size.
6148 The caches require no explicit maintenance; their accuracy is
6149 maintained internally by the Emacs primitives. Enabling or disabling
6150 the cache should not affect the behavior of any of the motion
6151 functions; it should only affect their performance. */);
6153 DEFVAR_PER_BUFFER ("point-before-scroll", &BVAR (current_buffer, point_before_scroll), Qnil,
6154 doc: /* Value of point before the last series of scroll operations, or nil. */);
6156 DEFVAR_PER_BUFFER ("buffer-file-format", &BVAR (current_buffer, file_format), Qnil,
6157 doc: /* List of formats to use when saving this buffer.
6158 Formats are defined by `format-alist'. This variable is
6159 set when a file is visited. */);
6161 DEFVAR_PER_BUFFER ("buffer-auto-save-file-format",
6162 &BVAR (current_buffer, auto_save_file_format), Qnil,
6163 doc: /* Format in which to write auto-save files.
6164 Should be a list of symbols naming formats that are defined in `format-alist'.
6165 If it is t, which is the default, auto-save files are written in the
6166 same format as a regular save would use. */);
6168 DEFVAR_PER_BUFFER ("buffer-invisibility-spec",
6169 &BVAR (current_buffer, invisibility_spec), Qnil,
6170 doc: /* Invisibility spec of this buffer.
6171 The default is t, which means that text is invisible if it has a non-nil
6172 `invisible' property.
6173 This variable can also be a list. The list can have two kinds of elements:
6174 `ATOM' and `(ATOM . ELLIPSIS)'. A text character is invisible if its
6175 `invisible' property is `ATOM', or has an `invisible' property that is a list
6176 that contains `ATOM'.
6177 If the `(ATOM . ELLIPSIS)' form is used, and `ELLIPSIS' is non-nil, an
6178 ellipsis will be displayed after the invisible characters.
6179 Setting this variable is very fast, much faster than scanning all the text in
6180 the buffer looking for properties to change. */);
6182 DEFVAR_PER_BUFFER ("buffer-display-count",
6183 &BVAR (current_buffer, display_count), Qintegerp,
6184 doc: /* A number incremented each time this buffer is displayed in a window.
6185 The function `set-window-buffer' increments it. */);
6187 DEFVAR_PER_BUFFER ("buffer-display-time",
6188 &BVAR (current_buffer, display_time), Qnil,
6189 doc: /* Time stamp updated each time this buffer is displayed in a window.
6190 The function `set-window-buffer' updates this variable
6191 to the value obtained by calling `current-time'.
6192 If the buffer has never been shown in a window, the value is nil. */);
6194 DEFVAR_LISP ("transient-mark-mode", Vtransient_mark_mode,
6195 doc: /* Non-nil if Transient Mark mode is enabled.
6196 See the command `transient-mark-mode' for a description of this minor mode.
6198 Non-nil also enables highlighting of the region whenever the mark is active.
6199 The region is highlighted with the `region' face.
6200 The variable `highlight-nonselected-windows' controls whether to highlight
6201 all windows or just the selected window.
6203 Lisp programs may give this variable certain special values:
6205 - The symbol `lambda' enables Transient Mark mode temporarily.
6206 The mode is disabled again after any subsequent action that would
6207 normally deactivate the mark (e.g. buffer modification).
6209 - The pair (only . OLDVAL) enables Transient Mark mode
6210 temporarily. After any subsequent point motion command that is
6211 not shift-translated, or any other action that would normally
6212 deactivate the mark (e.g. buffer modification), the value of
6213 `transient-mark-mode' is set to OLDVAL. */);
6214 Vtransient_mark_mode = Qnil;
6216 DEFVAR_LISP ("inhibit-read-only", Vinhibit_read_only,
6217 doc: /* Non-nil means disregard read-only status of buffers or characters.
6218 If the value is t, disregard `buffer-read-only' and all `read-only'
6219 text properties. If the value is a list, disregard `buffer-read-only'
6220 and disregard a `read-only' text property if the property value
6221 is a member of the list. */);
6222 Vinhibit_read_only = Qnil;
6224 DEFVAR_PER_BUFFER ("cursor-type", &BVAR (current_buffer, cursor_type), Qnil,
6225 doc: /* Cursor to use when this buffer is in the selected window.
6226 Values are interpreted as follows:
6228 t use the cursor specified for the frame
6229 nil don't display a cursor
6230 box display a filled box cursor
6231 hollow display a hollow box cursor
6232 bar display a vertical bar cursor with default width
6233 (bar . WIDTH) display a vertical bar cursor with width WIDTH
6234 hbar display a horizontal bar cursor with default height
6235 (hbar . HEIGHT) display a horizontal bar cursor with height HEIGHT
6236 ANYTHING ELSE display a hollow box cursor
6238 WIDTH and HEIGHT can't exceed the frame's canonical character size.
6240 When the buffer is displayed in a non-selected window, the
6241 cursor's appearance is instead controlled by the variable
6242 `cursor-in-non-selected-windows'. */);
6244 DEFVAR_PER_BUFFER ("line-spacing",
6245 &BVAR (current_buffer, extra_line_spacing), Qnumberp,
6246 doc: /* Additional space to put between lines when displaying a buffer.
6247 The space is measured in pixels, and put below lines on graphic displays,
6248 see `display-graphic-p'.
6249 If value is a floating point number, it specifies the spacing relative
6250 to the default frame line height. A value of nil means add no extra space. */);
6252 DEFVAR_PER_BUFFER ("cursor-in-non-selected-windows",
6253 &BVAR (current_buffer, cursor_in_non_selected_windows), Qnil,
6254 doc: /* Non-nil means show a cursor in non-selected windows.
6255 If nil, only shows a cursor in the selected window.
6256 If t, displays a cursor related to the usual cursor type
6257 \(a solid box becomes hollow, a bar becomes a narrower bar).
6258 You can also specify the cursor type as in the `cursor-type' variable.
6259 Use Custom to set this variable and update the display. */);
6261 DEFVAR_LISP ("kill-buffer-query-functions", Vkill_buffer_query_functions,
6262 doc: /* List of functions called with no args to query before killing a buffer.
6263 The buffer being killed will be current while the functions are running.
6265 If any of them returns nil, the buffer is not killed. Functions run by
6266 this hook are supposed to not change the current buffer. */);
6267 Vkill_buffer_query_functions = Qnil;
6269 DEFVAR_LISP ("change-major-mode-hook", Vchange_major_mode_hook,
6270 doc: /* Normal hook run before changing the major mode of a buffer.
6271 The function `kill-all-local-variables' runs this before doing anything else. */);
6272 Vchange_major_mode_hook = Qnil;
6273 DEFSYM (Qchange_major_mode_hook, "change-major-mode-hook");
6275 DEFVAR_LISP ("buffer-list-update-hook", Vbuffer_list_update_hook,
6276 doc: /* Hook run when the buffer list changes.
6277 Functions running this hook are, `get-buffer-create',
6278 `make-indirect-buffer', `rename-buffer', `kill-buffer',
6279 `bury-buffer-internal' and `select-window'. */);
6280 Vbuffer_list_update_hook = Qnil;
6281 DEFSYM (Qbuffer_list_update_hook, "buffer-list-update-hook");
6283 defsubr (&Sbuffer_live_p);
6284 defsubr (&Sbuffer_list);
6285 defsubr (&Sget_buffer);
6286 defsubr (&Sget_file_buffer);
6287 defsubr (&Sget_buffer_create);
6288 defsubr (&Smake_indirect_buffer);
6289 defsubr (&Sgenerate_new_buffer_name);
6290 defsubr (&Sbuffer_name);
6291 defsubr (&Sbuffer_file_name);
6292 defsubr (&Sbuffer_base_buffer);
6293 defsubr (&Sbuffer_local_value);
6294 defsubr (&Sbuffer_local_variables);
6295 defsubr (&Sbuffer_modified_p);
6296 defsubr (&Sforce_mode_line_update);
6297 defsubr (&Sset_buffer_modified_p);
6298 defsubr (&Sbuffer_modified_tick);
6299 defsubr (&Sbuffer_chars_modified_tick);
6300 defsubr (&Srename_buffer);
6301 defsubr (&Sother_buffer);
6302 defsubr (&Sbuffer_enable_undo);
6303 defsubr (&Skill_buffer);
6304 defsubr (&Sbury_buffer_internal);
6305 defsubr (&Sset_buffer_major_mode);
6306 defsubr (&Scurrent_buffer);
6307 defsubr (&Sset_buffer);
6308 defsubr (&Sbarf_if_buffer_read_only);
6309 defsubr (&Serase_buffer);
6310 defsubr (&Sbuffer_swap_text);
6311 defsubr (&Sset_buffer_multibyte);
6312 defsubr (&Skill_all_local_variables);
6314 defsubr (&Soverlayp);
6315 defsubr (&Smake_overlay);
6316 defsubr (&Sdelete_overlay);
6317 defsubr (&Sdelete_all_overlays);
6318 defsubr (&Smove_overlay);
6319 defsubr (&Soverlay_start);
6320 defsubr (&Soverlay_end);
6321 defsubr (&Soverlay_buffer);
6322 defsubr (&Soverlay_properties);
6323 defsubr (&Soverlays_at);
6324 defsubr (&Soverlays_in);
6325 defsubr (&Snext_overlay_change);
6326 defsubr (&Sprevious_overlay_change);
6327 defsubr (&Soverlay_recenter);
6328 defsubr (&Soverlay_lists);
6329 defsubr (&Soverlay_get);
6330 defsubr (&Soverlay_put);
6331 defsubr (&Srestore_buffer_modified_p);
6333 Fput (intern_c_string ("erase-buffer"), Qdisabled, Qt);
6336 void
6337 keys_of_buffer (void)
6339 initial_define_key (control_x_map, 'b', "switch-to-buffer");
6340 initial_define_key (control_x_map, 'k', "kill-buffer");