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