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