use vectors for symbol slots
[bpt/emacs.git] / src / buffer.c
1 /* Buffer manipulation primitives for GNU Emacs.
2
3 Copyright (C) 1985-1989, 1993-1995, 1997-2014 Free Software Foundation, Inc.
4
5 This file is part of GNU Emacs.
6
7 GNU Emacs is free software: you can redistribute it and/or modify
8 it under the terms of the GNU General Public License as published by
9 the Free Software Foundation, either version 3 of the License, or
10 (at your option) any later version.
11
12 GNU Emacs is distributed in the hope that it will be useful,
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 GNU General Public License for more details.
16
17 You should have received a copy of the GNU General Public License
18 along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
19
20 #include <config.h>
21
22 #include <sys/types.h>
23 #include <sys/stat.h>
24 #include <sys/param.h>
25 #include <errno.h>
26 #include <stdio.h>
27 #include <unistd.h>
28
29 #include <verify.h>
30
31 #include "lisp.h"
32 #include "intervals.h"
33 #include "window.h"
34 #include "commands.h"
35 #include "character.h"
36 #include "buffer.h"
37 #include "region-cache.h"
38 #include "indent.h"
39 #include "blockinput.h"
40 #include "keyboard.h"
41 #include "keymap.h"
42 #include "frame.h"
43
44 #ifdef WINDOWSNT
45 #include "w32heap.h" /* for mmap_* */
46 #endif
47
48 struct buffer *current_buffer; /* The current buffer. */
49
50 /* First buffer in chain of all buffers (in reverse order of creation).
51 Threaded through ->header.next.buffer. */
52
53 struct buffer *all_buffers;
54
55 /* This structure holds the default values of the buffer-local variables
56 defined with DEFVAR_PER_BUFFER, that have special slots in each buffer.
57 The default value occupies the same slot in this structure
58 as an individual buffer's value occupies in that buffer.
59 Setting the default value also goes through the alist of buffers
60 and stores into each buffer that does not say it has a local value. */
61
62 struct buffer alignas (GCALIGNMENT) buffer_defaults;
63
64 /* This structure marks which slots in a buffer have corresponding
65 default values in buffer_defaults.
66 Each such slot has a nonzero value in this structure.
67 The value has only one nonzero bit.
68
69 When a buffer has its own local value for a slot,
70 the entry for that slot (found in the same slot in this structure)
71 is turned on in the buffer's local_flags array.
72
73 If a slot in this structure is -1, then even though there may
74 be a DEFVAR_PER_BUFFER for the slot, there is no default value for it;
75 and the corresponding slot in buffer_defaults is not used.
76
77 If a slot in this structure corresponding to a DEFVAR_PER_BUFFER is
78 zero, that is a bug. */
79
80 struct buffer buffer_local_flags;
81
82 /* This structure holds the names of symbols whose values may be
83 buffer-local. It is indexed and accessed in the same way as the above. */
84
85 struct buffer alignas (GCALIGNMENT) buffer_local_symbols;
86
87 /* Return the symbol of the per-buffer variable at offset OFFSET in
88 the buffer structure. */
89
90 #define PER_BUFFER_SYMBOL(OFFSET) \
91 (*(Lisp_Object *)((OFFSET) + (char *) &buffer_local_symbols))
92
93 /* Maximum length of an overlay vector. */
94 #define OVERLAY_COUNT_MAX \
95 ((ptrdiff_t) min (MOST_POSITIVE_FIXNUM, \
96 min (PTRDIFF_MAX, SIZE_MAX) / word_size))
97
98 /* Flags indicating which built-in buffer-local variables
99 are permanent locals. */
100 static char buffer_permanent_local_flags[MAX_PER_BUFFER_VARS];
101
102 /* Number of per-buffer variables used. */
103
104 int last_per_buffer_idx;
105
106 static void call_overlay_mod_hooks (Lisp_Object list, Lisp_Object overlay,
107 bool after, Lisp_Object arg1,
108 Lisp_Object arg2, Lisp_Object arg3);
109 static void swap_out_buffer_local_variables (struct buffer *b);
110 static void reset_buffer_local_variables (struct buffer *, bool);
111
112 /* Alist of all buffer names vs the buffers. This used to be
113 a Lisp-visible variable, but is no longer, to prevent lossage
114 due to user rplac'ing this alist or its elements. */
115 Lisp_Object Vbuffer_alist;
116
117 static Lisp_Object Qkill_buffer_query_functions;
118
119 /* Hook run before changing a major mode. */
120 static Lisp_Object Qchange_major_mode_hook;
121
122 Lisp_Object Qfirst_change_hook;
123 Lisp_Object Qbefore_change_functions;
124 Lisp_Object Qafter_change_functions;
125
126 static Lisp_Object Qfundamental_mode, Qmode_class, Qpermanent_local;
127 static Lisp_Object Qpermanent_local_hook;
128
129 static Lisp_Object Qprotected_field;
130
131 static Lisp_Object QSFundamental; /* A string "Fundamental". */
132
133 static Lisp_Object Qkill_buffer_hook;
134 static Lisp_Object Qbuffer_list_update_hook;
135
136 static Lisp_Object Qget_file_buffer;
137
138 static Lisp_Object Qoverlayp;
139
140 Lisp_Object Qpriority, Qbefore_string, Qafter_string;
141
142 static Lisp_Object Qevaporate;
143
144 Lisp_Object Qmodification_hooks;
145 Lisp_Object Qinsert_in_front_hooks;
146 Lisp_Object Qinsert_behind_hooks;
147
148 static void alloc_buffer_text (struct buffer *, ptrdiff_t);
149 static void free_buffer_text (struct buffer *b);
150 static struct Lisp_Overlay * copy_overlays (struct buffer *, struct Lisp_Overlay *);
151 static void modify_overlay (struct buffer *, ptrdiff_t, ptrdiff_t);
152 static Lisp_Object buffer_lisp_local_variables (struct buffer *, bool);
153
154 static void
155 CHECK_OVERLAY (Lisp_Object x)
156 {
157 CHECK_TYPE (OVERLAYP (x), Qoverlayp, x);
158 }
159
160 /* These setters are used only in this file, so they can be private.
161 The public setters are inline functions defined in buffer.h. */
162 static void
163 bset_abbrev_mode (struct buffer *b, Lisp_Object val)
164 {
165 b->INTERNAL_FIELD (abbrev_mode) = val;
166 }
167 static void
168 bset_abbrev_table (struct buffer *b, Lisp_Object val)
169 {
170 b->INTERNAL_FIELD (abbrev_table) = val;
171 }
172 static void
173 bset_auto_fill_function (struct buffer *b, Lisp_Object val)
174 {
175 b->INTERNAL_FIELD (auto_fill_function) = val;
176 }
177 static void
178 bset_auto_save_file_format (struct buffer *b, Lisp_Object val)
179 {
180 b->INTERNAL_FIELD (auto_save_file_format) = val;
181 }
182 static void
183 bset_auto_save_file_name (struct buffer *b, Lisp_Object val)
184 {
185 b->INTERNAL_FIELD (auto_save_file_name) = val;
186 }
187 static void
188 bset_backed_up (struct buffer *b, Lisp_Object val)
189 {
190 b->INTERNAL_FIELD (backed_up) = val;
191 }
192 static void
193 bset_begv_marker (struct buffer *b, Lisp_Object val)
194 {
195 b->INTERNAL_FIELD (begv_marker) = val;
196 }
197 static void
198 bset_bidi_display_reordering (struct buffer *b, Lisp_Object val)
199 {
200 b->INTERNAL_FIELD (bidi_display_reordering) = val;
201 }
202 static void
203 bset_buffer_file_coding_system (struct buffer *b, Lisp_Object val)
204 {
205 b->INTERNAL_FIELD (buffer_file_coding_system) = val;
206 }
207 static void
208 bset_case_fold_search (struct buffer *b, Lisp_Object val)
209 {
210 b->INTERNAL_FIELD (case_fold_search) = val;
211 }
212 static void
213 bset_ctl_arrow (struct buffer *b, Lisp_Object val)
214 {
215 b->INTERNAL_FIELD (ctl_arrow) = val;
216 }
217 static void
218 bset_cursor_in_non_selected_windows (struct buffer *b, Lisp_Object val)
219 {
220 b->INTERNAL_FIELD (cursor_in_non_selected_windows) = val;
221 }
222 static void
223 bset_cursor_type (struct buffer *b, Lisp_Object val)
224 {
225 b->INTERNAL_FIELD (cursor_type) = val;
226 }
227 static void
228 bset_display_table (struct buffer *b, Lisp_Object val)
229 {
230 b->INTERNAL_FIELD (display_table) = val;
231 }
232 static void
233 bset_extra_line_spacing (struct buffer *b, Lisp_Object val)
234 {
235 b->INTERNAL_FIELD (extra_line_spacing) = val;
236 }
237 static void
238 bset_file_format (struct buffer *b, Lisp_Object val)
239 {
240 b->INTERNAL_FIELD (file_format) = val;
241 }
242 static void
243 bset_file_truename (struct buffer *b, Lisp_Object val)
244 {
245 b->INTERNAL_FIELD (file_truename) = val;
246 }
247 static void
248 bset_fringe_cursor_alist (struct buffer *b, Lisp_Object val)
249 {
250 b->INTERNAL_FIELD (fringe_cursor_alist) = val;
251 }
252 static void
253 bset_fringe_indicator_alist (struct buffer *b, Lisp_Object val)
254 {
255 b->INTERNAL_FIELD (fringe_indicator_alist) = val;
256 }
257 static void
258 bset_fringes_outside_margins (struct buffer *b, Lisp_Object val)
259 {
260 b->INTERNAL_FIELD (fringes_outside_margins) = val;
261 }
262 static void
263 bset_header_line_format (struct buffer *b, Lisp_Object val)
264 {
265 b->INTERNAL_FIELD (header_line_format) = val;
266 }
267 static void
268 bset_indicate_buffer_boundaries (struct buffer *b, Lisp_Object val)
269 {
270 b->INTERNAL_FIELD (indicate_buffer_boundaries) = val;
271 }
272 static void
273 bset_indicate_empty_lines (struct buffer *b, Lisp_Object val)
274 {
275 b->INTERNAL_FIELD (indicate_empty_lines) = val;
276 }
277 static void
278 bset_invisibility_spec (struct buffer *b, Lisp_Object val)
279 {
280 b->INTERNAL_FIELD (invisibility_spec) = val;
281 }
282 static void
283 bset_left_fringe_width (struct buffer *b, Lisp_Object val)
284 {
285 b->INTERNAL_FIELD (left_fringe_width) = val;
286 }
287 static void
288 bset_major_mode (struct buffer *b, Lisp_Object val)
289 {
290 b->INTERNAL_FIELD (major_mode) = val;
291 }
292 static void
293 bset_mark (struct buffer *b, Lisp_Object val)
294 {
295 b->INTERNAL_FIELD (mark) = val;
296 }
297 static void
298 bset_minor_modes (struct buffer *b, Lisp_Object val)
299 {
300 b->INTERNAL_FIELD (minor_modes) = val;
301 }
302 static void
303 bset_mode_line_format (struct buffer *b, Lisp_Object val)
304 {
305 b->INTERNAL_FIELD (mode_line_format) = val;
306 }
307 static void
308 bset_mode_name (struct buffer *b, Lisp_Object val)
309 {
310 b->INTERNAL_FIELD (mode_name) = val;
311 }
312 static void
313 bset_name (struct buffer *b, Lisp_Object val)
314 {
315 b->INTERNAL_FIELD (name) = val;
316 }
317 static void
318 bset_overwrite_mode (struct buffer *b, Lisp_Object val)
319 {
320 b->INTERNAL_FIELD (overwrite_mode) = val;
321 }
322 static void
323 bset_pt_marker (struct buffer *b, Lisp_Object val)
324 {
325 b->INTERNAL_FIELD (pt_marker) = val;
326 }
327 static void
328 bset_right_fringe_width (struct buffer *b, Lisp_Object val)
329 {
330 b->INTERNAL_FIELD (right_fringe_width) = val;
331 }
332 static void
333 bset_save_length (struct buffer *b, Lisp_Object val)
334 {
335 b->INTERNAL_FIELD (save_length) = val;
336 }
337 static void
338 bset_scroll_bar_width (struct buffer *b, Lisp_Object val)
339 {
340 b->INTERNAL_FIELD (scroll_bar_width) = val;
341 }
342 static void
343 bset_scroll_down_aggressively (struct buffer *b, Lisp_Object val)
344 {
345 b->INTERNAL_FIELD (scroll_down_aggressively) = val;
346 }
347 static void
348 bset_scroll_up_aggressively (struct buffer *b, Lisp_Object val)
349 {
350 b->INTERNAL_FIELD (scroll_up_aggressively) = val;
351 }
352 static void
353 bset_selective_display (struct buffer *b, Lisp_Object val)
354 {
355 b->INTERNAL_FIELD (selective_display) = val;
356 }
357 static void
358 bset_selective_display_ellipses (struct buffer *b, Lisp_Object val)
359 {
360 b->INTERNAL_FIELD (selective_display_ellipses) = val;
361 }
362 static void
363 bset_vertical_scroll_bar_type (struct buffer *b, Lisp_Object val)
364 {
365 b->INTERNAL_FIELD (vertical_scroll_bar_type) = val;
366 }
367 static void
368 bset_word_wrap (struct buffer *b, Lisp_Object val)
369 {
370 b->INTERNAL_FIELD (word_wrap) = val;
371 }
372 static void
373 bset_zv_marker (struct buffer *b, Lisp_Object val)
374 {
375 b->INTERNAL_FIELD (zv_marker) = val;
376 }
377
378 void
379 nsberror (Lisp_Object spec)
380 {
381 if (STRINGP (spec))
382 error ("No buffer named %s", SDATA (spec));
383 error ("Invalid buffer argument");
384 }
385 \f
386 DEFUN ("buffer-live-p", Fbuffer_live_p, Sbuffer_live_p, 1, 1, 0,
387 doc: /* Return non-nil if OBJECT is a buffer which has not been killed.
388 Value is nil if OBJECT is not a buffer or if it has been killed. */)
389 (Lisp_Object object)
390 {
391 return ((BUFFERP (object) && BUFFER_LIVE_P (XBUFFER (object)))
392 ? Qt : Qnil);
393 }
394
395 DEFUN ("buffer-list", Fbuffer_list, Sbuffer_list, 0, 1, 0,
396 doc: /* Return a list of all existing live buffers.
397 If the optional arg FRAME is a frame, we return the buffer list in the
398 proper order for that frame: the buffers show in FRAME come first,
399 followed by the rest of the buffers. */)
400 (Lisp_Object frame)
401 {
402 Lisp_Object general;
403 general = Fmapcar (Qcdr, Vbuffer_alist);
404
405 if (FRAMEP (frame))
406 {
407 Lisp_Object framelist, prevlist, tail;
408 Lisp_Object args[3];
409
410 framelist = Fcopy_sequence (XFRAME (frame)->buffer_list);
411 prevlist = Fnreverse (Fcopy_sequence
412 (XFRAME (frame)->buried_buffer_list));
413
414 /* Remove from GENERAL any buffer that duplicates one in
415 FRAMELIST or PREVLIST. */
416 tail = framelist;
417 while (CONSP (tail))
418 {
419 general = Fdelq (XCAR (tail), general);
420 tail = XCDR (tail);
421 }
422 tail = prevlist;
423 while (CONSP (tail))
424 {
425 general = Fdelq (XCAR (tail), general);
426 tail = XCDR (tail);
427 }
428
429 args[0] = framelist;
430 args[1] = general;
431 args[2] = prevlist;
432 return Fnconc (3, args);
433 }
434 else
435 return general;
436 }
437
438 /* Like Fassoc, but use Fstring_equal to compare
439 (which ignores text properties),
440 and don't ever QUIT. */
441
442 static Lisp_Object
443 assoc_ignore_text_properties (register Lisp_Object key, Lisp_Object list)
444 {
445 register Lisp_Object tail;
446 for (tail = list; CONSP (tail); tail = XCDR (tail))
447 {
448 register Lisp_Object elt, tem;
449 elt = XCAR (tail);
450 tem = Fstring_equal (Fcar (elt), key);
451 if (!NILP (tem))
452 return elt;
453 }
454 return Qnil;
455 }
456
457 DEFUN ("get-buffer", Fget_buffer, Sget_buffer, 1, 1, 0,
458 doc: /* Return the buffer named BUFFER-OR-NAME.
459 BUFFER-OR-NAME must be either a string or a buffer. If BUFFER-OR-NAME
460 is a string and there is no buffer with that name, return nil. If
461 BUFFER-OR-NAME is a buffer, return it as given. */)
462 (register Lisp_Object buffer_or_name)
463 {
464 if (BUFFERP (buffer_or_name))
465 return buffer_or_name;
466 CHECK_STRING (buffer_or_name);
467
468 return Fcdr (assoc_ignore_text_properties (buffer_or_name, Vbuffer_alist));
469 }
470
471 DEFUN ("get-file-buffer", Fget_file_buffer, Sget_file_buffer, 1, 1, 0,
472 doc: /* Return the buffer visiting file FILENAME (a string).
473 The buffer's `buffer-file-name' must match exactly the expansion of FILENAME.
474 If there is no such live buffer, return nil.
475 See also `find-buffer-visiting'. */)
476 (register Lisp_Object filename)
477 {
478 register Lisp_Object tail, buf, handler;
479
480 CHECK_STRING (filename);
481 filename = Fexpand_file_name (filename, Qnil);
482
483 /* If the file name has special constructs in it,
484 call the corresponding file handler. */
485 handler = Ffind_file_name_handler (filename, Qget_file_buffer);
486 if (!NILP (handler))
487 {
488 Lisp_Object handled_buf = call2 (handler, Qget_file_buffer,
489 filename);
490 return BUFFERP (handled_buf) ? handled_buf : Qnil;
491 }
492
493 FOR_EACH_LIVE_BUFFER (tail, buf)
494 {
495 if (!STRINGP (BVAR (XBUFFER (buf), filename))) continue;
496 if (!NILP (Fstring_equal (BVAR (XBUFFER (buf), filename), filename)))
497 return buf;
498 }
499 return Qnil;
500 }
501
502 Lisp_Object
503 get_truename_buffer (register Lisp_Object filename)
504 {
505 register Lisp_Object tail, buf;
506
507 FOR_EACH_LIVE_BUFFER (tail, buf)
508 {
509 if (!STRINGP (BVAR (XBUFFER (buf), file_truename))) continue;
510 if (!NILP (Fstring_equal (BVAR (XBUFFER (buf), file_truename), filename)))
511 return buf;
512 }
513 return Qnil;
514 }
515
516 DEFUN ("get-buffer-create", Fget_buffer_create, Sget_buffer_create, 1, 1, 0,
517 doc: /* Return the buffer specified by BUFFER-OR-NAME, creating a new one if needed.
518 If BUFFER-OR-NAME is a string and a live buffer with that name exists,
519 return that buffer. If no such buffer exists, create a new buffer with
520 that name and return it. If BUFFER-OR-NAME starts with a space, the new
521 buffer does not keep undo information.
522
523 If BUFFER-OR-NAME is a buffer instead of a string, return it as given,
524 even if it is dead. The return value is never nil. */)
525 (register Lisp_Object buffer_or_name)
526 {
527 register Lisp_Object buffer, name;
528 register struct buffer *b;
529
530 buffer = Fget_buffer (buffer_or_name);
531 if (!NILP (buffer))
532 return buffer;
533
534 if (SCHARS (buffer_or_name) == 0)
535 error ("Empty string for buffer name is not allowed");
536
537 b = allocate_buffer ();
538
539 /* An ordinary buffer uses its own struct buffer_text. */
540 b->text = &b->own_text;
541 b->base_buffer = NULL;
542 /* No one shares the text with us now. */
543 b->indirections = 0;
544 /* No one shows us now. */
545 b->window_count = 0;
546
547 BUF_GAP_SIZE (b) = 20;
548 block_input ();
549 /* We allocate extra 1-byte at the tail and keep it always '\0' for
550 anchoring a search. */
551 alloc_buffer_text (b, BUF_GAP_SIZE (b) + 1);
552 unblock_input ();
553 if (! BUF_BEG_ADDR (b))
554 buffer_memory_full (BUF_GAP_SIZE (b) + 1);
555
556 b->pt = BEG;
557 b->begv = BEG;
558 b->zv = BEG;
559 b->pt_byte = BEG_BYTE;
560 b->begv_byte = BEG_BYTE;
561 b->zv_byte = BEG_BYTE;
562
563 BUF_GPT (b) = BEG;
564 BUF_GPT_BYTE (b) = BEG_BYTE;
565
566 BUF_Z (b) = BEG;
567 BUF_Z_BYTE (b) = BEG_BYTE;
568 BUF_MODIFF (b) = 1;
569 BUF_CHARS_MODIFF (b) = 1;
570 BUF_OVERLAY_MODIFF (b) = 1;
571 BUF_SAVE_MODIFF (b) = 1;
572 BUF_COMPACT (b) = 1;
573 set_buffer_intervals (b, NULL);
574 BUF_UNCHANGED_MODIFIED (b) = 1;
575 BUF_OVERLAY_UNCHANGED_MODIFIED (b) = 1;
576 BUF_END_UNCHANGED (b) = 0;
577 BUF_BEG_UNCHANGED (b) = 0;
578 *(BUF_GPT_ADDR (b)) = *(BUF_Z_ADDR (b)) = 0; /* Put an anchor '\0'. */
579 b->text->inhibit_shrinking = false;
580 b->text->redisplay = false;
581
582 b->newline_cache = 0;
583 b->width_run_cache = 0;
584 b->bidi_paragraph_cache = 0;
585 bset_width_table (b, Qnil);
586 b->prevent_redisplay_optimizations_p = 1;
587
588 /* An ordinary buffer normally doesn't need markers
589 to handle BEGV and ZV. */
590 bset_pt_marker (b, Qnil);
591 bset_begv_marker (b, Qnil);
592 bset_zv_marker (b, Qnil);
593
594 name = Fcopy_sequence (buffer_or_name);
595 set_string_intervals (name, NULL);
596 bset_name (b, name);
597
598 bset_undo_list (b, SREF (name, 0) != ' ' ? Qnil : Qt);
599
600 reset_buffer (b);
601 reset_buffer_local_variables (b, 1);
602
603 bset_mark (b, Fmake_marker ());
604 BUF_MARKERS (b) = NULL;
605
606 /* Put this in the alist of all live buffers. */
607 XSETBUFFER (buffer, b);
608 Vbuffer_alist = nconc2 (Vbuffer_alist, list1 (Fcons (name, buffer)));
609 /* And run buffer-list-update-hook. */
610 if (!NILP (Vrun_hooks))
611 call1 (Vrun_hooks, Qbuffer_list_update_hook);
612
613 return buffer;
614 }
615
616
617 /* Return a list of overlays which is a copy of the overlay list
618 LIST, but for buffer B. */
619
620 static struct Lisp_Overlay *
621 copy_overlays (struct buffer *b, struct Lisp_Overlay *list)
622 {
623 struct Lisp_Overlay *result = NULL, *tail = NULL;
624
625 for (; list; list = list->next)
626 {
627 Lisp_Object overlay, start, end;
628 struct Lisp_Marker *m;
629
630 eassert (MARKERP (list->start));
631 m = XMARKER (list->start);
632 start = build_marker (b, m->charpos, m->bytepos);
633 XMARKER (start)->insertion_type = m->insertion_type;
634
635 eassert (MARKERP (list->end));
636 m = XMARKER (list->end);
637 end = build_marker (b, m->charpos, m->bytepos);
638 XMARKER (end)->insertion_type = m->insertion_type;
639
640 overlay = build_overlay (start, end, Fcopy_sequence (list->plist));
641 if (tail)
642 tail = tail->next = XOVERLAY (overlay);
643 else
644 result = tail = XOVERLAY (overlay);
645 }
646
647 return result;
648 }
649
650 /* Set an appropriate overlay of B. */
651
652 static void
653 set_buffer_overlays_before (struct buffer *b, struct Lisp_Overlay *o)
654 {
655 b->overlays_before = o;
656 }
657
658 static void
659 set_buffer_overlays_after (struct buffer *b, struct Lisp_Overlay *o)
660 {
661 b->overlays_after = o;
662 }
663
664 /* Clone per-buffer values of buffer FROM.
665
666 Buffer TO gets the same per-buffer values as FROM, with the
667 following exceptions: (1) TO's name is left untouched, (2) markers
668 are copied and made to refer to TO, and (3) overlay lists are
669 copied. */
670
671 static void
672 clone_per_buffer_values (struct buffer *from, struct buffer *to)
673 {
674 int offset;
675
676 FOR_EACH_PER_BUFFER_OBJECT_AT (offset)
677 {
678 Lisp_Object obj;
679
680 /* Don't touch the `name' which should be unique for every buffer. */
681 if (offset == PER_BUFFER_VAR_OFFSET (name))
682 continue;
683
684 obj = per_buffer_value (from, offset);
685 if (MARKERP (obj) && XMARKER (obj)->buffer == from)
686 {
687 struct Lisp_Marker *m = XMARKER (obj);
688
689 obj = build_marker (to, m->charpos, m->bytepos);
690 XMARKER (obj)->insertion_type = m->insertion_type;
691 }
692
693 set_per_buffer_value (to, offset, obj);
694 }
695
696 memcpy (to->local_flags, from->local_flags, sizeof to->local_flags);
697
698 set_buffer_overlays_before (to, copy_overlays (to, from->overlays_before));
699 set_buffer_overlays_after (to, copy_overlays (to, from->overlays_after));
700
701 /* Get (a copy of) the alist of Lisp-level local variables of FROM
702 and install that in TO. */
703 bset_local_var_alist (to, buffer_lisp_local_variables (from, 1));
704 }
705
706
707 /* If buffer B has markers to record PT, BEGV and ZV when it is not
708 current, update these markers. */
709
710 static void
711 record_buffer_markers (struct buffer *b)
712 {
713 if (! NILP (BVAR (b, pt_marker)))
714 {
715 Lisp_Object buffer;
716
717 eassert (!NILP (BVAR (b, begv_marker)));
718 eassert (!NILP (BVAR (b, zv_marker)));
719
720 XSETBUFFER (buffer, b);
721 set_marker_both (BVAR (b, pt_marker), buffer, b->pt, b->pt_byte);
722 set_marker_both (BVAR (b, begv_marker), buffer, b->begv, b->begv_byte);
723 set_marker_both (BVAR (b, zv_marker), buffer, b->zv, b->zv_byte);
724 }
725 }
726
727
728 /* If buffer B has markers to record PT, BEGV and ZV when it is not
729 current, fetch these values into B->begv etc. */
730
731 static void
732 fetch_buffer_markers (struct buffer *b)
733 {
734 if (! NILP (BVAR (b, pt_marker)))
735 {
736 Lisp_Object m;
737
738 eassert (!NILP (BVAR (b, begv_marker)));
739 eassert (!NILP (BVAR (b, zv_marker)));
740
741 m = BVAR (b, pt_marker);
742 SET_BUF_PT_BOTH (b, marker_position (m), marker_byte_position (m));
743
744 m = BVAR (b, begv_marker);
745 SET_BUF_BEGV_BOTH (b, marker_position (m), marker_byte_position (m));
746
747 m = BVAR (b, zv_marker);
748 SET_BUF_ZV_BOTH (b, marker_position (m), marker_byte_position (m));
749 }
750 }
751
752
753 DEFUN ("make-indirect-buffer", Fmake_indirect_buffer, Smake_indirect_buffer,
754 2, 3,
755 "bMake indirect buffer (to buffer): \nBName of indirect buffer: ",
756 doc: /* Create and return an indirect buffer for buffer BASE-BUFFER, named NAME.
757 BASE-BUFFER should be a live buffer, or the name of an existing buffer.
758 NAME should be a string which is not the name of an existing buffer.
759 Optional argument CLONE non-nil means preserve BASE-BUFFER's state,
760 such as major and minor modes, in the indirect buffer.
761 CLONE nil means the indirect buffer's state is reset to default values. */)
762 (Lisp_Object base_buffer, Lisp_Object name, Lisp_Object clone)
763 {
764 Lisp_Object buf, tem;
765 struct buffer *b;
766
767 CHECK_STRING (name);
768 buf = Fget_buffer (name);
769 if (!NILP (buf))
770 error ("Buffer name `%s' is in use", SDATA (name));
771
772 tem = base_buffer;
773 base_buffer = Fget_buffer (base_buffer);
774 if (NILP (base_buffer))
775 error ("No such buffer: `%s'", SDATA (tem));
776 if (!BUFFER_LIVE_P (XBUFFER (base_buffer)))
777 error ("Base buffer has been killed");
778
779 if (SCHARS (name) == 0)
780 error ("Empty string for buffer name is not allowed");
781
782 b = allocate_buffer ();
783
784 /* No double indirection - if base buffer is indirect,
785 new buffer becomes an indirect to base's base. */
786 b->base_buffer = (XBUFFER (base_buffer)->base_buffer
787 ? XBUFFER (base_buffer)->base_buffer
788 : XBUFFER (base_buffer));
789
790 /* Use the base buffer's text object. */
791 b->text = b->base_buffer->text;
792 /* We have no own text. */
793 b->indirections = -1;
794 /* Notify base buffer that we share the text now. */
795 b->base_buffer->indirections++;
796 /* Always -1 for an indirect buffer. */
797 b->window_count = -1;
798
799 b->pt = b->base_buffer->pt;
800 b->begv = b->base_buffer->begv;
801 b->zv = b->base_buffer->zv;
802 b->pt_byte = b->base_buffer->pt_byte;
803 b->begv_byte = b->base_buffer->begv_byte;
804 b->zv_byte = b->base_buffer->zv_byte;
805
806 b->newline_cache = 0;
807 b->width_run_cache = 0;
808 b->bidi_paragraph_cache = 0;
809 bset_width_table (b, Qnil);
810
811 name = Fcopy_sequence (name);
812 set_string_intervals (name, NULL);
813 bset_name (b, name);
814
815 reset_buffer (b);
816 reset_buffer_local_variables (b, 1);
817
818 /* Put this in the alist of all live buffers. */
819 XSETBUFFER (buf, b);
820 Vbuffer_alist = nconc2 (Vbuffer_alist, list1 (Fcons (name, buf)));
821
822 bset_mark (b, Fmake_marker ());
823
824 /* The multibyte status belongs to the base buffer. */
825 bset_enable_multibyte_characters
826 (b, BVAR (b->base_buffer, enable_multibyte_characters));
827
828 /* Make sure the base buffer has markers for its narrowing. */
829 if (NILP (BVAR (b->base_buffer, pt_marker)))
830 {
831 eassert (NILP (BVAR (b->base_buffer, begv_marker)));
832 eassert (NILP (BVAR (b->base_buffer, zv_marker)));
833
834 bset_pt_marker (b->base_buffer,
835 build_marker (b->base_buffer, b->base_buffer->pt,
836 b->base_buffer->pt_byte));
837
838 bset_begv_marker (b->base_buffer,
839 build_marker (b->base_buffer, b->base_buffer->begv,
840 b->base_buffer->begv_byte));
841
842 bset_zv_marker (b->base_buffer,
843 build_marker (b->base_buffer, b->base_buffer->zv,
844 b->base_buffer->zv_byte));
845
846 XMARKER (BVAR (b->base_buffer, zv_marker))->insertion_type = 1;
847 }
848
849 if (NILP (clone))
850 {
851 /* Give the indirect buffer markers for its narrowing. */
852 bset_pt_marker (b, build_marker (b, b->pt, b->pt_byte));
853 bset_begv_marker (b, build_marker (b, b->begv, b->begv_byte));
854 bset_zv_marker (b, build_marker (b, b->zv, b->zv_byte));
855 XMARKER (BVAR (b, zv_marker))->insertion_type = 1;
856 }
857 else
858 {
859 struct buffer *old_b = current_buffer;
860
861 clone_per_buffer_values (b->base_buffer, b);
862 bset_filename (b, Qnil);
863 bset_file_truename (b, Qnil);
864 bset_display_count (b, make_number (0));
865 bset_backed_up (b, Qnil);
866 bset_auto_save_file_name (b, Qnil);
867 set_buffer_internal_1 (b);
868 Fset (intern ("buffer-save-without-query"), Qnil);
869 Fset (intern ("buffer-file-number"), Qnil);
870 Fset (intern ("buffer-stale-function"), Qnil);
871 set_buffer_internal_1 (old_b);
872 }
873
874 /* Run buffer-list-update-hook. */
875 if (!NILP (Vrun_hooks))
876 call1 (Vrun_hooks, Qbuffer_list_update_hook);
877
878 return buf;
879 }
880
881 /* Mark OV as no longer associated with B. */
882
883 static void
884 drop_overlay (struct buffer *b, struct Lisp_Overlay *ov)
885 {
886 eassert (b == XBUFFER (Fmarker_buffer (ov->start)));
887 modify_overlay (b, marker_position (ov->start),
888 marker_position (ov->end));
889 unchain_marker (XMARKER (ov->start));
890 unchain_marker (XMARKER (ov->end));
891
892 }
893
894 /* Delete all overlays of B and reset it's overlay lists. */
895
896 void
897 delete_all_overlays (struct buffer *b)
898 {
899 struct Lisp_Overlay *ov, *next;
900
901 /* FIXME: Since each drop_overlay will scan BUF_MARKERS to unlink its
902 markers, we have an unneeded O(N^2) behavior here. */
903 for (ov = b->overlays_before; ov; ov = next)
904 {
905 drop_overlay (b, ov);
906 next = ov->next;
907 ov->next = NULL;
908 }
909
910 for (ov = b->overlays_after; ov; ov = next)
911 {
912 drop_overlay (b, ov);
913 next = ov->next;
914 ov->next = NULL;
915 }
916
917 set_buffer_overlays_before (b, NULL);
918 set_buffer_overlays_after (b, NULL);
919 }
920
921 /* Reinitialize everything about a buffer except its name and contents
922 and local variables.
923 If called on an already-initialized buffer, the list of overlays
924 should be deleted before calling this function, otherwise we end up
925 with overlays that claim to belong to the buffer but the buffer
926 claims it doesn't belong to it. */
927
928 void
929 reset_buffer (register struct buffer *b)
930 {
931 bset_filename (b, Qnil);
932 bset_file_truename (b, Qnil);
933 bset_directory (b, current_buffer ? BVAR (current_buffer, directory) : Qnil);
934 b->modtime = make_timespec (0, UNKNOWN_MODTIME_NSECS);
935 b->modtime_size = -1;
936 XSETFASTINT (BVAR (b, save_length), 0);
937 b->last_window_start = 1;
938 /* It is more conservative to start out "changed" than "unchanged". */
939 b->clip_changed = 0;
940 b->prevent_redisplay_optimizations_p = 1;
941 bset_backed_up (b, Qnil);
942 BUF_AUTOSAVE_MODIFF (b) = 0;
943 b->auto_save_failure_time = 0;
944 bset_auto_save_file_name (b, Qnil);
945 bset_read_only (b, Qnil);
946 set_buffer_overlays_before (b, NULL);
947 set_buffer_overlays_after (b, NULL);
948 b->overlay_center = BEG;
949 bset_mark_active (b, Qnil);
950 bset_point_before_scroll (b, Qnil);
951 bset_file_format (b, Qnil);
952 bset_auto_save_file_format (b, Qt);
953 bset_last_selected_window (b, Qnil);
954 bset_display_count (b, make_number (0));
955 bset_display_time (b, Qnil);
956 bset_enable_multibyte_characters
957 (b, BVAR (&buffer_defaults, enable_multibyte_characters));
958 bset_cursor_type (b, BVAR (&buffer_defaults, cursor_type));
959 bset_extra_line_spacing (b, BVAR (&buffer_defaults, extra_line_spacing));
960
961 b->display_error_modiff = 0;
962 }
963
964 /* Reset buffer B's local variables info.
965 Don't use this on a buffer that has already been in use;
966 it does not treat permanent locals consistently.
967 Instead, use Fkill_all_local_variables.
968
969 If PERMANENT_TOO, reset permanent buffer-local variables.
970 If not, preserve those. */
971
972 static void
973 reset_buffer_local_variables (struct buffer *b, bool permanent_too)
974 {
975 int offset, i;
976
977 /* Reset the major mode to Fundamental, together with all the
978 things that depend on the major mode.
979 default-major-mode is handled at a higher level.
980 We ignore it here. */
981 bset_major_mode (b, Qfundamental_mode);
982 bset_keymap (b, Qnil);
983 bset_mode_name (b, QSFundamental);
984 bset_minor_modes (b, Qnil);
985
986 /* If the standard case table has been altered and invalidated,
987 fix up its insides first. */
988 if (! (CHAR_TABLE_P (XCHAR_TABLE (Vascii_downcase_table)->extras[0])
989 && CHAR_TABLE_P (XCHAR_TABLE (Vascii_downcase_table)->extras[1])
990 && CHAR_TABLE_P (XCHAR_TABLE (Vascii_downcase_table)->extras[2])))
991 Fset_standard_case_table (Vascii_downcase_table);
992
993 bset_downcase_table (b, Vascii_downcase_table);
994 bset_upcase_table (b, XCHAR_TABLE (Vascii_downcase_table)->extras[0]);
995 bset_case_canon_table (b, XCHAR_TABLE (Vascii_downcase_table)->extras[1]);
996 bset_case_eqv_table (b, XCHAR_TABLE (Vascii_downcase_table)->extras[2]);
997 bset_invisibility_spec (b, Qt);
998
999 /* Reset all (or most) per-buffer variables to their defaults. */
1000 if (permanent_too)
1001 bset_local_var_alist (b, Qnil);
1002 else
1003 {
1004 Lisp_Object tmp, prop, last = Qnil;
1005 for (tmp = BVAR (b, local_var_alist); CONSP (tmp); tmp = XCDR (tmp))
1006 if (!NILP (prop = Fget (XCAR (XCAR (tmp)), Qpermanent_local)))
1007 {
1008 /* If permanent-local, keep it. */
1009 last = tmp;
1010 if (EQ (prop, Qpermanent_local_hook))
1011 {
1012 /* This is a partially permanent hook variable.
1013 Preserve only the elements that want to be preserved. */
1014 Lisp_Object list, newlist;
1015 list = XCDR (XCAR (tmp));
1016 if (!CONSP (list))
1017 newlist = list;
1018 else
1019 for (newlist = Qnil; CONSP (list); list = XCDR (list))
1020 {
1021 Lisp_Object elt = XCAR (list);
1022 /* Preserve element ELT if it's t,
1023 if it is a function with a `permanent-local-hook' property,
1024 or if it's not a symbol. */
1025 if (! SYMBOLP (elt)
1026 || EQ (elt, Qt)
1027 || !NILP (Fget (elt, Qpermanent_local_hook)))
1028 newlist = Fcons (elt, newlist);
1029 }
1030 XSETCDR (XCAR (tmp), Fnreverse (newlist));
1031 }
1032 }
1033 /* Delete this local variable. */
1034 else if (NILP (last))
1035 bset_local_var_alist (b, XCDR (tmp));
1036 else
1037 XSETCDR (last, XCDR (tmp));
1038 }
1039
1040 for (i = 0; i < last_per_buffer_idx; ++i)
1041 if (permanent_too || buffer_permanent_local_flags[i] == 0)
1042 SET_PER_BUFFER_VALUE_P (b, i, 0);
1043
1044 /* For each slot that has a default value, copy that into the slot. */
1045 FOR_EACH_PER_BUFFER_OBJECT_AT (offset)
1046 {
1047 int idx = PER_BUFFER_IDX (offset);
1048 if ((idx > 0
1049 && (permanent_too
1050 || buffer_permanent_local_flags[idx] == 0)))
1051 set_per_buffer_value (b, offset, per_buffer_default (offset));
1052 }
1053 }
1054
1055 /* We split this away from generate-new-buffer, because rename-buffer
1056 and set-visited-file-name ought to be able to use this to really
1057 rename the buffer properly. */
1058
1059 DEFUN ("generate-new-buffer-name", Fgenerate_new_buffer_name,
1060 Sgenerate_new_buffer_name, 1, 2, 0,
1061 doc: /* Return a string that is the name of no existing buffer based on NAME.
1062 If there is no live buffer named NAME, then return NAME.
1063 Otherwise modify name by appending `<NUMBER>', incrementing NUMBER
1064 \(starting at 2) until an unused name is found, and then return that name.
1065 Optional second argument IGNORE specifies a name that is okay to use (if
1066 it is in the sequence to be tried) even if a buffer with that name exists.
1067
1068 If NAME begins with a space (i.e., a buffer that is not normally
1069 visible to users), then if buffer NAME already exists a random number
1070 is first appended to NAME, to speed up finding a non-existent buffer. */)
1071 (register Lisp_Object name, Lisp_Object ignore)
1072 {
1073 register Lisp_Object gentemp, tem, tem2;
1074 ptrdiff_t count;
1075 char number[INT_BUFSIZE_BOUND (ptrdiff_t) + sizeof "<>"];
1076
1077 CHECK_STRING (name);
1078
1079 tem = Fstring_equal (name, ignore);
1080 if (!NILP (tem))
1081 return name;
1082 tem = Fget_buffer (name);
1083 if (NILP (tem))
1084 return name;
1085
1086 if (!strncmp (SSDATA (name), " ", 1)) /* see bug#1229 */
1087 {
1088 /* Note fileio.c:make_temp_name does random differently. */
1089 tem2 = concat2 (name, make_formatted_string
1090 (number, "-%"pI"d",
1091 XFASTINT (Frandom (make_number (999999)))));
1092 tem = Fget_buffer (tem2);
1093 if (NILP (tem))
1094 return tem2;
1095 }
1096 else
1097 tem2 = name;
1098
1099 count = 1;
1100 while (1)
1101 {
1102 gentemp = concat2 (tem2, make_formatted_string
1103 (number, "<%"pD"d>", ++count));
1104 tem = Fstring_equal (gentemp, ignore);
1105 if (!NILP (tem))
1106 return gentemp;
1107 tem = Fget_buffer (gentemp);
1108 if (NILP (tem))
1109 return gentemp;
1110 }
1111 }
1112
1113 \f
1114 DEFUN ("buffer-name", Fbuffer_name, Sbuffer_name, 0, 1, 0,
1115 doc: /* Return the name of BUFFER, as a string.
1116 BUFFER defaults to the current buffer.
1117 Return nil if BUFFER has been killed. */)
1118 (register Lisp_Object buffer)
1119 {
1120 if (NILP (buffer))
1121 return BVAR (current_buffer, name);
1122 CHECK_BUFFER (buffer);
1123 return BVAR (XBUFFER (buffer), name);
1124 }
1125
1126 DEFUN ("buffer-file-name", Fbuffer_file_name, Sbuffer_file_name, 0, 1, 0,
1127 doc: /* Return name of file BUFFER is visiting, or nil if none.
1128 No argument or nil as argument means use the current buffer. */)
1129 (register Lisp_Object buffer)
1130 {
1131 if (NILP (buffer))
1132 return BVAR (current_buffer, filename);
1133 CHECK_BUFFER (buffer);
1134 return BVAR (XBUFFER (buffer), filename);
1135 }
1136
1137 DEFUN ("buffer-base-buffer", Fbuffer_base_buffer, Sbuffer_base_buffer,
1138 0, 1, 0,
1139 doc: /* Return the base buffer of indirect buffer BUFFER.
1140 If BUFFER is not indirect, return nil.
1141 BUFFER defaults to the current buffer. */)
1142 (register Lisp_Object buffer)
1143 {
1144 struct buffer *base;
1145 Lisp_Object base_buffer;
1146
1147 if (NILP (buffer))
1148 base = current_buffer->base_buffer;
1149 else
1150 {
1151 CHECK_BUFFER (buffer);
1152 base = XBUFFER (buffer)->base_buffer;
1153 }
1154
1155 if (! base)
1156 return Qnil;
1157 XSETBUFFER (base_buffer, base);
1158 return base_buffer;
1159 }
1160
1161 DEFUN ("buffer-local-value", Fbuffer_local_value,
1162 Sbuffer_local_value, 2, 2, 0,
1163 doc: /* Return the value of VARIABLE in BUFFER.
1164 If VARIABLE does not have a buffer-local binding in BUFFER, the value
1165 is the default binding of the variable. */)
1166 (register Lisp_Object variable, register Lisp_Object buffer)
1167 {
1168 register Lisp_Object result = buffer_local_value (variable, buffer);
1169
1170 if (EQ (result, Qunbound))
1171 xsignal1 (Qvoid_variable, variable);
1172
1173 return result;
1174 }
1175
1176
1177 /* Like Fbuffer_local_value, but return Qunbound if the variable is
1178 locally unbound. */
1179
1180 Lisp_Object
1181 buffer_local_value (Lisp_Object variable, Lisp_Object buffer)
1182 {
1183 register struct buffer *buf;
1184 register Lisp_Object result;
1185 sym_t sym;
1186
1187 CHECK_SYMBOL (variable);
1188 CHECK_BUFFER (buffer);
1189 buf = XBUFFER (buffer);
1190 sym = XSYMBOL (variable);
1191
1192 start:
1193 switch (SYMBOL_REDIRECT (sym))
1194 {
1195 case SYMBOL_VARALIAS: sym = indirect_variable (sym); goto start;
1196 case SYMBOL_PLAINVAL: result = SYMBOL_VAL (sym); break;
1197 case SYMBOL_LOCALIZED:
1198 { /* Look in local_var_alist. */
1199 struct Lisp_Buffer_Local_Value *blv = SYMBOL_BLV (sym);
1200 XSETSYMBOL (variable, sym); /* Update In case of aliasing. */
1201 result = Fassoc (variable, BVAR (buf, local_var_alist));
1202 if (!NILP (result))
1203 {
1204 if (blv->fwd)
1205 { /* What binding is loaded right now? */
1206 Lisp_Object current_alist_element = blv->valcell;
1207
1208 /* The value of the currently loaded binding is not
1209 stored in it, but rather in the realvalue slot.
1210 Store that value into the binding it belongs to
1211 in case that is the one we are about to use. */
1212
1213 XSETCDR (current_alist_element,
1214 do_symval_forwarding (blv->fwd));
1215 }
1216 /* Now get the (perhaps updated) value out of the binding. */
1217 result = XCDR (result);
1218 }
1219 else
1220 result = Fdefault_value (variable);
1221 break;
1222 }
1223 case SYMBOL_FORWARDED:
1224 {
1225 union Lisp_Fwd *fwd = SYMBOL_FWD (sym);
1226 if (BUFFER_OBJFWDP (fwd))
1227 result = per_buffer_value (buf, XBUFFER_OBJFWD (fwd)->offset);
1228 else
1229 result = Fdefault_value (variable);
1230 break;
1231 }
1232 default: emacs_abort ();
1233 }
1234
1235 return result;
1236 }
1237
1238 /* Return an alist of the Lisp-level buffer-local bindings of
1239 buffer BUF. That is, don't include the variables maintained
1240 in special slots in the buffer object.
1241 If not CLONE, replace elements of the form (VAR . unbound)
1242 by VAR. */
1243
1244 static Lisp_Object
1245 buffer_lisp_local_variables (struct buffer *buf, bool clone)
1246 {
1247 Lisp_Object result = Qnil;
1248 Lisp_Object tail;
1249 for (tail = BVAR (buf, local_var_alist); CONSP (tail); tail = XCDR (tail))
1250 {
1251 Lisp_Object val, elt;
1252
1253 elt = XCAR (tail);
1254
1255 /* Reference each variable in the alist in buf.
1256 If inquiring about the current buffer, this gets the current values,
1257 so store them into the alist so the alist is up to date.
1258 If inquiring about some other buffer, this swaps out any values
1259 for that buffer, making the alist up to date automatically. */
1260 val = find_symbol_value (XCAR (elt));
1261 /* Use the current buffer value only if buf is the current buffer. */
1262 if (buf != current_buffer)
1263 val = XCDR (elt);
1264
1265 result = Fcons (!clone && EQ (val, Qunbound)
1266 ? XCAR (elt)
1267 : Fcons (XCAR (elt), val),
1268 result);
1269 }
1270
1271 return result;
1272 }
1273
1274 DEFUN ("buffer-local-variables", Fbuffer_local_variables,
1275 Sbuffer_local_variables, 0, 1, 0,
1276 doc: /* Return an alist of variables that are buffer-local in BUFFER.
1277 Most elements look like (SYMBOL . VALUE), describing one variable.
1278 For a symbol that is locally unbound, just the symbol appears in the value.
1279 Note that storing new VALUEs in these elements doesn't change the variables.
1280 No argument or nil as argument means use current buffer as BUFFER. */)
1281 (register Lisp_Object buffer)
1282 {
1283 register struct buffer *buf;
1284 register Lisp_Object result;
1285
1286 if (NILP (buffer))
1287 buf = current_buffer;
1288 else
1289 {
1290 CHECK_BUFFER (buffer);
1291 buf = XBUFFER (buffer);
1292 }
1293
1294 result = buffer_lisp_local_variables (buf, 0);
1295
1296 /* Add on all the variables stored in special slots. */
1297 {
1298 int offset, idx;
1299
1300 FOR_EACH_PER_BUFFER_OBJECT_AT (offset)
1301 {
1302 idx = PER_BUFFER_IDX (offset);
1303 if ((idx == -1 || PER_BUFFER_VALUE_P (buf, idx))
1304 && SYMBOLP (PER_BUFFER_SYMBOL (offset)))
1305 {
1306 Lisp_Object sym = PER_BUFFER_SYMBOL (offset);
1307 Lisp_Object val = per_buffer_value (buf, offset);
1308 result = Fcons (EQ (val, Qunbound) ? sym : Fcons (sym, val),
1309 result);
1310 }
1311 }
1312 }
1313
1314 return result;
1315 }
1316 \f
1317 DEFUN ("buffer-modified-p", Fbuffer_modified_p, Sbuffer_modified_p,
1318 0, 1, 0,
1319 doc: /* Return t if BUFFER was modified since its file was last read or saved.
1320 No argument or nil as argument means use current buffer as BUFFER. */)
1321 (register Lisp_Object buffer)
1322 {
1323 register struct buffer *buf;
1324 if (NILP (buffer))
1325 buf = current_buffer;
1326 else
1327 {
1328 CHECK_BUFFER (buffer);
1329 buf = XBUFFER (buffer);
1330 }
1331
1332 return BUF_SAVE_MODIFF (buf) < BUF_MODIFF (buf) ? Qt : Qnil;
1333 }
1334
1335 DEFUN ("force-mode-line-update", Fforce_mode_line_update,
1336 Sforce_mode_line_update, 0, 1, 0,
1337 doc: /* Force redisplay of the current buffer's mode line and header line.
1338 With optional non-nil ALL, force redisplay of all mode lines and
1339 header lines. This function also forces recomputation of the
1340 menu bar menus and the frame title. */)
1341 (Lisp_Object all)
1342 {
1343 if (!NILP (all))
1344 {
1345 update_mode_lines = 10;
1346 /* FIXME: This can't be right. */
1347 current_buffer->prevent_redisplay_optimizations_p = true;
1348 }
1349 else if (buffer_window_count (current_buffer))
1350 {
1351 bset_update_mode_line (current_buffer);
1352 current_buffer->prevent_redisplay_optimizations_p = true;
1353 }
1354 return all;
1355 }
1356
1357 DEFUN ("set-buffer-modified-p", Fset_buffer_modified_p, Sset_buffer_modified_p,
1358 1, 1, 0,
1359 doc: /* Mark current buffer as modified or unmodified according to FLAG.
1360 A non-nil FLAG means mark the buffer modified. */)
1361 (Lisp_Object flag)
1362 {
1363 Frestore_buffer_modified_p (flag);
1364
1365 /* Set update_mode_lines only if buffer is displayed in some window.
1366 Packages like jit-lock or lazy-lock preserve a buffer's modified
1367 state by recording/restoring the state around blocks of code.
1368 Setting update_mode_lines makes redisplay consider all windows
1369 (on all frames). Stealth fontification of buffers not displayed
1370 would incur additional redisplay costs if we'd set
1371 update_modes_lines unconditionally.
1372
1373 Ideally, I think there should be another mechanism for fontifying
1374 buffers without "modifying" buffers, or redisplay should be
1375 smarter about updating the `*' in mode lines. --gerd */
1376 return Fforce_mode_line_update (Qnil);
1377 }
1378
1379 DEFUN ("restore-buffer-modified-p", Frestore_buffer_modified_p,
1380 Srestore_buffer_modified_p, 1, 1, 0,
1381 doc: /* Like `set-buffer-modified-p', with a difference concerning redisplay.
1382 It is not ensured that mode lines will be updated to show the modified
1383 state of the current buffer. Use with care. */)
1384 (Lisp_Object flag)
1385 {
1386 Lisp_Object fn;
1387
1388 /* If buffer becoming modified, lock the file.
1389 If buffer becoming unmodified, unlock the file. */
1390
1391 struct buffer *b = current_buffer->base_buffer
1392 ? current_buffer->base_buffer
1393 : current_buffer;
1394
1395 fn = BVAR (b, file_truename);
1396 /* Test buffer-file-name so that binding it to nil is effective. */
1397 if (!NILP (fn) && ! NILP (BVAR (b, filename)))
1398 {
1399 bool already = SAVE_MODIFF < MODIFF;
1400 if (!already && !NILP (flag))
1401 lock_file (fn);
1402 else if (already && NILP (flag))
1403 unlock_file (fn);
1404 }
1405
1406 /* Here we have a problem. SAVE_MODIFF is used here to encode
1407 buffer-modified-p (as SAVE_MODIFF<MODIFF) as well as
1408 recent-auto-save-p (as SAVE_MODIFF<auto_save_modified). So if we
1409 modify SAVE_MODIFF to affect one, we may affect the other
1410 as well.
1411 E.g. if FLAG is nil we need to set SAVE_MODIFF to MODIFF, but
1412 if SAVE_MODIFF<auto_save_modified that means we risk changing
1413 recent-auto-save-p from t to nil.
1414 Vice versa, if FLAG is non-nil and SAVE_MODIFF>=auto_save_modified
1415 we risk changing recent-auto-save-p from nil to t. */
1416 SAVE_MODIFF = (NILP (flag)
1417 /* FIXME: This unavoidably sets recent-auto-save-p to nil. */
1418 ? MODIFF
1419 /* Let's try to preserve recent-auto-save-p. */
1420 : SAVE_MODIFF < MODIFF ? SAVE_MODIFF
1421 /* If SAVE_MODIFF == auto_save_modified == MODIFF,
1422 we can either decrease SAVE_MODIFF and auto_save_modified
1423 or increase MODIFF. */
1424 : MODIFF++);
1425
1426 return flag;
1427 }
1428
1429 DEFUN ("buffer-modified-tick", Fbuffer_modified_tick, Sbuffer_modified_tick,
1430 0, 1, 0,
1431 doc: /* Return BUFFER's tick counter, incremented for each change in text.
1432 Each buffer has a tick counter which is incremented each time the
1433 text in that buffer is changed. It wraps around occasionally.
1434 No argument or nil as argument means use current buffer as BUFFER. */)
1435 (register Lisp_Object buffer)
1436 {
1437 register struct buffer *buf;
1438 if (NILP (buffer))
1439 buf = current_buffer;
1440 else
1441 {
1442 CHECK_BUFFER (buffer);
1443 buf = XBUFFER (buffer);
1444 }
1445
1446 return make_number (BUF_MODIFF (buf));
1447 }
1448
1449 DEFUN ("buffer-chars-modified-tick", Fbuffer_chars_modified_tick,
1450 Sbuffer_chars_modified_tick, 0, 1, 0,
1451 doc: /* Return BUFFER's character-change tick counter.
1452 Each buffer has a character-change tick counter, which is set to the
1453 value of the buffer's tick counter \(see `buffer-modified-tick'), each
1454 time text in that buffer is inserted or deleted. By comparing the
1455 values returned by two individual calls of `buffer-chars-modified-tick',
1456 you can tell whether a character change occurred in that buffer in
1457 between these calls. No argument or nil as argument means use current
1458 buffer as BUFFER. */)
1459 (register Lisp_Object buffer)
1460 {
1461 register struct buffer *buf;
1462 if (NILP (buffer))
1463 buf = current_buffer;
1464 else
1465 {
1466 CHECK_BUFFER (buffer);
1467 buf = XBUFFER (buffer);
1468 }
1469
1470 return make_number (BUF_CHARS_MODIFF (buf));
1471 }
1472 \f
1473 DEFUN ("rename-buffer", Frename_buffer, Srename_buffer, 1, 2,
1474 "(list (read-string \"Rename buffer (to new name): \" \
1475 nil 'buffer-name-history (buffer-name (current-buffer))) \
1476 current-prefix-arg)",
1477 doc: /* Change current buffer's name to NEWNAME (a string).
1478 If second arg UNIQUE is nil or omitted, it is an error if a
1479 buffer named NEWNAME already exists.
1480 If UNIQUE is non-nil, come up with a new name using
1481 `generate-new-buffer-name'.
1482 Interactively, you can set UNIQUE with a prefix argument.
1483 We return the name we actually gave the buffer.
1484 This does not change the name of the visited file (if any). */)
1485 (register Lisp_Object newname, Lisp_Object unique)
1486 {
1487 register Lisp_Object tem, buf;
1488
1489 CHECK_STRING (newname);
1490
1491 if (SCHARS (newname) == 0)
1492 error ("Empty string is invalid as a buffer name");
1493
1494 tem = Fget_buffer (newname);
1495 if (!NILP (tem))
1496 {
1497 /* Don't short-circuit if UNIQUE is t. That is a useful way to
1498 rename the buffer automatically so you can create another
1499 with the original name. It makes UNIQUE equivalent to
1500 (rename-buffer (generate-new-buffer-name NEWNAME)). */
1501 if (NILP (unique) && XBUFFER (tem) == current_buffer)
1502 return BVAR (current_buffer, name);
1503 if (!NILP (unique))
1504 newname = Fgenerate_new_buffer_name (newname, BVAR (current_buffer, name));
1505 else
1506 error ("Buffer name `%s' is in use", SDATA (newname));
1507 }
1508
1509 bset_name (current_buffer, newname);
1510
1511 /* Catch redisplay's attention. Unless we do this, the mode lines for
1512 any windows displaying current_buffer will stay unchanged. */
1513 update_mode_lines = 11;
1514
1515 XSETBUFFER (buf, current_buffer);
1516 Fsetcar (Frassq (buf, Vbuffer_alist), newname);
1517 if (NILP (BVAR (current_buffer, filename))
1518 && !NILP (BVAR (current_buffer, auto_save_file_name)))
1519 call0 (intern ("rename-auto-save-file"));
1520
1521 /* Run buffer-list-update-hook. */
1522 if (!NILP (Vrun_hooks))
1523 call1 (Vrun_hooks, Qbuffer_list_update_hook);
1524
1525 /* Refetch since that last call may have done GC. */
1526 return BVAR (current_buffer, name);
1527 }
1528
1529 /* True if B can be used as 'other-than-BUFFER' buffer. */
1530
1531 static bool
1532 candidate_buffer (Lisp_Object b, Lisp_Object buffer)
1533 {
1534 return (BUFFERP (b) && !EQ (b, buffer)
1535 && BUFFER_LIVE_P (XBUFFER (b))
1536 && !BUFFER_HIDDEN_P (XBUFFER (b)));
1537 }
1538
1539 DEFUN ("other-buffer", Fother_buffer, Sother_buffer, 0, 3, 0,
1540 doc: /* Return most recently selected buffer other than BUFFER.
1541 Buffers not visible in windows are preferred to visible buffers, unless
1542 optional second argument VISIBLE-OK is non-nil. Ignore the argument
1543 BUFFER unless it denotes a live buffer. If the optional third argument
1544 FRAME is non-nil, use that frame's buffer list instead of the selected
1545 frame's buffer list.
1546
1547 The buffer is found by scanning the selected or specified frame's buffer
1548 list first, followed by the list of all buffers. If no other buffer
1549 exists, return the buffer `*scratch*' (creating it if necessary). */)
1550 (register Lisp_Object buffer, Lisp_Object visible_ok, Lisp_Object frame)
1551 {
1552 struct frame *f = decode_any_frame (frame);
1553 Lisp_Object tail = f->buffer_list, pred = f->buffer_predicate;
1554 Lisp_Object buf, notsogood = Qnil;
1555
1556 /* Consider buffers that have been seen in the frame first. */
1557 for (; CONSP (tail); tail = XCDR (tail))
1558 {
1559 buf = XCAR (tail);
1560 if (candidate_buffer (buf, buffer)
1561 /* If the frame has a buffer_predicate, disregard buffers that
1562 don't fit the predicate. */
1563 && (NILP (pred) || !NILP (call1 (pred, buf))))
1564 {
1565 if (!NILP (visible_ok)
1566 || NILP (Fget_buffer_window (buf, Qvisible)))
1567 return buf;
1568 else if (NILP (notsogood))
1569 notsogood = buf;
1570 }
1571 }
1572
1573 /* Consider alist of all buffers next. */
1574 FOR_EACH_LIVE_BUFFER (tail, buf)
1575 {
1576 if (candidate_buffer (buf, buffer)
1577 /* If the frame has a buffer_predicate, disregard buffers that
1578 don't fit the predicate. */
1579 && (NILP (pred) || !NILP (call1 (pred, buf))))
1580 {
1581 if (!NILP (visible_ok)
1582 || NILP (Fget_buffer_window (buf, Qvisible)))
1583 return buf;
1584 else if (NILP (notsogood))
1585 notsogood = buf;
1586 }
1587 }
1588
1589 if (!NILP (notsogood))
1590 return notsogood;
1591 else
1592 {
1593 buf = Fget_buffer (build_string ("*scratch*"));
1594 if (NILP (buf))
1595 {
1596 buf = Fget_buffer_create (build_string ("*scratch*"));
1597 Fset_buffer_major_mode (buf);
1598 }
1599 return buf;
1600 }
1601 }
1602
1603 /* The following function is a safe variant of Fother_buffer: It doesn't
1604 pay attention to any frame-local buffer lists, doesn't care about
1605 visibility of buffers, and doesn't evaluate any frame predicates. */
1606
1607 Lisp_Object
1608 other_buffer_safely (Lisp_Object buffer)
1609 {
1610 Lisp_Object tail, buf;
1611
1612 FOR_EACH_LIVE_BUFFER (tail, buf)
1613 if (candidate_buffer (buf, buffer))
1614 return buf;
1615
1616 buf = Fget_buffer (build_string ("*scratch*"));
1617 if (NILP (buf))
1618 {
1619 buf = Fget_buffer_create (build_string ("*scratch*"));
1620 Fset_buffer_major_mode (buf);
1621 }
1622
1623 return buf;
1624 }
1625 \f
1626 DEFUN ("buffer-enable-undo", Fbuffer_enable_undo, Sbuffer_enable_undo,
1627 0, 1, "",
1628 doc: /* Start keeping undo information for buffer BUFFER.
1629 No argument or nil as argument means do this for the current buffer. */)
1630 (register Lisp_Object buffer)
1631 {
1632 Lisp_Object real_buffer;
1633
1634 if (NILP (buffer))
1635 XSETBUFFER (real_buffer, current_buffer);
1636 else
1637 {
1638 real_buffer = Fget_buffer (buffer);
1639 if (NILP (real_buffer))
1640 nsberror (buffer);
1641 }
1642
1643 if (EQ (BVAR (XBUFFER (real_buffer), undo_list), Qt))
1644 bset_undo_list (XBUFFER (real_buffer), Qnil);
1645
1646 return Qnil;
1647 }
1648
1649 /* Truncate undo list and shrink the gap of BUFFER. */
1650
1651 void
1652 compact_buffer (struct buffer *buffer)
1653 {
1654 BUFFER_CHECK_INDIRECTION (buffer);
1655
1656 /* Skip dead buffers, indirect buffers and buffers
1657 which aren't changed since last compaction. */
1658 if (BUFFER_LIVE_P (buffer)
1659 && (buffer->base_buffer == NULL)
1660 && (BUF_COMPACT (buffer) != BUF_MODIFF (buffer)))
1661 {
1662 /* If a buffer's undo list is Qt, that means that undo is
1663 turned off in that buffer. Calling truncate_undo_list on
1664 Qt tends to return NULL, which effectively turns undo back on.
1665 So don't call truncate_undo_list if undo_list is Qt. */
1666 if (!EQ (buffer->INTERNAL_FIELD (undo_list), Qt))
1667 truncate_undo_list (buffer);
1668
1669 /* Shrink buffer gaps. */
1670 if (!buffer->text->inhibit_shrinking)
1671 {
1672 /* If a buffer's gap size is more than 10% of the buffer
1673 size, or larger than GAP_BYTES_DFL bytes, then shrink it
1674 accordingly. Keep a minimum size of GAP_BYTES_MIN bytes. */
1675 ptrdiff_t size = clip_to_bounds (GAP_BYTES_MIN,
1676 BUF_Z_BYTE (buffer) / 10,
1677 GAP_BYTES_DFL);
1678 if (BUF_GAP_SIZE (buffer) > size)
1679 make_gap_1 (buffer, -(BUF_GAP_SIZE (buffer) - size));
1680 }
1681 BUF_COMPACT (buffer) = BUF_MODIFF (buffer);
1682 }
1683 }
1684
1685 DEFUN ("kill-buffer", Fkill_buffer, Skill_buffer, 0, 1, "bKill buffer: ",
1686 doc: /* Kill the buffer specified by BUFFER-OR-NAME.
1687 The argument may be a buffer or the name of an existing buffer.
1688 Argument nil or omitted means kill the current buffer. Return t if the
1689 buffer is actually killed, nil otherwise.
1690
1691 The functions in `kill-buffer-query-functions' are called with the
1692 buffer to be killed as the current buffer. If any of them returns nil,
1693 the buffer is not killed. The hook `kill-buffer-hook' is run before the
1694 buffer is actually killed. The buffer being killed will be current
1695 while the hook is running. Functions called by any of these hooks are
1696 supposed to not change the current buffer.
1697
1698 Any processes that have this buffer as the `process-buffer' are killed
1699 with SIGHUP. This function calls `replace-buffer-in-windows' for
1700 cleaning up all windows currently displaying the buffer to be killed. */)
1701 (Lisp_Object buffer_or_name)
1702 {
1703 Lisp_Object buffer;
1704 register struct buffer *b;
1705 register Lisp_Object tem;
1706 register struct Lisp_Marker *m;
1707 struct gcpro gcpro1;
1708
1709 if (NILP (buffer_or_name))
1710 buffer = Fcurrent_buffer ();
1711 else
1712 buffer = Fget_buffer (buffer_or_name);
1713 if (NILP (buffer))
1714 nsberror (buffer_or_name);
1715
1716 b = XBUFFER (buffer);
1717
1718 /* Avoid trouble for buffer already dead. */
1719 if (!BUFFER_LIVE_P (b))
1720 return Qnil;
1721
1722 /* Run hooks with the buffer to be killed the current buffer. */
1723 {
1724 dynwind_begin ();
1725 Lisp_Object arglist[1];
1726
1727 record_unwind_protect (save_excursion_restore, save_excursion_save ());
1728 set_buffer_internal (b);
1729
1730 /* First run the query functions; if any query is answered no,
1731 don't kill the buffer. */
1732 arglist[0] = Qkill_buffer_query_functions;
1733 tem = Frun_hook_with_args_until_failure (1, arglist);
1734 if (NILP (tem)){
1735
1736 dynwind_end ();
1737 return Qnil;
1738 }
1739
1740 /* Query if the buffer is still modified. */
1741 if (INTERACTIVE && !NILP (BVAR (b, filename))
1742 && BUF_MODIFF (b) > BUF_SAVE_MODIFF (b))
1743 {
1744 GCPRO1 (buffer);
1745 tem = do_yes_or_no_p (format2 ("Buffer %s modified; kill anyway? ",
1746 BVAR (b, name), make_number (0)));
1747 UNGCPRO;
1748 if (NILP (tem)){
1749
1750 dynwind_end ();
1751 return Qnil;
1752 }
1753 }
1754
1755 /* If the hooks have killed the buffer, exit now. */
1756 if (!BUFFER_LIVE_P (b)){
1757
1758 dynwind_end ();
1759 return Qt;
1760 }
1761
1762 /* Then run the hooks. */
1763 Frun_hooks (1, &Qkill_buffer_hook);
1764 dynwind_end ();
1765 }
1766
1767 /* If the hooks have killed the buffer, exit now. */
1768 if (!BUFFER_LIVE_P (b))
1769 return Qt;
1770
1771 /* We have no more questions to ask. Verify that it is valid
1772 to kill the buffer. This must be done after the questions
1773 since anything can happen within do_yes_or_no_p. */
1774
1775 /* Don't kill the minibuffer now current. */
1776 if (EQ (buffer, XWINDOW (minibuf_window)->contents))
1777 return Qnil;
1778
1779 /* When we kill an ordinary buffer which shares it's buffer text
1780 with indirect buffer(s), we must kill indirect buffer(s) too.
1781 We do it at this stage so nothing terrible happens if they
1782 ask questions or their hooks get errors. */
1783 if (!b->base_buffer && b->indirections > 0)
1784 {
1785 struct buffer *other;
1786
1787 GCPRO1 (buffer);
1788
1789 FOR_EACH_BUFFER (other)
1790 if (other->base_buffer == b)
1791 {
1792 Lisp_Object buf;
1793 XSETBUFFER (buf, other);
1794 Fkill_buffer (buf);
1795 }
1796
1797 UNGCPRO;
1798
1799 /* Exit if we now have killed the base buffer (Bug#11665). */
1800 if (!BUFFER_LIVE_P (b))
1801 return Qt;
1802 }
1803
1804 /* Run replace_buffer_in_windows before making another buffer current
1805 since set-window-buffer-start-and-point will refuse to make another
1806 buffer current if the selected window does not show the current
1807 buffer (bug#10114). */
1808 replace_buffer_in_windows (buffer);
1809
1810 /* Exit if replacing the buffer in windows has killed our buffer. */
1811 if (!BUFFER_LIVE_P (b))
1812 return Qt;
1813
1814 /* Make this buffer not be current. Exit if it is the sole visible
1815 buffer. */
1816 if (b == current_buffer)
1817 {
1818 tem = Fother_buffer (buffer, Qnil, Qnil);
1819 Fset_buffer (tem);
1820 if (b == current_buffer)
1821 return Qnil;
1822 }
1823
1824 /* If the buffer now current is shown in the minibuffer and our buffer
1825 is the sole other buffer give up. */
1826 XSETBUFFER (tem, current_buffer);
1827 if (EQ (tem, XWINDOW (minibuf_window)->contents)
1828 && EQ (buffer, Fother_buffer (buffer, Qnil, Qnil)))
1829 return Qnil;
1830
1831 /* Now there is no question: we can kill the buffer. */
1832
1833 /* Unlock this buffer's file, if it is locked. */
1834 unlock_buffer (b);
1835
1836 GCPRO1 (buffer);
1837 kill_buffer_processes (buffer);
1838 UNGCPRO;
1839
1840 /* Killing buffer processes may run sentinels which may have killed
1841 our buffer. */
1842 if (!BUFFER_LIVE_P (b))
1843 return Qt;
1844
1845 /* These may run Lisp code and into infinite loops (if someone
1846 insisted on circular lists) so allow quitting here. */
1847 frames_discard_buffer (buffer);
1848
1849 clear_charpos_cache (b);
1850
1851 tem = Vinhibit_quit;
1852 Vinhibit_quit = Qt;
1853 /* Remove the buffer from the list of all buffers. */
1854 Vbuffer_alist = Fdelq (Frassq (buffer, Vbuffer_alist), Vbuffer_alist);
1855 /* If replace_buffer_in_windows didn't do its job fix that now. */
1856 replace_buffer_in_windows_safely (buffer);
1857 Vinhibit_quit = tem;
1858
1859 /* Delete any auto-save file, if we saved it in this session.
1860 But not if the buffer is modified. */
1861 if (STRINGP (BVAR (b, auto_save_file_name))
1862 && BUF_AUTOSAVE_MODIFF (b) != 0
1863 && BUF_SAVE_MODIFF (b) < BUF_AUTOSAVE_MODIFF (b)
1864 && BUF_SAVE_MODIFF (b) < BUF_MODIFF (b)
1865 && NILP (Fsymbol_value (intern ("auto-save-visited-file-name"))))
1866 {
1867 Lisp_Object delete;
1868 delete = Fsymbol_value (intern ("delete-auto-save-files"));
1869 if (! NILP (delete))
1870 internal_delete_file (BVAR (b, auto_save_file_name));
1871 }
1872
1873 /* Deleting an auto-save file could have killed our buffer. */
1874 if (!BUFFER_LIVE_P (b))
1875 return Qt;
1876
1877 if (b->base_buffer)
1878 {
1879 INTERVAL i;
1880 /* Unchain all markers that belong to this indirect buffer.
1881 Don't unchain the markers that belong to the base buffer
1882 or its other indirect buffers. */
1883 struct Lisp_Marker **mp = &BUF_MARKERS (b);
1884 while ((m = *mp))
1885 {
1886 if (m->buffer == b)
1887 {
1888 m->buffer = NULL;
1889 *mp = m->next;
1890 }
1891 else
1892 mp = &m->next;
1893 }
1894 /* Intervals should be owned by the base buffer (Bug#16502). */
1895 i = buffer_intervals (b);
1896 if (i)
1897 {
1898 Lisp_Object owner;
1899 XSETBUFFER (owner, b->base_buffer);
1900 set_interval_object (i, owner);
1901 }
1902 }
1903 else
1904 {
1905 /* Unchain all markers of this buffer and its indirect buffers.
1906 and leave them pointing nowhere. */
1907 for (m = BUF_MARKERS (b); m; )
1908 {
1909 struct Lisp_Marker *next = m->next;
1910 m->buffer = 0;
1911 m->next = NULL;
1912 m = next;
1913 }
1914 BUF_MARKERS (b) = NULL;
1915 set_buffer_intervals (b, NULL);
1916
1917 /* Perhaps we should explicitly free the interval tree here... */
1918 }
1919 /* Since we've unlinked the markers, the overlays can't be here any more
1920 either. */
1921 b->overlays_before = NULL;
1922 b->overlays_after = NULL;
1923
1924 /* Reset the local variables, so that this buffer's local values
1925 won't be protected from GC. They would be protected
1926 if they happened to remain cached in their symbols.
1927 This gets rid of them for certain. */
1928 swap_out_buffer_local_variables (b);
1929 reset_buffer_local_variables (b, 1);
1930
1931 bset_name (b, Qnil);
1932
1933 block_input ();
1934 if (b->base_buffer)
1935 {
1936 /* Notify our base buffer that we don't share the text anymore. */
1937 eassert (b->indirections == -1);
1938 b->base_buffer->indirections--;
1939 eassert (b->base_buffer->indirections >= 0);
1940 /* Make sure that we wasn't confused. */
1941 eassert (b->window_count == -1);
1942 }
1943 else
1944 {
1945 /* Make sure that no one shows us. */
1946 eassert (b->window_count == 0);
1947 /* No one shares our buffer text, can free it. */
1948 free_buffer_text (b);
1949 }
1950
1951 if (b->newline_cache)
1952 {
1953 free_region_cache (b->newline_cache);
1954 b->newline_cache = 0;
1955 }
1956 if (b->width_run_cache)
1957 {
1958 free_region_cache (b->width_run_cache);
1959 b->width_run_cache = 0;
1960 }
1961 if (b->bidi_paragraph_cache)
1962 {
1963 free_region_cache (b->bidi_paragraph_cache);
1964 b->bidi_paragraph_cache = 0;
1965 }
1966 bset_width_table (b, Qnil);
1967 unblock_input ();
1968 bset_undo_list (b, Qnil);
1969
1970 /* Run buffer-list-update-hook. */
1971 if (!NILP (Vrun_hooks))
1972 call1 (Vrun_hooks, Qbuffer_list_update_hook);
1973
1974 return Qt;
1975 }
1976 \f
1977 /* Move association for BUFFER to the front of buffer (a)lists. Since
1978 we do this each time BUFFER is selected visibly, the more recently
1979 selected buffers are always closer to the front of those lists. This
1980 means that other_buffer is more likely to choose a relevant buffer.
1981
1982 Note that this moves BUFFER to the front of the buffer lists of the
1983 selected frame even if BUFFER is not shown there. If BUFFER is not
1984 shown in the selected frame, consider the present behavior a feature.
1985 `select-window' gets this right since it shows BUFFER in the selected
1986 window when calling us. */
1987
1988 void
1989 record_buffer (Lisp_Object buffer)
1990 {
1991 Lisp_Object aelt, aelt_cons, tem;
1992 register struct frame *f = XFRAME (selected_frame);
1993
1994 CHECK_BUFFER (buffer);
1995
1996 /* Update Vbuffer_alist (we know that it has an entry for BUFFER).
1997 Don't allow quitting since this might leave the buffer list in an
1998 inconsistent state. */
1999 tem = Vinhibit_quit;
2000 Vinhibit_quit = Qt;
2001 aelt = Frassq (buffer, Vbuffer_alist);
2002 aelt_cons = Fmemq (aelt, Vbuffer_alist);
2003 Vbuffer_alist = Fdelq (aelt, Vbuffer_alist);
2004 XSETCDR (aelt_cons, Vbuffer_alist);
2005 Vbuffer_alist = aelt_cons;
2006 Vinhibit_quit = tem;
2007
2008 /* Update buffer list of selected frame. */
2009 fset_buffer_list (f, Fcons (buffer, Fdelq (buffer, f->buffer_list)));
2010 fset_buried_buffer_list (f, Fdelq (buffer, f->buried_buffer_list));
2011
2012 /* Run buffer-list-update-hook. */
2013 if (!NILP (Vrun_hooks))
2014 call1 (Vrun_hooks, Qbuffer_list_update_hook);
2015 }
2016
2017
2018 /* Move BUFFER to the end of the buffer (a)lists. Do nothing if the
2019 buffer is killed. For the selected frame's buffer list this moves
2020 BUFFER to its end even if it was never shown in that frame. If
2021 this happens we have a feature, hence `bury-buffer-internal' should be
2022 called only when BUFFER was shown in the selected frame. */
2023
2024 DEFUN ("bury-buffer-internal", Fbury_buffer_internal, Sbury_buffer_internal,
2025 1, 1, 0,
2026 doc: /* Move BUFFER to the end of the buffer list. */)
2027 (Lisp_Object buffer)
2028 {
2029 Lisp_Object aelt, aelt_cons, tem;
2030 register struct frame *f = XFRAME (selected_frame);
2031
2032 CHECK_BUFFER (buffer);
2033
2034 /* Update Vbuffer_alist (we know that it has an entry for BUFFER).
2035 Don't allow quitting since this might leave the buffer list in an
2036 inconsistent state. */
2037 tem = Vinhibit_quit;
2038 Vinhibit_quit = Qt;
2039 aelt = Frassq (buffer, Vbuffer_alist);
2040 aelt_cons = Fmemq (aelt, Vbuffer_alist);
2041 Vbuffer_alist = Fdelq (aelt, Vbuffer_alist);
2042 XSETCDR (aelt_cons, Qnil);
2043 Vbuffer_alist = nconc2 (Vbuffer_alist, aelt_cons);
2044 Vinhibit_quit = tem;
2045
2046 /* Update buffer lists of selected frame. */
2047 fset_buffer_list (f, Fdelq (buffer, f->buffer_list));
2048 fset_buried_buffer_list
2049 (f, Fcons (buffer, Fdelq (buffer, f->buried_buffer_list)));
2050
2051 /* Run buffer-list-update-hook. */
2052 if (!NILP (Vrun_hooks))
2053 call1 (Vrun_hooks, Qbuffer_list_update_hook);
2054
2055 return Qnil;
2056 }
2057
2058 DEFUN ("set-buffer-major-mode", Fset_buffer_major_mode, Sset_buffer_major_mode, 1, 1, 0,
2059 doc: /* Set an appropriate major mode for BUFFER.
2060 For the *scratch* buffer, use `initial-major-mode', otherwise choose a mode
2061 according to the default value of `major-mode'.
2062 Use this function before selecting the buffer, since it may need to inspect
2063 the current buffer's major mode. */)
2064 (Lisp_Object buffer)
2065 {
2066 ptrdiff_t count;
2067 Lisp_Object function;
2068
2069 CHECK_BUFFER (buffer);
2070
2071 if (!BUFFER_LIVE_P (XBUFFER (buffer)))
2072 error ("Attempt to set major mode for a dead buffer");
2073
2074 if (strcmp (SSDATA (BVAR (XBUFFER (buffer), name)), "*scratch*") == 0)
2075 function = find_symbol_value (intern ("initial-major-mode"));
2076 else
2077 {
2078 function = BVAR (&buffer_defaults, major_mode);
2079 if (NILP (function)
2080 && NILP (Fget (BVAR (current_buffer, major_mode), Qmode_class)))
2081 function = BVAR (current_buffer, major_mode);
2082 }
2083
2084 if (NILP (function) || EQ (function, Qfundamental_mode))
2085 return Qnil;
2086
2087 dynwind_begin ();
2088
2089 /* To select a nonfundamental mode,
2090 select the buffer temporarily and then call the mode function. */
2091
2092 record_unwind_protect (save_excursion_restore, save_excursion_save ());
2093
2094 Fset_buffer (buffer);
2095 call0 (function);
2096
2097 dynwind_end ();
2098 return Qnil;
2099 }
2100
2101 DEFUN ("current-buffer", Fcurrent_buffer, Scurrent_buffer, 0, 0, 0,
2102 doc: /* Return the current buffer as a Lisp object. */)
2103 (void)
2104 {
2105 register Lisp_Object buf;
2106 XSETBUFFER (buf, current_buffer);
2107 return buf;
2108 }
2109
2110 /* Set the current buffer to B, and do not set windows_or_buffers_changed.
2111 This is used by redisplay. */
2112
2113 void
2114 set_buffer_internal_1 (register struct buffer *b)
2115 {
2116 register struct buffer *old_buf;
2117 register Lisp_Object tail;
2118
2119 #ifdef USE_MMAP_FOR_BUFFERS
2120 if (b->text->beg == NULL)
2121 enlarge_buffer_text (b, 0);
2122 #endif /* USE_MMAP_FOR_BUFFERS */
2123
2124 if (current_buffer == b)
2125 return;
2126
2127 BUFFER_CHECK_INDIRECTION (b);
2128
2129 old_buf = current_buffer;
2130 current_buffer = b;
2131 last_known_column_point = -1; /* Invalidate indentation cache. */
2132
2133 if (old_buf)
2134 {
2135 /* Put the undo list back in the base buffer, so that it appears
2136 that an indirect buffer shares the undo list of its base. */
2137 if (old_buf->base_buffer)
2138 bset_undo_list (old_buf->base_buffer, BVAR (old_buf, undo_list));
2139
2140 /* If the old current buffer has markers to record PT, BEGV and ZV
2141 when it is not current, update them now. */
2142 record_buffer_markers (old_buf);
2143 }
2144
2145 /* Get the undo list from the base buffer, so that it appears
2146 that an indirect buffer shares the undo list of its base. */
2147 if (b->base_buffer)
2148 bset_undo_list (b, BVAR (b->base_buffer, undo_list));
2149
2150 /* If the new current buffer has markers to record PT, BEGV and ZV
2151 when it is not current, fetch them now. */
2152 fetch_buffer_markers (b);
2153
2154 /* Look down buffer's list of local Lisp variables
2155 to find and update any that forward into C variables. */
2156
2157 do
2158 {
2159 for (tail = BVAR (b, local_var_alist); CONSP (tail); tail = XCDR (tail))
2160 {
2161 Lisp_Object var = XCAR (XCAR (tail));
2162 sym_t sym = XSYMBOL (var);
2163 if (SYMBOL_REDIRECT (sym) == SYMBOL_LOCALIZED /* Just to be sure. */
2164 && SYMBOL_BLV (sym)->fwd)
2165 /* Just reference the variable
2166 to cause it to become set for this buffer. */
2167 Fsymbol_value (var);
2168 }
2169 }
2170 /* Do the same with any others that were local to the previous buffer */
2171 while (b != old_buf && (b = old_buf, b));
2172 }
2173
2174 /* Switch to buffer B temporarily for redisplay purposes.
2175 This avoids certain things that don't need to be done within redisplay. */
2176
2177 void
2178 set_buffer_temp (struct buffer *b)
2179 {
2180 register struct buffer *old_buf;
2181
2182 if (current_buffer == b)
2183 return;
2184
2185 old_buf = current_buffer;
2186 current_buffer = b;
2187
2188 /* If the old current buffer has markers to record PT, BEGV and ZV
2189 when it is not current, update them now. */
2190 record_buffer_markers (old_buf);
2191
2192 /* If the new current buffer has markers to record PT, BEGV and ZV
2193 when it is not current, fetch them now. */
2194 fetch_buffer_markers (b);
2195 }
2196
2197 DEFUN ("set-buffer", Fset_buffer, Sset_buffer, 1, 1, 0,
2198 doc: /* Make buffer BUFFER-OR-NAME current for editing operations.
2199 BUFFER-OR-NAME may be a buffer or the name of an existing buffer.
2200 See also `with-current-buffer' when you want to make a buffer current
2201 temporarily. This function does not display the buffer, so its effect
2202 ends when the current command terminates. Use `switch-to-buffer' or
2203 `pop-to-buffer' to switch buffers permanently.
2204 The return value is the buffer made current. */)
2205 (register Lisp_Object buffer_or_name)
2206 {
2207 register Lisp_Object buffer;
2208 buffer = Fget_buffer (buffer_or_name);
2209 if (NILP (buffer))
2210 nsberror (buffer_or_name);
2211 if (!BUFFER_LIVE_P (XBUFFER (buffer)))
2212 error ("Selecting deleted buffer");
2213 set_buffer_internal (XBUFFER (buffer));
2214 return buffer;
2215 }
2216
2217 void
2218 restore_buffer (Lisp_Object buffer_or_name)
2219 {
2220 Fset_buffer (buffer_or_name);
2221 }
2222
2223 /* Set the current buffer to BUFFER provided if it is alive. */
2224
2225 void
2226 set_buffer_if_live (Lisp_Object buffer)
2227 {
2228 if (BUFFER_LIVE_P (XBUFFER (buffer)))
2229 set_buffer_internal (XBUFFER (buffer));
2230 }
2231 \f
2232 DEFUN ("barf-if-buffer-read-only", Fbarf_if_buffer_read_only,
2233 Sbarf_if_buffer_read_only, 0, 0, 0,
2234 doc: /* Signal a `buffer-read-only' error if the current buffer is read-only. */)
2235 (void)
2236 {
2237 if (!NILP (BVAR (current_buffer, read_only))
2238 && NILP (Vinhibit_read_only))
2239 xsignal1 (Qbuffer_read_only, Fcurrent_buffer ());
2240 return Qnil;
2241 }
2242 \f
2243 DEFUN ("erase-buffer", Ferase_buffer, Serase_buffer, 0, 0, "*",
2244 doc: /* Delete the entire contents of the current buffer.
2245 Any narrowing restriction in effect (see `narrow-to-region') is removed,
2246 so the buffer is truly empty after this. */)
2247 (void)
2248 {
2249 Fwiden ();
2250
2251 del_range (BEG, Z);
2252
2253 current_buffer->last_window_start = 1;
2254 /* Prevent warnings, or suspension of auto saving, that would happen
2255 if future size is less than past size. Use of erase-buffer
2256 implies that the future text is not really related to the past text. */
2257 XSETFASTINT (BVAR (current_buffer, save_length), 0);
2258 return Qnil;
2259 }
2260
2261 void
2262 validate_region (register Lisp_Object *b, register Lisp_Object *e)
2263 {
2264 CHECK_NUMBER_COERCE_MARKER (*b);
2265 CHECK_NUMBER_COERCE_MARKER (*e);
2266
2267 if (XINT (*b) > XINT (*e))
2268 {
2269 Lisp_Object tem;
2270 tem = *b; *b = *e; *e = tem;
2271 }
2272
2273 if (! (BEGV <= XINT (*b) && XINT (*e) <= ZV))
2274 args_out_of_range_3 (Fcurrent_buffer (), *b, *e);
2275 }
2276 \f
2277 /* Advance BYTE_POS up to a character boundary
2278 and return the adjusted position. */
2279
2280 static ptrdiff_t
2281 advance_to_char_boundary (ptrdiff_t byte_pos)
2282 {
2283 int c;
2284
2285 if (byte_pos == BEG)
2286 /* Beginning of buffer is always a character boundary. */
2287 return BEG;
2288
2289 c = FETCH_BYTE (byte_pos);
2290 if (! CHAR_HEAD_P (c))
2291 {
2292 /* We should advance BYTE_POS only when C is a constituent of a
2293 multibyte sequence. */
2294 ptrdiff_t orig_byte_pos = byte_pos;
2295
2296 do
2297 {
2298 byte_pos--;
2299 c = FETCH_BYTE (byte_pos);
2300 }
2301 while (! CHAR_HEAD_P (c) && byte_pos > BEG);
2302 INC_POS (byte_pos);
2303 if (byte_pos < orig_byte_pos)
2304 byte_pos = orig_byte_pos;
2305 /* If C is a constituent of a multibyte sequence, BYTE_POS was
2306 surely advance to the correct character boundary. If C is
2307 not, BYTE_POS was unchanged. */
2308 }
2309
2310 return byte_pos;
2311 }
2312
2313 DEFUN ("buffer-swap-text", Fbuffer_swap_text, Sbuffer_swap_text,
2314 1, 1, 0,
2315 doc: /* Swap the text between current buffer and BUFFER. */)
2316 (Lisp_Object buffer)
2317 {
2318 struct buffer *other_buffer;
2319 CHECK_BUFFER (buffer);
2320 other_buffer = XBUFFER (buffer);
2321
2322 if (!BUFFER_LIVE_P (other_buffer))
2323 error ("Cannot swap a dead buffer's text");
2324
2325 /* Actually, it probably works just fine.
2326 * if (other_buffer == current_buffer)
2327 * error ("Cannot swap a buffer's text with itself"); */
2328
2329 /* Actually, this may be workable as well, tho probably only if they're
2330 *both* indirect. */
2331 if (other_buffer->base_buffer
2332 || current_buffer->base_buffer)
2333 error ("Cannot swap indirect buffers's text");
2334
2335 { /* This is probably harder to make work. */
2336 struct buffer *other;
2337 FOR_EACH_BUFFER (other)
2338 if (other->base_buffer == other_buffer
2339 || other->base_buffer == current_buffer)
2340 error ("One of the buffers to swap has indirect buffers");
2341 }
2342
2343 #define swapfield(field, type) \
2344 do { \
2345 type tmp##field = other_buffer->field; \
2346 other_buffer->field = current_buffer->field; \
2347 current_buffer->field = tmp##field; \
2348 } while (0)
2349 #define swapfield_(field, type) \
2350 do { \
2351 type tmp##field = BVAR (other_buffer, field); \
2352 bset_##field (other_buffer, BVAR (current_buffer, field)); \
2353 bset_##field (current_buffer, tmp##field); \
2354 } while (0)
2355
2356 swapfield (own_text, struct buffer_text);
2357 eassert (current_buffer->text == &current_buffer->own_text);
2358 eassert (other_buffer->text == &other_buffer->own_text);
2359 #ifdef REL_ALLOC
2360 r_alloc_reset_variable ((void **) &current_buffer->own_text.beg,
2361 (void **) &other_buffer->own_text.beg);
2362 r_alloc_reset_variable ((void **) &other_buffer->own_text.beg,
2363 (void **) &current_buffer->own_text.beg);
2364 #endif /* REL_ALLOC */
2365
2366 swapfield (pt, ptrdiff_t);
2367 swapfield (pt_byte, ptrdiff_t);
2368 swapfield (begv, ptrdiff_t);
2369 swapfield (begv_byte, ptrdiff_t);
2370 swapfield (zv, ptrdiff_t);
2371 swapfield (zv_byte, ptrdiff_t);
2372 eassert (!current_buffer->base_buffer);
2373 eassert (!other_buffer->base_buffer);
2374 swapfield (indirections, ptrdiff_t);
2375 current_buffer->clip_changed = 1; other_buffer->clip_changed = 1;
2376 swapfield (newline_cache, struct region_cache *);
2377 swapfield (width_run_cache, struct region_cache *);
2378 swapfield (bidi_paragraph_cache, struct region_cache *);
2379 current_buffer->prevent_redisplay_optimizations_p = 1;
2380 other_buffer->prevent_redisplay_optimizations_p = 1;
2381 swapfield (overlays_before, struct Lisp_Overlay *);
2382 swapfield (overlays_after, struct Lisp_Overlay *);
2383 swapfield (overlay_center, ptrdiff_t);
2384 swapfield_ (undo_list, Lisp_Object);
2385 swapfield_ (mark, Lisp_Object);
2386 swapfield_ (enable_multibyte_characters, Lisp_Object);
2387 swapfield_ (bidi_display_reordering, Lisp_Object);
2388 swapfield_ (bidi_paragraph_direction, Lisp_Object);
2389 /* FIXME: Not sure what we should do with these *_marker fields.
2390 Hopefully they're just nil anyway. */
2391 swapfield_ (pt_marker, Lisp_Object);
2392 swapfield_ (begv_marker, Lisp_Object);
2393 swapfield_ (zv_marker, Lisp_Object);
2394 bset_point_before_scroll (current_buffer, Qnil);
2395 bset_point_before_scroll (other_buffer, Qnil);
2396
2397 current_buffer->text->modiff++; other_buffer->text->modiff++;
2398 current_buffer->text->chars_modiff++; other_buffer->text->chars_modiff++;
2399 current_buffer->text->overlay_modiff++; other_buffer->text->overlay_modiff++;
2400 current_buffer->text->beg_unchanged = current_buffer->text->gpt;
2401 current_buffer->text->end_unchanged = current_buffer->text->gpt;
2402 other_buffer->text->beg_unchanged = other_buffer->text->gpt;
2403 other_buffer->text->end_unchanged = other_buffer->text->gpt;
2404 {
2405 struct Lisp_Marker *m;
2406 for (m = BUF_MARKERS (current_buffer); m; m = m->next)
2407 if (m->buffer == other_buffer)
2408 m->buffer = current_buffer;
2409 else
2410 /* Since there's no indirect buffer in sight, markers on
2411 BUF_MARKERS(buf) should either be for `buf' or dead. */
2412 eassert (!m->buffer);
2413 for (m = BUF_MARKERS (other_buffer); m; m = m->next)
2414 if (m->buffer == current_buffer)
2415 m->buffer = other_buffer;
2416 else
2417 /* Since there's no indirect buffer in sight, markers on
2418 BUF_MARKERS(buf) should either be for `buf' or dead. */
2419 eassert (!m->buffer);
2420 }
2421 { /* Some of the C code expects that both window markers of a
2422 live window points to that window's buffer. So since we
2423 just swapped the markers between the two buffers, we need
2424 to undo the effect of this swap for window markers. */
2425 Lisp_Object w = selected_window, ws = Qnil;
2426 Lisp_Object buf1, buf2;
2427 XSETBUFFER (buf1, current_buffer); XSETBUFFER (buf2, other_buffer);
2428
2429 while (NILP (Fmemq (w, ws)))
2430 {
2431 ws = Fcons (w, ws);
2432 if (MARKERP (XWINDOW (w)->pointm)
2433 && (EQ (XWINDOW (w)->contents, buf1)
2434 || EQ (XWINDOW (w)->contents, buf2)))
2435 Fset_marker (XWINDOW (w)->pointm,
2436 make_number
2437 (BUF_BEGV (XBUFFER (XWINDOW (w)->contents))),
2438 XWINDOW (w)->contents);
2439 if (MARKERP (XWINDOW (w)->start)
2440 && (EQ (XWINDOW (w)->contents, buf1)
2441 || EQ (XWINDOW (w)->contents, buf2)))
2442 Fset_marker (XWINDOW (w)->start,
2443 make_number
2444 (XBUFFER (XWINDOW (w)->contents)->last_window_start),
2445 XWINDOW (w)->contents);
2446 w = Fnext_window (w, Qt, Qt);
2447 }
2448 }
2449
2450 if (current_buffer->text->intervals)
2451 (eassert (EQ (current_buffer->text->intervals->up.obj, buffer)),
2452 XSETBUFFER (current_buffer->text->intervals->up.obj, current_buffer));
2453 if (other_buffer->text->intervals)
2454 (eassert (EQ (other_buffer->text->intervals->up.obj, Fcurrent_buffer ())),
2455 XSETBUFFER (other_buffer->text->intervals->up.obj, other_buffer));
2456
2457 return Qnil;
2458 }
2459
2460 DEFUN ("set-buffer-multibyte", Fset_buffer_multibyte, Sset_buffer_multibyte,
2461 1, 1, 0,
2462 doc: /* Set the multibyte flag of the current buffer to FLAG.
2463 If FLAG is t, this makes the buffer a multibyte buffer.
2464 If FLAG is nil, this makes the buffer a single-byte buffer.
2465 In these cases, the buffer contents remain unchanged as a sequence of
2466 bytes but the contents viewed as characters do change.
2467 If FLAG is `to', this makes the buffer a multibyte buffer by changing
2468 all eight-bit bytes to eight-bit characters.
2469 If the multibyte flag was really changed, undo information of the
2470 current buffer is cleared. */)
2471 (Lisp_Object flag)
2472 {
2473 struct Lisp_Marker *tail, *markers;
2474 struct buffer *other;
2475 ptrdiff_t begv, zv;
2476 bool narrowed = (BEG != BEGV || Z != ZV);
2477 bool modified_p = !NILP (Fbuffer_modified_p (Qnil));
2478 Lisp_Object old_undo = BVAR (current_buffer, undo_list);
2479 struct gcpro gcpro1;
2480
2481 if (current_buffer->base_buffer)
2482 error ("Cannot do `set-buffer-multibyte' on an indirect buffer");
2483
2484 /* Do nothing if nothing actually changes. */
2485 if (NILP (flag) == NILP (BVAR (current_buffer, enable_multibyte_characters)))
2486 return flag;
2487
2488 GCPRO1 (old_undo);
2489
2490 /* Don't record these buffer changes. We will put a special undo entry
2491 instead. */
2492 bset_undo_list (current_buffer, Qt);
2493
2494 /* If the cached position is for this buffer, clear it out. */
2495 clear_charpos_cache (current_buffer);
2496
2497 if (NILP (flag))
2498 begv = BEGV_BYTE, zv = ZV_BYTE;
2499 else
2500 begv = BEGV, zv = ZV;
2501
2502 if (narrowed)
2503 error ("Changing multibyteness in a narrowed buffer");
2504
2505 invalidate_buffer_caches (current_buffer, BEGV, ZV);
2506
2507 if (NILP (flag))
2508 {
2509 ptrdiff_t pos, stop;
2510 unsigned char *p;
2511
2512 /* Do this first, so it can use CHAR_TO_BYTE
2513 to calculate the old correspondences. */
2514 set_intervals_multibyte (0);
2515
2516 bset_enable_multibyte_characters (current_buffer, Qnil);
2517
2518 Z = Z_BYTE;
2519 BEGV = BEGV_BYTE;
2520 ZV = ZV_BYTE;
2521 GPT = GPT_BYTE;
2522 TEMP_SET_PT_BOTH (PT_BYTE, PT_BYTE);
2523
2524
2525 for (tail = BUF_MARKERS (current_buffer); tail; tail = tail->next)
2526 tail->charpos = tail->bytepos;
2527
2528 /* Convert multibyte form of 8-bit characters to unibyte. */
2529 pos = BEG;
2530 stop = GPT;
2531 p = BEG_ADDR;
2532 while (1)
2533 {
2534 int c, bytes;
2535
2536 if (pos == stop)
2537 {
2538 if (pos == Z)
2539 break;
2540 p = GAP_END_ADDR;
2541 stop = Z;
2542 }
2543 if (ASCII_CHAR_P (*p))
2544 p++, pos++;
2545 else if (CHAR_BYTE8_HEAD_P (*p))
2546 {
2547 c = STRING_CHAR_AND_LENGTH (p, bytes);
2548 /* Delete all bytes for this 8-bit character but the
2549 last one, and change the last one to the character
2550 code. */
2551 bytes--;
2552 del_range_2 (pos, pos, pos + bytes, pos + bytes, 0);
2553 p = GAP_END_ADDR;
2554 *p++ = c;
2555 pos++;
2556 if (begv > pos)
2557 begv -= bytes;
2558 if (zv > pos)
2559 zv -= bytes;
2560 stop = Z;
2561 }
2562 else
2563 {
2564 bytes = BYTES_BY_CHAR_HEAD (*p);
2565 p += bytes, pos += bytes;
2566 }
2567 }
2568 if (narrowed)
2569 Fnarrow_to_region (make_number (begv), make_number (zv));
2570 }
2571 else
2572 {
2573 ptrdiff_t pt = PT;
2574 ptrdiff_t pos, stop;
2575 unsigned char *p, *pend;
2576
2577 /* Be sure not to have a multibyte sequence striding over the GAP.
2578 Ex: We change this: "...abc\302 _GAP_ \241def..."
2579 to: "...abc _GAP_ \302\241def..." */
2580
2581 if (EQ (flag, Qt)
2582 && GPT_BYTE > 1 && GPT_BYTE < Z_BYTE
2583 && ! CHAR_HEAD_P (*(GAP_END_ADDR)))
2584 {
2585 unsigned char *q = GPT_ADDR - 1;
2586
2587 while (! CHAR_HEAD_P (*q) && q > BEG_ADDR) q--;
2588 if (LEADING_CODE_P (*q))
2589 {
2590 ptrdiff_t new_gpt = GPT_BYTE - (GPT_ADDR - q);
2591
2592 move_gap_both (new_gpt, new_gpt);
2593 }
2594 }
2595
2596 /* Make the buffer contents valid as multibyte by converting
2597 8-bit characters to multibyte form. */
2598 pos = BEG;
2599 stop = GPT;
2600 p = BEG_ADDR;
2601 pend = GPT_ADDR;
2602 while (1)
2603 {
2604 int bytes;
2605
2606 if (pos == stop)
2607 {
2608 if (pos == Z)
2609 break;
2610 p = GAP_END_ADDR;
2611 pend = Z_ADDR;
2612 stop = Z;
2613 }
2614
2615 if (ASCII_CHAR_P (*p))
2616 p++, pos++;
2617 else if (EQ (flag, Qt)
2618 && ! CHAR_BYTE8_HEAD_P (*p)
2619 && (bytes = MULTIBYTE_LENGTH (p, pend)) > 0)
2620 p += bytes, pos += bytes;
2621 else
2622 {
2623 unsigned char tmp[MAX_MULTIBYTE_LENGTH];
2624 int c;
2625
2626 c = BYTE8_TO_CHAR (*p);
2627 bytes = CHAR_STRING (c, tmp);
2628 *p = tmp[0];
2629 TEMP_SET_PT_BOTH (pos + 1, pos + 1);
2630 bytes--;
2631 insert_1_both ((char *) tmp + 1, bytes, bytes, 1, 0, 0);
2632 /* Now the gap is after the just inserted data. */
2633 pos = GPT;
2634 p = GAP_END_ADDR;
2635 if (pos <= begv)
2636 begv += bytes;
2637 if (pos <= zv)
2638 zv += bytes;
2639 if (pos <= pt)
2640 pt += bytes;
2641 pend = Z_ADDR;
2642 stop = Z;
2643 }
2644 }
2645
2646 if (pt != PT)
2647 TEMP_SET_PT (pt);
2648
2649 if (narrowed)
2650 Fnarrow_to_region (make_number (begv), make_number (zv));
2651
2652 /* Do this first, so that chars_in_text asks the right question.
2653 set_intervals_multibyte needs it too. */
2654 bset_enable_multibyte_characters (current_buffer, Qt);
2655
2656 GPT_BYTE = advance_to_char_boundary (GPT_BYTE);
2657 GPT = chars_in_text (BEG_ADDR, GPT_BYTE - BEG_BYTE) + BEG;
2658
2659 Z = chars_in_text (GAP_END_ADDR, Z_BYTE - GPT_BYTE) + GPT;
2660
2661 BEGV_BYTE = advance_to_char_boundary (BEGV_BYTE);
2662 if (BEGV_BYTE > GPT_BYTE)
2663 BEGV = chars_in_text (GAP_END_ADDR, BEGV_BYTE - GPT_BYTE) + GPT;
2664 else
2665 BEGV = chars_in_text (BEG_ADDR, BEGV_BYTE - BEG_BYTE) + BEG;
2666
2667 ZV_BYTE = advance_to_char_boundary (ZV_BYTE);
2668 if (ZV_BYTE > GPT_BYTE)
2669 ZV = chars_in_text (GAP_END_ADDR, ZV_BYTE - GPT_BYTE) + GPT;
2670 else
2671 ZV = chars_in_text (BEG_ADDR, ZV_BYTE - BEG_BYTE) + BEG;
2672
2673 {
2674 ptrdiff_t byte = advance_to_char_boundary (PT_BYTE);
2675 ptrdiff_t position;
2676
2677 if (byte > GPT_BYTE)
2678 position = chars_in_text (GAP_END_ADDR, byte - GPT_BYTE) + GPT;
2679 else
2680 position = chars_in_text (BEG_ADDR, byte - BEG_BYTE) + BEG;
2681 TEMP_SET_PT_BOTH (position, byte);
2682 }
2683
2684 tail = markers = BUF_MARKERS (current_buffer);
2685
2686 /* This prevents BYTE_TO_CHAR (that is, buf_bytepos_to_charpos) from
2687 getting confused by the markers that have not yet been updated.
2688 It is also a signal that it should never create a marker. */
2689 BUF_MARKERS (current_buffer) = NULL;
2690
2691 for (; tail; tail = tail->next)
2692 {
2693 tail->bytepos = advance_to_char_boundary (tail->bytepos);
2694 tail->charpos = BYTE_TO_CHAR (tail->bytepos);
2695 }
2696
2697 /* Make sure no markers were put on the chain
2698 while the chain value was incorrect. */
2699 if (BUF_MARKERS (current_buffer))
2700 emacs_abort ();
2701
2702 BUF_MARKERS (current_buffer) = markers;
2703
2704 /* Do this last, so it can calculate the new correspondences
2705 between chars and bytes. */
2706 set_intervals_multibyte (1);
2707 }
2708
2709 if (!EQ (old_undo, Qt))
2710 {
2711 /* Represent all the above changes by a special undo entry. */
2712 bset_undo_list (current_buffer,
2713 Fcons (list3 (Qapply,
2714 intern ("set-buffer-multibyte"),
2715 NILP (flag) ? Qt : Qnil),
2716 old_undo));
2717 }
2718
2719 UNGCPRO;
2720
2721 current_buffer->prevent_redisplay_optimizations_p = 1;
2722
2723 /* If buffer is shown in a window, let redisplay consider other windows. */
2724 if (buffer_window_count (current_buffer))
2725 windows_or_buffers_changed = 10;
2726
2727 /* Copy this buffer's new multibyte status
2728 into all of its indirect buffers. */
2729 FOR_EACH_BUFFER (other)
2730 if (other->base_buffer == current_buffer && BUFFER_LIVE_P (other))
2731 {
2732 BVAR (other, enable_multibyte_characters)
2733 = BVAR (current_buffer, enable_multibyte_characters);
2734 other->prevent_redisplay_optimizations_p = 1;
2735 }
2736
2737 /* Restore the modifiedness of the buffer. */
2738 if (!modified_p && !NILP (Fbuffer_modified_p (Qnil)))
2739 Fset_buffer_modified_p (Qnil);
2740
2741 /* Update coding systems of this buffer's process (if any). */
2742 {
2743 Lisp_Object process;
2744
2745 process = Fget_buffer_process (Fcurrent_buffer ());
2746 if (PROCESSP (process))
2747 setup_process_coding_systems (process);
2748 }
2749
2750 return flag;
2751 }
2752 \f
2753 DEFUN ("kill-all-local-variables", Fkill_all_local_variables,
2754 Skill_all_local_variables, 0, 0, 0,
2755 doc: /* Switch to Fundamental mode by killing current buffer's local variables.
2756 Most local variable bindings are eliminated so that the default values
2757 become effective once more. Also, the syntax table is set from
2758 `standard-syntax-table', the local keymap is set to nil,
2759 and the abbrev table from `fundamental-mode-abbrev-table'.
2760 This function also forces redisplay of the mode line.
2761
2762 Every function to select a new major mode starts by
2763 calling this function.
2764
2765 As a special exception, local variables whose names have
2766 a non-nil `permanent-local' property are not eliminated by this function.
2767
2768 The first thing this function does is run
2769 the normal hook `change-major-mode-hook'. */)
2770 (void)
2771 {
2772 Frun_hooks (1, &Qchange_major_mode_hook);
2773
2774 /* Make sure none of the bindings in local_var_alist
2775 remain swapped in, in their symbols. */
2776
2777 swap_out_buffer_local_variables (current_buffer);
2778
2779 /* Actually eliminate all local bindings of this buffer. */
2780
2781 reset_buffer_local_variables (current_buffer, 0);
2782
2783 /* Force mode-line redisplay. Useful here because all major mode
2784 commands call this function. */
2785 update_mode_lines = 12;
2786
2787 return Qnil;
2788 }
2789
2790 /* Make sure no local variables remain set up with buffer B
2791 for their current values. */
2792
2793 static void
2794 swap_out_buffer_local_variables (struct buffer *b)
2795 {
2796 Lisp_Object oalist, alist, buffer;
2797
2798 XSETBUFFER (buffer, b);
2799 oalist = BVAR (b, local_var_alist);
2800
2801 for (alist = oalist; CONSP (alist); alist = XCDR (alist))
2802 {
2803 Lisp_Object sym = XCAR (XCAR (alist));
2804 eassert (SYMBOL_REDIRECT (XSYMBOL (sym)) == SYMBOL_LOCALIZED);
2805 /* Need not do anything if some other buffer's binding is
2806 now cached. */
2807 if (EQ (SYMBOL_BLV (XSYMBOL (sym))->where, buffer))
2808 {
2809 /* Symbol is set up for this buffer's old local value:
2810 swap it out! */
2811 swap_in_global_binding (XSYMBOL (sym));
2812 }
2813 }
2814 }
2815 \f
2816 /* Find all the overlays in the current buffer that contain position POS.
2817 Return the number found, and store them in a vector in *VEC_PTR.
2818 Store in *LEN_PTR the size allocated for the vector.
2819 Store in *NEXT_PTR the next position after POS where an overlay starts,
2820 or ZV if there are no more overlays between POS and ZV.
2821 Store in *PREV_PTR the previous position before POS where an overlay ends,
2822 or where an overlay starts which ends at or after POS;
2823 or BEGV if there are no such overlays from BEGV to POS.
2824 NEXT_PTR and/or PREV_PTR may be 0, meaning don't store that info.
2825
2826 *VEC_PTR and *LEN_PTR should contain a valid vector and size
2827 when this function is called.
2828
2829 If EXTEND, make the vector bigger if necessary.
2830 If not, never extend the vector,
2831 and store only as many overlays as will fit.
2832 But still return the total number of overlays.
2833
2834 If CHANGE_REQ, any position written into *PREV_PTR or
2835 *NEXT_PTR is guaranteed to be not equal to POS, unless it is the
2836 default (BEGV or ZV). */
2837
2838 ptrdiff_t
2839 overlays_at (EMACS_INT pos, bool extend, Lisp_Object **vec_ptr,
2840 ptrdiff_t *len_ptr,
2841 ptrdiff_t *next_ptr, ptrdiff_t *prev_ptr, bool change_req)
2842 {
2843 Lisp_Object overlay, start, end;
2844 struct Lisp_Overlay *tail;
2845 ptrdiff_t idx = 0;
2846 ptrdiff_t len = *len_ptr;
2847 Lisp_Object *vec = *vec_ptr;
2848 ptrdiff_t next = ZV;
2849 ptrdiff_t prev = BEGV;
2850 bool inhibit_storing = 0;
2851
2852 for (tail = current_buffer->overlays_before; tail; tail = tail->next)
2853 {
2854 ptrdiff_t startpos, endpos;
2855
2856 XSETMISC (overlay, tail);
2857
2858 start = OVERLAY_START (overlay);
2859 end = OVERLAY_END (overlay);
2860 endpos = OVERLAY_POSITION (end);
2861 if (endpos < pos)
2862 {
2863 if (prev < endpos)
2864 prev = endpos;
2865 break;
2866 }
2867 startpos = OVERLAY_POSITION (start);
2868 /* This one ends at or after POS
2869 so its start counts for PREV_PTR if it's before POS. */
2870 if (prev < startpos && startpos < pos)
2871 prev = startpos;
2872 if (endpos == pos)
2873 continue;
2874 if (startpos <= pos)
2875 {
2876 if (idx == len)
2877 {
2878 /* The supplied vector is full.
2879 Either make it bigger, or don't store any more in it. */
2880 if (extend)
2881 {
2882 vec = xpalloc (vec, len_ptr, 1, OVERLAY_COUNT_MAX,
2883 sizeof *vec);
2884 *vec_ptr = vec;
2885 len = *len_ptr;
2886 }
2887 else
2888 inhibit_storing = 1;
2889 }
2890
2891 if (!inhibit_storing)
2892 vec[idx] = overlay;
2893 /* Keep counting overlays even if we can't return them all. */
2894 idx++;
2895 }
2896 else if (startpos < next)
2897 next = startpos;
2898 }
2899
2900 for (tail = current_buffer->overlays_after; tail; tail = tail->next)
2901 {
2902 ptrdiff_t startpos, endpos;
2903
2904 XSETMISC (overlay, tail);
2905
2906 start = OVERLAY_START (overlay);
2907 end = OVERLAY_END (overlay);
2908 startpos = OVERLAY_POSITION (start);
2909 if (pos < startpos)
2910 {
2911 if (startpos < next)
2912 next = startpos;
2913 break;
2914 }
2915 endpos = OVERLAY_POSITION (end);
2916 if (pos < endpos)
2917 {
2918 if (idx == len)
2919 {
2920 if (extend)
2921 {
2922 vec = xpalloc (vec, len_ptr, 1, OVERLAY_COUNT_MAX,
2923 sizeof *vec);
2924 *vec_ptr = vec;
2925 len = *len_ptr;
2926 }
2927 else
2928 inhibit_storing = 1;
2929 }
2930
2931 if (!inhibit_storing)
2932 vec[idx] = overlay;
2933 idx++;
2934
2935 if (startpos < pos && startpos > prev)
2936 prev = startpos;
2937 }
2938 else if (endpos < pos && endpos > prev)
2939 prev = endpos;
2940 else if (endpos == pos && startpos > prev
2941 && (!change_req || startpos < pos))
2942 prev = startpos;
2943 }
2944
2945 if (next_ptr)
2946 *next_ptr = next;
2947 if (prev_ptr)
2948 *prev_ptr = prev;
2949 return idx;
2950 }
2951 \f
2952 /* Find all the overlays in the current buffer that overlap the range
2953 BEG-END, or are empty at BEG, or are empty at END provided END
2954 denotes the position at the end of the current buffer.
2955
2956 Return the number found, and store them in a vector in *VEC_PTR.
2957 Store in *LEN_PTR the size allocated for the vector.
2958 Store in *NEXT_PTR the next position after POS where an overlay starts,
2959 or ZV if there are no more overlays.
2960 Store in *PREV_PTR the previous position before POS where an overlay ends,
2961 or BEGV if there are no previous overlays.
2962 NEXT_PTR and/or PREV_PTR may be 0, meaning don't store that info.
2963
2964 *VEC_PTR and *LEN_PTR should contain a valid vector and size
2965 when this function is called.
2966
2967 If EXTEND, make the vector bigger if necessary.
2968 If not, never extend the vector,
2969 and store only as many overlays as will fit.
2970 But still return the total number of overlays. */
2971
2972 static ptrdiff_t
2973 overlays_in (EMACS_INT beg, EMACS_INT end, bool extend,
2974 Lisp_Object **vec_ptr, ptrdiff_t *len_ptr,
2975 ptrdiff_t *next_ptr, ptrdiff_t *prev_ptr)
2976 {
2977 Lisp_Object overlay, ostart, oend;
2978 struct Lisp_Overlay *tail;
2979 ptrdiff_t idx = 0;
2980 ptrdiff_t len = *len_ptr;
2981 Lisp_Object *vec = *vec_ptr;
2982 ptrdiff_t next = ZV;
2983 ptrdiff_t prev = BEGV;
2984 bool inhibit_storing = 0;
2985 bool end_is_Z = end == Z;
2986
2987 for (tail = current_buffer->overlays_before; tail; tail = tail->next)
2988 {
2989 ptrdiff_t startpos, endpos;
2990
2991 XSETMISC (overlay, tail);
2992
2993 ostart = OVERLAY_START (overlay);
2994 oend = OVERLAY_END (overlay);
2995 endpos = OVERLAY_POSITION (oend);
2996 if (endpos < beg)
2997 {
2998 if (prev < endpos)
2999 prev = endpos;
3000 break;
3001 }
3002 startpos = OVERLAY_POSITION (ostart);
3003 /* Count an interval if it overlaps the range, is empty at the
3004 start of the range, or is empty at END provided END denotes the
3005 end of the buffer. */
3006 if ((beg < endpos && startpos < end)
3007 || (startpos == endpos
3008 && (beg == endpos || (end_is_Z && endpos == end))))
3009 {
3010 if (idx == len)
3011 {
3012 /* The supplied vector is full.
3013 Either make it bigger, or don't store any more in it. */
3014 if (extend)
3015 {
3016 vec = xpalloc (vec, len_ptr, 1, OVERLAY_COUNT_MAX,
3017 sizeof *vec);
3018 *vec_ptr = vec;
3019 len = *len_ptr;
3020 }
3021 else
3022 inhibit_storing = 1;
3023 }
3024
3025 if (!inhibit_storing)
3026 vec[idx] = overlay;
3027 /* Keep counting overlays even if we can't return them all. */
3028 idx++;
3029 }
3030 else if (startpos < next)
3031 next = startpos;
3032 }
3033
3034 for (tail = current_buffer->overlays_after; tail; tail = tail->next)
3035 {
3036 ptrdiff_t startpos, endpos;
3037
3038 XSETMISC (overlay, tail);
3039
3040 ostart = OVERLAY_START (overlay);
3041 oend = OVERLAY_END (overlay);
3042 startpos = OVERLAY_POSITION (ostart);
3043 if (end < startpos)
3044 {
3045 if (startpos < next)
3046 next = startpos;
3047 break;
3048 }
3049 endpos = OVERLAY_POSITION (oend);
3050 /* Count an interval if it overlaps the range, is empty at the
3051 start of the range, or is empty at END provided END denotes the
3052 end of the buffer. */
3053 if ((beg < endpos && startpos < end)
3054 || (startpos == endpos
3055 && (beg == endpos || (end_is_Z && endpos == end))))
3056 {
3057 if (idx == len)
3058 {
3059 if (extend)
3060 {
3061 vec = xpalloc (vec, len_ptr, 1, OVERLAY_COUNT_MAX,
3062 sizeof *vec);
3063 *vec_ptr = vec;
3064 len = *len_ptr;
3065 }
3066 else
3067 inhibit_storing = 1;
3068 }
3069
3070 if (!inhibit_storing)
3071 vec[idx] = overlay;
3072 idx++;
3073 }
3074 else if (endpos < beg && endpos > prev)
3075 prev = endpos;
3076 }
3077
3078 if (next_ptr)
3079 *next_ptr = next;
3080 if (prev_ptr)
3081 *prev_ptr = prev;
3082 return idx;
3083 }
3084
3085
3086 /* Return true if there exists an overlay with a non-nil
3087 `mouse-face' property overlapping OVERLAY. */
3088
3089 bool
3090 mouse_face_overlay_overlaps (Lisp_Object overlay)
3091 {
3092 ptrdiff_t start = OVERLAY_POSITION (OVERLAY_START (overlay));
3093 ptrdiff_t end = OVERLAY_POSITION (OVERLAY_END (overlay));
3094 ptrdiff_t n, i, size;
3095 Lisp_Object *v, tem;
3096
3097 size = 10;
3098 v = alloca (size * sizeof *v);
3099 n = overlays_in (start, end, 0, &v, &size, NULL, NULL);
3100 if (n > size)
3101 {
3102 v = alloca (n * sizeof *v);
3103 overlays_in (start, end, 0, &v, &n, NULL, NULL);
3104 }
3105
3106 for (i = 0; i < n; ++i)
3107 if (!EQ (v[i], overlay)
3108 && (tem = Foverlay_get (overlay, Qmouse_face),
3109 !NILP (tem)))
3110 break;
3111
3112 return i < n;
3113 }
3114
3115
3116 \f
3117 /* Fast function to just test if we're at an overlay boundary. */
3118 bool
3119 overlay_touches_p (ptrdiff_t pos)
3120 {
3121 Lisp_Object overlay;
3122 struct Lisp_Overlay *tail;
3123
3124 for (tail = current_buffer->overlays_before; tail; tail = tail->next)
3125 {
3126 ptrdiff_t endpos;
3127
3128 XSETMISC (overlay ,tail);
3129 eassert (OVERLAYP (overlay));
3130
3131 endpos = OVERLAY_POSITION (OVERLAY_END (overlay));
3132 if (endpos < pos)
3133 break;
3134 if (endpos == pos || OVERLAY_POSITION (OVERLAY_START (overlay)) == pos)
3135 return 1;
3136 }
3137
3138 for (tail = current_buffer->overlays_after; tail; tail = tail->next)
3139 {
3140 ptrdiff_t startpos;
3141
3142 XSETMISC (overlay, tail);
3143 eassert (OVERLAYP (overlay));
3144
3145 startpos = OVERLAY_POSITION (OVERLAY_START (overlay));
3146 if (pos < startpos)
3147 break;
3148 if (startpos == pos || OVERLAY_POSITION (OVERLAY_END (overlay)) == pos)
3149 return 1;
3150 }
3151 return 0;
3152 }
3153 \f
3154 struct sortvec
3155 {
3156 Lisp_Object overlay;
3157 ptrdiff_t beg, end;
3158 EMACS_INT priority;
3159 EMACS_INT spriority; /* Secondary priority. */
3160 };
3161
3162 static int
3163 compare_overlays (const void *v1, const void *v2)
3164 {
3165 const struct sortvec *s1 = v1;
3166 const struct sortvec *s2 = v2;
3167 /* Return 1 if s1 should take precedence, -1 if v2 should take precedence,
3168 and 0 if they're equal. */
3169 if (s1->priority != s2->priority)
3170 return s1->priority < s2->priority ? -1 : 1;
3171 /* If the priority is equal, give precedence to the one not covered by the
3172 other. If neither covers the other, obey spriority. */
3173 else if (s1->beg < s2->beg)
3174 return (s1->end < s2->end && s1->spriority > s2->spriority ? 1 : -1);
3175 else if (s1->beg > s2->beg)
3176 return (s1->end > s2->end && s1->spriority < s2->spriority ? -1 : 1);
3177 else if (s1->end != s2->end)
3178 return s2->end < s1->end ? -1 : 1;
3179 else if (s1->spriority != s2->spriority)
3180 return (s1->spriority < s2->spriority ? -1 : 1);
3181 else if (EQ (s1->overlay, s2->overlay))
3182 return 0;
3183 else
3184 /* Avoid the non-determinism of qsort by choosing an arbitrary ordering
3185 between "equal" overlays. The result can still change between
3186 invocations of Emacs, but it won't change in the middle of
3187 `find_field' (bug#6830). */
3188 return XLI (s1->overlay) < XLI (s2->overlay) ? -1 : 1;
3189 }
3190
3191 /* Sort an array of overlays by priority. The array is modified in place.
3192 The return value is the new size; this may be smaller than the original
3193 size if some of the overlays were invalid or were window-specific. */
3194 ptrdiff_t
3195 sort_overlays (Lisp_Object *overlay_vec, ptrdiff_t noverlays, struct window *w)
3196 {
3197 ptrdiff_t i, j;
3198 USE_SAFE_ALLOCA;
3199 struct sortvec *sortvec;
3200
3201 SAFE_NALLOCA (sortvec, 1, noverlays);
3202
3203 /* Put the valid and relevant overlays into sortvec. */
3204
3205 for (i = 0, j = 0; i < noverlays; i++)
3206 {
3207 Lisp_Object tem;
3208 Lisp_Object overlay;
3209
3210 overlay = overlay_vec[i];
3211 if (OVERLAYP (overlay)
3212 && OVERLAY_POSITION (OVERLAY_START (overlay)) > 0
3213 && OVERLAY_POSITION (OVERLAY_END (overlay)) > 0)
3214 {
3215 /* If we're interested in a specific window, then ignore
3216 overlays that are limited to some other window. */
3217 if (w)
3218 {
3219 Lisp_Object window;
3220
3221 window = Foverlay_get (overlay, Qwindow);
3222 if (WINDOWP (window) && XWINDOW (window) != w)
3223 continue;
3224 }
3225
3226 /* This overlay is good and counts: put it into sortvec. */
3227 sortvec[j].overlay = overlay;
3228 sortvec[j].beg = OVERLAY_POSITION (OVERLAY_START (overlay));
3229 sortvec[j].end = OVERLAY_POSITION (OVERLAY_END (overlay));
3230 tem = Foverlay_get (overlay, Qpriority);
3231 if (NILP (tem))
3232 {
3233 sortvec[j].priority = 0;
3234 sortvec[j].spriority = 0;
3235 }
3236 else if (INTEGERP (tem))
3237 {
3238 sortvec[j].priority = XINT (tem);
3239 sortvec[j].spriority = 0;
3240 }
3241 else if (CONSP (tem))
3242 {
3243 Lisp_Object car = XCAR (tem);
3244 Lisp_Object cdr = XCDR (tem);
3245 sortvec[j].priority = INTEGERP (car) ? XINT (car) : 0;
3246 sortvec[j].spriority = INTEGERP (cdr) ? XINT (cdr) : 0;
3247 }
3248 j++;
3249 }
3250 }
3251 noverlays = j;
3252
3253 /* Sort the overlays into the proper order: increasing priority. */
3254
3255 if (noverlays > 1)
3256 qsort (sortvec, noverlays, sizeof (struct sortvec), compare_overlays);
3257
3258 for (i = 0; i < noverlays; i++)
3259 overlay_vec[i] = sortvec[i].overlay;
3260
3261 SAFE_FREE ();
3262 return (noverlays);
3263 }
3264 \f
3265 struct sortstr
3266 {
3267 Lisp_Object string, string2;
3268 ptrdiff_t size;
3269 EMACS_INT priority;
3270 };
3271
3272 struct sortstrlist
3273 {
3274 struct sortstr *buf; /* An array that expands as needed; never freed. */
3275 ptrdiff_t size; /* Allocated length of that array. */
3276 ptrdiff_t used; /* How much of the array is currently in use. */
3277 ptrdiff_t bytes; /* Total length of the strings in buf. */
3278 };
3279
3280 /* Buffers for storing information about the overlays touching a given
3281 position. These could be automatic variables in overlay_strings, but
3282 it's more efficient to hold onto the memory instead of repeatedly
3283 allocating and freeing it. */
3284 static struct sortstrlist overlay_heads, overlay_tails;
3285 static unsigned char *overlay_str_buf;
3286
3287 /* Allocated length of overlay_str_buf. */
3288 static ptrdiff_t overlay_str_len;
3289
3290 /* A comparison function suitable for passing to qsort. */
3291 static int
3292 cmp_for_strings (const void *as1, const void *as2)
3293 {
3294 struct sortstr const *s1 = as1;
3295 struct sortstr const *s2 = as2;
3296 if (s1->size != s2->size)
3297 return s2->size < s1->size ? -1 : 1;
3298 if (s1->priority != s2->priority)
3299 return s1->priority < s2->priority ? -1 : 1;
3300 return 0;
3301 }
3302
3303 static void
3304 record_overlay_string (struct sortstrlist *ssl, Lisp_Object str,
3305 Lisp_Object str2, Lisp_Object pri, ptrdiff_t size)
3306 {
3307 ptrdiff_t nbytes;
3308
3309 if (ssl->used == ssl->size)
3310 ssl->buf = xpalloc (ssl->buf, &ssl->size, 5, -1, sizeof *ssl->buf);
3311 ssl->buf[ssl->used].string = str;
3312 ssl->buf[ssl->used].string2 = str2;
3313 ssl->buf[ssl->used].size = size;
3314 ssl->buf[ssl->used].priority = (INTEGERP (pri) ? XINT (pri) : 0);
3315 ssl->used++;
3316
3317 if (NILP (BVAR (current_buffer, enable_multibyte_characters)))
3318 nbytes = SCHARS (str);
3319 else if (! STRING_MULTIBYTE (str))
3320 nbytes = count_size_as_multibyte (SDATA (str),
3321 SBYTES (str));
3322 else
3323 nbytes = SBYTES (str);
3324
3325 if (INT_ADD_OVERFLOW (ssl->bytes, nbytes))
3326 memory_full (SIZE_MAX);
3327 ssl->bytes += nbytes;
3328
3329 if (STRINGP (str2))
3330 {
3331 if (NILP (BVAR (current_buffer, enable_multibyte_characters)))
3332 nbytes = SCHARS (str2);
3333 else if (! STRING_MULTIBYTE (str2))
3334 nbytes = count_size_as_multibyte (SDATA (str2),
3335 SBYTES (str2));
3336 else
3337 nbytes = SBYTES (str2);
3338
3339 if (INT_ADD_OVERFLOW (ssl->bytes, nbytes))
3340 memory_full (SIZE_MAX);
3341 ssl->bytes += nbytes;
3342 }
3343 }
3344
3345 /* Concatenate the strings associated with overlays that begin or end
3346 at POS, ignoring overlays that are specific to windows other than W.
3347 The strings are concatenated in the appropriate order: shorter
3348 overlays nest inside longer ones, and higher priority inside lower.
3349 Normally all of the after-strings come first, but zero-sized
3350 overlays have their after-strings ride along with the
3351 before-strings because it would look strange to print them
3352 inside-out.
3353
3354 Returns the concatenated string's length, and return the pointer to
3355 that string via PSTR, if that variable is non-NULL. The storage of
3356 the concatenated strings may be overwritten by subsequent calls. */
3357
3358 ptrdiff_t
3359 overlay_strings (ptrdiff_t pos, struct window *w, unsigned char **pstr)
3360 {
3361 Lisp_Object overlay, window, str;
3362 struct Lisp_Overlay *ov;
3363 ptrdiff_t startpos, endpos;
3364 bool multibyte = ! NILP (BVAR (current_buffer, enable_multibyte_characters));
3365
3366 overlay_heads.used = overlay_heads.bytes = 0;
3367 overlay_tails.used = overlay_tails.bytes = 0;
3368 for (ov = current_buffer->overlays_before; ov; ov = ov->next)
3369 {
3370 XSETMISC (overlay, ov);
3371 eassert (OVERLAYP (overlay));
3372
3373 startpos = OVERLAY_POSITION (OVERLAY_START (overlay));
3374 endpos = OVERLAY_POSITION (OVERLAY_END (overlay));
3375 if (endpos < pos)
3376 break;
3377 if (endpos != pos && startpos != pos)
3378 continue;
3379 window = Foverlay_get (overlay, Qwindow);
3380 if (WINDOWP (window) && XWINDOW (window) != w)
3381 continue;
3382 if (startpos == pos
3383 && (str = Foverlay_get (overlay, Qbefore_string), STRINGP (str)))
3384 record_overlay_string (&overlay_heads, str,
3385 (startpos == endpos
3386 ? Foverlay_get (overlay, Qafter_string)
3387 : Qnil),
3388 Foverlay_get (overlay, Qpriority),
3389 endpos - startpos);
3390 else if (endpos == pos
3391 && (str = Foverlay_get (overlay, Qafter_string), STRINGP (str)))
3392 record_overlay_string (&overlay_tails, str, Qnil,
3393 Foverlay_get (overlay, Qpriority),
3394 endpos - startpos);
3395 }
3396 for (ov = current_buffer->overlays_after; ov; ov = ov->next)
3397 {
3398 XSETMISC (overlay, ov);
3399 eassert (OVERLAYP (overlay));
3400
3401 startpos = OVERLAY_POSITION (OVERLAY_START (overlay));
3402 endpos = OVERLAY_POSITION (OVERLAY_END (overlay));
3403 if (startpos > pos)
3404 break;
3405 if (endpos != pos && startpos != pos)
3406 continue;
3407 window = Foverlay_get (overlay, Qwindow);
3408 if (WINDOWP (window) && XWINDOW (window) != w)
3409 continue;
3410 if (startpos == pos
3411 && (str = Foverlay_get (overlay, Qbefore_string), STRINGP (str)))
3412 record_overlay_string (&overlay_heads, str,
3413 (startpos == endpos
3414 ? Foverlay_get (overlay, Qafter_string)
3415 : Qnil),
3416 Foverlay_get (overlay, Qpriority),
3417 endpos - startpos);
3418 else if (endpos == pos
3419 && (str = Foverlay_get (overlay, Qafter_string), STRINGP (str)))
3420 record_overlay_string (&overlay_tails, str, Qnil,
3421 Foverlay_get (overlay, Qpriority),
3422 endpos - startpos);
3423 }
3424 if (overlay_tails.used > 1)
3425 qsort (overlay_tails.buf, overlay_tails.used, sizeof (struct sortstr),
3426 cmp_for_strings);
3427 if (overlay_heads.used > 1)
3428 qsort (overlay_heads.buf, overlay_heads.used, sizeof (struct sortstr),
3429 cmp_for_strings);
3430 if (overlay_heads.bytes || overlay_tails.bytes)
3431 {
3432 Lisp_Object tem;
3433 ptrdiff_t i;
3434 unsigned char *p;
3435 ptrdiff_t total;
3436
3437 if (INT_ADD_OVERFLOW (overlay_heads.bytes, overlay_tails.bytes))
3438 memory_full (SIZE_MAX);
3439 total = overlay_heads.bytes + overlay_tails.bytes;
3440 if (total > overlay_str_len)
3441 overlay_str_buf = xpalloc (overlay_str_buf, &overlay_str_len,
3442 total - overlay_str_len, -1, 1);
3443
3444 p = overlay_str_buf;
3445 for (i = overlay_tails.used; --i >= 0;)
3446 {
3447 ptrdiff_t nbytes;
3448 tem = overlay_tails.buf[i].string;
3449 nbytes = copy_text (SDATA (tem), p,
3450 SBYTES (tem),
3451 STRING_MULTIBYTE (tem), multibyte);
3452 p += nbytes;
3453 }
3454 for (i = 0; i < overlay_heads.used; ++i)
3455 {
3456 ptrdiff_t nbytes;
3457 tem = overlay_heads.buf[i].string;
3458 nbytes = copy_text (SDATA (tem), p,
3459 SBYTES (tem),
3460 STRING_MULTIBYTE (tem), multibyte);
3461 p += nbytes;
3462 tem = overlay_heads.buf[i].string2;
3463 if (STRINGP (tem))
3464 {
3465 nbytes = copy_text (SDATA (tem), p,
3466 SBYTES (tem),
3467 STRING_MULTIBYTE (tem), multibyte);
3468 p += nbytes;
3469 }
3470 }
3471 if (p != overlay_str_buf + total)
3472 emacs_abort ();
3473 if (pstr)
3474 *pstr = overlay_str_buf;
3475 return total;
3476 }
3477 return 0;
3478 }
3479 \f
3480 /* Shift overlays in BUF's overlay lists, to center the lists at POS. */
3481
3482 void
3483 recenter_overlay_lists (struct buffer *buf, ptrdiff_t pos)
3484 {
3485 Lisp_Object overlay, beg, end;
3486 struct Lisp_Overlay *prev, *tail, *next;
3487
3488 /* See if anything in overlays_before should move to overlays_after. */
3489
3490 /* We don't strictly need prev in this loop; it should always be nil.
3491 But we use it for symmetry and in case that should cease to be true
3492 with some future change. */
3493 prev = NULL;
3494 for (tail = buf->overlays_before; tail; prev = tail, tail = next)
3495 {
3496 next = tail->next;
3497 XSETMISC (overlay, tail);
3498 eassert (OVERLAYP (overlay));
3499
3500 beg = OVERLAY_START (overlay);
3501 end = OVERLAY_END (overlay);
3502
3503 if (OVERLAY_POSITION (end) > pos)
3504 {
3505 /* OVERLAY needs to be moved. */
3506 ptrdiff_t where = OVERLAY_POSITION (beg);
3507 struct Lisp_Overlay *other, *other_prev;
3508
3509 /* Splice the cons cell TAIL out of overlays_before. */
3510 if (prev)
3511 prev->next = next;
3512 else
3513 set_buffer_overlays_before (buf, next);
3514
3515 /* Search thru overlays_after for where to put it. */
3516 other_prev = NULL;
3517 for (other = buf->overlays_after; other;
3518 other_prev = other, other = other->next)
3519 {
3520 Lisp_Object otherbeg, otheroverlay;
3521
3522 XSETMISC (otheroverlay, other);
3523 eassert (OVERLAYP (otheroverlay));
3524
3525 otherbeg = OVERLAY_START (otheroverlay);
3526 if (OVERLAY_POSITION (otherbeg) >= where)
3527 break;
3528 }
3529
3530 /* Add TAIL to overlays_after before OTHER. */
3531 tail->next = other;
3532 if (other_prev)
3533 other_prev->next = tail;
3534 else
3535 set_buffer_overlays_after (buf, tail);
3536 tail = prev;
3537 }
3538 else
3539 /* We've reached the things that should stay in overlays_before.
3540 All the rest of overlays_before must end even earlier,
3541 so stop now. */
3542 break;
3543 }
3544
3545 /* See if anything in overlays_after should be in overlays_before. */
3546 prev = NULL;
3547 for (tail = buf->overlays_after; tail; prev = tail, tail = next)
3548 {
3549 next = tail->next;
3550 XSETMISC (overlay, tail);
3551 eassert (OVERLAYP (overlay));
3552
3553 beg = OVERLAY_START (overlay);
3554 end = OVERLAY_END (overlay);
3555
3556 /* Stop looking, when we know that nothing further
3557 can possibly end before POS. */
3558 if (OVERLAY_POSITION (beg) > pos)
3559 break;
3560
3561 if (OVERLAY_POSITION (end) <= pos)
3562 {
3563 /* OVERLAY needs to be moved. */
3564 ptrdiff_t where = OVERLAY_POSITION (end);
3565 struct Lisp_Overlay *other, *other_prev;
3566
3567 /* Splice the cons cell TAIL out of overlays_after. */
3568 if (prev)
3569 prev->next = next;
3570 else
3571 set_buffer_overlays_after (buf, next);
3572
3573 /* Search thru overlays_before for where to put it. */
3574 other_prev = NULL;
3575 for (other = buf->overlays_before; other;
3576 other_prev = other, other = other->next)
3577 {
3578 Lisp_Object otherend, otheroverlay;
3579
3580 XSETMISC (otheroverlay, other);
3581 eassert (OVERLAYP (otheroverlay));
3582
3583 otherend = OVERLAY_END (otheroverlay);
3584 if (OVERLAY_POSITION (otherend) <= where)
3585 break;
3586 }
3587
3588 /* Add TAIL to overlays_before before OTHER. */
3589 tail->next = other;
3590 if (other_prev)
3591 other_prev->next = tail;
3592 else
3593 set_buffer_overlays_before (buf, tail);
3594 tail = prev;
3595 }
3596 }
3597
3598 buf->overlay_center = pos;
3599 }
3600
3601 void
3602 adjust_overlays_for_insert (ptrdiff_t pos, ptrdiff_t length)
3603 {
3604 /* After an insertion, the lists are still sorted properly,
3605 but we may need to update the value of the overlay center. */
3606 if (current_buffer->overlay_center >= pos)
3607 current_buffer->overlay_center += length;
3608 }
3609
3610 void
3611 adjust_overlays_for_delete (ptrdiff_t pos, ptrdiff_t length)
3612 {
3613 if (current_buffer->overlay_center < pos)
3614 /* The deletion was to our right. No change needed; the before- and
3615 after-lists are still consistent. */
3616 ;
3617 else if (current_buffer->overlay_center - pos > length)
3618 /* The deletion was to our left. We need to adjust the center value
3619 to account for the change in position, but the lists are consistent
3620 given the new value. */
3621 current_buffer->overlay_center -= length;
3622 else
3623 /* We're right in the middle. There might be things on the after-list
3624 that now belong on the before-list. Recentering will move them,
3625 and also update the center point. */
3626 recenter_overlay_lists (current_buffer, pos);
3627 }
3628
3629 /* Fix up overlays that were garbled as a result of permuting markers
3630 in the range START through END. Any overlay with at least one
3631 endpoint in this range will need to be unlinked from the overlay
3632 list and reinserted in its proper place.
3633 Such an overlay might even have negative size at this point.
3634 If so, we'll make the overlay empty. */
3635 void
3636 fix_start_end_in_overlays (register ptrdiff_t start, register ptrdiff_t end)
3637 {
3638 Lisp_Object overlay;
3639 struct Lisp_Overlay *before_list IF_LINT (= NULL);
3640 struct Lisp_Overlay *after_list IF_LINT (= NULL);
3641 /* These are either nil, indicating that before_list or after_list
3642 should be assigned, or the cons cell the cdr of which should be
3643 assigned. */
3644 struct Lisp_Overlay *beforep = NULL, *afterp = NULL;
3645 /* 'Parent', likewise, indicates a cons cell or
3646 current_buffer->overlays_before or overlays_after, depending
3647 which loop we're in. */
3648 struct Lisp_Overlay *tail, *parent;
3649 ptrdiff_t startpos, endpos;
3650
3651 /* This algorithm shifts links around instead of consing and GCing.
3652 The loop invariant is that before_list (resp. after_list) is a
3653 well-formed list except that its last element, the CDR of beforep
3654 (resp. afterp) if beforep (afterp) isn't nil or before_list
3655 (after_list) if it is, is still uninitialized. So it's not a bug
3656 that before_list isn't initialized, although it may look
3657 strange. */
3658 for (parent = NULL, tail = current_buffer->overlays_before; tail;)
3659 {
3660 XSETMISC (overlay, tail);
3661
3662 endpos = OVERLAY_POSITION (OVERLAY_END (overlay));
3663 startpos = OVERLAY_POSITION (OVERLAY_START (overlay));
3664
3665 /* If the overlay is backwards, make it empty. */
3666 if (endpos < startpos)
3667 {
3668 startpos = endpos;
3669 Fset_marker (OVERLAY_START (overlay), make_number (startpos),
3670 Qnil);
3671 }
3672
3673 if (endpos < start)
3674 break;
3675
3676 if (endpos < end
3677 || (startpos >= start && startpos < end))
3678 {
3679 /* Add it to the end of the wrong list. Later on,
3680 recenter_overlay_lists will move it to the right place. */
3681 if (endpos < current_buffer->overlay_center)
3682 {
3683 if (!afterp)
3684 after_list = tail;
3685 else
3686 afterp->next = tail;
3687 afterp = tail;
3688 }
3689 else
3690 {
3691 if (!beforep)
3692 before_list = tail;
3693 else
3694 beforep->next = tail;
3695 beforep = tail;
3696 }
3697 if (!parent)
3698 set_buffer_overlays_before (current_buffer, tail->next);
3699 else
3700 parent->next = tail->next;
3701 tail = tail->next;
3702 }
3703 else
3704 parent = tail, tail = parent->next;
3705 }
3706 for (parent = NULL, tail = current_buffer->overlays_after; tail;)
3707 {
3708 XSETMISC (overlay, tail);
3709
3710 startpos = OVERLAY_POSITION (OVERLAY_START (overlay));
3711 endpos = OVERLAY_POSITION (OVERLAY_END (overlay));
3712
3713 /* If the overlay is backwards, make it empty. */
3714 if (endpos < startpos)
3715 {
3716 startpos = endpos;
3717 Fset_marker (OVERLAY_START (overlay), make_number (startpos),
3718 Qnil);
3719 }
3720
3721 if (startpos >= end)
3722 break;
3723
3724 if (startpos >= start
3725 || (endpos >= start && endpos < end))
3726 {
3727 if (endpos < current_buffer->overlay_center)
3728 {
3729 if (!afterp)
3730 after_list = tail;
3731 else
3732 afterp->next = tail;
3733 afterp = tail;
3734 }
3735 else
3736 {
3737 if (!beforep)
3738 before_list = tail;
3739 else
3740 beforep->next = tail;
3741 beforep = tail;
3742 }
3743 if (!parent)
3744 set_buffer_overlays_after (current_buffer, tail->next);
3745 else
3746 parent->next = tail->next;
3747 tail = tail->next;
3748 }
3749 else
3750 parent = tail, tail = parent->next;
3751 }
3752
3753 /* Splice the constructed (wrong) lists into the buffer's lists,
3754 and let the recenter function make it sane again. */
3755 if (beforep)
3756 {
3757 beforep->next = current_buffer->overlays_before;
3758 set_buffer_overlays_before (current_buffer, before_list);
3759 }
3760
3761 if (afterp)
3762 {
3763 afterp->next = current_buffer->overlays_after;
3764 set_buffer_overlays_after (current_buffer, after_list);
3765 }
3766 recenter_overlay_lists (current_buffer, current_buffer->overlay_center);
3767 }
3768
3769 /* We have two types of overlay: the one whose ending marker is
3770 after-insertion-marker (this is the usual case) and the one whose
3771 ending marker is before-insertion-marker. When `overlays_before'
3772 contains overlays of the latter type and the former type in this
3773 order and both overlays end at inserting position, inserting a text
3774 increases only the ending marker of the latter type, which results
3775 in incorrect ordering of `overlays_before'.
3776
3777 This function fixes ordering of overlays in the slot
3778 `overlays_before' of the buffer *BP. Before the insertion, `point'
3779 was at PREV, and now is at POS. */
3780
3781 void
3782 fix_overlays_before (struct buffer *bp, ptrdiff_t prev, ptrdiff_t pos)
3783 {
3784 /* If parent is nil, replace overlays_before; otherwise, parent->next. */
3785 struct Lisp_Overlay *tail = bp->overlays_before, *parent = NULL, *right_pair;
3786 Lisp_Object tem;
3787 ptrdiff_t end IF_LINT (= 0);
3788
3789 /* After the insertion, the several overlays may be in incorrect
3790 order. The possibility is that, in the list `overlays_before',
3791 an overlay which ends at POS appears after an overlay which ends
3792 at PREV. Since POS is greater than PREV, we must fix the
3793 ordering of these overlays, by moving overlays ends at POS before
3794 the overlays ends at PREV. */
3795
3796 /* At first, find a place where disordered overlays should be linked
3797 in. It is where an overlay which end before POS exists. (i.e. an
3798 overlay whose ending marker is after-insertion-marker if disorder
3799 exists). */
3800 while (tail
3801 && (XSETMISC (tem, tail),
3802 (end = OVERLAY_POSITION (OVERLAY_END (tem))) >= pos))
3803 {
3804 parent = tail;
3805 tail = tail->next;
3806 }
3807
3808 /* If we don't find such an overlay,
3809 or the found one ends before PREV,
3810 or the found one is the last one in the list,
3811 we don't have to fix anything. */
3812 if (!tail || end < prev || !tail->next)
3813 return;
3814
3815 right_pair = parent;
3816 parent = tail;
3817 tail = tail->next;
3818
3819 /* Now, end position of overlays in the list TAIL should be before
3820 or equal to PREV. In the loop, an overlay which ends at POS is
3821 moved ahead to the place indicated by the CDR of RIGHT_PAIR. If
3822 we found an overlay which ends before PREV, the remaining
3823 overlays are in correct order. */
3824 while (tail)
3825 {
3826 XSETMISC (tem, tail);
3827 end = OVERLAY_POSITION (OVERLAY_END (tem));
3828
3829 if (end == pos)
3830 { /* This overlay is disordered. */
3831 struct Lisp_Overlay *found = tail;
3832
3833 /* Unlink the found overlay. */
3834 tail = found->next;
3835 parent->next = tail;
3836 /* Move an overlay at RIGHT_PLACE to the next of the found one,
3837 and link it into the right place. */
3838 if (!right_pair)
3839 {
3840 found->next = bp->overlays_before;
3841 set_buffer_overlays_before (bp, found);
3842 }
3843 else
3844 {
3845 found->next = right_pair->next;
3846 right_pair->next = found;
3847 }
3848 }
3849 else if (end == prev)
3850 {
3851 parent = tail;
3852 tail = tail->next;
3853 }
3854 else /* No more disordered overlay. */
3855 break;
3856 }
3857 }
3858 \f
3859 DEFUN ("overlayp", Foverlayp, Soverlayp, 1, 1, 0,
3860 doc: /* Return t if OBJECT is an overlay. */)
3861 (Lisp_Object object)
3862 {
3863 return (OVERLAYP (object) ? Qt : Qnil);
3864 }
3865
3866 DEFUN ("make-overlay", Fmake_overlay, Smake_overlay, 2, 5, 0,
3867 doc: /* Create a new overlay with range BEG to END in BUFFER and return it.
3868 If omitted, BUFFER defaults to the current buffer.
3869 BEG and END may be integers or markers.
3870 The fourth arg FRONT-ADVANCE, if non-nil, makes the marker
3871 for the front of the overlay advance when text is inserted there
3872 \(which means the text *is not* included in the overlay).
3873 The fifth arg REAR-ADVANCE, if non-nil, makes the marker
3874 for the rear of the overlay advance when text is inserted there
3875 \(which means the text *is* included in the overlay). */)
3876 (Lisp_Object beg, Lisp_Object end, Lisp_Object buffer,
3877 Lisp_Object front_advance, Lisp_Object rear_advance)
3878 {
3879 Lisp_Object overlay;
3880 struct buffer *b;
3881
3882 if (NILP (buffer))
3883 XSETBUFFER (buffer, current_buffer);
3884 else
3885 CHECK_BUFFER (buffer);
3886
3887 if (MARKERP (beg) && !EQ (Fmarker_buffer (beg), buffer))
3888 signal_error ("Marker points into wrong buffer", beg);
3889 if (MARKERP (end) && !EQ (Fmarker_buffer (end), buffer))
3890 signal_error ("Marker points into wrong buffer", end);
3891
3892 CHECK_NUMBER_COERCE_MARKER (beg);
3893 CHECK_NUMBER_COERCE_MARKER (end);
3894
3895 if (XINT (beg) > XINT (end))
3896 {
3897 Lisp_Object temp;
3898 temp = beg; beg = end; end = temp;
3899 }
3900
3901 b = XBUFFER (buffer);
3902
3903 beg = Fset_marker (Fmake_marker (), beg, buffer);
3904 end = Fset_marker (Fmake_marker (), end, buffer);
3905
3906 if (!NILP (front_advance))
3907 XMARKER (beg)->insertion_type = 1;
3908 if (!NILP (rear_advance))
3909 XMARKER (end)->insertion_type = 1;
3910
3911 overlay = build_overlay (beg, end, Qnil);
3912
3913 /* Put the new overlay on the wrong list. */
3914 end = OVERLAY_END (overlay);
3915 if (OVERLAY_POSITION (end) < b->overlay_center)
3916 {
3917 eassert (b->overlays_after || (XOVERLAY (overlay)->next == NULL));
3918 XOVERLAY (overlay)->next = b->overlays_after;
3919 set_buffer_overlays_after (b, XOVERLAY (overlay));
3920 }
3921 else
3922 {
3923 eassert (b->overlays_before || (XOVERLAY (overlay)->next == NULL));
3924 XOVERLAY (overlay)->next = b->overlays_before;
3925 set_buffer_overlays_before (b, XOVERLAY (overlay));
3926 }
3927 /* This puts it in the right list, and in the right order. */
3928 recenter_overlay_lists (b, b->overlay_center);
3929
3930 /* We don't need to redisplay the region covered by the overlay, because
3931 the overlay has no properties at the moment. */
3932
3933 return overlay;
3934 }
3935 \f
3936 /* Mark a section of BUF as needing redisplay because of overlays changes. */
3937
3938 static void
3939 modify_overlay (struct buffer *buf, ptrdiff_t start, ptrdiff_t end)
3940 {
3941 if (start > end)
3942 {
3943 ptrdiff_t temp = start;
3944 start = end;
3945 end = temp;
3946 }
3947
3948 BUF_COMPUTE_UNCHANGED (buf, start, end);
3949
3950 bset_redisplay (buf);
3951
3952 ++BUF_OVERLAY_MODIFF (buf);
3953 }
3954
3955 /* Remove OVERLAY from LIST. */
3956
3957 static struct Lisp_Overlay *
3958 unchain_overlay (struct Lisp_Overlay *list, struct Lisp_Overlay *overlay)
3959 {
3960 register struct Lisp_Overlay *tail, **prev = &list;
3961
3962 for (tail = list; tail; prev = &tail->next, tail = *prev)
3963 if (tail == overlay)
3964 {
3965 *prev = overlay->next;
3966 overlay->next = NULL;
3967 break;
3968 }
3969 return list;
3970 }
3971
3972 /* Remove OVERLAY from both overlay lists of B. */
3973
3974 static void
3975 unchain_both (struct buffer *b, Lisp_Object overlay)
3976 {
3977 struct Lisp_Overlay *ov = XOVERLAY (overlay);
3978
3979 set_buffer_overlays_before (b, unchain_overlay (b->overlays_before, ov));
3980 set_buffer_overlays_after (b, unchain_overlay (b->overlays_after, ov));
3981 eassert (XOVERLAY (overlay)->next == NULL);
3982 }
3983
3984 DEFUN ("move-overlay", Fmove_overlay, Smove_overlay, 3, 4, 0,
3985 doc: /* Set the endpoints of OVERLAY to BEG and END in BUFFER.
3986 If BUFFER is omitted, leave OVERLAY in the same buffer it inhabits now.
3987 If BUFFER is omitted, and OVERLAY is in no buffer, put it in the current
3988 buffer. */)
3989 (Lisp_Object overlay, Lisp_Object beg, Lisp_Object end, Lisp_Object buffer)
3990 {
3991 struct buffer *b, *ob = 0;
3992 Lisp_Object obuffer;
3993 dynwind_begin ();
3994 ptrdiff_t n_beg, n_end, o_beg IF_LINT (= 0), o_end IF_LINT (= 0);
3995
3996 CHECK_OVERLAY (overlay);
3997 if (NILP (buffer))
3998 buffer = Fmarker_buffer (OVERLAY_START (overlay));
3999 if (NILP (buffer))
4000 XSETBUFFER (buffer, current_buffer);
4001 CHECK_BUFFER (buffer);
4002
4003 if (NILP (Fbuffer_live_p (buffer)))
4004 error ("Attempt to move overlay to a dead buffer");
4005
4006 if (MARKERP (beg) && !EQ (Fmarker_buffer (beg), buffer))
4007 signal_error ("Marker points into wrong buffer", beg);
4008 if (MARKERP (end) && !EQ (Fmarker_buffer (end), buffer))
4009 signal_error ("Marker points into wrong buffer", end);
4010
4011 CHECK_NUMBER_COERCE_MARKER (beg);
4012 CHECK_NUMBER_COERCE_MARKER (end);
4013
4014 if (XINT (beg) > XINT (end))
4015 {
4016 Lisp_Object temp;
4017 temp = beg; beg = end; end = temp;
4018 }
4019
4020 specbind (Qinhibit_quit, Qt);
4021
4022 obuffer = Fmarker_buffer (OVERLAY_START (overlay));
4023 b = XBUFFER (buffer);
4024
4025 if (!NILP (obuffer))
4026 {
4027 ob = XBUFFER (obuffer);
4028
4029 o_beg = OVERLAY_POSITION (OVERLAY_START (overlay));
4030 o_end = OVERLAY_POSITION (OVERLAY_END (overlay));
4031
4032 unchain_both (ob, overlay);
4033 }
4034
4035 /* Set the overlay boundaries, which may clip them. */
4036 Fset_marker (OVERLAY_START (overlay), beg, buffer);
4037 Fset_marker (OVERLAY_END (overlay), end, buffer);
4038
4039 n_beg = marker_position (OVERLAY_START (overlay));
4040 n_end = marker_position (OVERLAY_END (overlay));
4041
4042 /* If the overlay has changed buffers, do a thorough redisplay. */
4043 if (!EQ (buffer, obuffer))
4044 {
4045 /* Redisplay where the overlay was. */
4046 if (ob)
4047 modify_overlay (ob, o_beg, o_end);
4048
4049 /* Redisplay where the overlay is going to be. */
4050 modify_overlay (b, n_beg, n_end);
4051 }
4052 else
4053 /* Redisplay the area the overlay has just left, or just enclosed. */
4054 {
4055 if (o_beg == n_beg)
4056 modify_overlay (b, o_end, n_end);
4057 else if (o_end == n_end)
4058 modify_overlay (b, o_beg, n_beg);
4059 else
4060 modify_overlay (b, min (o_beg, n_beg), max (o_end, n_end));
4061 }
4062
4063 /* Delete the overlay if it is empty after clipping and has the
4064 evaporate property. */
4065 if (n_beg == n_end && !NILP (Foverlay_get (overlay, Qevaporate))){
4066
4067 Lisp_Object tem0 = Fdelete_overlay (overlay);
4068 dynwind_end ();
4069 return tem0;
4070 }
4071
4072 /* Put the overlay into the new buffer's overlay lists, first on the
4073 wrong list. */
4074 if (n_end < b->overlay_center)
4075 {
4076 XOVERLAY (overlay)->next = b->overlays_after;
4077 set_buffer_overlays_after (b, XOVERLAY (overlay));
4078 }
4079 else
4080 {
4081 XOVERLAY (overlay)->next = b->overlays_before;
4082 set_buffer_overlays_before (b, XOVERLAY (overlay));
4083 }
4084
4085 /* This puts it in the right list, and in the right order. */
4086 recenter_overlay_lists (b, b->overlay_center);
4087
4088 dynwind_end ();
4089 return overlay;
4090 }
4091
4092 DEFUN ("delete-overlay", Fdelete_overlay, Sdelete_overlay, 1, 1, 0,
4093 doc: /* Delete the overlay OVERLAY from its buffer. */)
4094 (Lisp_Object overlay)
4095 {
4096 Lisp_Object buffer;
4097 struct buffer *b;
4098 dynwind_begin ();
4099
4100 CHECK_OVERLAY (overlay);
4101
4102 buffer = Fmarker_buffer (OVERLAY_START (overlay));
4103 if (NILP (buffer)) {
4104 dynwind_end ();
4105 return Qnil;
4106 }
4107
4108 b = XBUFFER (buffer);
4109 specbind (Qinhibit_quit, Qt);
4110
4111 unchain_both (b, overlay);
4112 drop_overlay (b, XOVERLAY (overlay));
4113
4114 /* When deleting an overlay with before or after strings, turn off
4115 display optimizations for the affected buffer, on the basis that
4116 these strings may contain newlines. This is easier to do than to
4117 check for that situation during redisplay. */
4118 if (!windows_or_buffers_changed
4119 && (!NILP (Foverlay_get (overlay, Qbefore_string))
4120 || !NILP (Foverlay_get (overlay, Qafter_string))))
4121 b->prevent_redisplay_optimizations_p = 1;
4122
4123 dynwind_end ();
4124 return Qnil;
4125 }
4126
4127 DEFUN ("delete-all-overlays", Fdelete_all_overlays, Sdelete_all_overlays, 0, 1, 0,
4128 doc: /* Delete all overlays of BUFFER.
4129 BUFFER omitted or nil means delete all overlays of the current
4130 buffer. */)
4131 (Lisp_Object buffer)
4132 {
4133 register struct buffer *buf;
4134
4135 if (NILP (buffer))
4136 buf = current_buffer;
4137 else
4138 {
4139 CHECK_BUFFER (buffer);
4140 buf = XBUFFER (buffer);
4141 }
4142
4143 delete_all_overlays (buf);
4144 return Qnil;
4145 }
4146 \f
4147 /* Overlay dissection functions. */
4148
4149 DEFUN ("overlay-start", Foverlay_start, Soverlay_start, 1, 1, 0,
4150 doc: /* Return the position at which OVERLAY starts. */)
4151 (Lisp_Object overlay)
4152 {
4153 CHECK_OVERLAY (overlay);
4154
4155 return (Fmarker_position (OVERLAY_START (overlay)));
4156 }
4157
4158 DEFUN ("overlay-end", Foverlay_end, Soverlay_end, 1, 1, 0,
4159 doc: /* Return the position at which OVERLAY ends. */)
4160 (Lisp_Object overlay)
4161 {
4162 CHECK_OVERLAY (overlay);
4163
4164 return (Fmarker_position (OVERLAY_END (overlay)));
4165 }
4166
4167 DEFUN ("overlay-buffer", Foverlay_buffer, Soverlay_buffer, 1, 1, 0,
4168 doc: /* Return the buffer OVERLAY belongs to.
4169 Return nil if OVERLAY has been deleted. */)
4170 (Lisp_Object overlay)
4171 {
4172 CHECK_OVERLAY (overlay);
4173
4174 return Fmarker_buffer (OVERLAY_START (overlay));
4175 }
4176
4177 DEFUN ("overlay-properties", Foverlay_properties, Soverlay_properties, 1, 1, 0,
4178 doc: /* Return a list of the properties on OVERLAY.
4179 This is a copy of OVERLAY's plist; modifying its conses has no effect on
4180 OVERLAY. */)
4181 (Lisp_Object overlay)
4182 {
4183 CHECK_OVERLAY (overlay);
4184
4185 return Fcopy_sequence (XOVERLAY (overlay)->plist);
4186 }
4187
4188 \f
4189 DEFUN ("overlays-at", Foverlays_at, Soverlays_at, 1, 2, 0,
4190 doc: /* Return a list of the overlays that contain the character at POS.
4191 If SORTED is non-nil, then sort them by decreasing priority. */)
4192 (Lisp_Object pos, Lisp_Object sorted)
4193 {
4194 ptrdiff_t len, noverlays;
4195 Lisp_Object *overlay_vec;
4196 Lisp_Object result;
4197
4198 CHECK_NUMBER_COERCE_MARKER (pos);
4199
4200 if (!buffer_has_overlays ())
4201 return Qnil;
4202
4203 len = 10;
4204 /* We can't use alloca here because overlays_at can call xrealloc. */
4205 overlay_vec = xmalloc (len * sizeof *overlay_vec);
4206
4207 /* Put all the overlays we want in a vector in overlay_vec.
4208 Store the length in len. */
4209 noverlays = overlays_at (XINT (pos), 1, &overlay_vec, &len,
4210 NULL, NULL, 0);
4211
4212 if (!NILP (sorted))
4213 noverlays = sort_overlays (overlay_vec, noverlays,
4214 WINDOWP (sorted) ? XWINDOW (sorted) : NULL);
4215
4216 /* Make a list of them all. */
4217 result = Flist (noverlays, overlay_vec);
4218
4219 xfree (overlay_vec);
4220 return result;
4221 }
4222
4223 DEFUN ("overlays-in", Foverlays_in, Soverlays_in, 2, 2, 0,
4224 doc: /* Return a list of the overlays that overlap the region BEG ... END.
4225 Overlap means that at least one character is contained within the overlay
4226 and also contained within the specified region.
4227 Empty overlays are included in the result if they are located at BEG,
4228 between BEG and END, or at END provided END denotes the position at the
4229 end of the buffer. */)
4230 (Lisp_Object beg, Lisp_Object end)
4231 {
4232 ptrdiff_t len, noverlays;
4233 Lisp_Object *overlay_vec;
4234 Lisp_Object result;
4235
4236 CHECK_NUMBER_COERCE_MARKER (beg);
4237 CHECK_NUMBER_COERCE_MARKER (end);
4238
4239 if (!buffer_has_overlays ())
4240 return Qnil;
4241
4242 len = 10;
4243 overlay_vec = xmalloc (len * sizeof *overlay_vec);
4244
4245 /* Put all the overlays we want in a vector in overlay_vec.
4246 Store the length in len. */
4247 noverlays = overlays_in (XINT (beg), XINT (end), 1, &overlay_vec, &len,
4248 NULL, NULL);
4249
4250 /* Make a list of them all. */
4251 result = Flist (noverlays, overlay_vec);
4252
4253 xfree (overlay_vec);
4254 return result;
4255 }
4256
4257 DEFUN ("next-overlay-change", Fnext_overlay_change, Snext_overlay_change,
4258 1, 1, 0,
4259 doc: /* Return the next position after POS where an overlay starts or ends.
4260 If there are no overlay boundaries from POS to (point-max),
4261 the value is (point-max). */)
4262 (Lisp_Object pos)
4263 {
4264 ptrdiff_t i, len, noverlays;
4265 ptrdiff_t endpos;
4266 Lisp_Object *overlay_vec;
4267
4268 CHECK_NUMBER_COERCE_MARKER (pos);
4269
4270 if (!buffer_has_overlays ())
4271 return make_number (ZV);
4272
4273 len = 10;
4274 overlay_vec = xmalloc (len * sizeof *overlay_vec);
4275
4276 /* Put all the overlays we want in a vector in overlay_vec.
4277 Store the length in len.
4278 endpos gets the position where the next overlay starts. */
4279 noverlays = overlays_at (XINT (pos), 1, &overlay_vec, &len,
4280 &endpos, 0, 1);
4281
4282 /* If any of these overlays ends before endpos,
4283 use its ending point instead. */
4284 for (i = 0; i < noverlays; i++)
4285 {
4286 Lisp_Object oend;
4287 ptrdiff_t oendpos;
4288
4289 oend = OVERLAY_END (overlay_vec[i]);
4290 oendpos = OVERLAY_POSITION (oend);
4291 if (oendpos < endpos)
4292 endpos = oendpos;
4293 }
4294
4295 xfree (overlay_vec);
4296 return make_number (endpos);
4297 }
4298
4299 DEFUN ("previous-overlay-change", Fprevious_overlay_change,
4300 Sprevious_overlay_change, 1, 1, 0,
4301 doc: /* Return the previous position before POS where an overlay starts or ends.
4302 If there are no overlay boundaries from (point-min) to POS,
4303 the value is (point-min). */)
4304 (Lisp_Object pos)
4305 {
4306 ptrdiff_t prevpos;
4307 Lisp_Object *overlay_vec;
4308 ptrdiff_t len;
4309
4310 CHECK_NUMBER_COERCE_MARKER (pos);
4311
4312 if (!buffer_has_overlays ())
4313 return make_number (BEGV);
4314
4315 /* At beginning of buffer, we know the answer;
4316 avoid bug subtracting 1 below. */
4317 if (XINT (pos) == BEGV)
4318 return pos;
4319
4320 len = 10;
4321 overlay_vec = xmalloc (len * sizeof *overlay_vec);
4322
4323 /* Put all the overlays we want in a vector in overlay_vec.
4324 Store the length in len.
4325 prevpos gets the position of the previous change. */
4326 overlays_at (XINT (pos), 1, &overlay_vec, &len,
4327 0, &prevpos, 1);
4328
4329 xfree (overlay_vec);
4330 return make_number (prevpos);
4331 }
4332 \f
4333 /* These functions are for debugging overlays. */
4334
4335 DEFUN ("overlay-lists", Foverlay_lists, Soverlay_lists, 0, 0, 0,
4336 doc: /* Return a pair of lists giving all the overlays of the current buffer.
4337 The car has all the overlays before the overlay center;
4338 the cdr has all the overlays after the overlay center.
4339 Recentering overlays moves overlays between these lists.
4340 The lists you get are copies, so that changing them has no effect.
4341 However, the overlays you get are the real objects that the buffer uses. */)
4342 (void)
4343 {
4344 struct Lisp_Overlay *ol;
4345 Lisp_Object before = Qnil, after = Qnil, tmp;
4346
4347 for (ol = current_buffer->overlays_before; ol; ol = ol->next)
4348 {
4349 XSETMISC (tmp, ol);
4350 before = Fcons (tmp, before);
4351 }
4352 for (ol = current_buffer->overlays_after; ol; ol = ol->next)
4353 {
4354 XSETMISC (tmp, ol);
4355 after = Fcons (tmp, after);
4356 }
4357
4358 return Fcons (Fnreverse (before), Fnreverse (after));
4359 }
4360
4361 DEFUN ("overlay-recenter", Foverlay_recenter, Soverlay_recenter, 1, 1, 0,
4362 doc: /* Recenter the overlays of the current buffer around position POS.
4363 That makes overlay lookup faster for positions near POS (but perhaps slower
4364 for positions far away from POS). */)
4365 (Lisp_Object pos)
4366 {
4367 ptrdiff_t p;
4368 CHECK_NUMBER_COERCE_MARKER (pos);
4369
4370 p = clip_to_bounds (PTRDIFF_MIN, XINT (pos), PTRDIFF_MAX);
4371 recenter_overlay_lists (current_buffer, p);
4372 return Qnil;
4373 }
4374 \f
4375 DEFUN ("overlay-get", Foverlay_get, Soverlay_get, 2, 2, 0,
4376 doc: /* Get the property of overlay OVERLAY with property name PROP. */)
4377 (Lisp_Object overlay, Lisp_Object prop)
4378 {
4379 CHECK_OVERLAY (overlay);
4380 return lookup_char_property (XOVERLAY (overlay)->plist, prop, 0);
4381 }
4382
4383 DEFUN ("overlay-put", Foverlay_put, Soverlay_put, 3, 3, 0,
4384 doc: /* Set one property of overlay OVERLAY: give property PROP value VALUE.
4385 VALUE will be returned.*/)
4386 (Lisp_Object overlay, Lisp_Object prop, Lisp_Object value)
4387 {
4388 Lisp_Object tail, buffer;
4389 bool changed;
4390
4391 CHECK_OVERLAY (overlay);
4392
4393 buffer = Fmarker_buffer (OVERLAY_START (overlay));
4394
4395 for (tail = XOVERLAY (overlay)->plist;
4396 CONSP (tail) && CONSP (XCDR (tail));
4397 tail = XCDR (XCDR (tail)))
4398 if (EQ (XCAR (tail), prop))
4399 {
4400 changed = !EQ (XCAR (XCDR (tail)), value);
4401 XSETCAR (XCDR (tail), value);
4402 goto found;
4403 }
4404 /* It wasn't in the list, so add it to the front. */
4405 changed = !NILP (value);
4406 set_overlay_plist
4407 (overlay, Fcons (prop, Fcons (value, XOVERLAY (overlay)->plist)));
4408 found:
4409 if (! NILP (buffer))
4410 {
4411 if (changed)
4412 modify_overlay (XBUFFER (buffer),
4413 marker_position (OVERLAY_START (overlay)),
4414 marker_position (OVERLAY_END (overlay)));
4415 if (EQ (prop, Qevaporate) && ! NILP (value)
4416 && (OVERLAY_POSITION (OVERLAY_START (overlay))
4417 == OVERLAY_POSITION (OVERLAY_END (overlay))))
4418 Fdelete_overlay (overlay);
4419 }
4420
4421 return value;
4422 }
4423 \f
4424 /* Subroutine of report_overlay_modification. */
4425
4426 /* Lisp vector holding overlay hook functions to call.
4427 Vector elements come in pairs.
4428 Each even-index element is a list of hook functions.
4429 The following odd-index element is the overlay they came from.
4430
4431 Before the buffer change, we fill in this vector
4432 as we call overlay hook functions.
4433 After the buffer change, we get the functions to call from this vector.
4434 This way we always call the same functions before and after the change. */
4435 static Lisp_Object last_overlay_modification_hooks;
4436
4437 /* Number of elements actually used in last_overlay_modification_hooks. */
4438 static ptrdiff_t last_overlay_modification_hooks_used;
4439
4440 /* Add one functionlist/overlay pair
4441 to the end of last_overlay_modification_hooks. */
4442
4443 static void
4444 add_overlay_mod_hooklist (Lisp_Object functionlist, Lisp_Object overlay)
4445 {
4446 ptrdiff_t oldsize = ASIZE (last_overlay_modification_hooks);
4447
4448 if (oldsize - 1 <= last_overlay_modification_hooks_used)
4449 last_overlay_modification_hooks =
4450 larger_vector (last_overlay_modification_hooks, 2, -1);
4451 ASET (last_overlay_modification_hooks, last_overlay_modification_hooks_used,
4452 functionlist); last_overlay_modification_hooks_used++;
4453 ASET (last_overlay_modification_hooks, last_overlay_modification_hooks_used,
4454 overlay); last_overlay_modification_hooks_used++;
4455 }
4456 \f
4457 /* Run the modification-hooks of overlays that include
4458 any part of the text in START to END.
4459 If this change is an insertion, also
4460 run the insert-before-hooks of overlay starting at END,
4461 and the insert-after-hooks of overlay ending at START.
4462
4463 This is called both before and after the modification.
4464 AFTER is true when we call after the modification.
4465
4466 ARG1, ARG2, ARG3 are arguments to pass to the hook functions.
4467 When AFTER is nonzero, they are the start position,
4468 the position after the inserted new text,
4469 and the length of deleted or replaced old text. */
4470
4471 void
4472 report_overlay_modification (Lisp_Object start, Lisp_Object end, bool after,
4473 Lisp_Object arg1, Lisp_Object arg2, Lisp_Object arg3)
4474 {
4475 Lisp_Object prop, overlay;
4476 struct Lisp_Overlay *tail;
4477 /* True if this change is an insertion. */
4478 bool insertion = (after ? XFASTINT (arg3) == 0 : EQ (start, end));
4479 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
4480
4481 overlay = Qnil;
4482 tail = NULL;
4483
4484 /* We used to run the functions as soon as we found them and only register
4485 them in last_overlay_modification_hooks for the purpose of the `after'
4486 case. But running elisp code as we traverse the list of overlays is
4487 painful because the list can be modified by the elisp code so we had to
4488 copy at several places. We now simply do a read-only traversal that
4489 only collects the functions to run and we run them afterwards. It's
4490 simpler, especially since all the code was already there. -stef */
4491
4492 if (!after)
4493 {
4494 /* We are being called before a change.
4495 Scan the overlays to find the functions to call. */
4496 last_overlay_modification_hooks_used = 0;
4497 for (tail = current_buffer->overlays_before; tail; tail = tail->next)
4498 {
4499 ptrdiff_t startpos, endpos;
4500 Lisp_Object ostart, oend;
4501
4502 XSETMISC (overlay, tail);
4503
4504 ostart = OVERLAY_START (overlay);
4505 oend = OVERLAY_END (overlay);
4506 endpos = OVERLAY_POSITION (oend);
4507 if (XFASTINT (start) > endpos)
4508 break;
4509 startpos = OVERLAY_POSITION (ostart);
4510 if (insertion && (XFASTINT (start) == startpos
4511 || XFASTINT (end) == startpos))
4512 {
4513 prop = Foverlay_get (overlay, Qinsert_in_front_hooks);
4514 if (!NILP (prop))
4515 add_overlay_mod_hooklist (prop, overlay);
4516 }
4517 if (insertion && (XFASTINT (start) == endpos
4518 || XFASTINT (end) == endpos))
4519 {
4520 prop = Foverlay_get (overlay, Qinsert_behind_hooks);
4521 if (!NILP (prop))
4522 add_overlay_mod_hooklist (prop, overlay);
4523 }
4524 /* Test for intersecting intervals. This does the right thing
4525 for both insertion and deletion. */
4526 if (XFASTINT (end) > startpos && XFASTINT (start) < endpos)
4527 {
4528 prop = Foverlay_get (overlay, Qmodification_hooks);
4529 if (!NILP (prop))
4530 add_overlay_mod_hooklist (prop, overlay);
4531 }
4532 }
4533
4534 for (tail = current_buffer->overlays_after; tail; tail = tail->next)
4535 {
4536 ptrdiff_t startpos, endpos;
4537 Lisp_Object ostart, oend;
4538
4539 XSETMISC (overlay, tail);
4540
4541 ostart = OVERLAY_START (overlay);
4542 oend = OVERLAY_END (overlay);
4543 startpos = OVERLAY_POSITION (ostart);
4544 endpos = OVERLAY_POSITION (oend);
4545 if (XFASTINT (end) < startpos)
4546 break;
4547 if (insertion && (XFASTINT (start) == startpos
4548 || XFASTINT (end) == startpos))
4549 {
4550 prop = Foverlay_get (overlay, Qinsert_in_front_hooks);
4551 if (!NILP (prop))
4552 add_overlay_mod_hooklist (prop, overlay);
4553 }
4554 if (insertion && (XFASTINT (start) == endpos
4555 || XFASTINT (end) == endpos))
4556 {
4557 prop = Foverlay_get (overlay, Qinsert_behind_hooks);
4558 if (!NILP (prop))
4559 add_overlay_mod_hooklist (prop, overlay);
4560 }
4561 /* Test for intersecting intervals. This does the right thing
4562 for both insertion and deletion. */
4563 if (XFASTINT (end) > startpos && XFASTINT (start) < endpos)
4564 {
4565 prop = Foverlay_get (overlay, Qmodification_hooks);
4566 if (!NILP (prop))
4567 add_overlay_mod_hooklist (prop, overlay);
4568 }
4569 }
4570 }
4571
4572 GCPRO4 (overlay, arg1, arg2, arg3);
4573 {
4574 /* Call the functions recorded in last_overlay_modification_hooks.
4575 First copy the vector contents, in case some of these hooks
4576 do subsequent modification of the buffer. */
4577 ptrdiff_t size = last_overlay_modification_hooks_used;
4578 Lisp_Object *copy = alloca (size * sizeof *copy);
4579 ptrdiff_t i;
4580
4581 memcpy (copy, XVECTOR (last_overlay_modification_hooks)->contents,
4582 size * word_size);
4583 gcpro1.var = copy;
4584 gcpro1.nvars = size;
4585
4586 for (i = 0; i < size;)
4587 {
4588 Lisp_Object prop_i, overlay_i;
4589 prop_i = copy[i++];
4590 overlay_i = copy[i++];
4591 call_overlay_mod_hooks (prop_i, overlay_i, after, arg1, arg2, arg3);
4592 }
4593 }
4594 UNGCPRO;
4595 }
4596
4597 static void
4598 call_overlay_mod_hooks (Lisp_Object list, Lisp_Object overlay, bool after,
4599 Lisp_Object arg1, Lisp_Object arg2, Lisp_Object arg3)
4600 {
4601 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
4602
4603 GCPRO4 (list, arg1, arg2, arg3);
4604
4605 while (CONSP (list))
4606 {
4607 if (NILP (arg3))
4608 call4 (XCAR (list), overlay, after ? Qt : Qnil, arg1, arg2);
4609 else
4610 call5 (XCAR (list), overlay, after ? Qt : Qnil, arg1, arg2, arg3);
4611 list = XCDR (list);
4612 }
4613 UNGCPRO;
4614 }
4615
4616 /* Delete any zero-sized overlays at position POS, if the `evaporate'
4617 property is set. */
4618 void
4619 evaporate_overlays (ptrdiff_t pos)
4620 {
4621 Lisp_Object overlay, hit_list;
4622 struct Lisp_Overlay *tail;
4623
4624 hit_list = Qnil;
4625 if (pos <= current_buffer->overlay_center)
4626 for (tail = current_buffer->overlays_before; tail; tail = tail->next)
4627 {
4628 ptrdiff_t endpos;
4629 XSETMISC (overlay, tail);
4630 endpos = OVERLAY_POSITION (OVERLAY_END (overlay));
4631 if (endpos < pos)
4632 break;
4633 if (endpos == pos && OVERLAY_POSITION (OVERLAY_START (overlay)) == pos
4634 && ! NILP (Foverlay_get (overlay, Qevaporate)))
4635 hit_list = Fcons (overlay, hit_list);
4636 }
4637 else
4638 for (tail = current_buffer->overlays_after; tail; tail = tail->next)
4639 {
4640 ptrdiff_t startpos;
4641 XSETMISC (overlay, tail);
4642 startpos = OVERLAY_POSITION (OVERLAY_START (overlay));
4643 if (startpos > pos)
4644 break;
4645 if (startpos == pos && OVERLAY_POSITION (OVERLAY_END (overlay)) == pos
4646 && ! NILP (Foverlay_get (overlay, Qevaporate)))
4647 hit_list = Fcons (overlay, hit_list);
4648 }
4649 for (; CONSP (hit_list); hit_list = XCDR (hit_list))
4650 Fdelete_overlay (XCAR (hit_list));
4651 }
4652
4653 /***********************************************************************
4654 Allocation with mmap
4655 ***********************************************************************/
4656
4657 /* Note: WINDOWSNT implements this stuff on w32heap.c. */
4658 #if defined USE_MMAP_FOR_BUFFERS && !defined WINDOWSNT
4659
4660 #include <sys/mman.h>
4661
4662 #ifndef MAP_ANON
4663 #ifdef MAP_ANONYMOUS
4664 #define MAP_ANON MAP_ANONYMOUS
4665 #else
4666 #define MAP_ANON 0
4667 #endif
4668 #endif
4669
4670 #ifndef MAP_FAILED
4671 #define MAP_FAILED ((void *) -1)
4672 #endif
4673
4674 #if MAP_ANON == 0
4675 #include <fcntl.h>
4676 #endif
4677
4678 #include "coding.h"
4679
4680
4681 /* Memory is allocated in regions which are mapped using mmap(2).
4682 The current implementation lets the system select mapped
4683 addresses; we're not using MAP_FIXED in general, except when
4684 trying to enlarge regions.
4685
4686 Each mapped region starts with a mmap_region structure, the user
4687 area starts after that structure, aligned to MEM_ALIGN.
4688
4689 +-----------------------+
4690 | struct mmap_info + |
4691 | padding |
4692 +-----------------------+
4693 | user data |
4694 | |
4695 | |
4696 +-----------------------+ */
4697
4698 struct mmap_region
4699 {
4700 /* User-specified size. */
4701 size_t nbytes_specified;
4702
4703 /* Number of bytes mapped */
4704 size_t nbytes_mapped;
4705
4706 /* Pointer to the location holding the address of the memory
4707 allocated with the mmap'd block. The variable actually points
4708 after this structure. */
4709 void **var;
4710
4711 /* Next and previous in list of all mmap'd regions. */
4712 struct mmap_region *next, *prev;
4713 };
4714
4715 /* Doubly-linked list of mmap'd regions. */
4716
4717 static struct mmap_region *mmap_regions;
4718
4719 /* File descriptor for mmap. If we don't have anonymous mapping,
4720 /dev/zero will be opened on it. */
4721
4722 static int mmap_fd;
4723
4724 /* Page size on this system. */
4725
4726 static int mmap_page_size;
4727
4728 /* 1 means mmap has been initialized. */
4729
4730 static bool mmap_initialized_p;
4731
4732 /* Value is X rounded up to the next multiple of N. */
4733
4734 #define ROUND(X, N) (((X) + (N) - 1) / (N) * (N))
4735
4736 /* Size of mmap_region structure plus padding. */
4737
4738 #define MMAP_REGION_STRUCT_SIZE \
4739 ROUND (sizeof (struct mmap_region), MEM_ALIGN)
4740
4741 /* Given a pointer P to the start of the user-visible part of a mapped
4742 region, return a pointer to the start of the region. */
4743
4744 #define MMAP_REGION(P) \
4745 ((struct mmap_region *) ((char *) (P) - MMAP_REGION_STRUCT_SIZE))
4746
4747 /* Given a pointer P to the start of a mapped region, return a pointer
4748 to the start of the user-visible part of the region. */
4749
4750 #define MMAP_USER_AREA(P) \
4751 ((void *) ((char *) (P) + MMAP_REGION_STRUCT_SIZE))
4752
4753 #define MEM_ALIGN sizeof (double)
4754
4755 /* Predicate returning true if part of the address range [START .. END]
4756 is currently mapped. Used to prevent overwriting an existing
4757 memory mapping.
4758
4759 Default is to conservatively assume the address range is occupied by
4760 something else. This can be overridden by system configuration
4761 files if system-specific means to determine this exists. */
4762
4763 #ifndef MMAP_ALLOCATED_P
4764 #define MMAP_ALLOCATED_P(start, end) 1
4765 #endif
4766
4767 /* Perform necessary initializations for the use of mmap. */
4768
4769 static void
4770 mmap_init (void)
4771 {
4772 #if MAP_ANON == 0
4773 /* The value of mmap_fd is initially 0 in temacs, and -1
4774 in a dumped Emacs. */
4775 if (mmap_fd <= 0)
4776 {
4777 /* No anonymous mmap -- we need the file descriptor. */
4778 mmap_fd = emacs_open ("/dev/zero", O_RDONLY, 0);
4779 if (mmap_fd == -1)
4780 fatal ("Cannot open /dev/zero: %s", emacs_strerror (errno));
4781 }
4782 #endif /* MAP_ANON == 0 */
4783
4784 if (mmap_initialized_p)
4785 return;
4786 mmap_initialized_p = 1;
4787
4788 #if MAP_ANON != 0
4789 mmap_fd = -1;
4790 #endif
4791
4792 mmap_page_size = getpagesize ();
4793 }
4794
4795 /* Unmap a region. P is a pointer to the start of the user-araa of
4796 the region. */
4797
4798 static void
4799 mmap_free_1 (struct mmap_region *r)
4800 {
4801 if (r->next)
4802 r->next->prev = r->prev;
4803 if (r->prev)
4804 r->prev->next = r->next;
4805 else
4806 mmap_regions = r->next;
4807
4808 if (munmap (r, r->nbytes_mapped) == -1)
4809 fprintf (stderr, "munmap: %s\n", emacs_strerror (errno));
4810 }
4811
4812
4813 /* Enlarge region R by NPAGES pages. NPAGES < 0 means shrink R.
4814 Value is true if successful. */
4815
4816 static bool
4817 mmap_enlarge (struct mmap_region *r, int npages)
4818 {
4819 char *region_end = (char *) r + r->nbytes_mapped;
4820 size_t nbytes;
4821 bool success = 0;
4822
4823 if (npages < 0)
4824 {
4825 /* Unmap pages at the end of the region. */
4826 nbytes = - npages * mmap_page_size;
4827 if (munmap (region_end - nbytes, nbytes) == -1)
4828 fprintf (stderr, "munmap: %s\n", emacs_strerror (errno));
4829 else
4830 {
4831 r->nbytes_mapped -= nbytes;
4832 success = 1;
4833 }
4834 }
4835 else if (npages > 0)
4836 {
4837 nbytes = npages * mmap_page_size;
4838
4839 /* Try to map additional pages at the end of the region. We
4840 cannot do this if the address range is already occupied by
4841 something else because mmap deletes any previous mapping.
4842 I'm not sure this is worth doing, let's see. */
4843 if (!MMAP_ALLOCATED_P (region_end, region_end + nbytes))
4844 {
4845 void *p;
4846
4847 p = mmap (region_end, nbytes, PROT_READ | PROT_WRITE,
4848 MAP_ANON | MAP_PRIVATE | MAP_FIXED, mmap_fd, 0);
4849 if (p == MAP_FAILED)
4850 ; /* fprintf (stderr, "mmap: %s\n", emacs_strerror (errno)); */
4851 else if (p != region_end)
4852 {
4853 /* Kernels are free to choose a different address. In
4854 that case, unmap what we've mapped above; we have
4855 no use for it. */
4856 if (munmap (p, nbytes) == -1)
4857 fprintf (stderr, "munmap: %s\n", emacs_strerror (errno));
4858 }
4859 else
4860 {
4861 r->nbytes_mapped += nbytes;
4862 success = 1;
4863 }
4864 }
4865 }
4866
4867 return success;
4868 }
4869
4870
4871 /* Allocate a block of storage large enough to hold NBYTES bytes of
4872 data. A pointer to the data is returned in *VAR. VAR is thus the
4873 address of some variable which will use the data area.
4874
4875 The allocation of 0 bytes is valid.
4876
4877 If we can't allocate the necessary memory, set *VAR to null, and
4878 return null. */
4879
4880 static void *
4881 mmap_alloc (void **var, size_t nbytes)
4882 {
4883 void *p;
4884 size_t map;
4885
4886 mmap_init ();
4887
4888 map = ROUND (nbytes + MMAP_REGION_STRUCT_SIZE, mmap_page_size);
4889 p = mmap (NULL, map, PROT_READ | PROT_WRITE, MAP_ANON | MAP_PRIVATE,
4890 mmap_fd, 0);
4891
4892 if (p == MAP_FAILED)
4893 {
4894 if (errno != ENOMEM)
4895 fprintf (stderr, "mmap: %s\n", emacs_strerror (errno));
4896 p = NULL;
4897 }
4898 else
4899 {
4900 struct mmap_region *r = p;
4901
4902 r->nbytes_specified = nbytes;
4903 r->nbytes_mapped = map;
4904 r->var = var;
4905 r->prev = NULL;
4906 r->next = mmap_regions;
4907 if (r->next)
4908 r->next->prev = r;
4909 mmap_regions = r;
4910
4911 p = MMAP_USER_AREA (p);
4912 }
4913
4914 return *var = p;
4915 }
4916
4917
4918 /* Free a block of relocatable storage whose data is pointed to by
4919 PTR. Store 0 in *PTR to show there's no block allocated. */
4920
4921 static void
4922 mmap_free (void **var)
4923 {
4924 mmap_init ();
4925
4926 if (*var)
4927 {
4928 mmap_free_1 (MMAP_REGION (*var));
4929 *var = NULL;
4930 }
4931 }
4932
4933
4934 /* Given a pointer at address VAR to data allocated with mmap_alloc,
4935 resize it to size NBYTES. Change *VAR to reflect the new block,
4936 and return this value. If more memory cannot be allocated, then
4937 leave *VAR unchanged, and return null. */
4938
4939 static void *
4940 mmap_realloc (void **var, size_t nbytes)
4941 {
4942 void *result;
4943
4944 mmap_init ();
4945
4946 if (*var == NULL)
4947 result = mmap_alloc (var, nbytes);
4948 else if (nbytes == 0)
4949 {
4950 mmap_free (var);
4951 result = mmap_alloc (var, nbytes);
4952 }
4953 else
4954 {
4955 struct mmap_region *r = MMAP_REGION (*var);
4956 size_t room = r->nbytes_mapped - MMAP_REGION_STRUCT_SIZE;
4957
4958 if (room < nbytes)
4959 {
4960 /* Must enlarge. */
4961 void *old_ptr = *var;
4962
4963 /* Try to map additional pages at the end of the region.
4964 If that fails, allocate a new region, copy data
4965 from the old region, then free it. */
4966 if (mmap_enlarge (r, (ROUND (nbytes - room, mmap_page_size)
4967 / mmap_page_size)))
4968 {
4969 r->nbytes_specified = nbytes;
4970 *var = result = old_ptr;
4971 }
4972 else if (mmap_alloc (var, nbytes))
4973 {
4974 memcpy (*var, old_ptr, r->nbytes_specified);
4975 mmap_free_1 (MMAP_REGION (old_ptr));
4976 result = *var;
4977 r = MMAP_REGION (result);
4978 r->nbytes_specified = nbytes;
4979 }
4980 else
4981 {
4982 *var = old_ptr;
4983 result = NULL;
4984 }
4985 }
4986 else if (room - nbytes >= mmap_page_size)
4987 {
4988 /* Shrinking by at least a page. Let's give some
4989 memory back to the system.
4990
4991 The extra parens are to make the division happens first,
4992 on positive values, so we know it will round towards
4993 zero. */
4994 mmap_enlarge (r, - ((room - nbytes) / mmap_page_size));
4995 result = *var;
4996 r->nbytes_specified = nbytes;
4997 }
4998 else
4999 {
5000 /* Leave it alone. */
5001 result = *var;
5002 r->nbytes_specified = nbytes;
5003 }
5004 }
5005
5006 return result;
5007 }
5008
5009
5010 #endif /* USE_MMAP_FOR_BUFFERS */
5011
5012
5013 \f
5014 /***********************************************************************
5015 Buffer-text Allocation
5016 ***********************************************************************/
5017
5018 /* Allocate NBYTES bytes for buffer B's text buffer. */
5019
5020 static void
5021 alloc_buffer_text (struct buffer *b, ptrdiff_t nbytes)
5022 {
5023 void *p;
5024
5025 block_input ();
5026 #if defined USE_MMAP_FOR_BUFFERS
5027 p = mmap_alloc ((void **) &b->text->beg, nbytes);
5028 #elif defined REL_ALLOC
5029 p = r_alloc ((void **) &b->text->beg, nbytes);
5030 #else
5031 p = xmalloc_atomic (nbytes);
5032 #endif
5033
5034 if (p == NULL)
5035 {
5036 unblock_input ();
5037 memory_full (nbytes);
5038 }
5039
5040 b->text->beg = p;
5041 unblock_input ();
5042 }
5043
5044 /* Enlarge buffer B's text buffer by DELTA bytes. DELTA < 0 means
5045 shrink it. */
5046
5047 void
5048 enlarge_buffer_text (struct buffer *b, ptrdiff_t delta)
5049 {
5050 void *p;
5051 ptrdiff_t nbytes = (BUF_Z_BYTE (b) - BUF_BEG_BYTE (b) + BUF_GAP_SIZE (b) + 1
5052 + delta);
5053 block_input ();
5054 #if defined USE_MMAP_FOR_BUFFERS
5055 p = mmap_realloc ((void **) &b->text->beg, nbytes);
5056 #elif defined REL_ALLOC
5057 p = r_re_alloc ((void **) &b->text->beg, nbytes);
5058 #else
5059 p = xrealloc (b->text->beg, nbytes);
5060 #endif
5061
5062 if (p == NULL)
5063 {
5064 unblock_input ();
5065 memory_full (nbytes);
5066 }
5067
5068 BUF_BEG_ADDR (b) = p;
5069 unblock_input ();
5070 }
5071
5072
5073 /* Free buffer B's text buffer. */
5074
5075 static void
5076 free_buffer_text (struct buffer *b)
5077 {
5078 block_input ();
5079
5080 #if defined USE_MMAP_FOR_BUFFERS
5081 mmap_free ((void **) &b->text->beg);
5082 #elif defined REL_ALLOC
5083 r_alloc_free ((void **) &b->text->beg);
5084 #else
5085 xfree (b->text->beg);
5086 #endif
5087
5088 BUF_BEG_ADDR (b) = NULL;
5089 unblock_input ();
5090 }
5091
5092
5093 \f
5094 /***********************************************************************
5095 Initialization
5096 ***********************************************************************/
5097
5098 void
5099 init_buffer_once (void)
5100 {
5101 int idx;
5102
5103 memset (buffer_permanent_local_flags, 0, sizeof buffer_permanent_local_flags);
5104
5105 /* Make sure all markable slots in buffer_defaults
5106 are initialized reasonably, so mark_buffer won't choke. */
5107 reset_buffer (&buffer_defaults);
5108 eassert (EQ (BVAR (&buffer_defaults, name), make_number (0)));
5109 reset_buffer_local_variables (&buffer_defaults, 1);
5110 eassert (EQ (BVAR (&buffer_local_symbols, name), make_number (0)));
5111 reset_buffer (&buffer_local_symbols);
5112 reset_buffer_local_variables (&buffer_local_symbols, 1);
5113 /* Prevent GC from getting confused. */
5114 buffer_defaults.text = &buffer_defaults.own_text;
5115 buffer_local_symbols.text = &buffer_local_symbols.own_text;
5116 /* No one will share the text with these buffers, but let's play it safe. */
5117 buffer_defaults.indirections = 0;
5118 buffer_local_symbols.indirections = 0;
5119 /* Likewise no one will display them. */
5120 buffer_defaults.window_count = 0;
5121 buffer_local_symbols.window_count = 0;
5122 set_buffer_intervals (&buffer_defaults, NULL);
5123 set_buffer_intervals (&buffer_local_symbols, NULL);
5124 /* This is not strictly necessary, but let's make them initialized. */
5125 bset_name (&buffer_defaults, build_pure_c_string (" *buffer-defaults*"));
5126 bset_name (&buffer_local_symbols, build_pure_c_string (" *buffer-local-symbols*"));
5127 BUFFER_PVEC_INIT (&buffer_defaults);
5128 BUFFER_PVEC_INIT (&buffer_local_symbols);
5129
5130 /* Set up the default values of various buffer slots. */
5131 /* Must do these before making the first buffer! */
5132
5133 /* real setup is done in bindings.el */
5134 bset_mode_line_format (&buffer_defaults, build_pure_c_string ("%-"));
5135 bset_header_line_format (&buffer_defaults, Qnil);
5136 bset_abbrev_mode (&buffer_defaults, Qnil);
5137 bset_overwrite_mode (&buffer_defaults, Qnil);
5138 bset_case_fold_search (&buffer_defaults, Qt);
5139 bset_auto_fill_function (&buffer_defaults, Qnil);
5140 bset_selective_display (&buffer_defaults, Qnil);
5141 bset_selective_display_ellipses (&buffer_defaults, Qt);
5142 bset_abbrev_table (&buffer_defaults, Qnil);
5143 bset_display_table (&buffer_defaults, Qnil);
5144 bset_undo_list (&buffer_defaults, Qnil);
5145 bset_mark_active (&buffer_defaults, Qnil);
5146 bset_file_format (&buffer_defaults, Qnil);
5147 bset_auto_save_file_format (&buffer_defaults, Qt);
5148 set_buffer_overlays_before (&buffer_defaults, NULL);
5149 set_buffer_overlays_after (&buffer_defaults, NULL);
5150 buffer_defaults.overlay_center = BEG;
5151
5152 XSETFASTINT (BVAR (&buffer_defaults, tab_width), 8);
5153 bset_truncate_lines (&buffer_defaults, Qnil);
5154 bset_word_wrap (&buffer_defaults, Qnil);
5155 bset_ctl_arrow (&buffer_defaults, Qt);
5156 bset_bidi_display_reordering (&buffer_defaults, Qt);
5157 bset_bidi_paragraph_direction (&buffer_defaults, Qnil);
5158 bset_cursor_type (&buffer_defaults, Qt);
5159 bset_extra_line_spacing (&buffer_defaults, Qnil);
5160 bset_cursor_in_non_selected_windows (&buffer_defaults, Qt);
5161
5162 bset_enable_multibyte_characters (&buffer_defaults, Qt);
5163 bset_buffer_file_coding_system (&buffer_defaults, Qnil);
5164 XSETFASTINT (BVAR (&buffer_defaults, fill_column), 70);
5165 XSETFASTINT (BVAR (&buffer_defaults, left_margin), 0);
5166 bset_cache_long_scans (&buffer_defaults, Qt);
5167 bset_file_truename (&buffer_defaults, Qnil);
5168 XSETFASTINT (BVAR (&buffer_defaults, display_count), 0);
5169 XSETFASTINT (BVAR (&buffer_defaults, left_margin_cols), 0);
5170 XSETFASTINT (BVAR (&buffer_defaults, right_margin_cols), 0);
5171 bset_left_fringe_width (&buffer_defaults, Qnil);
5172 bset_right_fringe_width (&buffer_defaults, Qnil);
5173 bset_fringes_outside_margins (&buffer_defaults, Qnil);
5174 bset_scroll_bar_width (&buffer_defaults, Qnil);
5175 bset_vertical_scroll_bar_type (&buffer_defaults, Qt);
5176 bset_indicate_empty_lines (&buffer_defaults, Qnil);
5177 bset_indicate_buffer_boundaries (&buffer_defaults, Qnil);
5178 bset_fringe_indicator_alist (&buffer_defaults, Qnil);
5179 bset_fringe_cursor_alist (&buffer_defaults, Qnil);
5180 bset_scroll_up_aggressively (&buffer_defaults, Qnil);
5181 bset_scroll_down_aggressively (&buffer_defaults, Qnil);
5182 bset_display_time (&buffer_defaults, Qnil);
5183
5184 /* Assign the local-flags to the slots that have default values.
5185 The local flag is a bit that is used in the buffer
5186 to say that it has its own local value for the slot.
5187 The local flag bits are in the local_var_flags slot of the buffer. */
5188
5189 /* Nothing can work if this isn't true */
5190 { verify (sizeof (EMACS_INT) == word_size); }
5191
5192 /* 0 means not a lisp var, -1 means always local, else mask */
5193 memset (&buffer_local_flags, 0, sizeof buffer_local_flags);
5194 bset_filename (&buffer_local_flags, make_number (-1));
5195 bset_directory (&buffer_local_flags, make_number (-1));
5196 bset_backed_up (&buffer_local_flags, make_number (-1));
5197 bset_save_length (&buffer_local_flags, make_number (-1));
5198 bset_auto_save_file_name (&buffer_local_flags, make_number (-1));
5199 bset_read_only (&buffer_local_flags, make_number (-1));
5200 bset_major_mode (&buffer_local_flags, make_number (-1));
5201 bset_mode_name (&buffer_local_flags, make_number (-1));
5202 bset_undo_list (&buffer_local_flags, make_number (-1));
5203 bset_mark_active (&buffer_local_flags, make_number (-1));
5204 bset_point_before_scroll (&buffer_local_flags, make_number (-1));
5205 bset_file_truename (&buffer_local_flags, make_number (-1));
5206 bset_invisibility_spec (&buffer_local_flags, make_number (-1));
5207 bset_file_format (&buffer_local_flags, make_number (-1));
5208 bset_auto_save_file_format (&buffer_local_flags, make_number (-1));
5209 bset_display_count (&buffer_local_flags, make_number (-1));
5210 bset_display_time (&buffer_local_flags, make_number (-1));
5211 bset_enable_multibyte_characters (&buffer_local_flags, make_number (-1));
5212
5213 idx = 1;
5214 XSETFASTINT (BVAR (&buffer_local_flags, mode_line_format), idx); ++idx;
5215 XSETFASTINT (BVAR (&buffer_local_flags, abbrev_mode), idx); ++idx;
5216 XSETFASTINT (BVAR (&buffer_local_flags, overwrite_mode), idx); ++idx;
5217 XSETFASTINT (BVAR (&buffer_local_flags, case_fold_search), idx); ++idx;
5218 XSETFASTINT (BVAR (&buffer_local_flags, auto_fill_function), idx); ++idx;
5219 XSETFASTINT (BVAR (&buffer_local_flags, selective_display), idx); ++idx;
5220 XSETFASTINT (BVAR (&buffer_local_flags, selective_display_ellipses), idx); ++idx;
5221 XSETFASTINT (BVAR (&buffer_local_flags, tab_width), idx); ++idx;
5222 XSETFASTINT (BVAR (&buffer_local_flags, truncate_lines), idx); ++idx;
5223 XSETFASTINT (BVAR (&buffer_local_flags, word_wrap), idx); ++idx;
5224 XSETFASTINT (BVAR (&buffer_local_flags, ctl_arrow), idx); ++idx;
5225 XSETFASTINT (BVAR (&buffer_local_flags, fill_column), idx); ++idx;
5226 XSETFASTINT (BVAR (&buffer_local_flags, left_margin), idx); ++idx;
5227 XSETFASTINT (BVAR (&buffer_local_flags, abbrev_table), idx); ++idx;
5228 XSETFASTINT (BVAR (&buffer_local_flags, display_table), idx); ++idx;
5229 XSETFASTINT (BVAR (&buffer_local_flags, syntax_table), idx); ++idx;
5230 XSETFASTINT (BVAR (&buffer_local_flags, cache_long_scans), idx); ++idx;
5231 XSETFASTINT (BVAR (&buffer_local_flags, category_table), idx); ++idx;
5232 XSETFASTINT (BVAR (&buffer_local_flags, bidi_display_reordering), idx); ++idx;
5233 XSETFASTINT (BVAR (&buffer_local_flags, bidi_paragraph_direction), idx); ++idx;
5234 XSETFASTINT (BVAR (&buffer_local_flags, buffer_file_coding_system), idx);
5235 /* Make this one a permanent local. */
5236 buffer_permanent_local_flags[idx++] = 1;
5237 XSETFASTINT (BVAR (&buffer_local_flags, left_margin_cols), idx); ++idx;
5238 XSETFASTINT (BVAR (&buffer_local_flags, right_margin_cols), idx); ++idx;
5239 XSETFASTINT (BVAR (&buffer_local_flags, left_fringe_width), idx); ++idx;
5240 XSETFASTINT (BVAR (&buffer_local_flags, right_fringe_width), idx); ++idx;
5241 XSETFASTINT (BVAR (&buffer_local_flags, fringes_outside_margins), idx); ++idx;
5242 XSETFASTINT (BVAR (&buffer_local_flags, scroll_bar_width), idx); ++idx;
5243 XSETFASTINT (BVAR (&buffer_local_flags, vertical_scroll_bar_type), idx); ++idx;
5244 XSETFASTINT (BVAR (&buffer_local_flags, indicate_empty_lines), idx); ++idx;
5245 XSETFASTINT (BVAR (&buffer_local_flags, indicate_buffer_boundaries), idx); ++idx;
5246 XSETFASTINT (BVAR (&buffer_local_flags, fringe_indicator_alist), idx); ++idx;
5247 XSETFASTINT (BVAR (&buffer_local_flags, fringe_cursor_alist), idx); ++idx;
5248 XSETFASTINT (BVAR (&buffer_local_flags, scroll_up_aggressively), idx); ++idx;
5249 XSETFASTINT (BVAR (&buffer_local_flags, scroll_down_aggressively), idx); ++idx;
5250 XSETFASTINT (BVAR (&buffer_local_flags, header_line_format), idx); ++idx;
5251 XSETFASTINT (BVAR (&buffer_local_flags, cursor_type), idx); ++idx;
5252 XSETFASTINT (BVAR (&buffer_local_flags, extra_line_spacing), idx); ++idx;
5253 XSETFASTINT (BVAR (&buffer_local_flags, cursor_in_non_selected_windows), idx); ++idx;
5254
5255 /* Need more room? */
5256 if (idx >= MAX_PER_BUFFER_VARS)
5257 emacs_abort ();
5258 last_per_buffer_idx = idx;
5259
5260 Vbuffer_alist = Qnil;
5261 current_buffer = 0;
5262 all_buffers = 0;
5263
5264 QSFundamental = build_pure_c_string ("Fundamental");
5265
5266 Qfundamental_mode = intern_c_string ("fundamental-mode");
5267 bset_major_mode (&buffer_defaults, Qfundamental_mode);
5268
5269 Qmode_class = intern_c_string ("mode-class");
5270
5271 Qprotected_field = intern_c_string ("protected-field");
5272
5273 Qpermanent_local = intern_c_string ("permanent-local");
5274
5275 Qkill_buffer_hook = intern_c_string ("kill-buffer-hook");
5276 Fput (Qkill_buffer_hook, Qpermanent_local, Qt);
5277
5278 /* super-magic invisible buffer */
5279 Vprin1_to_string_buffer = Fget_buffer_create (build_pure_c_string (" prin1"));
5280 Vbuffer_alist = Qnil;
5281
5282 Fset_buffer (Fget_buffer_create (build_pure_c_string ("*scratch*")));
5283
5284 inhibit_modification_hooks = 0;
5285 }
5286
5287 void
5288 init_buffer (int initialized)
5289 {
5290 char *pwd;
5291 Lisp_Object temp;
5292 ptrdiff_t len;
5293
5294 #ifdef USE_MMAP_FOR_BUFFERS
5295 if (initialized)
5296 {
5297 struct buffer *b;
5298
5299 #ifndef WINDOWSNT
5300 /* These must be reset in the dumped Emacs, to avoid stale
5301 references to mmap'ed memory from before the dump.
5302
5303 WINDOWSNT doesn't need this because it doesn't track mmap'ed
5304 regions by hand (see w32heap.c, which uses system APIs for
5305 that purpose), and thus doesn't use mmap_regions. */
5306 mmap_regions = NULL;
5307 mmap_fd = -1;
5308 #endif
5309
5310 /* The dumped buffers reference addresses of buffer text
5311 recorded by temacs, that cannot be used by the dumped Emacs.
5312 We map new memory for their text here.
5313
5314 Implementation note: the buffers we carry from temacs are:
5315 " prin1", "*scratch*", " *Minibuf-0*", "*Messages*", and
5316 " *code-conversion-work*". They are created by
5317 init_buffer_once and init_window_once (which are not called
5318 in the dumped Emacs), and by the first call to coding.c routines. */
5319 FOR_EACH_BUFFER (b)
5320 {
5321 b->text->beg = NULL;
5322 enlarge_buffer_text (b, 0);
5323 }
5324 }
5325 else
5326 {
5327 struct buffer *b;
5328
5329 /* Only buffers with allocated buffer text should be present at
5330 this point in temacs. */
5331 FOR_EACH_BUFFER (b)
5332 {
5333 eassert (b->text->beg != NULL);
5334 }
5335 }
5336 #else /* not USE_MMAP_FOR_BUFFERS */
5337 /* Avoid compiler warnings. */
5338 initialized = initialized;
5339 #endif /* USE_MMAP_FOR_BUFFERS */
5340
5341 Fset_buffer (Fget_buffer_create (build_string ("*scratch*")));
5342 if (NILP (BVAR (&buffer_defaults, enable_multibyte_characters)))
5343 Fset_buffer_multibyte (Qnil);
5344
5345 pwd = get_current_dir_name ();
5346
5347 if (!pwd)
5348 fatal ("`get_current_dir_name' failed: %s\n", strerror (errno));
5349
5350 /* Maybe this should really use some standard subroutine
5351 whose definition is filename syntax dependent. */
5352 len = strlen (pwd);
5353 if (!(IS_DIRECTORY_SEP (pwd[len - 1])))
5354 {
5355 /* Grow buffer to add directory separator and '\0'. */
5356 pwd = realloc (pwd, len + 2);
5357 if (!pwd)
5358 fatal ("`get_current_dir_name' failed: %s\n", strerror (errno));
5359 pwd[len] = DIRECTORY_SEP;
5360 pwd[len + 1] = '\0';
5361 len++;
5362 }
5363
5364 /* At this moment, we still don't know how to decode the directory
5365 name. So, we keep the bytes in unibyte form so that file I/O
5366 routines correctly get the original bytes. */
5367 bset_directory (current_buffer, make_unibyte_string (pwd, len));
5368
5369 /* Add /: to the front of the name
5370 if it would otherwise be treated as magic. */
5371 temp = Ffind_file_name_handler (BVAR (current_buffer, directory), Qt);
5372 if (! NILP (temp)
5373 /* If the default dir is just /, TEMP is non-nil
5374 because of the ange-ftp completion handler.
5375 However, it is not necessary to turn / into /:/.
5376 So avoid doing that. */
5377 && strcmp ("/", SSDATA (BVAR (current_buffer, directory))))
5378 bset_directory
5379 (current_buffer,
5380 concat2 (build_string ("/:"), BVAR (current_buffer, directory)));
5381
5382 temp = get_minibuffer (0);
5383 bset_directory (XBUFFER (temp), BVAR (current_buffer, directory));
5384
5385 free (pwd);
5386 }
5387
5388 /* Similar to defvar_lisp but define a variable whose value is the
5389 Lisp_Object stored in the current buffer. LNAME is the Lisp-level
5390 variable name. VNAME is the name of the buffer slot. PREDICATE
5391 is nil for a general Lisp variable. If PREDICATE is non-nil, then
5392 only Lisp values that satisfies the PREDICATE are allowed (except
5393 that nil is allowed too). DOC is a dummy where you write the doc
5394 string as a comment. */
5395
5396 #define DEFVAR_PER_BUFFER(lname, vname, predicate, doc) \
5397 do { \
5398 static struct Lisp_Buffer_Objfwd bo_fwd; \
5399 defvar_per_buffer (&bo_fwd, lname, vname, predicate); \
5400 } while (0)
5401
5402 static void
5403 defvar_per_buffer (struct Lisp_Buffer_Objfwd *bo_fwd, const char *namestring,
5404 Lisp_Object *address, Lisp_Object predicate)
5405 {
5406 sym_t sym;
5407 int offset;
5408
5409 sym = XSYMBOL (intern (namestring));
5410 offset = (char *)address - (char *)current_buffer;
5411
5412 bo_fwd->type = Lisp_Fwd_Buffer_Obj;
5413 bo_fwd->offset = offset;
5414 bo_fwd->predicate = predicate;
5415 SET_SYMBOL_DECLARED_SPECIAL (sym, 1);
5416 SET_SYMBOL_REDIRECT (sym, SYMBOL_FORWARDED);
5417 SET_SYMBOL_FWD (sym, (union Lisp_Fwd *) bo_fwd);
5418 XSETSYMBOL (PER_BUFFER_SYMBOL (offset), sym);
5419
5420 if (PER_BUFFER_IDX (offset) == 0)
5421 /* Did a DEFVAR_PER_BUFFER without initializing the corresponding
5422 slot of buffer_local_flags. */
5423 emacs_abort ();
5424 }
5425
5426
5427 /* Initialize the buffer routines. */
5428 void
5429 syms_of_buffer (void)
5430 {
5431 #include "buffer.x"
5432
5433 staticpro (&last_overlay_modification_hooks);
5434 last_overlay_modification_hooks
5435 = Fmake_vector (make_number (10), Qnil);
5436
5437 staticpro (&Qfundamental_mode);
5438 staticpro (&Qmode_class);
5439 staticpro (&QSFundamental);
5440 staticpro (&Vbuffer_alist);
5441 staticpro (&Qprotected_field);
5442 staticpro (&Qpermanent_local);
5443 staticpro (&Qkill_buffer_hook);
5444
5445 DEFSYM (Qpermanent_local_hook, "permanent-local-hook");
5446 DEFSYM (Qoverlayp, "overlayp");
5447 DEFSYM (Qevaporate, "evaporate");
5448 DEFSYM (Qmodification_hooks, "modification-hooks");
5449 DEFSYM (Qinsert_in_front_hooks, "insert-in-front-hooks");
5450 DEFSYM (Qinsert_behind_hooks, "insert-behind-hooks");
5451 DEFSYM (Qget_file_buffer, "get-file-buffer");
5452 DEFSYM (Qpriority, "priority");
5453 DEFSYM (Qbefore_string, "before-string");
5454 DEFSYM (Qafter_string, "after-string");
5455 DEFSYM (Qfirst_change_hook, "first-change-hook");
5456 DEFSYM (Qbefore_change_functions, "before-change-functions");
5457 DEFSYM (Qafter_change_functions, "after-change-functions");
5458 DEFSYM (Qkill_buffer_query_functions, "kill-buffer-query-functions");
5459
5460 Fput (Qprotected_field, Qerror_conditions,
5461 listn (CONSTYPE_PURE, 2, Qprotected_field, Qerror));
5462 Fput (Qprotected_field, Qerror_message,
5463 build_pure_c_string ("Attempt to modify a protected field"));
5464
5465 DEFVAR_BUFFER_DEFAULTS ("default-mode-line-format",
5466 mode_line_format,
5467 doc: /* Default value of `mode-line-format' for buffers that don't override it.
5468 This is the same as (default-value 'mode-line-format). */);
5469
5470 DEFVAR_BUFFER_DEFAULTS ("default-header-line-format",
5471 header_line_format,
5472 doc: /* Default value of `header-line-format' for buffers that don't override it.
5473 This is the same as (default-value 'header-line-format). */);
5474
5475 DEFVAR_BUFFER_DEFAULTS ("default-cursor-type", cursor_type,
5476 doc: /* Default value of `cursor-type' for buffers that don't override it.
5477 This is the same as (default-value 'cursor-type). */);
5478
5479 DEFVAR_BUFFER_DEFAULTS ("default-line-spacing",
5480 extra_line_spacing,
5481 doc: /* Default value of `line-spacing' for buffers that don't override it.
5482 This is the same as (default-value 'line-spacing). */);
5483
5484 DEFVAR_BUFFER_DEFAULTS ("default-cursor-in-non-selected-windows",
5485 cursor_in_non_selected_windows,
5486 doc: /* Default value of `cursor-in-non-selected-windows'.
5487 This is the same as (default-value 'cursor-in-non-selected-windows). */);
5488
5489 DEFVAR_BUFFER_DEFAULTS ("default-abbrev-mode",
5490 abbrev_mode,
5491 doc: /* Default value of `abbrev-mode' for buffers that do not override it.
5492 This is the same as (default-value 'abbrev-mode). */);
5493
5494 DEFVAR_BUFFER_DEFAULTS ("default-ctl-arrow",
5495 ctl_arrow,
5496 doc: /* Default value of `ctl-arrow' for buffers that do not override it.
5497 This is the same as (default-value 'ctl-arrow). */);
5498
5499 DEFVAR_BUFFER_DEFAULTS ("default-enable-multibyte-characters",
5500 enable_multibyte_characters,
5501 doc: /* Default value of `enable-multibyte-characters' for buffers not overriding it.
5502 This is the same as (default-value 'enable-multibyte-characters). */);
5503
5504 DEFVAR_BUFFER_DEFAULTS ("default-buffer-file-coding-system",
5505 buffer_file_coding_system,
5506 doc: /* Default value of `buffer-file-coding-system' for buffers not overriding it.
5507 This is the same as (default-value 'buffer-file-coding-system). */);
5508
5509 DEFVAR_BUFFER_DEFAULTS ("default-truncate-lines",
5510 truncate_lines,
5511 doc: /* Default value of `truncate-lines' for buffers that do not override it.
5512 This is the same as (default-value 'truncate-lines). */);
5513
5514 DEFVAR_BUFFER_DEFAULTS ("default-fill-column",
5515 fill_column,
5516 doc: /* Default value of `fill-column' for buffers that do not override it.
5517 This is the same as (default-value 'fill-column). */);
5518
5519 DEFVAR_BUFFER_DEFAULTS ("default-left-margin",
5520 left_margin,
5521 doc: /* Default value of `left-margin' for buffers that do not override it.
5522 This is the same as (default-value 'left-margin). */);
5523
5524 DEFVAR_BUFFER_DEFAULTS ("default-tab-width",
5525 tab_width,
5526 doc: /* Default value of `tab-width' for buffers that do not override it.
5527 NOTE: This controls the display width of a TAB character, and not
5528 the size of an indentation step.
5529 This is the same as (default-value 'tab-width). */);
5530
5531 DEFVAR_BUFFER_DEFAULTS ("default-case-fold-search",
5532 case_fold_search,
5533 doc: /* Default value of `case-fold-search' for buffers that don't override it.
5534 This is the same as (default-value 'case-fold-search). */);
5535
5536 DEFVAR_BUFFER_DEFAULTS ("default-left-margin-width",
5537 left_margin_cols,
5538 doc: /* Default value of `left-margin-width' for buffers that don't override it.
5539 This is the same as (default-value 'left-margin-width). */);
5540
5541 DEFVAR_BUFFER_DEFAULTS ("default-right-margin-width",
5542 right_margin_cols,
5543 doc: /* Default value of `right-margin-width' for buffers that don't override it.
5544 This is the same as (default-value 'right-margin-width). */);
5545
5546 DEFVAR_BUFFER_DEFAULTS ("default-left-fringe-width",
5547 left_fringe_width,
5548 doc: /* Default value of `left-fringe-width' for buffers that don't override it.
5549 This is the same as (default-value 'left-fringe-width). */);
5550
5551 DEFVAR_BUFFER_DEFAULTS ("default-right-fringe-width",
5552 right_fringe_width,
5553 doc: /* Default value of `right-fringe-width' for buffers that don't override it.
5554 This is the same as (default-value 'right-fringe-width). */);
5555
5556 DEFVAR_BUFFER_DEFAULTS ("default-fringes-outside-margins",
5557 fringes_outside_margins,
5558 doc: /* Default value of `fringes-outside-margins' for buffers that don't override it.
5559 This is the same as (default-value 'fringes-outside-margins). */);
5560
5561 DEFVAR_BUFFER_DEFAULTS ("default-scroll-bar-width",
5562 scroll_bar_width,
5563 doc: /* Default value of `scroll-bar-width' for buffers that don't override it.
5564 This is the same as (default-value 'scroll-bar-width). */);
5565
5566 DEFVAR_BUFFER_DEFAULTS ("default-vertical-scroll-bar",
5567 vertical_scroll_bar_type,
5568 doc: /* Default value of `vertical-scroll-bar' for buffers that don't override it.
5569 This is the same as (default-value 'vertical-scroll-bar). */);
5570
5571 DEFVAR_BUFFER_DEFAULTS ("default-indicate-empty-lines",
5572 indicate_empty_lines,
5573 doc: /* Default value of `indicate-empty-lines' for buffers that don't override it.
5574 This is the same as (default-value 'indicate-empty-lines). */);
5575
5576 DEFVAR_BUFFER_DEFAULTS ("default-indicate-buffer-boundaries",
5577 indicate_buffer_boundaries,
5578 doc: /* Default value of `indicate-buffer-boundaries' for buffers that don't override it.
5579 This is the same as (default-value 'indicate-buffer-boundaries). */);
5580
5581 DEFVAR_BUFFER_DEFAULTS ("default-fringe-indicator-alist",
5582 fringe_indicator_alist,
5583 doc: /* Default value of `fringe-indicator-alist' for buffers that don't override it.
5584 This is the same as (default-value 'fringe-indicator-alist'). */);
5585
5586 DEFVAR_BUFFER_DEFAULTS ("default-fringe-cursor-alist",
5587 fringe_cursor_alist,
5588 doc: /* Default value of `fringe-cursor-alist' for buffers that don't override it.
5589 This is the same as (default-value 'fringe-cursor-alist'). */);
5590
5591 DEFVAR_BUFFER_DEFAULTS ("default-scroll-up-aggressively",
5592 scroll_up_aggressively,
5593 doc: /* Default value of `scroll-up-aggressively'.
5594 This value applies in buffers that don't have their own local values.
5595 This is the same as (default-value 'scroll-up-aggressively). */);
5596
5597 DEFVAR_BUFFER_DEFAULTS ("default-scroll-down-aggressively",
5598 scroll_down_aggressively,
5599 doc: /* Default value of `scroll-down-aggressively'.
5600 This value applies in buffers that don't have their own local values.
5601 This is the same as (default-value 'scroll-down-aggressively). */);
5602
5603 DEFVAR_PER_BUFFER ("header-line-format",
5604 &BVAR (current_buffer, header_line_format),
5605 Qnil,
5606 doc: /* Analogous to `mode-line-format', but controls the header line.
5607 The header line appears, optionally, at the top of a window;
5608 the mode line appears at the bottom. */);
5609
5610 DEFVAR_PER_BUFFER ("mode-line-format", &BVAR (current_buffer, mode_line_format),
5611 Qnil,
5612 doc: /* Template for displaying mode line for current buffer.
5613
5614 The value may be nil, a string, a symbol or a list.
5615
5616 A value of nil means don't display a mode line.
5617
5618 For any symbol other than t or nil, the symbol's value is processed as
5619 a mode line construct. As a special exception, if that value is a
5620 string, the string is processed verbatim, without handling any
5621 %-constructs (see below). Also, unless the symbol has a non-nil
5622 `risky-local-variable' property, all properties in any strings, as
5623 well as all :eval and :propertize forms in the value, are ignored.
5624
5625 A list whose car is a string or list is processed by processing each
5626 of the list elements recursively, as separate mode line constructs,
5627 and concatenating the results.
5628
5629 A list of the form `(:eval FORM)' is processed by evaluating FORM and
5630 using the result as a mode line construct. Be careful--FORM should
5631 not load any files, because that can cause an infinite recursion.
5632
5633 A list of the form `(:propertize ELT PROPS...)' is processed by
5634 processing ELT as the mode line construct, and adding the text
5635 properties PROPS to the result.
5636
5637 A list whose car is a symbol is processed by examining the symbol's
5638 value, and, if that value is non-nil, processing the cadr of the list
5639 recursively; and if that value is nil, processing the caddr of the
5640 list recursively.
5641
5642 A list whose car is an integer is processed by processing the cadr of
5643 the list, and padding (if the number is positive) or truncating (if
5644 negative) to the width specified by that number.
5645
5646 A string is printed verbatim in the mode line except for %-constructs:
5647 %b -- print buffer name. %f -- print visited file name.
5648 %F -- print frame name.
5649 %* -- print %, * or hyphen. %+ -- print *, % or hyphen.
5650 %& is like %*, but ignore read-only-ness.
5651 % means buffer is read-only and * means it is modified.
5652 For a modified read-only buffer, %* gives % and %+ gives *.
5653 %s -- print process status. %l -- print the current line number.
5654 %c -- print the current column number (this makes editing slower).
5655 To make the column number update correctly in all cases,
5656 `column-number-mode' must be non-nil.
5657 %i -- print the size of the buffer.
5658 %I -- like %i, but use k, M, G, etc., to abbreviate.
5659 %p -- print percent of buffer above top of window, or Top, Bot or All.
5660 %P -- print percent of buffer above bottom of window, perhaps plus Top,
5661 or print Bottom or All.
5662 %n -- print Narrow if appropriate.
5663 %t -- visited file is text or binary (if OS supports this distinction).
5664 %z -- print mnemonics of keyboard, terminal, and buffer coding systems.
5665 %Z -- like %z, but including the end-of-line format.
5666 %e -- print error message about full memory.
5667 %@ -- print @ or hyphen. @ means that default-directory is on a
5668 remote machine.
5669 %[ -- print one [ for each recursive editing level. %] similar.
5670 %% -- print %. %- -- print infinitely many dashes.
5671 Decimal digits after the % specify field width to which to pad. */);
5672
5673 DEFVAR_BUFFER_DEFAULTS ("default-major-mode", major_mode,
5674 doc: /* Value of `major-mode' for new buffers. */);
5675
5676 DEFVAR_PER_BUFFER ("major-mode", &BVAR (current_buffer, major_mode),
5677 Qsymbolp,
5678 doc: /* Symbol for current buffer's major mode.
5679 The default value (normally `fundamental-mode') affects new buffers.
5680 A value of nil means to use the current buffer's major mode, provided
5681 it is not marked as "special".
5682
5683 When a mode is used by default, `find-file' switches to it before it
5684 reads the contents into the buffer and before it finishes setting up
5685 the buffer. Thus, the mode and its hooks should not expect certain
5686 variables such as `buffer-read-only' and `buffer-file-coding-system'
5687 to be set up. */);
5688
5689 DEFVAR_PER_BUFFER ("mode-name", &BVAR (current_buffer, mode_name),
5690 Qnil,
5691 doc: /* Pretty name of current buffer's major mode.
5692 Usually a string, but can use any of the constructs for `mode-line-format',
5693 which see.
5694 Format with `format-mode-line' to produce a string value. */);
5695
5696 DEFVAR_PER_BUFFER ("local-abbrev-table", &BVAR (current_buffer, abbrev_table), Qnil,
5697 doc: /* Local (mode-specific) abbrev table of current buffer. */);
5698
5699 DEFVAR_PER_BUFFER ("abbrev-mode", &BVAR (current_buffer, abbrev_mode), Qnil,
5700 doc: /* Non-nil if Abbrev mode is enabled.
5701 Use the command `abbrev-mode' to change this variable. */);
5702
5703 DEFVAR_PER_BUFFER ("case-fold-search", &BVAR (current_buffer, case_fold_search),
5704 Qnil,
5705 doc: /* Non-nil if searches and matches should ignore case. */);
5706
5707 DEFVAR_PER_BUFFER ("fill-column", &BVAR (current_buffer, fill_column),
5708 Qintegerp,
5709 doc: /* Column beyond which automatic line-wrapping should happen.
5710 Interactively, you can set the buffer local value using \\[set-fill-column]. */);
5711
5712 DEFVAR_PER_BUFFER ("left-margin", &BVAR (current_buffer, left_margin),
5713 Qintegerp,
5714 doc: /* Column for the default `indent-line-function' to indent to.
5715 Linefeed indents to this column in Fundamental mode. */);
5716
5717 DEFVAR_PER_BUFFER ("tab-width", &BVAR (current_buffer, tab_width),
5718 Qintegerp,
5719 doc: /* Distance between tab stops (for display of tab characters), in columns.
5720 NOTE: This controls the display width of a TAB character, and not
5721 the size of an indentation step.
5722 This should be an integer greater than zero. */);
5723
5724 DEFVAR_PER_BUFFER ("ctl-arrow", &BVAR (current_buffer, ctl_arrow), Qnil,
5725 doc: /* Non-nil means display control chars with uparrow.
5726 A value of nil means use backslash and octal digits.
5727 This variable does not apply to characters whose display is specified
5728 in the current display table (if there is one). */);
5729
5730 DEFVAR_PER_BUFFER ("enable-multibyte-characters",
5731 &BVAR (current_buffer, enable_multibyte_characters),
5732 Qnil,
5733 doc: /* Non-nil means the buffer contents are regarded as multi-byte characters.
5734 Otherwise they are regarded as unibyte. This affects the display,
5735 file I/O and the behavior of various editing commands.
5736
5737 This variable is buffer-local but you cannot set it directly;
5738 use the function `set-buffer-multibyte' to change a buffer's representation.
5739 See also Info node `(elisp)Text Representations'. */);
5740 SET_SYMBOL_CONSTANT (XSYMBOL (intern_c_string ("enable-multibyte-characters")), 1);
5741
5742 DEFVAR_PER_BUFFER ("buffer-file-coding-system",
5743 &BVAR (current_buffer, buffer_file_coding_system), Qnil,
5744 doc: /* Coding system to be used for encoding the buffer contents on saving.
5745 This variable applies to saving the buffer, and also to `write-region'
5746 and other functions that use `write-region'.
5747 It does not apply to sending output to subprocesses, however.
5748
5749 If this is nil, the buffer is saved without any code conversion
5750 unless some coding system is specified in `file-coding-system-alist'
5751 for the buffer file.
5752
5753 If the text to be saved cannot be encoded as specified by this variable,
5754 an alternative encoding is selected by `select-safe-coding-system', which see.
5755
5756 The variable `coding-system-for-write', if non-nil, overrides this variable.
5757
5758 This variable is never applied to a way of decoding a file while reading it. */);
5759
5760 DEFVAR_PER_BUFFER ("bidi-display-reordering",
5761 &BVAR (current_buffer, bidi_display_reordering), Qnil,
5762 doc: /* Non-nil means reorder bidirectional text for display in the visual order. */);
5763
5764 DEFVAR_PER_BUFFER ("bidi-paragraph-direction",
5765 &BVAR (current_buffer, bidi_paragraph_direction), Qnil,
5766 doc: /* If non-nil, forces directionality of text paragraphs in the buffer.
5767
5768 If this is nil (the default), the direction of each paragraph is
5769 determined by the first strong directional character of its text.
5770 The values of `right-to-left' and `left-to-right' override that.
5771 Any other value is treated as nil.
5772
5773 This variable has no effect unless the buffer's value of
5774 \`bidi-display-reordering' is non-nil. */);
5775
5776 DEFVAR_PER_BUFFER ("truncate-lines", &BVAR (current_buffer, truncate_lines), Qnil,
5777 doc: /* Non-nil means do not display continuation lines.
5778 Instead, give each line of text just one screen line.
5779
5780 Note that this is overridden by the variable
5781 `truncate-partial-width-windows' if that variable is non-nil
5782 and this buffer is not full-frame width.
5783
5784 Minibuffers set this variable to nil. */);
5785
5786 DEFVAR_PER_BUFFER ("word-wrap", &BVAR (current_buffer, word_wrap), Qnil,
5787 doc: /* Non-nil means to use word-wrapping for continuation lines.
5788 When word-wrapping is on, continuation lines are wrapped at the space
5789 or tab character nearest to the right window edge.
5790 If nil, continuation lines are wrapped at the right screen edge.
5791
5792 This variable has no effect if long lines are truncated (see
5793 `truncate-lines' and `truncate-partial-width-windows'). If you use
5794 word-wrapping, you might want to reduce the value of
5795 `truncate-partial-width-windows', since wrapping can make text readable
5796 in narrower windows.
5797
5798 Instead of setting this variable directly, most users should use
5799 Visual Line mode . Visual Line mode, when enabled, sets `word-wrap'
5800 to t, and additionally redefines simple editing commands to act on
5801 visual lines rather than logical lines. See the documentation of
5802 `visual-line-mode'. */);
5803
5804 DEFVAR_PER_BUFFER ("default-directory", &BVAR (current_buffer, directory),
5805 Qstringp,
5806 doc: /* Name of default directory of current buffer. Should end with slash.
5807 To interactively change the default directory, use command `cd'. */);
5808
5809 DEFVAR_PER_BUFFER ("auto-fill-function", &BVAR (current_buffer, auto_fill_function),
5810 Qnil,
5811 doc: /* Function called (if non-nil) to perform auto-fill.
5812 It is called after self-inserting any character specified in
5813 the `auto-fill-chars' table.
5814 NOTE: This variable is not a hook;
5815 its value may not be a list of functions. */);
5816
5817 DEFVAR_PER_BUFFER ("buffer-file-name", &BVAR (current_buffer, filename),
5818 Qstringp,
5819 doc: /* Name of file visited in current buffer, or nil if not visiting a file.
5820 This should be an absolute file name. */);
5821
5822 DEFVAR_PER_BUFFER ("buffer-file-truename", &BVAR (current_buffer, file_truename),
5823 Qstringp,
5824 doc: /* Abbreviated truename of file visited in current buffer, or nil if none.
5825 The truename of a file is calculated by `file-truename'
5826 and then abbreviated with `abbreviate-file-name'. */);
5827
5828 DEFVAR_PER_BUFFER ("buffer-auto-save-file-name",
5829 &BVAR (current_buffer, auto_save_file_name),
5830 Qstringp,
5831 doc: /* Name of file for auto-saving current buffer.
5832 If it is nil, that means don't auto-save this buffer. */);
5833
5834 DEFVAR_PER_BUFFER ("buffer-read-only", &BVAR (current_buffer, read_only), Qnil,
5835 doc: /* Non-nil if this buffer is read-only. */);
5836
5837 DEFVAR_PER_BUFFER ("buffer-backed-up", &BVAR (current_buffer, backed_up), Qnil,
5838 doc: /* Non-nil if this buffer's file has been backed up.
5839 Backing up is done before the first time the file is saved. */);
5840
5841 DEFVAR_PER_BUFFER ("buffer-saved-size", &BVAR (current_buffer, save_length),
5842 Qintegerp,
5843 doc: /* Length of current buffer when last read in, saved or auto-saved.
5844 0 initially.
5845 -1 means auto-saving turned off until next real save.
5846
5847 If you set this to -2, that means don't turn off auto-saving in this buffer
5848 if its text size shrinks. If you use `buffer-swap-text' on a buffer,
5849 you probably should set this to -2 in that buffer. */);
5850
5851 DEFVAR_PER_BUFFER ("selective-display", &BVAR (current_buffer, selective_display),
5852 Qnil,
5853 doc: /* Non-nil enables selective display.
5854 An integer N as value means display only lines
5855 that start with less than N columns of space.
5856 A value of t means that the character ^M makes itself and
5857 all the rest of the line invisible; also, when saving the buffer
5858 in a file, save the ^M as a newline. */);
5859
5860 DEFVAR_PER_BUFFER ("selective-display-ellipses",
5861 &BVAR (current_buffer, selective_display_ellipses),
5862 Qnil,
5863 doc: /* Non-nil means display ... on previous line when a line is invisible. */);
5864
5865 DEFVAR_PER_BUFFER ("overwrite-mode", &BVAR (current_buffer, overwrite_mode), Qnil,
5866 doc: /* Non-nil if self-insertion should replace existing text.
5867 The value should be one of `overwrite-mode-textual',
5868 `overwrite-mode-binary', or nil.
5869 If it is `overwrite-mode-textual', self-insertion still
5870 inserts at the end of a line, and inserts when point is before a tab,
5871 until the tab is filled in.
5872 If `overwrite-mode-binary', self-insertion replaces newlines and tabs too. */);
5873
5874 DEFVAR_PER_BUFFER ("buffer-display-table", &BVAR (current_buffer, display_table),
5875 Qnil,
5876 doc: /* Display table that controls display of the contents of current buffer.
5877
5878 If this variable is nil, the value of `standard-display-table' is used.
5879 Each window can have its own, overriding display table, see
5880 `set-window-display-table' and `window-display-table'.
5881
5882 The display table is a char-table created with `make-display-table'.
5883 A char-table is an array indexed by character codes. Normal array
5884 primitives `aref' and `aset' can be used to access elements of a char-table.
5885
5886 Each of the char-table elements control how to display the corresponding
5887 text character: the element at index C in the table says how to display
5888 the character whose code is C. Each element should be a vector of
5889 characters or nil. The value nil means display the character in the
5890 default fashion; otherwise, the characters from the vector are delivered
5891 to the screen instead of the original character.
5892
5893 For example, (aset buffer-display-table ?X [?Y]) tells Emacs
5894 to display a capital Y instead of each X character.
5895
5896 In addition, a char-table has six extra slots to control the display of:
5897
5898 the end of a truncated screen line (extra-slot 0, a single character);
5899 the end of a continued line (extra-slot 1, a single character);
5900 the escape character used to display character codes in octal
5901 (extra-slot 2, a single character);
5902 the character used as an arrow for control characters (extra-slot 3,
5903 a single character);
5904 the decoration indicating the presence of invisible lines (extra-slot 4,
5905 a vector of characters);
5906 the character used to draw the border between side-by-side windows
5907 (extra-slot 5, a single character).
5908
5909 See also the functions `display-table-slot' and `set-display-table-slot'. */);
5910
5911 DEFVAR_PER_BUFFER ("left-margin-width", &BVAR (current_buffer, left_margin_cols),
5912 Qintegerp,
5913 doc: /* Width in columns of left marginal area for display of a buffer.
5914 A value of nil means no marginal area.
5915
5916 Setting this variable does not take effect until a new buffer is displayed
5917 in a window. To make the change take effect, call `set-window-buffer'. */);
5918
5919 DEFVAR_PER_BUFFER ("right-margin-width", &BVAR (current_buffer, right_margin_cols),
5920 Qintegerp,
5921 doc: /* Width in columns of right marginal area for display of a buffer.
5922 A value of nil means no marginal area.
5923
5924 Setting this variable does not take effect until a new buffer is displayed
5925 in a window. To make the change take effect, call `set-window-buffer'. */);
5926
5927 DEFVAR_PER_BUFFER ("left-fringe-width", &BVAR (current_buffer, left_fringe_width),
5928 Qintegerp,
5929 doc: /* Width of this buffer's left fringe (in pixels).
5930 A value of 0 means no left fringe is shown in this buffer's window.
5931 A value of nil means to use the left fringe width from the window's frame.
5932
5933 Setting this variable does not take effect until a new buffer is displayed
5934 in a window. To make the change take effect, call `set-window-buffer'. */);
5935
5936 DEFVAR_PER_BUFFER ("right-fringe-width", &BVAR (current_buffer, right_fringe_width),
5937 Qintegerp,
5938 doc: /* Width of this buffer's right fringe (in pixels).
5939 A value of 0 means no right fringe is shown in this buffer's window.
5940 A value of nil means to use the right fringe width from the window's frame.
5941
5942 Setting this variable does not take effect until a new buffer is displayed
5943 in a window. To make the change take effect, call `set-window-buffer'. */);
5944
5945 DEFVAR_PER_BUFFER ("fringes-outside-margins", &BVAR (current_buffer, fringes_outside_margins),
5946 Qnil,
5947 doc: /* Non-nil means to display fringes outside display margins.
5948 A value of nil means to display fringes between margins and buffer text.
5949
5950 Setting this variable does not take effect until a new buffer is displayed
5951 in a window. To make the change take effect, call `set-window-buffer'. */);
5952
5953 DEFVAR_PER_BUFFER ("scroll-bar-width", &BVAR (current_buffer, scroll_bar_width),
5954 Qintegerp,
5955 doc: /* Width of this buffer's scroll bars in pixels.
5956 A value of nil means to use the scroll bar width from the window's frame. */);
5957
5958 DEFVAR_PER_BUFFER ("vertical-scroll-bar", &BVAR (current_buffer, vertical_scroll_bar_type),
5959 Qnil,
5960 doc: /* Position of this buffer's vertical scroll bar.
5961 The value takes effect whenever you tell a window to display this buffer;
5962 for instance, with `set-window-buffer' or when `display-buffer' displays it.
5963
5964 A value of `left' or `right' means put the vertical scroll bar at that side
5965 of the window; a value of nil means don't show any vertical scroll bars.
5966 A value of t (the default) means do whatever the window's frame specifies. */);
5967
5968 DEFVAR_PER_BUFFER ("indicate-empty-lines",
5969 &BVAR (current_buffer, indicate_empty_lines), Qnil,
5970 doc: /* Visually indicate empty lines after the buffer end.
5971 If non-nil, a bitmap is displayed in the left fringe of a window on
5972 window-systems. */);
5973
5974 DEFVAR_PER_BUFFER ("indicate-buffer-boundaries",
5975 &BVAR (current_buffer, indicate_buffer_boundaries), Qnil,
5976 doc: /* Visually indicate buffer boundaries and scrolling.
5977 If non-nil, the first and last line of the buffer are marked in the fringe
5978 of a window on window-systems with angle bitmaps, or if the window can be
5979 scrolled, the top and bottom line of the window are marked with up and down
5980 arrow bitmaps.
5981
5982 If value is a symbol `left' or `right', both angle and arrow bitmaps
5983 are displayed in the left or right fringe, resp. Any other value
5984 that doesn't look like an alist means display the angle bitmaps in
5985 the left fringe but no arrows.
5986
5987 You can exercise more precise control by using an alist as the
5988 value. Each alist element (INDICATOR . POSITION) specifies
5989 where to show one of the indicators. INDICATOR is one of `top',
5990 `bottom', `up', `down', or t, which specifies the default position,
5991 and POSITION is one of `left', `right', or nil, meaning do not show
5992 this indicator.
5993
5994 For example, ((top . left) (t . right)) places the top angle bitmap in
5995 left fringe, the bottom angle bitmap in right fringe, and both arrow
5996 bitmaps in right fringe. To show just the angle bitmaps in the left
5997 fringe, but no arrow bitmaps, use ((top . left) (bottom . left)). */);
5998
5999 DEFVAR_PER_BUFFER ("fringe-indicator-alist",
6000 &BVAR (current_buffer, fringe_indicator_alist), Qnil,
6001 doc: /* Mapping from logical to physical fringe indicator bitmaps.
6002 The value is an alist where each element (INDICATOR . BITMAPS)
6003 specifies the fringe bitmaps used to display a specific logical
6004 fringe indicator.
6005
6006 INDICATOR specifies the logical indicator type which is one of the
6007 following symbols: `truncation' , `continuation', `overlay-arrow',
6008 `top', `bottom', `top-bottom', `up', `down', empty-line', or `unknown'.
6009
6010 BITMAPS is a list of symbols (LEFT RIGHT [LEFT1 RIGHT1]) which specifies
6011 the actual bitmap shown in the left or right fringe for the logical
6012 indicator. LEFT and RIGHT are the bitmaps shown in the left and/or
6013 right fringe for the specific indicator. The LEFT1 or RIGHT1 bitmaps
6014 are used only for the `bottom' and `top-bottom' indicators when the
6015 last (only) line has no final newline. BITMAPS may also be a single
6016 symbol which is used in both left and right fringes. */);
6017
6018 DEFVAR_PER_BUFFER ("fringe-cursor-alist",
6019 &BVAR (current_buffer, fringe_cursor_alist), Qnil,
6020 doc: /* Mapping from logical to physical fringe cursor bitmaps.
6021 The value is an alist where each element (CURSOR . BITMAP)
6022 specifies the fringe bitmaps used to display a specific logical
6023 cursor type in the fringe.
6024
6025 CURSOR specifies the logical cursor type which is one of the following
6026 symbols: `box' , `hollow', `bar', `hbar', or `hollow-small'. The last
6027 one is used to show a hollow cursor on narrow lines display lines
6028 where the normal hollow cursor will not fit.
6029
6030 BITMAP is the corresponding fringe bitmap shown for the logical
6031 cursor type. */);
6032
6033 DEFVAR_PER_BUFFER ("scroll-up-aggressively",
6034 &BVAR (current_buffer, scroll_up_aggressively), Qfloatp,
6035 doc: /* How far to scroll windows upward.
6036 If you move point off the bottom, the window scrolls automatically.
6037 This variable controls how far it scrolls. The value nil, the default,
6038 means scroll to center point. A fraction means scroll to put point
6039 that fraction of the window's height from the bottom of the window.
6040 When the value is 0.0, point goes at the bottom line, which in the
6041 simple case that you moved off with C-f means scrolling just one line.
6042 1.0 means point goes at the top, so that in that simple case, the
6043 window scrolls by a full window height. Meaningful values are
6044 between 0.0 and 1.0, inclusive. */);
6045
6046 DEFVAR_PER_BUFFER ("scroll-down-aggressively",
6047 &BVAR (current_buffer, scroll_down_aggressively), Qfloatp,
6048 doc: /* How far to scroll windows downward.
6049 If you move point off the top, the window scrolls automatically.
6050 This variable controls how far it scrolls. The value nil, the default,
6051 means scroll to center point. A fraction means scroll to put point
6052 that fraction of the window's height from the top of the window.
6053 When the value is 0.0, point goes at the top line, which in the
6054 simple case that you moved off with C-b means scrolling just one line.
6055 1.0 means point goes at the bottom, so that in that simple case, the
6056 window scrolls by a full window height. Meaningful values are
6057 between 0.0 and 1.0, inclusive. */);
6058
6059 DEFVAR_LISP ("before-change-functions", Vbefore_change_functions,
6060 doc: /* List of functions to call before each text change.
6061 Two arguments are passed to each function: the positions of
6062 the beginning and end of the range of old text to be changed.
6063 \(For an insertion, the beginning and end are at the same place.)
6064 No information is given about the length of the text after the change.
6065
6066 Buffer changes made while executing the `before-change-functions'
6067 don't call any before-change or after-change functions.
6068 That's because `inhibit-modification-hooks' is temporarily set non-nil.
6069
6070 If an unhandled error happens in running these functions,
6071 the variable's value remains nil. That prevents the error
6072 from happening repeatedly and making Emacs nonfunctional. */);
6073 Vbefore_change_functions = Qnil;
6074
6075 DEFVAR_LISP ("after-change-functions", Vafter_change_functions,
6076 doc: /* List of functions to call after each text change.
6077 Three arguments are passed to each function: the positions of
6078 the beginning and end of the range of changed text,
6079 and the length in bytes of the pre-change text replaced by that range.
6080 \(For an insertion, the pre-change length is zero;
6081 for a deletion, that length is the number of bytes deleted,
6082 and the post-change beginning and end are at the same place.)
6083
6084 Buffer changes made while executing the `after-change-functions'
6085 don't call any before-change or after-change functions.
6086 That's because `inhibit-modification-hooks' is temporarily set non-nil.
6087
6088 If an unhandled error happens in running these functions,
6089 the variable's value remains nil. That prevents the error
6090 from happening repeatedly and making Emacs nonfunctional. */);
6091 Vafter_change_functions = Qnil;
6092
6093 DEFVAR_LISP ("first-change-hook", Vfirst_change_hook,
6094 doc: /* A list of functions to call before changing a buffer which is unmodified.
6095 The functions are run using the `run-hooks' function. */);
6096 Vfirst_change_hook = Qnil;
6097
6098 DEFVAR_PER_BUFFER ("buffer-undo-list", &BVAR (current_buffer, undo_list), Qnil,
6099 doc: /* List of undo entries in current buffer.
6100 Recent changes come first; older changes follow newer.
6101
6102 An entry (BEG . END) represents an insertion which begins at
6103 position BEG and ends at position END.
6104
6105 An entry (TEXT . POSITION) represents the deletion of the string TEXT
6106 from (abs POSITION). If POSITION is positive, point was at the front
6107 of the text being deleted; if negative, point was at the end.
6108
6109 An entry (t HIGH LOW USEC PSEC) indicates that the buffer was previously
6110 unmodified; (HIGH LOW USEC PSEC) is in the same style as (current-time)
6111 and is the visited file's modification time, as of that time. If the
6112 modification time of the most recent save is different, this entry is
6113 obsolete.
6114
6115 An entry (t . 0) means means the buffer was previously unmodified but
6116 its time stamp was unknown because it was not associated with a file.
6117 An entry (t . -1) is similar, except that it means the buffer's visited
6118 file did not exist.
6119
6120 An entry (nil PROPERTY VALUE BEG . END) indicates that a text property
6121 was modified between BEG and END. PROPERTY is the property name,
6122 and VALUE is the old value.
6123
6124 An entry (apply FUN-NAME . ARGS) means undo the change with
6125 \(apply FUN-NAME ARGS).
6126
6127 An entry (apply DELTA BEG END FUN-NAME . ARGS) supports selective undo
6128 in the active region. BEG and END is the range affected by this entry
6129 and DELTA is the number of characters added or deleted in that range by
6130 this change.
6131
6132 An entry (MARKER . DISTANCE) indicates that the marker MARKER
6133 was adjusted in position by the offset DISTANCE (an integer).
6134
6135 An entry of the form POSITION indicates that point was at the buffer
6136 location given by the integer. Undoing an entry of this form places
6137 point at POSITION.
6138
6139 Entries with value `nil' mark undo boundaries. The undo command treats
6140 the changes between two undo boundaries as a single step to be undone.
6141
6142 If the value of the variable is t, undo information is not recorded. */);
6143
6144 DEFVAR_PER_BUFFER ("mark-active", &BVAR (current_buffer, mark_active), Qnil,
6145 doc: /* Non-nil means the mark and region are currently active in this buffer. */);
6146
6147 DEFVAR_PER_BUFFER ("cache-long-scans", &BVAR (current_buffer, cache_long_scans), Qnil,
6148 doc: /* Non-nil means that Emacs should use caches in attempt to speedup buffer scans.
6149
6150 There is no reason to set this to nil except for debugging purposes.
6151
6152 Normally, the line-motion functions work by scanning the buffer for
6153 newlines. Columnar operations (like `move-to-column' and
6154 `compute-motion') also work by scanning the buffer, summing character
6155 widths as they go. This works well for ordinary text, but if the
6156 buffer's lines are very long (say, more than 500 characters), these
6157 motion functions will take longer to execute. Emacs may also take
6158 longer to update the display.
6159
6160 If `cache-long-scans' is non-nil, these motion functions cache the
6161 results of their scans, and consult the cache to avoid rescanning
6162 regions of the buffer until the text is modified. The caches are most
6163 beneficial when they prevent the most searching---that is, when the
6164 buffer contains long lines and large regions of characters with the
6165 same, fixed screen width.
6166
6167 When `cache-long-scans' is non-nil, processing short lines will
6168 become slightly slower (because of the overhead of consulting the
6169 cache), and the caches will use memory roughly proportional to the
6170 number of newlines and characters whose screen width varies.
6171
6172 Bidirectional editing also requires buffer scans to find paragraph
6173 separators. If you have large paragraphs or no paragraph separators
6174 at all, these scans may be slow. If `cache-long-scans' is non-nil,
6175 results of these scans are cached. This doesn't help too much if
6176 paragraphs are of the reasonable (few thousands of characters) size.
6177
6178 The caches require no explicit maintenance; their accuracy is
6179 maintained internally by the Emacs primitives. Enabling or disabling
6180 the cache should not affect the behavior of any of the motion
6181 functions; it should only affect their performance. */);
6182
6183 DEFVAR_PER_BUFFER ("point-before-scroll", &BVAR (current_buffer, point_before_scroll), Qnil,
6184 doc: /* Value of point before the last series of scroll operations, or nil. */);
6185
6186 DEFVAR_PER_BUFFER ("buffer-file-format", &BVAR (current_buffer, file_format), Qnil,
6187 doc: /* List of formats to use when saving this buffer.
6188 Formats are defined by `format-alist'. This variable is
6189 set when a file is visited. */);
6190
6191 DEFVAR_PER_BUFFER ("buffer-auto-save-file-format",
6192 &BVAR (current_buffer, auto_save_file_format), Qnil,
6193 doc: /* Format in which to write auto-save files.
6194 Should be a list of symbols naming formats that are defined in `format-alist'.
6195 If it is t, which is the default, auto-save files are written in the
6196 same format as a regular save would use. */);
6197
6198 DEFVAR_PER_BUFFER ("buffer-invisibility-spec",
6199 &BVAR (current_buffer, invisibility_spec), Qnil,
6200 doc: /* Invisibility spec of this buffer.
6201 The default is t, which means that text is invisible if it has a non-nil
6202 `invisible' property.
6203 This variable can also be a list. The list can have two kinds of elements:
6204 `ATOM' and `(ATOM . ELLIPSIS)'. A text character is invisible if its
6205 `invisible' property is `ATOM', or has an `invisible' property that is a list
6206 that contains `ATOM'.
6207 If the `(ATOM . ELLIPSIS)' form is used, and `ELLIPSIS' is non-nil, an
6208 ellipsis will be displayed after the invisible characters.
6209 Setting this variable is very fast, much faster than scanning all the text in
6210 the buffer looking for properties to change. */);
6211
6212 DEFVAR_PER_BUFFER ("buffer-display-count",
6213 &BVAR (current_buffer, display_count), Qintegerp,
6214 doc: /* A number incremented each time this buffer is displayed in a window.
6215 The function `set-window-buffer' increments it. */);
6216
6217 DEFVAR_PER_BUFFER ("buffer-display-time",
6218 &BVAR (current_buffer, display_time), Qnil,
6219 doc: /* Time stamp updated each time this buffer is displayed in a window.
6220 The function `set-window-buffer' updates this variable
6221 to the value obtained by calling `current-time'.
6222 If the buffer has never been shown in a window, the value is nil. */);
6223
6224 DEFVAR_LISP ("transient-mark-mode", Vtransient_mark_mode,
6225 doc: /* Non-nil if Transient Mark mode is enabled.
6226 See the command `transient-mark-mode' for a description of this minor mode.
6227
6228 Non-nil also enables highlighting of the region whenever the mark is active.
6229 The variable `highlight-nonselected-windows' controls whether to highlight
6230 all windows or just the selected window.
6231
6232 Lisp programs may give this variable certain special values:
6233
6234 - A value of `lambda' enables Transient Mark mode temporarily.
6235 It is disabled again after any subsequent action that would
6236 normally deactivate the mark (e.g. buffer modification).
6237
6238 - A value of (only . OLDVAL) enables Transient Mark mode
6239 temporarily. After any subsequent point motion command that is
6240 not shift-translated, or any other action that would normally
6241 deactivate the mark (e.g. buffer modification), the value of
6242 `transient-mark-mode' is set to OLDVAL. */);
6243 Vtransient_mark_mode = Qnil;
6244
6245 DEFVAR_LISP ("inhibit-read-only", Vinhibit_read_only,
6246 doc: /* Non-nil means disregard read-only status of buffers or characters.
6247 If the value is t, disregard `buffer-read-only' and all `read-only'
6248 text properties. If the value is a list, disregard `buffer-read-only'
6249 and disregard a `read-only' text property if the property value
6250 is a member of the list. */);
6251 Vinhibit_read_only = Qnil;
6252
6253 DEFVAR_PER_BUFFER ("cursor-type", &BVAR (current_buffer, cursor_type), Qnil,
6254 doc: /* Cursor to use when this buffer is in the selected window.
6255 Values are interpreted as follows:
6256
6257 t use the cursor specified for the frame
6258 nil don't display a cursor
6259 box display a filled box cursor
6260 hollow display a hollow box cursor
6261 bar display a vertical bar cursor with default width
6262 (bar . WIDTH) display a vertical bar cursor with width WIDTH
6263 hbar display a horizontal bar cursor with default height
6264 (hbar . HEIGHT) display a horizontal bar cursor with height HEIGHT
6265 ANYTHING ELSE display a hollow box cursor
6266
6267 When the buffer is displayed in a non-selected window, the
6268 cursor's appearance is instead controlled by the variable
6269 `cursor-in-non-selected-windows'. */);
6270
6271 DEFVAR_PER_BUFFER ("line-spacing",
6272 &BVAR (current_buffer, extra_line_spacing), Qnumberp,
6273 doc: /* Additional space to put between lines when displaying a buffer.
6274 The space is measured in pixels, and put below lines on graphic displays,
6275 see `display-graphic-p'.
6276 If value is a floating point number, it specifies the spacing relative
6277 to the default frame line height. A value of nil means add no extra space. */);
6278
6279 DEFVAR_PER_BUFFER ("cursor-in-non-selected-windows",
6280 &BVAR (current_buffer, cursor_in_non_selected_windows), Qnil,
6281 doc: /* Non-nil means show a cursor in non-selected windows.
6282 If nil, only shows a cursor in the selected window.
6283 If t, displays a cursor related to the usual cursor type
6284 \(a solid box becomes hollow, a bar becomes a narrower bar).
6285 You can also specify the cursor type as in the `cursor-type' variable.
6286 Use Custom to set this variable and update the display." */);
6287
6288 DEFVAR_LISP ("kill-buffer-query-functions", Vkill_buffer_query_functions,
6289 doc: /* List of functions called with no args to query before killing a buffer.
6290 The buffer being killed will be current while the functions are running.
6291
6292 If any of them returns nil, the buffer is not killed. Functions run by
6293 this hook are supposed to not change the current buffer. */);
6294 Vkill_buffer_query_functions = Qnil;
6295
6296 DEFVAR_LISP ("change-major-mode-hook", Vchange_major_mode_hook,
6297 doc: /* Normal hook run before changing the major mode of a buffer.
6298 The function `kill-all-local-variables' runs this before doing anything else. */);
6299 Vchange_major_mode_hook = Qnil;
6300 DEFSYM (Qchange_major_mode_hook, "change-major-mode-hook");
6301
6302 DEFVAR_LISP ("buffer-list-update-hook", Vbuffer_list_update_hook,
6303 doc: /* Hook run when the buffer list changes.
6304 Functions running this hook are, `get-buffer-create',
6305 `make-indirect-buffer', `rename-buffer', `kill-buffer',
6306 `bury-buffer-internal' and `select-window'. */);
6307 Vbuffer_list_update_hook = Qnil;
6308 DEFSYM (Qbuffer_list_update_hook, "buffer-list-update-hook");
6309 }
6310
6311 void
6312 keys_of_buffer (void)
6313 {
6314 initial_define_key (control_x_map, 'b', "switch-to-buffer");
6315 initial_define_key (control_x_map, 'k', "kill-buffer");
6316
6317 /* This must not be in syms_of_buffer, because Qdisabled is not
6318 initialized when that function gets called. */
6319 Fput (intern_c_string ("erase-buffer"), Qdisabled, Qt);
6320 }