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