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