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