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