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