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