]> code.delx.au - gnu-emacs/blob - src/buffer.c
Minor tweaks of copying text properties when padding strings
[gnu-emacs] / src / buffer.c
1 /* Buffer manipulation primitives for GNU Emacs.
2
3 Copyright (C) 1985-1989, 1993-1995, 1997-2016 Free Software Foundation,
4 Inc.
5
6 This file is part of GNU Emacs.
7
8 GNU Emacs is free software: you can redistribute it and/or modify
9 it under the terms of the GNU General Public License as published by
10 the Free Software Foundation, either version 3 of the License, or (at
11 your option) any later version.
12
13 GNU Emacs is distributed in the hope that it will be useful,
14 but WITHOUT ANY WARRANTY; without even the implied warranty of
15 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 GNU General Public License for more details.
17
18 You should have received a copy of the GNU General Public License
19 along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
20
21 #include <config.h>
22
23 #include <sys/types.h>
24 #include <sys/stat.h>
25 #include <sys/param.h>
26 #include <errno.h>
27 #include <stdio.h>
28 #include <unistd.h>
29
30 #include <verify.h>
31
32 #include "lisp.h"
33 #include "intervals.h"
34 #include "systime.h"
35 #include "window.h"
36 #include "commands.h"
37 #include "character.h"
38 #include "buffer.h"
39 #include "region-cache.h"
40 #include "indent.h"
41 #include "blockinput.h"
42 #include "keymap.h"
43 #include "frame.h"
44 #include "xwidget.h"
45
46 #ifdef WINDOWSNT
47 #include "w32heap.h" /* for mmap_* */
48 #endif
49
50 struct buffer *current_buffer; /* The current buffer. */
51
52 /* First buffer in chain of all buffers (in reverse order of creation).
53 Threaded through ->header.next.buffer. */
54
55 struct buffer *all_buffers;
56
57 /* This structure holds the default values of the buffer-local variables
58 defined with DEFVAR_PER_BUFFER, that have special slots in each buffer.
59 The default value occupies the same slot in this structure
60 as an individual buffer's value occupies in that buffer.
61 Setting the default value also goes through the alist of buffers
62 and stores into each buffer that does not say it has a local value. */
63
64 struct buffer alignas (GCALIGNMENT) buffer_defaults;
65
66 /* This structure marks which slots in a buffer have corresponding
67 default values in buffer_defaults.
68 Each such slot has a nonzero value in this structure.
69 The value has only one nonzero bit.
70
71 When a buffer has its own local value for a slot,
72 the entry for that slot (found in the same slot in this structure)
73 is turned on in the buffer's local_flags array.
74
75 If a slot in this structure is -1, then even though there may
76 be a DEFVAR_PER_BUFFER for the slot, there is no default value for it;
77 and the corresponding slot in buffer_defaults is not used.
78
79 If a slot in this structure corresponding to a DEFVAR_PER_BUFFER is
80 zero, that is a bug. */
81
82 struct buffer buffer_local_flags;
83
84 /* This structure holds the names of symbols whose values may be
85 buffer-local. It is indexed and accessed in the same way as the above. */
86
87 struct buffer alignas (GCALIGNMENT) buffer_local_symbols;
88
89 /* Return the symbol of the per-buffer variable at offset OFFSET in
90 the buffer structure. */
91
92 #define PER_BUFFER_SYMBOL(OFFSET) \
93 (*(Lisp_Object *)((OFFSET) + (char *) &buffer_local_symbols))
94
95 /* Maximum length of an overlay vector. */
96 #define OVERLAY_COUNT_MAX \
97 ((ptrdiff_t) min (MOST_POSITIVE_FIXNUM, \
98 min (PTRDIFF_MAX, SIZE_MAX) / word_size))
99
100 /* Flags indicating which built-in buffer-local variables
101 are permanent locals. */
102 static char buffer_permanent_local_flags[MAX_PER_BUFFER_VARS];
103
104 /* Number of per-buffer variables used. */
105
106 int last_per_buffer_idx;
107
108 static void call_overlay_mod_hooks (Lisp_Object list, Lisp_Object overlay,
109 bool after, Lisp_Object arg1,
110 Lisp_Object arg2, Lisp_Object arg3);
111 static void swap_out_buffer_local_variables (struct buffer *b);
112 static void reset_buffer_local_variables (struct buffer *, bool);
113
114 /* Alist of all buffer names vs the buffers. This used to be
115 a Lisp-visible variable, but is no longer, to prevent lossage
116 due to user rplac'ing this alist or its elements. */
117 Lisp_Object Vbuffer_alist;
118
119 static Lisp_Object QSFundamental; /* A string "Fundamental". */
120
121 static void alloc_buffer_text (struct buffer *, ptrdiff_t);
122 static void free_buffer_text (struct buffer *b);
123 static struct Lisp_Overlay * copy_overlays (struct buffer *, struct Lisp_Overlay *);
124 static void modify_overlay (struct buffer *, ptrdiff_t, ptrdiff_t);
125 static Lisp_Object buffer_lisp_local_variables (struct buffer *, bool);
126
127 static void
128 CHECK_OVERLAY (Lisp_Object x)
129 {
130 CHECK_TYPE (OVERLAYP (x), Qoverlayp, x);
131 }
132
133 /* These setters are used only in this file, so they can be private.
134 The public setters are inline functions defined in buffer.h. */
135 static void
136 bset_abbrev_mode (struct buffer *b, Lisp_Object val)
137 {
138 b->abbrev_mode_ = val;
139 }
140 static void
141 bset_abbrev_table (struct buffer *b, Lisp_Object val)
142 {
143 b->abbrev_table_ = val;
144 }
145 static void
146 bset_auto_fill_function (struct buffer *b, Lisp_Object val)
147 {
148 b->auto_fill_function_ = val;
149 }
150 static void
151 bset_auto_save_file_format (struct buffer *b, Lisp_Object val)
152 {
153 b->auto_save_file_format_ = val;
154 }
155 static void
156 bset_auto_save_file_name (struct buffer *b, Lisp_Object val)
157 {
158 b->auto_save_file_name_ = val;
159 }
160 static void
161 bset_backed_up (struct buffer *b, Lisp_Object val)
162 {
163 b->backed_up_ = val;
164 }
165 static void
166 bset_begv_marker (struct buffer *b, Lisp_Object val)
167 {
168 b->begv_marker_ = val;
169 }
170 static void
171 bset_bidi_display_reordering (struct buffer *b, Lisp_Object val)
172 {
173 b->bidi_display_reordering_ = val;
174 }
175 static void
176 bset_buffer_file_coding_system (struct buffer *b, Lisp_Object val)
177 {
178 b->buffer_file_coding_system_ = val;
179 }
180 static void
181 bset_case_fold_search (struct buffer *b, Lisp_Object val)
182 {
183 b->case_fold_search_ = val;
184 }
185 static void
186 bset_ctl_arrow (struct buffer *b, Lisp_Object val)
187 {
188 b->ctl_arrow_ = val;
189 }
190 static void
191 bset_cursor_in_non_selected_windows (struct buffer *b, Lisp_Object val)
192 {
193 b->cursor_in_non_selected_windows_ = val;
194 }
195 static void
196 bset_cursor_type (struct buffer *b, Lisp_Object val)
197 {
198 b->cursor_type_ = val;
199 }
200 static void
201 bset_display_table (struct buffer *b, Lisp_Object val)
202 {
203 b->display_table_ = val;
204 }
205 static void
206 bset_extra_line_spacing (struct buffer *b, Lisp_Object val)
207 {
208 b->extra_line_spacing_ = val;
209 }
210 static void
211 bset_file_format (struct buffer *b, Lisp_Object val)
212 {
213 b->file_format_ = val;
214 }
215 static void
216 bset_file_truename (struct buffer *b, Lisp_Object val)
217 {
218 b->file_truename_ = val;
219 }
220 static void
221 bset_fringe_cursor_alist (struct buffer *b, Lisp_Object val)
222 {
223 b->fringe_cursor_alist_ = val;
224 }
225 static void
226 bset_fringe_indicator_alist (struct buffer *b, Lisp_Object val)
227 {
228 b->fringe_indicator_alist_ = val;
229 }
230 static void
231 bset_fringes_outside_margins (struct buffer *b, Lisp_Object val)
232 {
233 b->fringes_outside_margins_ = val;
234 }
235 static void
236 bset_header_line_format (struct buffer *b, Lisp_Object val)
237 {
238 b->header_line_format_ = val;
239 }
240 static void
241 bset_indicate_buffer_boundaries (struct buffer *b, Lisp_Object val)
242 {
243 b->indicate_buffer_boundaries_ = val;
244 }
245 static void
246 bset_indicate_empty_lines (struct buffer *b, Lisp_Object val)
247 {
248 b->indicate_empty_lines_ = val;
249 }
250 static void
251 bset_invisibility_spec (struct buffer *b, Lisp_Object val)
252 {
253 b->invisibility_spec_ = val;
254 }
255 static void
256 bset_left_fringe_width (struct buffer *b, Lisp_Object val)
257 {
258 b->left_fringe_width_ = val;
259 }
260 static void
261 bset_major_mode (struct buffer *b, Lisp_Object val)
262 {
263 b->major_mode_ = val;
264 }
265 static void
266 bset_mark (struct buffer *b, Lisp_Object val)
267 {
268 b->mark_ = val;
269 }
270 static void
271 bset_minor_modes (struct buffer *b, Lisp_Object val)
272 {
273 b->minor_modes_ = val;
274 }
275 static void
276 bset_mode_line_format (struct buffer *b, Lisp_Object val)
277 {
278 b->mode_line_format_ = val;
279 }
280 static void
281 bset_mode_name (struct buffer *b, Lisp_Object val)
282 {
283 b->mode_name_ = val;
284 }
285 static void
286 bset_name (struct buffer *b, Lisp_Object val)
287 {
288 b->name_ = val;
289 }
290 static void
291 bset_overwrite_mode (struct buffer *b, Lisp_Object val)
292 {
293 b->overwrite_mode_ = val;
294 }
295 static void
296 bset_pt_marker (struct buffer *b, Lisp_Object val)
297 {
298 b->pt_marker_ = val;
299 }
300 static void
301 bset_right_fringe_width (struct buffer *b, Lisp_Object val)
302 {
303 b->right_fringe_width_ = val;
304 }
305 static void
306 bset_save_length (struct buffer *b, Lisp_Object val)
307 {
308 b->save_length_ = val;
309 }
310 static void
311 bset_scroll_bar_width (struct buffer *b, Lisp_Object val)
312 {
313 b->scroll_bar_width_ = val;
314 }
315 static void
316 bset_scroll_bar_height (struct buffer *b, Lisp_Object val)
317 {
318 b->scroll_bar_height_ = val;
319 }
320 static void
321 bset_scroll_down_aggressively (struct buffer *b, Lisp_Object val)
322 {
323 b->scroll_down_aggressively_ = val;
324 }
325 static void
326 bset_scroll_up_aggressively (struct buffer *b, Lisp_Object val)
327 {
328 b->scroll_up_aggressively_ = val;
329 }
330 static void
331 bset_selective_display (struct buffer *b, Lisp_Object val)
332 {
333 b->selective_display_ = val;
334 }
335 static void
336 bset_selective_display_ellipses (struct buffer *b, Lisp_Object val)
337 {
338 b->selective_display_ellipses_ = val;
339 }
340 static void
341 bset_vertical_scroll_bar_type (struct buffer *b, Lisp_Object val)
342 {
343 b->vertical_scroll_bar_type_ = val;
344 }
345 static void
346 bset_horizontal_scroll_bar_type (struct buffer *b, Lisp_Object val)
347 {
348 b->horizontal_scroll_bar_type_ = val;
349 }
350 static void
351 bset_word_wrap (struct buffer *b, Lisp_Object val)
352 {
353 b->word_wrap_ = val;
354 }
355 static void
356 bset_zv_marker (struct buffer *b, Lisp_Object val)
357 {
358 b->zv_marker_ = val;
359 }
360
361 void
362 nsberror (Lisp_Object spec)
363 {
364 if (STRINGP (spec))
365 error ("No buffer named %s", SDATA (spec));
366 error ("Invalid buffer argument");
367 }
368 \f
369 DEFUN ("buffer-live-p", Fbuffer_live_p, Sbuffer_live_p, 1, 1, 0,
370 doc: /* Return non-nil if OBJECT is a buffer which has not been killed.
371 Value is nil if OBJECT is not a buffer or if it has been killed. */)
372 (Lisp_Object object)
373 {
374 return ((BUFFERP (object) && BUFFER_LIVE_P (XBUFFER (object)))
375 ? Qt : Qnil);
376 }
377
378 DEFUN ("buffer-list", Fbuffer_list, Sbuffer_list, 0, 1, 0,
379 doc: /* Return a list of all existing live buffers.
380 If the optional arg FRAME is a frame, we return the buffer list in the
381 proper order for that frame: the buffers show in FRAME come first,
382 followed by the rest of the buffers. */)
383 (Lisp_Object frame)
384 {
385 Lisp_Object general;
386 general = Fmapcar (Qcdr, Vbuffer_alist);
387
388 if (FRAMEP (frame))
389 {
390 Lisp_Object framelist, prevlist, tail;
391
392 framelist = Fcopy_sequence (XFRAME (frame)->buffer_list);
393 prevlist = Fnreverse (Fcopy_sequence
394 (XFRAME (frame)->buried_buffer_list));
395
396 /* Remove from GENERAL any buffer that duplicates one in
397 FRAMELIST or PREVLIST. */
398 tail = framelist;
399 while (CONSP (tail))
400 {
401 general = Fdelq (XCAR (tail), general);
402 tail = XCDR (tail);
403 }
404 tail = prevlist;
405 while (CONSP (tail))
406 {
407 general = Fdelq (XCAR (tail), general);
408 tail = XCDR (tail);
409 }
410
411 return CALLN (Fnconc, framelist, general, prevlist);
412 }
413 else
414 return general;
415 }
416
417 /* Like Fassoc, but use Fstring_equal to compare
418 (which ignores text properties),
419 and don't ever QUIT. */
420
421 static Lisp_Object
422 assoc_ignore_text_properties (register Lisp_Object key, Lisp_Object list)
423 {
424 register Lisp_Object tail;
425 for (tail = list; CONSP (tail); tail = XCDR (tail))
426 {
427 register Lisp_Object elt, tem;
428 elt = XCAR (tail);
429 tem = Fstring_equal (Fcar (elt), key);
430 if (!NILP (tem))
431 return elt;
432 }
433 return Qnil;
434 }
435
436 DEFUN ("get-buffer", Fget_buffer, Sget_buffer, 1, 1, 0,
437 doc: /* Return the buffer named BUFFER-OR-NAME.
438 BUFFER-OR-NAME must be either a string or a buffer. If BUFFER-OR-NAME
439 is a string and there is no buffer with that name, return nil. If
440 BUFFER-OR-NAME is a buffer, return it as given. */)
441 (register Lisp_Object buffer_or_name)
442 {
443 if (BUFFERP (buffer_or_name))
444 return buffer_or_name;
445 CHECK_STRING (buffer_or_name);
446
447 return Fcdr (assoc_ignore_text_properties (buffer_or_name, Vbuffer_alist));
448 }
449
450 DEFUN ("get-file-buffer", Fget_file_buffer, Sget_file_buffer, 1, 1, 0,
451 doc: /* Return the buffer visiting file FILENAME (a string).
452 The buffer's `buffer-file-name' must match exactly the expansion of FILENAME.
453 If there is no such live buffer, return nil.
454 See also `find-buffer-visiting'. */)
455 (register Lisp_Object filename)
456 {
457 register Lisp_Object tail, buf, handler;
458
459 CHECK_STRING (filename);
460 filename = Fexpand_file_name (filename, Qnil);
461
462 /* If the file name has special constructs in it,
463 call the corresponding file handler. */
464 handler = Ffind_file_name_handler (filename, Qget_file_buffer);
465 if (!NILP (handler))
466 {
467 Lisp_Object handled_buf = call2 (handler, Qget_file_buffer,
468 filename);
469 return BUFFERP (handled_buf) ? handled_buf : Qnil;
470 }
471
472 FOR_EACH_LIVE_BUFFER (tail, buf)
473 {
474 if (!STRINGP (BVAR (XBUFFER (buf), filename))) continue;
475 if (!NILP (Fstring_equal (BVAR (XBUFFER (buf), filename), filename)))
476 return buf;
477 }
478 return Qnil;
479 }
480
481 Lisp_Object
482 get_truename_buffer (register Lisp_Object filename)
483 {
484 register Lisp_Object tail, buf;
485
486 FOR_EACH_LIVE_BUFFER (tail, buf)
487 {
488 if (!STRINGP (BVAR (XBUFFER (buf), file_truename))) continue;
489 if (!NILP (Fstring_equal (BVAR (XBUFFER (buf), file_truename), filename)))
490 return buf;
491 }
492 return Qnil;
493 }
494
495 DEFUN ("get-buffer-create", Fget_buffer_create, Sget_buffer_create, 1, 1, 0,
496 doc: /* Return the buffer specified by BUFFER-OR-NAME, creating a new one if needed.
497 If BUFFER-OR-NAME is a string and a live buffer with that name exists,
498 return that buffer. If no such buffer exists, create a new buffer with
499 that name and return it. If BUFFER-OR-NAME starts with a space, the new
500 buffer does not keep undo information.
501
502 If BUFFER-OR-NAME is a buffer instead of a string, return it as given,
503 even if it is dead. The return value is never nil. */)
504 (register Lisp_Object buffer_or_name)
505 {
506 register Lisp_Object buffer, name;
507 register struct buffer *b;
508
509 buffer = Fget_buffer (buffer_or_name);
510 if (!NILP (buffer))
511 return buffer;
512
513 if (SCHARS (buffer_or_name) == 0)
514 error ("Empty string for buffer name is not allowed");
515
516 b = allocate_buffer ();
517
518 /* An ordinary buffer uses its own struct buffer_text. */
519 b->text = &b->own_text;
520 b->base_buffer = NULL;
521 /* No one shares the text with us now. */
522 b->indirections = 0;
523 /* No one shows us now. */
524 b->window_count = 0;
525
526 BUF_GAP_SIZE (b) = 20;
527 block_input ();
528 /* We allocate extra 1-byte at the tail and keep it always '\0' for
529 anchoring a search. */
530 alloc_buffer_text (b, BUF_GAP_SIZE (b) + 1);
531 unblock_input ();
532 if (! BUF_BEG_ADDR (b))
533 buffer_memory_full (BUF_GAP_SIZE (b) + 1);
534
535 b->pt = BEG;
536 b->begv = BEG;
537 b->zv = BEG;
538 b->pt_byte = BEG_BYTE;
539 b->begv_byte = BEG_BYTE;
540 b->zv_byte = BEG_BYTE;
541
542 BUF_GPT (b) = BEG;
543 BUF_GPT_BYTE (b) = BEG_BYTE;
544
545 BUF_Z (b) = BEG;
546 BUF_Z_BYTE (b) = BEG_BYTE;
547 BUF_MODIFF (b) = 1;
548 BUF_CHARS_MODIFF (b) = 1;
549 BUF_OVERLAY_MODIFF (b) = 1;
550 BUF_SAVE_MODIFF (b) = 1;
551 BUF_COMPACT (b) = 1;
552 set_buffer_intervals (b, NULL);
553 BUF_UNCHANGED_MODIFIED (b) = 1;
554 BUF_OVERLAY_UNCHANGED_MODIFIED (b) = 1;
555 BUF_END_UNCHANGED (b) = 0;
556 BUF_BEG_UNCHANGED (b) = 0;
557 *(BUF_GPT_ADDR (b)) = *(BUF_Z_ADDR (b)) = 0; /* Put an anchor '\0'. */
558 b->text->inhibit_shrinking = false;
559 b->text->redisplay = false;
560
561 b->newline_cache = 0;
562 b->width_run_cache = 0;
563 b->bidi_paragraph_cache = 0;
564 bset_width_table (b, Qnil);
565 b->prevent_redisplay_optimizations_p = 1;
566
567 /* An ordinary buffer normally doesn't need markers
568 to handle BEGV and ZV. */
569 bset_pt_marker (b, Qnil);
570 bset_begv_marker (b, Qnil);
571 bset_zv_marker (b, Qnil);
572
573 name = Fcopy_sequence (buffer_or_name);
574 set_string_intervals (name, NULL);
575 bset_name (b, name);
576
577 bset_undo_list (b, SREF (name, 0) != ' ' ? Qnil : Qt);
578
579 reset_buffer (b);
580 reset_buffer_local_variables (b, 1);
581
582 bset_mark (b, Fmake_marker ());
583 BUF_MARKERS (b) = NULL;
584
585 /* Put this in the alist of all live buffers. */
586 XSETBUFFER (buffer, b);
587 Vbuffer_alist = nconc2 (Vbuffer_alist, list1 (Fcons (name, buffer)));
588 /* And run buffer-list-update-hook. */
589 if (!NILP (Vrun_hooks))
590 call1 (Vrun_hooks, Qbuffer_list_update_hook);
591
592 return buffer;
593 }
594
595
596 /* Return a list of overlays which is a copy of the overlay list
597 LIST, but for buffer B. */
598
599 static struct Lisp_Overlay *
600 copy_overlays (struct buffer *b, struct Lisp_Overlay *list)
601 {
602 struct Lisp_Overlay *result = NULL, *tail = NULL;
603
604 for (; list; list = list->next)
605 {
606 Lisp_Object overlay, start, end;
607 struct Lisp_Marker *m;
608
609 eassert (MARKERP (list->start));
610 m = XMARKER (list->start);
611 start = build_marker (b, m->charpos, m->bytepos);
612 XMARKER (start)->insertion_type = m->insertion_type;
613
614 eassert (MARKERP (list->end));
615 m = XMARKER (list->end);
616 end = build_marker (b, m->charpos, m->bytepos);
617 XMARKER (end)->insertion_type = m->insertion_type;
618
619 overlay = build_overlay (start, end, Fcopy_sequence (list->plist));
620 if (tail)
621 tail = tail->next = XOVERLAY (overlay);
622 else
623 result = tail = XOVERLAY (overlay);
624 }
625
626 return result;
627 }
628
629 /* Set an appropriate overlay of B. */
630
631 static void
632 set_buffer_overlays_before (struct buffer *b, struct Lisp_Overlay *o)
633 {
634 b->overlays_before = o;
635 }
636
637 static void
638 set_buffer_overlays_after (struct buffer *b, struct Lisp_Overlay *o)
639 {
640 b->overlays_after = o;
641 }
642
643 /* Clone per-buffer values of buffer FROM.
644
645 Buffer TO gets the same per-buffer values as FROM, with the
646 following exceptions: (1) TO's name is left untouched, (2) markers
647 are copied and made to refer to TO, and (3) overlay lists are
648 copied. */
649
650 static void
651 clone_per_buffer_values (struct buffer *from, struct buffer *to)
652 {
653 int offset;
654
655 FOR_EACH_PER_BUFFER_OBJECT_AT (offset)
656 {
657 Lisp_Object obj;
658
659 /* Don't touch the `name' which should be unique for every buffer. */
660 if (offset == PER_BUFFER_VAR_OFFSET (name))
661 continue;
662
663 obj = per_buffer_value (from, offset);
664 if (MARKERP (obj) && XMARKER (obj)->buffer == from)
665 {
666 struct Lisp_Marker *m = XMARKER (obj);
667
668 obj = build_marker (to, m->charpos, m->bytepos);
669 XMARKER (obj)->insertion_type = m->insertion_type;
670 }
671
672 set_per_buffer_value (to, offset, obj);
673 }
674
675 memcpy (to->local_flags, from->local_flags, sizeof to->local_flags);
676
677 set_buffer_overlays_before (to, copy_overlays (to, from->overlays_before));
678 set_buffer_overlays_after (to, copy_overlays (to, from->overlays_after));
679
680 /* Get (a copy of) the alist of Lisp-level local variables of FROM
681 and install that in TO. */
682 bset_local_var_alist (to, buffer_lisp_local_variables (from, 1));
683 }
684
685
686 /* If buffer B has markers to record PT, BEGV and ZV when it is not
687 current, update these markers. */
688
689 static void
690 record_buffer_markers (struct buffer *b)
691 {
692 if (! NILP (BVAR (b, pt_marker)))
693 {
694 Lisp_Object buffer;
695
696 eassert (!NILP (BVAR (b, begv_marker)));
697 eassert (!NILP (BVAR (b, zv_marker)));
698
699 XSETBUFFER (buffer, b);
700 set_marker_both (BVAR (b, pt_marker), buffer, b->pt, b->pt_byte);
701 set_marker_both (BVAR (b, begv_marker), buffer, b->begv, b->begv_byte);
702 set_marker_both (BVAR (b, zv_marker), buffer, b->zv, b->zv_byte);
703 }
704 }
705
706
707 /* If buffer B has markers to record PT, BEGV and ZV when it is not
708 current, fetch these values into B->begv etc. */
709
710 static void
711 fetch_buffer_markers (struct buffer *b)
712 {
713 if (! NILP (BVAR (b, pt_marker)))
714 {
715 Lisp_Object m;
716
717 eassert (!NILP (BVAR (b, begv_marker)));
718 eassert (!NILP (BVAR (b, zv_marker)));
719
720 m = BVAR (b, pt_marker);
721 SET_BUF_PT_BOTH (b, marker_position (m), marker_byte_position (m));
722
723 m = BVAR (b, begv_marker);
724 SET_BUF_BEGV_BOTH (b, marker_position (m), marker_byte_position (m));
725
726 m = BVAR (b, zv_marker);
727 SET_BUF_ZV_BOTH (b, marker_position (m), marker_byte_position (m));
728 }
729 }
730
731
732 DEFUN ("make-indirect-buffer", Fmake_indirect_buffer, Smake_indirect_buffer,
733 2, 3,
734 "bMake indirect buffer (to buffer): \nBName of indirect buffer: ",
735 doc: /* Create and return an indirect buffer for buffer BASE-BUFFER, named NAME.
736 BASE-BUFFER should be a live buffer, or the name of an existing buffer.
737 NAME should be a string which is not the name of an existing buffer.
738 Optional argument CLONE non-nil means preserve BASE-BUFFER's state,
739 such as major and minor modes, in the indirect buffer.
740 CLONE nil means the indirect buffer's state is reset to default values. */)
741 (Lisp_Object base_buffer, Lisp_Object name, Lisp_Object clone)
742 {
743 Lisp_Object buf, tem;
744 struct buffer *b;
745
746 CHECK_STRING (name);
747 buf = Fget_buffer (name);
748 if (!NILP (buf))
749 error ("Buffer name `%s' is in use", SDATA (name));
750
751 tem = base_buffer;
752 base_buffer = Fget_buffer (base_buffer);
753 if (NILP (base_buffer))
754 error ("No such buffer: `%s'", SDATA (tem));
755 if (!BUFFER_LIVE_P (XBUFFER (base_buffer)))
756 error ("Base buffer has been killed");
757
758 if (SCHARS (name) == 0)
759 error ("Empty string for buffer name is not allowed");
760
761 b = allocate_buffer ();
762
763 /* No double indirection - if base buffer is indirect,
764 new buffer becomes an indirect to base's base. */
765 b->base_buffer = (XBUFFER (base_buffer)->base_buffer
766 ? XBUFFER (base_buffer)->base_buffer
767 : XBUFFER (base_buffer));
768
769 /* Use the base buffer's text object. */
770 b->text = b->base_buffer->text;
771 /* We have no own text. */
772 b->indirections = -1;
773 /* Notify base buffer that we share the text now. */
774 b->base_buffer->indirections++;
775 /* Always -1 for an indirect buffer. */
776 b->window_count = -1;
777
778 b->pt = b->base_buffer->pt;
779 b->begv = b->base_buffer->begv;
780 b->zv = b->base_buffer->zv;
781 b->pt_byte = b->base_buffer->pt_byte;
782 b->begv_byte = b->base_buffer->begv_byte;
783 b->zv_byte = b->base_buffer->zv_byte;
784
785 b->newline_cache = 0;
786 b->width_run_cache = 0;
787 b->bidi_paragraph_cache = 0;
788 bset_width_table (b, Qnil);
789
790 name = Fcopy_sequence (name);
791 set_string_intervals (name, NULL);
792 bset_name (b, name);
793
794 /* An indirect buffer shares undo list of its base (Bug#18180). */
795 bset_undo_list (b, BVAR (b->base_buffer, undo_list));
796
797 reset_buffer (b);
798 reset_buffer_local_variables (b, 1);
799
800